perm filename TELNET.FAI[S,NET]10 blob
sn#820016 filedate 1986-06-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00037 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE TELNET history
C00009 00003 X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK ALLACT BSACT SUPCCR NWKERR NIORTS ERRHAN ERRINS ERRTNS HSTTAB MRKCHR
C00012 00004 PATCH CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY NOPK TRANSP INSDLP CRP GETXPP GETYPP XPOS SUPDPY QUOTEP LSTESC ESCMOD ARGC ARGV ARGMAX RCBINP TRBINP ECHOP SUPGAP MORTLP SUBNGP SUBPTR SUBBUF DSIBF DSOBF TTOBFR TTOCTR TTOPTR HNUMSZ HNUMTB HPRITB COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF PRTBUF HSTEND DEBUGP MONCMP DPYP DMDPYP NOEDTP ESCHAR USRPRT SMRBLK NETMSK NETTSZ NETTAB NETPRI INTPRI EIPPRI ETHPRI NETNAM EIGHTB
C00021 00005 NAME TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
C00024 00006 INTSER INTSR0 INTSR1 INTSR2
C00026 00007 TELNET MONDLM SEMDLM SCNARG
C00028 00008 SCNAR1 SCNAR2 CHKTTY
C00031 00009 TOPCLR TOPLEV GETHST GETHS1 NOT8BT GETHCH FLSHEX GLOBSW
C00035 00010 GOTHST GOTHS1 PRTLUZ SKPSPC
C00039 00011 HSTSPC IPHCHK GOTHSN HSTLUZ ILLHSN ALPHST MISSWT
C00041 00012 GETPRT ALPPRT ALPPR1 ALPPR2 ALPPR3 ALPPR4 ALPPR5 PRTTAB PRTTNM
C00044 00013 CHKHNM HNUMLP HNUMEN GOTHDB NOSYS HPRILP HPRIL0 HPRIL1 HPRIL2 HPRIL3 HPRIL4 HPRIL5
C00048 00014 GOICP GOICP0 GOICP1 GOIC1A ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
C00054 00015 SLEEPR SLEPRX SLEPR1 GETDCH SNCH CANON CONERR
C00058 00016 TTISER TTISR4 TTYSR5 TTISR2 HAKCOM
C00062 00017 CHRHAK CHRHK0 CHRHK2 CHRHK1 NOTSUP TTISR1 TTISR9 TTISR3
C00066 00018 NTISER NTISR2 NTISR2 NTISR4
C00071 00019 NTISR1 NTIS1A NTISR6 NTISR5 NTISR3 NTISR7 NTISR8
C00075 00020 IACSER TPLMSG OPTMSG RNDMSG SUBSER
C00078 00021 WILLSR WILBAD WONTSR
C00081 00022 DOSR DONTSR
C00083 00023 SNDTYP SNDTY1 SNDTY2
C00084 00024 DCHOUT DCHCKY DCHSND DCHPRT CPOPJ FIXDPY
C00087 00025 DMCTAB GOTESC
C00090 00026 ESCONT ESCL1 ESCL2 BADESC
C00093 00027 ESCTB1
C00095 00028 CMCDSP
C00097 00029 ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
C00099 00030 ECHATM ECHAT2 LCHATM LCHAT2 CLSCON SCRFIX PUNT SUPON SUPOFF SND200 SNDNUL SNDNU2 DBUG NDBUG
C00103 00031 ETRANS LTRANS ESCSET
C00106 00032 APPEND DAPPND
C00109 00033 CLSOFL OPNOFL
C00111 00034 CLSIFL OPNIFS OPNIFL
C00113 00035 DDTCAL HLPMES
C00115 00036 GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
C00118 00037 OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 SWINIP SWINP1 PRHNUM PRHNIP PRDECP PRDEC PROCT PRLOOP ...LIT
C00125 ENDMK
C⊗;
TITLE TELNET ;⊗ history
SUBTTL Definitions
;This is the WAITS Telnet program, implementing the Internet and PUP Telnet
;protocols. It was originally written by Mark Crispin at SU-AI in October 1980.
COMMENT ⊗ History (please record changes):
1980-1983 MRC,ME,TVR Various changes.
01-May-83 JJW,ME Changes for IP/TCP Arpanet service.
18-May-83 JJW Allow numeric IP host numbers.
04-Jun-83 JJW HOSTS3 host numbers now in use.
Ethernet IP/TCP preferred to ARPAnet when possible.
17-Jun-83 ME DTN WAITS mode.
11-Sep-83 JJW No more OTN monitor command.
22-Nov-83 ME Ethernet IP preferred over PUP.
07-Jan-84 JJW Conversion from MIDAS to FAIL.
25-Oct-84 JJW SLEEPR doesn't check message allocation for IMP.
13-Nov-84 JJW Implemented terminal type option for DTN.
Should also be done for transparent-mode TN.
Doesn't work to Unix sites unless their /etc/termcap contains
official terminal names. Non-Unix hosts don't implement the
option yet at all.
01-Feb-85 ME /8 switch sets 8-bit tty/file mode for music transmission
(EIGHTB set). Also, now allows telnetting to an even port
(since NCP is gone).
08-May-86 JJW Print out host name in "Trying ..." messages.
01-Jun-86 JJW Removed FTALTN switch (alternate host addresses), which we
now always use, and took out IFE FTALTN code. Added code
to parse decimal port numbers and port names after host name.
Changed "socket" to "port" everywhere.
history: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
;Assembly switches
IFNDEF OPRPRT,<OPRPRT←←1> ;old protocol Telnet port
IFNDEF NPRPRT,<NPRPRT←←=23> ;default (new protocol) Telnet port
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
IFNDEF FTDPYP,<FTDPYP←←0> ;display Telnet (DTN)
PRINTS/Switches? (Set FTDPYP=1 for DTN, FTDPYP=2 for ANSI simulator)
/
.INSERT TTY:
IFN FTDPYP&1,<
PRINTS/DM simulator version!
/
>;IFN FTDPYP&1
IFN FTDPYP&2,<
PRINTS/ANSI simulator version!
/
IFN FTDPYP&1,<
.FATAL You don't want both of these, do you?
>;IFN FTDPYP&1
>;IFN FTDPYP&2
.INSERT WATSIT[S,SYS] ;Define FTF2, etc.
;⊗ X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK ALLACT BSACT SUPCCR NWKERR NIORTS ERRHAN ERRINS ERRTNS HSTTAB MRKCHR
; 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!*
/]
FOR CMD IN (CMDLST)<
MOVEI CMD
PUSHJ P,NETOCH
>;FOR
PUSHJ P,NETSND
>;DEFINE
;SAIL system bit definitions
INTTTY←←<020000,,0> ;TTY input interrupt
INTCLK←←<000200,,0> ;clock interrupt
DISLIN←←<400000,,0> ;III
DMLIN←← <040000,,0> ;DM
DDDLIN←←<020000,,0> ;DD
PTYLIN←←<004000,,0> ;PTY
IMPBIT←←<001000,,0> ;IMP TTY
SPCBRK←←<000100,,0> ;special activation mode
;SETACT UUO bits
ALLACT←←000040 ;makes all line editor cmds activate too
BSACT←← 000020 ;activate on backspace
SUPCCR←←000002 ;disable control-cr from retrieving line
;Include wonderful network routines
NWKERR: JRST CONERR ;here on errors from NETWRK
NIORTS←←-1 ;include I/O routines
ERRHAN←←-1 ;include automagic error handling
ERRINS←←<JRST NWKERR> ;error instruction
ERRTNS←←-1 ;include error routines
HSTTAB←←-1 ;include host table routines
MRKCHR←←-1 ;read mark bytes as characters
.INSERT NETWRK.FAI[S,NET]
;Include magic display routines
IFN FTDPYP,<.INSERT DISPLY.FAI[S,NET]>
;⊗ PATCH CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY NOPK TRANSP INSDLP CRP GETXPP GETYPP XPOS SUPDPY QUOTEP LSTESC ESCMOD ARGC ARGV ARGMAX RCBINP TRBINP ECHOP SUPGAP MORTLP SUBNGP SUBPTR SUBBUF DSIBF DSOBF TTOBFR TTOCTR TTOPTR HNUMSZ HNUMTB HPRITB COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF PRTBUF HSTEND DEBUGP MONCMP DPYP DMDPYP NOEDTP ESCHAR USRPRT SMRBLK NETMSK NETTSZ NETTAB NETPRI INTPRI EIPPRI ETHPRI NETNAM EIGHTB
SUBTTL Data area
PATCH: BLOCK 40 ;patch space
CORBEG←←. ;beginning area zeroed at startup
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
CRONLY: BLOCK 1 ;-1 → suppress LF's for Pup Telnet
NOPK: BLOCK 1 ;-1 → TTY input no-PK bit set
IFE FTDPYP,<
TRANSP: BLOCK 1 ;-1 → transparent mode
>;IFE FTDPYP
IFN FTDPYP,<
INSDLP: BLOCK 1 ;-1 → insert/delete mode on
CRP: BLOCK 1 ;-1 → last character CR, ignore LF
GETXPP: BLOCK 1 ;-1 → get X position
GETYPP: BLOCK 1 ;-1 → get Y position
XPOS: BLOCK 1 ;X position
SUPDPY: BLOCK 1 ;-1 → META becomes EDIT-NULL
IFE FTDPYP&2,<
QUOTEP: BLOCK 1 ;-1 → control character quoting
>;IFE FTDPYP&2
IFN FTDPYP&2,<
LSTESC: BLOCK 1 ;last escape character seen
ESCMOD: BLOCK 1 ;less than 0 → escape processing.
ARGC: BLOCK 1 ;Number of arguments seen - 1
ARGV: BLOCK 10 ;Arguments to ESC [ ...
ARGMAX←←.-ARGV ; ]
>;IFN FTDPYP&2
>;IFN FTDPYP
;Connection option flags
FOR @! OPT IN (WILL,WONT,DO,DONT)<
OPT!P: BLOCK 1 ;-1 → option in effect
>;FOR
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
;Subnegotiation stuff
SUBNGP: BLOCK 1 ;-1 → subnegotiation in progress
SUBPTR: BLOCK 1 ;byte pointer into SUBBUF
SUBBUF: BLOCK 20 ;subnegotiation text
;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
;Tables for multiple addresses
HNUMSZ←←5 ;max number of host addresses
HNUMTB: BLOCK HNUMSZ ;table of possible host addresses
HPRITB: BLOCK HNUMSZ ;priority to use given networks
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
PRTBUF: BLOCK 4 ;port name stored here
HSTEND←←.-1
DEBUGP: 0 ;-1 → MRC is fooling around
MONCMP: 0 ;-1 → monitor command
IFE FTDPYP,<
DPYP: 0 ;-1 → display terminal
DMDPYP: 0 ;-1 → DM display
NOEDTP: 0 ;1 → NOEDIT display (else zero)
ESCHAR: "↑"-100 ;escape character for printing consoles
>;IFE FTDPYP
USRPRT: 0 ;explicit port number
SMRBLK: 25 ;send Mark (this ought to be in NETWRK)
0 ;status word
6 ;Timing Mark Reply
;Table of networks and their priority to use
;
;This table is HOST DEPENDENT
;
;In the following tables, entries are in the order that we want matching to
;occur. For example, an ARPAnet address will match both the ARPAnet and
;Internet entries, so ARPAnet is put first. That way, it will get the priority
;ARPPRI rather than INTPRI, and Ethernet IP will be preferred if it has an
;Ethernet Internet address.
;Bits to match for various networks
NETMSK: 777700,,0 ;ARPAnet or MILnet
IFE FTF2,<777700,,0> ;SU-Net (using IP)
NN%IP ;Internet
IFE FTF2,<777700,,0> ;SU-Net (using PUP)
NETTSZ←←.-NETMSK
;Table of known networks
NETTAB:
IFE FTF2,<NW%ARP> ;ARPAnet for SAIL
IFN FTF2,<NW%MIL> ;MILnet for LLL
IFE FTF2,<NW%SI> ;SU-Net (IP)
0 ;Internet
IFE FTF2,<NW%SU> ;SU-Net (PUP)
;Table of corresponding priorities. Must all be different for code
;at GOICP1 to work correctly.
NETPRI: ARPPRI::6 ;ARPAnet ;Lower than Ethernet, as is flakey
IFE FTF2,<EIPPRI::11> ;SU-Net (IP) ;Was 7, now make higher priority than PUP
INTPRI::5 ;Internet
IFE FTF2,<ETHPRI::10> ;SU-NET (PUP)
XWD -2,0 ;Unknown network
IFN FTF2,<
EIPPRI:7 ;Make sure these are defined to avoid more conditionals
ETHPRI:10
>;IFN FTF2
;Table of corresponding names
NETNAM: [ASCIZ/Internet/]
IFE FTF2,<[ASCIZ/Internet/]>
[ASCIZ/Internet/]
IFE FTF2,<[ASCIZ/Ethernet/]>
EIGHTB: BLOCK 1 ;-1 → 8-bit binary, incl. files, for music
;⊗ NAME TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
SUBTTL TELNET protocol codes
DEFINE TPC(NAME,CODE)<
NAME←←CODE
[ASCIZ/NAME/]
>;DEFINE
;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
TPC SNDLOC,=23 ;Send location
TPC TTYTYP,=24 ;Terminal type
TPC EOR,=25 ;End of record
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
SETZM EIGHTB ;assume not 8-bit music mode
HRRES EIPPRI
HRRES INTPRI
HRRES ARPPRI
HRRES ETHPRI
MOVE P,[IOWD PDLLEN,PDL] ;set up stack pointer
;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
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 "/"
JRST [ INCHRS
JRST MISSWT ;missing switch
PUSHJ P,GLOBSW
JRST SCNARG ]
CAIN "?" ;? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ;something else there
OUTSTR HLPMES
JRST SCNARG]
CAIE 12
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
;JJW - It seems a bit redundant to have this code so similar to that
;at GETHCH, but that's how MRC originally wrote it. Originally, spaces
;were flushed from the input string, but now they're kept to separate
;host and port specs.
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]
CAIN 15
JRST SCNAR1
CAIE 12
CAIN 175
JRST CHKTTY
IDPB Y ;save character in buffer
SOJG X,SCNAR1
SCNAR2: INCHWL ;flush extra characters
CAIE 12
CAIN 175
JRST CHKTTY
JRST SCNAR2 ;what a loser
;Paw over terminal characteristics
CHKTTY: HRROI 0,[003000,,0]
TTYSET 0, ;get line characteristics
CAMN 0,[-1]
EXIT ;how can I work if detached?
IFE FTDPYP,<
SETZM DPYP ↔ SETZM DMDPYP
TLNE 0,(DISLIN!DMLIN!DDDLIN) ;display?
SETOM DPYP
TLNE 0,(DMLIN) ;DM?
SETOM DMDPYP
HRROI 0,[055000,,NOEDTP]
TTYSET 0, ;get NOEDIT flag (0 or 1)
SKIPE NOEDTP ;skip unless noedit display
TDZA 0,0 ;no EDIT key, make [NULL] the escape char
MOVEI 0,200 ;make <EDIT>[NULL] the escape character
SKIPN DMDPYP ;skip if an individual display terminal
MOVEI 0,"↑"-100 ;not a display, use this as escape char
MOVEM 0,ESCHAR
>;IFE FTDPYP
SKIPN MONCMP
JRST GETHST ;not command; prompt for host
JRST GETHS1 ;no host prompt
;⊗ TOPCLR TOPLEV GETHST GETHS1 NOT8BT GETHCH FLSHEX GLOBSW
SUBTTL Top level
TOPCLR: CLRBFI ;Here after errors
TOPLEV: SKIPE MONCMP ;Called from monitor level?
JRST PUNT
GETHST: SETZM MONCMP ;in case called from null command
HRRES EIPPRI
HRRES INTPRI
HRRES ARPPRI
HRRES ETHPRI
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,[IOWD PDLLEN,PDL] ;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
SETZM USRPRT
SKIPN EIGHTB ;skip if 8-bit music mode
JRST NOT8BT
MOVSI 0,1000 ;set disk buffer headers to 8-bit mode
HLLM 0,DSIBF+1 ;8-bit byte pointer
HLLM 0,DSOBF+1 ;8-bit byte pointer
NOT8BT:
;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]
CAIN X,15
JRST GETHCH
CAIE X,12
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,12
CAIN X,175
JRST GOTHST
JRST FLSHEX ;what a loser
GLOBSW: CAIE 0,"A" ;ARPAnet
CAIN 0,"a"
JRST [ MOVSI 0,1
HLLM 0,ARPPRI
POPJ P, ]
CAIE 0,"E" ;Ethernet
CAIN 0,"e"
JRST [ MOVSI 0,1
HLLM 0,ETHPRI
POPJ P, ]
CAIE 0,"I" ;Internet
CAIN 0,"i"
JRST [ MOVSI 0,1
HLLM 0,INTPRI
HLLM 0,ARPPRI ;Change all Internet priorities
HLLM 0,EIPPRI
POPJ P, ]
CAIN 0,"8"
JRST [ SETOM EIGHTB ;wants 8-bit binary tranmission (music)
POPJ P, ]
OUTSTR [ASCIZ "?
Bad switch: /"]
OUTCHR 0
OUTSTR [ASCIZ/
/]
POPJ P,
;⊗ GOTHST GOTHS1 PRTLUZ SKPSPC
SUBTTL Process host specification
;We still allow various old-style specifications, such as <imp>/<host>
;and <port>,<host> where the default for <port> is octal. However, the
;preferred syntax now is <host> <port> where <host> is a name or IP
;address, and <port> is a name or decimal number.
GOTHST: MOVE Y,[440700,,HSPBUF]
MOVE Z,[440700,,HNMBUF]
ILDB X,Y ;first character tells it all
PUSHJ P,SKPSPC
CAIN X,"/" ;switch?
JRST [ILDB 0,Y
PUSHJ P,GLOBSW
ILDB X,Y
PUSHJ P,SKPSPC
JRST .+1]
JUMPE X,GETHST ;null JCL
CAIL X,"0"
CAILE X,"9"
JRST ALPHST ;alphabetic host specification
PUSHJ P,SWINIP ;get port or host number
JRST GOTHS1 ;not an IP host number
JRST IPHCHK ;check for valid number
GOTHS1: JUMPE X,ILLHSN ;Don't allow number with no punctuation
CAIN X,"/" ;BBN style number?
JRST [ CAILE B,377
JRST ILLHSN
PUSH P,B
ILDB X,Y ;check numericness
CAIL X,"0"
CAILE X,"9"
JRST HSTLUZ
PUSHJ P,SWINIR
POP P,A ;A←host, B←IMP
JUMPE B,ILLHSN
LSH A,=16
ADD B,A
TLO B,(NW%ARP) ;Set network
JRST GOTHSN]
CAIN X,"#" ;XEROX style number
JRST [ SKIPLE A
CAILE A,377
JRST ILLHSN
PUSH P,A
ILDB X,Y ;check numericness
CAIL X,"0"
CAILE X,"9"
JRST HSTLUZ
PUSHJ P,SWINIR
POP P,B ;B←network, A←host
SKIPLE A
CAILE A,377
JRST ILLHSN
LSH B,=8
ADDI B,(A)
TLO B,(NW%SU) ;Set network
MOVEI A,OPRPRT ;Set default port
MOVEM A,USRPRT
JUMPE X,GOTHSN ;if end of string, we're done
CAIE X,"#"
JRST GOTHSN
ILDB X,Y ;skip over #, check for number
JUMPE X,GOTHSN ;trailing # should be there!
CAIL X,"0" ;scan port number
CAILE X,"9"
JRST HSTLUZ
PUSH P,B
PUSHJ P,SWINIR
POP P,B
JUMPL A,PRTLUZ
MOVEM A,USRPRT
JUMPE X,GOTHSN ;make sure this is last thing!
JRST PRTLUZ]
SKIPL A ;octal has priority over decimal
MOVE B,A
;; TRNN B,1 ;homosocketual connection?
;; SETO B,
JUMPLE B,PRTLUZ
MOVEM B,USRPRT
CAIE X,","
CAIN X,"@"
JRST HSTSPC
OUTSTR [ASCIZ/Illegal character in port number
/]
JRST TOPCLR
PRTLUZ: OUTSTR [ASCIZ/Illegal port number
/]
JRST TOPCLR
;Call SKPSPC with current char in X to skip over spaces and tabs.
SKPSPC: CAIE X," "
CAIN X,11
JRST .+2
POPJ P,
ILDB X,Y
JRST SKPSPC
;⊗ HSTSPC IPHCHK GOTHSN HSTLUZ ILLHSN ALPHST MISSWT
;Host specification
HSTSPC: ILDB X,Y ;first character must be numeric
JUMPE X,HSTLUZ
CAIL X,"0"
CAILE X,"9"
JRST ALPHST
PUSHJ P,SWINIP ;get host number
JRST ILLHSN ;not an IP host number
IPHCHK: TLNE B,(NN%IP) ;Make sure number is valid
JRST ILLHSN ;Bad IP format
GOTHSN: JUMPLE B,ILLHSN ;Catch 0 or bad host number
MOVEM B,HOST
CAIE X," "
CAIN X,11
JRST GETPRT ;Parse port specification
JUMPE X,CHKHNM ;end of spec, check host type
HSTLUZ: OUTSTR [ASCIZ/Illegal character in host number
/]
JRST TOPCLR
ILLHSN: OUTSTR [ASCIZ/Illegal host number
/]
JRST TOPCLR
;Alphabetic host specification
ALPHST: IDPB X,Z ;Copy spec into block for HSTNAM
JUMPE X,CHKHNM
ILDB X,Y
CAIE X," "
CAIN X,11
JRST GETPRT ;Space or tab separates host from port
CAIE X,"/" ;Switch?
JRST ALPHST
ILDB 0,Y
PUSHJ P,GLOBSW
ILDB X,Y
JUMPE X,CHKHNM
OUTSTR [ASCIZ/?
Single switch only, please.
/]
JRST GETHST
MISSWT: OUTSTR [ASCIZ/?
Missing switch letter.
/]
JRST GETHST
;⊗ GETPRT ALPPRT ALPPR1 ALPPR2 ALPPR3 ALPPR4 ALPPR5 PRTTAB PRTTNM
;Port specification
GETPRT: PUSHJ P,SKPSPC
JUMPE X,CHKHNM ;Nothing there
CAIL X,"0"
CAILE X,"9"
JRST ALPPRT ;Alphabetic port spec
PUSHJ P,SWINIR
MOVEM B,USRPRT ;Store decimal port number
JRST CHKHNM
ALPPRT: MOVE Z,[440700,,PRTBUF]
ALPPR1: CAIL X,"a"
SUBI X,"a"-"A"
IDPB X,Z
JUMPE X,ALPPR2
ILDB X,Y
JRST ALPPR1
ALPPR2: DMOVE 0,PRTBUF ;Get two words to compare
MOVSI X,-PRTTNM
ALPPR3: HLRZ Y,PRTTAB(X)
CAME 0,(Y) ;Compare first word
JRST ALPPR4
TRNE 0,376 ;Skip if fewer than 5 chars
CAMN 1,1(Y) ;Compare second word
JRST ALPPR5
ALPPR4: AOBJN X,ALPPR3 ;Mismatch, keep checking
OUTSTR [ASCIZ/Unknown port name
/]
JRST TOPCLR
ALPPR5: HRRZ Y,PRTTAB(X) ;Match, get port number
MOVEM Y,USRPRT
JRST CHKHNM
;Table of names for well-known ports
PRTTAB: [ASCIZ/DAYTIME/],,=13
[ASCIZ/DISCARD/],,=9
[ASCIZ/ECHO/],,=7
[ASCIZ/FINGER/],,=79
[ASCIZ/FTP/],,=21
[ASCIZ/METAGRAM/],,=99
[ASCIZ/NAME/],,=42
[ASCIZ/NETSTAT/],,=15
[ASCIZ/NIC-NAME/],,=101
[ASCIZ/OLD-FTP/],,=3
[ASCIZ/OLD-TELNET/],,=1
[ASCIZ/SMTP/],,=25
[ASCIZ/SYSTAT/],,=11
[ASCIZ/TELNET/],,=23
[ASCIZ/TEXT/],,=17
[ASCIZ/TN-TUNNEL/],,=89
[ASCIZ/TTYTST/],,=19
[ASCIZ/WHOIS/],,=43
PRTTNM←←.-PRTTAB
;⊗ CHKHNM HNUMLP HNUMEN GOTHDB NOSYS HPRILP HPRIL0 HPRIL1 HPRIL2 HPRIL3 HPRIL4 HPRIL5
;Host name specified, ask magical routine to find it
CHKHNM: PUSHJ P,MAPHST ;bring host table in core
SKIPE HOST ;host name waiting?
JRST [ MOVE 0,HOST ;no, just try to get an HDB
PUSHJ P,HSTNUM
SETZ 1, ;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
JRST TOPCLR]
JRST [ OUTSTR [ASCIZ/Ambiguous host name.
/]
PUSHJ P,UNMHST
JRST TOPCLR]
MOVSI X,-HNUMSZ
HNUMLP: MOVEM HNUMTB(X) ;Save a network address
PUSHJ P,HSTNXA ;Get next host address
JRST HNUMEN ; No more addresses
AOBJN X,HNUMLP ;Go back for more addresses
HNUMEN: SETZM HNUMTB+1(X) ;Mark end of table
GOTHDB: SETZM HNMBUF
TRNN 1,-1 ;This host got a name?
JRST NONAME
HRLZ X,1
HRRI X,HNMBUF
BLT X,HNMBUF+HSTNLN-1 ;Copy name to HNMBUF
NONAME:
IFE FTDPYP,<
TLNN 1,-1 ;any system spec?
JRST NOSYS ;unknown system
MOVE USRPRT
CAIE NPRPRT
JUMPN 0,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
MOVSI X,-HNUMSZ ;Scan host number table
HPRILP: SKIPN Z,HNUMTB(X) ;Get host number or end mark
JRST HPRIL2
MOVSI 1,-NETTSZ ;Search networks we know about
HPRIL0: MOVE Y,Z ;Get host number
AND Y,NETMSK(1) ;Mask bits we're interested in
CAME Y,NETTAB(1) ;Is this a network we know about?
AOBJN 1,HPRIL0 ; No, forget it
MOVE NETPRI(1) ;Get priority for using this net
HPRIL1: MOVEM HPRITB(X) ;Save for sorting by priority
AOBJN X,HPRILP ;Repeat for each host address
HPRIL2: HRROM X,HPRITB(X) ;Large negative priority for last
HPRIL3: MOVSI X,-HNUMSZ+1 ;Do one iteration of bubble sort
SETO 1, ;Presume in order
HPRIL4: MOVE HPRITB(X) ;Get first entry
CAML HPRITB+1(X) ;Is next entry higher priority
JRST HPRIL5 ; No
MOVE 1,HNUMTB(X) ;Use two ACs for side effect of setting
;AC 1 ≠ -1
EXCH HPRITB+1(X) ;Swap entries
EXCH 1,HNUMTB+1(X)
MOVEM HPRITB(X)
MOVEM 1,HNUMTB(X)
HPRIL5: SKIPE HNUMTB+1(X) ;End of table?
AOBJN X,HPRIL4 ;Repeat for each table entry
AOJN 1,HPRIL3 ;Start again if at least one swap
;⊗ GOICP GOICP0 GOICP1 GOIC1A ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
SUBTTL ICP ICP ICP
GOICP: PTJOBX [0 ↔ 3] ;local echo off
MOVSI X,-HNUMSZ ;setup for list of addresses to try
SKIPE 1,HOST ;is there an explicit address?
TDZA X,X ; yes
GOICP0: MOVE 1,HNUMTB(X)
JUMPE 1,NOICP
MOVEM 1,HOST
HLRE 0,HPRITB(X) ;is host accessible
AOJL 0,NOICP ; no
OUTSTR [ASCIZ/ Trying /]
SKIPN HNMBUF
JRST GOIC0A
OUTSTR HNMBUF ;Type host name
OUTSTR [ASCIZ/ (/]
GOIC0A: MOVE 0,HPRITB(X) ;Priority uniquely determines network
MOVSI 1,-NETTSZ
GOICP1: CAME 0,NETPRI(1)
AOBJN 1,GOICP1
JUMPGE 1,GOIC1A
OUTSTR @NETNAM(1)
OUTCHR [" "]
GOIC1A: PUSH P,0
MOVE 0,HOST ;Get host number
PUSHJ P,PRHNUM ;Print host number
POP P,0
SKIPE HNMBUF
OUTCHR [")"]
OUTSTR [ASCIZ/ ... /]
MOVEI 1,NPRPRT
CAMN 0,ETHPRI ;If PUP Ethernet, use "old" as default
MOVEI 1,OPRPRT
SKIPE USRPRT ;use only as default
MOVE 1,USRPRT
MOVEM 1,CONFPR ;Set foreign port number
XCT CONECT ;let's take our own errors
JRST [PUSHJ 17,MTPERR ↔ JRST ICPFAI]
JRST [PUSHJ 17,NIOERR ↔ JRST ICPFAI]
JRST GOICP2
ICPFAI: SKIPE HNUMTB+1(X)
AOBJN X,GOICP0 ;check for another
NOICP: SKIPN HOST ;did we try even once?
OUTSTR [ASCIZ/Host not directly accessible.
/] ; no
CLRBFI ;couldn't connect, flush typeahead
EXIT 1,
JRST GETHST
GOICP2: SETZM NPROTP
MOVE 0,CONFPR ;for check below
CAIN 0,NPRPRT
SETOM NPROTP ;using new protocol
OUTSTR [ASCIZ/Open
/]
HRROI 0,[030000,,1] ;set the no-PK bit to hide input buffer
TTYSET 0,
SETOM NOPK
MOVEI 1 ;get type of connection
PNAME 0,
SETZ 0,
MOVSS 0
SKIPN NPROTP ;old protocol PUP connection?
CAIE 'PUP'
JRST NOTPUP ; not PUP or else new protocol
SETOM CRONLY ; yes, sigh...
SETOM ECHOP
NOTPUP:
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 EIGHTB ;no telnet cmds if in 8-bit music mode
SKIPN NPROTP ;new protocol?
JRST GOICP4 ;may be an FTP or something
SNEAKS
JRST GOICP3
CAIN 700 ;if αβ@ typed ahead
SETOM DEBUGP ;MRC is fooling around!
GOICP3: SETOM ECHOP
SETOM SUPGAP
IFE FTDPYP,<
TELCMD <IAC,DO,ECHO,IAC,DO,SUPRGA>
>;IFE FTDPYP
IFN FTDPYP,<
SETOM TRBINP
TELCMD <IAC,DO,ECHO,IAC,DO,SUPRGA,IAC,WILL,TRNBIN,IAC,WILL,TTYTYP>
>;IFN FTDPYP
;Initialize TTY output buffer variables and randomness
GOICP4:
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 CANON 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 allocation, must wait!
HLRZ 0,NETDEV
CAIE 0,'IMP' ;IMP has no message allocations
JUMPE 10,SLEPRX ;if out of message allocation, 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 ;matching '['
OUTSTR [ASCIZ/].
/]
SETZM INPFLP
JRST SLEEPR]
ILDB DSIBF+1
SKIPE EIGHTB ;no echo, no conversion, nulls OK, in 8-bit music mode
JRST CANON
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 ;right-brace
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
IFN FTDPYP,<JRST SCRFIX> ;but fix the screen first dear
JRST NTISER ;no, start slurping
;⊗ TTISER TTISR4 TTYSR5 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,15
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 614 ;αβFORM is like META
JRST [ INCHRW
JRST HAKCOM]
CAIE 613 ;αβVT is like CONTROL-META
JRST CHRHAK
INCHRW
IORI 200
HAKCOM:
>;IFN FTDPYP
IFE FTDPYP,<
CAIN 777 ;αβBS?
JRST [ MOVEI 177 ↔ JRST TTISR1];just an ordinary character
TRZN 400 ;META set?
JRST [ SKIPE EIGHTB ;in 8-bit mode, just output 8-bit char
JRST TTISR1 ; without any conversion
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!
>;IFE 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 NOTSUP TTISR1 TTISR9 TTISR3
;Here only if an ASCII printing character
CHRHAK: SKIPE EIGHTB ;absolute 8-bit music binary mode?
JRST TTISR1 ;yes, no diddling, no echo, just output
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 ;right-brace
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,15
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 ;right-brace
MOVEI 1,175
CAIN 1,32 ;~
MOVEI 1,176
CAIN 1,33 ;≠
MOVEI 1,32
CHRHK1: DPB 1,[000700,,]
IFN 1,<
SKIPN SUPDPY ;skip if want SUPDUP sort of chars
JRST NOTSUP
TRZN 0,400 ;META becomes EDIT-NULL
JRST TTISR1 ;CONTROL remains 200 (EDIT bit)
PUSH P,0
MOVEI 0,200 ;make an EDIT-NULL
PUSHJ P,NETOCH ;and output it to the network
POP P,0 ;get back now-META-less original char
JRST TTISR1 ;and output it as is
NOTSUP:
>;IFN 1
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
SKIPE EIGHTB ;nothing special to do in 8-bit mode
JRST TTISER
CAIN IAC ;IAC must be doubled
SKIPN NPROTP ;but not in old protocol.
SKIPA
JRST TTISR3 ;double the IAC
SKIPE TRBINP ;don't consider CR's if binary mode
JRST TTISER
CAIN 15
TRCA 12≠15 ;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
>;IFE FTDPYP
IFN FTDPYP,<
SKIPE ECHOP
JRST TTISR9
PUSH P, ↔ PUSHJ P,DCHOUT ↔ PUSHJ P,SCNUPD ↔ POP P,
>;IFN FTDPYP
TTISR9: SKIPN CRONLY ;only sending CR's without LF's
TTISR3: PUSHJ P,NETOCH
JRST TTISER
;⊗ NTISER NTISR2 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>
IFN FTDPYP,<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 ;None there. Update screen
PUSHJ P,NETICH ;Check again since we've waited
JRST SLEEPR ;Still nothing
JRST .+1] ;Got more, process it
>;IFN FTDPYP
IFE FTDPYP,<
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
ifn 0,<
NTISR2: SKIPN NPROTP ;old protocol?
TRNN 600 ;command?
JRST NTISR4 ;new protocol or not a command
CAIE 200 ;old TELNET DM
CAIN 401 ;pup TELNET DM
AOS NTOINP
CAIN 203
SETOM ECHOP
CAIN 204
SETZM ECHOP
CAIN 405 ;pup TELNET timing mark?
JRST NTISR8 ; yes, send stupid reply
;Don't look at IAC for PARC's Ethernet TELNET. If it's in this mode, it
;isn't going to know this, and it's a probably a VAX EMACS trying to be
;'10 EMACS and mistakenly echoing a word-delete command (e.g. Meta-Delete).
SKIPN CRONLY ;Don't even try new protocol if CRONLY
CAIE IAC
JRST NTISER ;otherwise some random old command
>;ifn 0
;JJW 5-Oct-83. Flush old protocol; no one uses it. In PUP, some hosts set
;200 as parity bit, so don't interpret such things as commands.
NTISR2: SKIPN CRONLY ;Skip if PUP
JRST NTISR4 ;Not PUP, use new protocol
SKIPN EIGHTB ;save parity bit in 8-bit mode
TRZ 0,200 ;Flush parity bit
TRNN 0,400 ;Mark byte?
JRST NTISR1 ;No, ordinary character
CAIN 0,401 ;PUP telnet DM?
AOS NTOINP
CAIN 0,405 ;PUP telnet timing mark?
JRST NTISR8 ;Yes, send stupid reply
JRST NTISER ;Otherwise some random command
;end JJW change
NTISR4: SKIPE EIGHTB ;no such thing as IAC in 8-bit music mode
JRST NTIS1A
AOSG NETCMP ;IAC in progress?
JRST IACSER
FOR @!OPT IN (WILL,WONT,DO,DONT)<
AOSG OPT!P
JRST OPT!SR
>;FOR
CAIN IAC ;network command?
JRST [ SETOM NETCMP ;remember that one is coming
SETOM NPROTP
JRST NTISER]
SKIPE SUBNGP ;Subnegotiating?
JRST [ IDPB 0,SUBPTR ;Yes, save in buffer
JRST NTISER]
;(continued on next page)
;⊗ NTISR1 NTIS1A NTISR6 NTISR5 NTISR3 NTISR7 NTISR8
;Hack character for output
NTISR1:
IFE FTDPYP,<
SKIPN EIGHTB ;no conversion for 8-bit music
SKIPE TRANSP ;no canonicalization needed if transparent
JRST NTIS1A
JUMPE NTISER ;flush nulls
CAIN 176 ;~
MOVEI 32
CAIN 175 ;right-brace
MOVEI 176
CAIN 33 ;diamond
MOVEI 175
CAIN "G"-100
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 NTISR7
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
NTISR7:
;;;This should be needed, but isn't???
;;; SKIPE CRONLY ;do we need to supply a LF
;;; CAIE 15 ;after a CR?
JRST NTISER ; no
IFE FTDPYP,<
SKIPE TRANSP ;watch out for transparent mode!
JRST NTISER
>;IFE FTDPYP
MOVEI 12 ;fake a LF
JRST NTISR1
;Send timing mark reply for old style PUP (sigh...)
NTISR8: MTAPE 1,SMRBLK ;yes, send Timing Mark Reply
JFCL ;ignore error, interrupt code should see it
JRST NTISER
;⊗ IACSER TPLMSG OPTMSG RNDMSG SUBSER
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]
FOR @! OPT IN (WILL,WONT,DO,DONT)<
CAIN OPT
JRST [SETOM OPT!P
JRST NTISER]
>;FOR
CAIN SB ;Start of subnegotiation?
JRST [ SETOM SUBNGP ;Yes, set flag
MOVE 0,[POINT 7,SUBBUF] ;Initialize pointer
MOVEM 0,SUBPTR
JRST NTISER]
CAIN SE ;End of subnegotiation?
JRST SUBSER
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,
;Subnegotiation
SUBSER: SETZ 0, ;End buffer with a null
IDPB 0,SUBPTR
SKIPE DEBUGP
OUTSTR SUBBUF
MOVE A,[POINT 7,SUBBUF] ;Point to beginning of buffer
ILDB 0,A ;Get subnegotiation option
IFN FTDPYP&1,<
CAIN 0,TTYTYP ;Terminal type?
JRST [ ILDB 0,A
CAIN 0,1 ;Code for "SEND"
PUSHJ P,SNDTYP ;Send reply
JRST NTISER]
>;IFN FTDPYP&1
JRST NTISER ;Not an option we know
;⊗ 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
IFN FTDPYP&1,<
CAIN TTYTYP ;terminal type
JRST [ PUSHJ P,SNDTYP
JRST NTISER]
>;IFN FTDPYP&1
;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
;⊗ SNDTYP SNDTY1 SNDTY2
;Send terminal type in subnegotiation
IFN FTDPYP&1,<
SNDTYP: SKIPE DEBUGP
OUTSTR [ASCIZ/⊗IAC SB TTYTYP IS DATAMEDIA-2500 IAC SE
/]
MOVEI 0,IAC
PUSHJ P,NETOCH
MOVEI 0,SB
PUSHJ P,NETOCH
MOVEI 0,TTYTYP
PUSHJ P,NETOCH
MOVEI 0,0 ;Code for "IS"
PUSHJ P,NETOCH
MOVE A,[POINT 7,[ASCIZ/DATAMEDIA-2500/]]
SNDTY1: ILDB 0,A
JUMPE 0,SNDTY2
PUSHJ P,NETOCH
JRST SNDTY1
SNDTY2: MOVEI 0,IAC
PUSHJ P,NETOCH
MOVEI 0,SE
PUSHJ P,NETOCH
JRST NETSND
>;IFN FTDPYP&1
;⊗ DCHOUT DCHCKY DCHSND DCHPRT CPOPJ FIXDPY
SUBTTL Datamedia simulator
IFN FTDPYP,< ;Whole page
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
IFN FTDPYP&2,<
AOSG ESCMOD ;processing escape sequence?
JRST ESCONT ; yes, parse the fool thing
>;IFN FTDPYP&2
IFE FTDPYP&2,<
AOSE QUOTEP
>;IFE FTDPYP&2
CAIL " " ;if a printing character,
DCHPRT: 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,
;Here for ⊗V command to redraw the screen.
FIXDPY: HRROI A,[4000,,"C"] ;do an ESC C to erase the screen
TTYSET A,
JRST DPYRDW ;force redrawing of everything
>;IFN FTDPYP
;⊗ DMCTAB GOTESC
IFN FTDPYP,< ;Whole page
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
JRST GOTESC ;↑[ quote next character or ANSI ESC
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
GOTESC:
IFN FTDPYP&2,<
SETOM ESCMOD ;Perhaps quote next character
SETZM ARGC ;No arguments yet
SETZM ARGV
>;IFN FTDPYP&2
IFE FTDPYP&2,<
SETOM QUOTEP ;quote next character
>;IFE FTDPYP&2
POPJ P,
>;IFN FTDPYP
;⊗ ESCONT ESCL1 ESCL2 BADESC
SUBTTL ANSI "Standard" display (+ some VT-100 stuff)
IFN FTDPYP&2,<
ESCONT: SKIPN 1,ARGV ;We'll need this sooner or later...
MOVEI 1,1
EXCH 1 ;Argument in 0, character in 1
MOVEM 1,LSTESC ;Remember for iteration and debugging
CAIL 1,"@" ;Is this one we have a table for?
CAILE 1,"P"
JRST ESCL2
SETZM ESCMOD ;Leave this mode.
ESCL1: XCT ESCTB1-"@"(1) ;Routine does POPJ if done.
SOSG ARGV ;More to do?
POPJ P, ;No, done
MOVE 1,LSTESC ;Restore character
JRST ESCL1 ;Try for more.
ESCL2: CAIN 1,"[" ;New standard? (Matching "]")
JRST [ HRROM 1,ESCMOD ; Yes, special treatment (make large
POPJ P,] ; neg. number, value not critical)
CAIN 1,";" ;Separator?
JRST [ SKIPL ESCMOD ;Better be in long mode
JRST BADESC ; Sorry, Charlie
AOS 1,ARGC
CAIL 1,ARGMAX ;Watch for overflow
SOS ARGC ; Keep it dirty but honest
SETZM ARGV(1) ;Default assumption
POPJ P,]
CAIL 1,"0"
CAILE 1,"9"
JRST BADESC
SKIPGE ESCMOD ;Long form?
JRST [ MOVEI -"0"(1) ;Yes, accumulate argument(s)
MOVE 1,ARGC
EXCH ARGV(1)
IMULI 12 ;Decimal?!!
ADDM ARGV(1)
POPJ P,]
SETZM ESCMOD ;Leave this mode.
; XCT ESCTB2-"0"(1)
; POPJ P,
jrst badesc
;Here we have a bad escape sequence. Put this stuff on the page printer if
;in debug mode
BADESC: SETZM ESCMOD ;Leave this mode.
SKIPN DEBUGP ;Looking at lossage?
POPJ P, ; No, just ignore.
OUTSTR [ASCIZ/Bad <ESC>/]
SKIPGE ESCMOD
OUTSTR [ASCIZ/[.../] ;] for balance
OUTCHR 1
OUTSTR [ASCIZ/ /]
POPJ P,
>;IFN FTDPYP&2
;⊗ ESCTB1
;Tables for ANSI mode
IFN FTDPYP&2,< ;Whole page
;These things JRST when they don't wanted to be repeated by ARGV
ESCTB1: JRST INSCHR ;@ ICH Insert Character
PUSHJ P,LINSRV ;A CUU Cursor Up
PUSHJ P,LINEFD ;B CUD Cursor Down
PUSHJ P,CSRAOS ;C CUF Cursor Forward
PUSHJ P,CSRSOS ;D CUB Cursor Backward
PUSHJ P,[PUSHJ P,CARRET ;E CNL Cursor Next Line
MOVNI 1,"E"-"B"
ADDB 1,LSTESC
PUSHJ P,LINEFD
POPJ P,]
PUSHJ P,[PUSHJ P,CARRET ;F CPL Cursor Previous Line
MOVNI 1,"F"-"C"
ADDB 1,LSTESC
PUSHJ P,LINSRV
POPJ P,]
PUSHJ P,[PUSHJ P,CARRET ;G CHA Cursor Horizonal Absolute
MOVNI 1,"G"-"C"
ADDB 1,LSTESC
POPJ P,]
JRST [ SKIPE 0 ;H CUP Cursor Position
SUBI 0,1
SKIPE ARGC
HRL ARGV+1
TLNE 0,-1
SUB 0,[1,,0]
JRST CSRPOS]
PUSHJ P,CSRTAB ;I CHT Cursor Horizonal Tabulation
JRST CLREOF ;J ED Erase in Display
JRST CLREOL ;K EL Erase in Line
JRST INSLIN ;L IL Insert Line
JRST DELLIN ;M DL Delete Line
JRST BADESC ;N EF Erase in Field
JRST BADESC ;O EA Erase in Area
JRST DELCHR ;P DCH Delete Character
>;IFN FTDPYP&2
;⊗ CMCDSP
SUBTTL Command dispatch
;Command dispatch table
CMCDSP: REPEAT 40,<NTISER,,NTISER> ;default to no-op
DEFINE CMDCHR (CHR,CDISP,DISP)<
ORG CMCDSP+"CHR"-"@"
CDISP,,DISP
>;DEFINE
;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 N,SND200,SNDNUL ;send null or EDIT-null
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
IFN FTDPYP,<CMDCHR T,SUPOFF,SUPON> ;supdup char handling on or off
IFN FTDPYP,<CMDCHR V,FIXDPY,FIXDPY> ;redraw screen in DTN
CMDCHR W,RUTHER,RUTHER ;are you there?
IFE FTDPYP,<CMDCHR X,ESCSET,ESCSET> ;set escape character
ORG CMCDSP+40
;⊗ ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
SUBTTL Command service routines
;Send ATTN
ATTN: SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
repeat 0,<
PUSHJ P,NETINS ;send INS
>;repeat 0
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*
/]
repeat 0,<
PUSHJ P,NETINS
>;repeat 0
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 ECHAT2 LCHATM LCHAT2 CLSCON SCRFIX PUNT SUPON SUPOFF SND200 SNDNUL SNDNU2 DBUG NDBUG
;More commands
;Enter character-at-a-time mode
ECHATM: SETOM CHARMP
ECHAT2: HRROI [001000,,(SPCBRK)]
TTYSET ;enter special activation mode
SETACT [[ 777777,,777777 ;activate on everything
777777,,777777 ;just set it up for when we need it
777777,,777777
777777,,600000!ALLACT!BSACT!SUPCCR]]
POPJ P,
;Leave character-at-a-time mode
LCHATM: SETZM CHARMP
LCHAT2: HRROI [002000,,(SPCBRK)]
TTYSET ;leave special activation mode
SETACT [[ 777777,,777777 ;activate on everything
777777,,777777 ;just set it up for when we need it
777777,,777777
777777,,600000!BSACT]]
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
MOVE 0,[-2,,[ 010000,,0 ;Disable αCR
030000,,0]] ;Re-enable PK of input buffer
SKIPE NOPK
TTYSET 0, ;Execute 2 functions above
EXIT
IFN FTDPYP,<
SUPON: SETOM SUPDPY ;enable SUPDUP like char handling
POPJ P, ;(META now means prepend EDIT-NULL)
SUPOFF: SETZM SUPDPY ;disable SUPDUP like char handling
POPJ P,
>;IFN FTDPYP
SND200: MOVEI 0,200 ;send an EDIT-null
JRST SNDNU2
SNDNUL: MOVEI 0,0 ;send a null
SNDNU2: PUSHJ P,NETOCH ;output the character
JRST NETSND ;force out IMP buffers
;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
;;this code moved to initialization to allow changing esc before getting here.
;; 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
JRST [SKIPE CRONLY ;old protocol or in the mode already
SETOM TRBINP ; in PARC Ethernet TELNET, 200 bit
; isn't used for commands, so is safe.
POPJ P,]
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 [ OUTSTR [ASCIZ/No DDT./]
EXIT 1,
POPJ P,] ;no DDT!
OUTSTR [ASCIZ/You're in DDT.
/]
SKIPE CHARMP
PUSHJ P,LCHAT2 ;leave special activation mode
PTJOBX [0 ↔ 4] ;turn on echoing
PUSHJ P,[POP P,JOBOPC↑ ;enter DDT
JRST @JOBDDT↑]
PTJOBX [0 ↔ 3] ;turn off echoing (assuming was off)
SKIPE CHARMP
PUSHJ P,ECHAT2 ;enter special activation mode
POPJ P,
;As random a place as any to put it
HLPMES: ASCIZ/Type a command specificiation in the form:
<host> <port>
where <host> is the host name or number of the remote site, and <port> is
the port name or number (in decimal) of the server of that site you wish
to talk to. The default port number is 23 for ordinary Telnet.
For more information, see the Monitor Command Manual, online as the file
MONCOM.BH[S,DOC], and the updates in MONCOM.UPD[S,DOC].
/
;⊗ GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
SUBTTL Filespec input
;Smashes X, Y, and Z; sets up FSPBLK.
GETFSP: SKIPE CHARMP
PUSHJ P,LCHAT2 ;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,12
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,15
JRST FSPCCR
CAIE Y,12
JRST FSPLUZ
FSPDUN: PTJOBX [0 ↔ 3]
SKIPE CHARMP
PUSHJ P,ECHAT2 ;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 SWINIP SWINP1 PRHNUM PRHNIP PRDECP PRDEC PROCT PRLOOP ...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,15
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
;Super winning IP host number parser. If an IP host number is seen, then it will
;be returned in B and SWINIP will skip return. Otherwise, just like SWINIR.
SWINIP: PUSHJ P,SWINIR ;Parse a number
CAIL X,"0" ;Check the next character
CAILE X,"9"
POPJ P, ;Not a digit, so not an IP host number
PUSH P,B ;Save 1st byte
PUSHJ P,SWINP1 ;Get rest of IP host number left-adj in B
POP P,A ;Restore 1st byte
LSHC A,-=12 ;Right-adjust entire number in B
AOS (P) ;Skip to show IP host number
POPJ P,
;Subroutine to return an IP host number left-adjusted in B.
SWINP1: PUSHJ P,SWINIR ;Get a number
PUSH P,B ;Save it
CAIL X,"0" ;See if a digit follows
CAILE X,"9"
TDZA B,B ;No. Zero B and skip
PUSHJ P,SWINP1 ;Yes, get rest of IP host in B
POP P,A ;Get back current byte
LSHC A,-=8 ;Shift into rest of number
POPJ P,
;Routine to print a host number, either in SU Ethernet or IP format. Takes
;host number in 0.
PRHNUM: TLNE 0,(NN%IP) ;Non-Internet?
JRST PRHNIP ;Yes, print non-IP
LDB 1,[301000,,0]
PUSHJ P,PRDEC ;Print first byte
LDB 1,[201000,,0]
PUSHJ P,PRDECP ;Print period and second byte
LDB 1,[101000,,0]
PUSHJ P,PRDECP ;Print period and third byte
LDB 1,[001000,,0]
JRST PRDECP ;Print period and fourth byte
PRHNIP: HLRZ 1,0 ;Get left half of addr
CAIE 1,(NW%SU) ;SU-Net?
POPJ P, ;No, return quietly
LDB 1,[101000,,0]
PUSHJ P,PROCT ;Print first byte
OUTCHR ["#"]
LDB 1,[001000,,0]
JRST PROCT ;Print second byte
PRDECP: OUTCHR ["."]
PRDEC: SKIPA 3,[=10]
PROCT: MOVEI 3,10
PRLOOP: IDIV 1,3
PUSH P,2
SKIPE 1
PUSHJ P,PRLOOP
POP P,1
ADDI 1,"0"
OUTCHR 1
POPJ P,
...LIT: LIT
END TELNET