perm filename TELNET.OLD[S,NET]2 blob
sn#698986 filedate 1983-01-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00033 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE TELNET
C00006 00003 X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS HSTTAB
C00009 00004 CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP INSDLP CRP QUOTEP GETXPP GETYPP XPOS RCBINP TRBINP ECHOP SUPGAP MORTLP DSIBF DSOBF TTOBFR TTOCTR TTOPTR COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF HSTEND DEBUGP MONCMP OTNCMP DPYP DMDPYP NOEDTP ESCHAR
C00014 00005 TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
C00017 00006 INTSER INTSR0 INTSR1 INTSR2
C00019 00007 TELNET MONDLM SEMDLM SCNARG
C00021 00008 SCNAR1 SCNAR2 CHKTTY
C00023 00009 TOPLEV GETHST GETHS1 GETHCH FLSHEX
C00026 00010 GOTHST NOTNSW
C00028 00011 HSTSPC GOTHSN GOTHS1 HSTLUZ ALPHST
C00030 00012 CHKHNM GOTHDB NOSYS
C00032 00013 GOICP NOTPRT GOICP0 GOICP1
C00035 00014 SLEEPR SLEPRX SLEPR1 GETDCH SNCH CONERR
C00038 00015 TTISER TTISR4 TTISR2 HAKCOM
C00042 00016 CHRHAK CHRHK0 CHRHK2 CHRHK1 TTISR1 TTISR9 TTISR3
C00045 00017 NTISER NTISR2 NTISR4
C00048 00018 NTISR1 NTIS1A NTISR6 NTISR5 NTISR3
C00051 00019 IACSER TPLMSG OPTMSG RNDMSG
C00053 00020 WILLSR WILBAD WONTSR
C00056 00021 DOSR DONTSR
C00058 00022 DCHOUT DCHCKY DCHSND CPOPJ
C00060 00023 DMCTAB
C00063 00024 CMCDSP
C00065 00025 ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
C00067 00026 ECHATM LCHATM CLSCON SCRFIX PUNT DBUG NDBUG
C00069 00027 ETRANS LTRANS ESCSET
C00071 00028 APPEND DAPPND
C00074 00029 CLSOFL OPNOFL
C00076 00030 CLSIFL OPNIFS OPNIFL
C00078 00031 DDTCAL HLPMES
C00080 00032 GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
C00083 00033 OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 ...LIT
C00086 ENDMK
C⊗;
TITLE TELNET
SUBTTL Definitions
; Mark Crispin, SU-AI, October 1980
; Assembly switches
IFNDEF OPRSKT,OPRSKT==1 ; old protocol ICP socket
IFNDEF NPRSKT,NPRSKT==27 ; default (new protocol) ICP socket
IFNDEF HSTNLN,HSTNLN==10. ; host name buffer length
IFNDEF PDLLEN,PDLLEN==50. ; PDL length
IFNDEF TTOBFL,TTOBFL==50. ; TTY output buffer length
IFNDEF CLKSPD,CLKSPD==2. ; number of seconds between clock ints
IFNDEF LOKTMO,LOKTMO==60./CLKSPD ; # of seconds for lock timeout
IF1,[
FTDPYP==0
PRINTX/FTDPYP (≠0 → display hacking) == /
.TTYMAC FOO
IFNB [FOO][FTDPYP==FOO]
TERMIN
];IF1
IF2,[
IFN FTDPYP,[
PRINTX/DM simulator version!
/
];IFN FTDPYP
];IF2
;X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS HSTTAB
; AC definitions. 0→3 (and, at HSTNAM, 4→11) are used by NETWRK.
; 0→6 are used by DISPLY.
; 0 is also used as very temp in the main program.
; X, Y, Z, A, and B are in approximate descending order of usage.
X=7 ? Y=10 ? Z=11 ? A=12 ? B=13 ? P=17
; I/O channels. NETWRK uses 0 and 1.
DSI==2 ? DSO==3
; Macro to send a TELNET command
DEFINE TELCMD CMDLST
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗!CMDLST!*
/]
IRPS CMD,,CMDLST
MOVEI CMD
PUSHJ P,NETOCH
TERMIN
PUSHJ P,NETSND
TERMIN
; SAIL system bit definitions
INTTTY==020000,, ; TTY input interrupt
INTCLK==000200,, ; clock interrupt
DISLIN==400000,, ; III
DMLIN== 040000,, ; DM
DDDLIN==020000,, ; DD
PTYLIN==004000,, ; PTY
IMPBIT==001000,, ; IMP TTY
SPCBRK==000100,, ; special activation mode
BSACT== 000020 ; activate on backspace
; Include wonderful network routines
NIORTS==-1 ; include I/O routines
ERRHAN==-1 ; include automagic error handling
ERRINS==IF1,[0] .ELSE JRST CONERR ; error instruction
ERRTNS==-1 ; include error routines
HSTTAB==-1 ; include host table routines
.INSRT NETWRK
; Include magic display routines
IFN FTDPYP,.INSRT DISPLY
;CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP INSDLP CRP QUOTEP GETXPP GETYPP XPOS RCBINP TRBINP ECHOP SUPGAP MORTLP DSIBF DSOBF TTOBFR TTOCTR TTOPTR COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF HSTEND DEBUGP MONCMP OTNCMP DPYP DMDPYP NOEDTP ESCHAR
SUBTTL Data area
CORBEG==.
FSPBLK: BLOCK 4 ; filespec block
INPFLN: BLOCK 1 ; input filename stuff
INPEXT: BLOCK 1
INPPPN: BLOCK 1
OUTFLN: BLOCK 1 ; output filename stuff
OUTEXT: BLOCK 1
OUTPPN: BLOCK 1
; Flags
TTINTP: BLOCK 1 ; -1 → TTI interrupt
NTINTP: BLOCK 1 ; -1 → NTI interrupt
NTOINP: BLOCK 1 ; ≤ -1 → output should be flushed
CLSINP: BLOCK 1 ; -1 → connection closing
ISLURP: BLOCK 1 ; -1 → in input slurping mode
NTBFOP: BLOCK 1 ; -1 → something in net buffer
NETCMP: BLOCK 1 ; -1 → network command in progress
INPFLP: BLOCK 1 ; -1 → input file opened
SLOWFP: BLOCK 1 ; -1 → input in slow mode
OUTFLP: BLOCK 1 ; -1 → output file opened
CHARMP: BLOCK 1 ; -1 → in character mode
NPROTP: BLOCK 1 ; -1 → using new protocol
IFE FTDPYP,TRANSP: BLOCK 1 ; -1 → transparent mode
.ELSE [
INSDLP: BLOCK 1 ; -1 → insert/delete mode on
CRP: BLOCK 1 ; -1 → last character CR, ignore LF
QUOTEP: BLOCK 1 ; -1 → control character quoting
GETXPP: BLOCK 1 ; -1 → get X position
GETYPP: BLOCK 1 ; -1 → get Y position
XPOS: BLOCK 1 ; X position
];IFN FTDPYP
; Connection option flags
IRPS OPT,,WILL WONT DO DONT
OPT!P: BLOCK 1 ; -1 → option in effect
TERMIN
RCBINP: BLOCK 1 ; -1 → receiving binary
TRBINP: BLOCK 1 ; -1 → transmitting binary
ECHOP: BLOCK 1 ; -1 → remote echoing
SUPGAP: BLOCK 1 ; -1 → suppressing GA
MORTLP: BLOCK 1 ; -1 → foreign job mortality
; Buffer and other stuff
DSIBF: BLOCK 3 ; disk input buffer
DSOBF: BLOCK 3 ; disk output buffer
IFE FTDPYP,[
TTOBFR: BLOCK TTOBFL ; TTY output buffer
TTOCTR: BLOCK 1 ; TTY output counter
TTOPTR: BLOCK 1 ; TTY output pointer
];IFE FTDPYP
COREND==.-1
; Protected storage
PDL: BLOCK PDLLEN ; pushdown list
IDLTIM: BLOCK 1 ; idle timeout count
HSTBEG==.
HSPBUF: BLOCK HSTNLN ; host argument stored here
HNMBUF: BLOCK HSTNLN ; host name stored here
HSTEND==.-1
DEBUGP: 0 ; -1 → MRC is fooling around
MONCMP: 0 ; -1 → monitor command
OTNCMP: 0 ; -1 → OTN monitor command
IFE FTDPYP,[
DPYP: 0 ; -1 → display terminal
DMDPYP: 0 ; -1 → DM display
NOEDTP: 0 ; 1 → NOEDIT display (else zero)
ESCHAR: ↑↑ ; escape character for printing consoles
];IFE FTDPYP
;TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
SUBTTL TELNET protocol codes
DEFINE TPC CODE
CODE
IRPS NAME,,CODE
[ASCIZ/NAME/]
.ISTOP
TERMIN
TERMIN
; Top level codes
TPLTAB:
TPC SE==240. ; subnegotiation end
TPC NOP==241. ; no-op
TPC DM==242. ; data mark
TPC BRK==243. ; break key
TPC IP==244. ; interrupt process
TPC AO==245. ; abort output
TPC AYT==246. ; are you there?
TPC EC==247. ; erase character
TPC EL==248. ; erase line
TPC GA==249. ; go ahead
TPC SB==250. ; subnegotiation
TPC WILL==251. ; sender will do
TPC WONT==252. ; sender won't do
TPC DO==253. ; receiver asked to do
TPC DONT==254. ; receiver must not do
TPC IAC==255. ; interpret as command
TPLMIN==400-<.-TPLTAB>
; Various WILL/WONT/DO/DONT options
WDOTAB:
TPC TRNBIN==0. ; transmit binary
TPC ECHO==1. ; echo
TPC RCP==2. ; reconnect
TPC SUPRGA==3. ; suppress GA
TPC NAMS==4. ; negotiate approx. message size
TPC STATUS==5. ; status option
TPC TIMMRK==6. ; timing mark
TPC RCTE==7. ; remote controlled trans/echo
TPC NAOL==8. ; negotiate output line width
TPC NAOP==9. ; negotiate page size
TPC NAOCRD==10. ; negotiate output CR
TPC NAOHTS==11. ; negotiate output horizontal tab stops
TPC NAOHTD==12. ; negotiate output HT
TPC NAOFFD==13. ; negotiate output FF
TPC NAOVTS==14. ; negotiate output vertical tab stops
TPC NAOVTD==15. ; negotiate output VT
TPC NAOLFD==16. ; negotiate output LF
TPC EXTASC==17. ; Tovar's cretinous idea of extended ASCII
TPC LOGOUT==18. ; logout option
TPC BM==19. ; byte macro
TPC DET==20. ; data entry terminal option
TPC SUPDUP==21. ; SUPDUP (not TELNET) protocol
TPC SDOTPT==22. ; SUPDUP output
WDOMAX==.-WDOTAB-1
EXOPL==255. ; extended options
RNDYLZ==256. ; randomly lose
;INTSER INTSR0 INTSR1 INTSR2
SUBTTL Interrupt server
; Interrupts only set flags which the main program (normally in INTW⊗
; state) looks at. Clock interrupts fake the world since it is possible
; to lose an interrupt otherwise.
INTSER: SKIPN X,JOBCNI ; get interrupt status
JRST 4,.-1
TLNN X,(INTCLK) ; clock int fakes TTI and NTI
JRST INTSR0
TLO X,(INTTTY\INTINP)
AOSN IDLTIM ; bump idle time
UNLOCK ; idle timeout; unlock
INTSR0: TLNE X,(INTTTY) ; TTI int
SETOM TTINTP
TLNE X,(INTINP) ; NTI int
SETOM NTINTP
TLNE X,(INTIMS) ; status change
SETOM CLSINP
TLNN X,(INTINR)
JRST INTSR1
SKIPE DEBUGP
OUTSTR [ASCIZ/*INR*
/]
DISMIS
INTSR1: TLNN X,(INTINS) ; IMP INS int
DISMIS
SOSL NTOINP
JRST INTSR2 ; dismiss interrupt
; Network interrupt, abort all TTY output!
IFE FTDPYP,[
MOVEI X,5*TTOBFL-1 ; reset TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM X,TTOPTR
SETZM X,TTOBFR ; and zap buffer while at it
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
]
INTSR2: SKIPE DEBUGP
OUTSTR [ASCIZ/*INS*
/]
DISMIS ; dismiss interrupt
;TELNET MONDLM SEMDLM SCNARG
SUBTTL Start of program
TELNET: CAI
RESET
SETZM MONCMP
; Scan monitor command line.
RESCAN X
JUMPLE X,CHKTTY ; no command to scan
INCHRS
JRST CHKTTY ; goddam bagbiting lying monitor
TRZ "a#"A ; uppercaseify if necesary
CAIN "S ; maybe SUPDUP command?
JRST [ INCHRS
JRST CHKTTY ; guess not
TRZ "a#"A
CAIE "U ; SUPDUP
CAIN "D ; SD
JRST MONDLM ; SUPDUP or SD command
JRST SEMDLM] ; something else
CAIN "O ; OTN?
JRST [ SETOM OTNCMP
JRST MONDLM]
CAIE "D
CAIN "T
MONDLM: SKIPA X,[" ] ; TELNET or DTN command, scan for space
SEMDLM: MOVEI X,"; ; some other command, use semicolon
SCNARG: INCHRS
JRST CHKTTY
CAIN "? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
JRST SCNARG]
CAIE ↑J
CAIN 175
JRST CHKTTY ; end of command line
CAIE (X)
JRST SCNARG
SETOM MONCMP
; (continued on next page)
;SCNAR1 SCNAR2 CHKTTY
; Gobble down host name from monitor command here
SETZM HSTBEG
MOVE [HSTBEG,,HSTBEG+1]
BLT HSTEND ; zak!
MOVEI X,5*HSTNLN
MOVE Y,[440700,,HSPBUF]
SCNAR1: INCHWL
CAIN "? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
JRST SCNAR1]
CAIE <" >
CAIN ↑M
JRST SCNAR1
CAIE ↑J
CAIN 175
JRST CHKTTY
IDPB Y ; save character in buffer
SOJG X,SCNAR1
SCNAR2: INCHWL ; flush extra characters
CAIE ↑J
CAIN 175
JRST CHKTTY
JRST SCNAR2 ; what a loser
; Paw over terminal characteristics
CHKTTY:
;notyet MOVE 0,[-2,,[030000,,1 ? 003000,,0]] ; set the no-PK bit, get line bits
HRROI 0,[003000,,]
TTYSET 0, ; get line characteristics
CAMN 0,[-1]
EXIT ; how can I work if detached?
IFE FTDPYP,[
SETZM DPYP ? SETZM DMDPYP
TLNE (DISLIN\DMLIN\DDDLIN) ; display?
SETOM DPYP
TLNE (DMLIN) ; DM?
SETOM DMDPYP
HRROI [055000,,NOEDTP]
TTYSET ; get NOEDIT flag (0 or 1)
];IFE FTDPYP
SKIPN MONCMP
JRST GETHST ; not command; prompt for host
JRST GETHS1 ; no host prompt
;TOPLEV GETHST GETHS1 GETHCH FLSHEX
SUBTTL Top level
TOPLEV: SKIPE MONCMP ; called from monitor level?
JRST PUNT
GETHST: SETZM MONCMP ; in case called from null command
OUTSTR [ASCIZ/Host = /]
SETZM HSTBEG
MOVE [HSTBEG,,HSTBEG+1]
BLT HSTEND ; zak!
; Set up the world
GETHS1: RESET ; clear all I/O
MOVE JOBFF
CORE ; smallify
CAI
SETZM CORBEG
MOVE [CORBEG,,CORBEG+1]
BLT COREND ; zak!
MOVE P,[PDL(-PDLLEN)] ; set up stack pointer
OPEN DSI,[0 ? 'DSK,, ? DSIBF] ; get a disk input channel
FATAL DSK OPEN failed
OPEN DSO,[0 ? 'DSK,, ? DSOBF,,] ; get a disk output channel
FATAL DSK OPEN failed
SETACT [[ 777777,,777777 ; activate on everything
777777,,777777 ; just set it up for when we need it
777777,,777777
777777,,600000\BSACT]]
SETZM HOST
SKIPE OTNCMP
SKIPA X,[OPRSKT]
MOVEI X,NPRSKT
MOVEM X,ICPSKT
; Now preprocess the host name
SKIPE MONCMP
JRST GOTHST ; already set up
SETZM HSPBUF
MOVE [HSPBUF,,HSPBUF+1]
BLT HSPBUF+HSTNLN-1
MOVE Y,[440700,,HSPBUF]
MOVEI Z,5*HSTNLN
GETHCH: INCHWL X
CAIN X,775 ; αβALT is magic
PUSHJ P,DDTCAL
ANDI X,177
CAIN X,"? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
INSKIP
JRST TOPLEV
JRST GETHCH]
CAIE X,<" >
CAIN X,↑M
JRST GETHCH
CAIE X,↑J
CAIN X,175
JRST GOTHST
IDPB X,Y ; save character in buffer
SOJG Z,GETHCH
FLSHEX: INCHWL X ; flush extra characters
CAIN X,775 ; αβALT is magic
PUSHJ P,DDTCAL
ANDI X,177
CAIE X,↑J
CAIN X,175
JRST GOTHST
JRST FLSHEX ; what a loser
;GOTHST NOTNSW
SUBTTL Process host specification
GOTHST: MOVE HSPBUF
ANDCM [<ASCII/XXX/>#<ASCII/xxx/>]; convert cases
CAME [ASCII/NSW/] ; happy Geoff
JRST NOTNSW
MOVE [ASCII/33@SR/]
MOVEM HSPBUF
MOVE [ASCII/I-KA/]
MOVEM HSPBUF+1
NOTNSW: MOVE Y,[440700,,HSPBUF]
MOVE Z,[440700,,HNMBUF]
ILDB X,Y ; first character tells it all
JUMPE X,GETHST ; null JCL
CAIL X,"0
CAILE X,"9
JRST ALPHST ; alphabetic host specification
PUSHJ P,SWINIR ; get socket or host number
JUMPE X,GOTHSN ; end of spec, host number
CAIN X,"/ ; BBN style number?
JRST [ CAILE B,377
SETO B,
PUSH P,B
ILDB X,Y ; check numericness
CAIL X,"0
CAILE X,"9
JRST HSTLUZ
PUSHJ P,SWINIR
SKIPN B
SETZM (P)
POP P,A ; A←host, B←IMP
LSH B,9.
ADDI B,(A)
JRST GOTHS1]
SKIPL A ; octal has priority over decimal
MOVE B,A
TRNN B,1 ; homosocketual connection?
SETO B,
JUMPLE B,[ OUTSTR [ASCIZ/Illegal socket number
/]
CLRBFI
JRST TOPLEV]
MOVEM B,ICPSKT
CAIE X,",
CAIN X,"@
JRST HSTSPC
OUTSTR [ASCIZ/Illegal character in socket number
/]
CLRBFI
JRST TOPLEV
;HSTSPC GOTHSN GOTHS1 HSTLUZ ALPHST
; Host specification
HSTSPC: ILDB X,Y ; first character must be numeric
JUMPE X,HSTLUZ
CAIL X,"0
CAIL X,"9
JRST ALPHST
PUSHJ P,SWINIR ; get socket
GOTHSN: SKIPL A
MOVE B,A
GOTHS1: LDB A,[330700,,B] ; check network number
CAIE A,12 ; ARPAnet = 12
SKIPN A ; local network = 0
TDNE B,[600600,,000400] ; make sure number is valid
SETZ B, ; crufty argument
JUMPLE B,[ OUTSTR [ASCIZ/Illegal host number
/]
CLRBFI
JRST TOPLEV]
MOVEM B,HOST
JUMPE X,GOICP ; end of spec
HSTLUZ: OUTSTR [ASCIZ/Illegal character in host number
/]
CLRBFI
JRST TOPLEV
; Alphabetic host specification
ALPHST: IDPB X,Z ; copy spec into block for HSTNAM
JUMPE X,CHKHNM
ILDB X,Y
JRST ALPHST
;CHKHNM GOTHDB NOSYS
; Host name specified, ask magical routine to find it
CHKHNM: PUSHJ P,MAPHST ; bring host table in core
SKIPE HOST ; host name waiting?
JRST [ PUSHJ P,HSTNUM ; no, just try and get an HDB
CAI ; ignore unknown host
JRST GOTHDB]
MOVEI HNMBUF
PUSHJ P,HSTNAM ; get descriptor block for the host
JRST [ OUTSTR [ASCIZ/No such host.
/]
PUSHJ P,UNMHST
CLRBFI
JRST TOPLEV]
JRST [ OUTSTR [ASCIZ/Ambiguous host name.
/]
PUSHJ P,UNMHST
CLRBFI
JRST TOPLEV]
MOVEM HOST
GOTHDB:
IFE FTDPYP,[
TLNN 1,-1 ; any system spec?
JRST NOSYS ; unknown system
MOVE ICPSKT
CAIE NPRSKT
JRST NOSYS ; don't flush line editor if not TELNET
HLRZ X,1
MOVE (X)
CAME [ASCII/ITS/] ; if an ITS,
NOSYS: SKIPN DPYP ; or not a display
];IFE FTDPYP
PUSHJ P,ECHATM ; use character mode
PUSHJ P,UNMHST ; flush host table
;GOICP NOTPRT GOICP0 GOICP1
SUBTTL ICP ICP ICP
GOICP: PTJOBX [0 ? 3] ; local echo off
OUTSTR [ASCIZ/ Trying... /]
MOVE ICPSKT ; for check below
CAIN NPRSKT
SETOM NPROTP
PUSHJ P,CONECT ; call wonderful ICPer
OUTSTR [ASCIZ/Open
/]
IFN FTDPYP,[
PUSHJ P,DPYINI ; init the dpy screen
PUSHJ P,CLRSCN
];IFN FTDPYP
; Initialize interrupts
MOVEI INTSER
MOVEM JOBAPR ; set up interrupt server
CLKINT 60.*CLKSPD ; start the ticking clock
MOVSI (INTTTY\INTCLK\INTINS\INTINR\INTIMS\INTINP)
INTENB ; enable interrupts
; Random other initialization
MOVNI LOKTMO
MOVEM IDLTIM ; initialize lock timeout
LOCK ; prevent swapouts
IFE FTDPYP,[
SKIPE DPYP
JRST NOTPRT
PUSHJ P,ETRANS ; enter transparent mode
];IFE FTDPYP
; If new protocol, flush cretin GA's (we refuse to implement 'em) and try to
; get local echoing.
NOTPRT: SKIPN NPROTP ; new protocol?
JRST GOICP1 ; may be an FTP or something
SNEAKS
JRST GOICP0
CAIN 700 ; if αβ@ typed ahead
SETOM DEBUGP ; MRC is fooling around!
GOICP0:
IFE FTDPYP,[
TELCMD [IAC DO ECHO IAC DO SUPRGA]
];IFE FTDPYP
IFN FTDPYP,[
TELCMD [IAC DO ECHO IAC DO SUPRGA IAC WILL TRNBIN]
];IFN FTDPYP
SETOM ECHOP ? SETOM SUPGAP
; Initialize TTY output buffer variables and randomness
GOICP1:
IFE FTDPYP,[
MOVEI 5*TTOBFL-1 ; set up TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
];IFE FTDPYP
INSKIP
JRST SLEEPR
SETOM TTINTP
; (continued on next page)
;SLEEPR SLEPRX SLEPR1 GETDCH SNCH CONERR
SUBTTL Main program loop
SLEEPR: SKIPL INPFLP ; unless input file open,
SLEPRX: IWAIT ; sleep for an interrupt
SLEPR1: AOSG TTINTP ; TTY int?
JRST TTISER
SKIPN CLSINP ; if closing, keep trying input till lossage
AOSG NTINTP ; NTI int?
JRST NTISER
SKIPL INPFLP ; input file open?
JRST SLEEPR
MOVEI 16 ; get allocations
MTAPE NET,
JUMPE 7,SLEPRX ; if out of bit
JUMPE 10,SLEPRX ; or message allocation, must wait!
GETDCH: SOSG DSIBF+2
IN DSI,
CAIA
JRST [ CLOSE DSI,
PUSHJ P,NETSND
OUTSTR [ASCIZ/End of input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/].
/]
SETZM INPFLP
JRST SLEEPR]
ILDB DSIBF+1
JUMPE GETDCH
; Semi-duplicate of TTYSER's CHRHAK
IFE FTDPYP,[
SKIPN ECHOP ; echo if in local mode
OUTCHR
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST SNCH
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
SNCH:];IFN FTDPYP
; Canonicalize from SAIL to standard ASCII
CAIN 33 ; control-Z
JRST [MOVEI 32 ↔ JRST CANON]
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
CANON:
; Here to actually send the character
PUSHJ P,NETOCH ; output the character
SKIPE SLOWFP ; nice slow file processing?
PUSHJ P,NETSND ; yah, force on every character
JRST SLEPR1
; Here if connection is losing
CONERR: SKIPE CLSINP ; not closing?
SKIPE ISLURP ; error in slurping?
IFE FTDPYP,JRST TOPLEV ; yes, back to top level
.ELSE JRST SCRFIX ; but fix the screen first dear
JRST NTISER ; no, start slurping
;TTISER TTISR4 TTISR2 HAKCOM
SUBTTL TTY input interrupt
TTISER: INCHSL ; get a character
JRST [ AOSG NTBFOP ; anything in the buffer?
PUSHJ P,NETSND ; force it out
AOSG NTINTP ; TTI buffer empty
JRST NTISER ; but some net stuff to handle
JRST SLEEPR]
SKIPL IDLTIM
LOCK
MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
; Command and mapping stuff. We only map between our character set and
; ASCII. Anybody who wants mapping to MIT's character set should use SUPDUP!!
IFE FTDPYP,[
SKIPE TRANSP ; ↑↑ processing if transparent
JRST TTISR4
LDB 1,[000700,,]
CAIN 1,↑M
INCHRW 1 ; flush LF after CR
JRST TTISR2
TTISR4: ANDCMI 400 ; zap image-mode bit
SKIPN NOEDTP ; skip if noedit display -- flush parity bit
SKIPN DMDPYP ; skip if DM-type display (has edit key)
ANDI 177 ; flush the parity bit (no EDIT key)
CAME ESCHAR
JRST CHRHAK ; not escape character
INCHRW
ANDCMI 400 ; turn off image-mode bit
SKIPN NOEDTP ; skip if noedit display -- flush parity bit
SKIPN DMDPYP ; skip if DM-type display (has edit key)
ANDI 177 ; flush the parity bit (no EDIT key)
CAMN ESCHAR ; escape quotes itself
JRST CHRHAK ; send esc char itself
ANDCMI 200 ; clear EDIT bit
CAIE "- ; command off?
JRST TTYSR5 ; no, this is cmd char, do positive cmd (β-char)
INCHRW ; yes, get cmd char
TROA 600 ; form αβcharacter
TTYSR5: IORI 400 ; form βcharacter
TTISR2:
];IFE FTDPYP
CAIN 775 ; αβALT is magic
PUSHJ P,DDTCAL
IFN FTDPYP,[
CAIN 600\↑L ; αβFORM is like META
JRST [ INCHRW
JRST HAKCOM]
CAIE 600\↑K ; αβVT is like CONTROL-META
JRST CHRHAK
INCHRW
IORI 200
HAKCOM:
];IFN FTDPYP
.ELSE [
CAIN 777 ; αβBS?
JRST [ MOVEI 177 ? JRST TTISR1]; just an ordinary character
TRZN 400 ; META set?
JRST [ TRZN 200 ; if CONTROL is set
JRST CHRHAK ; output it, but map
ANDI 37 ; convert to canonical ASCII control
JRST TTISR1] ; never map if we controllified!
];IFN FTDPYP
LDB X,[000700,,0] ; get ASCII part
CAILE X,"←
SUBI X,"a-"A ; uppercaseify if necessary
SUBI X,"@
JUMPL X,NTISER ; no op character
TRNN 200 ; CONTROL?
SKIPA X,CMCDSP(X) ; no, use right half
HLR X,CMCDSP(X) ; yes, use left half
PUSHJ P,(X)
JRST TTISER
;CHRHAK CHRHK0 CHRHK2 CHRHK1 TTISR1 TTISR9 TTISR3
; Here only if an ASCII printing character
CHRHAK:
IFE FTDPYP,[
SKIPE ECHOP ; echo if in local mode
JRST CHRHK0
OUTCHR
SKIPL OUTFLP ; output file in progress?
JRST CHRHK0
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
CHRHK0:
; Canonicalize from SAIL to standard ASCII
SKIPE TRANSP ; no canonicalization need if transparent
JRST [ SKIPN TRBINP ; if not binary mode
ANDCMI 200 ; flush edit bit
JRST TTISR1]
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST CHRHK2
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
CHRHK2: LDB 1,[000700,,] ; get only ASCII part of character
CAIN 1,↑M
JRST [ INCHRW ; oops, line feed lossage
JRST CHRHK1] ; so the CR has the right bucky bits
CAIN 1,175
JRST [ MOVEI 1,33 ; ALT
JRST CHRHK1]
CAIN 1,176 ; }
MOVEI 1,175
CAIN 1,32 ; ~
MOVEI 1,176
CAIN 1,33 ; ≠
MOVEI 1,32
CHRHK1: DPB 1,[000700,,]
TRZE 200 ; if CONTROL is set
TRZ 140 ; convert to canonical ASCII control
TRZE 400 ; and for META
IORI 200 ; set EDIT
];IFN FTDPYP
; Here to actually send the character
TTISR1: PUSHJ P,NETOCH ; output the character
SETOM NTBFOP ; flag there is network output
CAIN IAC ; IAC must be doubled
JRST TTISR3
SKIPE TRBINP ; don't consider CR's if binary mode
JRST TTISER
CAIN ↑M
TRCA ↑J#↑M ; finish off new line
JRST TTISER
IFE FTDPYP,[
SKIPE ECHOP ; echo right on printing terminals
JRST TTISR9
OUTCHR
SKIPL OUTFLP ; output file in progress?
JRST TTISR9
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
TTISR9:
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST TTISR1
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
];IFN FTDPYP
TTISR3: PUSHJ P,NETOCH
JRST TTISER
;NTISER NTISR2 NTISR4
SUBTTL Network input interrupt
NTISER: SKIPE CLSINP ; closing?
JRST [ SKIPN ISLURP ; in slurp mode?
JSP X,[SETOM ISLURP ; tell CONERR we are slurping
IFE FTDPYP,OUTSTR TTOBFR
.ELSE PUSHJ P,SCNUPD
JRST (X)]
PUSHJ P,NETICW ; slurp slurp slurp
JRST NTISR2]
AOSG TTINTP
JRST [ SETOM NTINTP ; make sure we come back here
JRST TTISER] ; give the TTY a chance!
PUSHJ P,NETICH ; get a character
IFN FTDPYP,[
JRST [ PUSHJ P,SCNUPD
JRST SLEEPR]
];IFN FTDPYP
.ELSE [ JRST [ OUTSTR TTOBFR
MOVEI 5*TTOBFL-1 ; reset TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
AOSG TTINTP
JRST TTISER ; TTI int to be taken care of
JRST SLEEPR] ; else sleep
];IFE FTDPYP
SKIPL IDLTIM
LOCK
MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
; Hack protocol commands
NTISR2: SKIPN NPROTP ; old protocol?
TRNN 200 ; command?
JRST NTISR4 ; new protocol or not a command
CAIN 200
AOS NTOINP
CAIN 203
SETOM ECHOP
CAIN 204
SETZM ECHOP
CAIE IAC
JRST NTISER ; otherwise some random old command
NTISR4: AOSG NETCMP ; IAC in progress?
JRST IACSER
IRPS OPT,,WILL WONT DO DONT
AOSG OPT!P
JRST OPT!SR
TERMIN
CAIN IAC ; network command?
JRST [ SETOM NETCMP ; remember that one is coming
SETOM NPROTP
JRST NTISER]
; (continued on next page)
;NTISR1 NTIS1A NTISR6 NTISR5 NTISR3
; Hack character for output
NTISR1: IFE FTDPYP,[
SKIPE TRANSP ; no canonicalization needed if transparent
JRST NTIS1A
JUMPE NTISER ; flush nulls
CAIN 176 ; ~
MOVEI 32
CAIN 175 ; }
MOVEI 176
CAIN 33 ; diamond
MOVEI 175
CAIN ↑G
JRST [ SETO
BEEP
JRST NTISER] ; map bells to bells
CAIN 177 ; rubout is usually padding
JRST NTISER
];IFE FTDPYP
NTIS1A: SKIPGE NTOINP ; no output if still output reset
JRST NTISR3
SKIPE ISLURP
IFN FTDPYP,[
JRST [ PUSH P,
PUSHJ P,DCHOUT
PUSHJ P,SCNUPD
POP P,
JRST NTISR3]
PUSH P,
PUSHJ P,DCHOUT
POP P,
];IFN FTDPYP
IFE FTDPYP,[
JRST [ OUTCHR ; slurp mode can't buffer
JRST NTISR3] ; since it can die at any time!
TRNE 0,177 ; nulls can't be outstr'd, skip if null
TRNE 0,200 ; nor can chars with parity bit set
JRST NTISR6 ; so must use OUTCHR
SOSLE TTOCTR ; buffer stuffed?
JUMPN NTISR5 ; no, put new byte in unless null
NTISR6: OUTSTR TTOBFR ; type out all previous text
MOVEI X,5*TTOBFL-1 ; set up TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM X,TTOPTR
SETZM TTOBFR
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
TRNE 0,177 ; nulls can't be outstr'd
TRNE 0,200 ; nor can chars with parity bit set
JRST [AOS TTOCTR ; bump pointer back up by one
OUTCHR 0 ; output funny char (maybe transparent mode)
JRST NTISR3]
NTISR5: IDPB TTOPTR
];IFE FTDPYP
NTISR3: SKIPL OUTFLP ; output file in progress?
JRST NTISER
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
JRST NTISER
;IACSER TPLMSG OPTMSG RNDMSG
SUBTTL IAC service
IACSER: CAIN IAC ; quoted IAC?
JRST NTISR1 ; just send it
SKIPE DEBUGP
PUSHJ P,TPLMSG
CAIN DM ; data mark?
JRST [ AOS NTOINP
JRST NTISER]
IRPS OPT,,WILL WONT DO DONT
CAIN OPT
JRST [SETOM OPT!P
JRST NTISER]
TERMIN
CAIN SB
WARN Foreign host sent a subnegotiation
JRST NTISER ; not an option I know
; Protocol command message for MRC's fooling around
TPLMSG: OUTSTR [ASCIZ/*IAC /]
CAIGE TPLMIN ; big enough?
JRST @RNDMSG
MOVE 1,
OUTSTR @TPLTAB-TPLMIN(1)
CAIGE WILL
OUTSTR [ASCIZ/*
/]
POPJ P,
; WILL/WONT/DO/DONT option message for MRC's fooling around
OPTMSG: CAIN EXOPL
JRST [ OUTSTR [ASCIZ/ EXOPL*
/]
POPJ P,]
OUTCHR [" ]
CAILE WDOMAX
RNDMSG: JRST [ IDIVI 100
ADDI "0
OUTCHR
IDIVI 1,10
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTSTR [ASCIZ/*
/]
POPJ P,]
MOVE 1,
OUTSTR @WDOTAB(1)
OUTSTR [ASCIZ/*
/]
POPJ P,
;WILLSR WILBAD WONTSR
; IAC WILL/WONT
WILLSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN ; binary from host
JRST [ SKIPE RCBINP ; catch protocol loops
JRST NTISER
SETOM RCBINP
TELCMD [IAC DO TRNBIN]
JRST NTISER]
CAIN ECHO ; remote echo (what a win!)
JRST [ SKIPE ECHOP ; catch protocol loops
JRST NTISER
SETOM ECHOP
TELCMD [IAC DO ECHO]
JRST NTISER] ; command, we always accept it
CAIN SUPRGA ; suppress GA?
JRST [ SKIPE SUPGAP ; command or reply?
JRST NTISER
SETOM SUPGAP
TELCMD [IAC DO SUPRGA]
JRST NTISER]
CAIN LOGOUT
SKIPN MORTLP
JRST WILBAD
JRST NTISER
; Not an option we like, refuse it
WILBAD: PUSH P,
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗IAC DONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI DONT
PUSHJ P,NETOCH
POP P,
SKIPE DEBUGP
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
WONTSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN
JRST [ SKIPN RCBINP
JRST NTISER
SETZM RCBINP
TELCMD [IAC DONT TRNBIN]
JRST NTISER]
CAIN ECHO
JRST [ SKIPN ECHOP
JRST NTISER
SETZM ECHOP ; back to lossage
TELCMD [IAC DONT ECHO]
JRST NTISER]
CAIN SUPRGA
SKIPL SUPGAP
JRST NTISER ; protocol violator
SETZM SUPGAP
TELCMD [IAC DONT SUPRGA]
JRST NTISER ; loser
;DOSR DONTSR
; IAC DO/DONT
DOSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN ; binary to host
JRST [ SKIPE TRBINP ; catch protocol loops
JRST NTISER
SETOM TRBINP
TELCMD [IAC WILL TRNBIN]
JRST NTISER]
CAIN TIMMRK ; silly Multix and Tenex cretinism?
JRST [ TELCMD [IAC WILL TIMMRK]
JRST NTISER] ; yes, make the losers happy
; Not an option we like, refuse it
PUSH P,
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗IAC WONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI WONT
PUSHJ P,NETOCH
POP P,
SKIPE DEBUGP
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
DONTSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN
SKIPN TRBINP
JRST NTISER
SETZM TRBINP
TELCMD [IAC WONT TRNBIN]
JRST NTISER
;DCHOUT DCHCKY DCHSND CPOPJ
SUBTTL Datamedia simulator
IFN FTDPYP,[
DCHOUT: ANDI 177 ; flush buckies
AOSN GETXPP
CAIGE <" > ; controls abort
JRST DCHCKY
XORI 140
CAMLE HSIZE
SETZ
MOVEM XPOS
SETOM GETYPP
POPJ P,
DCHCKY: AOSN GETYPP
CAIGE <" >
JRST DCHSND ; real character to print
XORI 140
CAMLE VSIZE
SETZ
HRL XPOS ; make cursor position for CSRPOS
JRST CSRPOS
DCHSND: CAIN 177
MOVEI "⊗ ; random substitution for rubout
; (conveniently a no-op)
CAIN 176 ; ~
JRST [MOVEI 32 ? JRST SCSTOR]
CAIN 175 ; }
MOVEI 176
AOSE QUOTEP
CAIL <" > ; if a printing character,
JRST [CAIN 32
MOVEI 33 ; sad but necessary conversion
SETZM CRP ; flush CR hacking
SKIPN INSDLP ; if not i/d
JRST SCSTOR ; store it on the screen
PUSH P,
MOVEI 1 ? PUSHJ P,INSCHR; insert character
POP P, ? JRST SCSTOR]
MOVE 1,
XCT DMCTAB(1)
CPOPJ: POPJ P,
;DMCTAB
DMCTAB: CAI ; ↑@ no-op
CAI ; ↑A no-op
JRST [SETZ ? JRST CSRPOS] ; ↑B home up
CAI ; ↑C no-op
CAI ; ↑D no-op
CAI ; ↑E no-op
CAI ; ↑F no-op
JRST [SETO ? BEEP ? POPJ P,] ; ↑G bell
JRST [ SKIPN INSDLP
JRST CSRSOS
MOVEI 1 ? JRST DELCHR] ; ↑H backspace | delete character
JRST CSRTAB ; ↑I tab
JRST [ SKIPE INSDLP
JRST [MOVEI 1 ? JRST INSLIN]
AOSE CRP
JRST LINEFD
POPJ P,] ; ↑J line feed | insert line
CAI ; ↑K no-op
SETOM GETXPP ; ↑L set cursor position
JRST [SETOM CRP ? PUSHJ P,CARRET ? JRST LINEFD]; ↑M move to BOL
CAI ; ↑N no-op
CAI ; ↑O no-op
SETOM INSDLP ; ↑P i/d mode on
CAI ; ↑Q no-op
CAI ; ↑R no-op
CAI ; ↑S no-op
CAI ; ↑T no-op
CAI ; ↑U no-op
CAI ; ↑V no-op
JRST CLREOL ; ↑W clear to end of line
JRST [SETZM INSDLP ? SETZM ROLLP ? POPJ P,]; ↑X cancel
CAI ; ↑Y no-op
JRST [ SKIPN INSDLP
JRST LINSRV
MOVEI 1 ? JRST DELLIN] ; ↑Z line starve | delete line
SETOM QUOTEP ; ↑[ quote next character
JRST [ SKIPN INSDLP
JRST CSRAOS
MOVEI 1 ? JRST INSCHR] ; ↑\ forespace | insert character
SETOM ROLLP ; ↑] scroll on
JRST [SETZM INSDLP ? JRST CLRSCN]; ↑↑ master clear
JRST [SETZM INSDLP ? JRST CLRSCN]; ↑← erase screen
];IFN FTDPYP
;CMCDSP
SUBTTL Command dispatch
; Command dispatch table
CMCDSP: REPEAT 40,[NTISER,,NTISER ? ] ; default to no-op
DEFINE CMDCHR CHR,CDISP,DISP
LOC CMCDSP+"CHR-"@
CDISP,,DISP
TERMIN
; Command dispatch table. All routines are assumed to return via POPJ P,
; CMDCHR character,αβdispatch,βdispatch
CMDCHR @,DBUG,NDBUG ; MRC fooling around
CMDCHR A,ATTN,ATTN ; send ATTN
CMDCHR B,BREAK,BREAK ; send BRK
CMDCHR C,CLSCON,CLSCON ; close connection
CMDCHR D,CLSOFL,OPNOFL ; output file
CMDCHR E,RECHO,LECHO ; echo mode
CMDCHR F,APPEND,DAPPND ; append file
CMDCHR I,CLSIFL,OPNIFL ; input file
CMDCHR J,EOFF,EON ; echo diddle without telling host
CMDCHR K,KJOB,KJOB ; kill remote job
CMDCHR L,ECHATM,LCHATM ; line editor diddle
CMDCHR O,ABORTO,ABORTO ; abort output
CMDCHR Q,PUNT,PUNT ; exit
CMDCHR R,CLSIFL,OPNIFS ; open file in nice slow way
IFE FTDPYP,CMDCHR T,LTRANS,ETRANS ; transparent mode
CMDCHR W,RUTHER,RUTHER ; are you there?
IFE FTDPYP,CMDCHR X,ESCSET,ESCSET ; set escape character
LOC CMCDSP+40
;ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
SUBTTL Command service routines
; Send ATTN
ATTN: SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS ; send INS
SKIPN NPROTP
JRST [ TELCMD [201 200]
POPJ P,]
TELCMD [IAC IP IAC DM] ; and data mark
POPJ P,
; Send break
BREAK: SKIPN NPROTP
POPJ P,
TELCMD [IAC BRK]
POPJ P,
; Send abort output
ABORTO: SKIPN NPROTP
POPJ P,
CLRBFO
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS
TELCMD [IAC AO IAC DM]
POPJ P,
; Send are you there
RUTHER: SKIPN NPROTP
POPJ P,
TELCMD [IAC AYT]
POPJ P,
; Logout
KJOB: SKIPN NPROTP
POPJ P,
SETOM MORTLP
TELCMD [IAC DO LOGOUT]
POPJ P,
; Enter remote echo mode
RECHO: SKIPE ECHOP
POPJ P,
SETOM ECHOP
SKIPN NPROTP
JRST [ TELCMD [204]
POPJ P,]
TELCMD [IAC DO ECHO]
POPJ P,
; Enter local echo mode
LECHO: SKIPN ECHOP
POPJ P,
SETZM ECHOP
SKIPN NPROTP
JRST [ TELCMD [203]
POPJ P,]
TELCMD [IAC DONT ECHO]
POPJ P,
; Echo diddle without asking host
EOFF: SETOM ECHOP ? POPJ P,
EON: SETZM ECHOP ? POPJ P,
;ECHATM LCHATM CLSCON SCRFIX PUNT DBUG NDBUG
; More commands
; Enter character-at-a-time mode
ECHATM: SETOM CHARMP
HRROI [001000,,(SPCBRK)]
TTYSET ; enter special activation mode
POPJ P,
; Leave character-at-a-time mode
LCHATM: SETZM CHARMP
HRROI [002000,,(SPCBRK)]
TTYSET ; leave special activation mode
POPJ P,
; Close connection
CLSCON: PUSHJ P,CLOSER ; close network connection
PUSHJ P,CLSOFL ; close output file
SETZM MONCMP ; forget being a monitor command
IFE FTDPYP,[
MOVE [-2,,[012000,,10 ? 004000,,"P]]
SKIPE TRANSP
TTYSET ; leave image mode and do [ESCAPE]P
];IFE FTDPYP
IFN FTDPYP,[
SCRFIX: HRROI [004000,,400\"N] ; [BREAK]N
TTYSET
];IFN FTDPYP
JRST TOPLEV
; Go away
PUNT:
IFE FTDPYP,[
MOVE [-2,,[012000,,10 ? 004000,,"P]]
SKIPE TRANSP
TTYSET ; leave image mode and do [ESCAPE]P
];IFE FTDPYP
IFN FTDPYP,[
HRROI [004000,,400\"N] ; [BREAK]N
TTYSET
];IFN FTDPYP
HRROI 0,[030000,,0] ; clear the no-PK bit
TTYSET 0,
EXIT
; MRC fooling around
DBUG: SETOM DEBUGP ? POPJ P,
NDBUG: SETZM DEBUGP ? POPJ P,
;ETRANS LTRANS ESCSET
; Non-display commands
IFE FTDPYP,[
; Enter transparent mode
ETRANS: SKIPE DPYP ; DD's and III's can't be transparent
SKIPE DMDPYP ; DM's can be transparent
CAIA
POPJ P,
SETOM TRANSP
HRROI [011000,,10]
TTYSET ; enter image mode
SKIPN DMDPYP
POPJ P, ; not a DM
SKIPE NOEDTP ; skip unless noedit display
TDZA 0,0 ; no EDIT key, make [NULL] the escape char
MOVEI 200 ; make <EDIT>[NULL] the escape character
MOVEM ESCHAR
SKIPN TRBINP
SKIPN NPROTP
POPJ P, ; old protocol or in the mode already
SETOM TRBINP ; diddle the EDIT key
TELCMD [IAC WILL TRNBIN]
POPJ P,
; Leave transparent mode
LTRANS: SKIPN TRANSP
POPJ P,
SETZM TRANSP
MOVE [-2,,[012000,,10 ? 004000,,"P]]
TTYSET ; leave image mode and do [ESCAPE]P
SKIPE TRBINP
SKIPN DMDPYP
POPJ P, ; not a DM or not in the mode
SKIPN NPROTP
POPJ P,
SETZM TRBINP ; diddle the EDIT key
TELCMD [IAC WONT TRNBIN]
POPJ P,
; Set escape character
ESCSET: INCHRW
ANDI 377 ;flush the image mode bit
SKIPN NOEDTP ;skip if noedit display -- flush parity bit
SKIPN DMDPYP
ANDI 177 ;flush the parity bit (no EDIT key)
MOVEM ESCHAR
POPJ P,
];IFE FTDPYP
;APPEND DAPPND
SUBTTL Append file
; Append to a file and always ask
APPEND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Append file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
POPJ P,
; Append but try using defaults
DAPPND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
SKIPN X,OUTFLN
JRST APPEND
MOVEM X,FSPBLK
MOVE X,OUTEXT
MOVEM X,FSPBLK+1
SETZM FSPBLK+2
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
OUTSTR [ASCIZ/Appending to file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/]
/]
POPJ P,
;CLSOFL OPNOFL
SUBTTL Output file
; Close output file
CLSOFL: AOSE OUTFLP ; file open?
POPJ P,
CLOSE DSO, ; close output
OUTSTR [ASCIZ/Output file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
POPJ P,
; Open output file
OPNOFL: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Output file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
SETOM OUTFLP
POPJ P,
;CLSIFL OPNIFS OPNIFL
SUBTTL Input file
; Close input file
CLSIFL: AOSE INPFLP ; file open?
POPJ P,
CLOSE DSI, ; close input
OUTSTR [ASCIZ/Input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
SETZM SLOWFP
POPJ P,
; Open input file
OPNIFS: SETOM SLOWFP
OPNIFL: SKIPGE INPFLP ; file open?
JRST [ OUTSTR [ASCIZ/Input file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Input file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,INPFLN
MOVE FSPBLK+1 ? MOVEM INPEXT
MOVE FSPBLK+3 ? MOVEM INPPPN
LOOKUP DSI,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM SLOWFP
POPJ P,]
SETOM INPFLP
POPJ P,
;DDTCAL HLPMES
SUBTTL DDT bopper
DDTCAL: SKIPN JOBDDT
JRST [ EXIT 1,
POPJ P,] ; no DDT!
OUTSTR [ASCIZ/You're in DDT.
/]
HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
PTJOBX [0 ? 4]
PUSHJ P,@JOBDDT ; enter DDT
PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
POPJ P,
; As random a place as any to put it
HLPMES: ASCIZ/Type a command specificiation in the form:
socket-number,host
where host is the host name or number of the remote site, and
socket-number is the contact socket number of the server of that
site you wish to talk to. The socket number, if present, must
be followed by a comma or an atsign. The default socket number
is 1 for the OTN monitor command and 27 otherwise.
For more information, read TELNET.MRC[UP,DOC].
/
;GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
SUBTTL Filespec input
; Smashes X, Y, and Z; sets up FSPBLK.
GETFSP: HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
IFE FTDPYP,[
HRROI [012000,,10]
SKIPE TRANSP
TTYSET ; leave image mode
];IFE FTDPYP
PTJOBX [0 ? 4] ; echo filespec
SETZM FSPBLK ? SETZM FSPBLK+1 ? SETZM FSPBLK+2
SETZ X,
DSKPPN X,
MOVEM X,FSPBLK+3
PUSHJ P,GETSIX ; get file name
JUMPE X,FSPLUZ
MOVEM X,FSPBLK ; got file name
CAIE Y,".
JRST NOEXT
PUSHJ P,GETSIX ; try for extension
MOVEM X,FSPBLK+1
NOEXT: CAIN Y,↑J
JRST FSPDUN
CAIE Y,"[ ; must be a PPN
JRST FSPLUZ
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLLM X,FSPBLK+3
CAIE Y,",
JRST FSPEOS
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLRM X,FSPBLK+3
FSPEOS: CAIN Y,"]
FSPCCR: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST FSPCCR
CAIE Y,↑J
JRST FSPLUZ
FSPDUN: PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
IFE FTDPYP,[
HRROI [011000,,10]
SKIPE TRANSP
TTYSET ; enter image mode
];IFE FTDPYP
POPJ P,
FSPLUZ: CLRBFI
CAIN Y,175
JRST [ SETZM FSPBLK ; sorry defaulters
OUTSTR [ASCIZ/ Aborted.
/]
JRST FSPDUN]
OUTSTR [ASCIZ/Invalid filespec. Try again: /]
JRST GETFSP
;OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 ...LIT
SUBTTL Sixbit & numeric TTY I/O
; Sixbit output routine. Takes a word in X, smashes Y, flushes spaces.
OUTSIX: SETZ Y,
ROTC X,6
JUMPE Y,OUTSX1
ADDI Y,"A-'A
OUTCHR Y
OUTSX1: JUMPN X,OUTSIX
POPJ P,
; Sixbit input routine. Inputs a sixbit word in X, smashes Y and Z.
GETSIX: SETZ X,
MOVE Z,[440600,,X]
GETSX1: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST GETSX1
CAIL Y,"a ; convert to upper case
CAILE Y,"z
CAIA
SUBI Y,"a-"A
CAIL Y,"0 ; only allow alphanumerics
CAILE Y,"Z
POPJ P,
CAILE Y,"9
CAIL Y,"A
CAIA
POPJ P,
SUBI Y,"A-'A ; convert to sixbit
TRNN X,77 ; don't go beyond last byte
IDPB Y,Z
JRST GETSX1
; Super winning numeric input routine. Numbers are parsed as both octal and
; decimal, unless either (a) an 8 or 9 appears in the number, or (b) the number
; is followed by a decimal point.
SWINIR: SETZB A,B ; A ← octal number, B ← decimal
SWINR1: CAIL X,"8 ; if can't be octal, A ← -1
SETO A,
JUMPL A,SWINR2
LSH A,3
ADDI A,-"0(X) ; bring in next octal digit
SWINR2: IMULI B,10.
ADDI B,-"0(X) ; bring in next decimal digit
ILDB X,Y
CAIN X,". ; decimal point ends spec and forces decimal
JRST [ SETO A,
ILDB X,Y
POPJ P,]
CAIL X,"0
CAILE X,"9
POPJ P, ; non-numeric, return
JRST SWINR1
...LIT: CONSTANTS
END TELNET