;*** THINGS TO DO -*- Mode: MIDAS; Fonts: CPTFONT-*-
; TCP Interrupt/datamark stuff (when it gets put into ITS)

IF1	TITLE TELSER - ITS TELNET SERVER

;NEW SERVER TELNET USING SIOT, ETC.
;PROTOCOLS: OLD TELNET, NEW TELNET, AND NEW SUPDUP.
;THIS VERSION, OF 3/13/83, TALKS TCP AND CHAOS NET AND USES HOSTS3.

VERSION==.FNAM2

SUBTTL DEFINITIONS

A=1		;CLOBBERED BY INPUT-SIDE P.I. LEVEL
B=2		;..
C=3		;..
D=4		;..
E=5		;..
T=6		;CLOBBERED BY OUTPUT-SIDE P.I. LEVEL
TT=7		;..
H=10		;..
I=11		;..
J=12		;..
SLEEP=16	;USED ONLY BY MAIN .SLEEP
P=17

STYIC==1
STYOC==2
ICPCH==3	;NEXT 3 MUST BE IN ORDER FOR SERVE ROUTINE
NETIC==4
NETOC==5
RANCH==6

DELAY==20.*30.	;20 Seconds

;OLD TELNET CONTROL CHARACTERS

OT%DMK==200	;DATA MARK
OT%BRK==201	;BREAK
OT%NOP==202	;NO-OP
OT%NEC==203	;NO ECHO
OT%ECH==204	;ECHO
OT%HID==205	;HIDE INPUT

;NEW TELNET CONTROL CHARACTERS

NT%IAC==377	;INTERPRET FOLLOWING CHAR AS COMMAND
NT%DONT==376	;DON'T <OPTION>
NT%DO==375	;DO <OPTION>
NT%WONT==374	;WON'T <OPTION>
NT%WILL==373	;WILL <OPTION>
NT%SB==372	;SUBNEGOTIATION BEGIN <OPTION> <TEXT...> IAC SE
NT%GA==371	;GO AHEAD
NT%ERL==370	;ERASE INPUT LINE
NT%ERS==367	;ERASE INPUT CHARACTER
NT%AYT==366	;ARE YOU THERE
NT%AO==365	;ABORT OUTPUT
NT%IP==364	;INTERRUPT PROCESS
NT%BRK==363	;BREAK
NT%DMK==362	;DATA MARK
NT%NOP==361	;NOP
NT%SE==360	;SUBNEGOTIATION END

;NEW TELNET OPTIONS

OP%BIN==0	;TRANSMIT BINARY
OP%ECO==1	;ECHO
OP%SGA==3	;SUPPRESS GO AHEAD
OP%LOG==18.	;LOGOUT
OP%SUP==21.	;SUPDUP
OP%LOC==23.	;TTYLOC

DEFINE INFORM A,B
IF2,[
	PRINTX\A B
\]
TERMIN
DEFINE SYSCAL A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN

;;; HSTAT (host status) definitions.

SERVER==0		;Server host.
USER==1			;User host only.
TIP==2			;TIP (nowadays, TAC).
MINITS==3		;MINITS terminal concentrator.

.INSRT SYSTEM;CHSDEF
SUBTTL VARIABLES

IFN .-100, .ERR THIS HAS TO BE AT 100, PWORD AND NAME LOOK AT IT
	'TERMID		;MAGIC IDENTIFIER
TERMID:	BLOCK 8		;IF NON-ZERO, AN ASCIZ TERMINAL NAME
HSTNAM:	BLOCK 8		;IF NON-ZERO, THE NAME OF THE HOST IN ASCIZ
TIPNUM:	0		;IF NON-ZERO, PORT NUMBER ON TIP
FHOST:	0		;FOREIGN HOST CONNECTED TO
HSTSIX:	0		;SIXBIT NAME OF HOST
FUNAME:	0		;SIXBIT NAME OF USER AT FOREIGN SITE
HSTAT:	0		;FOREIGN HOST STATUS (SERVER, USER, TIP)
 ;END OF STUFF LOOKED AT BY PWORD AND NAME.
 ;THESE NEXT THREE LOOKED AT BY LMODEM, OR ANYONE ELSE WHO WANTS
 ;TO SEE IF WE THINK WE'RE IN BINARY MODE.
 ;THE VARIABLE IS NEEDED ANYWAY TO PREVENT INFINITE ACK LOOPS
 ;UNDER SOME CONDITIONS.
IFN .-126, .ERR BINARY MODE INFO NOT WHERE EXPECTED
	'BINARY
TRBINF:	0		;-1 RECEIVED IAC DO TRNBIN
RCBINF:	0		;-1 RECEIVED IAC WILL TRNBINN
;
OLDTEL:	0		;-1 USING OLD TELNET PROTOCOL
NEWTEL:	0		;-1 USING NEW TELNET PROTOCOL
SUPDUP:	0		;-1 USING (NEW) SUPDUP PROTOCOL
SUPNGF:	0		;-1 => EXPECTING SUPDUP VS TELNET NEGOTIATION
			; Only one of NCPP, CHAOSP, or TCPP can be set.
NCPP:	0		;-1 => WE'RE USING ARPA NCP
CHAOSP:	0		;-1 => WE'RE USING CHAOS NET
TCPP:	0		;-1 => WE'RE USING INTERNET TCP
ECOSTS:	NT%DO		;INITIAL ECHO STATE (REMOTE ECHO)
SGASTS:	-1		;LH -1 => WILL, RH -1 => DO   (TO AVOID INFINITE LOOPS)
DEBUG:	0		;NONZERO DEBUGGING, LEAVE SELF AROUND; ALSO DON'T TIME OUT THE ICP.
			;NEGATIVE => UNDER A DDT, SO DON'T TRY TO LOG IN.
TAFJPC:	0		;WHERE TERMINATED FROM

;LETS BE REALLY ASSHOLES!!!

BADSIZ==20
BADTBL:	BLOCK BADSIZ


;VARIABLES FOR THE OUTPUT SIDE

OBL==70.
OBSZ==OBL*4
OBF:	BLOCK OBL		;OUTPUT BUFFER.
OOP:	440800,,OBF		;NET TAKES OUT.
OIP:	440800,,OBF		;STY PUTS IN.
BBP:	440800,,OBF
BEP:	040800,,OBF+OBL-1
ORM:	OBSZ-1			;ROOM IN BUFFER
ORN:	0			;CHARS IN BUFFER
OOW:	OBSZ			;CHARS UNTIL OOP WRAPS
OIW:	OBSZ			;CHARS UNTIL OIP WRAPS
DMKFLG:	0			;NUMBER OF DATA MARKS TO BE SENT
NTRM:	0			;USED TO TELL IF BLOCKED FOR FULL NEW OUTPUT BUFFER
NTOTMO:	5*60.			;TIME OUT IS 5 SECONDS (SHOULDN'T NEED AFTER ITS 1004)
LFIGNR:	0			;-1 => IGNORE CHAR AFTER CR IF IT'S LF OR NULL
LFPROC:	0			;-1 => DO LFIGNR PROCESSING
STYHNG:	0			;-1 => STY HUNG FOR BUFFER FULL
STIM:	0			;NORMALLY 0, NON-ZERO WHEN STIMULATING
				; INPUT INTERRUPT
IACFLG:	0			;NON-ZERO => IAC PROCESSING AWAITING OUTPUT
				; AVAILABILITY
GOAWAY:	0			;NON-ZERO => GO AWAY AFTER PROCESSING NET INPUT
DIRCON:	-1			;NON-ZERO => TRY OUT DIRECT CONNECT FEATURE
TTYFRE: -1			; -1 => TTY was in use last time we looked.
				; 0 => TTY was free last time we looked.

DRCONC:	SETZ			;.CALL BLOCK TO DIRECT CONNECT
	'STYNET
	MOVEI STYOC
	MOVEI NETIC
	MOVEI NETOC
	SETZ DRORST

DRORST:	0			;CHARS TO SEND ON OUTPUT RESET WHILE DIRECT CONNECTED

LPDL==60
PDL:	-LPDL,,.
	BLOCK LPDL
SUBTTL OUTPUT SIDE

;HERE WHEN STY WANTS TO START TYPING OUT
;ALSO WHEN BUFFER GOES FROM FULL TO LESS THAN FULL

STYINT:	PUSH P,[DISMIS]
STYIN0:	SETOM STYHNG		;ASSUME WILL HANG W/ BUFFER FULL
	MOVE TT,ORM		;COMPUTE # CHARS TO READ
	CAMLE TT,OIW
	 MOVE TT,OIW
	SKIPE T,TT
	 JRST STYIN1
	SKIPE OIW
	 POPJ P,		;BUFFER FULL
	MOVE T,BEP		;WRAP AROUND TIME
	CAME T,OIP
	 .VALUE			;POINTERS SCREWED
	MOVE T,BBP
	MOVEM T,OIP
	MOVEI T,OBSZ
	MOVEM T,OIW
	JRST STYIN0

STYIN1:	MOVE H,OIP
	.CALL [	SETZ		;AND READ FROM STY IN DON'T HANG MODE
		SIXBIT/SIOT/
		MOVEI STYIC
		MOVE OIP
		SETZ TT ]
	 JSR DEATH
	SKIPE TT
	 SETZM STYHNG		;READ ALL THAT STY HAD TO OFFER
	SUBB T,TT		;# CHARS THAT WERE READ
	JUMPE T,CPOPJ		;JUMP IF NOTHING WAS READ FROM STY
	SUBM T,OIW		;UPDATE OIW ACCORDING TO ADVANCEMENT OF OIP
	MOVNS OIW
;; No interrupts or datamarks for TCP yet either, though this should
;; change someday.
	SKIPN TCPP
	 SKIPE CHAOSP
	  JRST STYIN3		;NO INTERRUPTS AND DATA MARKS ON CHAOS NET
STYIN2:	ILDB I,H		;SCAN THROUGH CHARS THAT WERE READ, LOOKING FOR OUTPUT RESET.
	CAIN I,%TDQOT
	 JRST [ SOJE TT,STYIN3	;%TDQOT QUOTES NEXT CHARACTER: DON'T ASK IF IT'S OUTPUT RESET,
		ILDB I,H	;BUT DO COUNT IT OFF.
		SOJE TT,STYIN3
		JRST STYIN2]
	CAIE I,%TDORS
	 SOJG TT,STYIN2
	JUMPE TT,STYIN3		;JUMP IF NO OUTPUT RESET SEEN

	AOS DMKFLG		;OUTPUT RESET - CAUSE DATA MARK TO BE SENT
	PUSH P,[NETIN0]		;(MAKE SURE IT GETS SENT)
	;SKIPN CHAOSP		;THIS CODE NOT USED ON CHAOS NET ANYWAY, SEE STYIN2-2
	 .NETINT NETOC,		;ALSO SEND AN INTERRUPT

	MOVEM H,OOP		;FLUSH BUFFER UP TO RESET POINT
	SETZM ORN
	SOS T,TT
	MOVEI TT,OBSZ-1
	MOVEM TT,ORM
	MOVEI TT,0		;RECOMPUTE OOW
	TLNE H,700000		;ADVANCE H TO LAST BYTE IN WORD
	 JRST [ IBP H ? AOJA TT,.-1 ]
	MOVEI H,-OBF+1(H)
	IMULI H,4
	ADDI TT,OBSZ
	SUB TT,H
	MOVEM TT,OOW
STYIN3:	SKIPN ORN		;IF BUFFER WENT FROM EMPTY TO NOT-EMPTY,
	 PUSH P,[NETIN0]	; STIMULATE THE NETWORK INTERRUPT
	ADDM T,ORN		;UPDATE FOR NUMBER OF CHARACTERS READ
	MOVNS T
	ADDM T,ORM
	SKIPN OIW		;IF STOPPED DUE TO WRAP-AROUND
	 JRST STYIN0		;THERE MAY BE MORE
	POPJ P,
;NETOC INTERRUPT (REAL OR STIMULATED)

NETINT:	PUSH P,[DISMIS]
NETIN0:	MOVSI TT,(SETZ)
	SKIPN NTRM		;IF TIME OUT PENDING, FLUSH IT
	 .REALT TT,
	SKIPE CHAOSP
	 JRST CHSAA
	SKIPE TCPP
	 JRST [SYSCAL WHYINT,[MOVEI NETOC	; T/ State
		MOVEM T ? MOVEM T ? MOVEM TT]	; TT/ # bytes free in outbuf
		 .LOSE %LSSYS
		JRST NETIND]
	.CALL [ SETZ ? 'WHYINT ? MOVEI NETOC	;CHECK ON THE NET CHANNEL
		MOVEM T ? MOVEM T ? SETZM TT ]	;RH(T) STATE, TT # BYTES
	 .LOSE %LSSYS
NETIND:	HRRZS T
	CAIE T,%NSOPN
	CAIN T,%NSRFN
	 CAIA
	  JSR DEATH		;CLOSED
	MOVNM TT,NTRM		;MINUS NUMBER OF BYTES OF OUTPUT BUFFER SPACE
	JUMPG TT,NETIN1
NETINA:	.NETS NETOC,		;IF NO OUTPUT BUFFER SPACE, MAKE SOME
	MOVE TT,[MOVE NTOTMO]
	SKIPN NTRM
	 .REALT TT,		;IF NET OUTPUT BUFFER FULL, SET TIME OUT
CPOPJ:	POPJ P,			;WILL INTERRUPT BACK WHEN READY
				;HOPEFULLY FROM NET, ELSE FROM TIMEOUT


CHSAA:	.CALL [	SETZ ? 'WHYINT ? MOVEI NETOC	;FIND HOW MANY PACKETS OF OUTPUT SPACE AVAIL
		MOVEM T ? MOVEM T ? SETZM TT ]	;IN TT, AND STATE IN T
	 .LOSE %LSSYS
	CAIE T,%CSOPN
	 JSR DEATH		;CONNECTION NOT OPEN
	HRRZS TT
	IMULI TT,%CPMXC		;CONVERT TO CHARACTERS
	MOVNM TT,NTRM
	JUMPLE TT,NETINA	;JUMP IF NO SPACE NOW
NETIN1:	SKIPE DMKFLG
	 JRST NETIN3		;NEED TO PUT A DATA MARK BEFORE PROCEEDING
	SKIPE OOW
	 JRST NETIN2
	MOVE T,BBP
	MOVEM T,OOP
	MOVEI T,OBSZ
	MOVEM T,OOW
	JRST NETIN1

NETIN2:	CAMLE TT,ORN		;COMPUTE NUMBER CHARS TO SEND AT A WHACK
	 MOVE TT,ORN
	CAMLE TT,OOW
	 MOVE TT,OOW
	JUMPE TT,CPOPJ		;NOTHING TO SEND
	SKIPE DIRCON		;UN-DIRECT-CONNECT IN CASE A TIMING ERROR
	 .CALL [ SETZ ? 'STYNET ? MOVEI STYOC ? MOVEI -1 ;GENERATED SOME OUTPUT TO US
				  MOVEI 0 ? SETZI 0 ] ;ITS WANTS TO SEE 4 ARGS
	  JFCL
	MOVE T,TT
	.CALL [	SETZ
		SIXBIT/SIOT/
		MOVEI NETOC
		MOVE OOP
		SETZ TT ]
	 JSR DEATH
	SKIPE TT
	 JSR DEATH		;SUPPOSED TO ALL GET TRANSMITTED
	MOVE TT,ORM
	ADDM T,ORM		;UPDATE FOR ADVANCEMENT OF OOP
	ADDM T,NTRM
	MOVNS T
	ADDM T,ORN
	ADDM T,OOW
	AOSN STYHNG		;IF DIDN'T READ ALL STY HAD TO OFFER,
	 PUSHJ P,STYIN0		; TRY AGAIN NOW THAT BUFFER IS LESS FULL
	SKIPE ORN		;IF MORE STUFF TO BE SENT,
	 JRST NETIN0		; THEN TRY TO DO SO
	JRST NETINA		;OTHERWISE, JUST SEND WHAT WE'VE GOT

NETIN3:	SKIPE NEWTEL		;SEND RIGHT FLAVOR OF DATA MARK DEPENDING ON PROTOCOL
	 SOJA TT,[.IOT NETOC,[NT%IAC]	;NEED TO INSERT A IAC CHARACTER HERE
		  AOS NTRM
		  JRST .+1]
	SKIPE NEWTEL
	 .IOT NETOC,[NT%DMK]
	SKIPE OLDTEL
	 .IOT NETOC,[OT%DMK]
	SKIPE SUPDUP
	 .IOT NETOC,[%TDORS]
	SOS DMKFLG		;ONE LESS DATA MARK NEEDING TO BE SENT
	AOS NTRM
	SOJLE TT,NETINA
	.NETS NETOC,		;MAKE SURE IT GETS SENT
	JRST NETIN1
SUBTTL INTERRUPT HANDLER

INTABL:	P			;PUSH STATUS ON AC P

	%PIIOC ? 0		;IOC ERROR HAS HIGH PRIORITY
	-1 ? -1
	IOCERR			;CONNECTION DISCONNECTED, TERMINATE

	0 ? 1_NETIC		;NETWORK INPUT HAS HIGHEST PRIORITY
	0 ? -1
	INPINT

	%PIRLT ? 1_NETOC	;NETWORK OUTPUT REAL OR SIMULATED
	%PIRLT ? 1_NETOC+1_STYIC
	NETINT

	0 ? 1_STYIC		;STY INPUT RUNS AT SAME PRIORITY LEVEL
	%PIRLT ? 1_NETOC+1_STYIC
	STYINT
INTBLN==.-INTABL

;INTERRUPT ROUTINES GENERALLY START WITH PUSH P,[DISMIS]
DISMIS:	.CALL [	SETZ
		'DISMIS
		SETZ P ]

;HERE TO GET GOING

UBLAST:	.CORE 1			;FLUSH INITIALIZATION HAIR
	 .VALUE			;AND DROP INTO MAIN HANG
	SKIPE DIRCON
	 .CALL DRCONC		;TELL SYSTEM TO HANDLE SIMPLE TELNET FUNCTIONS
	  JFCL			;IF FAILS, WELL, OK
	MOVEI SLEEP,1		;MAKE SURE SLEEP IS NOT ZERO WHEN FIRST INTERRUPT HAPPENS!
	.SUSET [.SPICLR,,[-1]]	;NOW SAFE TO ALLOW INTERRUPTS (PC IS GOOD)
	MOVEI SLEEP,1
	MOVEM SLEEP,STIM	; Ensure we don't miss any NET input ints
	CAIA			; the first time we enter sleep loop, by
				; provoking an interrupt right away.

;MAIN PROGRAM LEVEL HANGS HERE.  BEWARE OF INTERRUPT ROUTINES RANDOMLY CLOBBERING ACS!
HANG:	MOVEI SLEEP,DELAY	;NOTE THIS AC CAN GET CLOBBERED TO CAUSE WAKEUP
	.SLEEP SLEEP,
	MOVE SLEEP,STIM
	.SUSET [.SIIFPIR,,[1_NETIC]] ;INPINT ROUTINE WANTS TO BE AWOKEN
	JRST HANG

;CALL HERE TO ARRANGE FOR INPINT TO WAKE UP AGAIN IN 1/2 SECOND
REWAKE:	SKIPE STIM
	 POPJ P,		;ALREADY DONE ONCE, DON'T DO IT AGAIN
	HRRZ E,PDL+5		;MAIN PROGRAM PC SHOULD BE HERE
	CAIL E,HANG
	 CAIL E,HANG+5
	  .VALUE		;UGH PDL CLOBBERED OR SOMETHING
	MOVEI E,HANG+1
	MOVEM E,PDL+5
	MOVEI SLEEP,15.
	AOS STIM
	POPJ P,

;ON AN IOC ERROR, MAKE SURE THIS INDICATES CONNECTION CLOSED
IOCERR:	.CALL [	SETZ ? 'WHYINT ? MOVEI NETIC ? MOVEM A ? SETZM A ]
	 JSR DEATH
	HRRZS A
	JUMPE A,THTSAL .SEE %NSCLS .SEE %CSCLS
	.CALL [ SETZ ? 'WHYINT ? MOVEI NETOC ? MOVEM A ? SETZM A ]
	 JSR DEATH
	HRRZS A
	JUMPE A,THTSAL .SEE %NSCLS .SEE %CSCLS
	;.VALUE			;RANDOM IOC ERROR.  CATCH FOR DEBUGGING.
	JSR DEATH

THTSAL:	.SUSET [.SPICLR,,[0]]	;THAT'S ALL, FOLKS
	.SUSET [.RJPC,,TAFJPC]
	.CALL GTUIDX		;GET INDEX OF STY USER IN B
	 JRST THTSAC		;(NEVER OPENED THE STY)
	JUMPL B,THTSAC
	MOVE A,[10,,'USR]	;OPEN THAT JOB
	IORI B,%JSNUM		;<JOB> SPEC
	MOVEI C,0
	.OPEN RANCH,A
	 JRST THTSAC
	.USET RANCH,[.RUNAME,,A]	;SEE IF LOGGED IN
	HLRES A
	AOJE A,THTSAC		;NO, CLOSING STY WILL LOG OUT
	.CALL [	SETZ		;YES, WANT TO DETACH
		'DETACH
		MOVEI STYIC
		ANDI 10 ]	;AND HAVE SYSTEM FLUSH IT IF IT SITS AROUND FOR AN HOUR
	 JFCL ;SIGH
THTSAC:	.LOGOUT
	.VALUE

GTUIDX:	SETZ		;.CALL THIS TO GET INDEX OF USER AT OTHER END OF STY
	'STYGET
	MOVEI STYIC
	MOVEM B
	SETZM B

;HERE ON LOSSAGE

DEATH:	0
	SKIPE DEBUG
	 .VALUE
	JRST THTSAL
SUBTTL INPUT SIDE

INPINT:	PUSH P,[DISMIS]
INPIN0:	JUMPL SLEEP,INPIN1	;JUMP IF INTERRUPTED WHILE IN MIDDLE OF SLEEPING
	CAMN SLEEP,STIM
	 SETZM STIM		;STIMULUS HAPPENED
	JUMPN SLEEP,INPIN1	;JUMP IF NOT TWO-MINUTE WAKEUP
	.CALL GTUIDX		;GET INDEX OF TTY USER IN B
	 JSR DEATH
	JUMPL B,[		; If TTY not in use:
		AOSE TTYFRE	; Was it in use last time?
		 JRST THTSAC	; No:  Go kill self.
		JRST .+2]	; Yes:  Go around again.
	 SETOM TTYFRE		; Remember TTY was in use this time.
;;; Used to be just:
;;;	JUMPL B,THTSAC		;GO KILL SELF IF TTY NOT IN USE
	SKIPN DIRCON		;DON'T IOT IF DIRECT CONNECTED - COULD MESS UP OUTPUT
	 SKIPE ORN
	  JRST INPIN1		;THEN IF OUTPUT BUFFER IS NOT BUSY, SEND A NO-OP
	SKIPE SUPDUP		; TO FIND OUT IF CONNECTION IS REALLY STILL OPEN.
	 .IOT NETOC,[%TDNOP]
	SKIPE OLDTEL
	 .IOT NETOC,[OT%NOP]
	SKIPE NEWTEL
	 .IOT NETOC,[NT%IAC]
	SKIPE NEWTEL
	 .IOT NETOC,[NT%NOP]
	.NETS NETOC,
INPIN1:	.CALL [	SETZ		;WHAT'S THE STATE OF NET CONNECTION
		'WHYINT
		MOVEI NETIC	;ARPA		;CHAOS
		MOVEM C		;%WYNET		;%WYCHA
		MOVEM A		;STATE		;STATE
		SETZM B ]	;BYTE COUNT	;RECEIVE,,TRANSMIT PACKET COUNT
	 JSR DEATH
	CAIE C,%WYTCP
	 CAIN C,%WYNET
	  JRST ARPIN
	CAIE C,%WYCHA
	 .LOSE
	CAIE A,%CSOPN		;IF NOT OPEN, READ INPUT, THEN GO AWAY
	 SETOM GOAWAY
	TLNE B,-1		;ANY INPUT AVAILABLE
	 JRST INPIN2		;YES, GO PROCESS IT, WITH HUMONGOUS CHARACTER COUNT
	CAIE A,%CSOPN		;OTHERWISE, IF STATE IS BAD, TIME TO GO AWAY
	 JRST THTSAL		;IF STATE BAD AND INPUT AVAIL, WILL WIN VIA IOC ERROR
	POPJ P,			;NO INPUT AVAILABLE

ARPIN:	HRRZS A			;FLUSH INTERRUPT BIT
	CAIN A,%NSOPN
	 POPJ P,		;ALL OK
	CAIE A,%NSINP
	CAIN A,%NSCLI
	 CAIA
	  JRST THTSAL		;IOC ERROR ESSENTIALLY
	SKIPE IACFLG
	 JRST GOTIAC		;CONTINUE TRYING TO HACK IAC
INPIN2:	SOJL B,INPIN7		;RETURN IF NO MORE CHARS OF INPUT AVAIL
	.CALL [ SETZ ? SIXBIT/IOT/ ? MOVEI NETIC ? MOVEM A ? ANDI 10 ] ;UNIT INPUT, DON'T-HANG
	 JSR DEATH
	JUMPL A,INPIN7		;"EOF" NO INPUT AVAILABLE NOW
	SKIPE SUPDUP		;DIFFERENT SPECIAL HAIR FOR SUPDUP
	 JRST [	CAIE A,300	;300 IS THE PREFIX FOR SPECIAL CODES.
		 JRST INPIN9
		.IOT NETIC,A
		CAIN A,301	;300 - 301 IS THE COMMAND TO LOG OUT (NOT DETACH).
		 .LOGOUT
		CAIN A,302	;300 - 302 IS SET TERMINAL ID COMMAND
		 JRST GTTYID
		SOJA B,INPIN2 ]	;IGNORE OTHER SPECIAL SEQUENCES
	SKIPN LFPROC
	 JRST INPIN3
	AOSN LFIGNR		;TELNET PROTOCOL SENDS LF OR NULL AFTER CR
	 JRST [	CAIE A,12
		CAIN A,0
		 JRST INPIN2	;WHICH WE WANT TO IGNORE
		JRST .+1 ]
	CAIN A,15
	 SETOM LFIGNR
INPIN3:	TRNN A,200		;SEE IF CONTROL
	 JRST INPIN9		;DATA, SEND IT THROUGH
	SKIPE OLDTEL
	 JRST OLDCNC		;OLD TELNET CONTROL
	CAIE A,NT%IAC		;IAC INTRODUCES NEW TELNET CONTROL SEQUENCE
	 JRST INPIN9		;OTHER CHARS > 200 NOT SPECIAL IN NEW TELNET
;DROPS THROUGH			;(USE JRST INPIN9 IF YOU WANT TO SEND THEM THROUGH)
;DROPS IN
GOTIAC:	SETZM OLDTEL		;AND CAUSES SWITCH TO NEW TELNET IF OLD
	SETOM NEWTEL
	MOVE E,[.BYTE 8 ? NT%IAC ? NT%DMK]
	MOVEM E,DRORST
	SETOM IACFLG
	SKIPE ORN
	 JRST REWAKE		;OUTPUT COULD BE MESSED UP, WAIT UNTIL LATER
	SETZM IACFLG
	SOS B
	.IOT NETIC,A		;GET COMMAND CHARACTER
	CAIL A,NT%WILL
	 JRST NEGOT		;JUMP IF OPTION NEGOTIATION OR DOUBLE IAC
	CAIGE A,NT%SE
	 JRST INPIN2		;SE OR LESS => IGNORE
	XCT NTCTBL-NT%SE(A)	;GET APPROPRIATE RESPONSE
				;SHOULD EITHER JRST OR LOAD A WITH CHAR TO TURN INTO
INPIN9:	.IOT STYOC,A		;HERE TO FEED CHAR TO STY AND RE-ENTER MAIN INPUT LOOP
	.STATUS STYOC,E		;NOW CHECK ON TTY INPUT BUFFER
	TLNE E,1_9
	 JRST REWAKE		;BUFFER NEARLY FULL, DON'T TRY TO SEND MORE.
				;THIS IS FOR TWO REASONS, (1) LINE AT A TIME
				; TELNET COULD LOSE, (2) COULD GET HUNG UP
				; BECAUSE CAN'T SEND INTO TTY UNTIL SOMETHING
				; HAS ECHOED BUT OUTPUT BUFFER HAS STUFF IN
				; IT WHICH REQUIRES THIS JOB TO SERVICE A
				; STYIC INTERRUPT
	JRST INPIN2		;HANDLE ANY ADDITIONAL INPUT, B HAS COUNT.

NEGOT:	CAIN A,NT%IAC		;HERE FOR DO, DON'T, WILL, WON'T, OR
	 JRST INPIN9		; YACKETY YACK
	PUSHJ P,NEGOT0		;CALL NEGOTIATION PROCESSING ROUTINE
	JRST INPIN1		;INPIN1 RATHER THAN INPIN2 IN CASE B IS CLOBBERED

NTCTBL:	OFFSET NT%SE-.
NT%SE:: JRST INPIN2		;IGNORE SE
NT%NOP::JRST INPIN2		;IGNORE NOP
NT%DMK::JRST INPIN2		;IGNORE DATA MARK
NT%BRK::MOVEI A,^Z		;BREAK = CALL
NT%IP::	JRST IP			;INTERRUPT PROCESS
NT%AO::	MOVEI A,%TXCTL+"S	;ABORT OUTPUT = CONTROL S
NT%AYT::JRST AYT		;AM I HERE
NT%ERS::MOVEI A,177		;ERASE CHARACTER = RUBOUT
NT%ERL::MOVEI A,%TXCTL+"G	;ERASE LINE = CONTROL G
NT%GA::	JRST INPIN2		;IGNORE GO AHEAD
NT%SB:: JRST NEGSB		;IGNORE FORMAT (?)
NT%WIL::			;HERE FOR ERROR CHECKING
OFFSET 0

;PROCESS A NEW TELNET NEGOTIATION.  A HAS THE DO/DONT/WILL/WONT CHARACTER.
NEGOT0:	MOVE E,A		;SAVE NEGOTIATION TYPE
	.IOT NETIC,A		;A GETS OPTION NUMBER
	CAIN A,OP%BIN		;TRANSMIT BINARY?
	 JRST NEGBIN
	CAIN A,OP%SGA		;SUPPRESS GO AHEAD OPTION?
	 JRST NEGSGA
	CAIN A,OP%LOC		;TTYLOC OPTION?
	 JRST NEGLOC
	CAIGE E,NT%DO		;SKIP IF DO OR DONT
	 JRST NEGDNT		;OTHERWISE, ITS UNKNOWN WILL OR WONT; SEND DONT
	CAIN A,OP%SUP		;SUPDUP OPTION?
	 JRST NEGSUP
	CAIN A,OP%ECO		;ECHO OPTION?
	 JRST NEGECH
	CAIN A,OP%LOG		;LOGOUT OPTION?
	 JRST NEGLOG
	;; DO OR DONT OF UNKNOWN OPTION
	JRST NEGWNT		;CONFIRM IF DONT, REFUSE IF DO

NEGLOC:	CAIL E,NT%DO		;IF DO OR DONT
	 JRST NEGWNT		; THEN REFUSE OR CONFIRM RESPECTIVELY
	JRST NEGB1		;IF WILL OR WONT, ACCEPT OR CONFIRM RESPECTIVELY

NEGSB:	.IOT NETIC,A		;GET OPTION NUMBER
	CAIE A,OP%LOC
	 JRST NEGSB1
	MOVE E,[440700,,TERMID]
NEGLO1:	.IOT NETIC,A
	CAIN A,NT%IAC
	 JRST NEGLO2
	CAME E,[100700,,TERMID+7]
	 IDPB A,E
	JRST NEGLO1
NEGLO2:	MOVEI A,0
	IDPB A,E
	.IOT NETIC,A		;IGNORE SE
	JRST INPIN1

	;; HERE TO IGNORE SUBNEGOTIATION BLOCK.
NEGSB1:	.IOT NETIC,A
NEGSB2:	CAIE A,NT%IAC
	 JRST NEGSB1
	.IOT NETIC,A
	CAIE A,NT%SE
	 JRST NEGSB2
	JRST INPIN1

NEGBIN:	CAIN E,NT%DO
	 JRST [	SKIPE TRBINF	; IF ALREADY GOT DO TRNBIN, IGNORE
		 POPJ P,
		SETOM TRBINF
		JRST NEGB1 ]	; JUST ACK DO
	CAIN E,NT%DONT
	 JRST [	SKIPN TRBINF	; IF ALREADY GOT DONT TRNBIN, IGNORE
		 POPJ P,
		SETZM TRBINF
		JRST NEGB1 ]	; JUST ACK DONT
	;;IF WILL OR WONT, THEN CHANGE %TPTEL AND THEN ACK
	; UNLESS ALREADY DID
	CAIN E,NT%WILL
	 JRST [	SKIPE RCBINF	; IF ALREADY GOT WILL TRNBIN, IGNORE
		 POPJ P,
		SETOM RCBINF
		JRST NEGB0 ]	; PROCESS THE WILL TRNBIN
	; MUST BE NT%WONT
	SKIPN RCBINF		; IF ALREADY GOT WONT TRNBIN, IGNORE
	 POPJ P,
	SETZM RCBINF
NEGB0:	PUSH P,B
	.CALL [	SETZ ? SIXBIT /CNSGET/ ? 1000,,STYIC
		2000,,A ? 2000,,A ? 2000,,A ? 2000,,B
		402000,,A ]
	 .LOSE %LSSYS
	TRZ A,%TPTEL		;SET %TPTEL IF DONT, CLEAR IT IF DO
	CAIN E,NT%WONT
	 TRO A,%TPTEL
	.CALL [	SETZ ? SIXBIT /CNSSET/ ? 1000,,STYIC
		[-1] ? [-1] ? [-1] ? B
		SETZ A ]
	 .LOSE %LSSYS
	POP P,B
	MOVEI A,OP%BIN
NEGB1:	MOVE E,NEGO6C-NT%WILL(E)
	JRST NEGOTA

NEGSGA:	MOVE A,SGASTS		;GET CURRENT STATUS
	XCT NEGO6A-NT%WILL(E)	;SKIP UNLESS INCOMING STUFF IS JUST AN ACK (SAME STATE AS NOW)
	  POPJ P,		;NOT SUPPOSED TO REPLY TO REQUEST TO ENTER CURRENT STATE
	XCT NEGO6B-NT%WILL(E)	;CHANGE TO NEW STATE
	MOVE E,NEGO6C-NT%WILL(E)
	MOVEI A,OP%SGA		;WHATEVER YOU SAY, BOSS,
	JRST NEGOTA		; BUT DON'T HOLD YOUR BREATH WAITING FOR A GA!

NEGO6A:	TLNE A,-1		;WILL
	TLNN A,-1		;WONT
	TRNE A,-1		;DO
	TRNN A,-1		;DONT
NEGO6B:	HRROS SGASTS		;WILL
	HRRZS SGASTS		;WONT
	HLLOS SGASTS		;DO
	HLLZS SGASTS		;DONT
NEGO6C:	NT%DO			;WILL
	NT%DONT			;WONT
	NT%WILL			;DO
	NT%WONT			;DONT

NEGSUP:	AOSE SUPNGF		;EXPECTED?
	 JRST NEGWNT		;NO, REFUSE.  IT'S TOO LATE AND YOU MISSED THE BOAT.
	CAIE E,NT%DO		;REQUEST TO SWITCH TO SUPDUP?
	 POPJ P,		;NO, REFUSAL TO USE SUPDUP, NO REPLY NECESSARY
	SETOM SUPDUP		;YES, SWITCH PROTOCOLS.
	SETZM NEWTEL
	MOVE A,[.BYTE 8 ? %TDORS]
	MOVEM A,DRORST
	POPJ P,			;NO REPLY NECESSARY, ALREADY SENT IAC WILL SUPDUP

NEGLOG:	CAIE E,NT%DO		;IGNORE IAC DONT LOGOUT
	 POPJ P,
	MOVE E,[.LOGOUT 1,]	;IF WE GET IOC ERROR SENDING REPLY, LOGOUT
	MOVEM E,IOCERR		; RATHER THAN DETACH
	.IOT NETOC,[NT%IAC]
	.IOT NETOC,[NT%WILL]
	.IOT NETOC,A
	.NETS NETOC,
	.LOGOUT 1,


;THIS SECTION FOR DO/DONT ECHO.
NEGECH:	CAMN E,ECOSTS		;CHANGING STATE?
	 POPJ P,		;NO, IGNORE IT COMPLETELY
	MOVEM E,ECOSTS		;YES, SAVE NEW STATE
	CAIN E,NT%DO		;AND SWITCH STY TO THAT STATE
	 PUSHJ P,IECHO
	CAIN E,NT%DONT
	 PUSHJ P,UECHO
	SUBI E,NT%DO-NT%WILL	;AFFIRMATIVE
	JRST NEGOTA

NEGWNT:	MOVEI E,NT%WONT
	JRST NEGOTA
NEGDNT:	MOVEI E,NT%DONT		;WILL OR WONT, ALWAYS REPLY NEGATIVELY TO THESE
;	JRST NEGOTA

;SEND REPLY:  IAC, C(E), C(A)
NEGOTA:	.IOT NETOC,[NT%IAC]
	.IOT NETOC,E
	.IOT NETOC,A
	POPJ P,

AYT:	IRPC A,,YES
	 .IOT NETOC,["A]
	TERMIN
	.NETS NETOC,
	JRST INPIN2

IP:	.CALL [	SETZ
		'STYGET
		MOVEI STYOC
		MOVEM E		;JOB THAT HAS TTY
		SETZM D ]	;TOP JOB OF TREE THAT HAS TTY
	 JSR DEATH
	MOVEI A,^Z		;NORMALLY, ^Z (CALL) IS INTERRUPT PROCESS CHAR
	JUMPL D,INPIN9
	CAMN D,E
	 MOVEI A,%TXCTL+"G	;BUT USE CONTROL-G IF TTY IS AT TOP LEVEL
	JRST INPIN9

OLDCNC:	CAIN A,NT%IAC		;HERE IF PROBABLE OLD TELNET CONTROL CHARACTER
	 JRST GOTIAC		;THOUGHT THIS WAS OLD TELNET BUT IT'S REALLY NEW
	CAIN A,OT%ECH
	 PUSHJ P,IECHO
	CAIN A,OT%NEC
	 PUSHJ P,UECHO
	JRST INPIN1		;OTHERS SHOULD NOT BE SENT TO SERVER

;HERE WHEN INPUT HAS BEEN PROCESSED.  MAY WANT TO RECONNECT DIRECT CONNECTION STUFF

INPIN7:	SKIPE GOAWAY
	 JSR DEATH		;CONNECTION NOT OPEN
	SKIPE DIRCON		;JUST DISMISS IF NOT ENABLED
	 SKIPGE LFIGNR		;OR IF IN MIDDLE OF CR-LF LOSSAGE
	  POPJ P,
	.CALL DRCONC		;CONNECT STY TO NET DIRECTLY
	 JFCL			;PRESUMABLY ALREADY CONNECTED, GOT RANDOM INTERRUPT,
				; HAPPENED TO CATCH IT IN INPUT-AVAILABLE STATE.
	POPJ P,			;NOW DISMISS, SHOULDN'T INTERRUPT ANY MORE

;ROUTINES TO RE-OPEN STY IN APPROPRIATE FULL OR HALF DUPLEX MODE

IECHO:	SKIPA B,[.UAI+30,,]	;FDX, %TDORS, DON'T HANG
UECHO:	 MOVSI B,.UAI+34	;HDX, %TDORS, DON'T HANG
	HRRI B,'STY
	.OPEN STYIC,B
	 JSR DEATH
	POPJ P,

;GET TERMINAL ID FROM SUPDUP

GTTYID:	MOVE B,[440700,,TERMID]
GTTYI1:	.IOT NETIC,A
	CAIN A,33		;check for altmode hack (:ttyloc $foo)
	 JRST GTTYI1
	CAIGE A,40
	 JRST INPIN1
	CAME B,[100700,,TERMID+7]
	 IDPB A,B
	JRST GTTYI1

CONSTANTS
VARIABLES
PATCH: PAT: BLOCK 40

INFORM HIGHEST IN LOW PART,\.
IFG .-2000, .ERR LOW PART IS TOO BIG

;EVERYTHING BELOW THIS POINT IS DISCARDED AFTER THE CONNECTION IS OPENED.
SUBTTL INITIALIZATION

TELSER:	.CLOSE 1,
	MOVE P,PDL
	.SUSET [.RJNAME,,A]	;DETERMINE SOCKET ICP'ED ON
	SKIPN DEBUG
	 .SUSET [.SJNAME,,['TELSER]]
	CAMN A,['STELNT]
	 MOVE A,['RFC001]
	CAMN A,[SIXBIT /TCP/]
	 JRST [	SETOM TCPP	; SIXBIT contact name in 0
; Have STYNET now!!
;		SETZM DIRCON	; No STYNET yet for TCP
		HLRZ B,0
		CAIE B,'SYN	; Should be SYNnnn
		 JRST ICP1	; Oh well???
		MOVE A,0
		JRST GO10]
	CAMN A,[SIXBIT/CHAOS/]
	 JRST [	SETOM CHAOSP	;SIXBIT CONTACT NAME IN 0
		CAMN 0,[SIXBIT/SUPDUP/]
		 SETOM SUPDUP
		CAMN 0,[SIXBIT/TELNET/]
		 SETOM NEWTEL
		JRST CHTELE ]
	SETOM NCPP		; Assume NCP
	HLRZ B,A
	CAIE B,'RFC
	 .SUSET [.RSNAM,,A]
	HLRZ B,A
	CAIE B,'RFC
	 JRST ICP1		;PROBABLY BEING DEBUGGED, ICPSOC SHOULD ALREADY BE SET
GO10:	LDB B,[.BP 70000,A]
	LSH B,6
	LDB C,[.BP 700,A]
	LSH C,3
	ANDI A,7
	ADD A,B
	ADD A,C
	MOVEM A,ICPSOC
ICP1:	SKIPN A,ICPSOC
	 .VALUE
	CAIN A,1		;DETERMINE PROTOCOL TO USE
	 SETOM OLDTEL
	CAIN A,137
	 SETOM SUPDUP
CHTELE:	SETOM NEWTEL		;NEW TELNET IS DEFAULT
	SKIPN OLDTEL
	SKIPE SUPDUP
	 SETZM NEWTEL		;UNLESS SOME OTHER IS SPECIFIED
	SKIPE SUPDUP
	 .SUSET [.SXJNAME,,[SIXBIT/SUPSER/]]	;SUPDUP SERVER - THIS IS FOR STLGET TO WIN.
	SKIPN SUPDUP
	 .SUSET [.SXJNAME,,[SIXBIT/TELSER/]]	;TELNET SERVER - THIS IS FOR STLGET TO WIN.
	MOVE E,[.BYTE 8 ? NT%IAC ? NT%DMK]	;DETERMINE OUTPUT RESET SEQUENCE
	SKIPE OLDTEL
	 MOVE E,[.BYTE 8 ? OT%DMK]
	SKIPE SUPDUP
	 MOVE E,[.BYTE 8 ? %TDORS]
	MOVEM E,DRORST
	.CALL [	SETZ		;DETERMINE GREETING MESSAGE, ETC.
		'SSTATU
		MOVEM TT
		MOVEM SYSDBG
		MOVEM TT ? MOVEM TT ? MOVEM TT
		SETZM C ]	;Machine name.
	 JSR DEATH
	SKIPLE SYSDBG
	 SETZM SYSDBG		;DON'T CONSIDER SYSTEM TO BE DOWN IF SYSDBG IS POSITIVE
	MOVSS C
	CAIN C,(SIXBIT/DM/)
	 .DEMON			;ON DM, LOADED AS DEMON SO FLUSH REQUEST	
	  JFCL
	MOVEI A,[ASCIZ/Unknown ITS PDP-10/]
	CAIN C,(SIXBIT/AI/)
	 MOVEI A,[ASCIZ/MIT Artificial Intelligence Lab PDP-10/]
	CAIN C,(SIXBIT/ML/)
;	 MOVEI A,[ASCIZ/MIT Medical Liability PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Miraculously Living PDP-10/]
	 MOVEI A,[ASCIZ/MIT Math Lab PDP-10/]
	CAIN C,(SIXBIT/DM/)
	 MOVEI A,[ASCIZ/MIT Dynamic Modelling PDP-10/]
	CAIN C,(SIXBIT/MD/)
	 MOVEI A,[ASCIZ/MIT Mostly Development PDP-10/]
	CAIN C,(SIXBIT/MX/)
;	 MOVEI A,[ASCIZ/MIT Mailer eXperimentation PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Peacekeeper PDP-10/]
	 MOVEI A,[ASCIZ/MIT Mostly eXtinct PDP-10/]
	CAIN C,(SIXBIT/MC/)
;	 MOVEI A,[ASCIZ/MIT Might Crash PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Mighty Computer PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Mondo Crufto PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Management Consultant's PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Marginally Competent PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Missing Components PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Maintenance Continued PDP-10/]
;	 MOVEI A,[ASCIZ/MIT Maintenance Curtailed PDP-10/]
	 MOVEI A,[ASCIZ/MIT Mailinglist Central PDP-10/]
	CAIN C,(SIXBIT/DB/)
	 MOVEI A,[ASCIZ/DB-ITS/]
	HRLI A,440700
	MOVEM A,GREET
	.SUSET [.SMASK,,[%PIIOC]]
	SKIPN TCPP
	 JRST GREEZE
	 MOVEI A,NETIC
	MOVE B,ICPSOC
;IF1,.ERR TCP needs to hack $$SYSDBG 
	SYSCAL TCPOPN,[ MOVEI NETIC ? MOVEI NETOC
		ICPSOC ? [-1] ? [-1]]
	 JSR DEATH	; Failed (should timeout!)
	MOVEI B,3*30.	; Try for 30 sec
TCPOL:	MOVEI A,10.
	.SLEEP A,
	SYSCAL WHYINT,[MOVEI NETOC ? MOVEM A ? MOVEM A]
	 .LOSE %LSSYS
	CAIE A,%NSOPN
	 CAIN A,%NSRFN
	  CAIA
	   SOJG B,TCPOL
	CAIG B,
	 JSR DEATH		; Timed out...
	SYSCAL RFNAME,[MOVEI NETOC ? MOVEM A ? MOVEM A ? MOVEM A
			MOVEM A]
	 .LOSE %LSSYS
;	PUSHJ P,NETWRK"CVH2NA	   ; Convert address to HOSTS2
	MOVE B,A
	MOVE C,SYSDBG
	JRST GREET0
GREEZE:
	SKIPE CHAOSP
	 JRST [	MOVEI A,NETIC
		MOVEI C,[ASCIZ/SUPDUP/]
		SKIPN SUPDUP
		 MOVEI C,[ASCIZ/TELNET/]
		MOVEI D,5	;WINDOW SIZE (SMALL)
		PUSHJ P,NETWRK"CHASRV
		 JSR DEATH	;FAILED
		JRST GREET0 ]
	MOVEI A,ICPCH
	MOVE B,ICPSOC
	MOVE C,[10040+.UII,,10040+.UIO]
	PUSHJ P,NETWRK"ARPSRV
		;Serve the ICP
	 JSR DEATH
GREET0:	MOVEM B,FHOST		;Remember the HOSTS2 host number.
	MOVEM C,SYSDBG		;Remember whether users allowed on from host
	SKIPE NEWTEL
	 PUSHJ P,TELNEG
	SKIPE OLDTEL
	 .IOT NETOC,[OT%NEC]	;I'LL HANDLE THE ECHOING
	JRST GREET1

;;; Deposit Internet address in B down ASCII Bp in D.

INTDPB:	PUSH P,A
	PUSH P,B
	MOVE A,B
	LDB B,[400400,,A]	   ;Check for flag bits.
	JUMPN B,[ PUSHJ P,OCTDPB
		  MOVEI B,":
		  IDPB B,D
		  JRST .+1 ]
	LDB B,[301000,,A]
	PUSHJ P,DECDPB
	MOVEI B,".
	IDPB B,D
	LDB B,[201000,,A]
	PUSHJ P,DECDPB
	MOVEI B,".
	IDPB B,D
	LDB B,[101000,,A]
	PUSHJ P,DECDPB
	MOVEI B,".
	IDPB B,D
	LDB B,[001000,,A]
	PUSHJ P,DECDPB
	POP P,B
	POP P,A
	POPJ P,

;;; Deposit number in B down ASCII Bp in D.

OCTDPB:	PUSH P,E
	MOVEI E,8.
	PUSHJ P,NUMDPB
	POP P,E
	POPJ P,

DECDPB:	PUSH P,E
	MOVEI E,10.
	PUSHJ P,NUMDPB
	POP P,E
	POPJ P,

NUMDPB:	MOVE T,B
	IDIV T,E
NUMDP1:	ADDI TT,"0
	CAILE TT,"9
	 ADDI TT,<"A-10.-"0>
	JUMPE T,NUMDP2
	HRLM TT,(P)
	IDIV T,E
	PUSHJ P,NUMDP1
	HLRZ TT,(P)
NUMDP2:	IDPB TT,D
	POPJ P,







;SUPDUP INITIAL NEGOTIATION.  RECIEVE SOME 36-BIT WORDS ENCODED AS
;6 6-BIT BYTES FROM THE LEFT.  FIRST WORD IS TCTYP, SECOND IS TTYOPT,
;THIRD IS TCMXV, FOURTH IS TCMXH, FIFTH IS TTYROL.
;IT IS ASSUMED THAT %TPCBS IS ON IN TTYOPT.
;USER-SUPDUP WILL DO ALL OUTPUT-RESET HACKING AND BUCKY-BITS
;USING THE INTELLIGENT TERMINAL PROTOCOL.  ALL THAT IT SENDS US
;IS JUST PASSED ON TO THE STY.  ONLY 7-BIT CHARS ARE THUS NEEDED
;FOR INPUT.  THE CHARACTER 300 IS USED AS AN ESCAPE FOR COMMANDS TO
;BE INTERPRETED BY TELSER RATHER THAN PASSED TO THE STY.
;COMMANDS NOW DEFINED:
  ;300-301, WHICH MEANS LOG OUT KILLING THE USER'S TREE.
  ;300-302, SET TERMINAL NAME
;IN THE OTHER DIRECTION, A STREAM OF 8-BIT SOFTWARE TTY CODES IS
;PASSED;  TELSER DOES NO PARSING OF IT AND SUPDUP DOES ONLY A LITTLE.

SUPRWD:	SETZ TT,		;RETURN 36-BIT WORD IN TT
	PUSH P,B
	MOVEI T,6
SUPWD1:	.IOT NETIC,A
	LSH TT,6
	IOR TT,A
	SOJG T,SUPWD1
	POP P,B
	POPJ P,

SUPNEG:	PUSHJ P,SUPRWD	;FIRST WORD IS AOBJN PNTR TO REMAINDER IF NEG
	JUMPGE TT,[MOVEM TT,TCTYP	;OR TCTYP IF POSITIVE
		   MOVE D,[-NNEGVR+1,,1]	;WHICH IS THE OLD PROTOCOL
		   JRST SUPNG1]
	CAMGE TT,[-NNEGVR,,0]
	 MOVSI TT,-NNEGVR
	HLLZ D,TT
SUPNG1:	PUSHJ P,SUPRWD
	MOVEM TT,TCTYP(D)
	AOBJN D,SUPNG1
	MOVE TT,OUNAME
	MOVEM TT,FUNAME
	PUSHJ P,SUPNG2
	.IOT NETOC,[%TDNOP]	;SEND NOP TO INDICATE TIME TO SWITCH INTO 8-BIT MODE
	MOVE E,TTYOPT
	TLNE E,%TOMVU		;IF SUPDUP'S TTY IS PRINTING, PREVENT INFINITE LF'S BY
	 POPJ P,		;TELLING BOTH SIDES THAT CURSOR POS IS 0.
	.CALL [	SETZ ? SIXBIT/SCPOS/ ? MOVEI STYOC ? MOVEI 0 ? SETZI 0]
	 JSR DEATH
	.IOT NETOC,[%TDMV0]
	.IOT NETOC,[0]
	.IOT NETOC,[0]
	POPJ P,

SUPNG2:	.CALL [	SETZ
		'CNSSET
		MOVEI STYOC
		TCMXV
		TCMXH
		TCTYP
		MOVEI 0	;TTYCOM
		SETZ TTYOPT ]
	 JSR DEATH
	MOVE E,[-8,,[	'TTYROL ? MOVE TTYROL
			'TTYSMT ? MOVE TTYSMT
			'ISPEED ? MOVE ISPEED
			'OSPEED ? MOVE OSPEED ]]
	.CALL [	SETZ
		'TTYVAR
		MOVEI STYOC
		SETZ E ]
	 JSR DEATH
	POPJ P,

;NEW-TELNET INITIAL NEGOTIATOR.  ASK FOR SUPPRESS GO AHEAD
;AND ITS TO ECHO.  ALSO, INVITES USER SIDE TO USE SUPDUP INSTEAD OF TELNET.

TELNEG:	IRPS CH,,NT%IAC NT%NOP NT%IAC NT%DO OP%SGA NT%IAC NT%WILL OP%SGA NT%IAC NT%WILL OP%ECO NT%IAC NT%WILL OP%SUP
				; SUPDUP last, so if accepted then not
				; followed by garbage
	 .IOT NETOC,[CH]
	 TERMIN		;DON'T WAIT FOR REPLY, RIGHT THINGS WILL HAPPEN LATER
	POPJ P,	

;Now type our host's standard greeting message.
GREET1:	ILDB A,GREET
	JUMPE A,GREET2
	.IOT NETOC,A
	JRST GREET1

GREET2:	.IOT NETOC,[^M]
	.IOT NETOC,[^J]
	.NETS NETOC,	;TYPE THIS WHILE WE OPEN FILES, ETC.

;Set up host short name (HSTSIX), figure out host status (HSTAT), 
;and see if we can get the host's official name (HSTNAM).
	MOVEI A,RANCH
	MOVEI B,HSTPAG
	PUSHJ P,NETWRK"HSTMAP	;Map in HOSTS3 data base.
	 .VALUE
	MOVEI A,USER		;Host is at least a USER.
	MOVEM A,HSTAT
	MOVE A,FHOST		;Remote host address.
	PUSHJ P,NETWRK"HSTSIX	;Sixbit host abbreviation.
	 JFCL			; (Always something available.)
	MOVEM A,HSTSIX		; (though generally useless).
	MOVE B,FHOST		;Host address.
	PUSHJ P,NETWRK"HSTSRC	;Find the SITES table entry for this host.
	 CAIA
	 JRST [	HRLZ TT,A	   	;Copy ASCIZ host long name.
		HRRI TT,HSTNAM
		BLT TT,HSTNAM+7
		JUMPL A,GRET2B		;If really a TAC, HSTAT is right.
		MOVEI A,USER		;Else assume it's a user.
		SKIPGE NETWRK"STLFLG(D)	;Is it a server after all?
		 MOVEI A,SERVER		; Yes - say so.
		HLRZ T,NETWRK"STLSYS(D)	;Check out system type.
		ADD T,NETWRK"HSTADR
		MOVE T,(T)
		CAMN T,[ASCIZ /MINITS/]	;User coming from a MINITS terminal
		 MOVEI A,MINITS		; Yes - say so. 
		MOVEM A,HSTAT		;Remember host status.
		JRST GRET2B ]
	;; No host name, so try to make up a number.
	MOVE D,[440700,,HSTNAM]
	MOVE B,FHOST		;Get host number.
	HLLZ T,B		;Get network #.
	CAMN T,[NETWRK"NW%CHS]	;If coming from Chaosnet
	 JRST [	HRRZ B,B	; use octal host number.
		PUSHJ P,OCTDPB
		JRST GRET2A ]
	PUSHJ P,INTDPB		;Else Internet - decimal numbers with dots.
GRET2A:	MOVEI TT,0		;Tie off ASCIZ string.
	IDPB TT,D
GRET2B:	;; Print out message for network lusers.
	.OPEN RANCH,[ .UAI,,'SYS ? SIXBIT/NET/ ? SIXBIT/MAIL/ ]
	 JRST GREET3
	PUSHJ P,OUTMSG
GREET3:	SETZM TIPNUM
	MOVE A,HSTAT		;Check status of this host.
	CAIE A,TIP		;If this is not a TIP
	 JRST GRET40		; don't check for terminal types.
	SKIPN TCPP
	 JRST [ SYSCAL RCHST,[MOVEI NETIC ? MOVEM A ? MOVEM A ? MOVEM A] 
		 JSR DEATH  ;A GETS FOREIGN SOCKET NUMBER
		LSH A,-16.  ;TIP PORT NUMBER
		JRST GREET4 ]
	SYSCAL RFNAME,[MOVEI NETIC ? MOVEM A ? MOVEM A ? MOVEM A]
	 JSR DEATH
	LDB A,[101000,,A]   ;TAC port is the high byte of the TCP FgnPort.
GREET4:	MOVEM A,TIPNUM
	;Look up this TIP port in table of such, to find out its terminal
	;name and terminal type, if known.
	MOVE A,FHOST
	MOVSI I,-NTIPS
TIPLK1:	HLRZ B,TIPTAB+1(I)
	CAMN A,TIPTAB(I)	;Check for host# match
	 CAME B,TIPNUM		;and port# match
	  JRST TIPLK8
	HRRZ B,TIPTAB+1(I)	;Match, copy terminal ID
	MOVE A,[-8,,TERMID]
TIPLK2:	MOVE T,(B)
	MOVEM T,(A)
	ADDI B,1
	TRNE T,376
	 AOBJN A,TIPLK2
	MOVE A,TIPTAB+2(I)	;Sixbit tctyp
	JUMPE A,TIPLK9		;Unspecified, leave as default
	CAME A,[SIXBIT/VT52/]	;VT52 is only type we know about.
	 JRST TIPLK9
	SETOM TCTIP		;Will set terminal parameters after getting STY
	MOVEI A,%TNESC
	MOVEM A,TCTYP
	MOVEI A,80.-1
	MOVEM A,TCMXH
	MOVEI A,24.
	MOVEM A,TCMXV
	MOVE A,[%TOMVU+%TOMVB+%TOLWR+%TOERS+%TOMOR,,3*%TPPTB+%TPORS+%TPTEL]
	MOVEM A,TTYOPT
	MOVEI A,1
	MOVEM A,TTYROL
	;Don't try to guess speed
	JRST TIPLK9
TIPLK8:	ADDI I,2
	AOBJN I,TIPLK1
TIPLK9:	.OPEN RANCH,[			;SPECIAL MESSAGE FOR THESE LOSERS.
		.UAI,,'SYS
		SIXBIT /NETLSR/
		SIXBIT /MAIL/ ]
	 JRST GRET40
	PUSHJ P,OUTMSG
GRET40:	SKIPE SYSDBG		;If we are REALLY debugging ITS now
	 JRST GRET41		; give real debugging message.
	PUSHJ P,FASIST		;Else should we let the loser on?
	 JRST GRET41		; Nope.
	JRST OPEN1		;Well, OK.

FASIST:	MOVE A,[-BADSIZ,,BADTBL]
FAS1:	MOVE B,(A)		;GET A HOST INDIX
	CAMN B,FHOST		;IS THIS IT?
	 POPJ P,		;RETURN NON SKIP
	AOBJN A,FAS1
	AOS (P)			;RETURN SKIPED
	POPJ P,

GRET41:	MOVE B,[440700,,[ASCIZ/ITS being debugged, users not allowed on.
/]]

GREET5:	ILDB A,B
	JUMPE A,GREET6
	.IOT NETOC,A
	JRST GREET5

GREET6:	SKIPN CHAOSP
	 JRST GREET7
	.NETS NETOC,
	.CALL [	SETZ		;On Chaos net, send an EOF before closing in case user wants
		'PKTIOT
		MOVEI NETOC
		SETZI [%COEOF_28.]]	;Hopefully this won't MPV!
	 .LOSE %LSSYS
GREET7:	.CALL [	SETZ ? 'FINISH ? SETZI NETOC ]	;MAKE SURE OUTPUT DELIVERED BEFORE CLOSING
	 JRST THTSAL		;Ignore failure, other end might have closed
	JRST THTSAL

;SEND MESSAGE FROM A FILE

OUTMSG:	.IOT RANCH,A
	JUMPL A,OUTMS1	;EOF
	CAIE A,^M
	 CAIL A,40	;SUPPRESS CONTROL CHARACTERS OTHER THAN CR
	  .IOT NETOC,A
	CAIN A,^M
	 .IOT NETOC,[^J]	;CHANGE CR INTO CR-LF
	JRST OUTMSG

OUTMS1:	.NETS NETOC,
	.CLOSE RANCH,
	POPJ P,

;OPEN UP A STY

OPEN1:	.OPEN STYOC,[ .UIO,,'STY ]
	 CAIA
	  JRST OPEN2
OPENFU:	MOVE B,[440700,,[ASCIZ/All network ports in use.
/]]
	JRST GREET5

OPEN2:	PUSHJ P,IECHO		;INITIALLY, I ALWAYS ECHO
	SKIPE NEWTEL		;IF NEW TELNET, SEE IF REALLY SUPDUP
	 PUSHJ P,TELSUP
	SKIPE SUPDUP		;NOW DO INITIAL NEGOTIATION IF SUPDUP
	 JRST OPEN3		;IF NOT SUPDUP, SET UP TTY PARAMETERS
	MOVEI B,%TPTEL		;INCLUDING DISCARDING OF LFS AFTER CR ON INPUT, AND
	MOVE A,HSTAT		; CURSOR MOTION OPTIMIZATION.
	CAIE A,TIP		;ONLY TIPS CAN GET OPTIMIZED CURSOR MOTION,
	 TLO B,%TORAW		;SMART HOSTS GET SCREWED UP.
	.CALL [ SETZ ? 'TTYVAR ? MOVEI STYOC ? ['TTYOPT] ? 0 ? SETZ [IOR B]]
	 SETOM LFPROC		;OLD VERSION OF ITS, WE HAVE TO HANDLE CR-LF OURSELF
	CAIE A,TIP		;ON TIP'S, DEFAULT THE LINE-SPEED TO 300 BAUD
	 JRST OPEN3A
	MOVE A,[-4,,[ 'ISPEED ? MOVE [300.]
		      'OSPEED ? MOVE [300.]]]
	.CALL [	SETZ ? 'TTYVAR ? MOVEI STYOC ? SETZ A ]
	 .LOSE %LSSYS
	SKIPE TCTIP
	 PUSHJ P,SUPNG2		;SET TERMINAL PARAMETERS FROM STUFF GOT OUT OF TIPINF FILE
	JRST OPEN3A

OPEN3:	PUSHJ P,SUPNEG		;SUPDUP, DO APPROPRIATE STUFF
OPEN3A:	.NETS NETOC,		;FINISH SENDING GREETING

;LOG IN

	.SUSET [.RIOC+STYOC,,B]	;GET TTY # STY CONNECTED TO
	LSHC B,-25
	LSH B,3
	LSHC B,3
	ANDI B,0707
	ROT B,-14
	IOR B,['00TLNT]		;CONSTRUCT UNAME FROM TTY #
	MOVEI C,'LNZ		;RH LAST ACCEPTABLE UNAME
	SKIPGE DEBUG
	 JRST OPEN7		;UNDER A DDT DON'T TRY TO LOG IN
OPEN6:	.CALL [	SETZ
		SIXBIT/LOGIN/
		B
		SETZ HSTSIX ]
	 JRST [	CAIE C,(B)
		 AOJA B,OPEN6	;LOGIN LOST, TRY INCREMENTING NAME
		MOVE B,[440700,,[ASCIZ/Trouble logging in server job.
/]]
		JRST GREET5]	;TRIED TOO MANY TIMES, LOSING BIG
OPEN7:	.SUSET [.SSNAME,,HSTSIX]	;FOR PEEK
	.IOT STYOC,[^Z]		;CALL FOR A HACTRN

;SWITCH INTO NORMAL MODE.

	.SUSET [.SPICLR,,[0]]
	MOVE A,[-INTBLN,,INTABL]
	MOVEM A,42
	.SUSET [.ROPTION,,A]
	TLO A,OPTINT
	.SUSET [.SOPTION,,A]
	.SUSET [.SMASK,,[%PIIOC\%PIRLT]]
	.SUSET [.SMSK2,,[1_STYIC\1_NETOC\1_NETIC]]
	JRST UBLAST

;IF NEW TELNET, WE HAVE SENT A IAC WILL SUPDUP.  THE USER SIDE
;MUST REPLY EITHER IAC DO SUPDUP OR IAC DONT SUPDUP.  HERE WE
;WAIT FOR THE REPLY AND DECIDE WHICH PROTOCOL WE'RE GOING TO BE.
;ALSO, WE HAVE TO PROCESS ANY OTHER NEGOTIATIONS THAT THE USER
;SIDE MIGHT HAVE FELT LIKE DOING FIRST.  NOTE THAT THIS HAS TO
;BE DONE IN A SOMEWHAT MAGIC WAY BECAUSE IT IS NECESSARY TO
;DECIDE WHICH PROTOCOL IS GOING TO BE USED BEFORE ^Z-ING THE STY.
;THE USER SIDE HAD BETTER ANSWER OUR SUPDUP QUESTION BEFORE
;IT SENDS ANY NORMAL DATA CHARACTERS.
;ALSO, THIS IS NOT GOING TO WORK ON SOCKET 1, ONLY SOCKET 27,
;BECAUSE WE HAVE TO BE EXPECTING TO USE NEW TELNET.
TELSUP:	SETOM SUPNGF		;EXPECTING TO NEGOTIATE ABOUT SUPDUP
	.IOT NETIC,A		;GET A IAC
	CAIE A,NT%IAC
	 JSR TELSPL		;DATA, WE'RE NOT READY YET!
	.IOT NETIC,A
	CAIN A,NT%NOP
	 JRST TELSUP		;IAC NOP, IGNORE IT
	CAIE A,NT%IAC
	 CAIGE A,NT%WILL
	  JSR TELSPL		;SOMETHING OTHER THAN DO/DONT/WILL/WONT
	PUSHJ P,NEGOT0		;PROCESS THE NEGOTIATION
	SKIPGE SUPNGF		;WAS THE SUPDUP NEGOTIATION COMPLETED?
	 JRST TELSUP		;NO, READ MORE NET INPUT
	.NETS NETOC,		;MAKE SURE THE REPLY IS SENT RIGHT OUT
	POPJ P,			;YES, OK NOW WE KNOW WHICH PROTOCOL TO USE.

;JSR HERE IF USER SENDS SOMETHING DIFFERENT THAN WHAT WE EXPECTED
TELSPL:	0
;	SKIPE DEBUG
;	 .VALUE
	SETZM SUPNGF
	POPJ P,			;HOPE WHATEVER IT WAS WAS NOT TOO IMPORTANT

;HERE ON IOCERR INTERRUPT DURING INITIALIZATION

ZZZ==. ? LOC 42
	IOCLUZ
LOC ZZZ

IOCLUZ:	0 ? 0
	JSR DEATH
	0

$$HST3==1		; Use HOSTS3 now.
$$SERVE==1		;From NETWRK, we want the server-side-of-ICP routine
$$SYSDBG==1		;If SYSDBG set, allow ICP anyway, we will then
			; send an explanatory message and refuse.
$$HSTMAP==1		;and the things for handling the HOSTS2 data base.
$$HSTSIX==1		;and the host name abbreviation generator.
$$CHAOS==1		;Assemble chaos net routines
$$ARPA==1		;Assemble Arpa net routines


;WARNING!  NETWRK is assembled into the initialization code and gets flushed!
;See NETWRK or KSC;HOSTS3 > for the format of the HOSTS3 data base.

.INSRT SYSENG;NETWRK

POPJ1:	AOS (P)
	POPJ P,

;VARIABLES USED ONLY DURING INITIALIZATION

GREET:	0		;BYTE POINTER TO ASCIZ GREETING MESSAGE
ICPSOC:	0		;SOCKET TO PERFORM I.C.P. WITH
SYSDBG:	0		;NONZERO IF USERS NOT ALLOWED IN FROM THIS HOST
TCTIP:	0		;IF NON-ZERO, TIP SPECIFIED TCTYP, TTYOPT, ETC.

;LOCATIONS READ INTO BY INITIAL NEGOTIATION
TCTYP:	%TNSFW
TTYOPT:	%TOLWR+%TOMVB,,%TPCBS+%TPORS
TCMXV:	24.
TCMXH:	79.
TTYROL:	0
TTYSMT:	0		;GRAPHICS SMARTS
ISPEED:	0		;INPUT SPEED
OSPEED:	0		;OUTPUT LINE SPEED
OUNAME:	0		;UNAME ON FOREIGN SITE
	BLOCK 20	;IN CASE USER END SENDS EXTRA ONES
NNEGVR==.-TCTYP

;INFORMATION ABOUT TIPS
;
;Source:
;	TIP hostno,portno,notusedyet,ascii identification
;
;Object:
;	host# ? port#,,[asciz/terminal name/] ? sixbit tctyp 
;
;Host# can be old format.  All TIPs are on the Arpanet.
;
EXPUNGE TIP
DEFINE TIP HOST,PORT,TCTYP,TERMID/
	NETWRK"NW%ARP+IFL HOST-1000,[<HOST&77>+<HOST&300>_10.] .ELSE [<<HOST&377>_16.>+<<HOST&177400>_-8.>]
	PORT,,[ASCIZTERMID]
	.1STWD SIXBIT/TCTYP/
TERMIN
TIPTAB:	.INSRT SYSENG;TIPINF >
NTIPS==<.-TIPTAB>/3
EXPUNGE TIP

;Put VARIABLES before CONSTANTS if you value your ass
VARIABLES
CONSTANTS

INFORM Highest used,\.

HSTPAG==<.+1777>/2000		;Page to start mapping HOSTS3 into.
HSTPGA==HSTPAG*2000

END TELSER
