github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-19 17:39:17 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysnet/telnet.752
Eric Swenson 4623e0db21 Added TELNET server and client.
2016-11-24 21:43:54 +01:00

2334 lines
73 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

; -*-MIDAS-*-
.symtab 2700.,5000. ; allocate lots of space for symbols
title TELNET
subttl Definitions, etc.
; Mark Crispin, MIT AI Lab, January 1977; last update June 1980
; Disclaimer: Most of this program was written on an ADM-3 glass TTY back
; in early 1977 when I had these incredibly wedged ideas on programming,
; like the incredibly hairy macros all over the place, lower case code,
; comments on every line, etc. Believe me, I don't write code this way now!
; However, if you think this is bad, you should have seen the code it replaced.
;
; Anyway, if you need something changed in TELNET, try to get me to do it,
; since there are all sorts of hairy things in the macros and stuff that
; only a wizard would know about. If you do hack it, try to follow the
; conventions that the rest of the code is written in; use the hairy macros,
; etc. The only thing that looks worse than poor programming conventions
; is mixed programming conventions.
.insrt MRC;MACROS
; Assembly parameters
nd. nprskt==27 ; default ICP socket
nd. icptmt==30.*30. ; time out time
nd. linmor==6. ; lines of output before **More** not inhibited
nd. hstnln==10. ; length of host name string
nd. patlen==50. ; length of patch area
nd. jclbfl==10. ; length of JCL buffer
nd. ntibfl==200. ; length of net input buffer
nd. ttobfl==600. ; length of TTY output buffer
nd. pdllen==500. ; length of push-down stack
nd. linbfl==50. ; length of line editor buffer
nd. ftnethop==-1 ; -1 if to include net hop hassle code
; AC definitions
acdef. [a b c d x y z zz j tp t tt nt]
; NT used only by net output rtns
hiac==j ; highest AC to be saved in an interrupt
; I/O channels
acdef. [icp tti itto tto nti nto wal htb err]
.hkill icp,tti,itto,tto,nti,nto,wal,htb,err
subttl Macros
ret==:return
; Macro to output an ASCII string for command level
define type string
move a,[440700,,[ascii\string\]]
movei b,.length\string\
syscal SIOT,[ clarg. tto
a ? b]
.lose %lssys
termin
; Macro to do a cursor hack for command level
define csrmov code
.iot tto,[^P] ? .iot tto,["code] termin
; Macro to do a cursor hack for network transmission
define csrmv1 code
movei a,^P
call ttoc
movei a,"code
call ttoc
termin
; Macro to send a TELNET command
define telcmd cmdlst
irps cmd,,[cmdlst]
.iot nto,[cmd]
termin
.nets nto,
termin
define telcmf cmdlist
irps cmd,,[cmdlist]
movei nt,cmd
call ntout
termin
call ntofrc ; Force output
termin
; Macro to generate a string word for SIOT
define strwrd string
.length\string\,,[ascii\string\]
termin
subttl Data area
cmdesc: " ; escape character ([BREAK] for TV's)
corbeg==.
tcpp: block 1 ; -1  using TCP (else NCP)
debug: 0 ; -1  debugging
sdpblk: block 1 ; first word of SUPDUP block
tctyp: block 1 ; TCTYP variable
ttyopt: block 1 ; TTYOPT variable
tcmxv: block 1 ; vertical screen size
tcmxh: block 1 ; horizontal screen size
ttyrol: block 1 ; rolling
smarts: block 1 ; display smarts
ispeed: block 1 ; input speed
ospeed: block 1 ; output speed
nsdvrs==.+1-sdpblk ; number of SUPDUP variables
ttyst1: block 1 ; this job's TTYST1 variable
ttyst2: block 1 ; TTYST2 variable
ttysts: block 1 ; TTYSTS variable
ttycom: block 1 ; TTYCOM variable
ttytyp: block 1 ; TTYTYP variable
hostad: block 1 ; host address for foreign host
morep: block 1 ; -1  **More** on
twinp: block 1 ; ~ 0  has i/d, -1  SAIL graphics too
; Data area initialized every time
rstbeg==. ; beginning of data area
10tabp: block 1 ; -1  using 10 tabs (Multix TELNET)
sdoutp: block 1 ; -1  using SUPDUP output option
openp: block 1 ; -1  connection open
servrp: block 1 ; -1  seen a server in search
nprotp: block 1 ; -1  using new protocol
killp: block 1 ; -1  suicide if ICP loses
scclrp: block 1 ; -1  clear screen before output
ttyop: block 1 ; -1  silence output
echop: block 1 ; -1  foreign host is echoing
logoup: block 1 ; -1  logout option
supgap: block 1 ; -1  host is winning with GA's
linedp: block 1 ; -1  line editor enabled
wallp: block 1 ; -1  enable wallpaper
quotep: block 1 ; -1  next char quoted
lquotp: block 1 ; -1  line editor quote
dmsimp: block 1 ; -1  Datamedia simulation
trbinp: block 1 ; -1  can transmit binary
rcbinp: block 1 ; -1  can receive binary
indlmp: block 1 ; -1  DM insert/delete mode is on
editkp: block 1 ; -1  <EDIT> key depressed
morinh: block 1 ;  0  **More** inhibited
gthpos: block 1 ; DM setting HPOS (-1  wants HPOS)
gtvpos: block 1 ; DM setting VPOS (-1  wants VPOS)
inslct: block 1 ; Count of buffered-up insert-line commands.
; Negative => buffered up delete-line commands.
xsave: block 1 ; scratch location to save AC X
asave: block 1 ; scratch location to save AC A
inipos: block 1 ; initial cursor position
hpos: block 1 ; horizontal position (line editor)
icpskt: block 1 ; foreign socket to ICP on
axttop: block 1 ; auxillary TTY output glitcher
linbuf: block linbfl ; line editor input buffer
linptr: block 1 ; line editor pointer
linctr: block 1 ; line editor counter
ntibuf: block ntibfl ; network input buffer
ntiptr: block 1 ; network input pointer
ntictr: block 1 ; network input counter
ttobuf: block ttobfl ; TTY output buffer
ttoptr: block 1 ; TTY output pointer
ttoctr: block 1 ; TTY output counter
ttoctl: block 1 ; control bits for tto (also flag)
sdobfr: block <254./4.>+1 ; SUPDUP output buffer
lclrcv: block 1 ; ITS  host socket
lcltrn: block 1 ; ITS  host socket
forrcv: block 1 ; host  ITS socket
fortrn: block 1 ; host  ITS socket
hstnam: block hstnln ; host name string in ASCII
hstsnm: block 3 ; host sixbit name ( who line)
jclbuf: block jclbfl+1 ; JCL buffer
corend==.-1 ; end of data area
pdl: block pdllen ; push down stack
tabpdl: block 5*linbfl ; tab pdl(urk!)
pat: block patlen ; patch area
patch==pat ; beginning of free patch area
loc <.\1777>+1 ; put pure code on a clean page
$$hst3==1 ; HOSTS3 format table
$$arpa==1 ; Just ARPAnet stuff
$$tcp==1
$$connect==1
$$hostnm==1 ; Let's try this out.
$$symget==1
$$prompt==0 ; Don't use default prompt.
$$hstmap==1 ; HSTMAP routine
$$analyz==1 ; Analysis reoutines
netwrk"E==x
.insrt syseng;netwrk
subttl TELNET commands for the new protocol
trnbin==0 ; transmit binary
echo==1 ; echo
rcp==2 ; prepare to reconnect
suprga==3 ; suppress go ahead
nams==4 ; negotiate approx. message size
status==5 ; status option
timmrk==6 ; timing mark
rcte==7 ; remote controlled tran/echo
naol==8. ; negotiate line width
naop==9. ; negotiate page size
naocrd==10. ; negotiate output cr disposition
naohts==11. ; negotiate output hor. tabs
naohtd==12. ; negotiate output hor. tab disp.
naoffd==13. ; negotiate output form feed disp.
naovts==14. ; negotiate output ver. tabs
naovtd==15. ; negotiate output ver. tab disp.
naolfd==16. ; negotiate output lf disposition
extasc==17. ; extended ASCII
logout==18. ; log out foreign job
bm==19. ; byte macro
det==20. ; data entry terminal option
supdup==21. ; moby SUPDUP option
sdotpt==22. ; SUPDUP output
exopl==255. ; extended options
rndylz==256. ; randomly lose
se==240. ; subnegotiation end
nop==241. ; no operation
dm==242. ; data mark
brk==243. ; break
ip==244. ; interrupt process
ao==245. ; abort output
ayt==246. ; are you there
ec==247. ; erase character
el==248. ; erase line
ga==249. ; go ahead
sb==250. ; subnegotiation
will==251. ; sender will perform operation
wont==252. ; sender wont perform operation
do==253. ; receiver asked to perform operation
dont==254. ; receiver must not perform operation
iac==255. ; interpret as command
subttl Initialization, etc.
telnet: move p,[-pdllen,,pdl] ; load push down pointer
store %zeros,corbeg,corend ; clear data area
call ntoini ; Initialize net output buff
setom tcpp
.suset [.rxjname,,a] ; TCP: check JNAME
came a,[sixbit/tcptn/] ; If either of these two names,
camn a,[sixbit/ttn/]
setom tcpp ; then say to use TCP for connecting.
came a,[sixbit /ncptn/]
camn a,[sixbit /otn/]
setzm tcpp
store %fword,hostad ; not at any host
uget OPTION,x ; get my options
tlo x,%opint ; enable new style interrupts
uset OPTION,x ; and reset my .OPTION variable
store ^C_1,jclbuf+jclbfl ; ensure that JCL ends
tlne x,%opcmd ; any alleged JCL?
.break 12,[..rjcl,,jclbuf] ; read in JCL
syscal OPEN,[ clctl. .uio\%tjdis; enable cursor P codes
clarg. tto ; TTY output channel
clarg. ('TTY)] ; device TTY
.lose %lsfil ; can't open TTY output?
syscal OPEN,[ clctl. .uio\%tjsio; super-image output
clarg. itto ; TTY output channel
clarg. ('TTY)] ; device TTY
.lose %lsfil ; can't open TTY output?
syscal TTYGET,[ clarg. tto ; get TTY status variables
%clval ttyst1 ; first character group
%clval ttyst2 ; second character group
%clval ttysts] ; TTY control status
.lose %lssys ; can't read TTY status
syscal CNSGET,[ clarg. tto ; get console parameters
%clval tcmxv ; vertical size
%clval tcmxh ; horizontal size
%clval tctyp ; TCTYP variable
%clval ttycom ; TTYCOM variable
%clval ttyopt ; TTYOPT variable
%clval ttytyp] ; TTYTYP variable
.lose %lssys ; huh???
move x,[-nsdvrs,,] ; set up AOBJN count
movem x,sdpblk ; for SUPDUP block
move x,[131313131313] ; all chars are activation+interrupt
movem x,ttyst1 ; ...but no echoing
move x,[130313131313] ; similar, but image output...
movem x,ttyst2 ; ...is off for I, J
move x,ttysts ; get TTYSTS variable
tdnn x,[%tsmor] ; **More**'s on?
useti MSK2,1_tto+1_itto ; enable **More** ints
store %fword,morep ; flag more processing "on"
syscal TTYSET,[ clarg. tto ; set TTY status variables
%clarg ttyst1 ; first set of character groups
%clarg ttyst2 ; second set of character groups
%clarg ttysts] ; TTY control status
.lose %lssys ; can't set TTY status
; (continued on next page)
store %fword,twinp ; assume that it's a winner
movei y,.uii ; assume just unit image input
move x,ttyopt ; get TTY options
tlnn x,%tosai ; does it have SAIL graphics?
movns twinp ; nope, only semi-winning
tlnn x,%tofci ; does this frob have bucky bits?
jrst [ movsi z,%tssii ; super-image input
iorm z,ttysts ; so Z and _ go through
jrst nobcky] ; no [BREAK] key stuff
store %txtop\"B,cmdesc ; yes, intercept char  [BREAK]
tro y,%tiful ; full char set mode
nobcky: and x,[(%tocid\%tolid)] ; mask out all but i/d bits
came x,[(%tocid\%tolid)] ; is this a winning terminal?
store %zeros,twinp ; no, it's a loser so no DM simulator
syscal OPEN,[ %clctl y ; open input console
clarg. tti ; on TTY input channel
clarg. ('TTY)] ; device TTY
.lose %lsfil ; can't open TTY input?
; Output TELNET's greeting message
notsty: type [User TELNET.]
move y,[%version] ; get our version
vrsout: movei x,%zeros ; clear where a digit goes
lshc x,wid. '_ ; siphon off a digit
addi x,"A-'A ; ASCIIify
.iot tto,x ; output the digit
jumpn y,vrsout ; and continue until done
csrmov A ; now a blank line
peek a,IMPUP ; Check if IMP is up
jumpe a,maphtb ; Print error msg if not
came a,[-1]
move c,[strwrd [IMP is down.]]
came a,[-2]
move c,[strwrd [IMP is not yet up.]]
came a,[1]
move c,[strwrd [IMP is down (until ready line changes).]]
movsi a,440700
hrr a,c
hlrz b,c
syscal SIOT,[ clarg. tto
a ? b]
.lose %lssys
.logout 1,
; Map DSK:SYSBIN;HOSTS3 > (the host table) in.
maphtb: movei a,hsttab_-10. ; Page # to map into
movei b,htb ; channel # to use
pushj p,netwrk"hstmap ; Map it in.
.value [asciz /: Cannot map in host table! 
/]
; Job name and JCL hacking stuff
skipn jclbuf ; got JCL?
jrst chkjnm ; no, check JNAME
ldb x,[350700,,jclbuf] ; get first character
cain x,"? ; question mark?
jrst [ call help ; yes, help cruft
jrst notcon] ; and enter main loop
store %fword,killp ; flag death
jrst notcon ; no JNAME checking
chkjnm: uget XJNAME,x ; get XJNAME
came x,[sixbit /TACAC/]
camn x,[sixbit /TACACS/]
jrst [move j,[440700,,[asciz "65.,TACAC.ARPA"]]
call filjcl
store %fword,killp
jrst notcon ]
camn x,[sixbit /TACNUZ/]
jrst [ move j,[440700,,[asciz "143,NIC"]]
call filjcl
store %fword,killp
jrst notcon ]
camn x,[sixbit /RSEXEC/]
jrst [ move j,[440700,,[asciz "367,ISI"]]
call filjcl
store %fword,killp
jrst notcon ]
camn x,[('NSW)]
jrst [ move j,[440700,,[asciz "33,SRI-KA"]]
call filjcl
store %fword,killp
jrst notcon ]
came x,['TELNET] ; XJNAME = 'TELNET ?
camn x,[sixbit/TN/] ; or TN?
jrst notcon ; yes, ignore this
move y,x ; copy job name
tlz y,(sixbit/_/) ; zap out first character
came y,[sixbit/ TELNE/] ; is it xTELNET
camn y,[sixbit/ TN/] ; or xTN
jrst notcon ; then no hacking again
move z,[440700,,jclbuf] ; load pointer to JCL buffer
store %fword,killp ; flag suicide if lossage
jnmhst: movei y,%zeros ; clear frob where char will go
rotc x,6. ; snarf off a character
addi y,"A-'A ; ASCIIify
idpb y,z ; fake in JCL buffer
jumpn x,jnmhst ; and loop for more
movei y,^M ; zap in an M
idpb y,z ; shove in buffer
; Top level not connected loop
notcon: useti WHO1,<.byte 8 ? 166 ? 0 ? 366 ? 0>; two SIXBIT words together
useti WHO2,sixbit/NOT IN/ ; message when not connected
useti WHO3,sixbit/ COMM/ ; . . .
call cmprmt ; get a command
jrst notcon ; not connected
.break 16,100000 ; back to DDT
jrst notcon ; got continued
subttl ICP to foreign host
; Final pre-ICP initialization
goicp: move x,ttysts ; get TTY status
tlnn x,%tsrol ; in losing scroll mode?
store %fword,scclrp ; no, clear screen when winning
store %fword,linedp ; line editor on if half duplex host
move tp,[-5*linbfl,,tabpdl] ; load up tab pdp
store %zeros,linctr ; clear line editor counter
store linbuf(440700),linptr ; initialize line editor pointer
; Set up who line
move b,hostad
call netwrk"hstsrc ; Look up name
caia ; lost
jrst gotwhn
store sixbit/RANDOM/,hstsnm ; host name not in table
store sixbit/-PLACE/,hstsnm+1 ; so invent a name
jrst setwvr ; and set it
gotwhn: hlrz x,netwrk"stlsys(d) ; get ptr to system name
move y,hsttab+1(x) ; get second 5 chars of system name
move x,hsttab(x) ; and first 5 chars
camn x,[ascii/MULTI/] ; Multix?
came y,[ascii/CS/] ; . . .
caia ; nope
store %fword,10tabp ; yes, indicate 10 tabs
move x,a
hrli x,440700 ; make byte pointer to host name
move y,[440600,,hstsnm] ; load pointer to sixbit name
getwvr: ildb z,x ; get a character
jumpe z,setwvr ; set who vars when done
subi z,"A-'A ; sixbitify
idpb z,y ; save in sixbit name frob
skipn hstsnm+2 ; done as much as I can?
jrst getwvr ; no, continue for more
setwvr: uset WHO2,hstsnm ; set first half of who line thing
uset WHO3,hstsnm+1 ; second half now
useti IMSK2,1_tti ; enable TTY ints so can abort
; (continued on next page)
; Open TCP network connection unless NCP specified
skipn tcpp ; Skip if using TCP
jrst goicp0 ; no, use normal NCP type ICP
movei a,nti
move b,hostad
move c,icpskt
call netwrk"tcpcon
jrst tcpluz
syscal RFNAME,[ clarg. nti
%clval x ; Randomness
%clval lclrcv ; Local port #
%clval forrcv] ; Remote port #
.lose %lssys
move x,lclrcv ; Just for completeness, in case
movem x,lcltrn
move x,forrcv
movem x,fortrn
jrst goicpw ; Now go wait for conns to open.
; Open ICP connection, get socket number from server
goicp0: syscal OPEN,[ clctl. .uii\40050; open on gensymmed socket, 32 bits
clarg. icp ; on ICP channel
clarg. ('NET) ; NET: device
clarg. %fword ; let ITS pick local socket
%clarg icpskt ; initial foreign socket
%clarg hostad] ; foreign host address
jrst icpluz ; can't, say why and die
movei a,%nsrfs ; socket state when starting up
movei y,icptmt ; load up time out time
goicp1: syscal NETBLK,[ clarg. icp ; hang for ICP channel
%clarg a ; until condition not this
%clarg y ; or if timeout exceeded
%clval c ; new socket state
%clval x] ; time left on the clock
.lose %lssys ; huh???
jumple x,icptmo ; yup, lose big
jumpe c,[ syscal WHYINT,[ clarg. icp; ICP channel status
repeat 4,%clval c]; reason for close
.lose %lssys ; ???
jrst closed] ; and report this lossage
cain c,%nsopn ; just opened?
jrst [ movei a,%nsopn ; yes, wait until something
jrst goicp1] ; else to avoid lossage
caie c,%nscli ; CLS w/input?
cain c,%nsinp ; input?
caia ; winning
jrst badskt ; losing
syscal RFNAME,[ clarg. icp ; socket status on ICP channel
repeat 2,%clval x]; the local socket number
.lose %lssys ; huh???
addi x,2 ; compute receive end
movem x,lclrcv ; save for open
addi x,1 ; compute local transmit end
movem x,lcltrn ; save for open
.iot icp,x ; find out foreign receive socket
movem x,forrcv ; save for open
addi x,1 ; compute foreign send socket
movem x,fortrn ; save for open
; Open network connections
syscal OPEN,[ clctl. 40\.uai ; open in single ASCII mode
clarg. nti ; on net input channel
clarg. ('NET) ; NET: device
%clarg lclrcv ; local receive socket
%clarg fortrn ; socket to me!
%clarg hostad] ; foreign host's host address
jrst icpluz ; can't, say why
syscal OPEN,[ clctl. 40\.uao ; open in single ASCII mode
clarg. nto ; on net output channel
clarg. ('NET) ; NET: device
%clarg lcltrn ; local tranmission socket
%clarg forrcv ; foreign receipt socket
%clarg hostad] ; foreign host address
jrst icpluz ; can't, say why
.close icp, ; close off ICP socket
; (continued on next page)
; Wait until connections are opened
goicpw: movei y,icptmt ; load up time out time
syscal NETBLK,[ clarg. nti ; net input channel
clarg. %nsrfs ; wait until not "RFC sent"
%clarg y ; time out time
repeat 2,%clval x]; time left on clock
.lose %lssys ; huh???
jumple x,icptmo ; yup
syscal WHYINT,[ clarg. nti ; channel status on net input
repeat 2,%clval y; socket state
repeat 2,%clval c]; reason for CLS
.lose %lssys ; ???
tlz y,-1 ; flush left half
jumpe y,closed ; punt if closed
caie y,%nsopn ; connection open?
cain y,%nsinp ; or input available?
jrst goicp2 ; still winning
cain y,%nscli ; CLS but input?
jrst goicp2 ; still looking good
movei c,(y) ; copy socket state
jrst badskt ; losing totally
goicp2: movei y,icptmt ; load up time out time
syscal NETBLK,[ clarg. nto ; net output channel
clarg. %nsrfs ; wait until not "RFC sent"
%clarg y ; time out time
repeat 2,%clval x]; time left on clock
.lose %lssys ; huh???
jumple x,icptmo ; yup
syscal WHYINT,[ clarg. nto ; status of net output
repeat 2,%clval y; socket state
repeat 2,%clval c]; reason for CLS
.lose %lssys ; ???
andi y,-1 ; clear left half
jumpe y,closed ; and punt if closed
caie y,%nsopn ; connection open?
cain y,%nsrfn ; or RFNM wait?
jrst inineg ; winning
movei c,(y) ; get the losing state
jrst badskt ; lost
; Initial negotiations
inineg: move x,icpskt ; get socket # for ICP
caie x,nprskt ; new protocol socket?
jrst opened ; nope, maybe old protocol
store %fword,nprotp ; definitely new protocol
; For new TELNET we try to get remote echo and have GA's flushed. We'll
; ignore any GA's we get and never send any anyway.
telcmf [IAC DO ECHO IAC DO SUPRGA]
store %fword,echop ; remember I want echo hacked
store %fword,supgap ; remember I want no host GA's
; ICP negotiations finished, tell user so and enter main program
opened: store %fword,openp ; flag connection open
type [ Open
]
useti IMSK2,1_nto ; enable ints
store %zeros,ntictr ; and zap net input buffer
call imagon ; enter image mode
; jrst ntimpg ; and enter net main program
subttl Network input main program
ntimpg: call ntic ; gobble a character
cain a,IAC ; got an IAC?
jrst iacsrv ; yes, service it
trne a,200 ; 8 bit character?
skipge nprotp ; yes, new protocol?
caia ; new protocol or not command
jrst [ cain a,200 ; old style datamark?
jrst @dmkser ; yes
cain a,203 ; no echo?
store %fword,echop; yes
cain a,204 ; echo?
store %zeros,echop; yes
jrst ntimpg] ; and next character
skipge wallp ; wallpaper enabled?
.iot wal,a ; output character
aosn quotep ; is char quoted?
jrst [ skipge ttyop ; silenced? (LOSE!!!)
jrst ntimpg ; yes, poor loser
jrst nosim] ; no, win.
skipge gthpos ; want to get horizontal pos?
jrst [ store %zeros,gthpos ; forget it now
caige a,<" > ; an abort?
jrst dmsim ; yup
xori a,140 ; convert to character position
camle a,tcmxh ; out of range totally?
movei a,%zeros ; zap to beginning
addi a,8. ; offset for ITS
movem a,gthpos ; save this as next to be set hpos
csrmv1 H ; set horizontal position
move a,gthpos ; get hor pos
call ttoc ; send hor pos
store %fword,gtvpos ; now get vertical position
jrst ntimpg] ; and charge on
skipge gtvpos ; want vertical position?
jrst [ store %zeros,gtvpos ; forget it now
caige a,<" > ; an abort?
jrst dmsim ; yup
xori a,140 ; convert to position
camle a,tcmxv ; out of range?
movei a,%zeros ; whoops! top line time...
addi a,8. ; offset for ITS
movem a,gtvpos ; save the position
csrmv1 V ; set vertical position
move a,gtvpos ; get hor pos
call ttoc ; send ver pos
jrst ntimpg] ; and charge on
ttoout: skipge ttyop ; TTO enabled?
jrst ntimpg ; no, flush it then
skipl scclrp ; clear screen?
jrst dmsim ; no, already did it
csrmov C
store %zeros,scclrp ; flag that screen has been cleared
; jrst dmsim ; fall through
subttl Hairy Datamedia simulator!!
dmsim: skipl dmsimp ; simulate DM?
jrst nosim ; nope, display normally
skipge indlmp
skipn inslct ; If we have buffered up some insert or delete lines,
jrst dmsim1
caie a,^J ; and the next command is NOT another one,
cain a,^Z
jrst dmsim1
cain a,177 ; (and don't count padding, which we will ignore)
jrst dmsim1
push p,a ; do them now, before this character.
call ttofrc ; Force out buffered 7-bit output first.
movei a,%tdilp
skipg inslct
movei a,%tddlp ; Output multiple-line insert or delete command.
.iot itto,a
movm a,inslct
.iot itto,a
setzm inslct
pop p,a
dmsim1: cail a,<" > ; control character?
jrst [ skipl indlmp ; insert/delete mode?
jrst nosim ; no, just output it
cain a,177 ; ignore rubouts completely
jrst ntimpg ; for cretinous EMACS
push p,a ; save character
csrmv1 ^ ; insert a space here
pop p,a ; restore character
jrst nosim] ; and output the byte
skipge indlmp ; insert/delete mode?
jrst @indtab(a) ; yes, do special things
jrst @dmctab(a) ; no, do normal DM display hack
dmctab: repeat 40,ntimpg ; no op
indtab: repeat 40,@dmctab(a) ; normal function
gzkddl==. ; save current location counter
define dmcsr code,server
loc dmctab+code
[server
jrst ntimpg]
termin
dmcsr ^B,[csrmv1 T] ; home cursor
dmcsr ^G,[call ttoc] ; bell
dmcsr ^H,[csrmv1 B] ; back cursor
dmcsr ^I,[call ttoc] ; tab
dmcsr ^J,[ move x,ttysts ; get TTY status
tlne x,%tsrol ; scrolling (ick!)
jrst [call ttoc ? jrst ntimpg]
csrmv1 D] ; cursor down
dmcsr ^L,[store %fword,gthpos] ; set cursor position
dmcsr ^M,[call ttoc] ; carriage return
dmcsr ^P,[store %fword,indlmp] ; turn insert/delete on
dmcsr ^W,[csrmv1 L] ; wipe to EOL
dmcsr ^X,[ store %zeros,indlmp; cancel; i/d mode off
movsi b,%tsrol ; scroll mode...
andcam b,ttysts ; turn it off
syscal TTYSET,[ clarg. tto; TTY output channel
ttyst1 ? ttyst2 ? ttysts]
.lose %lssys] ; foo!
dmcsr ^Z,[csrmv1 U] ; up cursor
dmcsr ",[store %fword,quotep] ; quote next character (IMSSS DM's)
dmcsr ^\,[csrmv1 F] ; forward cursor
dmcsr ^],[ movsi b,%tsrol ; roll on
iorm b,ttysts ; turn it on
syscal TTYSET,[ clarg. tto; TTY output channel
ttyst1 ? ttyst2 ? ttysts]
.lose %lssys] ; foo!
dmcsr ^^,[ store %zeros,indlmp; master clear
csrmv1 C
movsi b,%tsrol ; roll on
iorm b,ttysts ; turn it on
syscal TTYSET,[ clarg. tto; TTY output channel
ttyst1 ? ttyst2 ? ttysts]
.lose %lssys]
dmcsr ^_,[ store %zeros,indlmp; erase screen
csrmv1 C
movsi b,%tsrol ; roll on
iorm b,ttysts ; turn it on
syscal TTYSET,[ clarg. tto; TTY output channel
ttyst1 ? ttyst2 ? ttysts]
.lose %lssys]
define dmcsr code,server
loc indtab+code
[server
jrst ntimpg]
termin
dmcsr ^H,[csrmv1 _] ; delete character
dmcsr ^J,[aos inslct] ; insert line
dmcsr ^Z,[sos inslct] ; delete line
dmcsr ^\,[csrmv1 ^] ; insert character
loc gzkddl ; restore location counter
;^P[ to insert line. ^P\ to delete line.
subttl Normal console display
nosim: skipe ttoctl ; if super image output, skip down
jrst nosim2
move x,ttyopt ; get terminal status
tlne x,%toovr ; overprinting?
skipl dmsimp ; simulating a DM?
jrst nosim1 ; no DM or no overprint, win!
save a ; save to avoid clobberage
csrmv1 K ; someday this needs to be smarter
retr a ; restore character
nosim1: cain a,177 ; rubout from a loser?
jrst ntimpg ; yup, flush flush flush
jumpe a,ntimpg ; flush nulls from losers
cain a,^J ; line feed?
sos morinh ; yes, one line closer to **More**!!
call ttoc ; display character on TTY
caie a,^P ; did foreign host send a ^P?
jrst ntimpg ; no, try for another character
movei a,"P ; yes, get ready to complete
nosim2: call ttoc ; complete the character
jrst ntimpg ; and go again
subttl Network input  TTY output buffering
; Input a character from the network, either from the net or from a buffer.
; If nothing in the buffer or the net, then go to sleep. This also dumps out
; the old TTY output buffer if the net input buffer is empty.
; (Shades of 10/50!!!!!!!!)
ntic: sosg ntictr ; anything in this buffer?
call ntic1 ; nope, get a new buffer
ildb a,ntiptr ; get a character
return ; and return
ntic1: store ttobuf(440700),ttoptr,,d ; reset TTY output pointer
skipn ttoctr ; any TTY output to do?
jrst ntic3 ; nope
call imagon ; try to make proceeding win
syscal SIOT,[ clarg. tto ; output the buffer to TTY
%clctl ttoctl ; control bits (super image control)
d ? ttoctr] ; and reset counter
.lose %lssys ; huh???
ntic3: syscal NETBLK,[ clarg. nti ; net input channel
clarg. %nsopn] ; open with no input
.lose %lssys ; ???
syscal WHYINT,[ clarg. nti ; something happened...
repeat 2,%clval d; socket state
%clval j ; # of characters to do
%clval c] ; reason for CLS
.lose %lssys ; ???
tdzn d,[%minfi] ; network interrupt?
jrst ntic4 ; nope
store ttobuf(440700),ttoptr ; reset buffer pointer
store %zeros,ttoctr ; zap output buffer too
aosle axttop ; maybe output flush
store %fword,ttyop ; turn off the TTY for good measure
.reset nti, ; and bop off the network interrupt state
ntic4: jumpn j,ntic2 ; make sure read what's left
jumpe d,closed ; connection randomly closed?
skipn tcpp
jrst ntic4x
ifndef %ntclu,%ntclu==3
cain d,%ntclu ; another valid closed state
jrst closed
ntic4x: movei c,(d) ; get the losing state
jrst badskt ; socket entered illegal state!
ntic2:
; caile j,4*ntibfl ; more came than can take now?
; Always try for max, don't hang.
movei j,4*ntibfl ; yes, then size down to what can take
movem j,ntictr ; save input counter
store ntibuf(441000),ntiptr,,d ; load pointer to net buffer
syscal SIOT,[ %clbit,,10 ; Set "don't-hang" bit!!
clarg. nti ; gobble down the buffer
d ? j] ; from network input
.lose %lssys ; ???
exch j,ntictr ; Orig # bytes in J
subm j,ntictr ; Get # bytes read into ntictr
return ; and return
; TTY character output routine when coming from the net
ttoc: aosle zz,ttoctr ; bump TTY counter
caile zz,5*ttobfl ; filled up buffer?
.lose ; foo!
idpb a,ttoptr ; shove character in buffer
return ; and return
; Force out the contents of the buffer and empty it.
ttofrc: move a,[440700,,ttobuf]
movem a,ttoptr
syscal siot,[%climm,,tto ? a ? ttoctr]
.lose %lsfil
setzm ttoctr
return
subttl IAC service
iacsrv: store %fword,nprotp ; definitely new protocol now!
; Before handling IAC, force TTY output buffer. If the IAC is a
; IAC SB SUPDUP-OUTPUT, this will fix a bug. May be other bugs, too.
store ttobuf(440700),ttoptr,,d ; reset TTY output pointer
skipn ttoctr ; any TTY output to do?
jrst iacsr0 ; nope
call imagon ; try to make proceeding win
syscal SIOT,[ clarg. tto ; output the buffer to TTY
%clctl ttoctl ; control bits (super image control)
d ? ttoctr] ; and reset counter
.lose %lssys ; huh???
iacsr0: call ntic ; get command character
cain a,IAC ; quoted IAC?
jrst ttoout ; yes, output it then
cain a,WILL ; is this a WILL code?
jrst [ call ntic ; yes, get code
cain a,ECHO ; saying it will echo?
jrst [ skipe echop ; is echoing on already?
jrst ntimpg ; yes, ignore it
store %fword,echop; no, I don't have to echo now
telcmf [IAC DO ECHO]
jrst ntimpg] ; no, respond to random request
cain a,SUPRGA ; suppress GA?
jrst [ skipe supgap ; really confirming or new?
jrst ntimpg ; no, I asked for it
store %fword,supgap
telcmf [IAC DO SUPRGA]
jrst ntimpg] ; yes, confirm it
cain a,TRNBIN ; cretin Twenices?
jrst [ skipe rcbinp ; avoid protocol loop
jrst ntimpg ; loser
store %fword,rcbinp
telcmf [IAC DO TRNBIN]
jrst ntimpg] ; set and confirm
cain a,LOGOUT ; logout foreign job?
jsp a,[skipn logoup ; did I ask to logout?
jrst (a) ; foo, what's happening?
type [SZL Logout request acceptedR]
jrst ntimpg] ; now return
cain a,SDOTPT ; moby SUPDUP output?
jrst [ store %fword,sdoutp; set the state
telcmf [IAC DO SDOTPT IAC SB SDOTPT 1]
move a,[440600,,sdpblk] ; get block pointer
movei b,6*nsdvrs ; and number of TTY variables
syscal SIOT,[ clarg. nto
a ? b]
.lose %lssys ; oops!
telcmf [IAC SE]
jrst ntimpg] ; all done
telcmd [IAC DONT] ; refuse to accept this option
call ntosnd ; send what I refuse
call ntofrc ; and send it out
jrst ntimpg] ; and continue
; (continued on next page)
cain a,WONT ; is this a WONT?
jrst [ call ntic ; yes, get code
cain a,ECHO ; turn off echo?
jrst [ skipn echop ; flush my request
jrst ntimpg ; I asked for it and got it
store %zeros,echop; sigh, I have to echo!
telcmf [IAC DONT ECHO]; I didn't, must confirm
jrst ntimpg] ; and return
cain a,TRNBIN ; losey Twenices?
jrst [ skipn rcbinp ; avoid protocol loops
jrst ntimpg ; loser
store %zeros,rcbinp
telcmf [IAC DONT TRNBIN]
jrst ntimpg] ; and return
cain a,LOGOUT ; logout foreign job?
jrst [ skipn logoup ; did I ask to logout?
jrst ntimpg ; huh?
store %zeros,logoup
telcmf [IAC DONT LOGOUT]
type [SZL Logout request rejectedR]
jrst ntimpg] ; now return
cain a,SDOTPT
jrst [ skipn sdoutp ; catch protocol lossage
jrst ntimpg ; whatever
store %zeros,sdoutp; clear the state
telcmf [IAC DONT SDOTPT]
jrst ntimpg] ; and return
cain a,SUPRGA ; suppress GA?
skipl supgap ; protocol violator
jrst ntimpg ; loser either way
store %zeros,supgap ; clear the state
telcmf [IAC DONT SUPRGA]; must confirm
jrst ntimpg] ; and return
; (continued from previous page)
cain a,DO ; requesting me to DO something?
jrst [ call ntic ; what does it want?
cain a,TIMMRK ; nebbish timing mark?
jrst [ telcmf [IAC WILL TIMMRK]
jrst ntimpg] ; and continue
cain a,TRNBIN ; transmit binary?
jrst [ skipe trbinp ; am already doing this?
jrst ntimpg ; yes, then ignore this
store %fword,trbinp; yes, good, I can
telcmf [IAC WILL TRNBIN]
jrst ntimpg] ; no, random, win anyway
telcmd [IAC WONT] ; well, I won't do it!
call ntosnd ; so there.
call ntofrc ; and force it out
jrst ntimpg] ; and continue
cain a,DONT ; DONT do something?
jrst [ call ntic ; what doesn't it want me to do?
cain a,TRNBIN ; transmit binary?
skipn trbinp ; check for already
jrst ntimpg ; already
store %zeros,trbinp ; yes, turn it off
telcmf [IAC WONT TRNBIN]
jrst ntimpg] ; and return
cain a,DM ; data mark?
dmkser: jrst [ sosg axttop ; should TTY go on?
store %zeros,ttyop ; bop on TTY
jrst ntimpg] ; and let's continue
caie a,SB ; subnegotiation?
jrst ntimpg ; no, return
call ntic ; get the option
cain a,SDOTPT ; SUPDUP option?
skipn sdoutp ; in SUPDUP mode?
.value ; you lose buckeroo
call ntic ; get next byte
caie a,2 ; better be a 2...
.value ; when the time comes I'll write it
call ntic ; get the count now
jumpe a,sdsdun ; null option
caile a,254. ; legal?
.value ; Greenberg you turkey
save a ; save the counter
move b,a ; stash count away in a good place
move x,[441000,,sdobfr] ; get pointer to SUPDUP buffer
sdiout: call ntic ; get the byte
idpb a,x ; stash in buffer
sojg b,sdiout ; loop until done
move x,[441000,,sdobfr] ; I/O pointer
retr b ; get counter back
syscal SIOT,[ clarg. itto ; output to image TTY
x ? b] ; pointers...
.lose %lssys ; ? ? ?
sdsdun: call ntic ; eat the x position
move b,a ; stash it away
call ntic ; now the y position
syscal SCPOS,[ clarg. tto ; tty number
a ? b] ; position arguments
.lose %lssys ; horrible error 69
call ntic ; now look for the IAC SE
caie a,IAC ; paranoia
.value ; don't blame me you wrote the option
call ntic ; now the SE
caie a,SE ; well?
.value ; sigh...
jrst ntimpg ; and return
subttl Connection error messages
; Tables of network error messages
errtab: strwrd [ Connection never opened]
strwrd [ Closed by user]
strwrd [ Closed by host]
strwrd [ Reset by host]
strwrd [ Host died]
strwrd [ Incomplete transmission]
strwrd [ Byte size mismatch]
strwrd [ Local Network Control Program down]
strwrd [ Refused]
maxerr==.-errtab
icperr: strwrd [random network lossage]
strwrd [system down]
strwrd [foreign Network Control Program down]
strwrd [host does not exist to the knowledge of the NCC]
strwrd [foreign Network Control Program initialization]
strwrd [scheduled maintenance]
strwrd [scheduled hardware work]
strwrd [scheduled software work]
strwrd [emergency restart]
strwrd [power failure]
strwrd [software breakpoint]
strwrd [hardware error]
strwrd [scheduled downtime]
strwrd [undefined reason - 13]
strwrd [undefined reason - 14]
strwrd [host coming up now]
esstab: strwrd [CLS received.]
strwrd [listening for RFC.]
strwrd [RFC received.]
strwrd [CLS received after RFC.]
strwrd [RFC sent.]
strwrd [open.]
strwrd [RFNM wait.]
strwrd [waiting for matching CLS.]
strwrd [CLS with input available.]
strwrd [input available.]
maxess==.-esstab
; Here when ICP loses. Say why
tcpluz: call netwrk"analyz
jfcl
jrst reset
icpluz: move a,$ercod ; get socket state
cain a,%efldv ; all sockets taken?
jrst [ type [ No free network sockets]
jrst reset] ; restart
cain a,%enrdv ; network crash?
jrst [ type [ Local Network Control Program down]
jrst reset] ; restart
cain a,%ensio ; bad gender?
jrst [ type [ Homosocketuality is against the laws of ARPA]
jrst reset] ; the Anita Bryant feature
cain a,%emchn ; moby host?
jrst [ type [ Extended address host not yet supported by ITS]
jrst reset] ; anybody still lose this way?
caie a,%enapp ; host down?
cain a,%ensdr ; . . .
jrst hstded ; yup, say so and when back
save $ercod ; save this value
type [ ICP failure -- ]
retr a ; get connection error code
syscal OPEN,[ clarg. err ; open on error channel
clarg. ('ERR) ; magical error reporting device
clarg. 4 ; this is a .CALL error
%clarg a] ; this is the code it was
.lose %lssys ; goddam bagbiting system
.iot err, ; get a character of the message
jumpg [ caie 0,^L ; flush form feeds
.iot tto, ; if still more type it
jrst .-1] ; and get more
.close err, ; flush error channel
rnderr: type [
This is not supposed to happen; please report this via :BUG TELNET.
]
jrst reset ; oh well
; Here if no response from foreign host
icptmo: type [ Time out]
jrst reset ; losing time outs!
; Here when connection closed on me
closed: skipl openp ; ICP done?
jrst clsd1 ; no, no header
type [
Connection closed;]
skipn tcpp
jrst clsd1
type [
]
jrst reset
clsd1: cail c,maxerr ; greater than largest error?
jrst random ; yes, random error
movsi a,440700 ; byte pointer
hrr a,errtab(c) ; to proper error message
hlrz b,errtab(c) ; and counter
syscal SIOT,[ clarg. tto ; output the string to the TTY
a ? b] ; point in A, count in B
.lose %lssys ; argh
cain c,%ncded ; host dead?
jrst hstwhy ; yes, say why
caie c,%ncnto ; never opened?
cain c,%ncusr ; or I closed it?
jrst rnderr ; this ain't supposed to happen!
jrst reset ; restart
random: type [ unknown code - ]
idivi c,8. ; split close reason up
addi c,"0 ; ASCIIify
.iot tto,c ; output
addi d,"0 ; ASCIIify low order
.iot tto,d ; output it too
jrst rnderr ; and restart
; Here when host dead, say so and when it will be back up
hstded: type [ Host dead]
hstwhy: syscal NETHST,[ %clarg hostad ; get status of this host
%clval x] ; into a convenient place
.lose %lssys ; huh???
move y,x ; make an extra copy
andi x,17 ; just get state
type [ due to ]
movsi a,440700 ; byte pointer
hrr a,icperr(x) ; get pointer to error
hlrz b,icperr(x) ; counter
syscal SIOT,[ clarg. tto ; type on TTY
a ? b] ; with count and pointer
.lose %lssys ; argh
andi y,177760 ; get time back
jumpe y,reset ; flush if nothing
cain y,177740 ; -2 means unknown future time
jrst reset ; which is flushed make Moon happy
type [.
Host is expected back up ]
cain y,177760 ; -1 means more than a week
jrst [ type [over a week from now.]
jrst reset] ; and reset the world
ldb a,[150300,,y] ; get day of week
ldb b,[100500,,y] ; get hours time
subi b,5 ; EST/GMT offset
.ryear x, ; get time info
tlne x,100000 ; daylight losing time?
aosl b ; yes, go ahead an hour
jumpge b,noday ; easy way out
addi b,24. ; move up a day
sosge a ; and days back
movei a,6 ; back to Sunday
noday: save b ; save real hours
move a,[strwrd [on Monday at ]
strwrd [on Tuesday at ]
strwrd [on Wednesday at ]
strwrd [on Thursday at ]
strwrd [on Friday at ]
strwrd [on Saturday at ]
strwrd [on Sunday at ]
strwrd [on April Fool's Day at ]](a)
hlrz b,a ; get counter
hrli a,440700 ; make into a byte pointer
syscal SIOT,[ clarg. tto ; output to TTY
a ? b] ; pointer and counter
.lose %lssys ; argh
retr a ; get hours back
idivi a,10. ; split high and low order
addi a,"0 ; ASCIIify
.iot tto,a ; output high order
addi b,"0 ; ASCIIify low order
.iot tto,b ; output it too
.iot tto,[":] ; delimit
ldb a,[040400,,y] ; get minutes/5
imuli a,5. ; make into real minutes
idivi a,10. ; split up
addi a,"0 ; ASCIIify
.iot tto,a ; output
addi b,"0 ; ASCIIify
.iot tto,b ; output
tlne x,100000 ; daylight losing time?
jrst [ type [ EDT.]
jrst reset] ; different message
type [ EST.]
jrst reset ; and reset the world
subttl Interrupt service
tmploc 42,intvec(,,-intvcl) ; set up interrupt addr
; Interrupt service vector
intvec: hiac+1,,p ; AC's to save, pdl stack
%pirlt ? 1_tti ? %pirlt ? 1_tti ? ttiser ; TTY input interrupts
; (or simulated interrupt by REALT)
0 ? 1_tto+1_itto ? %pirlt ? 1_tti ? ttoser ; TTY **More** interrupts
0 ? 1_nto ? 0 ? 1_nto ? ntoser ; net output interrupts
intvcl==.-intvec ; length of interrupt vector
; Here to return from an interrupt
tsret: syscal DISMIS,[ %clcti hiac+1 ; number of AC's to restore
%clarg p] ; dismiss interrupt
.lose %lssys ; argh!
subttl Handle ints on TTI channel
; TTY input interrupt (or realtime clock interrupt to resume network
; output).
; Gobble down characters from TTY into circ buffer, and output them if
; there's room.
.scalar rltflg ; Flag set when REALT turned on
.scalar ntolos ; # times buffer overflows
.scalar ntowp ; Deposit ptr into buff
.scalar ntowc ; # chars room to deposit in
lntobf==512. ; Max size of net output buffer
.scalar ntobuf(lntobf/4) ; Net output buffer
lttibf==20.
.scalar ttibuf(lttibf/4) ; TTY input buffer (not used?)
ntoini: movei nt,lntobf ; Call to initialize buffering etc.
movem nt,ntowc
move nt,[441000,,ntobuf]
movem nt,ntowp
skipn rltflg
ret
movsi nt,(setz)
.realt nt,
jfcl
setzm rltflg
ret
ntosnd: movei nt,(a)
ntout: sosge ntowc
jrst [ setzm ntowc
.iot tto,[^G] ; Lose, ding bell.
aos ntolos
ret]
idpb nt,ntowp
ret
; Force out network output buffer
ntofrc: movei nt,lntobf
sub nt,ntowc ; Find # chars to output
jumple nt,ntoini ; Jump if none, re-init ourselves.
push p,a
syscal whyint,[movei nto ? movem a ? movem a ? movem a]
.lose %lssys ; Get # chars room in A
jumple a,ttirt8 ; Jump if can't send anything.
caile a,(nt) ; Use minimum of <buffer room> and <data>
movei a,(nt)
push p,b
push p,c
subi nt,(a) ; Get # bytes that will be left over
move b,[441000,,ntobuf]
syscal siot,[movei nto ? b ? a]
.lose %lssys
.nets nto,
jumple nt,[pop p,c ? pop p,b ? pop p,a
jrst ntoini] ; If none left, we won.
movem nt,ntowc ; Save temporarily
; Ugh, didn't send all tty input to net, so must set up
; to send it later. Instead of hacking circular buff, we
; simplify life by moving data up to beg of buffer!
move nt,[441000,,ntobuf]
ildb a,b
idpb a,nt
sojg c,.-2
movem nt,ntowp ; Store new deposit ptr
movei a,lntobf
sub a,ntowc
movem a,ntowc ; and new # chars room for deposit
pop p,c ; Fall thru to enable timer
pop p,b
ttirt8: pop p,a
skipe rltflg ; Can't send anything more now.
ret ; Timer already set to tickle us later.
setom rltflg
move nt,[600000,,[20.]] ; Try again in 1/3 sec
.realt nt,
jfcl
ret
; Return point when TTY input processing done, to
; force out network output.
ttiret: call ntofrc
jrst tsret
; Gobble down character
ttiser: syscal IOT,[ clctl. %tiint\%tinwt; read character if any
clarg. tti ; from TTY input
%clval a] ; into A
.lose %lssys ; huh???
jumpl a,ttiret ; return when no more
trz a,%txsft ; lose shift bits
camn a,cmdesc ; user wants a command?
jrst [ call cmprmt ; yes, do a command
jrst ttiser ; and try for another character
.value [asciz/:Proceed
:Vk
/]
useti AIFPIR,1_tti ; lost the TTY, lose this int too
jrst ttiret] ; dismiss int
cain a,%txtop\"H ; [HELP]?
jrst [ call help ; give the guy some help
jrst ttiser] ; and get another character
ttisr5: skipl openp ; connection opened?
jrst ttiser ; nope, flush this frob then
trze a,%txmta ; <META> set?
store %fword,editkp ; yes, set <EDIT> key
store linmor,morinh ; reset **More** inhibit count
; Fold bucky bits down to ASCII
ttisr1: move b,a ; copy the character
trz b,%txctl ; lose <CONTROL>
caie b,%txtop\"A ; [ESCAPE]?
cain b,%txtop\"B ; [BREAK]?
jrst [skipn echop ; in local echo mode?
skipn linedp ; no, in line editor?
jrst ttiser ; nope, no line editor to work with
movei a,^B ; yes, load line editor BREAK
jrst ttisr2] ; and continue
cain b,%txtop\"C ; [CLEAR]?
jrst [ skipn echop ; in local echo mode?
skipn linedp ; no, in line editor?
jrst ttiser ; nope, no line editor to work with
movei a,^U ; yes, load line editor clear command
jrst ttisr2] ; and continue
cain b,^Z ; [CALL]?
jrst [ move b,ttyopt ; get options
tlnn b,%tofci ; gotta have bucky bits
jrst ttisr2 ; don't screw non-bucky bit keyboards
skipn echop ; in local echo mode?
skipn linedp ; in line editor?
jrst ttisr2 ; nope, no line editor
movei a,^A ; yes, make it an ATTN
jrst ttisr2] ; and continue
trz a,%txtop ; lose top bit
; (continued on next page)
; Canonical ITS mapping for <CONTROL> to standard ASCII. [SPACE]
; mapping to @ is taken from the usual ASCII keyboard.
trzn a,%txctl ; control bit on?
jrst ttisr2 ; nope, a-okay
cain a,<" > ; space?
movei a,^@ ; yes, become null
cail a,"? ; ? is [RUB OUT]
cain a,177 ; [RUB OUT] is not hacked
jrst ttisr2 ; not hacking character
caile a,"_ ; lower case?
subi a,"a-"A ; uppercaseify
xori a,100 ; controlify
; Now send the character
ttisr2: skipl echop ; half duplex mode?
jrst hlfdpx ; yup
chrsnd: aosn editkp ; send <EDIT> key too?
iori a,200 ; turn it on
call ntosnd ; send character to foreign host
cain a,IAC ; sending [BS]?
call ntosnd ; gotta send it again!
cain a,^M ; got a <CR>?
skipge trbinp ; binary mode?
jrst [
;;; .nets nto, ; force sending buffer
jrst ttiser] ; and try for more
movei a,^J ; CR and not binary, fake an LF
jrst ttisr1 ; and make it "input" from kbd
; Input a character from the TTY when at TTY interrupt level
inpchr: syscal IOT,[ clctl. %tiint ; read char always
clarg. tti ; from device TTY
%clval a] ; into ac A
.lose %lssys ; huh???
return ; and return
subttl Half duplex local echoing, etc.
hlfdpx: skipge wallp ; wall paper on?
skipge linedp ; yes, but in the line editor?
caia ; line editor or wall paper off
.iot wal,a ; otherwise put in wallpaper file
skipge linedp ; in line editor?
skipe linctr ; first character on this line?
jrst hlfdx1 ; nope
syscal SCPOS,[ clarg. tto ; get cursor position
repeat 2,%clval inipos]
.lose %lssys ; ???
move b,inipos ? movem b,hpos ; set hpos count
hlfdx1: cain a,^I ; tab?
jrst [ push tp,hpos ; save this hpos
skipge 10tabp ; Multix tabs?
jrst [ movei b,10. ; to next tab stop
add b,hpos ; add in current position
idivi b,10. ; now flush modulo
imuli b,10. ; to get real position
movem b,hpos ; and remember it
csrmov H ; set horizontal position
addi b,8. ; add in ITS offset
.iot tto,b ; and move there
jrst hlfdx3] ; and continue on
movei b,8. ; to next tab stop
addm b,hpos ; add in tab
movei b,7 ; mask for extraneous cruft
andcam b,hpos ; flush the cruft
jrst hlfdx4] ; and continue
cain a,177 ; rubout?
jrst hlfdx3 ; yes, flush flush flush
cain a,^H ; backspace?
jrst [ sos hpos ; yes, decrement horizontal position
jrst hlfdx4] ; and win
cain a,^M ; terpri?
jrst hlfdx4 ; yes, win
; (continued on next page)
caige a,<" > ; or printing character?
jrst [ skipe linedp ; line editor command?
jsp b,[skipge lquotp ; line editor quote?
jrst (b) ; yes, no echo suppress
caie a,^J ; yes, line feed?
cain a,^W ; word wipe?
jrst hlfdx3 ; never are echoed
caie a,^A ; same for the ATTN
cain a,^C
jrst hlfdx3 ; ATTN
caie a,^O ; and output abort commands
cain a,^S
jrst hlfdx3
caie a,^L ; redisplay
cain a,^R
jrst hlfdx3 ; don't echo either
caie a,^Q ; quoting
cain a,^U ; and line erase
jrst hlfdx3 ; don't echo
caie a,^B ; finally BREAK
cain a,^T ; and AYT commands
jrst hlfdx3 ; which never come out
jrst 2(b)] ; else echo the character
cain a,^J ; line feed?
jrst hlfdx4 ; never bumps HPOS
skipge twinp ; SAIL terminal?
skipa b,[" ] ; yes, use TV uparrow
movei b,"^ ; no, use ASCII caret
.iot tto,b ; print the control indication
movei b,"@(a) ; get ASCII form
.iot tto,b ; output the character
aos hpos ? aos hpos ; allow for character
jrst hlfdx3] ; and continue
aos hpos ; bump the horizontal position
hlfdx4: .iot tto,a ; output character
hlfdx3: skipl linedp ; in the line editor?
jrst chrsnd ; finally can send
; jrst lined ; yes, hack time
subttl Hairy line editor
lined: cain a,177 ; rubout?
jrst [ call delch ; yes, erase a character
jrst ttiser] ; and continue
caie a,^I ; tab?
cail a,<" > ; printing character?
jrst lnechs ; yes, send character
aosn lquotp ; line editor quote?
jrst lnechs ; yes, send it
caie a,^C ; C is ATTN too
cain a,^A ; send ATTN?
jrst [store ttobuf(440700),ttoptr; reset buffer pointer
store %zeros,ttoctr ; zap output buffer
.netint nto, ; complete synch
telcmd [IAC IP IAC DM] ; send command + part of synch
jrst ttiser] ; and continue
cain a,^B ; send break?
jrst [ .netint nto, ; complete synch
telcmd [IAC BRK IAC DM] ; send command + part of synch
jrst ttiser] ; and continue
caie a,^O ; O is an alias for silence
cain a,^S ; silence?
jrst [.netint nti, ; send an interrupt
telcmd [IAC AO IAC DM]
store %zeros,ttoctr ; empty buffer
store ttobuf(440700),ttoptr; reset pointer
jrst ttiser] ; and continue
cain a,^Q ; quote next character
jrst [ store %fword,lquotp ; yes, quoted
jrst ttiser] ; and continue
cain a,^T ; print status?
jrst [ telcmd [IAC AYT]
jrst ttiser] ; yes, get host to send a wholine
cain a,^U ; flush entire line?
jrst [ store linbuf(440700),linptr; load pointer
store %zeros,linctr ; clear line counter
store %zeros,hpos ; initialize horizontal position
move b,ttyopt ; get terminal options
tlne b,%toovr ; glass TTY? (might as well)
tlne b,%toers ; display?
jrst [csrmov H
move a,inipos ; get initial cursor position
movem a,hpos ; reset it for us
addi a,8. ; offset
.iot tto,a ; restore cursor
csrmov L
jrst ttiser] ; and try again
csrmov A
jrst ttiser] ; restart again
cain a,^W ; wipe out word?
jrst delwrd ; yes, flush the word
cain a,^J ; line feed?
jrst sndbfr ; yes, send buffer
; (continued on next page)
; (continued from previous page)
; The Incomparable Incredibly Bletcherous Retype Routine!!!
; ...bringing you the very worst in program readability, the lowest in
; taste and the ultimate(?) in hair. How can anybody ever understand
; this disgusting code? What made me ever write it this gross way?
caie a,^L ; zap and redisplay?
cain a,^R ; redisplay?
jrst [move b,ttyopt ; get this console's option variable
tlne b,%toovr ; glass TTY?
tlne b,%toers ; or display?
jsp b,[ cain a,^L; zap screen too?
jrst [ csrmov C
jrst 2(b)]; yes, zap then fall through
csrmov H
move c,inipos; initial cursor position
movei a,8.(c); offset
.iot tto,a; restore cursor
csrmov L
jrst 3(b)]; and continue
csrmov A
setzb c,inipos ; cursor at BOL
move a,[440700,,linbuf] ; if you thought that was bad,
move tp,[-5*linbfl,,tabpdl]; look at the crocks coming up!
move linctr ; how many characters to do
jsp b,[ sojl ttiser ; all done yet?
ildb d,a ; get character
caige d,<" > ; control character?
jrst [ cain d,^I; tab?
jrst [ push tp,c; save current position
skipn 10tabp; screwy Multix 10 tabs?
jrst [ addi c,8.; no, go to next stop
trz c,7; make sure at a real stop
.iot tto,d; output an 8. tab
aoja c,@-1(b)]; now try next
addi c,10.; go to Multix tab stop
idivi c,10.; but flush modulo
imuli c,10.; in the canonical way
csrmov H
movei d,8.(c); PH offset
.iot tto,d; now put cursor there
jrst @-1(b)]; and try next character
cain d,^J; line feed?
jrst [ .iot tto,d; yes, just output it
jrst ttiser]; without bumping position
cain d,^H; backspace?
jrst [ .iot tto,d; yes, output it
soja c,@-1(b)]; but SOS position!
save d ; save old character
skipge twinp; winning terminal?
skipa d,[" ]; uparrow
movei d,"^; no, caret
.iot tto,d; output the control prefix
retr d ; and get the character back
movei d,"@(d); get ASCII name
.iot tto,d; output it
aoja c,@-1(b)]; and try next
.iot tto,d ; no, output the character (sigh)
aoja c,@-1(b)]] ; and try next character
; (continued on next page)
; (continued from previous page)
lnechs: aosle b,linctr ; update counter
cail b,5*linbfl ; too long line?
jrst [type [ALine too long!A]
move tp,[-5*linbfl,,tabpdl] ; reinitialize line editor variables
store %zeros,linctr ; counter...
store linbuf(440700),linptr; and pointer
jrst ttiser] ; and return
idpb a,linptr ; save character in buffer
caie a,^M ; CR?
jrst ttiser ; no, return
movei a,^J ; get a LF too
.iot tto,a ; echo it
aos linctr ; bump buffer pointer again
idpb a,linptr ; save character
skipge wallp ; wallpaper file enabled?
.iot wal,a ; yes, stick the LF in (thanx Moon)
sndbfr: store linbuf(440700),linptr,,a ; load pointer
move tp,[-5*linbfl,,tabpdl] ; load up tab pdp
skipl wallp ; wallpaper?
jrst sndbf1 ; nope
move b,linctr ; don't want counter smashed yet
syscal SIOT,[ clarg. wal ; wallpaper output
a ? b] ; line editor buffer
.lose %lssys ; foo!
move a,linptr ; reload line pointer
sndbf1: call ntofrc ; Ensure other buffer flushed first
syscal SIOT,[ clarg. nto ; network output
a ? linctr] ; output the line
.lose %lssys ; huh????
.nets nto, ; force it out
jrst ttiser ; and continue
; Here to flush an alphanumeric word.
delwrd: skipg linctr ; line empty?
jrst ttiser ; yes all done
ldb a,linptr ; get current character
call alpnmp ; alphanumeric?
jrst [ call delch ; no, flush it
jrst delwrd] ; and go again
delwd1: call delch ; flush this character
skipg linctr ; any more?
jrst ttiser ; nope
ldb a,linptr ; get new current char
call alpnmp ; alphanumeric?
jrst ttiser ; nope, all done
jrst delwd1 ; yes, flush it too
; Here to skip if alphanumeric character in A.
alpnmp: cail a,"a ; lower case?
subi a,"a-"A ; yes, uppercaseify
cail a,"0 ; too low?
caile a,"Z ; too high?
return ; yes, rejected!
caile a,"9 ; numeric?
cail a,"A ; alphabetic?
aos (p) ; yes, bump return PC
return ; and return
; Here to flush a single character from the screen or echo it
; back if a printing console.
delch: sosge linctr ; rubout, drop buffer
jrst [ store %zeros,linctr ; buffer already empty
return] ; get another character
move a,linptr ; get line editor pointer
add a,[70000,,] ; decrement pointer
tdne a,[%minfi] ; back a full word?
sub a,[430000000001] ; yes, decrement word
movem a,linptr ; store updated pointer
ildb a,a ; get character deleted
move b,ttyopt ; get status of this terminal
tlne b,%toovr ; glass teletype?
tlne b,%toers ; or display?
jrst [cain a,^I ; tabs are special
jrst [ pop tp,a ; get last tab pos
movem a,hpos ; set new position
csrmov H ; set horizontal position
addi a,8. ; offset
.iot tto,a ; fix cursor
return] ; and return
cain a,^J ; line feed
jrst [ csrmov U ; just moves cursor up
return] ; now return
cain a,^H ; backspace
jrst [ aos hpos ; bumps the cursor forward
csrmov F ; this can't win all the time,
return] ; but we'll try...
caige a,<" > ; for all other controls...
jsp b,[sos hpos ; erase the ASCII part
csrmov X ; account for it
jrst (b)] ; and erase the ^
sos hpos ; get the current horizontal pos
csrmov X ; erase character
return] ; and continue
sos hpos ; account for character
.iot tto,a ; echo character deleted
return ; and continue
subttl Command process and dispatch
define cmnd code,server
loc cmdtab+code-<" >
server
termin
cmprmt: skipe jclbuf ; any JCL?
jrst open ; yes, fake an O command right away
skipge x,hostad ; connection open or opening?
jrst cmprm1 ; no, no bottom of screen
move a,ttyopt ; get option bits
tlc a,%tomvu\%toers ; set both bits zero iff both one
tlne a,%tomvu\%toers ; well, are they?
jrst [ csrmov A ; not a display, just terpri
jrst cmprm1] ; continue on
csrmov S ; save cursor pos
csrmov Z ; bottom of screen
csrmov L ; clear line
cmprm1: type [TELNET>]
move a,ttysts ; get current status
tlz a,%tssii ; turn off super-image mode
syscal TTYSET,[ clarg. tto ; this is so Z and _ will
%clarg ttyst1 ; do their normal ITS functions
%clarg ttyst2 ; at command level
%clarg a]
.lose %lssys ; TTYSET failed?
commnd: call inpchr ; and hang for it
camn a,cmdesc ; escape character again?
jumpge x,[ csrmov R ; restore cursor position
retr (p) ; reset stack down
syscal TTYSET,[ clarg. tto; turn super-image
%clarg ttyst1; mode back on
%clarg ttyst2
%clarg ttysts]
.lose %lssys ; huh???
jrst ttisr5] ; send it to foreign host
cmmnd1: andi a,%txctl\%txasc ; only want char plus bucky bit
cail a,140 ; lower case?
subi a,40 ; yes, uppercaseify
trnn a,%txctl ; control character?
caige a,<" > ; . . .
jrst cmdnop ; yes, flush the command
jrst @cmdtab-<" >(a) ; otherwise dispatch on command
cmdnop: .iot tto,[^G] ; barf at bad command
skipl hostad ; connection open?
jrst cmdret ; yes, return
jrst commnd ; no, just ask for something else
cmdfls: .iot tto,[^G] ; here when a command flushed
store %zeros,jclbuf ; just in case
jrst cmdret ; and return
; Command dispatch table
cmdtab: repeat 100,cmdnop ; default to nothing
cmnd "1,10tabs ; Multix type tabs
cmnd "?,help ; alternate help cruft
cmnd "A,sndatt ; ATTN
cmnd "B,sndbrk ; break
cmnd "C,close ; close connection
cmnd "D,dmsima ; DM simulation
cmnd "E,echotg ; echo toggle
cmnd "F,fullcs ; FCS toggle
cmnd "G,supimg ; super image toggle
cmnd "H,help ; help cruft
cmnd "I,escset ; interrupt character
cmnd "J,jtglce ; just toggle crufty echo
cmnd "K,kiljob ; kill foreign job
cmnd "L,linedt ; line editor toggle
cmnd "M,mortog ; **More** processing toggle
cmnd "N,ncptog ; Use NCP not TCP (toggle)
cmnd "O,open ; open connection
cmnd "P,proced ; DDT
cmnd "Q,quit ; quit
cmnd "S,wholin ; do a wholine at foreign host
cmnd "T,ttyotg ; TTY output toggle
cmnd "W,walltg ; wallpaper toggle
cmnd "X,togsts ; toggle status
cmnd "Z,zapscn ; zap screen
cmnd "^,editfy ; <EDIT>ifier
loc cmdtab+100 ; to end of table again
subttl Help text
define htxgen string
hlptxt: ascii\!string!\
htxlen==.length\!string!\
termin
htxgen [
User TELNET commands:
A * Send ATTN (interrupt process at foreign host).
B * Send Break.
C * + Close connection or abort an incomplete O command.
D * Toggle the Datamedia 3000 simulator. Works only on terminals with
insert/delete mode. <META> acts like the DM <EDIT> key.
E * Request foreign host to toggle the echo mode; toggling to local
echo will always work. The echo state is initially remote
echo if the host accepts it. The foreign host may forbid the
toggle, in which case the J command can be used.
F Full character set toggle. Says whether or not super-image
mode should be used. Defaults on for non-TV's.
G Toggle super image output mode (useful for displaying graphics
from a remote host). Defaults off.
H or ? Display help message (this text). The [HELP] key does this too.
I Set the intercept character (defaults to <CONTROL>^ on non-TV's;
[BREAK] on TV's).
J * Toggle TELNET's echo mode without telling the foreign host or
asking it for permission.
K * + Request foreign host to kill the foreign job.
L Toggle the line editor; normally on, but only works in local
echo mode. Hence if the foreign host forbids remote echo mode
you automatically get the line editor (such as in Multics).
Line editor commands:
<CONTROL>A send ATTN.
<CONTROL>B send Break.
<CONTROL>C send ATTN.
<CONTROL>L clear screen and redisplay line.
<CONTROL>O abort output.
<CONTROL>Q quotes next character.
<CONTROL>R redisplay line.
<CONTROL>S abort output.
<CONTROL>T ask host for a status message.
<CONTROL>U delete line.
<CONTROL>W delete last word.
[LINE FEED] activate line (send it to the foreign host),
[RETURN] insert a CRLF and activate line.
[FORM FEED] clear screen and redisplay line.
[RUB OUT] delete last character.
<META>[BREAK] send Break.
[CLEAR] delete line.
<META>[CALL] send ATTN.
M Toggle **More** processing; initially enabled for displays.
N Use old NCP protocol instead of TCP -- give only before Open!
O Open connection to SOCKET,HOST. The socket number is optional
and defaults to 27 for new TELNET. The host specification may
be a name or a number; "?" lists the available hosts at that
point in the scan. Numbers are octal unless followed by a
decimal point or an 8 or 9 appears in the number.
P Proceed TELNET and return the console to DDT.
Q + Quit (exit from TELNET and kill the job).
S * Ask host to give some sort of status message.
T Toggle TTY output; initially enabled.
W Toggle wallpaper file; initially disabled. The file is written
as DSK:NETOUT > on the default directory.
X Lists status of TELNET's toggles.
Z Zap (clear) display screen.
1 Toggle Multics-style tab processing (ie, 10. column tab stops).
This only happens in local echo. Connecting to a Multics host
sets this mode automatically.
^ * Send <EDIT> on the next character, intended to be used with the
DM simulator for terminals without a <META> key.
* = open connection required, + = confirmation required if open
The intercept character as a command sends that character to the host.
]
subttl Help and toggle status commands
define toggle tognam,togdsc/
type [ togdsc ]
.iot tto,["O]
ifse tognam,TTYOP,skipge tognam
.else skipl tognam
jrst [type [ff]
jrst .+2]
.iot tto,["n]
csrmov A
termin
help: type [Help text]
csrmov C
save morep ; save **More** status
store %fword,morep ; must have **More** processing now
store %fword,morinh ; don't allow inhibition of **More**
move x,[440700,,hlptxt] ; load pointer to help text
movei y,htxlen ; load length of text
syscal SIOT,[ clarg. tto ; output to console
x ? y] ; using pointer and count
.lose %lssys ; ???
retr morep ; restore **More** state
store %zeros,jclbuf ; zap JCL buffer
jrst hlpret
togsts: type [Toggle status]
save morep ; save **More** state
store %fword,morep ; turn on **More** processing
move a,ttyopt ; get option bits
tlc a,%tomvu\%toers ; set both bits zero iff both one
tlnn a,%tomvu\%toers ; well, are they?
skipge hostad ; connection open?
jrst togst1 ; no, no cursor hacking
csrmov R
togst1: csrmov A
toggle 10TABP,Multics-style tab processing
toggle DMSIMP,Datamedia simulator
toggle ECHOP,Remote echo
toggle LINEDP,Line editor
toggle (P),**More** processing
toggle TTYOP,TTY output
toggle WALLP,Wallpaper file
retr morep ; restore **More** state
hlpret: skipge hostad ; connection open?
jrst cmprm1 ; no, go get a command
csrmov Z ; bottom of screen
csrmov L ; wipe line
jrst cmprm1 ; and get a command
subttl Open command
open: skipl hostad ; are we connected?
jrst cmdnop ; yes, must close first!
skipe jclbuf ; got JCL?
move j,[440700,,jclbuf] ; load pointer to JCL buffer
movei a,[asciz /Open connection to /]
movem a,prompt'
store %zeros,icpskt ; initialize initial socket
pushj p,netwrk"hostnm ; Do hostname lookup interactively
jrst cmdfls ; Fail or something?
movem a,hostad ; Store host address.
netwrk"getnet x,hostad ; Find out which network.
came x,[netwrk"nw%chs] ; Chaosnet is not on Internet.
jrst open1
type [A This program cannot reach that Chaosnet-only host.]
store %fword,hostad ; not at any host
jrst cmdret
;;; Now check to see if we should hassle people.
;;; Hassle only ARPAnet people.
;;; If this program is ever extended to hack CHAOS connections,
;;; we should not barf at ARPA->CHAOS users.
ifn ftnethop,[
skipa x,[tto] ; start with this TTY
nxtpty: addi x,400000 ; try next TTY down
syscal STYGET,[ %clarg x ; get STY mother
%clval x ] ; into X
.lose %lssys ; ???
andi x,777777 ; flush left half
jumpe x,notsty ; no PTY mother, no net hopping here
syscal STLGET,[ %clari tto ? %clval a ? %clval b ? %clval c ? %clval d ]
.lose %lsfil ; Get luser's server telnet info.
tlnn d,2000 ; If he is coming from the ARPAnet
jrst nhpcfm ; go hassle him about net-hopping.
];ifn ftnethop
open1: movei b,nprskt ; default ICP socket #
skipn icpskt ; have I gotten one?
movem b,icpskt ; nope, got one now!
store %zeros,jclbuf ; clear JCL buffer
type [A Trying...]
jrst goicp
netwrk"spchan:
cain t,",
jrst [ .iot tto,t
skipl t,netwrk"numgot
movem t,icpskt
return] ; restart from beginning (clear RCPBUF)
cain t,^G
jrst cmdfls
aos (p) ; else ignore char
cpopj: return
netwrk"putchr:
.iot tto,t
return
; Open input character routine (either from TTY or JCL)
netwrk"getchr:
skipn jclbuf ; any JCL?
jrst [ .iot tti,t ; no, get a character from console
andi t,%txasc ; only want ASCII part
aos (p)
return] ; and return
ildb t,j ; yes, get a character from JCL
cain t,^C ; end of buffer?
movei t,^M ; yes, fake a CR
cain t,^M ; is it end of command?
store %zeros,jclbuf ; yes, flush JCL forever
jumpe t,netwrk"getchr ; flush nulls
aos (p)
return ; got a JCL character all okay
; Copy the zero-terminated string from Bp in J into JCLBUF.
filjcl: move t,[440700,,jclbuf]
filjc1: ildb x,j
idpb x,t
skipe x
jrst filjc1
return
; Close command and reset routine if connection closed on us
close: skipge hostad ; ever got opened?
jrst cmdnop ; nope, no-op
type [Close connection]
skipe openp ; don't need confirm if not open
jsp c,confrm ; get confirmation
store %zeros,killp ; no death if this way
reset: skipe killp ; shall I suicide?
.logout 1, ; yup
csrmov A ; advance to NL
irps chnl,,[icp nti nto]
.close chnl, ; close all net channels
termin
store %zeros,rstbeg,corend ; reset all flags
store %fword,hostad ; clear host to get to
useti MSK2,1_tto ; clear interrupts pending
useti MASK,%pirlt
useti IFPIR,%zeros ; . . .
useti DF2,%zeros ; . . .
move p,[-pdllen,,pdl] ; reset stack pointer
call ntoini
jrst notcon ; and become not connected
subttl Host level commands
echotg: skipl openp ; ICP done?
jrst cmdnop ; no, not ready yet
type [Echo request at ]
skipl echop ; full duplex?
jrst [ type [remote host]
store %fword,echop
skipl nprotp ; new protocol?
jrst [telcmd [204] ? jrst cmdret]; old protocol ECHO
telcmf [IAC DO ECHO]
jrst cmdret] ; and return
type [local host]
store %zeros,echop
skipl nprotp ; new protocol?
jrst [telcmd [203] ? jrst cmdret]; old protocol NO ECHO
telcmf [IAC DONT ECHO]
jrst cmdret ; and return
dmsima: skipe twinp ; is this a TV?
skipl openp ; connection open?
jrst cmdnop ; no, don't take this command
type [Datamedia simulation o]
setcmb a,dmsimp ; toggle DM simulation
jumpge a,[ type [ff]
skipl nprotp ; new protocol?
jrst cmdret ; oh damn
store %zeros,trbinp; not in 8 bit mode any more
telcmf [IAC WONT TRNBIN]
jrst cmdret] ; and return
.iot tto,["n] ; it's on
skipl nprotp ; new protocol?
jrst dmsma1 ; too bad
store %fword,trbinp
telcmf [IAC WILL TRNBIN]
dmsma1: movsi x,%tsrol ; have to scroll (ick!)
iorm x,ttysts ; turn the bit on
syscal TTYSET,[ clarg. TTO ; set it
ttyst1 ? ttyst2 ? ttysts]; TTY variables
.lose %lssys ; ???
store %zeros,morep ; turn off **More** processing
jrst cmdret ; and return
editfy: skipl openp ; ICP done?
jrst cmdnop ; nope, lose
type [<EDIT> key]
store %fword,editkp ; turn on <EDIT> key
jrst cmdret ; and return
wholin: skipge nprotp ; new protocol?
skipl openp ; ICP done?
jrst cmdnop ; no, not ready yet
type [Status]
telcmf [IAC AYT]
jrst cmdret ; and return
sndatt: skipl openp ; ICP done?
jrst cmdnop ; no, not ready yet
type [ATTN]
.netint nto, ; send an interrupt
skipl nprotp ; new protocol?
jrst [ telcmf [201 200]
jrst cmdret] ; old protocol break
telcmd [IAC IP IAC DM]
store %zeros,ttoctr ; and buffer count
store ttobuf(440700),ttoptr ; reset buffer pointer
jrst cmdret ; and return
kiljob: skipge nprotp ; new protocol?
skipl openp ; connection open?
jrst cmdnop ; nope, lose
type [Kill job request at foreign host]
jsp c,confrm ; demand confirmation!
telcmf [IAC DO LOGOUT]
store %fword,logoup ; remember this was asked for
jrst cmdret ; and return
sndbrk: skipge nprotp ; new protocol?
skipl openp ; ICP done?
jrst cmdnop ; no, not ready yet
type [Break]
.netint nto, ; send network interrupt (INS)
telcmf [IAC BRK IAC DM]
jrst cmdret ; and return
subttl Local level commands, confirmations, etc.
proced: type [Proceed, return TTY to DDT]
aos (p) ; bump return PC
jrst cmdret ; and return
zapscn: csrmov C ; clear screen
jrst imagon ; and return
quit: type [Quit]
skipe openp ; connection open?
jsp c,confrm ; yes, require confirmation
.logout 1, ; suicide now
ifn ftnethop,[
nhpcfm: uget XUNAME,x ; get my name
irps winner,,MRC RWK RMS KLH GSB EAK EJS CSTACY ED MOON PGS DLW JNC OTA JIS JSOL CBF
camn x,[sixbit/winner/]
jrst notsty
termin
hllos x ; check for not logged in
aoje x,[type [Login Please]
.logout 1,] ; you lose
type [
You are logged into ITS over the ARPAnet. It is a waste of ITS'
system resources (jobs, network channels) to go back again over
the ARPAnet to another site. It also slows down response to you
and increases the chances of lossage due to a system or network
failure.
You should not do this unless you have a good reason to do so. If
you have any questions, typing :LUSER to DDT will request a system
programmer to assist you.
Are you sure you want to run TELNET now?]
.iot tti,x ; get a character
andi x,%txasc ; only want character, no bucky bits
caie x,"Y ; Yes?
cain x,"y ; . . .
jrst [type [Yes
]
jrst notsty] ; claims to know what (s)he's doing
type [No
Thank you for your co-operation.
]
.logout 1, ; and suicide
];ifn ftnethop
confrm: type [ [Confirm]]
call inpchr ; get a character
andi a,%txasc ; only want character
caie a,<" > ; how about a space?
cain a,^M ; is it a CR?
movei a,"Y ; yes, fake a Yes
caie a,"y ; yes?
cain a,"Y ; . . .
caia ; yup, prepare to die...
jrst [ type [No]
jrst cmdfls] ; deconfirmed
type [Yes]
jrst (c) ; return to do whatever
escset: type [Intercept character=]
call inpchr ; get new interrupt character
.iot tto,a ; echo it
movem a,cmdesc ; set it
jrst cmdret ; and return from command
linedt: aosn linedp ; line editor on?
jrst [ type [Line editor off]
jrst cmdret] ; yes, turn off with no problems
type [Line editor on]
store %fword,linedp ; yes, enable line editor
move tp,[-5*linbfl,,tabpdl] ; load up tab pdp
store %zeros,linctr ; clear line editor counter
store linbuf(440700),linptr ; initialize line editor pointer
jrst cmdret ; and return
10tabs: type [10 character tabs o]
setcmb a,10tabp ; complement Multix tabs
jumpl a,[.iot tto,["n] ? jrst cmdret]; on
type [ff]
jrst cmdret ; and return from command
ncptog: setcmb a,tcpp
jumpe a,[type [NCP protocol (not TCP)]
jrst cmdret]
type [NCP off, using TCP]
jrst cmdret
type [NCP protocol]
mortog: type [More processing o]
setcmb a,morep ; complement **More** hacking
jumpl a,[.iot tto,["n] ? jrst cmdret]; **More** on now
type [ff]
jrst cmdret ; and return from command
walltg: type [Wallpaper file ]
setcmb a,wallp ; toggle wallpaper flag
jumpge a,[ type [closed]
.close wal, ; close off wallpaper
jrst cmdret] ; and return
.open wal,[.uao,,'DSK ? sixbit/NETOUT>/]; try to make wallpaper file
jrst [ type [cannot be opened]
store %zeros,wallp ; remember can't do!
jrst cmdret] ; and return
type [opened]
jrst cmdret ; and continue
fullcs: type [Full character set o]
movsi a,%tssii ; super image mode
xorb a,ttysts ; toggle it
syscal TTYSET,[ clarg. TTO ; set it
ttyst1 ? ttyst2 ? ttysts]; TTY variables
.lose %lssys ; ???
tlne a,%tssii ; report what it toggled to
jrst [ .iot tto,["n] ? jrst cmdret]
type [ff]
jrst cmdret
supimg: type [Super image output o]
movei a,%tjsio
xorb a,ttoctl
trne a,%tjsio ; report what it toggled to
jrst [ .iot tto,["n] ? jrst cmdret]
type [ff]
jrst cmdret
jtglce: skipl openp ; connection open?
jrst cmdnop ; nope, lose lose
type [Just toggle crufty echo o]
setcmb a,echop ; togglify it (hack hack)
jumpge a,[ .iot tto,["n]
jrst cmdret] ; echo off
type [ff]
jrst cmdret ; echo on
ttyotg: .reset tto, ; flush output
type [TTY output o]
setcmb a,ttyop ; toggle TTY output
jumpge a,[ .iot tto,["n] ; nope, indicate on
jrst cmdret] ; and return
type [ff]
store %zeros,ttobuf ; flush TTY output buffer
store ttobuf(440700),ttoptr ; and reset buffer pointer
; jrst cmdret ; and return
; Here to restore cursor position after a command
cmdret: move a,ttyopt ; get option bits
tlc a,%tomvu\%toers ; set both bits zero iff both one
tlnn a,%tomvu\%toers ; well, are they?
skipge hostad ; connected?
jrst [csrmov A ; advance to new line
return]
csrmov R ; restore cursor position
imagon: movsi a,%tssii ; super image mode
tdnn a,ttysts ; is it on?
return ; no, avoid doing the TTYSET then
syscal TTYSET,[ clarg. tto ; turn super-image mode back on
%clarg ttyst1
%clarg ttyst2
%clarg ttysts]
.lose %lssys ; TTYSET failed?
return ; and return
subttl Handle ints on NTO and TTO channels
; Network output interrupt
ntoser: syscal WHYINT,[ clarg. nto ; get status of net output channel
repeat 2,%clval c]; socket state
.lose %lssys ; huh???
andi c,-1 ; flush any left half
caie c,%nsopn ; socket open?
cain c,%nsrfn ; RFNM wait?
jrst tsret ; okay, ignore that
store %zeros,openp ; zap open status
jumpe c,tsret ; if CLS, ignore until NTI closed too
badskt: type [
Socket entered illegal state -- ]
cail c,maxess ; greater than maximum?
jrst random ; yes, barf with number
movsi a,440700 ; make a byte pointer
hrr a,esstab(c) ; get message
hlrz b,esstab(c) ; and counter
syscal SIOT,[ clarg. tto ; output to TTY
a ? b] ; pointer and counter
.lose %lssys ; argh
jrst rnderr ; and continue to barf
; TTY **More** interrupt
ttoser: syscal WHYINT,[clarg. tto] ; acknowledge the int
.lose %lssys ; huh???
skipge openp ; open connection (meaningful MORINH)?
skipge morinh ; **More**'s inhibited?
skipn morep ; taking **More**'s?
jrst tsret ; nope, flush the int
type [**More**]
syscal IOT,[ clctl. %tiint\%tipek; peek ahead, but wait
clarg. tti ; on TTY input channel
%clval a] ; to AC a
.lose %lssys ; huh???
cain a,<" > ; a space?
call inpchr ; yes, flush it
type [
]
jrst tsret ; and flush it
; Generate constants
variab ; variables
...lit: consta ; constants
hsttab=<.\1777>+1 ; start of HSTTAB mapped pages
end TELNET
Reference in New Issue View Git Blame Copy Permalink