Trailing-Edge
-
PDP-10 Archives
-
BB-H138D-BM
-
5-1-sources/telnet.mac
There are 15 other files named telnet.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>TELNET.MAC.3, 11-Oct-79 11:37:43, Edit by LCAMPBELL
; Update version and edit numbers for release 4
;<4.ARPA-UTILITIES>TELNET.MAC.2, 9-Jan-79 13:57:40, Edit by LCAMPBELL
; Update copyright notice
;<3.ARPA-UTILITIES>TELNET.MAC.4, 14-Nov-77 10:22:41, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>TELNET.MAC.3, 26-Oct-77 02:39:27, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3.ARPA-UTILITIES>TELNET.MAC.2, 5-Oct-77 01:45:17, EDIT BY CROSSLAND
;CONVERT TO RELEASE 3
;FIX NEWS TO TRY TO LOOKUP BBN HOST NUMBER
;<101B-SOURCES>TELNET.MAC.3, 8-Mar-77 17:07:53, EDIT BY CROSSLAND
;FIX ILLIGAL INTRUCTION ON HELP COMMAND
;<101B-SOURCES>TELNET.MAC.2, 22-Feb-77 14:12:55, EDIT BY CROSSLAND
;CHANGE NETSTA^FEXE TO NETSTAT.EXE TO AVOID CONFLICT WITH NETSTA.EXE
;<A-UTILITIES>TELNET.MAC.3, 14-Oct-76 15:41:44, EDIT BY CLEMENTS
;RE-DO PAGE MODE SAVING LOGIC FOR TOPS20
;<2MURPHY>TELNET.MAC.6, 28-Sep-76 19:45:20, EDIT BY CLEMENTS
;makfrk sets 1b9 in capabilities of inferior
;<2MURPHY>TELNET.MAC.5, 9-Sep-76 15:38:10, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<DODDS>OTLNET.MAC;3 14-JUN-74 10:16:35 EDIT BY DODDS
; 1) FIX FOR SCOPE TERMINALS, 2) TYPESCRIPT FILE PROTECTED (SELF)
;<DODDS>TELNET.MAC;17 23-JAN-74 11:39:30 EDIT BY DODDS
;<DODDS>TELNET.MAC;15 5-NOV-73 15:26:54 EDIT BY DODDS
; Conversion to MACRO and repaging
;<DODDS>TELNET.FAI;4 3-NOV-73 08:03:43 EDIT BY DODDS
;<JOHNSON>TELNET.FAI;29 16-APR-73 11:18:32 EDIT BY JOHNSON
; CHANGE NEWS SOCKET TO 367 (OCTAL) FROM 15600031
;<SOURCES>TELNET.FAI;28 18-JAN-73 11:20:44 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;27 17-JAN-73 16:46:23 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;26 16-JAN-73 10:52:09 EDIT BY TOMLINSON
; Deleted surveying and time constant. Revamped receive fork.
;<TOMLINSON>TELNET.FAI;13 15-JAN-73 14:02:33 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;12 15-JAN-73 13:43:16 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;11 15-JAN-73 13:13:11 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;10 15-JAN-73 12:29:13 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;9 15-JAN-73 11:57:40 EDIT BY TOMLINSON
;<TOMLINSON>MESSAGE.TXT;2 14-JAN-73 17:10:46 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;6 14-JAN-73 16:51:00 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;5 14-JAN-73 13:50:18 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;4 14-JAN-73 13:20:44 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;3 11-JAN-73 14:12:15 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;2 11-JAN-73 13:32:49 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;1 11-JAN-73 12:36:52 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;25 10-SEP-72 10:07:17 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;24 8-SEP-72 10:02:57 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;23 8-SEP-72 9:08:11 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;22 5-SEP-72 11:37:29 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;21 5-SEP-72 11:33:24 EDIT BY TOMLINSON
;<SOURCES>TELNET.FAI;20 5-SEP-72 11:17:41 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;46 3-SEP-72 11:37:58 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;45 2-SEP-72 16:02:59 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;44 2-SEP-72 15:56:36 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;43 2-SEP-72 15:54:09 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;42 2-SEP-72 15:28:21 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;41 2-SEP-72 15:13:34 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;40 2-SEP-72 14:54:29 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;39 2-SEP-72 14:45:07 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;38 2-SEP-72 14:43:04 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;37 2-SEP-72 14:19:33 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;36 2-SEP-72 13:59:08 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;35 2-SEP-72 13:57:07 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;34 2-SEP-72 12:04:40 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;33 2-SEP-72 11:33:29 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;32 28-JUL-72 15:15:14 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;31 28-JUL-72 14:24:37 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;30 28-JUL-72 14:17:41 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;29 28-JUL-72 13:27:03 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;28 28-JUL-72 11:42:16 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;27 28-JUL-72 11:23:30 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;26 28-JUL-72 11:09:29 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;25 28-JUL-72 10:53:32 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;24 28-JUL-72 10:29:02 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;23 27-JUL-72 16:59:25 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;22 27-JUL-72 16:01:50 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;21 27-JUL-72 15:55:01 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;20 3-JUL-72 13:29:08 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;19 3-JUL-72 13:22:25 EDIT BY TOMLINSON
;<TOMLINSON>TELNET.FAI;10 29-JUN-72 21:15:41 EDIT BY TOMLINSON
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979 Digital Equipment Corporation, Maynard, Mass.
TITLE TELNET (USER)
SUBTTL R.S.Tomlinson
SALL
.DIRECT FLBLST
.REQUIRE SYS:MACREL
SEARCH MONSYM,MACSYM
VWHO==0 ;LAST EDITED BY DEC
VMAJOR==4 ;MAJOR VERSION #
VMINOR==0 ;REVISION #
VEDIT==^D9 ;EDIT NUMBER
LOC <.JBVER==137>
VERSIO: <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
RELOC
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
CDELCH==.CHDEL ;RUBOUT IS CHAR DELETE
CDELLN=="U"-100 ;CTRL-U IS LINE DELETE
CRTYPE=="R"-100 ;CTRL-R IS LINE RETYPE
DEFINE FMSG (MSG)<
HRROI B,[ASCIZ \MSG\]
SETZ C,
SOUT>
; Flags (rh of f)
REMOTF==1 ; Operating in remote mode
COMMDF==4 ; In command mode
NSTIWF==2 ; Don't do stiw's
TMPF==400000 ; Temporary flags
TMPF2==200000
; Parameters
NPDL==2000 ; Size of push list
NCONN==7 ; Number of connections to remember
NHSTW==[^D256+^D35]/^D36 ; Number of words in host bit tables
IESC=="Z"-100 ; Initial escape character
ICBF=="O"-100 ; Initial clear output buffer character
TELSNC==200 ; Sync sequence to serving site
TELBRK==201 ; Break character
TELNOP==202 ; Telnet nop character
TELNEC==203 ; Don't echo
TELECH==204 ; Do echo
TELHID==205 ; Hide input
TELASC==240 ; Use ascii
ESCCHN==0 ; Use channel 0 for escape
ABNCHN==2 ; Channel 2 for abnormal connection termination
NTICHN==3 ; Channel 3 for network psi's
CBFCHN==4
SAVBFS==4000 ; Size of string saving buffer
LOC 200000 ; FORK DATA AREA
SPDL: BLOCK 100
FKRET1: BLOCK 1
FKRET2: BLOCK 1
FKRET3: BLOCK 1
SAVBUF: BLOCK SAVBFS
LOC 100000 ; Where to store variables
; Variables etc.
ARRAY HOSTRG[4*^D256]
ARRAY SHOSTB,NHOSTB[^D256]
INTEGER SHSTAB,NHSTAB,CONTAB
ARRAY PDL[NPDL]
ARRAY COMBUF[200]
ARRAY BIGBUF[4000]
INTEGER LODFLG,WATFLG,TCASE,TRMLWC
INTEGER BPTR,LPTR,SVP
INTEGER TTCOC0,TTCOC1,TTMOD0,TTMODR,TTMODC,JOBTIW,HDX,NFANCY
INTEGER ESCAPE,ESCCOD,CBFCHR,CBFCOD,LSTBDI,CONCSF
INTEGER ABNLCK,ABNCNX
INTEGER LCASCF,UCASCF
INTEGER LCASC,LCASL,UCASC,UCASL,UNSFT
INTEGER BRKC,SYNC,QUOT,QUOTF
ARRAY FAC[20]
INTEGER IJFN,JJFN,AJFN,SCRJFN,SCRCNT,SCRTIM
INTEGER DIVJFN,DIVSWT,RLACJ,SPCFRK
INTEGER SKTMSK,FSKT,FHST,FHSTN,RETPC1,RETPC2,RETPC3
ARRAY SNDJFN,RCVJFN,SNDFRK,RCVFRK,LSKT,ELCLF,LFCRF,LNBFF[NCONN+1]
ARRAY XPARNT,CBFCNT[NCONN+1]
ARRAY RAISEF,LOWERF,ECHCOC,CONTB,SAVINP,SAVINC,SAVONP,SAVSWT[NCONN+1]
ARRAY CONNAM[3+3*NCONN]
INTEGER ICPTIM,SUMTOT,SUMPHC,SUMSCL,SUMTIM,SUMTM2,SUMFST,SUMSRT,SWOFLG
ARRAY SUMAVG,SUMAVC,SUMUPT,SUMUPC,SUMTTC[400]
INTEGER TERM
INTEGER JUNK
INTEGER NTICNT,NTIIA,CLROBF
ARRAY LINBUF[200]
RELOC
; Program starts here
START: HRROI A,[ASCIZ /
User Telnet /]
PSOUT
SETZM SCRJFN ;SET THE SCRIPT JFN TO ZERO
MOVE P,[XWD -NPDL,PDL-1]
PUSHJ P,VERTYP ;TYPE OUT VERSION NUMBER
HRROI A,[ASCIZ /. Type HELP<cr> for help./]
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
MOVE A,[SIXBIT /HOSTN/]
SYSGT
PUSH P,B
MOVE A,[SIXBIT /HSTNAM/]
SYSGT
PUSH P,B
MOVEI Y,NHOSTB-1
MOVEI X,SHOSTB-1
MOVEI C,HOSTRG-1
HLLZ D,-1(P)
GTHSTL: HRRZ A,-1(P)
HRL A,D
GETAB
0
MOVEI B,1(C)
HRLI B,(<POINT 7,0>)
TLNN A,(1B0)
JRST [ PUSH Y,B
JRST .+2]
PUSH X,B
MOVE B,A
GTHSTE: HRRZ A,0(P) ; Hostab number
HRL A,B ; Offset
GETAB
0
PUSH C,A ; Store in hostrg
TRNE A,377 ; Done when reach null byte
AOJA B,GTHSTE ; Loop
LDB A,[POINT 9,B,17]
PUSH C,[PUSHJ P,.CVHST]
PUSH C,A
GTHSTN: AOBJN D,GTHSTL
HLLZS X
HLLZS Y
MOVNS X
MOVNS Y
HRRI X,SHOSTB
HRRI Y,NHOSTB
MOVEM X,SHSTAB
MOVEM Y,NHSTAB
SUB P,[XWD 2,2]
SETOM ABNLCK ; Unlock abnormal interrupt handler.
SETOM UCASC
SETOM UCASL
SETOM LCASC
SETOM LCASL
SETOM UNSFT
SETOM QUOT
SETOM BRKC
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
SETZ NOA,
PUSHJ P,SETSCR ; Set up for typescript
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
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
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<NTICHN>!1B<CBFCHN>!1B9!1B11!1B15!7B18]
MOVEI A,400000
AIC ; Activate interrupt channel
; Main command loop
COMLP: TRO F,COMMDF
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,3,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)
TRNN F,REMOTF ; Remote mode?
JRST COMLP ; No. stay in command mode
TRZ F,COMMDF
MOVEI A,"#"
PUSHJ P,.PBOUT
MOVEI A,.CHLFD
PUSHJ P,.PBOUT
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
MOVEI A,100
MOVE B,TTMODR
SKIPE XPARNT(CNX)
TRZ B,3B29
SFMOD ; Set tty mode for remote
RFMOD ; MAKE SURE PAGE MODE IS OFF, SO
TXZ B,TT%PGM ; XON AND XOFF GO THRU TO RMT. LET
STPAR ; REMOTE SITE DO PAGING, IF NEEDED.
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
CAILE B,RECV0 ; If fork will get back to recv0
CAILE B,RECVB+1
JRST REST2 ; Skip the following
MOVEI B,RECV0
SFORK ; Restart fork
REST2: MOVEI A,400000
EIR
MOVE A,RCVFRK(CNX)
RFORK ; And resume
MOVE A,SNDFRK(CNX)
RFORK ; Resume send fork
WFORK ; Should wait forever
HRROI A,[ASCIZ /
Funny fork termination. Restarted./]
PUSHJ P,.PSOUT
JRST RSTART
; Abnormal interrupts come here
BADINT: 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 X,ABNCNX ; Get the correct cnx
PUSHJ P,DISC1
JRST ESCINZ
; Clear outbuf int comes here
CBFINT: SKIPE 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: SKIPE SNDJFN ; If connection exists,
AOSE QUOTF ; And quote prefix typed,
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,101
TRNE COMMDF ; COMMAND MODE?
CFOBF ; YES, FLUSH OUTPUT
ESCINZ: MOVEI A,100
CFIBF
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 RCVJFN(CNX) ; Connected?
JRST ESCINW ; No, skip this
SETOM SAVSWT(CNX) ; Switch to saving input
MOVE A,RCVFRK(CNX)
RFORK ; Leave running
ESCINW: SKIPE A,SPCFRK ; If there is a special fork
KFORK ; Kill it
SETZM SPCFRK
SKIPE A,AJFN
PUSHJ P,CLRJFN
SETZM AJFN
SKIPE A,JJFN
PUSHJ P,CLRJFN
SETZM JJFN
SKIPE A,IJFN
PUSHJ P,CLRJFN
SETZM IJFN ; Release temporary jfn's
MOVE B,TTMOD0 ; WAS THIS INITIALLY A PAGED TTY?
TXNE B,TT%PGM ; ..
JRST [ MOVEI A,101
RFMOD ; YES. SO TURN SCOPE PAGING BACK ON
TXO B,TT%PGM
STPAR ; ..
JRST .+1 ]
ESCI1: 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
0
XWD 1,ABNINT
XWD 3,NTIINT
XWD 2,CBFINT
REPEAT <^D36-5-ESCCHN>,<XWD 1,BADINT>
FKLVT: FKRET1
FKRET2
FKRET3
FKCHT: 0
XWD 3,RCVINS
REPEAT ^D8,<0>
XWD 2,RCVEOF
XWD 1,IOERR
REPEAT ^D36-^D12,<0>
DEBRK
; Get a character
GCH: PUSHJ P,.PBINX
CAIE A,CDELLN
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
CAME A,QUOT
CAMN A,BRKC
JRST ESPCL
PBOUT
POPJ P,
ESPCL: PUSH P,A
SKIPLE A,QUOT
PBOUT
POP P,A
PBOUT
POPJ P,
; Primary input
.PBINX: PUSHJ P,.PBIN
CAIN A,.CHCRT ;FLUSH CR
JRST .-2
POPJ P,
.PBIN: PUSH P,B
MOVEI A,100
RFMOD ; Will echo be generated?
TRNE B,3B33!3B25
JRST [ MOVEI B,PBOUT0
EXCH B,0(P)
JRST .+2]
POP P,B
PBIN
POPJ P,
; Primary output
.PBOUT: PBOUT
PBOUT0: SKIPN SCRJFN
POPJ P,
PUSH P,B
MOVE B,A
MOVE A,SCRJFN
BOUT
PUSHJ P,SCRUPD
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
; Map fork one to one with this fork through page 177
;also, enable it to interrupt its superior.
; Call: A ; Fork handle
; PUSHJ P,MAPFRK
; Returns
; +1 ; Always. transparent
MAPFRK: PUSH P,C
PUSH P,D
PUSH P,B
rpcap
tlo b,(1b9)
tlo c,(1b9)
epcap
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!1B10!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,SHSTAB
XWD -1,NULTAB
CC(<;*%x>,<JRST DOCOMT>)
CC(<flush.host>,<PUSHJ P,.FLUSH>)
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(<write.modes.for.host>,<PUSHJ P,WRTMDF>)
CC(<!synch!>,<PUSHJ P,SNDSNC>)
CC(<!break!>,<PUSHJ P,SNDBRK>)
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(<socket.map>,<PUSHJ P,.SMAP>)
CC(<netstatus>,<PUSHJ P,.NSTS>)
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(<news>,<PUSHJ P,.NEWS>)
CC(<status.of>,<PUSHJ P,.STAT>)
CC(<disconnect>,<PUSHJ P,.DISC>)
CC(<connection.to>,<PUSHJ P,.CONN>)
COMTAB: XWD TOPC-.,TOPC
YNT: CC(<signal.waiting.output>,<MOVEM NOA,SWOFLG>)
CC(<typescript.to.file>,<PUSHJ P,SETSCR>)
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(<attention.character:>,<PUSHJ P,SETATN>)
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(<FTP>,<PUSHJ P,.STFSK
3>)
CC(<RJS>,<PUSHJ P,.STFSK
5>)
CC(<Terminal.test>,<PUSHJ P,.STFSK
23>)
CC(<Netstatus>,<PUSHJ P,.STFSK
17>)
CC(<Date>,<PUSHJ P,.STFSK
15>)
CC(<Systat>,<PUSHJ P,.STFSK
13>)
CC(<Discard>,<PUSHJ P,.STFSK
11>)
CC(<Echo>,<PUSHJ P,.STFSK
7>)
CC(<logger>,<PUSHJ P,.STFSK
1>)
CC(<%o*%o>,<PUSHJ P,OCTFSK>)
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>)
CC(<load.settings>,<MOVEM NOA,LODFLG>)
SETTAB: XWD STB-.,STB
; Host table
HTP: XWD -1,NHSTAB
XWD -1,SHSTAB
XWD -1,OCTB
HOSTAB: XWD HTP-.,HTP
; 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
; socket map host table
SMTAB: XWD -1,HOSTAB
CC(<all>,<SETOB C,A>)
SMTB: XWD SMTAB-.,SMTAB
; Socket map state table
STTAB: CC(<dead>,<MOVSI A,1B18>)
CC(<clzd>,<MOVSI A,1B19>)
CC(<pndg>,<MOVSI A,1B20>)
CC(<lsng>,<MOVSI A,1B21>)
CC(<rfcr>,<MOVSI A,1B22>)
CC(<clw2>,<MOVSI A,1B23>)
CC(<rfcs>,<MOVSI A,1B24>)
CC(<opnd>,<MOVSI A,1B25>)
CC(<clsw>,<MOVSI A,1B26>)
CC(<datw>,<MOVSI A,1B27>)
CC(<rfn1>,<MOVSI A,1B28>)
CC(<clzw>,<MOVSI A,1B29>)
CC(<rfn2>,<MOVSI A,1B30>)
CC(<kild>,<MOVSI A,1B31>)
CC(<all>,<SETO A,>)
STTB: XWD STTAB-.,STTAB
; Symbol evaluator
SYMVAL: SETO NOA,
SYMVAN: MOVEM PTR,BPTR ; Save beginning of symbol
SYMLUP: PUSHJ P,GCH ; Get a character
CAIN A,CDELCH ;RUBOUT?
JRST DELCH ; Delete character
CAIN A,CRTYPE
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,.CHLFD ; 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,.CHLFD
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,.CHLFD
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,.CHLFD
MOVE A,D
PUSHJ P,ECHOIT
IDPB A,PTR
PUSHJ P,TRMST
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
PUSHJ P,SYMLUK ; Get all the possibilities
PRQUEL: JUMPE X,RETYPE ; All done, retype the line
MOVEI A,.CHLFD
PUSHJ P,.PBOUT ; Eol
TRZ F,TMPF!TMPF2
PRQUEN: ILDB A,0(P)
JUMPE A,PRQUEE
CAIN A,"*"
JRST [ HRROI A,[ASCIZ /<any number of /]
PUSHJ P,.PSOUT
TRO F,TMPF
JRST PRQUEN]
CAIN A,"%"
JRST [ ILDB A,0(P)
CAIN A,"%"
JRST .+1
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/]
CAIN A,"N"+40
HRROI B,[ASCIZ /alphameric/]
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/]
JUMPE B,.+1
MOVEI A,"<"
TRNN F,TMPF
PUSHJ P,.PBOUT
MOVE A,B
PUSHJ P,.PSOUT
TRO F,TMPF2
JRST PRQUEQ]
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,
; News
.NEWS: MOVE B,SHSTAB ;GET TABLE POINTER
NEWS1: HRRZ X,0(B) ;GET ADDRESS OF START OF STRING
MOVE A,0(X) ;GET FIRST WORD OF STRING
CAMN A,[ASCIZ /BBN/] ;IS IT BBN?
JRST NEWS2 ;YES
AOBJN B,NEWS1 ;NO, GO TRY NEXT ONE
SKIPA A,[361] ;DIDN'T FIND IT USE 361
NEWS2: MOVE A,2(X) ;GET HOST NUMBER
MOVEM A,FHSTN
MOVEM A,FHST
MOVE B,[367]
MOVEM B,FSKT
JRST CONNX1
; Connect.to
.CONN: MOVE TAB,HOSTAB
PUSHJ P,SYMVAL
MOVEM A,FHSTN
CONNX: MOVEM A,FHST
SETOM FSKT
CONNX1: MOVSI X,-NCONN
SKIPE SNDJFN(X)
AOBJN X,.-1
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)
SKIPL FSKT
JRST CONN2
PUSHJ P,DEFSKT
PUSHJ P,SETMOD
JRST CONN2 ; Settings not changed
HRROI A,[ASCIZ /(settings loaded) /]
SKIPN CONCSF
PUSHJ P,.PSOUT
CONN2: HRROI A,[ASCIZ /is /]
PUSHJ P,.PSOUT
PUSHJ P,ASNSKT
PUSHJ P,DOICP ; Do icp
JRST [ SKIPN WATFLG ; Failed. wait?
JRST CONFL ; No.
HRROI A,[ASCIZ /incomplete on first try.
Trying again ... /]
SKIPG WATFLG
PUSHJ P,.PSOUT
MOVMS WATFLG
MOVEI A,^D10000
DISMS
JRST .-2]
MOVEI A,7
MOVEI B,20
SKIPLE WATFLG
PUSHJ P,.PBOUT
SOJG B,.-2
HRROI A,[ASCIZ /complete/]
PUSHJ P,.PSOUT
MOVEI A,400000
DIR
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 A,IJFN
MOVEM A,SNDJFN(NCNX)
MOVE A,JJFN
MOVEM A,RCVJFN(NCNX)
SETZM IJFN
SETZM JJFN
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
MOVEI A,400000
EIR
MOVEI A,"."
PUSHJ P,.PBOUT
POPJ P,
CONFL1:CONFL0: HRROI A,[ASCIZ /,
but /]
PUSHJ P,.PSOUT
PUSHJ P,RELCON
JRST CONFLX
CONFL: PUSH P,A
HRROI A,[ASCIZ /incomplete,
because /]
PUSHJ P,.PSOUT
POP P,A
CONFLX: PUSHJ P,.PSOUT
POPJ P,
; Assign 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,
; Perform icp
DOICP: MOVEM A,LSKT(NCNX) ; Remember local socket
MOVE A,PTR
IBP A ; Use area past command string
PUSH P,A ; Save start of string
HRROI B,[ASCIZ /NET:/]
SETZ C,
SOUT
PUSH P,A ; Save where socket number is
MOVE B,LSKT(NCNX)
MOVE C,[1B2+1B3+3B17+10]
NOUT
0
MOVEI B,"."
IDPB B,A
SETZ C,
MOVE B,FHST
TLNE B,-1 ; Number ?
JRST [ SOUT ; No, string, use it
JRST ICP9]
MOVEI C,10
NOUT
0
ICP9: MOVEI B,"-"
IDPB B,A
PUSH P,A ; Save where fs begins
MOVE B,FSKT
MOVEI C,10
NOUT
0
HRROI B,[ASCIZ /;T/]
SETZ C,
SOUT
ICPA:MOVE B,-2(P) ; Get beginning of string
MOVEI A,400000
DIR
MOVSI A,1 ; Short form, string pointer
GTJFN
JRST [ JSP X,ICPFL2
ASCIZ /IMP is disconnected./]
MOVEM A,IJFN ; Save jfn to be released if int
MOVEI A,400000
EIR ; Interrupts
TIME
MOVEM A,ICPTIM
MOVE A,IJFN
MOVE B,[XWD 400001,200000]
PUSHJ P,.OPENF
JRST [ PUSHJ P,HSTCHK
JRST [ JSP X,ICPFL2
ASCIZ /host is disconnected./]
JSP X,ICPFL2
ASCIZ /host is rejecting./]
MOVE A,IJFN
BIN ; Get socket number to use
MOVEI A,400000
DIR
MOVE A,IJFN
CLOSF
JFCL
SETZM IJFN
MOVEI A,400000
EIR
POP P,A ; Back to beginning of fs
MOVEI C,10
NOUT
0
HRROI B,[ASCIZ /;T/]
SETZ C,
SOUT
POP P,A ; Get loc of ls
MOVE B,LSKT(NCNX)
ADDI B,2
MOVE C,[1B2+1B3+3B17+10]
NOUT
0
MOVEI B,"."
IDPB B,A
ICPB: MOVE B,0(P) ; Beginning of string
MOVEI A,400000
DIR
MOVSI A,1
GTJFN
JRST [ JSP X,ICPFL1
ASCIZ /no send JFN/]
MOVEM A,IJFN
POP P,B
MOVSI A,1
GTJFN
JRST [ JSP X,ICPFL0
ASCIZ /no recv JFN/]
MOVEM A,JJFN
MOVEI A,400000
EIR
MOVE A,IJFN
MOVE B,[XWD 103402,100000]
OPENF ; Open send, don't wait
JRST [ JSP X,ICPFL0
ASCIZ /send connection can't be opened./]
MOVE A,JJFN
MOVE B,[XWD 100010,200000]
PUSHJ P,.OPENF
JRST [ JSP X,ICPFL0
ASCIZ /receive connection can't be opened./]
MOVE A,IJFN
PUSHJ P,OPNWAT ; Wait for connection to be opened
JRST [ JSP X,ICPFL0
ASCIZ /send connection was not successfully opened./]
TIME
SUBM A,ICPTIM
AOS (P)
POPJ P,
ICPFL2: SUB P,[XWD 2,2]
ICPFL1: SUB P,[XWD 1,1]
ICPFL0: SETOM ICPTIM
PUSHJ P,RELCON
HRROI A,(X)
POPJ P,
RELCON: MOVEI A,400000
DIR
SKIPE A,IJFN
PUSHJ P,CLRJFN
SKIPE A,JJFN
PUSHJ P,CLRJFN
SETZM IJFN
SETZM JJFN
MOVEI A,400000
EIR
POPJ P,
OPNWAT: PUSH P,A
JRST OPNWT0
.OPENF: PUSH P,A
TLO B,3000
OPENF
JRST OPNFL1
OPNWT0: SETOM NTICNT
MOVEI B,24
MOVSI C,777700+NTICHN
MTOPR ; Cause fsm state changes to interrupt
OPNWTL: SETOM NTICNT
MOVE A,0(P)
GDSTS
ROT B,4
ANDI B,17
CAIN B,7
JRST OPNWIN
CAIE B,6
JRST OPNFL
MOVEI A,^D100000
AOSN NTICNT ; Increment to 0 if waiting
OPNWTK: DISMS
JRST OPNWTL
OPNWIN: POP P,A
MOVEI B,24
SETO C,
MTOPR
JRST SKPRET
OPNFL1: POP P,A
POPJ P,
OPNFL: POP P,A
CLOSF
JFCL
POPJ P,
NTIINT: MOVEM A,NTIIA
AOSN NTICNT
DEBRK
HRRZ A,RETPC3
CAIE A,OPNWTK
CAIN A,OPNWTK+1 ; Either two locations is ok
SKIPA A,[XWD 10000,OPNWTL]
SKIPA A,NTIIA
MOVEM A,RETPC3
DEBRK
; Disconnect
.DISC: MOVE A,TERM
MOVE X,CNX
CAIN A,.CHLFD
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
SKIPN RCVJFN(X)
POPJ P, ; No connection
MOVE A,RCVFRK(X)
FFORK
SKIPE A,RCVJFN(X)
PUSHJ P,CLRJFN
SKIPE A,SNDJFN(X)
PUSHJ P,CLRJFN
SETZM RCVJFN(X)
SETZM SNDJFN(X)
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
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/]
; Wait for a connection wanting to print
WATRET: MOVSI X,-NCONN
WATREL: SKIPG 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
MOVEI A,101
MOVE B,SNDJFN(B)
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,.CHLFD
PUSHJ P,.PBOUT
LSTCOX: AOBJN X,LSTCOL
HRROI A,[ASCIZ /
No saved connections./]
TRZN F,TMPF
PUSHJ P,.PSOUT
POPJ P,
; Set mode switches
SETMOD: SKIPN LODFLG
POPJ P,
PUSHJ P,OPNMDF ; Open mode file
POPJ P, ; Non-existent
JFCL ; Ok if we can't write
PUSHJ P,SCHMDF ; Search mode file for the right host
JRST STMDX ; Not found
MOVE C,PMODSW
BIN
MOVEM B,@0(C)
AOBJN C,.-2
AOS (P)
STMDX: PUSHJ P,CLRJFN
SETZM IJFN
POPJ P,
WRTMDF: MOVE TAB,HOSTAB
PUSHJ P,SYMVAL
PUSHJ P,DEFSKT
PUSHJ P,OPNMDF ; Open it
JFCL ; Can't find it
JRST [ HRROI A,[ASCIZ /Cannot write TELNET.MODES/]
PUSHJ P,.PSOUT
SKIPE A,IJFN
PUSHJ P,CLRJFN
SETZM IJFN
POPJ P,]
PUSHJ P,SCHMDF ; See if old settings exist
JRST WRTMD1 ; No, ok to write
HRROI A,[ASCIZ /Confirm /]
PUSHJ P,.PSOUT
PUSHJ P,GCH
CAIE A,.CHLFD
JRST [ HRROI A,[ASCIZ /Not done./]
PUSHJ P,.PSOUT
JRST WRTMDX]
MOVE A,IJFN
WRTMD1: MOVE B,FHSTN
ROUT
MOVE B,FSKT
BOUT
MOVE NCNX,CNX
MOVE C,PMODSW
MOVE B,@0(C)
BOUT
AOBJN C,.-2
WRTMDX: MOVE A,IJFN
PUSHJ P,CLRJFN
SETZM IJFN
POPJ P,
PMODSW: XWD -NMODSW,MODSWP
MODSWP: XWD NCNX,LFCRF
XWD NCNX,ELCLF
XWD NCNX,LNBFF
XWD NCNX,RAISEF
XWD NCNX,JUNK
XWD NCNX,ECHCOC
XWD NCNX,LOWERF
XWD NCNX,JUNK
XWD NCNX,JUNK
XWD NCNX,JUNK
SCHMDF: MOVEI C,0 ; Start with word 0
SCHMDL: RIN ; Read it
JUMPE B,CPOPJ ; End of file
CAME B,FHSTN ; Correct host?
JRST SCHMDN ; Not this, try next
BIN ; Get socket
CAMN B,FSKT ; Correct one?
JRST SKPRET
SCHMDN: ADDI C,NMODSW+2
JRST SCHMDL
OPNMDF: MOVEI A,400000
DIR
HRROI B,[ASCIZ /SYS:TELNET.MODES/]
MOVSI A,1
GTJFN
JRST [ MOVEI A,400000
EIR
POPJ P,]
MOVEM A,IJFN
MOVEI A,400000
EIR
MOVE A,IJFN
MOVE B,[XWD 440000,300000]
OPENF
JRST [ MOVE A,IJFN
TRZE B,100000
JRST .-1
PUSHJ P,CLRJFN
SETZM IJFN
POPJ P,]
TRNE B,100000
AOS (P)
JRST SKPRET
; Status.of
.STAT: MOVEI NCNX,NCONN ; Use this cnx for status
MOVE TAB,HOSTAB
PUSHJ P,SYMVAL
MOVEM A,FHST
PUSHJ P,DEFSKT
PUSHJ P,SETMOD
JFCL
STAT1: MOVEI NCNX,NCONN ; For late-comers
MOVEI A,74 ; Local socket for icp
PUSHJ P,DOICP
JRST STAT2
PUSHJ P,RELCON ; Flush things set up by doicp
HRROI A,[ASCIZ /logger operational./]
STAT2: PUSHJ P,.PSOUT
POPJ P,
; Exec
.EXEC: HRROI B,[ASCIZ /<SYSTEM>EXEC.EXE/]
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,
JRST SBGET
; Socket.map
.SMAP: SETOM FAC
SETOM FAC+1
MOVE A,TERM
CAIN A,.CHLFD
JRST SMAPD
MOVE TAB,SMTB
PUSHJ P,SYMVAL
TLNN A,-1
MOVE C,A
MOVEM C,FAC+0
MOVE A,TERM
CAIN A,.CHLFD
JRST SMAPD
SETZM FAC+1
HRROI A,[ASCIZ /(states) /]
PUSHJ P,.PSOUT
SMAPL: MOVE TAB,STTB
PUSHJ P,SYMVAL
IORM A,FAC+1
MOVE A,TERM
CAIN A,","
JRST SMAPL
SMAPD: MOVEI C,1
JRST NTSTSD
; Netstatus
.NSTS: MOVEI C,0
NTSTSD: HRROI B,[ASCIZ /SYS:NETSTAT.EXE/]
MOVSI A,100001
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)
PUSHJ P,.PBINX
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 SETESC
PRESC: HRROI A,[ASCIZ /
control-@ through control-z
altmode
rubout
space
/]
PUSHJ P,.PSOUT
MOVE A,LPTR
PUSHJ P,.PSOUT
JRST SETESC
; Set terminal modes
SETTRM: MOVE TAB,TRMTAB
JRST SYMVAL
; Set attention character
SETATN: SETOM BRKC
JUMPGE NOA,CPOPJ
PUSHJ P,.PBINX
PUSHJ P,ECHOIT
MOVEM A,BRKC
POPJ P,
; Set synch character
SETSNC: SETOM SYNC
JUMPGE NOA,CPOPJ
PUSHJ P,.PBINX
PUSHJ P,ECHOIT
MOVEM A,SYNC
POPJ P,
; Set single charcter quote prefix
SETQOT: SETOM QUOT
JUMPGE NOA,CPOPJ
PUSHJ P,.PBINX
PUSHJ P,ECHOIT
MOVEM A,QUOT
POPJ P,
; Set unshift prefix
SETUNS: SETOM UNSFT
JUMPGE NOA,CPOPJ
PUSHJ P,.PBINX
PUSHJ P,ECHOIT
MOVEM A,UNSFT
POPJ P,
; 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,CPOPJ ; Done if "no"
PUSH P,A
PUSHJ P,.PBINX
PUSHJ P,ECHOIT
MOVEM A,@(P)
SUB P,[XWD 1,1]
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
SKIPN A,SNDJFN
POPJ P,
MOVEI B,TELNEC
SKIPN ELCLF(CNX)
MOVEI B,TELECH
BOUT
MOVEI B,21
MTOPR
POPJ P,
; 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)
POPJ P,
MOVEI B,22
MTOPR ; Send ins
MOVEI B,TELSNC
BOUT ; And sync character
MOVEI B,21
MTOPR
POPJ P,
; Set control character echoing
SETCOC: PUSHJ P,GCH
CAIN A,"?"
JRST SETCOQ
PUSHJ P,ECHOIT
SETCO2: CAIN A,.CHLFD
MOVEI A,15
MOVEM A,TERM
PUSHJ P,.PBINX
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,.CHLFD
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,.CHLFD
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,.CHLFD
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 BRKC,[ASCIZ /Break: /]
XWD SYNC,[ASCIZ /Synch: /]
NSPECH==.-CSTAB
; Help
.HELP: MOVEI A,400000
DIR
HRROI B,[ASCIZ /HLP:TELNET.MANUAL/]
MOVSI A,100001
GTJFN
JRST [ MOVEI A,400000
EIR
HRROI A,[ASCIZ /HLP:TELNET.MANUAL 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,]
TYPLP: MOVEI X,^D20
TYPLP1: MOVE A,IJFN
MOVE B,[POINT 7,COMBUF]
MOVEI C,200*5-3
MOVEI D,12
SIN
GTSTS
MOVEI A,101
TLNE B,1000
JRST ETYPL
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,.PBINX
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,
; Typescript to a file
SETSCR: SETOM SCRTIM ; TIME OF LAST SCRIPT UPDATE
SETZM SCRCNT ; Characters output since last openf
MOVEI A,400000
DIR
SETZ A,
EXCH A,SCRJFN
SKIPLE A
PUSHJ P,CLRJFN
JUMPGE NOA,[MOVSI A,400001
HRROI B,[ASCIZ /TELNET.TYPESCRIPT;P770000;T/]
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 /
TELNET typescript file started at /]
SETZ C,
SOUT
SETO B,
MOVE C,[1B1+1B7+1B12+1B17]
ODTIM
FMSG <
>
POP P,SCRJFN
MOVEI A,400000
EIR
POPJ P,]
MOVEI A,400000
EIR
MOVSI A,460003
PUSHJ P,.GTJFN
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
PUSHJ P,SCRUPD ; CAUSE FILE TO EXIST
POPJ P,
; Update script file
SCRUPD: SKIPN SCRJFN
POPJ P,
PUSH P,A
PUSH P,B
SKIPGE SCRTIM
JRST SCRUP0 ; Forced update
GTAD
SUB A,SCRTIM ; Ho long since last update?
MUL A,[^D<24*60*60>] ; CONVERT FROM FRACTION TO SECONDS
DIV A,[EXP 1B17] ; ..
CAIG A,^D30
JRST SCRUPX ; Never less than 30 secs
CAIL A,^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: GTAD
MOVEM A,SCRTIM ; LATEST UPDATE TIME
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,
; 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,
; Print where we are
.WHERE: MOVEI A,.CHLFD
PUSHJ P,.PBOUT
SKIPN 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
MOVEI A,101
MOVE B,SNDJFN(CNX)
MOVSI C,(<BYTE (3)0,0,1>)
JFNS
SKIPE A,SCRJFN
JFNS
HRROI A,[ASCIZ / to /]
PUSHJ P,.PSOUT
MOVEI A,101
MOVE B,SNDJFN(CNX)
MOVSI 3,(<BYTE (3)0,0,0,1>)
JFNS
SKIPE A,SCRJFN
JFNS
MOVEI A,.CHLFD
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 /
TELNET version /]
PUSHJ P,.PSOUT
VERTYP: LDB B,[POINT 9,VERSIO,11] ;GET MAJOR VERSION
MOVEI A,101 ;TYPE VERSION
MOVEI C,10 ;OCTAL NUMBERS
SKIPE B ;PRINT IF NON-ZERO
PUSHJ P,.NOUT
JFCL
LDB A,[POINT 6,VERSIO,17] ;GET MINOR VERSION
JUMPE A,VERSI1 ;SKIP IF 0
SUBI A,1
IDIVI A,^D26 ;MAKE 2 LETTERS
JUMPE A,VERSI0 ;ANY FIRST LETTER?
HRRZI A,"A"-1(A) ;YES PRINT IT
PUSHJ P,.PBOUT
VERSI0: HRRZI A,"A"(B) ;PRINT SECOND LETTER
PUSHJ P,.PBOUT
VERSI1: HRRZ B,VERSIO ;GET EDIT NUMBER
JUMPE B,VERSI2 ;SKIP IF EDIT IS 0
MOVEI A,"(" ;PRINT OPEN PAREN
PUSHJ P,.PBOUT
MOVEI A,101
PUSHJ P,.NOUT ;PRINT IT
JFCL
MOVEI A,")" ;PRINT CLOSE PAREN
PUSHJ P,.PBOUT
VERSI2: LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
JUMPE B,VERSI3 ;SKIP IF ZERO
MOVEI A,"-" ;PRINT -
PUSHJ P,.PBOUT
LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
MOVEI A,101
PUSHJ P,.NOUT ;PRINT IT
JFCL
VERSI3: POPJ P,
; Request monitor to send reset to a host
; Is nop if not wheel
.FLUSH: MOVE TAB,HOSTAB
PUSHJ P,SYMVAL
TLNN A,-1
MOVE C,A
PUSH P,C
MOVEI A,400000
DIR
RPCAP
EXCH C,0(P)
PUSH P,C
TRO C,600000
EPCAP
POP P,A
FLHST
MOVEI A,400000
POP P,C
EPCAP
EIR
POPJ P,
; Reset
.RESET: JRST RSTART
; Logout
.LGOUT: HRROI A,[ASCIZ / [Confirm] /]
PUSHJ P,.PSOUT
PUSHJ P,.PBINX
CAIE A,.CHLFD
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
MOVEI A,400000
DIR
HALTF
MOVEI A,-4
FFORK
MOVEI A,400000
EIR
POPJ P,
; Send code and control
SNDDCD: IBP BPTR
PUSHJ P,CVDEC
JRST SNDC
SNDOCD: IBP BPTR
SNDOCT: PUSHJ P,CVOCT
JRST SNDC
SNDHCD: IBP BPTR
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
PUSHJ P,SYMVAL
ANDI A,37
JRST SNDC
SNDBRK: SKIPA A,[TELBRK]
SNDCD1: PUSHJ P,CVOCT
SNDC: MOVE B,A
SKIPN A,SNDJFN(CNX)
POPJ P,
BOUT
MOVEI B,21
MTOPR
POPJ P,
; Set remote mode
SETREM: SKIPE SNDJFN(CNX)
TRO F,REMOTF
POPJ P,
DEFSKT: SETZM WATFLG
SETOM LODFLG
MOVEI A,1
MOVEM A,FSKT ; Default socket is 1
DEFSK0: MOVE A,TERM
CAIN A,.CHLFD
POPJ P,
MOVE TAB,SKTTAB
PUSHJ P,SYMVAL ; Look for a possible socket
JRST DEFSK0
; Other routines
.CVHST: MOVE A,C
MOVEM A,FHST
MOVE C,2(B)
MOVEM C,FHSTN
CAME TAB,COMTAB
POPJ P,
MOVE A,FHST
JRST CONNX
; Check if host is up
HSTCHK: PUSH P,A
PUSH P,B
MOVE A,[SIXBIT /IMPHRT/]
SYSGT
PUSH P,B
MOVE A,FHSTN
IDIVI A,^D36
HRLM A,0(P)
POP P,A
GETAB
SETZ A,
ROT A,(B)
SKIPGE A
AOS -2(P)
POP P,B
POP P,A
POPJ P,
; Set socket number
.STFSK: SKIPA A,2(B)
OCTFSK: PUSHJ P,CVOCT
MOVEM A,FSKT
POPJ P,
DOCOMT: PUSHJ P,GCH
PUSHJ P,ECHOIT
CAIE A,.CHLFD
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
MOVE P,[XWD -100,SPDL-1]
MOVE PTR,[POINT 7,LINBUF-1,34]
SEND0: PUSHJ P,.PBIN
ANDI A,177
SKIPE XPARNT(CNX) ; Completely transparent?
JRST [ MOVE B,A ; Yes
MOVE A,SNDJFN(CNX)
BOUT
MOVEI B,21
MTOPR
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,BRKC ; Break substitute?
JRST [ MOVEI A,TELBRK ; Yes, send break
JRST SEND3]
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
REPEAT 0,<
CAIN A,37
JRST [ MOVEI 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 B,PTR
MOVE A,SNDJFN(CNX)
SETZ C,
SOUT
MOVEI B,21
MTOPR
POPJ P,
SNDDO: SKIPE LNBFF(CNX)
JRST SNDLBF
MOVE B,A
MOVE A,SNDJFN(CNX)
BOUT
PUSH P,B
MOVEI B,21
MTOPR
POP P,B
MOVE A,B
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
MOVE B,ECHCOC(CNX)
ROT B,(A) ; Prepare to test coc
CAIGE A,40 ; If not control
JUMPGE B,CPOPJ
PUSHJ P,.PEOUT ; Echo
POPJ P,
SNDLBF: CAIN A,CDELCH
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,CDELLN
JRST [ MOVEI A,"X"
PUSHJ P,.PBOUT
PUSHJ P,.PBOUT
PUSHJ P,.PBOUT
MOVEI A,.CHLFD
PUSHJ P,.PBOUT
MOVE PTR,[POINT 7,LINBUF-1,34]
POPJ P,]
CAIN A,CRTYPE
JRST [ MOVEI A,.CHLFD
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,
RECV: CIS
MOVE A,RCVJFN(CNX)
MOVEI B,24
MOVSI C,017777
MTOPR ; Ins interrupts on channel 1
MOVE P,[XWD -100,SPDL-1]
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: 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: MOVE A,RCVJFN(CNX)
RECVB: BIN
CAIL B,200
JRST RCVCTL ; Process telnet control character
SKIPGE CBFCNT(CNX)
JRST RECV0 ; Flushing output
SKIPE SAVSWT(CNX) ; Saving up the output?
JRST RECVS ; Yes, go put it in buffer
RECV1: SKIPE CLROBF
JRST RECVFL
SKIPLE A,DIVJFN
JRST RECVX
MOVE A,B
PUSHJ P,.PEOUT
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
RECVS: 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?
JRST RECV0 ; 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,.CHLFD
PUSHJ P,.PBOUT
JRST RECV0
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
MOVE A,RCVJFN(CNX)
SKIPN SAVINC(CNX)
SIBE
JRST RECV0
MOVEI C,2
RECVF1: MOVEI A,^D500
DISMS
MOVE A,RCVJFN(CNX)
SIBE
JRST RECV0
SOJG C,RECVF1
SETZM CLROBF
MOVEI A,.CHLFD
PUSHJ P,.PBOUT
MOVE B,D
JRST RECV1
IOERR: HRROI A,[ASCIZ /
IO error for connection /]
JRST GENABN
RCVEOF: MOVE A,[XWD 10000,RECVH]
MOVEM A,FKRET2
SKIPN SAVSWT(CNX)
SKIPE SAVINC(CNX)
DEBRK ; Delay eof response until buffer gone
HRROI A,[ASCIZ /Remote disconnect of /]
GENABN: PUSH P,A
AOSE ABNLCK ; Wait for abnormal interrupt 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 interrupt in superior
MOVEI A,^D100000
DISMS ; And hang
JRST .-2
RCVCTL: CAIN B,TELASC
JRST RECV0 ; Ignore telasc
CAIGE B,205
JRST RCTLDT-200(B)
HRROI A,[ASCIZ /Undefined telnet control /]
PUSHJ P,.PSOUT
MOVEI A,101
MOVEI C,10
PUSHJ P,.NOUT
JFCL
JRST RECV0
RCTLDT: JRST $CFOBF
JRST PRBRK
JRST RECV0
JRST ECHOFF
JRST ECHON
$CFOBF: MOVEI A,1
EXCH A,CBFCNT(CNX) ; Set to 1
JUMPE A,CFOBF0 ; This came first, clear output
SETZM CBFCNT(CNX) ; Came second, clear
JUMPL A,RECV0 ; Jump if not out of phase
MOVEI A,^D5000
DISMS ; Wait for any possible ins
SETZM CBFCNT(CNX) ; And cancel it's remainder
JRST RECV0
CFOBF0: MOVEI A,101
SKIPN SAVSWT(CNX)
CFOBF
JRST RECVY
RCVINS: PUSH P,A
SKIPLE CBFCNT(CNX)
JRST [SETZM CBFCNT(CNX)
JRST RCVINX]
SETOM CBFCNT(CNX)
MOVEI A,101
SKIPN SAVSWT(CNX)
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: POP P,A
DEBRK
PRBRK: SKIPLE A,BRKC
JRST [ PUSHJ P,.PBOUT
JRST RECV0]
HRROI A,[ASCIZ /'break'/]
PUSHJ P,.PSOUT
JRST RECV0
ECHOFF: SKIPE HDX
JRST [ MOVEI B,TELNEC
MOVE A,SNDJFN(CNX)
BOUT ; Tell him he can't
MOVEI B,21
MTOPR
JRST RECV0]
TDZA A,A
ECHON: SETO A,
MOVEM A,ELCLF(CNX)
JRST RECV0
LOC
VARS: VAR
FMODSW: BLOCK 7
SPARE: BLOCK 3
NMODSW==.-FMODSW
EVARS:
RELOC
END START