perm filename NETWRK.FAI[S,NET]4 blob
sn#712326 filedate 1983-05-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 Network routines, intended to be .INSERT'ed
C00008 00003 INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND ICTRAN HDEAD CTROV RSET TMO ERRBTS WINBTS ICP NET DAT
C00011 00004 NWKDBG HSTADR HSTTOP HDBPTR CONBLK CONSTS CONLSK CONWAT CONBYT ICPSKT CONFSK HOST CONHST LSNBLK LSNSTS LSNSKT LSNWAT LSNBYT LSNFSK LSNHST
C00013 00005 WATBLK WATSTS WATSKT INRBLK INRSTS INRSKT INSBLK INSSTS INSSKT WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT LSOCKT
C00015 00006 CONECT .CONEC .CONC1
C00020 00007 LISTEN .LISTE .LSTN1
C00023 00008 DATI .DATI .DATI1
C00025 00009 DATO .DATO .DATO1
C00027 00010 NETICH NETICW NTICH2 NTICH4 NTICH3 NTICH1 NTIC1A
C00031 00011 NETOCH .NETOC
C00032 00012 NETSND .NETSN NETOER
C00034 00013 DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
C00038 00014 DATOCH .DATOC
C00039 00015 DATSND .DATSN DATOER
C00041 00016 CLOSER CLSDAT
C00042 00017 NETINR NETINS
C00043 00018 MTPERR MTPER1 MTPE1A MERTAB MERLEN
C00047 00019 NIOERR
C00048 00020 HSTDED
C00051 00021 HSTDE2
C00053 00022 HSTSID HSTFN1 HSTVRS HSTDIR HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW$BYT
C00063 00023 MAPHST
C00065 00024 UNMHST
C00066 00025 HSTNUM HSTNU0 HSTNU1 HSTNU2
C00069 00026 HSTNAM CNTCHR
C00071 00027 SEARCH SRCNXW SRCWIN SRCLUZ SRCDUN GOTNAM AMBNAM GETHDB
C00076 00028 HSTNXA HSTNU0 HSTNU1 HSTNU2
C00078 00029 SETANM SETAN1 SETAN0 SETAN2 SETAN4 SETAN5 SETAN6 SETAN7 SETAN8
C00082 00030 H2TOIP H2ARP H2ARP1 H2ARP2 H2SU
C00084 00031 IPTOH2 IPTH2A IPARP IPARP1 IPSU
C00086 00032 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT
C00087 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSERT'ed
; Mark Crispin, SU-AI, April 1978
; This is a library of ARPAnet 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) is used for data I/O.
; Bugs → MRC.
; This package can also be used with the Ethernet as well, 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)
; Modified for ARPAnet IP/TCP in April 1983. Major change is the elimination
; of ICP for ARPAnet connections. Bugs → ME and JJW.
; This is the FAIL version which lives in NETWRK.FAI[S,NET]. The MIDAS version
; lives in NETWRK.MID[S,NET].
; Assembly switches
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 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
IFE NIORTS!ERRTNS!HSTTAB,<.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 an exclamation point and halt. WARNings type a question
; mark 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
IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,0,0,=15,5,0>> ; Connect ICP
IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=10,=10,=30,0,0>> ; Listen ICP
IFNDEF TNTIMO,<TNTIMO←←<BYTE (6)1,=15,0,5,0,0>> ; Telnet socket
IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,24,0,7,0,0>> ; Data socket
;INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND ICTRAN HDEAD CTROV RSET TMO ERRBTS WINBTS ICP NET DAT
; System bits and bytes
BEGIN NETWRK
; Goddam bagbiting assembler!!!
GLOBAL NIORTS,ERRHAN,ERRINS,ERRTNS,HSTTAB,SVRRTS,DATRTS,HSTSIX,MRKCHR
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 socket 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 ; socket in use
↑CCS←←02 ; can't change 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
ERRBTS←←<IOIMPM!IODERR!IODTER!IOBKTL!IODEND>
WINBTS←←<RFCS!RFCR> ; connection winning
; I/O channel definitions
ICP←←0 ; channel to get socket from logger
↑NET←←1 ; channel to do real network hacking
↑DAT←←2 ; channel to do data hacking
IFE HSTTAB,< ;If not defined later.
; Network numbers (for distinguishing IMP from local Ethernet)
NW%SU←←44 ;SUnet
NW%ARP←←12 ;Arpa net
NW$BYT←←331100 ;Byte pointer to network number
>;End IFE HSTTAB
;NWKDBG HSTADR HSTTOP HDBPTR CONBLK CONSTS CONLSK CONWAT CONBYT ICPSKT CONFSK HOST CONHST LSNBLK LSNSTS LSNSKT LSNWAT LSNBYT LSNFSK LSNHST
; Data area
NWKDBG: 0 ; -1 → do OUTCHR on network I/O
IFN HSTTAB,<
; Host table pointers
↑HSTADR:BLOCK 1 ; ≠ 0 → address of beginning of host table
BLOCK 1 ; = 0 → host table not in core
HSTTOP: BLOCK 1 ; top of host table (JOBFF at map time)
HDBPTR: BLOCK 1 ; pointer to relative HDB
>; End IFN HSTTAB
IFN NIORTS,<
; CONNECT MTAPE block
CONBLK: 0 ; CONNECT
CONSTS: BLOCK 1 ; returned status bits
CONLSK: BLOCK 1 ; local socket
CONWAT: BLOCK 1 ; ≠ 0 → wait for connection until timeout
CONBYT: BLOCK 1 ; byte size
↑ICPSKT:
CONFSK: BLOCK 1 ; foreign socket
↑HOST:
CONHST: BLOCK 1 ; foreign host
IFN SVRRTS,<
; LISTEN MTAPE block
LSNBLK: 1 ; LISTEN
LSNSTS: BLOCK 1 ; returned status bits
↑LSNSKT:BLOCK 1 ; local socket to listen to
LSNWAT: BLOCK 1 ; ≠ 0 → wait for connection
LSNBYT: BLOCK 1 ; byte size
LSNFSK: BLOCK 1 ; foreign socket
LSNHST: BLOCK 1 ; foreign host
>; End IFN SVRRTS
IFN NIORTS!SVRRTS,<
OPNBLK: 0
NETDEV: 'IMP',,0 ; device name
NTOBF,,NTIBF ; buffers
>; End IFN NIORTS!SVRRTS
;WATBLK WATSTS WATSKT INRBLK INRSTS INRSKT INSBLK INSSTS INSSKT WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT LSOCKT
; More data area, shared by USER and SERVER
; WAIT MTAPE block
WATBLK: 4 ; WAIT
WATSTS: BLOCK 1 ; returned status bits
WATSKT: BLOCK 1 ; socket number
; INTERRUPT MTAPE blocks
INRBLK: 11 ; SEND INTERRUPT
INRSTS: BLOCK 1 ; returned status bits
INRSKT: BLOCK 1 ; socket number
INSBLK: 11
INSSTS: BLOCK 1
INSSKT: BLOCK 1
; Other stuff
WHYWHY: BLOCK 1 ; host down word
↑IPHOST:BLOCK 1 ; ≠ 0 if host number in IP format
; 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
IFN MRKCHR,<
RMKBLK: 26 ; READ MARK
RMKSTS: BLOCK 1
RMKDAT: BLOCK 1 ; mark byte returned here
>; End IFN MRKCHR
; Base sockets, set up by CONECT and LISTEN
↑FSOCKT:BLOCK 1 ; foreign base socket
↑LSOCKT:BLOCK 1 ; local base socket
>; End IFN NIORTS
;⊗ CONECT .CONEC .CONC1
; CONECT -- Connect to foreign host
; Call: MOVEM <host number>,HOST
; MOVEM <ICP socket number>,ICPSKT
; 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. If IPHOST is 0 when CONECT is called, HOST is assumed to
; be in HOSTS2 format. If IPHOST is non-0, then HOST must be in IP format.
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: SKIPE IPHOST ; IP host number given?
TDZA 0,0 ; Yes, use default net (ARPA)
LDB [NW$BYT,,HOST] ; check network type
SETZ 1,
CAIN NW%SU ; Ethernet?
MOVEI 1,'PUP'
SKIPE 0 ; No net specified means ARPANet
CAIN NW%ARP ; ARPANet?
MOVEI 1,'IMP' ; yes, use IMP
JUMPE 1,[MOVE [360,,IOIMPM] ; if unknown name, fake an IMP code
MOVEM WHYWHY ; to indicate inaccessibility.
JRST CPOPJ1]
MOVSM 1,NETDEV ; specify device for OPEN
SETZ
CAIN 1,'PUP'
DPB [NW$BYT,,HOST] ; don't confuse PUPSER with network ID
SKIPN IPHOST
CAIE 1,'IMP'
JRST .CONC1 ; Jump if no host number conversion
PUSH 17,HOST ; Save old host number in case needed
MOVE 0,HOST
PUSHJ 17,H2TOIP ; Convert to IP address for IMP
CAIA ; Damn! Hope the system can handle this
MOVEM 0,HOST
.CONC1: OPEN NET,OPNBLK ; open NET in ASCII mode
FATAL Network device INIT failure
MTAPE NET,[17 ↔ CNTIMO]
SETOM CONLSK ; gensym local socket
SETOM CONWAT ; do wait until timeout
MTAPE NET,CONBLK ; connect → foreign server
SKIPN IPHOST
CAIE 1,'IMP'
CAIA ; Skip if no host number conversion
POP 17,HOST ; Get back old host number
MOVE CONLSK ; get gensymmed socket
MOVEM LSOCKT ; save local base socket
MOVE CONSTS ; check for MTAPE error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS NET, ; check for I/O error on proper channel
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal socket state?
POPJ 17,
MOVE CONFSK ; get socket we got
MOVEM CONFSK ; and save it back
MOVEM FSOCKT ; save foreign socket for later
MOVE CONLSK ; for completeness and compatibilty
MOVEM INSSKT
MOVEI =8 ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[17 ↔ TNTIMO]
MTAPE NET,[10]
CAI
JRST CPOPJ2
>; End IFE SVRRTS
;⊗ LISTEN .LISTE .LSTN1
; LISTEN -- Listen for an ICP from a foreign host
; Call: MOVEM <ICP socket number>,LSNSKT
; 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. If IPHOST is 0 when CONECT is called, HOST is returned in
; HOSTS2 format. If IPHOST is non-0, then HOST is returned in IP format.
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
MTAPE ICP,[17 ↔ LSTIMO] ; set timeouts
SETOM LSNWAT ; do wait until timeout
MTAPE NET,LSNBLK
CAIE 1,'IMP'
JRST .LSTN1
MOVE 0,LSNHST
PUSHJ 17,IPTOH2 ; Get host number in HOSTS2 format
CAIA ; Oh well, we tried
MOVEM 0,LSNHST
.LSTN1: 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 socket state?
POPJ 17,
MOVE LSNHST
MOVEM CONHST
MOVE LSNFSK
MOVEM FSOCKT ; save foreign base socket
MOVE LSNSKT ; remember local socket
MOVEM LSOCKT
MOVEM INSSKT ; for completeness, set this as well
MOVEI =8 ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[17 ↔ TNTIMO]
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
MTAPE DAT,[17 ↔ DATIMO]
.DATI1: MOVE LSOCKT
ADDI 4 ; ICP/U receive data offset
MOVEM CONLSK ; local receive socket
MOVE FSOCKT
ADDI 3 ; ICP/S transmit data offset
MOVEM CONFSK ; foreign transmit socket
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
MTAPE DAT,[17 ↔ DATIMO]
.DATO1: MOVE LSOCKT
ADDI 5 ; ICP/U transmit data offset
MOVEM CONLSK ; local receive socket
MOVE FSOCKT
ADDI 2 ; ICP/S receive data offset
MOVEM CONFSK ; foreign transmit socket
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
;⊗ NETICH NETICW NTICH2 NTICH4 NTICH3 NTICH1 NTIC1A
; 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: IBP NTIBF+1 ; increment pointer to hack
MOVE @NTIBF+1 ; get word to hack
ANDI 17 ; only marking bits
JFFO NTICH1 ; count leading zeros
LDB NTIBF+1 ; get the character
SKIPE NWKDBG
OUTCHR
JUMPN 2,CPOPJ1 ; NETICW only skips once
JRST CPOPJ2 ; NETICH good return
; Have to flush nulls here.
NTICH1: 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,NTIBF+2 ; remove padding characters from count
MOVNS NTIBF+2 ; SUBM goes the wrong way
SKIPE 1 ; maybe no adjustment necessary
NTIC1A: IBP NTIBF+1
SOJG 1,NTIC1A ; 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 @NTIBF+1 ; get word we are hacking
LSH (1) ; right justify its bytes
MOVEM @NTIBF+1 ; store it back again
JRST NTICH2 ; now try it again
;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>
; Smashes 0 and 1.
↑NETSND:
IFN ERRHAN,<
PUSHJ 17,.NETSN
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.NETSN: LDB 1,[410300,,NTOBF+1] ; get position field
MOVEI 1
LSH (1) ; AC0 ← 2↑<# of null characters>
SOS ; AC0 ← mask to flush nulls
IORM @NTOBF+1 ; ensure padding nulls aren't sent
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
; 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
;NETINR NETINS
; 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,
>; End IFN NIORTS
;MTPERR 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)
CLRBFI
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/
/]
TLNE 1,400000 ;Test for fatal error
JRST LUZBIG
TLNE 1,200000 ;Test for warning
MTPE1A: WARN
CLRBFI
POPJ 17,
;Bits in LH: 400000 if fatal error
; 200000 if warning
MERTAB: 200000,,[ASCIZ/Socket in use/]
200000,,[ASCIZ/Can't change socket/]
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/Connection was reset/] ;(11)
[ASCIZ/Can't get there from here/] ;(12)
400000,,[ASCIZ/Not enough internal buffer space/] ;(13)
[ASCIZ/Illegal host number/] ;(14)
[ASCIZ/Remote host down or not on net/] ;(15)
[ASCIZ/Timeout/] ;(16)
[ASCIZ/Destination net unreachable/] ;(17)
[ASCIZ/Destination host unreachable/] ;(20)
200000,,[ASCIZ/Destination protocol unreachable/] ;(21)
[ASCIZ/Destination port unreachable/] ;(22)
200000,,[ASCIZ/Fragmentation needed and DF set/] ;(23)
200000,,[ASCIZ/Source route failed/] ;(24)
200000,,[ASCIZ/Destination unreachable: unknown code/] ;(25)
MERLEN←←.-MERTAB
;NIOERR
; NIOERR -- Explain network I/O lossage
; Call: MOVE <I/O status bits>
; PUSHJ 17,NIOERR
; <return>
; Smashes 0, 1, and 2.
↑NIOERR:ANDI ERRBTS ; only error bits
SKIPN
FATAL No error status
CLRBFI
TRNE IOBKTL
FATAL Block too large
TRNE IOIMPM
OUTSTR [ASCIZ/Connection closed
/]
TRNE IODERR
OUTSTR [ASCIZ/Connection was reset
/]
TRNE IODTER
OUTSTR [ASCIZ/Timeout
/]
TRNE IODEND
OUTSTR [ASCIZ/Host closed connection
/]
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,]
cain 17 ; Funny code from CONECT for bad net?
JRST [ OUTSTR [ASCIZ/Host net is inaccessible
/]
POPJ 17,]
OUTSTR [ASCIZ/Communication prohibited!
/] ; 3 → host access prohibited
POPJ 17,]
OUTSTR [ASCIZ/Host dead, /]
LDB 1,[220400,,WHYWHY] ; dead host status
OUTSTR @(1)[ [ASCIZ/random lossage/]
[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
SETZ 2, ; 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 HSTMCH HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV SITLEN NMLSIT NMRNAM NAMLEN NW%CHS NW%ARP NW%RCC NW%DLN NW%DSK NW%LCS NW%SU NW$BYT
; Host table routines (HOSTS2)
IFN HSTTAB,<
;The format of the compiled HOSTS2 file is:
HSTSID←←0 ; wd 0 SIXBIT /HOSTS2/
HSTFN1←←1 ; wd 1 SIXBIT /HOSTS/ usually
HSTVRS←←2 ; wd 2 FN2 of HOSTS file which this was compiled from.
HSTDIR←←3 ; wd 3 SIXBIT /SYSENG/ usually, directory name of source file
HSTMCH←←4 ; wd 4 SIXBIT /AI/ (e.g.), device name of source file
HSTWHO←←5 ; wd 5 UNAME of person who compiled this
HSTDAT←←6 ; wd 6 Date of compilation as sixbit YYMMDD
HSTTIM←←7 ; wd 7 Time of compilation as sixbit HHMMSS
NAMPTR←←10 ; wd 10 Address in file of NAME table.
SITPTR←←11 ; wd 11 Address in file of SITE table.
NETPTR←←12 ; wd 12 Address in file of NETWORK table.
;....expandable....
;NETWORK table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
;This table contains one entry for each network known about, sorted
;alphabetically. A network number is bits 4.8-4.1 of a network
;address; these numbers are assigned by Jon Postel. See symbols below.
;The reason for keeping track of different networks is that the user
;program must make different system calls to use each network.
;Each entry contains:
NETNUM←←0 ; wd 0 network number
NTLNAM←←1 ; wd 1 LH - address in file of name of network
NTRTAB←←1 ; wd 1 RH - address in file of network's address table
NETLEN←←2
;ADDRESS table(s)
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
;There is one of these tables for each network. It contains entries
;for each site attached to that network, sorted by network address.
;These tables are used to convert a numeric address into a host name.
;Also, the list of network addresses for a site is stored
;within these tables.
;Each entry contains:
ADDADR←←0 ; wd 0 Network address of this entry (including network number).
ADLSIT←←1 ; wd 1 LH - address in file of SITE table entry
ADRCDR←←1 ; wd 1 RH - address in file of next ADDRESS entry for this site
; 0 = end of list
ADDLEN←←2
;SITE table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
;This table contains entries for each network site,
;not sorted by anything in particular. A site can have more
;than one network address, usually on different networks.
;This is the main, central table.
;Each entry looks like:
STLNAM←←0 ; wd 0 LH - address in file of official host name
STRADR←←0 ; wd 0 RH - address in file of first ADDRESS table entry for this
; site. Successive entries are threaded together
; through ADRCDR.
STLSYS←←1 ; wd 1 LH - address in file of system name (ITS, TIP, TENEX, etc.)
; May be 0 means not known.
STRMCH←←1 ; wd 1 RH - address in file of machine name (PDP10, etc.)
; May be 0 means not known.
STLFLG←←2 ; wd 2 LH - flags:
STFSRV←←400000 ; 4.9 1 means server site (according to NIC)
; wd 2 RH - not used
SITLEN←←3
;NAMES table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
;This table is used to convert host names into network addresses. It
;contains entries sorted alphabetically by host name.
NMLSIT←←0 ; lh address in file of SITE table entry for this host.
NMRNAM←←0 ; rh address in file of host name
;This name is official if NMRNAM = STLNAM of NMLSIT.
NAMLEN←←1
; All names are ASCIZ strings, all letters upper case.
; The strings are stored before, after and between the tables.
; All strings are word-aligned, and fully zero-filled in the last word.
;Network addresses are defined as follows, for purposes of this table:
; 4.9 0
; 4.8-4.1 network number
; Chaos net (number 7):
; 3.9-2.8 0
; 2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
; Arpa net (number 12): (note, old-format Arpanet addresses
; & BBN-RCCnet (number 3): never appear in the host table.)
; 3.9-3.8 0
; 3.7-2.1 Imp
; 1.9 0
; 1.8-1.1 Host
; Dialnet (number 26):
; 3.9-3.1 0
; 2.9-1.1 address in file of ASCIZ string of phone number
; LCSnet (number 22):
; 3.9 0
; 3.8-3.1 Subnet
; 2.9-1.9 0
; 1.8-1.1 Host
; SU net (number 44):
; 3.9-2.8 0
; 2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
↑NW%CHS←←7 ;Chaos net
↑NW%ARP←←12 ;Arpa net
↑NW%RCC←←3 ;BBN-RCCnet
↑NW%DLN←←26 ;Dialnet
↑NW%DSK←←777 ;DSKnet
↑NW%LCS←←22 ;LCSnet
↑NW%SU←←44 ;SUnet
↑NW$BYT←←331100 ;Byte pointer to network number
;Other network address formats accepted elsewhere:
;A network number of 0 defaults the network according to context. "Old
;format" Arpanet addresses, of the form 1.8-1.7 host, 1.6-1.1 IMP
;The host-table compiler assumes Arpanet if the network number is
;zero, and converts old format Arpanet addresses to new format. The
;NETWRK routines for accessing this table assume a network (for number
;zero) which depends on a program switch, and convert old format Arpa
;net addresses to new format. There will also be a program switch for
;which networks are allowed to be returned from a host name lookup.
;The ITS Arpanet software accepts addresses with or without the network
;number; if the network number is non-zero it must be 12(octal). The
;network number is not returned by the system. ITS accepts either old
;or new format addresses, and returns the old format whenever possible.
;The ITS CHAOS net software always inputs and outputs addresses in
;16-bit bytes, so the network number issue does not arise.
;Dialnet addresses are always ASCIZ strings.
;LCSnet addresses are in the form subnet/host, in octal.
IFN 0,< ;Old names used by HOSTS1 for use in conversion
; NUMBERS table
NUMNUM==0 ; host number
NUMSYS==1 ; LH pointer to system name
NUMNAM==1 ; RH pointer to official name of host.
NUMBTS==2 ; LH flags:
NUMSRV==400000 ; 4.9 → server site.
NUMMCH==2 ; RH pointer to machine name
; NAMES table
NAMNAM==0 ; <numbers pointer,,host name pointer>
>;IFN 0
;MAPHST
; MAPHST -- Map host table into core
; Call: PUSHJ 17,MAPHST
; <return>
; Smashes 0, 1, 2, and 3.
↑MAPHST:SKIPE HSTADR
JRST [ WARN Host table already mapped
POPJ 17,]
INIT 17
('DSK')
0
FATAL DSK INIT failure
DMOVE [SIXBIT/HOSTS2BIN/]
MOVE 3,['HSTNET']
LOOKUP ; find file HOSTS2.BIN[HST,NET]
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]
MOVE 2,JOBFF↑
MOVS 3 ↔ MOVN ↔ ADDB JOBFF↑ ; get address of highest addr we need
MOVEM HSTTOP
CORE ; get more core from system maybe
FATAL CORE UUO failure
MOVE 3 ↔ HRRI -1(2) ; compute IOWD to read host table in
SETZ 1,
INPUT
MOVE (2) ; get first word of host table
CAME ['HOSTS2']
FATAL Bad host table
MOVEM 2,HSTADR ; remember where host table begins
RELEAS
POPJ 17,
;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 ['HOSTS2']
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 HSTNU0 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>
; 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,['HOSTS2']
FATAL Bad host table
;Someone at MIT changed Ethernet host number format. I claim no resp. TVR/Dec82
ifn 1,< ;turned (back?) on by ME 1/4/83
ldb 2,[nw$byt,,0]
cain 2,nw%su ; *** Screwed up HOSTS2?
jrst [ ldb 2,[101100,,0] ; *** Perhaps
caig 2,77 ; *** Properly justified?
lsh 2,1 ; *** Sigh, patch it up!
dpb 2,[101100,,0]
jrst hstnu0 ]
>;ifn 1
CAILE 377 ; old style host?
JRST HSTNU0
DPB [170600,,] ; convert to new style
LSH -6
HSTNU0: LDB 4,[NW$BYT,,0] ; get network number
SKIPN 4 ; if none given, assume ARPANet
MOVEI 4,NW%ARP
DPB 4,[NW$BYT,,0] ; set network number if none
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,
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
SETZM HDBPTR ; no HDB
MOVEI 1,[ASCIZ/RANDOM-PLACE/] ; name for unknown hosts
SETZB 2,3
POPJ 17, ; failure
;HSTNAM CNTCHR
; HSTNAM -- Return descriptor block for a host name
; Call: MOVEI <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 (!!!).
↑HSTNAM:SKIPN 1,HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,['HOSTS2']
FATAL Bad host table
; Set up various AC's for hairy search below. 0 has a pointer to the input
; host, 1 has the host table pointer, 2 has the character count.
MOVE 2,NAMPTR(1)
ADD 2,HSTADR ; address of NAMES table
HRLO 1,(2) ; # of entries,,-1
EQVI 1,(2) ; -<1+# of entries>,,table-1
ADJSP 1,1 ; now have AOJBN pointer to table
MOVE 3,
HRLI 3,440700 ; make byte pointer
SETZ 2, ; character count
; Compute character count in AC 2
CNTCHR: ILDB 4,3
JUMPE 4,[ JUMPE 2,CPOPJ ; null specification loses
SETZB 3,4 ; init pointers
JRST SEARCH]
CAIL 4,"a" ; lowercase?
SUBI 4,"a"-"A"
DPB 4,3
AOJA 2,CNTCHR
;SEARCH SRCNXW SRCWIN SRCLUZ SRCDUN GOTNAM AMBNAM GETHDB
; Host name search
SEARCH: MOVEI 5,(2) ; copy of count
MOVE 6, ; copy of source pointer
HRRZ 7,(1)
ADD 7,HSTADR ; pointer for this entry
SRCNXW: MOVE 10,(7)
MOVE 11,(6)
ANDCMI 11,1 ; 1.1 is a loser
CAIL 5,=5 ; account for this word
JRST [ CAME 10,11 ; match for this word?
JRST SRCLUZ
SUBI 5,=5 ; match, account for this word
ADDI 7,1
AOJA 6,SRCNXW] ; still more to go
AND 11,[BYTE (7)000,000,000,000,000
BYTE (7)177,000,000,000,000
BYTE (7)177,177,000,000,000
BYTE (7)177,177,177,000,000
BYTE (7)177,177,177,177,000](5)
CAMN 10,11 ; exact match?
JRST [ HLRZ 1,(1) ↔ ADD 1,HSTADR
JRST GOTNAM] ; stop the presses!
SOJL 5,SRCWIN ; this string ends on word boundry
AND 10,[BYTE (7)177,000,000,000,000
BYTE (7)177,177,000,000,000
BYTE (7)177,177,177,000,000
BYTE (7)177,177,177,177,000](5)
CAME 10,11 ; match for partial word?
JRST SRCLUZ
SRCWIN: HLRZ 5,(1) ↔ ADD 5,HSTADR ; set up pointer to HDB
MOVE 6,2(5) ; NUMBTS
TLNE 6,STFSRV ; server?
JRST [ CAMN 3,5 ; all self-matches win
JRST SRCLUZ
SKIPE 3 ; somebody there?
TLOA 3,-1 ; yah, loser
MOVE 3,5 ; else remember the name
AOBJN 1,SEARCH ; keep on hunting
JRST SRCDUN] ; else done
CAMN 4,5 ; self-matcher?
JRST SRCLUZ
SKIPE 4 ; already seen a user?
TLOA 4,-1 ; remember can't be a user
MOVE 4,5 ; else remember the pointer
SRCLUZ: AOBJN 1,SEARCH ; maybe could be a server in there
; Search done, set up HDB ala HSTNUM and return
SRCDUN: SKIPN 1,3 ; use server if found one
MOVE 1,4 ; no server, maybe a user
JUMPE 1,CPOPJ ; no match at all
SKIPL 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.
HRRZ 3,STRADR(1) ; get address block
ADD 3,HSTADR
MOVE ADDADR(3) ; host number
HRRZ 3,ADRCDR(3) ; get other address(es), if any
ldb 2,[nw$byt,,0]
cain 2,nw%su ; *** Screwed up HOSTS2?
pushj 17,[ldb 2,[101100,,0] ; *** Perhaps
caile 2,77 ; *** Too big?
lsh 2,-1 ; *** Sigh, patch it up!
dpb 2,[101100,,0]
popj 17, ]
CAILE 377 ; old style host?
JRST GETHDB
DPB [170600,,] ; convert to new style
LSH -6
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
TLNN 1,-1
JRST [ ADD 1,HSTADR ; case of unknown system name
POPJ 17,]
ADJSP 1,@HSTADR
POPJ 17, ; and return
;HSTNXA HSTNU0 HSTNU1 HSTNU2
; 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,['HOSTS2']
FATAL Bad host table
JUMPE 3,[ SETZ 0, ; if no addresses left, fail
POPJ 17,]
ADD 3,HSTADR
MOVE 0,ADDADR(3) ; get this address
push 17,2
ldb 2,[nw$byt,,0]
cain 2,nw%su ; *** Screwed up HOSTS2?
pushj 17,[ldb 2,[101100,,0] ; *** Perhaps
caile 2,77 ; *** Too big?
lsh 2,-1 ; *** Sigh, patch it up!
dpb 2,[101100,,0]
popj 17, ]
pop 17,2
HRRZ 3,ADRCDR(3) ; get other address(es), if any
AOS (17)
POPJ 17, ; failure
;SETANM SETAN1 SETAN0 SETAN2 SETAN4 SETAN5 SETAN6 SETAN7 SETAN8
; 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
SKIPN 1,HDBPTR
JRST [ MOVE ['RANDOM']
JRST SETAN8]
MOVE 2,HSTADR
HRRZ 2,NAMPTR(2) ; get address of NAMES table.
ADD 2,HSTADR
MOVE 3,(2) ; number of entries in the table.
SETOB 4,5 ; 4 ← longest name ≤ 6 chars, 5 ← length
JRST SETAN0
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
MOVE 5,HDBPTR
ADD 5,HSTADR ; no short name, truncate official one
MOVEI 4,"-" ; also, will remove hyphens from it
HLRZ 5,STLNAM(5)
ADD 5,HSTADR ; pointer to name
SETAN5: MOVE 2,5
HRLI 2,440700 ; get BP to name string.
MOVSI 1,440600
SETZ ; 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 "-"
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 -1
IORI '.'
SETO 1,
GETLIN 1
AOSN 1 ; don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
>; End IFN HSTSIX
>; End IFN HSTTAB
;⊗ H2TOIP H2ARP H2ARP1 H2ARP2 H2SU
; H2TOIP -- Convert HOSTS2-format address to IP address
; Call: MOVE 0,<HOSTS2 address>
; PUSHJ 17,H2TOIP
; <error return--unable to convert>
; <return--IP address in 0>
↑↑H2TOIP:
PUSH 17,1
LDB 1,[NW$BYT,,0]
SKIPN 1
MOVEI 1,NW%ARP ;Default to ARPA
CAIN 1,NW%ARP ;ARPA?
JRST H2ARP
CAIN 1,NW%SU ;SU-Net?
JRST H2SU
POP 17,1 ;We don't know how to do this one
POPJ 17,
H2ARP: DPB 0,[311000,,0] ;Move host number to left of IMP
LSH 0,-11 ;Right-align IMP in word
H2ARP1: DPB 1,[301000,,0] ;Include net number
H2ARP2: POP 17,1
JRST CPOPJ1
H2SU:
IFN 1,< ;This code is for SU-NET-TEMP (net 36.0.0.0)
DPB 0,[341000,,0] ;Copy host number
ROT 0,10 ;Put subnet and host in place
AND 0,[000077,,600377] ;Zero everything else
JRST H2ARP1
>;IFN 1
IFN 0,< ;This code is for SU-NET (net 128.12.0.0)
MOVEI 1,100014 ;Get new net number
DPB 1,[202400,,0] ;Overwrite old net number
JRST H2ARP2
>;IFN 0
;⊗ IPTOH2 IPTH2A IPARP IPARP1 IPSU
; IPTOH2 -- Convert IP address to HOSTS2-format address
; Call: MOVE 0,<IP address>
; PUSHJ 17,IPTOH2
; <error return--unable to convert>
; <return--HOSTS2 address in 0>
↑↑IPTOH2:
PUSH 17,1
PUSH 17,2
LDB 1,[301000,,0] ;Get 1st byte
LDB 2,[202000,,0] ;Get 1st and 2nd bytes
CAIN 1,NW%ARP ;ARPA?
JRST IPARP
IFN 1,< ;This code is for SU-NET-TEMP (net 36.0.0.0)
CAIN 1,NW%SU ;SU-Net?
>;IFN 1
IFN 0,< ;This code is for SU-NET (net 128.12.0.0)
CAIN 2,100014 ;SU-Net?
>;IFN 0
JRST IPSU
;If not ARPA or SU-Net, return non-skip.
IPTH2A: POP 17,2
POP 17,1
POPJ 17,
IPARP: ANDI 0,177777 ;Get just IMP number
LSH 0,11 ;Shift into place
DPB 2,[001000,,0] ;Deposit host number
IPARP1: DPB 1,[331000,,0] ;Deposit net number
AOS -2(17) ;Set skip return
JRST IPTH2A
IPSU:
IFN 1,< ;SU-NET-TEMP
ANDI 0,377 ;Get just host number
DPB 2,[101000,,0] ;Deposit subnet number
JRST IPARP1
>;IFN 1
IFN 0,< ;SU-NET
ANDI 0,177777 ;Get address
MOVEI 1,NW%SU ;HOSTS2's number for SU-NET
JRST IPARP1
>;IFN 0
;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.
/]
POPJ 17,
; Fatality!
↑LUZBIG:OUTSTR [ASCIZ/
Find a wizard.
/]
JRST 4,WARNIN
..NLIT: LIT
;Export these things (put here, so that entire definition page can be just
;recopied if we ever change to HOST3)
↑NW%ARP←←NW%ARP
↑NW%SU←←NW%SU
↑NW$BYT←←NW$BYTE
BEND NETWRK