;<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