perm filename NETWRK.FAI[S,NET]33 blob sn#845898 filedate 1987-09-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00049 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00008 00002	Network routines, intended to be .INSERT'ed  History
C00015 00003	 Assembly switches
C00020 00004	 INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU NW%36 NW%08 NW%P08 NW%P36
C00024 00005	 NWKDBG ERRCLR HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV VARSET VART17 VARTMO
C00028 00006	 TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT PRINUM NUMPRI PRIADR PRIMSK
C00033 00007	 CONECT .CONEC
C00037 00008	 LISTEN .LISTE
C00040 00009	 DATI .DATI .DATI1
C00043 00010	 DATO .DATO .DATO1
C00045 00011	 CONCHK
C00046 00012	 UDPCON .UDPCN
C00048 00013	 NETICH NETICW NTICH2 NTICH4 NTICH3
C00051 00014	 NETOCH .NETOC
C00052 00015	 NETSND .NETSN NETOER
C00053 00016	 DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
C00057 00017	 DATOCH .DATOC
C00058 00018	 DATSND .DATSN DATOER
C00060 00019	 CLOSER CLSDAT CLOSEW
C00061 00020	 NETINR NETINS ABORT
C00062 00021	 MTPERR MTPER2 MTPER1 MTPE1A MERTAB MERLEN
C00066 00022	 NIOERR NIOER2
C00068 00023	 HSTDED
C00071 00024	 HSTDE2
C00073 00025	 HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM
C00084 00026	 MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3
C00087 00027	 UNMHST
C00088 00028	 HSTNUM HSTNUS HSTNU1 HSTNU2
C00092 00029	 HSTNAM SEARCH SRCLT SRCGT SRCDUN SRCDU1 SRCDU2 COMPAR PMATCH PMATC1 PMATC2 CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1 HSTUNA
C00104 00030	 SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 SRTADF
C00107 00031	 HSTNXA
C00108 00032	 SVCCHK SVCCH1 SVCCH2 SVCCH3
C00110 00033	 SETANM SETAN1 SETAN2
C00117 00034	 HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1
C00120 00035	 HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX
C00123 00036	 OURNAM OURNA1
C00125 00037	 ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM
C00128 00038	 DETHST
C00129 00039	 B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1
C00140 00040	Domain resource record format 
C00148 00041	 RRTYPE RRCLAS RRTTL RRDLEN RRNAME TY.A TY.NS TY.CNAME TY.SOA TY.MB TY.MG TY.MR TY.NULL TY.WKS TY.PTR TY.HINFO TY.MINFO TY.MX TY.AXFR TY.MAILB TY.ALL CL.IN CL.CH CL.ALL DOM NETIBF NETOBF DOMIBF DOMOBF NETBFL DOMBFL NETBUF DOMBUF DVERBOSE UPCASE AUTHOR NODFLT MXPREF OSNAME BLKLEN DLKBLK DLKNME NAMBLK DATBLK DATPTR MXDBLK MXHBLK MXABLK MXAPTR MXPBLK MXPPTR SETUDP QUERYB QDCOUNT ANCOUNT NSCOUNT ARCOUNT TEMPBP TTLMIN TTLMAX TTLFAI NODOTS DFLTDM DFATAL LDOMAN DOMAN DOMANX DOMANL
C00155 00042	 SUCCES NICKNM SFTERR NAMERR GETDOM GETDO1 GETDO2 GETDO5 GETDO6 GETDMA GETINP GETIN1 GETIN2 GETIN3 GT.UNK GTDISP GT.MAX GT.A GT.RET GT.MX GT.DOM GT.DO1 GT.DO2 GT.DO3 GT.WKS GT.HIN GT.HI1 GT.HI2
C00167 00043	 SQUERY SQUER1 SQUER2 UNKERR FMTERR SRVFAI NOTIMP REFUSE RDRESP SKIPQR SKIPQ1 RDANS RDAUTH RDADDL RDRRET NAMERX
C00175 00044	 READRR READR1 READR2 READR3 READR4 RD.UNK RDDISP RD.MAX RD.DAT RD.DA1 RDOUTP RD.MX RD.DOM RD.DO1 RD.DO2 READC0 READCP READC1 READC2
C00181 00045	 NAMADR NAMAD0 NAMAD1 NAMAD2 NAMHST NAMHST NAMHS1 NAMHS2 NAMHL1 NAMHL2 SRTDAT SRTDA1 SRTDA2 COMPRI COMPR1 NANAME
C00187 00046	 ADRNAM ADRPTR ADRPT1 ADRPTD ADRPD1 ADRHST ADRHST ADRHS1 ADRHL1 ADADDR
C00191 00047	 A0 A1 A2 A3 OURDOM OURDO0 OURDO1 OURDOE OURDO2
C00195 00048	 MXFIND MXFND1 MXNXTH MXFNDH MXFNH1 SRTMXA MXLOSE MXNAME
C00202 00049	 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT
C00203 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSERT'ed ;⊗ History

; This is a library of network hacking routines.  Each routine describes its
; calling sequence and what AC's it smashes.  A pushdown stack is expected in 17.
;
; I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT,DOM) is used for data I/O and the
; system domain record cache.

; This package can also be used with the Ethernet, but data connections are
; not implemented.  Also, Ethernet does not have equivalent to INTINR, and
; simply sends an INTINS.  Host down messages are bogus. (TVR/Dec81)

; This is the FAIL version which lives in NETWRK.FAI[S,NET].  The MIDAS version
; lives in NETWRK.MID[S,NET].

COMMENT ⊗  History (please record changes):

History recording began in August 1986.

   Apr 78  MRC	Original NETWRK for Arpanet NCP.
   Dec 81  TVR	Added support for Ethernet PUP connections.
   Apr 83  ME,JJW	Modified for Arpanet IP/TCP.  Major change is
		the elimination of ICP for Arpanet connections.
   Jun 83  JJW	Host table format changed from HOSTS2 to HOSTS3.
   (1983-1986)	Numerous changes, undocumented.
09 Aug 86  JJW	Commented out IP address lookup kludge.  (Host table we
		now get from Argus has Stanford IP addresses.)  Added
		SRTADR to sort addresses (by modifying the HOSTS3 table
		incore).  Changed HSTNAB and HNUMST to accept and print
		PUP addresses in the form [a#b], but PUP code useless
		since it parses in decimal.
13 Aug 86  JJW	Added HSTNBR to parse [a.b.c.d] in decimal or [a#b] in
		octal.  Doesn't look up number in host table.
26 Aug 86  ME,JJW  Added ATTHST and DETHST for upper-segment host table.
		Disabled call to SRTADR for use of this feature.
03 Sep 86  JJW	Changed DETHST not to save high segment, since [RSLV]
		phantom does.
10 Sep 86  JJW	Changed SETANM to always use official name, supressing
		hyphens and stopping at first "." in name.
03 Nov 86  ME	Added symbols to refer to MJH 10MB network.
07 Nov 86  JJW	Changed network priority to prefer MJH 10MB net, added DECWRL.
07 Nov 86  ME	Add symbol NW%P36.
15 Dec 86  ME	Added ERRCLR flag word: zero means never do CLRBFI (formerly
		always did CLRBFI upon error typeout).  Also, if user sets
		VARSET, then timeouts are set from VARTMO cell.
15 Jan 86  ME	"Fatal" errors now do an EXIT 1, instead of halting, so a
		phantom (like the remind phantom) will go away (and return
		later) instead of halting.  Also, MTPERR and NIOERR, which
		after all are just typing error messages, don't have any
		FATAL errors, only WARNings.
23 Mar 87  ME	Declared NTOBF internal (↑) so caller can tell if NETOCH will
		do an OUT UUO (to allow ↑S checking in Pancake spooler).
16 Aug 87  JJW	Added GETDOM for general domain name lookup, NAMADR and
		ADRNAM for name/address translation using domains followed
		by host table if domain lookup fails.
19 Aug 87  JJW	Removed use of inverse address kludge.  Use PTR records in
		system cache as well as in server queries.
26 Aug 87  JJW	Changed NAMADR, ADRNAM and MXFIND to have separate returns
		for hard and soft errors.
27 Aug 87  ME	Changed OURDOM to use lowcore pointer in RH of 356 to get
		domain name from system.  Provides emergency domain name.  Made
		ADRHL1 failure return a string containing dotted host number.
04 Sep 87  JJW	Network output error when sending to domain server is non-fatal,
		since a dead gateway can cause this.
06 Sep 87  JJW	Data in TY.A records now stored same as other types.  Type
		TY.HINFO now supported.
07 Sep 87  JJW	Domain routines now use statically allocated I/O buffers for
		NET and DOM channels.  UPCASE switch controls mapping of domain
		characters to upper-case; is on by default, except when
		appending default domain or when applied to names of MX hosts
		that have been received from servers.

History: end of comment ⊗ 
; Assembly switches

IFDEF FTHST3,<
PRINTS/Please remove the FTHST3 switch and non-HOSTS3 code from this program.
All NETWRK-reading programs must now use HOSTS3 host numbers.
/>;IFDEF FTHST3
IFNDEF SVRRTS,<SVRRTS←←0>		; ≠ 0 → server (not user) routines
IFNDEF DATRTS,<DATRTS←←0>		; ≠ 0 → data channel routines
IFNDEF MRKCHR,<MRKCHR←←0>		; ≠ 0 → pass BSP mark bytes as characters
IFNDEF ERRHAN,<ERRHAN←←0>		; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,<ERRINS←←<047000,,12>>	; (iff ERRHAN≠0) what to do after an error
IFNDEF HSTSIX,<HSTSIX←←0>		; ≠ 0 → sixbit alias name hacking
IFNDEF TTYSTS,<TTYSTS←←0>		; ≠ 0 → code to get TTY location string
IFNDEF IPUDP,<IPUDP←←0>			; ≠ 0 → IP/UDP code
IFNDEF MXRTS,<MXRTS←←0>			; ≠ 0 → MX routines

IFNDEF NIORTS,<NIORTS←←SVRRTS!DATRTS!ERRHAN> ; ≠ 0 → network I/O routines

IFNDEF ERRTNS,<ERRTNS←←ERRHAN>		; ≠ 0 → error reporting routines

IFNDEF HSTTAB,<HSTTAB←←HSTSIX>		; ≠ 0 → host table routines

IFNDEF DOMRTS,<DOMRTS←←MXRTS>		; ≠ 0 → domain routines

IFE NIORTS!ERRTNS!HSTTAB!DOMRTS,<.FATAL No NETWRK routines selected>
IFE NIORTS,<IFN SVRRTS!DATRTS!ERRHAN,<.FATAL NIORTS Illegal switch setting>>
IFE ERRTNS,<IFN ERRHAN,<.FATAL ERRHAN Illegal switch setting>>
IFE HSTTAB,<IFN HSTSIX,<.FATAL HSTTAB Illegal switch setting>>
IFE NIORTS,<IFN MRKCHR,<.FATAL MRKCHR Illegal switch setting>>

;Macro definitions

;FATAL errors type a question mark and stop program at LUZBIG.
;WARNings type an exclamation point and continue.

DEFINE FATAL(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING?\] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING!\] ↔ JRST WARNIN]>

;Timeouts for various flavors of connection (CLOSE,RFNM,ALLOC,RFC,INPUT,IDLE)

;(pre-TCP definitions)
;IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,0,0,=15,5,0>>	; Connect
;IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=10,=10,=30,0,0>>	; Listen
;IFNDEF TNTIMO,<TNTIMO←←<BYTE (6)1,=15,0,5,0,0>>	; Telnet port
;IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,24,0,7,0,0>>		; Data port

;TCP/PUP definitions.  Because there is no ICP on a separate port, only
;one set of timeouts is defined for each type of connection.  IMPSER no
;longer uses RFNM timeout, but PUPSER uses it to time out ACK failure.
IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,=15,=60,=15,0,0>>	; Connect
IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=15,=60,=30,0,0>>	; Listen
IFDEF TNTIMO,<PRINTX TNTIMO no longer used or defined in NETWRK>
IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,=20,0,7,0,0>>		; Data port

;Macro to zero all but network number in a word.  Placed outside BEGIN so
;programs .INSERTing this file can use it.

DEFINE GETNET(AC,ADDR)<
IFDIF <ADDR><><MOVE AC,ADDR>
	TLNN AC,(17⊗=32)	; Check for non-Internet type addrs
	 TLNN AC,(1⊗=31)	;  Internet address, see if class A net
	  TDZA AC,[77,,-1]	;   Unternet or class A, zap low 3 octets
	TLNN AC,(1⊗=30)		; Class B or C, see which.
	 TRZA AC,177777		;  Class B network, zap low 2 octets
	  TRZ AC,377		;   Class C net, only zap 1 low octet
>;GETNET
;⊗ INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU NW%36 NW%08 NW%P08 NW%P36

; System bits and bytes

BEGIN NETWRK

; Goddam bagbiting assembler!!!

GLOBAL NIORTS,ERRHAN,ERRINS,ERRTNS,HSTTAB,SVRRTS,DATRTS,HSTSIX,MRKCHR
GLOBAL TTYSTS,IPUDP,DOMRTS,MXRTS

DEFINE FATAL(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING?\] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING!\] ↔ JRST WARNIN]>

; Interrupt condition bits

↑INTINR←←<000100,,0>			; IMP INR
↑INTINS←←<000040,,0>			; IMP INS
↑INTIMS←←<000020,,0>			; IMP status change
↑INTINP←←<000010,,0>			; IMP input waiting

; Network status flags

↑RFCS←←  <200000,,0>			; RFC sent
↑RFCR←←  <100000,,0>			; RFC received
↑CLSS←←  <040000,,0>			; CLS sent
↑CLSR←←  <020000,,0>			; CLS received

; Network status word error codes

↑SIU←←01				; port (socket) in use
↑CCS←←02				; can't change port (socket) numbers
↑SYS←←03				; horrible system error
↑NLA←←04				; no links available
↑ILB←←05				; illegal byte size
↑IDD←←06				; IMP dead
↑GMM←←07				; Gender mismatch

; I/O status word error bits

↑IOIMPM←←400000				; improper mode
↑IODERR←←200000				; hard device error
↑IODTER←←100000				; soft device error
↑IOBKTL←←040000				; block number out of bounds
↑IODEND←←020000				; end of file
↑HDEAD←← 002000				; host or destination IMP dead
↑RSET←←  000400				; host sent a RST
↑TMO←←   000200				; time out

ERRBTS←←<IOIMPM!IODERR!IODTER!IOBKTL!IODEND!HDEAD!RSET!TMO>
WINBTS←←<RFCS!RFCR>			; connection winning

; I/O channel definitions

↑NET←←1					; channel to do network hacking
↑DAT←←2					; channel to do data hacking

; Network numbers (for distinguishing IMP from local Ethernet)
↑NT$NUM←←301400		;Byte pointer to network number (high 12 bits)
↑NE%UNT←←<040000,,0>	;Escape bit indicating "Unternet" type address
↑NE%STR←←<100000,,0>	;Escape bit indicating "string" type address
↑NN%IP←←<740000,,0>	;host number bits that are off for all IP addresses
↑NW%ARP←←<=10⊗=24>	;HOSTS3 uses full word network # values
↑NW%MIL←←<=26⊗=24>	;LLL is on MILnet
↑NW%SI←←44⊗=24		;Internet address of SU-NET-TEMP
↑NW%SU←←NE%UNT!NW%SI	;"Unternet" used for Stanford Ethernet
↑NW%36←←NW%SI!44⊗=16	;local 3-meg net
↑NW%08←←NW%SI!10⊗=16	;local 10-meg net
↑NW%P08←←NW%SU!10⊗=8	;"Unternet" 10-meg subnet in MJH
↑NW%P36←←NW%SU!44⊗=8	;"Unternet" 3-meg subnet in MJH
;⊗ NWKDBG ERRCLR HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV VARSET VART17 VARTMO

; Data area

NWKDBG:	0			; -1 → do OUTCHR on network I/O
↑ERRCLR:-1			;nonzero means clear typeahead on error typeout

IFN HSTTAB,<

; Host table pointers

↑HSTADR:BLOCK 1				; ≠ 0 → address of beginning of host table
					; = 0 → host table not in core
HSTTOP:	BLOCK 1				; top of host table (JOBFF at map time)
HDBPTR:	BLOCK 1				; pointer to relative HDB

; Block for ASCIZ text of dotted host number of host not in table
DHSTST:	BLOCK 10

>; End IFN HSTTAB

IFN TTYSTS,<

TTYFIL:	SIXBIT/TTYINI/		;File of SU-Ethernet TTY information
	SIXBIT/BIN/
TTYPPN:	SIXBIT/HSTNET/
TTBSIZ:	BLOCK 1			;Size of TTY info block, read from file
TTYNAM:	BLOCK 10		;Block to return TTY string

>;End IFN TTYSTS

IFN NIORTS,<

OPNBLK:	0
↑NETDEV:'IMP',,0			; device name
	NTOBF,,NTIBF			; buffers

; CONNECT MTAPE block

CONBLK:	0				; CONNECT
CONSTS:	BLOCK 1				; returned status bits
CONLPR:	BLOCK 1				; local port
CONWAT:	BLOCK 1				; ≠ 0 → wait for connection until timeout
CONBYT:	BLOCK 1				; byte size
↑ICPSKT::				;(old name, for compatibility)
↑CONFPR:BLOCK 1				; foreign port
↑HOST:
CONHST:	BLOCK 1				; foreign host

IFN SVRRTS,<
; LISTEN MTAPE block

LSNBLK:	1				; LISTEN
LSNSTS:	BLOCK 1				; returned status bits
↑LSNSKT::				;(old name, for compatibility)
↑LSNPRT:BLOCK 1				; local port to listen to
LSNWAT:	BLOCK 1				; ≠ 0 → wait for connection
LSNBYT:	BLOCK 1				; byte size
LSNFPR:	BLOCK 1				; foreign port
LSNHST:	BLOCK 1				; foreign host
>; End IFN SVRRTS

STABLK:	2			;STATUS
STASND:	BLOCK 1			;Send side status
STARCV:	BLOCK 1			;Receive side status
;Both IMPSER and PUPSER store the same values in the above two words.

↑VARSET:0			;nonzero means use timeouts in VARTMO below

;MTAPE block for setting timeouts
VART17:	17
↑VARTMO:0			;place for use to stick desired timeouts
;⊗ TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT PRINUM NUMPRI PRIADR PRIMSK

; More data area, shared by USER and SERVER

;TERMINATE MTAPE block

TERBLK:	3			;TERMINATE
TERSTS:	BLOCK 1			;Returned status bits
TERPRT:	BLOCK 1			;Port number
TERWAI:	BLOCK 1			;Wait flag

repeat 0,<			;Leftover from NCP days
; WAIT MTAPE block

WATBLK:	4				; WAIT
WATSTS:	BLOCK 1				; returned status bits
WATPRT:	BLOCK 1				; port number

; INTERRUPT MTAPE blocks

INRBLK:	11				; SEND INTERRUPT
INRSTS:	BLOCK 1				; returned status bits
INRPRT:	BLOCK 1				; port number

INSBLK:	11
INSSTS:	BLOCK 1
INSPRT:	BLOCK 1
>;repeat 0

;ABORT MTAPE block

ABTBLK:	22			;ABORT
ABTSTS:	BLOCK 1			;Returned status bits

IFN MRKCHR,<
RMKBLK:	26				; READ MARK
RMKSTS:	BLOCK 1
RMKDAT:	BLOCK 1				; mark byte returned here
>; End IFN MRKCHR

IFN IPUDP,<
UDPBLK:	26			;Set UDP parameters
UDPSTS:	BLOCK 1			;Returned status bits
↑UDPLPR:BLOCK 1			;Local port
	0
	0
↑UDPFPR:BLOCK 1			;Foreign port
↑UDPHST:BLOCK 1			;Foreign host
>;IFN IPUDP

; Other stuff

WHYWHY:	BLOCK 1				; host down word

; I/O buffer headers

NTIBF:	BLOCK 3				; network input buffer header
↑NTOBF:	BLOCK 3				; network output buffer header

IFN DATRTS,<
DTIBF:	BLOCK 3				; network data input buffer header
DTOBF:	BLOCK 3				; network data output buffer header
>; End IFN DATRTS

; Base ports, set up by CONECT and LISTEN

↑FSOCKT::				;(old name, for compatibility)
↑FBPORT:BLOCK 1				; foreign base port
↑LSOCKT::				;(old name, for compatibility)
↑LBPORT:BLOCK 1				; local base port

>; End IFN NIORTS

IFN HSTTAB!DOMRTS,<
;Table for sorting host addresses

;In the following list, addresses that are more specific should be
;earlier.  I.e., a subnetwork should precede its parent network, so
;that the comparison on the subnetwork will take precedence.
DEFINE PRILST<
	PRIMAC(14,<004402,,0>,<777777,,777400>)	;Internet MJH 10MB
	PRIMAC(13,<004411,,0>,<777777,,777400>)	;Internet MJH 3MB
	PRIMAC(12,<004400,,0>,<777700,,000000>)	;Internet SU-Net
	PRIMAC(11,<044400,,004000>,<777777,,777400>)	;Pup MJH 10MB
	PRIMAC(10,<044400,,022000>,<777777,,777400>)	;Pup MJH 3MB
	PRIMAC(7,<044400,,000000>,<777700,,000000>)	;Pup SU-Net
	PRIMAC(6,<020013,,200000>,<777777,,600000>)	;DECRWL
	PRIMAC(5,<001200,,0>,<777700,,0>)	;Arpanet
	PRIMAC(4,<003200,,0>,<777700,,0>)	;Milnet
	PRIMAC(3,<000000,,0>,<740000,,0>)	;Any Internet address
>;DEFINE PRILST

DEFINE PRIMAC(NUM,ADDR,MASK)<NUM>
PRINUM:	PRILST
NUMPRI←←.-PRINUM

DEFINE PRIMAC(NUM,ADDR,MASK)<ADDR>
PRIADR:	PRILST

DEFINE PRIMAC(NUM,ADDR,MASK)<MASK>
PRIMSK:	PRILST

>;IFN HSTTAB!DOMRTS
;⊗ CONECT .CONEC

; CONECT -- Connect to foreign host
; Call:	MOVEM <host number>,HOST
;	MOVEM <foreign port number>,CONFPR
;	PUSHJ 17,CONECT
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

IFN NIORTS,<

IFE SVRRTS,<

; Open channels and set timeouts

↑CONECT:
IFN ERRHAN,<
	PUSHJ 17,.CONEC
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.CONEC:	GETNET 0,HOST			; check network type
	MOVEI 1,'IMP'			; Assume not PUP
	CAMN 0,[NW%SU]			; Ethernet?
	 MOVEI 1,'PUP'			; Yes, use PUP
	MOVSM 1,NETDEV			; specify device for OPEN
	CAIN 1,'PUP'
	 HRRZS HOST			; Don't confuse PUPSER with net number
	OPEN NET,OPNBLK			; open NET in ASCII mode
	 JRST [	MOVEI 0,0		; failed, maybe device is detached
		JRST CPOPJ1]		; return 0 to indicate no device
	SKIPE VARSET			;want timeouts set from variable cell?
	MTAPE NET,VART17		;set timeouts from VARTMO
	SKIPN VARTMO
	MTAPE NET,[17 ↔ CNTIMO]
	SETOM CONLPR			; gensym local port
	SETOM CONWAT			; do wait until timeout
	MTAPE NET,CONBLK		; connect → foreign server
	MOVE CONLPR			; get gensymmed port
	MOVEM LBPORT			; save local base port
	MOVE CONSTS			; get MTAPE status
	MOVEM WHYWHY			; save it
	GETSTS NET,			; check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TRNE 77				; check for MTAPE error
	 POPJ 17,
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal state?
	 POPJ 17,
	MOVE CONFPR			; get port we got
	MOVEM FBPORT			; save foreign port for later
	MOVE CONLPR			; for completeness and compatibilty
repeat 0,<
	MOVEM INSPRT
>;repeat 0
	MOVEM TERPRT
	MOVEI =8			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[10]
	 CAI
	JRST CPOPJ2

>; End IFE SVRRTS
;⊗ LISTEN .LISTE

; LISTEN -- Listen for a connection from a foreign host
; Call:	MOVEM <local port number>,LSNPRT
;	MOVEM <device name>,NETDEV	;If omitted, then use IMP
;	PUSHJ 17,LISTEN
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--host we connected to in HOST>
; Smashes 0 and 1.

IFN SVRRTS,<

; Open channels and set timeouts (punts after a minute)

↑LISTEN:
IFN ERRHAN,<
	PUSHJ 17,.LISTE
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.LISTE:	OPEN NET,OPNBLK			; open NET in ASCII mode
	 FATAL Network device INIT failure
	MOVS 1,NETDEV
	SKIPE VARSET			;want timeouts set from variable cell?
	MTAPE NET,VART17		;set timeouts from VARTMO
	SKIPN VARTMO
	MTAPE NET,[17 ↔ LSTIMO]		; set timeouts
	SETOM LSNWAT			; do wait until timeout
	MTAPE NET,LSNBLK
	MOVE LSNSTS			; check for MTAPE error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS NET,			; check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal state?
	 POPJ 17,
	MOVE LSNHST
	MOVEM CONHST
	MOVE LSNFPR
	MOVEM FBPORT			; save foreign base port
	MOVE LSNPRT			; remember local port
	MOVEM LBPORT
repeat 0,<
	MOVEM INSPRT			; for completeness, set this as well
>;repeat 0
	MOVEM TERPRT
	MOVEI =8			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[10]
	 CAI
	JRST CPOPJ2

>; End IFN SVRRTS
;⊗ DATI .DATI .DATI1

; DATI -- Open data input network channel
; Call:	PUSHJ 17,DATI
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--byte size in 0>
; Smashes 0 and 1.

IFN DATRTS,<

↑DATI:
IFN ERRHAN,<
	PUSHJ 17,.DATI
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATI:	CHNSTS DAT,			; check for channel open
	JUMPN .DATI1
	INIT DAT,0			; open channel
	 ('IMP')
	 DTOBF,,DTIBF			; buffers
	 FATAL IMP INIT failure
	SKIPE VARSET			;want timeouts set from variable cell?
	MTAPE DAT,VART17		;set timeouts from VARTMO
	SKIPN VARTMO
	MTAPE DAT,[17 ↔ DATIMO]
.DATI1:	MOVE LBPORT
	ADDI 4				; ICP/U receive data offset
	MOVEM CONLPR			; local receive port
	MOVE FBPORT
	ADDI 3				; ICP/S transmit data offset
	MOVEM CONFPR			; foreign transmit port
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect ← foreign data output
	MOVE CONSTS			; test for error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MTAPE DAT,[15 ↔ 1]		; system maximum allocation
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTIBF+1]
	INBUF DAT,
	MTAPE DAT,[10]
	 CAI
	JRST CPOPJ2
;⊗ DATO .DATO .DATO1

; DATO -- Open data output network channel
; Call:	MOVEI <byte size of connection>
;	PUSHJ 17,DATO
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

↑DATO:
IFN ERRHAN,<
	PUSHJ 17,.DATO
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATO:	MOVEM CONBYT
	CHNSTS DAT,
	JUMPN .DATO1
	INIT DAT,0			; open channel
	 ('IMP')
	 DTOBF,,DTIBF			; buffers
	 FATAL IMP INIT failure
	SKIPE VARSET			;want timeouts set from variable cell?
	MTAPE DAT,VART17		;set timeouts from VARTMO
	SKIPN VARTMO
	MTAPE DAT,[17 ↔ DATIMO]
.DATO1:	MOVE LBPORT
	ADDI 5				; ICP/U transmit data offset
	MOVEM CONLPR			; local receive port
	MOVE FBPORT
	ADDI 2				; ICP/S receive data offset
	MOVEM CONFPR			; foreign transmit port
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect → foreign data input
	MOVE CONSTS			; test for error
	MOVEM WHYWHY
	TRNE 77
	 POPJ 17,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTOBF+1]
	OUTBUF DAT,
	JRST CPOPJ2

>; End IFN DATRTS
;⊗ CONCHK

;CONCHK -- Check status of network connection.
;Call:	PUSHJ 17,CONCHK
;	 <return if error or no connection open>
;	<return if connection open and no error>
;Connection status is returned in 0 in either case.

↑CONCHK:MTAPE NET,STABLK	;Get status
	MOVE STASND		;Pick up "send side" status
	TRNE 77			;Check for MTAPE error
	 POPJ 17,
	TLC (WINBTS)		;For next instruction to win
	TLCE (WINBTS)		;Legal state?
	 POPJ 17,
	JRST CPOPJ1
;⊗ UDPCON .UDPCN

;;; Note: This code experimental and subject to change.

;UDPCON -- Set up IP/UDP connection.
;Call:	MOVEM <host number>,UDPHST
;	MOVEM <local port number or -1>,UDPLPR
;	MOVEM <foreign port number or -1>,UDPFPR
;	PUSHJ 17,UDPCON
;	 <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	 <error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
;Smashes 0 and 1.

IFN IPUDP,<

↑UDPCON:
IFN ERRHAN,<
	PUSHJ 17,.UDPCN
	 JRST [PUSHJ 17,MTPERR ↔ ERRINS]
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>;End IFN ERRHAN
.UDPCN:	MOVEI 1,'IMP'		;Can't do this with PUP!
	MOVSM 1,NETDEV
	OPEN NET,OPNBLK		;Open NET in ASCII mode
	 FATAL Network device INIT failure
	MTAPE NET,UDPBLK	;Set UDP parameters for connection
	MOVE UDPSTS		;Get MTAPE status
	MOVEM WHYWHY		;Save it
	GETSTS NET,		;Check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE WHYWHY
	TRNE 77			;Check for MTAPE error
	 POPJ 17,
	MOVEI =8		;Change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	SKIPE VARSET		;want timeouts set from variable cell?
	MTAPE NET,VART17	;set timeouts from VARTMO
	SKIPN VARTMO
	MTAPE NET,[17 ↔ CNTIMO]
	JRST CPOPJ2

>;End IFN IPUDP
;⊗ NETICH NETICW NTICH2 NTICH4 NTICH3

; NETICH/NETICW -- Read a character from the network
; Call:	PUSHJ 17,NETICH or PUSHJ 17,NETICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff NETICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

↑NETICH:TDZA 2,2			; don't hang
↑NETICW: SETO 2,			; hang
IFN ERRHAN,<
	PUSHJ 17,NTICH2
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	 POPJ 17,			; NETICW or empty NETICH
	JRST CPOPJ1			; NETICH return
>; End IFN ERRHAN
NTICH2:	SOSLE NTIBF+2			; anything in buffer?
	 JRST NTICH3
	JUMPN 2,NTICH4
	HRRZ 1,NTIBF
	HRRZ 1,(1)
	SKIPGE (1)			; anything in further buffers?
	 JRST NTICH4
	MTAPE NET,[10]			; no, any input available?
	 JRST CPOPJ1			; no, empty error return
NTICH4:	IN NET,				; yes, read the buffer
	 JRST NTICH3			; won
	GETSTS NET,			; error, get status
IFN MRKCHR,<
	TRNN 0,IOBKTL			; mark seen?
>; End IFN MRKCHR
	POPJ 17,			; I/O error return
IFN MRKCHR,<
	MTAPE NET,RMKBLK		; read mark byte
	 POPJ 17,			; failed
	MOVE 0,RMKDAT
	TRO 0,400			; send it in specially marked package
	JRST CPOPJ2			; good return
>; End IFN MRKCHR
NTICH3:	ILDB NTIBF+1			; get the character
	SKIPE NWKDBG
	 OUTCHR
	JUMPN 2,CPOPJ1			; NETICW only skips once
	JRST CPOPJ2			; NETICH good return
;⊗ NETOCH .NETOC

; NETOCH -- Output a character to the network
; Call:	MOVE <character>
;	PUSHJ 17,NETOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

↑NETOCH:
IFN ERRHAN,<
	PUSHJ 17,.NETOC
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.NETOC:	SOSG NTOBF+2			; space available in buffer?
	 OUT NET,			; no, output it
	  CAIA				; win
	   JRST NETOER
	IDPB NTOBF+1			; put character in buffer
	SKIPE NWKDBG
	 OUTCHR
	JRST CPOPJ1			; success
;⊗ NETSND .NETSN NETOER

; NETSND -- Force network buffer out
; Call:	PUSHJ 17,NETSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>

↑NETSND:
IFN ERRHAN,<
	PUSHJ 17,.NETSN
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.NETSN:	OUT NET,			; send the buffer
	 JRST [	AOS NTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
NETOER:	GETSTS NET,			; lost, get status
	POPJ 17,			; and return
;⊗ DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A

; DATICH/DATICW -- Read a character from the network data channel
; Call:	PUSHJ 17,DATICH or PUSHJ 17,DATICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff DATICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

IFN DATRTS,<

↑DATICH:TDZA 2,2			; don't hang
↑DATICW: SETO 2,			; hang
IFN ERRHAN,<
	PUSHJ 17,DTICH2
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	 POPJ 17,			; DATICW or empty DATICH
	JRST CPOPJ1			; DATICH return
>; End IFN ERRHAN
DTICH2:	SOSLE DTIBF+2			; anything in buffer?
	 JRST DTICH3
	JUMPE 2,[	HRRZ 1,DTIBF
			HRRZ 1,(1)
			SKIPGE (1)	; anything in further buffers?
			 JRST .+1
			MTAPE DAT,[10]	; no, any input available?
			 JRST CPOPJ1	; no, empty error return
			JRST .+1]	; input available or hang
	IN DAT,				; yes, read the buffer
	 JRST DTICH3			; won
	GETSTS DAT,			; error, get status
	POPJ 17,			; I/O error return
DTICH3:	LDB [300600,,DTIBF+1]		; get byte size
	CAIE =8
	 JRST [	ILDB DTIBF+1		; non-ASCII data mode
		JUMPN 2,CPOPJ1
		JRST CPOPJ2]
	IBP DTIBF+1			; increment pointer to hack
	MOVE @DTIBF+1			; get word to hack
	ANDI 17 			; only marking bits
	JFFO DTICH1			; count leading zeros
	LDB DTIBF+1			; get the character
	JUMPN 2,CPOPJ1			; DATICW only skips once
	JRST CPOPJ2			; DATICH good return

; Have to flush nulls here.

DTICH1:	MOVNI 1,-44(1)			; get -1,,# of padding characters
	HRRZM 1,1(17)			; stash # of characters away on stack
	MOVEI 1,-1(1)			; # of characters to take off buffer
	SUBM 1,DTIBF+2			; remove padding characters from count
	MOVNS DTIBF+2			; SUBM goes the wrong way
	SKIPE 1				; maybe no adjustment necessary
DTIC1A:	IBP DTIBF+1
	SOJG 1,DTIC1A			; increment byte ptr given nbr of bytes
	MOVN 1,1(17)			; get # of characters back from stack
	LSH 1,3				; # of bits to shift over
	MOVE @DTIBF+1			; get word we are hacking
	LSH (1)				; right justify its bytes
	MOVEM @DTIBF+1			; store it back again
	JRST DTICH2			; now try it again
;⊗ DATOCH .DATOC

; DATOCH -- Output a character to the network data channel
; Call:	MOVE <character>
;	PUSHJ 17,DATOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

↑DATOCH:
IFN ERRHAN,<
	PUSHJ 17,.DATOC
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATOC:	SOSG DTOBF+2			; space available in buffer?
	 OUT DAT,			; no, output it
	  CAIA				; win
	   JRST DATOER
	IDPB DTOBF+1			; put character in buffer
	JRST CPOPJ1			; success
;⊗ DATSND .DATSN DATOER

; DATSND -- Force network buffer out
; Call:	PUSHJ 17,DATSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

↑DATSND:
IFN ERRHAN,<
	PUSHJ 17,.DATSN
	 JRST [PUSHJ 17,NIOERR ↔ ERRINS]
	POPJ 17,
>; End IFN ERRHAN
.DATSN:	LDB 1,[410300,,DTOBF+1]		; get position field
	MOVEI 1
	LSH (1)				; AC0 ← 2↑<# of null characters>
	SOS				; AC0 ← mask to flush nulls
	IORM @DTOBF+1			; ensure padding nulls aren't sent
	OUT DAT,			; send the buffer
	 JRST [	AOS DTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
DATOER:	GETSTS DAT,			; lost, get status
	POPJ 17,			; and return

>; End IFN DATRTS
;⊗ CLOSER CLSDAT CLOSEW

; CLOSER/CLSDAT -- Close a connection
; Call:	PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
;	<return>
; Smashes 0.

↑CLOSER:CLOSE NET,
	RELEASE NET,
	OUTSTR [ASCIZ/
Connection closed.
/]
	POPJ 17,

IFN DATRTS,<

↑CLSDAT:CLOSE DAT,
	RELEASE DAT,
	POPJ 17,

>; End IFN DATRTS

;CLOSEW -- Close a connection and wait, using MTAPE for this.
;Call:	PUSHJ 17,CLOSEW
;	<return>

↑CLOSEW:SETOM TERWAI		;Set wait flag
	MTAPE NET,TERBLK	;Close connection
	POPJ 17,
;⊗ NETINR NETINS ABORT

repeat 0,<			;Leftover from NCP days
; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call:	PUSHJ 17,NETINR (or NETINS)
;	<return>
; Smashes 0.

↑NETINR:MTAPE NET,INRBLK		; interrupt from receiver
	POPJ 17,

↑NETINS:MTAPE NET,INSBLK		; interrupt from sender
	POPJ 17,
>;repeat 0


; ABORT -- Abort TCP connection (send reset)
; Call:	PUSHJ 17,ABORT
;	<return>

↑ABORT:	CHNSTS NET,ABTSTS	;see if channel is open
	HRLZS ABTSTS		;put INITB into sign bit
	SKIPGE ABTSTS		;skip if no channel open
	MTAPE NET,ABTBLK	;send TCP reset
	POPJ 17,

>; End IFN NIORTS
;⊗ MTPERR MTPER2 MTPER1 MTPE1A MERTAB MERLEN

; MTPERR -- Explain MTAPE lossage
; Call:	MOVE <MTAPE status bits>
;	PUSHJ 17,MTPERR
;	<return>
; Smashes 0 and 1.

IFN ERRTNS,<

↑↑MTPERR:TRNE 77			; UUO lossage?
	 JRST MTPER1			; yes, different message
	TLNN (CLSR)			; closed by foreign host?
	 SKIPA 1,[[ASCIZ/Time out
/]]
	  MOVEI 1,[ASCIZ/Refused
/]
	OUTSTR (1)
	SKIPE ERRCLR			;want to clear typeahead on error?
	CLRBFI				;yup, clear it
	POPJ 17,

; MTAPE UUO lossage

MTPER1:	ANDI 77				; only error code
	CAILE MERLEN			; error code too high?
	 JRST [	OUTSTR [ASCIZ/MTAPE error #/]
		IDIVI 10
		ADDI "0"
		ADDI 1,"0"
		OUTCHR
		OUTCHR 1
		JRST MTPE1A]
;;;	CAIN 0,15			;Is it the "host dead" code?
;;;	 JRST HSTDED			;Yes, say why
	MOVE 1,
	MOVE 1,MERTAB-1(1)		;Get word from table
	OUTSTR (1)			;Output the error string
	TLNN 1,600000			;Print crlf if not warning or fatal
	 OUTSTR [ASCIZ/
/]
;Don't need to stop during simple error message typeout.
;	TLNE 1,400000			;Test for fatal error
;	 JRST LUZBIG
	TLNE 1,200000			;Test for warning
MTPE1A:	 WARN
	SKIPE ERRCLR			;want to clear typeahead on error?
	CLRBFI				;yup, clear it
	POPJ 17,

;Bits in LH: 400000 if fatal error  (says find a wizard) ;No longer implemented.
;	     200000 if warning  (says please report via GRIPE NETWORK)

MERTAB:	200000,,[ASCIZ/Port in use/]
	200000,,[ASCIZ/Can't change port/]
	200000,,[ASCIZ/System error/]		; horrible IMPSER bug; RTS&STR but no DDB
	[ASCIZ/No free links/]
	200000,,[ASCIZ/Illegal byte size/]
	[ASCIZ/IMP dead/]
	200000,,[ASCIZ/Gender mismatch/]	; the Anita Bryant feature
	;TOPS-10 error codes (from TCPSER.MAC[S,SYS]):
	200000,,[ASCIZ/State error/]				;(10)
	[ASCIZ/Can't get there from here/]			;(11)
	200000,,[ASCIZ/Not enough internal buffer space/]	;(12)
	[ASCIZ/Illegal host number/]				;(13)
	[ASCIZ/Destination net unreachable/]			;(14)
	[ASCIZ/Destination host unreachable/]			;(15)
	[ASCIZ/Destination protocol unreachable/]		;(16)
	[ASCIZ/Destination port unreachable/]			;(17)
	200000,,[ASCIZ/Fragmentation needed and DF set/]	;(20)
	200000,,[ASCIZ/Source route failed/]			;(21)
	200000,,[ASCIZ/Destination unreachable: unknown code/]	;(22)
MERLEN←←.-MERTAB
;⊗ NIOERR NIOER2

; NIOERR -- Explain network I/O lossage
; Call:	MOVE <I/O status bits>
;	PUSHJ 17,NIOERR
;	<return>
; Smashes 0, 1, and 2.

↑NIOERR:JUMPE 0,NIOER2			;no bits means OPEN failed
	ANDI ERRBTS			;error bits only
	SKIPN
	 WARN No network error status
	SKIPE ERRCLR			;want to clear typeahead on error?
	CLRBFI				;yup, clear it
	TRNE IOBKTL
	 WARN Network block-too-large error
	TRNE IOIMPM
	 OUTSTR [ASCIZ/Connection closed
/]
	TRNE RSET
	 OUTSTR [ASCIZ/Connection was reset
/]
	TRNE TMO
	 OUTSTR [ASCIZ/Time out
/]
	TRNE IODEND
	 OUTSTR [ASCIZ/Host closed connection
/]
	TRNE HDEAD
	 JRST HSTDED
	POPJ 17,

NIOER2:	OUTSTR [ASCIZ/Network device unavailable (maybe being debugged)
/]
	SKIPE ERRCLR			;want to clear typeahead on error?
	CLRBFI				;yup, clear it
	POPJ 17,
;⊗ HSTDED

; HSTDED -- Explain why a host is dead

HSTDED:	LDB [260400,,WHYWHY]		; get what's wrong first
	JUMPE [	OUTSTR [ASCIZ/Net trouble
/]
		POPJ 17,]		; 0 → destination IMP down
	CAIE 1				; 1 → destination host down
	 JRST [	CAIN 2			; 2 → destination host talks 32 bit leaders
		 JRST [ OUTSTR [ASCIZ/Communication with host not possible because it only talks 32 bit leaders
This probably indicates a hardware error at the other host, since 32-bit
leaders have been invalid since January 1, 1981.
/]
			POPJ 17,]
ifn 0,<
		cain 17			; Funny code from CONECT for bad net?
		 JRST [	OUTSTR [ASCIZ/Host net is inaccessible
/]
			POPJ 17,]
>;ifn 0
		OUTSTR [ASCIZ/Communication prohibited!
/]					; 3 → host access prohibited
		POPJ 17,]
	OUTSTR [ASCIZ/Host dead, /]
	LDB 1,[220400,,WHYWHY]		; dead host status
	OUTSTR @(1)[	[ASCIZ/reason unknown/]
			[ASCIZ/system down/]
			[ASCIZ/foreign NCP down/]
			[ASCIZ/host doesn't exist/]
			[ASCIZ/NCP initialization/]
			[ASCIZ/scheduled PM/]
			[ASCIZ/hardware work/]
			[ASCIZ/software work/]
			[ASCIZ/emergency restart/]
			[ASCIZ/power failure/]
			[ASCIZ/software breakpoint/]
			[ASCIZ/hardware error/]
			[ASCIZ/scheduled down/]
			[ASCIZ/down code #13/]
			[ASCIZ/down code #14/]
			[ASCIZ/coming up now/]]
	OUTSTR [ASCIZ/
/]
;⊗ HSTDE2

; Hairy "when host up" code

	LDB [061400,,WHYWHY]		; get time when back up
	JUMPE CPOPJ
	CAIN 7776			; -2 → unknown future time
	 POPJ 17,
	OUTSTR [ASCIZ/  Host is expected back up /]
	CAIN 7777			; -1 → more than a week
	 JRST [	OUTSTR [ASCIZ/over a week from now./]
		POPJ 17,]
	LDB 1,[040500,,0]		; 1.5→1.9 hours
	LDB 2,[110300,,0]		; 2.1→2.3 day of week
	SUBI 1,=8			; PST/GMT offset
	MOVEI 3,261			; DAYLIT
	PEEK 3,
	PEEK 3,
	SKIPE 3
	 AOSL 1				; daylight losing time
	  JUMPGE 1,HSTDE2
	ADDI 1,=24			; hours become positive again
	SOJGE 2,HSTDE2			; back up a day
	MOVEI 2,6			; back to Monday
HSTDE2:	OUTSTR @(2)[	[ASCIZ/on Monday at /]
			[ASCIZ/on Tuesday at /]
			[ASCIZ/on Wednesday at /]
			[ASCIZ/on Thursday at /]
			[ASCIZ/on Friday at /]
			[ASCIZ/on Saturday at /]
			[ASCIZ/on Sunday at /]
			[ASCIZ/on April Fool's Day at /]]
	IDIVI 1,=10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	OUTCHR [":"]
	LDB 1,[000400,,0]		; 1.1→1.4 minutes/5
	IMULI 1,5.			; make into real minutes
	IDIVI 1,=10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	JUMPE 3,[	OUTSTR [ASCIZ/ PST
/]
			POPJ 17,]
	OUTSTR [ASCIZ/ PDT
/]
	POPJ 17,

>; End IFN ERRTNS
;⊗ HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM

; Host table routines

IFN HSTTAB,<

; Herein is the description of the compiled binary file (HOSTS3.BIN).
; General terms:
;	"fileaddr" = a file address, relative to start of file.
;	"netaddr" = a network address, in HOSTS3 format.
;
; All strings (hostnames etc) are uppercase ASCIZ, word-aligned and
; fully zero-filled in the last word.  The strings are stored in the
; file in such a way that their locations are sorted, and only ONE
; copy of any distinct string is stored - everything that references
; the same string points to the same place.  Thus it is reasonable to
; compare string pointers for = as well as < and >, which is much
; faster than comparing the strings.

;The format of the compiled output file is:

HSTSID←←0	; wd 0	SIXBIT /HOSTS3/
HSTFN1←←1	; wd 1	SIXBIT FN1 of source file (eg HOSTS)
HSTVRS←←2	; wd 2	SIXBIT FN2 of source file (TNX: version #)
HSTDIR←←3	; wd 3  SIXBIT directory name of source file (eg SYSENG)
HSTDEV←←4	; wd 4  SIXBIT device name of source file (eg AI)
HSTWHO←←5	; wd 5	SIXBIT login name of person who compiled this
HSTDAT←←6	; wd 6  SIXBIT Date of compilation as YYMMDD
HSTTIM←←7	; wd 7	SIXBIT Time of compilation as HHMMSS
NAMPTR←←10	; wd 10 Fileaddress of NAME table.
SITPTR←←11	; wd 11	Fileaddress of SITE table.
NETPTR←←12	; wd 12 Fileaddress of NETWORK table.
NTNPTR←←13	; wd 13 Fileaddress of NETNAME table.
		;....expandable....
  HDRLEN←←14	; length of header

; NETWORK table
;	wd 0	Number of entries in table.
;	wd 1	Number of words per entry. (2)
; This table contains one entry for each known network.
; It is sorted by network number.
; Each entry contains:

NETNUM←←0	; wd 0 network number (full netaddr)
NTLNAM←←1	; wd 1 LH - fileaddr of ASCIZ name of network
NTRTAB←←1	; wd 1 RH - fileaddr of network's ADDRESS table
 NETLEN←←2

; ADDRESS table(s)
;	wd 0	Number of entries in table.
;	wd 1	Number of words per entry. (3)
; 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 and services for a site is stored
; within these tables.
; Each entry contains:

ADDADR←←0	; wd 0	Network address of this entry, in HOSTS3 fmt.
ADLSIT←←1	; wd 1 LH - fileaddr of SITE table entry
ADRCDR←←1	; wd 1 RH - fileaddr of next ADDRESS entry for this site
		;	 0 = end of list
ADLXXX←←2	; wd 2 LH - unused
ADRSVC←←2	; wd 2 RH - fileaddr of services list for this address
		;	0 = none, else points to SERVICE node of format:
	SVLCNT←←0	;		<# wds>,,<fileaddr of next, or 0>
	SVRCDR←←0
	SVLFLG←←1	;		<flags>,,<fileaddr of svc name>
	SVRNAM←←1
	SVCARG←←2	;		<param1> ? <param2> ? ...
 ADDLEN←←3

; 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 - fileaddr of official host name
STRADR←←0	; wd 0 RH - fileaddr of first ADDRESS table entry for this
		;		site.  Successive entries are threaded
		;		together through ADRCDR.
STLSYS←←1	; wd 1 LH - fileaddr of system name (ITS, TIP, TENEX, etc.)
		;		May be 0 → not known.
STRMCH←←1	; wd 1 RH - fileaddr of machine name (PDP10, etc.)
		;		May be 0 → not known.
STLFLG←←2	; wd 2 LH - flags:
STFSRV←←400000	;	4.9 1 → server site (has FTP or TELNET)
STFGWY←←200000	;	4.8 1 → Internet Gateway site (HOSTS3 only)
 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	; wd 0 LH - fileaddr of SITE table entry for this host.
NMRNAM←←0	; wd 0 RH - fileaddr of host name
		; This name is official if NMRNAM = STLNAM of NMLSIT.
 NAMLEN←←1

; NETNAME table:
;	wd 0	Number of entries
;	wd 1	Number of words per entry. (1)
; This table is used to convert network names into network numbers.  It
; contains entries sorted alphabetically by network name, exactly as
; for the NAMES table.  Although the symbols below are different (in order
; to make semantic distinctions), programs can depend on the fact
; that the NETNAME table format is identical to that of the NAMES table.

NNLNET←←0	; wd 0 LH - fileaddr of NETWORK table entry for this host.
NNRNAM←←0	; wd 0 RH - fileaddr of network name
 NTNLEN←←1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;		HOSTS3 Network Address Format           ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

comment |
HOSTS3 network address format:

   4.9-4.6 - 4 bits of format type, which specify interpretation of
		the remaining 32 bits.
IN	0000 - Internet address (handles ARPA, RCC, LCS)
		4.5-1.1 - 32 bits of IN address.
UN	0001 - Unternet address.  Same format, but not part of Internet.
		4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
		3.6-1.1 - address value in next 24 bits.
			This handles CHAOS and any local nets.  The network
			numbers are unique within the HOSTS3 table but
			don't necessarily mean anything globally, as do
			Internet network numbers.
	0011 - String address.
		4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
		3.6-3.1 - 0
		2.9-1.1 - address of ASCIZ string in file/process space

Note that the "network number" for all of these formats is located in
the same place.  However, for fast deciphering of the entire range of
possibilities, one could simply consider all of the high 12 bits as the
network number.  Beware of the Internet class A, B, and C formats, though;
the only truly general way to compare network numbers is to use their
masked 36-bit values, although simpler checks are OK for specific nets.
For this reason (among others) network numbers are represented by
full 36-bit values with the "local address" portion zero.

The 4-bit "String address" value is much more tentative than the IN or UN
values.  Bit 4.9, the sign bit, is being reserved as usual for the possible
advent of a truly spectacular incompatible format.
|

HSTFIL:	SIXBIT/HOSTS3/		;Filename and extension of binary file
	SIXBIT/BIN/
HSTPPN:	SIXBIT/HSTNET/		;PPN of binary file

;The following is for a kludge in HSTNAM.  It should be read from the file.
LOCDOM:	ASCIZ/Stanford.EDU/	;Local domain's parent
;⊗ MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3

; MAPHST -- Map host table into core
; Call:	PUSHJ 17,MAPHST
;	<return>
; Smashes 0, 1, 2, and 3.

MAPHS2:	HRROS (17)	;indicate want host table in new upper segment
	JRST MAPHS0

↑MAPHST:HRRZS (17)	;indicate want host table in lower segment
MAPHS0:	SKIPE HSTADR
	 JRST [	WARN Host table already mapped
		POPJ 17,]
	INIT 17
	 ('DSK')
	 0
	 FATAL DSK INIT failure
	DMOVE 0,HSTFIL
	MOVE 3,HSTPPN
	LOOKUP 0
	 JRST [	OUTSTR [ASCIZ/Host table LOOKUP failure (/]
		ANDI 1,77
		IDIVI 1,10
		ADDI 1,"0" ↔ ADDI 2,"0"
		OUTCHR 1 ↔ OUTCHR 2 ↔ OUTCHR [")"]
		JRST LUZBIG]
	MOVS 0,3		;unswap file length
	MOVN 0,0		;make file length positive
	SKIPGE (17)		;going into upper?
	JRST MAPHS3		;yes
	MOVE 2,JOBFF↑		;place to put table
	ADDB 0,JOBFF↑		;get address of highest addr we need
	MOVEM 0,HSTTOP
	CORE 0,			;get more core from system maybe
	 FATAL CORE UUO failure
MAPHS4:	MOVE 0,3 		;negative length in LH
	HRRI 0,-1(2)		;compute IOWD to read host table in
	MOVEI 1,0
	INPUT 0			;read whole host table
	MOVE 0,(2)		;get first word of host table
	CAME 0,HSTFIL
	 FATAL Bad host table
	MOVEM 2,HSTADR		;remember where host table begins
	RELEAS
	POPJ 17,

MAPHS3:	MOVEI 2,400000		;place to put host table, beginning of upper
	ADDI 0,(2)		;ending address of table
	MOVEM 0,HSTTOP		;end of table
	CORE2 0,		;get enough core in upper segment
	 FATAL CORE2 UUO failed for host table space in segment
	JRST MAPHS4
;⊗ UNMHST

; UNMHST -- Unmap host table from core
; Call:	PUSHJ 17,UNMHST
;	<return>
; Smashes 0 and 1.

↑UNMHST:SKIPN 1,HSTADR			; host table in core?
	 JRST [	WARN Host table not mapped
		POPJ 17,]
	MOVE (1)
	CAME HSTFIL
	 FATAL Bad host table
	MOVE HSTTOP			; check JOBFF from before
	CAMLE JOBFF↑			; smashed too?
	 FATAL Host table after JOBFF
	CAME JOBFF↑
	 JRST [	WARN Host table locked
		POPJ 17,]
	SETZM HSTADR			; remove table pointer/interlock
	MOVEM 1,JOBFF↑			; return host table to free storage
	CORE 1,				; and garbage collect
	 FATAL CORE UUO failure
	POPJ 17,
;⊗ HSTNUM HSTNUS HSTNU1 HSTNU2

; HSTNUM -- Return descriptor block for a host
; Call:	MOVEI <host number>
;	PUSHJ 17,HSTNUM
;	<error return--no such host>
;	<return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
;	 address block in 3>
; Smashes 0, 1, 2, 3, and 4.

↑HSTNUM:SKIPN 1,HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,HSTFIL
	 FATAL Bad host table
	GETNET 4,0			; get network number
	MOVE 1,NETPTR(1)
	PUSHJ 17,HSTNUS			; lookup network number
	  POPJ 17,
	MOVE 1,NTRTAB(1)		; get address table for network
	MOVEM 4				; thing to search for
	PUSHJ 17,HSTNUS			; lookup address
	  POPJ 17,
	MOVE 3,1			; Save address table entry
	HLRZ 1,ADLSIT(1)		; Get site table entry
	ADD 1,HSTADR
	AOS (17)			; successful return
	JRST GETHDB			; return useful stuff in ACs

HSTNUS:	ADD 1,HSTADR			; relocate table
	MOVE 2,(1)			; get # of entries
	MOVE 3,1(1)			; and entry size
	ADDI 1,2			; point at first entry
HSTNU1:	CAMN 4,(1)			; found it?
	  JRST CPOPJ1			;   yes, skip return for success
	ADD 1,3				; point at next entry
	SOJG 2,HSTNU1			; keep on searching
repeat 0,<	;JJW 8/86 We now get IP addresses from Argus host table
;Special treatment for failed search on SU-NET hosts, to look up name using
;SU-ETHERNET (PUP) host number.  Note that this code depends on knowing the
;format of SU-Net host numbers (currently class A).  Hopefully this code can
;disappear someday, when our host table contains the IP numbers of these hosts.
	TDZ 4,[77,,-1]		;Get class-A host number
	CAME 4,[NW%SI]		;SU-Net?
	 JRST HSTNU2		;No
	PUSH 17,0		;Save original (IP) host number
	LDB 4,[201000,,0]	;Get subnet from bits 12-19
	DPB 4,[102000,,0]	;Store in bits 20-27, clear 12-19
	TLC 0,(NW%SI≠NW%SU)	;Change net number
	PUSHJ 17,HSTNUM		;Call ourself!
	 JRST [	POP 17,0	;Still failed.  Oh well.
		JRST HSTNU2]	;Make ASCIZ string for IP host number
	POP 17,0		;Get back IP host number
	POP 17,(17)		;Avoid going to GETHDB again
	JRST CPOPJ1		;Skip return to caller of HSTNUM

HSTNU2:
>;repeat 0
;Host not in our host table.  Generate ASCIZ string for host number
;instead of name.
	MOVEI 1,DHSTST		;Address for ASCIZ host number string
	PUSHJ 17,HNUMST		;Preserves 1
	SETZM HDBPTR		;no HDB
	SETZB 2,3
	POPJ 17,		;failure return
;⊗ HSTNAM SEARCH SRCLT SRCGT SRCDUN SRCDU1 SRCDU2 COMPAR PMATCH PMATC1 PMATC2 CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1 HSTUNA

;HSTNAM -- Return descriptor block for a host name
;Call:	MOVEI 0,<pointer to host name string>
;	PUSHJ 17,HSTNAM
;	  <error return--no such host>
;	  <error return--ambiguous name>
;	<return--absolute NUMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2
;	 next address block in 3>
;Smashes 0 → 11 (!!!).

;Rewritten Apr 86 by JJW.  Original code did a linear search through the
;names table and required all-upper-case names in the table.  New code
;does binary search since HOSTS3 names table is sorted, and does
;case-insensitive comparisons.

↑HSTNAM:SKIPN 1,HSTADR		;Fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,HSTFIL
	 FATAL Bad host table

;Set up various AC's for search.

	HRLI 0,440700		;Make byte pointer
	MOVE 4,0		;Set up for HSTNAB
	ILDB 2,4		;Get first char
	CAIN 2,"["
	 JRST HSTNAB		;Parse bracketed host number
	MOVE 1,NAMPTR(1)
	ADD 1,HSTADR		;Address of NAMES table
	HRLI 1,2(1)		;<first entry>,,<addr of table>
	ADD 1,(1)		;<first entry>,,<last entry>+1
	PUSH 17,1		;Save for use in SRCDUN
	SUBI 1,1		;<first entry>,,<last entry>

;Host name search.  AC's during search hold the following:
;  0: byte pointer to source string
;  1: <beginning>,,<ending> of current range in NAMES table
;  2: current entry in NAMES table being tested
SEARCH:	HLRZ 2,1		;Beginning of current range
	CAILE 2,(1)		;Beyond end?
	 JRST SRCDUN		;Yes, search done
	ADDI 2,(1)		;Add beginning and ending
	LSH 2,-1		;Compute midpoint
	HRRZ 7,NMRNAM(2)
	ADD 7,HSTADR		;Pointer for this entry
	HRLI 7,440700
	MOVE 6,0		;Copy of source pointer
	PUSHJ 17,COMPAR
	 JRST SRCGT
	 JRST SRCLT
	 JRST [	HLRZ 1,NMLSIT(2) ;Exact match!
		ADD 1,HSTADR
		ADJSP 17,-1	;Fix up stack ptr
		JRST GOTNAM]
	;Fall into SRCLT if partial match
;Here if source string less than table entry.
SRCLT:	HRRI 1,-1(2)		;Set end of range to before entry
	JRST SEARCH

;Here if source string greater than table entry.
SRCGT:	HRLI 1,1(2)		;Set beginning of range to after entry
	JRST SEARCH

;Here when binary search done.  Unless we got an exact match, we need
;to compare the source against all possible names that might be a partial
;match, to check for ambiguities.
SRCDUN:	POP 17,1		;Get back <first entry>,,<last entry+1>
	SUBM 2,1		;- <Max # of entries to check>
	HRL 2,1			;Make AOBJN ptr
	SETZ 3,			;No match yet
SRCDU1:	HRRZ 7,NMRNAM(2)
	ADD 7,HSTADR		;Pointer for this entry
	HRLI 7,440700
	MOVE 6,0		;Copy of source pointer
	PUSHJ 17,COMPAR
	 JRST SRCDU2
	 JRST CHKAMB		;Done, now check for ambiguity
	 FATAL Impossible exact match happened in host name lookup
	PUSHJ 17,PMATCH		;Handle partial match
SRCDU2:	AOBJN 2,SRCDU1
	JRST CHKAMB		;Hit end of table

;Subroutine to compare two names given by byte pointers in 6 and 7.
;Returns: +1 if (6) .gt. (7)
;	  +2 if (6) .lt. (7) and is not a partial match
;	  +3 if (6) matches (7) exactly
;	  +4 if (6) matches a substring of (7)
;ACs 10 and 11 hold the most recent characters read from each string.
COMPAR:	ILDB 10,6		;Get next byte from each string
	ILDB 11,7
	JUMPE 10,[JUMPE 11,CPOPJ2	;Exact match
		  AOS (17)		;Partial match
		  JRST CPOPJ2]
	JUMPE 11,CPOPJ		;Partial match the other way
	CAIL 10,"a"		;Use upper case for comparisons
	 SUBI 10,40
	CAIL 11,"a"
	 SUBI 11,40
	CAIGE 10,(11)
	 AOSA (17)
	CAILE 10,(11)
	 POPJ 17,
	JRST COMPAR		;Characters match, keep comparing

;Here to handle a partial match.  If there was a previous partial match,
;AC 3 contains <flags>,,<HDB ptr>.  Bits in <flags> are
;  10   if character after partial match is a "."
;   4   if, in addition, "." is followed by parent of our local domain
;   2   if host is a server
;   1   if ambiguous
;These are set up so that higher-valued combinations are "better" matches
;than lower-valued ones.  When a different host with the same bits is
;matched, the ambiguous bit is set.  Further matches at the same level
;will be ignored since they now appear worse, but a better match will
;clear the ambiguity bit.
PMATCH:	HLRZ 5,NMLSIT(2)	;Set up pointer to HDB
	ADD 5,HSTADR
	HLLZ 6,STLFLG(5)	;HOSTS3 flags in LH
	TLNE 6,STFSRV		;Server?
	 TRO 6,2		;Yes, set our flag in RH
	CAIE 11,"."		;Subdomain name match?
	 JRST PMATC2		;No
	TRO 6,10		;Yes
	PUSH 17,6
	MOVE 6,[440700,,LOCDOM]	;Our local domain's parent
	PUSHJ 17,COMPAR		;Compare with remainder of (7)
	 JRST PMATC1
	 JRST PMATC1
	 JRST [POP 17,6 ↔ TRO 6,4 ↔ JRST PMATC2] ;Exact match, set flag
PMATC1:	POP 17,6
PMATC2:	HLRZ 4,3		;Get flags from previous match
	SKIPE 3			;First partial match?
	CAIGE 4,(6)		;Or this one better?
	 JRST [ MOVEI 3,(5)	;Yes, save new host entry
		HRLI 3,(6)	;And flags
		POPJ 17,]
	CAILE 4,(6)		;This one worse?
	 POPJ 17,		;Yes, keep looking
	CAIE 5,(3)		;Bits are equal.  Same host?
	 TLO 3,1		;No.  Set ambiguity flag
	POPJ 17,

;Search done, set up HDB ala HSTNUM and return

CHKAMB:	JUMPE 3,CPOPJ		;Jump if no match at all
	HRRZ 1,3		;HDB of best match
	TLNN 3,1		;Ambiguous name?
GOTNAM:	 AOS (17)		;No, set up double skip return
AMBNAM:	AOS (17)		;Ordinary skip return

;Routine to get a block of host specifications with pointer in 1.

;;Commented out for now -- won't work with shared upper segment
;;	PUSHJ 17,SRTADR		;Sort address list
	HRRZ 3,STRADR(1)	;Get address block
	ADD 3,HSTADR
	MOVE 0,ADDADR(3)	;First address
GETHDB:	MOVE 2,STRMCH(1)	;NUMBTS,,NUMMCH
	HLL 2,STLFLG(1)
	TRNE 2,-1
	 ADD 2,HSTADR
	MOVEM 1,HDBPTR		;Save pointer to HDB
	SUB 1,HSTADR
	EXCH 1,HDBPTR
	HLL 1,STLSYS(1)
	HLR 1,STLNAM(1)		;NUMSYS,,NUMNAM
	ADD 1,HSTADR		;Relocate right half
	TLNN 1,-1
	 POPJ 17,		;Case of unknown system name
	MOVS 1,1
	ADD 1,HSTADR		;Relocate left half
	MOVS 1,1
	POPJ 17,		;And return

;Parse a bracketed specification of the form [a.b.c.d] (IP) or [a#b] (PUP).

HSTNAB:	SETZ 0,			;0 will hold result
	MOVEI 1,4		;Number of bytes (assume IP)
HSTNB1:	SETZ 2,			;Value of current byte
HSTNB2:	ILDB 3,4		;Get next char
	CAIL 3,"0"
	CAILE 3,"9"
	 JRST HSTNB3		;Non-numeric
	IMULI 2,=10
	ADDI 2,-"0"(3)
	JRST HSTNB2

HSTNB3:	CAILE 2,=255		;Legal byte?
	 POPJ 17,		;No, lose
	LSH 0,=8
	ADDI 0,(2)		;Add in current byte
	SOJLE 1,HSTNB4		;Count bytes
	CAIN 3,"."		;IP delimiter?
	 JRST HSTNB1		;Yes, scan next byte
	CAIE 3,"#"		;PUP delimiter?
	 POPJ 17,		;No, bad format
	ADD 0,[NW%SU⊗-=8]	;Yes, set Unternet network number
	MOVEI 1,1		;Scan just 1 more byte
	JRST HSTNB1

HSTNB4:	JUMPE 3,HSTNB5		;Allow omission of final delimiter
	CAIE 3,"]"		;Last delimiter is different
	 POPJ 17,
	ILDB 3,4		;Check for garbage at end
	JUMPN 3,CPOPJ
HSTNB5:	PUSH 17,0
	PUSHJ 17,HSTNUM		;Look it up if we can
	 JRST [	DMOVE 1,HSTUN1	;Not in table - use dummy data
		MOVEI 3,HSTUNA
		JRST .+1]
	POP 17,0
	JRST CPOPJ2

HSTUNK:	ASCIZ/unknown/
HSTUN1:	HSTUNK,,HSTUNK
	0,,HSTUNK

HSTUNA:	0			;Dummy address block for unknown host
	0			;(so that HSTNXA doesn't lose)
	0
;⊗ SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 SRTADF

repeat 0,<			;Not currently used (see HSTNAM)

;Sort address list for the site in AC 1, so that programs can try the most
;preferred addresses first.  It is better to do this here than to pre-sort
;the host table, because it allows different WAITS sites to share the same
;table, and might still be usable once we switch from tables to domain
;servers.

;We use an O(n↑2) sorting algorithm (bubblesort), and recompute the
;priorities of addresses on each pass, because we never expect to have
;more than a handful of addresses for a single host.

SRTADR:	SETZM SRTADF		;Clear flag - no exchanges yet
	MOVEI 2,STRADR-ADRCDR(1) ;Make pseudo-address block pointer
	HRRZ 3,ADRCDR(2)
	ADD 3,HSTADR		;Get first real address block
	MOVE 0,ADDADR(3)
	PUSHJ 17,PRIORI		;Priority of first address
SRTAD1:	MOVE 5,6		;Save for comparison
	HRRZ 4,ADRCDR(3)
	JUMPE 4,SRTAD3		;End of list - see if done
	ADD 4,HSTADR		;Next address block
	MOVE 0,ADDADR(4)
	PUSHJ 17,PRIORI		;Priority of next address
	CAML 5,6		;Need to swap?
	JRST SRTAD2
	SETOM SRTADF		;Yes, flag a change
	HRRZ 0,ADRCDR(4)	;Shuffle pointers
	HRRM 0,ADRCDR(3)
	SUB 3,HSTADR
	HRRM 3,ADRCDR(4)
	ADD 3,HSTADR
	SUB 4,HSTADR
	HRRM 4,ADRCDR(2)
	ADD 4,HSTADR
	EXCH 5,6		;Swap priorities correspondingly
SRTAD2:	MOVE 2,3		;Step forward through list
	MOVE 3,4
	JRST SRTAD1

SRTAD3:	SKIPE SRTADF		;Any changes this pass?
	JRST SRTADR		;Yes, do another pass
	POPJ 17,		;No, all done

PRIORI:	MOVSI 7,-NUMPRI
PRIOR1:	XOR 0,PRIADR(7)		;Compare with an address
	TDNN 0,PRIMSK(7)	;See if any masked bits are different
	JRST [	MOVE 6,PRINUM(7);No difference, assign priority
		POPJ 17,]
	XOR 0,PRIADR(7)		;Restore address
	AOBJN 7,PRIOR1
	SETZ 6,
	POPJ 17,

SRTADF:	BLOCK 1			;Flag for SRTADR
>;repeat 0
;⊗ HSTNXA

; HSTNXA -- Return descriptor block for a host
; Call:	MOVE 3,<number return by HSTNAM as next address block>
;	PUSHJ 17,HSTNXA
;	<error return--no other addresses>
;	<return--absolute NAMNUM in 0, next address block in 3>
; Does not disturb 1,2

↑HSTNXA:
	SKIPN HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 0,@HSTADR
	CAME 0,HSTFIL
	 FATAL Bad host table
	HRRZ 3,ADRCDR(3)		; get other address(es), if any
	JUMPE 3,[ SETZ 0,		; if no addresses left, fail
		  POPJ 17,]
	ADD 3,HSTADR
	MOVE 0,ADDADR(3)		; get this address
	AOS (17)
	POPJ 17,			; failure
;⊗ SVCCHK SVCCH1 SVCCH2 SVCCH3

;SVCCHK -- Check address block for a specific service.
;Call:	MOVE 3,<number returned by HSTNUM, HSTNAM, or HSTNXA as address block>
;	MOVEI 1,[ASCIZ/string to match/]
;	PUSHJ 17,SVCCHK
;	<return if string not in service list>
;	<return if string in service list>
;Preserves 0-3.  Smashes 4-10.

↑SVCCHK:
	SKIPN HSTADR		;Fail if host table not mapped
	 FATAL Host table not mapped
	HRRZ 4,ADRSVC(3)	;Address of services list
SVCCH1:	JUMPE 4,CPOPJ		;No services, or end of list
	ADD 4,HSTADR
	HRRZ 5,SVRNAM(4)	;Get name of service
	ADD 5,HSTADR
	HRLI 5,440700		;Set up byte pointers
	MOVSI 6,440701
SVCCH2:	ILDB 7,5
	ILDB 10,6
	JUMPE 7,[JUMPE 10,CPOPJ1 ;Succeed if simultaneous end
		JRST SVCCH3]	;Try next if one ends early
	JUMPE 10,SVCCH3
	CAMN 7,10
	 JRST SVCCH2		;Match, keep checking
SVCCH3:	HRRZ 4,SVRCDR(4)	;Get next service node
	JRST SVCCH1
;⊗ SETANM SETAN1 SETAN2

; SETANM -- Generate alias name from host name
; Call:	<call to HSTNUM or HSTNAM to set up HDB pointer>
;	PUSHJ 17,SETANM
; Smashes 0 → 3.

IFN HSTSIX,<

↑SETANM:HRLI 1,440700		;Byte ptr to official name or dotted address
	MOVSI 2,440600		;Byte ptr to output word in 0
	SETZ 0,
	SKIPN HDBPTR		;Do we have a real HDB?
	HRLI 1,350700		;No, dotted address.  Skip over bracket
	MOVE 3,(1)		;Get first word of name
	TRZ 3,377		;Check 4 chars
	CAME 3,[ASCII/TIP-/]	;Is it "TIP-something"?
	CAMN 3,[ASCII/Tip-/]	;Or "Tip-something"?
	HRLI 1,100700		;Yes, skip over "TIP-"
SETAN1:	ILDB 3,1		;Get a character
	JUMPE 3,SETAN2		;Jump if all done
	CAIN 3,"."
	SKIPN HDBPTR		;Dots are OK in dotted addresses
	JRST .+2
	JRST SETAN2		;End name at dot (don't show domain)
	CAIN 3,"-"
	JRST SETAN1		;Ignore hyphens
	CAIL 3,"a"		;Map lowercase to uppercase
	SUBI 3,40
	SUBI 3,40		;Convert ascii to sixbit
	IDPB 3,2
	TLNE 2,770000		;Stop after getting one full word
	JRST SETAN1
SETAN2:	TRNN 0,-1		;If right half of "alias" is zero,
	IORI '.'		;  then add a dot to make it "longer"
	SETO 1,
	GETLIN 1
	AOSN 1			;Don't screw DSK PPN if not a phantom
	DSKPPN
	POPJ 17,

>; End IFN HSTSIX

repeat 0,<		;Old version

; SETANM -- Generate alias name from host name
; Call:	<call to HSTNUM or HSTNAM to set up HDB pointer>
;	PUSHJ 17,SETANM
; Smashes 0 → 7 (!!!).

IFN HSTSIX,<

↑SETANM:HRRZ 6,1			; check official name first (or dotted nbr)
	SKIPN 1,HDBPTR
	 JRST SETA00			; no host was found, use dotted host nbr
	MOVE 2,HSTADR
	HRRZ 2,NAMPTR(2)		; get address of NAMES table.
	ADD 2,HSTADR
	SKIPA 3,(2)			; number of entries in the table.
SETA00:	MOVEI 3,0			; no match earlier, don't look again
	SETOB 4,5			; 4 ← longest name ≤ 6 chars, 5 ← length
	AOJA 2,SETAN0			; skip word 1 of table (entry length)

SETAN1:	ADDI 2,1			; next untried NAMES table entry.
	HLRZ 6,(2)
	CAME 6,1			; name the host we are serving?
	 JRST SETAN4
	HRRZ 6,(2)			; how long is this name?
	ADD 6,HSTADR
SETAN0:	HRLI 6,440700
	PUSH 17,6
	PUSH 17,6
	SETZ 7,
SETAN2:	ILDB 6,(17)
	SKIPE 6
	 AOJA 7,SETAN2

	POP 17,6			; flush garbage
	POP 17,6			; restore pointer to name
	CAIG 7,6			; fit in 6 characters?
	 CAMG 7,4			; and longer than the previous one?
	  JRST SETAN4
	HRRZ 5,6			; save name's address
	MOVE 4,7			; and the length
SETAN4:	SOJG 3,SETAN1			; look through the rest of the table.
	JUMPGE 4,SETAN5			; jump if found a reasonable name
	MOVEI 4,"-"			; also, will remove hyphens from it
	SKIPN 5,HDBPTR
	JRST SETAN9			; no host name at all, using dotted nbr
	ADD 5,HSTADR			; no short name, truncate official one
	HLRZ 5,STLNAM(5)
	ADD 5,HSTADR			; pointer to name
SETAN5:	SKIPA 2,5
SETAN9:	MOVEI 2,(6)			; ptr to dotted host number string
	HRLI 2,440700			; get BP to name string.
	MOVE 1,(2)			; Get beginning of name
	TRZ 1,377			; Check 4 chars
	CAME 1,[ASCII/TIP-/]		; Is it "TIP-something"?
	CAMN 1,[ASCII/Tip-/]		; Or "Tip-something"?
	HRLI 2,100700			; Yes, skip over "TIP-"
	TRZ 1,77777			; Check 3 chars
	CAMN 1,[ASCII/SU-/]		; Is it "SU-something"?
	HRLI 2,170700			; Yes, skip over "SU-"
	MOVSI 1,440600
	SETZ 0,				; convert name to SIXBIT word in 0
SETAN6:	ILDB 3,2
	JUMPE 3,SETAN7			; stop if name string runs out
	CAMN 3,4			; remove hyphens if requested to
	 JRST SETAN6			; note 4 has number from 1 to 6 or "-"
	CAIL 3,"a"
	 SUBI 3,40		;Map to upper case
	SUBI 3," "-' '
	IDPB 3,1
	TLNE 1,770000			; stop after getting one full word.
	 JRST SETAN6
SETAN7:	LDB 3,1				; if last character is a hyphen, flush it.
	CAIN 3,'-'
	 SETZ 3,
	DPB 3,1
SETAN8:	TRNN 0,-1			; if right half of "alias" is zero,
	 IORI '.'			;   then add a dot to make it "longer"
	SETO 1,
	GETLIN 1
	AOSN 1				; don't screw DSK PPN if not a phantom
	 DSKPPN
	POPJ 17,

>; End IFN HSTSIX
>;repeat 0
;⊗ HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1

;HSTNBR -- Convert numeric text string to host number
;Call:	MOVE 0,<addr of text, or byte ptr>
;	PUSHJ 17,HSTNBR
;	 <error--illegal number>
;	<return, host number in 1, updated byte ptr in 0>
;Clobbers 2-4.

;Skips over optional leading "[", parses a.b.c.d in decimal (IP address)
;or a#b in octal (PUP address), and skips over optional trailing "]".

↑HSTNBR:TLNN 0,-1
	HRLI 0,440700
	MOVE 1,0		;Copy byte ptr
	ILDB 2,1		;Peek at first char
	CAIL 2,"0"
	CAILE 2,"9"
	JRST [	CAIE 2,"["	;Delimiter?
		POPJ 17,	;No, then illegal
		MOVE 0,1	;Skip over delimiter
		JRST .+1]
	PUSHJ 17,TXTNUM
	CAIN 2,"."
	JRST IPNBR
	CAIN 2,"#"
	JRST PUPNBR
	POPJ 17,

IPNBR:	MOVE 1,3
	PUSHJ 17,TXTNUM
	CAIE 2,"."
	POPJ 17,
	LSH 1,=8
	ADD 1,3
	PUSHJ 17,TXTNUM
	CAIE 2,"."
	POPJ 17,
	LSH 1,=8
	ADD 1,3
	PUSHJ 17,TXTNUM
	LSH 1,=8
	ADD 1,3
HSTNBE:	CAIN 2,"]"
	ILDB 2,0
	JRST CPOPJ1

PUPNBR:	MOVE 1,4		;Use octal for PUP
	PUSHJ 17,TXTNUM
	LSH 1,=8
	ADD 1,4
	ADD 1,[NW%SU]		;Set "Unternet" network
	JRST HSTNBE

;Subroutine to parse digits into a number, both decimal and octal.
TXTNUM:	SETZB 3,4		;Clear both numbers
TXTNU1:	ILDB 2,0		;Get next char
	CAIL 2,"0"
	CAILE 2,"9"
	POPJ 17,		;Not a digit
	IMULI 3,=10
	ADDI 3,-"0"(2)		;Decimal
	IMULI 4,10
	ADDI 4,-"0"(2)		;Octal
	JRST TXTNU1
;⊗ HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX

;HNUMST -- Generate text string from host number
;Call:	MOVE 0,<host number>
;	MOVE 1,<address to store text string, or IDPB pointer>
;	PUSHJ 17,HNUMST
;Assumes enough space for string and final null byte.  (Currently at most =16
;characters.)  Smashes 2, 3, and 4 (preserves 0 and 1).

↑HNUMST:PUSH 17,1		;Save address
	TLNN 1,-1		;Byte ptr in 1?
	HRLI 1,440700		;No, make one
	JUMPE 0,HNUMS4		;Return blank string for address 0
	MOVEI 2,"["		;Start with a bracket
	IDPB 2,1
	GETNET 4,0		;Get network number
	CAMN 4,[NW%SU]		;Is it the Ethernet?
	JRST HNUMS5		;Yes, generate subnet#host
	PUSH 17,[401000,,0]	;Byte ptr to ILDB for host number
	JRST HNUMS2

HNUMS1:	MOVEI 2,"."		;insert dot between parts of host number
	IDPB 2,1		;stuff into host "name" string (actually host nbr)
HNUMS2:	ILDB 2,(17)		;get next byte of host nbr
	PUSHJ 17,HNUMSD		;convert to decimal string
	MOVE 2,(17)
	TLNE 2,770000		;end of word in byte ptr?
	JRST HNUMS1		;no, output more parts of host nbr
	ADJSP 17,-1		;flush byte ptr from stack
HNUMS3:	MOVEI 2,"]"		;end with a bracket
	IDPB 2,1
HNUMS4:	MOVEI 2,0		;Terminate host string with a null
	IDPB 2,1
	POP 17,1		;Restore original addr
	POPJ 17,

HNUMS5:	LDB 2,[101000,,0]	;Get subnet number
	PUSHJ 17,HNUMSO		;Convert to octal string
	MOVEI 2,"#"		;Insert delimiter
	IDPB 2,1
	LDB 2,[001000,,0]	;Get host number
	PUSHJ 17,HNUMSO		;Put in host number string
	JRST HNUMS3		;Finish up

HNUMSD:	SKIPA 4,[=10]		;Usual decimal output routine
HNUMSO:	MOVEI 4,10		;Octal output
HNUMSX:	IDIV 2,4
	HRLM 3,(17)
	JUMPE 2,.+2
	PUSHJ 17,HNUMSX
	HLRZ 3,(17)
	ADDI 3,"0"
	IDPB 3,1		;Stick digit into host string
	POPJ 17,
;⊗ OURNAM OURNA1

;OURNAM -- Get our host name
;Call:	PUSHJ 17,OURNAM
;	<error return--can't get our name>
;	<return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
;	 address block in 3>
; Smashes 0, 1, 2, 3, and 4.

↑OURNAM:MOVEI 1,355		;Lowcore ptr to table of host numbers
	PEEK 1,			;Get AOBJN ptr
	JUMPGE 1,CPOPJ
	;Loop thru system table until we find a name
OURNA1:	HRRZ 0,1		;System address of next name in table
	PEEK 0,			;Get host number
	PUSH 17,1		;Save AOBJN ptr
	PUSHJ 17,HSTNUM
	 JRST [	POP 17,1	;Failed
		AOBJN 1,OURNA1	;Try next number
		POPJ 17,]	;Lose if we tried them all
	POP 17,(17)		;Flush AOBJN ptr
	JRST CPOPJ1
;⊗ ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM

;ATTHST -- Attach to upper segment that has the host table in it,
;	   or create one if necessary.
;Call:	PUSHJ 17,ATTHST
;	<return>
;Preserves ALL ACs.

↑ATTHST:PUSH 17,3		;preserve all ACs
	MOVE 3,HSGNAM		;get upper segment name
ATTHS0:	ATTSEG 3,		;try to attach to segment
	 JRST ATTHS2		;failed, see why
	MOVEI 3,400000
	MOVEM 3,HSTADR		;set host table address
	POP 17,3
	POPJ 17,

ATTHS2:	HLLM 3,-1(17)		;save error code's left half
	ANDI 3,-1		;just error code
	CAIL 3,MXATTE		;reasonable error?
	MOVEI 3,MXATTE		;no
	JRST @ATTERR(3)		;dispatch on error

;Create upper segment and read host table into it.
ATTCRE:	PUSH 17,0
	PUSH 17,1
	PUSH 17,2
	PUSHJ 17,MAPHS2		;read host table into new upper segment, AC 3 already saved
	MOVEI 1,1
	SETUWP 1,		;write protect upper segment
	 JFCL			;error should never happen
	MOVE 1,HSGNAM
	SETNM2 1,		;rename it so others can share it
	 JFCL			;error should never happen
	POP 17,2
	POP 17,1
	POP 17,0
	POP 17,3
	POPJ 17,

;Attach one of multiple uppers with same name
ATTMUL:	HLRZ 3,-1(17)		;job number of one job with given name
	JRST ATTHS0		;try again

ATTUPP:	FATAL ATTHST called with existing upper segment in use.

ATTLOW:	FATAL ATTHST called with lower segment bigger than 128K.

ATTERR:	ATTCRE			;protection violation, create new segment
	ATTMUL			;multiple upper segments, attach one
	ATTCRE			;no such upper segment job number
	ATTCRE			;no such upper segment job name
	ATTUPP			;already have an upper
	ATTLOW			;lower segment is too big
MXATTE←←.-ATTERR

↑HSGNAM:SIXBIT/HOSTS!/		;name of upper segment
;⊗ DETHST

;DETHST -- Detach upper segment (that has host table in it, presumably).
;Call:	PUSHJ 17,DETHST
;	<return>
;Preserves ALL ACs.

↑DETHST:SETZM HSTADR		;no more host table in upper
;;	DETSEG 1,		;detach upper but don't let it go away when we're RESET
	PUSH 17,0
	MOVEI 0,0
	CORE2 0,		;Release upper segment
	 JFCL			;Impossible error
	POP 17,0
	POPJ 17,

>; End IFN HSTTAB
;⊗ B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1

;TTYSTR -- Get TTY location string for SU-Ethernet host
;Call:	MOVE 1,[BYTE(2)0(8)net,host(18)line]
;	PUSHJ 17,TTYSTR
;	 <error return - not in table>
;	<success, byte ptr to TTY location string in 1>
;Smashes 0-4.  Temporarily uses one page of core above JOBFF (allocating
;if necessary, but not deallocating), and I/O channel 0.  FINGER and maybe
;other programs allocate their own core and fake JOBFF before calling here.

IFN TTYSTS,<

COMMENT \

[Copied from <FINGER.SOURCES>TINIDF.MAC at Score.  Watch out for unannounced
 changes in the format of the TTYINI.BIN files.  Note: we don't currently use
 the "default" information for hosts.

 If changing this code, recompile: CHTSER (PUP001), ARPSER (PUP131),
 NETFNG (FINGER).]

TTYINI.NET-BIN File format:

Page 0:
	Word 0:  TTYINI version number of file (VERSION).
	Word 1:  Size of blocks in TTYINI entries (BLKSIZ).
	Words 2-511:  Net pointers, indexed by net number.  Each pointer
		      points to a page (called a NET page) in the file.
		      A word of all ones is a null pointer (symbolic address
		      NETADR).

NET pages (mapped at NETPAG):
	Words 0-511:  Host pointers, indexed by host number.  These pointers
		      point to the TTYINI data for each host, and are page 
		      numbers (HOST pages).  A word of all ones is a null
		      pointer (symbolic address NETPGA).  If not -1 but the
		      left half is nonzero then this is a pointer to another
		      host.

HOST pages (mapped at HSTPAG):
	Word 0:  Number of TTYINI blocks for this host (number of lines on 
	         host, symbolic name NUMTTY).
	Words 1-end:  TTYINI blocks (TTYBLK).

TTYINI blocks:

Each line has an associated terminal block of the following format:

TYPE
    ttynumber = RECORD (* TTYNumber *)
		    NetNumber,
		    HostNumber:  9bit integer unsigned;
		    LineNumber:  short integer unsigned; 
		END (* TTYNumber is a word of net, host,, line number *)
    directiontype = (toleft, toright, acrossglass, facing, 
		     diagonally-opposite, behind, acrosspartition, unused);
		    (* For fing/neighbor *)
    locationtype =  (ceras105, ceraslobby, cerasother, terman104,
		     termanother, termanlobby, dialin, gandalf, ethernvt,
		     arpanvt, decnvt, internetnvt, pty, erl206, meyer,
		     larkin);	    (* Typical locations *)
    flagtype =      (consultant, assignable, overhead, formfeed, lowercase,
		     tabs, pagepause, commandpause, raise, flag);
    tty = RECORD (* Tty *)
	      ttytype,		    (* Terminal type number, or -1 if ? *)
	      defttytype,	    (* Default type number or -1 if ? *)
	      length,		    (* Terminal length or -1 if ? *)
	      width:     integer;   (* Terminal width or -1 if ? *)
				    (* Total 4 wds *)
	      address:   PACKED ARRAY[1..30] OF char;
				    (* String for finger.  6 wds *)
	      location:  locationtype;  (* Where it is for finger.  1 wd *)
	      neighbors: PACKED ARRAY [directiontype] OF ttynumber;
				    (* For FINGER/NEIGHBORS.   8 wds *)
	      dplxmode:  (fullduplex, noduplex, halfduplex, linehduplex);
				    (* 1 wd *)
	      bits:     PACKED SET OF flagtype;
				    (* Bits.  2 wds currently *)
	      print-node: PACKED ARRAY [1..10] OF char;
				    (* 6 letter DECnet node name.  2 wds *)
	  END  (* Tty *)	(* 24 words, currently *)
\

;Constants we need
B%ADDRESS==4			;Index of address string
B%EXISTS==33			;Index of word which is 0 if entry exists, else -1
B%DEFL==34			;Length of default TTYINI block

;Page 0 of TTYINI.NET-BIN
VERSIO==0			;Version number of TTYINI.NET-BIN
BLKSIZ==1			;Size of each TTY's block
NETADR==2			;Table of network page pointers

;Host pages
NUMTTY==0			;Number of lines on host
DEFBLK==1			;Default TTYINI block for this host
TTYBLK==1+B%DEFL		;Start of TTYINI data for host


↑TTYSTR:
	PUSH 17,1		;Save argument
	INIT 0,17
	 ('DSK')
	 0
	 FATAL DSK INIT failure
	DMOVE 0,TTYFIL
	MOVE 3,TTYPPN
	LOOKUP
	 JRST TTYST9		;Return quietly if file not there
	MOVE 4,JOBFF↑		;Start of one-page data area
	;AC 4 will hold this value from now on.
	MOVEI 0,777(4)		;Highest address in page
	CAMG 0,JOBREL↑		;Do we have enough core?
	JRST TTYST1		;Yes
	CORE 0,			;No, get more
	 FATAL CORE UUO failure
TTYST1:	MOVEI 1,0		;Get page 0
	PUSHJ 17,TTYREA
	MOVE 0,BLKSIZ(4)	;Copy blocksize while we have it here
	MOVEM 0,TTBSIZ
	LDB 1,[321017,,0]	;Network number
	ADDI 1,NETADR(4)	;Index into list of pages
	SKIPN 1,(1)		;File page for network
	 JRST TTYST9		;Unknown network
	PUSHJ 17,TTYREA		;Read network page
	LDB 1,[221017,,0]	;Host number
	ADDI 1,(4)		;Index into list of pages
	SKIPG 1,(1)		;File page for host
	 JRST TTYST9		;Unknown host
	TLNE 1,-1		;Pointer to another host?
	 JRST TTYST9		;Yes, deal with this later
	MOVE 3,1		;Remember page number
	PUSHJ 17,TTYREA		;Read first page of host info
	HRRZ 1,(17)		;Line number
	CAMLE 1,NUMTTY(4)	;Compare with max for this host
	 MOVEI 1,0		;Out of range: use name for line 0
	IMUL 1,TTBSIZ		;Offset of TTY info block
	ADDI 1,TTYBLK		;Skip header preceding first block
	MOVEI 2,-1(1)
	ADD 2,TTBSIZ		;Offset of last word in block
	CAIG 2,777		;Is block within page 0?
	 JRST CPYNAM		;Yes, we have it
	PUSH 17,1		;Remember start of block
	XOR 2,1
	TRNE 2,777000		;Are start and end within same page?
	 JRST [	LSH 1,-=8	;No, get 1/2 pages before and after start
		LSH 1,1
		LSH 3,2		;File addr of first page of host info
		ADD 1,3
		PUSHJ 17,TTYRE1
		POP 17,1
		ANDI 1,377	;New offset
		JRST CPYNAM]
	LSH 1,-=9		;Get page containing entire block
	ADD 1,3
	PUSHJ 17,TTYREA
	POP 17,1
	ANDI 1,777
CPYNAM:	ADDI 1,(4)		;Start of block for this line
	SKIPE B%EXISTS(1)	;Skip if entry exists
	 JRST TTYST9		;No entry, return failure
CPYNA1:	MOVSI 2,B%ADDRESS(1)	;Start of terminal location string
	HRRI 2,TTYNAM		;Place to copy it to
	BLT 2,TTYNAM+5		;Copy 6 words
	AOS -1(17)		;Set skip return
	MOVE 1,[440700,,TTYNAM]	;Set return value
TTYST9:	RELEAS			;Give up I/O channel
	ADJSP 17,-1		;Flush argument
	POPJ 17,

;Subroutine to read a page of the binary file.
TTYREA:	LSH 1,2			;Convert pages to disk records
TTYRE1:	USETI 0,1(1)		;First record is 1
	MOVEI 0,-1(4)		;Construct IOWD
	HRLI 0,-1000
	SETZ 1,			;End IOWD list
	INPUT 0,0
	POPJ 17,

>;End IFN TTYSTS
;Domain resource record format ;⊗

IFN DOMRTS,<			;First of several pages

;Resource records read from or written to the system cache are stored
;in the following format (36-bit words):
;
; +-----------------------------------------------------------------------+
; |			TYPE						  |
; +-----------------------------------------------------------------------+
; |			CLASS						  |
; +-----------------------------------------------------------------------+
; |			TIME TO LIVE (in seconds)			  |
; +-----------------------------------------------------------------------+
; |			DATA LENGTH (or immediate data)			  |
; +---------------+---------------+---------------+---------------+-------+
; |								  |	  |
; |	    DOMAIN NAME, followed by DATA (in 8-bit bytes)	  |	  |
; |								  |	  |
; +---------------+---------------+---------------+---------------+-------+
;
;The domain name is a sequence of components, each having a length byte
;followed by that many bytes of characters.  A zero length byte terminates
;the string.  It is followed by data, whose format may depend on the type
;and class of the record.  If the data is known to fit in one word, it is
;stored in place of the data length.  (For Internet addresses, it is 32
;bits right-aligned in the word.)

;A negative data length means a reply was received indicating that the
;requested data does not exist (e.g., the name is unknown).  These records
;are cached to avoid repeated queries for nonexistent information.

;Messages sent to or received from name servers follow the format in RFC
;883, as modified in RFC 973.  Each message has five sections:
;
;      +---------------------+
;      |	Header	     |
;      +---------------------+
;      |       Question      | the question for the name server
;      +---------------------+
;      |	Answer	     | answering resource records (RRs)
;      +---------------------+
;      |      Authority      | RRs pointing toward an authority
;      +---------------------+
;      |      Additional     | RRs holding pertinent information
;      +---------------------+
;
;There are no padding bytes, so after the header we cannot assume the
;alignment of any fields in such a message.
;
;The header is 12 bytes (shown here in 16-bit words; we store these two
;per word, left-aligned):
;
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		      ID		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |QR|   Opcode  |AA|TC|RD|RA|	   |   RCODE   |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		    QDCOUNT		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		    ANCOUNT		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		    NSCOUNT		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		    ARCOUNT		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;The question section looks as follows:
;
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |					       |
;      /		     QNAME		       /
;      /					       /
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		     QTYPE		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		     QCLASS		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;QNAME is in the 8-bit format described above, except that it may be
;"compressed" by including pointers to previous name components.  See RFC
;883 for details.
;
;The other sections contain 0 or more resource records (given by the
;counts in the header).  A resource record looks like
;
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |					       |
;      /					       /
;      /		      NAME		       /
;      |					       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		      TYPE		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		     CLASS		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |					       |
;      +		      TTL		       +
;      |					       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;      |		   RDLENGTH		       |
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--|
;      /		     RDATA		       /
;      /					       /
;      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;NAME is in the 8-bit compressed format, as is RDATA if it is a domain
;name.	RDLENGTH is the length (in bytes) of RDATA.

;⊗ RRTYPE RRCLAS RRTTL RRDLEN RRNAME TY.A TY.NS TY.CNAME TY.SOA TY.MB TY.MG TY.MR TY.NULL TY.WKS TY.PTR TY.HINFO TY.MINFO TY.MX TY.AXFR TY.MAILB TY.ALL CL.IN CL.CH CL.ALL DOM NETIBF NETOBF DOMIBF DOMOBF NETBFL DOMBFL NETBUF DOMBUF DVERBOSE UPCASE AUTHOR NODFLT MXPREF OSNAME BLKLEN DLKBLK DLKNME NAMBLK DATBLK DATPTR MXDBLK MXHBLK MXABLK MXAPTR MXPBLK MXPPTR SETUDP QUERYB QDCOUNT ANCOUNT NSCOUNT ARCOUNT TEMPBP TTLMIN TTLMAX TTLFAI NODOTS DFLTDM DFATAL LDOMAN DOMAN DOMANX DOMANL

;Resource record format as stored in system cache.  Data follows name,
;unless (based on RRTYPE and RRCLAS) it is stored in RRDLEN word.
RRTYPE←←0			;Type
RRCLAS←←1			;Class
RRTTL←←2			;Time to live (in seconds)
RRDLEN←←3			;Data length (in bytes), or immediate data
RRNAME←←4			;Start of name

;Resource record types
↑TY.A←←=1			;Internet address
↑TY.NS←←=2			;Name server
;↑TY.MD←←=3	(obsolete)	;Mail destination
;↑TY.MF←←=4	(obsolete)	;Mail forwarder
↑TY.CNAME←←=5			;Canonical name
↑TY.SOA←←=6			;Start of authority
↑TY.MB←←=7			;Mailbox
↑TY.MG←←=8			;Mail group
↑TY.MR←←=9			;Mail rename
↑TY.NULL←←=10			;Null
↑TY.WKS←←=11			;Well-known service
↑TY.PTR←←=12			;Pointer
↑TY.HINFO←←=13			;Host information
↑TY.MINFO←←=14			;Mail information
↑TY.MX←←=15			;Mail exchange

;Query types (in addition to above)
↑TY.AXFR←←=252			;Zone of authority transfer
↑TY.MAILB←←=253			;MAILB Mailbox-related records
;↑TY.MAIA←←=254	(obsolete)	;(MAILA) Mail agent records
↑TY.ALL←←=255			;All types

;Resource record classes
↑CL.IN←←=1			;Internet
;↑CL.CS←←=2	(obsolete)	;CSNET
↑CL.CH←←=3			;Chaos

;Query classes (in addition to above)
↑CL.ALL←←=255			;All classes

DOM←←2				;Channel for domain cache

;Buffer headers
NETIBF:	BLOCK 3
NETOBF:	BLOCK 3
DOMIBF:	BLOCK 3
DOMOBF:	BLOCK 3

;Space for the buffers themselves.  For each device we have 1 input and 1
;output buffer.  We allocate them here to avoid expanding core, mainly for
;the benefit of MAIL.
NETBFL←←200			;Length of data in NET buffers
DOMBFL←←200			;Length of data in DOM buffers
NETBUF:	BLOCK 2*<NETBFL+3>
DOMBUF:	BLOCK 2*<DOMBFL+3>

↑DVERBOSE:-1			;0 to supress some typeout
↑UPCASE:-1			;0 to not convert names to upper case
↑AUTHOR:0			;-1 to force authoritative answer
↑NODFLT:0			;-1 to disable appending default domain
↑MXPREF:0			;preference value in MX record
↑OSNAME:0			;OS name in HINFO record

BLKLEN←←100			;Length of various blocks
DLKBLK:	BLOCK BLKLEN		;Domain LOOKUP block
DLKNME:	BLOCK 1			;Pointer to end of name in DLKBLK
NAMBLK:	BLOCK BLKLEN		;Block for returned name
DATBLK:	BLOCK BLKLEN		;Block for returned data
DATPTR:	BLOCK 1			;Pointer used to fill DATBLK
IFN MXRTS,<
MXDBLK:	BLOCK BLKLEN		;Name of target domain
MXHBLK:	BLOCK BLKLEN		;Name of mail exchange host
MXABLK:	BLOCK BLKLEN		;List of addresses
MXAPTR:	BLOCK 1			;Ptr into MXABLK
MXPBLK:	BLOCK BLKLEN		;List of corresponding priorities
MXPPTR:	BLOCK 1			;Ptr into MXPBLK
>;IFN MXRTS

SETUDP:	26			;MTAPE block for UDP parameters
	0			;Status bits
	0			;Local port
	0
	0
	=53			;Remote domain server port
	0			;Remote address

;Message header (12 bytes) for domain server query
QUERYB:	BYTE (8)0,0,1,0		;ID, flags (recursion desired)
	BYTE (8)0,1,0,0		;QDCOUNT, ANCOUNT
	BYTE (8)0,0,0,0		;NSCOUNT, ARCOUNT

QDCOUNT:0			;Storage for RDRESP
ANCOUNT:0
NSCOUNT:0
ARCOUNT:0
TEMPBP:	0

TTLMIN:	=60			;Minimum TTL for records we give system
TTLMAX:	=48*=60*=60		;Maximum TTL for records we give system
TTLFAI:	=4*=60*=60		;TTL for cached failures
NODOTS:	0
DFLTDM:	ASCIZ/Stanford.EDU/	;Default domain string

DFATAL:	FATAL Fatal error in domain lookup code.

LDOMAN←←10			;number of words allocated to domain name string
↑DOMAN:	BLOCK LDOMAN		;space for storing our system's domain name
DOMANX:	ASCIZ/SAIL.Stanford.EDU/;spare host name for emergency use only
	BLOCK LDOMAN+DOMANX-.	;patch space for longer emergency host name
↑DOMANL:0			;number of chars in our domain name (for MAIL)
;⊗ SUCCES NICKNM SFTERR NAMERR GETDOM GETDO1 GETDO2 GETDO5 GETDO6 GETDMA GETINP GETIN1 GETIN2 GETIN3 GT.UNK GTDISP GT.MAX GT.A GT.RET GT.MX GT.DOM GT.DO1 GT.DO2 GT.DO3 GT.WKS GT.HIN GT.HI1 GT.HI2

;Get domain information.  Calling sequence:
;
;	MOVE 0,[<addr or byte ptr to ASCIZ domain name>]
;	MOVE 1,[<query type>]
;	MOVE 2,[<query class>]
;	PUSHJ 17,GETDOM
;	 <name error: requested information does not exist>
;	 <soft error: requested information not available>
;	 <nickname was given: AC 3 points to canonical name>
;	<success, 0 contains addr of domain name,
;		  1 contains type,
;		  2 contains class,
;		  3 contains data>
;
;Several flags can be set to affect processing:
;   AUTHOR	if non-0, always send a network query to get authoritative
;		information before checking system cache
;   NODFLT	if non-0, don't append a default domain to names not
;		containing any "." characters.
;
;After a successful return, to get further answers:
;
;	PUSHJ 17,GETDMA
;	 <no more information>
;	<success, 0-3 contain same as above>
;
;The returned domain name pointed to by AC 0 may differ in capitalization,
;otherwise it is expected to be the same as the query domain name.  The
;format of the data returned in AC 3 depends on the type in AC 1, as follows:
;
;  TY.A		AC 3 contains the 32-bit address.
;  TY.SOA	Not implemented
;  TY.NULL	Not implemented
;  TY.WKS	AC 3 points to a block organized as follows:
;		Word 0/	32-bit IP address (right-aligned)
;		Word 1/	Internet protocol number
;		Word 2/ Number of bytes in bit map
;		Bit map of well-known services
;  TY.HINFO	AC 3 points to an ASCIZ string for the CPU name,
;		location OSNAME points to an ASCIZ string for the OS name.
;  TY.MINFO	Not implemented
;  TY.MX	AC 3 points to an ASCIZ string for a host name,
;		location MXPREF contains the preference value
;  Others	AC 3 points to an ASCIZ string representing a domain name
;
;If the original name is found to be a nickname, you should call GETDOM
;again with the canonical name that was returned.  It is safe to copy AC 3
;into 0 (and reset the type in AC 1).
;
;A name error means a server told us the information does not exist for
;the requested domain.  A soft error means we could not get to a server,
;so retrying later may work.

;Return addresses restore ACs saved on entry and skip appropriately.
SUCCES:	AOS -1(17)		;Success
NICKNM:	AOS -1(17)		;Nickname
SFTERR:	AOS -1(17)		;Soft error
NAMERR:	POP 17,4		;Name error
	POPJ 17,

↑GETDOM:PUSH 17,4		;Save some ACs
	;Prepare lookup block
	MOVEM 1,DLKBLK+RRTYPE
	MOVEM 2,DLKBLK+RRCLAS
	;Convert name argument from ASCIZ to domain format
	TLNN 0,-1		;Byte ptr?
	HRLI 0,440700		;No, make one
	MOVE 2,[POINT 8,DLKBLK+RRNAME]	;Destination byte ptr
	SETOM NODOTS		;No "." seen yet
	PUSH 17,UPCASE		;We may clobber this
GETDO1:	SETZ 4,			;Component length ← 0
	IBP 2			;Skip length byte
	MOVE 3,2		;Save ptr to length byte
GETDO2:	ILDB 1,0		;Get a byte
	JUMPE 1,GETDO5		;Jump if end of string
	CAIN 1,"."		;End of component?
	JRST [	SETZM NODOTS	;Yes, now we've seen a "."
		DPB 4,3		;Store length byte
		JRST GETDO1]	;Start next component
	SKIPN UPCASE		;Convert letters to upper case?
	JRST GETDO3		;No
	;This is for servers that return name in the same form we send it.
	CAIL 1,"a"
	CAILE 1,"z"
	CAIA
	SUBI 1,"a"-"A"
GETDO3:	IDPB 1,2		;Copy byte to domain string
	AOJA 4,GETDO2

GETDO5:	DPB 4,3			;Store length byte
	SKIPE NODOTS		;If we've seen a "."
	SKIPE NODFLT		; or if no defaulting wanted
	JRST GETDO6		; then we're done
	MOVE 0,[440700,,DFLTDM]	;Else point to default domain
	SETZM NODOTS
	SETZM UPCASE
	JRST GETDO1		;Add it to string

GETDO6:	IDPB 1,2		;End with 0 length byte
	MOVEM 2,DLKNME		;Save ptr to end of name
	POP 17,UPCASE
	INIT DOM,0		;Open domain device
	 SIXBIT/DOM/
	 DOMOBF,,DOMIBF
	 FATAL Domain device INIT failure
	MOVEI 0,DOMBUF		;Allocate buffers
	EXCH 0,JOBFF↑
	INBUF DOM,1
	OUTBUF DOM,1
	MOVEM 0,JOBFF↑
	SKIPN AUTHOR		;Force query if authority desired
	LOOKUP DOM,DLKBLK	;See if data in system
	 JRST [	PUSHJ 17,SQUERY	;Not found, ask a server
		 JRST SFTERR	;No reply
		LOOKUP DOM,DLKBLK ;See if server added info for us
		 JRST SFTERR	;Nope, nothing there
		JRST .+1]
	;System has information, read it
	PUSHJ 17,GETINP		;Read RR, return data in ACs
	 JRST NAMERR		;Name error
	 FATAL Domain device input failure
	CAIN 1,TY.CNAME		;Skip unless returning a CNAME
	CAIN 1,DLKBLK+RRTYPE	;Did he ask for a CNAME?
	JRST SUCCESS		;Give standard return
	JRST NICKNM		;No, indicate nickname

↑GETDMA:PUSH 17,4
	PUSHJ 17,GETINP
	 JFCL			;Name error
	 SOS -1(17)		;No input data
	POP 17,4
	JRST CPOPJ1

;GETINP reads one input record from the system.  Calling sequence:
;
;	PUSHJ 17,GETINP
;	 <name error>
;	 <no data available>
;	<success, ACs 0-3 contain return data>
;
;Return data is same as for GETDOM.

GETINP:	IN DOM,			;Get the data
	 JRST .+2
	JRST CPOPJ1		;Input failed, no more data
	MOVE 1,DOMIBF		;Buffer pointer
	ADDI 1,2		;Point to resource record
	SKIPGE RRDLEN(1)	;Name error?
	POPJ 17,		;Yes, return failure
	;Copy the name in the reply into NAMBLK.
	MOVE 2,[POINT 8,RRNAME(1)]
	MOVE 0,[POINT 7,NAMBLK]
GETIN1:	ILDB 3,2		;Get a length byte
	JUMPE 3,GETIN3
GETIN2:	ILDB 4,2		;Get a data byte
	IDPB 4,0		;Copy it
	SOJG 3,GETIN2
	MOVEI 4,"."		;End a name component
	IDPB 4,0
	JRST GETIN1

GETIN3:	DPB 3,0			;Replace last "." with null
	MOVE 3,RRTYPE(1)	;Examine type
	CAIGE 3,GT.MAX		;Bounds check
	JRST @GTDISP(3)		;Dispatch based on type
;Unknown record type - shouldn't happen since READRR only stores known types.
GT.UNK:	FATAL Unknown domain record read from system

GTDISP:	GT.UNK
	GT.A			;TY.A
	GT.DOM			;TY.NS
	GT.DOM			;TY.MD (obsolete)
	GT.DOM			;TY.MF (obsolete)
	GT.DOM			;TY.CNAME
	GT.UNK			;TY.SOA
	GT.DOM			;TY.MB
	GT.DOM			;TY.MG
	GT.DOM			;TY.MR
	GT.UNK			;TY.NULL
	GT.WKS			;TY.WKS
	GT.DOM			;TY.PTR
	GT.HIN			;TY.HINFO
	GT.UNK			;TY.MINFO
	GT.MX			;TY.MX
GT.MAX←←.-GTDISP

GT.A:
repeat 1,<	;Remove after system no longer stores addrs in RRDLEN
	MOVE 3,RRDLEN(1)	;Get length field
	TLNE 3,-1		;Is left half non-zero?
	JRST GT.RET		;Yes, this is the address
>;repeat 1
	MOVE 0,[POINT 8,3,3]	;Byte ptr to store address
REPEAT 4,<
	ILDB 4,2		;Copy an address byte
	IDPB 4,0
>;REPEAT 4
GT.RET:	MOVE 2,RRCLAS(1)	;Set up ACs 0-2 for return
	MOVE 1,RRTYPE(1)
	MOVEI 0,NAMBLK
	JRST CPOPJ2		;Skip twice for success

GT.MX:	ILDB 3,2		;Get 1st byte of MX preference
	ILDB 4,2		; and 2nd
	LSH 3,=8		;Combine them
	ADDI 3,(4)
	MOVEM 3,MXPREF
	;fall into GT.DOM to read MX domain name
GT.DOM:	MOVE 0,[POINT 7,DATBLK]	;Init destination ptr
GT.DO1:	ILDB 3,2		;Get a length byte
	JUMPE 3,GT.DO3
GT.DO2:	ILDB 4,2		;Copy a character
	IDPB 4,0
	SOJG 3,GT.DO2
	MOVEI 4,"."		;End a name component
	IDPB 4,0
	JRST GT.DO1

GT.DO3:	DPB 3,0			;Replace last "." with null
	MOVEI 3,DATBLK		;Point to returned data
	JRST GT.RET

GT.WKS:	JRST GT.UNK

;HINFO data is 1 byte CPU name length, CPU name, 1 byte OS name length,
;OS name.
GT.HIN:	MOVE 0,[POINT 7,DATBLK]
	ILDB 3,2		;CPU name length
GT.HI1:	ILDB 4,2		;Copy a character
	IDPB 4,0
	SOJG 3,GT.HI1
	MOVEI 4,0		;End with a null
	IDPB 4,0
	ADDI 0,1		;Point to next word
	HRRZM 0,OSNAME
	HRLI 0,440700
	ILDB 3,2		;OS name length
GT.HI2:	ILDB 4,2		;Copy a character
	IDPB 4,0
	SOJG 3,GT.HI2
	MOVEI 4,0		;End with a null
	IDPB 4,0
	MOVEI 3,DATBLK		;Point to CPU name
	JRST GT.RET
;⊗ SQUERY SQUER1 SQUER2 UNKERR FMTERR SRVFAI NOTIMP REFUSE RDRESP SKIPQR SKIPQ1 RDANS RDAUTH RDADDL RDRRET NAMERX

;Send query to domain server.  Returns non-skip if no response,
;skip if response received.

SQUERY:	INIT NET,0		;Open network channel
	 SIXBIT/IMP/
	 NETOBF,,NETIBF
	 FATAL Network device INIT failure
	MOVEI 0,NETBUF		;Allocate buffers
	EXCH 0,JOBFF↑
	INBUF NET,1
	OUTBUF NET,1
	MOVEM 0,JOBFF↑
	MOVEI 1,=8		;Set byte size in buffer headers
	DPB 1,[POINT 6,NETIBF+1,11]
	DPB 1,[POINT 6,NETOBF+1,11]
	MTAPE NET,[17 ↔ 0,,001200]	;Set 20-second input timeout
	SETOM SETUDP+2		;Let system allocate local port
	MOVE 1,[4416,,000227]	;(Argus)
;;	MOVE 1,[4405,,200024]	;(Portia)
;;	MOVE 1,[4402,,000057]	;(Labrea)
	MOVEM 1,SETUDP+6	;Set server address
	MTAPE NET,SETUDP
	OUTPUT NET,		;Set up first output buffer
	MOVE 1,SETUDP+2		;Get the port we were assigned
	DPB 1,[POINT 16,QUERYB,15]	;Use it as the ID byte
	MOVE 1,NETOBF		;Output buffer pointer
	ADDI 1,2		;First data word
	HRLI 1,QUERYB		;Set up to copy query block
	BLT 1,2(1)		;Copy three header words
	MOVE 0,DLKBLK+RRTYPE
	HRLI 1,DLKBLK+RRNAME	;Start of name to copy
	MOVE 2,DLKNME		;Ptr to last byte in source
	SUBI 2,DLKBLK+RRNAME	;RH ← length of name in words
	ADDI 2,(1)		;Ptr to last byte in destination
	MOVEM 2,NETOBF+1	;Store ptr in buffer header
	BLT 1,(2)		;Copy name
	MOVE 1,DLKBLK+RRTYPE	;Copy type from lookup block
	ROT 1,-=8
	IDPB 1,NETOBF+1
	ROT 1,=8
	IDPB 1,NETOBF+1
	MOVE 1,DLKBLK+RRCLAS	;Copy class
	ROT 1,-=8
	IDPB 1,NETOBF+1
	ROT 1,=8
	IDPB 1,NETOBF+1
	OUT NET,		;Send the query
	 JRST SQUER1
	;Output can fail when, e.g., gateways are down and the server
	;is unreachable.
SQUERR:	RELEAS NET,
	POPJ 17,

SQUER1:	IN NET,			;Wait for response
	 CAIA
	JRST SQUERR		;Time out or other error
	OUTPUT DOM,		;Set up first output buffer
	MOVEI 1,=16		;Temporarily change byte size
	DPB 1,[POINT 6,NETIBF+1,11]
	ILDB 1,NETIBF+1		;ID field
	;Don't bother checking ID for now.  What would we do if it was wrong?
	ILDB 1,NETIBF+1		;Opcode and Flags
	ILDB 2,NETIBF+1		;Read and store other header fields
	MOVEM 2,QDCOUNT
	ILDB 2,NETIBF+1
	MOVEM 2,ANCOUNT
	ILDB 2,NETIBF+1
	MOVEM 2,NSCOUNT
	ILDB 2,NETIBF+1
	MOVEM 2,ARCOUNT
	MOVEI 2,=8		;Back to 8-bit bytes
	DPB 2,[POINT 6,NETIBF+1,11]
	;Various flags in 1 should be checked.
	ANDI 1,17		;Dispatch on RCODE field
	CAILE 1,5		;Highest reply code we know
	JRST UNKERR
	JRST @[	RDRESP		;No error, read response
		FMTERR		;Format error
		SRVFAI		;Server failure
		NAMERX		;Name error
		NOTIMP		;Not implemented
		REFUSE](1)	;Refused

UNKERR:	OUTSTR [ASCIZ/Unknown error code.
/]
	PUSHJ 17,DFATAL

FMTERR:	OUTSTR [ASCIZ/Format error.
/]
	PUSHJ 17,DFATAL

;These errors sometimes happen so treat as a temporary failure.
SRVFAI:	OUTSTR [ASCIZ/Server failure.
/]
	JRST SQUERR

NOTIMP:	OUTSTR [ASCIZ/Not implemented error.
/]
	PUSHJ 17,DFATAL

REFUSE:	OUTSTR [ASCIZ/Query refused.
/]
	PUSHJ 17,DFATAL

;Read response from server, and store all of the resource records in the
;response into the system cache.  These will then be used to answer the
;original query.

;Skip over question section.  (We assume it matches the query.)
;QDCOUNT should always be 1, but we don't assume it.
RDRESP:	SOSGE QDCOUNT		;Skip unless done question section
	JRST RDANS
SKIPQR:	ILDB 1,NETIBF+1		;Get a length byte
	JUMPE 1,SKIPQ1		;Jump at end of QNAME
	TRZE 1,300		;Compressed format?
	JRST [	IBP NETIBF+1	;Yes, this makes it easy to skip over!
		JRST SKIPQ1]
	IBP NETIBF+1		;Skip over that many bytes
	SOJG 1,.-1
	JRST SKIPQR

SKIPQ1:	AOS NETIBF+1		;Skip 4 bytes (type and class)
	JRST RDRESP

;Read resource records from answer section.
RDANS:	SOSGE ANCOUNT		;Skip unless done answer section
	JRST RDAUTH
	PUSHJ 17,READRR		;Read a resource record
	JRST RDANS

;Read resource records from authority section.
RDAUTH:	SOSGE ANCOUNT		;Skip unless done authority section
	JRST RDADDL
	PUSHJ 17,READRR		;Read a resource record
	JRST RDAUTH

;Read resource records from additional section.
RDADDL:	SOSGE ANCOUNT		;Skip unless done additional section
	JRST RDRRET
	PUSHJ 17,READRR		;Read a resource record
	JRST RDADDL

RDRRET:	RELEAS NET,
	JRST CPOPJ1		;Return from SQUERY

;Name error means the name we sent it is no good.  Make up a record
;to indicate this and store it in the system cache.

NAMERX:	MOVE 1,DLKBLK+RRTYPE
	SETOM DLKBLK+RRDLEN	;Indicate error
	MOVE 1,TTLFAI		;Set its TTL
	MOVEM 1,DLKBLK+RRTTL
	MOVE 1,DOMOBF		;Output buffer pointer
	ADDI 1,2		;First data word
	HRLI 1,DLKBLK		;Addr of our query
	MOVE 2,DLKNME		;Ptr to last byte in query
	ADDI 2,-DLKBLK(1)	;Ptr to last byte in destination
	BLT 1,(2)		;Copy the query
	MOVEM 2,DOMOBF+1	;Store final byte ptr for output
	OUTPUT DOM,		;Send record to system cache
	JRST RDRRET
;⊗ READRR READR1 READR2 READR3 READR4 RD.UNK RDDISP RD.MAX RD.DAT RD.DA1 RDOUTP RD.MX RD.DOM RD.DO1 RD.DO2 READC0 READCP READC1 READC2

;Read a resource record and enter it in the system's cache.

;Macro to copy NUM bytes from input buffer to a word, right-aligned.
DEFINE COPYB(NUM,WORD)<
	SETZM WORD
	MOVE 1,[POINT 8,WORD,<35-8*NUM>]
REPEAT NUM,<
	ILDB 0,NETIBF+1
	IDPB 0,1
>;REPEAT NUM
>;DEFINE COPYB

READRR:	MOVE 3,DOMOBF		;Pointer to output buffer
	ADDI 3,2		;Start of data
	MOVE 2,3		;Make a copy for byte ptr
	ADD 2,[POINT 8,RRNAME]	;Start of name
	MOVEM 2,DOMOBF+1	;Store ptr in buffer hdr
READR1:	ILDB 1,NETIBF+1		;Get a length byte
	TRZE 1,300		;Compressed format?
	JRST READR3		;Yes
	IDPB 1,DOMOBF+1		;Copy length byte
	JUMPE 1,READR4		;Jump when done
READR2:	ILDB 0,NETIBF+1		;Get a byte
	IDPB 0,DOMOBF+1		;Copy it
	SOJG 1,READR2
	JRST READR1

READR3:	PUSHJ 17,READCP		;Read compressed name
READR4:	COPYB(2,<RRTYPE(3)>)	;Copy type
	COPYB(2,<RRCLAS(3)>)	;Copy class
	COPYB(4,<RRTTL(3)>)	;Copy time to live
	MOVE 0,RRTTL(3)		;Examine TTL
	CAMGE 0,TTLMIN		;Force into desired range
	MOVE 0,TTLMIN
	CAMLE 0,TTLMAX
	MOVE 0,TTLMAX
	MOVEM 0,RRTTL(3)
	COPYB(2,<RRDLEN(3)>)	;Copy data length
	MOVE 1,RRTYPE(3)	;Examine type
	CAIGE 1,RD.MAX		;Bounds check
	JRST @RDDISP(1)		;Dispatch based on type
;Unknown record type -- skip over data bytes and ignore record
;(don't enter in system cache).
RD.UNK:	SOSGE RRDLEN(3)		;End of data?
	POPJ 17,		;Yes, return from READRR
	IBP NETIBF+1		;Skip a byte
	JRST RD.UNK

RDDISP:	RD.UNK
	RD.DAT			;TY.A
	RD.DOM			;TY.NS
	RD.DOM			;TY.MD (obsolete)
	RD.DOM			;TY.MF (obsolete)
	RD.DOM			;TY.CNAME
	RD.UNK			;TY.SOA
	RD.DOM			;TY.MB
	RD.DOM			;TY.MG
	RD.DOM			;TY.MR
	RD.DAT			;TY.NULL
	RD.UNK			;TY.WKS (change to RD.DAT when GT.WKS is written)
	RD.DOM			;TY.PTR
	RD.DAT			;TY.HINFO
	RD.UNK			;TY.MINFO
	RD.MX			;TY.MX
RD.MAX←←.-RDDISP

;Copy data bytes for record types that don't have domain names in data.
RD.DAT:	SKIPN 1,RRDLEN(3)	;Get data length
	JRST RDOUTP		;Just in case ...
RD.DA1:	ILDB 0,NETIBF+1		;Copy a data byte
	IDPB 0,DOMOBF+1
	SOJG 1,RD.DA1
RDOUTP:	OUTPUT DOM,		;Send record to system cache
	POPJ 17,		;Return from READRR

RD.MX:	ILDB 0,NETIBF+1		;1st byte of preference
	IDPB 0,DOMOBF+1
	ILDB 0,NETIBF+1		;2nd byte
	IDPB 0,DOMOBF+1
	;(fall into RD.DOM to copy host name)
;Copy a domain name into the output buffer, handling compressed format.
RD.DOM:	ILDB 1,NETIBF+1		;Get a length byte
	TRZE 1,300		;Compressed format?
	JRST RD.DO2		;Yes
	IDPB 1,DOMOBF+1		;Copy length byte
	JUMPE 1,RDOUTP		;Jump when done
RD.DO1:	ILDB 0,NETIBF+1		;Get a byte
	IDPB 0,DOMOBF+1		;Copy it
	SOJG 1,RD.DO1
	JRST RD.DOM

RD.DO2:	PUSHJ 17,READCP		;Read compressed name
	JRST RDOUTP

;Follow a compressed name pointer to read and copy the rest of a name.
READC0:	ILDB 0,TEMPBP		;Here when multiple pointers
	JRST .+2
READCP:	ILDB 0,NETIBF+1		;Get the rest of the pointer
	LSH 1,=8
	ADDI 0,(1)		;Compute the byte offset
	IDIVI 0,4		;0←word offset, 1←byte
	ADD 0,[	POINT 8,2	;Make a byte ptr
		POINT 8,2,7	;(2 is for data offset from NETIBF)
		POINT 8,2,15
		POINT 8,2,23](1)
	ADD 0,NETIBF		;Relocate to input message
	MOVEM 0,TEMPBP
READC1:	ILDB 1,TEMPBP		;Get a length byte
	TRZE 1,300		;Another pointer?
	JRST READC0		;Yes, what complexity!
	IDPB 1,DOMOBF+1		;Copy length byte
	JUMPE 1,CPOPJ		;Return when done
READC2:	ILDB 0,TEMPBP		;Get a byte
	IDPB 0,DOMOBF+1		;Copy it
	SOJG 1,READC2
	JRST READC1
;⊗ NAMADR NAMAD0 NAMAD1 NAMAD2 NAMHST NAMHST NAMHS1 NAMHS2 NAMHL1 NAMHL2 SRTDAT SRTDA1 SRTDA2 COMPRI COMPR1 NANAME

;NAMADR -- Name to address translation.  Looks up a name using domain
;servers or host table, and returns a list of HOSTS3 addresses sorted
;in order of preference.
;	MOVEI 0,<pointer to host name string>
;	PUSHJ 17,NAMADR
;	 <hard error, 1 points to string describing error>
;	 <soft error, 1 points to string describing error>
;	<success, 1 points to sorted list of addresses>
;All returns provide ptr to (possibly updated) host name string in 0.
;
;A hard error indicates that the given domain name cannot be resolved
;to an address.  A soft error indicates a temporary failure.
;
;Clobbers 0-11 (potentially).

↑NAMADR:MOVEI 1,DATBLK		;Init ptr to address block
	MOVEM 1,DATPTR
	SKIPE DVERBOSE
	OUTSTR [ASCIZ/Domain lookup ... /]
NAMAD0:	MOVEM 0,NANAME		;Save ptr to name
	MOVEI 1,TY.A		;Set up query parameters
	MOVEI 2,CL.IN
	PUSHJ 17,GETDOM		;Do an address query
	 JRST NAMHST		;No such host
	 JRST NAMHST		;Query failed
	 JRST [	MOVE 0,3	;Nickname -- point to real name
		JRST NAMAD0]	;Look it up
NAMAD1:	MOVEM 3,@DATPTR		;Save address
	AOS DATPTR
	PUSHJ 17,GETDMA		;Get next address
	 CAIA			;No more
	JRST NAMAD1
NAMAD2:	SETZM @DATPTR		;Put zero at end of list
	PUSH 17,0
	PUSHJ 17,SRTDAT		;Sort address list
	POP 17,0
	MOVEI 1,DATBLK		;Point to list of addresses
	JRST CPOPJ2

IFE HSTTAB,<
NAMHST:	MOVEI 1,[ASCIZ/Domain lookup failed/]
	MOVE 0,NANAME
	POPJ 17,
>;IFE HSTTAB

IFN HSTTAB,<
NAMHST:	MOVE 0,NANAME		;Get back ptr to name
	SKIPE DVERBOSE
	OUTSTR [ASCIZ/Host table ... /]
	PUSHJ 17,ATTHST		;Attach host table
	PUSHJ 17,HSTNAM		;Try to look up the name
	 JRST NAMHL1		;No such host
	 JRST NAMHL2		;Ambiguous name
NAMHS1:	MOVEM 0,@DATPTR		;Save address
	AOS DATPTR
	PUSHJ 17,HSTNXA		;Get next address
	 CAIA
	JRST NAMHS1
	SETZM NAMBLK
	TRNN 1,-1		;This host got a name?
	JRST NAMHS2		;No
	HRLZ 0,1
	HRRI 0,NAMBLK
	BLT 0,NAMBLK+BLKLEN-1	;Copy name to NAMBLK
	MOVEI 0,NAMBLK		;Point to name
NAMHS2:	PUSHJ 17,DETHST
	JRST NAMAD2		;Sort addresses and return

NAMHL1:	SKIPA 1,[[ASCIZ/Unknown host name/]]
NAMHL2:	MOVEI 1,[ASCIZ/Ambiguous host name/]
	MOVE 0,NANAME		;Ptr to original name
	JRST DETHST		;Detach host table and return
>;IFN HSTTAB

;Sort the list of addresses in DATBLK (terminated by 0).  We use
;insertion sort, though it is O(n↑2), since the expected number of
;addresses is very small.

SRTDAT:	MOVEI 0,DATBLK		;Init ptr to last inserted addr
	MOVEM 0,DATPTR
SRTDA1:	AOS 3,DATPTR		;Point to next addr to insert
	MOVE 0,(3)		;Get address
	JUMPE 0,CPOPJ		;Return if done
	PUSHJ 17,COMPRI		;Compute its priority
	MOVE 4,1		;Save for comparisons
SRTDA2:	MOVE 0,-1(3)		;Get previous address
	PUSHJ 17,COMPRI		;Compute its priority
	CAML 1,4		;Skip if out of order
	JRST SRTDA1		;In order, done this insertion
	MOVE 0,-1(3)		;Swap addresses
	EXCH 0,(3)
	MOVEM 0,-1(3)
	CAILE 3,DATBLK+1	;Skip if at left end of array
	SOJA 3,SRTDA2		;Still more to compare
	JRST SRTDA1		;Do next insertion

;Compute priority for address in AC 0, return value in 1.  Uses 2.
COMPRI:	MOVSI 2,-NUMPRI
COMPR1:	XOR 0,PRIADR(2)		;Compare with an address
	TDNN 0,PRIMSK(2)	;See if any masked bits are different
	JRST [	MOVE 1,PRINUM(2);No difference, assign priority
		POPJ 17,]
	XOR 0,PRIADR(2)		;Restore address
	AOBJN 2,COMPR1
	SETZ 1,
	POPJ 17,

NANAME:	BLOCK 1
;⊗ ADRNAM ADRPTR ADRPT1 ADRPTD ADRPD1 ADRHST ADRHST ADRHS1 ADRHL1 ADADDR

;ADRNAM -- Address to name translation.  Looks up an address using domain
;servers or host table, and returns a host name.
;	MOVE 0,[<HOSTS3 address>]
;	PUSHJ 17,ADRNAM
;	 <hard error, 1 points to string describing error>
;	 <soft error, 1 points to string describing error>
;	<success, 0 points to host name>
;Clobbers 0-4 (potentially).

↑ADRNAM:MOVEM 0,ADADDR		;Save address
	TLNE 0,(NN%IP)		;Is it an IP address?
	JRST ADRHS1		;No, don't bother with domain lookup
	PUSHJ 17,ADRPTR		;Construct domain for PTR query
	SKIPE DVERBOSE
	OUTSTR [ASCIZ/Domain lookup ... /]
	MOVEI 1,TY.PTR		;Set up query
	MOVEI 2,CL.IN
	PUSHJ 17,GETDOM		;Do an inverse address query
	 JRST ADRHST
	 JRST ADRHST
	 FATAL Unexpected GETDOM return in ADRNAM
	MOVE 0,3		;Return host name in 0
	JRST CPOPJ2

;Convert an Internet address a.b.c.d to a domain name of the form
;d.c.b.a.IN-ADDR.ARPA, for use in a PTR query.
ADRPTR:	MOVE 0,[POINT 7,NAMBLK]	;Init destination ptr
	LDB 1,[POINT 8,ADADDR,35]	;4th byte
	PUSHJ 17,ADRPTD
	LDB 1,[POINT 8,ADADDR,27]	;3rd byte
	PUSHJ 17,ADRPTD
	LDB 1,[POINT 8,ADADDR,19]	;2nd byte
	PUSHJ 17,ADRPTD
	LDB 1,[POINT 8,ADADDR,11]	;1st byte
	PUSHJ 17,ADRPTD
	MOVE 1,[POINT 7,[ASCIZ/IN-ADDR.ARPA/]]
ADRPT1:	ILDB 2,1
	IDPB 2,0
	JUMPN 2,ADRPT1
	MOVEI 0,NAMBLK		;Point to finished string
	POPJ 17,

ADRPTD:	PUSHJ 17,ADRPD1
	MOVEI 2,"."
	IDPB 2,0
	POPJ 17,

ADRPD1:	IDIVI 1,=10		;Standard decimal output routine
	PUSH 17,2
	JUMPE 1,.+2
	PUSHJ 17,ADRPD1
	POP 17,2
	ADDI 2,"0"
	IDPB 2,0
	POPJ 17,

IFE HSTTAB,<
printx ADRHST doesn't currently return dotted host number in text.
ADRHST:
ADRHS1:	MOVEI 1,[ASCIZ/Domain lookup failed/]
	POPJ 17,
>;IFE HSTTAB

IFN HSTTAB,<
ADRHST:	MOVE 0,ADADDR		;Get back address
	SKIPE DVERBOSE
	OUTSTR [ASCIZ/Host table ... /]
ADRHS1:	PUSHJ 17,ATTHST		;Attach host table
	PUSHJ 17,HSTNUM		;Try to look up the name
	 JRST ADRHL1		;No such host
	HRLZ 0,1		;Ptr to name in host table
	HRRI 0,NAMBLK
	BLT 0,NAMBLK+BLKLEN-1	;Copy name to NAMBLK
	PUSHJ 17,DETHST
	MOVEI 0,NAMBLK		;Point to name
	JRST CPOPJ2

ADRHL1:	MOVE 0,1		;return ptr to dotted host number in text
	MOVEI 1,[ASCIZ/Unknown host address/]
	JRST DETHST		;Detach host table and return
>;IFN HSTTAB

ADADDR:	BLOCK 1
;⊗ A0 A1 A2 A3 OURDOM OURDO0 OURDO1 OURDOE OURDO2

;OURDOM -- Get our own domain name
;Call:	PUSHJ 17,OURDOM
;	<always returns here>
;
;Copies system's domain name into block at DOMAN (uses lowcore 356).
;Puts length of name into DOMANL.
;If no domain name available from system, pauses (EXIT 1,) but lets you
;use a default compiled-in (patchable) domain name by CONTINUING.
;Default domain names resides at DOMANX.
;Domain names limited to LDOMAN words of ASCII.
;
;Clobbers 0-3 (potentially).

;AC names used here.
A0←←0
A1←←1
A2←←2
A3←←3

;Copy system's domain name into block at DOMAN.
;Put length of name into DOMANL.
↑OURDOM:SETZM DOMANL		;count name length in this cell
	MOVEI A0,356		;get system's pointer to its domain name
	PEEK A0,		;get ptr
	JUMPE A0,OURDOE		;jump if none
	HRLI A0,-LDOMAN		;max length in words (makes AOBJN ptr)
	MOVEI A3,DOMAN		;place to store name
OURDO0:	HRRZ A2,A0		;copy current ptr into system (can't use MOVEI)
	PEEK A2,		;get one word of domain name from system
	MOVSI A1,-5		;possible number of chars in this word
	MOVEM A2,(A3)		;save it
OURDO1:	TLNN A2,774000		;check high byte for zero
	POPJ 17,		;end of ASCIZ name, all done
	AOS DOMANL		;count a nonzero byte
	LSH A2,7		;shift in the next byte
	AOBJN A1,OURDO1		;loop unless reached end of word
	ADDI A3,1		;next word to save in
	AOBJN A0,OURDO0		;go back for next word from system
	SETZM DOMANL		;overflow -- reset length and use default name
	;fall into OURDOE if system domain name too long
OURDOE:	OUTSTR [ASCIZ/? System pointer to its own domain name is missing or too long.
Type CONTINUE to use the host name currently patched in at DOMANX,
which is currently: /]
	OUTSTR DOMANX		;you can patch name THERE, and you
	EXIT 1,			;  can patch HERE not to pause if you want
	;now copy default domain name to current domain name
	MOVE A1,[POINT 7,DOMANX] ;source of default name
	SKIPA A3,[POINT 7,DOMAN] ;destination for name
OURDO2:	AOS DOMANL		;count a nonzero char
	ILDB A0,A1		;copy a char
	IDPB A0,A3		;including ending null
	JUMPN A0,OURDO2		;loop unless reached end of name
	POPJ 17,
;⊗ MXFIND MXFND1 MXNXTH MXFNDH MXFNH1 SRTMXA MXLOSE MXNAME

IFN MXRTS,<

;MXFIND -- Find MX records for a domain and return a list of HOSTS3
;addresses to use for mail exchange, sorted in order of preference.  If
;that fails, try to look up host address for the given domain.
;	MOVEI 0,<pointer to domain name string>
;	PUSHJ 17,MXFIND
;	 <hard error, 1 points to string describing error>
;	 <soft error, 1 points to string describing error>
;	<success, 0 points to updated domain name,
;		  1 points to sorted list of addresses>
;If the original name pointed to by 0 is a nickname (or not a domain
;name), the updated name will be the official domain name to use in its
;place in a mail header.
;
;Clobbers 0-11 (potentially).

↑MXFIND:SKIPE DVERBOSE
	OUTSTR [ASCIZ/Domain lookup ... /]
MXFND1:	MOVEM 0,MXNAME		;Save ptr to name
	MOVEI 1,TY.MX		;Set up query parameters
	MOVEI 2,CL.IN
	PUSHJ 17,GETDOM		;Do an MX query
	 JRST MXLOSE		;No MX records
	 JRST MXLOSE		;Query failed
	 JRST [	MOVE 0,3	;Nickname -- point to real name
		JRST MXFND1]	;Look it up
	;MX query succeeded, 3 points to host, MXPREF has priority.
	HRLZ 1,0		;Copy official name of MX target
	HRRI 1,MXDBLK
	BLT 1,MXDBLK+BLKLEN-1
	MOVE 1,[POINT 36,MXABLK];Init ptr into MXABLK
	MOVEM 1,MXAPTR
	MOVE 1,[POINT 36,MXPBLK];and MXPBLK
	MOVEM 1,MXPPTR
	PUSH 17,DVERBOSE	;Stay silent for a while
	SETZM DVERBOSE
	PUSH 17,UPCASE		;Turn off upper-case conversion
	SETZM UPCASE
MXNXTH:	HRLZ 1,3		;Copy name of MX host
	HRRI 1,MXHBLK
	BLT 1,MXHBLK+BLKLEN-1
	IOPUSH DOM,'DOM'	;Save channel reading MX records
	 FATAL IOPUSH failed
	;Note that we reuse the I/O buffers for DOM during the call
	;to MXFNDH.  This works, since input and output each have
	;only 1 buffer.
	PUSHJ 17,MXFNDH		;Find addresses for this host
	IOPOP DOM,'DOM'
	 FATAL IOPOP failed
	PUSHJ 17,GETDMA		;Get next MX host
	 CAIA			;No more
	JRST MXNXTH
	POP 17,UPCASE		;Restore old values
	POP 17,DVERBOSE
	MOVEI 2,0
	IDPB 2,MXAPTR		;Terminate both lists
	IDPB 2,MXPPTR
	PUSHJ 17,SRTMXA		;Sort all the addresses
	MOVEI 0,MXDBLK		;Point to return parameters
	MOVEI 1,MXABLK
	JRST CPOPJ2		;Return success

MXFNDH:	MOVEI 0,MXHBLK		;Point to host name
	PUSHJ 17,NAMADR		;Look up its addresses
	 POPJ 17,		;Doesn't have any!
	 POPJ 17,		;Soft error, maybe another will have an address
	;Address priority is determined by position in the list
	;followed by MX preference.  This way we try alternate hosts
	;before alternate addresses for a host that we've already tried.
MXFNH1:	SKIPN 2,(1)		;Get an address
	POPJ 17,		;Done all addresses for this host
	IDPB 2,MXAPTR
	;The absolute address in (1) can be used as the list position
	;since we "know" that the list returned by NAMADR is in a fixed
	;location (DATBLK).  Both orderings are "lowest first".
	MOVE 3,MXPREF
	HRLI 3,(1)		;Compute sorting priority
	IDPB 3,MXPPTR
	AOJA 1,MXFNH1

;Subroutine to sort priorities in MXPBLK (and addresses in MXABLK along
;with them!), lowest first.  This is an O(n↑2) sort, because in most cases
;we expect not many addresses.

SRTMXA:	MOVEI 0,MXPBLK		;Init ptr to last inserted value
	MOVEM 0,MXPPTR
SRTMX1:	AOS 3,MXPPTR		;Point to next value to insert
	SKIPN 4,(3)		;Get the priority
	POPJ 17,		;Return if done
SRTMX2:	CAML 4,-1(3)		;Skip if priorities out of order
	JRST SRTMX1		;In order, done this insertion
	MOVE 0,-1(3)		;Swap priorities
	EXCH 0,(3)
	MOVEM 0,-1(3)
	MOVE 0,MXABLK-MXPBLK-1(3) ;Swap associated addresses
	EXCH 0,MXABLK-MXPBLK(3)
	MOVEM 0,MXABLK-MXPBLK-1(3)
	CAILE 3,MXPBLK+1	;Skip if at left end of array
	SOJA 3,SRTMX2		;Still more to compare
	JRST SRTMX1		;Do next insertion

;Here if MX query fails.  Look up ordinary host addresses.
MXLOSE:	MOVE 0,MXNAME
	JRST NAMADR		;Returns with 0, 1 or 2 skips

MXNAME:	BLOCK 1
>;IFN MXRTS

>;IFN DOMRTS			;Last of several pages
;⊗ CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT

; All good things must come to an end

; Return routines

CPOPJ2:	AOS (17)			; double skip return
CPOPJ1:	AOS (17)			; skip return
CPOPJ:	POPJ 17,			; return to caller

; Warning

↑WARNIN:OUTSTR [ASCIZ/
Please report this via GRIPE NETWORK.
/]
	POPJ 17,

; Fatality!

↑LUZBIG:OUTSTR [ASCIZ/
Find a wizard.
/]
	EXIT 1,		;Stop the program, go away if phantom.
	JRST WARNIN

..NLIT:	LIT

BEND NETWRK