perm filename SUPDUP.MID[S,NET]5 blob
sn#724721 filedate 1983-08-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00045 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00007 00002 title SUPDUP
C00010 00003 sdttop sdttop
C00012 00004 %toalt %toclc %tohdx %toovr %torol %toraw %toiml %tpplf %tppcr %tpptb %tpprn %tptel %tp11t %tomch %toim1 %tqim4 %tqp11 %tqhgt %tqwid %tqvir %tqbnk %tqxor %tqrec %tqset %tqgrf %trgin %trghc %tnprt %tndp %tnodp %tniml %tntek %tntv %tnmem %tnsfw %tntrm %tnesc %tndtm %tnmax %txasc %txctl %txmta %txsft %txsfl %txtop
C00018 00005 %gomvr %goxor %goset %gomsr %goinv %gobnk %goclr %gopsh %govir %gohrd %gogin %golmt %gomva %goior %gomsa %govis %gocls %gophy %godlr %godpr %godrr %godch %godla %godpa %godra %goelr %goepr %goerr %goech %goela %goepa %goera %tdmov %tdmv1 %tdeof %tdeol %tddlf %tdmtf %tdmtn %tdcrl %tdnop %tdbs %tdlf %tdrcr %tdors %tdqot %tdfs %tdmv0 %tdclr %tdbel %tdini %tdilp %tddlp %tdicp %tddcp %tdbow %tdrst %tdgrf %tdmax
C00023 00006 allact bsact supscm supccr dislin dmlin dddlin echarr ptylin impbit spcbrk dm128 inttty intclk intinr intins intims intinp inttti trunca noeeol noeeob usergo rfcs rfcr clss clsr siu ccs sys nla ilb idd gmm ioimpm ioderr iodter iobktl iodend ictran hdead ctrov rset tmo
C00028 00007 corbeg cnsblo`tctyp ttyopt tcmxv tcmxh ttyrol smarts ispeed ospeed cnsbll dmp dmluzp ddp iiip ptyp netp filinp runcmp clsedp imgchp ntbfop ttiinp ntiinp ntoinp ntibf ntobf dsibf dsobf lgrskt pdl ttynum ttystr svjbpc dpyblk patch intdat
C00032 00008 impcod impsta implsk impwat impbyt impfsk imphst watcod watsta watskt clscod clssta clsskt clswat
C00034 00009 nwrdln scrsiz ngw vpos hpos ovpos govpos gohpos gtvpos gthpos gtiln gtdln gtich gtdch slupdp scupdp saupdp crupdp csronp csrhkp corend iiihdr scp screen scrend scpl botlin
C00038 00010 scc sccl linprg sdisp cdisp cclear ldisp scbytp dmdisp dmpgm dmcnt dmpnt
C00041 00011 burp barf pgmbeg uuoser cpopj ddtcal ddtret echon
C00044 00012 intser intsr1 intsr0 inesci inesc2 escich maxidt uknint
C00047 00013 supdup supdp1
C00050 00014 hgtlmt hgtok sdpprt nothop sdpdpy
C00055 00015 chfhnm moncom
C00057 00016 gethst scnhst A badhst hstsss
C00062 00017 goicp
C00065 00018 makcon
C00069 00019 ttchsn grtmsg
C00071 00020 grtdun ptyluz phstrm
C00074 00021 search fndrom sndrom flsspc sndtid sntrom tidone
C00077 00022 chkiii inidpy sleepr
C00079 00023 ttiser ttisrx netsnd netoc1
C00081 00024 netoch netoc2 ntoc2a netoc3 outmap allomp
C00086 00025 ntiser
C00090 00026 dpypr1 netich inpmap allimp nulfls nulfl2
C00094 00027 dpyser dpyctb
C00097 00028 scrini scrin1 glnini scstor scsto2 clrscn dmceof
C00101 00029 clreol cleol1 clr1ch terpri
C00105 00030 bredle oreset csraos clreof cleof1
C00108 00031 inslin insl0a insln0 insl1a insln1 insln2
C00110 00032 dellin dell0a delln0 dell1a delln1
C00112 00033 inschr insc0a insch0 insc1a insch2 insch1
C00115 00034 delchr delc0a delch0 delc1a delch2 delch1
C00118 00035 scnupd csrupd scupd1 scup1a
C00122 00036 getcsy updlin
C00124 00037 dmchar dmredw dmred1 dmdrw1 dmdrw2 dmout
C00129 00038 cmdcmd cmdcm0 review
C00133 00039 imgsnd
C00136 00040 hlptxt
C00137 00041 reentr record recrd0 recrd1 recrd2
C00141 00042 refuse closed dieclr quit quit2 nosock cnetab cnemax conerr diedie
C00145 00043 nioerr iioerr hstded hstde1
C00148 00044 hstde2
C00150 00045 rndtid rndrom sndid1 getch cpopj1 ...lit sdpff
C00152 ENDMK
C⊗;
title SUPDUP
subttl Assembly options, etc.
; Mark Crispin, SU-AI, June 1977; last updated: March 1981
; This is the WAITS implementation of the ITS SUPDUP program, which is used
; for display communication across ITS systems. The protocol is described
; in RFC 734, NIC 41953, and RFC 746, NIC 43976.
; The original version of this program was written before NETWRK, DISPLY,
; and other such advanced technology existed. In fact, some of the routines
; in here were the prototypes for the NETWRK and DISPLY packages. Someday
; it should be rewritten to use this stuff.
.nstgw ; no storage words allowed
IFNDEF FTF2,[ IFDEF F2UUO,FTF2==1 ; set automatically nonzero for F2
.ELSE FTF2==0
];IFNDEF FTF2
ifndef ftip,ftip==1 ; nonzero to compile for IP/TCP
if2,.hkill icp,net,dsk ; so DDT doesn't confuse these
; with AC's on typeout
if1,[ ; First time through define all macros, symbols, etc.
; Canonical macro library
.insrt MACROS
; Assembly switches
nd. icpskt==137 ; SUPDUP ICP socket
nd. pdllen==50 ; length of pushdown stack
nd. dmbufl==200 ; words of DM buffer space
IFE FTF2,[
printx/New SYS:SUPDUP.DMP should have NLINES=40. and
new SYS:SUPDUP.BIG should have NLINES=70.
/
nd. nlines==40. ; maximum number of lines on screen
];IFE FTF2
IFN FTF2,nd. nlines==70. ; maximum number of lines on screen
nd. linel==85. ; maximum number of characters (must be
; a multiple of 5)
nd. nlnglt==1 ; number of lines to glitch when scrolling
nd. clkspd==30. ; slow clock speed
nd. nlnupd==3. ; number of lines that cause screen update
; instead of updating individual lines
nd. flsddt==0 ; non-zero to include hairy DDT flush code
;sdttop sdttop
subttl AC's, I/O channels, macros
; Accumulators
; Things depend on the order of X, Y, Z, and A being consecutive. U and T
; are used at UUO level.
acdef. [x y z a b c t u]
; I/O channels
; ICP is used for ICP'ing only, NET is the general network work channel,
; DSK is used for reading ROOMS[P,DOC] and for recording the screen.
acdef. [icp net dsk]
; Macros
; Map character in ac to char2 if it contains char1 now
define mapit ac,char1,char2
caxn ac,char1
jrst [movx ac,char2
return]
termin
; Generate a Data Disc command
define ddcmd o1,d1,o2,d2,o3,d3
.byte 8.,8.,8.,3.,3.,3.,3.
d1 ? d2 ? d3 ? o1 ? o2 ? o3 ? 4
.byte
termin
; Send a DM command character
define dmcmd ch
move x,dmcnt
caxge x,10
call dmout
movx x,177
call dmchar
movx x,ch
call dmchar
termin
; Specify this TTYOPT bit is used
sdttop==0 ; for initial value
define use def/
def
irps bit,,[def]
sdttop==sdttop\bit
.istop
termin
termin
;%toalt %toclc %tohdx %toovr %torol %toraw %toiml %tpplf %tppcr %tpptb %tpprn %tptel %tp11t %tomch %toim1 %tqim4 %tqp11 %tqhgt %tqwid %tqvir %tqbnk %tqxor %tqrec %tqset %tqgrf %trgin %trghc %tnprt %tndp %tnodp %tniml %tntek %tntv %tnmem %tnsfw %tntrm %tnesc %tndtm %tnmax %txasc %txctl %txmta %txsft %txsfl %txtop
subttl ITS TTY definitions
; These definitions are the various bits, words, etc. for the ITS terminal
; service system calls and are here for convenience and clarity. This is
; abridged from [MIT-AI] SYSTEM;BITS >, the monitor bits definition file.
; TTYOPT variable (terminal capabilities)
%toalt==200000,, ; 1 → standardise altmodes
%toclc==100000,, ; 1 → convert cases on input
use %toers==040000,, ; 1 → this terminal can erase
%tohdx==020000,, ; 1 → half duplex
use %tomvb==010000,, ; 1 → can backspace
use %tosai==004000,, ; 1 → has SAIL graphics
use %tosa1==002000,, ; 1 → init %TSSAI in new jobs (use graphics)
%toovr==001000,, ; 1 → can overprint
use %tomvu==000400,, ; 1 → can line starve (ie a display)
use %tomor==000200,, ; 1 → do **More** processing (init %TSMOR)
%torol==000100,, ; 1 → scroll (init %TSROL for new jobs)
%toraw==000040,, ; 1 → no cursor motion optimization
use %tolwr==000020,, ; 1 → lower case keyboard
use %tofci==000010,, ; 1 → has bucky bit keyboard
%toiml==000004,, ; 1 → acts like a grIMLAC (funny ↑PF, ↑PB)
use %tolid==000002,, ; 1 → can insert/delete lines
use %tocid==000001,, ; 1 → can insert/delete characters
%tpplf==700000 ; LF padding
%tppcr==070000 ; CR padding
%tpptb==007000 ; TAB padding (0 → no tabs, 1 → tabs)
%tpprn==000200 ; 1 → swap () with [] on input
%tptel==000100 ; 1 → CR → CRLF for ARPAnet protocol
use %tpcbs==000040 ; 1 → intelligent terminal protocol (↑\)
%tp11t==000020 ; 1 → PDP-11 TV (reflects %TY11T)
use %tpors==000010 ; 1 → output reset should do something
; SMARTS variable (terminal smarts)
%tomch==700000,, ; machine type
%toim1==300000,, ; PDS1
%tqim4==200000,, ; PDS4
%tqp11==100000,, ; PDP-11
%tqhgt==076000,, ; character height in dots
%tqwid==001700,, ; character width in dots
%tqvir==000040,, ; virtual coordinates
%tqbnk==000020,, ; blinking
%tqxor==000010,, ; XOR mode
%tqrec==000004,, ; rectangle command
%tqset==000002,, ; multiple sets
%tqgrf==000001,, ; understands graphics
%trgin==400000 ; graphics input
%trghc==200000 ; hardcopy device
; TCTYP variable (terminal type)
%tnprt==0 ; printing console, glass TTY, etc.
%tndp==1 ; good Datapoint
%tnodp==2 ; inferior losing Datapoint
%tniml==3 ; grIMLAC
%tntek==4 ; Tektronix 4000 series
%tntv==5 ; PDP-11 TV
%tnmem==6 ; Memowreck
%tnsfw==7 ; Software
%tntrm==10 ; Terminet
%tnesc==11 ; ASCII standard display (VT52, etc.)
%tndtm==12 ; Datamedia 2500
%tnmax==13 ; 1 + largest terminal type
; Components of an input character in 12-bit mode.
%txasc==0177 ; ASCII part
%txctl==0200 ; control
%txmta==0400 ; meta
%txsft==1000 ; shift
%txsfl==2000 ; shift lock
%txtop==4000 ; top
;%gomvr %goxor %goset %gomsr %goinv %gobnk %goclr %gopsh %govir %gohrd %gogin %golmt %gomva %goior %gomsa %govis %gocls %gophy %godlr %godpr %godrr %godch %godla %godpa %godra %goelr %goepr %goerr %goech %goela %goepa %goera %tdmov %tdmv1 %tdeof %tdeol %tddlf %tdmtf %tdmtn %tdcrl %tdnop %tdbs %tdlf %tdrcr %tdors %tdqot %tdfs %tdmv0 %tdclr %tdbel %tdini %tdilp %tddlp %tdicp %tddcp %tdbow %tdrst %tdgrf %tdmax
; Graphics output buffer codes
%gomvr==001 ; move cursor to P
%goxor==002 ; turn on XOR mode
%goset==003 ; select set N
%gomsr==004 ; move set origin to P
%goinv==006 ; make current set invisible
%gobnk==007 ; make current set blink
%goclr==010 ; erase whole screen
%gopsh==011 ; push status information
%govir==012 ; use virtual coordinates
%gohrd==013 ; divert output to N
%gogin==014 ; request input, reply code N
%golmt==015 ; limit to subrectangle P1 P2
%gomva==021 ; move cursor to P, abs addr
%goior==022 ; turn off XOR mode
%gomsa==024 ; move set origin to P, abs addr
%govis==026 ; make current set visible
%gocls==030 ; erase current set
%gophy==032 ; use unit coordinates
%godlr==101 ; draw line relative, to P
%godpr==102 ; draw point relative, at P
%godrr==103 ; draw rectangle relative, at P
%godch==104 ; display STRING
%godla==121 ; draw line absolute, to P
%godpa==122 ; draw point absolute, at P
%godra==123 ; draw rectangle absolute, at P
%goelr==141 ; erase line relative, to P
%goepr==142 ; erase point relative, at P
%goerr==143 ; erase rectangle relative, at P
%goech==144 ; erase STRING
%goela==161 ; erase line absolute, to P
%goepa==162 ; erase point absolute, at P
%goera==163 ; erase rectangle absolute, at P
; Non-graphics output buffer codes
%tdmov==200 ; move cursor OV OH NV NH
%tdmv1==201 ; move cursor; NV NH
%tdeof==202 ; clear to end of screen
%tdeol==203 ; clear to end of line
%tddlf==204 ; delete character after cursor
%tdmtf==205 ; motor off
%tdmtn==206 ; motor on
%tdcrl==207 ; terpri
%tdnop==210 ; no-op
%tdbs==211 ; backspace
%tdlf==212 ; line feed
%tdrcr==213 ; carriage return
%tdors==214 ; output reset
%tdqot==215 ; quote next character (mystery command)
%tdfs==216 ; cursor forward
%tdmv0==217 ; move cursor NV NH
%tdclr==220 ; clear screen
%tdbel==221 ; feep!
%tdini==222 ; reset reset reset
%tdilp==223 ; insert line; count
%tddlp==224 ; delete line; count
%tdicp==225 ; insert character; count
%tddcp==226 ; delete character; count
%tdbow==227 ; inverse video
%tdrst==230 ; reset inverse video, etc.
%tdgrf==231 ; graphics mode
%tdmax==232 ; 1 + largest display code
;allact bsact supscm supccr dislin dmlin dddlin echarr ptylin impbit spcbrk dm128 inttty intclk intinr intins intims intinp inttti trunca noeeol noeeob usergo rfcs rfcr clss clsr siu ccs sys nla ilb idd gmm ioimpm ioderr iodter iobktl iodend ictran hdead ctrov rset tmo
subttl SAIL system definitions
; First define all the UUO's. MIDAS has these predefined, but DDT is cretinous.
.insrt SAIDFS[CSP,SYS]
.decdf
; This page contains the SAIL system bits that are used within SUPDUP. It is
; not a complete list of the SAIL system bits.
; SETACT bits
allact==000040 ; all αβ characters and BS activate
bsact== 000020 ; all forms of BS activate
supscm==000004 ; all αβ characters activate
supccr==000002 ; αCR is an ordinary character
; GETLIN/SETLIN bits
dislin==400000,, ; terminal is a III
dmlin== 040000,, ; terminal is a DM
dddlin==020000,, ; terminal is a DD
echarr==010000,, ; terminal echoes arrow for controls
ptylin==004000,, ; terminal is a PTY
impbit==001000,, ; terminal is controlled by a network job
spcbrk==000100,, ; terminal is in special activation mode
dm128== 000002 ; FCS datamedia (DPYDES flag)
; Interrupt condition bits
inttty==020000,, ; TTY input activation
intclk==000200,, ; clock interrupt
intinr==000100,, ; IMP INR
intins==000040,, ; IMP INS
intims==000020,, ; IMP status change
intinp==000010,, ; IMP input waiting
inttti==000004,, ; [ESCAPE]I
; DM UPGIOT flags
trunca==040000,, ; truncate output lines to 80. characters
noeeol==020000,, ; suppress CEOL when moving to a line
noeeob==010000,, ; suppress CEOL on blank line
usergo==002000,, ; suppress other DM output
; Network socket status flags
rfcs== 200000,, ; RFC sent
rfcr== 100000,, ; RFC received
clss== 040000,, ; CLS sent
clsr== 020000,, ; CLS received
; Network status word error codes
siu== 01 ; socket in use
ccs== 02 ; can't change socket numbers
sys== 03 ; horrible system error
nla== 04 ; no links available
ilb== 05 ; illegal byte size
idd== 06 ; IMP dead
gmm== 07 ; gender mismatch (Anita Bryant feature)
; I/O status word error bits
ioimpm==400000 ; improper mode
ioderr==200000 ; hard device error (data missed, etc.)
iodter==100000 ; soft device error (parity error, etc.)
iobktl==040000 ; block number out of bounds
iodend==020000 ; end of file
IFE FTIP,[
ictran==004000 ; incomplete transmission
hdead== 002000 ; host or destination IMP dead
ctrov== 001000 ; host sent more bits than allocated
rset== 000400 ; host sent a RST
tmo== 000200 ; time out
];IFE FTIP
IFN FTIP,[
;these bits do not exist in FTIP WAITS.
ictran==0 ; incomplete transmission
hdead== 0 ; host or destination IMP dead
ctrov== 0 ; host sent more bits than allocated
rset== 0 ; host sent a RST
tmo== 0 ; time out
];IFN FTIP
];if1
;corbeg cnsblk tctyp ttyopt tcmxv tcmxh ttyrol smarts ispeed ospeed cnsbll dmp dmluzp ddp iiip ptyp netp filinp runcmp clsedp imgchp ntbfop ttiinp ntiinp ntoinp ntibf ntobf dsibf dsobf lgrskt pdl ttynum ttystr svjbpc dpyblk patch intdat
subttl Data area
.ystgw ; storage words okay now
; Beginning of core area initialized to zero at startup
corbeg==. ; beginning of data area
cnsblk: block 1 ; CNSGET info (AOBJN pntr)
tctyp: block 1 ; TCTYP for server
ttyopt: block 1 ; TTYOPT for server
tcmxv: block 1 ; TTY page length
tcmxh: block 1 ; TTY width
ttyrol: block 1 ; TTYROL variable
smarts: block 1 ; SMARTS variable
ispeed: block 1 ; input speed
ospeed: block 1 ; output speed
cnsbll==.-cnsblk
; Random flags
dmp: block 1 ; -1 → this is a Datamedia
dmluzp: block 1 ; -1 → this is a non-FCS (losing) Datamedia
ddp: block 1 ; -1 → this is a Data Disc
iiip: block 1 ; -1 → this is a III
ptyp: block 1 ; -1 → this is a PTY
netp: block 1 ; -1 → this is a network PTY
filinp: block 1 ; -1 → fill in host name
runcmp: block 1 ; -1 → called via RUN command
clsedp: block 1 ; -1 → connection closed by foreign host
imgchp: block 1 ; -1 → image characters from command
ntbfop: block 1 ; -1 → output to net in buffer
; Interrupt level flags
ttiinp: block 1 ; -1 → TTY input pending
ntiinp: block 1 ; -1 → net input pending
ntoinp: block 1 ; <0 → INS pending
; Buffer headers
ntibf: block 3 ; net input buffer header
ntobf: block 3 ; net output buffer header
dsibf: block 3 ; disk input buffer header
dsobf: block 3 ; disk output buffer header
; Other random storage
lgrskt: block 1 ; socket from logger
pdl: block pdllen ; pushdown stack
ttynum: block 1 ; our TTY number
ttystr: block 11. ; TTY string
svjbpc: block 1 ; save of JOBTPC
dpyblk: block 14 ; for display type info from TTYSET
patch: block 40 ; for debugging
intdat: block 1 ; interrupt datum, arg from ESC n I
;impcod impsta implsk impwat impbyt impfsk imphst watcod watsta watskt clscod clssta clsskt clswat
; IMP MTAPE command words
; Connect to host command block
impcod: block 1 ; command
impsta: block 1 ; status
implsk: block 1 ; local socket
impwat: block 1 ; ≠ 0 → wait for connection
impbyt: block 1 ; byte size
impfsk: block 1 ; foreign socket
imphst: block 1 ; foreign host number
; Wait for connection to be completed command block
watcod: block 1 ; command
watsta: block 1 ; status
watskt: block 1 ; socket
; Close connection to host command block
clscod: block 1 ; close code
clssta: block 1 ; close status
clsskt: block 1 ; close socket
clswat: block 1 ; ≠ 0 → wait for close
;nwrdln scrsiz ngw vpos hpos ovpos govpos gohpos gtvpos gthpos gtiln gtdln gtich gtdch slupdp scupdp saupdp crupdp csronp csrhkp corend iiihdr scp screen scrend scpl botlin
subttl Display crufties
; Number of words in display frobs
nwrdln==4+linel/5 ; number of words on a line
scrsiz==nlines*nwrdln ; number of words on screen
ngw==<<linel*3>+17.>/16. ; number of graphics words
; Cursor position pointers
vpos: block 1 ; vertical position
hpos: block 1 ; horizontal position
ovpos: block 1 ; old vertical position
; Positioning flags
govpos: block 1 ; -1 → get old vertical position
gohpos: block 1 ; -1 → get old horizontal position
gtvpos: block 1 ; -1 → get vertical position
gthpos: block 1 ; -1 → get horizontal position
; Insert/delete mode flags
gtiln: block 1 ; -1 → get # of lines to insert
gtdln: block 1 ; -1 → get # of lines to delete
gtich: block 1 ; -1 → get # of characters to insert
gtdch: block 1 ; -1 → get # of characters to delete
; Screen updating flags
slupdp: block nlines ; -1 → this line has changed
scupdp: block 1 ; -1 → some update happened someplace
saupdp: block 1 ; -1 → updated whole screen
crupdp: block 1 ; -1 → updated cursor
csronp: block 1 ; -1 → display cursor
csrhkp: block 1 ; -1 → do blinking cursor hack
corend==.-1 ; address of top of core
; End of core zeroed upon startup
ifn flsddt,debugp: block 1 ; -1 → debugging
; Various display programs
; III header word
iiihdr:
.byte 11.,11.,3.,3.,2.,2.,4.
-777 ? 640 ? 4 ? 2 ? 1 ? 2 ? 6 ; invisible absolute vector
.byte
; Display screen display program
scp: ddcmd 1,46,4,1,5,10 ; line address 30
ddcmd 3,2,3,2,3,2 ; go to column 2
screen: block scrsiz ; TV screen storage
scrend=.-1 ; end of screen storage
0 ; end of DD program
scpl==.-scp
botlin=screen+scrsiz-nwrdln+2-1 ; address of start of bottom line
;scc sccl linprg sdisp cdisp cclear ldisp scbytp dmdisp dmpgm dmcnt dmpnt
; More display data stuff
; Display cursor display program
scc: ddcmd 1,7,1,7,1,7 ; graphics
ddcmd 3,1,4,0,5,0 ; select position
block ngw ; all graphics columns
ddcmd 0,0,1,46,1,46 ; execute
0 ; end of program
sccl==.-scc
; Line display programs
linprg: ddcmd 1,46,4,0,5,0 ; line update commands
ddcmd 3,2,3,2,3,2
block nwrdln-3
0
; Display commands
; Display screen
sdisp: 600000,,scp ; two field mode
scpl ; size of display program
0 ; transfer in progress flag
scp ; address of low order line command
; Cursor display
cdisp: 400000,,scc ; address of cursor hacker
sccl ; size of the hacker
0 ; transfer in progress flag
scc+1 ; address of low order line command
cclear: scc ; address of cursor hacker
sccl ; size of the hacker
0 ; no transfer in progress flag
scc+1 ; address of low order line command
; Line display
ldisp: 600000,,linprg ; two field mode
nwrdln ; size of this command
0 ? linprg ; t-i-p flag, low order line command
; Byte pointer table for insertions
scbytp: 350700,,(y)
260700,,(y)
170700,,(y)
100700,,(y)
010700,,(y)
; DM display programs and stuff
dmdisp: trunca\noeeol\noeeob\usergo+dmpgm ; flags, etc.
0 ? 0 ; # words, t-i-p flag
dmpgm: block dmbufl ; DM display program
dmcnt: 0 ; DM program counter
dmpnt: 0 ; DM program counter
;burp barf pgmbeg uuoser cpopj ddtcal ddtret echon
subttl UUO server
; UUO server. Only allows BURP UUO (op code 037).
; BURP [OP=037]
; --------------------------------------------------
; BURP ADR
;
; ADR: <asciz string>
;
; The BURP UUO types out the ASCIZ string that starts at location ADR.
; message. If the DEBUGP runtime switch is set, BURP bops into DDT if
; DDT is present; CPOPJ[ALT]G from DDT attempts to return. BURP should
; not be called from interrupt level.
; A non-zero AC field means the error is fatal.
burp=037000,, ; UUO for logging cruft
barf=burp 1, ; UUO for fatalities
pgmbeg==. ; start of pure core
tmploc job41,call uuoser ; UUO server
uuoser: save t ? save u ; save the old UUO AC's
save jobuuo ; and the UUO itself
ldb u,[.bp %icopc,jobuuo] ; get op code
caxe u,burp←-27. ; was it a BURP UUO?
barf [asciz/Illegal UUO!
/] ; isn't recursion wonderful?
ldb u,[.bp %icacf,jobuuo] ; get AC field
outstr @(p) ; type the message
ifn flsddt,[
skipn u ; fatal error?
skipe debugp ; debugging?
call ddtcal ; yes, call DDT
];ifn flsddt
ife flsddt,[
skipe u
call ddtcal
];ife flsddt
adjsp p,-3 ; drop stack
cpopj: return ; return to user
; Call DDT
ddtcal: call echon ; turn echoing back on
skipn u,jobddt ; get start addr of DDT
jrst [ exit 1, ; no DDT!!!
jrst ddtret] ; continue...
outstr [asciz/You're in DDT.
/]
call (u) ; call DDT
ddtret: ptjobx [0 ? sixbit/DOFF/] ; turn echoing off
ppact ; flush PP
store %fword,saupdp ; must fix whole screen
leypos 2000 ; throw away line editor
return ; and return
; Turn echoing back on (this so it can be called from bkpt)
echon: ptjobx [0 ? sixbit/DON/] ; turn echoing on
hrroi t,[004000,,400\"N] ; [BREAK]N
ttyset t,
return ; return to caller
;intser intsr1 intsr0 inesci inesc2 escich maxidt uknint
subttl Interrupt server
intser: movem 10,intdat ; save interrupt datum, in case is ESC I
skipn x,jobcni ; get reason for interrupt
jrst 4,.-1 ; no interrupt set?
txzn x,intclk ; clock int?
jrst intsr0
skipn csrhkp ; hacking the cursor?
jrst intsr1
setcmm csronp ; complement cursor on flag
setom crupdp ; flag cursor hacked
intsr1: txoa x,intinp ; yes, fake TTI and NTI int
intsr0: txze x,inttty ; TTY int?
store %fword,ttiinp
txze x,intinp ; network interrupt?
store %fword,ntiinp
txze x,intins ; IMP INS?
sos ntoinp
txze x,inttti ; [ESCAPE]I?
jrst inesci
txze x,intims ; IMP status change?
store %fword,clsedp
jumpn x,uknint ; known interrupt?
dismis ; yes, dismiss the interrupt
;ESC n I interrupt (n optional)
inesci: imskcl [%fword] ; mask ints off
move jobtpc ; stupid UWAIT
movem svjbpc ; bop back
uwait ; get AC's back, finish UUO in prog.
insirp save,svjbpc x y z
debreak ; leave interrupt level
skiple x,intdat ; explicit arg to ESC I?
caile x,maxidt ; yes, in range?
jrst inesc2 ; no, read cmd char
skipa x,escich-1(x) ; get implied cmd char
inesc2: inchrw x ; read explicit cmd char from user
call cmdcm0 ; do command
insirp retr,z y x
imskst [%fword] ; mask ints back on
return ; finally flush interrupt
;table to map the numeric argument in ESC n I to simulated cmd char in ESC I <char>
escich: "α ; ESC 1 I means ESCAPE (ESC I α)
"β ; ESC 2 I means BREAK (ESC I β)
"ε ; ESC 3 I means CLEAR (ESC I ε)
maxidt==.-escich
; Interrupt-level errors
uknint: outstr [asciz/Unknown interrupt!
/]
uwait ; finish UUO, restore AC's
save jobtpc ; save PC of interrupt
debreak ; enter user mode
jrst ddtcal ; now enter DDT
;supdup supdp1
subttl Startup, etc.
; Initialize the world; clear all I/O and other things; give
; back any unneeded core to the monitor; clear data area, and
; set up the stack pointer.
supdup: cai ; flush CCL crufties
reset ; reset all I/O
ifn flsddt,[
skipe debugp ; debugging?
outstr [asciz/Debugging version!
/]
];ifn flsddt
movei intser ; get addr of interrupt server
movem jobapr ; tell monitor
hlrz jobsa ; get size I should be
ifn flsddt,[
skipn debugp ; debugging?
movei sdpff ; no, then okay to flush DDT
];ifn flsddt
hrlm jobsa ; but make sure monitor knows now
movem jobff ; make sure monitor knows
core ; in case I grew
barf [asciz/CORE failed!
/] ; goddam ungrateful monitor!
ifn flsddt,[
skipe debugp ; debugging?
jrst supdp1 ; yes, can't flush DDT
hrrz jobddt ; get addr of DDT
caige sdpff ; it is below pgm?
jrst supdp1 ; yes, didn't flush DDT
movx x,%zeros ; no, flushed DDT, flush DDT's start addr
setddt x, ; tell monitor (sigh)
supdp1:
];ifn flsddt
store %zeros,corbeg,corend ; clear data area
setzb @jobff ; clear first word of garbage
adjsp @jobff ; make zapping pointer
aos ; point to next word
blt @jobrel ; now flush this trash
move p,[pdl(-pdllen)] ; load PDP
store %fword,csrhkp ; flag do cursor hacking
; (continued on next page)
;hgtlmt hgtok sdpprt nothop sdpdpy
; Initial terminal setup
; Set up terminal codes for ITS and the sort of display we are
store <<1-cnsbll>,,>,cnsblk ; Moon's new protocol
store %tnsfw,tctyp ; software TTY
store sdttop,ttyopt ; what we can support
store nlnglt,ttyrol ; scroll count
move [-2,,[6000,,tcmxh ? 15000,,tcmxv]]
ttyset ; get screen size information
sos tcmxv ? sos x,tcmxv ; don't garble who-line
caxg x,nlines ; too many lines for program?
jrst hgtok ; nope, is OK
movx 0,nlines
caxle 0,40. ; does this core image handle big screens?
jrst hgtlmt ; yes, do our best, max screen hgt
move x,[[sixbit /SYS/ ? sixbit/SUPDUP/ ? sixbit/BIG/ ? 0 ? 0]]
swap x, ; try to use different program dmp file
hgtlmt: movx x,nlines ; use max
movem x,tcmxv ; store away proper size
hgtok: move x,tcmxh ; get line width
caxg x,linel ; greater than program max?
sosa x ; no, just allow for line overflow
movx x,linel-1 ; make it program max w/ line overflow
movem x,tcmxh ; now stash it away
; Check terminal characteristics
hrroi [3000,,x] ; real line chars
ttyset ; get my line characteristics
caxn x,%fword ; detached?
exit ; yes, die die die
hrrzm x,ttynum ; save console number
txne x,ptylin ; a PTY?
store %fword,ptyp ; what a pity (I like puns)
txne x,dislin ; III?
store %fword,iiip ; yes
txne x,dddlin ; Data Disc?
store %fword,ddp ; yes
txne x,dislin\dddlin ; is this a local display?
jrst sdpdpy ; yup, it's a display
txnn x,dmlin ; Datamedia?
sdpprt: jrst [ movei ['SYS,, ? 'TELNET ? 0 ? 0 ? 0 ? 0]
run ; printing console, use TELNET instead
jrst 4,.-1] ; RUN failed?
txnn x,impbit ; IMP PTY?
jrst nothop ; nope
store %fword,netp ; net hopper!
outstr [asciz/Foo you are a net hopper.
/]
nothop: store %fword,dmp ; yes
movx y,1200. ; set speed to 1200 baud
insirp movem y,ispeed ospeed
hrroi [63000,,dpyblk] ; get display type info
ttyset ; (right half of DMFLAG in DPY header)
move y,dpyblk+7 ; get DPYDES flags
txnn y,dm128 ; is this a fcs Datamedia?
sosa dmluzp ; nope, loser
jrst sdpdpy ; now continue
movx y,%tosai\%tosa1 ; FCS bits
andcam y,ttyopt ; tell ITS we don't have SAIL graphics
; Set terminal activate on all characters
sdpdpy: txo x,spcbrk ; special activation mode bit
setlin x ; enter SAM
setact [[777777,,777777 ; activate on 000 - 043
777777,,777777 ; 044 - 107
777777,,777777 ; 110 - 153
777777,,600000\allact\bsact\supscm\supccr]]; 154 - 177, αβ act
ptjobx [0 ? sixbit/DOFF/] ; turn echoing off
; jrst chfhnm ; now check for host name
;chfhnm moncom
subttl Monitor command processor
; Check for host name in the monitor command line. Yes, I realize this
; code is totally gross!!!
chfhnm: rescan x ; get monitor command cruft back
jumpe x,gethst ; no cruft, ask for it
moncom: inchrs x ; got a command, gobble a character
jrst gethst ; lost, do it manually
caxl x,"a ; lower case?
caxle x,"z ; . . .
caxa ; no
subx x,"a-"A ; yes, uppercaseify
skipn runcmp ; already checked for RUN command?
jrst [ caxe x,"R ; is it a RUN command?
aosa runcmp ; nope
store %fword,runcmp ; yes, no spaces checked!
jrst .+1] ; now return
skipl runcmp ; called via RUN command?
caxe x,<" > ; space frob? (only if not RUN)
caxn x,<";> ; or comment?
caxa ; yup, hack it
jrst moncom ; haven't gotten there yet, try again
move b,[jsp y,[ inchrs x ; yes, load subroutine
jrst badhst ; lost
caxl x,"a ; lower case?
caxle x,"z ; . . .
caxa ; no
subx x,"a-"A ; yes
caxn x,<" > ; found space?
jrst -1(y) ; yes, flush it
jrst (y)]] ; end of subroutine
jrst scnhst ; and scan for this host
;gethst scnhst A badhst hstsss
subttl Get host name
;IP host numbers - JJW 8/83. This program should read in the host table using
;NETWRK subroutines, but then it should really be rewritten completely.
define iphost(a,b,c,d)
<<a←24.>+<b←16.>+<c←8.>+d>
termin
gethst: outstr [asciz/Host = /]
move b,[jsp y,[ inchrw x ; subroutine for non-monitor command
caxl x,"a ; lower case?
caxle x,"z ; . . .
caxa ; no
subx x,"a-"A ; yes, uppercaseify
outchr x ; echo the whatever
jrst (y)]] ; end of non-monitor subroutine
store %fword,filinp ; remember to fill in host name
scnhst: xct b ; get a character
caxn x,"? ; ? for help
jrst [ outstr [asciz/
Command escape is [ESCAPE] I; [ESCAPE] I ? lists options.
Type the host to talk to:
A=AI Lab, D=Dynamod, MC=MACSYMA Consortium, ML=Mathlab, SA=SAIL, S1=S1-A, X=XX
/]
clrbfi
jrst gethst]
caxn x,"A ; AI Lab?
jrst [ skipe filinp ; fill in host name?
outstr [asciz/I
/]
movx a,sixbit/SD AI/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,2.,0.,6.)] ; MIT-AI
jrst goicp] ; now ICP
caxn x,"D ; Dynamod?
jrst [ skipe filinp ; fill in host name?
outstr [asciz/M
/]
movx a,sixbit/SD DM/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,1.,0.,6.)] ; MIT-DMS
jrst goicp] ; now ICP
caxn x,"S ; SAIL or S1?
jrst hstsss ; yes
caxn x,"X ; XX?
jrst [ skipe filinp ; fill in host name?
outstr [asciz/X
/]
movx a,sixbit/SD XX/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,0.,0.,44.)] ; MIT-XX
jrst goicp] ; now ICP
caxe x,"M ; MathLab LCS place?
badhst: jrst [ outstr [asciz/?
/]
clrbfi ; flush input buffer
jrst gethst]
xct b ; get another character
caxl x,"a ; lower case?
caxle x,"z ; . . .
caxa ; no
subx x,"a-"A ; uppercaseify
caxn x,"C ; MACSYMA consortium?
jrst [ movx a,sixbit/SD MC/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,3.,0.,44.)] ; MIT-MC
skipe filinp ; filling in?
outstr [asciz/
/]
jrst goicp] ; now ICP
caxe x,"L ; Autoprog?
jrst badhst ; nope, losey
movx a,sixbit/SD ML/ ; select host name
setnam a, ; tell monitor
move a,[iphost(10.,3.,0.,6.)] ; MIT-ML
skipe filinp ; filling in?
outstr [asciz/
/]
jrst goicp ; now ICP
;here if first char in host name is S. Is it SAIL or S1?
hstsss: xct b ; get another character
caxl x,"a ; lower case?
caxle x,"z ; . . .
caxa ; no
subx x,"a-"A ; uppercaseify
caxe x,"U ; SU-AI?
caxn x,"A ; or SAIL?
jrst [movx a,sixbit/SD SU/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,0.,0.,11.)] ; SU-AI
jrst goicp] ; now ICP
caxe x,"1 ; S1?
jrst badhst ; no, bad name
movx a,sixbit/SD S1/ ; select host name
setnam a, ; and tell monitor
move a,[iphost(10.,1.,0.,95.)] ; S1-A
; jrst goicp ; now ICP
;goicp
subttl ICP ICP ICP
goicp: clrbfi ; clear any crlf, etc.
outstr [asciz/ Trying... /]
; Open channels and set timeouts
IFE FTIP,[
init icp,17 ; open ICP in dump mode
'IMP,, ; ARPAnet
0 ; no buffers
barf [asciz/Can't OPEN the IMP!
/]
mtape icp,[ 17 ; set timeouts
.byte 6 ? 1 ? 0 ? 0 ? 15.? 5 ? 0]
];IFE FTIP
init net,0 ; open NET in ASCII mode
'IMP,, ; ARPAnet
ntobf,,ntibf ; buffers
barf [asciz/Can't OPEN the IMP!
/]
mtape net,[ 17 ; set timeouts
.byte 6 ? 1 ? 15. ? 0 ? 5 ? 0 ? 0]
; Now try to get to the foreign place's server
insirp setzm,impcod impsta impbyt
insirp setom,implsk impwat
movem x,clsskt ; socket to close when done
movem a,imphst ; host to go to
hrroi a,[030000,,1] ; set the no-pk bit to hide input buffer
ttyset a,
store icpskt,impfsk ; socket to ICP on
IFE FTIP,[
mtape icp,impcod ; connect → foreign logger
move x,impsta ; get status
txne x,77 ; error code?
jrst conerr ; yes, report MTAPE lossage
getsts icp,y ; get error stats for message
txne y,ioimpm\ioderr\iodter\iobktl\iodend\hdead\ctrov\rset\tmo
jrst iioerr ; so sorry
txc x,rfcs\rfcr ; for next instruction to win
txne x,rfcs\rfcr ; RFC sent+received?
jrst [ txne x,clss\clsr ; close sent?
jrst refuse ; yes, refused
movx y,tmo ; no, fake time out
jrst iioerr] ; and output error message
hrroi y,impfsk-1 ; get ready to get a word
movx z,%zeros ; stop after
; Get socket number from logger
makcon: in icp,y ; get socket from logger
caxa ; won
jrst nosock ; didn't get socket number!
ldb x,[044000,,impfsk] ; get socket we got
movem x,impfsk ; and save it back
store 3,clscod ; close code
mtape icp,clscod ; close off ICP socket
releas icp, ; free up channel
];IFE FTIP
; (continued on next page)
;makcon
;(falls thru)
; Got socket number from logger; now connect output
IFE FTIP,[
movx x,3 ; ICP/transmit offset
addb x,implsk ; local transmit socket
movem x,watskt ; save wait socket
store %zeros,impwat ; don't wait
];IFE FTIP
store 8.,impbyt ; byte size
mtape net,impcod ; connect → server output
move x,impsta ; get status
txne x,77 ; only error code
jrst conerr ; error?
IFE FTIP,[
; Now connect input
sos implsk ; local receive socket
aos impfsk ; foreign transmit socket
mtape net,impcod ; connect ← server input
move x,impsta ; get status
txne x,77 ; only error code
jrst conerr ; lose lose lose
; Connections started, now wait for output
store 4,watcod ; WAIT code
mtape net,watcod ; wait for output
move x,watsta ; get status
txne x,77 ; only error code
jrst conerr ; lose lose lose
getsts net,y ; get error bits for message
txne y,ioimpm\ioderr\iodter\iobktl\iodend\hdead\ctrov\rset\tmo
jrst iioerr ; too bad
txc x,rfcs\rfcr ; for next instruction to win
txne x,rfcs\rfcr ; RFC sent+received?
jrst [ txne x,clss\clsr ; close sent?
jrst refuse ; yes, refused
movx y,tmo ; no, fake a time out
jrst iioerr] ; and report it
; Output connected, now wait for input
sos watskt ; now select receive socket
mtape net,watcod ; wait for input
move x,watsta ; get status
txne x,77 ; only error code
jrst conerr ; error?
];IFE FTIP
getsts net,y ; get error bits for message
txne y,ioimpm\ioderr\iodter\iobktl\iodend\hdead\ctrov\rset\tmo
jrst iioerr ; too bad
txc x,rfcs\rfcr ; for next instruction to win
txne x,rfcs\rfcr ; RFC sent+received?
jrst [ txne x,clss\clsr ; close sent?
jrst refuse ; yes, refused
movx y,tmo ; no, fake a time out
jrst iioerr] ; and continue
outstr [asciz/Open
/]
; (continued on next page)
;ttchsn grtmsg
subttl Final pre-display initialization
; Random other pre-execution initialization crufties
movx x,8. ; 8 bit bytes you know
dpb x,[300600,,ntibf+1] ; hack input buffer
dpb x,[300600,,ntobf+1] ; and output buffer
movx x,inttty\intclk\intinr\intins\intims\intinp\inttti
clkint clkspd ; set clock ticking
intenb x, ; enable interrupt conditions
mtape net,[15 ? 1] ; maximum allocation
; Send terminal characteristics
move z,[440600,,cnsblk] ; load sixbit pointer to TTY chars
movx y,6*cnsbll ; load number of bytes to do
ttchsn: ildb x,z ; get a character
call netoc1 ; output it
sojg y,ttchsn ; loop until done
call netsnd ; now force it out
; Now get server's greeting message
grtmsg: call netich ; get a character from the network
caxn x,%tdnop ; hit the no-op yet?
jrst grtdun ; yes, greeting message done
outchr x ; output it
jrst grtmsg ; and loop for next
;grtdun ptyluz phstrm
subttl Slurp up and send terminal ID
; Tell SUPDUP server to expect terminal name
grtdun: movx x,300 ; escape to SUPSER
call netoc1 ; send it
movx x,302 ; set TTY id
call netoc1 ; send it
skipn ptyp ; is it a PTY?
jrst phstrm ; no, physical terminal
movsi 377777 ; half a moby
setpr2 ; map in the monitor
barf [asciz/SETPR2 failed!
/]
move x,ttynum ; get our TTY number
add x,400270 ; pointer into PTYJOB table
hrrz x,400000-161(x) ; get number of job's controller
movx y,%lhalf\137 ; where string pointer is
movx z,y ; where to put result
movx 0,x ; pointer to block
jobrd ; get address of string in PTY controller
jrst ptyluz ; JOBRD failed??? here?
jumpe y,ptyluz ; if zero string pointer
txne y,%lhalf ; or with a left half
jrst ptyluz ; then not using 137 protocol
hrli y,-11. ; read 11 words
movei z,ttystr ; into terminal string
jobrd ; read
jrst ptyluz ; lose again
move x,ttystr ; get first word of block
caxe x,'TERMID ; is it SIXBIT/TERMID/?
jrst ptyluz ; not using 137 protocol
move y,[440700,,ttystr+1] ; is, use this string
jrst sndid1 ; and send it along
ptyluz: move y,[440700,,[asciz/PTY Datamedia/]]
skipe netp ; is it a network user?
move y,[440700,,[asciz/ARPAnet Datamedia/]]
jrst sndid1 ; and send it
; Now try to get the file
phstrm: open dsk,[0 ? 'DSK,, ? dsibf] ; try to get a DDB
barf [asciz/Can't OPEN the DSK!
/]
movx x,sixbit/ROOMS/ ; file name
setzb y,z ; extension, date cruft
movx a,sixbit/ PDOC/ ; PPN
lookup dsk,x ; try to find file
jrst [ burp [asciz/ROOMS[P,DOC] is gone!
/]
jrst rndtid] ; lose
; Compute name we must look for
hrroi y,[17000,,y] ; my responsible TTY
ttyset y, ; get my TTY #
jumpe y,fndrom ; found it now if TTY 0
; jrst search ; and search for it
;search fndrom sndrom flsspc sndtid sntrom tidone
; Now search for terminal
search: call getch ; get a character
call getch ; got CR, get the LF (we're trusting)
jrst search ; no line feed
sojg y,search ; got line feed, punt if done
; Found the terminal name, now flush TTY name and spaces
movx y,8. ; skip over TTY name
fndrom: call getch ; gobble down TTY name
jrst [ burp [asciz/ROOMS[P,DOC] in bad format!
/]
jrst rndtid] ; somebody better fix ROOMS[P,DOC] !!
sojg y,fndrom
caxn x,<" > ; space?
jrst flsspc ; yes, roomless TTY
sndrom: call netoc1 ; send character out
call getch ; get a character
jrst [ burp [asciz/ROOMS[P,DOC] in bad format!
/]
jrst rndtid] ; somebody better fix ROOMS[P,DOC] !!
caxe x,<" > ; saw a space?
jrst sndrom ; nope, okay to send it
call netoc1 ; well, can send one space
flsspc: call getch ; but not any more
jrst rndrom ; all done
caxn x,<" > ; a space to flush?
jrst flsspc ; yes, flush it
sndtid: call netoc1 ; not a space, send it
call getch ; get a character
caxa ; all done
jrst sndtid ; no, send it out
; Done with sending room, finish that up and get going on real work
sntrom: movx x,%zeros ; final null
call netoc1 ; send it
tidone: call netsnd ; force the buffer out
release dsk, ; free up channel
; (continued on next page)
;chkiii inidpy sleepr
subttl Initialize screen
store %zeros,hpos ; to beginning of line
store %zeros,vpos ; top of screen
ppact ; flush PP 0
leypos 2000 ; line editor off screen
skipn dmp ; is it a DM?
jrst chkiii ; no, check for III
store 5*dmbufl,dmcnt ; initialize DM counter
move [440700,,dmpgm] ; initialize DM pointer
movem dmpnt ; . . .
dmcmd 35 ; put terminal in scroll mode
jrst inidpy ; and continue
chkiii: skipn iiip ; cretinous III?
jrst inidpy ; nope
store %zeros,scp ; all III frobs start with zero
move iiihdr ; get III header
movem scp+1 ; stuff in III program
inidpy: call scrini ; init core screen
store %fword,ovpos ; old vertical position
lock ; now get locked in core
; Top level sleeper
sleepr: call scnupd ; update screen if necessary
iwait ; sleep until next interrupt
aosg ttiinp ; TTY input?
jrst ttiser ; loop around again
skipn clsedp ; if closing hack network input always
aosg ntiinp ; net input?
jrst ntiser ; hack it
jrst sleepr ; else back to sleep
;ttiser ttisrx netsnd netoc1
subttl TTY input service
ttiser: skipn sdisp+2 ; t i p?
jrst ntiser ; no, try for net input
ttisrx: inchrs x ; got a character?
jrst [ aosg ntbfop ; was there network output?
call netsnd ; force the buffer out
aosg ntiinp ; net input?
jrst ntiser ; yes, hack it
jrst sleepr] ; nope, back to main loop
ldb y,[000700,,x] ; get ASCII part of X
caxn y,↑M ; terpri?
inchrw y ; gobble line feed
andx y,%txctl\%txmta ; get bucky bits of thing
iori x,(y) ; and bop them on
store %fword,ntbfop ; flag there is network buffered output
call netoch ; send it out
jrst ttiser ; and try for any frobs just came in
; Force the buffer out to the network
netsnd: ldb x,[410300,,ntobf+1] ; load position field
movx y,1 ; get a bit to hack
lsh y,(x) ; 2↑# of characters
subx y,1 ; now get null bit flusher mask
iorm y,@ntobf+1 ; make sure the nulls aren't sent
out net, ; send the character
return ; won
jrst nioerr ; lost
; Auxillary NETOCH
netoc1: sosg ntobf+2 ; space available in buffer?
out net, ; no, output the buffer
caxa ; win
jrst nioerr ; lose
idpb x,ntobf+1 ; put character in buffer
return ; and return
;netoch netoc2 ntoc2a netoc3 outmap allomp
; Output a character to the network buffer in the hairy way
netoch: aosn imgchp ; image characters?
jrst ntoc2a ; yes, don't map then
; Map αZ to [CALL], αβZ to α[CALL], α_ to [BACK NEXT]. αz and αβz behave in
; a similar manner.
; These mappings are necessary since there is no way that SUPDUP can read a
; [CALL] coming in for the Stanford keyboard, and there is no [BACK NEXT] key
; on them. For various other obscure characters, commands exist to send them.
ldb y,[001000,,x] ; get αcharacter
caxe y,%txctl\"z ; some form of αz?
caxn y,%txctl\"Z ; or of αZ?
jrst [movx y,↑Z ; yes, convert to [CALL]
dpb y,[001000,,x] ; save character
txze x,%txmta ; αβz or αβZ?
iorx x,%txctl ; yes, make it α[CALL]
jrst netoc3] ; now send this bucky command
caxn x,%txctl\"_ ; α_?
jrst [ movx x,↑← ; yes, convert to [BACK NEXT]
jrst netoc3] ; now go send the frob
; Map the character from the SAIL to the ITS character set and check for
; if TOPififcation is needed (TECO will treat SAIL graphics as controls
; unless %TXTOP is on). Then check for any bucky bits.
netoc2: ldb y,[000700,,x] ; get ASCII part of character
call outmap ; map to ITS ASCII
dpb y,[000700,,x] ; and kludge back
caxl y,↑I ; TAB is not TOPified
caxle y,↑M ; neither are LF, VT, FORM, and CR
caxn y,<↑[> ;]neither is ALT
jrst ntoc2a ; nope, it's a positioning(?) frob
caxge y,<" > ; all SAIL graphics
iorx x,%txtop ; are TOPified (happy TECO)
ntoc2a: txnn x,%txtop\%txsfl\%txsft\%txmta\%txctl; any bucky bits?
jrst [ call netoc1 ; nope, just send the frob
caxn x,"≤ ; sending the escape code?
jrst netoc1 ; yes, repeat it
return] ; now return
; The character has bucky bits, so the intelligent terminal protocol is used to
; send bucky bits: [↑\] [<bucky bits>←-7] [<character>].
netoc3: move y,x ; swap swap swap
movx x,↑\ ; load escape code
call netoc1 ; put character in buffer
movx x,"@ ; initialize bucky word
irps bucky,,[%txtop %txsfl %txsft %txmta %txctl]
txze y,bucky ; bucky bit?
txo x,bucky←-7 ; yup
termin
call netoc1 ; send this cruftie out
move x,y ; swap back
jrst netoc1 ; now send the non-bucky character
; Output mapping from SAIL to ITS character set.
outmap: skipe dmluzp ; losing DM?
jrst allomp ; yah, don't do FCS mappings
mapit y,137,030 ; backarrow
mapit y,030,137 ; underscore
; Common mappings for everything
allomp: mapit y,033,032 ; not equals
mapit y,032,176 ; tilde
mapit y,175,033 ; diamond
mapit y,176,175 ; right curly bracket
return ; else return
;ntiser
subttl Network input service
; Read a character but don't hang.
ntiser: sosg ntibf+2 ; anything in buffer?
jrst [ hrrz x,ntibf ; nope, pointer to next
hrrz x,(x) ; check next
skipn clsedp ; closing should slurp always
skipge (x) ; anything in next buffer?
jrst [in net, ; yes, get a new buffer
jrst .+1 ; won
jrst nioerr] ; lost
mtape net,[10] ; no, any input available?
jrst [ skipn sdisp+2 ; if t i p flag off
call scnupd ; update the screen
inskip ; how about from the TTY?
jrst [ aosg ntbfop ; was there network output?
call netsnd ; force the buffer out
jrst sleepr] ; nope, back to sleep
jrst ttisrx] ; TTY input
in net, ; yes, get a new buffer
jrst .+1 ; won
jrst nioerr] ; lost
call nulfls ; flush nulls
jrst ntiser ; nulls got flushed
ldb x,ntibf+1 ; get a byte
caxe x,%tdors ; got an output reset?
skipl ntoinp ; still hacking output reset?
caxa ; no output flushing
jrst ntiser ; sigh
; Check for any display stuff that must be done
aosn govpos ; get old vertical position?
jrst [ store %fword,gohpos ; yes, now get old horizontal position
jrst ntiser] ; and try for next
aosn gohpos ; get old horizontal position?
jrst [ store %fword,gtvpos ; yes, get vertical position now
jrst ntiser] ; and try for next
aosn gtvpos ; get vertical position?
jrst [ store %fword,gthpos ; yes, get horizontal position now
movem x,vpos ; save current vpos now
store %fword,crupdp ; flag cursor updated
jrst ntiser] ; and try for next
aosn gthpos ; get horizontal position?
jrst [ movem x,hpos ; set horizontal position
store %fword,crupdp ; flag cursor updated
skipn dmp ; is this a DM?
jrst ntiser ; no, return
dmcmd ↑L ; send a cursor position
move x,hpos ; x position
xorx x,140 ; DM crock
call dmchar ; output the character
move x,vpos ; y position
addx x,2 ; give who-line room
xorx x,140 ; DM crock
call dmchar ; output the character
jrst ntiser] ; and continue
; (continued on next page)
;dpypr1 netich inpmap allimp nulfls nulfl2
; Check for other display stuff
dpypr1: aosn gtiln ; insert lines?
jrst inslin ; yup
aosn gtdln ; delete lines?
jrst dellin ; yup
aosn gtich ; insert characters?
jrst inschr ; yup
aosn gtdch ; delete characters?
jrst delchr ; yup
caxl x,%tdmov ; display code?
jrst dpyser ; yes, go do special things
call inpmap ; map from ITS to SAIL ASCII
call scstor ; store it on the screen
jrst ntiser ; continue until this frob empty
; Read a character from the network, hanging for it
netich: sosg ntibf+2 ; anything in buffer?
in net, ; nope, get some
caxa ; won
jrst nioerr ; lost
call nulfls ; call null flusher crock
jrst netich ; nulls got flushed
ldb x,ntibf+1 ; get a byte
return
; Map graphics from ITS extended ASCII to SAIL's extended ASCII.
; First come mappings necessary between SAIL and ITS ASCII
inpmap: skipe dmluzp ; losing DM?
jrst allimp ; yah, too bad
mapit x,000,056 ; centered dot
mapit x,011,017 ; gamma
mapit x,012,017 ; delta
mapit x,013,136 ; uparrow
mapit x,015,026 ; circle plus
mapit x,030,137 ; left arrow
mapit x,032,033 ; not equals
mapit x,033,175 ; diamond
mapit x,136,004 ; caret (sigh!!!)
mapit x,137,030 ; underscore
mapit x,177,013 ; integral sign
; Then come mappings which are done going anywhere
allimp: mapit x,175,176 ; right curly brace
mapit x,176,032 ; tilde
return ; and return
; Flush padding nulls. Also bumps the byte pointer
nulfls: ibp ntibf+1 ; point to word
move x,@ntibf+1 ; get word of that byte
andx x,17 ; only marking bits
jffo x,.+2 ; count leading zeros
jrst cpopj1 ; no nulls to flush
movni x,-44(y) ; get -1,,# of padding characters
movei y,-1(x) ; # of characters to take off buffer
subm y,ntibf+2 ; remove padding characters from count
movns ntibf+2 ; SUBM goes the wrong way, fix it
skipe y
nulfl2: ibp ntibf+1 ; advance byte ptr a few bytes
sojg y,nulfl2
lsh x,3 ; # of bits to shift over
movni x,(x) ; reverse direction
move y,@ntibf+1 ; get word we are hacking
lsh y,(x) ; right justify its bytes
movem y,@ntibf+1 ; store it back again
return ; normal return
;dpyser dpyctb
subttl Display hacking
dpyser: caxl x,%tdmax ; a baddie?
jrst [ outstr [asciz/Spurious input %TD code (/]
idivx x,100 ; get hundreds
idivx y,10 ; and tens and ones
repeat 3,[
addx x+.rpcnt,"0 ; ASCIIify
outchr x+.rpcnt ; and print it
] ; once for each digit
burp [asciz/) flushed.
/]
jrst ntiser] ; yes, report it
xct dpyctb-%tdmov(x) ; no, dispatch on it
jrst ntiser ; return
; Dispatch table for ITS cursor control codes. The server for
; a display code is defined by:
; DPYSVR code,server instruction
; The servers must be in order by their codes!
define dpysvr code,server
ifn .-dpyctb-code+%tdmov,.err code is out of order
server
termin
dpyctb: dpysvr %tdmov,[store %fword,govpos]
dpysvr %tdmv1,[store %fword,gtvpos]
dpysvr %tdeof,[call clreof]
dpysvr %tdeol,[call clreol]
dpysvr %tddlf,[call clr1ch]
dpysvr %tdmtf,[burp [asciz/Spurious input %TDMTF flushed.
/]]
dpysvr %tdmtn,[burp [asciz/Spurious input %TDMTN flushed.
/]]
dpysvr %tdcrl,[call terpri]
dpysvr %tdnop,[cai]
dpysvr %tdbs,[burp [asciz/Spurious input %TDBS flushed.
/]]
dpysvr %tdlf,[burp [asciz/Spurious input %TDLF flushed.
/]]
dpysvr %tdrcr,[burp [asciz/Spurious input %TDRCR flushed.
/]]
dpysvr %tdors,[call oreset]
dpysvr %tdqot,[burp [asciz/Spurious input %TDQOT flushed.
/]]
dpysvr %tdfs,[call csraos]
dpysvr %tdmv0,[store %fword,gtvpos]
dpysvr %tdclr,[call clrscn]
dpysvr %tdbel,[call bredle]
dpysvr %tdini,[burp [asciz/Spurious input %TDINI flushed.
/]]
dpysvr %tdilp,[store %fword,gtiln]
dpysvr %tddlp,[store %fword,gtdln]
dpysvr %tdicp,[store %fword,gtich]
dpysvr %tddcp,[store %fword,gtdch]
dpysvr %tdbow,[cai]
dpysvr %tdrst,[cai]
dpysvr %tdgrf,[burp [asciz/Graphics not implemented!
/]]
ifn .-dpyctb-%tdmax+%tdmov,.err %TDMAX is wrong
;scrini scrin1 glnini scstor scsto2 clrscn dmceof
subttl Display subroutines
; Here to initialize the screen image in core
scrini: store ascii/ /+1,screen,scrend; write blanks throughout screen
movx x,<ascii/
/+1> ; DD type of terpri
movx y,%zeros ; top line
movx z,1 ; blank word
movx a,nlines ; do for number of lines on screen
scrin1: movem z,screen(y) ; zap first word on line
movem z,screen+1(y) ; and second one too
movem x,screen+nwrdln-2(y) ; put terpri at end
movem z,screen+nwrdln-1(y) ; and nothingness after that
addx y,nwrdln ; go to next line
store %zeros,slupdp-1(a) ; line not updated
sojg a,scrin1 ; loop for next line
glnini: store 2,scc+2,scc+2+ngw-1 ; blank graphics word
return ; now return
; Here to store a character on the screen
scstor: move y,vpos ; line position
store %fword,slupdp(y) ; flag this line changed
store %fword,scupdp ; and that there is a change
imulx y,nwrdln ; number words/line
move z,hpos ; x position
camle z,tcmxh ; greater than line length
jrst scsto2 ; account for it anyway, flush the attempt
idivx z,5 ; word position
addi y,screen+2(z) ; address of word to hack
dpb x,scbytp(z+1) ; save character on screen
skipe dmp ; is this a DM?
call dmchar ; yes, output this character
scsto2: aos hpos ; bump X position (must be after DMCHAR)
return ; and return
; Here to clear the screen
clrscn: store %zeros,vpos ; top line
store %zeros,hpos ; leftmost column
call scrini ; initialize screen
store %fword,saupdp ; updated entire screen
call scnupd ; now update the screen
skipn dmp ; is this a DM?
return ; no, return
dmcmd ↑L ; set cursor position
movx x,140 ; beginning of line
call dmchar ; output the character
movx x,142 ; line 2
call dmchar ; output it
move y,tcmxv ; get height of screen
dmceof: dmcmd ↑W ; clear this line
dmcmd ↑M ; and go to next line
sojg y,dmceof ; and continue clearing
dmcmd ↑L ; set cursor position
movx x,140 ; beginning of line
call dmchar ; output the character
movx x,142 ; line 2
call dmchar ; output it
jrst dmout ; force it all out
;clreol cleol1 clr1ch terpri
; Non-insert/delete display subroutines
; Here to clear to EOL
clreol: skipe dmp ; is this a DM?
jrst [ dmcmd ↑W ; yes, send line zapper
jrst .+1] ; and return
move b,hpos ; get the position now
caxl b,linel ; if done
return ; flush
move y,vpos ; get vertical position
store %fword,slupdp(y) ; flag this line changed
store %fword,scupdp ; and that there is a change
imulx y,nwrdln ; number of words/line
move z,hpos ; save horizontal position
idivx z,5 ; word position
addi y,screen+2(z) ; address of word to hack
move z,scbytp(z+1) ; get byte pointer
movx x,<" > ; space in the character
dpb x,z ; zap this character
cleol1: addx b,1 ; bump character pointer
caxl b,linel ; got to EOL yet?
return ; and return
idpb x,z ; zap another character
jrst cleol1 ; nope, not done yet
; Here to delete a character forward
clr1ch: skipe dmp ; is this a DM?
jrst [ dmcmd <" > ; yes, zap out the character
dmcmd ↑H ; back up
jrst .+1] ; and continue
movx x,<" > ; a blank space
move y,vpos ; line position
store %fword,slupdp(y) ; flag this line changed
store %fword,scupdp ; and that a change happened
imulx y,nwrdln ; number of words/line
move z,hpos ; horizonal position
idivx z,5 ; word position
addi y,screen+2(z) ; address to be hacked
dpb x,scbytp(z+1) ; shove character in
return ; and return
; Here to terpri
terpri: skipe dmp ; is this a DM?
jrst [ dmcmd 35 ; put terminal in scroll mode
dmcmd ↑M ; and do a CR
dmcmd ↑X ; leave scroll mode
jrst .+1] ; and continue
store %zeros,hpos ; to beginning of line
aos y,vpos ; bump vertical position
caml y,tcmxv ; gone too far?
jrst [ move y,[screen+nwrdln,,screen]; foo! gotta scroll (sigh)
blt y,screen+scrsiz-nwrdln-1; the big BLT strikes again
store ascii/ /+1,botlin+1,botlin+<linel/5>
store %fword,saupdp ; I can't believe I updated the WHOLE thing
move tcmxv ? sos ? movem vpos; set vertical position to bottom line
jrst .+1] ; and continue
store %fword,crupdp ; flag cursor has moved
jrst clreol ; and now clear the line
;bredle oreset csraos clreof cleof1
; More display subroutines
; Here to breedle
bredle: skipe dmp ; DM?
jrst [ dmcmd ↑G ; yes, can beep this way
return] ; and return
movx x,%fword ; → own speaker
beep x, ; breedle...
return ; and return
; Here to respond to an output reset
oreset: movx x,↑\ ; escape code
call netoc1 ; send it
movx x,↑P ; ready to send cursor position
call netoc1 ; here it comes...
move x,vpos ; vertical position
call netoc1 ; . . .
move x,hpos ; horizontal position
call netoc1 ; . . .
aos ntoinp ; flush one net interrupt
jrst netsnd ; force these crufies out
; Here to forespace
csraos: skipe dmp ; is this a DM?
jrst [ dmcmd ↑\ ; yes, space forward
jrst .+1] ; and continue
aos hpos ; bump horizontal position
store %fword,crupdp ; flag cursor updated
return ; and return
; Here to clear to EOF
clreof: save hpos ; save current horizontal pos
save vpos ; ditto for vertical
cleof1: call clreol ; clear to end of line
dmcmd ↑M ; next line
store %zeros,hpos ; now clear all of the lines below
aos x,vpos ; bump to new line
caxge x,nlines ; all done yet?
jrst cleof1 ; nope, kill next line
retr vpos ; get back old vertical position
retr hpos ; and horizontal position
dmcmd ↑L ; set cursor position
move x,hpos ; horizontal position
xorx x,140 ; DM crock
call dmchar ; output it
move x,vpos ; vertical position
xorx x,140 ; DM crock
addx x,2 ; account for wholine
jrst dmchar ; output it
;inslin insl0a insln0 insl1a insln1 insln2
; Line insert
inslin: move a,x ; copy # of lines to hack
skipn dmp ; is this a DM?
jrst insln0 ; nope
dmcmd ↑P ; yes, enter i/d mode
insln0: skipn dmp ; DM again?
jrst insl1a ; nope
dmcmd ↑J ; insert a line
insl1a: move x,vpos ; load vertical position
imulx x,nwrdln ; make into word counter
addi x,screen ; address of first word of cursor line
cain x,screen+<nlines-1>*nwrdln ; skip unless at bottom line
jrst insln2 ; on bottom, zap it
move y,[screen+<nlines-2>*nwrdln,,screen+<nlines-1>*nwrdln]
insln1: move z,y ; copy pointer
blt z,nwrdln-1(y) ; copy one line
adjsp y,-nwrdln ; offset a line
caie x,(y) ; done yet?
jrst insln1 ; nope
insln2: store ascii/ /+1,2(x) ; blanks
movei y,nwrdln-2-1(x) ; number to do
addx x,3 ; address offset
hrli x,-1(x) ; complete pointer
blt x,(y) ; zak!
sojg a,insln0 ; loop for more lines
store %fword,saupdp ; updated the world
skipn dmp ; on a DM?
jrst ntiser ; no, just return
dmcmd ↑X ; yes, leave i/d mode
jrst ntiser ; and return
;dellin dell0a delln0 dell1a delln1
; Line delete
dellin: move a,x ; copy # of lines to hack
skipn dmp ; is this a DM?
jrst delln0 ; nope
dmcmd ↑P ; yes, enter i/d mode
delln0: skipn dmp ; is this a DM?
jrst dell1a ; nope
dmcmd ↑Z ; delete a line
dell1a: move x,vpos ; get vertical position
imulx x,nwrdln ; frobs to do
addi x,screen ; address of first word of cursor line
cain x,screen+<nlines-1>*nwrdln ; at bottom line?
jrst delln1 ; yup, just copy extra line in
movei y,(x) ; make a copy
addx y,nwrdln ; address of next line
hrli x,(y) ; make a BLT pointer
blt x,screen+<nlines-1>*nwrdln-1; copy the lines
delln1: store ascii/ /+1,2(x) ; blanks
movei y,nwrdln-2-1(x) ; number to do
addx x,3 ; address offset
hrli x,-1(x) ; complete pointer
blt x,(y) ; zak!
sojg a,delln0 ; loop for more lines
store %fword,saupdp ; updated the world
skipn dmp ; on a DM?
jrst ntiser ; no, just return
dmcmd ↑X ; leave i/d mode
jrst ntiser ; and return
;inschr insc0a insch0 insc1a insch2 insch1
; Character insert
inschr: move c,x ; copy character counter
skipn dmp ; is this a DM?
jrst insch0 ; nope
dmcmd ↑P ; yes, enter i/d mode
insch0: skipn dmp ; on a DM?
jrst insc1a ; nope
dmcmd ↑\ ; insert a character
insc1a: move x,vpos ; get vertical position
imulx x,nwrdln ; now number of words
move a,x ; copy it for hacking
addi a,screen+nwrdln-3 ; address of last text word
move y,hpos ; get horizontal position
idivx y,5 ; make it words
addi x,screen+2(y) ; address of word with cursor
ldb y,[010700,,(x)] ; first character in next word
ldb b,[ 103400,,(x)
102500,,(x)
101600,,(x)
100700,,(x)
100000,,(x)](z) ; bytes after character
dpb b,[ 013400,,(x)
012500,,(x)
011600,,(x)
010700,,(x)
010000,,(x)](z) ; get shifted over one
movx b,<" > ; space in hole
dpb b,[ 350700,,(x)
260700,,(x)
170700,,(x)
100700,,(x)
010700,,(x)](z)
jrst insch1 ; check for being done
; At each iteration Y has last character, X has next address
insch2: move z,y ; copy the character
ldb y,[010700,,(x)] ; first character in next word
dpb z,[000700,,(x)] ; last character here
move z,(x) ; get word being hacked
rot z,-7 ; put characters in right place
iorx z,1 ; make sure bit 1.1 is on
movem z,(x) ; save character in word
insch1: came x,a ; at last address?
aoja x,insch2 ; nope
store %fword,scupdp ; some update somewhere
move x,vpos ; this line
sojg c,insch0 ; loop for more characters
store %fword,slupdp(x) ; this line was hacked
skipn dmp ; on a DM?
jrst ntiser ; no, just return
dmcmd ↑X ; leave i/d mode
jrst ntiser ; and return
;delchr delc0a delch0 delc1a delch2 delch1
; Character delete
delchr: move c,x ; copy number of characters to hack
skipn dmp ; is this a DM?
jrst delch0 ; nope
dmcmd ↑P ; yes, enter i/d mode
delch0: skipn dmp ; on a DM?
jrst delc1a ; nope
dmcmd ↑H ; delete a character
delc1a: move x,vpos ; get current vertical position
imulx x,nwrdln ; number of words
move a,x ; save it for later
addi a,screen+nwrdln-3 ; address of last text word in line
move y,hpos ; get horizontal position
idivx y,5 ; number of words
addi x,screen+2(y) ; address of word with cursor
ldb b,[ 013400,,(x)
012500,,(x)
011600,,(x)
010700,,(x)
010000,,(x)](z)
dpb b,[ 103400,,(x)
102500,,(x)
101600,,(x)
100700,,(x)
100000,,(x)](z)
jrst delch1 ; check for being done
; Each time around the iteration A had address of next word
delch2: ldb y,[350700,,(x)] ; last character in previous
dpb y,[010700,,-1(x)] ; to previous
ldb y,[013400,,(x)] ; get last characters in this word
dpb y,[103400,,(x)] ; put back left justified
delch1: came x,a ; done?
aoja x,delch2 ; not yet
movx y,<" > ; get a space
dpb y,[010700,,(x)] ; blank out last column
store %fword,scupdp ; screen updated someplace
move x,vpos ; get this line
sojg c,delch0 ; hack another character
store %fword,slupdp(x) ; flag this line hacked
skipn dmp ; on a DM?
jrst ntiser ; no, just return
dmcmd ↑X ; leave i/d mode
jrst ntiser ; and return
;scnupd csrupd scupd1 scup1a
subttl Display update subroutines
scnupd: movx x,<-nlines,,> ; load pointer to line update table
movx y,%zeros ; initialize line count
skipe slupdp(x) ; does this line need hacking?
addx y,1 ; yup, bump count
aobjn x,.-2 ; try for more lines
skipn iiip ; III always updates everything
caxl y,nlnupd ; three lines or so?
store %fword,saupdp ; yup, must update screen
aose saupdp ; update entire screen?
jrst scupd1 ; nope, maybe selective
store %zeros,scupdp ; clear other update flags
store %zeros,slupdp,slupdp+nlines-1; . . .
skipe dmp ; is this a DM?
jrst csrupd ; and update the cursor
upgiot sdisp ; output new screen
; jrst csrupd ; now update cursor
; Update cursor
csrupd: skipe dmp ; is this a DM?
jrst [ dmcmd ↑L ; yes, send a cursor pos
move x,hpos ; horizontal position
xorx x,140 ; DM crock
call dmchar ; output it
move x,vpos ; vertical position
addx x,2 ; room for who line
xorx x,140 ; DM crock
call dmchar ; output it
jrst dmout] ; force it out and return
skipn ddp ; is this a DD?
return ; nope, too bad III
skipe cdisp+2 ; finished with the last display?
upgiot [0 ? 0 ? 0 ? 0] ; no, sit and wait
call glnini ; clear cursor line
skipge x,ovpos ; got an old position?
jrst .+3 ; nope, don't try to clear old
call getcsy ; get cursor vertical position
ddupg cclear ; clear cursor
skipn csronp ; is cursor on?
return ; no, you lose
move x,hpos ; horizontal character position
imulx x,6 ; horizontal bit position
addx x,2 ; graphics mode hack
idivx x,32.
movns y
movx z,(740000)
lsh z,(y)
ldb a,[010300,,z]
rot a,-3
andx z,777777777760
iorx z,2
iorx a,2
movem z,scc+2(x)
movem a,scc+3(x)
move x,vpos ; get current vertical position
movem x,ovpos ; save as old position
call getcsy ; get cursor vertical position
ddupg cdisp ; and send it all out
return ; finally return
scupd1: aose scupdp ; did any update happen?
jrst [ aose crupdp ; was cursor hacked
return ; nope, just return
jrst csrupd] ; yes, then hack the cursor
movx x,<-nlines,,> ; load line pointer
scup1a: skipe slupdp(x) ; need to hack this line?
call updlin ; yup
aobjn x,scup1a ; loop for next line
jrst csrupd ; now update cursor
;getcsy updlin
; More display updating stuff
; Set up display program vertical position
getcsy: imulx x,12.
addx x,24.+10.
dpb x,[140400,,scc+1]
lsh x,-4
dpb x,[240500,,scc+1]
return ; and return
; Display a single line
updlin: skipe dmp ; don't do this garbage if a DM
return ; flitter back immediately
skipe ldisp+2 ; finished with the last display?
upgiot [0 ? 0 ? 0 ? 0] ; no, sit and wait
store %zeros,slupdp(x) ; am updating now
hrrz y,x ; line number
imulx y,nwrdln ; word position
movsi y,screen+2(y) ; address of start of line
hrri y,linprg+2 ; and where line is going to
blt y,linprg+nwrdln-2 ; copy line
hrrz z,x ; get line number again
imulx z,12.
addx z,24. ; starting raster number
dpb z,[140400,,linprg] ; zap in low 4 bits of address
lsh z,-4 ; throw low bits away
dpb z,[240500,,linprg] ; high 5 bits of address
upgiot ldisp ; display the line
return ; now return
;dmchar dmredw dmred1 dmdrw1 dmdrw2 dmout
subttl DM display routines
; Character output to DM
dmchar: sosg dmcnt ; any room in buffer?
call dmout ; nope, output the buffer
idpb x,dmpnt ; save character
return ; and return
; Redraw DM screen, aborts any undone DM output
dmredw: store %zeros,dmpgm,dmpgm+dmbufl-1; clear the old program
store <5*dmbufl>-4,dmcnt ; initialize DM counter
move [440700,,dmpgm] ; initialize DM pointer
movem dmpnt ; . . .
save hpos ? save vpos ; save current cursor position
dmcmd ↑L ; set cursor position
movx x,140 ; beginning of line
call dmchar ; output the character
movx x,142 ; line 2
call dmchar ; output it
move y,tcmxv ; get height of screen
dmred1: dmcmd ↑W ; clear this line
dmcmd ↑M ; and go to next line
sojg y,dmred1 ; and continue clearing
dmcmd ↑L ; set cursor postion
movx x,140 ; beginning of line
call dmchar ; set X position
movx x,142 ; second line from top
call dmchar ; output that too
store %zeros,vpos ; starting at top
movn z,tcmxv ; get number of lines
hrlzs z ; make it an AOBJN pointer
dmdrw1: movx y,nwrdln ; number of words to offset
imuli y,(z) ; compute offset from start of screen
add y,[440700,,screen+1] ; absolute address of line's characters-1
store %zeros,hpos ; start at beginning of line
dmdrw2: ildb x,y ; get a character from the line
jumpe x,dmdrw2 ; flush nulls
call dmchar ; output the character
aos x,hpos ; bump horizontal position
came x,tcmxh ; gotten to end of the line?
jrst dmdrw2 ; yes
store %zeros,hpos ; end of this line
aos vpos ; bump vertical position
dmcmd ↑M ; new line
aobjn z,dmdrw1 ; and loop for next line
retr vpos ? retr hpos ; get back old cursor position
; jrst dmout ; and output the mess
; Buffer output to DM; called when DM buffer full or want to force buffer out
dmout: skipn dmpgm ; any program there?
return ; lets not get overenthusiastic
hrrz dmpnt ; get current value of pointer
subi dmpgm-1 ; compute number of words used
movem dmdisp+1 ; set number of words to do
upgiot dmdisp ; output DM program
movs hpos ; get current X position
hrr vpos ; and Y position
addx 0,2 ; give the who line some space
cursor ; bop the cursor to last position
store %zeros,dmpgm,dmpgm+dmbufl-1; clear the old program
store <5*dmbufl>-4,dmcnt ; initialize DM counter
move [440700,,dmpgm] ; initialize DM pointer
movem dmpnt ; . . .
movx 0,177 ; quote
idpb dmpnt ; put in buffer
movx 0,↑L ; cursor position
idpb dmpnt ; bufferify
move hpos ; horizontal position
xorx 0,140 ; DM crock
idpb dmpnt ; bop away
move vpos ; vertical position
addx 0,2 ; who line space
xorx 0,140 ; DM crock
idpb dmpnt ; bop away
return ; and return
;cmdcmd cmdcm0 review
subttl SUPDUP commands
cmdcmd: inchrw x ; get command character
cmdcm0: ldb y,[001000,,x] ; get αcharacter, enter here with char in x
caxl y,"a ; lowercase?
caxle y,"z ; . . .
caxa ; no
txz x,<" > ; yes, uppercasify
caxe x,"K ; logout foreign job?
caxn x,"L ; . . .
jrst [movx x,300 ; escape code
call netoc1 ; prepare for escape
movx x,301 ; kill other job code
call netoc1 ; send it too
call netsnd ; now send this command out
outstr [asciz/Logged out foreign job./]
jrst quit] ; and die
caxn x,"Q ; quit?
jrst quit ; yes, clear screen and exit
caxn x,"B ; toggle blinking state?
jrst [ setcmb y,csrhkp ; zap the flag
jumpn y,cpopj ; done if turning it on
setom csronp ; otherwise make sure cursor is on
setom crupdp ; flag cursor "updated"
return] ; now return
caxn x,"H ; [HELP]?
jrst [ txo x,%txtop ; TOPify
jrst imgsnd] ; and send it out
caxe x,"? ; help?
caxn x,"P ; page printer restore?
jrst [caxn x,"? ; was it a help?
jsp z,[hrroi y,[004000,,"C]; [ESCAPE]C
ttyset y, ; clear the screen
ppsel 400002 ; yes, select PP 2 but don't activate yet
outstr hlptxt ; display help text
ppact 100000 ; now activate PP 2
jrst 3(z)] ; and continue
ppact 400000 ; activate PP 0
hrroi y,[004000,,400\"N]; [BREAK]N
ttyset y, ; refresh screen
movx y,2 ; 2 seconds
sleep y, ; zzz...
outstr [asciz/Type any character to return to ITS:/]
inchrw y ; get a character
outstr [asciz/
/]
clrbfi ; flush any other input (like CRLF)
caxn x,"? ; was it a help frob?
pprel 2 ; flush temporary page printer
jrst @review] ; and review screen
caxn x,"R ; screen record crock?
jrst record ; yes, write record file
caxn x,"V ; re-view screen?
review: jrst [ leypos 2000 ; line editor off screen
ppact ; flush all PP's
skipe dmp ; is this a DM?
call dmredw ; redraw the whole screen
store %fword,saupdp ; must redisplay whole screen
call scnupd ; update screen
store %zeros,ntoinp ; clear output resets
return] ; all done
caxn x,"D ; enter DDT?
jrst ddtcal ; call DDT
; (continued on next page)
;imgsnd
; Esoteric character mappings (all magical)
caxe y,%txctl\"z ; αz or αβz?
caxn y,%txctl\"Z ; αZ or αβZ?
jrst imgsnd ; yes, send it in image form
caxn y,%txctl\"_ ; α_ or αβ_?
jrst [ addx x,"←-"_ ; map it first
jrst imgsnd] ; and send it
txz y,%txctl ; flush αification
caxn y,". ; centered-dot?
jrst [ addx x,%txtop-". ; yes
jrst imgsnd] ; and send it
caxe y,↑I ; gamma?
caxn y,↑J ; delta?
jrst [addx x,%txtop ; yes
jrst imgsnd] ; and send it
caxe y,↑M ; circle-plus?
caxn y,177 ; integral?
jrst [addx x,%txtop ; yes
jrst imgsnd] ; and send it
caxn y,"∂ ; [NULL]?
jrst [ subx x,"∂ ; yes
jrst imgsnd] ; and send it
caxe y,"λ ; λ? [BACK SPACE]
caxn y,"∨ ; ∨? [BACK NEXT]
jrst imgsnd ; yes, send it
caxn y,"≠ ; ≠? [CALL]
jrst [ subx x,"≠-"~ ; yes, convertify (cretin character set)
jrst imgsnd] ; yes, send it
caxn y,"α ; α? [ESCAPE]
jrst [ addx x,%txtop\<"A-"α> ; yes, change α to [ESCAPE]
jrst imgsnd] ; and send it
caxn y,"β ; β? [BREAK]
jrst [ addx x,%txtop\<"B-"β> ; yes, change β to [BREAK]
jrst imgsnd] ; and send it
caxn y,"ε ; ε? [CLEAR]
jrst [ addx x,%txtop\<"C-"ε> ; yes, change ε to [CLEAR]
jrst imgsnd] ; and send it
caxe y,"↑ ; ↑? uparrow
return ; no-op illegal command
addx x,%txtop+013-"↑ ; yes, change ↑ to uparrow
imgsnd: store %fword,imgchp ; image characters now
call netoch ; send it too
jrst netsnd ; send it out
;hlptxt
; SUPDUP help text
hlptxt: asciz/Commands:
B Toggle cursor blinking H Send [HELP] ("help" key)
K or L Kill job and quit P View page printer
Q Detach job and quit R Write a screen record
V Re-draw screen ? Type this message
Special mappings:
. centered-dot [TAB] gamma [LF] delta
[CR] circle-plus [BS] integral ⊗ [NULL]
λ [BACK SPACE] ≠ [CALL] ∨ [BACK NEXT]
α [ESCAPE] β [BREAK] ε [CLEAR]
↑, α↑, β↑, αβ↑, αz, αβz, αZ, αβZ, α_, and αβ_ are not mapped in command mode.
/
;reentr record recrd0 recrd1 recrd2
subttl Screen record crock
tmploc jobren,reentr
reentr: setzm jobren ; flag to exit
record: open dsk,[0 ? 'DSK,, ? dsobf,,] ; get a disk channel
barf [asciz/Unable to OPEN the DSK!
/]
skipn jobren ; if reentering
jrst recrd0 ; don't hack things much
push p,jobff ; save old JOBFF
hrroi x,[004000,,400\"N] ; [BREAK]N
ttyset x, ; normalize screen
ptjobx [0 ? sixbit/DON/] ; turn echoing on
movx x,%fword ; this terminal
getlin x ; get line characteristics
txz x,spcbrk ; special activation mode bit
setlin x ; leave SAM
setact [[777777,,777777 ; activate on 000 - 043
777700,,037600 ; 044 - 107
000000,,374000 ; 110 - 153
000007,,600000]] ; 154 - 177
recrd0: outstr [asciz/Writing screen record.../]
movx x,<-nlines,,> ; number of lines to write
recrd1: movx y,nwrdln ; number of words to offset
imuli y,(x) ; compute offset from start of screen
add y,[440700,,screen+1] ; absolute address of line's characters-1
recrd2: ildb z,y ; get a character from the line
jumpe z,recrd2 ; bop away nulls
sosg dsobf+2 ; any room in the buffer?
out dsk, ; no, dump out what's there now
caxa ; won
barf [asciz/Disk OUT failed!
/]
idpb z,dsobf+1 ; save character
caxe z,↑J ; hit the line feed yet?
jrst recrd2 ; not yet
aobjn x,recrd1 ; won
close dsk, ; close off file
release dsk, ; free up channel
skipn jobren ; if reentered
jrst quit2 ; just exit
pop p,jobff ; recover old jobff
move x,jobff ; get core top size
core x, ; ensmallify
barf [asciz/CORE failed!
/] ; tried to be nice
lock ; get locked again
ptjobx [0 ? sixbit/DOFF/] ; turn echoing off
movx x,%fword ; this line
getlin x ; get line characteristics
txo x,spcbrk ; special activation mode bit
setlin x ; enter SAM
setact [[777777,,777777 ; activate on 000 - 043
777777,,777777 ; 044 - 107
777777,,777777 ; 110 - 153
777777,,600000\allact\bsact\supscm\supccr]]; 154 - 177, αβ act
ppact ; flush PP 0
jrst @review ; and redraw screen
;refuse closed dieclr quit quit2 nosock cnetab cnemax conerr diedie
subttl Network error analysis
; Connection refused
refuse: outstr [asciz/Refused./]
jrst diedie
; Connection closed by foreign host
closed: outstr [asciz/Closed./]
dieclr: clrbfi
quit: hrroi y,[004000,,400\"N] ; [BREAK]N
ttyset y, ; clear the screen
quit2: move y,[-2,,[ 010000,,0 ; disable αcr
030000,,0]] ; re-enable pk of input buffer
ttyset y, ; execute 2 functions above
exit ; return to monitor
IFE FTIP,[
; Failed to get socket number from logger
nosock: getsts icp,y ; get channel status of loser
jrst iioerr ; and report why it happened
];IFE FTIP
; CONNECT MTAPE error codes
define cnemes code,message/
ifn 1+.-cnetab-code,.err code is out of order
[asciz/message/]
termin
cnetab: cnemes siu,Socket in use.
cnemes ccs,Can't change socket.
cnemes sys,System error.
cnemes nla,No free links.
cnemes ilb,Illegal byte size.
cnemes idd,NCP dead.
cnemes gmm,Gender mismatch.
cnemes 10,State error.
cnemes 11,Connection was reset.
cnemes 12,Can't get there from here.
cnemes 13,Not enough internal buffer space.
cnemes 14,Illegal host number.
cnemes 15,Remote host down or not on net.
cnemes 16,Timeout.
cnemes 17,Destination net unreachable.
cnemes 20,Destination host unreachable.
cnemes 21,Destination protocol unreachable.
cnemes 22,Destination port unreachable.
cnemes 23,Fragmentation needed and DF set.
cnemes 24,Source route failed.
cnemes 25,Destination unreachable: unknown code.
cnemax==1+.-cnetab
; CONNECT MTAPE failed
conerr: andx x,77 ; only error code
caxl x,cnemax ; error code too high?
jrst [ outstr [asciz/Failed, code #/]
idivx x,10 ; split into two digits
repeat 2,[
addx x+.rpcnt,"0 ; ASCIIify
outchr x+.rpcnt ; output the digit
] ; once for each digit
outchr [".] ; final dot
jrst diedie] ; and die
outstr @cnetab-1(x) ; output error message
diedie: clrbfi
jrst quit2 ; and exit
;nioerr iioerr hstded hstde1
; More network error reporting
; IMP I/O error
nioerr: getsts net,y ; get error status
skipe clsedp ; known that it was closing?
jrst closed ; okay, report that instead
iioerr: andx y,ioimpm\iobktl\iodend\ictran\hdead\ctrov\rset\tmo
txne y,ioimpm
outstr [asciz/Improper mode.
/]
txne y,iobktl
outstr [asciz/Block too large.
/]
txne y,ctrov
outstr [asciz/Allocation error.
/]
txne y,rset
outstr [asciz/Host reset.
/]
txne y,tmo
outstr [asciz/Time out.
/]
txne y,ictran
outstr [asciz/Incomplete transmission.
/]
txne y,iodend
jrst closed
txze y,hdead
jrst hstded
jrst dieclr
; Explain why a host is dead
hstded: ldb y,[260400,,x] ; get what's wrong first
jumpe y,[ outstr [asciz/Net trouble/]
jrst diedie] ; 0 → destination IMP down
soje y,hstde1 ; 1 → destination host down
caie y,2 ; 3 → host access prohibited
jrst [ outstr [asciz/Net error #/]
idivi y,10
addi y,"0
addi z,"0
outchr y
outchr z
jrst diedie]
outstr [asciz/Communication prohibited!/]
jrst diedie
hstde1: outstr [asciz/Host dead, /]
ldb y,[220400,,x] ; dead host status
outstr @(y)[ [asciz/random lossage/]
[asciz/system down/]
[asciz/foreign NCP down/]
[asciz/host doesn't exist/]
[asciz/NCP initialization/]
[asciz/scheduled PM/]
[asciz/hardware work/]
[asciz/software work/]
[asciz/emergency restart/]
[asciz/power failure/]
[asciz/software breakpoint/]
[asciz/hardware error/]
[asciz/scheduled down/]
[asciz/down code #13/]
[asciz/down code #14/]
[asciz/coming up now/]]
; (continued on next page)
;hstde2
ldb [061400,,x] ; get time when back up
jumpe diedie
caxn 0,7776 ; -2 → unknown future time
jrst diedie
outstr [asciz/
Host is expected back up /]
caxn 0,7777 ; -1 → more than a week
jrst [ outstr [asciz/over a week from now./]
jrst diedie]
ldb x,[040500,,] ; 1.5→1.9 hours
ldb y,[110300,,] ; 2.1→2.3 day of week
subx x,8. ; PST/GMT offset
movx z,261 ; DAYLIT
peek z,
peek z, ; non-zero if PDT
skipe z
aosl x ; daylight losing time
jumpge x,hstde2
addx x,24. ; back up a day
sosge y ; if it's Monday in GMT
movx y,6 ; it's still Sunday in California
hstde2: outstr @(y)[ [asciz/on Monday at /]
[asciz/on Tuesday at /]
[asciz/on Wednesday at /]
[asciz/on Thursday at /]
[asciz/on Friday at /]
[asciz/on Saturday at /]
[asciz/on Sunday at /]
[asciz/on April Fool's Day at /]]
idivx x,10.
addx x,"0
outchr x
addx y,"0
outchr y
outchr [":]
ldb x,[000400,,] ; 1.1→1.4 minutes/5
imulx x,5. ; make into real minutes
idivx x,10.
addx x,"0
outchr x
addx y,"0
outchr y
jumpe z,[ outstr [asciz/ PST/]
jrst diedie]
outstr [asciz/ PDT/]
jrst diedie
;rndtid rndrom sndid1 getch cpopj1 ...lit sdpff
subttl Random routines, literals, etc.
; Here if could not get terminal name; give a random string
rndtid: burp [asciz/Unable to get terminal's location from ROOMS[P,DOC].
/]
move y,[440700,,[asciz/Unknown Data Disc/]]
skipe iiip ; is it a III?
move y,[440700,,[asciz/Unknown III/]]
skipn dmp ; is it a DM?
jrst sndid1 ; no
skipa y,[440700,,[asciz/Unknown Datamedia/]]
rndrom: move y,[440700,,[asciz/Jungle/]]
sndid1: ildb x,y ; get a character
call netoc1 ; send it
jumpn x,sndid1 ; and continue if not done
jrst tidone ; all done
; Here to get a character from terminal rooms table
getch: sosg dsibf+2 ; buffer ready?
in dsk, ; no, get one then
caxa ; won
jrst rndtid ; lost, send random name
ildb x,dsibf+1 ; get a character
jumpe x,getch+1 ; flush nulls
caxe x,↑M ; hit a terpri?
cpopj1: aos (p) ; no, bump return PC
return ; now return
; Literals
...lit: variables
constants ; generate constants
sdpff=. ; first free location in SUPDUP
end SUPDUP