COMMENT ⊗   VALID 00024 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	PDLLEN IIILIN DMLIN DDDLIN ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW BAL MAL NHBA NHMA HBA HMA BIIL MIIL
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	DELAYP PDL HSTFIL LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD FRSPTY IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP NETCOD ADRTAB LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB FFLNK MKTITL ADRFIX ENDCHK NETBSZ PUPHST PUPLDB PUPLSK PUPFSK PUPSTB PUPLKS PRJPRG JOBNAM PTYJOB TTYTAB
C00024 00005	IMPSTA
C00027 00006	SNARF
C00029 00007	GETNET HDNODM IMPDDN
C00032 00008	NOTIDI NOTID1 NOTID2
C00033 00009	NOTID3 NXTNET NXTLNK HSTSRH
C00035 00010	HSTSR0 HSTOUT DOLINK DOLNKX FORSKT
C00038 00011	DPYLS SKPBS NOTCLS
C00040 00012	STADUN
C00041 00013	NODDB
C00043 00014	PUPSTA PUPLUK HAVPUP
C00044 00015	NENLNK ENLTYO
C00046 00016	LSNHST NXTENL
C00048 00017	PTYMAP PTYCHK PTYLUP PTYFND
C00050 00018	GETLOC NTELSR NXTPTY
C00051 00019	MSGEND SBNTLP CLREOF
C00053 00020	NODDDM DOIII DODM
C00055 00021	DELAY NODLAY DELAY1
C00056 00022	TERPRI DECOUT OCTOUT NUMOUT NUMOU1 NUMOU2 NUMOU3
C00057 00023	JOBOUT SIXOUT SIXOU1 TXTSTR ...LIT
C00058 00024	Fixup network addresses for HOSTS2
C00060 ENDMK
C⊗;
;PDLLEN IIILIN DMLIN DDDLIN ILM EXCT FNCN ALPHBG CHNL COLM HILIN LOLIN IMP RFCS RFCR CLSS CLSR DEVCHR DEVIOS INPW LNK0W BLOKW ALLW BAL MAL NHBA NHMA HBA HMA BIIL MIIL

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

ILM==	020000				; 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[NET,MRC] and HOSTS2.BIN[NET,MRC].
;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.
;DELAYP PDL HSTFIL LINCNT HDABLK HSIZE SCREEN COLPOS TXTOUT DPHEAD FRSPTY IMPDIE IMPDEA NMESIN NMESOU IMPDWY IMPTDN IMPTUP NETCOD ADRTAB LNKTAB LNKDDB IMPLS IMPFS IMPBS IMPSTB FFLNK MKTITL ADRFIX ENDCHK NETBSZ PUPHST PUPLDB PUPLSK PUPFSK PUPSTB PUPLKS PRJPRG JOBNAM PTYJOB TTYTAB

SUBTTL Data area

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:	200000,,			; double field mode
	0				; size
	0
	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

;IMPSTA

SUBTTL Start of program

IMPSTA:	JFCL
	RESET
	MOVE P,[PDL(-PDLLEN)]

; Map in host table

	OPEN [17 ? 'DSK,, ? 0]		; get a disk channel
	 JRST 4,.-1
	DMOVE [SIXBIT/HOSTS2BIN/] ? DMOVE 2,[0 ? 'NETMRC]
	LOOKUP				; find file HOSTS2.BIN[NET,MRC]
	 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

NETSRE:

; Make sure we never lose with MPV

	MOVEI [	MOVE JOBREL
		ADDI 2000		; πnother K of core, please
		CORE
		 JRST 4,IMPSTA
		LOCK
		JRST GETNET]		; restart status
	MOVEM JOBAPR
	MOVEI ILM
	APRENB
	LOCK				; ensure fast response
; (continued on next page)
;SNARF

SUBTTL Get initial monitor information

; Map the monitor in

SNARF:	MOVE [400,,220←5]
	GETHI
	 JRST 4,.-1

; Snarf up some monitor symbols

	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

	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 NODLAY DELAY1

; Done, wait a while and go again

DELAY:	SKIPE DELAYP
	 JRST NODLAY
	MOVEI 20.
	TLNE L,(DDDLIN\IIILIN)
	 MOVEI 1
	TLNE L,(DMLIN)
	 MOVEI 5.
	SLEEP
NODLAY:	SNEAKS
	 JRST GETNET
	ANDI 177
	CAIN 175
	 JRST [INCHRW ? SETCMM DELAYP ? JRST GETNET] ; ALT toggles the delay flag
	CAIN <" >
	 JRST [INCHRW ? INCHRW ? JRST GETNET] ; space holds us
	CAIE ↑M
	 JRST DELAY1
	INCHRW				; only eat CRLF's
	INCHRW
DELAY1:	HRROI [004000,,400\"N]
	TTYSET
	EXIT
;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