; -*-MIDAS-*-

.symtab 2700.,5000.	; allocate lots of space for symbols
title TELNET
subttl Definitions, etc.

; Mark Crispin, MIT AI Lab, January 1977; last update June 1980

;  Disclaimer: Most of this program was written on an ADM-3 glass TTY back
; in early 1977 when I had these incredibly wedged ideas on programming,
; like the incredibly hairy macros all over the place, lower case code,
; comments on every line, etc.  Believe me, I don't write code this way now!
; However, if you think this is bad, you should have seen the code it replaced.
;
;  Anyway, if you need something changed in TELNET, try to get me to do it,
; since there are all sorts of hairy things in the macros and stuff that
; only a wizard would know about.  If you do hack it, try to follow the
; conventions that the rest of the code is written in; use the hairy macros,
; etc.  The only thing that looks worse than poor programming conventions
; is mixed programming conventions.

.insrt MRC;MACROS

; Assembly parameters

nd. nprskt==27		; default ICP socket
nd. icptmt==30.*30.	; time out time
nd. linmor==6.		; lines of output before **More** not inhibited
nd. hstnln==10.		; length of host name string
nd. patlen==50.		; length of patch area
nd. jclbfl==10.		; length of JCL buffer
nd. ntibfl==200.	; length of net input buffer
nd. ttobfl==600.	; length of TTY output buffer
nd. pdllen==500.	; length of push-down stack
nd. linbfl==50.		; length of line editor buffer
nd. ftnethop==-1	; -1 if to include net hop hassle code

; AC definitions

acdef. [a b c d x y z zz j tp t tt nt]
			; NT used only by net output rtns
hiac==j			; highest AC to be saved in an interrupt

; I/O channels

acdef. [icp tti itto tto nti nto wal htb err]
.hkill icp,tti,itto,tto,nti,nto,wal,htb,err

subttl Macros

ret==:return

; Macro to output an ASCII string for command level

define type string
  move a,[440700,,[ascii\string\]]
  movei b,.length\string\
  syscal SIOT,[	clarg. tto
		a ? b]
   .lose %lssys
termin

; Macro to do a cursor hack for command level

define csrmov code
 .iot tto,[^P] ? .iot tto,["code] termin

; Macro to do a cursor hack for network transmission

define csrmv1 code
 movei a,^P
 call ttoc
 movei a,"code
 call ttoc
termin

; Macro to send a TELNET command

define telcmd cmdlst
 irps cmd,,[cmdlst]
  .iot nto,[cmd]
 termin
 .nets nto,
termin

define telcmf cmdlist
 irps cmd,,[cmdlist]
	movei nt,cmd
	call ntout
 termin
call ntofrc		; Force output
termin

; Macro to generate a string word for SIOT

define strwrd string
 .length\string\,,[ascii\string\]
termin

subttl Data area

cmdesc:	"				; escape character ([BREAK] for TV's)

corbeg==.

tcpp:	block 1				; -1  using TCP (else NCP)
debug:	0				; -1  debugging
sdpblk:	block 1				; first word of SUPDUP block
tctyp:	block 1				; TCTYP variable
ttyopt:	block 1				; TTYOPT variable
tcmxv:	block 1				; vertical screen size
tcmxh:	block 1				; horizontal screen size
ttyrol:	block 1				; rolling
smarts:	block 1				; display smarts
ispeed:	block 1				; input speed
ospeed:	block 1				; output speed
nsdvrs==.+1-sdpblk			; number of SUPDUP variables

ttyst1:	block 1				; this job's TTYST1 variable
ttyst2:	block 1				; TTYST2 variable
ttysts:	block 1				; TTYSTS variable
ttycom:	block 1				; TTYCOM variable
ttytyp:	block 1				; TTYTYP variable
hostad:	block 1				; host address for foreign host
morep:	block 1				; -1  **More** on
twinp:	block 1				; ~ 0  has i/d, -1  SAIL graphics too

; Data area initialized every time

rstbeg==.				; beginning of data area
10tabp:	block 1				; -1  using 10 tabs (Multix TELNET)
sdoutp:	block 1				; -1  using SUPDUP output option
openp:	block 1				; -1  connection open
servrp:	block 1				; -1  seen a server in search
nprotp:	block 1				; -1  using new protocol
killp:	block 1				; -1  suicide if ICP loses
scclrp:	block 1				; -1  clear screen before output
ttyop:	block 1				; -1  silence output
echop:	block 1				; -1  foreign host is echoing
logoup:	block 1				; -1  logout option
supgap:	block 1				; -1  host is winning with GA's
linedp:	block 1				; -1  line editor enabled
wallp:	block 1				; -1  enable wallpaper
quotep:	block 1				; -1  next char quoted
lquotp:	block 1				; -1  line editor quote
dmsimp:	block 1				; -1  Datamedia simulation
trbinp:	block 1				; -1  can transmit binary
rcbinp:	block 1				; -1  can receive binary
indlmp:	block 1				; -1  DM insert/delete mode is on
editkp:	block 1				; -1  <EDIT> key depressed
morinh:	block 1				;  0  **More** inhibited
gthpos:	block 1				; DM setting HPOS (-1  wants HPOS)
gtvpos:	block 1				; DM setting VPOS (-1  wants VPOS)
inslct:	block 1				; Count of buffered-up insert-line commands.
					; Negative => buffered up delete-line commands.
xsave:	block 1				; scratch location to save AC X
asave:	block 1				; scratch location to save AC A
inipos:	block 1				; initial cursor position
hpos:	block 1				; horizontal position (line editor)
icpskt:	block 1				; foreign socket to ICP on
axttop:	block 1				; auxillary TTY output glitcher
linbuf:	block linbfl			; line editor input buffer
linptr:	block 1				; line editor pointer
linctr:	block 1				; line editor counter
ntibuf:	block ntibfl			; network input buffer
ntiptr:	block 1				; network input pointer
ntictr:	block 1				; network input counter
ttobuf:	block ttobfl			; TTY output buffer
ttoptr: block 1				; TTY output pointer
ttoctr:	block 1				; TTY output counter
ttoctl:	block 1				; control bits for tto (also flag)
sdobfr:	block <254./4.>+1		; SUPDUP output buffer
lclrcv:	block 1				; ITS  host socket
lcltrn:	block 1				; ITS  host socket
forrcv:	block 1				; host  ITS socket
fortrn:	block 1				; host  ITS socket
hstnam:	block hstnln			; host name string in ASCII
hstsnm:	block 3				; host sixbit name ( who line)
jclbuf:	block jclbfl+1			; JCL buffer
corend==.-1				; end of data area
pdl:	block pdllen			; push down stack
tabpdl:	block 5*linbfl			; tab pdl(urk!)
pat:	block patlen			; patch area
patch==pat				; beginning of free patch area

loc <.\1777>+1				; put pure code on a clean page

$$hst3==1		; HOSTS3 format table
$$arpa==1		; Just ARPAnet stuff
$$tcp==1
$$connect==1
$$hostnm==1		; Let's try this out.
$$symget==1
$$prompt==0		; Don't use default prompt.
$$hstmap==1		; HSTMAP routine
$$analyz==1		; Analysis reoutines
netwrk"E==x
.insrt syseng;netwrk


subttl TELNET commands for the new protocol

trnbin==0				; transmit binary
echo==1					; echo
rcp==2					; prepare to reconnect
suprga==3				; suppress go ahead
nams==4					; negotiate approx. message size
status==5				; status option
timmrk==6				; timing mark
rcte==7					; remote controlled tran/echo
naol==8.				; negotiate line width
naop==9.				; negotiate page size
naocrd==10.				; negotiate output cr disposition
naohts==11.				; negotiate output hor. tabs
naohtd==12.				; negotiate output hor. tab disp.
naoffd==13.				; negotiate output form feed disp.
naovts==14.				; negotiate output ver. tabs
naovtd==15.				; negotiate output ver. tab disp.
naolfd==16.				; negotiate output lf disposition
extasc==17.				; extended ASCII
logout==18.				; log out foreign job
bm==19.					; byte macro
det==20.				; data entry terminal option
supdup==21.				; moby SUPDUP option
sdotpt==22.				; SUPDUP output
exopl==255.				; extended options
rndylz==256.				; randomly lose

se==240.				; subnegotiation end
nop==241.				; no operation
dm==242.				; data mark
brk==243.				; break
ip==244.				; interrupt process
ao==245.				; abort output
ayt==246.				; are you there
ec==247.				; erase character
el==248.				; erase line
ga==249.				; go ahead
sb==250.				; subnegotiation
will==251.				; sender will perform operation
wont==252.				; sender wont perform operation
do==253.				; receiver asked to perform operation
dont==254.				; receiver must not perform operation
iac==255.				; interpret as command

subttl Initialization, etc.

telnet:	move p,[-pdllen,,pdl]		; load push down pointer
	store %zeros,corbeg,corend	; clear data area
	call ntoini			; Initialize net output buff
	setom tcpp
	.suset [.rxjname,,a]		; TCP: check JNAME
	came a,[sixbit/tcptn/]		; If either of these two names,
	 camn a,[sixbit/ttn/]
	  setom tcpp			; then say to use TCP for connecting.
	came a,[sixbit /ncptn/]
	 camn a,[sixbit /otn/]
	  setzm tcpp
	store %fword,hostad		; not at any host
	uget OPTION,x			; get my options
	tlo x,%opint			; enable new style interrupts
	uset OPTION,x			; and reset my .OPTION variable
	store ^C_1,jclbuf+jclbfl	; ensure that JCL ends
	tlne x,%opcmd			; any alleged JCL?
	 .break 12,[..rjcl,,jclbuf]	; read in JCL
	syscal OPEN,[	clctl. .uio\%tjdis; enable cursor P codes
			clarg. tto	; TTY output channel
			clarg. ('TTY)]	; device TTY
	 .lose %lsfil			; can't open TTY output?
	syscal OPEN,[	clctl. .uio\%tjsio; super-image output
			clarg. itto	; TTY output channel
			clarg. ('TTY)]	; device TTY
	 .lose %lsfil			; can't open TTY output?
	syscal TTYGET,[	clarg. tto	; get TTY status variables
			%clval ttyst1	; first character group
			%clval ttyst2	; second character group
			%clval ttysts]	; TTY control status
	 .lose %lssys			; can't read TTY status
	syscal CNSGET,[	clarg. tto	; get console parameters
			%clval tcmxv	; vertical size
			%clval tcmxh	; horizontal size
			%clval tctyp	; TCTYP variable
			%clval ttycom	; TTYCOM variable
			%clval ttyopt	; TTYOPT variable
			%clval ttytyp]	; TTYTYP variable
	 .lose %lssys			; huh???
	move x,[-nsdvrs,,]		; set up AOBJN count
	movem x,sdpblk			; for SUPDUP block
	move x,[131313131313]		; all chars are activation+interrupt
	movem x,ttyst1			; ...but no echoing
	move x,[130313131313]		; similar, but image output...
	movem x,ttyst2			; ...is off for I, J
	move x,ttysts			; get TTYSTS variable
	tdnn x,[%tsmor]			; **More**'s on?
	 useti MSK2,1_tto+1_itto	; enable **More** ints
	store %fword,morep		; flag more processing "on"
	syscal TTYSET,[	clarg. tto	; set TTY status variables
			%clarg ttyst1	; first set of character groups
			%clarg ttyst2	; second set of character groups
			%clarg ttysts]	; TTY control status
	 .lose %lssys			; can't set TTY status
; (continued on next page)

	store %fword,twinp		; assume that it's a winner
	movei y,.uii			; assume just unit image input
	move x,ttyopt			; get TTY options
	tlnn x,%tosai			; does it have SAIL graphics?
	 movns twinp			; nope, only semi-winning
	tlnn x,%tofci			; does this frob have bucky bits?
	 jrst [	movsi z,%tssii		; super-image input
		iorm z,ttysts		; so Z and _ go through
		jrst nobcky]		; no [BREAK] key stuff
	store %txtop\"B,cmdesc		; yes, intercept char  [BREAK]
	tro y,%tiful			; full char set mode
nobcky:	and x,[(%tocid\%tolid)]		; mask out all but i/d bits
	came x,[(%tocid\%tolid)]	; is this a winning terminal?
	 store %zeros,twinp		; no, it's a loser so no DM simulator
	syscal OPEN,[	%clctl y	; open input console
			clarg. tti	; on TTY input channel
			clarg. ('TTY)]	; device TTY
	 .lose %lsfil			; can't open TTY input?


; Output TELNET's greeting message

notsty:	type [User TELNET.]
	move y,[%version]		; get our version
vrsout:	movei x,%zeros			; clear where a digit goes
	lshc x,wid. '_			; siphon off a digit
	addi x,"A-'A			; ASCIIify
	.iot tto,x			; output the digit
	jumpn y,vrsout			; and continue until done
	csrmov A			; now a blank line
	peek a,IMPUP			; Check if IMP is up
	jumpe a,maphtb			; Print error msg if not
	came a,[-1]
	 move c,[strwrd [IMP is down.]]
	came a,[-2]
	 move c,[strwrd [IMP is not yet up.]]
	came a,[1]
	 move c,[strwrd [IMP is down (until ready line changes).]]
	movsi a,440700
	hrr a,c
	hlrz b,c
	syscal SIOT,[	clarg. tto
			a ? b]
	   .lose %lssys
	.logout 1,

; Map DSK:SYSBIN;HOSTS3 > (the host table) in.

maphtb:	movei a,hsttab_-10.	; Page # to map into
	movei b,htb		; channel # to use
	pushj p,netwrk"hstmap	; Map it in.
	 .value [asciz /: Cannot map in host table! 
/]

; Job name and JCL hacking stuff

	skipn jclbuf			; got JCL?
	 jrst chkjnm			; no, check JNAME
	ldb x,[350700,,jclbuf]		; get first character
	cain x,"?			; question mark?
	 jrst [	call help		; yes, help cruft
		jrst notcon]		; and enter main loop
	store %fword,killp		; flag death
	jrst notcon			; no JNAME checking
chkjnm:	uget XJNAME,x			; get XJNAME
	came x,[sixbit /TACAC/]
	 camn x,[sixbit /TACACS/]
	  jrst [move j,[440700,,[asciz "65.,TACAC.ARPA"]]
		call filjcl
		store %fword,killp
		jrst notcon ]
	camn x,[sixbit /TACNUZ/]
	 jrst [	move j,[440700,,[asciz "143,NIC"]]
		call filjcl
		store %fword,killp
		jrst notcon ]
	camn x,[sixbit /RSEXEC/]
	 jrst [	move j,[440700,,[asciz "367,ISI"]]
		call filjcl
		store %fword,killp
		jrst notcon ]
	camn x,[('NSW)]
	 jrst [	move j,[440700,,[asciz "33,SRI-KA"]]
		call filjcl
		store %fword,killp
		jrst notcon ]
	came x,['TELNET]		; XJNAME = 'TELNET ?
	 camn x,[sixbit/TN/]		; or TN?
	  jrst notcon			; yes, ignore this
	move y,x			; copy job name
	tlz y,(sixbit/_/)		; zap out first character
	came y,[sixbit/ TELNE/]		; is it xTELNET
	 camn y,[sixbit/ TN/]		; or xTN
	  jrst notcon			; then no hacking again
	move z,[440700,,jclbuf]		; load pointer to JCL buffer
	store %fword,killp		; flag suicide if lossage
jnmhst:	movei y,%zeros			; clear frob where char will go
	rotc x,6.			; snarf off a character
	addi y,"A-'A			; ASCIIify
	idpb y,z			; fake in JCL buffer
	jumpn x,jnmhst			; and loop for more
	movei y,^M			; zap in an M
	idpb y,z			; shove in buffer

; Top level not connected loop

notcon:	useti WHO1,<.byte 8 ? 166 ? 0 ? 366 ? 0>; two SIXBIT words together
	useti WHO2,sixbit/NOT IN/	; message when not connected
	useti WHO3,sixbit/ COMM/	; . . .
	call cmprmt			; get a command
	 jrst notcon			; not connected
	.break 16,100000		; back to DDT
	jrst notcon			; got continued

subttl ICP to foreign host

; Final pre-ICP initialization

goicp:	move x,ttysts			; get TTY status
	tlnn x,%tsrol			; in losing scroll mode?
	 store %fword,scclrp		; no, clear screen when winning
	store %fword,linedp		; line editor on if half duplex host
	move tp,[-5*linbfl,,tabpdl]	; load up tab pdp
	store %zeros,linctr		; clear line editor counter
	store linbuf(440700),linptr	; initialize line editor pointer

; Set up who line

	move b,hostad
	call netwrk"hstsrc	; Look up name
	 caia			; lost
	  jrst gotwhn
	store sixbit/RANDOM/,hstsnm	; host name not in table
	store sixbit/-PLACE/,hstsnm+1	; so invent a name
	jrst setwvr			; and set it

gotwhn:	hlrz x,netwrk"stlsys(d)	; get ptr to system name
	move y,hsttab+1(x)		; get second 5 chars of system name
	move x,hsttab(x)		; and first 5 chars
	camn x,[ascii/MULTI/]		; Multix?
	 came y,[ascii/CS/]		; . . .
	  caia				; nope
	   store %fword,10tabp		; yes, indicate 10 tabs
	move x,a
	hrli x,440700			; make byte pointer to host name
	move y,[440600,,hstsnm]		; load pointer to sixbit name
getwvr:	ildb z,x			; get a character
	jumpe z,setwvr			; set who vars when done
	subi z,"A-'A			; sixbitify
	idpb z,y			; save in sixbit name frob
	skipn hstsnm+2			; done as much as I can?
	 jrst getwvr			; no, continue for more
setwvr:	uset WHO2,hstsnm		; set first half of who line thing
	uset WHO3,hstsnm+1		; second half now
	useti IMSK2,1_tti		; enable TTY ints so can abort

; (continued on next page)

; Open TCP network connection unless NCP specified

	skipn tcpp			; Skip if using TCP
	 jrst goicp0			; no, use normal NCP type ICP

	movei a,nti
	move b,hostad
	move c,icpskt
	call netwrk"tcpcon
	 jrst tcpluz
	syscal RFNAME,[	clarg. nti
			%clval x	; Randomness
			%clval lclrcv	; Local port #
			%clval forrcv]	; Remote port #
	 .lose %lssys
	move x,lclrcv			; Just for completeness, in case
	movem x,lcltrn
	move x,forrcv
	movem x,fortrn
	jrst goicpw			; Now go wait for conns to open.

; Open ICP connection, get socket number from server

goicp0:	syscal OPEN,[	clctl. .uii\40050; open on gensymmed socket, 32 bits
			clarg. icp	; on ICP channel
			clarg. ('NET)	; NET: device
			clarg. %fword	; let ITS pick local socket
			%clarg icpskt	; initial foreign socket
			%clarg hostad]	; foreign host address
	 jrst icpluz			; can't, say why and die
	movei a,%nsrfs			; socket state when starting up
	movei y,icptmt			; load up time out time
goicp1:	syscal NETBLK,[	clarg. icp	; hang for ICP channel
			%clarg a	; until condition not this
			%clarg y	; or if timeout exceeded
			%clval c	; new socket state
			%clval x]	; time left on the clock
	 .lose %lssys			; huh???
	jumple x,icptmo			; yup, lose big
	jumpe c,[	syscal WHYINT,[	clarg. icp; ICP channel status
					repeat 4,%clval c]; reason for close
			 .lose %lssys	; ???
			jrst closed]	; and report this lossage
	cain c,%nsopn			; just opened?
	 jrst [	movei a,%nsopn		; yes, wait until something
		jrst goicp1]		;  else to avoid lossage
	caie c,%nscli			; CLS w/input?
	 cain c,%nsinp			; input?
	  caia				; winning
	   jrst badskt			; losing
	syscal RFNAME,[	clarg. icp	; socket status on ICP channel
			repeat 2,%clval x]; the local socket number
	 .lose %lssys			; huh???
	addi x,2			; compute receive end
	movem x,lclrcv			; save for open
	addi x,1			; compute local transmit end
	movem x,lcltrn			; save for open
	.iot icp,x			; find out foreign receive socket
	movem x,forrcv			; save for open
	addi x,1			; compute foreign send socket
	movem x,fortrn			; save for open

; Open network connections

	syscal OPEN,[	clctl. 40\.uai	; open in single ASCII mode
			clarg. nti	; on net input channel
			clarg. ('NET)	; NET: device
			%clarg lclrcv	; local receive socket
			%clarg fortrn	; socket to me!
			%clarg hostad]	; foreign host's host address
	 jrst icpluz			; can't, say why
	syscal OPEN,[	clctl. 40\.uao	; open in single ASCII mode
			clarg. nto	; on net output channel
			clarg. ('NET)	; NET: device
			%clarg lcltrn	; local tranmission socket
			%clarg forrcv	; foreign receipt socket
			%clarg hostad]	; foreign host address
	 jrst icpluz			; can't, say why
	.close icp,			; close off ICP socket
; (continued on next page)

; Wait until connections are opened

goicpw:	movei y,icptmt			; load up time out time
	syscal NETBLK,[	clarg. nti	; net input channel
			clarg. %nsrfs	; wait until not "RFC sent"
			%clarg y	; time out time
			repeat 2,%clval x]; time left on clock
	 .lose %lssys			; huh???
	jumple x,icptmo			; yup
	syscal WHYINT,[	clarg. nti	; channel status on net input
			repeat 2,%clval y; socket state
			repeat 2,%clval c]; reason for CLS
	 .lose %lssys			; ???
	tlz y,-1			; flush left half
	jumpe y,closed			; punt if closed
	caie y,%nsopn			; connection open?
	 cain y,%nsinp			; or input available?
	  jrst goicp2			; still winning
	cain y,%nscli			; CLS but input?
	 jrst goicp2			; still looking good
	movei c,(y)			; copy socket state
	jrst badskt			; losing totally
goicp2:	movei y,icptmt			; load up time out time
	syscal NETBLK,[	clarg. nto	; net output channel
			clarg. %nsrfs	; wait until not "RFC sent"
			%clarg y	; time out time
			repeat 2,%clval x]; time left on clock
	 .lose %lssys			; huh???
	jumple x,icptmo			; yup
	syscal WHYINT,[	clarg. nto	; status of net output
			repeat 2,%clval y; socket state
			repeat 2,%clval c]; reason for CLS
	 .lose %lssys			; ???
	andi y,-1			; clear left half
	jumpe y,closed			; and punt if closed
	caie y,%nsopn			; connection open?
	 cain y,%nsrfn			; or RFNM wait?
	  jrst inineg			; winning
	movei c,(y)			; get the losing state
	jrst badskt			; lost

; Initial negotiations

inineg:	move x,icpskt			; get socket # for ICP
	caie x,nprskt			; new protocol socket?
	 jrst opened			; nope, maybe old protocol
	store %fword,nprotp		; definitely new protocol

;  For new TELNET we try to get remote echo and have GA's flushed.  We'll
; ignore any GA's we get and never send any anyway.

	telcmf [IAC DO ECHO IAC DO SUPRGA]
	store %fword,echop		; remember I want echo hacked
	store %fword,supgap		; remember I want no host GA's

; ICP negotiations finished, tell user so and enter main program

opened:	store %fword,openp		; flag connection open
	type [ Open
]
	useti IMSK2,1_nto		; enable ints
	store %zeros,ntictr		; and zap net input buffer
	call imagon			; enter image mode
;	jrst ntimpg			; and enter net main program

subttl Network input main program

ntimpg:	call ntic			; gobble a character
	cain a,IAC			; got an IAC?
	 jrst iacsrv			; yes, service it
	trne a,200			; 8 bit character?
	 skipge nprotp			; yes, new protocol?
	  caia				; new protocol or not command
	   jrst [	cain a,200	; old style datamark?
			 jrst @dmkser	; yes
			cain a,203	; no echo?
			 store %fword,echop; yes
			cain a,204	; echo?
			 store %zeros,echop; yes
			jrst ntimpg]	; and next character
	skipge wallp			; wallpaper enabled?
	 .iot wal,a			; output character
	aosn quotep			; is char quoted?
	 jrst [	skipge ttyop		; silenced?  (LOSE!!!)
		 jrst ntimpg		; yes, poor loser
		jrst nosim]		; no, win.
	skipge gthpos			; want to get horizontal pos?
	 jrst [	store %zeros,gthpos	; forget it now
		caige a,<" >		; an abort?
		 jrst dmsim		; yup
		xori a,140		; convert to character position
		camle a,tcmxh		; out of range totally?
		 movei a,%zeros		; zap to beginning
		addi a,8.		; offset for ITS
		movem a,gthpos		; save this as next to be set hpos
		csrmv1 H		; set horizontal position
		move a,gthpos		; get hor pos
		call ttoc		; send hor pos
		store %fword,gtvpos	; now get vertical position
		jrst ntimpg]		; and charge on
	skipge gtvpos			; want vertical position?
	 jrst [	store %zeros,gtvpos	; forget it now
		caige a,<" >		; an abort?
		 jrst dmsim		; yup
		xori a,140		; convert to position
		camle a,tcmxv		; out of range?
		 movei a,%zeros		; whoops!  top line time...
		addi a,8.		; offset for ITS
		movem a,gtvpos		; save the position
		csrmv1 V		; set vertical position
		move a,gtvpos		; get hor pos
		call ttoc		; send ver pos
		jrst ntimpg]		; and charge on
ttoout:	skipge ttyop			; TTO enabled?
	 jrst ntimpg			; no, flush it then
	skipl scclrp			; clear screen?
	 jrst dmsim			; no, already did it
	csrmov C
	store %zeros,scclrp		; flag that screen has been cleared
;	jrst dmsim			; fall through

subttl Hairy Datamedia simulator!!

dmsim:	skipl dmsimp			; simulate DM?
	 jrst nosim			; nope, display normally
	skipge indlmp
	 skipn inslct			; If we have buffered up some insert or delete lines,
	  jrst dmsim1
	caie a,^J			; and the next command is NOT another one,
	 cain a,^Z
	  jrst dmsim1
	cain a,177			; (and don't count padding, which we will ignore)
	 jrst dmsim1
	push p,a			; do them now, before this character.
	call ttofrc			; Force out buffered 7-bit output first.
	movei a,%tdilp
	skipg inslct
	 movei a,%tddlp			; Output multiple-line insert or delete command.
	.iot itto,a
	movm a,inslct
	.iot itto,a
	setzm inslct
	pop p,a
dmsim1:	cail a,<" >			; control character?
	 jrst [	skipl indlmp		; insert/delete mode?
		 jrst nosim		; no, just output it
		cain a,177		; ignore rubouts completely
		 jrst ntimpg		; for cretinous EMACS
		push p,a		; save character
		csrmv1 ^		; insert a space here
		pop p,a			; restore character
		jrst nosim]		; and output the byte
	skipge indlmp			; insert/delete mode?
	 jrst @indtab(a)		; yes, do special things
	jrst @dmctab(a)			; no, do normal DM display hack
dmctab:	repeat 40,ntimpg		; no op
indtab:	repeat 40,@dmctab(a)		; normal function
	gzkddl==.			; save current location counter

define dmcsr code,server
 loc dmctab+code
 [server
  jrst ntimpg]
termin

	dmcsr ^B,[csrmv1 T]		; home cursor
	dmcsr ^G,[call ttoc]		; bell
	dmcsr ^H,[csrmv1 B]		; back cursor
	dmcsr ^I,[call ttoc]		; tab
	dmcsr ^J,[	move x,ttysts	; get TTY status
			tlne x,%tsrol	; scrolling (ick!)
			 jrst [call ttoc ? jrst ntimpg]
			csrmv1 D]	; cursor down
	dmcsr ^L,[store %fword,gthpos]	; set cursor position
	dmcsr ^M,[call ttoc]		; carriage return
	dmcsr ^P,[store %fword,indlmp]	; turn insert/delete on
	dmcsr ^W,[csrmv1 L]		; wipe to EOL
	dmcsr ^X,[	store %zeros,indlmp; cancel; i/d mode off
			movsi b,%tsrol	; scroll mode...
			andcam b,ttysts	; turn it off
			syscal TTYSET,[	clarg. tto; TTY output channel
					ttyst1 ? ttyst2 ? ttysts]
			 .lose %lssys]	; foo!
	dmcsr ^Z,[csrmv1 U]		; up cursor
	dmcsr ",[store %fword,quotep]	; quote next character (IMSSS DM's)
	dmcsr ^\,[csrmv1 F]		; forward cursor
	dmcsr ^],[	movsi b,%tsrol	; roll on
			iorm b,ttysts	; turn it on
			syscal TTYSET,[	clarg. tto; TTY output channel
					ttyst1 ? ttyst2 ? ttysts]
			 .lose %lssys]	; foo!
	dmcsr ^^,[	store %zeros,indlmp; master clear
			csrmv1 C
			movsi b,%tsrol	; roll on
			iorm b,ttysts	; turn it on
			syscal TTYSET,[	clarg. tto; TTY output channel
					ttyst1 ? ttyst2 ? ttysts]
			 .lose %lssys]
	dmcsr ^_,[	store %zeros,indlmp; erase screen
			csrmv1 C
			movsi b,%tsrol	; roll on
			iorm b,ttysts	; turn it on
			syscal TTYSET,[	clarg. tto; TTY output channel
					ttyst1 ? ttyst2 ? ttysts]
			 .lose %lssys]

define dmcsr code,server
 loc indtab+code
 [server
  jrst ntimpg]
termin

	dmcsr ^H,[csrmv1 _]		; delete character
	dmcsr ^J,[aos inslct]		; insert line
	dmcsr ^Z,[sos inslct]		; delete line
	dmcsr ^\,[csrmv1 ^]		; insert character

	loc gzkddl			; restore location counter

;^P[ to insert line.  ^P\ to delete line.

subttl Normal console display

nosim:	skipe ttoctl			; if super image output, skip down
	 jrst nosim2
	move x,ttyopt			; get terminal status
	tlne x,%toovr			; overprinting?
	 skipl dmsimp			; simulating a DM?
	  jrst nosim1			; no DM or no overprint, win!
	save a				; save to avoid clobberage
	csrmv1 K			; someday this needs to be smarter
	retr a				; restore character
nosim1:	cain a,177			; rubout from a loser?
	 jrst ntimpg			; yup, flush flush flush
	jumpe a,ntimpg			; flush nulls from losers
	cain a,^J			; line feed?
	 sos morinh			; yes, one line closer to **More**!!
	call ttoc			; display character on TTY
	caie a,^P			; did foreign host send a ^P?
	 jrst ntimpg			; no, try for another character
	movei a,"P			; yes, get ready to complete
nosim2:	call ttoc			; complete the character
	jrst ntimpg			; and go again

subttl Network input  TTY output buffering

;  Input a character from the network, either from the net or from a buffer.
; If nothing in the buffer or the net, then go to sleep.  This also dumps out
; the old TTY output buffer if the net input buffer is empty.
; (Shades of 10/50!!!!!!!!)

ntic:	sosg ntictr			; anything in this buffer?
	 call ntic1			; nope, get a new buffer
	ildb a,ntiptr			; get a character
	return				; and return

ntic1:	store ttobuf(440700),ttoptr,,d	; reset TTY output pointer
	skipn ttoctr			; any TTY output to do?
	 jrst ntic3			; nope
	call imagon			; try to make proceeding win
	syscal SIOT,[	clarg. tto	; output the buffer to TTY
			%clctl ttoctl	; control bits (super image control)
			d ? ttoctr]	; and reset counter
	 .lose %lssys			; huh???
ntic3:	syscal NETBLK,[	clarg. nti	; net input channel
			clarg. %nsopn]	; open with no input
	 .lose %lssys			; ???
	syscal WHYINT,[	clarg. nti	; something happened...
			repeat 2,%clval d; socket state
			%clval j	; # of characters to do
			%clval c]	; reason for CLS
	 .lose %lssys			; ???
	tdzn d,[%minfi]			; network interrupt?
	 jrst ntic4			; nope
	store ttobuf(440700),ttoptr	; reset buffer pointer
	store %zeros,ttoctr		; zap output buffer too
	aosle axttop			; maybe output flush
	 store %fword,ttyop		; turn off the TTY for good measure
	.reset nti,			; and bop off the network interrupt state
ntic4:	jumpn j,ntic2			; make sure read what's left
	jumpe d,closed			; connection randomly closed?
	skipn tcpp
	 jrst ntic4x
ifndef %ntclu,%ntclu==3
	cain d,%ntclu			; another valid closed state
	 jrst closed
ntic4x:	movei c,(d)			; get the losing state
	jrst badskt			; socket entered illegal state!
ntic2:
;	caile j,4*ntibfl		; more came than can take now?
; Always try for max, don't hang.
	 movei j,4*ntibfl		; yes, then size down to what can take
	movem j,ntictr			; save input counter
	store ntibuf(441000),ntiptr,,d	; load pointer to net buffer
	syscal SIOT,[	%clbit,,10	; Set "don't-hang" bit!!
			clarg. nti	; gobble down the buffer
			d ? j]		; from network input
	 .lose %lssys			; ???
	exch j,ntictr			; Orig # bytes in J
	subm j,ntictr			; Get # bytes read into ntictr
	return				; and return

; TTY character output routine when coming from the net

ttoc:	aosle zz,ttoctr			; bump TTY counter
	 caile zz,5*ttobfl		; filled up buffer?
	  .lose				; foo!
	idpb a,ttoptr			; shove character in buffer
	return				; and return

; Force out the contents of the buffer and empty it.

ttofrc:	move a,[440700,,ttobuf]
	movem a,ttoptr
	syscal siot,[%climm,,tto ? a ? ttoctr]
	 .lose %lsfil
	setzm ttoctr
	return	

subttl IAC service

iacsrv:	store %fword,nprotp		; definitely new protocol now!
	; Before handling IAC, force TTY output buffer.  If the IAC is a
	; IAC SB SUPDUP-OUTPUT, this will fix a bug.  May be other bugs, too.
	store ttobuf(440700),ttoptr,,d	; reset TTY output pointer
	skipn ttoctr			; any TTY output to do?
	 jrst iacsr0			; nope
	call imagon			; try to make proceeding win
	syscal SIOT,[	clarg. tto	; output the buffer to TTY
			%clctl ttoctl	; control bits (super image control)
			d ? ttoctr]	; and reset counter
	 .lose %lssys			; huh???
iacsr0:	call ntic			; get command character
	cain a,IAC			; quoted IAC?
	 jrst ttoout			; yes, output it then
	cain a,WILL			; is this a WILL code?
	 jrst [	call ntic		; yes, get code
		cain a,ECHO		; saying it will echo?
		 jrst [	skipe echop	; is echoing on already?
			 jrst ntimpg	; yes, ignore it
			store %fword,echop; no, I don't have to echo now
			telcmf [IAC DO ECHO]
			jrst ntimpg]	; no, respond to random request
		cain a,SUPRGA		; suppress GA?
		 jrst [	skipe supgap	; really confirming or new?
			 jrst ntimpg	; no, I asked for it
			store %fword,supgap
			telcmf [IAC DO SUPRGA]
			jrst ntimpg]	; yes, confirm it
		cain a,TRNBIN		; cretin Twenices?
		 jrst [	skipe rcbinp	; avoid protocol loop
			 jrst ntimpg	; loser
			store %fword,rcbinp
			telcmf [IAC DO TRNBIN]
			jrst ntimpg]	; set and confirm
		cain a,LOGOUT		; logout foreign job?
		 jsp a,[skipn logoup	; did I ask to logout?
			 jrst (a)	; foo, what's happening?
			type [SZL Logout request acceptedR]
			jrst ntimpg]	; now return
		cain a,SDOTPT		; moby SUPDUP output?
		 jrst [	store %fword,sdoutp; set the state
			telcmf [IAC DO SDOTPT IAC SB SDOTPT 1]
			move a,[440600,,sdpblk] ; get block pointer
			movei b,6*nsdvrs	; and number of TTY variables
			syscal SIOT,[	clarg. nto
					a ? b]
			 .lose %lssys	; oops!
			telcmf [IAC SE]
			jrst ntimpg]	; all done
		telcmd [IAC DONT]	; refuse to accept this option
		call ntosnd		; send what I refuse
		call ntofrc		; and send it out
		jrst ntimpg]		; and continue
; (continued on next page)

	cain a,WONT			; is this a WONT?
	 jrst [	call ntic		; yes, get code
		cain a,ECHO		; turn off echo?
		 jrst [	skipn echop	; flush my request
			 jrst ntimpg	; I asked for it and got it
			store %zeros,echop; sigh, I have to echo!
			telcmf [IAC DONT ECHO]; I didn't, must confirm
			jrst ntimpg]	; and return
		cain a,TRNBIN		; losey Twenices?
		 jrst [	skipn rcbinp	; avoid protocol loops
			 jrst ntimpg	; loser
			store %zeros,rcbinp
			telcmf [IAC DONT TRNBIN]
			jrst ntimpg]	; and return
		cain a,LOGOUT		; logout foreign job?
		 jrst [ skipn logoup	; did I ask to logout?
			 jrst ntimpg	; huh?
			store %zeros,logoup
			telcmf [IAC DONT LOGOUT]
			type [SZL Logout request rejectedR]
			jrst ntimpg]	; now return
		cain a,SDOTPT
		 jrst [	skipn sdoutp	; catch protocol lossage
			 jrst ntimpg	; whatever
			store %zeros,sdoutp; clear the state
			telcmf [IAC DONT SDOTPT]
			jrst ntimpg]	; and return
		cain a,SUPRGA		; suppress GA?
		 skipl supgap		; protocol violator
		  jrst ntimpg		; loser either way
		store %zeros,supgap	; clear the state
		telcmf [IAC DONT SUPRGA]; must confirm
		jrst ntimpg]		; and return

; (continued from previous page)
	cain a,DO			; requesting me to DO something?
	 jrst [	call ntic		; what does it want?
		cain a,TIMMRK		; nebbish timing mark?
		 jrst [	telcmf [IAC WILL TIMMRK]
			jrst ntimpg]	; and continue
		cain a,TRNBIN		; transmit binary?
		 jrst [	skipe trbinp	; am already doing this?
			 jrst ntimpg	; yes, then ignore this
			store %fword,trbinp; yes, good, I can

			telcmf [IAC WILL TRNBIN]
			jrst ntimpg]	; no, random, win anyway
		telcmd [IAC WONT]	; well, I won't do it!
		call ntosnd		; so there.
		call ntofrc		; and force it out
		jrst ntimpg]		; and continue
	cain a,DONT			; DONT do something?
	 jrst [	call ntic		; what doesn't it want me to do?
		cain a,TRNBIN		; transmit binary?
		 skipn trbinp		; check for already
		  jrst ntimpg		; already
		store %zeros,trbinp	; yes, turn it off
		telcmf [IAC WONT TRNBIN]
		jrst ntimpg]		; and return
	cain a,DM			; data mark?
dmkser:	 jrst [	sosg axttop		; should TTY go on?
		 store %zeros,ttyop	; bop on TTY
		jrst ntimpg]		; and let's continue
	caie a,SB			; subnegotiation?
	 jrst ntimpg			; no, return
	call ntic			; get the option
	cain a,SDOTPT			; SUPDUP option?
	 skipn sdoutp			; in SUPDUP mode?
	  .value			; you lose buckeroo
	call ntic			; get next byte
	caie a,2			; better be a 2...
	 .value				; when the time comes I'll write it
	call ntic			; get the count now
	jumpe a,sdsdun			; null option
	caile a,254.			; legal?
	 .value				; Greenberg you turkey
	save a				; save the counter
	move b,a			; stash count away in a good place
	move x,[441000,,sdobfr]		; get pointer to SUPDUP buffer
sdiout:	call ntic			; get the byte
	idpb a,x			; stash in buffer
	sojg b,sdiout			; loop until done
	move x,[441000,,sdobfr]		; I/O pointer
	retr b				; get counter back
	syscal SIOT,[	clarg. itto	; output to image TTY
			x ? b]		; pointers...
	 .lose %lssys			; ? ? ?
sdsdun:	call ntic			; eat the x position
	move b,a			; stash it away
	call ntic			; now the y position
	syscal SCPOS,[	clarg. tto	; tty number
			a ? b]		; position arguments
	 .lose %lssys			; horrible error 69
	call ntic			; now look for the IAC SE
	caie a,IAC			; paranoia
	 .value				; don't blame me you wrote the option
	call ntic			; now the SE
	caie a,SE			; well?
	 .value				; sigh...
	jrst ntimpg			; and return

subttl Connection error messages

; Tables of network error messages

errtab:	strwrd [ Connection never opened]
	strwrd [ Closed by user]
	strwrd [ Closed by host]
	strwrd [ Reset by host]
	strwrd [ Host died]
	strwrd [ Incomplete transmission]
	strwrd [ Byte size mismatch]
	strwrd [ Local Network Control Program down]
	strwrd [ Refused]
maxerr==.-errtab

icperr:	strwrd [random network lossage]
	strwrd [system down]
	strwrd [foreign Network Control Program down]
	strwrd [host does not exist to the knowledge of the NCC]
	strwrd [foreign Network Control Program initialization]
	strwrd [scheduled maintenance]
	strwrd [scheduled hardware work]
	strwrd [scheduled software work]
	strwrd [emergency restart]
	strwrd [power failure]
	strwrd [software breakpoint]
	strwrd [hardware error]
	strwrd [scheduled downtime]
	strwrd [undefined reason - 13]
	strwrd [undefined reason - 14]
	strwrd [host coming up now]

esstab:	strwrd [CLS received.]
	strwrd [listening for RFC.]
	strwrd [RFC received.]
	strwrd [CLS received after RFC.]
	strwrd [RFC sent.]
	strwrd [open.]
	strwrd [RFNM wait.]
	strwrd [waiting for matching CLS.]
	strwrd [CLS with input available.]
	strwrd [input available.]
maxess==.-esstab



; Here when ICP loses.  Say why

tcpluz:	call netwrk"analyz
	 jfcl
	jrst reset

icpluz:	move a,$ercod			; get socket state
	cain a,%efldv			; all sockets taken?
	 jrst [	type [ No free network sockets]
		jrst reset]		; restart
	cain a,%enrdv			; network crash?
	 jrst [	type [ Local Network Control Program down]
		jrst reset]		; restart
	cain a,%ensio			; bad gender?
	 jrst [	type [ Homosocketuality is against the laws of ARPA]
		jrst reset]		; the Anita Bryant feature
	cain a,%emchn			; moby host?
	 jrst [	type [ Extended address host not yet supported by ITS]
		jrst reset]		; anybody still lose this way?
	caie a,%enapp			; host down?
	 cain a,%ensdr			; . . .
	  jrst hstded			; yup, say so and when back
	save $ercod			; save this value
	type [ ICP failure -- ]
	retr a				; get connection error code
	syscal OPEN,[	clarg. err	; open on error channel
			clarg. ('ERR)	; magical error reporting device
			clarg. 4	; this is a .CALL error
			%clarg a]	; this is the code it was
	 .lose %lssys			; goddam bagbiting system
	.iot err,			; get a character of the message
	jumpg [	caie 0,^L		; flush form feeds
		 .iot tto,		; if still more type it
		jrst .-1]		; and get more
	.close err,			; flush error channel
rnderr:	type [
This is not supposed to happen; please report this via :BUG TELNET.
]
	jrst reset			; oh well

; Here if no response from foreign host

icptmo:	type [ Time out]
	jrst reset			; losing time outs!

; Here when connection closed on me

closed:	skipl openp			; ICP done?
	 jrst clsd1			; no, no header
	type [
Connection closed;]
	skipn tcpp
	 jrst clsd1
	type [
]
	jrst reset
clsd1:	cail c,maxerr			; greater than largest error?
	 jrst random			; yes, random error
	movsi a,440700			; byte pointer
	hrr a,errtab(c)			; to proper error message
	hlrz b,errtab(c)		; and counter
	syscal SIOT,[	clarg. tto	; output the string to the TTY
			a ? b]		; point in A, count in B
	 .lose %lssys			; argh
	cain c,%ncded			; host dead?
	 jrst hstwhy			; yes, say why
	caie c,%ncnto			; never opened?
	 cain c,%ncusr			; or I closed it?
	  jrst rnderr			; this ain't supposed to happen!
	jrst reset			; restart 	

random:	type [ unknown code - ]
	idivi c,8.			; split close reason up
	addi c,"0			; ASCIIify
	.iot tto,c			; output
	addi d,"0			; ASCIIify low order
	.iot tto,d			; output it too
	jrst rnderr			; and restart

; Here when host dead, say so and when it will be back up

hstded:	type [ Host dead]
hstwhy:	syscal NETHST,[	%clarg hostad	; get status of this host
			%clval x]	; into a convenient place
	 .lose %lssys			; huh???
	move y,x			; make an extra copy
	andi x,17			; just get state
	type [ due to ]
	movsi a,440700			; byte pointer
	hrr a,icperr(x)			; get pointer to error
	hlrz b,icperr(x)		; counter
	syscal SIOT,[	clarg. tto	; type on TTY
			a ? b]		; with count and pointer
	 .lose %lssys			; argh
	andi y,177760			; get time back
	jumpe y,reset			; flush if nothing
	cain y,177740			; -2 means unknown future time
	 jrst reset			; which is flushed make Moon happy
	type [.
  Host is expected back up ]
	cain y,177760			; -1 means more than a week
	 jrst [	type [over a week from now.]
		jrst reset]		; and reset the world
	ldb a,[150300,,y]		; get day of week
	ldb b,[100500,,y]		; get hours time
	subi b,5			; EST/GMT offset
	.ryear x,			; get time info
	tlne x,100000			; daylight losing time?
	 aosl b				; yes, go ahead an hour
	  jumpge b,noday		; easy way out
	addi b,24.			; move up a day
	sosge a				; and days back
	 movei a,6			; back to Sunday
noday:	save b				; save real hours
	move a,[strwrd [on Monday at ]
		strwrd [on Tuesday at ]
		strwrd [on Wednesday at ]
		strwrd [on Thursday at ]
		strwrd [on Friday at ]
		strwrd [on Saturday at ]
		strwrd [on Sunday at ]
		strwrd [on April Fool's Day at ]](a)
	hlrz b,a			; get counter
	hrli a,440700			; make into a byte pointer
	syscal SIOT,[	clarg. tto	; output to TTY
			a ? b]		; pointer and counter
	 .lose %lssys			; argh
	retr a				; get hours back
	idivi a,10.			; split high and low order
	addi a,"0			; ASCIIify
	.iot tto,a			; output high order
	addi b,"0			; ASCIIify low order
	.iot tto,b			; output it too
	.iot tto,[":]			; delimit
	ldb a,[040400,,y]		; get minutes/5
	imuli a,5.			; make into real minutes
	idivi a,10.			; split up
	addi a,"0			; ASCIIify
	.iot tto,a			; output
	addi b,"0			; ASCIIify
	.iot tto,b			; output
	tlne x,100000			; daylight losing time?
	 jrst [	type [ EDT.]
		jrst reset]		; different message
	type [ EST.]
	jrst reset			; and reset the world

subttl Interrupt service

	tmploc 42,intvec(,,-intvcl)	; set up interrupt addr

; Interrupt service vector

intvec:	hiac+1,,p			; AC's to save, pdl stack
	%pirlt ? 1_tti ? %pirlt ? 1_tti ? ttiser	; TTY input interrupts
					; (or simulated interrupt by REALT)
	0 ? 1_tto+1_itto ? %pirlt ? 1_tti ? ttoser ; TTY **More** interrupts
	0 ? 1_nto ? 0 ? 1_nto ? ntoser	; net output interrupts
intvcl==.-intvec			; length of interrupt vector

; Here to return from an interrupt

tsret:	syscal DISMIS,[	%clcti hiac+1	; number of AC's to restore
			%clarg p]	; dismiss interrupt
	 .lose %lssys			; argh!


subttl Handle ints on TTI channel

; TTY input interrupt (or realtime clock interrupt to resume network
; output).
; Gobble down characters from TTY into circ buffer, and output them if
; there's room.

.scalar rltflg		; Flag set when REALT turned on
.scalar ntolos		; # times buffer overflows
.scalar ntowp		; Deposit ptr into buff
.scalar ntowc		; # chars room to deposit in
lntobf==512.		; Max size of net output buffer
.scalar ntobuf(lntobf/4)	; Net output buffer
lttibf==20.
.scalar ttibuf(lttibf/4)	; TTY input buffer (not used?)

ntoini:	movei nt,lntobf	; Call to initialize buffering etc.
	movem nt,ntowc
	move nt,[441000,,ntobuf]
	movem nt,ntowp
	skipn rltflg
	 ret
	movsi nt,(setz)
	.realt nt,
	 jfcl
	setzm rltflg
	ret

ntosnd:	movei nt,(a)
ntout:	sosge ntowc
	 jrst [	setzm ntowc
		.iot tto,[^G]	; Lose, ding bell.
		aos ntolos
		ret]
	idpb nt,ntowp
	ret

	; Force out network output buffer
ntofrc:	movei nt,lntobf
	sub nt,ntowc		; Find # chars to output
	jumple nt,ntoini	; Jump if none, re-init ourselves.
	push p,a
	syscal whyint,[movei nto ? movem a ? movem a ? movem a]
	 .lose %lssys		; Get # chars room in A
	jumple a,ttirt8		; Jump if can't send anything.
	caile a,(nt)		; Use minimum of <buffer room> and <data>
	 movei a,(nt)
	push p,b
	push p,c
	subi nt,(a)		; Get # bytes that will be left over
	move b,[441000,,ntobuf]
	syscal siot,[movei nto ? b ? a]
	 .lose %lssys
	.nets nto,
	jumple nt,[pop p,c ? pop p,b ? pop p,a
		jrst ntoini]		; If none left,  we won.
	movem nt,ntowc		; Save temporarily

	; Ugh, didn't send all tty input to net, so must set up
	; to send it later.  Instead of hacking circular buff, we
	; simplify life by moving data up to beg of buffer!
	move nt,[441000,,ntobuf]
	ildb a,b
	idpb a,nt
	sojg c,.-2
	movem nt,ntowp		; Store new deposit ptr
	movei a,lntobf
	sub a,ntowc
	movem a,ntowc		; and new # chars room for deposit
	pop p,c			; Fall thru to enable timer
	pop p,b

ttirt8:	pop p,a
	skipe rltflg		; Can't send anything more now.
	 ret			; Timer already set to tickle us later.
	setom rltflg
	move nt,[600000,,[20.]]	; Try again in 1/3 sec
	.realt nt,
	 jfcl
	ret

	; Return point when TTY input processing done, to
	; force out network output.
ttiret:	call ntofrc
	jrst tsret

; Gobble down character

ttiser:	syscal IOT,[	clctl. %tiint\%tinwt; read character if any
			clarg. tti	; from TTY input
			%clval a]	; into A
	 .lose %lssys			; huh???
	jumpl a,ttiret			; return when no more
	trz a,%txsft			; lose shift bits
	camn a,cmdesc			; user wants a command?
	 jrst [	call cmprmt		; yes, do a command
		 jrst ttiser		; and try for another character
		.value [asciz/:Proceed
:Vk
/]
		useti AIFPIR,1_tti	; lost the TTY, lose this int too
		jrst ttiret]		; dismiss int
	cain a,%txtop\"H		; [HELP]?
	 jrst [	call help		; give the guy some help
		jrst ttiser]		; and get another character
ttisr5:	skipl openp			; connection opened?
	 jrst ttiser			; nope, flush this frob then
	trze a,%txmta			; <META> set?
	 store %fword,editkp		; yes, set <EDIT> key
	store linmor,morinh		; reset **More** inhibit count

; Fold bucky bits down to ASCII

ttisr1:	move b,a			; copy the character
	trz b,%txctl			; lose <CONTROL>
	caie b,%txtop\"A		; [ESCAPE]?
	 cain b,%txtop\"B		; [BREAK]?
	  jrst [skipn echop		; in local echo mode?
		 skipn linedp		; no, in line editor?
		  jrst ttiser		; nope, no line editor to work with
		movei a,^B		; yes, load line editor BREAK
		jrst ttisr2]		; and continue
	cain b,%txtop\"C		; [CLEAR]?
	 jrst [	skipn echop		; in local echo mode?
		 skipn linedp		; no, in line editor?
		  jrst ttiser		; nope, no line editor to work with
		movei a,^U		; yes, load line editor clear command
		jrst ttisr2]		; and continue
	cain b,^Z			; [CALL]?
	 jrst [	move b,ttyopt		; get options
		tlnn b,%tofci		; gotta have bucky bits
		 jrst ttisr2		; don't screw non-bucky bit keyboards
		skipn echop		; in local echo mode?
		 skipn linedp		; in line editor?
		  jrst ttisr2		; nope, no line editor
		movei a,^A		; yes, make it an ATTN
		jrst ttisr2]		; and continue
	trz a,%txtop			; lose top bit
; (continued on next page)

;  Canonical ITS mapping for <CONTROL> to standard ASCII.  [SPACE]
; mapping to @ is taken from the usual ASCII keyboard.

	trzn a,%txctl			; control bit on?
	 jrst ttisr2			; nope, a-okay
	cain a,<" >			; space?
	 movei a,^@			; yes, become null
	cail a,"?			; ? is [RUB OUT]
	 cain a,177			; [RUB OUT] is not hacked
	  jrst ttisr2			; not hacking character
	caile a,"_			; lower case?
	 subi a,"a-"A			; uppercaseify
	xori a,100			; controlify

; Now send the character

ttisr2:	skipl echop			; half duplex mode?
	 jrst hlfdpx			; yup
chrsnd:	aosn editkp			; send <EDIT> key too?
	 iori a,200			; turn it on
	call ntosnd			; send character to foreign host
	cain a,IAC			; sending [BS]?
	 call ntosnd			; gotta send it again!
	cain a,^M			; got a <CR>?
	 skipge trbinp			; binary mode?
	  jrst [
;;;		.nets nto,		; force sending buffer
		jrst ttiser]		; and try for more
	movei a,^J			; CR and not binary, fake an LF
	jrst ttisr1			; and make it "input" from kbd

; Input a character from the TTY when at TTY interrupt level

inpchr:	syscal IOT,[	clctl. %tiint	; read char always
			clarg. tti	; from device TTY
			%clval a]	; into ac A
	 .lose %lssys			; huh???
	return				; and return

subttl Half duplex local echoing, etc.

hlfdpx:	skipge wallp			; wall paper on?
	 skipge linedp			; yes, but in the line editor?
	  caia				; line editor or wall paper off
	  .iot wal,a			; otherwise put in wallpaper file
	skipge linedp			; in line editor?
	 skipe linctr			; first character on this line?
	  jrst hlfdx1			; nope
	syscal SCPOS,[	clarg. tto	; get cursor position
			repeat 2,%clval inipos]
	 .lose %lssys			; ???
	move b,inipos ? movem b,hpos	; set hpos count
hlfdx1:	cain a,^I			; tab?
	 jrst [	push tp,hpos		; save this hpos
		skipge 10tabp		; Multix tabs?
		 jrst [	movei b,10.	; to next tab stop
			add b,hpos	; add in current position
			idivi b,10.	; now flush modulo
			imuli b,10.	; to get real position
			movem b,hpos	; and remember it
			csrmov H	; set horizontal position
			addi b,8.	; add in ITS offset
			.iot tto,b	; and move there
			jrst hlfdx3]	; and continue on
		movei b,8.		; to next tab stop
		addm b,hpos		; add in tab
		movei b,7		; mask for extraneous cruft
		andcam b,hpos		; flush the cruft
		jrst hlfdx4]		; and continue
	cain a,177			; rubout?
	 jrst hlfdx3			; yes, flush flush flush
	cain a,^H			; backspace?
	 jrst [	sos hpos		; yes, decrement horizontal position
		jrst hlfdx4]		; and win
	cain a,^M			; terpri?
	 jrst hlfdx4			; yes, win
; (continued on next page)

	caige a,<" >			; or printing character?
	 jrst [	skipe linedp		; line editor command?
		 jsp b,[skipge lquotp	; line editor quote?
			 jrst (b)	; yes, no echo suppress
			caie a,^J	; yes, line feed?
			 cain a,^W	; word wipe?
			  jrst hlfdx3	; never are echoed
			caie a,^A	; same for the ATTN
			 cain a,^C
			  jrst hlfdx3	; ATTN
			caie a,^O	; and output abort commands
			 cain a,^S
			  jrst hlfdx3
			caie a,^L	; redisplay
			 cain a,^R
			  jrst hlfdx3	; don't echo either
			caie a,^Q	; quoting
			 cain a,^U	; and line erase
			  jrst hlfdx3	; don't echo
			caie a,^B	; finally BREAK
			 cain a,^T	; and AYT commands
			  jrst hlfdx3	; which never come out
			jrst 2(b)]	; else echo the character
		cain a,^J		; line feed?
		 jrst hlfdx4		; never bumps HPOS
		skipge twinp		; SAIL terminal?
		 skipa b,["]		; yes, use TV uparrow
		  movei b,"^		; no, use ASCII caret
		.iot tto,b		; print the control indication
		movei b,"@(a)		; get ASCII form
		.iot tto,b		; output the character
		aos hpos ? aos hpos	; allow for character
		jrst hlfdx3]		; and continue
	aos hpos			; bump the horizontal position
hlfdx4:	.iot tto,a			; output character
hlfdx3:	skipl linedp			; in the line editor?
	 jrst chrsnd			; finally can send
;	jrst lined			; yes, hack time

subttl Hairy line editor

lined:	cain a,177			; rubout?
	 jrst [ call delch		; yes, erase a character
		jrst ttiser]		; and continue
	caie a,^I			; tab?
	 cail a,<" >			; printing character?
	  jrst lnechs			; yes, send character
	aosn lquotp			; line editor quote?
	 jrst lnechs			; yes, send it
	caie a,^C			; C is ATTN too
	 cain a,^A			; send ATTN?
	  jrst [store ttobuf(440700),ttoptr; reset buffer pointer
		store %zeros,ttoctr	; zap output buffer
		.netint nto,		; complete synch
		telcmd [IAC IP IAC DM]	; send command + part of synch
		jrst ttiser]		; and continue
	cain a,^B			; send break?
	 jrst [	.netint nto,		; complete synch
		telcmd [IAC BRK IAC DM]	; send command + part of synch
		jrst ttiser]		; and continue
	caie a,^O			; O is an alias for silence
	 cain a,^S			; silence?
	  jrst [.netint nti,		; send an interrupt
		telcmd [IAC AO IAC DM]
		store %zeros,ttoctr	; empty buffer
		store ttobuf(440700),ttoptr; reset pointer
		jrst ttiser]		; and continue
	cain a,^Q			; quote next character
	 jrst [	store %fword,lquotp	; yes, quoted
		jrst ttiser]		; and continue
	cain a,^T			; print status?
	 jrst [	telcmd [IAC AYT]
		jrst ttiser]		; yes, get host to send a wholine
	cain a,^U			; flush entire line?
	 jrst [	store linbuf(440700),linptr; load pointer
		store %zeros,linctr	; clear line counter
		store %zeros,hpos	; initialize horizontal position
		move b,ttyopt		; get terminal options
		tlne b,%toovr		; glass TTY? (might as well)
		 tlne b,%toers		; display?
		  jrst [csrmov H
			move a,inipos	; get initial cursor position
			movem a,hpos	; reset it for us
			addi a,8.	; offset
			.iot tto,a	; restore cursor
			csrmov L
			jrst ttiser]	; and try again
		csrmov A
		jrst ttiser]		; restart again
	cain a,^W			; wipe out word?
	 jrst delwrd			; yes, flush the word
	cain a,^J			; line feed?
	 jrst sndbfr			; yes, send buffer
; (continued on next page)

; (continued from previous page)

;  The Incomparable Incredibly Bletcherous Retype Routine!!!
; ...bringing you the very worst in program readability, the lowest in
; taste and the ultimate(?) in hair.  How can anybody ever understand
; this disgusting code?  What made me ever write it this gross way?

	caie a,^L			; zap and redisplay?
	 cain a,^R			; redisplay?
	  jrst [move b,ttyopt		; get this console's option variable
		tlne b,%toovr		; glass TTY?
		 tlne b,%toers		; or display?
		  jsp b,[	cain a,^L; zap screen too?
				 jrst [	csrmov C
					jrst 2(b)]; yes, zap then fall through
				csrmov H
				move c,inipos; initial cursor position
				movei a,8.(c); offset
				.iot tto,a; restore cursor
				csrmov L
				jrst 3(b)]; and continue
		csrmov A
		setzb c,inipos		; cursor at BOL
		move a,[440700,,linbuf]	; if you thought that was bad,
		move tp,[-5*linbfl,,tabpdl]; look at the crocks coming up!
		move linctr		; how many characters to do
		jsp b,[	sojl ttiser	; all done yet?
			ildb d,a	; get character
			caige d,<" >	; control character?
			 jrst [	cain d,^I; tab?
				 jrst [	push tp,c; save current position
					skipn 10tabp; screwy Multix 10 tabs?
					 jrst [	addi c,8.; no, go to next stop
						trz c,7; make sure at a real stop
						.iot tto,d; output an 8. tab
						aoja c,@-1(b)]; now try next
					addi c,10.; go to Multix tab stop
					idivi c,10.; but flush modulo
					imuli c,10.; in the canonical way
					csrmov H
					movei d,8.(c); PH offset
					.iot tto,d; now put cursor there
					jrst @-1(b)]; and try next character
				cain d,^J; line feed?
				 jrst [	.iot tto,d; yes, just output it
					jrst ttiser]; without bumping position
				cain d,^H; backspace?
				 jrst [	.iot tto,d; yes, output it
					soja c,@-1(b)]; but SOS position!
				save d	; save old character
				skipge twinp; winning terminal?
				 skipa d,["]; uparrow
				  movei d,"^; no, caret
				.iot tto,d; output the control prefix
				retr d	; and get the character back
				movei d,"@(d); get ASCII name
				.iot tto,d; output it
				aoja c,@-1(b)]; and try next
			.iot tto,d	; no, output the character (sigh)
			aoja c,@-1(b)]]	; and try next character
; (continued on next page)

; (continued from previous page)
lnechs:	aosle b,linctr			; update counter
	 cail b,5*linbfl		; too long line?
	  jrst [type [ALine too long!A]
		move tp,[-5*linbfl,,tabpdl] ; reinitialize line editor variables
		store %zeros,linctr	; counter...
		store linbuf(440700),linptr; and pointer
		jrst ttiser]		; and return
	idpb a,linptr			; save character in buffer
	caie a,^M			; CR?
	 jrst ttiser			; no, return
	movei a,^J			; get a LF too
	.iot tto,a			; echo it
	aos linctr			; bump buffer pointer again
	idpb a,linptr			; save character
	skipge wallp			; wallpaper file enabled?
	 .iot wal,a			; yes, stick the LF in (thanx Moon)
sndbfr:	store linbuf(440700),linptr,,a	; load pointer
	move tp,[-5*linbfl,,tabpdl]	; load up tab pdp
	skipl wallp			; wallpaper?
	 jrst sndbf1			; nope
	move b,linctr			; don't want counter smashed yet
	syscal SIOT,[	clarg. wal	; wallpaper output
			a ? b]		; line editor buffer
	 .lose %lssys			; foo!
	move a,linptr			; reload line pointer
sndbf1:	call ntofrc			; Ensure other buffer flushed first
	syscal SIOT,[	clarg. nto	; network output
			a ? linctr]	; output the line
	 .lose %lssys			; huh????
	.nets nto,			; force it out
	jrst ttiser			; and continue

; Here to flush an alphanumeric word.

delwrd:	skipg linctr			; line empty?
	 jrst ttiser			; yes all done
	ldb a,linptr			; get current character
	call alpnmp			; alphanumeric?
	 jrst [	call delch		; no, flush it
		jrst delwrd]		; and go again
delwd1:	call delch			; flush this character
	skipg linctr			; any more?
	 jrst ttiser			; nope
	ldb a,linptr			; get new current char
	call alpnmp			; alphanumeric?
	 jrst ttiser			; nope, all done
	jrst delwd1			; yes, flush it too

; Here to skip if alphanumeric character in A.

alpnmp:	cail a,"a			; lower case?
	 subi a,"a-"A			; yes, uppercaseify
	cail a,"0			; too low?
	 caile a,"Z			; too high?
	  return			; yes, rejected!
	caile a,"9			; numeric?
	 cail a,"A			; alphabetic?
	  aos (p)			; yes, bump return PC
	return				; and return

;  Here to flush a single character from the screen or echo it
; back if a printing console.

delch:	sosge linctr			; rubout, drop buffer
	 jrst [	store %zeros,linctr	; buffer already empty
		return]			; get another character
	move a,linptr			; get line editor pointer
	add a,[70000,,]			; decrement pointer
	tdne a,[%minfi]			; back a full word?
	 sub a,[430000000001]		; yes, decrement word
	movem a,linptr			; store updated pointer
	ildb a,a			; get character deleted
	move b,ttyopt			; get status of this terminal
	tlne b,%toovr			; glass teletype?
	 tlne b,%toers			; or display?
	  jrst [cain a,^I		; tabs are special
		 jrst [	pop tp,a	; get last tab pos
			movem a,hpos	; set new position
			csrmov H	; set horizontal position
			addi a,8.	; offset
			.iot tto,a	; fix cursor
			return]		; and return
		cain a,^J		; line feed
		 jrst [	csrmov U	; just moves cursor up
			return]		; now return
		cain a,^H		; backspace
		 jrst [	aos hpos	; bumps the cursor forward
			csrmov F	; this can't win all the time,
			return]		; but we'll try...
		caige a,<" >		; for all other controls...
		 jsp b,[sos hpos	; erase the ASCII part
			csrmov X	; account for it
			jrst (b)]	; and erase the ^
		sos hpos		; get the current horizontal pos
		csrmov X		; erase character
		return]			; and continue
	sos hpos			; account for character
	.iot tto,a			; echo character deleted
	return				; and continue

subttl Command process and dispatch

define cmnd code,server
 loc cmdtab+code-<" >
 server
termin

cmprmt:	skipe jclbuf			; any JCL?
	 jrst open			; yes, fake an O command right away
	skipge x,hostad			; connection open or opening?
	 jrst cmprm1			; no, no bottom of screen
	move a,ttyopt			; get option bits
	tlc a,%tomvu\%toers		; set both bits zero iff both one
	tlne a,%tomvu\%toers		; well, are they?
	 jrst [	csrmov A		; not a display, just terpri
		jrst cmprm1]		; continue on
	csrmov S			; save cursor pos
	csrmov Z			; bottom of screen
	csrmov L			; clear line
cmprm1:	type [TELNET>]
	move a,ttysts			; get current status
	tlz a,%tssii			; turn off super-image mode
	syscal TTYSET,[	clarg. tto	; this is so Z and _ will
			%clarg ttyst1	; do their normal ITS functions
			%clarg ttyst2	; at command level
			%clarg a]
	 .lose %lssys			; TTYSET failed?
commnd:	call inpchr			; and hang for it
	camn a,cmdesc			; escape character again?
	 jumpge x,[	csrmov R	; restore cursor position
			retr (p)	; reset stack down
			syscal TTYSET,[	clarg. tto; turn super-image
					%clarg ttyst1; mode back on
					%clarg ttyst2
					%clarg ttysts]
			 .lose %lssys	; huh???
			jrst ttisr5]	; send it to foreign host
cmmnd1:	andi a,%txctl\%txasc		; only want char plus bucky bit
	cail a,140			; lower case?
	 subi a,40			; yes, uppercaseify
	trnn a,%txctl			; control character?
	 caige a,<" >			; . . .
	  jrst cmdnop			; yes, flush the command
	jrst @cmdtab-<" >(a)		; otherwise dispatch on command

cmdnop:	.iot tto,[^G]			; barf at bad command
	skipl hostad			; connection open?
	 jrst cmdret			; yes, return
	jrst commnd			; no, just ask for something else
cmdfls:	.iot tto,[^G]			; here when a command flushed
	store %zeros,jclbuf		; just in case
	jrst cmdret			; and return

; Command dispatch table
cmdtab:	repeat 100,cmdnop		; default to nothing

	cmnd "1,10tabs			; Multix type tabs
	cmnd "?,help			; alternate help cruft
	cmnd "A,sndatt			; ATTN
	cmnd "B,sndbrk			; break
	cmnd "C,close			; close connection
	cmnd "D,dmsima			; DM simulation
	cmnd "E,echotg			; echo toggle
	cmnd "F,fullcs			; FCS toggle
	cmnd "G,supimg			; super image toggle
	cmnd "H,help			; help cruft
	cmnd "I,escset			; interrupt character
	cmnd "J,jtglce			; just toggle crufty echo
	cmnd "K,kiljob			; kill foreign job
	cmnd "L,linedt			; line editor toggle
	cmnd "M,mortog			; **More** processing toggle
	cmnd "N,ncptog			; Use NCP not TCP (toggle)
	cmnd "O,open			; open connection
	cmnd "P,proced			; DDT
	cmnd "Q,quit			; quit
	cmnd "S,wholin			; do a wholine at foreign host
	cmnd "T,ttyotg			; TTY output toggle
	cmnd "W,walltg			; wallpaper toggle
	cmnd "X,togsts			; toggle status
	cmnd "Z,zapscn			; zap screen
	cmnd "^,editfy			; <EDIT>ifier
	loc cmdtab+100			; to end of table again

subttl Help text

define htxgen string
 hlptxt: ascii\!string!\
 htxlen==.length\!string!\
termin

	htxgen [
User TELNET commands:

A *	Send ATTN (interrupt process at foreign host).
B *	Send Break.
C * +	Close connection or abort an incomplete O command.
D *	Toggle the Datamedia 3000 simulator.  Works only on terminals with
	 insert/delete mode.  <META> acts like the DM <EDIT> key.
E *	Request foreign host to toggle the echo mode; toggling to local
	 echo will always work.  The echo state is initially remote
	 echo if the host accepts it.  The foreign host may forbid the
	 toggle, in which case the J command can be used.
F	Full character set toggle.  Says whether or not super-image
	 mode should be used.  Defaults on for non-TV's.
G  	Toggle super image output mode (useful for displaying graphics
	 from a remote host).  Defaults off.
H or ?	Display help message (this text).  The [HELP] key does this too.
I	Set the intercept character (defaults to <CONTROL>^ on non-TV's;
	 [BREAK] on TV's).
J *	Toggle TELNET's echo mode without telling the foreign host or
	 asking it for permission.
K * +	Request foreign host to kill the foreign job.
L	Toggle the line editor; normally on, but only works in local
	 echo mode.  Hence if the foreign host forbids remote echo mode
	 you automatically get the line editor (such as in Multics).
	 Line editor commands:
	 <CONTROL>A	send ATTN.
	 <CONTROL>B	send Break.
	 <CONTROL>C	send ATTN.
	 <CONTROL>L	clear screen and redisplay line.
	 <CONTROL>O	abort output.
	 <CONTROL>Q	quotes next character.
	 <CONTROL>R	redisplay line.
	 <CONTROL>S	abort output.
	 <CONTROL>T	ask host for a status message.
	 <CONTROL>U	delete line.
	 <CONTROL>W	delete last word.
	 [LINE FEED]	activate line (send it to the foreign host),
	 [RETURN]	insert a CRLF and activate line.
	 [FORM FEED]	clear screen and redisplay line.
	 [RUB OUT]	delete last character.
	 <META>[BREAK]	send Break.
	 [CLEAR]	delete line.
	 <META>[CALL]	send ATTN.
M	Toggle **More** processing; initially enabled for displays.
N	Use old NCP protocol instead of TCP -- give only before Open!
O	Open connection to SOCKET,HOST.  The socket number is optional
	 and defaults to 27 for new TELNET.  The host specification may
	 be a name or a number; "?" lists the available hosts at that
	 point in the scan.  Numbers are octal unless followed by a
	 decimal point or an 8 or 9 appears in the number.
P	Proceed TELNET and return the console to DDT.
Q +	Quit (exit from TELNET and kill the job).
S *	Ask host to give some sort of status message.
T	Toggle TTY output; initially enabled.
W	Toggle wallpaper file; initially disabled.  The file is written
	 as DSK:NETOUT > on the default directory.
X	Lists status of TELNET's toggles.
Z	Zap (clear) display screen.
1	Toggle Multics-style tab processing (ie, 10. column tab stops).
	 This only happens in local echo.  Connecting to a Multics host
	 sets this mode automatically.
^ *	Send <EDIT> on the next character, intended to be used with the
	 DM simulator for terminals without a <META> key.

   * = open connection required, + = confirmation required if open

 The intercept character as a command sends that character to the host.
]

subttl Help and toggle status commands

define toggle tognam,togdsc/
 type [    togdsc ]
 .iot tto,["O]
 ifse tognam,TTYOP,skipge tognam
 .else skipl tognam
  jrst [type [ff]
	jrst .+2]
 .iot tto,["n]
 csrmov A
termin

help:	type [Help text]
	csrmov C
	save morep			; save **More** status
	store %fword,morep		; must have **More** processing now
	store %fword,morinh		; don't allow inhibition of **More**
	move x,[440700,,hlptxt]		; load pointer to help text
	movei y,htxlen			; load length of text
	syscal SIOT,[	clarg. tto	; output to console
			x ? y]		; using pointer and count
	 .lose %lssys			; ???
	retr morep			; restore **More** state
	store %zeros,jclbuf		; zap JCL buffer
	jrst hlpret

togsts:	type [Toggle status]
	save morep			; save **More** state
	store %fword,morep		; turn on **More** processing
	move a,ttyopt			; get option bits
	tlc a,%tomvu\%toers		; set both bits zero iff both one
	tlnn a,%tomvu\%toers		; well, are they?
	 skipge hostad			; connection open?
	  jrst togst1			; no, no cursor hacking
	csrmov R
togst1:	csrmov A
	toggle 10TABP,Multics-style tab processing
	toggle DMSIMP,Datamedia simulator
	toggle ECHOP,Remote echo
	toggle LINEDP,Line editor
	toggle (P),**More** processing
	toggle TTYOP,TTY output
	toggle WALLP,Wallpaper file
	retr morep			; restore **More** state
hlpret:	skipge hostad			; connection open?
	 jrst cmprm1			; no, go get a command
	csrmov Z			; bottom of screen
	csrmov L			; wipe line
	jrst cmprm1			; and get a command

subttl Open command

open:	skipl hostad			; are we connected?
	 jrst cmdnop			; yes, must close first!
	skipe jclbuf			; got JCL?
	 move j,[440700,,jclbuf]	; load pointer to JCL buffer
	movei a,[asciz /Open connection to /]
	movem a,prompt'
	store %zeros,icpskt		; initialize initial socket
	pushj p,netwrk"hostnm		; Do hostname lookup interactively
	 jrst cmdfls			; Fail or something?
	movem a,hostad			; Store host address.
	netwrk"getnet x,hostad		; Find out which network.
	came x,[netwrk"nw%chs]		; Chaosnet is not on Internet.
	 jrst open1
	type [A This program cannot reach that Chaosnet-only host.]
	store %fword,hostad		; not at any host
	jrst cmdret
	;;; Now check to see if we should hassle people.
	;;; Hassle only ARPAnet people.
	;;; If this program is ever extended to hack CHAOS connections,
	;;; we should not barf at ARPA->CHAOS users.
ifn ftnethop,[
	skipa x,[tto]			; start with this TTY
nxtpty:	 addi x,400000			; try next TTY down
	syscal STYGET,[	%clarg x	; get STY mother
			%clval x ]	; into X
	 .lose %lssys			; ???
	andi x,777777			; flush left half
	jumpe x,notsty			; no PTY mother, no net hopping here
	syscal STLGET,[	%clari tto ? %clval a ? %clval b ? %clval c ? %clval d ]
	 .lose %lsfil			; Get luser's server telnet info.
	tlnn d,2000			; If he is coming from the ARPAnet
	 jrst nhpcfm			;  go hassle him about net-hopping.
];ifn ftnethop

open1:	movei b,nprskt	; default ICP socket #
	skipn icpskt	; have I gotten one?
	 movem b,icpskt	; nope, got one now!
	store %zeros,jclbuf	; clear JCL buffer
	type [A Trying...]
	jrst goicp


netwrk"spchan:
	cain t,",
	 jrst [	.iot tto,t
		skipl t,netwrk"numgot
		 movem t,icpskt
		return]	; restart from beginning (clear RCPBUF)
	cain t,^G
	 jrst cmdfls
	aos (p)		; else ignore char
cpopj:	return


netwrk"putchr:
	.iot tto,t
	return

; Open input character routine (either from TTY or JCL)

netwrk"getchr:
	skipn jclbuf			; any JCL?
	 jrst [	.iot tti,t		; no, get a character from console
		andi t,%txasc		; only want ASCII part
		aos (p)
		return]			; and return
	ildb t,j			; yes, get a character from JCL
	cain t,^C			; end of buffer?
	 movei t,^M			; yes, fake a CR
	cain t,^M			; is it end of command?
	 store %zeros,jclbuf		; yes, flush JCL forever
	jumpe t,netwrk"getchr			; flush nulls
	aos (p)
	return				; got a JCL character all okay

; Copy the zero-terminated string from Bp in J into JCLBUF.

filjcl:	move t,[440700,,jclbuf]
filjc1:	ildb x,j
	idpb x,t
	skipe x
	 jrst filjc1
	return


; Close command and reset routine if connection closed on us

close:	skipge hostad			; ever got opened?
	 jrst cmdnop			; nope, no-op
	type [Close connection]
	skipe openp			; don't need confirm if not open
	 jsp c,confrm			; get confirmation
	store %zeros,killp		; no death if this way
reset:	skipe killp			; shall I suicide?
	 .logout 1,			; yup
	csrmov A			; advance to NL
	irps chnl,,[icp nti nto]
	 .close chnl,			; close all net channels
	termin
	store %zeros,rstbeg,corend	; reset all flags
	store %fword,hostad		; clear host to get to
	useti MSK2,1_tto		; clear interrupts pending
	useti MASK,%pirlt
	useti IFPIR,%zeros		; . . .
	useti DF2,%zeros		; . . .
	move p,[-pdllen,,pdl]		; reset stack pointer
	call ntoini
	jrst notcon			; and become not connected

subttl Host level commands

echotg:	skipl openp			; ICP done?
	 jrst cmdnop			; no, not ready yet
	type [Echo request at ]
	skipl echop			; full duplex?
	 jrst [	type [remote host]
		store %fword,echop
		skipl nprotp		; new protocol?
		 jrst [telcmd [204] ? jrst cmdret]; old protocol ECHO
		telcmf [IAC DO ECHO]
		jrst cmdret]		; and return
	type [local host]
	store %zeros,echop
	skipl nprotp			; new protocol?
	 jrst [telcmd [203] ? jrst cmdret]; old protocol NO ECHO
	telcmf [IAC DONT ECHO]
	jrst cmdret			; and return

dmsima:	skipe twinp			; is this a TV?
	 skipl openp			; connection open?
	  jrst cmdnop			; no, don't take this command
	type [Datamedia simulation o]
	setcmb a,dmsimp			; toggle DM simulation
	jumpge a,[	type [ff]
			skipl nprotp	; new protocol?
			 jrst cmdret	; oh damn
			store %zeros,trbinp; not in 8 bit mode any more
			telcmf [IAC WONT TRNBIN]
			jrst cmdret]	; and return
	.iot tto,["n]			; it's on
	skipl nprotp			; new protocol?
	 jrst dmsma1			; too bad
	store %fword,trbinp
	telcmf [IAC WILL TRNBIN]
dmsma1:	movsi x,%tsrol			; have to scroll (ick!)
	iorm x,ttysts			; turn the bit on
	syscal TTYSET,[	clarg. TTO	; set it
			ttyst1 ? ttyst2 ? ttysts]; TTY variables
	 .lose %lssys			; ???
	store %zeros,morep		; turn off **More** processing
	jrst cmdret			; and return

editfy:	skipl openp			; ICP done?
	 jrst cmdnop			; nope, lose
	type [<EDIT> key]
	store %fword,editkp		; turn on <EDIT> key
	jrst cmdret			; and return

wholin:	skipge nprotp			; new protocol?
	 skipl openp			; ICP done?
	  jrst cmdnop			; no, not ready yet
	type [Status]
	telcmf [IAC AYT]
	jrst cmdret			; and return

sndatt:	skipl openp			; ICP done?
	 jrst cmdnop			; no, not ready yet
	type [ATTN]
	.netint nto,			; send an interrupt
	skipl nprotp			; new protocol?
	 jrst [	telcmf [201 200]
		jrst cmdret]		; old protocol break
	telcmd [IAC IP IAC DM]
	store %zeros,ttoctr		; and buffer count
	store ttobuf(440700),ttoptr	; reset buffer pointer
	jrst cmdret			; and return

kiljob:	skipge nprotp			; new protocol?
	 skipl openp			; connection open?
	  jrst cmdnop			; nope, lose
	type [Kill job request at foreign host]
	jsp c,confrm			; demand confirmation!
	telcmf [IAC DO LOGOUT]
	store %fword,logoup		; remember this was asked for
	jrst cmdret			; and return

sndbrk:	skipge nprotp			; new protocol?
	 skipl openp			; ICP done?
	  jrst cmdnop			; no, not ready yet
	type [Break]
	.netint nto,			; send network interrupt (INS)
	telcmf [IAC BRK IAC DM]
	jrst cmdret			; and return

subttl Local level commands, confirmations, etc.

proced:	type [Proceed, return TTY to DDT]
	aos (p)				; bump return PC
	jrst cmdret			; and return

zapscn:	csrmov C			; clear screen
	jrst imagon			; and return

quit:	type [Quit]
	skipe openp			; connection open?
	 jsp c,confrm			; yes, require confirmation
	.logout 1,			; suicide now

ifn ftnethop,[
nhpcfm:	uget XUNAME,x			; get my name
	irps winner,,MRC RWK RMS KLH GSB EAK EJS CSTACY ED MOON PGS DLW JNC OTA JIS JSOL CBF
	 camn x,[sixbit/winner/]
	  jrst notsty
	termin
	hllos x				; check for not logged in
	aoje x,[type [Login Please]
		.logout 1,]		; you lose
	type [
 You are logged into ITS over the ARPAnet.  It is a waste of ITS'
system resources (jobs, network channels) to go back again over
the ARPAnet to another site.  It also slows down response to you
and increases the chances of lossage due to a system or network
failure.

 You should not do this unless you have a good reason to do so.  If
you have any questions, typing :LUSER to DDT will request a system
programmer to assist you.

 Are you sure you want to run TELNET now?]
	.iot tti,x			; get a character
	andi x,%txasc			; only want character, no bucky bits
	caie x,"Y			; Yes?
	 cain x,"y			; . . .
	  jrst [type [Yes
]
		jrst notsty]		; claims to know what (s)he's doing
	type [No
Thank you for your co-operation.
]
	.logout 1,			; and suicide
];ifn ftnethop

confrm:	type [ [Confirm]]
	call inpchr			; get a character
	andi a,%txasc			; only want character
	caie a,<" >			; how about a space?
	 cain a,^M			; is it a CR?
	  movei a,"Y			; yes, fake a Yes
	caie a,"y			; yes?
	 cain a,"Y			; . . .
	  caia				; yup, prepare to die...
	   jrst [	type [No]
			jrst cmdfls]	; deconfirmed
	type [Yes]
	jrst (c)			; return to do whatever

escset:	type [Intercept character=]
	call inpchr			; get new interrupt character
	.iot tto,a			; echo it
	movem a,cmdesc			; set it
	jrst cmdret			; and return from command

linedt:	aosn linedp			; line editor on?
	 jrst [	type [Line editor off]
		jrst cmdret]		; yes, turn off with no problems
	type [Line editor on]
	store %fword,linedp		; yes, enable line editor
	move tp,[-5*linbfl,,tabpdl]	; load up tab pdp
	store %zeros,linctr		; clear line editor counter
	store linbuf(440700),linptr	; initialize line editor pointer
	jrst cmdret			; and return

10tabs:	type [10 character tabs o]
	setcmb a,10tabp			; complement Multix tabs
	jumpl a,[.iot tto,["n] ? jrst cmdret]; on
	type [ff]
	jrst cmdret			; and return from command

ncptog:	setcmb a,tcpp
	jumpe a,[type [NCP protocol (not TCP)]
		jrst cmdret]
	type [NCP off, using TCP]
	jrst cmdret

	type [NCP protocol]
mortog:	type [More processing o]
	setcmb a,morep			; complement **More** hacking
	jumpl a,[.iot tto,["n] ? jrst cmdret]; **More** on now
	type [ff]
	jrst cmdret			; and return from command

walltg:	type [Wallpaper file ]
	setcmb a,wallp			; toggle wallpaper flag
	jumpge a,[	type [closed]
			.close wal,	; close off wallpaper
			jrst cmdret]	; and return
	.open wal,[.uao,,'DSK ? sixbit/NETOUT>/]; try to make wallpaper file
	 jrst [	type [cannot be opened]
		store %zeros,wallp	; remember can't do!
		jrst cmdret]		; and return
	type [opened]
	jrst cmdret			; and continue

fullcs:	type [Full character set o]
	movsi a,%tssii			; super image mode
	xorb a,ttysts			; toggle it
	syscal TTYSET,[	clarg. TTO	; set it
			ttyst1 ? ttyst2 ? ttysts]; TTY variables
	 .lose %lssys			; ???
	tlne a,%tssii			; report what it toggled to
	 jrst [	.iot tto,["n] ? jrst cmdret]
	type [ff]
	jrst cmdret

supimg:	type [Super image output o]
	movei a,%tjsio
	xorb a,ttoctl
	trne a,%tjsio			; report what it toggled to
	 jrst [	.iot tto,["n] ? jrst cmdret]
	type [ff]
	jrst cmdret

jtglce:	skipl openp			; connection open?
	 jrst cmdnop			; nope, lose lose
	type [Just toggle crufty echo o]
	setcmb a,echop			; togglify it (hack hack)
	jumpge a,[	.iot tto,["n]
			jrst cmdret]	; echo off
	type [ff]
	jrst cmdret			; echo on

ttyotg:	.reset tto,			; flush output
	type [TTY output o]
	setcmb a,ttyop			; toggle TTY output
	jumpge a,[	.iot tto,["n]	; nope, indicate on
			jrst cmdret]	; and return
	type [ff]
	store %zeros,ttobuf		; flush TTY output buffer
	store ttobuf(440700),ttoptr	; and reset buffer pointer
;	jrst cmdret			; and return

; Here to restore cursor position after a command

cmdret:	move a,ttyopt			; get option bits
	tlc a,%tomvu\%toers		; set both bits zero iff both one
	tlnn a,%tomvu\%toers		; well, are they?
	 skipge hostad			; connected?
	  jrst [csrmov A		; advance to new line
		return]
	csrmov R			; restore cursor position
imagon:	movsi a,%tssii			; super image mode
	tdnn a,ttysts			; is it on?
	 return				; no, avoid doing the TTYSET then
	syscal TTYSET,[	clarg. tto	; turn super-image mode back on
			%clarg ttyst1
			%clarg ttyst2
			%clarg ttysts]
	 .lose %lssys			; TTYSET failed?
	return				; and return

subttl Handle ints on NTO and TTO channels

; Network output interrupt

ntoser:	syscal WHYINT,[	clarg. nto	; get status of net output channel
			repeat 2,%clval c]; socket state
	 .lose %lssys			; huh???
	andi c,-1			; flush any left half
	caie c,%nsopn			; socket open?
	 cain c,%nsrfn			; RFNM wait?
	  jrst tsret			; okay, ignore that
	store %zeros,openp		; zap open status
	jumpe c,tsret			; if CLS, ignore until NTI closed too
badskt:	type [
Socket entered illegal state -- ]
	cail c,maxess			; greater than maximum?
	 jrst random			; yes, barf with number
	movsi a,440700			; make a byte pointer
	hrr a,esstab(c)			; get message
	hlrz b,esstab(c)		; and counter
	syscal SIOT,[	clarg. tto	; output to TTY
			a ? b]		; pointer and counter
	 .lose %lssys			; argh
	jrst rnderr			; and continue to barf

; TTY **More** interrupt

ttoser:	syscal WHYINT,[clarg. tto]	; acknowledge the int
	 .lose %lssys			; huh???
	skipge openp			; open connection (meaningful MORINH)?
	 skipge morinh			; **More**'s inhibited?
	  skipn morep			; taking **More**'s?
	   jrst tsret			; nope, flush the int
	type [**More**]
	syscal IOT,[	clctl. %tiint\%tipek; peek ahead, but wait
			clarg. tti	; on TTY input channel
			%clval a]	; to AC a
	 .lose %lssys			; huh???
	cain a,<" >			; a space?
	 call inpchr			; yes, flush it
	type [
]
	jrst tsret			; and flush it

; Generate constants

	variab				; variables
...lit:	consta				; constants

hsttab=<.\1777>+1			; start of HSTTAB mapped pages

end TELNET
