;-*- Mode:MIDAS; -*-

; Netwrk subroutines
;	Canonical location is [MIT-AI] SYSNET;NETWRK >
;	All changes must be made or copied to this location,
;		or they will be lost!
;
; New version partially fixed for HOSTS3, 2/17/83. --KLH
; ITS/20X version, 4/8/83. --Ian
;
;	$$ARPA is understood to mean Internet; any address with NE%UNT off
;	qualifies as an Internet address.
;
;***************************************************************************
;******* In order to help clean things up and keep stuff working,
;******* please enter here the names of any programs you are aware of
;******* which insert this file!  This will assure that future changes
;******* will not break your favorite software.
;	AI:SYSENG;CRTSTY
;	AI:SYSENG;TELSER
;	AI:SYSEN1;HSTLOK
;	AI:SYSEN1;PWORD
;	AI:SYSEN1;UP
;	AI:SYSEN2;PEEK
;	AI:SYSEN2;TELNET
;	AI:KSC;COMSAT
;	AI:SYSNET;FTPS
;	AI:SYSNET;FTPU
;	AI:KSC;QMAIL
;	MX:MT;NTELSUP
;	AI:SYSEN1;SENDER
;	AI:BAWDEN;PROBE
;	AI:SYSENG;DUMP


IFNDEF ITS,[
  IFE .OSMID-SIXBIT/ITS/,ITS==1
  .ELSE ITS==0
];IFNDEF ITS
IFNDEF 20X,[
  IFE .OSMID-SIXBIT/TWENEX/,20X==1
  .ELSE 20X==0
];IFNDEF 20X
IFNDEF 10X,[
  IFE .OSMID-SIXBIT/TENEX/,10X==1
  .ELSE 10X==0
];IFNDEF 10X
TNX==20X\10X	; This is the normally used switch.

.AUXIL		;Don't mention all my symbols in crefs of programs that use me.

.BEGIN NETWRK

;Calling Conventions:
;
;All subroutines herein are called by PUSHJ P,
;and take their skip return if successful, non-skip if error.
;Arguments are passed in ACs A,B,C,D,E.  ACs T and TT are freely smashable.
;However, "low level" subroutines generally take arguments and
;return values in T and TT and leave A-E alone.
;Subroutines may alter A-E as documented with each routine.
;The only ACs assumed are A,B,C,D,E,T,TT,P.  TT=T+1 is assumed.
;
;The following externally defined symbols are assumed:
;
;GETCHR	Routine to read character for HOSTNM/SYMGET routine.
;	Returns in T, clobbers TT, skip return unless no chars available.
;
;PUTCHR	Routine to write character for HOSTNM/SYMGET and ANALYZE routines.
;	Char is passed in T (!!).  Mustn't clobber any ACs.  Never skips (!!).
;
;SPCHAN	Routine to handle special characters for HOSTNM/SYMGET.
;	Char is passed in T, number so far read in TT.
;	Non-skip return to restart reader, skip to ignore char.
;
;DEBUG	Nonzero if debugging.  SERVE doesn't time out, and .VALUE'S
;	if anything bad happens.
;
;The usual values for ITS predefined symbols are assumed.
;
;The NETWRK subroutines are enclosed in a MIDAS begin block to avoid
;confusion in the local tags.  All code produced is pure.  Any impure
;locations needed are created as MIDAS variables (eg, .VECTOR).

;Print file version
	.TYO6 .IFNM1
	.TYO 40
IFN ITS,.TYO6 .IFNM2
IFN TNX,[
DEFINE TYPN ARG
PRINTX "ARG"
TERMIN
RADIX 10.
	TYPN \.IFVRS
RADIX 8.
] ;TNX
	PRINTX / included in this assembly.
/

qmtch==.qmtch	;In case the .INSRTer didn't have this set, turn it on so that
.qmtch==-1	;we use "foo" construct, for other-assembler compatability.

;The following symbols are used to select only necessary routines

IFNDEF $$HST3,   $$HST3==1		; 1 = use HOSTS3 format and file.
IFNDEF $$HOSTNM, $$HOSTNM==0		;Host name file lookup routines.
IFNDEF $$SYMGET, $$SYMGET==0		;Interactive symbol input routine
IFNDEF $$SYMLOOK,$$SYMLOOK==0		;table lookup routine.
IFNDEF $$HSTMAP, $$HSTMAP==0		;HSTMAP, HSTUNMAP, HSTSRC host name table rts
IFNDEF $$HSTSIX, $$HSTSIX==0		;Sixbit host name abbreviation
IFNDEF $$MIT,	 $$MIT==1		;Flush "MIT-" in HSTSIX
IFNDEF $$OWNHST, $$OWNHST==0		;Routine to get own host address
IFNDEF $$HSTCMP, $$HSTCMP==0		;Routine to compare two host addresses
IFNDEF $$NETSRC, $$NETSRC==0		;NETSRC routine to get network names
IFNDEF $$ICP,	 $$ICP==0		;Initial Connection Protocol
IFNDEF $$SERVE,  $$SERVE==0		;Respond to an ICP (for a server)
IFNDEF $$SYSDBG, $$SYSDBG==0		;ARPSRV, CHASRV shouldn't handle SYSDBG itself
IFNDEF $$CONNECT, $$CONNECT==0		;Network Connection Routine (ARPCON, CHACON)
IFNDEF $$SIMPLE, $$SIMPLE==0		;Simple-transaction for Chaosnet
IFNDEF $$ANALYZE, $$ANALYZE==0		;Network Error Analysis Routine
IFNDEF $$ERRHAN, $$ERRHAN==0		;Automatic ANALYZE in ARPCON, CHACON, etc.
IFNDEF $$LOGGING, $$LOGGING==0	   	;Network library usage logging
IFNDEF $$UPTM,	 $$UPTM==1		;ANALYZ should give estimated time up again
IFNDEF $$CVH,	$$CVH==0		;1 to include host number conversions

IFNDEF $$LOOK,	 $$LOOK==0		;1 to support no network (just lookups)
IFNDEF $$CHAOS,	 $$CHAOS==0		;1 to support Chaosnet hosts and rtns
IFNDEF $$ARPA,	 $$ARPA==0		;1 to support Arpanet hosts and rtns
IFNDEF $$TCP,	 $$TCP==0		;1 to support /TCP switch & routines
IFN $$TCP*$$SYMLOOK,[
  $$ARPA==1			;arpa must be set for TCP to work here
  ]
IFNDEF $$ALLNET,[		; 1 for lookup rtns to support all nets
	IFE $$HST3,$$ALLNET==0	; Including ones ITS doesn't handle.
	.ELSE $$ALLNET==$$ARPA
  ]

IFN $$ARPA,[
IFNDEF ARPHST, .SCALAR ARPHST
]

IFN $$TCP,[
IFNDEF USENCP, .SCALAR USENCP
IFNDEF USETCP, .SCALAR USETCP
 ]

IFNDEF $$PROMPT, $$PROMPT==1		;1 to use default prompt "Host: "
IFNDEF $$TCPTO, $$TCPTO==15.*30.
IFNDEF $$CHATO, $$CHATO==15.*30.

;;; Summary of entry-points and calling sequences.
;;; Note that all routines listed here skip-return on success, clobber T and TT.
;;;
;;; SYMGET(E:table_p) => A:symbol_value, B,C,D,E:junk
;;; SYMLOOK(A:input, E:table_p) => B:result_descr, T:numeric_value
;;; HSTMAP(A:page#, B:channel#) => RH(A):next_free_page
;;; HSTUNMAP()
;;; HSTSRC(B:host#) => A:TIP_flag,,name_p, D:site_p
;;; HOSTNM() => A:host#, TT:network#, B,C,D,E:junk
;;; HSTLOOK(A:input) => A:host#, TT:network#, B:result_desc, E:junk
;;; HSTSIX(A:host#) => A:sixbit_host_name
;;; OWNHST(A:network#) => A:host#  (address of this machine on that network)
;;; HSTCMP(A:host#,B:host#) => skip iff 2 hosts are the same
;;; NETSRC(B:net#) => A:name_p
;;; ARPICP(A:pin#, B:host#, C:socket#, D:imode,,omode) => clobbers all, opens pin+2,pin+3
;;; ICPASN(A:pin#, B:host#, C:socket#, D:imode,,omode, E:phase#)
;;; ARPSRV(A:pin#, B:socket#, C:imode,,omode) => B:host#, C:sysdbg, A,D:junk, opens pin+2,+3
;;; ARPCON(A:pin#, B:host#, C:frn_socket#, D:async,,mode)
;;; CONFIN(A:pin#, , , D:mode)
;;; CHASRV(A:channel#, C:contact_name_p, D:window_size) => B:host#, C:sysdbg, A,D:junk
;;; CHACON(A:channel#, B:host#, C:contact_name_p, D:window_size)
;;; CHASMP(A:channel#, B:host#, C:request, D:answer)
;;; CHALSN(A:channel#, B:zero_or_host#, C:contact_name_p, D:window_size)
;;; TCPCON(A:channel#, B:host#, C:port#)
;;; TCPSRV(A:channel#, B:port#) => B:host#, C:sysdbg, A,D:junk
;;; ANALYZE(A:channel#) => prints error message, with no CRLF

IFE $$LOOK+$$CHAOS+$$ARPA, .FATAL You have to specify at least one network
IFN $$ERRHAN,$$ANALYZE==1
IFN $$SYMGET,$$SYMLOOK==1
IFN $$HOSTNM,$$HSTMAP==1
IFN $$HSTCMP,$$HSTMAP==1
IFN $$SIMPLE,$$CONNECT==1

DEFINE $$LOG
IFN $$LOGGING!TERMIN

$$LOG,[
IFE ITS, .ERR Sorry the LOGging feature is only supported under ITS
;;; For logging connections.  Example:   LOG OPEN,[B,C]
DEFINE	LOG NETOP,CRUFT
%%ZZ==1
PUSHJ P,[ PUSH P,A
	  PUSH P,[SIXBIT /NETOP/]
  IRP CRUFTY,,[CRUFT]
	  MOVE A,CRUFTY
	  PUSH P,A
	%%ZZ==%%ZZ+1
  TERMIN
	  MOVEI A,%%ZZ
	  PUSHJ P,NETWRK"LOGACT
  REPEAT %%ZZ, POP P,A
	  POP P,A
	  POPJ P, ]
TERMIN
];$$LOG

NE%UNT==:<1_32.>	; Escape bit indicating non-Internet address
IFN $$HST3,[
NW$BYT==:301400		; Byte pointer to network number (approx!)	
NE%STR==:<1_33.>	; Escape bit indicating string-type address
			; Useful HOSTS3 full word network # values
NW%CHS==:<NE%UNT+<7_24.>>	; CHAOSNET
NW%ARP==:<10._24.>		; ARPANET
NW%MIL==:<26._24.>		; MILNET
NW%LCS==:<18._24.>		; MIT-LCS (18)
NW%AI==:<20015,,>		; MIT-AI-NET (128.52)

; Corresponds to kludge in HOSTS3 that reduces the size of the network table.
DEFINE GETNET AC,(ADDR)
IFNB [ADDR] MOVE AC,ADDR
	TDZ AC,[<1_24.>-1]
TERMIN

IFN 0,[
DEFINE GETNET AC,(ADDR)
IFNB [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
TERMIN
] ;IFN 0

] ;$$HST3
.ELSE [		; HOSTS2 format stuff
NW%CHS==:7	;Chaos net
NW%ARP==:12	;Arpa net
NW%LCS==:22	;LCS net
;NW%DLN==:26	;Dial net (not supported by these routines)
NW$BYT==:331000	; Byte pointer to network number

DEFINE GETNET AC,(ADDR)
	LDB AC,[NW$BYT,,ADDR]
TERMIN
] ;HOSTS2

IFN $$CHAOS,[
 IFNDEF $CPKOP,[
  IFN ITS, .INSRT SYSTEM; CHSDEF >
  .ELSE    .INSRT SYSTEM:CHSDEF
  ]
]
IFN ITS,[
.CALL==43_33			;IN CASE OUR .INSRT'ER USES CALRET .CALL MACRO.
DEFINE SYSCAL NAME,ARGS
.CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))]
TERMIN
];ITS

POP2J:	SUB P,[1,,1]		;Exits used in a few places.
POP1J:	SUB P,[1,,1]
CPOPJ:	POPJ P,

POPJ1:	AOS (P)
	POPJ P,

IFNDEF NWLOSS,[	; SO .INSRT'ER CAN SUBSTITUTE SOMETHING FOR LOSSAGE CHKS
IFN ITS,[
DEFINE NWLOSS
  .LOSE
TERMIN
];ITS
IFN TNX,[
DEFINE NWLOSS
  HALTF
TERMIN
];TNX
];NWLOSS

IFN $$SYMGET+$$SYMLOOK,[
.SCALAR HSTNMF			;Document these!
.SCALAR NOABRV
.SCALAR NTSPCF
]

IFN $$SYMGET,[

;Interactive symbol readin and lookup.
;
; Call:	MOVE E,TABLEP
;	PUSHJ P,SYMGET
;	 error
;	value of symbol now in A.
;
;Smashes B, C, D, E, T, TT.
;
; TABLEP should be an aobjn ptr to the table
; of symbols from which user input is to select.
; Num is an arbitrary 18-bit field derived from the table.
; The format of the table is:
;	[asciz/prompt string/]
;  -->	value1,,[asciz/upper-case-symbol-1/]
;	value2,,[asciz/upper-case-symbol-2/]
;	. . .
; Note that this table is an argument to the SYMGET entry.  The
; HOSTNM entry uses the table from the HOSTS3 file, not in the same format.
;
;Subroutines used:
;	GETCHR, PUTCHR, SPCHAN (see previous page for call sequences)
;
; GETCHR subroutine to get a character (1 arg)
; PUTCHR subroutine to type a character (1 arg).
;	   input is echoed/completed through PUTCHR
; SPCHAN if a character other than a letter, a number,
;	  a hyphen, a period, a space, or a CR is seen,
;	   SPCHAN is called with the char in T.  Variable NUMGOT
;		will have value of number read thus far (-1 if none).
;		Non-skip return restarts reader, skip return ignores char
;		and continues.
;

.VECTOR RCPBUF(6)		;input buffer for this routine
.SCALAR CHRCNT,NUMGOT

;Register Usage
;
;A	octal host number accum  -  scratch, if reading name.
;B	decimal host number accum  -  scratch, if reading name.
;C	scratch.
;D	byte pointer into input buffer
;E	(aobjn) pointer to table
;T	character or random data
;TT	miscellany

IFN $$PROMPT,[
PROMPT:	[ASCIZ /Host: /]	; default prompt
]; IFN $$PROMPT

SYMGET:		;interactive symbol input routine, with completion.
	SETZM HSTNMF	;Say we are not using the host names table (it has no prompt string).
HSTNM1: REGO:
	SKIPN HSTNMF
	 SKIPA TT,-1(E)	;prompt
	  MOVE TT,PROMPT
	PUSHJ P,ZTYPE
GO3A:	MOVEI D,RCPBUF	;PTR TO SPEC STRING
	HRLI D,440700	;PTR INTO COLLECTED STRING
	SETZM CHRCNT	;COUNT OF CHARS IN STRING
	SETOM NUMGOT	; Value of number read thus far

GO1:	PUSHJ P,GETCHR	;GET INPUT CHARACTER
	 MOVEI T,^M	;NO CHARS AVAIL SAME AS A CR.
	JUMPE T,GO1	;IGNORE NULLS.
	CAIL T,"a"
	CAILE T,"z"
	 CAIA		;NOT LOWER CASE
	  SUBI T,40	;CONVERT LOWER CASE TO UPPER
	CAIE T,12
	CAIN T,15
	 JRST GOTRM	;E-O-L MEANS USER DONE WITH SPEC.
	CAIN T,40
	 JRST GOTRM0	;SPACE COMPLETE BUT DON'T TERM
	CAIN T,177	;RUBOUT CAUSES COMPLETE RESTART
	 JRST [	MOVEI TT,[ASCIZ\?
\] ?		PUSHJ P, ZTYPE
		JRST REGO ]
	CAIE T,"?"
	CAIN T,33	;? OR ALT MEANS LIST ALL POSSIBLE HOSTS,
	 JRST GOTALT	;GIVEN TYPEIN THUS FAR.
	JRST GOTC

BAD1:	SUB P,[1,,1]
BAD:	MOVEI T,7	;IF BAD CHAR GIVEN, DING BELL.
GOECH:	PUSHJ P,PUTCHR
	JRST GO1

;GOT A CHARACTER.  IS EITHER SPECIAL OR PART OF A NAME

GOTC:	CAIN T,"-"	;BY SPECIAL DISPENSATION, HYPHEN
	 JRST GOTC00
	CAIN T,"."	; Also allow period as part of name
	 JRST GOTC00
	CAIN T,"/"	;SLASH AT THIS LEVEL IS JUST A CHARACTER
	 JRST GOTC00	;SYML1 WILL HANDLE HOST/IMP AND ADDRESS/NETWORK-NAME CONSTRUCTS
	CAIGE T,"0"	;NUMBERS
	 JRST SPECL
	CAIG T,"9"
	 JRST GOTC00
	CAIGE T,"A"	;LETTERS
	 JRST SPECL
	CAIG T,"Z"
	 JRST GOTC00
;OTHERWISE SPECIAL CHARACTER, HANDLE IT
SPECL:	MOVE TT,A
	PUSHJ P,SPCHAN
	 JRST GO3A	;RESTART FROM THE BEGINNING
	JRST GO1	;IGNORE THIS CHAR

;GOT A CHAR.  STORE IF IT PLUS STRING THUS FAR MATCHES A NAME, DON'T STORE IF NOT.
;CHAR (NOT ECHOED YET) IS IN T.
GOTC00:	PUSH P,D	;PREPARE TO FLUSH THE CHAR IF IT MAKES AN UNDEF SYMBOL.
	IDPB T,D	;STORE CHAR IN STRING, FOLLOWED BY A NULL.
	PUSH P,D
	SETZ TT,
	IDPB TT,D
	POP P,D
	AOS CHRCNT	;INCREMENT COUNT OF CHARS IN STR.
	PUSH P,T
	MOVEI A,RCPBUF
	PUSHJ P,SYML1	;SEARCH THE TABLE FOR THIS STRING.
	 JFCL
	CAIGE B,
	 MOVEM T,NUMGOT	; Store number got thus far.
	POP P,T
	POP P,TT
	JUMPN B,GOECH	;NUMBER, OR SYMBOL FOUND OR AMBIGUOUS => THIS CHARACTER IS OK.
	SETZ TT,	;SYMBOL UNDEFINED => ZERO OUT THIS CHAR IN THE STRING
	DPB TT,D
	MOVE D,TT	;BACK UP POINTER TO END OF STRING
	SOS CHRCNT
	JRST BAD	;AND COMPLAIN.

;GOT A E-O-L, SEE IF HAVE ENOUGH OF NAME TO RENDER IT UNIQUE.
GOTRM:	TDZA C,C	;COMPLETE AND TERMINATE
GOTRM0:	 SETOM C	;JUST COMPLETE
	SKIPG CHRCNT	;HMMM, ANYTHING IN STRING STORED?
	 JRST BAD	;NO, DING...
	MOVEI A,RCPBUF	;ELSE LOOK THE STRING UP.
	PUSHJ P,SYML1
	 JRST BAD	;UNDEFINED OR AMBIGUOUS => LOSE.
	MOVE A,T
	MOVE TT,B	;NUMBER => OK, AND DON'T TYPE ANYTHING.  RETURN NUMBER IN A.
	AOJE TT,WIN
	HRRZ TT,(B)	;FOUND AND UNAMBIGUOUS.  COMPLETE THE NAME IF ABBREVIATED.
	SKIPE HSTNMF
	 ADD TT,HSTADR	;GET POINTER TO THE FULL NAME.
	HRLI TT,440700
	MOVE A,CHRCNT
	ILDB T,TT	;IGNORE AS MANY CHARS AS THE USER ACTUALLY GAVE.
	JUMPE T,GOTRM2	;HANDLE USER ABBREVIATION AND /NET FORMS RIGHT
	SOJG A,.-2
GOTRM1:	ILDB T,TT
	JUMPE T,GOTRM2
	IDPB T,D	;AS WE COMPLETE THE NAME, STORE THE CHARS INTO THE ARG
	AOS CHRCNT	;SO THAT IF THIS IS A SPACE, THE FOLLOWING CR DOESN'T
	PUSHJ P,PUTCHR	;TYPE THE SAME STUFF OUT AGAIN.
	JRST GOTRM1

GOTRM2:	HLRZ A,(B)	;WIN.  RETURN LH. OF TABLE WORD.
	SKIPE HSTNMF	;NORMALLY IS SYMBOL VALUE, BUT IF READING HOST NAME, IS FILE-
	 SETO TT,	;RELATIVE ADDRESS OF SITE TABLE ENTRY, TT NON-ZERO MEANS NOT NUMBER
WIN:	JUMPN C,GO1	;SHOULD TERMINATE?  NO => GO READ MORE CHARS.
	PUSHJ P,CRLF	;YES, GIVE CRLF
	JRST POPJ1	;AND RETURN WINNING NUMBER IN A

;GOT ? OR ALT, LIST ALL NAMES POSSIBLE AT THIS STAGE.
GOTALT:	SKIPN CHRCNT
	 JRST GO1	;ALTMODE OR ? AFTER A NUMBER IS A NO-OP.
	MOVEI A,RCPBUF
	SETOM NOABRV
	PUSHJ P,SYMLA	;SEARCH FOR ALL POSSIBLE ALTERNATIVES.
	 JFCL
	TLNN B,-1
	 HRLS B		;IF ONLY ONE, SET IT UP AS RANGE  <ONLY ONE>,,<SAME ONE>.
	MOVE TT,B
	AOJE TT,GO1	;IF ARG IS A NUMBER, DON'T TYPE ANYTHING.
	PUSHJ P,CRLF
	HLRZ A,B	;A POINTS TO FIRST, RH(B) POINTS TO LAST.
GOTAL1:	HRRZ TT,(A)	;GET THE ADDR OF THE NEXT POSSIBLE MATCH'S NAME STRING
	SKIPE HSTNMF
	 ADD TT,HSTADR
	PUSHJ P,ZTYPE	;TYPE IT.
	PUSHJ P,CRLF
	ADDI A,1
	CAIG A,(B)
	 JRST GOTAL1
	SKIPN HSTNMF	;GIVE PROMPT STRING AGAIN
	 SKIPA TT,-1(E)
	  MOVE TT,PROMPT
	PUSHJ P,ZTYPE
	MOVEI TT,RCPBUF	;FOLLOWED BY THE ARG CHARS WE HAVE SO FAR.
	PUSHJ P,ZTYPE
	JRST GO1

] ;END IFN $$SYMGET

IFN $$SYMLOOK,[

; SYMLOOK - Non-incremental hostname/hostaddr (symbol) lookup routine
;		called by the incremental one.
;Numbers are normally octal, but a "." at the end implies decimal.
;Decimal host slash decimal Imp and any address slash network name are allowed.
; The decimal "octet" form is allowed, right justified.
;In the address slash network-name form, the argument is smashed then restored!
;
				;	A/ <BP to ASCIZ string>		; Can also be 0,,<addr> or -1,,<addr>
;	E/ <AOBJN to table>		; e.g. -tablelen,,table
; Returns .+1 if fail:
;	B/ 0 for an undefined sym, or <first>,,<last> for an ambiguous one.
; Returns .+2 if won:
;	B/ addr of table entry for symbol we found.
;	or -1 if argument was a number; value returned in T.
; Clobbers T, TT.

SYMLOOK:
	SETZM HSTNMF
SYML1:	SETZM NOABRV
SYMLA:	PUSH P,C
	PUSH P,D
	HLRZ TT,A
	SKIPE TT		;If A is an address,
	  CAIN TT,-1		;or HRROI-style TWENEX string pointer,
	    HRLI A,440700	;then turn into canonical PDP-10 BP
	MOVE TT,A
	MOVE T,A
	ILDB T,T		;First character of string
	CAIL T,"0"		;Is the argument a number (starts with a digit)?
	 CAILE T,"9"
	  JRST SYML6
	SETZB C,D		;Yes => accumulate octal number in C, decimal in D.
SYML7:	ILDB T,TT
	CAIL T,"0"
	 CAILE T,"9"
	  JRST SYML8
	IMULI C,10
	IMULI D,10.
	ADDI C,-"0"(T)
	ADDI D,-"0"(T)
	JRST SYML7

SYML8:	CAIN T,"/"
	 JRST SYMSL1		;Digits followed by slash
	CAIE T,"."		;Out of digits => "." means use the decimal number
	 JRST SYML9		;(else use the octal).
	MOVE C,D
	ILDB T,TT
	CAIN T,"/"		;OK to have both a decimal point and a slash
	 JRST SYMSL1
	JUMPE T,SYML9
	CAIL T,"0"		; Another number?
	 CAILE T,"9"
	  JRST SYML9

	; Aha, have num.num so keep going in this vein.
	MOVEI D,-"0"(T)		; Initialize D with 1st digit of 2nd number
SYML41:	ILDB T,TT
	CAIL T,"0"
	 CAILE T,"9"
	  JRST [LSH C,8.
		ADDI C,(D)
		SETZ D,
		CAIN T,"."
		 JRST SYML41
		CAIN T,"/"
		 JRST SYMSL1
		JRST SYML9]
	IMULI D,10.
	ADDI D,-"0"(T)
	JRST SYML41

SYML9:	JUMPN T,SYMUND		;Any stray chars after the last digit or the "." => error.
	MOVE T,C
	SETO B,			;Return the number in T and -1 (=> this is a number) in B.
	JRST SYMWIN

SYMSL1:	SKIPN HSTNMF		;Slash only magic if hacking hosts
	 JRST SYML9
	ILDB T,TT		;Look at character after slash
	CAIL T,"0"
	 CAILE T,"9"
	  JRST [ADD TT,[070000,,]  ; Back up byte-pointer
	 	PUSHJ P,SYMSL4	   ; Process slash network-name.
		SETZ T,
		JRST SYML9 ]

IFE $$ARPA, JRST SYML9
IFN $$ARPA,[
	MOVE C,D		;Number slash number, use decimal
	MOVEI D,-"0"(T)
SYMSL2:	ILDB T,TT
	CAIL T,"0"
	 CAILE T,"9"
	  JRST [
IFN $$HST3,[	LSH C,16. ? DPB D,[002000,,C]	; Move HOST over and add IMP
		ADD D,[NW%ARP]
		MOVE TT,[NW%ARP]
		MOVEM TT,NTSPCF

];$$HST3
.ELSE [		DPB D,[112000,,C]	;Deposit IMP number into HOST number
		MOVEI D,NW%ARP		;And this is obviously Arpa net
		DPB D,[NW$BYT,,C]
];HOSTS2
		JRST SYML9 ]
	IMULI D,10.
	ADDI D,-"0"(T)
	JRST SYMSL2
];$$ARPA


;;Subroutine to read network name and set NTSPCF to network number
;; Note if HOSTS3 this is a full-word value.
IFE $$ALLNET,[

SYMSL4:	MOVEI D,0
SYMSL5:	ILDB T,TT
	JUMPE T,SYMSL6
	LSH D,6
	CAIL T,"a"
	 SUBI T,40
	IORI D,-40(T)
	JRST SYMSL5

SYMSL6:	IRPS FLAG,,[$$CHAOS $$ARPA $$TCP  $$TCP
	    ]NAME,,[CHAOS   ARPA   TCP	  NCP
	     ]NUM,,[NW%CHS  NW%ARP NW%ARP NW%ARP]
IFN FLAG,[			;Make sure we claim to support this network
	 MOVE TT,[SIXBIT \NAME\]
	 PUSHJ P,SYMSXC
	  MOVE T,[NUM]		;Prefix -- set it
];FLAG
	 TERMIN
IFN $$TCP,[
	MOVE TT,[SIXBIT \TCP\]
	PUSHJ P,SYMSXC
	 JRST [	SETOM USETCP
	        SETZM USENCP
		JRST .+1]
	MOVE TT,[SIXBIT \NCP\]
	PUSHJ P,SYMSXC
	 JRST [	SETOM USENCP
	        SETZM USETCP
		JRST .+1]
]
	JUMPE T,[POP P,T ? JRST SYMUND]	;Unknown network name, barf
	MOVEM T,NTSPCF
	POPJ P,

;; Compares sixbit arg in D with sixbit Network name in TT.
;; Returns .+1 if arg is prefix of net name
;;	   .+2 otherwise

SYMSXC:	PUSH P,D
	JUMPE D,SYMSX1	; Don't loop forever if arg is 0
	TLNN D,770000	; Shift until high byte is non-zero
	 JRST [ LSH D,6 ? JRST .-1 ]
	TRNN D,77	; Shift both until low char non-zero
	 JRST [	LSH D,-6 ? LSH TT,-6 ? JRST .-1 ]
	CAMN D,TT
	 CAIN D,0
SYMSX1:	  AOS -1(P)
	POP P,D
	POPJ P,

];$$ALLNET
IFN $$ALLNET,[
;; Like SYMCMP, but user's string needn't start on word boundary.
;; Compare strings, address of one in T, Byte Pointer to another in C.
;; Smash T, TT, but NOT A, B, C, or D

SYMCMC:	PUSH P,C
	PUSH P,D
	PUSHJ P,SYMCM0		   ;Do comparison w/o setting up C
	  CAIA
	    AOS -2(P)		   ;  Success, skip return
	POP P,D
	POP P,C
	POPJ P,

SYMSL4:	PUSH P,C
	MOVE C,TT		   ;ptr to string
	MOVE T,HSTADR
	ADD T,NETPTR(T)		   ;Ptr to network tables
	MOVN D,(T)		   ;Count of networks
	HRLZS D			   ;Prepare AOBJN ptr
	HRRI D,2(T)		   ;Ptr to first network
SYSL4A:	HLRZ T,NTLNAM(D)	   ;Ptr to host string
	ADD T,HSTADR
	PUSHJ P,SYMCMC		   ;Is this the network we were given?
	  JRST SYSL4B		   ;  Nope, try next

	MOVE T,NETNUM(D)	   ;Get the network number
	MOVEM T,NTSPCF		   ;Remember that we specified it
	POP P,C
	POPJ P,

SYSL4B:	MOVE T,HSTADR		   ;Find start of NETWORK table
	ADD T,NETPTR(T)
	ADD D,1(T)		   ;2nd word is size of entries
	ADD D,[1,,0]		   ;Update the counter
	JUMPL D,SYSL4A		   ;Try next match
	POP P,C
	POP P,(P)
	JRST SYMUND	   ;Else fail.

]; $$ALLNET

;Here to start processing an arg which is not a number.
SYML6:	MOVE B,E
	ILDB T,TT		;Check for slash and network name
	JUMPE T,SYML2		;None found
	CAIE T,"/"
	 JRST SYML6
	MOVEI T,0		;Ugh, barf, clobber the argument
	DPB T,TT
	PUSH P,TT
	PUSHJ P,SYMLA		;Go do that
	 JRST [	POP P,TT ? MOVEI T,"/" ? DPB T,TT ? JRST SYMLZ]	;Lost, propagate, fixing arg
	POP P,TT		;Note, recursive call didn't return anything in T
	MOVEI T,"/"		; since this wasn't a number
	DPB T,TT		;Fix argument
	PUSH P,TT		;Don't barf at / with nothing after it yet
	ILDB T,TT
	POP P,TT
	CAIE T,0
	PUSHJ P,SYMSL4		;Process network-name argument
	JRST SYMWIN		;And take success return

SYML2:	HRRZ T,(B)		;Get the next symbol's name from the table.
	SKIPE HSTNMF
	 ADD T,HSTADR
	PUSHJ P,SYMCMP		;Does the argument in A abbreviate it?
	 CAIA
	  JRST SYML3		;Yes, we have found the first match.
	AOBJN B,SYML2
SYMUND:	SETZ B,			;There is no match.  Return 0.
	JRST SYMLZ

SYML3:	PUSH P,B		;Remember where the first match is, and find the last.
SYML4:	AOBJP B,SYML5
	HRRZ T,(B)		;Get the next symbol's name from the table.
	SKIPE HSTNMF
	 ADD T,HSTADR
	PUSHJ P,SYMCMP		;Does the argument in A abbreviate it?
	 JRST SYML5		;No => we have gone past the last match.
	JRST SYML4

SYML5:	SUB B,[1,,1]		;B points at last match.
	CAMN B,(P)		;Last and first match are the same table entry?
	 JRST SYMLW		;Then that one is the value.
	MOVE TT,(P)
	PUSH P,A
	HLLZ A,(B)
SYML5A:	HLLZ T,(TT)
	CAME T,A
	 JRST SYML5B
	CAME TT,B
	 AOBJN TT,SYML5A	;If all names have the same value, then just
	MOVEM B,-1(P)		;return the last name, e.g. for XEROX.ARPA 
	JRST SYMLW1		;and XEROX.COM, return XEROX.COM

SYML5B:	MOVE A,-1(P)		;A gets the symbol name of the first match
	HRRZ A,(A)
	SKIPE HSTNMF
	 ADD A,HSTADR
	HRLI A,440700
	HRRZ T,(B)
	SKIPE HSTNMF		;and T gets the name of the last match.
	 ADD T,HSTADR
	SKIPN NOABRV		;If processing "BBN?", show all names starting with BBN
				;even though "BBN" by itself is a valid name.
	 PUSHJ P,SYMCMP		;if the first match is an abbreviation of the last,
	  JRST SYMLL
SYMLW1:	POP P,A			;then it's no ambiguity;  the first wins.
SYMLW:	POP P,B
	ANDI B,-1
SYMWIN:	POP P,D
	POP P,C
	JRST POPJ1

SYMLL:	POP P,A			;Here if argument is really ambiguous.
	HRL B,(P)		;produce 1st match addr,,last match addr.
	SUB P,[1,,1]
SYMLZ:	POP P,D
	POP P,C
	POPJ P,

;Compare the ASCIZ string <- A with the one <- T.
;Skip if the one in A is an initial segment of the one in T.
;We clobber C, D, T and TT but NOT A.

SYMCMP:	MOVE C,A
;	HRLI C,440700		;Already a BP now.
SYMCM0:	HRLI T,440700
SYMCM1:	ILDB TT,T
	ILDB D,C
	JUMPE D,POPJ1		;1st string ended and no mismatch => win.
	CAIL D,140
	 SUBI D,40		;Ignore case in the string in A.  Assume string in T is all upper.
	CAME D,TT
	 POPJ P,		;mismatch => lose.
	JRST SYMCM1

IFE $$HSTMAP,.SCALAR HSTADR

] ;end IFN $$SYMLOOK

IFN $$HSTMAP,[

.SCALAR HSTADR		;Address of HOSTS3 file is stored here.
.SCALAR HSTABN		; AOBJN page pointer to HOSTS3

;The format of the compiled HOSTS3 file is:
; NOTE THIS IS NOT COMPLETELY ACCURATE.  See the file
; AI:SYSNET;HOSTS3 > for an uptodate description.
HSTSID==:0	; wd 0	SIXBIT /HOSTS3/
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
;by network number.  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

;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
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		; Possible additional parameters

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

;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.
; Followed by entries, sorted by the host name treated as a vector of
; signed integers, looking like:
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.

; 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
;	3.9-3.8	0	 	never appear in the host table.)
;	3.7-2.1	Imp
;	1.9	0
;	1.8-1.1	Host

;Map the host table file SYSBIN;HOSTS3 > into core.
;A should contain the page number to start it at.
;B should contain the channel number to use.
;We skip if we succeed, returning in RH(A) the number of the first page not used up.
HSTMAP:
IFN ITS,[
	SYSCAL OPEN,[ B ? 5000,,.BII ? ['DSK',,]
IFN $$HST3,	['HOSTS3']
.ELSE		['HOSTS2']
		[SIXBIT />/] ? ['SYSBIN']]
	 POPJ P,
	SYSCAL FILLEN,[B ? 2000,,T]
	 POPJ P,
	JUMPLE T,CPOPJ	
	MOVEI T,1777(T)		;(round up)
	LSH T,-10.
	PUSH P,A
	LSH A,10.
	MOVEM A,HSTADR		;Save in HSTADR the address where we are mapping the file.
	POP P,A
	MOVNS T			;form AOBJN page ptr for CORBLK
	HRL A,T
	MOVEM A,HSTABN		; save AOBJN for unmapping
	SYSCAL CORBLK,[ 1000,,%CBNDR	;Read-Only.
			1000,,%JSELF	;into self
			A		;as specified
			B]		;from file open on channel.
	 POPJ P,
	SYSCAL CLOSE,B
	 POPJ P,
	MOVE T,HSTADR
];ITS
IFN TNX,[
.SCALAR HSTJFN
.SCALAR HSTLEN

	PUSH P,1 ? PUSH P,2 ? PUSH P,3
	PUSH P,A
	MOVSI 1,(GJ%SHT\GJ%OLD)
IFN 20X,[
IFN $$HST3,HRROI 2,[ASCIZ "SYSTEM:HOSTS3.BIN"]
.ELSE	   HRROI 2,[ASCIZ "SYSTEM:HOSTS2.BIN"]
] ;20X
IFN 10X,[
IFN $$HST3,HRROI 2,[ASCIZ "<SYSTEM>HOSTS3.BIN"]
.ELSE	   HRROI 2,[ASCIZ "<SYSTEM>HOSTS2.BIN"]
] ;10X
	GTJFN
	  JRST HSTMP7		; Failed, restore regs.
	MOVEM 1,HSTJFN
	MOVE 2,[70000,,OF%RD]
	OPENF
	  JRST [MOVE 1,HSTJFN
		RLJFN
		  NOP
		JRST HSTMP7]
	MOVE 2,[1,,.FBBYV]
	MOVEI 3,T
	GTFDB			;XXX,,#PAGES
	HRRZM T,HSTLEN
	HRLZ 1,HSTJFN		;JFN,,FILE PAGE 0
	HRRZ 2,(P)		;PAGE NUMBER WITHIN US (saved on stack)
	HRLI 2,.FHSLF
	HRRZ 3,T
	TLO 3,(PM%CNT\PM%RD)
	PMAP
IFN 10X,[
	TRNE 3,-1		; Counted out yet?
	 JRST [	HRRI 3,-1(3)	; Bump count down by 1
		TRNE 3,400000	; and stop if done (count -1)
		 JRST .+1
		ADDI 1,1	; Increment # of file page
		AOJA 2,.-1]	; and # of process page... then repeat PMAP.
] ;10X
	POP P,A
	POP P,3 ? POP P,2 ? POP P,1
	MOVE T,A
	IMULI T,1000
	MOVEM T,HSTADR
];TNX
	MOVE T,HSTSID(T)	;CHECK THAT FIRST WORD OF FILE IS REALLY HOSTS3
IFN $$HST3,CAME T,[SIXBIT /HOSTS3/]
.ELSE	CAME T,[SIXBIT/HOSTS2/]
	 POPJ P,
	JRST POPJ1

IFN TNX,[
HSTMP7:	POP P,A
	POP P,3 ? POP P,2 ? POP P,1
	POPJ P,
] ;TNX

; UNMAP HOSTS3.
HSTUNMAP:
	SKIPN HSTADR
	 POPJ P,
IFN ITS,[
	MOVE T,HSTABN		; AOBJN PAGE POINTER TO HOSTS3
	SYSCAL CORBLK,[	1000,,0		; DELETE
			1000,,%JSELF	; FROM SELF
			T ]
	 JFCL
];ITS
IFN TNX,[
	PUSH P,1 ? PUSH P,2 ? PUSH P,3
	SETO 1,
	MOVE 2,HSTADR
	IDIVI 2,1000		;PAGE#
	HRLI 2,.FHSLF
	MOVE 3,HSTLEN
	TLO 3,(PM%CNT)
	PMAP
IFN 10X,[
	TRNE 3,-1		; Counted out yet?
	 JRST [	HRRI 3,-1(3)	; Bump count down by 1
		TRNE 3,400000	; and stop if done (count -1)
		 JRST .+1
		AOJA 2,.-1]	; Bump # of process page... then repeat PMAP.
] ;10X
	POP P,3 ? POP P,2 ? POP P,1
];TNX
	SETZM HSTADR
	JRST POPJ1

;Given host number in B, return its host name addr in rh(A) and set sign of A
;if the host is a Tip.  Skip if successful.  No skip => unknown host.
;We also return in D the address of the SITES table entry for the host.
HSTSRC:	MOVE A,B
	PUSHJ P,STDHST
	MOVE B,A
	SKIPN HSTADR		;Fail if the HOSTS3 file isn't loaded.
	 POPJ P,
	PUSH P,C
	PUSH P,E
        PUSH P,T
	GETNET C,B		; Get network number
	MOVE D,HSTADR
	ADD D,NETPTR(D)         ;get address of NETWORKS table.
	MOVE TT,0(D)		;get # of entries,
	MOVE T,1(D)		;and entry size.
	ADDI D,2		;point at first entry.
HSTSR1:	CAMN C,NETNUM(D)	;Find appropriate network
	 JRST HSTSR2
	ADD D,T
	SOJG TT,HSTSR1		;no => look at next entry.
HSTSRX:	POP P,T			;unknown network => return non-skipping.
	POP P,E
        POP P,C
	POPJ P,

HSTSR2:	HRRZ D,NTRTAB(D)	;Get address of ADDRESS table for that network
	ADD D,HSTADR            ;Binary-search it
	MOVE C,1(D)		;Words per entry
	MOVE E,0(D)             ;Number of entries in table
	MOVEI D,2(D)		;Base address of table
	PUSH P,D
HSTSR3:	CAIG E,1
	 JRST HSTSR4		;Search narrowed down to one location
	MOVE T,E
	LSH T,-1
	MOVE TT,T               ;Number of entries in bottom "half" of table
 	IMUL T,C
	ADD T,D			;Probe point
	CAMGE B,ADDADR(T)
	 JRST [	MOVE E,TT	;Move down
		JRST HSTSR3 ]
	MOVE D,T		;Move up
	SUB E,TT
	JRST HSTSR3

HSTSR4:	POP P,T			; Recover base addr of table
	CAME B,ADDADR(D)	; Did we get any match at all?
	 JRST HSTSRX		; Nope, take non-skip return.
HSTSR5:	SUBI D,(C)		; Found one!  Back up to find 1st match
	CAIGE D,(T)		; Make sure we don't back up past beg
	 JRST HSTSR6
	CAMN B,ADDADR(D)	; As long as we still get a match,
	 JRST HSTSR5		; keep backing up.

HSTSR6:	ADDI D,(C)		; Recover from backup.
	MOVEI E,(D)		; Save ptr to ADDRESS table
	HLRZ D,ADLSIT(D)        ; Get address of SITES table entry
	ADD D,HSTADR
	MOVE A,STLFLG		; Check flags
	TLNE A,STFGWY		; to see if this one is a gateway.
	 JRST [	ADDI E,(C)	; Ugh, gateway.  Try to skip it.
		CAME B,ADDADR(E)
		 JRST .+1	; No good, stuck with this one.
		JRST HSTSR6]	; Hurray, try next entry!
	HLRZ A,STLNAM(D)	;found the host => get the addr of its name
	ADD A,HSTADR		;in our address space.
	HLRZ C,STLSYS(D)
	ADD C,HSTADR		;also get addr of its system type name
	MOVE C,(C)
	CAME C,[ASCIZ /TAC/]	;If it's a TAC,
	 CAMN C,[ASCIZ /TIP/]	; Or a TIP, 
	 TLO A,400000		;  set sign bit of A.
	AOS -3(P)               ;Take skip return
	JRST HSTSRX

] ;END $$HSTMAP

IFN $$NETSRC,[
;;; NETSRC(B:net#) => A:name_p
;;; Convert a network number to a network name

NETSRC:	SKIPN HSTADR		;Fail if the HOSTS3 file isn't loaded.
	 POPJ P,
	PUSH P,C
	PUSH P,D
	MOVE D,HSTADR
	ADD D,NETPTR(D)         ;get address of NETWORKS table.
	MOVE TT,0(D)		;get # of entries,
	MOVE T,1(D)		;and entry size.
	ADDI D,2		;point at first entry.
NETSR1:	CAMN B,NETNUM(D)	;Find appropriate network
	 JRST NETSR2
	ADD D,T
	SOJG TT,NETSR1		;no => look at next entry.
	POP P,D			;unknown network => return non-skipping.
        POP P,C
	POPJ P,

NETSR2:	HLRZ A,NTLNAM(D)	;Get address of name of network
	ADD A,HSTADR
	POP P,D			;unknown network => return non-skipping.
        POP P,C
	JRST POPJ1

];END $$NETSRC

IFN $$SYMGET*$$HOSTNM,[

;Read in a host name.  Works like SYMGET but searches host database.
;We return in A the number of the host, network# in TT.

HOSTNM:			;Host name reader
	PUSHJ P,HSTTBP	;E gets aobjn ptr to NAMES table, and set HSTNMF,NTSPCF
	PUSHJ P,HSTNM1	;Do an interactive symbol table lookup.
	 POPJ P,	;Failed
	;TT=0 => A has a number
	;else => A has file-relative address of SITE table entry
	JUMPE TT,HOSTN1
	;JRST HOSTN2
];$$SYMGET*$$HOSTNM

IFN <$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>,[
;Code to process result of Host-name lookup, returning full address in A
;with network number extracted into TT.
;Address was supplied, file-relative pointer to SITES table entry in A.
HOSTN2:	ADD A,HSTADR
	SKIPGE TT,NTSPCF	;Explicitly-specified network?
	 JRST HOSTN4		;No, try all nets we know about
HOSTN3:	HRRZ E,STRADR(A)	;Find an address for SITE in A on network in TT
HSTN3A:	ADD E,HSTADR
	GETNET T,ADDADR(E)
	CAMN T,TT
	 JRST [	MOVE A,ADDADR(E)	;This is it
		JRST POPJ1 ]
	HRRZ E,ADRCDR(E)
	JUMPN E,HSTN3A		;Try site's next address
	POPJ P,			;Not found

HOSTN4:	;Find a network address for this site
IFN $$CHAOS,[			;Chaos net is preferred, try it first
	MOVE TT,[NW%CHS]
	PUSHJ P,HOSTN3
	 CAIA
	  JRST POPJ1
HOSTN5:
];$$CHAOS
IFN $$ARPA,[
	MOVE TT,[NW%ARP]
	PUSHJ P,HOSTN3
	 CAIA
	  JRST POPJ1
HOSTN6:
];$$ARPA
IFE $$ALLNET,[
	POPJ P,			   ;Host exists, but not on any network we know about
]; $$ALLNET

IFN $$ALLNET,[
	HRRZ E,STRADR(A)
	JUMPE E,CPOPJ		   ;No addresses for this site?
	ADD E,HSTADR		   ;where ADDRESS entry is in core
	MOVE A,ADDADR(E)	   ;A J-random Host Address (some random net)
	GETNET TT,A		; Extract the network number
	JRST POPJ1		   ;Success

]; $$ALLNET	

;Number was supplied, it is in A.  Determine what network it is on.
HOSTN1:
IFE $$ALLNET,[
	GETNET TT,A	;Maybe net was specified explicitly as part of number
	JUMPN TT,[		;Yes, make sure is on a network we know about
		  IRPS FLAG,,[$$CHAOS $$ARPA]NUM,,[NW%CHS NW%ARP]
IFN FLAG,[	   CAMN TT,[NUM]
		    JRST POPJ1
];FLAG
		   TERMIN
		  POPJ P, ]	;Can't find it
]; $$ALLNET
	SKIPGE TT,NTSPCF	;Maybe network was specified by name
	 JRST [	PUSHJ P,STDHST	; Not specified, return standardized number.
		JRST POPJ1]
IFN $$HST3, IOR A,TT
.ELSE	DPB TT,[NW$BYT,,A]
	JRST POPJ1
];<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>

IFN $$SYMLOOK*$$HOSTNM,[

;HSTLOOK takes args like SYMLOOK and looks in the HOSTS3 NAMES table.
;It returns the same things that HOSTNM returns.  It clobbers E, T, TT.
;Also returns in B a pointer like SYMLOOK, or zero if no name lookup won.

HSTLOOK:
	PUSHJ P,HSTTBP	;E gets aobjn ptr to NAMES table, and set HSTNMF,NTSPCF
	PUSHJ P,SYML1	;Do a non-interactive symbol table search.
	 POPJ P,
	MOVE A,T	;If the input was a number
	AOJE B,HOSTN1	;go canonicalize it
	HLRZ A,NMLSIT-1(B)	;Else B points at a NAMES table word, so get
	SOJA B,HOSTN2	;the SITE table entry address, go find appropriate net address
];$$SYMLOOK*$$HOSTNM

IFN <$$SYMGET\$$SYMLOOK>*$$HOSTNM,[

;Put in E an aobjn pointer to the HOSTS3 file's NAMES table.  Also set HSTNMF.
HSTTBP:	SKIPN E,HSTADR
	 NWLOSS
	ADD E,NAMPTR(E)         ;Address of NAMES table
	MOVE T,1(E)		;Make sure words per entry is 1
	CAIE T,1
	 NWLOSS
	MOVN T,0(E)             ;Negative number of entries
	HRL E,T
	ADDI E,2		;E now has an aobjn pointer to the NAMES table.
	SETOM HSTNMF		;Say that each address needs HSTADR added to it.
	SETOM NTSPCF		;Say that no network explicitly specified
	POPJ P,
];<$$SYMGET\$$SYMLOOK>*$$HOSTNM

IFN $$SYMGET+$$ANALYZE,[

;TYPE A CRLF.  CLOBBER T.
CRLF:	MOVEI T,15
	PUSHJ P,PUTCHR
	MOVEI T,12
	PUSHJ P,PUTCHR
	POPJ P,

;TYPE ASCIZ STRING POINTED TO BY TT, CLOBBER T.
ZTYPE:
IFN ITS,[
	HRLI TT,440700
ZTYPE0:	ILDB T,TT
	JUMPE T,CPOPJ
	PUSHJ P,PUTCHR
	JRST ZTYPE0
];ITS
IFN TNX,[
	PUSH P,1
	HRRO 1,TT
	PSOUT
	POP P,1
	RETURN
];TNX
];$$SYMGET+$$ANALYZE

IFN $$HSTSIX,[

;Given a host number in A, returns a sixbit abbreviation of
;the name of the host, also in A.  Clobbers only T and TT.
;You better call HSTMAP before this.
;Always skip returns.

HSTSIX:	PUSH P,B
	PUSHJ P,STDHST
	PUSH P,C
	PUSH P,D
	PUSH P,E
	MOVE B,A
	PUSHJ P,HSTSRC          ;Find the SITES table entry for this host.
	 JRST HSTSX9            ;none => unknown host.  Use HSTnnn.
	SUB D,HSTADR            ;D gets addr of SITES table entry relative to file
	MOVE B,HSTADR           ;(for comparison with LH's of NAMES table words).
	ADD B,NAMPTR(B)         ;Get address of NAMES table.
	MOVE T,1(B)		;Make sure 1 word per entry
	CAIE T,1
	 NWLOSS
	MOVE T,0(B)             ;T gets number of entries in the table.
	SETOB C,E               ;E will get the address of the
                                ; longest name shorter than 7 chars, C its length.
	HRRZ TT,A               ;Check out the official name first
	AOJA B,HSTSX0

HSTSX1:	ADDI B,1                ;B points at next untried NAMES table entry.
	HLRZ TT,NMLSIT(B)
	CAME TT,D               ;Does this name name the host we are serving?
	 JRST HSTSX4
	HRRZ TT,NMRNAM(B)       ;If so, how long is this name?
	ADD TT,HSTADR
HSTSX0:	HRLI TT,440700
	PUSH P,TT
	PUSH P,TT
	SETZ A,
HSTSX2:	ILDB TT,(P)
	JUMPE TT,HSTSX3
	AOJA A,HSTSX2

HSTSX3:	POP P,TT	;Flush garbage
IFN $$MIT,[
	MOVE TT,@(P)	;First word of name
	TRZ TT,377
	CAMN TT,[ASCII/MIT-/]
	 CAIG A,6	;Strip off "MIT-" if longer than 6 characters
	  JRST .+4
	   SUBI A,4
	   MOVSI TT,100700
	   HLLM TT,(P)
];$$MIT
	POP P,TT	;Restore pointer to name
	CAIG A,6	;Fit in 6 characters?
	 CAMG A,C	;and longer than the previous one?
	  JRST HSTSX4
	MOVE E,TT	;Yes, save its name's address.
	MOVE C,A	;and the length of that one
HSTSX4:	SOJG T,HSTSX1	;look at all the names in the table.
	AOJN E,HSTSX5	;Jump if found a reasonable name
	ADD D,HSTADR	;No short name, truncate official one
	MOVEI C,"-"	;Also, will remove hyphens from it
	HLRZ E,STLNAM(D)
	ADD E,HSTADR	;Pointer to name
IFN $$MIT,[
	MOVE A,(E)
	TRZ A,377
	CAMN A,[ASCII/MIT-/]
	 JRST [ HRLI E,100700
		AOJA E,HSTSX5 ]
];$$MIT
	TLOA E,440700
HSTSX5:	 SUBI E,1
	MOVE B,E	;Get BP to name string.
;B has a B.P. to the name string we are going to use.
;C has "- if we should remove all hyphens from it, otherwise C has a number from 1 to 6.
;Convert the name string to SIXBIT in A.
	MOVE D,[440600,,A]
	SETZ A,		;Convert name to SIXBIT word in A
HSTSX6:	ILDB T,B
	JUMPE T,HSTSX7	;Stop if name string runs out (nice, it all fits).
	CAMN T,C	;Remove hyphens if requested to
	 JRST HSTSX6	;Note C has number from 1 to 6 or "-
	SUBI T,40
	IDPB T,D
	TLNE D,770000	;Stop after getting one full word.
	 JRST HSTSX6
HSTSX7:	LDB T,D		;If last character is a hyphen, flush it.
	CAIN T,'-'
	 MOVEI T,0
	DPB T,D
HSTSX8:	POP P,E
	POP P,D
	POP P,C
	POP P,B
	JRST POPJ1

;Have to do it numerically.  Depends on network.
HSTSX9:
	MOVSI A,'NET'
	GETNET TT,B
	CAMN TT,[NW%CHS]
	 MOVSI A,'CHS'
	CAMN TT,[NW%ARP]
	 JRST [ MOVSI A,'HST'
IFN $$HST3,	LDB T,[002000,,B]	; IMP
.ELSE		LDB T,[112000,,B]	;Imp
		CAIGE T,100
		 TRNN B,774
		  JRST .+1		;Doesn't fit in old-style
IFN $$HST3,	LSH B,-16.
		ANDI B,3
		LSH B,6         	;Host
		DPB T,[000600,,B]	;Convert to old-style
		JRST .+1 ]
	HRRI A,'000'		;If host number less than 3 digits, pad with zeroes
IFE $$HST3, TLZ B,(.BM (NW$BYT))	;Host number within network
	SETZB T,TT		;T gets sixbit, TT gets char mask
	PUSHJ P,HSTS9A	
	ANDCM A,TT		;Clear characters from A to be clobbered from T
	IOR A,T			;Bring in number
	JRST HSTSX8

HSTS9A:	IDIVI B,8
	HRLM C,(P)
	SKIPE B
	 PUSHJ P,HSTS9A
	HLRZ C,(P)
	LSH T,6
	IORI T,'0'(C)
	LSH TT,6
	IORI TT,77
	POPJ P,
];$$HSTSIX

;;; Standardize host number in A.  Clobber T.
;;; No skip-return

STDHST:
IFN $$HST3, JRST CVH3NA
.ELSE [
	TLNE A,777000		;Network number specified?
	 JRST STDHS1		;Yes, OK
IFN $$ARPA, TLO A,NW%ARP_9	;No, default to some net we know about
.ELSE IFN $$CHAOS, TLO A,NW%CHS_9
STDHS1:
IFN $$ARPA,[
	LDB T,[NW$BYT,,A]	;If Arpanet, standardize to new format
	CAIN T,NW%ARP
	 TDNE A,[177777000]
	  POPJ P,
	LDB T,[000600,,A]	;Imp
	LDB A,[060200,,A]	;Host
	DPB T,[112000,,A]
	TLO A,NW%ARP_9
];$$ARPA
	POPJ P,
] ;HOSTS2

IFN $$OWNHST+<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>,[
;;; GIVEN A NETWORK NUMBER IN A (WHICH MUST BE A NETWORK THIS PROGRAM IS
;;; CONDITIONALLY ASSEMBLED TO SUPPORT), RETURN THIS MACHINE'S OWN
;;; ADDRESS ON THAT NETWORK, IN A.  CLOBBER T.  SKIPS UNLESS HOST NOT ON THAT NET.
OWNHST:
IFN $$ARPA,[
	CAME A,[NW%ARP]
	 JRST OWNHS1
IFN ITS,[
	SYSCAL NETHST,[MOVEI -1 ? MOVEM A ? MOVEM A] ;GET OWN ARPANET ADDRESS
	 POPJ P,		;MUST NOT BE ON ARPANET
	PUSHJ P,STDHST	;SYSTEM DOESN'T RETURN NUMBER IN STANDARD FORMAT
	JRST POPJ1
];ITS
IFN TNX,[
	PUSH P,A
	PUSH P,1 ? PUSH P,2 ? PUSH P,3 ? PUSH P,4
	MOVEI 1,.GTHSZ
	GTHST
	 CAIA
	  AOS -5(P)		; Take skip return!
	MOVEM 4,-4(P)		; Store result into what will be put in A
	POP P,4 ? POP P,3 ? POP P,2 ? POP P,1
	POP P,A			;ALREADY IN INTERNET FORMAT
];TNX

OWNHS1:
];$$ARPA

IFN $$CHAOS,[
	CAME A,[NW%CHS]
	 JRST OWNHS2
IFN ITS,[
	MOVE A,[SQUOZE 0,MYCHAD]
	.EVAL A,
	 POPJ P,		;MUST NOT BE ON CHAOS NET
];ITS
IFN TNX,[
	PUSH P,A
	PUSH P,1 ? PUSH P,2
	MOVE 1,[SIXBIT "CHSTAT"]
	SYSGT
	HRR 1,2			;TABLE#
	HRLI 1,2		;WORD#2,,TABLE#
	GETAB
	  JRST [POP P,2 ? POP P,1
		POP P,A ? POPJ P,]
	MOVEM 1,-2(P)
	POP P,2 ? POP P,1
	POP P,A
];TNX
IFN $$HST3, IOR A,[NW%CHS]
.ELSE	TLO A,NW%CHS_9
	JRST POPJ1
OWNHS2:
];$$CHAOS
	POPJ P,		;Some network I don't know about
];$$OWNHST+<$$SYMGET*$$HOSTNM>+<$$SYMLOOK*$$HOSTNM>

;;; Routine to compare two hosts
IFN $$HSTCMP,[
;;  Take host #'s in A and B, and skip if they refer to the same host.
;;  Clobber no AC'S
;;
;;CALL:  MOVE A,[HOST]
;;	 MOVE B,[HOST]
;;	 PUSHJ P,HSTCMP
;;	   different or error (unknown host or unmapped HOSTS3 table)
;;	 same

HSTCMP:	CAMN A,B		   ;Trivial case
	 JRST POPJ1
	PUSH P,A		   ;Clobber no AC's
	PUSH P,B
	PUSH P,T
	PUSH P,D
	PUSH P,D		   ;Get's SITE table entry
	PUSHJ P,HSTSRC		   ;Check this one out
	  JRST HSTCM9		   ;  Non-existant or not mapped
	MOVEM D,(P)		   ;Remember this site table entry
	MOVE B,-4(P)		   ;Get the other host #
	PUSHJ P,HSTSRC		   ;and look up it's SITE table entry
	  JRST HSTCM9
	MOVE T,(P)		   ;Recover the first SITE table entry
	CAMN T,D		   ;Compare the two entry pointers
	  AOS -5(P)		   ;  The same!
HSTCM9:	POP P,D
	POP P,D
	POP P,T
	POP P,B
	POP P,A
	POPJ P,

];$$HSTCMP

;;; Arpanet connection routines
IFN $$ARPA*ITS,[
IFN $$ICP,[
  $$CONNECT==1		;necessary subroutine

; ARPA NETWORK ICP ROUTINE
;
;Call:	MOVEI A,pin	;first of group of 3 channels to use (nonconsecutively numbered)
;			;PIN itself is used only for the ICP.  PIN+1 is unused.
;			;PIN+2 and PIN+3 are the in and out sides of the TELNET connection.
;	MOVEI B,host	;host number to connect to
;	MOVEI C,frnsoc	;foreign socket number to icp through
;	MOVE D,[imode,,omode] ;input and output modes as in OPEN on NET device.
;	PUSHJ P,NETWRK"ARPICP	;do it.  Clobbers A,B,C,D,E,T,TT.
;	 failed		;A holds the channel which lost.  If $$ERRHAN, ANALYZ was called.
;	succeeded

ARPICP:	MOVEI E,0	;synchronous mode
ICPPHS:	PUSHJ P,ICP1	;This is also the phase table
	PUSHJ P,ICP2	
	PUSHJ P,ICP3
	JRST POPJ1

ICPASN:		;asynchronous mode.  Same args except E is phase (initially 1).
	SKIPL E		;keep calling back with same ACs as returned, until E is zero.
	 HRREI E,-3	;asynchronous init
	XCT ICPPHS+3(E)	;call appropriate phase
	AOJA E,POPJ1	;and advance to next

;First phase - connect to ICP socket.
ICP1:	PUSH P,D	;Assume that all sockets were closed, so ITS has deallocated any
	SETZM SKTBAS	;old set of sockets, and we must ask it for a new set.
	HRROI D,040044	;asynchronous, 32-bit read
	PUSHJ P,ARPCON	;initiate connection
	 JRST POP2J	;lose
	POP P,D		;win
	POPJ P,

;Second phase - get server socket number and connect up.
ICP2:	PUSHJ P,CONFIN	;finish ICP connection
	 JRST POP1J	;lose
	SYSCAL IOT,[MOVEI (A) ? MOVEM C]	;get foreign socket number
IFE $$ERRHAN, JRST POP1J	;Connection opened but nothing came through, lose
.ELSE	 JRST [ POP P,C ? JRST ANALNS ]	;Analyze then take error return
	 		;Due to bug in NCP socket allocation, don't close contact pin yet
	ADDI A,2	;connect our read pin
	ADDI C,1	;to foreign write pin
	PUSH P,D
	HLROS D		;using input mode, asynchronously
	PUSHJ P,ARPCON
	 JRST POP2J	;lose
	ADDI A,1	;connect our write pin
	SUBI C,1	;to foreign read pin
	HRRO D,(P)	;using output mode, asynchronously
	PUSHJ P,ARPCON
	 JRST POP2J	;lose
	POP P,D
	POPJ P,

;Third phase - finish up connections.
ICP3:	PUSHJ P,CONFIN	;finish write connection
	 JRST POP1J
	SUBI A,1
	PUSHJ P,CONFIN	;finish read connection
	 JRST POP1J
	SYSCAL CLOSE,[MOVEI -2(A)]	;and now close contact pin
	 .LOSE %LSSYS
	POPJ P,

] ;END IFN $$ICP

IFN $$SERVE,[

;Call:	MOVEI A,pin	;first channel number of three consecutive ones.
;			;the first is the ICP listen channel,
;			;the second is the input channel for the TELNET connection,
;			;the third is the output channel for it.
;	MOVEI B,icpsoc	;socket to listen for an ICP on.
;	MOVE C,[imode,,omode] ;input and output modes as in OPEN on NET device.
;	PUSHJ P,NETWRK"ARPSRV	;Listen for and accept an ICP.
;	 timed out.
;	succeeded.  B has number of foreign host.  
;
;If $$SYSDBG is 0, then connections from hosts locked out by SYSDBG are
;refused, and SERVE fails to skip.
;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C
;a value which is nonzero if the foreign host ought to be locked out by SYSDBG.

;Clobbers A, D, T and TT.

$$CONNECT==1	;We call ARPCON.

ARPSRV:	SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG']
	 .LOSE %LSSYS
	MOVEI TT,377777		;If debugging, wait forever.
	SKIPN DEBUG
	 MOVEI TT,30.*60.	;Otherwise time out after 60 sec.
ARPSR1:	SYSCAL OPEN,[ A ? 5000,,40065 ? [SIXBIT/NET/] ? B]
	 JRST ARSVLS		;Open a channel to receive the RFC with.
	SYSCAL WHYINT,[ A ? 2000,,T ? 2000,,T]
	 JRST ARSVLS
ARPSR2:	CAIN T,%NSRFC		;Have we an RFC to accept?
	 JRST ARPSR3
	SKIPN DEBUG		;No => OK only if debugging
	 POPJ P,		;(so you can start your server before starting the user).
	.CALL CONFIC		;So wait for it to change state and look again.
	 JRST ARSVLS		;[They also serve who hang and wait]
	JRST ARPSR2		;TRY AGAIN

ARPSR3:	HLRZ D,C
	TLO D,400000		;D gets mode for our input socket.
	PUSH P,C
	SYSCAL RCHST,[ A ? 2000,,C ? 2000,,C ? 2000,,C ? 2000,,B]
	 .LOSE %LSFIL		;C gets foreign socket ICP'd with.
				;B now has host number of host that ICP'd to us.
	TLZ B,777000		;Make sure network number field is 0
IFE $$SYSDBG,[
	SKIPL T,SYSDBG		;If system being debugged, may refuse ICP
	 JRST ARPSR4
	ASH T,-9		;Set to -1000*host# allowed in
	ADD T,B			;Zero if this guy allowed in
	JUMPN T,ARSVL2
ARPSR4:	];$$SYSDBG
;remember that TT has the "sleep time" arguments for NETBLKs, including CONFI1.
	SYSCAL NETAC,A
	 JRST ARSVL1
	ADDI A,1		;Channel to make input connection on.
	ADDI C,3		;Foreign socket ICP'd with, plus 3, is target for our input.
	SETZM SKTBAS'
	PUSH P,TT		;See comment 6 lines above!
	PUSHJ P,ARPCON
	 JRST [ POP P,TT ? JRST ARSVL1 ]
	MOVE TT,SKTBAS		;Get socket number of our input connection
	ADD TT,A
	SYSCAL IOT,[1000,,-1(A) ? TT]
	 .LOSE %LSFIL		;Send our lower socket # to the ICPer.
	SYSCAL CLOSE,[1000,,-1(A)]	;Don't need ICP socket any more.
	 .LOSE %LSFIL
	HRRZ D,-1(P)		;Saved C
	HRLI D,400000
	ADDI A,1		;Now open our output connection
	SUBI C,1		;to a foreign socket 1 smaller than that used for our input.
	PUSHJ P,ARPCON
	 JRST [ POP P,TT ? JRST ARSVL1 ]
	POP P,TT
	POP P,C
	PUSHJ P,CONFI1		;Then wait for the two connections to be finished.
	 JRST ARSVLS		;TT still has the time period (or by now maybe the
	SUBI A,1		;time to wait until).
	PUSHJ P,CONFI1
	 JRST ARSVLS
IFN $$SYSDBG,[
	SKIPL C,SYSDBG		;If system being debugged, may disallow
	 JRST [ SETZ C, ? JRST ARPSR5 ]
	ASH C,-9		;Set to -1000*host# allowed in
	TLZ B,777000		;Clear network number from host number
	ADD C,B			;Zero if this guy allowed in
ARPSR5:	];$$SYSDBG
	EXCH A,B		;Fix host# returned in B
	PUSHJ P,STDHST
	EXCH A,B
	JRST POPJ1

ARSVL2:	SYSCAL CLOSE,A
	 .LOSE %LSFIL
ARSVL1:	POP P,C
ARSVLS:	SKIPE DEBUG
	 NWLOSS
	POPJ P,

] ;END IFN $$SERVE

IFN $$CONNECT,[

.SCALAR SKTBAS		; ne 0 => socket number of pin zero

; ARPA NETWORK CONNECT ROUTINE
;
;Call:	MOVEI A,pin	;local its chnl and relative socket number to connect
;	MOVE B,host	;host number to connect to
;	MOVEI C,frnsoc	;foreign socket number to connect to
;	MOVEI D,mode	;mode to open in (RH).  Bit 4.9=1 => asynchronous
;	PUSHJ P,NETWRK"ARPCON
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Clobbers only T and TT.  If using asynchronous mode,
;call CONFIN later (with pin number in A) to finish up.
;
; NOTE:  AT PRESENT YOU MUST CONNECT THE LOWEST NUMBERED
; PIN FIRST, DUE TO BUGS IN SOCKET-SET ASSIGNMENT IN NCP.

ARPCON:	MOVE T,A		;Open operand word
	HRL T,D			;is mode,,channel
	SKIPN TT,SKTBAS		;get base of local socket group
	 TLO T,10		;not yet allocated, use gensoc mode
	ADD TT,A		;get local sock number to be opened
;	TLZ B,777000	;*** TEMPORARILY CLEAR NETWORK NUMBER UNTIL ITS IS FIXED ***
	MOVEM B,ARPHST		;Save last Arpanet host hacked for ANALYZE
	.CALL [	SETZ		;open 'er up
		SIXBIT/OPEN/
		T		;mode,,channel
		['NET',,]	;arpanet device
		TT		;local socket
		C		;foreign socket
		SETZ B ]	;foreign host
IFN $$ERRHAN,JRST ANALNS
.ELSE	 POPJ P,
	SKIPE SKTBAS
	 JRST CONNE0
	SYSCAL RCHST,[A ? MOVEM T ? MOVEM T] ;Get local socket, from first pin
	 .LOSE %LSSYS
	SUB T,A			;get socket base
	MOVEM T,SKTBAS
CONNE0:	JUMPL D,POPJ1		;asynchronous, return now
				;otherwise, drop into CONFIN

;Call:	MOVEI A,pin		;pin number of connection
;	MOVEI D,flags		;20 if listening, 0 if not.  Left over from call to ARPCON.
;	PUSHJ P,CONFIN		;finish connection
;	 lossage - you may call ANALYZE to get an error message
;	win - clobbers only T and TT

CONFIN:	MOVEI TT,30.*60.	;wait at most one minute
	SKIPE DEBUG		;In debug mode, wait forever
	 MOVSI TT,177777
CONFI1:	MOVEI T,%NSRFS		;Which state we started out in depends
	TRNE D,20		;on whether we were listening or initiating.
	 MOVEI T,%NSLSN
	.CALL CONFIC		;Wait up to time in TT to leave state in T.
	 .LOSE %LSSYS
	CAIE T,%NSOPN		;check good state
	 CAIN T,%NSINP
	  JRST POPJ1
	CAIE T,%NSRFC
	 CAIN T,%NSCLI
	  JRST POPJ1
IFN $$ERRHAN,JRST ANALNS	;losing state
.ELSE	POPJ P,

CONFIC:	SETZ		;wait for connection to open up
	'NETBLK'
	A
	T		;wait until not in state in T
	TT
	SETZM T		;return state

];$$CONNECT
];$$ARPA*ITS
IFN $$ERRHAN,[
ANALNS:	PUSH P,B	;ANALYZE AND THEN POPJ
	PUSH P,C
	JRST ANALN1
] ;END IFN $$ERRHAN

;;; Chaos network connection routines
IFN $$CHAOS,[
IFN ITS,[
IFN $$SERVE,[

;Call:	MOVEI A,chnl	;Input channel number.  That+1 is output channel.
;	MOVEI C,contact name	;an ASCIZ string
;	MOVEI D,window size
;	PUSHJ P,NETWRK"CHASRV
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Returns in B the number of the foreign host.
;
;If $$SYSDBG is 0, then connections from all hosts are
;refused, and SERVE fails to skip.
;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C
;a value which is nonzero if the foreign host ought to be locked out by SYSDBG.

;Clobbers A, D, T and TT.

$$CONNECT==1	;We call CHALSN.

CHASRV:	SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG']
	 .LOSE %LSSYS
	MOVEI TT,%COLSN
	PUSHJ P,CHACN0		;Start things up
	 POPJ P,		;Lost
;Listen done.  Check host number, return OPN or CLS
	CAIE TT,%CSRFC		;Have we an RFC to accept?
	 POPJ P,		;No, something went wrong
	SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF]	;Get the RFC packet
	 .LOSE %LSSYS
	LDB B,[$CPKSA+PKTBUF]	;Get source host
IFN $$HST3,IOR B,[NW%CHS]
.ELSE	TLO B,NW%CHS_9		;Including network number
IFE $$SYSDBG,[			;Reject rfc if system down
	SKIPL SYSDBG
	 JRST CHASV1
	MOVEI T,%COCLS		;Return CLS
	DPB T,[$CPKOP+PKTBUF]
	PUSH P,C
	MOVEI C,[ASCIZ/System not up/]
	PUSHJ P,CHSTNG
	POP P,C
	SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF]
	 .LOSE %LSSYS
	JRST CHASRV		;Try again

CHASV1:	];$$SYSDBG
	MOVEI T,%COOPN		;Return Open
	DPB T,[$CPKOP+PKTBUF]
	SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF]
	 .LOSE %LSSYS
IFN $$SYSDBG,[
	SKIPL C,SYSDBG		;If system being debugged, may disallow
	 JRST [ SETZ C, ? JRST POPJ1 ]
	;Unlike Arpanet, we don't have selective disallow, just disallow everyone
];$$SYSDBG
	JRST POPJ1
] ;END IFN $$SERVE
];ITS
IFN TNX,[
];TNX

IFN $$CONNECT,[
IFN ITS,[
;CHAOS NETWORK CONNECT ROUTINE
;
;Call:	MOVEI A,chnl	;Input channel number.  That+1 is output channel.
;	MOVEI B,host	;host number to connect to
;	MOVEI C,contact name	;an ASCIZ string
;	MOVEI D,window size
;	PUSHJ P,NETWRK"CHACON
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Clobbers only T and TT.
;
;CHALSN is the same as CHACON except that it uses LSN instead of RFC.
; B is host number it must be from, or 0 if any host is acceptable.

.VECTOR PKTBUF(%CPMXW)		;Buffer used by Open, Close, and Analyze

CHACON:
$$LOG,	LOG CHACON,[B,C]
	MOVEI TT,%CORFC
	PUSHJ P,CHACN0		;Start things up
	 POPJ P,		;Lost
	CAIE TT,%CSOPN
	 JRST CHACNL		;Started but didn't get open
	JRST POPJ1		;CHACON done

CHACN0:	SETZM PKTBUF
	MOVE T,[PKTBUF,,PKTBUF+1]
	BLT T,PKTBUF+%CPMXW-1	;For extra luck, clear the packet buffer
	DPB B,[$CPKDA+PKTBUF]	;Destination host
	DPB TT,[$CPKOP+PKTBUF]
	PUSHJ P,CHSTNG		;Store string from C
	SYSCAL CHAOSO,[MOVEI (A) ? MOVEI 1(A) ? D]	;Assign Chaos index
	 JRST CHACNL
	SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF]	;Send RFC or LSN
	 .LOSE %LSFIL
	MOVEI TT,$$CHATO	;15-second timeout
	SKIPE DEBUG
	 MOVSI TT,177777	;Or infinite, in debug mode
	LDB T,[$CPKOP+PKTBUF]
	CAIE T,%COLSN		;Get the boring state
	 SKIPA T,[%CSRFS]
	  MOVEI T,%CSLSN
	SYSCAL NETBLK,[MOVEI 1(A) ? T ? TT ? MOVEM TT]	;Await completion of connection
	 JRST CHACNL
	JRST POPJ1		;Return to second half

CHALSN: MOVEI TT,%COLSN
	PUSHJ P,CHACN0		;Start things up
	 POPJ P,		;Lost
;Listen done.  Check host number, return OPN or CLS
	CAIE TT,%CSRFC		;Should be RFC into LSN
	 JRST CHACNL
	SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF]	;Get the RFC packet
	 .LOSE %LSFIL
	LDB T,[$CPKSA+PKTBUF]	;Check source host
	CAIE T,(B)		;Not looking at network number
	 JUMPN B,CHALS2		;Jump if doesn't match
	MOVEI T,%COOPN		;Matches or we don't care, return open
	DPB T,[$CPKOP+PKTBUF]
	SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF]
	 .LOSE %LSFIL
	JRST POPJ1

CHALS2:	MOVEI T,%COCLS		;Return CLS
	DPB T,[$CPKOP+PKTBUF]
	PUSH P,C
	MOVEI C,[ASCIZ/You are the wrong host./]
	PUSHJ P,CHSTNG
	POP P,C
	SYSCAL PKTIOT,[MOVEI 1(A) ? MOVEI PKTBUF]
	 .LOSE %LSFIL
	JRST CHALSN		;Try again

CHACNL:	;CHACON or CHALSN lost
IFN $$ERRHAN, JRST ANALNS
.ELSE	POPJ P,

;Store string from C into PKTBUF. Bash T, TT
CHSTNG:	PUSH P,B
	PUSH P,C
	MOVE B,[440800,,PKTBUF+%CPKDT]
	MOVEI TT,0
	HRLI C,440700
CHSTG1:	ILDB T,C
	JUMPE T,CHSTG2
	IDPB T,B
	CAIGE TT,%CPMXC-1
	 AOJA TT,CHSTG1
CHSTG2:	DPB TT,[$CPKNB+PKTBUF]
	POP P,C
	POP P,B
	POPJ P,
] ;END IFN $$CONNECT
];ITS
IFN TNX,[
];TNX

IFN $$SIMPLE,[
IFN ITS,[
; CHASMP
;	A - channel pair
;	B - foreign host
;	C - pointer to asciz string of contact name and arguments (if any)
;	D - aobjn pointer to buffer in which answer is returned as asciz string
; Returns:
;	non-skip  failed to get response, or error response (you can call ANALYZE)
;	skip once  CLS response, asciz string in D's buffer
;	skip twice  ANS response, asciz string in D's buffer

CHASMP:	PUSH P,D
	MOVEI D,5		;Meaningless window size
	MOVEI TT,%CORFC
	PUSHJ P,CHACN0		;Start things up
	 JRST CHASM9		;Lose
	CAIN TT,%CSCLS
	 SYSCAL PKTIOT,[MOVEI (A) ? MOVEI PKTBUF]	;Get the ANS/CLS packet
	  JRST CHASM9		;Didn't get proper response
	LDB TT,[$CPKOP+PKTBUF]
	CAIN TT,%COANS	
	 AOSA -1(P)		;Skip twice
	  CAIN TT,%COCLS
	   AOSA -1(P)		;Skip once
	    JRST CHASM9		;Skip no times (shouldn't get here usually)
	PUSH P,C
	HLRE C,-1(P)		;Get minus number of words
	IMUL C,[-5]
	SUBI C,1		;Number of characters not counting terminator
	MOVE D,-1(P)
	HRLI D,440700
	MOVE TT,[440800,,PKTBUF+%CPKDT]
	LDB T,[$CPKNB+PKTBUF]
	CAMGE T,C
	 MOVE C,T
CHASM1:	ILDB T,TT
	IDPB T,D
	SOJG C,CHASM1
	IDPB C,D
	POP P,C
CHASM9:	POP P,D
	POPJ P,
] ;END IFN $$SIMPLE
];ITS
IFN TNX,[
];TNX
] ;END IFN $$CHAOS

IFN $$TCP,[
IFN $$SERVE,[

;Call:	MOVEI A,chnl	;Input channel number.  That+1 is output channel.
;	MOVEI B,port#
;	PUSHJ P,NETWRK"TCPSRV
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Returns in B the number of the foreign host.
;
;If $$SYSDBG is 0, then connections from all hosts are
;refused, and SERVE fails to skip.
;If $$SYSDBG is 1, then SERVE accepts all connections but returns in C
;a value which is nonzero if the foreign host ought to be locked out by SYSDBG.

;Clobbers A, D, T and TT.

$$CONNECT==1	;just for TCPCNL

TCPSRV:	SYSCAL SSTATU,[MOVEM TT ? MOVEM SYSDBG']
	 .LOSE %LSSYS
	SYSCAL TCPOPN,[MOVEI (A) ? MOVEI 1(A) ? B
		[-1] ? [-1]]		; Wild fgn port and host.
	 JRST TCPCNL		; Bah, failed for some reason.
	MOVEI TT,$$TCPTO	;15-second timeout
	SKIPE DEBUG
	 MOVSI TT,177777	;Or infinite, in debug mode
	MOVEI T,%NSLSN		; Initial state to hang on.
TCPSV1:	SYSCAL NETBLK,[MOVEI 1(A) ? T ? TT ? MOVEM T ? MOVEM TT]
	 .LOSE %LSSYS		; Gack?
	JUMPLE TT,TCPCNL	; Exit if timed out
	CAIN T,%NSRFC		; If in SYN-RECEIVED state
	 JRST TCPSV1		; then it's OK to keep waiting.
	CAIE T,%NSOPN		; Else should be open now.
	 CAIN T,%NSRFN
	  CAIA
	   JRST TCPCNL		; Aw, phooie.

	; TCP connection open now.
	SYSCAL RFNAME,[MOVEI 1(A) ? MOVEM T
			MOVEM T	; Local port # (should be = ICPSOC)
			MOVEM T	; Foreign port #
			MOVEM B]; Foreign host #
	 .LOSE %LSSYS		; Gack?
IFE $$SYSDBG,[			;Reject rfc if system down
	SKIPL SYSDBG
	 JRST TCPSV2
	;I don't know how to do this right.  Just send string and close
	MOVE T,[440700,,[ASCIZ/System not up/]]
	MOVEI TT,13.
	SYSCAL SIOT,[MOVEI 1(A) ? T ? TT]
	 JFCL
	SYSCAL CLOSE,[MOVEI (A)]
	 .LOSE %LSSYS
	SYSCAL CLOSE,[MOVEI 1(A)]
	 .LOSE %LSSYS
	JRST TCPSRV		;Try again

TCPSV2:	];$$SYSDBG
IFN $$SYSDBG,[
	SKIPL C,SYSDBG		;If system being debugged, may disallow
	 JRST [ SETZ C, ? JRST POPJ1 ]
	;Unlike Arpanet, we don't have selective disallow, just disallow everyone
];$$SYSDBG
	JRST POPJ1
] ;END IFN $$SERVE

IFN $$CONNECT,[

;TCP CONNECT ROUTINE
;
;Call:	MOVEI A,chnl	;Input channel number.  That+1 is output channel.
;	MOVEI B,host	;host number to connect to
;	MOVEI C,foreign port  ;you don't get to pick the local port
;	PUSHJ P,NETWRK"TCPCON
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Clobbers only T and TT.

TCPCON:
$$LOG,	LOG TCPCON,[B,C]
	MOVEI T,1(A)		;Output channel
	.CALL [ SETZ ? 'TCPOPN' ? A ? T ? [-1] ? C ? SETZ B ]
	 JRST TCPCNL		;Didn't even start trying
	MOVEI TT,$$TCPTO	;15-second timeout
	SKIPE DEBUG
	 MOVSI TT,177777	;Or infinite, in debug mode
	.CALL [ SETZ ? 'NETBLK' ? MOVEI 1(A) ? MOVEI %NSRFS ? TT
		SETZM T ]	;T gets state it went into
	 .LOSE %LSSYS
	CAIE T,%NSOPN		;Good state?
	 CAIN T,%NSRFN
	  JRST POPJ1		;Success
TCPCNL:				;Timed out or failed
IFN $$ERRHAN, JRST ANALNS
.ELSE	POPJ P,
];$$CONNECT
];$$TCP

IFN $$ANALYZE*ITS,[

; Network error analysis.

;Call:	MOVEI A,pin		;channel number that is losing
;	PUSHJ P,ANALYZE
;	 .VALUE			;always skip-returns
;
;Clobbers only T and TT.  Uses the PUTCHR routine to type out its messages.
;Does not type a crlf after the message.

.VECTOR WHYINT(5)		;Cruft returned from WHYINT

ANALYZE:
	AOS (P)
	PUSH P,B
	PUSH P,C
ANALN1:	SYSCAL USRVAR,[MOVEI %JSELF ? MOVEI .RIOC(A) ? MOVEM T ]	;Channel open?
	 .LOSE %LSSYS
	JUMPE T,ANALN2		;No, don't clobber error code with WHYINT
	SYSCAL WHYINT,[A ? MOVEM WHYINT ;Get device type
			 MOVEM WHYINT+1 ? MOVEM WHYINT+2 ? MOVEM WHYINT+3
			MOVEM WHYINT+4 ]
	 .LOSE %LSFIL
	MOVE T,WHYINT	; Get device type
IFN $$TCP\$$ARPA,[
	CAIE T,%WYNET
	 CAIN T,%WYTCP
	  JRST ANAL1	; Go analyze NCP/TCP channel.
];$$TCP\$$ARPA
IFN $$CHAOS,[
	CAIN T,%WYCHA
	 JRST ANLCHA		;Chaos net channel open, further info available
];$$CHAOS
ANALN2:	SYSCAL USRVAR,[MOVEI %JSELF ? MOVEI .RIOS(A) ? MOVEM T] ;Get I/O status wd for channel
	 .LOSE %LSSYS
	LDB TT,[220600,,T]	;only the open-loss code is available
	CAIN TT,%EFLDV		;Device full (this one applies to both Arpanet & Chaos net)
	 JRST [	JSP TT,SPEAK
		ASCIZ \All sockets in use.\ ]
	CAIN TT,%ENRDV		;Device not ready
	 JRST [	JSP TT,SPEAK
		ASCIZ \Network down.\ ]
IFN $$ARPA,[
	CAIE TT,%ENAPP		;Other end of pipeline gone, or
	CAIN TT,%ENSDR		;No such directory
	 JRST [ ;Host is down, say why.
		MOVE T,ARPHST	;Go print status for last host hacked, is probably right one
		JRST ANALC1 ]	;Unfortunately, channel not open, can't get right host
	CAIN TT,%ESCO		;Self-contradictory open
	 JRST [	JSP TT,SPEAK
		ASCIZ \Connection cannot be opened because of inconsistent byte sizes.\ ]
];$$ARPA
	SYSCAL IOPUSH,[A]	;Some other error - get ITS error message
	 .LOSE %LSSYS
	.CALL [	SETZ
		SIXBIT/OPEN/
		MOVEI (A)	;here we rely on .UAI=0
		['ERR',,]
		MOVEI 3		;Status from T
		SETZ T ]
	 .LOSE %LSFIL
	MOVEI TT,[ASCIZ\? Internal error - \]
	PUSHJ P,ZTYPE
ANAL0:	SYSCAL IOT,[MOVEI (A) ? MOVEM T] ;copy error message to output device
	 .LOSE %LSSYS
	CAIGE T,40
	 JRST ANALYX
	PUSHJ P,PUTCHR
	JRST ANAL0

ANALYX:	SYSCAL IOPOP,[A]
	 .LOSE %LSSYS
ANALX:	POP P,C
	POP P,B
	POPJ P,

IFN $$TCP\$$ARPA,[
; Arpanet channel still open - further information available

ANAL1:	HRRZ TT,WHYINT+1		;get socket state
	JUMPE TT,ANALC .SEE %NSCLS	;connection closed
IFN $$TCP,[
	CAIN T,%WYTCP
	 JRST ANAL20		; Report TCP channel state
] ;$$TCP
	CAIN TT,%NSRFS		;state is %NSRFS => we must have timed out at CONFIN.
	 JRST [	JSP TT,SPEAK
		ASCIZ /Timed-out while awaiting response to opening of connection./ ]
	CAIN TT,%NSLSN		;same but listening rather than rfc'ing
	 JRST [	JSP TT,SPEAK
		ASCIZ/Timed-out while listening for request to open connection./ ]
	JRST ANAL50			; Give up, complain about illegal state

IFN $$TCP,[
ANAL20:	CAILE TT,%NTINP
	 JRST ANAL50		; State too big
	PUSH P,TCPSTB(TT)	; Get state message
	MOVEI TT,[ASCIZ /Connection /]
	PUSHJ P,ZTYPE
	POP P,TT
	JRST SPEAK

TCPSTB:	OFFSET -.
%NTCLS::	[ASCIZ /closed./]
%NTLSN::	[ASCIZ /listening./]
%NTSYR::	[ASCIZ /wedged, SYN rcvd but not acked./]
%NTCLU::	[ASCIZ /being closed by foreign host./]
%NTSYN::	[ASCIZ /waiting for response to SYN./]
%NTOPN::	[ASCIZ /open./]
%NTWRT::	[ASCIZ /open, output buffer full./]
%NTCLX::	[ASCIZ /being closed by user./]
%NTCLI::	[ASCIZ /closed, input still available./]
%NTINP::	[ASCIZ /open, input available./]
	OFFSET 0
] ;$$TCP
ANAL50:	PUSH P,TT
	MOVEI TT,[ASCIZ\? Socket entered illegal state #\]
	PUSHJ P,ZTYPE
	LDB T,[030300,,(P)]
	SKIPE T
	 PUSHJ P,[ ADDI T,"0" ? JRST PUTCHR ]
	POP P,T
	ANDI T,7
	ADDI T,"0"
	PUSHJ P,PUTCHR
	JRST ANALX
];$$TCP\$$ARPA

SPEAK:	PUSHJ P,ZTYPE		;send message from TT
	JRST ANALX		; and return

IFN $$TCP\$$ARPA,[

;Say why connection was closed
ANALC:	SYSCAL RFNAME,[MOVEI (A) ? MOVEM T
			MOVEM T ? MOVEM T	; Local port, fgn port
			MOVEM T ]		; Fgn host (NCP: 1.1-1.9)
	 .LOSE %LSSYS
	HRRZ TT,WHYINT+3	; Get close reason
	CAIL TT,LCLSTB
	 SETO TT,
	MOVE TT,CLSTAB(TT)	;get asciz close reason
	PUSH P,T		;save host number
	PUSH P,TT
	PUSHJ P,ZTYPE
	POP P,TT
	POP P,T
	JUMPGE TT,ANALX		;return if host is up
	MOVE TT,WHYINT
	CAIN TT,%WYTCP		; If TCP, must do further checking
	 JRST [	GETNET TT,T	; Get network number
		CAME TT,[NW%ARP]	; Can only get status for arpanet sites
		 JRST ANALX	; Sorry, no can do.
		JRST .+1]	; Aha, try NETHST call.

	PUSHJ P,CRLF		;CRLF between down message and down reason
ANALC1:	SYSCAL NETHST,[T ? MOVEM T]	;get information about why host down
	 .LOSE %LSSYS
	MOVE B,T
	TRZ T,777760		;RH gets just reason down
	TLNE T,2000		;skip if down
	 SETO T,	  
	MOVE TT,DEDTAB(T)	;get asciz string describing situation
	PUSHJ P,ZTYPE
IFE $$UPTM,JRST ANALX
IFN $$UPTM,JRST ANALTM

IFN $$UPTM,[

;OPTIONALLY, SAY WHEN THE IMP THINKS THE HOST WILL BE BACK UP.
ANALTM:	ANDI B,177760		; get time back
	JUMPE B,ANALX		; flush if nothing
	CAIN B,177740		; -2 means unknown future time
	 JRST ANALX		; There isn't anything useful to say about this.
	MOVEI TT,[ASCIZ /  Host is expected back up /]
	PUSHJ P,ZTYPE
	CAIN B,177760			; -1 means more than a week
	 JRST [	JSP TT,SPEAK
		ASCIZ /over a week from now./ ]
	LDB T,[150300,,B]		; get day of week
	LDB TT,[100500,,B]		; get hours time
	SUBI TT,5			; EST/GMT offset
	PUSH P,B
	.RYEAR B,			; get time info
	TLNE B,100000			; daylight losing time?
	 AOSL TT			; yes, go ahead an hour
	  JUMPGE TT,NODAY		; easy way out
	ADDI TT,24.			; move up a day
	SOSGE T				; and days back
	 MOVEI T,6			; back to Sunday
NODAY:	MOVE B,TT			; Save real hours
	MOVE TT,DOWTAB(T)		; Get string describing day of week.
	PUSHJ P,ZTYPE
	MOVEI TT,[ASCIZ / at /]
	PUSHJ P,ZTYPE
	MOVE T,B			; get hours time
	PUSHJ P,2DTYPE
	MOVEI T,":"
	PUSHJ P,PUTCHR
	POP P,B				; Restore original time
	LDB T,[040400,,B]		; get minutes/5
	IMULI T,5.			; make into real minutes
	PUSHJ P,2DTYPE
	MOVEI TT,[ASCIZ/ EST./]
	.RYEAR T,
	TLNE T,100000
	 MOVEI TT,[ASCIZ/ EDT./]
	PUSHJ P,ZTYPE
	JRST ANALX

;TYPE NUMBER IN T AS TWO DECIMAL DIGITS.
2DTYPE:	IDIVI T,10.			; split high and low order
	ADDI T,"0"			; ASCIIify
	ADDI TT,"0"			; ASCIIify
	PUSH P,TT
	PUSHJ P,PUTCHR
	POP P,T
	JRST PUTCHR

DOWTAB:	[ASCIZ/on Monday/]
	[ASCIZ/on Tuesday/]
	[ASCIZ/on Wednesday/]
	[ASCIZ/on Thursday/]
	[ASCIZ/on Friday/]
	[ASCIZ/on Saturday/]
	[ASCIZ/on Sunday/]
	[ASCIZ/on April Fool's day/]

] ;END IFN $$UPTM
];$$TCP\$$ARPA

IFN $$CHAOS,[
;Analyze on chaos channel, still open

ANLCHA:	MOVE TT,WHYINT+1	;Connection state
	CAIE TT,%CSLOS
	 CAIN TT,%CSCLS
	  JRST ANLCH1
	CAIE TT,%CSINC
	 JRST ANLCH0		;Still open
	JSP TT,SPEAK
	ASCIZ /Connection broken -- foreign host not communicating./

ANLCH0:	PUSH P,CHSTTB(TT)
	MOVEI TT,[ASCIZ/Timed-out while connection /]
	PUSHJ P,ZTYPE
	POP P,TT
	JRST SPEAK

CHSTTB:	[ASCIZ/closed/]
	[ASCIZ/listening/]
	[ASCIZ/has received RFC/]
	[ASCIZ/trying to get connected/]  ;has sent RFC
	[ASCIZ/open/]
	[ASCIZ/lost/]
	[ASCIZ/broken/]

ANLCH1:	PUSH P,CHSTTB(TT)
	MOVEI TT,[ASCIZ/Connection /]
	PUSHJ P,ZTYPE
	POP P,TT
	PUSHJ P,ZTYPE
	MOVEI TT,[ASCIZ/ -- /]
	PUSHJ P,ZTYPE
	HLRZ TT,WHYINT+2	;get number of input packets
ANLCH2:	SOJL TT,ANALX		;scan input looking for CLS, LOS
	HLRZ T,WHYINT+4		;Pick up input channel number
	SYSCAL PKTIOT,[T ? MOVEI PKTBUF]
	 .LOSE %LSFIL
	LDB T,[$CPKOP+PKTBUF]
	CAIE T,%COCLS
	 CAIN T,%COLOS
	  SKIPA B,[440800,,PKTBUF+%CPKDT]
	   JRST ANLCH2
	LDB C,[$CPKNB+PKTBUF]
ANLCH3:	SOJL C,ANALX
	ILDB T,B
	PUSHJ P,PUTCHR
	JRST ANLCH3
];$$CHAOS

IFN $$ARPA\$$TCP,[

; Tables

;Close Reasons

	[ASCIZ/Illegal close-reason code??/]
CLSTAB:	OFFSET -.
%NCNTO::[ASCIZ/Connection never opened??/]
%NCUSR::[ASCIZ/Connection legitimately closed??/]
%NCFRN::[ASCIZ/Connection closed by foreign host./]
%NCRST::[ASCIZ/Connection reset by foreign host./]
%NCDED::400000,,[ASCIZ/Host died./]
%NCINC::400000,,[ASCIZ/Incomplete transmission - foreign host or network died./]
%NCBYT::[ASCIZ/Byte size mismatch??/]
%NCNCP::[ASCIZ/Local Network Control Program reset./]
%NCRFS::[ASCIZ/Request for Connection refused by foreign host./]
LCLSTB::OFFSET 0

;Host Dead Reasons

	[ASCIZ/Illegal host-dead code??/]
DEDTAB:	[ASCIZ/  Network lossage./]  ;0 probably no host-dead-reason returned
	[ASCIZ/  Destination Host dead./]	;1 WOULDN'T SAY WHY
	[ASCIZ/  Foreign Network Control Program not in operation./]
	[ASCIZ/  Destination Host or IMP does not exist./]
	[ASCIZ/  Destination Host is initializing its NCP software./]
	[ASCIZ/  Destination Host down for scheduled maintenance./]
	[ASCIZ/  Destination Host down for scheduled hardware work./]
	[ASCIZ/  Destination Host down for scheduled software work./]
	[ASCIZ/  Destination Host is in emergency restart./]
	[ASCIZ/  Destination Host down due to power failure./]
	[ASCIZ/  Destination Host is stopped at a breakpoint./]
	[ASCIZ/  Destination Host down due to hardware failure./]
	[ASCIZ/  Destination Host is not scheduled to be up./]
	[ASCIZ/  (Undefined host-down code 13.)/]
	[ASCIZ/  (Undefined host-down code 14.)/]
	[ASCIZ/  Destination Host is coming up now./]

];$$ARPA\$$TCP
];END IFN $$ANALYZE*ITS

IFN $$CVH,[
;;;; Utilities - CVH2NA, CVH3NA

; CVH2NA - Convert network host address in A to HOSTS2 format.
;	A/ net address (any format)
; Returns A

CVH2NA:	PUSH P,B
	LDB B,[301400,,A]	; Get high 12 bits of net address
	CAIGE B,70		; If less than lowest HOSTS2-fmt value
	 JUMPN B,CVH2N3		; then must be HOSTS3, go convert.
	CAIL B,1000		; If any of high 3 bits set,
	 JRST CVH2N3		;  then it's a HOSTS3 strange-fmt number.
	JUMPN B,CVH2N2
	CAILE A,377		; Zero network, so must be ARPA net
	 JRST CVH2N1		; Not just 8 bits, just add net number.

	; Old-style 8-bit Arpanet host number
	LSHC A,-6.
	ROT B,6.
	DPB B,[112000,,A]
CVH2N1:	TLO A,(12_33)
	JRST CVH2N9

	; Probably HOSTS2 format number
CVH2N2:	JRST CVH2N9		; For now, that's good enough.

	; HOSTS3 format number, convert it.
CVH2N3:	CAIN B,12		; Arpa net?
	 JRST [	LSHC A,-16.
		ANDI A,377
		ROT B,16.
		DPB B,[112000,,A]
		TLO A,(12_33)
		JRST CVH2N9]
	CAIN B,7+<NE%UNT_-24.>	; Chaos net?
	 JRST [	ANDI A,177777	; Yup, fix it up.
		TLO A,(7_33)
		JRST CVH2N9]
	CAIN B,22		; LCS net?
	 JRST [	LSHC A,-8.
		ANDI A,-1
		LSH A,2
		LSHC A,8.
		TLO A,(22_33)
		JRST CVH2N9]

	; Not a known net, but try to do something plausible.
	ANDCM A,[-1_24.]	; Preserve low 24 bits
	DPB B,[331100,,A]	; put net # into HOSTS2 field.
CVH2N9:	POP P,B
	POPJ P,
] ;$$CVH

; CVH3NA - Convert network host address in A to HOSTS3 (Internet) format.
;	A/ net address (any format)
; Returns A

CVH3NA:	PUSH P,B
	LDB B,[301400,,A]	; Get high 12 bits of net address
	CAIGE B,70		; If less than lowest HOSTS2 value,
	 JUMPN B,CVH3N3		; it's already HOSTS3 format!  (unless zero)
	CAIL B,1000		; If any of high 3 bits were set,
	 JRST CVH3N3		;  it must be a HOSTS3 strange-fmt addr.
	JUMPN B,CVH3N2		; If not zero, then must assume HOSTS2 fmt.

	; Old-format 8-bit Arpanet host number, or HOSTS2 with zero net.
IFE $$ARPA,IFN $$CHAOS, IOR A,[NW%CHS] ? JRST CVH3N3
	CAILE A,377
	 JRST CVH3N6	; If greater than 8 bits, assume HOSTS2, zero net.
	LSHC A,-6	; Put 10 bits spacing between host/imp #s.
	LSH B,-<2+8.>
	LSHC A,<2+8.+6>
	TLO A,(12_24.)	; and add ARPA network number.
	JRST CVH3N3

	; HOSTS2 format number
CVH3N2:	TRZE B,7	; Zap low 3 bits to ensure correct comparison
	 JRST CVH3N5	; If any were set, can't be Chaosnet.
	CAIN B,7_3		; Chaos net?
	 JRST [	ANDI A,177777		; Yes, kill all but bottom 16 bits
		TLO A,(NE%UNT+<7_24.>)	; Add Chaos net #
		JRST CVH3N3]
CVH3N5:	CAIN B,12_3		; Arpa net?
CVH3N6:	 JRST [	LSHC A,-9.
		ANDI A,177777
		ROT B,9.
		DPB B,[201000,,A]
		TLO A,(12_24.)
		JRST CVH3N3]
	CAIN B,22_3		; LCS net?
	 JRST [	LSHC A,-8.
		LSH A,-2
		ANDI A,377
		LSHC A,-8.
		TLO A,(22_24.)
		JRST CVH3N3]

	; No match, assume it's HOSTS3.
CVH3N3:	POP P,B
	POPJ P,


$$LOG,[
;;; Logging - CStacy, 22 October 1984
;;;
;;; This facility is (originally) so that I can see which users are using
;;; the TELNET and FTP facilities on our machine and to help discover who
;;; is using us as a base in attacking other sites.  Maybe ITS should do
;;; some sort of network logging like Multics, but I'll just put it in
;;; this library for now since it isn't clear how generally useful it is
;;; or what functionality we want.

LOGO==1	;Channel for log file.
LOGL==2	;Channel for log file lock-file.

;;; NOTE: The user could easily become screwed up if we're interrupted.
;;;   --We have IOPUSHed channels away from the user without consent.
;;;   --We do synchronous file IO behind its back and handle our own errors.
;;; Therefore, LOG processing  defers all interrupts. 
;;; The LOG stuff is only called before opening and after closing network
;;; channels, and so this should be a first approximation to a safe practice.

;;; Logfile entries are scattered through the file in sequential order.
;;; They are of variable length.  They begin with a unique id number;
;;; The log for a particular job can be threaded from the id.
;;;
;;; An transaction entry looks like:
;;;	/BEGIN/	
;;;	BEGIN-CODE (id)		The 36 bit unique id code for this job.
;;;     TIMESTAMP		The time of the entry.
;;;	OPCODE			Sixbit name of the transaction type.
;;;	CRUFT WORDS		Transaction dependant data.
;;;
;;;
;;; The NETLOG program (source in AR2:CSTACY;NETLOG) can be used to
;;; expand a logfile into an ASCII representation of some or all of the
;;; transactions.
;;;
;;; It is possible to have incomplete records of network usage
;;; in the logfile, since if many things go wrong we abort the
;;; logging procedure rather than waste time being too robust
;;; when the entire facility is supposed to be invisible.

;;; NETWRK routines may call LOGACT to log some action.
;;; Callers provide any list of cruft they want, the first word
;;; being SIXBIT name of the operation.  
;;; Semantics for entries should be documented here for interested
;;; programmers to find out how to decode the log file.
;;;
;;;  OPEN:	<host-address> <foreign port>
;;;  ANALYZ:	<host-address> <whyint> ... <whyint+4>
;;;

.SCALAR LOGID		;Our id number in the log file.

;;; LOGACT - Log some action
;;; A/ number of crufty words on the stack (P) before the funcall.
;;; Smashes no ACs and never skips.
;;; Caller must pop his args back off himself.

LOGACT:	MOVE T,P		;Save current SP here for a moment.
	.SUSET [.RPICLR,,TT]	;Read global interrupt defer word.
	PUSH P,TT		;Stack it away for restoration.
	.SUSET [.SPICLR,,[0]]	;Defer all interrupts.
	.IOPUSH LOGO,		;Push the channels we want,
	.IOPUSH LOGL,		;hoping the IOPDL doesn't overflow.
	PUSH P,A		;Do not smash ACs.
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE B,T		;B gets SP to top of LOGACT frame.
LOGA10:	PUSHJ P,LOGOPN		;Open log file if needed.
	 JRST LOGCLS
	SYSCAL ACCESS,[%CLIMM,,LOGO ? C]   ;Move to EOF.
	 JRST LOGCLS
	SUB B,A			;Point to first arg.
	HRLZ A,A
	HRR A,B			;A has length,,adr of crufties.
LOGA20:	SYSCAL RQDATE,[%CLOUT,,B]
	 JRST LOGCLS
	SKIPE C,LOGID		;If our id has been initialized,
	 JRST LOGA30		; go make an entry.
	.SUSET [.RUIND,,C]	;Else find our job number.
	HRL C,B			;*** This should be more or less unique? **
	MOVEM C,LOGID		;Set our id.
LOGA30:	MOVE T,[444400,,[SIXBIT /BEGIN/]]
	MOVEI TT,1
	SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT]	;Write entry marker.
	 JRST LOGCLS
	MOVE T,[444400,,B]
	MOVEI TT,2
	SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT]	;Write timestamp and id.
	 JRST LOGCLS
	.SUSET [.RUNAME,,B]
	.SUSET [.RJNAME,,C]
	MOVE T,[444400,,B]
	MOVEI TT,2
	SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT]	;UNAME, JNAME.
	 CAIA
LOGA40:	HRRZ T,A		;Get ptr to stacked args.
	HRLI T,444400		;Make BP.
	HLRZ TT,A		;Get length.
	SYSCAL SIOT,[%CLIMM,,LOGO ? T ? TT]	;Write opcode, crufties.
	 JRST LOGCLS
LOGCLS:	.CLOSE LOGO,
	.CLOSE LOGL,
	.IOPOP LOGL,
	.IOPOP LOGO,
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POP P,T			;Probably -1 (no global deferment).
	.SUSET [.SPICLR,,T]	;Restore interrupt defer state.
	POPJ P,			;All done.


;;; LOGOPN -  Seize the logfile lock, and open the logfile for writing.
;;; Uses LOGL and LOGO file channels, and skips on success.
;;; Returns length of the database in C, does not smash other ACs.
;;; Notes:
;;;   o If the lock file is missing LOGOPN will re-create it.
;;;   o If the logfile itself is missing, we just fail.

LOGMLT==6	;Maximum # attempts to make trying to seize the lock.

LOGOPN:	PUSH P,A
	PUSH P,B
	SETZ B,			;Count of locking attempts in B.
LOGLOK:	SYSCAL OPEN,[%CLBIT,,.BIO\%DOWOV ? %CLIMM,,LOGL
		[SIXBIT /DSK/]
		[SIXBIT /NETLOG/]
		[SIXBIT /LOCK/]
		[SIXBIT /SPACY/]]
	 CAIA
	JRST LOGLKD		;Got it!
	CAIL B,LOGMLT		;Else if we have exceeded the retry maximum
	 JRST LOGLKF		; Fail.
	.STATUS LOGL,A		;Let's see why the open failed.
	LDB A,[220600,,A]	;Get error code.
	CAIN A,%ENAFL		;If someone else has the lock
	 JRST [	MOVEI T,30.	; Sleep for one second.
		.SLEEP T,	; (They should give it up soon.)
		AOS B		; Keep count of attempts to seize lock.
		JRST LOGLOK ]	; Try,try again.
	CAIE A,%ENSFL		;Hmmm....Maybe the lock file is missing?
	 JRST LOGLKF		; Nope - some random lossage.
	SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LOGL	;Re-create it.
			[SIXBIT /DSK/]
			[SIXBIT /NETLOG/]
			[SIXBIT /LOCK/]
			[SIXBIT /SPACY/]]
	 JRST LOGLKF		; Fail if could not create lock.
	.CLOSE LOGL,		;Else close file
	JRST LOGLOK		;and try to seize it again.
LOGLKD:	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,LOGO
		[SIXBIT /DSK/]
		[SIXBIT /NETLOG/]
		[SIXBIT / DATA/]
		[SIXBIT /SPACY/]]
	 JRST LOGLKF
	SYSCAL FILLEN,[%CLIMM,,LOGO ? %CLOUT,,C]
	 JRST LOGLKF
	.CLOSE LOGO,		   ;Protocol says no lock competition here.
	SYSCAL OPEN,[%CLBIT,,%DOWOV+.UIO ? %CLIMM,,LOGO
		[SIXBIT /DSK/]
		[SIXBIT /NETLOG/]
		[SIXBIT / DATA/]
		[SIXBIT /SPACY/]]
	 CAIA			   ; Huh? We opened it a moment ago???
	AOS -2(P)		   ;Skip return if won.
LOGLKF:	POP P,B
	POP P,A
	POPJ P,


];$$LOG


.qmtch=qmtch	;set this back to the value the user gave it

.END NETWRK
