;<PUP>CHAT.MAC;14    13-OCT-81 08:32:21    EDIT BY TAFT
; Revise host name table
;<PUP>CHAT.MAC;13    16-APR-81 16:53:47    EDIT BY TAFT
; Fix bug in host-name command that prevented use of names containing
; an implicit nonzero socket number.
;<PUP>CHAT.MAC;12     2-FEB-81 12:29:29    EDIT BY TAFT
; Revise host name table
;<PUP>CHAT.MAC;11     3-JUL-79 10:31:10    EDIT BY TAFT
; Reset P when restarted at RECV0
;<PUP>CHAT.MAC;10    24-APR-78 12:14:50    EDIT BY TAFT
; Add names of all IFSs to host name table.
; Fix crash caused by log.file.for.current.connection when there
; is no connection.
;<PUP>CHAT.MAC;9    17-JUL-77 12:56:59    EDIT BY TAFT
; Add IFS command
;<PUP>CHAT.MAC;8    13-APR-77 12:54:36    EDIT BY TAFT
; Add initial Chat.Commands feature
; Correct implementation of timing mark
;<PUP>CHAT.MAC;7    21-MAR-77 16:50:45    EDIT BY TAFT
; Add simple host name collector
;<TAFT>CHAT.MAC;4    21-MAR-77 02:05:53    EDIT BY TAFT
; Find help file on <Doc>Chat.help
;<TAFT>CHAT.MAC;3    21-MAR-77 01:03:37    EDIT BY TAFT
; Conversion from TELNET to CHAT:
; Rip out all the BCPL call stuff
; Rip out all option negotiation and RCTE code
; Remove Arpanet-related stuff (netstat, socket.map, status.of ...)
; Rewrite DOICP to make Pup connections
; Remove state change stuff
; Insert commands "Maxc1" and "Maxc2" until we can figure out
; a good way of collecting host names.
;<DODDS>TELNET.MAC;135     4-FEB-75 14:55:16    EDIT BY DODDS

	TITLE CHAT -- TENEX PUP USER TELNET
	SUBTTL	E. A. Taft, based on TELNET by R.S.Tomlinson

	SEARCH STENEX

ENTVEC:	JRST START		; entry vector: start adr
	JRST START		; restart adr, changed later

VERNUM:	ASCIZ \1.04 2-Feb-81\
	BLOCK 3

OPDEF	ERROR[1B8]


; Accumulators

A=1
B=2
C=3
D=4
X=5
Y=6
Z=7
PTR=10
TAB=11
NOA=12
CNX=13
NCNX=14
P=17
F=0

; Flags (rh of f)

REMOTF==1		; Operating in remote mode
COMMDF==4		; In command mode
NSTIWF==2		; Don't do stiw's
ICPMOD==10		; ICP in progress
TMPF==400000		; Temporary flags
TMPF2==200000
TMPF3==100000
TMPF4==40000
TMPF5==20000
TMPF6==10000

; Parameters

NPDL==2000		; Size of push list
NCONN==7		; Number of connections to remember
IESC=="Z"-100		; Initial escape character
ICBF=="O"-100		; Initial clear output buffer character
ESCCHN==0		; Use channel 0 for escape
ABNCHN==2		; Channel 2 for abnormal connection termination
CBFCHN==4
SAVBFS==4000		; Size of string saving buffer

LOC 200000		; fork data area

SPDL:	BLOCK 100
APDL:	BLOCK 50
FKRET1:	BLOCK 1
FKRET2:	BLOCK 1
FKRET3:	BLOCK 1
FSVCNX:	BLOCK 1			; fork's cnx for use by INSRCV
IRSST:	BLOCK 1			; ditto temp for Send status
IACSAV:	BLOCK 20		; ditto AC save area
SAVBUF:	BLOCK SAVBFS

LOC 100000		; Where to store variables

INTEGER	CONTAB
ARRAY	PDL[NPDL]
ARRAY	COMBUF,LINBUF,HLPBUF[200]
ARRAY	BIGBUF[4000]
INTEGER	LODFLG,WATFLG,TCASE,TRMLWC,BPTR,LPTR,SVP
INTEGER	TTCOC0,TTCOC1,TTMOD0,TTMODR,TTMODC,JOBTIW,HDX,NFANCY
INTEGER	ESCAPE,ESCCOD,CBFCHR,CBFCOD,LSTBDI,CONCSF,ABNLCK,ABNCNX
INTEGER	LCASCF,UCASCF,LCASC,LCASL,UCASC,UCASL,UNSFT
INTEGER	SYNC,QUOT,QUOTF,SPECWK
ARRAY	FAC,LGDRST[20]
INTEGER	IJFN,SCRJFN,SCRCNT,SCRTIM,REALTT,CMCALX,CRNLSW,CMDJFN
INTEGER	DIVJFN,DIVSWT,RLACJ,SPCFRK,ACTVSW,ACTVTM
INTEGER	SKTMSK,FSKT,FHST,FHSTN,RETPC1,RETPC2,RETPC3
ARRAY	SNDFRK,RCVFRK,DMTIME,LSKT,ELCLF,LFCRF,LNBFF[NCONN+1]
ARRAY	XPARNT,RCVBSW,CBFCNT,ALTJFN,ALTJCT,SNDATM,RCVATM[NCONN+1]
ARRAY	RAISEF,LOWERF,ECHCOC,CONTB,SAVINP,SAVINC,SAVONP,SAVSWT[NCONN+1]
ARRAY	RHLDCT,RSHLCT,RBUFCT,RBFECT,RBFSCT[NCONN+1]
ARRAY	RHLDBF,RHLDPT,RECHPT,RSNDPT,LGFJFN,LGFCNT,LGFTIM[NCONN+1]
ARRAY	SNDJFN,RECJFN[NCONN+1]	; Send & Receive jfns
ARRAY	SYNCNT[NCONN+1]	; Sync count (interrupts - data marks)
ARRAY	CONNAM[3+3*NCONN]
INTEGER	SWOFLG,CLROBF,TERM,JUNK

RELOC


; Program starts here

START:	MOVEI A,100
	SIBE
	JRST RSTART
	HRROI A,[ASCIZ /
Chat -- Pup User Telnet /]
	PSOUT
	HRROI A,VERNUM
	PSOUT
RSTART:	RESET			; Reset the world
	MOVE P,[XWD -NPDL,PDL-1]
	MOVE A,[PUSHJ P,UUO]
	MOVEM A,41
	MOVEI A,400000
	RPCAP			; Find out what we can do
	AND B,[1B0!1B2]
	IOR C,B
	EPCAP			; Enable control-c stealing
	TLNE C,(1B0)
	TROA F,NSTIWF
	TRZ F,NSTIWF
	SETZB F,VARS
	MOVE A,[XWD VARS,VARS+1]
	BLT A,EVARS-1		; Zero all variables, set BCPL params
	SETOM ABNLCK		; Unlock abnormal interrupt handler.
	SETOM UCASC
	SETOM UCASL
	SETOM LCASC
	SETOM LCASL
	SETOM UNSFT
	SETOM QUOT
	SETOM SYNC
	MOVSI B,-NCONN

ICNVL:	MOVE A,[BYTE (1)0,0,0,0,0,0,0,1,0,1,1,0,0,1]
	MOVEM A,ECHCOC(B)	; Initial control character local echo
	SETOM LFCRF(B)
	SETOM ELCLF(B)
	AOBJN B,ICNVL
	MOVEI A,CONTB
	MOVEM A,CONTAB		; Contab points at contb
	MOVEI A,IESC		; Setup initial escape character
	MOVEM A,ESCAPE
	PUSHJ P,CVINTC		; Convert character to interrup channel
	 HALT .			; Can't fail
	MOVEM A,ESCCOD
	MOVEI A,ICBF
	MOVEM A,CBFCHR
	PUSHJ P,CVINTC
	 HALT .
	MOVEM A,CBFCOD
	SETZM FSVCNX
	MOVEI A,400000
	CIS
	MOVE B,[XWD LEVTAB,CHNTAB]
	SIR
	EIR
	MOVEI A,100
	RFMOD			; Find out what kind of line we have
	MOVEM B,TTMOD0		; Remember same
	TRNE B,1B32		; Hdx terminal?
	 SETOM HDX		; Yes, set hdx flag
	TLNE B,(1B3)
	 SETOM TRMLWC		; Remember term has lower case
	ANDCMI B,77B23!3B25!17B29!1B30!1B31
	PUSH P,B
	IORI B,17B23!0B25!1B29
	MOVEM B,TTMODC		; In command mode: break-all, echo-none
	POP P,B
	IORI B,17B23!1B29
	MOVEM B,TTMODR		; No change for remote mode
	RFCOC			; Get standard control output control
	MOVEM B,TTCOC0
	MOVEM C,TTCOC1
	GJINF
	PUSH P,A		; Save login dir number
	HRROI A,HLPBUF		; Build name <login-dir>Chat.Commands
	MOVEI B,"<"
	BOUT
	POP P,B
	DIRST
	 0
	HRROI B,[ASCIZ />CHAT.COMMANDS/]
	SETZ C,
	SOUT
	MOVSI A,(1B2+1B17)	; Old file, short form
	HRROI B,HLPBUF
	GTJFN
	 JRST INIT1		; Not there
	MOVEM A,CMDJFN		; Ok, save jfn
	MOVE B,[7B5+1B19]	; Open for reading
	OPENF
	 PUSHJ P,[SETZ A,	; Can't, just release jfn and ignore
		EXCH A,CMDJFN
		JRST CLRJFN]
INIT1:	MOVE A,[JRST PCLP]	; set up restart adr
	MOVEM A,ENTVEC+1
PCLP:	MOVEI A,ESCCHN		; Psi channel
	HRL A,ESCCOD		; Escape terminal code
	ATI
	MOVEI A,CBFCHN
	HRL A,CBFCOD
	ATI			; Assign
	MOVE B,[1B<ESCCHN>!1B<ABNCHN>!1B<CBFCHN>!1B9!1B11!17B18]
	MOVEI A,400000
	AIC			; Activate interrupt channel

; Main command loop

COMLP:	TRO F,COMMDF
	TRZ F,TMPF3!ICPMOD
	MOVEI A,101
	DOBE
	MOVE P,[XWD -NPDL,PDL-1]
	MOVE NCNX,CNX
	SETO B,
	MOVEI A,-5
	TRNN F,NSTIWF
	STIW			; Restore terminal interrupt word
	MOVEI A,100
	MOVE B,TTMODC
	SKIPE NFANCY
	 JRST [	TRZ B,77B23
		TRO B,2B25!16B23
		JRST .+1]
	SFMOD			; Set tty mode for command input
	MOVE B,[BYTE (2)0,0,1,1,1,1,1,2,0,2,2,1,2,2,1,1,1,1]
	MOVE C,[BYTE (2)0,1,1,1,1,1,0,1,1,0,1,1,1,2]
	SFCOC
	HRROI A,[ASCIZ /
#/]
	PUSHJ P,.PSOUT		; Prompt character
	MOVE PTR,[POINT 7,COMBUF-1,34]
	MOVEM PTR,LPTR		; Pointer to beginning of line
	MOVEI A," "
	IDPB A,PTR		; Deposit initial space to line up
	MOVE TAB,COMTAB		; Setup to use comtab
	PUSHJ P,SYMVAL		; Call symbol evaluator
	SKIPE SNDJFN(CNX)	; Was connection created or
	TRNN F,REMOTF		; Remote mode?
	 JRST COMLP		; No. stay in command mode
	TRZ F,COMMDF
	MOVEM CNX,FSVCNX	; save CNX for later restoration
	HRROI A,[ASCIZ /#
/]
	PUSHJ P,.PSOUT
	MOVEI A,-5
	MOVN C,ESCCOD
	MOVSI B,400000
	ROT B,(C)		; Get bit for escape code
	PUSH P,B
	MOVN C,CBFCOD
	MOVSI B,400000
	ROT B,0(C)
	IORM B,0(P)
	POP P,B
	IORI B,1B30		; Include carrier off
	TRNN F,NSTIWF
	STIW			; And set tiw to that

REST0:	MOVEI A,100
	MOVE B,TTMODR
	SKIPE XPARNT(CNX)
	 TRZ B,3B29
	SFMOD			; Set tty mode for remote
	MOVE B,[BYTE (2)0,0,0,0,0,0,0,2,2,2,2,2,2,2,0,0,0,0]
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	SFCOC			; echo all formatter + bell in remote
	MOVEI A,101
	GTTYP
	SETZ C,
	CAIL B,12		; is terminal a scope?
	 JRST [ EXCH C,B
		STTYP		; yes, save & set to 33 for remote
		JRST .+1 ]
	MOVEM C,REALTT		; save terminal type or 0 if not scope
	MOVE A,RCVFRK(CNX)
	FFORK			; Freeze it
	MOVEI A,400000
	DIR			; Interrupts off to avoid confusion
	SETZM SAVSWT(CNX)	; Resume output
	MOVE A,RCVFRK(CNX)
	RFSTS			; Get pc of receive fork
	MOVE A,RCVFRK(CNX)
	HRRZS B
	CAIG B,RECV0		; If fork will get back to RECVO
	 JRST REST2		;  let it proceed
	CAIG B,RECVB
	 JRST REST1
	CAIL B,RCVBX
	CAILE B,RCVB1+1
	SKIPE RCVBSW(CNX)
	 JRST REST1
	JRST REST2
REST1:	MOVEI B,RECV0		; Else restart it at RECV0
	SFORK
REST2:	MOVE A,SNDFRK(CNX)	; if io wait and input file assigned,
	RFSTS
	MOVE A,SNDFRK(CNX)
	HRRZS B
	CAIN B,PBINX+1
	SKIPN ALTJFN(CNX)
	JRST REST3
	MOVEI B,.PBIN	; restart .PBIN to prevent input hang
	SFORK


REST3:	MOVEI A,400000
	EIR
	MOVE A,RCVFRK(CNX)
	RFORK			; And resume
	MOVE A,SNDFRK(CNX)
	RFORK			; Resume send fork
	SKIPE ACTVSW		; if not auto-switching, wait
	 JRST REST3A
	WFORK			; Should wait forever
	HRROI A,[ASCIZ /
Funny fork termination. Restarted./]
	PUSHJ P,.PSOUT
	JRST RSTART
REST3A:	TIME
	MOVEM A,RCVATM(CNX)	; advance new fork's active time to now
REST4:	MOVEI A,↑D15000
	DISMS			; here for auto-switching. wait 1 min..
	TIME
	SUB A,ACTVTM
	MOVE B,A
	CAML A,RCVATM(CNX)	; send and recv forks inactive for
	CAMGE B,SNDATM(CNX)	; more than time constant?
	 JRST REST4		; no, go back to sleep
	MOVSI X,-NCONN
REST5:	MOVE A,SNDJFN(X)	; yes, scan for an active connection
	JUMPE A,REST6
	SKIPLE SAVINC(X)
	 JRST REST7
REST6:	AOBJN X,REST5
	JRST REST4		; if none found keep current one & loop
REST7:	SETOM SAVSWT(CNX)
	MOVEI A,400000
	DIR
	MOVEI A,100		; active cnx found: turn off current cnx
	CFIBF
	MOVE A,SNDFRK(CNX)
	FFORK
	PUSHJ P,TBEL
	HRROI A,[ASCIZ /
Switching to connection /]
	PUSHJ P,.PSOUT
	HRRZ A,X
	IMULI A,3
	HRROI A,CONNAM(A)
	PUSHJ P,.PSOUT
	HRROI A,[ASCIZ /.
/]
	PUSHJ P,.PSOUT
	HRRZ CNX,X
	TRO F,REMOTF
	MOVEM CNX,FSVCNX	; and turn on active one
	JRST REST0


; Abnormal interrupts come here

BADINT:	MOVE CNX,FSVCNX
	MOVEI A,101
	DOBE
	TIME
	SUBI A,↑D15000
	CAMGE A,LSTBDI		; Within 5 seconds of last bad int?
	 JRST BADBAD		; Very bad
	HRROI A,[ASCIZ /
Abnormal interrupt from location /]
	PUSHJ P,.PSOUT
	HRRZ B,RETPC1
	MOVEI C,10
	MOVEI A,101
	PUSHJ P,.NOUT
	 JFCL
	HRROI A,[ASCIZ /.
/]
	PUSHJ P,.PSOUT
	TIME
	MOVEM A,LSTBDI
	JRST ESCINZ

BADBAD:	HALTF
	JRST BADINT

; If remote host initiates disconnect, rec'v fork inits int'rpt to here

ABNINT:	MOVE CNX,FSVCNX
	MOVE X,ABNCNX		; Get the correct cnx
	PUSHJ P,DISC1
	JRST ESCINZ

; Clear outbuf int comes here

CBFINT:	MOVE CNX,FSVCNX
	SKIPE A,SNDJFN(CNX)
	AOSE QUOTF
	 JRST CBFINZ
	PUSH P,B
	MOVEI B,SENDO
	JRST SPCSND


CBFINZ:	SETOM CLROBF
	PUSH P,A
	MOVEI A,101
	CFOBF
	POP P,A
	DEBRK
	DEBRK

; Escape interrupt comes to here

ESCINT:	AOSE QUOTF		; if quote prefix typed and
	 JRST ESCINV
	MOVE CNX,FSVCNX
	SKIPN A,SNDJFN(CNX)	; If connection exists,
	 JRST ESCINV
	PUSH P,B
	MOVEI B,SENDE
SPCSND:	PUSH P,A		; Then sent escape character
	MOVE A,SNDFRK(CNX)
	FFORK
	SFORK
	RFORK
	POP P,A
	POP P,B
	DEBRK

ESCINV:	MOVEI A,100
	CFIBF			; do this early for performance
	MOVEI A,101
	TRNE F,COMMDF		; command mode?
	 CFOBF			; yes, flush output
	JRST ESCINY
ESCINZ:	MOVEI A,100
	CFIBF
ESCINY:	SKIPE RLACJ		; Is there likely to be a jfn in ac 1?
	TDNE A,[XWD -1,700000]
	SKIPA			; Apparently not
	 PUSHJ P,CLRJFN		; Apparently yes
	SETZM RLACJ
	SKIPE A,SNDFRK(CNX)	; If there is a send fork
	 FFORK			; Freeze it
	SKIPN A,RECJFN(CNX)	; Connected?
	 JRST ESCINW		; No, skip this
	SETOM SAVSWT(CNX)	; Switch to saving input
	SKIPE A,RCVFRK(CNX)
	RFORK			; Leave running

ESCINW:	SKIPE A,SPCFRK		; If there is a special fork
	 KFORK			; Kill it
	SETZM SPCFRK
	SKIPE A,IJFN
	 PUSHJ P,CLRJFN
	SETZM IJFN		; Release temporary jfn's
	TRNE F,ICPMOD
	 PUSHJ P,RELCON		; release connections if ICP was in prog
	SKIPE B,REALTT		; scope terminal type saved?
	 JRST [ MOVEI A,101
		STTYP		; yes, restore type for command mode
		MOVEI A,100
		SIBE		; any type-ahead since cfibf?
		 JRST .+1	; yes, restored ok
		MOVEI B,40
		STI		; no, simulate char in to break
		PBIN		;  scroll hold, if any
		JRST .+1 ]
ESCI1:	SKIPE A,CMDJFN		; Is there an initial command file?
	 PUSHJ P,CLRJFN		; Yes, close it
	SETZM CMDJFN
	MOVE A,[XWD 10000,COMLP]
	MOVEM A,RETPC1
	DEBRK			; Debrk back to comlp

LEVTAB:	RETPC1
	RETPC2
	RETPC3

CHNTAB:	REPEAT ESCCHN,<XWD 1,BADINT>
	XWD 1,ESCINT
	XWD 1,BADINT
	XWD 1,ABNINT
	XWD 1,BADINT
	XWD 2,CBFINT
	REPEAT <↑D36-5-ESCCHN>,<XWD 1,BADINT>

FKLVT:	FKRET1
	FKRET2
	FKRET3

FKCHT:	0
	XWD 3,RCVINS
	0
	REPEAT ↑D7,<0>
	0
	XWD 1,IOERR
	REPEAT ↑D36-↑D12,<0>
	DEBRK

; Get a character

GCH:	PUSHJ P,.PBIN
	CAIE A,177
CPOPJ:	POPJ P,
	HRROI A,[ASCIZ /XXX/]
	PUSHJ P,.PSOUT
	JRST COMLP

; Echo character in a

ECHOIT:	SKIPE HDX
	 PUSHJ P,PBOUT0
	SKIPE HDX
	POPJ P,
	SKIPE NFANCY
	TRNN F,COMMDF
	PUSHJ P,.PBOUT
	POPJ P,

; Primary output with case indicate

.PEOUT:	PUSHJ P,PBOUT0
	CAIL A,100		; Does character have case?
	SKIPE TRMLWC		; Or does terminal have lower case?
	 JRST EOUTX1		; Caseless
	SKIPGE LCASL
	SKIPL LCASC
	SKIPA
	 JRST EOUTX1		; Don't indicate if shift chars absent
	SKIPGE UCASL
	SKIPL UCASC
	SKIPA
	 JRST EOUTX1
	CAIE A,177
	CAIN A,137
	 JRST EOUTX1
	PUSH P,B
	MOVE B,A
	ANDI B,40		; Extract case
	ANDCMI A,40		; Force upper
	CAMN B,TCASE		; Same as current case?
	 JRST EOUTX0		; No need to indicate
	PUSH P,A
	JUMPE B,IUPC		; Upper case
	SKIPG A,LCASL		; Do we have a lower case lock?
	 JRST LCS1		; No, try for lowercase char
	PBOUT			; Yes, print it
	MOVEM B,TCASE		; And remember new case
	JRST EOUTX


LCS1:	SKIPG A,LCASC		; Have we a lower case char prefix?
	 JRST EOUTX		; No, can't indicate
	PBOUT			; Yes, print it
	JRST EOUTX		; But don't change case

IUPC:	SKIPG A,UCASL		; Do we have a upper case lock
	 JRST UCS1
	PBOUT
	MOVEM B,TCASE
	JRST EOUTX

UCS1:	SKIPG A,UCASC
	 JRST EOUTX
	PBOUT
EOUTX:	POP P,A
EOUTX0:	POP P,B
EOUTX1:	CAME A,UCASC
	CAMN A,UCASL
	 JRST ESPCL
	CAME A,LCASC
	CAMN A,LCASL
	 JRST ESPCL
	CAMN A,QUOT
	 JRST ESPCL
	PBOUT
	POPJ P,

ESPCL:	PUSH P,A
	SKIPLE A,QUOT
	PBOUT
	POP P,A
	PBOUT
	POPJ P,


; Primary input

.PBIN:	PUSH P,B
PBIN1:	MOVEI A,100
	TRNE F,COMMDF
	 JRST PBIN0
	SKIPN ALTJFN(CNX)
	 JRST PBIN2
	MOVE A,ALTJFN(CNX)  ; if alt. file exists & in remote mode,
	SOSGE ALTJCT(CNX)   ; take input from file, else tty
	 JRST [ SETZ NOA,
		PUSHJ P,SETALT	; if ct shows eof, close & release
		JRST PBIN1 ]
	BIN
	MOVE A,B
	POP P,B
	POPJ P,
PBIN2:
PBIN0:	SKIPE A,CMDJFN		; Taking input from initial command file?
	 JRST PBIN4		; Yes
	MOVEI A,101
	RFMOD			; will echo be generated?
	TRNE B,3B33!3B25
	 JRST [	MOVEI B,PBOUT0
		EXCH B,0(P)
		JRST .+2]
PBIN3:	POP P,B
PBINX:	PBIN
	POPJ P,

; Get input from initial command file
PBIN4:	BIN
	JUMPE B,[GTSTS		; End of file?
		TLNN B,(1B8)
		 JRST PBIN4	; No, flush null
		PUSHJ P,CLRJFN	; Yes, close file
		SETZM CMDJFN
		JRST PBIN1]	; Get input by other means
	CAIE B,15		; Carriage return?
	 JRST PBIN5		; No
	BIN			; See if line feed follows
	CAIE B,12
	 BKJFN			; No, back up so it will be read
	  CAI
	MOVEI B,37		; Substitute eol for crlf
PBIN5:	MOVE A,B
	POP P,B
	TRNE F,COMMDF		; In command mode?
	 PUSHJ P,PBOUT0		; Yes, echo the char
	POPJ P,

; Primary output

.PBOUT:	PBOUT
PBOUT0:	SKIPN SCRJFN
	 POPJ P,
	PUSH P,B
	MOVE B,A
	MOVE A,SCRJFN
	CAIN B,37
	 JRST [ MOVEI B,15	; translate EOL to <CR><LF>
		BOUT
		MOVEI B,12
		BOUT
		MOVEI B,37
		JRST .+2 ]
	BOUT
	PUSHJ P,SCRUPD
	MOVE A,B
	POP P,B
	POPJ P,

.PLOUT:	PUSHJ P,.PBOUT
	CAIA
PLOUT0:	PUSHJ P,PBOUT0
PLOUT1:	SKIPN LGFJFN(CNX)
	 POPJ P,
PLOUT2:	PUSH P,A
	MOVE B,A
	MOVE A,LGFJFN(CNX)
	CAIN B,37
	 JRST [ MOVEI B,15
		BOUT
		MOVEI B,12
		BOUT
		MOVEI B,37
		JRST .+2 ]
	BOUT
	PUSHJ P,LGFUPD
	MOVE A,B
	POP P,B
	POPJ P,


.GTJFN:	MOVE B,[XWD 100,101]
GTJFN0:	SETOM RLACJ
	GTJFN
	 JRST [	SETZM RLACJ
		POPJ P,]
	MOVEM A,IJFN
	SETZM RLACJ
	PUSH P,C
	SETZ C,
	MOVE B,A
	SKIPE A,SCRJFN
	 JFNS
	POP P,C
	PUSHJ P,SCRUPD
	MOVE A,B
	JRST SKPRET

.NOUT:	NOUT
	 POPJ P,
	SKIPE A,SCRJFN
	NOUT
	 JFCL
	PUSHJ P,SCRUPD
	MOVEI A,101
	AOS (P)
	POPJ P,

.SOUT:	SKIPN A,SCRJFN
	 JRST .SOUT0
	PUSH P,B
	PUSH P,C
	SOUT
	PUSHJ P,SCRUPD
	POP P,C
	POP P,B
.SOUT0:	MOVEI A,101
	SOUT
	POPJ P,

.PSOUT:	SKIPE SCRJFN
	PUSH P,A
	PSOUT
	SKIPN SCRJFN
	 POPJ P,
	EXCH B,0(P)
	PUSH P,C
	MOVE A,SCRJFN
	SETZ C,
	SOUT
	PUSHJ P,SCRUPD
	MOVE A,B
	POP P,C
	POP P,B
	POPJ P,

; Uuo handler

UUO:	HRRO A,40
	PUSHJ P,ERROUT
	MOVEI A,400000
	CIS
	EIR
	JRST COMLP

ERROUT:	PUSH P,A
	MOVEI A,101
	DOBE
	POP P,A
	PUSHJ P,.PSOUT
	MOVEI A,↑D1000
	DISMS
	MOVEI A,100
	CFIBF
	POPJ P,

; Convert interrupt character to code

CVINTC:	CAIG A,33
	 JRST SKPRET
	CAIE A,177
	CAIN A,40
	 SKIPA
	POPJ P,
	CAIN A,40
	MOVEI A,↑D29
	CAIN A,177
	MOVEI A,↑D28
	JRST SKPRET


; type bell

TBEL:	PUSH P,A
	MOVEI A,7
	PBOUT
	POP P,A
	POPJ P,


; Map fork one to one with this fork through page 177
; Call:	A	; Fork handle
;	PUSHJ P,MAPFRK
; Returns
;	+1	; Always. transparent

MAPFRK:	PUSH P,C
	PUSH P,D
	PUSH P,B
	MOVSI D,-177
	MOVSI B,(A)
	MOVSI A,400000
	MOVSI C,160000
MAPFKL:	HRR A,D
	HRR B,D
	PMAP
	AOBJN D,MAPFKL
	HLRZ A,B
	POP P,B
	POP P,D
	POP P,C
	POPJ P,

INIFRK:	MOVEM NCNX,CNX+FAC
	MOVEI B,FAC
	SFACS
	MOVE B,[XWD FKLVT,FKCHT]
	CIS
	SIR
	EIR
	MOVSI B,(1B1!1B2!1B11)
	AIC
	POPJ P,

; Close and release jfn

CLRJFN:	PUSH P,A
	CLOSF
	 JFCL
	POP P,A
	RLJFN
	 JFCL
	POPJ P,

; Macro for generating commands

DEFINE	CC(STR,VAL)<
	POINT 7,[ASCIZ \STR\
		VAL]
>

; Top level commands

TOPC:	XWD -1,NULTAB
	CC(<;*%x>,<JRST DOCOMT>)
	CC(<describe>,<PUSHJ P,.DSCRB>)
	CC(<list.connections>,<PUSHJ P,LSTCON>)
	CC(<where.am.I>,<PUSHJ P,.WHERE>)
	CC(<wait.for.any.active.connection>,<PUSHJ P,WATRET>)
	CC(<retrieve.connection.under.name>,<PUSHJ P,RETCON>)
	CC(<name.current.connection.to.be>,<PUSHJ P,.STNAM>)
	CC(<!synch!>,<PUSHJ P,SNDSNC>)
	CC(<control>,<PUSHJ P,SNDCTL>)
	XWD -1,CODTB
	CC(<code>,<JRST [	MOVE TAB,CODTB
				JRST SYMVAL]>)
	CC(<exec>,<PUSHJ P,.EXEC>)
	CC(<ddt>,<JRST 770000>)
	CC(<reset>,<PUSHJ P,.RESET>)
	CC(<logout>,<PUSHJ P,.LGOUT>)
	CC(<quit>,<PUSHJ P,.QUIT>)
	CC(<run>,<PUSHJ P,.RUN>)
	CC(<help>,<PUSHJ P,.HELP>)
	CC(<clear.output.character=>,<PUSHJ P,SETCBF>)
	CC(<escape.character=>,<PUSHJ P,SETESC>)
	XWD -1,YNTB
	CC(<current.modes.are>,<PUSHJ P,PRCMD>)
	CC(<no>,<JRST [SETCA NOA,
			MOVE TAB,YNTB
			JRST SYMVAN]>)
	CC(<remote.mode>,<PUSHJ P,SETREM>)
	CC(<local.mode>,<TRZ F,REMOTF>)
	CC(<terminal.type.is>,<PUSHJ P,SETTRM>)
	CC(<echo.mode.is>,<PUSHJ P,.ECHO>)
	CC(<disconnect>,<PUSHJ P,.DISC>)
	CC(<connection.to>,<PUSHJ P,.CONN>)
	XWD -1,HOSTAB
COMTAB:	XWD TOPC-.,TOPC

YNT:	CC(<log.file.for.current.connection>,<PUSHJ P,SETLGF>)
	CC(<auto.switch.to.active.connection>,<PUSHJ P,ACTVST>)
	CC(<signal.waiting.output>,<MOVEM NOA,SWOFLG>)
	CC(<typescript.to.file>,<PUSHJ P,SETSCR>)
	CC(<take.input.stream.from.file>,<PUSHJ P,SETALT>)
	CC(<divert.output.stream.to.file>,<PUSHJ P,SETDIV>)
	CC(<fancy.command.interpret>,<SETCAM NOA,NFANCY>)
	CC(<verbose>,<SETCAM NOA,CONCSF>)
	CC(<concise>,<MOVEM NOA,CONCSF>)
	CC(<synch.character:>,<PUSHJ P,SETSNC>)
	CC(<quote.prefix:>,<PUSHJ P,SETQOT>)
	CC(<unshift.prefix:>,<PUSHJ P,SETUNS>)
	CC(<case.shift.prefix.for>,<PUSHJ P,SETSHF>)
	CC(<transparent.mode>,<MOVEM NOA,XPARNT(CNX)>)
	CC(<lower>,<MOVEM NOA,LOWERF(CNX)>)
	CC(<raise>,<MOVEM NOA,RAISEF(CNX)>)
	CC(<line.buffer>,<MOVEM NOA,LNBFF(CNX)>)
	CC(<character.mode>,<SETCAM NOA,LNBFF(CNX)>)
YNTB:	XWD YNT-.,YNT

; Null table
NTP:	CC(<>,<JFCL>)
NULTAB:	XWD NTP-.,NTP

; Table of character code specifiers

CDTB:	CC(<d%d*%d>,<PUSHJ P,SNDDCD>)
	CC(<h%h*%h>,<PUSHJ P,SNDHCD>)
	CC(<o%o*%o>,<PUSHJ P,SNDOCD>)
	CC(<%o*%o>,<PUSHJ P,SNDOCT>)
CODTB:	XWD CDTB-.,CDTB

; Command table for terminal modes

TRMT:	CC(<lowercase>,<PUSHJ P,SETLWR>)
	CC(<halfduplex>,<MOVEM NOA,HDX>)
	CC(<fullduplex>,<SETCAM NOA,HDX>)
	CC(<no>,<JRST [	SETCA NOA,
			JRST SYMVAN]>)
TRMTAB:	XWD TRMT-.,TRMT

; Command table for echo modes

ETP:	CC(<local>,<JRST [	MOVEM NOA,ELCLF(CNX)
				JRST CHGECH]>)
	CC(<remote>,<JRST [	SETCAM NOA,ELCLF(CNX)
				JRST CHGECH]>)
	CC(<linefeed.for.carriage.return>,<MOVEM NOA,LFCRF(CNX)>)
	CC(<control.character.echo.for>,<PUSHJ P,SETCOC>)
	CC(<no>,<JRST [SETCA NOA,
			JRST SYMVAN]>)
ECTAB:	XWD ETP-.,ETP

; Command table for socket lookup

STP:	CC(<name.for.connection.is>,<PUSHJ P,.STNAM>)
	XWD -1,SETTAB
	XWD -1,NULTAB
SKTTAB:	XWD STP-.,STP

STB:	CC(<no>,<JRST [	SETCA NOA,
			MOVE TAB,SETTAB
			JRST SYMVAN]>)
	CC(<wait>,<MOVEM NOA,WATFLG>)
SETTAB:	XWD STB-.,STB

; Pup host names -- these go into the main command table.
; I would do something better if I really understood how this
; all worked!

HTP:	CC(<XEOS>,<PUSHJ P,CONMAX>)
	CC(<WRC>,<PUSHJ P,CONMAX>)
	CC(<Wind>,<PUSHJ P,CONMAX>)
	CC(<Sun>,<PUSHJ P,CONMAX>)
	CC(<Rain>,<PUSHJ P,CONMAX>)
	CC(<Phylum>,<PUSHJ P,CONMAX>)
	CC(<Oly>,<PUSHJ P,CONMAX>)
	CC(<Maxc2>,<PUSHJ P,CONMAX>)
	CC(<Maxc>,<PUSHJ P,CONMAX>)
	CC(<Juniper>,<PUSHJ P,CONMAX>)
	CC(<Ivy>,<PUSHJ P,CONMAX>)
	CC(<Isis>,<PUSHJ P,CONMAX>)
	CC(<Iris>,<PUSHJ P,CONMAX>)
	CC(<Indigo>,<PUSHJ P,CONMAX>)
	CC(<Igor>,<PUSHJ P,CONMAX>)
	CC(<Idun>,<PUSHJ P,CONMAX>)
	CC(<Ibis>,<PUSHJ P,CONMAX>)
	CC(<Ernestine>,<PUSHJ P,CONMAX>)
	CC(<Erie>,<PUSHJ P,CONMAX>)
	CC(<DLS>,<PUSHJ P,CONMAX>)
	CC(<Cherry>,<PUSHJ P,CONMAX>)
	CC(<Cactus>,<PUSHJ P,CONMAX>)
	CC(<ADL>,<PUSHJ P,CONMAX>)
HOSTAB:	XWD HTP-.,HTP

; "Any character" table - used to collect arbitrary strings
; (like host names)

ANYT:	CC(<%x*%x>,<JFCL>)
ANYTAB:	XWD ANYT-.,ANYT

; Octal number table

OCT:	CC(<%o*%o>,<PUSHJ P,CVOCT>)
OCTB:	XWD OCT-.,OCT

; Decimal number table

DCM:	CC(<%d*%d>,<PUSHJ P,CVDEC>)
DCMTB:	XWD DCM-.,DCM

; Letter table

LTR:	CC(<%a>,<ILDB A,BPTR>)
LTRTB:	XWD LTR-.,LTR

; Connection name table

NAMT:	CC(<%n*%n>,<SETO A,>)
NAMTB:	XWD -2,[XWD NAMT-.,NAMT
		XWD -1,CONTAB]

; Case shift command table

SFTAB:	CC(<lock.upper.case>,<MOVEI A,UCASL>)
	CC(<char.upper.case>,<MOVEI A,UCASC>)
	CC(<lock.lower.case>,<MOVEI A,LCASL>)
	CC(<char.lower.case>,<MOVEI A,LCASC>)
SFTB:	XWD SFTAB-.,SFTAB


; table of identifiers for describe command

DSCRT:	CC(<comments>,<JFCL>)
	CC(<list.connections>,<JFCL>)
	CC(<signal.waiting.output>,<JFCL>)
	CC(<where.am.i>,<JFCL>)
	CC(<auto.switch.to.active.connection>,<JFCL>)
	CC(<wait.for.any.active.connection>,<JFCL>)
	CC(<retrieve.connection.under.name>,<JFCL>)
	CC(<!synch!>,<JFCL>)
	CC(<code>,<JFCL>)
	CC(<exec>,<JFCL>)
	CC(<ddt>,<JFCL>)
	CC(<reset>,<JFCL>)
	CC(<logout>,<JFCL>)
	CC(<quit>,<JFCL>)
	CC(<run>,<JFCL>)
	CC(<describe>,<JFCL>)
	CC(<help>,<JFCL>)
	CC(<clear.output.character=>,<JFCL>)
	CC(<escape.character=>,<JFCL>)
	CC(<log.file.for.current.connection>,<JFCL>)
	CC(<typescript.to.file>,<JFCL>)
	CC(<take.input.stream.from.file>,<JFCL>)
	CC(<divert.output.stream.to.file>,<JFCL>)
	CC(<fancy.command.interpret>,<JFCL>)
	CC(<verbose>,<JFCL>)
	CC(<concise>,<JFCL>)
	CC(<synch.character>,<JFCL>)
	CC(<quote.prefix>,<JFCL>)
	CC(<unshift.prefix>,<JFCL>)
	CC(<case.shift.prefix.for>,<JFCL>)
	CC(<transparent.mode>,<JFCL>)
	CC(<lower>,<JFCL>)
	CC(<raise>,<JFCL>)
	CC(<line.buffer>,<JFCL>)
	CC(<character.mode>,<JFCL>)
	CC(<current.modes.are>,<JFCL>)
	CC(<no>,<JFCL>)
	CC(<remote.mode>,<JFCL>)
	CC(<local.mode>,<JFCL>)
	CC(<terminal.type.is>,<JFCL>)
	CC(<echo.mode.is>,<JFCL>)


	CC(<disconnect>,<JFCL>)
	CC(<connection.to>,<JFCL>)
	CC(<log-file>,<JFCL>)
	CC(<initial-command-file>,<JFCL>)
	CC(<input-from-a-file>,<JFCL>)
	CC(<diverting-output>,<JFCL>)
	CC(<typescript-file>,<JFCL>)
	CC(<multiple-connections>,<JFCL>)
	CC(<leaving-chat>,<JFCL>)
	CC(<special-characters>,<JFCL>)
	CC(<status-commands>,<JFCL>)
	CC(<line-buffering>,<JFCL>)
	CC(<echo-control>,<JFCL>)
	CC(<disconnecting>,<JFCL>)
	CC(<making-a-connection>,<JFCL>)
	CC(<escaping>,<JFCL>)
	CC(<command/remote-mode>,<JFCL>)
	CC(<command-interpreter>,<JFCL>)
	CC(<chat>,<JFCL>)
DSCRTB:	XWD DSCRT-.,DSCRT


; Symbol evaluator

SYMVAL:	SETO NOA,
SYMVAN:	MOVEM PTR,BPTR		; Save beginning of symbol
SYMLUP:	PUSHJ P,GCH		; Get a character
	CAIE A,"A"-100		; Control-a
	CAIN A,"H"-100		; Or control-h
	 JRST DELCH		; Delete character
	CAIN A,"R"-100
	 JRST RETYPE		; Control-r, retype line
	CAIN A,"W"-100		; Control-w
	 JRST DELWRD		; Delete word
	CAIN A,"?"		; Question mark
	 JRST PRQUES		; Print options
	CAIE A,33		; Altmode or
	CAIN A,37		; Eol
	 JRST SYMEND		; Lookup
	CAIE A,","		; Comma
	CAIN A," "		; Or space same thing
	 JRST SYMEND
	IDPB A,PTR		; Else deposit into string
	PUSHJ P,TRMST
	SKIPE NFANCY
	 JRST SYMLPE
	SETZ X,			; Clear x
	MOVEM P,SVP		; Save p
	MOVE Y,TAB		; Init y
	PUSHJ P,SYMLUK		; Lookup the current symbol
	MOVE P,SVP		; Restore p
	JUMPE X,[DPB X,PTR	; Smash null onto last character
		MOVE A,PTR
		BKJFN		; Back up pointer
		 0
		MOVEM A,PTR
		JRST DING]	; And echo bell
SYMLPE:	LDB A,PTR		; Symbol still ok, get char
	PUSHJ P,ECHOIT
	JRST SYMLUP		; And loop

DELCH:	CAMN PTR,BPTR		; Delete character, any to delete?
	 JRST DING		; No, echo bell
	MOVEI A,"\"
	PUSHJ P,.PBOUT
	LDB A,PTR
	PUSHJ P,.PBOUT
	MOVE A,PTR
	BKJFN
	 0
	MOVEM A,PTR
	JRST SYMLUP

TRMST:	PUSH P,A
	PUSH P,PTR
	SETZ A,
	IDPB A,PTR
	POP P,PTR
	POP P,A
	POPJ P,

DING:	MOVEI A,7
	PUSHJ P,.PBOUT
	JRST SYMLUP

DELWRD:	CAMN PTR,BPTR		; Delete word
	 JRST DING		; Nothing
	MOVEI A,"#"
	PUSHJ P,.PBOUT
	PUSHJ P,.PBOUT
DELW0:	MOVE PTR,BPTR
	JRST SYMLUP

RETYPE:	MOVE A,PTR
	MOVEI B,0
	IDPB B,A
	MOVEI A,15
	PUSHJ P,.PBOUT
	MOVEI A,12
	PUSHJ P,.PBOUT
	MOVE A,LPTR
	PUSHJ P,.PSOUT
	JRST SYMLUP

; End of symbol, try lookup

SYMEND:	MOVEM A,TERM		; Save terminator
	PUSHJ P,TRMST
	SETZ X,
	MOVE Y,TAB
	PUSHJ P,SYMLUK
	JUMPE X,[HRROI A,[ASCIZ / ? /]
		PUSHJ P,ERROUT
		MOVE A,TERM
		CAIE A,37
		 JRST DELW0
		JRST COMLP]
	CAIE X,1		; Exactly one symbol
	 JRST SYMAMB		; No. ambiguous
	POP P,C			; Leave pointer to head in c
	POP P,B			; Get pointer to tail of command
SYMCLP:	ILDB A,B		; Copy to terminal
	JUMPE A,SYMECL
	MOVE D,TERM
	SKIPE HDX
	 JRST NCOMP
	SKIPN NFANCY
	SKIPE CONCSF
NCOMP:	CAIN D,33
	 PUSHJ P,.PBOUT
	IDPB A,PTR
	JRST SYMCLP

SYMECL:	MOVEI A,40
	MOVE D,TERM
	CAIN D,33
	 JRST [	PUSHJ P,.PBOUT
		JRST .+4]
	CAIE D,37
	MOVE A,D
	PUSHJ P,ECHOIT
	IDPB A,PTR
	PUSHJ P,TRMST
	TRZ F,TMPF3!TMPF4!TMPF5
	XCT 1(B)		; Execute "value"
	POPJ P,			; And return
	XCT 2(B)		; If first value skips, execute 2nd
	POPJ P,

SYMAMB:	JUMPE X,DING		; Nothing left, go ding
	POP P,C			; Leave pointer to head in c
	POP P,B			; Get pointer to tail
	ILDB A,B		; Get first ch of tail
	JUMPN A,[SOJA X,SYMAMB]	; If not null, then loop
SYMAML:	SOJLE X,SYMECL		; Else unique
	SUB P,[XWD 2,2]		; Flush the junk
	JRST SYMAML


PRQUES:	PUSHJ P,ECHOIT
	PUSHJ P,TRMST
	SETZ X,
	MOVE Y,TAB
	TRZ F,TMPF5
	TRO F,TMPF6
	PUSHJ P,SYMLUK		; Get all the possibilities
PRQUEL:	JUMPE X,RETYPE		; All done, retype the line
	MOVEI A,37
	PUSHJ P,.PBOUT		; Eol
	TRZ F,TMPF!TMPF2!TMPF4
PRQUEN:	ILDB A,0(P)
	JUMPE A,PRQUEE
PRQUEB:	CAIN A,"*"
	 JRST [	TRNE F,TMPF3	; reassurance if in "not" mode
		TRNE F,TMPF5!TMPF6
		CAIA
		 JRST [	PUSH P,A
			HRROI A,[ASCIZ /[but otherwise] /]
			PUSHJ P,.PSOUT
			TRO F,TMPF5
			POP P,A
			JRST PRQUEB]
		HRROI A,[ASCIZ /<any number of /]
		PUSHJ P,.PSOUT
		TRO F,TMPF!TMPF4
		JRST PRQUEN]
	CAIN A,"%"
	 JRST [ TRNE F,TMPF3
		TRNE F,TMPF5!TMPF6
		CAIA
		 JRST [	PUSH P,A
			HRROI A,[ASCIZ /[but otherwise] /]
			PUSHJ P,.PSOUT
			TRO F,TMPF5
			POP P,A
			JRST PRQUEB]
		ILDB A,0(P)
		MOVE C,0(P)		; look ahead to detect possible
		PUSHJ P,[ ILDB B,C	;  "any number of same"
			CAIE B,"*"
			 POPJ P,
			ILDB B,C	; consisting of *%<char in A>..
			CAIE B,"%"
			 POPJ P,
			ILDB B,C
			CAMN B,A
			 AOS 0(P)	; skip if we have one
			POPJ P, ]


		CAIA		; do we have one?
		 JRST [ HRROI A,[ASCIZ /<string of /]
			PUSHJ P,.PSOUT	; yes, eliminate redundant
			IBP 0(P)	;  description of char class
			TRO F,TMPF!TMPF4
			JRST PRQUEN ]
		SETZ B,
		CAIN A,"D"+40
		 HRROI B,[ASCIZ /decimal digit/]
		CAIN A,"O"+40
		 HRROI B,[ASCIZ /octal digit/]
		CAIN A,"H"+40
		 HRROI B,[ASCIZ /hexadecimal digit/]
		CAIN A,"A"+40
		 HRROI B,[ASCIZ /alphabetic character/]
		CAIN A,"N"+40
		 HRROI B,[ASCIZ /alphameric character/]
		CAIN A,"S"+40
		 HRROI B,[ASCIZ /separator/]
		CAIN A,"P"+40
		 HRROI B,[ASCIZ /punctuation mark/]
		CAIN A,"X"+40
		 HRROI B,[ASCIZ /any character/]
		MOVEI A,"<"
		TRNN F,TMPF
		 PUSHJ P,.PBOUT
		MOVE A,B
		PUSHJ P,.PSOUT
		TRO F,TMPF2!TMPF4
		JRST PRQUEQ ]
	TRNN F,TMPF4
	TRNN F,TMPF3
	CAIA
	 JRST [	PUSH P,A
		HRROI A,[ASCIZ /[not] /]
		PUSHJ P,.PSOUT
		TRO F,TMPF4
		TRZ F,TMPF6
		POP P,A
		JRST .+1]
	PUSHJ P,.PBOUT
PRQUEQ:	TRNN F,TMPF!TMPF2
	 JRST PRQUEN
	HRROI A,[ASCIZ /'s>/]
	TRZE F,TMPF2
	 HRROI A,[ASCIZ /s>/]
	TRZN F,TMPF
	 HRROI A,[ASCIZ />/]
	PUSHJ P,.PSOUT
	JRST PRQUEN

PRQUEE:	SUB P,[XWD 2,2]		; Flush pointer to end
	SOJA X,PRQUEL		; And loop

; Lookup symbol
; Operates recursively and accumulates a list of things on the stack

SYMLUK:	PUSH P,SVP		; Save old bottom
	MOVEM P,SVP		; Svp points to chain of svp
	TLNE Y,7000		; Byte pointer in y?
	 JRST SYMLK1		; No aobjn word
	PUSH P,Y		; Yes, sve y
	MOVE D,BPTR		; Get pointer to symbol
SYMLKL:	ILDB A,D		; Get character from input
	ILDB B,Y		; And from table entry
	PUSHJ P,SYMCMP		; Compare the characters
	 JRST SYMNEQ		; Not equal
	JUMPN A,SYMLKL		; Continue until null
SYMEQL:	MOVE A,Y
	BKJFN			; Back up pointer to tail
	 JRST [ CAIE A,600150	; dont bomb out if empty list--
		0		; (non-neg. AOBJN ptr)
		JRST SYMNEX ]
	MOVEM A,Y
	EXCH Y,-2(P)		; Pointer to tail to stack, get ret
	POP P,A			; Pointer to head
	POP P,SVP		; Restore svp
	PUSH P,A		; Pointer to head back to stack
	AOJA X,0(Y)		; Return and count items

SYMNEQ:	JUMPE A,SYMEQL		; If input ends first, then substring
SYMNEX:	SUB P,[XWD 1,1]		; Else flush saved y
	POP P,SVP		; Restore svp
	POPJ P,			; And return

SYMLK1:	PUSH P,Z		; Save z
	MOVE Z,Y		; Use as place to count y
SYMLK3:	MOVE Y,0(Z)		; Loop to here for each item
	PUSHJ P,SYMLUK		; Do this item
	AOBJN Z,SYMLK3		; Loop over all things
	MOVE A,P		; Get p
	SUB A,[XWD 1,1]
	CAMN A,SVP		; Any items saved on stack?
	 JRST SYMLK4		; No, shuffle not needed
	MOVE A,SVP		; Get base of stack
	MOVE Z,1(A)		; Restore z
	POP A,SVP		; Restore svp
	MOVE Y,0(A)		; Get return
	MOVEI B,0(A)		; Where to blt to
	HRLI B,3(A)		; And where from
	BLT B,-3(P)		; Copy stack down
	SUB P,[XWD 3,3]
	JRST 0(Y)		; Return

SYMLK4:	POP P,Z
	POP P,SVP
	POPJ P,

SYMCMP:	CAIN B,"*"		; Asterisk
	 JRST SYMMNY		; Means any number of
	CAIN B,"%"		; Percent
	 JRST SYMCLS		; Means character class
	CAIN B,"#"		; Pound sign
	 JRST SYMNCL		; Means not character class
SYMCM2:	PUSH P,B
	PUSH P,A
	XOR A,B
	TRZ B,40		; Ignore case of b
	CAIL B,"A"		; Then if b has
	CAILE B,"Z"		;  a letter
	SKIPA
	 TRZ A,40		; Then ignore case of difference
	SKIPN A
	AOS -2(P)
	POP P,A
	POP P,B
	POPJ P,

SYMMNY:	PUSH P,Y		; Save where we are in table entry
	ILDB B,Y		; Get what we are doing many of
	PUSHJ P,SYMCMP		; Check match
	 JRST SYMMNN		; Not equal
	ILDB B,Y		; See if next is also equal
	PUSHJ P,SYMCMP
	 JRST [	EXCH A,0(P)	; Not equal, get back y, save a
		BKJFN
		 0
		MOVEM A,Y
		POP P,A
		JRST SKPRET]
	SUB P,[XWD 1,1]		; Matches next thing, use it instead
SKPRET:	AOS(P)
	POPJ P,

SYMMNN:	SUB P,[XWD 1,1]		; Go to next thiing
	ILDB B,Y
	JRST SYMCMP

SYMCLS:ILDB B,Y		; Get class indicator
	CAIN B,"%"		; %% means %
	 JRST SYMCM2
	CAIN B,"d"		; d means decimal digit
	 JRST SYMDEC
	CAIN B,"o"		; o means octal digit
	 JRST SYMOCT
	CAIN B,"h"
	 JRST SYMHEX
	CAIN B,"a"		; a means alphabetic
	 JRST SYMALP
	CAIN B,"n"		; n means alphameric
	 JRST SYMALM
	CAIN B,"s"		; s means separator
	 JRST SYMSEP
	CAIN B,"p"		; p for punctuation
	 JRST SYMPNC
	CAIN B,"x"
	 JRST SYMANY
	POPJ P,			; Else fail

SYMNCL:	PUSHJ P,SYMCLS
	 AOS (P)
	POPJ P,

SYMANY:	AOS (P)
	POPJ P,

SYMDEC:	CAIG A,"9"
	CAIGE A,"0"
	 POPJ P,
	JRST SKPRET

SYMOCT:	CAIG A,"7"
	CAIGE A,"0"
	 POPJ P,
	JRST SKPRET

SYMHEX:	CAIG A,"9"
	CAIGE A,"0"
	 JRST SYMHE1
	JRST SKPRET

SYMHE1:	TRZ A,40
	CAIG A,"F"
	CAIGE A,"A"
	 POPJ P,
	JRST SKPRET

SYMALM:	PUSHJ P,SYMDEC
	 JRST SYMALP
	JRST SKPRET

SYMALP:	TRZ A,40
	CAIG A,"Z"
	CAIGE A,"A"
	 POPJ P,
	JRST SKPRET

SYMSEP:SYMPNC:POPJ P,

; Host-name command

CONMAX:	MOVE A,C		; Pointer to host name
	JRST CONNX		; Enter "Connect"


; Connect.to

.CONN:	MOVE TAB,ANYTAB		; Collect arbitrary string
	PUSHJ P,SYMVAL
	MOVE A,BPTR		; Save pointer to it
CONNX:	MOVEM A,FHST
	MOVE B,[1B0+2B17+C]	; See if legal name expression
	PUPNM
	 JRST [	HRROI A,[ASCIZ / ? /]
		PUSHJ P,ERROUT
		MOVE A,TERM
		CAIE A,37
		 JRST .CONN
		JRST COMLP]
	TLNE C,-1		; Net and host specified?
	TRNN C,-1
	 JRST [	HRROI A,[ASCIZ / Insufficient address expression./]
		PUSHJ P,ERROUT
		JRST COMLP]
	MOVEM D,FSKT
	MOVSI X,-NCONN
CONNX2:	SKIPE A,SNDJFN(X)	; Find an empty connection
	 AOBJN X,CONNX2
	JUMPGE X,[ERROR [ASCIZ /too many connections./]]
	HRRZS NCNX,X
	MOVE A,NCNX
	IMULI A,3
	ADDI A,CONNAM
	HRLI A,440700
	MOVEI B,1(X)
	MOVEI C,010
	NOUT
	 JFCL
	IBP A
	HRLI X,(<MOVEI A,0>)
	MOVEM X,1(A)
	PUSHJ P,DEFSKT

CONN2:	HRROI A,[ASCIZ /is /]
	PUSHJ P,.PSOUT
	TRO F,ICPMOD		; set "ICP in progress"
	PUSHJ P,ASNSKT
	PUSHJ P,DOICP		; Do icp
	 JRST [	SKIPN WATFLG	; Failed. wait?
		 JRST [ TRZ F,ICPMOD  ; No
			POPJ P, ]
		HRROI A,[ASCIZ /  First attempt failed,
trying again ... /]
		SKIPG WATFLG
		PUSHJ P,.PSOUT
		SKIPLE WATFLG
		 PUSHJ P,TBEL
		MOVMS WATFLG
		MOVEI A,↑D10000
		DISMS
		JRST .-2]
	MOVEI A,7
	MOVEI B,20
	SKIPLE WATFLG
	PUSHJ P,.PBOUT
	SOJG B,.-2
	MOVEI A,400000
	DIR
	HRROI A,[ASCIZ /complete/]
	PUSHJ P,.PSOUT
	TRZ F,ICPMOD
	SKIPE A,SNDFRK(NCNX)
	 JRST CONN3
	MOVSI A,(1B1)
	CFORK
	 JRST [	JSP X,CONFL0
		ASCIZ /can't create send fork./]
	MOVEM A,SNDFRK(NCNX)
	PUSHJ P,MAPFRK

CONN3:	PUSHJ P,INIFRK
	SKIPE A,RCVFRK(NCNX)
	 JRST CONN4
	MOVSI A,(1B1)
	CFORK
	 JRST [	JSP X,CONFL1
		ASCIZ /can't create receive fork./]
	MOVEM A,RCVFRK(NCNX)
	PUSHJ P,MAPFRK
CONN4:	PUSHJ P,INIFRK
	MOVE CNX,NCNX
	HLRE A,CONTAB
	MOVNS A
	ADD A,CONTAB
	HRRZ B,CNX
	IMULI B,3
	ADDI B,CONNAM
	HRLI B,440700
	MOVEM B,(A)
	MOVSI B,-1
	ADDM B,CONTAB
	MOVN A,LSKT(CNX)
	ASH A,-1
	MOVSI B,(1B0)
	ROT B,(A)
	IORM B,SKTMSK
	SETZM SAVSWT(CNX)
	MOVEI B,SEND
	MOVE A,SNDFRK(CNX)
	FFORK
	SFORK
	MOVE A,RCVFRK(CNX)
	MOVEI B,RECV
	FFORK
	SFORK
	TRO F,REMOTF
	MOVEM CNX,FSVCNX	; change save loc to reflect new CNX
	MOVEI A,"."
	PUSHJ P,.PBOUT
	MOVEI A,400000
	EIR
	POPJ P,

CONFL1:CONFL0:	HRROI A,[ASCIZ /,
 but /]
	PUSHJ P,.PSOUT
	PUSHJ P,RELCON
CONFLX:	PUSHJ P,.PSOUT
	POPJ P,

; Assign local socket for connection

ASNSKT:	SETCM A,SKTMSK
	PUSH P,B
	JFFO A,ASNSK1
	MOVEI B,177
ASNSK1:	MOVE A,B
	POP P,B
	LSH A,1
	POPJ P,

; Get foreign socket number or return default socket

DEFSKT:	SETZM WATFLG
	SETOM LODFLG
DEFSK0:	MOVE A,TERM
	CAIN A,37
	 POPJ P,
	MOVE TAB,SKTTAB
	PUSHJ P,SYMVAL		; Look for qualifiers
	JRST DEFSK0


; Perform icp

DOICP:	MOVEM A,LSKT(NCNX)	; Remember local socket
	HRROI A,HLPBUF		; Build complete name here
	HRROI B,[ASCIZ /PUP:/]
	SETZ C,
	SOUT
	MOVE B,LSKT(NCNX)
	MOVEI C,10
	NOUT
	 0
	HRROI B,[ASCIZ /!J./]
	SETZ C,
	SOUT
	MOVE B,FHST		; Foreign host name
	SOUT
	LDB B,A			; See if command scanner put space on end
	CAIN B,40
	 BKJFN			; Yes, back up over it
	  CAI
	HRROI B,[ASCIZ /+Telnet/]
	SKIPG FSKT		; Foreign socket specified?
	 SOUT			; No, default
	MOVSI A,(1B2+1B17)	; Short form, name from string
	HRROI B,HLPBUF
	GTJFN			; Get a JFN for the port
	 JRST OPNCO7
	MOVEM A,SNDJFN(NCNX)	; Ok, save output JFN
	MOVE B,[8B5+8B17+1B20]	; Bytesize 8, 30-second timeout
	OPENF			; Initiate rendezvous
	 JRST OPNCO4		; Failed

; Now make name string and open same port for input
	MOVE C,[2,,C]		; Get foreign port address
	GDSTS
	PUSH P,D		; Save it
	PUSH P,C
	CVSKT			; Get local port address
	 0
	PUSH P,C
	HRROI A,HLPBUF		; Where to build name
	HRROI B,[ASCIZ /PUP:/]
	SETZ C,
	SOUT
	POP P,B
	MOVEI C,10
	NOUT
	 0
	HRROI B,[ASCIZ /!A./]
	SETZ C,
	SOUT
	HLRZ B,0(P)		; Recover net
	MOVEI C,10
	NOUT
	 0
	MOVEI B,"#"
	BOUT
	POP P,B			; Host
	HRRZS B
	NOUT
	 0
	MOVEI B,"#"
	BOUT
	POP P,B			; Socket
	NOUT
	 0
	MOVSI A,(1B2+1B17)	; Short form, name from string
	HRROI B,HLPBUF
	GTJFN			; Get a JFN for the port
	 JRST OPNCO6		; Failed (unlikely)
	MOVEM A,RECJFN(NCNX)	; Ok, save input JFN
	MOVE B,[8B5+1B19]	; Bytesize 8, open for input
	OPENF
	 JRST OPNCO5		; Failed (unlikely)
	JRST SKPRET		; Return +2

; Failure from first OPENF
OPNCO4:	HRLM A,0(P)		; Save error code
	MOVE A,SNDJFN(NCNX)	; Recover JFN
	RLJFN			; Release it
	 0
	HLRZ A,0(P)		; Recover error code
	JRST OPNCO7

; Failure from second OPENF
OPNCO5:	HRLM A,0(P)		; Save error code
	HRRZ A,RECJFN(NCNX)	; Release the input JFN
	RLJFN
	 0
	HLRZ A,0(P)		; Recover error code

; Failure from second GTJFN
OPNCO6:	HRLM A,0(P)
	HRRZ A,SNDJFN(NCNX)	; Get output JFN
	MOVEI B,25		; Abort function
	SETZ C,			; No code assigned
	HRROI D,[ASCIZ /Connection attempt aborted/]  ; Abort text
	MTOPR			; Abort the connection
	CLOSF			; Close the port
	 0			; Can't fail after abort done
	HLRZ A,0(P)
OPNCO7:	SETZM RECJFN(NCNX)
	SETZM SNDJFN(NCNX)
	SKIPLE WATFLG
	 POPJ P,		; No message on repeat failures
	HRROI B,[ASCIZ /of unknown problem./]
	CAIN A,OPNX20		; Check for special cases
	 HRROI B,[ASCIZ /connection attempt timed out./]
	CAIN A,OPNX21
	 HRROI B,[ASCIZ /connection attempt rejected by remote host./]
	HRROI A,[ASCIZ /incomplete,
because /]
	PSOUT
	MOVE A,B
	PSOUT
	POPJ P,			; Take fail return


RELCON:	MOVEI A,400000
	DIR
	MOVE X,NCNX
	PUSHJ P,DSCNCT
	MOVEI A,400000
	EIR
	POPJ P,

DSCNCT:	MOVE A,SNDJFN(X)	; Disconnect current conx
	CLOSF
	 JRST [	MOVE A,SNDJFN(X)
		CLOSF
		 CAI
		JRST .+1]
	MOVE A,RECJFN(X)
	CLOSF
	 CAI
	MOVE A,SNDJFN(X)
	RLJFN
	 CAI
	MOVE A,RECJFN(X)
	RLJFN
	 CAI
	SETZM SNDJFN(X)
	SETZM RECJFN(X)
	POPJ P,

; Disconnect

.DISC:	MOVE A,TERM
	MOVE X,CNX
	CAIN A,37
	 JRST DISC1
	SKIPL TAB,CONTAB
	 POPJ P,
	PUSHJ P,SYMVAL
	MOVE X,A
DISC1:	MOVEI A,400000
	DIR
	CAMN X,CNX
	 TRZ F,REMOTF
	MOVE A,ABNCNX		; Might be abncnx
	SETOM ABNCNX		; Clear it
	CAMN X,A		; And if it was
	 SETOM ABNLCK		; Unlock abnlck
	MOVEI A,0
	EXCH A,ALTJFN(X)	; flush file input if any
	SKIPLE A
	 PUSHJ P,CLRJFN
	SKIPN A,RECJFN(X)
	 POPJ P,		; No connection
	MOVE A,RCVFRK(X)
	FFORK
	SETZ NOA,
	EXCH X,CNX
	PUSHJ P,SETLGF
	EXCH X,CNX
	PUSHJ P,DSCNCT		; break connection
	MOVN A,LSKT(X)
	ASH A,-1
	MOVSI B,(1B0)
	ROT B,(A)
	ANDCAM B,SKTMSK
	IMULI X,3		; Compute pointer to this name
	ADDI X,CONNAM
	HRLI X,440700
	MOVE Y,CONTAB
	CAME X,0(Y)		; Search for entry in contb
	 AOBJN Y,.-1
	MOVE A,1(Y)		; Move entries above here, down to
	MOVEM A,0(Y)		;  fill in the gap
	AOBJN Y,.-2
	MOVSI X,1
	ADDM X,CONTAB		; One less entry in contb
	MOVEI A,400000
	EIR
	POPJ P,


; Set name for connection

.STNAM:	MOVE TAB,NAMTB
	TRO F,TMPF3
	PUSHJ P,SYMVAL
	JUMPGE A,NAMINU
	HRRZ A,NCNX
	IMULI A,3
	ADDI A,CONNAM
	HRLI A,440700
	MOVE B,BPTR
	MOVEI C,↑D8
	LDB D,PTR		; Get terminator
	SOUT			; Copy through it
	SETZ B,
	DPB B,A			; Replace terminator with null
	MOVE B,NCNX
	HRLI B,(<MOVEI A,>)
	MOVEM B,1(A)
	POPJ P,

NAMINU:	ERROR [ASCIZ /name already in use/]

; Set auto switching to active connection feature

ACTVST:	JUMPE NOA,[ SETZM ACTVSW
		    POPJ P, ]
	HRROI A,[ASCIZ /after /]
	PUSHJ P,.PSOUT
	MOVEI B,2
	MOVE A,TERM
	CAIN A,37
	 JRST [ MOVEI A,101	; if crlf, use default value
		MOVEI C,12
		PUSHJ P,.NOUT
		 JFCL
		MOVEI A,40
		PUSHJ P,.PBOUT
		MOVE A,B
		JRST ACTVS2 ]
ACTVS1:	MOVE TAB,DCMTB
	PUSHJ P,SYMVAL		; else get time limit in min.
	SKIPG A			; only positive times...
	 JRST [ HRROI A,[ASCIZ / ? /]
		PUSHJ P,.PSOUT
		JRST ACTVS1 ]
ACTVS2:	IMULI A,↑D60000
	MOVEM A,ACTVTM
	SETOM ACTVSW
	MOVE B,A
	HRROI A,[ASCIZ /minutes./]
	CAIN B,↑D60000
	 HRROI A,[ASCIZ /minute./]
	PUSHJ P,.PSOUT
	POPJ P,


; Wait for a connection wanting to print

WATRET:	MOVSI X,-NCONN
WATREL:	SKIPN A,SNDJFN(X)
	 JRST WATREX
	SKIPG SAVINC(X)
	 JRST WATREX
	HRROI A,[ASCIZ /
connection /]
	PUSHJ P,.PSOUT
	HRRZ A,X
	IMULI A,3
	HRROI A,CONNAM(A)
	PUSHJ P,.PSOUT
	HRROI A,[ASCIZ / ready. /]
	PUSHJ P,.PSOUT
	HRRZ A,X
	JRST RETCO1

WATREX:	AOBJN X,WATREL
	MOVEI A,↑D10000
	DISMS
	JRST WATRET

; Retrieve connection

RETCON:	SKIPL TAB,CONTAB
	 JRST [	HRROI A,[ASCIZ /
No connections.
/]
		PUSHJ P,.PSOUT
		POPJ P,]
	PUSHJ P,SYMVAL
RETCO1:	MOVEM A,CNX
	TRO F,REMOTF
	POPJ P,

; List connections

LSTCON:	TRZ F,TMPF
	MOVE X,CONTAB
	JUMPGE X,LSTCOX
LSTCOL:	HRROI A,[ASCIZ /
-Name-  -From-  --To--

/]
	TRON F,TMPF
	PUSHJ P,.PSOUT
	SETZ C,
	MOVE A,(X)
	PUSHJ P,.PSOUT
	MOVE B,1(A)
	MOVEI A,11
	PUSHJ P,.PBOUT
	HRRZ B,SNDJFN(B)
	MOVEI A,101
	MOVE C,[BYTE (3)0,0,1,1,0,0,0(5)0,0,2]
	JFNS
	SKIPE A,SCRJFN
	 JFNS
	PUSHJ P,SCRUPD
	MOVEI A,37
	PUSHJ P,.PBOUT
LSTCOX:	AOBJN X,LSTCOL
	HRROI A,[ASCIZ /
No saved connections./]
	TRZN F,TMPF
	PUSHJ P,.PSOUT
	POPJ P,

; Exec

.EXEC:	HRROI B,[ASCIZ /<SYSTEM>EXEC.SAV/]
	MOVSI C,(1B0)		; cause interrupts to go off
	MOVSI A,100001
	JRST SBGET

; Run

.RUN:	MOVSI A,100003
	MOVE B,[XWD 100,101]
	SETZ C,

SBGET:	PUSH P,B
	PUSHJ P,GTJFN0
	 JRST [	POP P,A
		TLNN A,-1
		PUSHJ P,.PSOUT
		ERROR [ASCIZ / not available./]]
	SUB P,[XWD 1,1]
	MOVEI A,400000
	DIR
	MOVSI A,(1B1!1B3)
	MOVEI B,FAC
	CFORK
	 JRST [	HRROI A,[ASCIZ /No forks available./]
		JRST GETF]
	MOVEM A,SPCFRK
	HRLZ A,SPCFRK
	HRR A,IJFN
	GET
	SETZM IJFN
	MOVEI A,400000
	EIR
	JUMPGE C,SBGET4
	DIR
	MOVE A,ESCCOD
	DTI
	MOVE A,CBFCOD
	DTI

SBGET4:	PUSH P,C
	MOVEI A,100
	MOVE B,TTCOC0
	MOVE C,TTCOC1
	SFCOC
	MOVE B,TTMOD0
	SFMOD
	HRRZ B,0(P)
	MOVE A,SPCFRK
	SFRKV
	WFORK
	MOVEI A,400000
	DIR
	MOVE A,SPCFRK
	KFORK
	SETZM SPCFRK
	POP P,C
	JUMPGE C,SBGET5
	MOVEI A,ESCCHN
	HRL A,ESCCOD
	ATI
	MOVEI A,CBFCHN
	HRL A,CBFCOD
	ATI
SBGET5:	MOVEI A,400000
	EIR
	POPJ P,

GETF:	PUSH P,A
	MOVEI A,400000
	EIR
	SKIPE A,IJFN
	 PUSHJ P,CLRJFN
	SETZM IJFN
	POP P,A
	PUSHJ P,.PSOUT
	POPJ P,

; Set escape character

SETESC:	PUSHJ P,SETICH
	 ESCAPE
	 ESCCOD
	 ESCCHN
	POPJ P,

SETCBF:	PUSHJ P,SETICH
	 CBFCHR
	 CBFCOD
	 CBFCHN
	POPJ P,

SETICH:	MOVE X,0(P)
	ADDI X,3
	EXCH X,0(P)
SETIC1:	PUSHJ P,.PBIN
	CAIN A,"?"
	 JRST PRESC
	PUSH P,A
	PUSHJ P,CVINTC
	 JRST SETED
	PUSH P,A
	MOVEI A,400000
	DIR
	POP P,A
	MOVE B,0(P)
	MOVEM B,@0(X)
	EXCH A,@1(X)
	DTI
	HRLZ A,@1(X)
	HRRI A,@2(X)
	ATI
	MOVE A,0(P)
	CAIL A,40
	 JRST SETE1
	MOVEI A,"↑"
	PUSHJ P,ECHOIT
	MOVEI A,100
	ADDM A,0(P)
SETE1:	POP P,A
	PUSHJ P,ECHOIT
	MOVEI A,400000
	EIR
	POPJ P,


SETED:	POP P,A
	MOVEI A,7
	PUSHJ P,.PBOUT
	JRST SETIC1

PRESC:	PUSHJ P,ECHOIT		; echo the "?"
	HRROI A,[ASCIZ /
control-@ through control-z
altmode
rubout
space
/]
	PUSHJ P,.PSOUT
	MOVE A,LPTR
	PUSHJ P,.PSOUT
	JRST SETIC1

; Set terminal modes

SETTRM:	MOVE TAB,TRMTAB
	JRST SYMVAL


; Set synch character

SETSNC:	SETOM SYNC
	JUMPGE NOA,SETIWK
	PUSHJ P,.PBIN
	PUSHJ P,ECHOIT
	MOVEM A,SYNC
	JRST SETIWK


; Set single charcter quote prefix

SETQOT:	SETOM QUOT
	JUMPGE NOA,SETIWK
	PUSHJ P,.PBIN
	PUSHJ P,ECHOIT
	MOVEM A,QUOT
	JRST SETIWK

; Set unshift prefix

SETUNS:	SETOM UNSFT
	JUMPGE NOA,SETIWK
	PUSHJ P,.PBIN
	PUSHJ P,ECHOIT
	MOVEM A,UNSFT
	JRST SETIWK

; Set case shift prefixes

SETSHF:	PUSH P,NOA		; Save noa
	MOVE TAB,SFTB
	PUSHJ P,SYMVAL
	POP P,NOA
	SETOM (A)		; Turn off prefix
	JUMPGE NOA,SETIWK	; Done if "no"
	PUSH P,A
	PUSHJ P,.PBIN
	PUSHJ P,ECHOIT
	MOVEM A,@(P)
	SUB P,[XWD 1,1]
SETIWK:	PUSH P,C		; create new special char.
	PUSH P,B		;  wakeup mask
	SETZ A,
	MOVSI C,-NSPECH
	ADD C,[XWD 2,2]		; omitting escape & clrobf
SETIW1:	HLRZ B,CSTAB(C)
	SKIPGE B,(B)		; lookup each spec. char.
	 JRST SETIW2
	HLRZ B,RCTGTB(B)	; OR in wakeup memshp if it exists
	IOR A,B
SETIW2:	AOBJN C,SETIW1
	MOVEM A,SPECWK		; store in specwk
	POP P,B
	POP P,C
	POPJ P,

; Echo.mode.is

.ECHO:	MOVE TAB,ECTAB
	JRST SYMVAL

CHGECH:	HRROI A,[ASCIZ /A half-duplex terminal (which I believe you have) will not work well
with remote echoing./]
	SKIPE HDX
	SKIPE ELCLF(CNX)
	CAIA
	 PUSHJ P,.PSOUT
	POPJ P,			;  DONT ECHO

; Terminal has lower case

SETLWR:	MOVEM NOA,TRMLWC
	MOVSI B,(1B3)
	JUMPGE NOA,SETLW1
	IORM B,TTMODR
	IORB B,TTMODC
	JRST SETLW2

SETLW1:	ANDCAM B,TTMODR
	ANDCAB B,TTMODC
SETLW2:	MOVEI A,101
	STPAR
	POPJ P,

SNDSNC:	SKIPN A,SNDJFN(CNX)	; Send "sync"
	 POPJ P,		; Connection not ok
	MOVEI B,22		; First send interrupt
	SETZB C,D
	MTOPR
	MOVEI B,3		; Then send mark type DM
	MOVEI C,1
	MTOPR
	POPJ P,

; Set control character echoing

SETCOC:	PUSHJ P,GCH
	CAIN A,"?"
	 JRST SETCOQ
	PUSHJ P,ECHOIT
SETCO2:	CAIN A,37
	MOVEI A,15
	MOVEM A,TERM
	PUSHJ P,.PBIN
	PUSHJ P,ECHOIT
	EXCH A,TERM
	ANDI A,37
	MOVSI B,400000
	MOVNS A
	ROT B,(A)
	SKIPN NOA
	ANDCAM B,ECHCOC(CNX)
	SKIPE NOA
	IORM B,ECHCOC(CNX)
	MOVE A,TERM
	CAIE A,37
	 JRST [	CAIE A,40
		CAIN A,","
		 JRST SETCOC
		JRST SETCO2]
	POPJ P,

SETCOQ:	HRROI A,[ASCIZ /
control characters or letter equivalents
/]
	PUSHJ P,.PSOUT
	MOVE A,LPTR
	PUSHJ P,.PSOUT
	JRST SETCOC

SETCOE:	MOVEI A,7
	PUSHJ P,.PBOUT
	JRST SETCOC

; Print current modes

PRCMD:	MOVSI X,-NPMDTB
PRCMD1:	MOVEI A,37
	PUSHJ P,.PBOUT
	MOVSI C,CNX
	HLR C,PCMDTB(X)
	HRROI A,[ASCIZ /no /]
	SKIPN @C
	PUSHJ P,.PSOUT
	HRRO A,PCMDTB(X)
	PUSHJ P,.PSOUT
	AOBJN X,PRCMD1
	HRROI A,[ASCIZ /
Special characters:
/]
	PUSHJ P,.PSOUT
	MOVSI X,-NSPECH
PCSLP:	HLRZ B,CSTAB(X)
	SKIPG (B)
	 JRST PCSLPN
	HRRO A,CSTAB(X)
	PUSHJ P,.PSOUT
	MOVEI A,11
	PUSHJ P,.PBOUT
	MOVE A,(B)
	PUSHJ P,.PBOUT
PCSLPE:	MOVEI A,37
	PUSHJ P,.PBOUT
PCSLPN:	AOBJN X,PCSLP
	SKIPE D,ECHCOC(CNX)
	SKIPN ELCLF(CNX)
	 POPJ P,		; Done if not local echo or no coc
	HRROI A,[ASCIZ /
Local echo for control /]
	PUSHJ P,.PSOUT
PRCM2:	JFFO D,.+1
	MOVSI B,400000
	MOVN C,D+1
	ROT B,(C)
	ANDCAM B,D
	JUMPN D,PRCM1
	HRROI A,[ASCIZ /and /]
	CAME B,ECHCOC(CNX)
	PUSHJ P,.PSOUT
PRCM1:	MOVEI A,100(D+1)
	PUSHJ P,.PBOUT
	JUMPE D,CPOPJ
	HRROI A,[ASCIZ /, /]
	PUSHJ P,.PSOUT
	JRST PRCM2

PCMDTB:	XWD RAISEF,[ASCIZ /Raise/]
	XWD LOWERF,[ASCIZ /Lower/]
	XWD ELCLF,[ASCIZ /Local echo/]
	XWD LFCRF,[ASCIZ /Echo linefeed for carriage return/]
	XWD LNBFF,[ASCIZ /Line buffer/]
NPMDTB==.-PCMDTB

CSTAB:	XWD ESCAPE,[ASCIZ /Escape: /]
	XWD CBFCHR,[ASCIZ /Clrobf: /]
	XWD QUOT,[ASCIZ /Quote:  /]
	XWD UNSFT,[ASCIZ /Unshift:/]
	XWD LCASC,[ASCIZ /Char.lower:/]
	XWD LCASL,[ASCIZ /Lock.lower:/]
	XWD UCASC,[ASCIZ /Char.upper:/]
	XWD UCASL,[ASCIZ /Lock.upper:/]
	XWD SYNC,[ASCIZ /Synch:  /]

NSPECH==.-CSTAB




; Help

.HELP:	HRROI A,[ASCIZ /
The describe command is the efficient way to get specific questions
answered; type "describe describe" to see how./]
	PUSHJ P,.PSOUT
	HRROI A,[ASCIZ /
You may also wish to list the file <DOC>CHAT.HELP on
the LPT: for future reference./]
	PUSHJ P,.PSOUT
	HRROI A,[ASCIZ /
Or you may continue with "help" to get the help file typed out in
pieces.  Continue?  /]
	PUSHJ P,.PSOUT
	PUSHJ P,OPNHLP		; open help file
	 POPJ P,		;   can't
	JRST TYPAL


TYPLP:	MOVEI X,↑D20
TYPLP1:	MOVE A,IJFN
	MOVE B,[POINT 7,COMBUF]
	MOVEI C,200*5-3
	MOVEI D,12
	SIN
	GTSTS
	TLNE B,1000
	 JRST ETYPL
	MOVEI A,101
	MOVE B,[POINT 7,COMBUF]
	MOVEI C,200*5-3
	MOVEI D,12
	PUSHJ P,.SOUT
	SOJG X,TYPLP1
	CAIGE C,200*5-3-2
	 JRST TYPLP1
	HRROI A,[ASCIZ /
More help? /]
	PUSHJ P,.PSOUT
TYPAL:	PUSHJ P,.PBIN
	CAIE A,"Y"
	CAIN A,"Y"+40
	 JRST TYPMO
	CAIE A,"N"
	CAIN A,"N"+40
	 JRST TYPNO
	MOVEI A,7
	PUSHJ P,.PBOUT
	JRST TYPAL

TYPMO:	HRROI A,[ASCIZ /Yes
/]
	PUSHJ P,.PSOUT
	JRST TYPLP

TYPNO:	HRROI A,[ASCIZ /No
/]
	PUSHJ P,.PSOUT
	JRST ETYPX

ETYPL:	SUBI C,200*5-3
	SOUT
ETYPX:	MOVE A,IJFN
	PUSHJ P,CLRJFN
	SETZM IJFN
	POPJ P,


; describe
.DSCRB:	MOVE TAB,DSCRTB
	PUSHJ P,SYMVAL		; get identifier, str ptr in bptr
	PUSHJ P,OPNHLP		; now open help file
	 POPJ P,
	SETZB B,X		; overlay null to separator in input
	DPB B,PTR
DSCRB1:	PUSHJ P,RDHLRB		; read help file up to next rubout
	PUSHJ P,RDHLP		; read following string
	MOVE D,BPTR
	MOVE Y,[POINT 7,HLPBUF]	; now compare string from file
	MOVE A,HLPBUF		; to "[no] ", scan off if present,
	CAMN A,[ASCII /[no] /]
	 ADDI Y,1		; then compare input identifier string
DSCRB2:	ILDB A,D		; to present string from file
	ILDB B,Y
	PUSHJ P,SYMCMP
	 JRST [ JUMPE A,DSCRB3	; unequal: substring match if input
		JRST DSCRB1 ]	; ends first; else get next record
	JUMPN A,DSCRB2		; exact match if null, else keep cmprng
DSCRB3:	MOVEI A,37		; file rec matches input identifier
	PUSHJ P,.PBOUT		; type initial <cr>
	PUSHJ P,.PBOUT
DSCRB4:	MOVEI A,101
	MOVE B,[POINT 7,HLPBUF]
	MOVEI C,200*5-3
	MOVEI D,177		; type out text
	PUSHJ P,.SOUT
	LDB A,B
	CAIN A,177		; did output end on a rubout marker?
	 JRST ETYPX		;  yes, done, close file & exit
	PUSHJ P,RDHLP		; no, read another buffer load
	JRST DSCRB4

RDHLRB:	JUMPE X,RDHLRR		; read file up to rubout marker
RDHLRC:	LDB A,X			; if str ptr in b, check if already
	CAIN A,177		;  at a rubout
	 POPJ P,		;   yes, exit
RDHLRR:	PUSHJ P,RDHLP		; no rubout, read another record
	JRST RDHLRC

RDHLP:	MOVE A,IJFN		; read help file into buffer
	GTSTS
	TLNE B,1000		; failure if file already at eof
	 ERROR [ASCIZ /help item not found./]
	MOVE B,[POINT 7,HLPBUF]	; (should never happen)
	MOVEI C,200*5-3
	MOVEI D,177		; read full buffer or up to rubout
	SIN
	MOVE X,B		; save updated pointer
	GTSTS
	TLNN B,1000
	 POPJ P,
	MOVEI A,177
	IDPB A,X		; if eof, smash rubout into buf
	POPJ P,


OPNHLP:	MOVEI A,400000		; get and open help file
	DIR
	HRROI B,[ASCIZ /<DOC>CHAT.HELP/]
	MOVSI A,100001
	GTJFN
	 JRST [	MOVEI A,400000
		EIR
		HRROI A,[ASCIZ /Help file not found./]
		PUSHJ P,.PSOUT
		POPJ P,]
	MOVEM A,IJFN
	MOVEI A,400000
	EIR
	MOVE A,IJFN
	MOVE B,[XWD 70000,200000]
	OPENF
	 JRST [	MOVE A,IJFN
		PUSHJ P,CLRJFN
		SETZM IJFN
		HRROI A,[ASCIZ /Help file can't be opened./]
		PUSHJ P,.PSOUT
		POPJ P,]
	JRST SKPRET		; 2nd return if success


; Typescript to a file

SETSCR:	PUSHJ P,UGTAD
	MOVEM B,SCRTIM		; Time of last typescript entry
	SETZM SCRCNT		; Characters output since last openf
	MOVEI A,400000
	DIR
	SETZ A,
	EXCH A,SCRJFN
	SKIPLE A
	 PUSHJ P,CLRJFN
	MOVEI A,400000
	EIR
	SKIPL NOA		; file flushed, done if "no"
	 POPJ P,
	PUSHJ P,.PBIN		; wait for input
	CAIE A,33
	CAIN A,37		; get default typscr file if CR or ESC
	 JRST [ MOVEI A,400000
		DIR
		GJINF
		MOVE B,A
		HRROI A,LGDRST	; always open file in login directory
		DIRST
		 JFCL		; (can't fail)
		MOVEI A,[ 1B0
			XWD 377777,377777
			0
			POINT 7,LGDRST
			REPEAT 5,<0> ]
		HRROI B,[ASCIZ /CHAT.TYPESCRIPT;T;P770000/]
		GTJFN
		 JRST [	MOVEI A,400000
			EIR
			POPJ P,]
		PUSH P,A
		MOVE B,[XWD 70000,20000]
		OPENF
		 JRST [	POP P,A
			RLJFN
			 JFCL
			MOVEI A,400000
			EIR
			POPJ P,]


		HRROI B,[ASCIZ /
CHAT typescript file started at /]
		SETZ C,
		SOUT
		SETO B,
		MOVE C,[1B1+1B7+1B12+1B17]
		ODTIM
		MOVEI B,15
		BOUT
		MOVEI B,12
		BOUT
		POP P,SCRJFN
		MOVEI A,400000
		EIR
		POPJ P,]
	SKIPN HDX
	 PBOUT			; echo first char typed...
	MOVEI A,100		; if non-terminator typed, back up
	BKJFN			;  and get user-named file
	 0
	MOVEI A,[XWD 460000,0
		XWD 100,101
		REPEAT 4,<0>
		XWD 500000,770000
		REPEAT 2,<0>]
	SETZ B,
	PUSHJ P,GTJFN0		; get any file name, but with self-only
	 ERROR [ASCIZ /File not available./]
	MOVE B,[XWD 70000,100000]
	OPENF
	 JRST [	MOVE A,IJFN
		PUSHJ P,CLRJFN
		SETZM IJFN
		ERROR [ASCIZ /Cannot open file./]]
	MOVEI A,400000
	DIR
	MOVEI B,0
	EXCH B,IJFN
	MOVEM B,SCRJFN
	EIR
	POPJ P,

; Get uniform time in secs

UGTAD:	GTAD
	HRRZS B,A
	HLRZS A
	IMULI A,↑D24*↑D60*↑D60
	ADDB A,B
	POPJ P,


; Update script file

SCRUPD:	SKIPN SCRJFN
	 POPJ P,
	PUSH P,A
	PUSH P,B
	SKIPGE SCRTIM
	 JRST SCRUP0		; Forced update
	PUSHJ P,UGTAD
	SUB B,SCRTIM		; Ho long since last update?
	CAIG B,↑D30
	 JRST SCRUPX		; Never less than 30 secs
	CAIL B,↑D300
	 JRST SCRUP0		; Always every 5 min
	MOVE A,SCRJFN
	RFPTR
	 SETZ B,
	SUB B,SCRCNT
	CAIG B,↑D1000
	 JRST SCRUPX		; Then not fewer thant 1000 chars
SCRUP0:	PUSHJ P,UGTAD
	MOVEM B,SCRTIM
	MOVE A,SCRJFN
	RFPTR
	 SETZ B,
	MOVEM B,SCRCNT
	HRLI A,400000
	CLOSF
	 JFCL
	HRRZS A
	MOVE B,[XWD 70000,20000]
	OPENF
	 0
SCRUPX:	POP P,B
	POP P,A
	POPJ P,


; Connection's output to a file as it arrives

SETLGF:	PUSHJ P,UGTAD
	MOVEM B,LGFTIM(CNX)	; Time of last logging entry
	SETZM LGFCNT(CNX)	; Characters output since last openf
	MOVEI A,400000
	DIR
	SETZ A,
	EXCH A,LGFJFN(CNX)
	SKIPLE A
	 PUSHJ P,CLRJFN
	MOVEI A,400000
	EIR
	SKIPL NOA		; file flushed, done if "no"
	 POPJ P,
	MOVEI A,[XWD 460000,0
		XWD 100,101
		REPEAT 4,<0>
		XWD 500000,770000
		REPEAT 2,<0>]
	SETZ B,
	PUSHJ P,GTJFN0		; get any file name, but with self-only
	 ERROR [ASCIZ /File not available./]
	MOVE B,[XWD 70000,100000]
	OPENF
	 JRST [	MOVE A,IJFN
		PUSHJ P,CLRJFN
		SETZM IJFN
		ERROR [ASCIZ /Cannot open file./]]
	MOVEI A,400000
	DIR
	MOVEI B,0
	EXCH B,IJFN
	MOVEM B,LGFJFN(CNX)
	MOVE A,LGFJFN(CNX)
	HRROI B,[ASCIZ /
CHAT logging file started at /]
	SETZ C,
	SOUT
	SETO B,
	MOVE C,[1B1+1B7+1B12+1B17]
	ODTIM
	SKIPN SNDJFN(CNX)	; Is there a connection?
	 JRST LGNJFN		; No, don't try to print its name
	HRROI B,[ASCIZ /
   on connection /]
	SETZ C,
	SOUT
	MOVE B,CNX
	IMULI B,3
	ADDI B,CONNAM
	HRROS B
	SOUT
	HRROI B,[ASCIZ / from /]
	SOUT
	HRRZ B,SNDJFN(CNX)
	MOVE D,B


	MOVSI C,(<BYTE (3)0,0,1>)
	JFNS
	HRROI B,[ASCIZ / to /]
	SETZ C,
	SOUT
	MOVE B,D
	MOVSI C,(<BYTE(3)0,0,0,1>)
	JFNS
LGNJFN:	MOVEI B,15
	BOUT
	MOVEI B,12
	BOUT
	MOVEI A,400000
	EIR
	POPJ P,

; Update logging file

LGFUPD:	SKIPN LGFJFN(CNX)
	 POPJ P,
	PUSH P,A
	PUSH P,B
	SKIPGE LGFTIM(CNX)
	 JRST LGFUP0		; Forced update
	PUSHJ P,UGTAD
	SUB B,LGFTIM(CNX)	; How long since last update?
	CAIG B,↑D60
	 JRST LGFUPX		; Never less than 60 secs
	CAIL B,↑D300
	 JRST LGFUP0		; Always every 5 min
	MOVE A,LGFJFN(CNX)
	RFPTR
	 SETZ B,
	SUB B,LGFCNT(CNX)
	CAIG B,↑D10
	 JRST LGFUPX		; Then not fewer thant 10 chars
LGFUP0:	PUSHJ P,UGTAD
	MOVEM B,LGFTIM(CNX)
	MOVE A,LGFJFN(CNX)
	RFPTR
	 SETZ B,
	MOVEM B,LGFCNT(CNX)
	HRLI A,400000
	CLOSF
	 JFCL
	HRRZS A
	MOVE B,[XWD 70000,20000]
	OPENF
	 0
LGFUPX:	POP P,B
	POP P,A
	POPJ P,


; Divert output  to a file

SETDIV:	MOVEI A,400000
	DIR
	MOVEI A,0
	EXCH A,DIVJFN
	SKIPLE A
	 PUSHJ P,CLRJFN
	MOVEI A,400000
	EIR
	JUMPGE NOA,CPOPJ
	MOVSI A,460003
	PUSHJ P,.GTJFN
	 ERROR [ASCIZ /File not found./]
	MOVE B,[XWD 70000,100000]
	OPENF
	 JRST [	MOVE A,IJFN
		PUSHJ P,CLRJFN
		SETZM IJFN
		ERROR [ASCIZ /Cannot open./]]
	MOVEI A,400000
	DIR
	MOVEI B,0
	EXCH B,IJFN
	MOVEM B,DIVJFN
	EIR
	POPJ P,


; Take input from a file (remote mode)

SETALT:	MOVEI A,400000
	DIR
	MOVEI A,0
	EXCH A,ALTJFN(CNX)
	SKIPLE A
	 PUSHJ P,CLRJFN
	MOVEI A,400000
	EIR
	JUMPGE NOA,CPOPJ
	MOVSI A,160003
	PUSHJ P,.GTJFN
	 ERROR [ASCIZ /File not found./]
	MOVE B,[XWD 1,11]
	MOVEI C,C
	GTFDB
	LDB B,[POINT 6,C,11]
	CAIE B,7
	 ERROR [ASCIZ /Not an ASCII file./]
	SIZEF
	 ERROR [ASCIZ /File not found./]
	MOVEM B,ALTJCT(CNX)
	MOVE B,[XWD 70000,200000]
	OPENF
	 JRST [ MOVE A,IJFN
		PUSHJ P,CLRJFN
		SETZM IJFN
		ERROR [ASCIZ /Cannot open./]]
	MOVEI A,400000
	DIR
	MOVEI B,0
	EXCH B,IJFN
	MOVEM B,ALTJFN(CNX)
	EIR
	POPJ P,

; Print where we are

.WHERE:	MOVEI A,37
	PUSHJ P,.PBOUT
	SKIPN A,SNDJFN(CNX)
	 JRST NOCC
	HRROI A,[ASCIZ /Connection /]
	PUSHJ P,.PSOUT
	MOVE A,CNX
	IMULI A,3
	ADDI A,CONNAM
	HRROS A
	PUSHJ P,.PSOUT
	HRROI A,[ASCIZ / from /]
	PUSHJ P,.PSOUT
	HRRZ B,SNDJFN(CNX)
	MOVEI A,101
	MOVSI C,(<BYTE (3)0,0,1>)
	JFNS
	SKIPE A,SCRJFN
	JFNS
	HRROI A,[ASCIZ / to /]
	PUSHJ P,.PSOUT
	HRRZ B,SNDJFN(CNX)
	MOVEI A,101
	MOVSI 3,(<BYTE (3)0,0,0,1>)
	JFNS
	SKIPE A,SCRJFN
	JFNS
	MOVEI A,37
	PUSHJ P,.PBOUT
NOCC:	MOVE A,[SIXBIT /SYSVER/]
	SYSGT
	MOVE D,P
	HRRZ C,B
	HLLZS B

.WHRL:	MOVE A,C
	HRL A,B
	GETAB
	 JFCL
	PUSH P,A
	AOBJN B,.WHRL
	PUSH P,[0]
	HRROI A,1(D)
	PUSHJ P,.PSOUT
	MOVE P,D
	HRROI A,[ASCIZ /
Job /]
	PUSHJ P,.PSOUT
	GJINF
	PUSH P,1
	MOVEI A,101
	MOVE B,C
	MOVEI C,12
	PUSHJ P,.NOUT
	 JFCL
	HRROI A,[ASCIZ /, terminal /]
	PUSHJ P,.PSOUT
	MOVE B,D
	MOVEI C,10
	MOVEI A,101
	PUSHJ P,.NOUT
	 JFCL
	HRROI A,[ASCIZ /, user /]
	PUSHJ P,.PSOUT
	POP P,B
	MOVEI A,101
	DIRST
	 JFCL
	SKIPLE A,SCRJFN
	 DIRST
	 JFCL
	HRROI A,[ASCIZ /
CHAT version /]
	PUSHJ P,.PSOUT
	HRROI A,VERNUM
	PUSHJ P,.PSOUT
	POPJ P,


; Reset

.RESET:	JRST RSTART

; Logout

.LGOUT:	HRROI A,[ASCIZ / [Confirm] /]
	PUSHJ P,.PSOUT
	PUSHJ P,.PBIN
	CAIE A,37
	POPJ P,
	PUSHJ P,.PBOUT
	MOVNI 1,1
	LGOUT
	HALTF

; Quit, exit back to exec

.QUIT:	SETOM SCRTIM
	PUSHJ P,SCRUPD		; Update script before leaving
	MOVSI CNX,-NCONN
QUITA:	SETOM LGFTIM(CNX)
	PUSHJ P,LGFUPD
	AOBJN CNX,QUITA
	MOVEI A,400000
	DIR
	HALTF
	MOVEI A,-4
	FFORK
	MOVE CNX,FSVCNX
	MOVEI A,400000
	EIR
	POPJ P,


; Send code and control

SNDDCD:	IBP BPTR		; Send decimal # as code
	PUSHJ P,CVDEC
	JRST SNDC

SNDOCD:	IBP BPTR		; Send octal # as code
SNDOCT:	PUSHJ P,CVOCT
	JRST SNDC

SNDHCD:	IBP BPTR		; Send hex # as code
	SETZ A,
SNDHCL:	ILDB B,BPTR
	JUMPE B,SNDC
	CAIL B,"A"
	ADDI B,11
	ANDI B,17
	ASH A,4
	ADD A,B
	JRST SNDHCL

SNDCTL:	MOVE TAB,LTRTB		; Send control char.
	PUSHJ P,SYMVAL
	ANDI A,37
	JRST SNDC

SNDCD1:	PUSHJ P,CVOCT
SNDC:	MOVE B,A
	SKIPN SNDJFN(CNX)
	 POPJ P,
	PUSHJ P,SNDCH		; Send and push out byte
	PUSHJ P,TRNSMT
	POPJ P,

; Set remote mode

SETREM:	SKIPE A,SNDJFN(CNX)
	TRO F,REMOTF
	POPJ P,


DOCOMT:	PUSHJ P,GCH
	PUSHJ P,ECHOIT
	CAIE A,37
	JRST DOCOMT
	POPJ P,

CVOCT:	SKIPA C,[10]
CVDEC:	MOVEI C,↑D10
	MOVE A,BPTR
	NIN
	 SETZ B,
	MOVE A,B
	POPJ P,

SEND:	CIS
	MOVEM CNX,FSVCNX	; save CNX for later restoration
	MOVE P,[XWD -100,SPDL-1]
	MOVE PTR,[POINT 7,LINBUF-1,34]

; Send terminal parameters first
	MOVEI A,101
	SKIPN B,REALTT		; Really a scope?
	 GTTYP			; No, get actual type
	MOVEI A,4		; Send terminal type
	PUSHJ P,SNTPAR
	MOVEI A,101
	RFMOD
	LDB C,[POINT 7,B,10]	; Save length
	PUSH P,C
	LDB B,[POINT 7,B,17]	; Get width
	MOVEI A,2		; Send line width
	PUSHJ P,SNTPAR
	POP P,B
	MOVEI A,3		; Send line length
	PUSHJ P,SNTPAR


SEND0:	PUSHJ P,.PBIN
	SKIPE ACTVSW		; account time
	 PUSHJ P,SNDTIM
	ANDI A,177
	SKIPE XPARNT(CNX)	; Completely transparent?
	 JRST [	MOVE B,A	; Yes
		PUSHJ P,SNDCH
		PUSHJ P,TRNSMT
		JRST SEND0]
	AOSN QUOTF
	 JRST SEND02		; Not special (may be shifted though)
	CAMN A,QUOT		; Quote character
	 JRST [	SETOM QUOTF	; Yes, remember
		JRST SEND0]
	CAMN A,SYNC		; Synch substitute
	 JRST [	PUSHJ P,SNDSNC	; Yes, send sync seq
		JRST SEND0]
	CAMN A,UNSFT		; Now for the shifts...unshift?
	 JRST [	SETZM RAISEF(CNX)
		SETZM LOWERF(CNX)
		SETZM UCASCF
		SETZM LCASCF	; clear all shift flags
		JRST SEND0]
	CAME A,LCASC
	CAMN A,UCASC
	 JRST SETCAS
	CAME A,LCASL
	CAMN A,UCASL
	 JRST SETCAS
SEND02:	CAIG A,136		; Regular character...needs shift?
	CAIGE A,100
	 JRST SEND1		; Not upper case
	AOSE UCASCF		; Upper case.  if no upper case shift
	 PUSHJ P,SFTDWN		; Then see if down shift wanted
	JRST SEND3


SEND1:	CAIG A,176
	CAIGE A,140
	 JRST SEND3		; Not lower case either
	AOSE LCASCF		; Lower case.  if no down shift
	 PUSHJ P,SFTUP		; Then shift up if wanted
	JRST SEND3

SETCAS:	SETZM LCASCF		; Clear character shifts
	SETZM UCASCF
	CAMN A,LCASC		; If lower case char prefix
	 JRST [	SETOM LCASCF	; Remember
		JRST SEND0]
	CAMN A,UCASC		; If upper case char prefix
	 JRST [	SETOM UCASCF	; Remember
		JRST SEND0]
	SETZM LOWERF(CNX)	; Clear shift locks
	SETZM RAISEF(CNX)
	CAMN A,LCASL
	 JRST [	SETOM LOWERF(CNX)
		JRST SEND0]
	CAMN A,UCASL
	 JRST [	SETOM RAISEF(CNX)
		JRST SEND0]

SEND3:	SKIPN LNBFF(CNX)	; If not line buffering
	 PUSHJ P,SNDBUF		; Send any stuff already buffered
	CAIN A,37
	 MOVEI A,15
REPEAT 0,<
	 JRST [	HRROI A,15
		PUSHJ P,SNDDO
		SETCM A,LFCRF(CNX)	; Get complement of switch
		HRRI A,12	; Line feed
		JRST .+1]
>
	PUSHJ P,SNDDO
	HRRZS A
	CAIE A,12
	CAIN A,33
	 PUSHJ P,SNDBUF
	JRST SEND0

SFTDWN:	AOSE LCASCF
	SKIPE LOWERF(CNX)
	 TRO A,140
	POPJ P,

SFTUP:	AOSE UCASCF
	SKIPE RAISEF(CNX)
	 TRZ A,40
	POPJ P,

SENDO:	SKIPA A,CBFCHR
SENDE:	MOVE A,ESCAPE
	JRST SEND3

SNDBUF:	CAMN PTR,[POINT 7,LINBUF-1,34]
	 POPJ P,
	PUSHJ P,TRMST
	MOVE PTR,[POINT 7,LINBUF-1,34]
	MOVE C,PTR
SNDBF1:	ILDB B,C		; YES, it's true, replace a SOUT with
	SKIPN B			; a tight loop including SNDCH!
	 JRST [ PUSHJ P,TRNSMT	; This make me soffer so...
		POPJ P, ]
	PUSHJ P,SNDCH
	JRST SNDBF1

SNDDO:	SKIPE LNBFF(CNX)
	 JRST SNDLBF
	MOVE B,A
	PUSHJ P,SNDCH		; Unbuffered: send char & push it out
	PUSHJ P,TRNSMT
	MOVE A,B
	JRST SNDECH


; Send character in B on send connection CNX
SNDCH:	HRRZ A,SNDJFN(CNX)
	BOUT
	POPJ P,

; Force transmission of buffered characters
TRNSMT:	HRRZ A,SNDJFN(CNX)
	MOVEI B,21
	MTOPR
	POPJ P,

; Send terminal parameter
; A/ mark type, B/ parameter value

SNTPAR:	PUSH P,B
	MOVE C,A
	MOVE A,SNDJFN(CNX)
	MOVEI B,3
	MTOPR
	POP P,B
	BOUT
	MOVEI B,21
	MTOPR
	POPJ P,

SNDECH:	JUMPL A,CPOPJ		; Never echo ch with -1 lh
	SKIPN HDX		; If hdx terminal
	SKIPN ELCLF(CNX)		; If not local echo
	 POPJ P,		; Then done
SNDEC1:	MOVE B,ECHCOC(CNX)
	ROT B,(A)		; Prepare to test coc
	CAIGE A,40		; If not control
	 JUMPGE B,CPOPJ
	PUSHJ P,PLOUT1
	PUSHJ P,.PEOUT		; Echo
	POPJ P,

SNDLBF:	CAIE A,"A"-100
	CAIN A,"H"-100
	 JRST [	CAMN PTR,[POINT 7,LINBUF-1,34]
		 JRST [	MOVEI A,7
			PUSHJ P,.PBOUT
			POPJ P,]
		MOVEI A,"\"
		PUSHJ P,.PBOUT
		LDB A,PTR
		PUSHJ P,.PBOUT
		MOVE A,PTR
		BKJFN
		 0
		MOVEM A,PTR
		POPJ P,]
	CAIN A,"X"-100
	 JRST [	MOVEI A,"#"
		PUSHJ P,.PBOUT
		PUSHJ P,.PBOUT
		MOVEI A,37
		PUSHJ P,.PBOUT
		MOVE PTR,[POINT 7,LINBUF-1,34]
		POPJ P,]
	CAIN A,"R"-100
	 JRST [	MOVEI A,37
		PUSHJ P,.PBOUT
		PUSHJ P,TRMST
		MOVE A,[POINT 7,LINBUF-1,34]
		PUSHJ P,.PSOUT
		POPJ P,]
	IDPB A,PTR
	SKIPE ELCLF(CNX)
	 PUSHJ P,SNDECH
	POPJ P,

; input character class membership table
;  TENEX wakeup class in lh (10,4,2,1=>F,C,P,A)
;  RCTE break class in rh *** not used by CHAT ***

RCTGTB:	REPEAT 10,<XWD 4,20>	; ↑@-↑G (C,5)
	REPEAT 6,<XWD 10,10>	; ↑H-↑M (F,4)
	REPEAT 22,<XWD 4,20>	; ↑N-↑← (C,5)
	XWD 2,400		; SPACE (P,9)
	XWD 2,40		; !	(P,6)
	REPEAT 6,<XWD 2,200>	; "#$%&' (P,8)
	REPEAT 2,<XWD 2,100>	; ()	(P,7)
	REPEAT 2,<XWD 2,200>	; *+	(P,8)
	XWD 2,40		; ,	(P,6)
	XWD 2,200		; -	(P,8)
	XWD 2,40		; .	(P,6)
	XWD 2,200		; /	(P,8)
	REPEAT 12,<XWD 1,4>	; 0-9	(A,3)
	REPEAT 2,<XWD 2,40>	; :;	(P,6)
	XWD 2,100		; <	(P,7)
	XWD 2,200		; =	(P,8)
	XWD 2,100		; >	(P,7)
	XWD 2,40		; ?	(P,6)
	XWD 2,200		; @	(P,8)
	REPEAT 32,<XWD 1,1>	; A-Z	(A,1)
	XWD 2,100		; [	(P,7)
	XWD 2,200		; \	(P,8)
	XWD 2,100		; ]	(P,7)
	REPEAT 3,<XWD 2,200>	; ↑←`	(P,8)
	REPEAT 32,<XWD 1,2>	; a-z	(A,2)
	XWD 2,100		; {	(P,7)
	XWD 2,200		; |	(P,8)
	XWD 2,100		; }	(P,7)
	XWD 2,200		; ~	(P,8)
	XWD 4,20		; DEL	(C,5)

; routines to store time of last net i/o

SNDTIM:	PUSH P,A
	PUSH P,B		; send fork time accounting
	TIME
	MOVEM A,SNDATM(CNX)
	POP P,B
	POP P,A
	POPJ P,

RCVTIM:	PUSH P,A
	PUSH P,B		; receive fork time accounting
	TIME
	MOVEM A,RCVATM(CNX)
	POP P,B
	POP P,A
	POPJ P,


RECV:	CIS
	MOVEM CNX,FSVCNX
	HRRZ A,RECJFN(CNX)
	MOVEI B,24
	MOVSI C,017777
	MTOPR			; Ins interrupts on channel 1
	SETZM SYNCNT(CNX)	; clean INS count
	SETZM CBFCNT(CNX)
RECVY:	SETZM SAVINC(CNX)	; Loop to here to reset buffer
	MOVE A,[POINT 7,SAVBUF]
	MOVEM A,SAVINP(CNX)
	MOVEM A,SAVONP(CNX)
RECV0:	MOVE CNX,FSVCNX		; restore CNX in case fork restarted
	MOVE P,[XWD -100,SPDL-1]
	SKIPE SAVSWT(CNX)	; Saving output up?
	 JRST RECVR		; Yes, check if full and do it
	SKIPE SAVINC(CNX)	; No, any saved characters?
	 JRST RECVU		; Yes, unsave them
	JRST RECVB0		; No, get next input

RECVR:	MOVEI A,SAVBFS*5-5
	CAMG A,SAVINC(CNX)
RECVH:	 HALTF
RECVB0:	SETOM RCVBSW(CNX)	; Sw stays set until BIN for rstrtng
RECVB:	PUSHJ P,RCVCH
	SKIPE LGFJFN(CNX)
	 PUSHJ P,PLOUT2
	MOVE B,A
	SKIPE ACTVSW
	 PUSHJ P,RCVTIM		; account time
	SKIPE CBFCNT(CNX)
	 JRST RECVFT		; Flushing output or DM timing
RECVBA:	SKIPE SAVSWT(CNX)	; Saving up the output?
	 JRST RECVS		; Yes, go put it in buffer
RECV1:	AOSN CRNLSW		; was last char a <cr>?
	 JUMPE B,RECV0		;  yes, if this char is a null, flush it
	CAIN B,15		; is this char a <cr>?
	 SETOM CRNLSW		;  yes, set switch to screen <cr><nul>
RECV2:	SKIPE CLROBF
	 JRST RECVFL
	SKIPLE A,DIVJFN
	 JRST RECVX
	MOVE A,B
	PUSHJ P,.PEOUT
	JRST RECV0

RECVS:	PUSHJ P,RECVSV
	JRST RECV0


RECVU:	SKIPE CLROBF		; Clear output buffer?
	 JRST [	MOVE A,SAVINP(CNX)
		MOVEM A,SAVONP(CNX)
		SETZM SAVINC(CNX)
		LDB B,SAVONP(CNX)
		JRST RECVFL]
	MOVNI A,SAVBFS		; No
	ADD A,SAVONP(CNX)	; Wrapped pointer if needed
	CAMN A,[POINT 7,SAVBUF-1,34]
	 MOVEM A,SAVONP(CNX)	; Wrap pointer
	ILDB B,SAVONP(CNX)	; Get byte
	SOS SAVINC(CNX)		; Account
	JRST RECV1		; Go put it out

RECVSV:	MOVNI A,SAVBFS		; Prepare wrapped pointer
	ADD A,SAVINP(CNX)
	CAMN A,[POINT 7,SAVBUF-1,34]
	 MOVEM A,SAVINP(CNX)	; And use it if needed
	IDPB B,SAVINP(CNX)	; Store character
	AOS A,SAVINC(CNX)	; Account
	SKIPE SWOFLG		; Swo and
	CAIE A,1		; First character?
	 POPJ P,		; No
	MOVEI A,101
	DOBE
	HRROI A,[ASCIZ /
Output waiting from connection /]
	PUSHJ P,.PSOUT
	MOVE A,CNX
	IMULI A,3
	HRROI A,CONNAM(A)
	PUSHJ P,.PSOUT
	MOVEI A,37
	PUSHJ P,.PBOUT
	POPJ P,

RECVX:	BOUT
	SKIPE DIVSWT
	 JRST RECVN
	SKIPLE A,SCRJFN
	 BOUT
	MOVE A,B
	PUSHJ P,.PEOUT
RECVN:	CAIE B,12
	 JRST RECV0
	MOVEI A,101
	SOBE
	 JRST [	HRROI A,[ASCIZ /...
/]
		SKIPN DIVSWT
		 PUSHJ P,.PSOUT
		SETOM DIVSWT
		JRST RECV0]
	SETZM DIVSWT
	JRST RECV0

RECVFL:	MOVEM B,D
	HRRZ A,RECJFN(CNX)
	SKIPN SAVINC(CNX)
	SIBE
	 JRST RECV0
	MOVEI C,2
RECVF1:	MOVEI A,↑D500
	DISMS
	HRRZ A,RECJFN(CNX)
	SIBE
	 JRST RECV0
	SOJG C,RECVF1
	SETZM CLROBF
	MOVEI A,37
	PUSHJ P,.PBOUT
	MOVE B,D
	JRST RECV2

; Receive character, return it in A.
; Handles Marks and Ends internally

RCVCH:	MOVE A,RECJFN(CNX)
	PUSHJ P,RCVBIN
	JUMPE B,RCVCH2		; Maybe EOF
RCVCH1:	MOVE A,B
	POPJ P,

RCVCH2:	SETZ C,
	GDSTS			; Check state of connection
	TLNE B,(1B5)
	 JRST RCVEOF		; End encountered
	TLZN B,(1B4)
	 JRST [	SETZ B,		; Just a null data byte
		JRST RCVCH1]
	SDSTS			; A Mark, clear it
	MOVEI B,23		; Read mark type
	MTOPR
	CAIN C,1		; Data mark?
	 JRST [	SOS SYNCNT(CNX)	; Decrement sync count
		PUSHJ P,ZCFOBF	; Consider whether to flush
		JRST RCVCH]
	CAIN C,5		; Timing mark?
	 JRST [	MOVEI A,101	; Yes, wait for tty buffer to empty
		DOBE
		MOVE A,SNDJFN(CNX)  ; Send timing mark reply
		MOVEI B,3
		MOVEI C,6
		MTOPR
		JRST RCVCH]
; We should never receive a timing mark reply since we never
; send a timing mark.  The other mark types should not be
; received by a Telnet user.
	JRST RCVCH		; Just ignore

IOERR:	HRROI A,[ASCIZ /
IO error for connection /]
	MOVE CNX,FSVCNX		; restore cnx to be sure
	JRST GENABN

RCVEOF:	MOVE CNX,FSVCNX
	SKIPN SAVSWT(CNX)
	SKIPE SAVINC(CNX)
	 JRST RECVH		; Delay eof response until buffer gone
	HRROI A,[ASCIZ /Remote disconnect of /]
GENABN:	PUSH P,A
	AOSE ABNLCK		; Wait for abnormal interpt handler
	 JRST [	MOVEI A,↑D1000
		DISMS
		JRST .-1]
	POP P,A
	PUSHJ P,.PSOUT
	MOVE A,CNX
	IMULI A,3
	HRROI A,CONNAM(A)
	PUSHJ P,.PSOUT
	MOVEM CNX,ABNCNX
	MOVEI A,-1
	MOVSI B,(1B<ABNCHN>)
	IIC			; Initiate abnormal interpt in superior
	MOVEI A,↑D100000
	DISMS			; And hang
	JRST .-2

RECVFT:	SKIPG CBFCNT(CNX)	; go to flush output if neg.
	JRST RECV0
	PUSH P,B
	TIME			; If pos., there is an excess of DM's,
	POP P,B
	SUB A,DMTIME(CNX)	;  check elapsed time since last DM
	JUMPL A,RECVBA		;  go on if less than limit
	MOVEI A,400000
	DIR			;  else disable interrups to avoid 
	SETZM SYNCNT(CNX)	;  confusion, then clear INS counts
	SETZM CBFCNT(CNX)
	MOVEI A,400000
	EIR
	JRST RECVBA


ZCFOBF:	AOS CBFCNT(CNX)		; if ct -> 0, output flushing stops
	SKIPL SYNCNT(CNX)	; if INS ct pos, more DM's to come,
	 POPJ P,		;  clearing continues
	MOVEI A,101		; if INS ct neg, DM came first, 
	SKIPN SAVSWT(CNX)	;  initiate clearing of buf
	CFOBF
	SETZM SAVINC(CNX)
	MOVE A,[POINT 7,SAVBUF]
	MOVEM A,SAVINP(CNX)
	MOVEM A,SAVONP(CNX)
	TIME			; start timing interval from receipt of
	ADDI A,↑D5000		;  last excess DM: if no balancing INS
	MOVEM A,DMTIME(CNX)	;  in 5 sec., counts will be cleared
	POPJ P,			;  (lost INS, presumably)


RCVBIN:				; Called from RCVCH rtn:
				; BIN done here so restart routine can
				; tell if BIN has been completed yet
RCVBX:	SETZM RCVBSW(CNX)	; --switch set from entry to RCVCH
RCVB1:	BIN			; until this point-- this to prevent a
				; restarted conx from hanging on BIN,
	POPJ P,			; and other undesirable effects


RCVINS:	MOVEM 17,IACSAV+17	; INS interrupts come here
	MOVEI 17,IACSAV
	BLT 17,IACSAV+16
	MOVE CNX,FSVCNX
	AOS A,SYNCNT(CNX)
	SOS CBFCNT(CNX)		; If ct -> 0, flushing stops
	SKIPG A			;  if ct neg, more INS's to come
	 JRST RCVINX
	MOVEI A,101		; if ct pos, INS arrived first,
	SKIPN SAVSWT(CNX)	;  start clearing output
	CFOBF
	SETZM SAVINC(CNX)
	MOVE A,[POINT 7,SAVBUF]
	MOVEM A,SAVINP(CNX)
	MOVEM A,SAVONP(CNX)
	HRRZ A,FKRET2
	CAIE A,RECVH
	CAIN A,RECVH+1
	 JRST [	MOVEI A,RECV0
		HRRM A,FKRET2
		JRST RCVINX]
RCVINX:	HRLZI 17,IACSAV
	BLT 17,17
	DEBRK


LOC
VARS:	BLOCK 1
NCONN1==NCONN+1
	VAR
HSFSTR:	BLOCK 20
FMODSW:	BLOCK 7
SPARE:	BLOCK 3
NMODSW==.-FMODSW
EVARS:
RELOC

END START