perm filename TELNET.FAI[S,NET]31 blob
sn#871970 filedate 1989-04-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00038 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 TITLE TELNET history
C00019 00003 X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK ALLACT BSACT SUPCCR NWKERR NIORTS ERRHAN ERRINS ERRTNS HSTTAB MRKCHR
C00025 00004 Data area PATCH CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY NOPK RWAITS TRANSP 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 COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF PRTBUF HSTEND DEBUGP MONCMP PTYP DPYP DMDPYP NOEDTP ESCHAR RMTDPY RMTHDR NTIQCT USRPRT SMRBLK CRNULL EIGHTB SWTNUM SWTMSK
C00035 00005 NAME TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
C00042 00006 INTSER INTSR0 INTSR1 INTSR2
C00048 00007 TELNET MONDLM SEMDLM SCNARG
C00053 00008 SCNAR1 SCNAR2 TOPCLR TOPLEV CHKTTY
C00059 00009 GETHST GETHS1 NOT8BT GETHCH FLSHEX GLOBSW SWHELP SWLOOP SWHELP SWTFND CHRTAB NUMSWT NUMTAB MSKTAB PRINIT
C00068 00010 GOTH00 GOTHST GOTHS0 GOTHS1 PRTLUZ SKPSPC
C00075 00011 HSTSPC IPHCHK GOTHSN HSTLUZ ILLHSN ALPHST ALPHS2 MISSWT
C00080 00012 GETPRT ALPPRT ALPPR1 ALPPR2 ALPPR3 ALPPR4 ALPPR5 PRTTAB PRTTNM
C00086 00013 CHKHNM CHKHN1 CHKHN3 CHKHN4 CHKHN5 CHKHNT HNUMLP HNUMEN GOTHDB NONAME NOSYS NOSYS1 HCHECK HCHEC1 HCHEC2
C00095 00014 GOICP GOICP0 GOICP1 GOIC1A ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
C00104 00015 SLEEPR SLEPRX SLEPR1 GETDCH SNCH CANON CONERR
C00111 00016 TTISER TTISR4 TTYSR5 TTISR2 HAKCOM
C00118 00017 CHRHAK CHRHK0 CHRHK2 CHRHK1 NOTSUP CTLMTA TTISR1 TTISR9 TTISR3
C00126 00018 NTISER NTISR2 NTISR2 NTISR4
C00134 00019 Hack character for output to terminal NTISR1 NTINOF NTINOR NTIS1A NTISR6 TYPONE NTISR5 NTISR3 NTISR7 NTISR8 RMTOUT RMTOU2 RMTOU3 RMTOUX
C00141 00020 IACSER TPLMSG OPTMSG RNDMSG SUBSER
C00147 00021 WILLSR WILBAD WONTSR
C00153 00022 DOSR DONTSR
C00158 00023 SNDTYP SNDTY1 SNDTY2
C00162 00024 DCHOUT DCHCKY DCHSND DCHPRT CPOPJ FIXDPY
C00168 00025 DMCTAB GOTESC
C00174 00026 ESCONT ESCL1 ESCL2 BADESC
C00180 00027 ESCTB1
C00185 00028 Command dispatch CMCDSP
C00190 00029 ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
C00195 00030 More commands ECHATM ECHAT2 LCHATM LCHAT2 CLSCON SCRFIX PUNT SUPON SUPOFF SND200 SNDNUL SNDNU2 DBUG NDBUG RMTDPN RMTDPF
C00202 00031 ETRANS LTRANS ESCSET
C00208 00032 APPEND DAPPND
C00214 00033 CLSOFL OPNOFL
C00219 00034 CLSIFL OPNIFS OPNIFL
C00221 00035 DPSAVE DPEXCH
C00224 00036 DDTCAL HLPMES
C00229 00037 GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
C00235 00038 OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 SWINIP SWINP1 PRHNUM PRHNIP PRDECP PRDEC PROCT PRLOOP ...LIT
C00240 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.
17-Jul-86 ME Fixed SUBSER to clear SUBNGP (end of subnegotiation string)
(used to hang forever since SUBNGP was never cleared).
Changed WILL TRNBIN to WONT TRNBIN to fix LF problem with Unix
4.3BSD (Navajo).
20 Jul 86 ME Changed WONT TRNBIN back to WILL at GOICP3, since Navajo
4.3 has been fixed.
27 Aug 86 JJW Changed MAPHST and UNMHST to ATTHST and DETHST.
28 Aug 86 JJW Fixed DOSR not to call SNDTYP when IAC DO TTYTYP received.
18 Sep 86 ME Fixed TTISER not to lose any bucky bits typed with a CR
when it is skipping over the following LF (which has buckies).
Note that GOICP3 was again changed back to WONT TRNBIN since
July, because binary mode doesn't seem to be necessary to
get foreign hosts to listen to the 8th bit. I guess only
transparent mode uses telnet binary, and maybe it shouldn't
either.
03 Nov 86 ME Added /P switch to mean prefer PUP 10-meg address.
Also, /3 to prefer 3-meg IP, and /0 to prefer 10-meg IP.
Switch errors return via TOPCLR, to do CLRBFI and maybe exit.
Allow multiple switches; earlier switches have higher priority.
07 Nov 86 JJW Removed network-preference code. We now take adresses in the
order stored by HOSTS3 in the table, or as changed by NETWRK.
Command switches still select preferred address, and avoid
trying others at all.
07 Nov 86 ME Moved TOPCLR/LEV back to before CHKTTY, to ensure knowing
terminal-type info. Made /E mean PUP on 3-meg net only.
25 Nov 86 JJW Added interchange of "_" and "←" to WAITS/ASCII translation.
01 Dec 86 JJW Don't interchange "_" and "←" when remote site is WAITS.
05 Dec 86 JJW Fixed a bug in the "_" ↔ "←" interchange affecting DTN.
12 Dec 86 JJW Fixed a bug in default port selection introduced recently.
11 Jan 87 ME Renamed /E to be /M (MJH 3-meg net). Added /E to mean PUP on
any SU net (which is what /E claimed to be before but wasn't).
16 Aug 87 JJW Call new NAMADR and ADRNAM routines in NETWRK for name/addr
translation using domain queries and host table.
18 Aug 87 JJW Call HSTNBR (which has been in NETWRK for some time) to
handle possible bracketed number supplied as host name.
26 Aug 87 JJW Change calls to NAMADR and ADRNAM to account for hard and
soft error returns.
20 Oct 87 ME Just above NOTPRT, avoid default of transparent mode for
pure PTYs, so they will get SAIL/ASCII character translation.
25 Oct 87 JJW Updated list of Telnet options.
27 Oct 87 JJW Commented out entering binary mode at ETRANS, and turning off
200 bit at CHRHK0 in transparent mode. This works best with
Unix sites, and still works with other systems.
26 Jan 88 JJW SETZM HNMBUF at CHKHNM to avoid printing host number twice.
22 Feb 88 ME CHKHNM uses short domain timeout if looking up host number.
22 Jun 88 ME Fixed GOICP3 not to set TRBINP since it isn't setting binary
mode after all (since July 1986; see above). Changed TTISR1
to follow CR with null instead of LF, to make Jeeves happy.
Hope that doesn't break talking to anyone else.
24 Jun 88 ME New Telnet mode (for DMWAITS) in which the terminal is not
put into image mode, but output from the remote host is
output verbatim and input is mapped just like DTN. Commands
are also entered like in DTN (αβFF and αβVT). All non-Telnet
output is frozen with the FREEZE UUO, and the UPGIOT uuo is
used with DMQUOT bit set to output all text from the remote
host as received, without any conversion. Also, UPGIOT uses
QUO177 bit to uncount padding nulls at end of program.
28 Jun 88 ME Leaving remote display mode (including exiting while in it)
does a BRK P to redraw the page printer.
02 Jul 88 ME If user specifies a port number, then TTISR1 follows CR with
LF. Otherwise it follows CR with NULL (for Jeeves).
28 Jul 88 JJW CR-null feature loses on connections to Forsythe. Reverted
to CR-LF as default, and added a new command (βU and αβU) to
indicate that CR-null should be used.
23 Aug 88 ME Changed numbers of IO channels DSI and DSO to 3 and 4 instead
of 2 and 3, since NETWRK uses 2. This fixes βI command.
08 Sep 88 ME Added port name WHOIS-UPDATE.
03 Dec 88 ME Exit if null host name after "HOST =" prompt. Also, changes
in DISPLY.FAI to fix cursor bug and provide tiny left margin
cursor for DTN to identify line the cursor is on.
[This may have completely broken DTN for DMs, although it
really wasn't working on DMs very well before.]
11 Dec 88 ME Changes in DISPLY.FAI to fix wrap around bug. Now it wraps
around at time of wrap around, instead of time of next char.
18 Dec 88 ME If Unternet address (e.g., PUP) is requested, e.g., via /E,
then we avoid domain lookup code and use host table only.
27 Jan 89 ME For DTN, added ↑T and ↑V DM commands to save and restore
screen state. Corresponding routines added to DISPLY.FAI.
Also added ⊗G and ⊗H commands to save, restore and exchange
screen text with one of two copies.
10 Apr 89 ME Added /L to mean use a low numbered local port number,
for testing things like Unix LPD connections.
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, 1, and 2.
DSI←←3 ↔ DSO←←4
;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
DOMRTS←←-1 ;Include domain routines
.INSERT NETWRK.FAI[S,NET]
;Include magic display routines
IFN FTDPYP,<.INSERT DISPLY.FAI[S,NET]>
SUBTTL Data area ;⊗ PATCH CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY NOPK RWAITS TRANSP 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 COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF PRTBUF HSTEND DEBUGP MONCMP PTYP DPYP DMDPYP NOEDTP ESCHAR RMTDPY RMTHDR NTIQCT USRPRT SMRBLK CRNULL EIGHTB SWTNUM SWTMSK
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
RWAITS: BLOCK 1 ;-1 → Remote host is WAITS site
IFE FTDPYP,<
TRANSP: BLOCK 1 ;-1 → transparent mode
>;IFE FTDPYP
IFN FTDPYP,<
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←←8 ;max number of host addresses
HNUMTB: BLOCK HNUMSZ ;table of possible host addresses
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,<
PTYP: 0 ;-1 → pure PTY (not network PTY)
DPYP: 0 ;-1 → display terminal
DMDPYP: 0 ;-1 → DM display
NOEDTP: 0 ;1 → NOEDIT display (else zero)
ESCHAR: "↑"-100 ;escape character for printing consoles
RMTDPY: 0 ;-1 → remote display mode
RMTHDR: 500040,,TTOBFR ;UPGIOT header: flags and prog address
0 ;length goes here
0 ;in-progress flag here by system
0 ;unused header word
0 ;padding byte count goes here
NTIQCT: 0 ;count of remote display chars to quote
>;IFE FTDPYP
USRPRT: 0 ;explicit port number
SMRBLK: 25 ;send Mark (this ought to be in NETWRK)
0 ;status word
6 ;Timing Mark Reply
CRNULL: 0 ;send NULL (not LF) after CR
EIGHTB: BLOCK 1 ;-1 → 8-bit binary, incl. files, for music
SWTNUM: BLOCK 1 ;Network number specified by user switch
SWTMSK: BLOCK 1 ;Mask specified by switch
;⊗ 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 ;RFC856 ;transmit binary
TPC ECHO,=1 ;RFC857 ;echo
TPC RCP,=2 ;reconnect
TPC SUPRGA,=3 ;RFC858 ;suppress GA
TPC NAMS,=4 ;negotiate approx. message size
TPC STATUS,=5 ;RFC859 ;status option
TPC TIMMRK,=6 ;RFC860 ;timing mark
TPC RCTE,=7 ;RFC726 ;remote controlled trans/echo
TPC NAOL,=8 ;negotiate output line width
TPC NAOP,=9 ;negotiate page size
TPC NAOCRD,=10 ;RFC652 ;negotiate output CR
TPC NAOHTS,=11 ;RFC653 ;negotiate output horizontal tab stops
TPC NAOHTD,=12 ;RFC654 ;negotiate output HT
TPC NAOFFD,=13 ;RFC655 ;negotiate output FF
TPC NAOVTS,=14 ;RFC656 ;negotiate output vertical tab stops
TPC NAOVTD,=15 ;RFC657 ;negotiate output VT
TPC NAOLFD,=16 ;RFC658 ;negotiate output LF
TPC EXTASC,=17 ;RFC698 ;Tovar's cretinous idea of extended ASCII
TPC LOGOUT,=18 ;RFC727 ;logout option
TPC BM,=19 ;RFC735 ;byte macro
TPC DET,=20 ;RFC732 ;data entry terminal option
TPC SUPDUP,=21 ;RFC736 ;SUPDUP (not TELNET) protocol
TPC SDOTPT,=22 ;RFC749 ;SUPDUP output
TPC SNDLOC,=23 ;RFC779 ;Send location
TPC TTYTYP,=24 ;RFC930 ;Terminal type
TPC EOR,=25 ;RFC885 ;End of record
TPC TACUSR,=26 ;RFC927 ;TACACS user identification
TPC OUTMRK,=27 ;RFC933 ;Output marking
TPC TTYLOC,=28 ;RFC946 ;Terminal location number (CMU)
WDOMAX←←.-WDOTAB-1
EXOPL←←=255 ;RFC861 ;extended options
RNDYLZ←←=256 ;RFC748 ;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
INTMSK [0] ;Mask interrupts off (back on at SLEPRX)
setzm clknow#
TLNN X,(INTCLK) ;clock int fakes TTI and NTI
JRST INTSR0
tlnn x,(intinp)
setom clknow
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,[010700,,TTOBFR-1] ;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
MOVE P,[IOWD PDLLEN,PDL] ;set up stack pointer
PUSHJ P,PRINIT ;initialize priorities
;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 TOPCLR TOPLEV 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
SUBTTL Top level
TOPCLR: CLRBFI ;Here after errors
TOPLEV: SKIPE MONCMP ;Called from monitor level?
JRST PUNT
;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 ↔ SETZM PTYP
TLNE 0,(DISLIN!DMLIN!DDDLIN) ;display?
SETOM DPYP
TLNE 0,(DMLIN) ;DM?
SETOM DMDPYP
TLNE 0,(IMPBIT) ;network PTY?
TLZ 0,(PTYLIN) ;yes, not pure PTY
TLNE 0,(PTYLIN) ;pure PTY
SETOM PTYP ;yes
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
;⊗ GETHST GETHS1 NOT8BT GETHCH FLSHEX GLOBSW SWHELP SWLOOP SWHELP SWTFND CHRTAB NUMSWT NUMTAB MSKTAB PRINIT
GETHST: SETZM MONCMP ;in case called from null command
PUSHJ P,PRINIT ;initialize priorities
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 GOTH00
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: CAIL 0,"a"
CAILE 0,"z"
CAIA
SUBI 0,"a"-"A"
CAIN 0,"?"
JRST SWHELP
CAIN 0,"8"
JRST [ SETOM EIGHTB ;8-bit binary tranmission (music)
POPJ P, ]
CAIN 0,"L"
JRST [ TIMER A, ;get random number
IORI A,1000 ;avoid small port numbers
ANDI A,1777 ;make sure it's a privileged port (Un*x)
MOVEM A,CONLPR ;set explicit low-numbered local port
SETOM PORSET ;tell CONECT to use port number we've set
POPJ P, ]
MOVSI 1,-NUMSWT
SWLOOP: CAMN 0,CHRTAB(1) ;Compare with switch name in table
JRST SWTFND
AOBJN 1,SWLOOP
OUTSTR [ASCIZ "?
Bad switch: /"]
OUTCHR 0
SWHELP: OUTSTR [ASCIZ\
Valid switches (one character):
0-10-meg MJH net (IP/TCP)
3-meg MJH net (IP/TCP)
P-up (PUP on MJH 10-meg net)
M-JH (PUP on MJH 3-meg net)
E-thernet (PUP on any SU net)
A-rpanet (IP/TCP)
I-nternet (IP/TCP)
L-ow numbered local port (IP/TCP)
8-bit binary (uninterpreted data connection)
\]
JRST TOPCLR ;Back to top level error routine
DEFINE SWNETS<
SWNET("0",NW%08,<777777,,177400>) ;IP MJH 10MB net
SWNET("3",NW%36,<777777,,177400>) ;IP MJH 3MB net
SWNET("P",NW%P08,<777777,,177400>) ;PUP MJH 10MB net
SWNET("M",NW%P36,<777777,,177400>) ;PUP MJH 3MB net
SWNET("E",NW%SU,<777700,,0>) ;PUP SU Ethernet
SWNET("A",NW%ARP,<777700,,0>) ;IP Arpanet
SWNET("I",0,<740000,,0>) ;IP Internet
>;DEFINE SWNETS
DEFINE SWNET(A,B,C)<A>
CHRTAB: SWNETS ;Table of switch characters
NUMSWT←←.-CHRTAB
DEFINE SWNET(A,B,C)<B>
NUMTAB: SWNETS ;Table of network numbers
DEFINE SWNET(A,B,C)<C>
MSKTAB: SWNETS ;Table of masks
SWTFND: MOVE 0,NUMTAB(1) ;Copy user's selected network number
MOVEM 0,SWTNUM
MOVE 0,MSKTAB(1) ;And mask bits
MOVEM 0,SWTMSK
POPJ P,
;Init net priorities and switch flags.
PRINIT: SETZM EIGHTB ;assume not 8-bit music mode
POPJ P,
;⊗ GOTH00 GOTHST GOTHS0 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.
GOTH00: CAMN Y,[440700,,HSPBUF]
EXIT ;just typed return, lf, or alt -- quit
GOTHST: MOVE Y,[440700,,HSPBUF]
MOVE Z,[440700,,HNMBUF]
GOTHS0: ILDB X,Y ;first character tells it all
PUSHJ P,SKPSPC
CAIN X,"/" ;switch?
JRST [ILDB 0,Y
PUSHJ P,GLOBSW
JRST GOTHS0] ;look for more switches
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
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 ALPHS2 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
ALPHS2: CAIE X,"/" ;Switch?
JRST ALPHST
ILDB 0,Y
PUSHJ P,GLOBSW
ILDB X,Y
PUSHJ P,SKPSPC
JRST ALPHS2 ;allow more switches
repeat 0,<
JUMPE X,CHKHNM
OUTSTR [ASCIZ/?
Single switch only, please.
/]
JRST TOPCLR
>;repeat 0
MISSWT: OUTSTR [ASCIZ/?
Missing switch letter.
/]
JRST TOPCLR
;⊗ 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
[ASCIZ/WHOIS-UPDATE/],,=1510
PRTTNM←←.-PRTTAB
;⊗ CHKHNM CHKHN1 CHKHN3 CHKHN4 CHKHN5 CHKHNT HNUMLP HNUMEN GOTHDB NONAME NOSYS NOSYS1 HCHECK HCHEC1 HCHEC2
;Look up specified host name or number.
CHKHNM: MOVE A,SWTNUM ;check to see if non-internet address requested
TDNE A,[NE%UNT] ;skip unless unternet address
JRST CHKHNT ;use host table only (e.g., for PUP)
SKIPE HOST ;Were we given a number?
JRST CHKHN1 ;Yes, look it up
MOVEI 0,HNMBUF ;Point to name
PUSHJ P,HSTNBR ;Is it really a number? (parse if so)
JRST CHKHN3 ;No
MOVEM 1,HOST ;Yes, save the address
SETZM HNMBUF ;Avoid printing "name" in GOICP
CHKHN1: SETOM DOMSET ;want short timeout for host number lookup
MOVEI 0,0200 ;four second timeout for host number lookup
MOVEM 0,DOMTMO ;set timeout for NETWRK
MOVE 0,HOST ;Get address
PUSHJ P,ADRNAM ;Convert address to name
JFCL ;Hard error
JRST NOSYS1 ;Failed, try to connect anyway
JRST CHKHN5 ;Success, ptr to name in 0
CHKHN3: MOVEI 0,HNMBUF ;Point to name
SETZM DOMSET ;not host number, use default timeouts
PUSHJ P,NAMADR ;Convert name to address
JFCL ;Hard error
JRST [ OUTSTR (1) ;Type reason for failure
OUTSTR [ASCIZ/
/]
JRST TOPCLR]
;Copy addresses into HNUMTB. (This is for compatibility with
;code that predates domains, it could be simplified.)
MOVSI X,-HNUMSZ
CHKHN4: MOVE 2,(1) ;Get an address
MOVEM 2,HNUMTB(X) ;Store an address
JUMPE 2,CHKHN5 ;Jump when done
ADDI 1,1
AOBJN X,CHKHN4
CHKHN5: HRLZ X,0 ;Copy name to HNMBUF
HRRI X,HNMBUF
BLT X,HNMBUF+HSTNLN-1
JRST NOSYS1
;Host table-based code is still here though not used. We need to
;still incorporate some of its features into domain code.
;[This code is used when non-internet (e.g., PUP) address is requested explicitly.]
CHKHNT: PUSHJ P,ATTHST ;attach upper segment host table
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,DETHST
JRST TOPCLR]
JRST [ OUTSTR [ASCIZ/Ambiguous host name.
/]
PUSHJ P,DETHST
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: TLNN 1,-1 ;any system spec?
JRST NOSYS ;unknown system
HLRZ X,1
MOVE 0,(X)
CAMN 0,[ASCII/WAITS/]
SETOM RWAITS ;Remote host is WAITS
IFE FTDPYP,<
MOVE X,USRPRT
CAIE X,NPRPRT
JUMPN X,NOSYS ;don't flush line editor if not TELNET
CAME 0,[ASCII/ITS/] ;If an ITS,
SKIPN DPYP ;or not a display
PUSHJ P,ECHATM ;use character mode
>;IFE FTDPYP
NOSYS: PUSHJ P,DETHST ;flush host table
NOSYS1:
IFN FTDPYP,<
PUSHJ P,ECHATM ;use character mode
>;IFN FTDPYP
SKIPN SWTMSK ;Was there a network switch?
JRST GOICP ;No
MOVSI X,-HNUMSZ ;Yes, see if any addresses satisfy it
HCHECK: SKIPN Z,HNUMTB(X) ;Get an address
JRST HCHEC1 ;End of list
AND Z,SWTMSK
CAMN Z,SWTNUM ;Does it satisfy the user switch?
JRST HCHEC2 ;Yes
AOBJN X,HCHECK ;No, try next address
HCHEC1: OUTSTR [ASCIZ/?No addresses for host on specified network.
/]
JRST TOPCLR
HCHEC2: MOVE Z,HNUMTB(X) ;Select this address
MOVEM Z,HOST
;fall into GOICP
;⊗ GOICP GOICP0 GOICP1 GOIC1A ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
SUBTTL ICP ICP ICP
GOICP: PTJOBX [0 ↔ 3] ;local echo off
;Try all appropriate addresses
MOVSI X,-HNUMSZ ;Setup for list of addresses to try
SKIPE 1,HOST ;Is there an explicit address?
TDZA X,X ;Yes, use it
GOICP0: MOVE 1,HNUMTB(X) ;Get next host number to try
JUMPE 1,NOICP ;No more numbers
MOVEM 1,HOST ;Store argument for CONECT
OUTSTR [ASCIZ/Trying /]
SKIPE HNMBUF
JRST [ OUTSTR HNMBUF
OUTCHR [" "]
JRST .+1]
OUTCHR ["["]
MOVE 0,HOST ;Get host number
PUSHJ P,PRHNUM ;Print host number
OUTSTR [ASCIZ/] ... /]
;Decide what port to use (may change depending on network of each address)
HLRZ 0,HOST ;Left half of address
MOVEI 1,NPRPRT ;Default port for Telnet
CAIN 0,(NW%SU) ;PUP Ethernet?
MOVEI 1,OPRPRT ;Yes, use "old" Telnet as default
SKIPE USRPRT ;Is user specifying port?
MOVE 1,USRPRT ;Yes, use it
MOVEM 1,CONFPR ;Set foreign port number for CONECT
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 ;clear the screen
PUSHJ P,SCSAV1 ;copy the init'd, cleared screen to primary copy
PUSHJ P,SCSAV2 ;copy the init'd, cleared screen to secondary copy
>;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,<
SKIPN PTYP ;if display or pure PTY, don't use
SKIPE DPYP ; transparent mode by default
CAIA
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,WONT,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 [010700,,TTOBFR-1] ;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: IMSTW [-1] ;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,0 ↔ PUSHJ P,DCHOUT ↔ PUSHJ P,SCNUPD ↔ POP P,0
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
IFE FTDPYP,<
SKIPN RMTDPY ;don't convert underscore and leftarrow
>;IFE FTDPYP
SKIPE RWAITS
JRST CANON
CAIE 0,30 ;underscore
CAIN 0,137 ;left-arrow
TRC 0,30≠137
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,,]
CAIE 1,15
JRST TTISR2 ;not CR
INCHRW 0 ;get LF after CR -- LF has the bucky bits on it
TRC 0,12≠15 ;turn LF into CR, keeping bucky bits
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
IFE FTDPYP,<
SKIPN RMTDPY ;skip if Telnet in remote display mode
JRST HAKCOM ;αβFORM and αβVT don't mean anything
>;IFE FTDPYP
;;;IFN FTDPYP,<
CAIN 0,614 ;αβFORM is like META
JRST [ INCHRW 0,
IORI 0,400 ;make it META-...
JRST HAKCOM]
CAIE 0,613 ;αβVT is like CONTROL-META
JRST CHRHAK
INCHRW 0
IORI 0,600 ;make it CONTROL-META-...
HAKCOM:
;;;>;IFN FTDPYP
IFE FTDPYP,<
CAIN 0,777 ;αβBS?
JRST [ MOVEI 0,177 ↔ JRST TTISR1] ;just an ordinary character
TRZN 0,400 ;META set?
JRST [ SKIPE EIGHTB ;in 8-bit mode, just output 8-bit char
JRST TTISR1 ; without any conversion
TRZN 0,200 ;if CONTROL is set
JRST CHRHAK ;output it, but map
ANDI 0,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 0,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 CTLMTA 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 TTISR1 ;JJW 27-Oct-87
repeat 0,<
JRST [ SKIPN TRBINP ;if not binary mode
ANDCMI 200 ;flush edit bit
JRST TTISR1]
>;repeat 0
CAIN 175 ;ALT
MOVEI 33
CAIN 176 ;right-brace
MOVEI 175
CAIN 32 ;~
MOVEI 176
SKIPE RMTDPY
JRST CTLMTA ;remote display mode, convert CTRL and META
SKIPE RWAITS
JRST TTISR1
CAIE 0,30 ;underscore
CAIN 0,137 ;left-arrow
TRC 0,30≠137
JRST TTISR1
>;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
SKIPE RWAITS
JRST CHRHK1
CAIE 1,30 ;underscore
CAIN 1,137 ;left-arrow
TRC 1,30≠137
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
>;IFN FTDPYP
CTLMTA: TRZE 200 ;if CONTROL is set
TRZ 140 ;convert to canonical ASCII control
TRZE 400 ;and for META
IORI 200 ;set EDIT
;falls through
;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
SKIPN TRBINP ;don't consider CR's if binary mode
CAIE 15
JRST TTISER
; SKIPE USRPRT ;if user specified port number, we user CRLF
SKIPN CRNULL
TRCA 12≠15 ;follow CR with LF
TRC 0≠15 ;follow CR with null (Jeeves memorial fix)
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,<PUSHJ P,RMTDPF> ;leave remote display mode
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 ;Update screen
JRST SLEEPR]
>;IFN FTDPYP
IFE FTDPYP,<
JRST [ SKIPN RMTDPY ;skip if remote display mode
OUTSTR TTOBFR ;type out all previous text
SKIPE RMTDPY ;skip unless remote display mode
PUSHJ P,RMTOUT ;output remote text from buffer
MOVEI 0,5*TTOBFL-1 ;reset TTY buffer counter
MOVEM 0,TTOCTR
MOVE 0,[010700,,TTOBFR-1] ;reset TTY buffer pointer
MOVEM 0,TTOPTR
SETZM TTOBFR
MOVE 0,[TTOBFR,,TTOBFR+1]
BLT 0,TTOBFR+TTOBFL-1
AOSG TTINTP
JRST TTISER ;TTI int to be taken care of
JRST SLEEPR] ;else sleep
>;IFE FTDPYP
aosg clknow
aos clkuse#
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
SKIPE DEBUGP
OUTCHR 0 ;Type out char if debugging
JRST NTISER]
;(continued on next page)
;Hack character for output to terminal ;⊗ NTISR1 NTINOF NTINOR NTIS1A NTISR6 TYPONE NTISR5 NTISR3 NTISR7 NTISR8 RMTOUT RMTOU2 RMTOU3 RMTOUX
NTISR1:
IFE FTDPYP,<
SKIPN EIGHTB ;no conversion for 8-bit music
SKIPE TRANSP ;no canonicalization needed if transparent
JRST NTIS1A
JUMPE 0,NTISER ;flush nulls
SKIPE RMTDPY ;no output conversion for remote display
JRST NTIS1A ;(nulls are flushed later also)
repeat 0,<
SKIPN RMTDPY
JRST NTINOR ;not remote display
CAIE 0,14 ;FF is DM positioning command
JRST NTINOF ;not a formfeed
MOVEI 0,2 ;quote next two characters
MOVEM 0,NTIQCT
MOVEI 0,14 ;get back our FF
JRST NTIS1A
NTINOF: SOSL NTIQCT ;skip unless suppressing conversion
JRST NTIS1A ;no conversion for this char
NTINOR:
>;repeat 0
CAIN 0,176 ;tilde
MOVEI 0,32
CAIN 0,175 ;right-brace
MOVEI 0,176
CAIN 0,33 ;diamond
MOVEI 0,175
; SKIPN RMTDPY
SKIPE RWAITS
JRST NTIS1A ;don't diddle underscore and left-arrow
CAIE 0,30 ;underscore
CAIN 0,137 ;left-arrow
TRC 0,30≠137
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 TYPONE ;slurp mode can't buffer, 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: SKIPN RMTDPY ;skip if remote display mode
OUTSTR TTOBFR ;type out all previous text
SKIPE RMTDPY ;skip unless remote display mode
PUSHJ P,RMTOUT ;output remote text from buffer
MOVEI X,5*TTOBFL-1 ;set up TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[010700,,TTOBFR-1] ;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
TYPONE: OUTCHR 0 ;output funny char (maybe transparent mode)
JRST NTISR3] ;may not do anything in remote display mode!
NTISR5: IDPB 0,TTOPTR
>;IFE FTDPYP
NTISR3: SKIPL OUTFLP ;output file in progress?
JRST NTISR7
SOSG DSOBF+2
OUTPUT DSO,
IDPB 0,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
IFE FTDPYP,<
RMTOUT: PUSH P,X ;preserve all ACs, get some to use
PUSH P,Y
MOVE X,TTOPTR ;get output byte ptr
SETZB Y,RMTHDR+4 ;no nulls yet for padding to end of word
JRST RMTOU3
RMTOU2: IDPB Y,X ;insert a padding null
AOS RMTHDR+4 ;count a padding null for UPGIOT to ignore
RMTOU3: TLNE X,760000 ;end of word
JRST RMTOU2 ;no
HRREI X,1-TTOBFR(X) ;calculate number of words for UPGIOT
JUMPLE X,RMTOUX ;return quick if no output
MOVEM X,RMTHDR+1 ;store display program length in words
UPGIOT RMTHDR ;output the display
RMTOUX: POP P,Y
POP P,X
POPJ P,
>;IFE FTDPYP
;⊗ 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: SETZB 0,SUBNGP ;End buffer with a null
IDPB 0,SUBPTR
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 NTISER ;don't reply since we sent WILL at GOICP3
>;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
CAML 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
SKIPE RWAITS
JRST $.+4
CAIE 0,30 ;underscore
CAIN 0,137 ;left-arrow
TRC 0,30≠137
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
JRST SCSAV1 ;↑T save screen (no-op on real DM)
CAI ;↑U no-op
JRST SCRES1 ;↑V restore screen (no-op on real DM)
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
SUBTTL Command dispatch ;⊗ CMCDSP
;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
IFN FTDPYP,<
CMDCHR G,DPEXCH,DPSAVE ;save copy of screen in core, or exchange
CMDCHR H,SCRES2,SCRES1 ;restore either backup copy of screen
>;IFN FTDPYP
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
CMDCHR U,CRNLOF,CRNLON ;transmit CR-null for losing Unixes
IFE FTDPYP,<CMDCHR V,RMTDPF,RMTDPN> ;remote display mode (semi-transparent)
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,
;More commands ;⊗ ECHATM ECHAT2 LCHATM LCHAT2 CLSCON SCRFIX PUNT SUPON SUPOFF SND200 SNDNUL SNDNU2 DBUG NDBUG RMTDPN RMTDPF
;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 0,[-2,,[012000,,10 ↔ 004000,,"P"]]
SKIPE TRANSP
TTYSET 0, ;leave image mode and do [ESCAPE]P
PUSHJ P,RMTDPF ;leave remote display mode
>;IFE FTDPYP
IFN FTDPYP,<
HRROI 0,[004000,,400!"N"] ;[BREAK]N
TTYSET 0,
>;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,
IFE FTDPYP,<
;Here for βV command -- for using a DM-type display as remote system's display.
RMTDPN: SKIPN DMDPYP ;must be a DM-type display
POPJ P,
PUSHJ P,LTRANS ;get out of transparent mode if in it
PUSHJ P,ECHATM ;enter character at a time mode
SETOM RMTDPY ;set remote display mode
FREEZE 1, ;freeze all non-upgiot output
POPJ P,
;Here for αβV -- turn off remote display mode.
RMTDPF: SKIPN RMTDPY ;skip if never did a freeze
POPJ P,
FREEZE 0, ;unfreeze non-upgiot output
SETZM RMTDPY ;clear remote display mode
HRROI 0,[004000,,400!"N"] ;[BREAK]N
TTYSET 0,
POPJ P,
>;IFE FTDPYP
;CR-null mode for losing Unix telnet servers (see TTISR1).
CRNLON: SETOM CRNULL
POPJ P,
CRNLOF: SETZM CRNULL
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,]
;;JJW 27-Oct-87 - This loses with too many BSD Unix hosts, and isn't really
;;necessary to make most hosts accept 8-bit data.
;; 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,
;⊗ DPSAVE DPEXCH
IFN FTDPYP,<
; Save copy of screen in core, in primary screen copy. Any previously
; saved screen is saved in secondary screen copy.
; Note that the remote host can also save the screen in the primary copy
; with ↑T command, but in that case the old primary copy is not preserved
; but lost (secondary copy is unaffected by remote host commands).
; There are three screen images:
; SCREEN -- current
; SCREE1 -- primary copy
; SCREE2 -- secondary copy (previously saved)
;DTN commands (really use αβ<form> and αβ<vt> and then G or H):
; βG -- save screen in primary copy (saving primary in secondary first)
; αβG -- exch screen with primary copy (clobbering secondary copy)
; βH -- restore primary copy of screen
; αβH -- restore secondary copy of screen
DPSAVE: PUSHJ P,SCSA12 ;save primary copy of screen in secondary
PUSHJ P,SCSAV1 ;save screen in primary copy
POPJ P,
DPEXCH: PUSHJ P,SCSAV2 ;save screen in secondary copy (clobbering it)
PUSHJ P,SCRES1 ;restore screen from primary copy
PUSHJ P,SCSA21 ;copy secondary copy to primary copy (finish exch)
POPJ P,
>;IFN FTDPYP
;⊗ 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