perm filename IMPSTA.MID[S,NET]4 blob sn#702383 filedate 1983-02-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00024 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	X J PDLLEN IIILIN DMLIN DDDLIN INTTTY ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW INTSW IO$INT IO$RFC IO$END IO$ACK IO$SBB IO.BKT BAL MAL NHBA NHMA HBA HMA BIIL MIIL PUPRID PUPSID
C00008 00003	HSTSID HSTFN1 HSTVRS HSTDIR HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW%RU NW$BYT
C00019 00004	SJBCNI DELAYP PDL HSTFIL LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD DPACT FRSPTY IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP ROUNET ROUSIZ ENINQM QMP11M PRJPRG JOBNAM PTYJOB TTYTAB NETCOD ADRTAB LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB FFLNK MKTITL RAWHST ADRFIX ENDCHK NETBSZ PUPHST PUPLDB PUPLSK PUPFSK PUPSTB PUPLKS IMPUPT
C00024 00005	IMPSTA NETSLP NETSRH INTRPT NETSRE
C00028 00006	SNARF CONTIN
C00032 00007	GETNET HDNODM IMPDDN
C00035 00008	NOTIDI NOTID1 NOTID2
C00036 00009	NOTID3 NXTNET NXTLNK HSTSRH
C00038 00010	HSTSR0 HSTOUT DOLINK DOLNKX FORSKT
C00041 00011	DPYLS SKPBS NOTCLS
C00043 00012	STADUN
C00044 00013	NODDB
C00046 00014	PUPSTA PUPLUK HAVPUP
C00047 00015	NENLNK ENLTYO
C00049 00016	LSNHST NXTENL
C00051 00017	PTYMAP PTYCHK PTYLUP PTYFND
C00053 00018	GETLOC NTELSR NXTPTY
C00054 00019	MSGEND SBNTLP CLREOF
C00056 00020	NODDDM DOIII DODM
C00058 00021	DELAY DELAY0 NODLAY TTYSER DELAY2 EATLF DELAY1
C00060 00022	TERPRI DECOUT OCTOUT NUMOUT NUMOU1 NUMOU2 NUMOU3
C00061 00023	JOBOUT SIXOUT SIXOU1 TXTSTR ...LIT
C00062 00024	Fixup network addresses for HOSTS2
C00064 ENDMK
C⊗;
;X J PDLLEN IIILIN DMLIN DDDLIN INTTTY ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW INTSW IO$INT IO$RFC IO$END IO$ACK IO$SBB IO.BKT BAL MAL NHBA NHMA HBA HMA BIIL MIIL PUPRID PUPSID

TITLE IMPSTAT
SUBTTL Definitions

; Mark Crispin, SU-AI, May 1981

X=1 ? Y=2 ? Z=3 ? L=4 ? I=5 ? N=6 ? DDB=7
J=10 ? T=11 ? A=12 ? B=13 ? C=14 ? NET=15 ? P=17

PDLLEN==50.				; stack size

; GETLIN bits

IIILIN==400000,,			; terminal is a III
DMLIN==	040000,,			; terminal is a DM
DDDLIN==020000,,			; terminal is a DD

; APRENB bits

INTTTY== 20000		;LH -- TTY input
ILM==	020000		;RH -- MPV occured

; Data Risc command word

DEFINE CW ?C1,B1,C2,B2,C3,B3
 <<B1←28.>\<B2←20.>\<B3←12.>\<C1←9.>\<C2←6.>\<C3←3>\4>
TERMIN

; Data Risc command names

EXCT==	0				; execute
FNCN==	1				; function, usual value bytes
	ALPHBG==6 ? ALPHA==46
CHNL==	2				; channel select
COLM==	3				; column select
HILIN==	4				; set high 5 bits of line address
LOLIN==	5				; set low 4 bits of line address

IMP==   400				; IMP interface device code

; IMP status bits

RFCS==	200000,,			; RFC sent
RFCR==	100000,,			; RFC received
CLSS==	040000,,			; CLS sent
CLSR==	020000,,			; CLS received

; DDB stuff

DEVCHR==1				; characteristics
DEVIOS==2				; I/O status
 INPW==	200000,,			; input wait
 LNK0W==100000,,			; control link RFNM wait
 BLOKW==040000,,			; RFNM wait
 ALLW==	020000,,			; allocation wait
 INTSW==000400,,			; interrupt acknowledge wait
 IO$INT==200000,,			; Interrupt waiting acknowedgement
 IO$RFC==100000,,			; waiting for matching RFC
 IO$END==040040,,			; End Pup seen
 IO$ACK==020000,,			; output Ack wait
 IO$SBB==001000,,			; in I/O wait
 IO.BKT==040000				; Mark/AMark seen
BAL==	14				; bit allocation
MAL==	15				; message allocation
NHBA==	16				; nominal bit allocation
NHMA==	17				; nominal message allocation
HBA==	22				; remote bit allocation
HMA==	23				; remote message allocation
BIIL==	24				; bits in input list
MIIL==	25				; messages in input list
PUPRID==32				; receive ID
PUPSID==33				; send ID
;HSTSID HSTFN1 HSTVRS HSTDIR HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW%RU NW$BYT

SUBTTL HOSTS2 Format

;Currently knows about seven networks, ARPA, BBN-RCC, CHAOS, DSK, DIAL, LCS,
;and SU, RU.
;To add additional networks, search for all occurrences of these strings and
;mung the code there appropriately.  It isn't really practical to make networks
;just be a table, since it has to know how to parse addresses on different
;networks.

;This program .INSRTs the file SYSENG;HOSTS > describing all the network hosts
;and produces a compiled file SYSBIN;HOSTS2 > which network programs read in.
;At SAIL the files are HOSTS.TXT[HST,HET] and HOSTS2.BIN[HST,NET].
;For Tops-20 the files are HOSTS.TXT and HOSTS2.BIN.

;The format of the compiled HOSTS2 file is:
HSTSID==:0	; wd 0	SIXBIT /HOSTS2/
HSTFN1==:1	; wd 1	SIXBIT /HOSTS/ usually
HSTVRS==:2	; wd 2	FN2 of HOSTS file which this was compiled from.
HSTDIR==:3	; wd 3  SIXBIT /SYSENG/ usually, directory name of source file
HSTMCH==:4	; wd 4  SIXBIT /AI/ (e.g.), device name of source file
HSTWHO==:5	; wd 5	UNAME of person who compiled this
HSTDAT==:6	; wd 6	Date of compilation as sixbit YYMMDD
HSTTIM==:7	; wd 7	Time of compilation as sixbit HHMMSS
NAMPTR==:10	; wd 10 Address in file of NAME table.
SITPTR==:11	; wd 11	Address in file of SITE table.
NETPTR==:12	; wd 12 Address in file of NETWORK table.
		;....expandable....

;NETWORK table
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (2)
;This table contains one entry for each network known about, sorted
;alphabetically.  A network number is bits 4.8-4.1 of a network
;address; these numbers are assigned by Jon Postel.  See symbols below.
;The reason for keeping track of different networks is that the user
;program must make different system calls to use each network.
;Each entry contains:
NETNUM==:0	; wd 0	network number
NTLNAM==:1	; wd 1 LH - address in file of name of network
NTRTAB==:1	; wd 1 RH - address in file of network's address table
 NETLEN==:2

;ADDRESS table(s)
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (2)
;There is one of these tables for each network.  It contains entries
;for each site attached to that network, sorted by network address.
;These tables are used to convert a numeric address into a host name.
;Also, the list of network addresses for a site is stored
;within these tables.
;Each entry contains:
ADDADR==:0	; wd 0	Network address of this entry (including network number).
ADLSIT==:1	; wd 1 LH - address in file of SITE table entry
ADRCDR==:1	; wd 1 RH - address in file of next ADDRESS entry for this site
		;	    0 = end of list
 ADDLEN==:2

;SITE table
; wd 0	Number of entries in table.
; wd 1	Number of words per entry. (3)
;This table contains entries for each network site,
;not sorted by anything in particular.  A site can have more
;than one network address, usually on different networks.
;This is the main, central table.
;Each entry looks like:
STLNAM==:0	; wd 0 LH - address in file of official host name
STRADR==:0	; wd 0 RH - address in file of first ADDRESS table entry for this
		;	    site.  Successive entries are threaded together
		;	    through ADRCDR.
STLSYS==:1	; wd 1 LH - address in file of system name (ITS, TIP, TENEX, etc.)
		;			May be 0 => not known.
STRMCH==:1	; wd 1 RH - address in file of machine name (PDP10, etc.)
		;			May be 0 => not known.
STLFLG==:2	; wd 2 LH - flags:
STFSRV==:400000	;	4.9 1 => server site (according to NIC)
		; wd 2 RH - not used
 SITLEN==:3

;NAMES table:
; wd 0	Number of entries
; wd 1	Number of words per entry. (1)
;This table is used to convert host names into network addresses.  It
;contains entries sorted alphabetically by host name.
NMLSIT==:0	; lh	address in file of SITE table entry for this host.
NMRNAM==:0	; rh	address in file of host name
		;This name is official if NMRNAM = STLNAM of NMLSIT.
 NAMLEN==:1

; All names are ASCIZ strings, all letters upper case.
; The strings are stored before, after and between the tables.
; All strings are word-aligned, and fully zero-filled in the last word.

;Network addresses are defined as follows, for purposes of this table:
;    4.9     0
;    4.8-4.1 network number
;    Chaos net (number 7):
;	3.9-2.8	0
;	2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
;    Arpa net (number 12):	(note, old-format Arpanet addresses
;    & BBN-RCCnet (number 3):	 never appear in the host table.)
;	3.9-3.8	0
;	3.7-2.1	Imp
;	1.9	0
;	1.8-1.1	Host
;    Dialnet (number 26):
;	3.9-3.1	0
;	2.9-1.1	address in file of ASCIZ string of phone number
;    LCSnet (number 22):
;	3.9	0
;	3.8-3.1	Subnet
;	2.9-1.9	0
;	1.8-1.1	Host
;    SU net (number 44):
;	3.9-2.8	0
;	2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
;    RU net (number 61):
;	3.9 0
;	3.8-3.1 Subnet
;	2.9-1.9 0
;	1.8-1.1 Host

NW%CHS==:7	;Chaos net
NW%ARP==:12	;Arpa net
NW%RCC==:3	;BBN-RCCnet
NW%DLN==:26	;Dialnet
NW%DSK==:777	;DSKnet
NW%LCS==:22	;LCSnet
NW%SU==:44	;SUnet
NW%RU==:61	;RUnet
NW$BYT==:331100	;Byte pointer to network number

;Other network address formats accepted elsewhere:

;A network number of 0 defaults the network according to context.  "Old
;format" Arpanet addresses, of the form 1.8-1.7 host, 1.6-1.1 IMP

;The host-table compiler assumes Arpanet if the network number is
;zero, and converts old format Arpanet addresses to new format.  The
;NETWRK routines for accessing this table assume a network (for number
;zero) which depends on a program switch, and convert old format Arpa
;net addresses to new format.  There will also be a program switch for
;which networks are allowed to be returned from a host name lookup.

;The ITS Arpanet software accepts addresses with or without the network
;number; if the network number is non-zero it must be 12(octal).  The
;network number is not returned by the system.  ITS accepts either old
;or new format addresses, and returns the old format whenever possible.

;The ITS CHAOS net software always inputs and outputs addresses in
;16-bit bytes, so the network number issue does not arise.

;Dialnet addresses are always ASCIZ strings.

;LCSnet addresses are in the form subnet/host, in octal.
;SJBCNI DELAYP PDL HSTFIL LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD DPACT FRSPTY IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP ROUNET ROUSIZ ENINQM QMP11M PRJPRG JOBNAM PTYJOB TTYTAB NETCOD ADRTAB LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB FFLNK MKTITL RAWHST ADRFIX ENDCHK NETBSZ PUPHST PUPLDB PUPLSK PUPFSK PUPSTB PUPLKS IMPUPT

SUBTTL Data area

SJBCNI:	BLOCK 1				; saved copy of JOBCNI at INTRPT
DELAYP:	BLOCK 1				; -1 → don't delay
PDL:	BLOCK PDLLEN			; stack
HSTFIL:	BLOCK 1				; where host table begins
LINCNT:	BLOCK 1				; line count
HDABLK:	BLOCK 13			; terminal location block
HSIZE:	BLOCK 1				; horizontal size
SCREEN:	BLOCK 1				; display screen image pointer

; Display program stuff

COLPOS:	CW COLM,2,HILIN,1,LOLIN,10	; second column, second line
TXTOUT:	CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA	; text output

DPHEAD:	600000,,			; overlapped mode, double field mode
	0				; size
DPACT:	0				; busy flag in dpy prog hdr
	0				; address of low order line select for DD

; Monitor pointers

FRSPTY:	0				; TTY # of first PTY

IMPDIE:	0				; NCP locked out
IMPDEA:	0				; NCP down
NMESIN:	0				; messages in
NMESOU:	0				; messages out
IMPDWY:	0				; why IMP going down
IMPTDN:	0				; when IMP going down
IMPTUP:	0				; when IMP coming back up (usual lie)

ROUNET:	0				; routing table pointer
ROUSIZ:	0				; size of routing table
ENINQM:	0				; number of Ethernet messages in
QMP11M:	0				; number of Ethernet messages out (sort of)

; Pointers indexed by job number

PRJPRG:	0				; PPN
JOBNAM:	0				; program name

; Pointers indexed by PTY number

PTYJOB:	0				; PTY mother

; Pointers indexed by TTY number

TTYTAB:	0				; TTY DDB pointer



; IMP table pointers indexed by IMP index

; Network numbers
NETCOD:	NW%ARP				;Network number for Arpa net
ADRTAB:	0				; pointer to address table
LNKTAB:	0				; host-link number
LNKDDB:	0				; address of DDB
IMPLS:	0				; local socket number
IMPFS:	0				; foreign socket number
IMPBS:	0				; byte size
IMPSTB:	0				; link status
FFLNK:	0				; first free link
MKTITL:	IMPTTL				; title line
RAWHST:	RAWIMP				; print numeric host address
ADRFIX:	IMPFXU				; fixup network address
ENDCHK:	CAMGE I,			; test end of table
NETBSZ==.-NETCOD			; Size of pointer table table

; Pup pointers.  Must agree with IMP version

	NW%SU				;SUnet
	0				; poiner to address table
PUPHST:	0				; host number
PUPLDB:	0				; DDB
PUPLSK:	0				; local socket number
PUPFSK:	0				; foreign socket number
	0				; no byte size table
PUPSTB:	0				; link status
PUPLKS:	0				; maximum number of links
	PUPTTL				; title line
	RAWPUP
	PUPFXU				; fixup network address
	CAILE (I)			; test end of table

; No more networks
	0				;End of network list


;Block of pointers for IMPSTAT program, pointed to by lowcore loc 352.
;Must end with a zero half word.
IMPUPT:	PUPLDB,,PUPHST
	PUPLSK,,PUPFSK
	PUPSTB,,PUPLKS
	ROUNET,,ROUSIZ
	ENINQM,,QMP11M
	FRSPTY,,0
;IMPSTA NETSLP NETSRH INTRPT NETSRE

SUBTTL Start of program

IMPSTA:	JFCL
	RESET
	MOVE P,[PDL(-PDLLEN)]
	SETZM DPACT			; no dpy program active now

; Map in host table

	OPEN [17 ? 'DSK,, ? 0]		; get a disk channel
	 JRST 4,.-1
	DMOVE [SIXBIT/HOSTS2BIN/] ? DMOVE 2,[0 ? 'HSTNET]
	LOOKUP				; find file HOSTS2.BIN[HST,NET]
	 JRST 4,.-1
	MOVE Y,JOBFF
	MOVS Z ? MOVN ? ADDB JOBFF	; get address of highest addr we need
	HRRM DPHEAD
	MOVEM DPHEAD+3
	AOS DPHEAD+3
	CORE				; get more core from system maybe
	 JRST 4,.-1
	HRRZ DPHEAD
	ADDI 2
	MOVEM SCREEN
	MOVE Z ? HRRI -1(Y)		; compute IOWD to read host table in
	SETZ X,
	INPUT
	MOVE (Y)			; get first word of host table
	CAME ['HOSTS2]
	 JRST 4,.-1
	MOVEM Y,HSTFIL			; remember where host table begins
	RELEAS
	MOVEI NET,0			; find address tables for each network
NETSLP:	SKIPN X,NETCOD(NET)		; thing to search for
	 JRST NETSRE			; no more nets to find
	MOVE Y,HSTFIL			; calculate first word of network table
	ADD Y,NETPTR(Y)
	MOVE Z,(Y)			; length of network table
	ADDI Y,2-NETLEN			; setup for first entry
NETSRH:	ADDI Y,NETLEN			; point to next entry
	CAME X,NETNUM(Y)		; is this it?
	 SOJG Z,NETSRH			; no, try next
	JUMPE Z,[ OUTSTR [ASCIZ /Host address table is missing for one of our nets. /]
		  JRST 4,.]
	MOVE Z,NTRTAB(Y)		; get address of address table
	ADD Z,HSTFIL
	MOVEM Z,ADRTAB(NET)		; save in network block
	ADDI NET,NETBSZ			; advance to next network
	JRST NETSLP

INTRPT:	MOVE 0,JOBCNI		; save bit telling cause of interrupt
	MOVEM 0,SJBCNI
	UWAIT			; terminate any sleep immediately
	DEBREAK			; get out of interrupt level
	MOVE 0,SJBCNI		; see what caused the interrupt
	TLNE 0,INTTTY		; TTY input?
	JRST TTYSER		; yes, process input quickly (out of sleep)
	MOVE JOBREL		; no, must be ilm, get more core
	ADDI 2000		; another K of core, please
	CORE
	 JRST 4,IMPSTA
	LOCK
	JRST GETNET		; restart status

NETSRE:

; Make sure we never lose with MPV

	MOVEI 0,INTRPT
	MOVEM 0,JOBAPR
	MOVE 0,[INTTTY,,ILM]
	INTENB 0,		; enable ints on tty input, ill mem ref
	LOCK			; ensure fast response
; (continued on next page)
;SNARF CONTIN

SUBTTL Get initial monitor information


; Snarf up some monitor symbols
SNARF:	MOVSI 0,377777		;map first 128K of monitor in to our upper
	SETPR2 0,		;skip on success
	 JRST 4,.-1		;failed (shouldn't)
SUP==400000			;address within our addr space of system lowcore
IMPSPT==352			;system low core address of ptr to table for us
	MOVE X,SUP+IMPSPT	;get pointer to table of ptrs for us
	ADDI X,SUP		;relocated sys address to our upper
	HRLI X,442200		;make byte ptr to table
	SKIPA Y,[442200,,IMPUPT] ;byte ptr to our copy of addresses in system table
SNARFL:	MOVEM 0,(Z)		;store datum
	ILDB 0,X		;get next datum
	ILDB Z,Y		;get place to store it
	JUMPN Z,SNARFL		;loop unless end of table
	AOS FRSPTY		;fix up this one to what IMPSTA really wants

;Here's the slow .SYML version of the quick code above (one uuo).  The .SYML uuo
;is the slowest uuo in the world, and it doesn't even do input!
;
;	MOVEI [.RSQZ 0,TCONLN ? 0]
;	.SYML
;	 JRST 4,.-1
;	ADDI 1
;	MOVEM FRSPTY
;IRPS SYM,,PUPLDB PUPLSK PUPFSK PUPHST PUPSTB PUPLKS ROUNET ROUSIZ ENINQM QMP11M
;	MOVEI [.RSQZ 0,SYM ? 0]
;	.SYML
;	 JRST 4,.-1
;	MOVEM SYM
;TERMIN

; Map the monitor in
	MOVE [400,,220←5]
	GETHI
	 JRST 4,.-1

CONTIN:	OPEN [0 ? 'IMP,, ? 0]		; need an IMP DDB to get a dump
	 JRST 4,.-1
	MOVEI 5				; magic dump of addresses
	MTAPE
	RELEAS
IRPS SYM,,IMPDIE IMPDEA NMESIN NMESOU IMPTDN IMPTUP IMPDWY FFLNK LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB
	 IFE .IRPCN&1,HLRM 1+<.IRPCN/2>,SYM
	 .ELSE HRRM 1+<.IRPCN/2>,SYM
TERMIN

; Get symbols with low core pointers

	MOVEI 211			; PRJPRG
	PEEK
	MOVEM PRJPRG
	MOVEI 225			; JOBNAM
	PEEK
	MOVEM JOBNAM
	MOVEI 270			; PTYJOB
	PEEK
	SUB FRSPTY
	MOVEM PTYJOB
	MOVEI 220			; TTYTAB
	PEEK
	MOVEM TTYTAB
	SETO L,
	GETLIN L
	CAMN L,[-1]
	 EXIT				; punt if detached

; Fool around with the page printer

	HRROI [015000,,HSIZE]
	TTYSET
	PPSEL 1
	DPYPOS -452			; near botton of screen
	DPYSIZ 3002			; 3 glitches, 2 lines/glitch
; (continued on next page)
;GETNET HDNODM IMPDDN

SUBTTL Initialize display, IMP going down

GETNET:	SETZB @SCREEN
	ADJSP @SCREEN
	AOS
	BLT @JOBREL
	MOVSI X,440700
	ADD X,SCREEN
	SETZM LINCNT
	TLNN L,(DMLIN)
	 JRST HDNODM
	MOVEI 177
	IDPB X
	MOVEI ↑W
	IDPB X
HDNODM:	MOVE A,IMPDWY
	PEEK A,
	JUMPE A,NOTIDI			; IMP isn't dying
	JSP Y,TXTSTR
	 ASCIZ/     IMP going down at /
	MOVE Y,IMPTDN
	PEEK Y,
	IDIVI Y,60.*60.			; minutes
	IDIVI Y,60.			; Y←hours, Z←minutes
	CAIL Y,24.
	 SUBI Y,24.
	PUSH P,Z
	IDIVI Y,10.			; ah, the joys of open coding!
	MOVEI "0(Y)
	IDPB X
	MOVEI "0(Z)
	IDPB X
	MOVEI B,":
	IDPB B,X
	POP P,Y
	IDIVI Y,10.
	MOVEI "0(Y)
	IDPB X
	MOVEI "0(Z)
	IDPB X
	JSP Y,TXTSTR
	 ASCIZ/ until /
	MOVE Y,IMPTUP
	PEEK Y,
	IDIVI Y,60.*60.			; minutes
	IDIVI Y,60.			; Y←hours, Z←minutes
	CAIL Y,24.
	 SUBI Y,24.
	PUSH P,Z
	IDIVI Y,10.
	MOVEI "0(Y)
	IDPB X
	MOVEI "0(Z)
	IDPB X
	IDPB B,X
	POP P,Y
	IDIVI Y,10.
	MOVEI "0(Y)
	IDPB X
	MOVEI "0(Z)
	IDPB X
	JSP Y,TXTSTR
	 ASCIZ/ for /
	JUMPE A,[	JSP Y,TXTSTR
			 ASCIZ/panic restart/
			JRST IMPDDN]
	SOJE A,[JSP Y,TXTSTR
		 ASCIZ/scheduled hardware PM/
		JRST IMPDDN]
	SOJE A,[JSP Y,TXTSTR
		 ASCIZ/scheduled software reload/
		JRST IMPDDN]
	JSP Y,TXTSTR
	 ASCIZ/emergency restart/
IMPDDN:	PUSHJ P,TERPRI
	MOVEI <" >
	IDPB X
	PUSHJ P,TERPRI
; (continued on next page)
;NOTIDI NOTID1 NOTID2

; Header and link stuff: Index, host, foreign socket

NOTIDI:	MOVE IMPDIE
	PEEK
	JUMPE NOTID1
	JSP Y,TXTSTR
	 ASCIZ/                       NCP locked out!/
	PUSHJ P,TERPRI
NOTID1:	MOVE IMPDEAD
	PEEK
	JUMPE NOTID2
	JSP Y,TXTSTR
	 ASCIZ/                          NCP dead!/
	PUSHJ P,TERPRI
NOTID2:	MOVE FFLNK
	PEEK
	JUMPN NOTID3
	JSP Y,TXTSTR
	 ASCIZ/                  Nobody is using the IMP!/
	PUSHJ P,TERPRI
;;	JRST PUPSTA
;NOTID3 NXTNET NXTLNK HSTSRH

	SKIPA NET,[NETBSZ]		; skip ARPANet
NOTID3:	MOVEI NET,0			; do first network
	JSP Y,TXTSTR
	 ASCIZ/Ix Host          Link Foreign skt Lskt BS Stat Jb Usr Subsys Wait Allocs/
	PUSHJ P,TERPRI
NXTNET:	MOVEI I,1
	PUSHJ P,@MKTITL(NET)
NXTLNK:	MOVEI Y,-1(I)
	MOVEI N,2
	PUSHJ P,OCTOUT			; table index
	MOVEI <" >
	IDPB X
	MOVE LNKTAB(NET)
	ADDI -1(I)
	PEEK
	PUSHJ P,@ADRFIX(NET)		; make a compatable address
	JUMPE [	JSP Y,TXTSTR		; listening, sorry!
		 ASCIZ/               /
		SKIPN IMPBS(NET)	; sigh...
		 JRST FORSKT		;   make format come out right.
		JSP Y,TXTSTR
		 ASCIZ/    /
		JRST FORSKT]
;;	MOVE A,HSTFIL
;;	MOVE A,7(A)			; NUMPTR
;;	ADD A,HSTFIL			; address of NUMBERS table
	MOVE A,ADRTAB(NET)
	MOVE B,(A)			; get # of entries
	MOVE C,1(A)			; and entry size
	ADDI A,2			; point at first entry
HSTSRH:	MOVE Y,ADDADR(A)
;;	CAILE Y,377			; old or new style?
;;	 JRST [	LDB Z,[001000,,Y]	; new style, get host number
;;		LSH Y,-9.		; put IMP number in IMP format place
;;		DPB Z,[201000,,Y]
;;		JRST HSTSR0]
;;	LDB Z,[060300,,Y]		; old style, get host number
;;	ANDI Y,77
;;	DPB Z,[200200,,Y]		; store host number in IMP format
;	JRST HSTSR0
	TLZ Y,777000			; turn off network number
;HSTSR0 HSTOUT DOLINK DOLNKX FORSKT

HSTSR0:	CAME Y				; found host?
	 JRST [	ADDI A,(C)		; point at next entry
		SOJG B,HSTSRH
		MOVE Y,LNKTAB(NET)
		ADDI Y,-1(I)
		PEEK Y,
		PUSHJ P,@RAWHST(NET)
		SETZ Z,
		JRST DOLNKX]
	HLRZ Y,ADLSIT(A)		; get site entry
	ADD Y,HSTFIL			; relocate
	HLRZ Y,STLNAM(Y)		; get name
	ADD Y,HSTFIL			; more relocation
	MOVE A,(Y)			; get text
;Sigh...  How does one do this in MIDAS, anyway?
;printx Herein lies the infamous kludge for flushing SU- from local hosts.
	CAME A,[ASCII/SU-AI/]		; avoid confusion with MIT-AI
	CAMN A,[ASCII/SU-TI/]		; avoid saying just TIP
	  SKIPA
	 TRZ A,77777			; low order bits
	CAMN A,[ASCIZ/SU-/]		; dept. of redundancy dept.?
	 TLOA Y,170700			;    yes, skip SU-
	HRLI Y,440700			; normal host-name
	SKIPA Z,[14.]			; assume all hosts stop at 14 characters
HSTOUT:	 IDPB X
	ILDB Y
	JUMPE DOLINK
	SOJA Z,HSTOUT
DOLINK:	MOVEI <" >
DOLNKX:	IDPB X
	SOJGE Z,DOLINK			; fill out with spaces as necessary
	SKIPN IMPBS(NET)		; if PUP, skip link
	 JRST FORSKT
	MOVE Y,LNKTAB(NET)
	ADDI Y,-1(I)
	PEEK Y,
	LDB Y,[001000,,Y]
	MOVEI N,3
	PUSHJ P,OCTOUT			; link number
	MOVEI <" >
	IDPB X
FORSKT:	MOVEI N,11.
	MOVE Y,IMPFS(NET)		; foreign socket number
	ADDI Y,-1(I)
	PEEK Y,
	CAMN Y,[-1]
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/  listening/
		JRST DPYLS]
	PUSHJ P,OCTOUT
; (continued on next page)
;DPYLS SKPBS NOTCLS

; Local socket, byte size, state

DPYLS:	MOVEI <" >
	IDPB X
	MOVE Y,IMPLS(NET)		; local socket number
	ADDI Y,-1(I)
	PEEK Y,
	SKIPN IMPBS(NET)		; is byte size used?
	 SKIPA N,[11.]			;   no, but socket is bigger
	MOVEI N,4
	PUSHJ P,OCTOUT
	SKIPN Y,IMPBS(NET)		; byte size
	 JRST SKPBS			;   none, skip it
	MOVEI <" >
	IDPB X
	ADDI Y,-1(I)
	PEEK Y,
	MOVEI N,2
	PUSHJ P,DECOUT
SKPBS:	MOVE IMPSTB(NET)
	ADDI -1(I)
	PEEK
	TLNN (CLSS\CLSR)
	 JRST NOTCLS
	TLNN (CLSS)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ CLSR/
		JRST STADUN]
	TLNN (CLSR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ CLSS/
		JRST STADUN]
	JSP Y,TXTSTR
	 ASCIZ/ CLSD/
	JRST STADUN
NOTCLS:	TLNN (RFCS\RFCR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ LISN/
		JRST STADUN]
	TLNN (RFCS)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ RFCR/
		JRST STADUN]
	TLNN (RFCR)
	 JRST [	JSP Y,TXTSTR
		 ASCIZ/ RFCS/
		JRST STADUN]
	JSP Y,TXTSTR
	 ASCIZ/ OPEN/
;	JRST STADUN
;STADUN

; Start of DDB stuff

STADUN:	MOVE DDB,LNKDDB(NET)
	ADDI DDB,-1(I)
	PEEK DDB,
	JUMPE DDB,NODDB			; no DDB for this guy
	MOVEI <" >
	IDPB X
	MOVEI J,347			; PJOBN
	PEEK J,
	XOR J,[DDB,,620000]
	LDB J,J
	PUSHJ P,JOBOUT
	MOVEI <" >
	IDPB X
	MOVE Y,400000-220000+DEVIOS(DDB)
	TLNE Y,(INPW)
	 MOVEI "I
	IDPB X
	MOVEI <" >
	TLNE Y,(LNK0W)
	 MOVEI "C
	TLNE Y,(INTSW)
	 MOVEI "i
	IDPB X
	MOVEI <" >
	TLNE Y,(BLOKW)
	 MOVEI "R
	IDPB X
	MOVEI <" >
	TLNE Y,(ALLW)
	 MOVEI "A
	IDPB X
	MOVEI <" >
	IDPB X
; (continued on next page)
;NODDB

; Allocations

	MOVE IMPLS(NET)
	ADDI -1(I)
	PEEK
	TRNN 1				; send or receive?
	 JRST [	MOVE Y,400000-220000+HMA(DDB); receive; foreign message allocation
		PUSHJ P,DECOUT
		MOVEI "/
		IDPB X
		MOVE Y,400000-220000+HBA(DDB)
		PUSHJ P,DECOUT
		MOVE Y,400000-220000+MIIL(DDB); messages in input list
		JUMPE Y,NODDB
		MOVEI <" >
		IDPB X
		MOVEI "[
		IDPB X
		PUSHJ P,DECOUT
		MOVEI "/
		IDPB X
		MOVE Y,400000-220000+BIIL(DDB); bits in input list
		PUSHJ P,DECOUT
		MOVEI "]
		IDPB X
		JRST NODDB]
	MOVE Y,400000-220000+MAL(DDB)	; send socket; message allocation
	PUSHJ P,DECOUT			; note N=-1 from last DECOUT call
	MOVEI "/
	IDPB X
	MOVE Y,400000-220000+BAL(DDB)	; bit allocation
	PUSHJ P,DECOUT
	MOVEI <" >
	IDPB X
NODDB:	PUSHJ P,TERPRI
	MOVE FFLNK(NET)
	PEEK
	XCT ENDCHK(NET)
	 AOJA I,NXTLNK
	ADDI NET,NETBSZ		;Advance to next network
	SKIPE NETCOD(NET)	;Is this another network?
	 JRST NXTNET		;  Yes, do it!
; (continued on next page)
;PUPSTA PUPLUK HAVPUP

SUBTTL Pup output

	jrst ptymap

	MOVEI <" >			; prevent crudding up screen
	IDPB X
PUPSTA:	MOVEI I,1			; look for any Pup links
PUPLUK:	MOVE DDB,PUPLDB			; any link here?
	ADDI DDB,-1(I)
	PEEK DDB,
	JUMPN DDB,HAVPUP
;;	CAME I,PUPLKS			; at last link?
;;	 AOJA I,PUPLUK			; no, try next
	PUSHJ P,TERPRI
	JSP Y,TXTSTR
	 ASCIZ/                Nobody is using the Ethernet!/
	PUSHJ P,TERPRI
	JRST PTYMAP

HAVPUP:	PUSHJ P,TERPRI
	JSP Y,TXTSTR
	 ASCIZ/Ix Jb Usr Subsys      SendID   ReceiveID  State Local Skt Foreign Port/
	PUSHJ P,TERPRI
	JRST ENLTYO
;NENLNK ENLTYO

NENLNK:	MOVE DDB,PUPLDB			; any link here?
	ADDI DDB,-1(I)
	PEEK DDB,
	JUMPE DDB,NXTENL		; no link if no DDB
ENLTYO:	MOVEI Y,-1(I)			; table index
	MOVEI N,2
	PUSHJ P,OCTOUT
	MOVEI <" >
	IDPB X
	MOVEI J,347			; PJOBN
	PEEK J,
	XOR J,[DDB,,620000]
	LDB J,J
	PUSHJ P,JOBOUT
	MOVE Y,400000-220000+PUPSID(DDB)
	MOVEI N,12.
	PUSHJ P,OCTOUT
	MOVE Y,400000-220000+PUPRID(DDB)
	MOVEI N,12.
	PUSHJ P,OCTOUT
	MOVEI <" >
	IDPB X
	MOVE Y,400000-220000+DEVIOS(DDB)
	MOVEI <" >
	TLNE Y,(IO$INT)
	 MOVEI "I
	IDPB X
	MOVEI <" >
	TLNE Y,(IO$RFC)
	 MOVEI "R
	IDPB X
	MOVEI <" >
	TLNE Y,(IO$END)
	 MOVEI "E
	IDPB X
	MOVEI <" >
	TLNE Y,(IO$ACK)
	 MOVEI "A
	IDPB X
	MOVEI <" >
	TLNE Y,(IO$SBB)
	 MOVEI "W
	IDPB X
	MOVEI <" >
	TRNE Y,IO.BKT
	 MOVEI "M
	IDPB X
; (continued on next page)
;LSNHST NXTENL

	MOVE Y,PUPLSK			; local socket
	ADDI Y,-1(I)
	PEEK Y,
	MOVEI N,10.			; can be up to 9 digits
	PUSHJ P,OCTOUT
	MOVEI <" >
	IDPB X
	MOVE Y,PUPHST			; output host number
	ADDI Y,-1(I)
	PEEK Y,
	JUMPL Y,[JSP Y,TXTSTR
		  ASCIZ/listening/
		 JRST LSNHST]
	IDIVI Y,400			; get network number
	PUSH P,Z
	SETZ N,
	PUSHJ P,OCTOUT
	MOVEI "#
	IDPB X
	POP P,Y
	PUSHJ P,OCTOUT
	MOVEI "#
	IDPB X
	MOVE Y,PUPFSK			; foreign socket
	ADDI Y,-1(I)
	PEEK Y,
	PUSHJ P,OCTOUT
LSNHST:	PUSHJ P,TERPRI
NXTENL:	MOVE PUPLKS
	PEEK
	CAMGE I
;;	CAME I,PUPLKS			; try next link
	 AOJA I,NENLNK
;	JRST PTYMAP

;PTYMAP PTYCHK PTYLUP PTYFND

SUBTTL PTY map

PTYMAP:	MOVEI T,221
	PEEK T,
	LDB T,[001100,,T]		; number of PTY's
	HRLOI T,-1(T)
	EQV T,FRSPTY			; first PTY
PTYCHK:	MOVE J,PTYJOB
	ADDI J,(T)
	PEEK J,
	JUMPE J,[AOBJN T,PTYCHK
		 JRST MSGEND]
	MOVEI <" >
	IDPB X
	PUSHJ P,TERPRI
	JSP Y,TXTSTR
	 ASCIZ/PTY CJ Usr Subsys SJ Usr Subsys Location/
	PUSHJ P,TERPRI
	JRST PTYFND

PTYLUP:	MOVE J,PTYJOB
	ADDI J,(T)
	PEEK J,
	JUMPE J,NXTPTY
PTYFND:	MOVEI N,3
	PUSH P,J
	MOVEI Y,(T)
	PUSHJ P,OCTOUT
	MOVEI <" >
	IDPB X
	PUSHJ P,JOBOUT
	MOVE J,TTYTAB
	ADDI J,(T)
	PEEK J,
	MOVEI 347			; PJOBN
	PEEK
	ADD J,
	PEEK J,				; TTY DDB's may be in upper 128K
	MOVEI 347			; PJOBN
	PEEK
	HRRI J
	LDB J,
	JUMPE J,[	JSP Y,TXTSTR
			 ASCIZ/               /
			JRST GETLOC]
	MOVEI <" >
	IDPB X
	PUSHJ P,JOBOUT
	MOVEI <" >
	IDPB X
;	JRST GETLOC
;GETLOC NTELSR NXTPTY

GETLOC:	POP P,A				; try for TELSER's 137 convention
	HRROI B,137
	MOVEI C,B
	MOVEI A
	JOBRD
	 JRST NTELSR
	JUMPE B,NTELSR
	TLNE B,-1
	 JRST NTELSR
	HRLI B,-13
	MOVEI C,HDABLK
	JOBRD
	 JRST NTELSR
	MOVE HDABLK
	CAME ['TERMID]
	 JRST NTELSR
	SKIPA Y,[440700,,HDABLK+1]
	 IDPB X
	ILDB Y
	JUMPN .-2
NTELSR:	PUSHJ P,TERPRI
NXTPTY:	AOBJN T,PTYLUP
;	JRST MSGEND
;MSGEND SBNTLP CLREOF

;IMP status line
MSGEND:	MOVEI <" >
	IDPB X
	PUSHJ P,TERPRI
	JSP Y,TXTSTR
	 ASCIZ/IMP CONI=/
	EIOTM
	CONI IMP,Y
	JRST 2,@[.+1]			; better than LIOTM
	MOVEI N,6
	PUSHJ P,OCTOUT
	JSP Y,TXTSTR
	 ASCIZ/, input messages=/
	MOVE Y,NMESIN
	PEEK Y,
	PUSHJ P,DECOUT
	JSP Y,TXTSTR
	 ASCIZ/, output messages=/
	MOVE Y,NMESOU
	PEEK Y,
	PUSHJ P,DECOUT
	PUSHJ P,TERPRI
	MOVEI <" >			; good old datarisc
	IDPB X
	PUSHJ P,TERPRI

;PUP status line
	JSP Y,TXTSTR
	 ASCIZ/PUP input packets=/
	MOVE Y,ENINQM
	PEEK Y,
	PUSHJ P,DECOUT
	JSP Y,TXTSTR
	 ASCIZ/, output packets=/
	MOVE Y,QMP11M		;Not exactly right, but close enough
	PEEK Y,
	PUSHJ P,DECOUT
	JSP Y,TXTSTR
	 ASCIZ/, accessible subnets:/
	MOVE Y,ROUSIZ		;Get size of routine table
	PEEK Y,
	MOVN A,Y
	MOVS A,A
	MOVE Y,ROUNET		;and address of table
	PEEK Y,
	HRR A,Y
SBNTLP:	MOVEI Y,(A)		;Fetch an entry
	PEEK Y,
	LSH Y,-34		;Extract destination net
	JUMPE Y,SBNTSK		;If zero, skip it
	MOVEI <" >
	IDPB X
	PUSHJ P,OCTOUT
SBNTSK:	AOBJN A,SBNTLP
	PUSHJ P,TERPRI

	MOVE Z,HSIZE
	TLNE L,(DDDLIN\DMLIN)
CLREOF:	 CAMG Z,LINCNT
	  JRST NODDDM			; III or printing
	MOVEI <" >
	IDPB X
	PUSHJ P,TERPRI
	SOJA Z,CLREOF
;	JRST NODDDM
;NODDDM DOIII DODM

SUBTTL Display it!

NODDDM:	TLNN X,700000			; if at word boundry
	 ADDI X,1
	SETZM 1(X)			; HALT to stop program
	MOVEI X,(X)
	MOVEI 2(X)
	SUBI @DPHEAD
	MOVEM DPHEAD+1			; save display program length
	AOS (X)
	CAME X,SCREEN
	 SOJA X,.-2

; Now output the accumulated text

	TLNN L,(DDDLIN\IIILIN\DMLIN)
	 JRST [	OUTSTR @SCREEN
		OUTSTR [ASCIZ/

/]
		JRST DELAY]
	JUMPL L,DOIII
	TLNE L,(DMLIN)
	 JRST [	SETZM @DPHEAD
		MOVE X,[.BYTE 7 ? 177 ? ↑L ? 140 ? 142]; cursor at third line
		JRST DODM]
	MOVE TXTOUT
	MOVEM @DPHEAD
	SKIPA X,COLPOS
DOIII:	 MOVE X,[.BYTE 11.,11.,3,3,2,2,4 ? -777 ? 640 ? 2 ? 2 ? 1 ? 2 ? 6]
DODM:	MOVEM X,@DPHEAD+3
	UPGIOT 1,DPHEAD			; display the text
;	JRST DELAY
;DELAY DELAY0 NODLAY TTYSER DELAY2 EATLF DELAY1

; Done, wait a while and go again

DELAY:	SKIPE DELAYP
	 JRST NODLAY
DELAY0:	MOVEI 20.
	TLNE L,(DMLIN)
	 MOVEI 5.
	TLNE L,(DDDLIN\IIILIN)
	 MOVEI 1
	SLEEP
NODLAY:	SKIPE DPACT
	JRST [	SKIPN DELAYP	;wait until dpy prog done, and then some
		JRST DELAY0	;wait usual delay again
		UPGIOT [0 ? 0]	;wait for dpy prog to finish
		JRST DELAY2 ]	;not delaying, go make new program
TTYSER:	UPGIOT [1000,,0		;flush any DM program running, wait for DD
		0]
DELAY2:	SETZM DPACT		;in case here from TTY interrupt
	SNEAKS
	 JRST GETNET
	ANDI 177
	CAIN 175
	 JRST [INCHRW ? SETCMM DELAYP ? JRST GETNET] ; ALT toggles the delay flag
	UNLOCK			;we're quitting or pausing--unlock from core
	CAIN <" >
	 JRST [	INTMSK [0]	;avoid interrupts right now
		INCHRW		;eat first space
		INCHRW		;wait till next char (note feature: CRLF here
		INTMSK [-1]	;  makes us exit because the LF isn't read here)
		LOCK
		JRST GETNET]	; space holds us
	CAIN ↑J
	 JRST EATLF		;eat LFs
	CAIE ↑M
	 JRST DELAY1		;not LF nor CR, let user's cmd go to monitor
	INCHRW			;eat CRLFs
EATLF:	INCHRW
DELAY1:	HRROI [004000,,400\"N]
	TTYSET
	EXIT 1,
	LOCK
	JRST CONTIN
;TERPRI DECOUT OCTOUT NUMOUT NUMOU1 NUMOU2 NUMOU3

SUBTTL Random stuff

TERPRI:	JSP Y,TXTSTR
	 ASCIZ/
/
	AOS LINCNT
	TLNN L,(DMLIN)
	 POPJ P,
	MOVEI 177
	IDPB X
	MOVEI ↑W
	IDPB X
	POPJ P,

; Octal/decimal output of Y.  If N > 0, pad with spaces so it fits in N digits

DECOUT:	SKIPA Z,[10.]
OCTOUT:	 MOVEI Z,8.
	HRRM Z,NUMOUT			; I don't want to fry another AC
NUMOUT:	IDIVI Y,
	ADDI Z,"0
	PUSH P,Z
	SOJLE N,NUMOU1
	JUMPN Y,NUMOU2
	MOVEI Z,<" >
	IDPB Z,X
	SOJG N,.-1
	JRST NUMOU3
NUMOU1:	SKIPE Y
NUMOU2:	 PUSHJ P,NUMOUT
NUMOU3:	POP P,Y
	IDPB Y,X
	POPJ P,
;JOBOUT SIXOUT SIXOU1 TXTSTR ...LIT

; Job number/PPN/name output

JOBOUT:	MOVEI N,2
	MOVEI Y,(J)
	PUSHJ P,DECOUT
	MOVEI <" >
	IDPB X
	MOVE Y,PRJPRG
	ADDI Y,(J)
	PEEK Y,
	HRLZS Y
	MOVEI N,3
	PUSHJ P,SIXOU1
	MOVEI <" >
	IDPB X
	MOVE Y,JOBNAM
	ADDI Y,(J)
	PEEK Y,
;	JRST SIXOUT

; Sixbit output routine

SIXOUT:	MOVEI N,6
SIXOU1:	SETZ Z,
	ROTC Y,6
	ADDI Z,"A-'A
	IDPB Z,X
	SOJG N,SIXOUT+1
	POPJ P,

; Output text string, called with JSP

TXTSTR:	HRLI Y,440700
	ILDB Y
	JUMPE 1(Y)
	IDPB X
	JRST TXTSTR+1

;Fixup network addresses for HOSTS2

IMPFXU:	LDB [103000,,]			;Flush link
	LDB A,[202300,,0]		;Fetch host within imp
	DPB 0,[112000,,0]		;Move IMP number
	DPB A,[001100,,0]
	POPJ P,

PUPFXU:	JUMPL [ SETZ
		POPJ P,]
	LDB A,[101000,,0]
	LSH A,1
	DPB A,[101100,,0]
	POPJ P,

RAWIMP:	PUSH P,Y
	LDB Y,[301000,,Y]	; get host number
	MOVEI N,1.		; needs to be changed if more than 9 hosts
	PUSHJ P,DECOUT		; on an IMP ever happens
	MOVEI <"/>
	IDPB X
	POP P,Y
	LDB Y,[102000,,Y]	; get IMP number
	MOVEI N,2.		; this needs to be changed if more than
	PUSHJ P,DECOUT		; 99 IMPs ever happens
	JSP Y,TXTSTR
	 ASCIZ/           /
	POPJ P,

RAWPUP:	PUSH P,Y
	LDB Y,[101000,,Y]
	MOVEI N,3
	PUSHJ P,OCTOUT
	MOVEI <"#>
	IDPB X
	POP P,Y
	ANDI Y,377
	MOVEI N,3
	PUSHJ P,OCTOUT
	JSP Y,TXTSTR
	 ASCIZ/        /
	POPJ P,

IMPTTL:	JSP Y,TXTSTR
	 ASCIZ/IMP:/
	JRST TERPRI

PUPTTL:	JSP Y,TXTSTR
	 ASCIZ/PUP:/
	JRST TERPRI

...LIT:	CONSTA

END IMPSTAT