--- /dev/null
+CLZE=6130
+CLSK=6131
+CLOE=6132
+CLAB=6133
+CLEN=6134
+CLSA=6135
+CLBA=6136
+CLCA=6137
+CREXT=0100
+CR2=0200
+CR3=0300
+CR4=0400
+CR5=0500
+CR6=0600
+COVSTAT=4000
+CMFREE=0000
+CMPROG=1000
+CADC=0040
+CINH=0020
+CION=0010
+CEV3=0004
+CEV2=0002
+CEV1=00001
+DIXY=6055
+DILX=6053
+DILY=6054
+DILE=6056
+DISD=6052
+XRIN=NOP
+XRCL=NOP
+/DSB=XXXX
+DXC=JMS I IVCLDX
+DYC=JMS I IVCLDY
+DXL=0000
+DYL=0000
+DIS=0000
+/CRF=NOP
+/CCF=NOP
+ *0
+ 0
+ JMP I 2
+ INTSER
+EMPTY, 0
+ODT1, 0
+ODT2, 0
+ODT3, 0
+ *10
+AUTO10, 0
+AUTO11, 0
+AUTO12, 0
+AUTO13, 0
+AUTO14, 0
+AUTO15, 0
+AUTO16, 0
+AUTO17, 0
+ *20
+ONEOUT, 0
+ONECNT, 0
+ONEFLG, 0
+ONETHE, 0
+ONEVEX, 0
+ONEVEY, 0
+ONEPEX, 0
+ONEPEY, 0
+ONESIN, 0
+ONECOS, 0
+ONEFIN, 0
+TWOOUT, 0
+TWOCNT, 0
+TWOFLG, 0
+TWOTHE, 0
+TWOVEX, 0
+TWOVEY, 0
+TWOPEX, 0
+TWOPEY, 0
+TWOSIN, 0
+TWOCOS, 0
+TWOFIN, 0
+XONEDS, 0
+YONEDS, 0
+XTWODS, 0
+YTWODS, 0
+DIXTEM, 0
+DIYTEM, 0
+DISCNT, 0
+T10SIN, 0
+T20SIN, 0
+T30SIN, 0
+T10COS, 0
+T20COS, 0
+T30COS, 0
+CALSIN, 0
+CALCOS, 0
+SINE, SINEIN
+COSINE, COSINI
+MULT, MULTI
+RSHIFT, SHIFTR
+VECTOR, DISPLY
+CALPOS, POSCAL
+INTWRD, 0
+INTCNT, 0
+HYPER, HYPSET
+MESOUT, CHARS
+THEADJ, THEAJI
+VEESCL, VEELIM
+ISHFT, DISHFT
+RESET1, RESE1
+GAMOVR, 0
+ACCFLG, 0
+ACCPER, -30
+MEXP, -400
+PROX, 0
+PROY, 0
+PROLIF, -360
+BUFTMP, 0
+ONEFIL, DISBUF
+TWOFIL, DISBUF+40
+P5, 5
+P10, 10
+P17, 17
+P20, 20
+P37, 37
+P40, 40
+P100, 100
+P132, 132
+P200, 200
+P400, 400
+P550, 550
+P3777, 3777
+M4, -4
+M6, -6
+M10, -10
+M11, -11
+M264, -264
+M200, -200
+M400, -400
+M550, -550
+IVCLDX, VCLDX
+IVCLDY, VCLDY
+ *200
+START, CLA CLL
+ DIXY
+ LAS
+ TAD SWRD
+ TAD XROPT
+ DCA COLDST
+RESTRT, CLA CMA
+ XRCL
+ CLA CLL
+ TAD P17
+ DCA AUTO10
+ TAD TABLEN
+ DCA AUTO11
+ DCA I AUTO10
+ ISZ AUTO11
+ JMP .-2
+ TAD STRT1
+ DCA ONEPEX
+ TAD STRT2
+ DCA TWOPEX
+ TAD P37
+ DCA ONECOS
+ TAD P37
+ DCA TWOCOS
+ TAD ACCPER
+ DCA ACCFLG
+ DCA ONEFIN
+ DCA TWOFIN
+ DCA GAMOVR
+ JMS I BUFSET
+ TCF
+ PCF
+ RRB
+ CLA CMA
+ CLZE
+ CLA
+ TAD CDELY
+ CLAB
+ CLA
+ TAD CCNF
+ CLOE
+ CLA CLL
+ JMP COLDST
+
+CCNF, CR4+CMPROG+CION+COVSTAT
+CDELY, -310
+UPDATE, CLA CLL
+
+COLDST, 0
+ LAS
+ DCA INTWRD
+ TAD INTWRD
+ RTR
+ RTR
+ AND LFTHAF
+ DCA INTTEM
+ TAD INTWRD
+ AND RYTHAF
+ TAD INTTEM
+ JMP .+3
+CODST, XRIN
+ XRCL
+ DCA INTWRD
+ TAD M550
+ DCA INTCNT
+ ION
+ TAD ACCFLG
+ IAC
+ SMA SZA
+ TAD ACCPER
+ DCA ACCFLG
+ JMP I .+1
+ ONEUP
+BUFSET, SETBUF
+TABLEN, AUTO17-CALCOS
+INTTEM, 0
+LFTHAF, 0360
+RYTHAF, 0017
+STRT1, 1000
+STRT2, -1000
+SWRD, 2000-CODST
+XROPT, JMP CODST
+INTSER, DCA INTACC
+ RAR
+ DCA INTLNK
+ CLSK
+ JMP INTBUS
+ CLA IAC RTR
+ CLSA
+ CLA CLL
+ JMP UPDATE
+INTBUS, KSF
+ JMP .+5
+ KCC
+ TAD GAMOVR
+ SZA CLA
+ JMP RESTRT
+/ TCF
+ ISZ INTGLH
+ SKP
+ HLT
+INTRET, CLA CLL
+ TAD INTLNK
+ RAL
+ TAD INTACC
+ ION
+ JMP I 0
+INTACC, 0
+INTLNK, 0
+INTGLH, 0
+ *400
+ONEUP, TAD ONEFLG
+ SNA
+ JMP ONEOK
+ IAC
+ SNA
+ TAD ONEFIN
+ DCA ONEFLG
+ JMP I ITWOUP
+ONEOK, TAD ONEOUT
+ SZA CLA
+ JMP ONEFIG
+ TAD TWOFIN
+ SZA CLA
+ JMS I ONEWN
+ TAD INTWRD
+ AND OP300
+ TAD OM300
+ SZA CLA
+ JMP ONELEF
+ CMA
+ JMP I HYPER
+ONELEF, TAD INTWRD
+ AND P200
+ SNA CLA
+ JMP ONERYT
+ CLA CLL CMA
+ JMP ONEFIG
+ONERYT, TAD INTWRD
+ AND P100
+ SZA CLA
+ IAC
+ONEFIG, TAD ONETHE
+ JMS I THEADJ
+ DCA ONETHE
+ TAD ONETHE
+ JMS I SINE
+ DCA ONESIN
+ TAD ONETHE
+ JMS I COSINE
+ DCA ONECOS
+ TAD ONEOUT
+ SZA CLA
+ JMP ONEVEL
+ONEMOV, TAD ACCFLG
+ SZA CLA
+ JMP ONEVEL
+ TAD INTWRD
+ AND P40
+ SNA CLA
+ JMP ONEVEL
+ TAD ONECOS
+ TAD ONEVEY
+ JMS I VEESCL
+ DCA ONEVEY
+ TAD ONESIN
+ TAD ONEVEX
+ JMS I VEESCL
+ DCA ONEVEX
+ONEVEL, TAD ONEVEX
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD ONEPEX
+ DCA ONEPEX
+ TAD ONEVEY
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD ONEPEY
+ DCA ONEPEY
+ TAD ONEOUT
+ SZA CLA
+ JMP I ITWOUP
+ONELNC, TAD LNC1FG
+ SNA CLA
+ JMP .+3
+ ISZ LNC1FG
+ JMP I ITWOUP
+ TAD INTWRD
+ AND P20
+ SNA CLA
+ JMP I ITWOUP
+
+ TAD PROLIF
+ DCA I AUTO16
+ TAD ONEVEX
+ JMS I ISHFT
+ JMS I RSHIFT
+ TAD ONESIN
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD ONESIN
+ CLL RTL
+ TAD ONEPEX
+ DCA I AUTO16
+ TAD ONEVEY
+ JMS I ISHFT
+ JMS I RSHIFT
+ TAD ONECOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD ONECOS
+ CLL RTL
+ TAD ONEPEY
+ DCA I AUTO16
+ TAD M200
+ DCA LNC1FG
+ JMS I RESET1
+ JMP I .+1
+ITWOUP, TWOUP
+LNC1FG, 0
+OP300, 300
+OM300, -300
+ONEWN, ONEWIN
+ *600
+TWOUP, TAD TWOFLG
+ SNA
+ JMP TWOOK
+ IAC
+ SNA
+ TAD TWOFIN
+ DCA TWOFLG
+ JMP I IONEST
+TWOOK, TAD TWOOUT
+ SZA CLA
+ JMP TWOFIG
+ TAD ONEFIN
+ SZA CLA
+ JMS I TWOWN
+ TAD INTWRD
+ AND OP14
+ TAD OM14
+ SNA CLA
+ JMP I HYPER
+
+TWOLEF, TAD INTWRD
+ AND P10
+ SNA CLA
+ JMP TWORYT
+ CLA CLL CMA
+ JMP TWOFIG
+TWORYT, CLA CLL IAC RTL
+ AND INTWRD
+ SZA CLA
+ IAC
+TWOFIG, TAD TWOTHE
+ JMS I THEADJ
+ DCA TWOTHE
+ TAD TWOTHE
+ JMS I SINE
+ DCA TWOSIN
+ TAD TWOTHE
+ JMS I COSINE
+ DCA TWOCOS
+ TAD TWOOUT
+ SZA CLA
+ JMP TWOVEL
+TWOMOV, TAD ACCFLG
+ SZA CLA
+ JMP TWOVEL
+ CLL IAC RAL
+ AND INTWRD
+ SNA CLA
+ JMP TWOVEL
+ TAD TWOSIN
+ TAD TWOVEX
+ JMS I VEESCL
+ DCA TWOVEX
+ TAD TWOCOS
+ TAD TWOVEY
+ JMS I VEESCL
+ DCA TWOVEY
+TWOVEL, TAD TWOVEX
+ JMS I ISHFT /COMPONENTS
+ JMS I ISHFT
+ TAD TWOPEX
+ DCA TWOPEX
+ TAD TWOVEY
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD TWOPEY
+ DCA TWOPEY
+ TAD TWOOUT
+ SZA CLA
+ JMP I IONEST
+TWOLNC, TAD LNC2FG
+ SNA CLA
+ JMP .+3
+ ISZ LNC2FG
+ JMP I IONEST
+ IAC
+ AND INTWRD
+ SNA CLA
+ JMP I IONEST
+ TAD PROLIF
+ DCA I AUTO16
+ TAD TWOVEX
+ JMS I ISHFT
+ JMS I RSHIFT
+ TAD TWOSIN
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD TWOSIN
+ CLL RTL
+ TAD TWOPEX
+ DCA I AUTO16
+ TAD TWOVEY
+ JMS I ISHFT
+ JMS I RSHIFT
+ TAD TWOCOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD TWOCOS
+ CLL RTL
+ TAD TWOPEY
+ DCA I AUTO16
+ TAD M200
+ DCA LNC2FG
+ JMS I RESET1
+ JMP I .+1
+IONEST, ONESET
+LNC2FG, 0
+OP14, 14
+OM14, -14
+TWOWN, TWOWIN
+ *1000
+ONESET, CLA CLL
+ TAD ONEFLG
+ SZA CLA
+ JMP I ITWOST
+ TAD ONESIN
+ DCA CALSIN
+ TAD ONECOS
+ DCA CALCOS
+ JMS I CALPOS
+ TAD ONEFIL
+ DCA AUTO10
+ TAD ONEPEX
+ TAD T30SIN
+ DCA I AUTO10
+ TAD ONEPEY
+ TAD T30COS
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T10SIN
+ TAD ONEPEY
+ DCA I AUTO10
+ TAD T30SIN
+ TAD T30COS
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T30COS
+ CIA
+ TAD T30SIN
+ TAD ONEPEY
+ DCA I AUTO10
+ TAD T10SIN
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+FLAM1, TAD INTWRD
+ AND P40
+ SNA CLA
+ JMP ONECON
+ TAD ONEOUT
+ SZA CLA
+ JMP ONECON
+ TAD ONFG1
+ SNA
+ CLA CLL CMA RAL
+ DCA ONFG1
+ ISZ ONFG1
+ JMP ONECON
+ TAD ONFG2
+ CMA
+ DCA ONFG2
+ TAD ONFG2
+ SNA CLA
+ TAD T10SIN
+ TAD T30SIN
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD ONFG2
+ SNA CLA
+ TAD T10COS
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ TAD T10SIN
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ CLA CLL CMA RAL
+ONECON, TAD M6
+ DCA ONECNT
+ TAD T30SIN
+ CIA
+ TAD T30COS
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T30SIN
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ TAD T10COS
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T10SIN
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ TAD T30SIN
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD ONEPEY
+ DCA I AUTO10
+ JMP I ITWOST
+ITWOST, TWOSET
+ONFG1, 0
+ONFG2, 0
+ *1200
+TWOSET, CLA CLL
+ TAD TWOFLG
+ SZA CLA
+ JMP I IFILDS
+ TAD TWOSIN
+ DCA CALSIN
+ TAD TWOCOS
+ DCA CALCOS
+ JMS I CALPOS
+ TAD TWOFIL
+ DCA AUTO10
+ TAD T30SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD T20COS
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20COS
+ TAD T30SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+FLAM2, CLA CLL IAC RAL
+ AND INTWRD
+ SNA CLA
+ JMP TWOCON
+ TAD TWOOUT
+ SZA CLA
+ JMP TWOCON
+ TAD TWFG1
+ SNA
+ CLA CLL CMA RAL
+ DCA TWFG1
+ ISZ TWFG1
+ JMP TWOCON
+ TAD TWFG2
+ CMA
+ DCA TWFG2
+
+ TAD TWFG2
+ SNA CLA
+ TAD T20SIN
+ TAD T30SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD TWFG2
+ SNA CLA
+ TAD T20COS
+ TAD T30COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+ CLA CLL CMA RAL
+TWOCON, TAD M10
+ DCA TWOCNT
+ TAD T30SIN
+ CIA
+ TAD T20COS
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20COS
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T20COS
+ TAD T20SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD T20COS
+ TAD TWOPEY
+ DCA I AUTO10
+ TAD T30SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD TWOPEY
+ DCA I AUTO10
+ JMP I IFILDS
+IFILDS, FILDIS
+TWFG1, 0
+TWFG2, 0
+ *1400
+FILDIS, CLA CLL
+ JMS I COLIDE
+/ DSB 1
+ TAD ONEFLG
+ SZA CLA
+ JMP TWODIS
+ TAD ONEFIL
+ DCA AUTO10
+ TAD ONECNT
+ DCA AUTO11
+ TAD I AUTO10
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD ONEOUT
+ SZA CLA
+ JMP I IONEEX
+FILONE, TAD I AUTO10
+ DCA XTWODS
+ TAD I AUTO10
+ DCA YTWODS
+ JMS I VECTOR
+ ISZ AUTO11
+ SKP
+ JMP TWODIS
+ TAD XTWODS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP FILONE
+TWODIS, TAD TWOFLG
+ SZA CLA
+ JMP I IPRODS
+ TAD TWOFIL
+ DCA AUTO10
+ TAD TWOCNT
+ DCA AUTO11
+ TAD I AUTO10
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD TWOOUT
+ SZA CLA
+ JMP I ITWOEX
+TWDLOP, TAD I AUTO10
+ DCA XTWODS
+ TAD I AUTO10
+ DCA YTWODS
+ JMS I VECTOR
+ ISZ AUTO11
+ JMP .+3
+ JMP I .+1
+IPRODS, PRODIS
+ TAD XTWODS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP TWDLOP
+COLIDE, COLLID
+IONEEX, ONEEXP
+ITWOEX, TWOEXP
+DISPLY, 0
+ CLA
+ TAD XONEDS
+ CIA
+ TAD XTWODS
+ JMS DISHFT
+ DCA DIXTEM
+ TAD YONEDS
+ CIA
+ TAD YTWODS
+ JMS DISHFT
+ DCA DIYTEM
+ TAD M4
+ DCA DISCNT
+DISLOP, TAD XONEDS
+ TAD DIXTEM
+ DCA XONEDS
+ TAD YONEDS
+ TAD DIYTEM
+ DCA YONEDS
+ TAD XONEDS
+/ RTR
+ DXC DXL
+ CLA
+ TAD YONEDS
+ DYC DYL DIS
+ CLA
+ ISZ DISCNT
+ JMP DISLOP
+ JMP I DISPLY
+DISHFT, 0
+ CLL
+ SPA
+ CML IAC
+ RAR
+ CLL
+ SPA
+ CML IAC
+ RAR
+ JMP I DISHFT
+ *1600
+PRODIS, CLA CLL
+ TAD BUFST
+ DCA BUFTMP
+/ DSB 2
+PROLOP, TAD I BUFTMP
+ SNA
+ JMP EXPIRE
+ IAC
+ DCA I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROX
+ ISZ BUFTMP
+ TAD I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROY
+ TAD PROX
+/ RTR
+/ RAR
+ DXC DXL
+ CLA
+ TAD PROY
+/ RTR
+ DYC DYL DIS
+ CLA
+ JMS I CHKOUT
+ ISZ BUFTMP
+ TAD BUFTMP
+ TAD BUFLIM
+ SZA CLA
+ JMP PROLOP
+/ BEGIN. TURNS OUT THAT ROUGHLY 2
+FINISH, TAD GAMOVR
+ SZA CLA
+ JMP I ENDGAM
+/ TAD M400
+ CLA CLL
+ TAD INTCNT
+ CIA
+ JMP .
+ENDGAM, JOBLOP
+EXPIRE, TAD BUFTMP
+ TAD P5
+ DCA BUFTMP
+ TAD BUFTMP
+ TAD BUFLIM
+ SZA CLA
+ JMP PROLOP
+ JMP FINISH
+BUFST, DISBUF+101
+BUFLIM, -DISBUF-175
+CHKOUT, CHECK
+RESE1, 0
+ TAD MRES
+ DCA RESCNT
+RESLOP, TAD RESPNT
+ TAD P5
+ DCA RESPNT
+ TAD RESPNT
+ TAD BUFLIM
+ SZA CLA
+ JMP RESCON
+ TAD BUFST
+ DCA RESPNT
+RESCON, TAD I RESPNT
+ SNA CLA
+ JMP RESFND
+ ISZ RESCNT
+ JMP RESLOP
+ HLT
+RESFND, CMA
+ TAD RESPNT
+ DCA AUTO16
+ JMP I RESE1
+MRES, -14
+RESCNT, 0
+RESPNT, 0
+SETBUF, 0
+ CMA
+ TAD BUFST
+ DCA AUTO16
+ TAD BUFST
+ DCA BUFTMP
+ TAD BUFST
+ DCA RESPNT
+ TAD BUFST
+ DCA SETPNT
+SETLOP, DCA I SETPNT
+ ISZ SETPNT
+ TAD SETPNT
+ TAD BUFLIM
+ SZA CLA
+ JMP SETLOP
+ JMP I SETBUF
+SETPNT, 0
+ *2000
+CHECK, 0
+ TAD ONEFLG
+ SZA CLA
+ JMP CHECK2
+ TAD ONEOUT
+ SZA CLA
+ JMP CHECK2
+ TAD PROX
+ CIA
+ TAD ONEPEX
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP CHECK2
+ TAD PROY
+ CIA
+ TAD ONEPEY
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP CHECK2
+ TAD MEXP
+ DCA ONEOUT
+ JMS CUTOUT
+CHECK2, TAD TWOFLG
+ SZA CLA
+ JMP I CHECK
+ TAD TWOOUT
+ SZA CLA
+ JMP I CHECK
+ TAD PROX
+ CIA
+ TAD TWOPEX
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP I CHECK
+ TAD PROY
+ CIA
+ TAD TWOPEY
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP I CHECK
+ TAD MEXP
+ DCA TWOOUT
+ JMS CUTOUT
+ JMP I CHECK
+LIMIT, -120
+CUTOUT, 0
+ TAD M4
+ TAD BUFTMP
+ DCA CUTPNT
+ DCA I CUTPNT
+ JMP I CUTOUT
+CUTPNT, 0
+COLLID, 0
+ TAD ONEFLG
+ SZA CLA
+ JMP I COLLID
+ TAD TWOFLG
+ SZA CLA
+ JMP I COLLID
+ TAD ONEOUT
+ SZA CLA
+ JMP I COLLID
+ TAD TWOOUT
+ SZA CLA
+ JMP I COLLID
+ TAD ONEPEX
+ CIA
+ TAD TWOPEX
+ SPA
+ CIA
+ TAD COLLIM
+ SMA CLA
+ JMP I COLLID
+ TAD ONEPEY
+ CIA
+ TAD TWOPEY
+ SPA
+ CIA
+ TAD COLLIM
+ SMA CLA
+ JMP I COLLID
+ TAD MEXP
+ DCA ONEOUT
+ TAD MEXP
+ DCA TWOOUT
+ JMP I COLLID
+COLLIM, -300
+ *2200
+HYPSET, DCA RTNFLG
+ TAD RTNFLG
+ SZA CLA
+ TAD ONEDIF
+ TAD TWOLST
+ DCA AUTO15
+ CLCA
+
+ DCA AUTO17
+ TAD I AUTO17
+ AND TIMOUT
+ CIA
+ DCA I AUTO15
+ TAD I AUTO17
+ JMS I THEADJ
+ DCA I AUTO15
+ TAD I AUTO17
+ JMS VEESET
+ DCA I AUTO15
+ TAD I AUTO17
+ JMS VEESET
+ DCA I AUTO15
+ TAD I AUTO17
+ DCA I AUTO15
+ TAD I AUTO17
+ DCA I AUTO15
+ TAD I AUTO17
+ AND TIMOUT
+ TAD MHYP /ABOUT 3
+ SMA CLA
+ JMP HYPRET
+ TAD RTNFLG
+ SZA CLA
+ TAD ONEDIF
+ TAD OUTLOC
+ DCA VEESET
+ TAD MEXP
+ DCA I VEESET
+HYPRET, ISZ RTNFLG
+ JMP I TWORTN
+ JMP I ONERTN
+TIMOUT, 777
+ONEDIF, ONEFLG-TWOFLG
+TWOLST, TWOFLG-1
+RTNFLG, 0
+ONERTN, TWOUP
+TWORTN, ONESET
+OUTLOC, TWOOUT
+MHYP, -200
+VEESET, 0
+ CLL
+ SPA
+ CML
+ AND HM177
+ SZL CLL
+ CIA
+ JMP I VEESET
+HM177, 177
+ONEEXP, CLA CLL
+ TAD ONETHE
+ TAD INCONE
+ DCA ONETHE
+ JMS I IXPDIS
+ ISZ ONEOUT
+ JMP I NOWTWO
+ IAC
+ DCA ONEFLG
+ IAC
+ DCA ONEFIN
+ TAD TWOFIN
+ SNA CLA
+ JMP I NOWTWO
+ JMP I TIEUP
+TWOEXP, CLA CLL
+ TAD TWOTHE
+ TAD INCTWO
+ DCA TWOTHE
+ JMS I IXPDIS
+ ISZ TWOOUT
+ JMP I NOWPRO
+ IAC
+ DCA TWOFLG
+ IAC
+ DCA TWOFIN
+
+ TAD ONEFIN
+ SZA CLA
+ JMP I TIEUP
+ JMP I NOWPRO
+NOWTWO, TWODIS
+NOWPRO, PRODIS
+TIEUP, NOWIN
+IXPDIS, EXPDIS
+INCONE, 55
+INCTWO, 55
+ *2400
+EXPDIS, 0
+ TAD I AUTO10
+ DCA XTWODS
+ TAD I AUTO10
+ DCA YTWODS
+ TAD XTWODS
+ CIA
+ TAD XONEDS
+ DCA DIXTEM
+ TAD YTWODS
+ CIA
+ TAD YONEDS
+ DCA DIYTEM
+ TAD M4
+ DCA DISCNT
+
+EXPLOP, TAD XONEDS
+ TAD DIXTEM
+ DCA XONEDS
+ TAD YONEDS
+ TAD DIYTEM
+ DCA YONEDS
+ TAD XONEDS
+/ RTR
+/ RAR
+ JMS I IVCLDX
+ CLA
+ TAD YONEDS
+ JMS I IVCLDY
+ CLA
+ ISZ DISCNT
+ JMP EXPLOP
+ ISZ AUTO11
+ SKP
+ JMP I EXPDIS
+ TAD XTWODS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP EXPDIS+1
+VEELIM, 0
+ DCA VEEHLD
+ TAD VEEHLD
+ SMA
+ JMP VEEPOS
+ TAD VEEMAX
+ SMA CLA
+ JMP VEECLR
+ TAD VEEMIN
+ JMP I VEELIM
+VEEPOS, TAD VEEMIN
+ SPA CLA
+ JMP VEECLR
+ TAD VEEMAX
+ JMP I VEELIM
+VEECLR, TAD VEEHLD
+ JMP I VEELIM
+VEEHLD, 0
+VEEMIN, -140
+VEEMAX, 140
+THEAJI, 0
+ SMA
+ JMP .+3
+ TAD P550
+ JMP .-3
+ TAD M550
+ SMA
+ JMP .-2
+ TAD P550
+ JMP I THEAJI
+ONEWIN, 0
+ TAD MES1
+ DCA MESS
+ IAC
+ DCA GAMOVR
+ JMP I ONEWIN
+TWOWIN, 0
+ TAD MES2
+ DCA MESS
+ IAC
+ DCA GAMOVR
+ JMP I TWOWIN
+NOWIN, TAD MES4
+ DCA MESS
+ IAC
+ DCA GAMOVR
+
+JOBLOP,
+/ DSB 1
+ TAD MES0
+ JMS I MESOUT
+ TAD MESS
+ JMS I MESOUT
+ TAD MES5
+ JMS I MESOUT
+ TAD MES3
+ JMS I MESOUT
+FINITO, JMP JOBLOP
+MES0, MESS0
+MES1, MESS1
+MES2, MESS2
+MES3, MESS3
+MES4, MESS4
+MES5, MESS5
+MESS, 0
+ *6400
+SINEIN, 0
+ DCA SINARG
+ TAD SINEIN
+ DCA I SINPSH
+ ISZ SINPSH
+ TAD SINARG
+ SZA
+ JMP SINNG2
+SINPOP, CLA CLL CMA
+ TAD SINPSH
+ DCA SINPSH
+ TAD I SINPSH
+ DCA SINEIN
+ TAD SINARG
+ JMP I SINEIN
+SINNG2, SMA
+ JMP SINPOS
+ CIA
+ JMS SINEIN
+SINNEG, CIA
+ DCA SINARG
+ JMP SINPOP
+SINPOS, TAD M264
+ SPA
+ JMP .+2
+ JMP SINNEG-1
+ TAD P132
+ SPA
+ JMP SINELK
+ SZA CLA
+ JMP .+3
+ TAD P37
+ JMP SINNEG+1
+ TAD SINARG
+ TAD M264
+ JMP SINNEG-1
+SINELK, TAD P132
+ TAD SINTAB
+ DCA SINEIN
+ TAD I SINEIN
+ DCA SINARG
+ JMP SINPOP
+SINARG, 0
+SINPSH, SINLST
+SINLST, 0
+ 0
+ 0
+ 0
+ 0
+ 0
+SINTAB, SINES-1
+COSINI, 0
+ CIA
+ TAD P132
+ JMS SINEIN
+ JMP I COSINI
+SINES, 00
+ 01
+ 01
+ 02
+ 02
+ 03
+ 03
+ 04
+ 05
+ 05
+ 06
+ 06
+ 07
+ 07
+ 10
+ 10
+ 11
+ 11
+ 12
+ 12
+ 13
+ 13
+ 14
+ 15
+ 15
+ 16
+ 16
+ 17
+ 17
+ 20
+ 20
+ 20
+ 21
+ 21
+ 22
+ 22
+ 23
+ 23
+ 24
+ 24
+ 25
+ 25
+ 25
+ 26
+ 26
+ 27
+ 27
+ 27
+ 30
+ 30
+ 30
+ 31
+ 31
+ 31
+ 32
+ 32
+ 32
+ 33
+ 33
+ 33
+ 33
+ 34
+ 34
+ 34
+ 35
+ 35
+ 35
+ 35
+ 35
+ 36
+ 36
+ 36
+ 36
+ 36
+ 36
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+ 37
+MULTI, 0
+ CLL
+ SPA
+ CMA CML IAC
+ DCA MULMP1
+ DCA MULMP5
+ TAD I MULTI
+ SNA
+ JMP MULPSN+2
+ SPA
+ CMA CML IAC
+ DCA MULMP2
+ TAD MULTHR
+ DCA MULMP3
+MULMP4, TAD MULMP1
+ RAR
+ DCA MULMP1
+ TAD MULMP5
+ SZL
+ TAD MULMP2
+ CLL RAR
+ DCA MULMP5
+ ISZ MULMP3
+ JMP MULMP4
+ TAD MULMP1
+ RAR
+MULPSN, SZL
+ JMP MULCMP
+ DCA MULMP1
+ TAD MULMP5
+MULMPZ, ISZ MULTI
+ JMP I MULTI
+MULCMP, CMA CLL IAC
+ DCA MULMP1
+ TAD MULMP5
+ CMA
+ SZL
+ IAC
+ JMP MULMPZ
+MULTHR, 7764
+MULMP1, 0
+MULMP5, 0
+MULMP2, 0
+MULMP3, 0
+SHIFTR, 0
+ CLL
+ SPA
+ CML IAC
+ RAR
+ JMP I SHIFTR
+POSCAL, 0
+ TAD CALSIN
+ DCA T10SIN
+ TAD T10SIN
+ CLL RAL
+ DCA T20SIN
+ TAD T10SIN
+ TAD T20SIN
+ DCA T30SIN
+ TAD CALCOS
+ DCA T10COS
+ TAD T10COS
+ CLL RAL
+ DCA T20COS
+ TAD T10COS
+ TAD T20COS
+ DCA T30COS
+ JMP I POSCAL
+VDIV, 0
+ SMA
+ JMP VPLUS
+VMINUS, CMA IAC
+ RTR
+ AND P1777
+ CMA IAC
+ JMP I VDIV
+VPLUS, RTR
+ AND P1777
+ JMP I VDIV
+VCLDX, 0
+ JMS VDIV
+ DISD
+ JMP .-1
+ DIXY
+ DILX
+ JMP I VCLDX
+VCLDY, 0
+ JMS VDIV
+ DILY
+ JMP I VCLDY
+P1777, 1777
+ *7000
+CHARS, 0
+ DCA ADDR
+ TAD I ADDR
+ RTR
+ RTR
+ RTR
+ JMS CHAR
+ SKP
+ JMP I CHARS
+ TAD I ADDR
+ ISZ ADDR
+ JMS CHAR
+ JMP CHARS+2
+ JMP I CHARS
+CHAR, 0
+ AND K77
+ CLL RAL
+ TAD TABLE
+ DCA POINT
+ CMA
+ DCA COUNT2
+ TAD I POINT
+ ISZ POINT
+ SNA
+ JMP SPCHAR
+ DCA CURPLT
+XPLOT, TAD KM6
+ DCA COUNT6
+ TAD YVALUE
+ DCA YTEMP
+ TAD XVALUE
+ DILX
+ TAD XINCR
+ DCA XVALUE
+YPLOT, TAD CURPLT
+ CLL RAL
+ DCA CURPLT
+ SNL
+ JMP CNTINU
+ TAD YTEMP
+ DILY
+ DISD
+ JMP .-1
+ DIXY
+ CLA CLL
+ TAD CURPLT
+ SNA CLA
+ JMP WRDEND
+CNTINU, TAD YTEMP
+ TAD YINCR
+ DCA YTEMP
+ ISZ COUNT6
+ JMP YPLOT
+ JMP XPLOT
+WRDEND, ISZ COUNT2
+ JMP EXIT
+ TAD I POINT
+ SZA
+ JMP XPLOT-1
+EXIT, TAD XVALUE
+ TAD XINCR
+ DCA XVALUE
+ JMP I CHAR
+SPCHAR, TAD I POINT
+ DCA POINT
+ JMP I POINT
+SPACE, TAD XINCR
+ CLL RTL
+ JMP EXIT
+CRLF, TAD INITX
+ DCA XVALUE
+LF, TAD YINCR
+ CLL RTL
+ CLL CIA RAL
+ TAD YVALUE
+ DCA YVALUE
+ JMP I CHAR
+RESET, TAD INITX
+ DCA XVALUE
+ TAD INITY
+ JMP RESET-2
+TERM, ISZ CHAR
+ JMP I CHAR
+INITX, 0
+INITY, 327
+XVALUE, 0
+YVALUE, 0
+XINCR, 6
+YINCR, 10
+YTEMP, 0
+CURPLT, 0
+ADDR, 0
+COUNT6, 0
+COUNT2, 0
+KM6, -6
+K77, 77
+POINT, 0
+TABLE, .+1
+ 0
+ TERM
+ 7611
+ 1176
+ 7745
+ 4532
+ 3641
+ 4122
+ 7741
+ 4136
+ 7745
+ 4541
+ 7705
+ 501
+ 7741
+ 5173
+ 7710
+ 1077
+ 4177
+ 4100
+ 2040
+ 4037
+ 7714
+ 2241
+ 7740
+ 4040
+ 7702
+ 277
+ 7706
+ 3077
+ 7741
+ 4177
+ 7705
+ 502
+ 3641
+ 6176
+ 7715
+ 2542
+ 2245
+ 5122
+ 177
+ 100
+ 3740
+ 4037
+ 1720
+ 4037
+ 7730
+ 3077
+ 4136
+ 3641
+ 374
+ 7403
+ 6151
+ 4543
+ 7741
+ 0
+ 204
+ 1020
+ 4177
+ 0
+ 436
+ 400
+ 0
+ RESET
+ 0
+ SPACE
+ 5600
+ 0
+ 303
+ 0
+ 1477
+ 7714
+ 2277
+ 2200
+ 2313
+ 6462
+ 7777
+ 7777
+ 300
+ 0
+ 3641
+ 0
+ 4136
+ 0
+ 4040
+ 4040
+ 1034
+ 1000
+ 0
+ LF
+ 1010
+ 1000
+ 4000
+ 0
+ 2010 /
+ 402
+ 3641
+ 4136
+ 4442
+ 7740
+ 4261
+ 5146
+ 2145
+ 5321
+ 1710
+ 1077
+ 4745
+ 4531
+ 7750
+ 5070
+ 6111
+ 503
+ 2255
+ 5522
+ 705
+ 577
+ 2400
+ 0
+ 0
+ CRLF
+ 1024
+ 4200
+ 1212
+ 1200
+ 4224
+ 1000
+ 255
+ 300
+MESS0, 3773
+MESS5, 7340
+ 4040
+ 4040
+ 4000
+MESS1, 1716
+ 0500
+MESS2, 2427
+ 1700
+MESS3, 2711
+ 1623
+ 4100
+MESS4, 1617
+ 0217
+ 0431
+ 0000
+ *7400
+DISBUF, 0
+ $
+///////////////////////////
+//////////////////////////
--- /dev/null
+/ SPACE WAR
+/
+/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR
+/ LAB-8
+/
+/ EVAN SUITS
+/
+/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE
+/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE
+/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND
+/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 *
+/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED.
+/
+/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD
+/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP
+/ 'TWO' ON THE RIGHT.
+/
+/ THE COMMAND WORD BIT ASSIGNMENTS ARE:
+/
+/ SR BIT: C: FUNCTION:
+/
+/ 0 0 SHIP ONE ROTATES LEFT
+/
+/ 1 1 SHIP ONE ROTATES RIGHT
+/
+/ 2 2 SHIP ONE ACCELERATES
+/
+/ 3 3 SHIP ONE FIRES
+/
+/
+/
+/ 8 4 SHIP TWO ROTATES LEFT
+/
+/ 9 5 SHIP TWO ROTATES RIGHT
+/
+/ 10 6 SHIP TWO ACCELERATES
+/
+/ 11 7 SHIP TWO FIRES
+/
+/
+/
+/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS
+/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS
+/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER
+/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE
+/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER
+/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART.
+/
+
+\f
+
+/ SYMBOL DEFINITIONS FOR PAL8-PAL10
+
+ZTEN=6342
+OTEN=6344
+
+XRIN=6331
+XRCL=6334
+
+SKXK=6321
+CLXK=6352
+
+DSB=6324
+
+DXC=6301
+DYC=6311
+DXL=6302
+DYL=6312
+DIS=6304
+
+CRF=6072
+CCF=6052
+
+\f/
+/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR
+/ REAL WORLD TIMING PURPOSES.
+/
+
+ *0
+
+ 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT
+ JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE
+ INTSER
+
+EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR
+ODT1, 0 /DEBUGGERS, ETC.
+ODT2, 0
+ODT3, 0
+
+/
+/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF
+/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT
+/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF
+/ THE CODE.
+/
+
+ *10
+
+AUTO10, 0
+AUTO11, 0
+AUTO12, 0
+AUTO13, 0
+AUTO14, 0
+AUTO15, 0
+AUTO16, 0
+AUTO17, 0
+
+/
+/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS
+/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS
+/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED
+/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED
+/
+
+ *20
+
+ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION
+ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED
+ONEFLG, 0 /IN OR OUT OF NORMAL SPACE
+ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN
+ONEVEX, 0 /X COMPONENT OF VELOCITY
+ONEVEY, 0 /Y COMPONENT OF VELOCITY
+ONEPEX, 0 /X POSITION (12 BITS)
+ONEPEY, 0 /Y POSITION (12 BITS)
+ONESIN, 0 /SINE OF ANGLE
+ONECOS, 0 /COSINE OF ANGLE
+ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT
+
+TWOOUT, 0 /SAME CONTENT AND ORDER
+TWOCNT, 0 /AS ABOVE
+TWOFLG, 0
+TWOTHE, 0
+TWOVEX, 0
+TWOVEY, 0
+TWOPEX, 0
+TWOPEY, 0
+TWOSIN, 0
+TWOCOS, 0
+TWOFIN, 0
+
+
+/
+/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN
+/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN
+/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM
+/
+
+XONEDS, 0
+YONEDS, 0
+XTWODS, 0
+YTWODS, 0
+DIXTEM, 0
+DIYTEM, 0
+DISCNT, 0
+
+
+/
+/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST
+/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES.
+/
+T10SIN, 0
+T20SIN, 0
+T30SIN, 0
+T10COS, 0
+T20COS, 0
+T30COS, 0
+
+CALSIN, 0
+CALCOS, 0
+
+\f
+/
+/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON
+/ PAGE ZERO
+/
+
+SINE, SINEIN
+COSINE, COSINI
+MULT, MULTI
+RSHIFT, SHIFTR
+VECTOR, DISPLY
+CALPOS, POSCAL
+INTWRD, 0
+INTCNT, 0
+CLOCK, 0
+HYPER, HYPSET
+MESOUT, CHARS
+THEADJ, THEAJI
+VEESCL, VEELIM
+ISHFT, DISHFT
+RESET1, RESE1
+GAMOVR, 0
+ACCFLG, 0
+ACCPER, -30
+MEXP, -400
+
+PROX, 0
+PROY, 0
+PROLIF, -360
+BUFTMP, 0
+ONEFIL, DISBUF
+TWOFIL, DISBUF+40
+
+P5, 5
+P10, 10
+P17, 17
+P20, 20
+P37, 37
+P40, 40
+P100, 100
+P132, 132
+P200, 200
+P400, 400
+P550, 550
+P3777, 3777
+
+M4, -4
+M6, -6
+M10, -10
+M11, -11
+M264, -264
+M200, -200
+M400, -400
+M550, -550
+
+\f
+/
+/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200.
+/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED,
+/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES
+/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR
+/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT
+/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08
+/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY
+/ FILE UPDATE TO START OFF THE GAME.
+/
+
+ *200
+
+START, CLA CLL /START OR RESTART HERE ANY OLD TIME
+ LAS /SR
+ SNA CLA
+ TAD SWRD /USE THE SR
+ TAD XROPT /USE THE BLUE RIBBON CONNECTOR
+ DCA COLDST /AND LEAVE IN THE TRAP LOCATION
+
+RESTRT, CLA CMA
+ XRCL
+ CLA CLL
+
+ TAD P17 /FIRST CLEAR THE POSITION AND DATA
+ DCA AUTO10 /TABLES OF THE TWO SHIPS
+ TAD TABLEN
+ DCA AUTO11
+ DCA I AUTO10
+ ISZ AUTO11
+ JMP .-2
+
+ TAD STRT1 /SET THE STARTING POSITIONS OF THE
+ DCA ONEPEX /TWO SHIPS
+ TAD STRT2
+ DCA TWOPEX
+ TAD P37 /SET TRIG FUNCTIONS JUST IN CASE
+ DCA ONECOS
+ TAD P37
+ DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP
+ TAD ACCPER /SET COUNT FOR VELOCITY INCREASE
+ DCA ACCFLG
+ DCA ONEFIN /CLEAR ALL GAME END FLAGS
+ DCA TWOFIN
+ DCA GAMOVR
+ JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS
+ TAD P400 /START UP THE CRYSTAL CLOCK IN THE AX08
+ ZTEN
+ OTEN
+ TCF /CLEAR OTHER REMAINING LIKELY FLAGS
+ PCF
+ RRB
+ CRF
+ CCF
+ CLA
+ JMP COLDST /AND GO TO IT
+
+\f
+/
+/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE
+/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE
+/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT
+/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER
+/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN.
+/
+
+UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW.
+ /START NEXT SWEEP
+COLDST, 0 /TRAP TO READ SR OR BRC
+ LAS /HERE FOR SR
+ DCA INTWRD /STORE TEMPORARILY
+ TAD INTWRD /MASK OUT LEFTMOST 4 BITS
+ RTR /FOR NUMBER ONE
+ RTR
+ AND LFTHAF
+ DCA INTTEM /AND STORE
+ TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO
+ AND RYTHAF
+ TAD INTTEM /ADD TOGETHER
+ JMP .+3 /AND CONTINUE
+
+CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR
+ XRCL
+ DCA INTWRD /CONTINUE
+ TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT
+ DCA INTCNT /UPDATE
+ ION /GET READY FOR THE NEXT CYCLE
+ TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME?
+ IAC /ONLY WHEN ACCFLG=0
+ SMA SZA
+ TAD ACCPER /IF ZERO, RESET COUNT
+ DCA ACCFLG
+
+ JMP I .+1 /NOW GET DOWN TO WORK.
+ ONEUP
+
+BUFSET, SETBUF
+TABLEN, AUTO17-CALCOS
+INTTEM, 0
+LFTHAF, 0360
+RYTHAF, 0017
+STRT1, 1000
+STRT2, -1000
+SWRD, 2000-CODST
+XROPT, JMP CODST
+
+\f
+/
+/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE
+/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE
+/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS
+/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO
+/ UPDATE WITH IOF.
+/
+/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS
+/ SET IN WHICH CASE THE GAME IS RESTARTED.
+/
+/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM
+/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE
+/ STRANGE FLAG
+/
+
+INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE
+ RAR /AC AND LINK
+ DCA INTLNK /FOR POSSIBLE CONTINUATION
+ SKXK /WAS IT THE CRYSTAL CLOCK?
+ JMP INTBUS /NO TRY SOMETHING ELSE
+ CLXK /YES CLEAR THE FLAG
+ ISZ CLOCK /AND BUMP CLOCK COUNTER
+ NOP /IGNORE OVERFLOW
+ ISZ INTCNT /TIME FOR AN UPDATE?
+ JMP INTRET /NO, DISMISS THE INTERUPT
+ JMP UPDATE /YES, GO TO IT
+
+INTBUS, KSF /HERE ON NON-CLOCK INTERUPT
+ JMP .+5 /NOT THE KEYBOARD
+ KCC /CLEAR KEYBOARD FLAG
+ TAD GAMOVR /IS THE GAMEOVER
+ SZA CLA
+ JMP RESTRT /YES, RESTART
+ TCF /NO, HELL WITH IT
+ ISZ INTGLH /COUNT ONE BADDIE
+ SKP
+ HLT /HALT IF TOO MANY BADDIES
+
+INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT
+ TAD INTLNK
+ RAL
+ TAD INTACC
+ ION
+ JMP I 0
+
+INTACC, 0
+INTLNK, 0
+INTGLH, 0
+
+\f
+/
+/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP
+/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON
+/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS
+/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN,
+/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS
+/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS.
+/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR
+/ NUMBER TWO.
+/
+
+ *400
+
+ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP ONEOK /YES IT IS
+ IAC /NO, BUT IS IT JUST COMING OUT?
+ SNA
+ TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED
+ DCA ONEFLG /OTHERWISE JUST COUNT ONE
+ JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO
+
+ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING?
+ SZA CLA
+ JMP ONEFIG /IF YES, ALLOW NO CONTROLS
+ TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED?
+ SZA CLA
+ JMS I ONEWN /YES, SIGNAL VICTORY
+ TAD INTWRD /NOW BEGIN TEST OF REQUEST
+ AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE!
+ TAD OM300 /TEST BITS 4 AND 5
+ SZA CLA
+ JMP ONELEF /NOPE, CONTINUE
+ CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE
+ JMP I HYPER
+ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN?
+ AND P200 /TEST BIT 4
+ SNA CLA
+ JMP ONERYT /NO
+ CLA CLL CMA /YES DECREMENT ANGLE
+ JMP ONEFIG
+
+ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN
+ AND P100 /TEST BIT 5
+ SZA CLA
+ IAC /YES, INCREMENT ANGLE
+
+ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE)
+ JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS
+ DCA ONETHE /AND STORE
+ TAD ONETHE /FIND THEM TRIG FUNCTIONS
+ JMS I SINE /AND STORE ONCE AND FOR ALL
+ DCA ONESIN /IN THE APPROPRIATE PLACES
+ TAD ONETHE
+ JMS I COSINE
+ DCA ONECOS
+ TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING
+ SZA CLA
+ JMP ONEVEL
+
+\f
+
+ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE?
+ SZA CLA
+ JMP ONEVEL /NOPE
+ TAD INTWRD /YES, ANY REQUESTED?
+ AND P40 /TEST BIT 6
+ SNA CLA
+ JMP ONEVEL /NONE REQUESTED
+ TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING
+ TAD ONEVEY /ON ORIENTATION
+ JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM
+ DCA ONEVEY /AND STORE
+ TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT
+ TAD ONEVEX
+ JMS I VEESCL
+ DCA ONEVEX
+
+
+
+ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE
+ JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4
+ JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION
+ TAD ONEPEX
+ DCA ONEPEX /IGNORE ANY OVERFLOW
+ TAD ONEVEY /DO THE SAME FOR Y COORDINATE
+ JMS I ISHFT /AND VELOCITY COMPONENT
+ JMS I ISHFT
+ TAD ONEPEY
+ DCA ONEPEY
+ TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF
+ SZA CLA /EXPLODING
+ JMP I ITWOUP
+
+\f
+
+ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED
+ SNA CLA
+ JMP .+3
+ ISZ LNC1FG /NO, CONTINUE RELOADING
+ JMP I ITWOUP /AND EXIT
+ TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED?
+ AND P20 /TEST BIT7
+ SNA CLA
+ JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT
+ /.....I GUESS.....
+ TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH
+ DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE
+ TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE)
+ JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY
+ JMS I RSHIFT /COMPONENT OF PROJECTILE
+ TAD ONESIN
+ JMS I RSHIFT /AND STICK IT IN THE FILE
+ DCA I AUTO16
+ TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE
+ CLL RTL /SHIP OF ORIGIN
+ TAD ONEPEX
+ DCA I AUTO16 /AND STORE X POSITION
+ TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND
+ JMS I ISHFT /POSITION
+ JMS I RSHIFT
+ TAD ONECOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD ONECOS
+ CLL RTL
+ TAD ONEPEY
+ DCA I AUTO16
+ TAD M200 /START RELOAD CYCLE
+ DCA LNC1FG
+ JMS I RESET1 /RESET AUTO16 TO NEXT HOLE
+
+ JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO
+ITWOUP, TWOUP
+
+LNC1FG, 0 /PROJECTILE LAUNCH ENABLE
+
+OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5
+OM300, -300
+ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE
+
+\f
+/
+/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO.
+/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE.
+/
+
+ *600
+
+TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP TWOOK /YES, CONTINUE
+ IAC /NO, BUMP COUNT AND TEST FOR REENTRY
+ SNA
+ TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED
+ DCA TWOFLG /AND CONTINUE
+ JMP I IONEST
+
+TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE
+ SZA CLA /IS IT EXPLODING?
+ JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE
+ TAD ONEFIN /DID WE JUST WIN?
+ SZA CLA
+ JMS I TWOWN /YES ENABLE END OF GAME MESSAGE
+ TAD INTWRD /TEST FOR HYPERSPACE REQUEST
+ AND OP14
+ TAD OM14 /BITS 8 AND 9 MUST BE SET
+ SNA CLA
+ JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0
+ /FOR SHIP NUMBER 2
+TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8
+ AND P10
+ SNA CLA
+ JMP TWORYT /NOT SET
+ CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE
+ JMP TWOFIG /SKIP TEST FOR RIGHT TURN
+
+TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9
+ AND INTWRD
+ SZA CLA
+ IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE
+
+TWOFIG, TAD TWOTHE /UPDTAE TWOTHE
+ JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE
+ DCA TWOTHE /AND STORE
+ TAD TWOTHE
+ JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS
+ DCA TWOSIN /AND STORE IN DATA TABLE
+ TAD TWOTHE
+ JMS I COSINE
+ DCA TWOCOS
+ TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING
+ SZA CLA
+ JMP TWOVEL
+
+\f
+
+TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED
+ SZA CLA /DURING THIS UPDATE CYCLE
+ JMP TWOVEL /NOPE
+ CLL IAC RAL /YES, TEST FOR BIT 2 SET
+ AND INTWRD
+ SNA CLA
+ JMP TWOVEL /NOT SET
+
+ TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF
+ TAD TWOVEX /ANGLE OF ORIENTATION
+ JMS I VEESCL /AND SCALE TO NOT EXCEED MAX
+ DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE
+
+ TAD TWOCOS
+ TAD TWOVEY
+ JMS I VEESCL
+ DCA TWOVEY
+
+
+
+TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY
+ JMS I ISHFT /COMPONENTS/16
+ JMS I ISHFT
+ TAD TWOPEX
+ DCA TWOPEX
+ TAD TWOVEY
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD TWOPEY
+ DCA TWOPEY
+ TAD TWOOUT
+ SZA CLA
+ JMP I IONEST
+
+\f
+
+TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST
+ SNA CLA /TEST TO SEE IF RELOAD COMPLETE
+ JMP .+3
+ ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT
+ JMP I IONEST
+ IAC /YES, TEST TRIGGER BIT 11
+ AND INTWRD
+ SNA CLA
+ JMP I IONEST /NOT SET, HELL WITH IT
+
+ TAD PROLIF /OK, SET PROJECTILE LIFE
+ DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT
+ TAD TWOVEX /ADD SHIPS VELOCITY
+ JMS I ISHFT /(ADJUSTED)
+ JMS I RSHIFT
+ TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT
+ JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION
+ DCA I AUTO16
+ TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD
+ CLL RTL /OF THE SHIP
+ TAD TWOPEX /X COMPONENT
+ DCA I AUTO16
+ TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY
+ JMS I ISHFT /Y POSITION AND COSINE
+ JMS I RSHIFT
+ TAD TWOCOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD TWOCOS
+ CLL RTL
+ TAD TWOPEY
+ DCA I AUTO16
+ TAD M200
+ DCA LNC2FG /200 CYCLES OF RELOAD
+ JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE!
+
+ JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS
+IONEST, ONESET
+
+LNC2FG, 0 /RELOAD COUNT
+
+OP14, 14 /HYPERSPACE CODE
+OM14, -14
+TWOWN, TWOWIN
+
+\f
+/
+/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT
+/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL
+/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY
+/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE
+/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN
+/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE
+/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS
+/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE
+/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE:
+/
+/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE]
+/
+/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE]
+/
+/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE
+/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE
+/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL)
+/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE
+/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND
+/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES
+/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS
+/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE
+/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS.
+/
+/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7
+/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED.
+/
+/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED
+/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE.
+/
+
+
+ *1000
+
+ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE
+ TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE
+ SZA CLA
+ JMP I ITWOST
+ TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS
+ DCA CALSIN
+ TAD ONECOS
+ DCA CALCOS
+ JMS I CALPOS /CALL THE CALCULATOR
+
+/
+/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE
+/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES
+/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE
+/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED
+/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y
+/ DISPLACED BY X,Y OF THE SHIP ITSELF
+/
+
+ TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE
+ DCA AUTO10 /POINTER
+ TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS
+ TAD T30SIN
+ DCA I AUTO10 / 0,3 OR TOP CENTER
+ TAD ONEPEY
+ TAD T30COS
+ DCA I AUTO10
+
+ TAD T10COS
+ CIA /THE SECOND IS
+ TAD ONEPEX
+ DCA I AUTO10 / -1,0
+ TAD T10SIN /OR JUST LEFT OF DEAD CENTER
+ TAD ONEPEY /AND SO ON
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD T30COS /THE THIRD POINT IS
+ CIA
+ TAD ONEPEX / -3,-3
+ DCA I AUTO10
+ TAD T30COS /OR BOTTOM LEFT HAND CORNER
+ CIA
+ TAD T30SIN
+ TAD ONEPEY
+ DCA I AUTO10
+
+\f
+
+ TAD T10SIN
+ CIA /FOURTH POINT
+ TAD ONEPEX
+ DCA I AUTO10 / 0,-1
+ TAD T10COS
+ CIA /OR JUST BELOW CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE
+ AND P40 /FLAME WITH AN EXTRA POINT SOME
+ SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP
+ JMP ONECON /POWER NOT ON - CONTINUE
+ TAD ONEOUT /DO NOT ALLOW IF EXPLODING
+ SZA CLA
+ JMP ONECON
+
+ TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND
+ SNA /OFF TO MAKE IT FLICKER. DISPLAY THE
+ CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE
+ DCA ONFG1
+
+ ISZ ONFG1
+ JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP
+
+ TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME
+ CMA /WITH LONG SHORT LONG SHORT
+ DCA ONFG2
+
+ TAD ONFG2 /TIP OF FLAME AT EITHER
+ SNA CLA
+ TAD T10SIN / 0,-4 OR
+ TAD T30SIN / 0,-3
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD ONFG2
+ SNA CLA
+ TAD T10COS
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10SIN
+ CIA
+ TAD ONEPEX /RETURN DISPLAY TO 0,-1
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+\f
+
+ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8
+ DCA ONECNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT
+ CIA
+ TAD T30COS / AT 3,-3
+ TAD ONEPEX /
+ DCA I AUTO10 /OR LOWER RIGHT HAND CORNER
+ TAD T30SIN
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10COS /NEXT
+ TAD ONEPEX /
+ DCA I AUTO10 / 1,0
+ TAD T10SIN /
+ CIA / OR JUST RIGHT OF CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T30SIN /FINALLY BACK TO
+ TAD ONEPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD ONEPEY / TOP CENTE
+ DCA I AUTO10
+
+ JMP I ITWOST /NOW FOR NUMBER TWO
+ITWOST, TWOSET
+
+ONFG1, 0 /USED TO COUNT FLICKERS
+ONFG2, 0 /SHORT OR LONG FLAG
+
+\f
+/
+/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO.
+/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH
+/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS
+/
+
+ *1200
+
+TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE
+ TAD TWOFLG
+ SZA CLA
+ JMP I IFILDS
+ TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS
+ DCA CALSIN /CALCULATED
+ TAD TWOCOS
+ DCA CALCOS
+ JMS I CALPOS
+
+ TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY
+ DCA AUTO10 /FILE
+ TAD T30SIN /FIRST POINT AT
+ TAD TWOPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD TWOPEY / OR TOP CENTER
+ DCA I AUTO10
+
+ TAD T20COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD T20COS /SECOND POINT
+ TAD TWOPEY / -2,2
+ DCA I AUTO10
+
+ TAD T20COS /THIRD POINT
+ CIA / -2,0
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS
+ TAD T30SIN
+ CIA
+ TAD TWOPEX /FOURTH POINT
+ DCA I AUTO10 / -2,-3
+ TAD T30COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+\f
+
+ TAD T20SIN
+ CIA /NEXT
+ TAD TWOPEX / 0,-2
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON
+ AND INTWRD
+ SNA CLA
+ JMP TWOCON /NO, FORGET IT
+ TAD TWOOUT /NOT ALLOWED IF EXPLODING
+ SZA CLA
+ JMP TWOCON
+
+ TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1
+ SNA
+ CLA CLL CMA RAL
+ DCA TWFG1
+
+ ISZ TWFG1 /ALSO THE LENGHT VARIATION
+ JMP TWOCON
+
+ TAD TWFG2 /EVERY OTHER TIME LONG
+ CMA
+ DCA TWFG2
+ /FLAME TIP AT EITHER
+ TAD TWFG2 / 0,-3
+ SNA CLA /OR
+ TAD T20SIN / 0,-5
+ TAD T30SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD TWFG2
+ SNA CLA
+ TAD T20COS
+ TAD T30COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20SIN /NOW BACK UP TO THE SHIP
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+\f
+
+TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10
+ DCA TWOCNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE
+ CIA /NEXT POINT AT 2,-3
+ TAD T20COS
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS /NEXT POINT
+ TAD TWOPEX /
+ DCA I AUTO10 / 2,0
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20COS /AND THE NEXT AT
+ TAD T20SIN
+ TAD TWOPEX / 2,2
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD T20COS
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS /AND THE LAST AT
+ TAD TWOPEY /
+ DCA I AUTO10 / 0,3
+
+ JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS
+IFILDS, FILDIS
+
+TWFG1, 0 /FLIK THE FLAME
+TWFG2, 0 /LONG OR SHORT
+
+\f
+/
+/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION
+/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END
+/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS
+/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR
+/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES.
+/
+
+ *1400
+
+FILDIS, CLA CLL /ALL SET TO GO
+ JMS I COLIDE /TEST FOR COLLISION FIRST
+ DSB 1 /IF NO COLLISION
+ TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL
+ SZA CLA /SPACE
+ JMP TWODIS
+
+ TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE
+ DCA AUTO10 /FOR NUMBER ONE
+ TAD ONECNT /ALONG WITH VECTOR COUNT
+ DCA AUTO11
+ TAD I AUTO10 /SET OUT THE FIRST POINT PAIR
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION?
+ SZA CLA
+ JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION
+
+FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS
+ DCA XTWODS /SET X AND Y TO NEW POINT
+ TAD I AUTO10
+ DCA YTWODS
+ JMS I VECTOR /CALL THE DOT DRAWING MACHINE
+ ISZ AUTO11
+ SKP /COUNT
+ JMP TWODIS /DO NUMBER TWO ON OVERFLOW
+ TAD XTWODS /SWAP POINTS FOR NEXT PAIR
+ DCA XONEDS
+ TAD YTWODS /THE GENERATOR DRAWS FROM ONE
+ DCA YONEDS /TOWARDS TWO
+ JMP FILONE
+
+\f
+
+TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO
+ SZA CLA /BUT NOT IF IN HYPER SPACE
+ JMP I IPRODS
+
+ TAD TWOFIL /SET UP FILE POINTER AS IN ONE
+ DCA AUTO10
+ TAD TWOCNT /AND THE COUNT
+ DCA AUTO11
+ TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD TWOOUT /IS IT EXPLODING?
+ SZA CLA
+ JMP I ITWOEX /YES, HOW EXCITING
+
+TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF
+ DCA XTWODS /POINTS
+ TAD I AUTO10
+ DCA YTWODS /AND CALL THE VECTOR SEQUENCE
+ JMS I VECTOR
+ ISZ AUTO11
+ JMP .+3
+
+ JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO
+IPRODS, PRODIS /DO THE PROJECTILE THING
+
+ TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR
+ DCA XONEDS /OF POINTS
+ TAD YTWODS
+ DCA YONEDS
+ JMP TWDLOP
+
+COLIDE, COLLID
+IONEEX, ONEEXP
+ITWOEX, TWOEXP
+
+\f
+/
+/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A
+/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS.
+/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND
+/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT
+/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE.
+/
+
+
+DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR
+ TAD XONEDS /FROM XONEDS,YONEDS
+ CIA /TO XTWODS,YTWODS
+ TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO
+ JMS DISHFT /FOURTHS
+ DCA DIXTEM /AND STORE INCREMENT
+ TAD YONEDS
+ CIA
+ TAD YTWODS
+ JMS DISHFT
+ DCA DIYTEM
+ TAD M4 /FOR FOUR DOTS
+ DCA DISCNT
+
+DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y
+ TAD DIXTEM
+ DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS
+ TAD YONEDS /XONEDS AND YONEDS
+ TAD DIYTEM
+ DCA YONEDS
+ TAD XONEDS
+ RTR /DIVIDE BY 8 TO FIT SCREEN SIZE
+ RAR
+ DXC DXL /SET X VALUE
+ CLA
+ TAD YONEDS /DO THE SAME FOR Y
+ RTR
+ RAR
+ DYC DYL DIS /AT LAST SOMETHING TO SEE!!
+ CLA
+ ISZ DISCNT /DONE YET?
+ JMP DISLOP /NOPE
+ JMP I DISPLY /YUP
+
+
+DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED
+ CLL /FROM EVERYWHERE TO DIVIDE THE
+ SPA /AC BY FOUR WITH AN ASR RIGHT
+ CML IAC /NOTE THAT NEGATIVE NUMBERS ARE
+ RAR /ROUNDED UPWARDS (TOWARD ZERO)
+ CLL /TO MAKE IT COME OUT RIGHT
+ SPA
+ CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS
+ RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES
+ JMP I DISHFT
+
+\f
+/
+/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS.
+/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH
+/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS
+/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR
+/ A HIT.
+/
+
+ *1600
+
+PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES
+ TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE
+ DCA BUFTMP
+ DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS
+
+PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT
+ SNA
+ JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT
+ IAC /INCREMENT COUNT AND REPLACE
+ DCA I BUFTMP
+ ISZ BUFTMP /BUMP POINTER TO X VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION
+ TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST
+ ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP /SAME LITTLE GAME
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROY /STORE THE NEW Y VALUE
+
+ TAD PROX /DISPLAY THE POINT WITH
+ RTR /THE SAME SHIFT AS FOR THE SHIPS
+ RAR /FOR THE SMALL SCREEN
+ DXC DXL
+ CLA
+ TAD PROY
+ RTR /
+ RAR
+ DYC DYL DIS /THERE IT IS!!
+ CLA
+ JMS I CHKOUT /TEST FOR A HIT
+ ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END
+ TAD BUFTMP /OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP PROLOP /NOT AT END - CONTINUE
+
+\f/
+/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR
+/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP
+/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT
+/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE
+/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED
+/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING
+/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD
+/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT
+/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY.
+/
+
+
+FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT?
+ SZA CLA
+ JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE
+ TAD M400 /MOVE THE BEAM OFF SCREEN
+ DYC DYL
+ CLA CLL
+ DXC DXL
+ TAD INTCNT /PICK UP THE COUNT
+ CIA
+ JMP .
+
+ENDGAM, JOBLOP
+
+\f
+
+EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER
+ TAD P5 /POINTER TO THE NEXT PROJECTILE
+ DCA BUFTMP /UNLESS THE END
+ TAD BUFTMP /OF THE BUFFER
+ TAD BUFLIM /IS REACHED
+ SZA CLA /IN WHICH CASE
+ JMP PROLOP /IT
+ JMP FINISH /QUITS
+
+BUFST, DISBUF+101
+BUFLIM, -DISBUF-175
+CHKOUT, CHECK
+
+RESE1, 0 /THIS IS CALLED TO SET THE POINTER
+ TAD MRES /(AUTO16) TO THE NEXT FREE SLOT
+ DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE
+
+RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT
+ TAD P5
+ DCA RESPNT
+ TAD RESPNT /RESTE IF AT END OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP RESCON
+ TAD BUFST
+ DCA RESPNT
+
+RESCON, TAD I RESPNT /FIND A HOLE YET?
+ SNA CLA
+ JMP RESFND /YES, SET UP AUTO16
+ ISZ RESCNT /NO COUNT
+ JMP RESLOP /AND TRY AGAIN
+ HLT /NO HOLES AT ALL?
+
+RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING
+ TAD RESPNT
+ DCA AUTO16
+ JMP I RESE1
+
+MRES, -14
+RESCNT, 0
+RESPNT, 0
+
+SETBUF, 0
+ CMA /THIS ROUTINE IS CALLED FROM THE
+ TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL
+ DCA AUTO16 /THE BUFFER POINTERS AND SO ON
+ TAD BUFST
+ DCA BUFTMP
+ TAD BUFST
+ DCA RESPNT
+ TAD BUFST
+ DCA SETPNT
+SETLOP, DCA I SETPNT
+ ISZ SETPNT
+ TAD SETPNT
+ TAD BUFLIM
+ SZA CLA
+ JMP SETLOP
+ JMP I SETBUF
+
+SETPNT, 0
+
+\f
+/
+/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY
+/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN.
+/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE
+/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP
+/ IS SUITABLY FLAGGED
+/
+
+ *2000
+
+CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT
+ TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE
+ SZA CLA
+ JMP CHECK2
+ TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT
+ SZA CLA
+ JMP CHECK2
+
+ TAD PROX /CHECK X COORDINATES OF SHIP ONE
+ CIA /AND PROJECTILE
+ TAD ONEPEX /THIS SORT OF THING IS WHY THE
+ SPA /COORDINATES HAVE TO BE MAINTAINED TO 12
+ CIA /BITS
+ TAD LIMIT /CLOSE ENOUGH?
+ SMA CLA
+ JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT
+ TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y?
+ CIA
+ TAD ONEPEY
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP CHECK2 /NO HIT
+
+ TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT
+ DCA ONEOUT /ALL THAT IS NECESSARY
+ JMS CUTOUT /REMOVE PROJECTILE
+
+\f
+
+CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO
+ SZA CLA
+ JMP I CHECK /BUT NOT IF IN HYPERSPACE
+ TAD TWOOUT /OR IF ALREADY HIT
+ SZA CLA
+ JMP I CHECK
+
+ TAD PROX /CHECK X'S FIRST
+ CIA
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY
+ SMA CLA /LIMIT
+ JMP I CHECK /NOWHERE NEAR CLOSE
+
+ TAD PROY /NYAH, NYAH
+ CIA /TRY THE Y'S
+ TAD TWOPEY
+ SPA
+ CIA /ABSOLUTE VALUE OF DIFFERENCE
+ TAD LIMIT
+ SMA CLA
+ JMP I CHECK /CLEAN MISS!
+
+ TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING
+ DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT
+ JMS CUTOUT
+ JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE
+
+LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT
+
+CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY
+ TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE
+ TAD BUFTMP /COUNT
+ DCA CUTPNT
+ DCA I CUTPNT
+ JMP I CUTOUT
+
+CUTPNT, 0
+
+\f
+/
+/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE
+/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED
+/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING
+/ THEIR EXPLOSION COUNTS NON-ZERO.
+/
+
+
+COLLID, 0 /HERE TO TEST FOR COLLISION
+ TAD ONEFLG /NO TEST IF EITHER SHIP IS IN
+ SZA CLA /HYPERSPACE OR EXPLODING
+ JMP I COLLID
+ TAD TWOFLG
+ SZA CLA
+ JMP I COLLID
+ TAD ONEOUT
+ SZA CLA
+ JMP I COLLID
+ TAD TWOOUT
+ SZA CLA
+ JMP I COLLID
+
+ TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION
+ CIA /CHECK X COORDINATES FIRST
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD COLLIM /CLOSE ENOUGH?
+ SMA CLA
+ JMP I COLLID /NOPE, FORGET IT
+
+ TAD ONEPEY /YES, NOW TRY THE Y COORDINATES
+ CIA
+ TAD TWOPEY
+ SPA
+ CIA /GET MAGNITUDE ONLY
+ TAD COLLIM
+ SMA CLA /CLOSE ENOUGH?
+ JMP I COLLID
+ TAD MEXP /YES, SET BOTH EXPLOSION COUNTS
+ DCA ONEOUT
+ TAD MEXP
+ DCA TWOOUT
+ JMP I COLLID
+
+COLLIM, -300
+\f
+/
+/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO
+/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP
+/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM
+/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE
+/ VARIOUS PARAMETERS FOR REENTRY.
+/
+
+ *2200
+
+HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0
+ TAD RTNFLG /SET UP LIST POINTER
+ SZA CLA
+ TAD ONEDIF /TO APPROPRIATE SHIP FILE
+ TAD TWOLST
+ DCA AUTO15
+
+ TAD CLOCK /SET UP "RANDOM NUMBER GENERATOR"
+ DCA AUTO17
+ TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME
+ AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777
+ CIA /UPDATE CYCLES ( ABOUT 15 SECONDS)
+ DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT
+
+ TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE
+ JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY
+ DCA I AUTO15
+ TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY
+ JMS VEESET /COMPONENT
+ DCA I AUTO15
+ TAD I AUTO17 /AND THEN THE Y COMPONENT
+ JMS VEESET
+ DCA I AUTO15
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY
+ AND TIMOUT
+ TAD MHYP /ABOUT 3/4 CHANCE
+ SMA CLA
+ JMP HYPRET /OK
+ TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET
+ SZA CLA /UP FOR EXPLOSION ON REENTRY
+ TAD ONEDIF
+ TAD OUTLOC
+ DCA VEESET
+ TAD MEXP
+ DCA I VEESET
+
+HYPRET, ISZ RTNFLG
+ JMP I TWORTN
+ JMP I ONERTN
+
+TIMOUT, 777
+ONEDIF, ONEFLG-TWOFLG
+TWOLST, TWOFLG-1
+RTNFLG, 0
+ONERTN, TWOUP
+TWORTN, ONESET
+OUTLOC, TWOOUT
+MHYP, -200
+
+\f
+
+VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS
+ CLL
+ SPA /GET MAGNITUDE
+ CML
+ AND HM177 /LIMIT TO 177
+ SZL CLL
+ CIA
+ JMP I VEESET /AND EXIT
+
+HM177, 177
+
+ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS
+ TAD ONETHE /AN EXPLOSION
+ TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP
+ DCA ONETHE
+ JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR
+ ISZ ONEOUT /DONE WITH THE EXPLOSION?
+ JMP I NOWTWO /NO, NORMAL RETURN
+
+ IAC /YES, SET INTO PSEUDO HYPER SPACE
+ DCA ONEFLG
+ IAC /DISABLE RETURN FROM HYPER SPACE
+ DCA ONEFIN
+
+ TAD TWOFIN /IS NUMBER TWO STILL AROUND?
+ SNA CLA
+ JMP I NOWTWO /YES, RETURN
+ JMP I TIEUP /NO, TIE BALL GAME
+\f
+
+TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO
+ TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND
+ TAD INCTWO
+ DCA TWOTHE
+ JMS I IXPDIS /THEN DISPLAY IT
+ ISZ TWOOUT /DONE WITH EXPLOSION?
+ JMP I NOWPRO /NO, NORMAL RETURN
+
+ IAC /YES, SEND INTO PSEUDO HYPER SPACE
+ DCA TWOFLG
+ IAC /DISABLE NORMAL RETURN FROM HYPERSPACE
+ DCA TWOFIN
+ /CHECK NUMBER ONE
+ TAD ONEFIN
+ SZA CLA /STILL ALIVE AND WELL?
+ JMP I TIEUP /NO, TIE GAME
+ JMP I NOWPRO /YES, CONTINUE ON
+NOWTWO, TWODIS
+NOWPRO, PRODIS
+TIEUP, NOWIN
+IXPDIS, EXPDIS
+INCONE, 55
+INCTWO, 55
+
+\f
+/
+/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS
+/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL
+/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS
+/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S
+/ A SORT OF CLOBBY EXPLOSION.
+/
+
+ *2400
+
+EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT
+ TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY
+ DCA XTWODS /SET UP BY FILDIS OR TWODIS
+ TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE
+ DCA YTWODS
+
+ TAD XTWODS
+ CIA /CALCULATE INCREMENT THE WRONG WAY
+ TAD XONEDS
+ DCA DIXTEM /AND STORE
+ TAD YTWODS
+ CIA
+ TAD YONEDS
+ DCA DIYTEM /SAME FOR Y
+
+ TAD M4 /4 DOTS IN THE VECTOR"
+ DCA DISCNT /COULD HAVE CALLED THE OTHER
+ /VECTOR GENERATOR I SUPPOSE
+EXPLOP, TAD XONEDS
+ TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING
+ DCA XONEDS /TOTALS AND DISPLAY THE RUNNING
+ TAD YONEDS /TOTALS NORMAL SIZE
+ TAD DIYTEM
+ DCA YONEDS
+
+ TAD XONEDS
+ RTR /COULD MAKE TWICE AS BIG BY NOP-ING
+ RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH
+ DXC DXL /AS IT IS
+ CLA
+ TAD YONEDS
+ RTR
+ RAR
+ DYC DYL DIS
+ CLA
+ ISZ DISCNT /DONE 4 DOTS?
+ JMP EXPLOP /NO
+
+ ISZ AUTO11 /DONE ALL VECTORS IN THE FILE?
+ SKP
+ JMP I EXPDIS /YES, EXIT
+
+ TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP EXPDIS+1
+
+
+\f
+/
+/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS.
+/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140
+/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED
+/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y
+/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT
+/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE
+/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE.
+/
+
+
+VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN
+ DCA VEEHLD /AC
+ TAD VEEHLD
+ SMA /BRANCH FOR POSITIVE OR NEGATIV
+ JMP VEEPOS
+ TAD VEEMAX
+ SMA CLA /GREATER THAN MAXIMUM POSITIVE?
+ JMP VEECLR /NO
+ TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET
+ JMP I VEELIM /TO MAX NEGATIV
+
+VEEPOS, TAD VEEMIN /GREATER THAN MAX?
+ SPA CLA
+ JMP VEECLR /NO
+ TAD VEEMAX /YES SET TO MAX
+ JMP I VEELIM
+
+VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG
+ JMP I VEELIM
+
+VEEHLD, 0
+VEEMIN, -140
+VEEMAX, 140
+
+THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE
+ SMA /0-550 OR 0-360 DEGREES. THIS IS
+ JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW
+ TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE
+ JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC
+ TAD M550 /MODULO 360 AND EXITS
+ SMA
+ JMP .-2
+ TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T
+ JMP I THEAJI
+
+\f
+/
+/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED.
+/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND
+/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE
+/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY
+/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF
+/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT
+/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE
+/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE
+/ INTERGALACTIC DUST.
+/
+
+
+ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET
+ TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR
+ DCA MESS /AND SET GAMOVR FLAG
+ IAC
+ DCA GAMOVR
+ JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE
+
+TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET
+ TAD MES2 /AND TWO FIN IS NOT
+ DCA MESS /SET ALSO GAMOVR
+ IAC
+ DCA GAMOVR
+ JMP I TWOWIN
+
+NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN
+ DCA MESS /ARE SET .
+ IAC
+ DCA GAMOVR /NOBODY EVER REALLY WINDS
+ /UP THE WINNER IN THESE THINGS
+JOBLOP, DSB 1 /THIS IS ENTERED FROM FINISH WHEN
+ TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY
+ JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN
+ TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT
+ JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED
+ TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS
+ JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED
+ TAD MES3
+ JMS I MESOUT
+FINITO, JMP JOBLOP
+
+MES0, MESS0
+MES1, MESS1
+MES2, MESS2
+MES3, MESS3
+MES4, MESS4
+MES5, MESS5
+MESS, 0
+
+\f
+/
+/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED
+/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER
+/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT
+/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES
+/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES
+/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER
+/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT
+/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE
+/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO
+/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN
+/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH
+/ THIS WAS STOLEN HAD FULL WORD PRECISION.
+/
+
+ *6400
+
+SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT
+ DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD
+ TAD SINEIN
+ DCA I SINPSH
+ ISZ SINPSH
+ TAD SINARG
+ SZA
+ JMP SINNG2
+
+SINPOP, CLA CLL CMA
+ TAD SINPSH
+ DCA SINPSH
+ TAD I SINPSH
+ DCA SINEIN
+ TAD SINARG
+ JMP I SINEIN
+
+SINNG2, SMA
+ JMP SINPOS
+ CIA
+ JMS SINEIN
+
+SINNEG, CIA
+ DCA SINARG
+ JMP SINPOP
+
+SINPOS, TAD M264
+ SPA
+ JMP .+2
+ JMP SINNEG-1
+ TAD P132
+ SPA
+ JMP SINELK
+ SZA CLA
+ JMP .+3
+ TAD P37
+ JMP SINNEG+1
+
+ TAD SINARG
+ TAD M264
+ JMP SINNEG-1
+
+SINELK, TAD P132
+ TAD SINTAB
+ DCA SINEIN
+ TAD I SINEIN
+ DCA SINARG
+ JMP SINPOP
+
+\f
+
+SINARG, 0
+SINPSH, SINLST
+SINLST, 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+SINTAB, SINES-1
+
+COSINI, 0
+ CIA
+ TAD P132
+ JMS SINEIN
+ JMP I COSINI
+
+\f
+
+SINES, 00 /1
+ 01 /2
+ 01 /3
+ 02 /4
+ 02 /5
+ 03 /6
+ 03 /7
+ 04 /8
+ 05 /9
+ 05 /10
+ 06 /11
+ 06 /12
+ 07 /13
+ 07 /14
+ 10 /15
+ 10 /16
+ 11 /17
+ 11 /18
+ 12 /19
+ 12 /20
+ 13 /21
+ 13 /22
+ 14 /23
+ 15 /24
+ 15 /25
+ 16 /26
+ 16 /27
+ 17 /28
+ 17 /29
+ 20 /30
+ 20 /31
+ 20 /32
+ 21 /33
+ 21 /34
+ 22 /35
+ 22 /36
+ 23 /37
+ 23 /38
+ 24 /39
+ 24 /40
+ 25 /41
+ 25 /42
+ 25 /43
+ 26 /44
+ 26 /45
+ 27 /46
+ 27 /47
+ 27 /48
+ 30 /49
+ 30 /50
+ 30 /51
+ 31 /52
+ 31 /53
+ 31 /54
+ 32 /55
+ 32 /56
+ 32 /57
+ 33 /58
+ 33 /59
+ 33 /60
+ 33 /61
+ 34 /62
+ 34 /63
+ 34 /64
+ 35 /65
+ 35 /66
+ 35 /67
+ 35 /68
+ 35 /69
+ 36 /70
+ 36 /71
+ 36 /72
+ 36 /73
+ 36 /74
+ 36 /75
+ 37 /76
+ 37 /77
+ 37 /78
+ 37 /79
+ 37 /80
+ 37 /81
+ 37 /82
+ 37 /83
+ 37 /84
+ 37 /85
+ 37 /86
+ 37 /87
+ 37 /88
+ 37 /89
+
+\f
+
+MULTI, 0 /THIS IS STANDARD SINGLE PRECISION
+ CLL /MULTIPLY ROUTINE WHICH WAS ONCE
+ SPA /USED. I'VE LEFT IT IN SINCE
+ CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND
+ DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT
+ DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE
+ TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT
+ SNA /LABELS
+ JMP MULPSN+2
+ SPA
+ CMA CML IAC
+ DCA MULMP2
+ TAD MULTHR
+ DCA MULMP3
+
+MULMP4, TAD MULMP1
+ RAR
+ DCA MULMP1
+ TAD MULMP5
+ SZL
+ TAD MULMP2
+ CLL RAR
+ DCA MULMP5
+ ISZ MULMP3
+ JMP MULMP4
+ TAD MULMP1
+ RAR
+MULPSN, SZL
+ JMP MULCMP
+ DCA MULMP1
+ TAD MULMP5
+MULMPZ, ISZ MULTI
+ JMP I MULTI
+
+MULCMP, CMA CLL IAC
+ DCA MULMP1
+ TAD MULMP5
+ CMA
+ SZL
+ IAC
+ JMP MULMPZ
+
+MULTHR, 7764
+MULMP1, 0
+MULMP5, 0
+MULMP2, 0
+MULMP3, 0
+
+\f
+/
+/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE
+/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS
+/
+
+
+SHIFTR, 0
+ CLL
+ SPA
+ CML IAC
+ RAR
+ JMP I SHIFTR
+
+
+/
+/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS
+/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING
+/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION
+/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND
+/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR
+/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER
+/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT....
+/
+
+POSCAL, 0
+ TAD CALSIN
+
+ DCA T10SIN
+ TAD T10SIN
+ CLL RAL
+ DCA T20SIN
+ TAD T10SIN
+ TAD T20SIN
+ DCA T30SIN
+
+ TAD CALCOS
+
+ DCA T10COS
+ TAD T10COS
+ CLL RAL
+ DCA T20COS
+ TAD T10COS
+ TAD T20COS
+ DCA T30COS
+ JMP I POSCAL
+
+\f
+ *7000
+
+/GENERAL PURPOSE SYMBOL GENERATOR
+/
+CHARS, 0 /ENTRY TO PLOT CHARACTER STRING
+ DCA ADDR /STORE STRING ADDRESS
+ TAD I ADDR /FETCH DOUBLE CHARACTER
+ RTR /SHIFT
+ RTR / FOR FIRST
+ RTR / CHARACTER
+ JMS CHAR /PLOT CHARACTER
+ SKP /NORMAL RETURN -- SKIP
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+ TAD I ADDR /RECALL DOUBLE CHARACTER
+ ISZ ADDR /ADVANCE STRING ADDRESS
+ JMS CHAR /PLOT CHARACTER
+ JMP CHARS+2 /NORMAL RETURN -- REPEAT
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+/
+CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER
+ AND K77 /MASK OUT UPPER BITS
+ CLL RAL /MULTIPLY CODE BY TWO
+ TAD TABLE /ADD TABLE BASE ADDRESS
+ DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE
+ CMA /INITIALIZE COUNTER FOR
+ DCA COUNT2 / TWO PLOT WORDS
+ TAD I POINT /FETCH FIRST PLOT WORD
+ ISZ POINT /INCREMENT POINTER FOR NEXT ONE
+ SNA /SKIP IF NOT SPECIAL CHARACTER
+ JMP SPCHAR /ELSE GO PROCESS IT
+ DCA CURPLT /SAVE CURRENT PLOT BITS
+XPLOT, TAD KM6 /INITIALIZE 6-BIT
+ DCA COUNT6 / COUNTER
+ TAD YVALUE /RESET Y TEMPORARY
+ DCA YTEMP / VALUE FOR CHARACTER
+ TAD XVALUE /OUTPUT CURRENT
+ DXC DXL / X-VALUE TO CRT
+ TAD XINCR /INCREMENT
+ DCA XVALUE / ABSCISSA
+YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS
+ CLL RAL /GET NEXT BIT
+ DCA CURPLT /SAVE REMAINING PLOT BITS
+ SNL /SKIP IF POINT TO PLOT
+ JMP CNTINU /ELSE JUMP AHEAD
+ TAD YTEMP /OUTPUT CURRENT
+ DYC DYL DIS / Y-VALUE TO CRT
+ CLA CLL /CLEAR AC
+ TAD CURPLT /RECALL CURRENT PLOT BITS
+ SNA CLA /SKIP IF POINTS REMAINING
+ JMP WRDEND /ELSE WORD IS FINISHED
+CNTINU, TAD YTEMP /INCREMENT TEMPORARY
+ TAD YINCR / Y-VALUE FOR NEXT
+ DCA YTEMP / CHARACTER STEP
+ ISZ COUNT6 /SKIP IF 6 BITS PLOTTED
+ JMP YPLOT /ELSE PLOT NEXT ONE
+ JMP XPLOT /GO UPDATE X-VALUE
+WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD
+\f JMP EXIT /ELSE EXIT
+ TAD I POINT /FETCH SECOND BIT WORD
+ SZA /SKIP IF NO PLOT POINTS
+ JMP XPLOT-1 /ELSE GO PLOT THEM
+EXIT, TAD XVALUE /INCREMENT ABSCISSA
+ TAD XINCR / FOR SPACE BETWEEN
+ DCA XVALUE / SYMBOLS
+ JMP I CHAR /EXIT FROM CHAR
+/
+SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR
+ DCA POINT /STORE AS INDIRECT ADDRESS
+\f JMP I POINT /GO TO APPROPRIATE ROUTINE
+SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT
+ CLL RTL /MULTIPLY BY FOUR AND
+ JMP EXIT / GO CREATE SPACE
+CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X
+ DCA XVALUE / TO ITS ORIGINAL VALUE
+LF, TAD YINCR /"LINE FEED"
+ CLL RTL / DECREMENTS THE
+ CLL CIA RAL / Y-VALUE BY
+ TAD YVALUE / EIGHT SCALE
+ DCA YVALUE / STEPS
+ JMP I CHAR /EXIT FROM CHAR
+RESET, TAD INITX /"RESET" RESETS
+ DCA XVALUE / X AND Y TO
+ TAD INITY / THEIR ORIGINAL
+ JMP RESET-2 / VALUES
+TERM, ISZ CHAR /TERMINATE CODE CAUSES
+ JMP I CHAR / EXIT TO P+2
+/
+INITX, 0 /INITIAL X-VALUE
+INITY, 327 /INITIAL Y-VALUE
+XVALUE, 0 /CURRENT X-VALUE
+YVALUE, 0 /CURRENT Y-VALUE
+XINCR, 6 /BASIC X INCREMENT VALUE
+YINCR, 10 /BASIC Y INCREMENT VALUE
+YTEMP, 0 /TEMPORARY Y-VALUE
+CURPLT, 0 /CURRENT PLOT BITS
+ADDR, 0 /CURRENT STRING ADDRESS
+COUNT6, 0 /6-BIT COUNTER
+COUNT2, 0 /2-WORD COUNTER
+KM6, -6 /CONSTANT FOR COUNT6
+K77, 77 /CHARACTER CODE MASK
+POINT, 0 /TABLE POINTER
+/
+\f
+/
+TABLE, .+1 /TABLE BASE ADDRESS
+ 0 /SPECIAL CHARACTER (00)
+ TERM /TERMINATION CODE
+ 7611 / A
+ 1176
+ 7745 / B
+ 4532
+ 3641 / C
+ 4122
+ 7741 / D
+ 4136
+ 7745 / E
+ 4541
+ 7705 / F
+ 501
+ 7741 / G
+ 5173
+ 7710 / H
+ 1077
+ 4177 / I
+ 4100
+ 2040 / J
+ 4037
+ 7714 / K
+ 2241
+ 7740 / L
+ 4040
+ 7702 / M
+ 277
+ 7706 / N
+ 3077
+ 7741 / O
+ 4177
+ 7705 / P
+ 502
+ 3641 / Q
+ 6176
+ 7715 / R
+ 2542
+ 2245 / S
+ 5122
+ 177 / T
+ 100
+ 3740 / U
+ 4037
+ 1720 / V
+ 4037
+ 7730 / W
+ 3077
+ 4136 / X
+ 3641
+ 374 / Y
+ 7403
+ 6151 / Z
+ 4543
+ 7741 / [
+ 0
+ 204 / \
+ 1020
+ 4177 / ]
+ 0
+ 436 / ^
+ 400
+ 0 /SPECIAL CHARACTER (37)
+ RESET /RESET
+ 0 /SPECIAL CHARACTER (40)
+ SPACE /SPACE
+ 5600 / !
+ 0
+ 303 / "
+ 0
+ 1477 / #
+ 7714
+ 2277 / MARKER
+ 2200
+ 2313 / %
+ 6462
+ 7777 / BLOCK
+ 7777
+ 300 / '
+ 0
+ 3641 / (
+ 0
+ 4136 / )
+ 0
+ 4040 / UNDERSCORE (52)
+ 4040
+ 1034 / +
+ 1000
+ 0 /SPECIAL CHARACTER (54)
+ LF /LINE FEED
+ 1010 / -
+ 1000
+ 4000 / .
+ 0
+ 2010 / /
+ 402
+ 3641 / 0
+ 4136
+ 4442 / 1
+ 7740
+ 4261 / 2
+ 5146
+ 2145 / 3
+ 5321
+ 1710 / 4
+ 1077
+ 4745 / 5
+ 4531
+ 7750 / 6
+ 5070
+ 6111 / 7
+ 503
+ 2255 / 8
+ 5522
+ 705 / 9
+ 577
+ 2400 / :
+ 0
+ 0 /SPECIAL CHARACTER (73)
+ CRLF /CARRIAGE RETURN; LINE FEED
+ 1024 / >
+ 4200
+ 1212 / =
+ 1200
+ 4224 / <
+ 1000
+ 255 / ?
+ 300
+
+\f
+/
+/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS
+/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE
+/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN.
+/
+
+MESS0, 3773
+MESS5, 7340
+ 4040
+ 4040
+ 4000
+
+MESS1, 1716
+ 0500
+
+MESS2, 2427
+ 1700
+
+MESS3, 2711
+ 1623
+ 4100
+
+MESS4, 1617
+ 0217
+ 0431
+ 0000
+
+\f
+ *7400
+
+DISBUF, 0
+
+/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO
+/ AROUND 7575 OR SO.
+/
+/
+/
+/
+/
+
+\f
+
+ $
+
+////////////////////////////
+/
+/ THIS IS THE END
+/
+///////////////////////////
+
+
+
+
+
+\f
\ No newline at end of file
--- /dev/null
+/ SPACE WAR
+/
+/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR
+/ LAB-8
+/
+/ EVAN SUITS
+/
+/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE
+/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE
+/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND
+/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 *
+/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED.
+/
+/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD
+/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP
+/ 'TWO' ON THE RIGHT.
+/
+/ THE COMMAND WORD BIT ASSIGNMENTS ARE:
+/
+/ SR BIT: C: FUNCTION:
+/
+/ 0 0 SHIP ONE ROTATES LEFT
+/
+/ 1 1 SHIP ONE ROTATES RIGHT
+/
+/ 2 2 SHIP ONE ACCELERATES
+/
+/ 3 3 SHIP ONE FIRES
+/
+/
+/
+/ 8 4 SHIP TWO ROTATES LEFT
+/
+/ 9 5 SHIP TWO ROTATES RIGHT
+/
+/ 10 6 SHIP TWO ACCELERATES
+/
+/ 11 7 SHIP TWO FIRES
+/
+/
+/
+/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS
+/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS
+/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER
+/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE
+/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER
+/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART.
+/
+
+
+/****************************************************************
+
+/***************************
+/ CLOCK OPERATIONS
+
+CLZE=6130 / CLEAR CLOCK ENABLE REGISTER PER AC
+CLSK=6131 / SKIP ON CLOCK FLAG
+CLOE=6132 / SET CLOCK ENABLE REGISTER PER AC
+CLAB=6133 / AC REGISTER TO CLOCK COUNTER REGISTER
+CLEN=6134 / CLOCK ENABLE REGISTER TO AC
+CLSA=6135 / STATUS TO AC
+CLBA=6136 / CLOCK BUFFER REGISTER TO AC
+CLCA=6137 / CLOCK COUNTER REGISTER TO AC
+
+/ BITS IN CLOCK ENABLE REGISTER
+CREXT=0100 / EXTERNAL SOURCE
+CR2=0200 / 10**2 per second
+CR3=0300 / 10**3 per second
+CR4=0400 / 10**4 per second
+CR5=0500 / 10**5 per second
+CR6=0600 / 10**6 per second
+
+COVSTAT=4000
+CMFREE=0000 / 4096 FIXED FREE RUN
+CMPROG=1000 / PROGRAMMED DELAY
+
+CADC=0040 / START ADC ON OVERFLOW
+CINH=0020 / INHIBIT CLOCK
+CION=0010 / INTERRUPT ENABLE
+
+CEV3=0004 / EVENT 3 ENABLED
+CEV2=0002 / EVENT 2 ENABLED
+CEV1=00001 / EVENT 1 ENABLED
+
+/ VC8-E OPCODES
+DIXY=6055 / INTENSIFY
+DILX=6053 / LOAD X
+DILY=6054 / LOAD Y
+DILE=6056 / LOAD ENABLES FROM A
+DISD=6052 / TEST FOR READY
+
+/****************************************************************
+/ SYMBOL DEFINITIONS FOR PAL8-PAL10
+
+XRIN=NOP / DIGITAL INPUT?
+XRCL=NOP
+
+/DSB=XXXX / SET BRIGHTNESS - MUST BE COMMENTED OUT!!!
+
+DXC=JMS I IVCLDX / X VALUE CONTROL?
+DYC=JMS I IVCLDY / Y VALUE CONTROL?
+
+DXL=0000 / X VALUE LOAD FLAG?
+DYL=0000 / Y VALUE LOAD FLAG?
+DIS=0000 / ANOTHER STRANGE FLAG
+
+/CRF=NOP / WHICH FLAG???
+/CCF=NOP / ??
+
+
+/****************************************************************
+/
+/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR
+/ REAL WORLD TIMING PURPOSES.
+/
+
+ *0
+
+ 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT
+ JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE
+ INTSER
+
+EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR
+ODT1, 0 /DEBUGGERS, ETC.
+ODT2, 0
+ODT3, 0
+
+/
+/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF
+/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT
+/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF
+/ THE CODE.
+/
+
+ *10
+
+AUTO10, 0
+AUTO11, 0
+AUTO12, 0
+AUTO13, 0
+AUTO14, 0
+AUTO15, 0
+AUTO16, 0
+AUTO17, 0
+
+/
+/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS
+/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS
+/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED
+/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED
+/
+
+ *20
+
+ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION
+ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED
+ONEFLG, 0 /IN OR OUT OF NORMAL SPACE
+ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN
+ONEVEX, 0 /X COMPONENT OF VELOCITY
+ONEVEY, 0 /Y COMPONENT OF VELOCITY
+ONEPEX, 0 /X POSITION (12 BITS)
+ONEPEY, 0 /Y POSITION (12 BITS)
+ONESIN, 0 /SINE OF ANGLE
+ONECOS, 0 /COSINE OF ANGLE
+ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT
+
+TWOOUT, 0 /SAME CONTENT AND ORDER
+TWOCNT, 0 /AS ABOVE
+TWOFLG, 0
+TWOTHE, 0
+TWOVEX, 0
+TWOVEY, 0
+TWOPEX, 0
+TWOPEY, 0
+TWOSIN, 0
+TWOCOS, 0
+TWOFIN, 0
+
+
+/
+/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN
+/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN
+/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM
+/
+
+XONEDS, 0
+YONEDS, 0
+XTWODS, 0
+YTWODS, 0
+DIXTEM, 0
+DIYTEM, 0
+DISCNT, 0
+
+
+/
+/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST
+/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES.
+/
+T10SIN, 0
+T20SIN, 0
+T30SIN, 0
+T10COS, 0
+T20COS, 0
+T30COS, 0
+
+CALSIN, 0
+CALCOS, 0
+
+/
+/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON
+/ PAGE ZERO
+/
+
+SINE, SINEIN
+COSINE, COSINI
+MULT, MULTI
+RSHIFT, SHIFTR
+VECTOR, DISPLY
+CALPOS, POSCAL
+INTWRD, 0
+INTCNT, 0
+/CLOCK, 0
+HYPER, HYPSET
+MESOUT, CHARS
+THEADJ, THEAJI
+VEESCL, VEELIM
+ISHFT, DISHFT
+RESET1, RESE1
+GAMOVR, 0
+ACCFLG, 0
+ACCPER, -30
+MEXP, -400
+
+PROX, 0
+PROY, 0
+PROLIF, -360
+BUFTMP, 0
+ONEFIL, DISBUF
+TWOFIL, DISBUF+40
+
+P5, 5
+P10, 10
+P17, 17
+P20, 20
+P37, 37
+P40, 40
+P100, 100
+P132, 132
+P200, 200
+P400, 400
+P550, 550
+P3777, 3777
+
+M4, -4
+M6, -6
+M10, -10
+M11, -11
+M264, -264
+M200, -200
+M400, -400
+M550, -550
+
+IVCLDX, VCLDX
+IVCLDY, VCLDY
+
+/
+/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200.
+/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED,
+/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES
+/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR
+/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT
+/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08
+/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY
+/ FILE UPDATE TO START OFF THE GAME.
+/
+
+ *200
+
+START, CLA CLL /START OR RESTART HERE ANY OLD TIME
+ DIXY /TO GET THE VC8-E STARTED ONCE
+ LAS /SR
+/TMP SNA CLA
+ TAD SWRD /USE THE SR
+ TAD XROPT /USE THE BLUE RIBBON CONNECTOR
+ DCA COLDST /AND LEAVE IN THE TRAP LOCATION
+
+RESTRT, CLA CMA
+ XRCL
+ CLA CLL
+
+ TAD P17 /FIRST CLEAR THE POSITION AND DATA
+ DCA AUTO10 /TABLES OF THE TWO SHIPS
+ TAD TABLEN
+ DCA AUTO11
+ DCA I AUTO10
+ ISZ AUTO11
+ JMP .-2
+
+ TAD STRT1 /SET THE STARTING POSITIONS OF THE
+ DCA ONEPEX /TWO SHIPS
+ TAD STRT2
+ DCA TWOPEX
+ TAD P37 /SET TRIG FUNCTIONS JUST IN CASE
+ DCA ONECOS
+ TAD P37
+ DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP
+ TAD ACCPER /SET COUNT FOR VELOCITY INCREASE
+ DCA ACCFLG
+ DCA ONEFIN /CLEAR ALL GAME END FLAGS
+ DCA TWOFIN
+ DCA GAMOVR
+ JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS
+
+
+ TCF /CLEAR OTHER REMAINING LIKELY FLAGS
+ PCF
+ RRB
+
+ CLA CMA / ALL ONES
+ CLZE / CLEAR CLOCK CONFIG REGISTER
+ CLA
+ TAD CDELY / LOAD NEG DELAY
+ CLAB / LOAD TO CLOCK BUFFER
+ CLA
+ TAD CCNF / LOAD CLOCK CONFIG
+ CLOE / SET CONFIG BITS
+
+ CLA CLL
+ JMP COLDST /AND GO TO IT
+
+CCNF, CR4+CMPROG+CION+COVSTAT / CLOCK CONFIGURATION
+CDELY, -310 / COUNTER PRESET (200)
+
+/
+/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE
+/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE
+/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT
+/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER
+/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN.
+/
+
+UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW.
+ /START NEXT SWEEP
+COLDST, 0 /TRAP TO READ SR OR BRC
+ LAS /HERE FOR SR
+ DCA INTWRD /STORE TEMPORARILY
+ TAD INTWRD /MASK OUT LEFTMOST 4 BITS
+ RTR /FOR NUMBER ONE
+ RTR
+ AND LFTHAF
+ DCA INTTEM /AND STORE
+ TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO
+ AND RYTHAF
+ TAD INTTEM /ADD TOGETHER
+ JMP .+3 /AND CONTINUE
+
+CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR
+ XRCL
+ DCA INTWRD /CONTINUE
+ TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT
+ DCA INTCNT /UPDATE
+ ION /GET READY FOR THE NEXT CYCLE
+ TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME?
+ IAC /ONLY WHEN ACCFLG=0
+ SMA SZA
+ TAD ACCPER /IF ZERO, RESET COUNT
+ DCA ACCFLG
+
+ JMP I .+1 /NOW GET DOWN TO WORK.
+ ONEUP
+
+BUFSET, SETBUF
+TABLEN, AUTO17-CALCOS
+INTTEM, 0
+LFTHAF, 0360
+RYTHAF, 0017
+STRT1, 1000
+STRT2, -1000
+SWRD, 2000-CODST
+XROPT, JMP CODST
+
+
+
+/
+/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE
+/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE
+/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS
+/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO
+/ UPDATE WITH IOF.
+/
+/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS
+/ SET IN WHICH CASE THE GAME IS RESTARTED.
+/
+/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM
+/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE
+/ STRANGE FLAG
+/
+
+INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE
+ RAR /AC AND LINK
+ DCA INTLNK /FOR POSSIBLE CONTINUATION
+ CLSK /WAS IT THE CRYSTAL CLOCK?
+ JMP INTBUS /NO TRY SOMETHING ELSE
+ CLA IAC RTR /LOAD 4000
+ CLSA /GET CLOCKSTATUS AND RESET FLAG
+ CLA CLL
+ JMP UPDATE /YES, GO TO IT
+
+INTBUS, KSF /HERE ON NON-CLOCK INTERUPT
+ JMP .+5 /NOT THE KEYBOARD
+ KCC /CLEAR KEYBOARD FLAG
+ TAD GAMOVR /IS THE GAMEOVER
+ SZA CLA
+ JMP RESTRT /YES, RESTART
+/ TCF /NO, HELL WITH IT
+ ISZ INTGLH /COUNT ONE BADDIE
+ SKP
+ HLT /HALT IF TOO MANY BADDIES
+
+INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT
+ TAD INTLNK
+ RAL
+ TAD INTACC
+ ION
+ JMP I 0
+
+INTACC, 0
+INTLNK, 0
+INTGLH, 0
+
+
+
+/
+/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP
+/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON
+/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS
+/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN,
+/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS
+/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS.
+/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR
+/ NUMBER TWO.
+/
+
+ *400
+
+ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP ONEOK /YES IT IS
+ IAC /NO, BUT IS IT JUST COMING OUT?
+ SNA
+ TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED
+ DCA ONEFLG /OTHERWISE JUST COUNT ONE
+ JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO
+
+ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING?
+ SZA CLA
+ JMP ONEFIG /IF YES, ALLOW NO CONTROLS
+ TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED?
+ SZA CLA
+ JMS I ONEWN /YES, SIGNAL VICTORY
+ TAD INTWRD /NOW BEGIN TEST OF REQUEST
+ AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE!
+ TAD OM300 /TEST BITS 4 AND 5
+ SZA CLA
+ JMP ONELEF /NOPE, CONTINUE
+ CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE
+ JMP I HYPER
+ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN?
+ AND P200 /TEST BIT 4
+ SNA CLA
+ JMP ONERYT /NO
+ CLA CLL CMA /YES DECREMENT ANGLE
+ JMP ONEFIG
+
+ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN
+ AND P100 /TEST BIT 5
+ SZA CLA
+ IAC /YES, INCREMENT ANGLE
+
+ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE)
+ JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS
+ DCA ONETHE /AND STORE
+ TAD ONETHE /FIND THEM TRIG FUNCTIONS
+ JMS I SINE /AND STORE ONCE AND FOR ALL
+ DCA ONESIN /IN THE APPROPRIATE PLACES
+ TAD ONETHE
+ JMS I COSINE
+ DCA ONECOS
+ TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING
+ SZA CLA
+ JMP ONEVEL
+
+
+
+
+ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE?
+ SZA CLA
+ JMP ONEVEL /NOPE
+ TAD INTWRD /YES, ANY REQUESTED?
+ AND P40 /TEST BIT 6
+ SNA CLA
+ JMP ONEVEL /NONE REQUESTED
+ TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING
+ TAD ONEVEY /ON ORIENTATION
+ JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM
+ DCA ONEVEY /AND STORE
+ TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT
+ TAD ONEVEX
+ JMS I VEESCL
+ DCA ONEVEX
+
+
+
+ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE
+ JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4
+ JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION
+ TAD ONEPEX
+ DCA ONEPEX /IGNORE ANY OVERFLOW
+ TAD ONEVEY /DO THE SAME FOR Y COORDINATE
+ JMS I ISHFT /AND VELOCITY COMPONENT
+ JMS I ISHFT
+ TAD ONEPEY
+ DCA ONEPEY
+ TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF
+ SZA CLA /EXPLODING
+ JMP I ITWOUP
+
+
+
+
+ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED
+ SNA CLA
+ JMP .+3
+ ISZ LNC1FG /NO, CONTINUE RELOADING
+ JMP I ITWOUP /AND EXIT
+ TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED?
+ AND P20 /TEST BIT7
+ SNA CLA
+ JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT
+ /.....I GUESS.....
+ TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH
+ DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE
+ TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE)
+ JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY
+ JMS I RSHIFT /COMPONENT OF PROJECTILE
+ TAD ONESIN
+ JMS I RSHIFT /AND STICK IT IN THE FILE
+ DCA I AUTO16
+ TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE
+ CLL RTL /SHIP OF ORIGIN
+ TAD ONEPEX
+ DCA I AUTO16 /AND STORE X POSITION
+ TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND
+ JMS I ISHFT /POSITION
+ JMS I RSHIFT
+ TAD ONECOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD ONECOS
+ CLL RTL
+ TAD ONEPEY
+ DCA I AUTO16
+ TAD M200 /START RELOAD CYCLE
+ DCA LNC1FG
+ JMS I RESET1 /RESET AUTO16 TO NEXT HOLE
+
+ JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO
+ITWOUP, TWOUP
+
+LNC1FG, 0 /PROJECTILE LAUNCH ENABLE
+
+OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5
+OM300, -300
+ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE
+
+
+
+/
+/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO.
+/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE.
+/
+
+ *600
+
+TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP TWOOK /YES, CONTINUE
+ IAC /NO, BUMP COUNT AND TEST FOR REENTRY
+ SNA
+ TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED
+ DCA TWOFLG /AND CONTINUE
+ JMP I IONEST
+
+TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE
+ SZA CLA /IS IT EXPLODING?
+ JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE
+ TAD ONEFIN /DID WE JUST WIN?
+ SZA CLA
+ JMS I TWOWN /YES ENABLE END OF GAME MESSAGE
+ TAD INTWRD /TEST FOR HYPERSPACE REQUEST
+ AND OP14
+ TAD OM14 /BITS 8 AND 9 MUST BE SET
+ SNA CLA
+ JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0
+ /FOR SHIP NUMBER 2
+TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8
+ AND P10
+ SNA CLA
+ JMP TWORYT /NOT SET
+ CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE
+ JMP TWOFIG /SKIP TEST FOR RIGHT TURN
+
+TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9
+ AND INTWRD
+ SZA CLA
+ IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE
+
+TWOFIG, TAD TWOTHE /UPDTAE TWOTHE
+ JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE
+ DCA TWOTHE /AND STORE
+ TAD TWOTHE
+ JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS
+ DCA TWOSIN /AND STORE IN DATA TABLE
+ TAD TWOTHE
+ JMS I COSINE
+ DCA TWOCOS
+ TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING
+ SZA CLA
+ JMP TWOVEL
+
+
+
+
+TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED
+ SZA CLA /DURING THIS UPDATE CYCLE
+ JMP TWOVEL /NOPE
+ CLL IAC RAL /YES, TEST FOR BIT 2 SET
+ AND INTWRD
+ SNA CLA
+ JMP TWOVEL /NOT SET
+
+ TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF
+ TAD TWOVEX /ANGLE OF ORIENTATION
+ JMS I VEESCL /AND SCALE TO NOT EXCEED MAX
+ DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE
+
+ TAD TWOCOS
+ TAD TWOVEY
+ JMS I VEESCL
+ DCA TWOVEY
+
+
+
+TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY
+ JMS I ISHFT /COMPONENTS/16
+ JMS I ISHFT
+ TAD TWOPEX
+ DCA TWOPEX
+ TAD TWOVEY
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD TWOPEY
+ DCA TWOPEY
+ TAD TWOOUT
+ SZA CLA
+ JMP I IONEST
+
+
+
+
+TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST
+ SNA CLA /TEST TO SEE IF RELOAD COMPLETE
+ JMP .+3
+ ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT
+ JMP I IONEST
+ IAC /YES, TEST TRIGGER BIT 11
+ AND INTWRD
+ SNA CLA
+ JMP I IONEST /NOT SET, HELL WITH IT
+
+ TAD PROLIF /OK, SET PROJECTILE LIFE
+ DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT
+ TAD TWOVEX /ADD SHIPS VELOCITY
+ JMS I ISHFT /(ADJUSTED)
+ JMS I RSHIFT
+ TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT
+ JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION
+ DCA I AUTO16
+ TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD
+ CLL RTL /OF THE SHIP
+ TAD TWOPEX /X COMPONENT
+ DCA I AUTO16
+ TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY
+ JMS I ISHFT /Y POSITION AND COSINE
+ JMS I RSHIFT
+ TAD TWOCOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD TWOCOS
+ CLL RTL
+ TAD TWOPEY
+ DCA I AUTO16
+ TAD M200
+ DCA LNC2FG /200 CYCLES OF RELOAD
+ JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE!
+
+ JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS
+IONEST, ONESET
+
+LNC2FG, 0 /RELOAD COUNT
+
+OP14, 14 /HYPERSPACE CODE
+OM14, -14
+TWOWN, TWOWIN
+
+
+
+/
+/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT
+/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL
+/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY
+/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE
+/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN
+/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE
+/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS
+/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE
+/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE:
+/
+/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE]
+/
+/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE]
+/
+/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE
+/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE
+/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL)
+/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE
+/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND
+/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES
+/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS
+/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE
+/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS.
+/
+/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7
+/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED.
+/
+/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED
+/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE.
+/
+
+
+ *1000
+
+ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE
+ TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE
+ SZA CLA
+ JMP I ITWOST
+ TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS
+ DCA CALSIN
+ TAD ONECOS
+ DCA CALCOS
+ JMS I CALPOS /CALL THE CALCULATOR
+
+/
+/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE
+/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES
+/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE
+/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED
+/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y
+/ DISPLACED BY X,Y OF THE SHIP ITSELF
+/
+
+ TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE
+ DCA AUTO10 /POINTER
+ TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS
+ TAD T30SIN
+ DCA I AUTO10 / 0,3 OR TOP CENTER
+ TAD ONEPEY
+ TAD T30COS
+ DCA I AUTO10
+
+ TAD T10COS
+ CIA /THE SECOND IS
+ TAD ONEPEX
+ DCA I AUTO10 / -1,0
+ TAD T10SIN /OR JUST LEFT OF DEAD CENTER
+ TAD ONEPEY /AND SO ON
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD T30COS /THE THIRD POINT IS
+ CIA
+ TAD ONEPEX / -3,-3
+ DCA I AUTO10
+ TAD T30COS /OR BOTTOM LEFT HAND CORNER
+ CIA
+ TAD T30SIN
+ TAD ONEPEY
+ DCA I AUTO10
+
+
+
+
+ TAD T10SIN
+ CIA /FOURTH POINT
+ TAD ONEPEX
+ DCA I AUTO10 / 0,-1
+ TAD T10COS
+ CIA /OR JUST BELOW CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE
+ AND P40 /FLAME WITH AN EXTRA POINT SOME
+ SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP
+ JMP ONECON /POWER NOT ON - CONTINUE
+ TAD ONEOUT /DO NOT ALLOW IF EXPLODING
+ SZA CLA
+ JMP ONECON
+
+ TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND
+ SNA /OFF TO MAKE IT FLICKER. DISPLAY THE
+ CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE
+ DCA ONFG1
+
+ ISZ ONFG1
+ JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP
+
+ TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME
+ CMA /WITH LONG SHORT LONG SHORT
+ DCA ONFG2
+
+ TAD ONFG2 /TIP OF FLAME AT EITHER
+ SNA CLA
+ TAD T10SIN / 0,-4 OR
+ TAD T30SIN / 0,-3
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD ONFG2
+ SNA CLA
+ TAD T10COS
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10SIN
+ CIA
+ TAD ONEPEX /RETURN DISPLAY TO 0,-1
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+
+
+
+ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8
+ DCA ONECNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT
+ CIA
+ TAD T30COS / AT 3,-3
+ TAD ONEPEX /
+ DCA I AUTO10 /OR LOWER RIGHT HAND CORNER
+ TAD T30SIN
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10COS /NEXT
+ TAD ONEPEX /
+ DCA I AUTO10 / 1,0
+ TAD T10SIN /
+ CIA / OR JUST RIGHT OF CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T30SIN /FINALLY BACK TO
+ TAD ONEPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD ONEPEY / TOP CENTE
+ DCA I AUTO10
+
+ JMP I ITWOST /NOW FOR NUMBER TWO
+ITWOST, TWOSET
+
+ONFG1, 0 /USED TO COUNT FLICKERS
+ONFG2, 0 /SHORT OR LONG FLAG
+
+
+
+/
+/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO.
+/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH
+/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS
+/
+
+ *1200
+
+TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE
+ TAD TWOFLG
+ SZA CLA
+ JMP I IFILDS
+ TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS
+ DCA CALSIN /CALCULATED
+ TAD TWOCOS
+ DCA CALCOS
+ JMS I CALPOS
+
+ TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY
+ DCA AUTO10 /FILE
+ TAD T30SIN /FIRST POINT AT
+ TAD TWOPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD TWOPEY / OR TOP CENTER
+ DCA I AUTO10
+
+ TAD T20COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD T20COS /SECOND POINT
+ TAD TWOPEY / -2,2
+ DCA I AUTO10
+
+ TAD T20COS /THIRD POINT
+ CIA / -2,0
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS
+ TAD T30SIN
+ CIA
+ TAD TWOPEX /FOURTH POINT
+ DCA I AUTO10 / -2,-3
+ TAD T30COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+
+ TAD T20SIN
+ CIA /NEXT
+ TAD TWOPEX / 0,-2
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON
+ AND INTWRD
+ SNA CLA
+ JMP TWOCON /NO, FORGET IT
+ TAD TWOOUT /NOT ALLOWED IF EXPLODING
+ SZA CLA
+ JMP TWOCON
+
+ TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1
+ SNA
+ CLA CLL CMA RAL
+ DCA TWFG1
+
+ ISZ TWFG1 /ALSO THE LENGHT VARIATION
+ JMP TWOCON
+
+ TAD TWFG2 /EVERY OTHER TIME LONG
+ CMA
+ DCA TWFG2
+ /FLAME TIP AT EITHER
+ TAD TWFG2 / 0,-3
+ SNA CLA /OR
+ TAD T20SIN / 0,-5
+ TAD T30SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD TWFG2
+ SNA CLA
+ TAD T20COS
+ TAD T30COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20SIN /NOW BACK UP TO THE SHIP
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+
+
+
+TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10
+ DCA TWOCNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE
+ CIA /NEXT POINT AT 2,-3
+ TAD T20COS
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS /NEXT POINT
+ TAD TWOPEX /
+ DCA I AUTO10 / 2,0
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20COS /AND THE NEXT AT
+ TAD T20SIN
+ TAD TWOPEX / 2,2
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD T20COS
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS /AND THE LAST AT
+ TAD TWOPEY /
+ DCA I AUTO10 / 0,3
+
+ JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS
+IFILDS, FILDIS
+
+TWFG1, 0 /FLIK THE FLAME
+TWFG2, 0 /LONG OR SHORT
+
+
+
+/
+/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION
+/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END
+/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS
+/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR
+/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES.
+/
+
+ *1400
+
+FILDIS, CLA CLL /ALL SET TO GO
+ JMS I COLIDE /TEST FOR COLLISION FIRST
+/ DSB 1 /IF NO COLLISION
+ TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL
+ SZA CLA /SPACE
+ JMP TWODIS
+
+ TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE
+ DCA AUTO10 /FOR NUMBER ONE
+ TAD ONECNT /ALONG WITH VECTOR COUNT
+ DCA AUTO11
+ TAD I AUTO10 /SET OUT THE FIRST POINT PAIR
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION?
+ SZA CLA
+ JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION
+
+FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS
+ DCA XTWODS /SET X AND Y TO NEW POINT
+ TAD I AUTO10
+ DCA YTWODS
+ JMS I VECTOR /CALL THE DOT DRAWING MACHINE
+ ISZ AUTO11
+ SKP /COUNT
+ JMP TWODIS /DO NUMBER TWO ON OVERFLOW
+ TAD XTWODS /SWAP POINTS FOR NEXT PAIR
+ DCA XONEDS
+ TAD YTWODS /THE GENERATOR DRAWS FROM ONE
+ DCA YONEDS /TOWARDS TWO
+ JMP FILONE
+
+
+
+
+TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO
+ SZA CLA /BUT NOT IF IN HYPER SPACE
+ JMP I IPRODS
+
+ TAD TWOFIL /SET UP FILE POINTER AS IN ONE
+ DCA AUTO10
+ TAD TWOCNT /AND THE COUNT
+ DCA AUTO11
+ TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD TWOOUT /IS IT EXPLODING?
+ SZA CLA
+ JMP I ITWOEX /YES, HOW EXCITING
+
+TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF
+ DCA XTWODS /POINTS
+ TAD I AUTO10
+ DCA YTWODS /AND CALL THE VECTOR SEQUENCE
+ JMS I VECTOR
+ ISZ AUTO11
+ JMP .+3
+
+ JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO
+IPRODS, PRODIS /DO THE PROJECTILE THING
+
+ TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR
+ DCA XONEDS /OF POINTS
+ TAD YTWODS
+ DCA YONEDS
+ JMP TWDLOP
+
+COLIDE, COLLID
+IONEEX, ONEEXP
+ITWOEX, TWOEXP
+
+
+
+/
+/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A
+/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS.
+/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND
+/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT
+/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE.
+/
+
+DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR
+ CLA
+ TAD XONEDS /FROM XONEDS,YONEDS
+ CIA /TO XTWODS,YTWODS
+ TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO
+ JMS DISHFT /FOURTHS
+ DCA DIXTEM /AND STORE INCREMENT
+ TAD YONEDS
+ CIA
+ TAD YTWODS
+ JMS DISHFT /FOURTHS
+ DCA DIYTEM
+ TAD M4 /FOR FOUR DOTS
+ DCA DISCNT
+
+DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y
+ TAD DIXTEM
+ DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS
+ TAD YONEDS /XONEDS AND YONEDS
+ TAD DIYTEM
+ DCA YONEDS
+ TAD XONEDS
+/ RTR /DIVIDE BY 8 TO FIT SCREEN SIZE
+/ RAR
+ DXC DXL /SET X VALUE
+ CLA
+ TAD YONEDS /DO THE SAME FOR Y
+/ RTR
+/ RAR
+ DYC DYL DIS /AT LAST SOMETHING TO SEE!!
+ CLA
+ ISZ DISCNT /DONE YET?
+ JMP DISLOP /NOPE
+ JMP I DISPLY /YUP
+
+
+DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED
+ CLL /FROM EVERYWHERE TO DIVIDE THE
+ SPA /AC BY FOUR WITH AN ASR RIGHT
+ CML IAC /NOTE THAT NEGATIVE NUMBERS ARE
+ RAR /ROUNDED UPWARDS (TOWARD ZERO)
+ CLL /TO MAKE IT COME OUT RIGHT
+ SPA
+ CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS
+ RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES
+ JMP I DISHFT
+
+
+
+/
+/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS.
+/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH
+/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS
+/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR
+/ A HIT.
+/
+
+ *1600
+
+PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES
+ TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE
+ DCA BUFTMP
+/ DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS
+
+PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT
+ SNA
+ JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT
+ IAC /INCREMENT COUNT AND REPLACE
+ DCA I BUFTMP
+ ISZ BUFTMP /BUMP POINTER TO X VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION
+ TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST
+ ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP /SAME LITTLE GAME
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROY /STORE THE NEW Y VALUE
+
+ TAD PROX /DISPLAY THE POINT WITH
+/ RTR /THE SAME SHIFT AS FOR THE SHIPS
+/ RAR /FOR THE SMALL SCREEN
+ DXC DXL
+ CLA
+ TAD PROY
+/ RTR /
+/ RAR
+ DYC DYL DIS /THERE IT IS!!
+ CLA
+ JMS I CHKOUT /TEST FOR A HIT
+ ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END
+ TAD BUFTMP /OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP PROLOP /NOT AT END - CONTINUE
+
+
+/
+/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR
+/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP
+/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT
+/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE
+/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED
+/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING
+/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD
+/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT
+/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY.
+/
+
+
+FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT?
+ SZA CLA
+ JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE
+/ TAD M400 /MOVE THE BEAM OFF SCREEN
+/ DYC DYL
+ CLA CLL
+/ DXC DXL
+ TAD INTCNT /PICK UP THE COUNT
+ CIA
+ JMP .
+
+ENDGAM, JOBLOP
+
+
+EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER
+ TAD P5 /POINTER TO THE NEXT PROJECTILE
+ DCA BUFTMP /UNLESS THE END
+ TAD BUFTMP /OF THE BUFFER
+ TAD BUFLIM /IS REACHED
+ SZA CLA /IN WHICH CASE
+ JMP PROLOP /IT
+ JMP FINISH /QUITS
+
+BUFST, DISBUF+101
+BUFLIM, -DISBUF-175
+CHKOUT, CHECK
+
+RESE1, 0 /THIS IS CALLED TO SET THE POINTER
+ TAD MRES /(AUTO16) TO THE NEXT FREE SLOT
+ DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE
+
+RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT
+ TAD P5
+ DCA RESPNT
+ TAD RESPNT /RESTE IF AT END OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP RESCON
+ TAD BUFST
+ DCA RESPNT
+
+RESCON, TAD I RESPNT /FIND A HOLE YET?
+ SNA CLA
+ JMP RESFND /YES, SET UP AUTO16
+ ISZ RESCNT /NO COUNT
+ JMP RESLOP /AND TRY AGAIN
+ HLT /NO HOLES AT ALL?
+
+RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING
+ TAD RESPNT
+ DCA AUTO16
+ JMP I RESE1
+
+MRES, -14
+RESCNT, 0
+RESPNT, 0
+
+SETBUF, 0
+ CMA /THIS ROUTINE IS CALLED FROM THE
+ TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL
+ DCA AUTO16 /THE BUFFER POINTERS AND SO ON
+ TAD BUFST
+ DCA BUFTMP
+ TAD BUFST
+ DCA RESPNT
+ TAD BUFST
+ DCA SETPNT
+SETLOP, DCA I SETPNT
+ ISZ SETPNT
+ TAD SETPNT
+ TAD BUFLIM
+ SZA CLA
+ JMP SETLOP
+ JMP I SETBUF
+
+SETPNT, 0
+
+
+
+/
+/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY
+/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN.
+/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE
+/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP
+/ IS SUITABLY FLAGGED
+/
+
+ *2000
+
+CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT
+ TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE
+ SZA CLA
+ JMP CHECK2
+ TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT
+ SZA CLA
+ JMP CHECK2
+
+ TAD PROX /CHECK X COORDINATES OF SHIP ONE
+ CIA /AND PROJECTILE
+ TAD ONEPEX /THIS SORT OF THING IS WHY THE
+ SPA /COORDINATES HAVE TO BE MAINTAINED TO 12
+ CIA /BITS
+ TAD LIMIT /CLOSE ENOUGH?
+ SMA CLA
+ JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT
+ TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y?
+ CIA
+ TAD ONEPEY
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP CHECK2 /NO HIT
+
+ TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT
+ DCA ONEOUT /ALL THAT IS NECESSARY
+ JMS CUTOUT /REMOVE PROJECTILE
+
+
+
+
+CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO
+ SZA CLA
+ JMP I CHECK /BUT NOT IF IN HYPERSPACE
+ TAD TWOOUT /OR IF ALREADY HIT
+ SZA CLA
+ JMP I CHECK
+
+ TAD PROX /CHECK X'S FIRST
+ CIA
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY
+ SMA CLA /LIMIT
+ JMP I CHECK /NOWHERE NEAR CLOSE
+
+ TAD PROY /NYAH, NYAH
+ CIA /TRY THE Y'S
+ TAD TWOPEY
+ SPA
+ CIA /ABSOLUTE VALUE OF DIFFERENCE
+ TAD LIMIT
+ SMA CLA
+ JMP I CHECK /CLEAN MISS!
+
+ TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING
+ DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT
+ JMS CUTOUT
+ JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE
+
+LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT
+
+CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY
+ TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE
+ TAD BUFTMP /COUNT
+ DCA CUTPNT
+ DCA I CUTPNT
+ JMP I CUTOUT
+
+CUTPNT, 0
+
+
+
+/
+/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE
+/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED
+/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING
+/ THEIR EXPLOSION COUNTS NON-ZERO.
+/
+
+
+COLLID, 0 /HERE TO TEST FOR COLLISION
+ TAD ONEFLG /NO TEST IF EITHER SHIP IS IN
+ SZA CLA /HYPERSPACE OR EXPLODING
+ JMP I COLLID
+ TAD TWOFLG
+ SZA CLA
+ JMP I COLLID
+ TAD ONEOUT
+ SZA CLA
+ JMP I COLLID
+ TAD TWOOUT
+ SZA CLA
+ JMP I COLLID
+
+ TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION
+ CIA /CHECK X COORDINATES FIRST
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD COLLIM /CLOSE ENOUGH?
+ SMA CLA
+ JMP I COLLID /NOPE, FORGET IT
+
+ TAD ONEPEY /YES, NOW TRY THE Y COORDINATES
+ CIA
+ TAD TWOPEY
+ SPA
+ CIA /GET MAGNITUDE ONLY
+ TAD COLLIM
+ SMA CLA /CLOSE ENOUGH?
+ JMP I COLLID
+ TAD MEXP /YES, SET BOTH EXPLOSION COUNTS
+ DCA ONEOUT
+ TAD MEXP
+ DCA TWOOUT
+ JMP I COLLID
+
+COLLIM, -300
+
+
+/
+/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO
+/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP
+/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM
+/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE
+/ VARIOUS PARAMETERS FOR REENTRY.
+/
+
+ *2200
+
+HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0
+ TAD RTNFLG /SET UP LIST POINTER
+ SZA CLA
+ TAD ONEDIF /TO APPROPRIATE SHIP FILE
+ TAD TWOLST
+ DCA AUTO15
+
+ CLCA /SET UP "RANDOM NUMBER GENERATOR"
+ /USE CLOCK COUNTER FOR THAT PURPOSE
+ DCA AUTO17
+ TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME
+ AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777
+ CIA /UPDATE CYCLES ( ABOUT 15 SECONDS)
+ DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT
+
+ TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE
+ JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY
+ DCA I AUTO15
+ TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY
+ JMS VEESET /COMPONENT
+ DCA I AUTO15
+ TAD I AUTO17 /AND THEN THE Y COMPONENT
+ JMS VEESET
+ DCA I AUTO15
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY
+ AND TIMOUT
+ TAD MHYP /ABOUT 3/4 CHANCE
+ SMA CLA
+ JMP HYPRET /OK
+ TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET
+ SZA CLA /UP FOR EXPLOSION ON REENTRY
+ TAD ONEDIF
+ TAD OUTLOC
+ DCA VEESET
+ TAD MEXP
+ DCA I VEESET
+
+HYPRET, ISZ RTNFLG
+ JMP I TWORTN
+ JMP I ONERTN
+
+TIMOUT, 777
+ONEDIF, ONEFLG-TWOFLG
+TWOLST, TWOFLG-1
+RTNFLG, 0
+ONERTN, TWOUP
+TWORTN, ONESET
+OUTLOC, TWOOUT
+MHYP, -200
+
+
+
+
+VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS
+ CLL
+ SPA /GET MAGNITUDE
+ CML
+ AND HM177 /LIMIT TO 177
+ SZL CLL
+ CIA
+ JMP I VEESET /AND EXIT
+
+HM177, 177
+
+ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS
+ TAD ONETHE /AN EXPLOSION
+ TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP
+ DCA ONETHE
+ JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR
+ ISZ ONEOUT /DONE WITH THE EXPLOSION?
+ JMP I NOWTWO /NO, NORMAL RETURN
+
+ IAC /YES, SET INTO PSEUDO HYPER SPACE
+ DCA ONEFLG
+ IAC /DISABLE RETURN FROM HYPER SPACE
+ DCA ONEFIN
+
+ TAD TWOFIN /IS NUMBER TWO STILL AROUND?
+ SNA CLA
+ JMP I NOWTWO /YES, RETURN
+ JMP I TIEUP /NO, TIE BALL GAME
+
+
+
+TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO
+ TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND
+ TAD INCTWO
+ DCA TWOTHE
+ JMS I IXPDIS /THEN DISPLAY IT
+ ISZ TWOOUT /DONE WITH EXPLOSION?
+ JMP I NOWPRO /NO, NORMAL RETURN
+
+ IAC /YES, SEND INTO PSEUDO HYPER SPACE
+ DCA TWOFLG
+ IAC /DISABLE NORMAL RETURN FROM HYPERSPACE
+ DCA TWOFIN
+ /CHECK NUMBER ONE
+ TAD ONEFIN
+ SZA CLA /STILL ALIVE AND WELL?
+ JMP I TIEUP /NO, TIE GAME
+ JMP I NOWPRO /YES, CONTINUE ON
+NOWTWO, TWODIS
+NOWPRO, PRODIS
+TIEUP, NOWIN
+IXPDIS, EXPDIS
+INCONE, 55
+INCTWO, 55
+
+
+
+/
+/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS
+/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL
+/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS
+/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S
+/ A SORT OF CLOBBY EXPLOSION.
+/
+
+ *2400
+
+EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT
+ TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY
+ DCA XTWODS /SET UP BY FILDIS OR TWODIS
+ TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE
+ DCA YTWODS
+
+ TAD XTWODS
+ CIA /CALCULATE INCREMENT THE WRONG WAY
+ TAD XONEDS
+ DCA DIXTEM /AND STORE
+ TAD YTWODS
+ CIA
+ TAD YONEDS
+ DCA DIYTEM /SAME FOR Y
+
+ TAD M4 /4 DOTS IN THE VECTOR"
+ DCA DISCNT /COULD HAVE CALLED THE OTHER
+ /VECTOR GENERATOR I SUPPOSE
+EXPLOP, TAD XONEDS
+ TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING
+ DCA XONEDS /TOTALS AND DISPLAY THE RUNNING
+ TAD YONEDS /TOTALS NORMAL SIZE
+ TAD DIYTEM
+ DCA YONEDS
+
+ TAD XONEDS
+/ RTR /COULD MAKE TWICE AS BIG BY NOP-ING
+/ RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH
+ JMS I IVCLDX /AS IT IS
+ CLA
+ TAD YONEDS
+/ RTR
+/ RAR
+ JMS I IVCLDY
+/ DISD
+/ JMP .-1
+/ DIXY
+
+ CLA
+ ISZ DISCNT /DONE 4 DOTS?
+ JMP EXPLOP /NO
+
+ ISZ AUTO11 /DONE ALL VECTORS IN THE FILE?
+ SKP
+ JMP I EXPDIS /YES, EXIT
+
+ TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP EXPDIS+1
+
+
+
+
+/
+/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS.
+/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140
+/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED
+/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y
+/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT
+/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE
+/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE.
+/
+
+
+VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN
+ DCA VEEHLD /AC
+ TAD VEEHLD
+ SMA /BRANCH FOR POSITIVE OR NEGATIV
+ JMP VEEPOS
+ TAD VEEMAX
+ SMA CLA /GREATER THAN MAXIMUM POSITIVE?
+ JMP VEECLR /NO
+ TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET
+ JMP I VEELIM /TO MAX NEGATIV
+
+VEEPOS, TAD VEEMIN /GREATER THAN MAX?
+ SPA CLA
+ JMP VEECLR /NO
+ TAD VEEMAX /YES SET TO MAX
+ JMP I VEELIM
+
+VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG
+ JMP I VEELIM
+
+VEEHLD, 0
+VEEMIN, -140
+VEEMAX, 140
+
+THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE
+ SMA /0-550 OR 0-360 DEGREES. THIS IS
+ JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW
+ TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE
+ JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC
+ TAD M550 /MODULO 360 AND EXITS
+ SMA
+ JMP .-2
+ TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T
+ JMP I THEAJI
+
+
+
+/
+/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED.
+/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND
+/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE
+/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY
+/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF
+/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT
+/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE
+/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE
+/ INTERGALACTIC DUST.
+/
+
+
+ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET
+ TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR
+ DCA MESS /AND SET GAMOVR FLAG
+ IAC
+ DCA GAMOVR
+ JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE
+
+TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET
+ TAD MES2 /AND TWO FIN IS NOT
+ DCA MESS /SET ALSO GAMOVR
+ IAC
+ DCA GAMOVR
+ JMP I TWOWIN
+
+NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN
+ DCA MESS /ARE SET .
+ IAC
+ DCA GAMOVR /NOBODY EVER REALLY WINDS
+ /UP THE WINNER IN THESE THINGS
+JOBLOP,
+/ DSB 1 /THIS IS ENTERED FROM FINISH WHEN
+ TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY
+ JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN
+ TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT
+ JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED
+ TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS
+ JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED
+ TAD MES3
+ JMS I MESOUT
+FINITO, JMP JOBLOP
+
+MES0, MESS0
+MES1, MESS1
+MES2, MESS2
+MES3, MESS3
+MES4, MESS4
+MES5, MESS5
+MESS, 0
+
+
+
+/
+/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED
+/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER
+/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT
+/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES
+/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES
+/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER
+/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT
+/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE
+/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO
+/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN
+/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH
+/ THIS WAS STOLEN HAD FULL WORD PRECISION.
+/
+
+ *6400
+
+SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT
+ DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD
+ TAD SINEIN
+ DCA I SINPSH
+ ISZ SINPSH
+ TAD SINARG
+ SZA
+ JMP SINNG2
+
+SINPOP, CLA CLL CMA
+ TAD SINPSH
+ DCA SINPSH
+ TAD I SINPSH
+ DCA SINEIN
+ TAD SINARG
+ JMP I SINEIN
+
+SINNG2, SMA
+ JMP SINPOS
+ CIA
+ JMS SINEIN
+
+SINNEG, CIA
+ DCA SINARG
+ JMP SINPOP
+
+SINPOS, TAD M264
+ SPA
+ JMP .+2
+ JMP SINNEG-1
+ TAD P132
+ SPA
+ JMP SINELK
+ SZA CLA
+ JMP .+3
+ TAD P37
+ JMP SINNEG+1
+
+ TAD SINARG
+ TAD M264
+ JMP SINNEG-1
+
+SINELK, TAD P132
+ TAD SINTAB
+ DCA SINEIN
+ TAD I SINEIN
+ DCA SINARG
+ JMP SINPOP
+
+
+
+
+SINARG, 0
+SINPSH, SINLST
+SINLST, 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+SINTAB, SINES-1
+
+COSINI, 0
+ CIA
+ TAD P132
+ JMS SINEIN
+ JMP I COSINI
+
+
+
+
+SINES, 00 /1
+ 01 /2
+ 01 /3
+ 02 /4
+ 02 /5
+ 03 /6
+ 03 /7
+ 04 /8
+ 05 /9
+ 05 /10
+ 06 /11
+ 06 /12
+ 07 /13
+ 07 /14
+ 10 /15
+ 10 /16
+ 11 /17
+ 11 /18
+ 12 /19
+ 12 /20
+ 13 /21
+ 13 /22
+ 14 /23
+ 15 /24
+ 15 /25
+ 16 /26
+ 16 /27
+ 17 /28
+ 17 /29
+ 20 /30
+ 20 /31
+ 20 /32
+ 21 /33
+ 21 /34
+ 22 /35
+ 22 /36
+ 23 /37
+ 23 /38
+ 24 /39
+ 24 /40
+ 25 /41
+ 25 /42
+ 25 /43
+ 26 /44
+ 26 /45
+ 27 /46
+ 27 /47
+ 27 /48
+ 30 /49
+ 30 /50
+ 30 /51
+ 31 /52
+ 31 /53
+ 31 /54
+ 32 /55
+ 32 /56
+ 32 /57
+ 33 /58
+ 33 /59
+ 33 /60
+ 33 /61
+ 34 /62
+ 34 /63
+ 34 /64
+ 35 /65
+ 35 /66
+ 35 /67
+ 35 /68
+ 35 /69
+ 36 /70
+ 36 /71
+ 36 /72
+ 36 /73
+ 36 /74
+ 36 /75
+ 37 /76
+ 37 /77
+ 37 /78
+ 37 /79
+ 37 /80
+ 37 /81
+ 37 /82
+ 37 /83
+ 37 /84
+ 37 /85
+ 37 /86
+ 37 /87
+ 37 /88
+ 37 /89
+
+
+
+
+MULTI, 0 /THIS IS STANDARD SINGLE PRECISION
+ CLL /MULTIPLY ROUTINE WHICH WAS ONCE
+ SPA /USED. I'VE LEFT IT IN SINCE
+ CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND
+ DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT
+ DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE
+ TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT
+ SNA /LABELS
+ JMP MULPSN+2
+ SPA
+ CMA CML IAC
+ DCA MULMP2
+ TAD MULTHR
+ DCA MULMP3
+
+MULMP4, TAD MULMP1
+ RAR
+ DCA MULMP1
+ TAD MULMP5
+ SZL
+ TAD MULMP2
+ CLL RAR
+ DCA MULMP5
+ ISZ MULMP3
+ JMP MULMP4
+ TAD MULMP1
+ RAR
+MULPSN, SZL
+ JMP MULCMP
+ DCA MULMP1
+ TAD MULMP5
+MULMPZ, ISZ MULTI
+ JMP I MULTI
+
+MULCMP, CMA CLL IAC
+ DCA MULMP1
+ TAD MULMP5
+ CMA
+ SZL
+ IAC
+ JMP MULMPZ
+
+MULTHR, 7764
+MULMP1, 0
+MULMP5, 0
+MULMP2, 0
+MULMP3, 0
+
+
+
+/
+/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE
+/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS
+/
+
+
+SHIFTR, 0
+ CLL
+ SPA
+ CML IAC
+ RAR
+ JMP I SHIFTR
+
+
+/
+/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS
+/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING
+/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION
+/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND
+/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR
+/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER
+/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT....
+/
+
+POSCAL, 0
+ TAD CALSIN
+
+ DCA T10SIN
+ TAD T10SIN
+ CLL RAL
+ DCA T20SIN
+ TAD T10SIN
+ TAD T20SIN
+ DCA T30SIN
+
+ TAD CALCOS
+
+ DCA T10COS
+ TAD T10COS
+ CLL RAL
+ DCA T20COS
+ TAD T10COS
+ TAD T20COS
+ DCA T30COS
+ JMP I POSCAL
+
+/****************************************************************
+/ VC8-E ROUTINES
+
+
+VDIV, 0
+ SMA / SKIP IF MINUS
+ JMP VPLUS
+VMINUS, CMA IAC / COMPLEMENT
+ RTR / DIVIDE BY FOUR
+ AND P1777 / DELETE UPPER TWO BITS
+ CMA IAC
+ JMP I VDIV / RETURN
+
+VPLUS, RTR
+ AND P1777
+ JMP I VDIV
+
+/*****
+
+VCLDX, 0 / INTENSIFY LAST POINT AND LOAD NEW X VALUE
+ JMS VDIV / DIVIDE BY FOUR
+ DISD / DISPLAY READY?
+ JMP .-1 / WAIT.
+ DIXY / INTENSIFY
+ DILX / LOAD NEW X VALUE
+ JMP I VCLDX / RETURN
+
+VCLDY, 0
+ JMS VDIV / DIVIDE BY FOUR
+ DILY / LOAD NEW Y VALUE
+ JMP I VCLDY
+
+P1777, 1777
+
+
+/****************************************************************
+
+
+ *7000
+
+/GENERAL PURPOSE SYMBOL GENERATOR
+/
+CHARS, 0 /ENTRY TO PLOT CHARACTER STRING
+ DCA ADDR /STORE STRING ADDRESS
+ TAD I ADDR /FETCH DOUBLE CHARACTER
+ RTR /SHIFT
+ RTR / FOR FIRST
+ RTR / CHARACTER
+ JMS CHAR /PLOT CHARACTER
+ SKP /NORMAL RETURN -- SKIP
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+ TAD I ADDR /RECALL DOUBLE CHARACTER
+ ISZ ADDR /ADVANCE STRING ADDRESS
+ JMS CHAR /PLOT CHARACTER
+ JMP CHARS+2 /NORMAL RETURN -- REPEAT
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+/
+CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER
+ AND K77 /MASK OUT UPPER BITS
+ CLL RAL /MULTIPLY CODE BY TWO
+ TAD TABLE /ADD TABLE BASE ADDRESS
+ DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE
+ CMA /INITIALIZE COUNTER FOR
+ DCA COUNT2 / TWO PLOT WORDS
+ TAD I POINT /FETCH FIRST PLOT WORD
+ ISZ POINT /INCREMENT POINTER FOR NEXT ONE
+ SNA /SKIP IF NOT SPECIAL CHARACTER
+ JMP SPCHAR /ELSE GO PROCESS IT
+ DCA CURPLT /SAVE CURRENT PLOT BITS
+XPLOT, TAD KM6 /INITIALIZE 6-BIT
+ DCA COUNT6 / COUNTER
+ TAD YVALUE /RESET Y TEMPORARY
+ DCA YTEMP / VALUE FOR CHARACTER
+ TAD XVALUE /OUTPUT CURRENT
+ DILX /X-VALUE TO CRT
+ TAD XINCR /INCREMENT
+ DCA XVALUE / ABSCISSA
+YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS
+ CLL RAL /GET NEXT BIT
+ DCA CURPLT /SAVE REMAINING PLOT BITS
+ SNL /SKIP IF POINT TO PLOT
+ JMP CNTINU /ELSE JUMP AHEAD
+ TAD YTEMP /OUTPUT CURRENT
+ DILY /Y-VALUE TO CRT
+ DISD / READY TO DISPLAY THE POINT?
+ JMP .-1 / NO, WE'LL WAIT.
+ DIXY / SHOOT THE BEAM!
+
+ CLA CLL /CLEAR AC
+ TAD CURPLT /RECALL CURRENT PLOT BITS
+ SNA CLA /SKIP IF POINTS REMAINING
+ JMP WRDEND /ELSE WORD IS FINISHED
+CNTINU, TAD YTEMP /INCREMENT TEMPORARY
+ TAD YINCR / Y-VALUE FOR NEXT
+ DCA YTEMP / CHARACTER STEP
+ ISZ COUNT6 /SKIP IF 6 BITS PLOTTED
+ JMP YPLOT /ELSE PLOT NEXT ONE
+ JMP XPLOT /GO UPDATE X-VALUE
+WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD
+ JMP EXIT /ELSE EXIT
+ TAD I POINT /FETCH SECOND BIT WORD
+ SZA /SKIP IF NO PLOT POINTS
+ JMP XPLOT-1 /ELSE GO PLOT THEM
+EXIT, TAD XVALUE /INCREMENT ABSCISSA
+ TAD XINCR / FOR SPACE BETWEEN
+ DCA XVALUE / SYMBOLS
+ JMP I CHAR /EXIT FROM CHAR
+/
+SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR
+ DCA POINT /STORE AS INDIRECT ADDRESS
+
+ JMP I POINT /GO TO APPROPRIATE ROUTINE
+SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT
+ CLL RTL /MULTIPLY BY FOUR AND
+ JMP EXIT / GO CREATE SPACE
+CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X
+ DCA XVALUE / TO ITS ORIGINAL VALUE
+LF, TAD YINCR /"LINE FEED"
+ CLL RTL / DECREMENTS THE
+ CLL CIA RAL / Y-VALUE BY
+ TAD YVALUE / EIGHT SCALE
+ DCA YVALUE / STEPS
+ JMP I CHAR /EXIT FROM CHAR
+RESET, TAD INITX /"RESET" RESETS
+ DCA XVALUE / X AND Y TO
+ TAD INITY / THEIR ORIGINAL
+ JMP RESET-2 / VALUES
+TERM, ISZ CHAR /TERMINATE CODE CAUSES
+ JMP I CHAR / EXIT TO P+2
+/
+INITX, 0 /INITIAL X-VALUE
+INITY, 327 /INITIAL Y-VALUE
+XVALUE, 0 /CURRENT X-VALUE
+YVALUE, 0 /CURRENT Y-VALUE
+XINCR, 6 /BASIC X INCREMENT VALUE
+YINCR, 10 /BASIC Y INCREMENT VALUE
+YTEMP, 0 /TEMPORARY Y-VALUE
+CURPLT, 0 /CURRENT PLOT BITS
+ADDR, 0 /CURRENT STRING ADDRESS
+COUNT6, 0 /6-BIT COUNTER
+COUNT2, 0 /2-WORD COUNTER
+KM6, -6 /CONSTANT FOR COUNT6
+K77, 77 /CHARACTER CODE MASK
+POINT, 0 /TABLE POINTER
+/
+
+
+/
+TABLE, .+1 /TABLE BASE ADDRESS
+ 0 /SPECIAL CHARACTER (00)
+ TERM /TERMINATION CODE
+ 7611 / A
+ 1176
+ 7745 / B
+ 4532
+ 3641 / C
+ 4122
+ 7741 / D
+ 4136
+ 7745 / E
+ 4541
+ 7705 / F
+ 501
+ 7741 / G
+ 5173
+ 7710 / H
+ 1077
+ 4177 / I
+ 4100
+ 2040 / J
+ 4037
+ 7714 / K
+ 2241
+ 7740 / L
+ 4040
+ 7702 / M
+ 277
+ 7706 / N
+ 3077
+ 7741 / O
+ 4177
+ 7705 / P
+ 502
+ 3641 / Q
+ 6176
+ 7715 / R
+ 2542
+ 2245 / S
+ 5122
+ 177 / T
+ 100
+ 3740 / U
+ 4037
+ 1720 / V
+ 4037
+ 7730 / W
+ 3077
+ 4136 / X
+ 3641
+ 374 / Y
+ 7403
+ 6151 / Z
+ 4543
+ 7741 / [
+ 0
+ 204 / \
+ 1020
+ 4177 / ]
+ 0
+ 436 / ^
+ 400
+ 0 /SPECIAL CHARACTER (37)
+ RESET /RESET
+ 0 /SPECIAL CHARACTER (40)
+ SPACE /SPACE
+ 5600 / !
+ 0
+ 303 / "
+ 0
+ 1477 / #
+ 7714
+ 2277 / MARKER
+ 2200
+ 2313 / %
+ 6462
+ 7777 / BLOCK
+ 7777
+ 300 / '
+ 0
+ 3641 / (
+ 0
+ 4136 / )
+ 0
+ 4040 / UNDERSCORE (52)
+ 4040
+ 1034 / +
+ 1000
+ 0 /SPECIAL CHARACTER (54)
+ LF /LINE FEED
+ 1010 / -
+ 1000
+ 4000 / .
+ 0
+ 2010 / /
+ 402
+ 3641 / 0
+ 4136
+ 4442 / 1
+ 7740
+ 4261 / 2
+ 5146
+ 2145 / 3
+ 5321
+ 1710 / 4
+ 1077
+ 4745 / 5
+ 4531
+ 7750 / 6
+ 5070
+ 6111 / 7
+ 503
+ 2255 / 8
+ 5522
+ 705 / 9
+ 577
+ 2400 / :
+ 0
+ 0 /SPECIAL CHARACTER (73)
+ CRLF /CARRIAGE RETURN; LINE FEED
+ 1024 / >
+ 4200
+ 1212 / =
+ 1200
+ 4224 / <
+ 1000
+ 255 / ?
+ 300
+
+
+
+/
+/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS
+/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE
+/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN.
+/
+
+MESS0, 3773
+MESS5, 7340
+ 4040
+ 4040
+ 4000
+
+MESS1, 1716
+ 0500
+
+MESS2, 2427
+ 1700
+
+MESS3, 2711
+ 1623
+ 4100
+
+MESS4, 1617
+ 0217
+ 0431
+ 0000
+
+
+
+ *7400
+
+DISBUF, 0
+
+/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO
+/ AROUND 7575 OR SO.
+/
+/
+/
+/
+/
+
+
+
+
+ $
+
+////////////////////////////
+/
+/ THIS IS THE END
+/
+///////////////////////////
+
+
+
+
+
+
--- /dev/null
+/ SPACE WAR
+/
+/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR
+/ LAB-8
+/
+/ EVAN SUITS
+/
+/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE
+/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE
+/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND
+/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 *
+/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED.
+/
+/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD
+/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP
+/ 'TWO' ON THE RIGHT.
+/
+/ THE COMMAND WORD BIT ASSIGNMENTS ARE:
+/
+/ SR BIT: C: FUNCTION:
+/
+/ 0 0 SHIP ONE ROTATES LEFT
+/
+/ 1 1 SHIP ONE ROTATES RIGHT
+/
+/ 2 2 SHIP ONE ACCELERATES
+/
+/ 3 3 SHIP ONE FIRES
+/
+/
+/
+/ 8 4 SHIP TWO ROTATES LEFT
+/
+/ 9 5 SHIP TWO ROTATES RIGHT
+/
+/ 10 6 SHIP TWO ACCELERATES
+/
+/ 11 7 SHIP TWO FIRES
+/
+/
+/
+/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS
+/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS
+/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER
+/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE
+/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER
+/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART.
+/
+
+
+/****************************************************************
+
+/***************************
+/ CLOCK OPERATIONS
+
+CLZE=6130 / CLEAR CLOCK ENABLE REGISTER PER AC
+CLSK=6131 / SKIP ON CLOCK FLAG
+CLOE=6132 / SET CLOCK ENABLE REGISTER PER AC
+CLAB=6133 / AC REGISTER TO CLOCK COUNTER REGISTER
+CLEN=6134 / CLOCK ENABLE REGISTER TO AC
+CLSA=6135 / STATUS TO AC
+CLBA=6136 / CLOCK BUFFER REGISTER TO AC
+CLCA=6137 / CLOCK COUNTER REGISTER TO AC
+
+/ BITS IN CLOCK ENABLE REGISTER
+CREXT=0100 / EXTERNAL SOURCE
+CR2=0200 / 10**2 per second
+CR3=0300 / 10**3 per second
+CR4=0400 / 10**4 per second
+CR5=0500 / 10**5 per second
+CR6=0600 / 10**6 per second
+
+COVSTAT=4000
+CMFREE=0000 / 4096 FIXED FREE RUN
+CMPROG=1000 / PROGRAMMED DELAY
+
+CADC=0040 / START ADC ON OVERFLOW
+CINH=0020 / INHIBIT CLOCK
+CION=0010 / INTERRUPT ENABLE
+
+CEV3=0004 / EVENT 3 ENABLED
+CEV2=0002 / EVENT 2 ENABLED
+CEV1=00001 / EVENT 1 ENABLED
+
+/ VC8-E OPCODES
+DIXY=6055 / INTENSIFY
+DILX=6053 / LOAD X
+DILY=6054 / LOAD Y
+DILE=6056 / LOAD ENABLES FROM A
+DISD=6052 / TEST FOR READY
+
+/****************************************************************
+/ SYMBOL DEFINITIONS FOR PAL8-PAL10
+
+XRIN=NOP / DIGITAL INPUT?
+XRCL=NOP
+
+/DSB=XXXX / SET BRIGHTNESS - MUST BE COMMENTED OUT!!!
+
+DXC=JMS I IVCLDX / X VALUE CONTROL?
+DYC=JMS I IVCLDY / Y VALUE CONTROL?
+
+DXL=0000 / X VALUE LOAD FLAG?
+DYL=0000 / Y VALUE LOAD FLAG?
+DIS=0000 / ANOTHER STRANGE FLAG
+
+/CRF=NOP / WHICH FLAG???
+/CCF=NOP / ??
+
+
+/****************************************************************
+/
+/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR
+/ REAL WORLD TIMING PURPOSES.
+/
+
+ *0
+
+ 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT
+ JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE
+ INTSER
+
+EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR
+ODT1, 0 /DEBUGGERS, ETC.
+ODT2, 0
+ODT3, 0
+
+/
+/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF
+/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT
+/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF
+/ THE CODE.
+/
+
+ *10
+
+AUTO10, 0
+AUTO11, 0
+AUTO12, 0
+AUTO13, 0
+AUTO14, 0
+AUTO15, 0
+AUTO16, 0
+AUTO17, 0
+
+/
+/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS
+/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS
+/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED
+/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED
+/
+
+ *20
+
+ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION
+ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED
+ONEFLG, 0 /IN OR OUT OF NORMAL SPACE
+ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN
+ONEVEX, 0 /X COMPONENT OF VELOCITY
+ONEVEY, 0 /Y COMPONENT OF VELOCITY
+ONEPEX, 0 /X POSITION (12 BITS)
+ONEPEY, 0 /Y POSITION (12 BITS)
+ONESIN, 0 /SINE OF ANGLE
+ONECOS, 0 /COSINE OF ANGLE
+ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT
+
+TWOOUT, 0 /SAME CONTENT AND ORDER
+TWOCNT, 0 /AS ABOVE
+TWOFLG, 0
+TWOTHE, 0
+TWOVEX, 0
+TWOVEY, 0
+TWOPEX, 0
+TWOPEY, 0
+TWOSIN, 0
+TWOCOS, 0
+TWOFIN, 0
+
+
+/
+/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN
+/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN
+/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM
+/
+
+XONEDS, 0
+YONEDS, 0
+XTWODS, 0
+YTWODS, 0
+DIXTEM, 0
+DIYTEM, 0
+DISCNT, 0
+
+
+/
+/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST
+/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES.
+/
+T10SIN, 0
+T20SIN, 0
+T30SIN, 0
+T10COS, 0
+T20COS, 0
+T30COS, 0
+
+CALSIN, 0
+CALCOS, 0
+
+/
+/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON
+/ PAGE ZERO
+/
+
+SINE, SINEIN
+COSINE, COSINI
+MULT, MULTI
+RSHIFT, SHIFTR
+VECTOR, DISPLY
+CALPOS, POSCAL
+INTWRD, 0
+INTCNT, 0
+/CLOCK, 0
+HYPER, HYPSET
+MESOUT, CHARS
+THEADJ, THEAJI
+VEESCL, VEELIM
+ISHFT, DISHFT
+RESET1, RESE1
+GAMOVR, 0
+ACCFLG, 0
+ACCPER, -30
+MEXP, -400
+
+PROX, 0
+PROY, 0
+PROLIF, -360
+BUFTMP, 0
+ONEFIL, DISBUF
+TWOFIL, DISBUF+40
+
+P5, 5
+P10, 10
+P17, 17
+P20, 20
+P37, 37
+P40, 40
+P100, 100
+P132, 132
+P200, 200
+P400, 400
+P550, 550
+P3777, 3777
+
+M4, -4
+M6, -6
+M10, -10
+M11, -11
+M264, -264
+M200, -200
+M400, -400
+M550, -550
+
+IVCLDX, VCLDX
+IVCLDY, VCLDY
+
+/
+/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200.
+/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED,
+/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES
+/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR
+/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT
+/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08
+/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY
+/ FILE UPDATE TO START OFF THE GAME.
+/
+
+ *200
+
+START, CLA CLL /START OR RESTART HERE ANY OLD TIME
+ DIXY /TO GET THE VC8-E STARTED ONCE
+ LAS /SR
+/TMP SNA CLA
+ TAD SWRD /USE THE SR
+ TAD XROPT /USE THE BLUE RIBBON CONNECTOR
+ DCA COLDST /AND LEAVE IN THE TRAP LOCATION
+
+RESTRT, CLA CMA
+ XRCL
+ CLA CLL
+
+ TAD P17 /FIRST CLEAR THE POSITION AND DATA
+ DCA AUTO10 /TABLES OF THE TWO SHIPS
+ TAD TABLEN
+ DCA AUTO11
+ DCA I AUTO10
+ ISZ AUTO11
+ JMP .-2
+
+ TAD STRT1 /SET THE STARTING POSITIONS OF THE
+ DCA ONEPEX /TWO SHIPS
+ TAD STRT2
+ DCA TWOPEX
+ TAD P37 /SET TRIG FUNCTIONS JUST IN CASE
+ DCA ONECOS
+ TAD P37
+ DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP
+ TAD ACCPER /SET COUNT FOR VELOCITY INCREASE
+ DCA ACCFLG
+ DCA ONEFIN /CLEAR ALL GAME END FLAGS
+ DCA TWOFIN
+ DCA GAMOVR
+ JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS
+
+
+ TCF /CLEAR OTHER REMAINING LIKELY FLAGS
+ PCF
+ RRB
+
+ CLA CMA / ALL ONES
+ CLZE / CLEAR CLOCK CONFIG REGISTER
+ CLA
+ TAD CDELY / LOAD NEG DELAY
+ CLAB / LOAD TO CLOCK BUFFER
+ CLA
+ TAD CCNF / LOAD CLOCK CONFIG
+ CLOE / SET CONFIG BITS
+
+ CLA CLL
+ JMP COLDST /AND GO TO IT
+
+CCNF, CR4+CMPROG+CION+COVSTAT / CLOCK CONFIGURATION
+CDELY, -310 / COUNTER PRESET (200)
+
+/
+/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE
+/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE
+/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT
+/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER
+/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN.
+/
+
+UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW.
+ /START NEXT SWEEP
+COLDST, 0 /TRAP TO READ SR OR BRC
+ LAS /HERE FOR SR
+ DCA INTWRD /STORE TEMPORARILY
+ TAD INTWRD /MASK OUT LEFTMOST 4 BITS
+ RTR /FOR NUMBER ONE
+ RTR
+ AND LFTHAF
+ DCA INTTEM /AND STORE
+ TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO
+ AND RYTHAF
+ TAD INTTEM /ADD TOGETHER
+ JMP .+3 /AND CONTINUE
+
+CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR
+ XRCL
+ DCA INTWRD /CONTINUE
+ TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT
+ DCA INTCNT /UPDATE
+ ION /GET READY FOR THE NEXT CYCLE
+ TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME?
+ IAC /ONLY WHEN ACCFLG=0
+ SMA SZA
+ TAD ACCPER /IF ZERO, RESET COUNT
+ DCA ACCFLG
+
+ JMP I .+1 /NOW GET DOWN TO WORK.
+ ONEUP
+
+BUFSET, SETBUF
+TABLEN, AUTO17-CALCOS
+INTTEM, 0
+LFTHAF, 0360
+RYTHAF, 0017
+STRT1, 1000
+STRT2, -1000
+SWRD, 2000-CODST
+XROPT, JMP CODST
+
+\f
+/
+/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE
+/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE
+/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS
+/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO
+/ UPDATE WITH IOF.
+/
+/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS
+/ SET IN WHICH CASE THE GAME IS RESTARTED.
+/
+/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM
+/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE
+/ STRANGE FLAG
+/
+
+INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE
+ RAR /AC AND LINK
+ DCA INTLNK /FOR POSSIBLE CONTINUATION
+ CLSK /WAS IT THE CRYSTAL CLOCK?
+ JMP INTBUS /NO TRY SOMETHING ELSE
+ CLA IAC RTR /LOAD 4000
+ CLSA /GET CLOCKSTATUS AND RESET FLAG
+ CLA CLL
+ JMP UPDATE /YES, GO TO IT
+
+INTBUS, KSF /HERE ON NON-CLOCK INTERUPT
+ JMP .+5 /NOT THE KEYBOARD
+ KCC /CLEAR KEYBOARD FLAG
+ TAD GAMOVR /IS THE GAMEOVER
+ SZA CLA
+ JMP RESTRT /YES, RESTART
+/ TCF /NO, HELL WITH IT
+ ISZ INTGLH /COUNT ONE BADDIE
+ SKP
+ HLT /HALT IF TOO MANY BADDIES
+
+INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT
+ TAD INTLNK
+ RAL
+ TAD INTACC
+ ION
+ JMP I 0
+
+INTACC, 0
+INTLNK, 0
+INTGLH, 0
+
+\f
+/
+/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP
+/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON
+/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS
+/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN,
+/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS
+/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS.
+/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR
+/ NUMBER TWO.
+/
+
+ *400
+
+ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP ONEOK /YES IT IS
+ IAC /NO, BUT IS IT JUST COMING OUT?
+ SNA
+ TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED
+ DCA ONEFLG /OTHERWISE JUST COUNT ONE
+ JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO
+
+ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING?
+ SZA CLA
+ JMP ONEFIG /IF YES, ALLOW NO CONTROLS
+ TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED?
+ SZA CLA
+ JMS I ONEWN /YES, SIGNAL VICTORY
+ TAD INTWRD /NOW BEGIN TEST OF REQUEST
+ AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE!
+ TAD OM300 /TEST BITS 4 AND 5
+ SZA CLA
+ JMP ONELEF /NOPE, CONTINUE
+ CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE
+ JMP I HYPER
+ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN?
+ AND P200 /TEST BIT 4
+ SNA CLA
+ JMP ONERYT /NO
+ CLA CLL CMA /YES DECREMENT ANGLE
+ JMP ONEFIG
+
+ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN
+ AND P100 /TEST BIT 5
+ SZA CLA
+ IAC /YES, INCREMENT ANGLE
+
+ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE)
+ JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS
+ DCA ONETHE /AND STORE
+ TAD ONETHE /FIND THEM TRIG FUNCTIONS
+ JMS I SINE /AND STORE ONCE AND FOR ALL
+ DCA ONESIN /IN THE APPROPRIATE PLACES
+ TAD ONETHE
+ JMS I COSINE
+ DCA ONECOS
+ TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING
+ SZA CLA
+ JMP ONEVEL
+
+\f
+
+ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE?
+ SZA CLA
+ JMP ONEVEL /NOPE
+ TAD INTWRD /YES, ANY REQUESTED?
+ AND P40 /TEST BIT 6
+ SNA CLA
+ JMP ONEVEL /NONE REQUESTED
+ TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING
+ TAD ONEVEY /ON ORIENTATION
+ JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM
+ DCA ONEVEY /AND STORE
+ TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT
+ TAD ONEVEX
+ JMS I VEESCL
+ DCA ONEVEX
+
+
+
+ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE
+ JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4
+ JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION
+ TAD ONEPEX
+ DCA ONEPEX /IGNORE ANY OVERFLOW
+ TAD ONEVEY /DO THE SAME FOR Y COORDINATE
+ JMS I ISHFT /AND VELOCITY COMPONENT
+ JMS I ISHFT
+ TAD ONEPEY
+ DCA ONEPEY
+ TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF
+ SZA CLA /EXPLODING
+ JMP I ITWOUP
+
+\f
+
+ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED
+ SNA CLA
+ JMP .+3
+ ISZ LNC1FG /NO, CONTINUE RELOADING
+ JMP I ITWOUP /AND EXIT
+ TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED?
+ AND P20 /TEST BIT7
+ SNA CLA
+ JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT
+ /.....I GUESS.....
+ TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH
+ DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE
+ TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE)
+ JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY
+ JMS I RSHIFT /COMPONENT OF PROJECTILE
+ TAD ONESIN
+ JMS I RSHIFT /AND STICK IT IN THE FILE
+ DCA I AUTO16
+ TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE
+ CLL RTL /SHIP OF ORIGIN
+ TAD ONEPEX
+ DCA I AUTO16 /AND STORE X POSITION
+ TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND
+ JMS I ISHFT /POSITION
+ JMS I RSHIFT
+ TAD ONECOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD ONECOS
+ CLL RTL
+ TAD ONEPEY
+ DCA I AUTO16
+ TAD M200 /START RELOAD CYCLE
+ DCA LNC1FG
+ JMS I RESET1 /RESET AUTO16 TO NEXT HOLE
+
+ JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO
+ITWOUP, TWOUP
+
+LNC1FG, 0 /PROJECTILE LAUNCH ENABLE
+
+OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5
+OM300, -300
+ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE
+
+\f
+/
+/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO.
+/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE.
+/
+
+ *600
+
+TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE
+ SNA
+ JMP TWOOK /YES, CONTINUE
+ IAC /NO, BUMP COUNT AND TEST FOR REENTRY
+ SNA
+ TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED
+ DCA TWOFLG /AND CONTINUE
+ JMP I IONEST
+
+TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE
+ SZA CLA /IS IT EXPLODING?
+ JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE
+ TAD ONEFIN /DID WE JUST WIN?
+ SZA CLA
+ JMS I TWOWN /YES ENABLE END OF GAME MESSAGE
+ TAD INTWRD /TEST FOR HYPERSPACE REQUEST
+ AND OP14
+ TAD OM14 /BITS 8 AND 9 MUST BE SET
+ SNA CLA
+ JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0
+ /FOR SHIP NUMBER 2
+TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8
+ AND P10
+ SNA CLA
+ JMP TWORYT /NOT SET
+ CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE
+ JMP TWOFIG /SKIP TEST FOR RIGHT TURN
+
+TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9
+ AND INTWRD
+ SZA CLA
+ IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE
+
+TWOFIG, TAD TWOTHE /UPDTAE TWOTHE
+ JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE
+ DCA TWOTHE /AND STORE
+ TAD TWOTHE
+ JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS
+ DCA TWOSIN /AND STORE IN DATA TABLE
+ TAD TWOTHE
+ JMS I COSINE
+ DCA TWOCOS
+ TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING
+ SZA CLA
+ JMP TWOVEL
+
+\f
+
+TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED
+ SZA CLA /DURING THIS UPDATE CYCLE
+ JMP TWOVEL /NOPE
+ CLL IAC RAL /YES, TEST FOR BIT 2 SET
+ AND INTWRD
+ SNA CLA
+ JMP TWOVEL /NOT SET
+
+ TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF
+ TAD TWOVEX /ANGLE OF ORIENTATION
+ JMS I VEESCL /AND SCALE TO NOT EXCEED MAX
+ DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE
+
+ TAD TWOCOS
+ TAD TWOVEY
+ JMS I VEESCL
+ DCA TWOVEY
+
+
+
+TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY
+ JMS I ISHFT /COMPONENTS/16
+ JMS I ISHFT
+ TAD TWOPEX
+ DCA TWOPEX
+ TAD TWOVEY
+ JMS I ISHFT
+ JMS I ISHFT
+ TAD TWOPEY
+ DCA TWOPEY
+ TAD TWOOUT
+ SZA CLA
+ JMP I IONEST
+
+\f
+
+TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST
+ SNA CLA /TEST TO SEE IF RELOAD COMPLETE
+ JMP .+3
+ ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT
+ JMP I IONEST
+ IAC /YES, TEST TRIGGER BIT 11
+ AND INTWRD
+ SNA CLA
+ JMP I IONEST /NOT SET, HELL WITH IT
+
+ TAD PROLIF /OK, SET PROJECTILE LIFE
+ DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT
+ TAD TWOVEX /ADD SHIPS VELOCITY
+ JMS I ISHFT /(ADJUSTED)
+ JMS I RSHIFT
+ TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT
+ JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION
+ DCA I AUTO16
+ TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD
+ CLL RTL /OF THE SHIP
+ TAD TWOPEX /X COMPONENT
+ DCA I AUTO16
+ TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY
+ JMS I ISHFT /Y POSITION AND COSINE
+ JMS I RSHIFT
+ TAD TWOCOS
+ JMS I RSHIFT
+ DCA I AUTO16
+ TAD TWOCOS
+ CLL RTL
+ TAD TWOPEY
+ DCA I AUTO16
+ TAD M200
+ DCA LNC2FG /200 CYCLES OF RELOAD
+ JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE!
+
+ JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS
+IONEST, ONESET
+
+LNC2FG, 0 /RELOAD COUNT
+
+OP14, 14 /HYPERSPACE CODE
+OM14, -14
+TWOWN, TWOWIN
+
+\f
+/
+/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT
+/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL
+/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY
+/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE
+/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN
+/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE
+/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS
+/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE
+/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE:
+/
+/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE]
+/
+/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE]
+/
+/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE
+/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE
+/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL)
+/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE
+/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND
+/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES
+/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS
+/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE
+/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS.
+/
+/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7
+/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED.
+/
+/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED
+/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE.
+/
+
+
+ *1000
+
+ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE
+ TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE
+ SZA CLA
+ JMP I ITWOST
+ TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS
+ DCA CALSIN
+ TAD ONECOS
+ DCA CALCOS
+ JMS I CALPOS /CALL THE CALCULATOR
+
+/
+/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE
+/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES
+/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE
+/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED
+/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y
+/ DISPLACED BY X,Y OF THE SHIP ITSELF
+/
+
+ TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE
+ DCA AUTO10 /POINTER
+ TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS
+ TAD T30SIN
+ DCA I AUTO10 / 0,3 OR TOP CENTER
+ TAD ONEPEY
+ TAD T30COS
+ DCA I AUTO10
+
+ TAD T10COS
+ CIA /THE SECOND IS
+ TAD ONEPEX
+ DCA I AUTO10 / -1,0
+ TAD T10SIN /OR JUST LEFT OF DEAD CENTER
+ TAD ONEPEY /AND SO ON
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD T30COS /THE THIRD POINT IS
+ CIA
+ TAD ONEPEX / -3,-3
+ DCA I AUTO10
+ TAD T30COS /OR BOTTOM LEFT HAND CORNER
+ CIA
+ TAD T30SIN
+ TAD ONEPEY
+ DCA I AUTO10
+
+\f
+
+ TAD T10SIN
+ CIA /FOURTH POINT
+ TAD ONEPEX
+ DCA I AUTO10 / 0,-1
+ TAD T10COS
+ CIA /OR JUST BELOW CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE
+ AND P40 /FLAME WITH AN EXTRA POINT SOME
+ SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP
+ JMP ONECON /POWER NOT ON - CONTINUE
+ TAD ONEOUT /DO NOT ALLOW IF EXPLODING
+ SZA CLA
+ JMP ONECON
+
+ TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND
+ SNA /OFF TO MAKE IT FLICKER. DISPLAY THE
+ CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE
+ DCA ONFG1
+
+ ISZ ONFG1
+ JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP
+
+ TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME
+ CMA /WITH LONG SHORT LONG SHORT
+ DCA ONFG2
+
+ TAD ONFG2 /TIP OF FLAME AT EITHER
+ SNA CLA
+ TAD T10SIN / 0,-4 OR
+ TAD T30SIN / 0,-3
+ CIA
+ TAD ONEPEX
+ DCA I AUTO10
+ TAD ONFG2
+ SNA CLA
+ TAD T10COS
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10SIN
+ CIA
+ TAD ONEPEX /RETURN DISPLAY TO 0,-1
+ DCA I AUTO10
+ TAD T10COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+\f
+
+ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8
+ DCA ONECNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT
+ CIA
+ TAD T30COS / AT 3,-3
+ TAD ONEPEX /
+ DCA I AUTO10 /OR LOWER RIGHT HAND CORNER
+ TAD T30SIN
+ TAD T30COS
+ CIA
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T10COS /NEXT
+ TAD ONEPEX /
+ DCA I AUTO10 / 1,0
+ TAD T10SIN /
+ CIA / OR JUST RIGHT OF CENTER
+ TAD ONEPEY
+ DCA I AUTO10
+
+ TAD T30SIN /FINALLY BACK TO
+ TAD ONEPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD ONEPEY / TOP CENTE
+ DCA I AUTO10
+
+ JMP I ITWOST /NOW FOR NUMBER TWO
+ITWOST, TWOSET
+
+ONFG1, 0 /USED TO COUNT FLICKERS
+ONFG2, 0 /SHORT OR LONG FLAG
+
+\f
+/
+/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO.
+/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH
+/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS
+/
+
+ *1200
+
+TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE
+ TAD TWOFLG
+ SZA CLA
+ JMP I IFILDS
+ TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS
+ DCA CALSIN /CALCULATED
+ TAD TWOCOS
+ DCA CALCOS
+ JMS I CALPOS
+
+ TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY
+ DCA AUTO10 /FILE
+ TAD T30SIN /FIRST POINT AT
+ TAD TWOPEX /
+ DCA I AUTO10 / 0,3
+ TAD T30COS /
+ TAD TWOPEY / OR TOP CENTER
+ DCA I AUTO10
+
+ TAD T20COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD T20COS /SECOND POINT
+ TAD TWOPEY / -2,2
+ DCA I AUTO10
+
+ TAD T20COS /THIRD POINT
+ CIA / -2,0
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS
+ TAD T30SIN
+ CIA
+ TAD TWOPEX /FOURTH POINT
+ DCA I AUTO10 / -2,-3
+ TAD T30COS
+ CIA
+ TAD T20SIN
+ TAD TWOPEY
+ DCA I AUTO10
+
+\f
+
+ TAD T20SIN
+ CIA /NEXT
+ TAD TWOPEX / 0,-2
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON
+ AND INTWRD
+ SNA CLA
+ JMP TWOCON /NO, FORGET IT
+ TAD TWOOUT /NOT ALLOWED IF EXPLODING
+ SZA CLA
+ JMP TWOCON
+
+ TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1
+ SNA
+ CLA CLL CMA RAL
+ DCA TWFG1
+
+ ISZ TWFG1 /ALSO THE LENGHT VARIATION
+ JMP TWOCON
+
+ TAD TWFG2 /EVERY OTHER TIME LONG
+ CMA
+ DCA TWFG2
+ /FLAME TIP AT EITHER
+ TAD TWFG2 / 0,-3
+ SNA CLA /OR
+ TAD T20SIN / 0,-5
+ TAD T30SIN
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD TWFG2
+ SNA CLA
+ TAD T20COS
+ TAD T30COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20SIN /NOW BACK UP TO THE SHIP
+ CIA
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T20COS
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ CLA CLL CMA RAL /ADD -2 TO POINT COUNT
+
+\f
+
+TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10
+ DCA TWOCNT
+
+ TAD T30SIN /CONTINUE WITH DISPLAY FILE
+ CIA /NEXT POINT AT 2,-3
+ TAD T20COS
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+
+
+ TAD T20COS /NEXT POINT
+ TAD TWOPEX /
+ DCA I AUTO10 / 2,0
+ TAD T20SIN
+ CIA
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T20COS /AND THE NEXT AT
+ TAD T20SIN
+ TAD TWOPEX / 2,2
+ DCA I AUTO10
+ TAD T20SIN
+ CIA
+ TAD T20COS
+ TAD TWOPEY
+ DCA I AUTO10
+
+ TAD T30SIN
+ TAD TWOPEX
+ DCA I AUTO10
+ TAD T30COS /AND THE LAST AT
+ TAD TWOPEY /
+ DCA I AUTO10 / 0,3
+
+ JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS
+IFILDS, FILDIS
+
+TWFG1, 0 /FLIK THE FLAME
+TWFG2, 0 /LONG OR SHORT
+
+\f
+/
+/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION
+/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END
+/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS
+/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR
+/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES.
+/
+
+ *1400
+
+FILDIS, CLA CLL /ALL SET TO GO
+ JMS I COLIDE /TEST FOR COLLISION FIRST
+/ DSB 1 /IF NO COLLISION
+ TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL
+ SZA CLA /SPACE
+ JMP TWODIS
+
+ TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE
+ DCA AUTO10 /FOR NUMBER ONE
+ TAD ONECNT /ALONG WITH VECTOR COUNT
+ DCA AUTO11
+ TAD I AUTO10 /SET OUT THE FIRST POINT PAIR
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION?
+ SZA CLA
+ JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION
+
+FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS
+ DCA XTWODS /SET X AND Y TO NEW POINT
+ TAD I AUTO10
+ DCA YTWODS
+ JMS I VECTOR /CALL THE DOT DRAWING MACHINE
+ ISZ AUTO11
+ SKP /COUNT
+ JMP TWODIS /DO NUMBER TWO ON OVERFLOW
+ TAD XTWODS /SWAP POINTS FOR NEXT PAIR
+ DCA XONEDS
+ TAD YTWODS /THE GENERATOR DRAWS FROM ONE
+ DCA YONEDS /TOWARDS TWO
+ JMP FILONE
+
+\f
+
+TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO
+ SZA CLA /BUT NOT IF IN HYPER SPACE
+ JMP I IPRODS
+
+ TAD TWOFIL /SET UP FILE POINTER AS IN ONE
+ DCA AUTO10
+ TAD TWOCNT /AND THE COUNT
+ DCA AUTO11
+ TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO
+ DCA XONEDS
+ TAD I AUTO10
+ DCA YONEDS
+ TAD TWOOUT /IS IT EXPLODING?
+ SZA CLA
+ JMP I ITWOEX /YES, HOW EXCITING
+
+TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF
+ DCA XTWODS /POINTS
+ TAD I AUTO10
+ DCA YTWODS /AND CALL THE VECTOR SEQUENCE
+ JMS I VECTOR
+ ISZ AUTO11
+ JMP .+3
+
+ JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO
+IPRODS, PRODIS /DO THE PROJECTILE THING
+
+ TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR
+ DCA XONEDS /OF POINTS
+ TAD YTWODS
+ DCA YONEDS
+ JMP TWDLOP
+
+COLIDE, COLLID
+IONEEX, ONEEXP
+ITWOEX, TWOEXP
+
+\f
+/
+/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A
+/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS.
+/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND
+/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT
+/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE.
+/
+
+DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR
+ CLA
+ TAD XONEDS /FROM XONEDS,YONEDS
+ CIA /TO XTWODS,YTWODS
+ TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO
+ JMS DISHFT /FOURTHS
+ DCA DIXTEM /AND STORE INCREMENT
+ TAD YONEDS
+ CIA
+ TAD YTWODS
+ JMS DISHFT /FOURTHS
+ DCA DIYTEM
+ TAD M4 /FOR FOUR DOTS
+ DCA DISCNT
+
+DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y
+ TAD DIXTEM
+ DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS
+ TAD YONEDS /XONEDS AND YONEDS
+ TAD DIYTEM
+ DCA YONEDS
+ TAD XONEDS
+/ RTR /DIVIDE BY 8 TO FIT SCREEN SIZE
+/ RAR
+ DXC DXL /SET X VALUE
+ CLA
+ TAD YONEDS /DO THE SAME FOR Y
+/ RTR
+/ RAR
+ DYC DYL DIS /AT LAST SOMETHING TO SEE!!
+ CLA
+ ISZ DISCNT /DONE YET?
+ JMP DISLOP /NOPE
+ JMP I DISPLY /YUP
+
+
+DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED
+ CLL /FROM EVERYWHERE TO DIVIDE THE
+ SPA /AC BY FOUR WITH AN ASR RIGHT
+ CML IAC /NOTE THAT NEGATIVE NUMBERS ARE
+ RAR /ROUNDED UPWARDS (TOWARD ZERO)
+ CLL /TO MAKE IT COME OUT RIGHT
+ SPA
+ CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS
+ RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES
+ JMP I DISHFT
+
+\f
+/
+/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS.
+/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH
+/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS
+/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR
+/ A HIT.
+/
+
+ *1600
+
+PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES
+ TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE
+ DCA BUFTMP
+/ DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS
+
+PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT
+ SNA
+ JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT
+ IAC /INCREMENT COUNT AND REPLACE
+ DCA I BUFTMP
+ ISZ BUFTMP /BUMP POINTER TO X VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION
+ TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST
+ ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY
+ TAD I BUFTMP
+ ISZ BUFTMP
+ TAD I BUFTMP /SAME LITTLE GAME
+ DCA I BUFTMP
+ TAD I BUFTMP
+ DCA PROY /STORE THE NEW Y VALUE
+
+ TAD PROX /DISPLAY THE POINT WITH
+/ RTR /THE SAME SHIFT AS FOR THE SHIPS
+/ RAR /FOR THE SMALL SCREEN
+ DXC DXL
+ CLA
+ TAD PROY
+/ RTR /
+/ RAR
+ DYC DYL DIS /THERE IT IS!!
+ CLA
+ JMS I CHKOUT /TEST FOR A HIT
+ ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END
+ TAD BUFTMP /OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP PROLOP /NOT AT END - CONTINUE
+
+\f/
+/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR
+/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP
+/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT
+/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE
+/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED
+/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING
+/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD
+/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT
+/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY.
+/
+
+
+FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT?
+ SZA CLA
+ JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE
+/ TAD M400 /MOVE THE BEAM OFF SCREEN
+/ DYC DYL
+ CLA CLL
+/ DXC DXL
+ TAD INTCNT /PICK UP THE COUNT
+ CIA
+ JMP .
+
+ENDGAM, JOBLOP
+
+
+EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER
+ TAD P5 /POINTER TO THE NEXT PROJECTILE
+ DCA BUFTMP /UNLESS THE END
+ TAD BUFTMP /OF THE BUFFER
+ TAD BUFLIM /IS REACHED
+ SZA CLA /IN WHICH CASE
+ JMP PROLOP /IT
+ JMP FINISH /QUITS
+
+BUFST, DISBUF+101
+BUFLIM, -DISBUF-175
+CHKOUT, CHECK
+
+RESE1, 0 /THIS IS CALLED TO SET THE POINTER
+ TAD MRES /(AUTO16) TO THE NEXT FREE SLOT
+ DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE
+
+RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT
+ TAD P5
+ DCA RESPNT
+ TAD RESPNT /RESTE IF AT END OF BUFFER
+ TAD BUFLIM
+ SZA CLA
+ JMP RESCON
+ TAD BUFST
+ DCA RESPNT
+
+RESCON, TAD I RESPNT /FIND A HOLE YET?
+ SNA CLA
+ JMP RESFND /YES, SET UP AUTO16
+ ISZ RESCNT /NO COUNT
+ JMP RESLOP /AND TRY AGAIN
+ HLT /NO HOLES AT ALL?
+
+RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING
+ TAD RESPNT
+ DCA AUTO16
+ JMP I RESE1
+
+MRES, -14
+RESCNT, 0
+RESPNT, 0
+
+SETBUF, 0
+ CMA /THIS ROUTINE IS CALLED FROM THE
+ TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL
+ DCA AUTO16 /THE BUFFER POINTERS AND SO ON
+ TAD BUFST
+ DCA BUFTMP
+ TAD BUFST
+ DCA RESPNT
+ TAD BUFST
+ DCA SETPNT
+SETLOP, DCA I SETPNT
+ ISZ SETPNT
+ TAD SETPNT
+ TAD BUFLIM
+ SZA CLA
+ JMP SETLOP
+ JMP I SETBUF
+
+SETPNT, 0
+
+\f
+/
+/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY
+/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN.
+/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE
+/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP
+/ IS SUITABLY FLAGGED
+/
+
+ *2000
+
+CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT
+ TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE
+ SZA CLA
+ JMP CHECK2
+ TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT
+ SZA CLA
+ JMP CHECK2
+
+ TAD PROX /CHECK X COORDINATES OF SHIP ONE
+ CIA /AND PROJECTILE
+ TAD ONEPEX /THIS SORT OF THING IS WHY THE
+ SPA /COORDINATES HAVE TO BE MAINTAINED TO 12
+ CIA /BITS
+ TAD LIMIT /CLOSE ENOUGH?
+ SMA CLA
+ JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT
+ TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y?
+ CIA
+ TAD ONEPEY
+ SPA
+ CIA
+ TAD LIMIT
+ SMA CLA
+ JMP CHECK2 /NO HIT
+
+ TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT
+ DCA ONEOUT /ALL THAT IS NECESSARY
+ JMS CUTOUT /REMOVE PROJECTILE
+
+\f
+
+CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO
+ SZA CLA
+ JMP I CHECK /BUT NOT IF IN HYPERSPACE
+ TAD TWOOUT /OR IF ALREADY HIT
+ SZA CLA
+ JMP I CHECK
+
+ TAD PROX /CHECK X'S FIRST
+ CIA
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY
+ SMA CLA /LIMIT
+ JMP I CHECK /NOWHERE NEAR CLOSE
+
+ TAD PROY /NYAH, NYAH
+ CIA /TRY THE Y'S
+ TAD TWOPEY
+ SPA
+ CIA /ABSOLUTE VALUE OF DIFFERENCE
+ TAD LIMIT
+ SMA CLA
+ JMP I CHECK /CLEAN MISS!
+
+ TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING
+ DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT
+ JMS CUTOUT
+ JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE
+
+LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT
+
+CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY
+ TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE
+ TAD BUFTMP /COUNT
+ DCA CUTPNT
+ DCA I CUTPNT
+ JMP I CUTOUT
+
+CUTPNT, 0
+
+\f
+/
+/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE
+/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED
+/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING
+/ THEIR EXPLOSION COUNTS NON-ZERO.
+/
+
+
+COLLID, 0 /HERE TO TEST FOR COLLISION
+ TAD ONEFLG /NO TEST IF EITHER SHIP IS IN
+ SZA CLA /HYPERSPACE OR EXPLODING
+ JMP I COLLID
+ TAD TWOFLG
+ SZA CLA
+ JMP I COLLID
+ TAD ONEOUT
+ SZA CLA
+ JMP I COLLID
+ TAD TWOOUT
+ SZA CLA
+ JMP I COLLID
+
+ TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION
+ CIA /CHECK X COORDINATES FIRST
+ TAD TWOPEX
+ SPA /GET ABSOLUTE VALUE OF DIFFERENCE
+ CIA
+ TAD COLLIM /CLOSE ENOUGH?
+ SMA CLA
+ JMP I COLLID /NOPE, FORGET IT
+
+ TAD ONEPEY /YES, NOW TRY THE Y COORDINATES
+ CIA
+ TAD TWOPEY
+ SPA
+ CIA /GET MAGNITUDE ONLY
+ TAD COLLIM
+ SMA CLA /CLOSE ENOUGH?
+ JMP I COLLID
+ TAD MEXP /YES, SET BOTH EXPLOSION COUNTS
+ DCA ONEOUT
+ TAD MEXP
+ DCA TWOOUT
+ JMP I COLLID
+
+COLLIM, -300
+\f
+/
+/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO
+/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP
+/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM
+/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE
+/ VARIOUS PARAMETERS FOR REENTRY.
+/
+
+ *2200
+
+HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0
+ TAD RTNFLG /SET UP LIST POINTER
+ SZA CLA
+ TAD ONEDIF /TO APPROPRIATE SHIP FILE
+ TAD TWOLST
+ DCA AUTO15
+
+ CLCA /SET UP "RANDOM NUMBER GENERATOR"
+ /USE CLOCK COUNTER FOR THAT PURPOSE
+ DCA AUTO17
+ TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME
+ AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777
+ CIA /UPDATE CYCLES ( ABOUT 15 SECONDS)
+ DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT
+
+ TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE
+ JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY
+ DCA I AUTO15
+ TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY
+ JMS VEESET /COMPONENT
+ DCA I AUTO15
+ TAD I AUTO17 /AND THEN THE Y COMPONENT
+ JMS VEESET
+ DCA I AUTO15
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17
+ DCA I AUTO15
+
+ TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY
+ AND TIMOUT
+ TAD MHYP /ABOUT 3/4 CHANCE
+ SMA CLA
+ JMP HYPRET /OK
+ TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET
+ SZA CLA /UP FOR EXPLOSION ON REENTRY
+ TAD ONEDIF
+ TAD OUTLOC
+ DCA VEESET
+ TAD MEXP
+ DCA I VEESET
+
+HYPRET, ISZ RTNFLG
+ JMP I TWORTN
+ JMP I ONERTN
+
+TIMOUT, 777
+ONEDIF, ONEFLG-TWOFLG
+TWOLST, TWOFLG-1
+RTNFLG, 0
+ONERTN, TWOUP
+TWORTN, ONESET
+OUTLOC, TWOOUT
+MHYP, -200
+
+\f
+
+VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS
+ CLL
+ SPA /GET MAGNITUDE
+ CML
+ AND HM177 /LIMIT TO 177
+ SZL CLL
+ CIA
+ JMP I VEESET /AND EXIT
+
+HM177, 177
+
+ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS
+ TAD ONETHE /AN EXPLOSION
+ TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP
+ DCA ONETHE
+ JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR
+ ISZ ONEOUT /DONE WITH THE EXPLOSION?
+ JMP I NOWTWO /NO, NORMAL RETURN
+
+ IAC /YES, SET INTO PSEUDO HYPER SPACE
+ DCA ONEFLG
+ IAC /DISABLE RETURN FROM HYPER SPACE
+ DCA ONEFIN
+
+ TAD TWOFIN /IS NUMBER TWO STILL AROUND?
+ SNA CLA
+ JMP I NOWTWO /YES, RETURN
+ JMP I TIEUP /NO, TIE BALL GAME
+\f
+
+TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO
+ TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND
+ TAD INCTWO
+ DCA TWOTHE
+ JMS I IXPDIS /THEN DISPLAY IT
+ ISZ TWOOUT /DONE WITH EXPLOSION?
+ JMP I NOWPRO /NO, NORMAL RETURN
+
+ IAC /YES, SEND INTO PSEUDO HYPER SPACE
+ DCA TWOFLG
+ IAC /DISABLE NORMAL RETURN FROM HYPERSPACE
+ DCA TWOFIN
+ /CHECK NUMBER ONE
+ TAD ONEFIN
+ SZA CLA /STILL ALIVE AND WELL?
+ JMP I TIEUP /NO, TIE GAME
+ JMP I NOWPRO /YES, CONTINUE ON
+NOWTWO, TWODIS
+NOWPRO, PRODIS
+TIEUP, NOWIN
+IXPDIS, EXPDIS
+INCONE, 55
+INCTWO, 55
+
+\f
+/
+/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS
+/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL
+/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS
+/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S
+/ A SORT OF CLOBBY EXPLOSION.
+/
+
+ *2400
+
+EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT
+ TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY
+ DCA XTWODS /SET UP BY FILDIS OR TWODIS
+ TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE
+ DCA YTWODS
+
+ TAD XTWODS
+ CIA /CALCULATE INCREMENT THE WRONG WAY
+ TAD XONEDS
+ DCA DIXTEM /AND STORE
+ TAD YTWODS
+ CIA
+ TAD YONEDS
+ DCA DIYTEM /SAME FOR Y
+
+ TAD M4 /4 DOTS IN THE VECTOR"
+ DCA DISCNT /COULD HAVE CALLED THE OTHER
+ /VECTOR GENERATOR I SUPPOSE
+EXPLOP, TAD XONEDS
+ TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING
+ DCA XONEDS /TOTALS AND DISPLAY THE RUNNING
+ TAD YONEDS /TOTALS NORMAL SIZE
+ TAD DIYTEM
+ DCA YONEDS
+
+ TAD XONEDS
+/ RTR /COULD MAKE TWICE AS BIG BY NOP-ING
+/ RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH
+ JMS I IVCLDX /AS IT IS
+ CLA
+ TAD YONEDS
+/ RTR
+/ RAR
+ JMS I IVCLDY
+/ DISD
+/ JMP .-1
+/ DIXY
+
+ CLA
+ ISZ DISCNT /DONE 4 DOTS?
+ JMP EXPLOP /NO
+
+ ISZ AUTO11 /DONE ALL VECTORS IN THE FILE?
+ SKP
+ JMP I EXPDIS /YES, EXIT
+
+ TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS
+ DCA XONEDS
+ TAD YTWODS
+ DCA YONEDS
+ JMP EXPDIS+1
+
+
+\f
+/
+/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS.
+/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140
+/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED
+/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y
+/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT
+/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE
+/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE.
+/
+
+
+VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN
+ DCA VEEHLD /AC
+ TAD VEEHLD
+ SMA /BRANCH FOR POSITIVE OR NEGATIV
+ JMP VEEPOS
+ TAD VEEMAX
+ SMA CLA /GREATER THAN MAXIMUM POSITIVE?
+ JMP VEECLR /NO
+ TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET
+ JMP I VEELIM /TO MAX NEGATIV
+
+VEEPOS, TAD VEEMIN /GREATER THAN MAX?
+ SPA CLA
+ JMP VEECLR /NO
+ TAD VEEMAX /YES SET TO MAX
+ JMP I VEELIM
+
+VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG
+ JMP I VEELIM
+
+VEEHLD, 0
+VEEMIN, -140
+VEEMAX, 140
+
+THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE
+ SMA /0-550 OR 0-360 DEGREES. THIS IS
+ JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW
+ TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE
+ JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC
+ TAD M550 /MODULO 360 AND EXITS
+ SMA
+ JMP .-2
+ TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T
+ JMP I THEAJI
+
+\f
+/
+/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED.
+/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND
+/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE
+/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY
+/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF
+/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT
+/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE
+/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE
+/ INTERGALACTIC DUST.
+/
+
+
+ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET
+ TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR
+ DCA MESS /AND SET GAMOVR FLAG
+ IAC
+ DCA GAMOVR
+ JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE
+
+TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET
+ TAD MES2 /AND TWO FIN IS NOT
+ DCA MESS /SET ALSO GAMOVR
+ IAC
+ DCA GAMOVR
+ JMP I TWOWIN
+
+NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN
+ DCA MESS /ARE SET .
+ IAC
+ DCA GAMOVR /NOBODY EVER REALLY WINDS
+ /UP THE WINNER IN THESE THINGS
+JOBLOP,
+/ DSB 1 /THIS IS ENTERED FROM FINISH WHEN
+ TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY
+ JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN
+ TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT
+ JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED
+ TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS
+ JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED
+ TAD MES3
+ JMS I MESOUT
+FINITO, JMP JOBLOP
+
+MES0, MESS0
+MES1, MESS1
+MES2, MESS2
+MES3, MESS3
+MES4, MESS4
+MES5, MESS5
+MESS, 0
+
+\f
+/
+/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED
+/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER
+/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT
+/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES
+/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES
+/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER
+/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT
+/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE
+/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO
+/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN
+/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH
+/ THIS WAS STOLEN HAD FULL WORD PRECISION.
+/
+
+ *6400
+
+SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT
+ DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD
+ TAD SINEIN
+ DCA I SINPSH
+ ISZ SINPSH
+ TAD SINARG
+ SZA
+ JMP SINNG2
+
+SINPOP, CLA CLL CMA
+ TAD SINPSH
+ DCA SINPSH
+ TAD I SINPSH
+ DCA SINEIN
+ TAD SINARG
+ JMP I SINEIN
+
+SINNG2, SMA
+ JMP SINPOS
+ CIA
+ JMS SINEIN
+
+SINNEG, CIA
+ DCA SINARG
+ JMP SINPOP
+
+SINPOS, TAD M264
+ SPA
+ JMP .+2
+ JMP SINNEG-1
+ TAD P132
+ SPA
+ JMP SINELK
+ SZA CLA
+ JMP .+3
+ TAD P37
+ JMP SINNEG+1
+
+ TAD SINARG
+ TAD M264
+ JMP SINNEG-1
+
+SINELK, TAD P132
+ TAD SINTAB
+ DCA SINEIN
+ TAD I SINEIN
+ DCA SINARG
+ JMP SINPOP
+
+\f
+
+SINARG, 0
+SINPSH, SINLST
+SINLST, 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+SINTAB, SINES-1
+
+COSINI, 0
+ CIA
+ TAD P132
+ JMS SINEIN
+ JMP I COSINI
+
+\f
+
+SINES, 00 /1
+ 01 /2
+ 01 /3
+ 02 /4
+ 02 /5
+ 03 /6
+ 03 /7
+ 04 /8
+ 05 /9
+ 05 /10
+ 06 /11
+ 06 /12
+ 07 /13
+ 07 /14
+ 10 /15
+ 10 /16
+ 11 /17
+ 11 /18
+ 12 /19
+ 12 /20
+ 13 /21
+ 13 /22
+ 14 /23
+ 15 /24
+ 15 /25
+ 16 /26
+ 16 /27
+ 17 /28
+ 17 /29
+ 20 /30
+ 20 /31
+ 20 /32
+ 21 /33
+ 21 /34
+ 22 /35
+ 22 /36
+ 23 /37
+ 23 /38
+ 24 /39
+ 24 /40
+ 25 /41
+ 25 /42
+ 25 /43
+ 26 /44
+ 26 /45
+ 27 /46
+ 27 /47
+ 27 /48
+ 30 /49
+ 30 /50
+ 30 /51
+ 31 /52
+ 31 /53
+ 31 /54
+ 32 /55
+ 32 /56
+ 32 /57
+ 33 /58
+ 33 /59
+ 33 /60
+ 33 /61
+ 34 /62
+ 34 /63
+ 34 /64
+ 35 /65
+ 35 /66
+ 35 /67
+ 35 /68
+ 35 /69
+ 36 /70
+ 36 /71
+ 36 /72
+ 36 /73
+ 36 /74
+ 36 /75
+ 37 /76
+ 37 /77
+ 37 /78
+ 37 /79
+ 37 /80
+ 37 /81
+ 37 /82
+ 37 /83
+ 37 /84
+ 37 /85
+ 37 /86
+ 37 /87
+ 37 /88
+ 37 /89
+
+\f
+
+MULTI, 0 /THIS IS STANDARD SINGLE PRECISION
+ CLL /MULTIPLY ROUTINE WHICH WAS ONCE
+ SPA /USED. I'VE LEFT IT IN SINCE
+ CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND
+ DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT
+ DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE
+ TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT
+ SNA /LABELS
+ JMP MULPSN+2
+ SPA
+ CMA CML IAC
+ DCA MULMP2
+ TAD MULTHR
+ DCA MULMP3
+
+MULMP4, TAD MULMP1
+ RAR
+ DCA MULMP1
+ TAD MULMP5
+ SZL
+ TAD MULMP2
+ CLL RAR
+ DCA MULMP5
+ ISZ MULMP3
+ JMP MULMP4
+ TAD MULMP1
+ RAR
+MULPSN, SZL
+ JMP MULCMP
+ DCA MULMP1
+ TAD MULMP5
+MULMPZ, ISZ MULTI
+ JMP I MULTI
+
+MULCMP, CMA CLL IAC
+ DCA MULMP1
+ TAD MULMP5
+ CMA
+ SZL
+ IAC
+ JMP MULMPZ
+
+MULTHR, 7764
+MULMP1, 0
+MULMP5, 0
+MULMP2, 0
+MULMP3, 0
+
+\f
+/
+/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE
+/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS
+/
+
+
+SHIFTR, 0
+ CLL
+ SPA
+ CML IAC
+ RAR
+ JMP I SHIFTR
+
+
+/
+/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS
+/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING
+/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION
+/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND
+/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR
+/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER
+/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT....
+/
+
+POSCAL, 0
+ TAD CALSIN
+
+ DCA T10SIN
+ TAD T10SIN
+ CLL RAL
+ DCA T20SIN
+ TAD T10SIN
+ TAD T20SIN
+ DCA T30SIN
+
+ TAD CALCOS
+
+ DCA T10COS
+ TAD T10COS
+ CLL RAL
+ DCA T20COS
+ TAD T10COS
+ TAD T20COS
+ DCA T30COS
+ JMP I POSCAL
+
+/****************************************************************
+/ VC8-E ROUTINES
+
+
+VDIV, 0
+ SMA / SKIP IF MINUS
+ JMP VPLUS
+VMINUS, CMA IAC / COMPLEMENT
+ RTR / DIVIDE BY FOUR
+ AND P1777 / DELETE UPPER TWO BITS
+ CMA IAC
+ JMP I VDIV / RETURN
+
+VPLUS, RTR
+ AND P1777
+ JMP I VDIV
+
+/*****
+
+VCLDX, 0 / INTENSIFY LAST POINT AND LOAD NEW X VALUE
+ JMS VDIV / DIVIDE BY FOUR
+ DISD / DISPLAY READY?
+ JMP .-1 / WAIT.
+ DIXY / INTENSIFY
+ DILX / LOAD NEW X VALUE
+ JMP I VCLDX / RETURN
+
+VCLDY, 0
+ JMS VDIV / DIVIDE BY FOUR
+ DILY / LOAD NEW Y VALUE
+ JMP I VCLDY
+
+P1777, 1777
+
+
+/****************************************************************
+
+
+ *7000
+
+/GENERAL PURPOSE SYMBOL GENERATOR
+/
+CHARS, 0 /ENTRY TO PLOT CHARACTER STRING
+ DCA ADDR /STORE STRING ADDRESS
+ TAD I ADDR /FETCH DOUBLE CHARACTER
+ RTR /SHIFT
+ RTR / FOR FIRST
+ RTR / CHARACTER
+ JMS CHAR /PLOT CHARACTER
+ SKP /NORMAL RETURN -- SKIP
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+ TAD I ADDR /RECALL DOUBLE CHARACTER
+ ISZ ADDR /ADVANCE STRING ADDRESS
+ JMS CHAR /PLOT CHARACTER
+ JMP CHARS+2 /NORMAL RETURN -- REPEAT
+ JMP I CHARS /TERMINATION RETURN -- EXIT
+/
+CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER
+ AND K77 /MASK OUT UPPER BITS
+ CLL RAL /MULTIPLY CODE BY TWO
+ TAD TABLE /ADD TABLE BASE ADDRESS
+ DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE
+ CMA /INITIALIZE COUNTER FOR
+ DCA COUNT2 / TWO PLOT WORDS
+ TAD I POINT /FETCH FIRST PLOT WORD
+ ISZ POINT /INCREMENT POINTER FOR NEXT ONE
+ SNA /SKIP IF NOT SPECIAL CHARACTER
+ JMP SPCHAR /ELSE GO PROCESS IT
+ DCA CURPLT /SAVE CURRENT PLOT BITS
+XPLOT, TAD KM6 /INITIALIZE 6-BIT
+ DCA COUNT6 / COUNTER
+ TAD YVALUE /RESET Y TEMPORARY
+ DCA YTEMP / VALUE FOR CHARACTER
+ TAD XVALUE /OUTPUT CURRENT
+ DILX /X-VALUE TO CRT
+ TAD XINCR /INCREMENT
+ DCA XVALUE / ABSCISSA
+YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS
+ CLL RAL /GET NEXT BIT
+ DCA CURPLT /SAVE REMAINING PLOT BITS
+ SNL /SKIP IF POINT TO PLOT
+ JMP CNTINU /ELSE JUMP AHEAD
+ TAD YTEMP /OUTPUT CURRENT
+ DILY /Y-VALUE TO CRT
+ DISD / READY TO DISPLAY THE POINT?
+ JMP .-1 / NO, WE'LL WAIT.
+ DIXY / SHOOT THE BEAM!
+
+ CLA CLL /CLEAR AC
+ TAD CURPLT /RECALL CURRENT PLOT BITS
+ SNA CLA /SKIP IF POINTS REMAINING
+ JMP WRDEND /ELSE WORD IS FINISHED
+CNTINU, TAD YTEMP /INCREMENT TEMPORARY
+ TAD YINCR / Y-VALUE FOR NEXT
+ DCA YTEMP / CHARACTER STEP
+ ISZ COUNT6 /SKIP IF 6 BITS PLOTTED
+ JMP YPLOT /ELSE PLOT NEXT ONE
+ JMP XPLOT /GO UPDATE X-VALUE
+WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD
+ JMP EXIT /ELSE EXIT
+ TAD I POINT /FETCH SECOND BIT WORD
+ SZA /SKIP IF NO PLOT POINTS
+ JMP XPLOT-1 /ELSE GO PLOT THEM
+EXIT, TAD XVALUE /INCREMENT ABSCISSA
+ TAD XINCR / FOR SPACE BETWEEN
+ DCA XVALUE / SYMBOLS
+ JMP I CHAR /EXIT FROM CHAR
+/
+SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR
+ DCA POINT /STORE AS INDIRECT ADDRESS
+\f JMP I POINT /GO TO APPROPRIATE ROUTINE
+SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT
+ CLL RTL /MULTIPLY BY FOUR AND
+ JMP EXIT / GO CREATE SPACE
+CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X
+ DCA XVALUE / TO ITS ORIGINAL VALUE
+LF, TAD YINCR /"LINE FEED"
+ CLL RTL / DECREMENTS THE
+ CLL CIA RAL / Y-VALUE BY
+ TAD YVALUE / EIGHT SCALE
+ DCA YVALUE / STEPS
+ JMP I CHAR /EXIT FROM CHAR
+RESET, TAD INITX /"RESET" RESETS
+ DCA XVALUE / X AND Y TO
+ TAD INITY / THEIR ORIGINAL
+ JMP RESET-2 / VALUES
+TERM, ISZ CHAR /TERMINATE CODE CAUSES
+ JMP I CHAR / EXIT TO P+2
+/
+INITX, 0 /INITIAL X-VALUE
+INITY, 327 /INITIAL Y-VALUE
+XVALUE, 0 /CURRENT X-VALUE
+YVALUE, 0 /CURRENT Y-VALUE
+XINCR, 6 /BASIC X INCREMENT VALUE
+YINCR, 10 /BASIC Y INCREMENT VALUE
+YTEMP, 0 /TEMPORARY Y-VALUE
+CURPLT, 0 /CURRENT PLOT BITS
+ADDR, 0 /CURRENT STRING ADDRESS
+COUNT6, 0 /6-BIT COUNTER
+COUNT2, 0 /2-WORD COUNTER
+KM6, -6 /CONSTANT FOR COUNT6
+K77, 77 /CHARACTER CODE MASK
+POINT, 0 /TABLE POINTER
+/
+\f
+/
+TABLE, .+1 /TABLE BASE ADDRESS
+ 0 /SPECIAL CHARACTER (00)
+ TERM /TERMINATION CODE
+ 7611 / A
+ 1176
+ 7745 / B
+ 4532
+ 3641 / C
+ 4122
+ 7741 / D
+ 4136
+ 7745 / E
+ 4541
+ 7705 / F
+ 501
+ 7741 / G
+ 5173
+ 7710 / H
+ 1077
+ 4177 / I
+ 4100
+ 2040 / J
+ 4037
+ 7714 / K
+ 2241
+ 7740 / L
+ 4040
+ 7702 / M
+ 277
+ 7706 / N
+ 3077
+ 7741 / O
+ 4177
+ 7705 / P
+ 502
+ 3641 / Q
+ 6176
+ 7715 / R
+ 2542
+ 2245 / S
+ 5122
+ 177 / T
+ 100
+ 3740 / U
+ 4037
+ 1720 / V
+ 4037
+ 7730 / W
+ 3077
+ 4136 / X
+ 3641
+ 374 / Y
+ 7403
+ 6151 / Z
+ 4543
+ 7741 / [
+ 0
+ 204 / \
+ 1020
+ 4177 / ]
+ 0
+ 436 / ^
+ 400
+ 0 /SPECIAL CHARACTER (37)
+ RESET /RESET
+ 0 /SPECIAL CHARACTER (40)
+ SPACE /SPACE
+ 5600 / !
+ 0
+ 303 / "
+ 0
+ 1477 / #
+ 7714
+ 2277 / MARKER
+ 2200
+ 2313 / %
+ 6462
+ 7777 / BLOCK
+ 7777
+ 300 / '
+ 0
+ 3641 / (
+ 0
+ 4136 / )
+ 0
+ 4040 / UNDERSCORE (52)
+ 4040
+ 1034 / +
+ 1000
+ 0 /SPECIAL CHARACTER (54)
+ LF /LINE FEED
+ 1010 / -
+ 1000
+ 4000 / .
+ 0
+ 2010 / /
+ 402
+ 3641 / 0
+ 4136
+ 4442 / 1
+ 7740
+ 4261 / 2
+ 5146
+ 2145 / 3
+ 5321
+ 1710 / 4
+ 1077
+ 4745 / 5
+ 4531
+ 7750 / 6
+ 5070
+ 6111 / 7
+ 503
+ 2255 / 8
+ 5522
+ 705 / 9
+ 577
+ 2400 / :
+ 0
+ 0 /SPECIAL CHARACTER (73)
+ CRLF /CARRIAGE RETURN; LINE FEED
+ 1024 / >
+ 4200
+ 1212 / =
+ 1200
+ 4224 / <
+ 1000
+ 255 / ?
+ 300
+
+\f
+/
+/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS
+/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE
+/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN.
+/
+
+MESS0, 3773
+MESS5, 7340
+ 4040
+ 4040
+ 4000
+
+MESS1, 1716
+ 0500
+
+MESS2, 2427
+ 1700
+
+MESS3, 2711
+ 1623
+ 4100
+
+MESS4, 1617
+ 0217
+ 0431
+ 0000
+
+\f
+ *7400
+
+DISBUF, 0
+
+/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO
+/ AROUND 7575 OR SO.
+/
+/
+/
+/
+/
+
+\f
+
+ $
+
+////////////////////////////
+/
+/ THIS IS THE END
+/
+///////////////////////////
+
+
+
+
+
+\f
\ No newline at end of file
--- /dev/null
+$JOB FORTRAN IV BUILD - INITIAL CLEANUP AND PREPARATION
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ INITIAL CLEANUP
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+
+.DELETE *.RL
+.DELETE *.BN
+.DELETE *.LD
+.DELETE SYS:FORTRN.*
+.DELETE SYS:F4.SV,LOAD.SV,RALF.SV
+.DELETE SYS:PASS2.SV,PASS20.SV,PASS3.SV
+.DELETE SYS:FRTS.SV,FORLIB.RL
+.SQUISH SYS:/O
+
+/ PUT MAIN BATCH FILE TO SYS:
+.COPY SYS:<FMAIN.BI
+
+/ CHAIN INTO IT
+.SUBMIT SYS:FMAIN.BI
--- /dev/null
+$JOB FORTRAN IV BUILD - FINAL CLEANUP
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ FINAL CLEANUP
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+.DELETE SYS:FMAIN.BI
+.SQUISH SYS:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ FINISH!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+$END
--- /dev/null
+$JOB FORTRAN IV BUILD - MAIN PART
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ PAL-8 ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 1
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2
+/ *******************************************************************
+/
+.PAL PASS2
+.LOAD PASS2
+.SAVE SYS PASS2=0;5000
+.DELETE PASS2.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2 OVERLAY
+/ *******************************************************************
+/
+.PAL PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2O=0;7605
+.DELETE PASS2O.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 3
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/ RALF ASSEMBLER
+/ *******************************************************************
+/
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/ FORTRAN IV LIBRARIAN
+/ *******************************************************************
+/
+.PAL LIBRA
+.LOAD LIBRA
+.SAVE SYS LIBRA=0;200
+.DELETE LIBRA.BN
+/
+/ *******************************************************************
+/ LINKING LOADER
+/ *******************************************************************
+/
+.PAL LOAD
+.LOAD LOAD
+.SAVE SYS LOAD=0;200
+.DELETE LOAD.BN
+/
+/ *******************************************************************
+/ FORTRAN IV RUNTIME SYSTEM
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS=0;200
+.DELETE FRTS.BN
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA/8
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA/8
+.COMPILE REAL.RA
+.COMPILE REALTM.RA/8
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SIN,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+$JOB FORTRAN IV BUILD - MAIN PART
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ PAL-8 ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 1
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2
+/ *******************************************************************
+/
+.PAL PASS2
+.LOAD PASS2
+.SAVE SYS PASS2=0;5000
+.DELETE PASS2.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2 OVERLAY
+/ *******************************************************************
+/
+.PAL PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2O=0;7605
+.DELETE PASS2O.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 3
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/ RALF ASSEMBLER
+/ *******************************************************************
+/
+.R PAL8
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/ FORTRAN IV LIBRARIAN
+/ *******************************************************************
+/
+.PAL LIBRA
+.LOAD LIBRA
+.SAVE SYS LIBRA=0;200
+.DELETE LIBRA.BN
+/
+/ *******************************************************************
+/ LINKING LOADER
+/ *******************************************************************
+/
+.PAL LOAD
+.LOAD LOAD
+.SAVE SYS LOAD=0;200
+.DELETE LOAD.BN
+/
+/ *******************************************************************
+/ FORTRAN IV RUNTIME SYSTEM
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS=0;200
+.DELETE FRTS.BN
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ STUPID ASSEMBLER PROCEDURES
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ THE RALF ASSEMBLER REFUSES TO ACCEPPT THE .RA FILES AS THEY
+/ COME FROM KERMIT. I CANNOT INVESTIGATE WHICH PARITY IS GENERATED
+/ BY KERMIT-12. BUT I KNOW THAT PIP MAKES EVERYTHING RIGHT AGAIN.
+/ SO ALL .RA FILES ARE MOVED TROUGH PIP ONCE.
+/
+.R PIP
+*ABS.RA<ABS.RA/A
+*ACOS.RA<ACOS.RA/A
+*ADC.RA<ADC.RA/A
+*ALOG10.RA<ALOG10.RA/A
+*ALOG.RA<ALOG.RA/A
+*AMAX.RA<AMAX.RA/A
+*AMIN.RA<AMIN.RA/A
+*AMOD.RA<AMOD.RA/A
+*ASIN.RA<ASIN.RA/A
+*ATAN2.RA<ATAN2.RA/A
+*ATAN.RA<ATAN.RA/A
+*CABS.RA<CABS.RA/A
+*CARITH.RA<CARITH.RA/A
+*CEXP.RA<CEXP.RA/A
+*CHARS.RA<CHARS.RA/A
+*CHKEOF.RA<CHKEOF.RA/A
+*CLK8A.RA<CLK8A.RA/A
+*CLOCK.RA<CLOCK.RA/A
+*CLOG.RA<CLOG.RA/A
+*CMPLX.RA<CMPLX.RA/A
+*COSD.RA<COSD.RA/A
+*COSH.RA<COSH.RA/A
+*COS.RA<COS.RA/A
+*CSIN.RA<CSIN.RA/A
+*CSQRT.RA<CSQRT.RA/A
+*DABS.RA<DABS.RA/A
+*DATAN2.RA<DATAN2.RA/A
+*DATAN.RA<DATAN.RA/A
+*DATE.RA<DATE.RA/A
+*DBLE.RA<DBLE.RA/A
+*DCOS.RA<DCOS.RA/A
+*DEXP3.RA<DEXP3.RA/A
+*DEXP.RA<DEXP.RA/A
+*DIM.RA<DIM.RA/A
+*DLOG10.RA<DLOG10.RA/A
+*DLOG.RA<DLOG.RA/A
+*DMAX1.RA<DMAX1.RA/A
+*DMIN1.RA<DMIN1.RA/A
+*DMOD.RA<DMOD.RA/A
+*DSIGN.RA<DSIGN.RA/A
+*DSIN.RA<DSIN.RA/A
+*DSQRT.RA<DSQRT.RA/A
+*EXP3.RA<EXP3.RA/A
+*EXPCC.RA<EXPCC.RA/A
+*EXPCI.RA<EXPCI.RA/A
+*EXPDD.RA<EXPDD.RA/A
+*EXPDI.RA<EXPDI.RA/A
+*EXPDR.RA<EXPDR.RA/A
+*EXPIC.RA<EXPIC.RA/A
+*EXPID2.RA<EXPID2.RA/A
+*EXPID.RA<EXPID.RA/A
+*EXPII.RA<EXPII.RA/A
+*EXPIR.RA<EXPIR.RA/A
+*EXP.RA<EXP.RA/A
+*FLOAT.RA<FLOAT.RA/A
+*IDINT.RA<IDINT.RA/A
+*IFIX.RA<IFIX.RA/A
+*LTR.RA<LTR.RA/A
+*ONQIB.RA<ONQIB.RA/A
+*PAUSE.RA<PAUSE.RA/A
+*PLOT.RA<PLOT.RA/A
+*REAL.RA<REAL.RA/A
+*REALTM.RA<REALTM.RA/A
+*RFCV.RA<RFCV.RA/A
+*RFDV.RA<RFDV.RA/A
+*RSW.RA<RSW.RA/A
+*SIGN.RA<SIGN.RA/A
+*SIND.RA<SIND.RA/A
+*SINH.RA<SINH.RA/A
+*SNGL.RA<SNGL.RA/A
+*SQRT.RA<SQRT.RA/A
+*TAND.RA<TAND.RA/A
+*TANH.RA<TANH.RA/A
+*TAN.RA<TAN.RA/A
+*XFIX.RA<XFIX.RA/A$
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+$JOB FORTRAN IV BUILD - LIBRARY BUILD ONLY
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SIN,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+$END
+
+
+
+
+
+
+
+
+
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ LINC=6141
+ PDP=2
+ DIS=140
+ COMMZ #PAGE0 /STANDARD PAGE 0
+ ORG 17
+ 0 /ALPHA REG FOR PDP-12
+ ENTRY #DISP /THIS IS SO #PAGE0 CAN BE LOADED
+#DISP,
+DISPLY, 0
+ TAD BUFADR+2 /GET BUFFER ADDRESS
+ DCA BUFADR
+ TAD DBFLD /SET UP CHANGABLE CDF
+ DCA FLDDB
+DBFLD, HLT /GO TO FIRST FIELD OF BUFFER
+ TAD PLTXR+4 /NUMBER OF POINTS
+ CMA
+ DCA NPTS /NEGATED
+ JMP ENDDL /BEGIN DISPLAY
+DSPLUP, /START OF DISPLAY LOOP
+ IFSW 8 <
+ TAD% BUFADR /GET X VALUE
+ 6053 /LOAD X DISPLACEMENT
+ CLA
+ ISZ BUFADR /BUMP ADDRESS
+ SKP CLA
+ JMS BUMPF /BUMP FIELD
+ TAD% BUFADR
+ 6054 /LOAD Y DISPLACEMENT
+ CLA
+ ISZ BUFADR /INCR ADDRESS
+ SKP CLA
+ JMS BUMPF /INCR FIELD
+ 6052 /SKIP ON BEAM POSITIONED
+ JMP .-1
+ 6055 /INTENSIFY POINT
+ >
+ IFNSW 8 <
+ TAD% BUFADR /GET X DISPLACEMENT
+ DCAZ 17 /INTO ALPHA REG
+ ISZ BUFADR /INCREMENT ADDRESS
+ SKP CLA
+ JMS BUMPF /INCREMENT DATA FIELD
+ TAD% BUFADR /GET Y DISPLACEMENT
+ CIF 10
+ LINC
+ DIS 17
+ PDP
+ CLA
+ ISZ BUFADR /INCR BUFFER POINTER
+ SKP CLA
+ JMS BUMPF
+ >
+ENDDL, ISZ NPTS /INCREMENT COUNTER
+ JMP DSPLUP /LOOP
+ CDF 10
+ JMP% DISPLY /RETURN TO IDLE Q
+BUMPF, 0 /FIELD CHANGER
+ TAD FLDDB /BUMP FIELD
+ TAD L10
+ DCA FLDDB
+FLDDB, HLT /CHANGE IT NOW
+ JMP% BUMPF
+PUTONQ, 0 /PUT DISPLY ONTO BACKROUND Q
+ TAD BUFADR+1 /CREATE CDF FOR DISPLAY LOOP
+ AND L7
+ CLL RAL
+ RTL
+ TAD FLD0
+ DCA DBFLD
+ IFSW 8 <
+ 6050 /CLEAR DISPLAY LOGIC
+ >
+ CDF CIF
+ SKP
+ JMP% PUTONQ
+ DCA .-2 /ONCE ONLY
+ CIF CDF 10
+ JMS% ONQBX+1
+ ADDR DISPLY
+ CIF CDF
+ JMP% PUTONQ /CALLED VIA TRAP4
+ EXTERN ONQB
+ONQBX, ADDR ONQB
+BUFADR, 0
+ 0
+PLTXR, 0;0;0;-1;0;0
+FLD0, CDF
+L7, 7
+L10, 10
+NPTS, 0
+\f SECT PLOT
+ JA #PLOT
+NAME, TEXT +PLOT +
+PLTBAS, 0;0;0
+XLO,
+X, 0;0;0
+YLO,
+Y, 0;0;0
+XHI,
+N, 0;0;0
+YHI, 0;0;0
+ADRBUF, 0;0;0
+ IFSW 8 <
+YSCALE, F 1022.
+YZERO, F 511.
+ ORG 10*3+PLTBAS
+ FNOP
+ JA NAME+3
+ 0
+PLTRET, JA .
+XSCALE, F 786.
+XZERO, F 511.
+RANGE, F 1022.
+BASE, F 511.>
+ IFNSW 8 <
+YSCALE, F 510.
+YZERO, F 255.
+ ORG 10*3+PLTBAS
+ FNOP
+ JA NAME+3
+ 0
+PLTRET, JA .
+XSCALE, F 392.
+XZERO, F 0.
+RANGE, F 510.
+BASE, F 255.>
+L1P5, F 1.5
+XYPAIR, 0;0;0
+#PLOT, BASE PLTBAS
+ JSA SETUP
+ LDX 1,1
+ FLDA% PLTBAS,1 /GET ARG ADDRESSES
+ FSTA N
+ FLDA% PLTBAS,1+
+ FSTA X
+ FLDA% PLTBAS,1+
+ FSTA Y
+ STARTF
+ FLDA% N /NUMBER OF POINTS TO PLOT
+ FNEG
+ ATX 1 /INTO XR 1
+ LDX -1,2 /XR 2 IS THE INDEXER
+PLTLUP, JXN PLOOP,3+ /ANY MORE ROOM IN PLOT BUFFER ?
+ LDX -1,3 /NO, FIX COUNT
+ JA PLTRET
+PLOOP, FLDA% Y,2+ /GET Y VALUE
+ FMUL YSCALE /SCALE IT
+ FSUB YZERO /SUBTRACT LOWER LIMIT
+ ALN 0
+ FSTA XYPAIR
+ FLDA% X,2 /GET X VALUE OF PAIR
+ FMUL XSCALE /SCALE IT
+ FSUB XZERO /SUBTRACT LOWER LIMIT
+ ALN 0
+ STARTD
+ FSTA XYPAIR,0 /XYPAIR+1,+2 CONTAINS THE POINT
+ FLDA XYPAIR /STORE THIS DOUBLE WORD INTO PLOT BUFFER
+ FSTA% ADRBUF,4
+ ADDX 1,4 /TROUBLE IS, WE WANT POST INCREMENT
+ STARTF
+ JXN PLTLUP,1+ /LOOP IF MORE POINTS
+ JA PLTRET
+ BASE 0
+SETUP, JA .
+ STARTD
+ FLDA 30 /GET RETURN ADDRESS
+ FSTA PLTRET
+ FLDA 0 /GET ARG POINTER
+ BASE PLTBAS
+ SETB PLTBAS
+ SETX PLTXR
+ FSTA PLTBAS
+ JA SETUP
+\f SECT PLOTR
+ BASE PLTBAS
+ JSA SETUP
+ LDX 1,1
+ FLDA% PLTBAS,1 /GET ARG ADDRESSES
+ FSTA N
+ FLDA% PLTBAS,1+
+ FSTA X
+ FLDA% PLTBAS,1+
+ FSTA Y
+ FLDA% PLTBAS,1+
+ FSTA YHI
+ STARTF
+ FLDA% YHI
+ ATX 5
+ FLDA% N /NUMBER OF POINTS TO PLOT
+ FNEG
+ ATX 1 /INTO XR 1
+ LDX -1,2 /XR 2 IS THE INDEXER
+PLOTRL, FLDA% Y,2+ /GET Y VALUE
+ FMUL YSCALE /SCALE IT
+ FSUB YZERO /SUBTRACT LOWER LIMIT
+ ALN 0
+ FSTA XYPAIR
+ FLDA% X,2 /GET X VALUE OF PAIR
+ FMUL XSCALE /SCALE IT
+ FSUB XZERO /SUBTRACT LOWER LIMIT
+ ALN 0
+ STARTD
+ FSTA XYPAIR,0 /XYPAIR+1,+2 CONTAINS THE POINT
+ FLDA XYPAIR /STORE THIS DOUBLE WORD INTO PLOT BUFFER
+ FSTA% ADRBUF,5
+ ADDX 1,5 /TROUBLE IS, WE WANT POST INCREMENT
+ STARTF
+ JXN PLOTRL,1+ /LOOP IF MORE POINTS
+ JA PLTRET
+\f SECT CLRPLT
+ BASE PLTBAS
+ JSA SETUP
+ LDX 0,4 /DISABLE DISPLAY LOOP
+ LDX 1,1
+ FLDA% PLTBAS,1 /GET ARG POINTERS
+ FSTA N
+ FLDA% PLTBAS,1+
+ FSTA ADRBUF
+ FSTA BUFADR+1
+ STARTF
+ FLDA% N /SIZE OF BUFFER
+ FMUL L1P5 /NUMBER OF 2 WORD PAIRS
+ FNEG
+ ATX 3 /INTO SOME CHOICE XRS
+ TRAP4 PUTONQ /PUTISPLY ONTO IDLE Q
+CLRRET, JA PLTRET
+\f SECT SCALE /SET SCALING FACTORS
+ BASE PLTBAS
+ JSA SETUP
+ LDX 1,1
+ FLDA% PLTBAS,1 /GET ARGS
+ FSTA XLO
+ FLDA% PLTBAS,1+
+ FSTA YLO
+ FLDA% PLTBAS,1+
+ FSTA XHI
+ FLDA% PLTBAS,1+
+ FSTA YHI
+ STARTF
+ FLDA% XHI /COMPUTE X RANGE
+ FSUB% XLO
+ FSTA XHI
+ FLDA% YHI /NOW Y RANGE
+ FSUB% YLO
+ FSTA YHI
+ FLDA RANGE /COMPUTE XSCALE
+ FDIV XHI
+ FSTA XSCALE
+ FLDA RANGE /NOW Y SCALE
+ FDIV YHI
+ FSTA YSCALE
+ FLDA% XLO /COMPUTE XZERO
+ FMUL RANGE
+ FDIV XHI
+ IFSW 8 <
+ FADD BASE>
+ FSTA XZERO
+ FLDA% YLO /NOW YZERO
+ FMUL RANGE
+ FDIV YHI
+ FADD BASE
+ FSTA YZERO
+SCLRET, JA PLTRET
+ END
+\f
--- /dev/null
+/ RALF, V62A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975, 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/ RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV
+/
+/
+/ FPPASM BY HANK MAURER
+/ RALF MODS BY JUD LEONARD
+/ OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY
+/ NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER
+/
+/ THE FOLLOWING FORMULA GIVES THE NUM
+/ OF USER SYMBOLS:
+/ -(FREE+200[BASE8])/6[BASE10]
+/ WHERE THE VALUE OF FREE IS FROM THE
+/ RALF SYMBOL MAP
+/
+/
+IFNDEF RALF <RALF=1 /GO RELOCATABLE THEN>
+/
+/ ASSEMBLE WITH PAL8-V9 WITH W SWITCH
+/ SAVE AS:
+/ .SAVE SYS RALF.SV ;200=2000
+
+/
+/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
+/ .CHANGED VERSION NUMBER TO 62
+/ .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF:
+/ 1.) THE ESD IS LONGER THAN ONE BLOCK, AND
+/ 2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER
+/
+/
+ FLD0=0
+ FLD1=10
+ VNUM=62
+ PATCH="A /PATCH LEVEL A
+ *3
+VERS, VNUM /VERSION NUMBER
+OLDN3, 0 /\ fTEMP FOR LOOKUP
+OTEMP, 0 /A COUPLE OF TEMPS THAT
+OCNT, 0 /DIDNT FIT INTO THEIR PAGE
+ 0
+X10, 0
+X11, 0
+X12, 0
+X13, 0
+X14, 0
+OUTPTR, OUBUF-1
+NEXT, FREE-1
+CHRPTR, LINE-1
+NCHARS, -1 /CHARACTER INPUT STUFF
+CPTMP, 0
+NCTMP, 0 /USED TO SAVE CHAR POSITION
+LINSIZ, 0 /SIZE OF LINE FOR PRINTING
+STYPE, /SYMBOL TYPE CODE
+CHKSUM, 0 /FOR BINARY OUTPUT
+ IFZERO RALF <
+LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM
+LOCTR2, 200 >
+ IFNZRO RALF <
+ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
+LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
+LOCTR2, 0
+DPFLG, 0 >
+\fBASER, 4000 /BASE REGISTER SETTING
+ 0
+INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER
+ 0
+EXPVAL, 0 /EXPRESSION VALUE
+ 0
+ 0
+EXPDEF, 0 /=0 IF EXPR IS UNDEFINED
+EXPSW, 0 /FLAG=1 IF NO EXPR
+WORD1, 0 /TEMPORARY 2 WORD OPERAND
+WORD2, 0
+FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR
+ 0
+OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER
+XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT
+XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR
+BUCKET, 0 /FIRST CHAR OF NAME
+NAME1, 0 /CHARS 2 AND 3 OF NAME
+NAME2, 0 /CHARS 4 AND 5 OF NAME
+NAME3, 0 /CHAR 6 OF NAME AND TYPE
+LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR
+PASSNO, -1 /PASS NUMBER
+ASMOF, 0 /SET NEGATIVE WHEN ASSEMBLY OFF
+PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT
+LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING)
+OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED
+REPCNT, 0 /REPEAT COUNTER
+SCSWT, 0 /SEMICOLON SWITCH
+RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL)
+LTEMP, -177 /TEMP USED BY LOOKUP
+EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS
+EXTMP2, 0
+EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN
+ /NEXT TWO LOCS USED WITH EQUN BY DMPESD
+FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR
+FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT
+FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0
+LITRL, 0 /SET = 1 FOR LITERAL
+P0LIT, 177
+CPLIT, 177
+PAGEN, 0
+ERRORS, 0 /ERROR COUNT
+PC, TTYOUT /OUTPUT ROUTINE
+OUFILE, 7573 /OUTPUT FILE LIST POINTER
+BFILE, 1
+\fLPAGE1, 1 /INPUT FORMFEED COUNT
+LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE
+LINPAG, -1 /LINES/PAGE COUNTER
+LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE
+LINKS, /NO OF LINKS GENERATED
+ABREFS, 0 /NO OF ABSOLUTE REFERENCES
+ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT
+USR, 200 /CURRENT CALL ADDRESS FOR USR
+SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE
+ /IS SPECIFIED. ITS SET VIA SLASH S
+ /=1=REGULAR
+NP17, 17 /**
+NP7700, 7700
+OPX, 0
+OP, ZBLOCK 6
+ACX, 0
+AC, ZBLOCK 6
+M3, -3
+BLINE, LINE-1
+/
+ PAGE
+\f/
+/ CORE ALLOCATION IN HIGH FIELD 0
+/
+ CPLBUF=5100 /ACTUALLY AT 5200
+ P0LBUF=5200 /AND 5300, 1/2 PAGE EACH
+ IFZERO RALF <
+ INBUF=5400 >
+ IFNZRO RALF <
+ INBUF=6000 /AFTER PASS 1, MOVES TO 5400>
+ OUBUF=6400
+ LINE=7000 /CURRENT INPUT LINE IN ASCII
+ INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR
+ OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR
+ INRECS=2
+ INCTL=400
+ OUCTL=4200
+/
+/ COLLECT THE NEXT STATEMENT
+/
+ ISZ .+2
+REPLEN, JMP I .+1
+REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001
+NEXTST, CDF FLD0 /JUST PRECAUTION
+ TAD OUTSWT /IF NO OUTPUT FROM THIS LINE,
+ SNA CLA
+ TAD PASSNO /AND LISTING PASS
+ SMA SZA CLA
+ TAD LISTSW /AND LISTING ENABLED
+ SNA CLA /PRINT THIS LINE NOW
+ JMP START /ELSE GET NEXT
+ JMS I [CRLF /PRINT CR/LF
+ TAD (-6
+ DCA LTEMP /SPACE OVER
+ JMS I [PRINT2 /12 SPACES
+ ISZ LTEMP
+ JMP .-2
+ JMS I (PRNTLN /THEN PRINT LINE
+START, JMS I [GETCHR /ANY MORE CHARS ?
+ JMP NOTEG
+ JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE
+ 0507 /*EG*
+NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ?
+ SNA CLA
+ JMP .+5 /NO
+ DCA SCSWT /KILL SC SWITCH
+ ISZ CHRPTR /SKIP OVER SEMICOLON
+ ISZ NCHARS
+ JMP ASMBL /DON'T READ A NEW LINE
+ TAD REPCNT /IS THIS LINE TO BE REPEATED?
+ SPA CLA
+ JMP AGAIN /DO IT
+NEWLIN, TAD BLINE /RESET POINTER
+ DCA CHRPTR
+ TAD [-200 /LIMIT LINE SIZE
+ DCA MAXLIN
+ DCA OUTSWT /CLEAR OUTPUT SWITCH
+\fRDLOOP, JMS I (ICHAR /READ A CHAR
+ TAD (-212
+ SNA
+ JMP RDLOOP /IGNORE LINE FEEDS
+ TAD (212-215 /END ON CR
+ SNA
+ JMP ENDLIN
+ IAC
+ SNA /FORM FEED?
+ JMP FORMFD
+ TAD (214 /FIX CHAR
+ DCA I CHRPTR /SAVE IT
+ ISZ MAXLIN /TEST FOR LINE TOO LONG
+ JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1
+ JMS I (ICHAR /IGNORE ANOTHER CHAR
+ TAD (-215 /UNLESS CR
+ SZA CLA
+ JMP .-3
+ JMS I [ERMSG /EXCESS LENGTH LINE
+ 1424 /*LT*
+ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1
+ CMA
+ TAD BLINE
+ DCA NCHARS
+ TAD REPCNT /0 BECOMES 0,
+ CIA /BUT POS REP COUNT
+ DCA REPCNT /ENABLES REPEAT
+ TAD NCHARS /SAVE LENGTH
+ DCA REPLEN
+ TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT
+ DCA REPLST
+REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT
+ DCA LINSIZ
+ TAD BLINE
+ DCA CHRPTR /SET POINTER
+ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL
+ SZA CLA
+ JMP OFFIT /YES, AND THE COND WAS FALSE
+ JMS I [GETCHR /LOOK FOR A CHARACTER
+ JMP NEXTST
+ TAD (-257 /IS IT SLASH ?
+ SNA
+ JMP NOASM /YES, COOL IT
+ TAD [257-240 /IS IT BLANK OR TAB ?
+ SZA CLA /YES, IGNORE
+ JMS I [BACK1 /NO, PUT IT BACK
+ JMP I (LUNAME /ASSEMBLE STMT
+\fFORMFD, ISZ LPAGE1 /BUMP FORM FEED COUNT
+ DCA LPAGE2 /CLEAR SUB-PAGE COUNT
+ CLA CMA
+ DCA LINPAG /FORCE EJECT ON CRLF
+ JMP RDLOOP
+OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE
+ TAD ASMOF
+ DCA ASMOF
+OFFIT, ISZ NCHARS /MORE TO GO?
+ JMP GETIT /YES
+NOASM, CLA CMA
+ DCA NCHARS /DONT ASSEMBLE THIS LINE
+ JMP NEXTST /(PREVENTING *EG* MESSAGE)
+GETIT, TAD I CHRPTR /PICK UP THE CHARACTER
+ TAD (-274 /OPEN ANGLE BRACKET?
+ SNA
+ JMP OPENIT /YES, PUSH ONE LEVEL DOWN
+ CLL RTR
+ SNA CLA
+ ISZ ASMOF /IF CLOSE, CHECK LEVEL
+ JMP OFFIT /TRY FOR NEXT
+ JMP ASMBL /RESUME WORK
+AGAIN, TAD REPLEN /WE NOW REPEAT THE SAME LINE
+ DCA NCHARS
+ DCA LISTSW /NO LISTING DURRING REPEAT
+ ISZ REPCNT
+ JMP REASM /ASSUMING COUNT STILL OK
+ TAD REPLST /RESTORE LISTING
+ DCA LISTSW
+ JMP NEWLIN /GET NEXT LINE
+ MAXLIN=LTEMP
+/
+TXERR, TEXT " ERRORS"
+TXELN= .-TXERR
+ PAGE
+\f/
+/ DIVIDE AC BY 3
+/ USEFUL IN FPP REFERENCES TO BASE
+/
+OVER3, 0 /DIVIDE AC BY THREE
+ DCA EXTMP2 /MQ
+ TAD (-15 /SET SHIFT COUNT
+ DCA LTEMP
+DIVLUP, CLL /ZERO LINK
+ TAD (-3 /SUBTRACT DIVISOR FROM AC
+ SZL /IF AC>=3 SET LINK TO 1
+ JMP .+3 /OK, DONT RESTORE
+ TAD (3 /TOO SMALL, RESTORE AC
+ CLL /SET LINK BACK TO 0
+ DCA EXTMP /SAVE AC
+ TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK IN MQ
+ RAL
+ DCA EXTMP2 /SAVE MQ
+ TAD EXTMP /GET BACK AC
+ RAL /COMPLETE SHIFT
+ ISZ LTEMP /TEST COUNT
+ JMP DIVLUP /KEEP GOING
+ DCA EXTMP /THIS IS REMAINDER
+ TAD EXTMP2 /RETURN QUOTIENT
+ JMP I OVER3
+/
+/ INITIALIZE FOR OUTPUT
+/
+OUSETP, 0
+ TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
+ CIA /NEGATE IT (PAL10 BLOWS)
+ DCA OUDWCT
+ TAD NOUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
+ JMP I OUSETP
+NOUBUF, OUBUF
+/
+/ STORE CHARACTERS IN OUTPUT BUFFER
+/ IN PS8 FORMAT (YOU KNOW, 3 CHARS
+/ IN 2 WORDS THE WRONG WAY)
+/
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ TAD OUTINH
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I OCHAR /NO - EXIT
+ CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+ TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, CDF
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+/
+/ MOVE OUTPUT FILE NAME TO FIELD 0
+/
+OFNAME, 0
+ TAD OUFILE
+ DCA X10
+ TAD (OUFNAM-1
+ DCA X11
+ TAD (-4
+ DCA LTEMP
+ CDF 10
+ TAD I X10
+ CDF 0
+ DCA I X11
+ ISZ LTEMP
+ JMP .-5
+ JMP I OFNAME
+\f/
+/ GET OUTPUT DEVICE CHARISTICS
+/
+OTYPE, 0
+ CDF 10
+ TAD I (7600
+ AND [17
+ TAD (DCB-1
+ DCA OTYPP
+ TAD I OTYPP
+ CDF 0
+ JMP I OTYPE
+OTYPP= OFNAME
+/
+/ BASIC TITLE INFO
+/
+TITBUF,
+ IFZERO RALF <
+ TEXT "FLAP V" >
+ IFNZRO RALF <
+ TEXT "RALF V" >
+*.-1
+VMTXT, 0;0;0
+TITDAT, ZBLOCK 6
+ TEXT " PAGE"
+TITLEN= .-TITBUF
+ PAGE
+\f/
+/ PROCESS A STATEMENT
+/
+LUNAME, TAD CHRPTR /SAVE CHAR STUFF
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP
+ DCA LINKSW /CLEAR SWITCH
+ JMS I [GETNAM /LOOK FOR NAME
+ IFZERO RALF <
+ JMP I (TRYSTR /COULD BE AN ORG>
+ IFNZRO RALF <
+ JMP I (GETEXP /NOT ONE OF OURS, I GUESS>
+ JMS I [GETCHR /LOOK FOR COMMA
+ JMP JSTONE /ITS JUST ONE SYMBOL
+ TAD (-254 /COMMA TEST
+ SZA
+ JMP TRYEQU /NO COMMA, CHECK FOR EQUAL
+ JMS I [LOOKUP /LOOK UP SYMBOL
+ JMP DEFLBL /ITS UNDEFINED
+ CLL RAR /VERIFY ADDR TYPE
+ SZA CLA
+ JMP MDERR /THAT'S A NO-NO
+ TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION
+ CIA
+ TAD LOCTR1 /FIRST UPPERR HALF
+ SZA CLA
+ JMP .+6
+ TAD I X10
+ CIA
+ TAD LOCTR2 /THEN LOWER HALF
+ SNA CLA
+ JMP DEFIND
+MDERR, JMS I [ERMSG /MULTIPLY DEFINED
+ 1504 /*MD*
+ JMP I (ASMBL /FIELD IS OK
+DEFLBL, ISZ I LTEMP /SET TYPE TO 1 (USER ADDR)
+ TAD LOCTR1 /PUT LOCATION COUNTER
+ DCA I X10 /INTO VALUE
+ TAD LOCTR2
+ DCA I X10
+DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG
+ JMP I (ASMBL
+\fTRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN
+ SZA
+ JMP TRYBLK /NO, TRY BLANK
+ TAD NAME1
+ DCA EQUN /SAVE 6 CHARACTER NAME
+ TAD NAME2
+ DCA EQUN+1
+ TAD NAME3
+ DCA EQUN+2
+ TAD BUCKET
+ DCA EQUN+3
+ JMS I [GETCHR /ALLOW BLANK AFTER =
+ JMP EQUERR
+ TAD [-240
+ SZA CLA
+ JMS I [BACK1 /ANYTHING ELSE GOES BACK
+ JMS I [EXPR /GET VALUE RIGHT OF EQUALS
+ JMP EQUERR /BAD EQU
+ TAD EQUN /RESTORE NAME
+ DCA NAME1
+ TAD EQUN+1
+ DCA NAME2
+ TAD EQUN+2
+ DCA NAME3
+ TAD EQUN+3
+ DCA BUCKET
+ JMS I [LOOKUP /LOOKUP SYMBOL
+ JMP PUTVAL /A NEW SYMBOL
+ CLL RAR
+ SZA CLA
+ JMP EQUERR /TYPE CONFLICT
+PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE
+ DCA I X10
+ TAD EXPVAL+2
+ DCA I X10
+ TAD I LTEMP /NOW GET TYPE WORD
+ AND (7740 /ZERO OLD TYPE, PRESERVING FORCE BIT
+ TAD EXPDEF /DEFINED BY RIGHT HAND SIDE
+ DCA I LTEMP /RESTORE WORD
+ CDF FLD0
+ JMP I [NEXTST /GO GET NEXT STMT
+EQUERR, JMS I [ERMSG /BAD EQU
+ 0205 /*BE*
+ JMP I [NEXTST
+\fTRYBLK, TAD (35 /CHECK FOR BLANK
+ SNA /MATCH BLANK?
+ JMP JSTONE /YES
+ AND [77
+ JMS I [R6L
+ DCA NAME3 /MAKE MODIFIED NAME OF IT
+ JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK
+ JMP I (GETEXP /LOOKS BAD
+ TAD [-240 /GOT IT?
+ SZA CLA
+ JMP I (GETEXP /LET EXPR TELL HIM IF ITS WRONG
+JSTONE, TAD (33 /USE OUR INTERNAL SYMBOL TABLE
+ JMS I [FIND /IS IT THERE?
+ JMP I (GETEXP /NO, LOOK IN USER'S
+ TAD OPCTBL /CREATE JUMP THRU TABLE
+ DCA OPCJMP /SAVE IT
+ TAD I X10 /PICK UP FIRST WORD OF VALUE
+ DCA OPCODE /ITS AN OPCODE-MAYBE?
+ CDF FLD0
+OPCJMP, 0 /JUMP SOMEWHERE
+OPCTBL, JMP I .-4
+ PSEUDO /PSEUDO OPS
+ PDP8MR /PDP8 MRI
+ FPPMR /FPPMR
+ FPPS1 /OTHER FPP OPCODES
+ FPPS2
+ FPPS3
+ FPPS4
+ FPPS5
+ FPMRI /INDIRECT FPP MEM REF
+ FPMRS /SHORT DIRECT MEM REF
+ FPMRL /LONG DIRECT REF
+ PDPOPR /8-MODE OPERATES
+REPETX, JMS I (ADRGET /EVALUATE REPEAT EXPR
+ CLL CMA RAR /3777
+ AND EXPVAL+2
+ DCA REPCNT
+ JMP I [NEXTST
+ PAGE
+\f/
+GETEXP, CDF FLD0
+ TAD CPTMP /RESTORE CHARACTER POINTER
+ DCA CHRPTR
+ TAD NCTMP /TO JUST AFTER TAG (IF ANY)
+ DCA NCHARS
+SX, DCA OPCODE
+ JMS I [EXPR /TRY FOR AN EXPRESSION
+ JMP BADEXP /IF NONE, ERROR
+ IFNZRO RALF <
+ JMS RELERR /BOMB IF NOT ABSOLUTE EXP>
+ TAD EXPVAL+2
+ JMS I [OUTWRD
+ JMP I [NEXTST /GO DO NEXT STMT
+ IFNZRO RALF </IF EXPVAL IS RELOCATABLE,
+RELERR, 0 /GIVE ERROR MESSAGE
+ TAD EXPVAL+1 /CAUTION: THIS ROUTINE IS
+ /SOMETIMES CALLED WITH NON-ZERO AC
+ AND [7770 /JUST ESD BITS
+ SNA CLA
+ JMP I RELERR /ITS ABSOLUTELY FINE
+ TAD EXPVAL+1
+ AND [7 /REMOVE ESD
+ DCA EXPVAL+1
+ JMS I [ERMSG
+ 2205 /*RE*
+ JMP I RELERR >
+/
+FPPMR, ISZ FPPSWT /SET FORCE ENABLE
+ JMS FPADR
+ TAD WORD1 /IF WAY OFF BASE,
+ SNA
+ TAD FPPWD2 /OR IF FORCED
+ SNA
+ TAD XFLAG /OR IF INDEXED
+ SZA CLA
+ JMP FORMT1 /USE LONG FORM
+ TAD WORD2
+ CLL
+ TAD (-600 /COMPLETE OFF-BASE CHECK
+ SZL CLA
+ JMP FORMT1 /USE LONG
+ JMP FORMT2
+FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR
+ JMS IXMES /BUT DISALLOW INDEX
+ JMP F2WD /PUT TWO WORDS OUT
+/
+IXMES, 0
+ TAD XFLAG /NO INDEX ALLOWED
+ SNA CLA
+ JMP I IXMES /HE'S COOL
+ JMS I [ERMSG
+ 1130 /*IX*
+ JMP I IXMES
+\fFPMRL, JMS FPADR
+FORMT1, JMS I (FIXOPC
+F2WD, TAD FPPADR
+ AND [7 /FIELD BITS
+ TAD OPCODE /IN FIRST WORD
+FPDMP, IFZERO RALF <
+ JMS I [OUTWRD
+ TAD FPPADR+1 /LOW ADDRESS
+ JMS I [OUTWRD
+ JMP I [NEXTST /NEXT!>
+ IFNZRO RALF <
+ JMP I (OUTREL /DUMP TWO RELOCATABLE>
+FPMRS, JMS FPADR /COLLECT OPERAND
+ JMS IXMES /ERROR IF INDEX GIVEN
+ TAD WORD1
+ SZA CLA
+ JMP BADEXP
+ TAD WORD2
+ CLL
+ TAD (-600 /DOES IT FIT?
+ SNL CLA
+ JMP FORMT2
+BADEXP, JMS I [ERMSG
+ 0230 /*BX*
+ TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT
+ JMS I [OUTWRD
+ JMP I [NEXTST
+FPMRI, JMS FPADR
+ TAD WORD1
+ SZA CLA
+ JMP BADEXP /NOT EVEN CLOSE
+ TAD WORD2
+ CLL
+ TAD (-30
+ SZL CLA
+ JMP BADEXP /GOTTA BE IN THE FIRST 10
+FORMT3, JMS I (FIXOPC
+FORMT2, TAD WORD2
+ JMS I (OVER3 /BY 3 FOR BASE ADDRESS
+ TAD [200
+FPPS3, TAD OPCODE
+ JMS I [OUTWRD /WHEW!
+ JMP I [NEXTST
+FPPS1, JMS I (GETADR /GET ADDR, AND INDEX
+ JMS I (FIXOPC /PUT OPCODE TOGETHER
+ TAD FPPADR /GET ADDR EXTENSION
+ AND [7
+ TAD OPCODE /WITH TOGETHER OPCODE
+ AND (7377 /WITHDRAW ONE BIT
+ JMP FPDMP /PUT IT OUT
+\fFPPS5, CLA IAC /DISALLOW INDEX INCR
+ JMS I (GETADR /COLLECT ADDRESS AND INDEX
+ IFNZRO RALF <
+ TAD FPPADR
+ AND [7770 /MUST BE ABSOLUTE
+ SNA CLA
+ JMP .+3 /OK
+ JMS I [ERMSG
+ 2205 /*RE*>
+ TAD XFLAG
+ SZA CLA /ANY INDEX?
+ TAD EXPVAL+2
+ AND [7 /STRIP OFF ESD BITS
+ TAD OPCODE
+ JMS I [OUTWRD /DUMP THAT
+ TAD FPPADR+1
+ JMS I [OUTWRD /NOW LOW 12 BITS
+ JMP I [NEXTST
+/
+FPADR, 0
+ JMS I (GETADR /COLLECT ADDRESS AND INDEX
+ TAD BASER+1
+ CIA STL
+ TAD FPPADR+1
+ DCA WORD2 /GET ADDRESS RELATIVE TO BASE
+ RAL
+ TAD BASER
+ CIA
+ TAD FPPADR
+ DCA WORD1
+ JMP I FPADR
+ PAGE
+\f/
+PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR
+/
+ IFZERO RALF <
+/
+/ ASSEMBLE VARIOUS INSTRUCTION TYPES
+/
+PDP8MR, TAD CHRPTR /SAVE POSITION
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP /SAVE COUNT
+ JMS I [GETCHR /LOOK FOR SPACE "I"
+ JMP GETMR /WILL GIVE BX ERROR
+ TAD (-"I /IS IT I?
+ SNA CLA /IF NOT, FORGET IT
+ JMS I [GETCHR /MUST BE FOLLOWED BY SPACE
+ JMP NOTIND
+ TAD [-240
+ SZA CLA
+ JMP NOTIND /SOMETHING ELSE
+ TAD OPCODE /PUT INDIRECT INTO OPCODE
+ TAD (400
+ DCA OPCODE
+GETMR, JMS ADRGET /PICK UP ADDRESS FIELD
+ TAD EXPVAL+2 /CHECK PAGE OF ADDRESS
+ AND [7600
+ SNA
+ JMP PAGEZ /ITS IN PAGE 0
+ CIA
+ TAD LOCTR2 /COMPARE WITH CURRENT PAGE
+ AND [7600
+ SNA CLA
+ JMP THSPAG /OK, ITS THIS PAGE
+ TAD OPCODE /CAN WE USE A LINK ?
+ AND (400 /IS INDIRECT BIT OFF ?
+ SNA CLA
+ JMP I (MAKLNK /YES, GO MAKE LINK
+ JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE
+ 1122 /*IR*
+THSPAG, TAD EXPVAL+2 /GET ADDRESS
+ AND [177 /LOWER 7 BITS
+ TAD [200 /PUT IN PAGE BIT
+ SKP
+PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
+ TAD OPCODE /PLUS OPCODE
+ JMS I [OUTWRD /OUTPUT WORD
+ JMP I [NEXTST
+NOTIND, TAD CPTMP /RESTORE CHAR POINTER
+ DCA CHRPTR
+ TAD NCTMP
+ DCA NCHARS
+ JMP GETMR /NOT AN INDIRECT>
+\fFPPS4, JMS ADRGET /GET INDEX REG EXPRESSION
+ IFZERO RALF <
+ JMS LITERR /CAN'T ALLOW LITERAL>
+ JMS SUBX /GET RELATIVE INDEX VALUE
+ TAD EXPVAL+2 /GET LOWER 3 BITS
+ AND [7 /OF INDEX REG EXPR
+ TAD OPCODE /WITH OPCODE
+ JMS I [OUTWRD /OUT
+ JMP I [NEXTST
+ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE
+ JMS I [EXPR /GET EXPR
+ JMS I [ERMSG /BAD ADDR EXPR
+ 0230 /*BX*
+ JMP I ADRGET
+ IFZERO RALF <
+LITERR, 0 /GIVE ERROR IF LITERAL
+ TAD LITRL
+ SNA CLA
+ JMP I LITERR
+ JMS I [ERMSG
+ 1114 /*IL*
+ JMP I LITERR >
+ IFNZRO RALF <
+PDP8MR, JMS ADRGET
+ JMP I (CHCKMR /V.56
+ >
+\fGETADR, 0 /GET ADDR, INDEX
+ DCA XITEMP /SAVE INDEX INCREMENT SWITCH
+ JMS ADRGET /GET ADDR
+ DCA FPPSWT /KILL FPP SWITCH
+ IFZERO RALF <
+ JMS LITERR /DISALLOW LITERALS>
+ TAD EXPDEF /IF EXPR WAS UNDEFINED
+ SNA CLA
+ IAC /OR FORCE BIT WAS SET
+ TAD FPP2WD
+ DCA FPPWD2 /FORCE 2 WORD FORMAT
+ DCA XFLAG /ZERO INDEX SWT
+ TAD EXPVAL+1 /SAVE ADDRESS VALUE
+ DCA FPPADR
+ TAD EXPVAL+2
+ DCA FPPADR+1
+ JMS I [GETCHR /LOOK FOR COMMA
+ JMP I GETADR /NO INDEX
+ TAD (-254
+ SZA CLA
+ JMS I [BACK1 /WILL CAUSE A BX ERROR
+ ISZ XFLAG /SET INDEX SWITCH
+ TAD XITEMP /SET INDEX INCREMENT SWITCH
+ DCA XINCR
+ JMS ADRGET
+ ISZ XINCR /CLEAR INDEX INCREMENT SWITCH
+ IFZERO RALF <
+ JMS LITERR >
+ JMS SUBX /CALCULATE INDEX NO
+ JMP I GETADR
+XITEMP,
+SUBX, 0
+ TAD INDXR+1 /CHECK FOR INDEX IN RANGE
+ STL CIA
+ TAD EXPVAL+2
+ DCA EXPVAL+2
+ RAL
+ TAD INDXR
+ CIA
+ TAD EXPVAL+1
+ SZA CLA
+ JMP BIERR
+ TAD EXPVAL+2
+ CLL
+ TAD [-10
+ SZL CLA
+BIERR, JMS I [ERMSG
+ 0211 /*BI*
+ JMP I SUBX
+\f IFNZRO RALF <
+/
+/ AT END OF PASS,
+/ CLEAR LENGTHS OF ALL SECTIONS
+/
+CLRSCT, 0
+ TAD (PNDL+3
+ DCA LTEMP /POINT TO USER SYMBOL SPACE
+ CDF FLD1
+CSLOOP, TAD I LTEMP /GET TYPE
+ AND [37 /STRIP TO TYPE ONLY
+ TAD (-3
+ SPA CLA /IS IT COMMON OR SECTION?
+ JMP NOTSCT /NO, PASS IT
+ ISZ LTEMP /BUMP POINTER TO VALUE
+ TAD I LTEMP
+ AND [7770 /SAVE ESD NUMBER
+ DCA I LTEMP
+ ISZ LTEMP
+ DCA I LTEMP /CLEAR LOW ORDER
+ CLA CLL CMA RAL /-2
+NOTSCT, TAD (6 /BUMP POINTER
+ TAD LTEMP /TO NEXT SYMBOL
+ DCA LTEMP
+ TAD NEXT /COMPARE END OF SYMBOL TABLE
+ CIA CLL
+ TAD LTEMP
+ SNL CLA
+ JMP CSLOOP /MORE TO GO
+ CDF FLD0
+ JMP I CLRSCT /THAS ALL>
+/
+/
+ IFNZRO RALF <
+/
+/ ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE
+/
+NOREL, 0
+ TAD WORD1 /IS SYMBOL RELOCATABLE?
+ AND [7770 /TEST ESD BITS
+ SZA CLA
+ STL RAR /IF SO, FORCE ERROR
+ JMS I (RELERR /TEST SUB EXPR
+ JMP I NOREL
+DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS
+ DCA DPFLG /DP HARDWARE
+ JMP I [NEXTST
+/ SET BASE AND INDEX LOCS
+INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
+BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
+ DCA X12 /HOPEFULLY UNUSED XR
+ JMS I (ADRGET /COLLECT EXPRESSION
+ TAD EXPVAL+1
+ DCA I X12 /HIGH ORDER AND ESD
+ TAD EXPVAL+2
+ DCA I X12 /LOW ORDER
+ JMP I [NEXTST >/THIS CONDITIONAL SASSEMBLY WAS
+/EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO
+/COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP.
+DELFIL, 0
+ TAD [7600
+ DCA OUFILE
+ JMS I [OFNAME
+ CLA IAC
+ CIF 10
+ JMS I USR
+ 4
+ OUFNAM
+ 0
+ NOP
+ JMP I DELFIL
+ PAGE
+\f/
+/ PRINT THE CURRENT LINE IF NOT ALREADY DONE
+/
+PRNTLN, 0 /PRINT THE LINE
+ TAD OUTSWT /HAS THE LINE BEEN PRINTED YET?
+ SZA CLA
+ JMP I PRNTLN /YES, COOL IT
+ ISZ OUTSWT /SET SWITCH
+ TAD BLINE /POINTER TO LINE
+ DCA X13
+ DCA CRLF /CLEAR POSITION COUNT
+ JMP PRLTST /IN CASE OF EMPTY LINE
+PRLNXT, TAD I X13 /GET A CHAR
+ TAD (-211 /WATCH OUT FOR TAB
+ SNA
+ JMP TABIT /CONVERT TO BLANKS
+ TAD (211 /RESTORE
+ ISZ CRLF /BUMP POSITION COUNT
+ JMS I PC /PRINT IT
+PRLTST, ISZ LINSIZ /CHECK COUNT
+ JMP PRLNXT
+ JMP I PRNTLN
+TABIT, TAD [240 /REPLACE TAB WITH BLANKS
+ ISZ CRLF
+ JMS I PC
+ TAD CRLF
+ AND [7
+ SZA CLA
+ JMP TABIT
+ JMP PRLTST
+/
+/ GO TO NEXT LINE
+/
+CRLF, 0
+ CLA
+ TAD (215
+ JMS I PC /PRINT A CHAR
+ TAD (212
+ JMS I PC
+ ISZ LINPAG /FULL PAGE?
+ JMP I CRLF /NO
+ CLA CMA
+ DCA LINPAG
+/
+/ NEW PAGE, WITH HEADING AND PAGE NO
+/
+ TAD PASSNO /IF NOT LISTING PASS
+ SMA SZA CLA
+ TAD LISTSW /OR IF NOT LISTING,
+ SNA CLA
+ JMP I CRLF /DO NOT EJECT
+ TAD RFORMF
+ SZA /DON'T F.F. FIRST TIME
+ JMS I PC /TOP OF PAGE
+ TAD (214
+ DCA RFORMF
+ JMS I (PRTXT /PRINT HEADING
+ TITBUF-1
+ -TITLEN
+ TAD LPAGE1 /FORM FEED COUNT
+ JMS I (DECOUT
+ TAD LPAGE2
+ SNA CLA
+ JMP .+5 /NO SUB PAGE IF 0
+ TAD (255
+ JMS I PC
+ TAD LPAGE2
+ JMS I (DECOUT
+ ISZ LPAGE2
+ TAD (215 /FOR BH
+ JMS I PC
+ TAD (212
+ JMS I PC
+ TAD (-71 /RESET LINE COUNTER
+ DCA LINPAG
+ JMP CRLF+1 /GIVE ANOTHER CRLF
+RFORMF, 0
+/
+/ PRINT TEXT
+/
+PRTXT, 0
+ TAD I PRTXT
+ DCA X13
+ ISZ PRTXT
+ TAD I PRTXT
+ DCA PRTTMP
+ ISZ PRTXT
+ TAD I X13
+ JMS PRINT2
+ ISZ PRTTMP
+ JMP .-3
+ JMP I PRTXT
+PRTTMP= PRNTLN
+/
+PRINT2, 0
+ DCA P2
+ TAD P2
+ JMS I [R6R
+ JMS P1
+ TAD P2
+ JMS P1
+ JMP I PRINT2
+/
+P1, 0
+ AND [77
+ SNA
+ JMP .+4 /PRINT ZERO AS BLANK
+ TAD (-40 /TEST ABOVE OR BELOW 300
+ SPA
+ TAD [100 /ABOVE, MAKE 301 TO 337
+ TAD [240 /IF BELOW, MAKE 240 TO 277
+ JMS I PC /PRINT IT, WHATEVER IT IS
+ JMP I P1
+\f/
+TTYOUT, 0
+ TLS
+ TSF
+ JMP .-1
+TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE
+ TAD (-14 /CTRL/O
+ SZA CLA
+ JMP I TTYOUT
+ TAD .+2
+ DCA TTYOUT+1
+ JMP I TTYOUT
+/
+P2, 0
+/
+ IFZERO RALF <
+TXLNK, TEXT " LINKS"
+TXLLN= .-TXLNK >
+ IFNZRO RALF <
+TXABR, TEXT " ABS REFS"
+TXALN= .-TXABR >
+ PAGE
+\f/
+/ GET AND EVALUATE AN EXPRESSION
+/
+EXPR, 0 /GET EXPRESSION
+ DCA EXPVAL /ZERO EXPR VALUE
+ DCA EXPVAL+1
+ DCA EXPVAL+2
+ CLA IAC
+ DCA EXPDEF /AND TYPE
+ CLA IAC /SET EXPR SWITCH TO NO EXPR
+ DCA EXPSW
+ DCA FPP2WD /SET FORCE SWITCH OFF
+ CLA IAC /SET LASTOP TO +
+ DCA LASTOP
+ IFZERO RALF <
+ JMS I (CHKLIT /GO CHECK FOR LITERAL>
+ JMS I (GETSGN /IGNORE +, BUMP LASTOP IF -
+SYMBOL, JMS I [GETNAM /NOW PICK UP NAME
+ JMP NOSYM /NONE, TRY OTHER
+ JMS I [LOOKUP /LOOK IT UP
+ JMP UNDEF /A NEW ONE
+ IFZERO RALF <
+ JMP ADR /YES >
+ IFNZRO RALF <
+ CLL RAR
+ SNA
+ JMP ADR
+SCTN, TAD I LTEMP /GET TYPE
+ AND (40 /FORCE BIT
+ SZA CLA
+ ISZ FPP2WD /SET FORCE EXPR SW
+ TAD I X10 /GET ESD FROM SYMBOL
+ AND [7770 /ESD ONLY
+ DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO
+ JMP CLR2 /SO CLEAR WORD 2>
+\fNOTDOT, TAD (256-242 /IS IT DBL QUOTE?
+ SZA CLA
+ JMP ENDEXP
+ ISZ NCHARS /IS THERE ANOTHER CHAR?
+ JMP ISQUOT /YES, USE IT
+ENDEXP, JMS I [BACK1 /PUT IT BACK
+ TAD EXPSW /WAS THERE ANY EXPRESSION AT ALL?
+ SZA CLA
+ JMP BAD /NO, DON'T SKIP
+ IFZERO RALF <
+ TAD LITRL /WAS IT A LITERAL REF?
+ SZA CLA
+ JMS I (CRLIT /YES, STICK IT IN THE POOL>
+ TAD LASTOP /TRAILING OPERATOR?
+ SNA
+ JMP OKEXP /NO, ALL IS FINE
+ CLL RAR /IF PLUS OPERATOR
+ TAD XINCR /AND THATS LEGAL
+ SNA CLA
+OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN
+BAD, JMS CKCTC
+ CLA
+ JMP I EXPR /AND RETURN
+/
+NOSYM, JMS I (NUMBER /LOOK FOR A NUMBER
+ JMP ADREXP /USE NUMBER
+ JMS I [GETCHR /NOT A NUMBER, GET A CHAR
+ JMP ENDEXP+1 /NONE LEFT, END
+ TAD (-256 /IS IT "." ?
+ SZA
+ JMP NOTDOT /NO, TRY FOR QUOTE
+ TAD LOCTR1 /THIS WAS LOC SYMBOL
+ DCA WORD1 /PUT VALUE INTO WORD1,2
+ TAD LOCTR2
+ JMP CLR2 /AND USE VALUE
+ISQUOT, DCA WORD1
+ TAD I CHRPTR
+ JMP CLR2
+CKCTC, 0
+ CLA
+ KSF /IF NOTHING AT THE KEYBOARD,
+ JMP I CKCTC /RETURN
+ TAD [200
+ KRS /ELSE, LOOK AT IT
+ TAD (-203 /IS IT CTRL/C?
+ SNA
+ JMP I [7600 /GO TO MOMMA
+ JMP I CKCTC
+\fADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL
+ AND (40
+ SZA CLA
+ ISZ FPP2WD /AND SET SWITCH IF BIT ON
+ TAD I X10 /GET FIRST WORD OF VALUE
+ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0
+ TAD I X10 /GET REST OF SYMBOL
+CLR2, DCA WORD2
+ CDF FLD0 /FIX FIELD
+ADREXP, DCA EXPSW /KILL FIRST TIME SWITCH
+ TAD LASTOP /PICK UP LAST OPERATOR
+ TAD ADROP /MAKE A JMP I
+ DCA .+1
+ 0 /DO IT
+ADROP, JMP I .
+ ADRADD
+ ADRSUB
+ ADRMUL
+ ADRDIV
+ ADRAND
+ ADROR
+ ADROR
+\fUNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ?
+ SNA CLA
+ JMP .+5 /NO, SKIP AROUND
+ TAD I LTEMP /TURN ON FORCE BIT
+ AND (7737 /FOR THIS SYMBOL
+ TAD (40
+ DCA I LTEMP
+ DCA EXPDEF /SET TYPE TO UNDEFINED
+ CDF FLD0 /FIX FIELD
+ DCA EXPSW /KILL FIRST TIME SWITCH
+ JMS I [ERMSG
+ 2523 /*US*
+OPR8R, TAD (OPR8RS-1 /SET POINTER
+ DCA X11 /TO OPERATOR TABLE
+ DCA LASTOP /ZERO LASTOP
+ JMS I [GETCHR /GET CHAR
+ JMP ENDEXP+1 /NONE, DONE
+ DCA EXTMP /SAVE IT
+FINDOP, ISZ LASTOP
+ TAD I X11 /GET NEXT LIST ENTRY
+ SNA
+ JMP NOOPR /ZERO IS END OF LIST
+ TAD EXTMP /COMPARE
+ SZA CLA
+ JMP FINDOP /LOOP
+ JMP SYMBOL /LOOK FOR OPERAND
+NOOPR, DCA LASTOP /NO MATCH FOUND
+ JMP ENDEXP /PUT IT BACK
+ PAGE
+\fADRADD, IFNZRO RALF <
+ TAD WORD1
+ AND [7770 /IF THIS SYMBOL IS RELOCATABLE,
+ SZA CLA /CHECK FOR EXPR VALIDITY
+ JMS I (RELERR >
+ TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS
+ CLL /ZERO LINK
+ TAD WORD2 /ADD LOW WORDS
+ DCA EXPVAL+2 /SAVE RESULT
+ RAL /PUT CARRY INTO BIT 11
+ TAD WORD1 /ORDER WORDS
+ JMP ADRASX /LOOK FOR OPERATOR
+ADRSUB, IFNZRO RALF <
+ TAD WORD1 /IF SYMBOL IS RELOCATABLE
+ AND [7770 /WE MUST COMPARE SECTIONS
+ CIA /IF EQUAL, EXPR BECOMES ABSOLUTE
+ SNA /ELSE, EXPR IS ILLEGAL
+ JMP .+5 /OK, USE EXPVAL ESD
+ JMS I (RELERR /COMPARE: AC DELIBERATELY NON-ZERO
+ TAD EXPVAL+1
+ AND [7 /IF WORD RELOCATABLE, EXP IS ABS
+ DCA EXPVAL+1 >
+ TAD WORD2 /SUBTR LOW 12 BITS
+ CLL CML CIA
+ TAD EXPVAL+2
+ DCA EXPVAL+2 /SAVE LOW HALF
+ RAL
+ TAD WORD1 /SUBTRACT HIGH HALF
+ CIA
+ AND [7 /DO NOT SUBTR ESD'S
+ADRASX, TAD EXPVAL+1
+ AND (7767 /PREVENT CARRY INTO BIT 8
+ADRASY, DCA EXPVAL+1 /SAVE HIGH HALF
+ JMP I (OPR8R /GET OPERATOR
+/INDXX HERE FOR FLAP
+ IFZERO RALF <
+/ SET BASE AND INDEX LOCS
+INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
+BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
+ DCA X12 /HOPEFULLY UNUSED XR
+ JMS I (ADRGET /COLLECT EXPRESSION
+ TAD EXPVAL+1
+ DCA I X12 /HIGH ORDER AND ESD
+ TAD EXPVAL+2
+ DCA I X12 /LOW ORDER
+ JMP I [NEXTST >
+\fADRAND, TAD WORD1 /AND
+ AND EXPVAL+1 /HIGH
+ AND [7 /3 BITS
+ DCA EXPVAL+1 /HALF
+ TAD WORD2 /THEN
+ AND EXPVAL+2 /LOW
+ JMP ADRAOX
+ADROR, TAD WORD1 /OR IS PERFORMED BY
+ CMA /SETTING THE BITS
+ AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A
+ TAD WORD1 /AND THEN SETTING THE BITS
+ AND [7
+ DCA EXPVAL+1 /THAT ARE ON IN A
+ TAD WORD2
+ CMA
+ AND EXPVAL+2
+ TAD WORD2
+ADRAOX, DCA EXPVAL+2
+ IFNZRO RALF <
+ JMS I (NOREL /**>
+ JMP I (OPR8R /GET NEXT OPERATOR
+/
+\fADRMUL, TAD WORD2 /**RL CODE
+ CIA
+ DCA EXPVAL+1 /MULT BY
+ TAD EXPVAL+2 /REPEATED ADDITIONS
+ ISZ EXPVAL+1
+ JMP .-2
+ JMP ADRAOX
+ADRDIV, DCA WORD1
+ DCA EXPVAL+1
+ TAD WORD2
+ SNA CLA
+ JMP DIVERR
+ TAD EXPVAL+2
+ CIA CLL
+ TAD WORD2
+ SZL
+ JMP .+3 /DIVIDE BY
+ ISZ WORD1 /COUNTING SUBTRACTIONS
+ JMP .-4
+ CLA
+ TAD WORD1
+ JMP ADRAOX
+\fDIVERR, JMS I [ERMSG
+ 0626 /*DV*
+ JMP I (OPR8R /CONTINUE
+\fPDPOPR, TAD CHRPTR
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP
+ JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST
+ JMP TRYEXP /NONE
+ TAD (33 /USE INTERNAL TABLE
+ JMS I [FIND /IS IT THERE ?
+ JMP TRYEXP /NO
+ TAD (-PDPOP /IS IT AN OPERATE ?
+ SZA CLA
+ JMP TRYEXP /NO
+ TAD I X10 /GET VALUE
+ CDF FLD0
+ DCA EXPVAL+2
+PDPOR, TAD EXPVAL+2
+ CMA /OR THEM TOGETHER
+ AND OPCODE
+ TAD EXPVAL+2
+ DCA OPCODE
+ JMS I [GETCHR /MORE CHARS ?
+ JMP I (FPPS3 /NO-DONE
+ TAD [-240 /BLANK ?
+ SNA CLA
+ JMP PDPOPR /YES-PROCESS NEXT
+ JMP I (BADEXP
+TRYEXP, CDF FLD0
+ TAD CPTMP
+ DCA CHRPTR
+ TAD NCTMP
+ DCA NCHARS
+ ISZ NCTMP
+ SKP
+ JMP I (FPPS3
+ JMS I [EXPR
+ JMP I (BADEXP
+ JMP PDPOR
+TXSYM, TEXT " SYMBOLS,"
+ TXSLN=.-TXSYM
+ PAGE
+\f IFZERO RALF <
+/
+/ LITERAL THINGS
+/
+CHKLIT, 0 /CHECK FOR LITERAL
+ DCA PAGENO /ZERO PAGE NUMBER
+ DCA LITRL
+ JMS I [GETCHR /GET CHARACTER
+ JMP I CHKLIT /NO LITERAL
+ TAD (-250 /CHECK FOR (
+ SNA
+ ISZ PAGENO /CURRENT PAGE LITERAL
+ SZA /SKIP IF ALREADY ZERO
+ TAD (-63 /CHECK FOR [
+ SNA
+ ISZ LITRL /SET SWITCH
+ SZA CLA
+ JMS I [BACK1 /PUT BACK NON ([
+ JMP I CHKLIT
+/
+/ CREATE A LINK FOR OFF-PAGE REFERENCE
+/
+MAKLNK, TAD (THSPAG /PROPER RETURN ADDR
+ DCA CRLIT
+ TAD OPCODE /SET INDIRECT BIT
+ TAD (400
+ DCA OPCODE
+ CLA IAC
+ DCA PAGENO /SET INDICATOR
+ ISZ LINKS /COUNT ANOTHER LINK GENERATED
+ ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT
+ JMP NOTP0
+CRLIT, 0 /CREATE LITERAL
+ /VALUE:EXPVAL, IN PAGE:PAGENO
+ TAD PAGENO /CHECK FOR PAGE 0
+ SNA CLA
+ JMP ISP0 /PAGE 0 LITERAL
+NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER
+ DCA LITBAS
+ TAD LOCTR2 /CHECK FOR LIT BUFFER FULL
+ AND [100
+ SNA CLA
+ JMP DOLIT-1 /USE 77 AS LIMIT
+ TAD LOCTR2
+ AND [177
+ JMP DOLIT /USE CURRENT ADDR AS LIMIT
+\fISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER
+ DCA LITBAS
+ TAD [77 /ASSUME FIRST 64 WORDS USED
+DOLIT, DCA NWUSED
+ TAD PAGENO /GET POINTER TO
+ TAD [P0LIT /LITERAL BOUNDARY
+ DCA XPAGE
+ TAD I XPAGE /DISPLACEMENT OF LIT BUFR - 1
+ DCA LITPTR /INTO LITPTR
+NOTIT, TAD LITPTR /POINTER+SIZE
+ TAD (-177 /SHOULD BE LESS THAN 177
+ SMA CLA
+ JMP NEWLIT /ENTER NEW LITERAL
+ TAD LITPTR /NOW GET POINTER
+ TAD LITBAS /TO TABLE
+ DCA X11 /FOR COMPARISON
+ ISZ LITPTR /INCREMENT POINTER
+ TAD I X11 /GET WORD OF LITERAL
+ CIA
+ TAD EXPVAL+2 /COMPARE PROTOTYPE
+ SZA CLA
+ JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY
+LITADR, TAD PAGENO /PAGE 0 ?
+ SZA CLA
+ TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS
+ AND [7600
+ TAD LITPTR /PLUS PAGE DISPLACEMENT
+ DCA EXPVAL+2 /INTO VALUE
+ TAD LOCTR1
+RETLIT, DCA EXPVAL+1
+ JMP I CRLIT
+\fNEWLIT, CLA CMA
+ TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN
+ DCA X10 /ADDRESS OF NEW LITERAL
+ TAD NWUSED /CHECK FOR PAGE OVERFULL
+ CIA
+ TAD X10
+ SMA CLA
+ JMP .+5 /NOT FULL
+ JMS I [ERMSG /*PO*
+ 2017
+ DCA EXPVAL+2 /ZERO ADDRESS
+ JMP RETLIT
+ TAD X10
+ DCA I XPAGE
+ TAD I XPAGE /SET UP POINTER FOR MOVE
+ TAD LITBAS
+ DCA X10
+ TAD EXPVAL+2 /MOVE LITERAL IN
+ DCA I X10
+ TAD I XPAGE /SET UP LITERAL ADDRESS
+ IAC
+ DCA LITPTR
+ JMP LITADR /RETURN LITERAL ADDRESS
+LITBAS, 0
+NWUSED, 0
+LITPTR, 0
+PAGENO, 0
+XPAGE, 0
+ PAGE />
+\f/
+/ FIND SYMBOL TABLE ENTRY
+/ FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3
+/ SKIP IF FOUND WITH TYPE IN AC
+/
+FIND, 0 /SYMBOL TABLE LOOKUP
+ TAD BUCKET /GET BUCKET ADDRESS
+ CDF FLD1 /GO TO FIELD 1
+LOOK, DCA OLDN3 /THIS IS PTR OF PREV ENTRY
+ TAD I OLDN3 /THIS IS ADR OF NEXT ENTRY
+ SNA /IF ZERO, THEN
+ JMP I FIND /IT AIN'T HERE
+ DCA X10 /SAVE NEXT NAME PTR
+ TAD NAME1 /COMPARE NAMES
+ CIA CLL
+ TAD I X10 /WORD 1
+ SZA CLA
+ JMP NOTSAM
+ TAD NAME2
+ CIA CLL
+ TAD I X10 /WORD2
+ SZA CLA
+ JMP NOTSAM
+ TAD NAME3
+ CIA CLL
+ TAD I X10 /COMPARE LAST CHAR
+ AND [7700 /HIGH HALF ONLY
+ SZA CLA
+ JMP NOTSAM
+ ISZ FIND /IF FOUND BUMP RETURN
+ TAD X10
+ DCA LTEMP /ADDR OF TYPE WORD
+ TAD I LTEMP /GET TYPE INTO AC
+ AND [37 /WITHOUT FORCE BIT
+ JMP I FIND /RETURN
+NOTSAM, SZL CLA /IS NAME 1,2,3 .LT. ENTRY
+ JMP I FIND /YES, IT ISN'T HERE
+ TAD I OLDN3 /GET ADDR OF LINK INTO AC
+ JMP LOOK /LOOP
+\f/
+/ FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT
+/
+LOOKUP, 0
+ JMS FIND
+ JMP .+4
+ SZA
+ ISZ LOOKUP /SKIP RETURN IF DEFINED
+ JMP I LOOKUP /RETURN TYPE CODE
+ TAD I OLDN3 /GET FORWARD LINK TO
+ DCA I NEXT /NEXT ENTRY INTO NEW ENTRY
+ TAD NEXT /PUT FORWARD LINK TO NEW
+ DCA I OLDN3 /ENTRY INTO PREVIOUS ENTRY
+ TAD NAME1 /PUT IN NAME
+ DCA I NEXT
+ TAD NAME2
+ DCA I NEXT
+ TAD NAME3
+ DCA I NEXT
+ TAD NEXT /X10=NEXT
+ DCA X10
+ TAD NEXT /LTEMP=NEXT
+ DCA LTEMP
+ DCA I NEXT /INITIAL VALUE IS ZERO
+ DCA I NEXT
+ TAD NEXT /CHECK FOR TABLE FULL
+ CLL
+ TAD [200 /GONNA OVERFLO PS8?
+ SNL CLA
+ JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP)
+ JMS I [ERMSG1
+ 2324 /*ST*
+\f/
+/ COLLECT AN INTEGER IN THE CURRENT RADIX
+/
+NUMBER, 0 /GET INTEGER NUMBER (NO SIGN)
+ DCA NSWTCH /CLEAR SWITCH
+ DCA NOFLO /CLEAR OVRFLO SW
+ DCA WORD1 /CLEAR 24 BIT NUMBER
+ DCA WORD2
+NUMLUP, JMS I (DIGIT
+ JMP NODGT /TOO BAD
+ DCA NUM /YES, SAVE IT
+ TAD WORD1 /SAVE CURRENT VALUE
+ DCA NUM1 /OF NUMBER
+ TAD WORD2
+ DCA NUM2
+ JMS SHIFT /SHIFT WORD1,2, LEFT 1 (MULT BY 2)
+ JMS SHIFT /DO IT AGAIN (MULT BY 4)
+ TAD RADIX /LOOK AT RADIX (1=DECIMAL)
+ SNA CLA
+ JMP OCTNUM /ITS OCTAL
+ CLL /DECIMAL, ADD IN NUMBER
+ TAD NUM2
+ TAD WORD2 /THUS MULTIPLYING BY 5
+ DCA WORD2
+ RAL
+ TAD NUM1
+ TAD WORD1
+ DCA WORD1
+ JMP ADDDGT
+OCTNUM, TAD NUM
+ AND [7770 /CHECK FOR 8 OR 9
+ SZA CLA
+ ISZ NOFLO /SET ERROR FLAG
+ADDDGT, JMS SHIFT /SHIFT LEFT 1 AGAIN, THUS
+ TAD WORD2 /MULTIPLYING BY 8 OR 10
+ CLL /THEN ADD IN NEW DIGIT
+ TAD NUM
+ DCA WORD2
+ RAL
+ TAD WORD1
+ DCA WORD1
+ SZL /BEWARE OF OVERFLO
+ ISZ NOFLO
+ JMP NUMLUP /LOOP
+\fNODGT, TAD NSWTCH /WAS THERE A NUMBER
+ SNA CLA
+ ISZ NUMBER /NO, SKIP
+ TAD WORD1
+ AND [7770 /CHECK FOR MORE THAN 15 BITS
+ SNA
+ TAD NOFLO /OR GROSS OVERFLOW
+ SNA CLA
+ JMP I NUMBER /ALL GREEN
+ JMS I [ERMSG
+ 1605 /*NE*
+ JMP I NUMBER /RETURN
+NOFLO= LOOKUP /ZERO IF NO ERRORS
+NUM= FIND
+NUM1= EXTMP
+NUM2= EXTMP2
+NSWTCH, /ZERO IF NO DIGITS
+SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1
+ TAD WORD2
+ CLL RAL
+ DCA WORD2
+ TAD WORD1
+ RAL
+ DCA WORD1
+ SZL /IF BIT SHIFTED FROM HI WORD,
+ ISZ NOFLO /SET ERROR FLAG
+ JMP I SHIFT
+ PAGE
+\f/
+/ BACK UP GETCHR POINTERS,
+/ WE DON'T WANT THIS ONE
+/
+BACK1, 0
+ CLA CMA /BACKUP COUNT
+ TAD NCHARS
+ DCA NCHARS
+ CLA CMA /AND POINTER
+ TAD CHRPTR
+ DCA CHRPTR
+ JMP I BACK1
+/
+/ GET NEXT CHAR FROM LINE BUFFER
+/ FOR ASSEMBLY PURPOSES ONLY
+/ SKIP UNLESS END OF LINE (CR, ;, OR /)
+/
+GETCHR, 0
+ JMS GETAC
+GETSKP, ISZ GETCHR /SKIP RETURN
+ JMP I GETCHR
+BLANK, JMS GETAC /COME HERE IF BALNK OR TAB
+ TAD (-257 /END OF LINE ON SLASH AFTER BLANK
+ SNA CLA
+ JMP GETCND
+ JMS BACK1 /PUT IT BACK
+ TAD [240 /AND RETURN A SINGLE BLANK
+ JMP GETSKP /SKIP OUT
+SEMICL, ISZ SCSWT
+ JMS BACK1 /PUT BACK SEMI COLON
+ JMP I GETCHR
+GETAC, 0
+ ISZ NCHARS /END OF LINE?
+ JMP .+4 /NO, GET IT
+GETCND, CLA CMA /YES, RESET IN CASE OF
+ DCA NCHARS /ANOTHER CALL
+ JMP I GETCHR /RETURN END OF LINE
+ TAD I CHRPTR /PICK UP NEXT
+ TAD [-240 /CHECK FOR BLANK
+ SZA
+ TAD (240-211 /OR TAB
+ SNA
+ JMP BLANK /THEY GET SPECIAL HANDLING
+ TAD (211-273 /LOOKOUT FOR SEMICOLON
+ SNA
+ JMP SEMICL /ALSO SPECIAL
+ TAD (273-276 /IGNORE CLOSE ANGLE BRACKET
+ SNA
+ JMP GETAC+1 /GET ANOTHER
+ TAD (276 /ELSE, RESTORE CHAR
+ JMP I GETAC /AND PASS IT BACK
+\f/
+/ COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3
+/ NO SKIP ON RETURN IF NO SYMBOL
+/
+GETNAM, 0
+ DCA NAME1 /CLEAR SYMBOL SPACE
+ DCA NAME2
+ DCA NAME3
+ JMS LETTER /GET A LETTER
+ JMP ISSYM
+ JMS GETCHR /CHECK FOR #
+ JMP I GETNAM /NOPE
+ TAD (-"#
+ SNA CLA
+ JMP ISSYM
+ JMS BACK1
+ JMP I GETNAM
+ISSYM, DCA BUCKET
+ ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE
+ JMS GNC /FRIENDLY LOCAL SUBR
+ JMS R6L
+ DCA NAME1
+ JMS GNC
+ TAD NAME1
+ DCA NAME1
+ JMS GNC
+ JMS R6L
+ DCA NAME2
+ JMS GNC
+ TAD NAME2
+ DCA NAME2
+ JMS GNC
+ JMS R6L
+ DCA NAME3
+ JMS GNC /AFTER 6, WE IGNORE
+ SKP CLA
+GNC, 0
+ JMS LETTER
+ JMP I GNC /RETTURN LETTER
+ JMS DIGIT
+ JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER
+ TAD (60
+ JMP I GNC
+\f/
+/ IF NEXT CHAR IS A LETTER, RETURN 6 BITS
+/ IF NOT, REPLACE CHAR AND SKIP.
+/
+LETTER, 0
+ JMS GETCHR
+ JMP NLETR /NO LETTER, SKIP
+ TAD (-333
+ CLL CML
+ TAD (33
+ SZA SNL /DON'T ALLOW 300
+ JMP I LETTER
+ JMS BACK1
+NLETR, ISZ LETTER
+ JMP I LETTER
+/
+/ IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
+/
+DIGIT, 0
+ JMS GETCHR
+ JMP I DIGIT
+ TAD (-272
+ CLL
+ TAD (12
+ SNL
+ JMP NDIGT
+ ISZ DIGIT
+ JMP I DIGIT
+NDIGT, JMS BACK1
+ JMP I DIGIT
+/
+R6L, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I R6L
+/
+R6R, 0
+ RTR
+ RTR
+ RTR
+ AND [77
+ JMP I R6R
+ PAGE
+\f/
+/ BUILD AN INSTRUCTION
+/
+FIXOPC, 0 /COMBINE OPCODE PARTS
+ TAD XFLAG /CHECK INDEX SWITCH
+ SNA CLA
+ JMP ZRONDX /IF ZERO, NO INDEX REG
+ CLA CMA
+ TAD LASTOP /IF INDEX, CHECK FOR INCR
+ SNA CLA
+ TAD [100 /YES, PUT + BIT ON
+ TAD OPCODE /COMBINE WITH OPCODE
+ DCA OPCODE
+ TAD EXPVAL+2 /GET INDEX REG. EXPR
+ AND [7 /ONLY 3 BITS
+ CLL RTL /SHIFT INTO POSITION
+ RAL
+ZRONDX, TAD OPCODE /ADD OPCODE
+ TAD (400 /TURN ON TYPE BIT
+ DCA OPCODE /SAVE OPCODE
+ JMP I FIXOPC /RETURN
+/
+OPR8RS,
+ -253 /PLUS
+ -255 /MINUS
+ -252 /STAR (MULTIPLY) **
+ -257 /SLASH (DIVIDE)
+ -246 /AMPERSAND (AND)
+ -240 /SPACE (OR)
+ -241 /EXCLAMATION (OR)
+ 0 /END OF LIST
+\f/
+/ FATAL ERRORS
+/
+ERMSG1, 0 /PASS 1 (FATAL) MESSAGES
+ CDF
+ TAD I ERMSG1 /GET CODE
+ DCA .+3
+ DCA PASSNO
+ JMS ERMSG /DO THE MSG THING
+ 0
+ IFZERO RALF <
+RETSYS, >
+ TSF /FINISH TYPING
+ JMP .-1
+ JMP I [7600 /EXIT TO PS8
+/
+/ GENERAL GARBAGE TYPE ERRORS
+/
+ERMSG, 0
+ CDF FLD0 /FIX FIELD
+ CLA /NO MESSAGE ON PASS 1
+ TAD PASSNO
+ SMA SZA /IF PASS 3, OUTPUT LEADING CRLF
+ JMS I [CRLF
+ SPA CLA
+ JMP MSGDUN
+ TAD (5555 /MINUSES
+ JMS I [PRINT2
+ TAD I ERMSG /2-CHAR CODE
+ JMS I [PRINT2 /PRINT THE MESSAGE
+ TAD (5555
+ JMS I [PRINT2
+ TAD PASSNO
+ SZA CLA
+ JMP .+4
+ JMS I [PRINT2
+PLINE, JMS I (PRNTLN
+ JMS I [CRLF
+ ISZ ERRORS /BUMP COUNT
+MSGDUN, ISZ ERMSG
+ JMP I ERMSG
+\f/
+/ OUTPUT DECIMAL
+/ SUPPRESS LEADING ZEROS
+/ PRINT "NO" INSTEAD OF "0"
+/
+DECOUT, 0
+ SNA /ZERO IS SPECIAL
+ JMP DECNO /NO INSTEAD OF 0
+ DCA OTEMP
+ DCA OCNT
+ JMS DEC2 /GET THOUSANDS
+ -1750
+ JMS DEC2 /HUNDREDS
+ -144
+ JMS DEC2 /TENS
+ -12
+ TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE)
+ JMS PDIG /PRINT LAST DIGIT
+ JMP I DECOUT /EASY, WHEN YOU KNOW HOW
+/
+DECNO, TAD (1617 /NO
+ JMS I [PRINT2
+ JMP I DECOUT
+/
+/ LAZY MAN'S DIVISION
+/
+DEC2, 0
+ CDF FLD0 /JUST TO MAKE SURE
+DEC3, CLA CLL
+ TAD OTEMP
+ SNA
+ JMP DEC4
+ TAD I DEC2 /SUBTRACT DIVISOR
+ SNL /TOO MUCH?
+ JMP DEC4 /YES, STOP NOW
+ DCA OTEMP /NO, SAVE NEW REMAIN
+ ISZ OCNT /BUMP QUOTIENT
+ JMP DEC3 /DO IT AGAIN
+DEC4, CLA
+ ISZ DEC2 /SKIP RETURN
+ TAD OCNT /CHECK FOR SIGNIFICANCE
+ SNA
+ JMP I DEC2 /NONE
+ JMS PDIG
+ CLA STL RAR /FORCE SIGNIFICANCE
+ DCA OCNT
+ JMP I DEC2
+\f/
+TENTH, -111
+ 1463;1463;1463
+ 1463;1463;1463
+TEN, 1
+PDIG, 0
+ TAD P260
+ JMS I PC
+ JMP I PDIG
+P260, 260
+ 5
+/
+/ OCTAL CONVERSION, THE HARD WAY
+/
+OCTOUT, 0
+ DCA OTEMP
+ STL RAR /NO ZERO SUPPRESS
+ DCA OCNT
+ JMS DEC2
+ -1000
+ JMS DEC2
+ -100
+ JMS DEC2
+ -10
+ TAD OTEMP
+ JMS PDIG
+ JMP I OCTOUT
+ PAGE
+\f/
+/ OUTPUT ONE WORD
+/
+ IFNZRO RALF <
+/
+/ TEXT TYPE CODES:
+TTABS= 0400
+TTORG= 1000
+TTREL= 1400
+/
+OUTREL, DCA WRD /HOLD FIRST WORD
+ DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR
+ TAD FPPADR /GET ESD CODE
+ RTR
+ RTR /RIGHT IN AC
+ AND [177 /STRIP TO ESD ONLY
+ SNA /CHECK FOR ABSOLUTE
+ JMP PUTABS
+ DCA FPPADR /SAVE ESD
+ TAD PASSNO /CHECK FOR PASS 2
+ SZA CLA
+ JMP PRNTRL /IF NOT, TREAT NORMALLY
+ DCA ABSOP
+ CLA STL RTL
+ JMS I (FULCHK /ENSURE 3 WORDS LEFT
+ TAD FPPADR /GET ESD AGAIN
+ TAD (TTREL /INSERT CONTROL CODE
+ DCA I OUTPTR
+ TAD WRD /FIRST DATUM
+ DCA I OUTPTR
+ TAD FPPADR+1
+ DCA I OUTPTR
+ JMS I (FULCHK /IS IT FULL?
+ JMS BMPLOC /TWO WORDS OUT
+ JMS BMPLOC /SO LOCCTR +2
+ JMP I [NEXTST
+PUTABS, ISZ ABREFS /COUNT IT
+ ISZ LINKSW /SET FLAG
+PRNTRL, TAD WRD /GET FIRST WORD
+ JMS OUTWRD
+ TAD FPPADR+1
+ JMS OUTWRD
+ JMP I [NEXTST >
+\f/
+OUTWRD, 0 /OUTPUT ROUTINE
+ DCA WRD /SAVE WORD
+ IFZERO RALF <
+ TAD LOCTR2 /GET LOW 12 BITS OF LOCATION
+ JMS I [R6L
+ AND [37 /GET PAGE NUMBER (WITHIN FIELD)
+ DCA OTEMP /SAVE PAGE NUMBER
+ TAD OTEMP
+ SZA CLA /POINTER TO LITERAL POINTER
+ IAC
+ TAD [P0LIT
+ DCA OWTEMP
+ TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT
+ AND [177
+ CIA /COMPARE WITH LITERAL BOUNDARY
+ TAD I OWTEMP
+ SMA CLA
+ JMP .+3 /NO PAGE OVER FLOW
+ JMS I [ERMSG
+ 2017 /*PO*>
+ TAD PASSNO /CHECK PASS
+ SZA
+ JMP PRNTST /ITS NOT PASS 2
+ IFZERO RALF <
+ TAD WRD /NOW OUTPUT WORD
+ JMS I [R6R
+ JMS OOCHAR
+ TAD WRD
+ AND [77
+ JMS OOCHAR >
+ IFNZRO RALF <
+ TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT
+ SZA CLA
+ JMP INABS /NO PROBLEM
+ CLA IAC
+ JMS I (FULCHK
+ TAD (TTABS /SET ABS CONTROL CODE
+ DCA I OUTPTR
+ TAD OUTPTR /SAVE POINTER FOR FUTRUE REF
+ DCA ABSOP
+INABS, ISZ I ABSOP /BUMP COUNT
+ TAD WRD
+ DCA I OUTPTR
+ JMS I (FULCHK /GOOD!>
+\fPRNTST, SMA SZA CLA
+ TAD LISTSW /IS LIST ON ?
+ SNA CLA
+ JMP ENDOUT /NO, DONT PRINT
+ JMS I [CRLF /NEW LINE
+ TAD LOCTR1 /PRINT LOCATION COUNTER
+ AND [7
+ JMS I (PDIG
+ TAD LOCTR2 /NEXT FOUR DIGITS
+ JMS I [OCTOUT
+ TAD [240
+ JMS I PC
+ TAD WRD /NOW WORD
+ JMS I [OCTOUT
+ TAD LINKSW /LINK GENERATED ON THIS LINE?
+ SZA CLA
+ TAD (4700 /IF SO, GIVE APOSTROPHE SPACE
+ JMS I [PRINT2
+ DCA LINKSW /CLEAR SW
+ JMS I (PRNTLN /PRINT LINE IF NECESSARY
+ENDOUT, JMS BMPLOC /BUMP LOC CNTR
+ JMP I OUTWRD /RETURN
+/
+WRD,
+BMPLOC, 0
+ ISZ LOCTR2 /BUMP LOW ORDER
+ JMP I BMPLOC
+ CLA IAC
+ TAD LOCTR1
+ AND (7767 /STOP CARRY INTO BIT 8
+ DCA LOCTR1
+ JMP I BMPLOC
+\f IFZERO RALF <
+/
+/ PUNCH CONTROL
+/
+NOPNCX, CLA IAC
+ENPNCX, DCA PNCHOF
+ JMP I [NEXTST
+/
+/ OUTPUT AN ORIGIN
+/
+PUTORG, 0
+ TAD PASSNO /CHECK FOR PASS 2
+ SZA CLA
+ JMP I PUTORG /ELSE FORGET IT
+ TAD LOCTR2 /OUTPUT FIRST CHAR
+ JMS I [R6R
+ TAD [100
+ JMS OOCHAR /OUTPUT CHAR
+ TAD LOCTR2 /NOW LOWER HALF OF ORIGIN
+ AND [77
+ JMS OOCHAR
+ JMP I PUTORG
+OWTEMP,
+CHAROO, 0
+OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM
+ DCA CHAROO
+ TAD PNCHOF /PUNCHING?
+ SZA CLA
+ JMP I OOCHAR /NOPE
+ TAD CHAROO
+ TAD CHKSUM
+ DCA CHKSUM
+ TAD CHAROO
+ JMS I [OCHAR
+ JMP I OOCHAR >
+\f/
+/ BEGIN NEXT PASS
+/ WITH APPROPRIATE THINGS RESET
+/ TO DEFAULT VALUES
+/
+RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE
+ TAD USR /EITHER 200 OR 7700
+ SPA CLA /IS USR IN CORE?
+ JMP .+6 /NO
+ CIF 10 /YES, DISMISS IT
+ JMS I USR
+ 11 /USROUT
+ TAD [7700
+ DCA USR /ITS GONE
+ IFNZRO RALF <
+ CLA STL RTL /COUNTING FROM 2,
+ DCA ESDNO /RESET ESD COUNT
+ JMS I (CLRSCT /ZERO ALL SECTION LENGTHS>
+ DCA ASMOF /ZERO CONDITIONAL SWITCH
+ DCA SCSWT /ZERO SEMICOLON SWITCH
+ TAD SYONLY /IF NOT SYM MAP ONLY
+ DCA LISTSW /FORCE LIST ENABLE
+ CLA IAC
+ DCA LPAGE1
+ DCA LPAGE2
+ CLA CMA
+ DCA LINPAG
+ IFZERO RALF <
+ TAD [177
+ DCA P0LIT /RESET LITERAL BUFFER POINTERS
+ TAD [177
+ DCA CPLIT
+ TAD [200 >
+ DCA LOCTR2 /LOCATION COUNTER
+ IFNZRO RALF <
+ TAD (20 >
+ DCA LOCTR1
+ CLL CML RAR /4000
+ DCA BASER /SET BASE BEYOND BELIEF
+ DCA INDXR
+ DCA INDXR+1
+ DCA RADIX /RESET DEFAULT OCTAL
+ DCA ERRORS /ZERO ERROR COUNT
+ DCA LINKS
+ ISZ PASSNO /BUMP PASS NUMBER
+ JMP I (NEWLIN
+ JMP I (NEWLIN /DO NEXT PASS
+ PAGE
+\f/
+/ END OF A PASS
+/
+ENDX, IFZERO RALF <
+ DCA PNCHOF /RE-ENABLE PUNCH>
+ IFNZRO RALF <
+ JMS I (BORG /SET MAX LEN OF CURRENT SECT>
+ TAD PASSNO
+ SMA CLA /WHAT PASS WAS THIS?
+ JMP EOP2 /NOT THE FIRST
+ IFNZRO RALF <
+ TAD (INBUF-400
+ DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD>
+ TAD BFILE
+ SNA CLA
+ JMP START3 /NO BINARY, START PASS 3
+ IFZERO RALF <
+ TAD [200 /START BIN OUT WITH L/T
+ JMS I [OCHAR
+ JMP I (RESET >
+ IFNZRO RALF <
+ JMP I (DMPESD /OUTPUT EXT SYM TABLE>
+/
+EOP2, IFZERO RALF <
+ CLA IAC /DUMP CURRENT PAGE LITERALS
+ JMS I (DMPLIT
+ JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS>
+ TAD PASSNO
+ SMA SZA CLA
+ JMP EOP3 /YES, PRINT SYMBOL TABLE
+ IFZERO RALF <
+ TAD CHKSUM /OUTPUT CHECKSUM
+ JMS I [R6R
+ JMS I [OCHAR
+ TAD CHKSUM
+ AND [77
+ JMS I [OCHAR /LOWER HALF
+ TAD [200 /TRAILER CHAR
+ JMS I [OCHAR >
+ IFNZRO RALF <
+ DCA I OUTPTR /SET OUTPUT END INDICATOR>
+ JMS I (OCLOSE /CLOSE THE BINARY FILE
+START3, DCA PASSNO /SKIP PASS TWO
+ JMS I (OOPEN /OPEN LISTING FILE
+ IFZERO RALF <
+ JMP NOP3 /NO LISTING, GIVE INFO ON TTY>
+ IFNZRO RALF <
+ JMP I (RETSYS >
+ TAD [OCHAR /CHANGE PRINT ROUTINE
+ DCA PC
+ JMP I (RESET /NO,RESET EVERYTHING
+\f/
+/ END OF LAST PASS
+/ GIVE SOME STATISTICS
+/
+EOP3, CLA CMA
+ DCA LINPAG
+ JMS I [CRLF
+NOP3, JMS I (7607 /READ IN OVERLAY
+ 0100
+OVERLY, OVBUFR
+ 40 /USE SYS SCRATCH BLK
+ JMP I (7605
+ JMP I OVERLY
+
+CHCKMR, 0
+ TAD OPCODE /BE SURE ALL REFS ARE
+ AND [200 /ARE ON SAME PG
+ SZA CLA
+ TAD LOCTR2
+ AND [7600
+ CIA
+ TAD EXPVAL+2
+ AND [7600
+ SZA CLA
+ADRERR, JMS I [ERMSG
+ 0201 /**BA**
+ TAD EXPVAL+2
+ AND [177
+ TAD OPCODE
+ JMS I [OUTWRD
+ JMP I [NEXTST
+
+IOERR, TAD INOP /REMOVE JMS PRNTLN
+ DCA PLINE
+ JMS I [ERMSG1
+ 1117 /**IO**
+INOP, NOP
+
+ PAGE
+\f IFZERO RALF <
+/ ORG THINGS FOR ABSOLUTE ASSEMBLIES
+/
+TRYSTR, JMS I [GETCHR
+ JMP I [NEXTST /WHAT CAN YOU DO?
+ TAD (-252 /IS IT AN ORG
+ SZA CLA
+ JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE
+ORGX, JMS I (ADRGET
+ TAD LOCTR1 /CHECK FOR NEW FIELD
+ CIA
+ TAD EXPVAL+1
+ SNA CLA
+ JMP SAMFLD /NOT A DIFFERENT FIELD
+ CLA IAC
+ JMS DMPLIT /DUMP CURRENT PAGE LITERALS
+ JMS DMPLIT /DUMP PAGE 0 LITERALS
+ TAD EXPVAL+1
+ AND [7
+ DCA LOCTR1
+ TAD PNCHOF /PUNCHING ENABLED?
+ SNA
+ TAD PASSNO /PASS 2?
+ SZA CLA
+ JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD
+ TAD LOCTR1 /NEW FIELD BITS
+ RTL CLL
+ RAL
+ TAD (300 /TURN ON THE LEFT TWO BITS
+ JMS I [OCHAR /PUT IT OUT (NOT IN CHECK SUM)
+ JMP SAMPAG /DO THE SAME FOR CURRENT PAGE
+SAMFLD, TAD LOCTR2
+ AND [7600 /CHECK FOR SAME PAGE
+ DCA LTEMP
+ TAD EXPVAL+2
+ AND [7600
+ CIA
+ TAD LTEMP
+ SNA CLA
+ JMP SAMPAG /PAGE IS THE SAME
+ CLA IAC
+ JMS DMPLIT /DUMP CURRENT PAGE LITERALS
+SAMPAG, TAD EXPVAL+2
+ DCA LOCTR2
+ JMS I (PUTORG
+ JMP I [NEXTST /DONE
+PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE
+ CLL
+ TAD [177
+ AND [7600
+ DCA EXPVAL+2
+ RAL
+ TAD LOCTR1
+ DCA EXPVAL+1
+ JMP ORGX+1 /DO ORG THINGS
+\fDMPLIT, 0
+ DCA PAGEN /SAVE PAGE INDICATOR
+ TAD OUTSWT /SAVE OUTPUT SWITCH
+ DCA SWTOUT
+ ISZ OUTSWT /DONT PRINT LINE WITH LITERALS
+ TAD PAGEN
+ TAD [P0LIT /GET BOUNDARY POINTER
+ DCA LTEMP
+ TAD PAGEN /WHICH LITERAL BUFFER ?
+ SNA CLA
+ TAD (P0LBUF-CPLBUF /PAGE 0 BUFFER
+ TAD (CPLBUF /CURRENT PAGE BUFFER
+ TAD I LTEMP /PLUS PAGE ADDRESS
+ DCA X10 /GIVES START OF LITERALS -1
+ TAD PAGEN
+ SZA CLA
+ TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS
+ AND [7600
+ TAD I LTEMP /PLUS LOWER SEVEN
+ IAC /PLUS ONE
+ DCA LOCTR2 /GIVES LOCATION COUNTER
+ TAD LOCTR2
+ AND [177 /ANYTHING TO DUMP?
+ SNA CLA
+ JMP DMPFIN /NO
+ TAD PASSNO
+ SMA SZA CLA
+ JMS I [CRLF /ONLY IF PASS 3
+ JMS I (PUTORG
+ TAD [177 /STORE SPURIOUS LITERAL BOUNDARY
+ DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES
+LITLUP, TAD I X10 /NO, GET NEXT LITERAL
+ JMS I [OUTWRD /OUTPUT WORD AND BUMP LC
+ TAD X10 /DONE?
+ IAC
+ AND [77
+ SZA CLA
+ JMP LITLUP /LOOP
+DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH
+ DCA OUTSWT
+ JMP I DMPLIT /ALL DONE
+SWTOUT, 0 >
+\fEXPON, TAD LASTOP
+ DCA TMP
+ DCA LASTOP
+ JMS I (GETSGN /GET SIGN OF EXPONENT
+ TAD RADIX
+ DCA OTEMP
+ ISZ RADIX /SET RADIX TO DECIMAL
+ JMS I (NUMBER /GET EXPONENT
+ NOP
+ TAD OTEMP
+ DCA RADIX /RESTORE RADIX
+ TAD TMP
+ CLL RAR
+ TAD LASTOP
+ RAR /LASTOP TO LINK,
+ DCA LASTOP /TMP TO SIGN OF LASTOP
+ TAD WORD2
+ SZL
+ CIA /PUT SIGN ON EXP
+ JMP I (OVER
+TMP, 0
+ IFZERO RALF < PAGE / >
+\f IFNZRO RALF <
+/
+/ IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
+/
+RETSYS, JMS I (DELFIL /THIS LOCATION USED BY INIT CODE
+/MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING
+/FROM COMPILER + OUTPUT DEV IS NOT SYS
+ CDF 10
+ TAD (7604 /POINT TO 2ND OUT FILE THING
+ DCA X11
+ TAD (7611 /POINTER TO 3RD
+ DCA X10
+ TAD (-5 /LENGTH OF SUCH THINGS
+ DCA LTEMP
+ TAD I X10 /MOVE 3RD TO 2ND
+ DCA I X11 /FOR LOADER MAP FILE
+ ISZ LTEMP
+ JMP .-3
+ TAD I [7600 /WAS THERE A FIRST OUT FILE
+ AND NP17 /(BINARY OUT)*
+ DCA LTEMP
+ TAD OUTBLK /GET FILE LENGTH
+ AND (377
+ CLL RTL
+ RTL
+ CIA
+ TAD LTEMP /COMBINE UNIT AND LEN
+ DCA I X10 /FOR FIRST INPUT FILE TO LOADER
+ TAD PASBLK /STARTING BLOCK
+ DCA I X10
+ DCA I X10 /THAT'S THE END OF INPUT
+ CDF 0
+ TAD ERRORS /IF NO ERRORS
+ SNA CLA
+ ISZ CHNSW /SHOULD WE CHAIN?
+ JMP I (7605 /NO!!!
+ ISZ I (7746 /**
+ CIF 10
+ JMS I USR
+ 6 /CHAIN
+LDRBLK, 0 /FIRST BLOCK OF LOADER
+/
+PASBLK, 0 /FIRST BLOCK OF FILE PASSED
+CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
+\f/
+/ OUTPUT A BLOCK OF BINARY
+/
+OUTBLK, 0 /AT END OF PASS2, BECOMES
+ /LENGTH OF BINARY FILE
+ TAD (OUCTL /DEV HNDLR CONTROL WORD
+ JMS I (OUTDMP /CALL THE HANDLER
+ TAD MOUBUF
+ DCA OUTPTR /RESET BUFFER POINTER
+ DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL
+ JMP I OUTBLK
+MOUBUF, OUBUF-1
+/
+TYPCOD, 2500 /UNDEFINED
+ 0000 /ADDRESS
+ 3000 /XTERNAL
+ 0300 /COMMON
+ 2300 /SECTION
+ -1 /?
+ -1 /?
+ 7000 /8-M0DE SECTION
+ 3200 /8-MODE PAGE0 COMMON SECTION
+ 0600 /8-MODE FIELD1 SECTION
+\fBORG, 0
+ CDF FLD0
+ TAD LOCTR1
+ RTR
+ RTR
+ AND [177
+ TAD (ESDBUF-1 /POINT INTO ESD TABLE
+ DCA LTEMP
+ TAD I LTEMP
+ TAD (4 /ADDRESS VALUE
+ DCA LTEMP
+ CDF FLD1
+ TAD LOCTR1
+ AND [7 /GET ADDR BITS ONLY
+ DCA BOTMP /SAVE EM
+ TAD I LTEMP /OLD HIGH VALUE BITS
+ AND [7
+ CIA
+ TAD BOTMP /COMPARE THEM
+ SPA
+ JMP BOXIT /NO UPDATE REQUIRED
+ SNA CLA
+ JMP BOCHKL /NO DIFFERENCE YET
+ TAD LOCTR1
+ DCA I LTEMP /RESET TO NEW HIGH
+ ISZ LTEMP
+ JMP BOSETL /SKIP OVER TEST
+BOCHKL, ISZ LTEMP /POINT TO LO-ORDER
+ TAD I LTEMP
+ CIA CLL
+ TAD LOCTR2 /COMPARE LOW ORDERS
+ SNL CLA
+ JMP BOXIT /NO REPLACE
+BOSETL, TAD LOCTR2
+ DCA I LTEMP
+BOXIT, CLA
+ CDF FLD0
+ JMP I BORG /WHEW!
+BOTMP= EXTMP
+ PAGE
+\fNEWESD, 0
+ TAD ESDNO
+ TAD (-177 /CHECK LIMIT
+ SPA CLA
+ JMP .+3
+ JMS I [ERMSG1 /TOO MANY
+ 3023 /*XS*
+ ISZ ESDNO /BUMP COUNT
+ TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1
+ SMA CLA
+ JMP I NEWESD
+ TAD ESDNO
+ TAD (ESDBUF-1 /INDEX BUFFER
+ DCA ESDTMP
+ CDF FLD1
+ TAD I OLDN3 /GET POINTER TO THIS SYMBOL
+ CDF FLD0
+ DCA I ESDTMP
+ TAD ESDTMP
+ TAD [200
+ DCA ESDTMP /NOW ADDRESS CHAR TABLE
+ TAD BUCKET
+ DCA I ESDTMP
+ JMP I NEWESD
+ESDTMP= EXTMP
+/
+/ RELOCATION CONTROL PSEUDO-OPS
+/
+ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT
+ JMP ESDERR
+ JMS I [LOOKUP /FIND IT
+ JMP QENT /UNDEFINED
+ CLL RAR /MUST BE USER ADDR TYPE
+ SNA CLA
+ TAD I X10 /LOOK AT ESD
+ AND [7770
+ SZA CLA /IS IT RELOCATABLE?
+ JMP OKENT /YES
+QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1
+ 1105 /*IE*
+OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT
+ JMP I [NEXTST
+\f/
+EXTRNX, CLA STL RTL
+ DCA STYPE /EXTERNS ARE TYPE 2
+ JMS I [GETNAM
+ JMP ESDERR
+ JMS I [LOOKUP
+ JMS CRESD /IF UNDEFINED, DEFINE IT
+ CLL RTR /IF DEFINED, CHECK LEGALITY
+ SZA CLA
+ESDERR, JMS I [ERMSG
+ 0523 /*ES*
+ JMP I [NEXTST
+/
+ CLA IAC /FIELD1 SECT=11
+ IAC /COMMZ SECT=10
+SECT8X, TAD [7
+ JMP COMMX+1
+SECTX, CLA IAC
+COMMX, TAD (COMMN /GET DESIRED CODE
+ DCA STYPE /FOR SECTION TYPE
+ JMS I [GETNAM
+ DCA BUCKET /IF NO NAME, BLANK COMMON
+ JMS I [LOOKUP
+ JMP NEWSCT /UNDEFINED
+ CIA /OLD FRIEND
+ TAD STYPE /SAME?
+ SNA CLA
+ JMP SETSCT /YUP, DO IT
+ JMP ESDERR
+/
+CRESD, 0
+ JMS NEWESD /CREATE NEW ESD ENTRY
+ CDF FLD1
+ TAD I LTEMP /SET TYPE CODE
+ AND [7700
+ TAD STYPE
+ DCA I LTEMP
+ ISZ LTEMP
+ TAD ESDNO
+ CLL RTL /ESD NO TO SYMBOL VLAUE
+ RTL
+ DCA I LTEMP
+ CDF FLD0
+ JMP I CRESD
+/
+NEWSCT, JMS CRESD /CREATE AN ESD
+SETSCT, JMS I (BORG /ADJUST LOC CTR'S
+ CDF FLD1
+ TAD I X10 /GET NEW LOC CTR VALUE
+ DCA LOCTR1
+ TAD I X10
+ DCA LOCTR2 /LOW LOC CTR
+ CDF FLD0
+ JMP PUTORG
+\f/
+ORGX, JMS I (ADRGET /GET ORG EXPR
+ JMS I (BORG
+ TAD EXPVAL+1
+ AND [7770 /DOES IT HAVE AN ESD?
+ SNA CLA
+ TAD LOCTR1 /IF NOT, KEEP CURRENT ESD
+ AND [7770
+ TAD EXPVAL+1
+ DCA LOCTR1 /RESET PC
+ TAD EXPVAL+2
+ DCA LOCTR2
+PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY
+ SZA CLA
+ JMP I [NEXTST
+ DCA ABSOP /CLEAR ABS OUTPUT SW
+ CLA STL RTL
+ JMS I (FULCHK /ROOM FOR MORE?
+ TAD LOCTR1
+ RTR
+ RTR /GET ESD
+ AND [177
+ TAD (TTORG
+ DCA I OUTPTR
+ TAD LOCTR1
+ AND [7 /FIELD BITS
+ DCA I OUTPTR
+ TAD LOCTR2 /ADDRESS
+ DCA I OUTPTR
+ JMS I (FULCHK
+ JMP I [NEXTST
+ PAGE />
+\f/
+/ VARIOUS PSEUDO-OP HANDLERS
+/
+LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY
+LSTOFX, DCA LISTSW
+ JMP I [NEXTST
+/
+DECX, CLA IAC
+OCTALX, DCA RADIX
+ JMP I [NEXTST
+/
+TEXTX, JMS I [GETCHR /GET DELIMITER
+ JMP I [NEXTST /NULL STMT
+ CIA
+ DCA EXTMP /SAVE - DELIM
+LOOP6B, JMS GETCHT /GET HIG ORDER CHAR
+ JMP I [NEXTST
+ JMS I [R6L /SHIFT IT UP
+ DCA LTEMP /SAVE HALF
+ JMS GETCHT /GET LOWER CHAR
+ JMP OUTTXT /GO PUT LAST
+ TAD LTEMP /PUT 2 CHARS TOGETHER
+ JMS I [OUTWRD /OUTPUT WORD
+ JMP LOOP6B /LOOP
+OUTTXT, TAD LTEMP /PUT OUT HALF WORD
+ JMS I [OUTWRD /OR ZERO WORD
+ JMP I [NEXTST
+GETCHT, 0 /GET CHAR FOR TEXT STMT
+ ISZ NCHARS /BUMP COUNT
+ SKP
+ JMP I GETCHT /END OF TEXT
+ TAD I CHRPTR /GET CHAR
+ DCA BUCKET /SAVE IT
+ TAD BUCKET /IS IT THE DELIM ?
+ TAD EXTMP
+ SNA CLA
+ JMP I GETCHT /YES, RETURN NO SKIP
+ ISZ GETCHT /BUMP RETURN
+ TAD BUCKET /GET CHAR
+ AND [77 /LOW 6 BITS
+ JMP I GETCHT /RETURN
+\f/
+/ CONDITIONAL ASSEMBLY HANDLERS
+/
+IFNZRX, CLA CMA
+IFZROX, JMS GETCON /GET CONDITION EXPR
+ TAD EXPVAL+1 /HIGH ORDER
+ AND [7
+ SNA
+ TAD EXPVAL+2 /LOW ORDER
+SWTCH, SNA CLA
+ JMP TRUE /PRESENT CONDITION OF ASMOF IS OK
+FALSE, TAD ASMOF /GOTTA REVERSE IT
+ CMA
+ DCA ASMOF /THAT DOES IT
+TRUE, CDF FLD0
+ JMS I [GETCHR
+ JMP BADCND /FORGOT THE ANGLE
+ TAD [-240 /IGNORE BLANK, IF ANY
+ SNA
+ JMP TRUE /TRY AGAIN
+ TAD (240-274
+ SNA CLA
+ JMP I (ASMBL /GO FROM HERE
+ JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT
+ JMP BADCND
+/
+GETCON, 0
+ DCA ASMOF /SET INITIAL TRUTH
+ JMS I [EXPR /COLLECT EXPR
+ JMP OKCND /BAD MAY MEAN GOOD
+BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD
+ 1103 /*IC*
+ DCA ASMOF /ENABLE ASSEMBLY
+ JMP I (ASMBL
+OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST?
+ SNA CLA
+ JMP I GETCON /YES
+ JMP BADCND
+/
+IFNEGX, CLA CMA
+IFPOSX, JMS GETCON
+ CLA CLL IAC RTL /4
+ AND EXPVAL+1 /SIGN OF EXPR
+ JMP SWTCH /GO FROM THERE
+/
+IFNDFX, CLA CMA
+IFREFX, DCA ASMOF
+ JMS I [GETNAM /GET SYMBOL NAME
+ JMP BADCND /GOTTA GIVE SOMETHING
+ JMS I [FIND /IS IT KNOWN TO US?
+ JMP FALSE /NOT REFERENCED YET
+ SNA CLA /SKIP IF DEFINED
+ DCA ASMOF /ELSE ASSEMBLE
+ JMP TRUE
+\fIFSWX, CLA CMA
+IFNSWX, DCA ASMOF
+ TAD (7642 /ADDRESS OF OPTION WORDS
+ DCA WORD2 /A TEMP
+ JMS I (LETTER /ALLOW LETTER
+ JMP .+4 /AC BETWEEN 1 AND 32
+ JMS I (DIGIT /OR NUMBER
+ JMP BADCND /ALL ELSE IS BAD
+ TAD (33 /MAKE 0 = Z+1
+ ISZ WORD2 /BUMP POINTER
+ TAD (-14 /IS IT IN THIS WORD?
+ SMA SZA
+ JMP .-3 /NO, POINT TO NEXT
+ CIA
+ CMA STL /BIT COUNT AWAY FROM LINK
+ DCA WORD1
+ RAL /SHIFT
+ ISZ WORD1 /COUNT
+ JMP .-2
+ CDF 10 /OPTIONS FIELD
+ AND I WORD2 /GET SELECTED BIT
+ JMP SWTCH /AND TEST IT
+/
+ZBLKX, JMS I (ADRGET /EVALUATE EXPR
+ TAD EXPVAL+2
+ CIA
+ DCA ZBCNT /HOLD COUNT
+ TAD LISTSW /SAVE LISTSWITCH
+ DCA ZBTMP
+ JMS I [OUTWRD /PUT A WORD
+ DCA LISTSW /NO LIST AFTER FIRST
+ ISZ ZBCNT /COUNT THEM
+ JMP .-3 /MORE
+ TAD ZBTMP /RESTORE
+ DCA LISTSW /LISTING
+ JMP I [NEXTST
+ZBCNT= EXTMP
+ZBTMP= EXTMP2
+ PAGE
+
+
+\f PTP=20
+ DCB=7760
+ INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
+IN7400, 7400
+NINCTL, INCTL+1
+NINREC, INRECS
+IOPEN, 0
+ TAD (7617
+ DCA INFPTR /RESET FILE POINTER
+ JMS INNEWF /FETCH NEW HNDLR, ETC
+ /WHILE USR IS STILL IN CORE
+ CLA CMA
+ DCA INCHCT /FORCE A READ ON NEXT CHAR
+ JMP I IOPEN
+
+ICHAR, 0
+IN7600, 7600
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SZA CLA /DID LAST READ GIVE EOF ?
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ TAD INCTR
+ CLL
+ TAD NINREC
+ SNL
+ DCA INCTR /RESTORE INCR IF NOT OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ CLL CML CMA RTR /MAKE CONTROL WORD
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CNTRL WD
+ TAD NINCTL
+ DCA INCTLW
+ CDF
+ JMS I INHNDL /CALL THE DEVICE HANDLER
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMP INERRX /SOME KIND OF HANDLER ERROR
+INBREC, TAD INREC
+ TAD NINREC
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
+ SMA CLA /WHICH TYPE WAS IT ?
+ JMP INBREC /END OF FILE - RESUME PROCESSING
+ JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE
+INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND IN7400
+ CLL RTR
+ RTR /COMBINE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE 2 WORD TO FORM THE 3RD CHAR
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND (177 /PHPH WAS 277
+ TAD (-32 /PHPH WAS 232
+ SNA /IS THE CHARACTER A ^Z?
+ JMP GETNEW /YES - GET A NEW FILE
+ TAD (232 /RESTORE THE CHARACTER /PHPH NOW WE HAVE PARITY ON!
+ CDF
+ JMP I ICHAR /AND RETURN
+INFPTR, 7617
+INEOF, 1 /PARAMETERS ARE SET UP SO THAT
+INCHCT, /IOPEN IS UNNECESSARY.
+INNEWF, -1
+ TAD NINDEV
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ CDF 10
+ TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
+ CDF
+ SNA /ANY MORE?
+ JMP I (ENDX /NO MORE INPUT
+ CIF 10
+ JMS I USR
+ 1 /ASSIGN, FETCH HANDLER
+
+INHNDL, 0
+ JMP I [IOERR /HUH?
+ CDF 10
+ TAD I INFPTR
+ AND (7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH GE 256
+ TAD [17 /ADD HIGH ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR
+ CDF
+ DCA INREC /STARTING RECORD NUMBER OF FILE
+ ISZ INFPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+ JMP I INNEWF
+INCTR, 0
+INPTR, 0
+OUFNAM, 0;0;0;0 /OUTPUT FILE NAME
+NINDEV, INDEVH
+ PAGE
+\fOOPEN, 0
+ TAD OUFILE /INCR OUTPUT FILE POINTER
+ TAD (5
+ DCA OUFILE
+ CDF 10
+ TAD I OUFILE /GET DEVICE CODE, LEN
+ DCA OUELEN /HOLD IT A MO
+ JMS I (OFNAME /GET FILE NAME INTO FIELD 0
+ TAD OUELEN /CHECK FOR NULL FILE
+ SNA CLA
+ JMP ONOFIL /INHIBIT OUTPUT
+ JMS GETUSR /LOAD USR IF NOT ALREADY IN
+ TAD OUNAME /RESET ENTER CALL
+ DCA OUBLK
+ TAD NOUDEV
+ DCA OUHNDL
+ TAD OUELEN /THE UNIT
+ CIF 10
+ JMS I USR
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ JMP I [IOERR /HUH?
+ TAD OUELEN /UNIT AGAIN
+ CIF 10
+ JMS I USR
+ 3 /ENTER OUTPUT FILE
+OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP I [IOERR /YOU BLEW IT!!!
+ DCA OUCCNT
+ DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
+ JMS I (OUSETP
+ ISZ OOPEN
+ JMP I OOPEN
+ONOFIL, ISZ I (OUTINH
+ JMP I OOPEN
+OUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE STARTING BLOCK
+ TAD OUCTLW
+ JMS I [R6L
+ AND [17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE SIZE OF FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /EXCEED GIVEN LENGTH ?
+ JMP I [IOERR /YES - ERROR
+ CDF
+ JMS I OUHNDL
+OUCTLW, 0
+LOUBUF, OUBUF
+OUREC, 0
+ JMP I [IOERR
+ JMP I OUTDMP
+OCLOSE, 0
+ JMS GETUSR /ENSURE USR IN CORE
+ IFNZRO RALF <
+ TAD PASSNO
+ SZA CLA
+ JMP .+6
+ TAD (377
+ JMS I (FULCHK /DUMP LAST BLOCK
+ TAD OUCCNT /SAVE FILE LENGTH
+ DCA I (OUTBLK /FOR CHAIN
+ JMP NODUMP >
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
+ SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
+ TAD (232 /OUTPUT A ^Z
+ JMS I [OCHAR
+FILLLP, JMS I [OCHAR
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD [100
+ TAD [77
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES DON'T DO IT
+ TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS
+ JMS OUTDMP
+NODUMP, CIF CDF 10
+ TAD I OUFILE
+ CDF
+ JMS I USR
+ 4 /CLOSE THE OUTPUT FILE
+OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
+OUCCNT, 0
+ JMP I [IOERR /ERROR WHILE CLOSING - BAD!!
+ JMP I OCLOSE /ALL DONE
+NOUDEV, OUDEVH
+\f/
+/ LOAD USR IF NOT IN CORE ALREADY
+/
+GETUSR, 0
+ TAD USR /CURRENT CALL ADDR
+ SMA CLA
+ JMP I GETUSR /WE GOT IT
+ CIF 10
+ JMS I USR /THE ANSWERING SERVICE
+ 10 /CALLS THE SR
+ TAD [200
+ DCA USR /RESET THE CALL ADDRESS
+ JMP I GETUSR /JES FINE
+ PAGE
+\fFULCHK, 0
+ IFNZRO RALF <
+/
+/ IF THE RELOCATABLE BINARY OUTPUT
+/ BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
+/ FILL THE REST WITH NOP CODES AND OUTPUT THE
+/ BLOCK.
+/
+ TAD OUTPTR
+ TAD KOUBUF
+ SPA CLA
+ JMP I FULCHK
+FULLUP, TAD OUTPTR
+ TAD KOUBUF
+ SMA CLA
+ JMP .+4
+ CLA IAC
+ DCA I OUTPTR
+ JMP FULLUP
+ JMS I (OUTBLK
+ JMP I FULCHK
+KOUBUF, -OUBUF-377 >
+/
+/
+/ GET SIGN CHARACTER IF ANY
+/ BUMP LASTOP IF MINUS
+/
+GETSGN, 0
+ JMS I [GETCHR
+ JMP I GETSGN
+ TAD (-255 /MINUS?
+ SNA
+ ISZ LASTOP
+ SZA
+ CLL CMA RAR /IF IT WAS PLUS, BECOMES 0
+ SZA CLA /SKIP IF PLUS OR MINUS
+ JMS I [BACK1 /OTHERWISE PUT IT BACK
+ JMP I GETSGN
+\f/ AS PER RICHIE LARY
+/
+/ SINGLE AND DOUBLE PRECISION
+/ FLOATING POINT INPUT
+/
+/
+EX, TAD M3
+FX, TAD M3
+ DCA DESW /STORE LENGTH
+ TAD (-7
+ JMS CLEAR /CLEAR FAC+OP
+ DCA LASTOP
+ JMS GETSGN /GET SIGN
+ STA /CLA CMA
+ DCA DPSW /SET NO DP
+GETD, DCA DCNT
+ JMS I (DIGIT /GET A DIGIT
+ JMP LOOKP /NO
+ DCA OTEMP /SAVE IT
+ JMS I (FMPTEN /MULT FAC*10
+ JMS CLEAR
+ TAD OTEMP
+ SZA
+ JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0
+ TAD DPSW
+ CMA
+ TAD DCNT /BUMP IF FP SEEN
+ JMP GETD
+\fLOOKP, JMS I [GETCHR
+ JMP OVER /DONE
+ TAD (-256
+ SNA
+ JMP DECPT
+ TAD (256-304
+ CLL RAR
+ SNA CLA
+ JMP I (EXPON /E OR D
+DEXERR, JMS I [ERMSG
+ 0620 /FP
+ JMP NOTNEG
+DECPT, ISZ DPSW
+ JMP DEXERR /2 PERIODS
+ JMP GETD
+/
+OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC
+ SNA
+ JMP NOSCAL /NO SCALING NEEDE
+ CLL
+ SMA
+ CIA CML /SIGN IN LINK,MAGNITUDE IN AC
+ DCA DCNT /AS A COUNT
+ SNL
+ TAD (TENTH-TEN /OFFSET KLUDGE
+ DCA OTEMP
+SCALUP, TAD OTEMP
+ JMS I (FMPTEN /MULT BY 10.0 OR 0.1
+ ISZ DCNT
+ JMP SCALUP
+NOSCAL, JMS CLEAR
+ STL RAR
+ DCA OP+5 /ROUNDING CONSTANT
+ JMS I (ADD
+ TAD AC
+ SZA CLA
+ JMS I (NORM /WATCH IT!
+ DCA AC+5
+ TAD LASTOP
+ SNA CLA /SIGN -?
+ JMP NOTNEG /NO
+ TAD (AC+5
+ JMS I (SETUP
+ACNGLP, RAL
+ TAD I P /NEGATE FAC
+ CLL CIA
+ DCA I P
+ STA
+ TAD P
+ DCA P
+ ISZ CT
+ JMP ACNGLP
+NOTNEG, JMS CLEAR /SET UP X10
+ TAD I X10
+ JMS I [OUTWRD
+ ISZ DESW /OUTPUT #
+ JMP .-3
+ JMP I [NEXTST
+\fCLEAR, 0 /AC MAY NOT BE 0
+ TAD (-7
+ DCA CT
+ TAD (OPX-1
+ DCA X10
+ DCA I X10
+ ISZ CT
+ JMP .-2
+ JMP I CLEAR
+ DCNT=FULCHK
+ DPSW=NCTMP
+ DESW=OPCODE
+ PAGE
+\f OVBUFR=.
+FAD, 0 /FLOATING ADD DIGIT IN AC
+ DCA OP
+ TAD (13
+ DCA OPX
+ALNLP, TAD OPX
+ CIA
+ TAD ACX
+ SNA /ALIGNED?
+ JMP GOADD /YES
+ SMA CLA
+ TAD (OPX-ACX
+ JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1
+ JMP ALNLP /TRY AGAIN
+GOADD, JMS ADD /ADD FRACTIONS
+ JMS NORM /NORMALIZE RESULT
+ JMP I FAD /RETURN
+/
+RSHFT, 0 /SHIFT RIGHT
+ TAD (ACX /DEFAULT IS FAC
+ JMS SETUP
+ ISZ I P /BUMP EXPONENT
+RSLP, ISZ P
+ TAD I P
+ RAR
+ DCA I P
+ ISZ CT
+ JMP RSLP
+ JMP I RSHFT
+/
+ADD, 0 /ADD TO FAC
+ TAD (OP+5
+ DCA PP2
+ TAD (AC+5
+ JMS SETUP
+ADDLP, RAL /CARRY
+ TAD I PP2
+ TAD I P
+ DCA I P /ADD ONE WORD
+ STA
+ TAD P /COMPLEMENT LINK
+ DCA P
+ STA
+ TAD PP2 /COMPLEMENT LINK
+ DCA PP2
+ ISZ CT
+ JMP ADDLP
+ JMP I ADD
+\fNORM, 0 /NORMALIZE FAC
+ TAD AC
+ SPA CLA /CHECK FOR OVERNORMALIZATION
+ JMS RSHFT /AND CORRECT
+NORMLP, STL RTR
+ AND AC
+ SZA CLA /NORMALIZED?
+ JMP I NORM /YES
+ TAD (AC+5
+ JMS SETUP
+LSLP, TAD I P
+ RAL /LEFT SHIFT
+ DCA I P /FAC 1 BIT
+ STA CML /COMPLEMENT LINK
+ TAD P
+ DCA P
+ ISZ CT
+ JMP LSLP
+ STA
+ TAD ACX /BUMP EXP
+ DCA ACX /DOWN 1
+ JMP NORMLP
+\fFMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1
+ TAD (TEN
+ JMS SETUP
+ TAD AC
+ SNA CLA /AC=0 MEANS RESULT=0
+ JMP I FMPTEN
+ TAD I P
+ TAD ACX /FUDGE FAC
+ DCA ACX /EXPONENT
+ TAD (MUX
+ DCA X11
+ TAD (ACX
+ DCA SETUP
+ TAD (OPX
+ DCA X10
+ DCA MUX /CLEAR MULT TEMP EXP
+MPLP1, ISZ SETUP
+ TAD I SETUP /MOVE FAC
+ DCA I X10 /TO OP
+ DCA I SETUP /CLEAR FAC
+ ISZ P
+ TAD I P /MOVE MULTIPLIER
+ DCA I X11 /TO MULT TEMP
+ ISZ CT
+ JMP MPLP1
+/
+MPLP2, TAD (MUX-ACX
+ JMS RSHFT /SHIFT MULT TEMP RIGHT 1
+ SZL
+ JMS ADD /ADD IF LOW ORDER BIT WAS 1
+ JMS RSHFT /SHIFT FAC RIGHT
+ TAD MU+5
+ SZA CLA /12 SUCCESSIVE 0 BITS
+ JMP MPLP2 /IN MULTIPLIER MEANS DONE
+ JMS NORM
+ JMP I FMPTEN
+/
+SETUP, 0 /COMMON CODE
+ DCA P
+ TAD (-6
+ DCA CT
+ CLL
+ JMP I SETUP
+/
+MUX, 0 /MULT TEMP
+MU, ZBLOCK 6
+ CT=CPTMP
+ P=EXTMP
+ PP2=PAGEN
+\f PAGE
+\f IFNZRO RALF <
+ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN
+ PNDL /DITTO FOR BLANK COMMON
+ ZBLOCK 376 /FILL TO 400 LOCS
+/
+/ BEGIN OF PASS 2:
+/ DUMP EXTERNAL SYMBOL DICTIONARY
+/ DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
+/
+DMPESD, CLA CLL CMA RAL /-2
+ DCA EXTMP2 /PASS CONTROL
+ TAD (3 /RALF OUTPUT IDENTIFIER
+ DCA I OUTPTR
+ TAD VERS
+ DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES
+ TAD DPFLG /4000=NEED DP HARDWARE
+ DCA I OUTPTR /EXACTLY FILL A BLOCK
+ DCA I OUTPTR
+ESDSCN, TAD (ESDBUF-1
+ DCA X10 /POINT TO POINTERS
+ TAD (ESDBUF+177
+ DCA X12 /POINT TO INITAIL CHARS
+ TAD ESDNO
+ CIA
+ DCA EXTMP
+ESDLUP, TAD (-3
+ DCA LTEMP /NAME LENGTH COUNT
+ TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME
+ DCA X13
+ TAD I X10 /GET POINTER
+ DCA X11
+ TAD I X12 /GET FIRST CHAR
+ SNA /BLANK BECOMES #
+ TAD (43
+ESDNLP, JMS I [R6L
+ DCA EQUN+2
+ CDF FLD1
+ TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE
+ DCA EQUN+3 /HOLD IT
+ CDF FLD0
+ TAD EQUN+3
+ JMS I [R6R /GET LEFT CHAR
+ TAD EQUN+2 /COMBINE THEM
+ DCA I X13
+ TAD EQUN+3 /GET RIGHT HALF OF PAIR
+ AND [77
+ ISZ LTEMP
+ JMP ESDNLP
+ AND [37 /DROP FORCE BIT FROM TYPE
+ DCA EQUN+3
+ CDF FLD1
+ TAD I X11 /HIGH VALUE
+ DCA EQUN+4
+ TAD I X11 /LOW VALUE
+ DCA EQUN+5
+ CDF FLD0
+ TAD EXTMP2 /WHAT PASS IS THIS?
+ RAR /LINK 0 IF FIRST, 1 IF SECOND
+ SNL CLA
+ JMP NOENTS /FIRST, ENTRYS NOT OUTPUT
+ TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND
+ CLL RAR
+ SNA CLA
+ SNL
+ JMP ESDLND /NO GO
+ JMP ESDOUT /YES, PUT IT
+NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN
+ CLL RAR
+ SNA /SKIP IF OK
+ JMP ESDLND /UNDEFINED OR ENTRY
+ RAR
+ SNA CLA
+ JMP ESDOUT /IF EXTERN, DO IT
+ TAD EQUN+4 /IF SECTION, CHECK
+ AND [7 /THAT LENGTH
+ SNA /IS NON-ZERO
+ TAD EQUN+5
+ SNA CLA
+ JMP ESDLND /ZERO LEN JUST GETS IN THE WAY
+ESDOUT, TAD (EQUN-1
+ DCA X13
+ TAD (-6
+ DCA LTEMP
+ TAD I X13 /GET OUTPUT WORD
+ DCA I OUTPTR
+ ISZ LTEMP
+ JMP .-3 /6-WORD ENTRIES
+ TAD OUTPTR
+ TAD OUTBUF
+ SPA CLA
+ JMP ESDLND /NOT END OF BLOCK YET
+ JMS I (OUTBLK
+ TAD (3
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ESDLND, ISZ EXTMP /GO THRU ESD LIST
+ JMP ESDLUP
+ ISZ EXTMP2 /WHOLE LIST TWO PASSES
+ JMP ESDSCN
+ TAD (-6 /THEN STORE END-OF-ESD
+ DCA LTEMP
+ DCA I OUTPTR
+ ISZ LTEMP
+ JMP .-2
+ TAD (377 /FORCE BLOCK OUTPUT
+ JMS I (FULCHK
+ CDF FLD1 /THEN DEFAULT ORG
+ TAD I (LMAIN /IF MAIN LEN .NE. 0
+ AND [7
+ SNA
+ TAD I (LMAIN+1
+ CDF FLD0
+ SNA CLA
+ JMP I (RESET /FIRST SECTION WILL GET IT
+ TAD (TTORG+1 /ORG TO ZERO OF MAIN
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ JMP I (RESET
+OUTBUF, 1001
+ PAGE />
+\f/
+/ INITIALIZATION CODE
+/
+BEGIN, JMP CHNIN /IF ENTERED BY CHAIN
+GCMND, CIF 10 /IF ENTERED BY .R, ETC
+ JMS I USR /USR IS LEFT OVER
+ 5 /DECODE
+ IFZERO RALF <
+ 620 /DEFAULT EXT = .FP>
+ IFNZRO RALF <
+ 2201 /DEFAULT EXT = .RA>
+ DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED
+CHNIN, JMS I (7607
+ 4100 /TEMP WRITE OUT OVERLAY
+ 6600 /NOW AT 6600
+ 40 /TO SYS SCRATCH BLK 40
+ JMP I (7605 /ERROR
+ CDF 10
+ IFNZRO RALF <
+ TAD I [7600 /BIN FILE UNIT
+ AND NP17
+ SNA /IS THERE ONE?
+ JMP DEFBIN /NO, SET DEFAULT
+ TAD (7757 /POINT TO DEV CTRL WORD
+ DCA WORD1
+ TAD I WORD1
+ SPA CLA
+ JMP OKBIN /FILE-STRUCTURED, OK
+ CDF 0
+ JMS I (PRTXT /TYPE MESSAGE
+ TXBBIN-1
+ -TXBLN
+ JMS I [CRLF
+ JMP GCMND /TRY AGAIN
+/
+DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS
+ DCA I [7600 /SET UNIT
+ TAD [7600
+ DCA X10 /SET POINTER
+ TAD (0617 /FO
+ DCA I X10
+ TAD (2224 /RT
+ DCA I X10
+ TAD (2216 /RN
+ DCA I X10 /FORTRN.
+ DCA I X10
+ CDF 0
+ JMP I (NOEXT /NOW, OPEN THE FILE>
+\fOKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE
+ JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE
+GBIN, CDF 10
+ TAD I (7644
+ AND (20
+ SNA CLA
+ ISZ SYONLY /=NO SLASH T
+ CDF 0
+ JMS I (NEW /**SEE IF NEED 2 PG HANDLER
+ 7600
+ JMS I (OOPEN
+ DCA BFILE
+ IFNZRO RALF <
+ TAD R41 /L OR G SWITCH**
+ CDF 10
+ AND I (7643 /TEST /L OR /G SWITCH
+ CDF 0
+ SNA CLA /**
+ JMP KCHN /KILL CHAIN, IT'S SET
+ CIF 10
+ CLA IAC /UNIT IS SYS
+ JMS I USR
+ 2 /LOOKUP
+LBLK, LDRNAM /LOADER.SV
+R41, 41 /**
+ JMP KCHN /NO FIND, NO CALL
+ TAD LBLK /STARTING BLOCK
+ DCA I (LDRBLK /FOR CHAIN
+ TAD I (OUBLK /OUTPUT STARTING BLOCK
+ DCA I (PASBLK /SAVED FOR CHAIN TO LOADER
+ CLA CMA /ENABLE CHAIN
+KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER>
+ JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
+ JMS I (INNEWF /GET INPUT HANDLER
+ CLA CMA
+ DCA I (INCHCT /SET INITIAL COUNT
+ TAD NP7700
+ DCA USR /FROM NOW ON, USE THE HIGH CALL
+\f JMS I (NEW
+ 7605 /CHECK LIST DEV TOO**
+ CDF 10
+ TAD I (7611 /LST FILE EXT
+ SNA
+ TAD (1423 /LS DEFAULT
+ DCA I (7611
+ TAD I (7666 /GET DATE
+ DCA WORD1
+/
+/ MOVE SYMBOL TABLE TO ITS PROPER LOCATION
+/
+ TAD (1777
+ DCA X10 /LOADED ADDRESS OF SYMBOL TABLE
+ CLA CMA
+ DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS
+ TAD (-FREE /LENGTH OF SYMBOL TABLE
+ DCA WORD2 /SET COUNT
+ TAD I X10
+ DCA I X11 /THIS SAVES SWAPS OF USR
+ ISZ WORD2
+ JMP .-3
+ CDF 0
+ JMP I (GDATE /CHECK FOR FPP PRESENCE**
+ PAGE
+\f/
+/ PUT THE DATE INTO THE PAGE HEADING
+/
+GDATE, TAD (1000
+ DCA I (7746 /SET NO-RESTART BIT
+ /PUT VERNUM IN TITLE LINE
+ TAD VMSG
+ DCA I (VMTXT
+ TAD VMSG+1 /PATCH LEVEL
+ DCA I (VMTXT+1
+ DCA OCNT /CLEAR OCNT
+ TAD WORD1 /RE-GET DATE
+ SNA
+ JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED
+ AND (370
+ CLL RTR
+ RAR
+ TAD (-12
+ SPA
+ JMP .+3
+ ISZ OCNT
+ JMP .-4
+ TAD (72 /60+12
+ DCA OTEMP
+ TAD (TITDAT-1
+ DCA X11
+ TAD OCNT
+ JMS I (R6L
+ SZA
+ TAD (6000
+ TAD OTEMP
+ DCA I X11
+ TAD WORD1
+ AND (7400 /MONTH
+ JMS I (R6L
+ TAD (MONTHS-3
+ DCA X10
+ TAD I X10
+ DCA I X11
+ TAD I X10
+ DCA I X11
+ DCA OCNT
+ TAD WORD1
+ AND [7
+ DCA OTEMP
+ TAD I (7777
+ AND (600
+ RTR CLL
+ RTR
+ TAD OTEMP
+ TAD (106
+\f TAD (-12
+ SPA
+ JMP .+3
+ ISZ OCNT
+ JMP .-4
+ TAD (72
+ DCA OTEMP
+ TAD (5560
+ TAD OCNT
+ DCA I 11
+ TAD OTEMP
+ JMS I (R6L
+ TAD (40
+ DCA I X11
+ JMP I (NEWLIN
+VMSG, VNUM&70^10+VNUM&707+6060
+ PATCH&77^100+40
+ IFNZRO RALF <
+LDRNAM, TEXT "LOAD@@SV"
+TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED"
+TXBLN= .-TXBBIN >
+MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
+\f PAGE
+/PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
+NEW, 0
+ TAD NT2 /CHECK IF ALREADY CHECKED
+ SZA CLA
+ JMP NEWDON
+ TAD I NEW /NO. GET THE DEV TO CHECK
+ DCA NTEMP
+ CDF 10
+ TAD I NTEMP /GET DEV.NUM
+ AND [17
+ DCA NT1 /INCHK NEEDS TO KNOW TOO
+ TAD NT1
+ SNA /IF 0,THEN NO DEVICE
+ JMP NEWDON
+ DCA NTEMP
+ CLA CMA
+ TAD I (37 /GET PTR TO DEV TBL
+ TAD NTEMP
+ DCA NTEMP /PTS TO ENTRY IN DEV TBL
+ TAD I NTEMP
+ CDF 0
+ SMA CLA
+ JMP FIX /NOT A 2 PG HANDLER
+ TAD (6377 /FIX ALL LOCATIONS THAT REFER TO
+/THE BUFFER VARIABLES.
+/THE CHANGES ARE:
+/OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
+/INRECS=1,INCTL=200
+ DCA I (BLINE
+ TAD (6000
+ DCA I (NOUBUF
+ IFNZRO RALF <
+ TAD (5777
+ DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS
+ TAD (6601
+ DCA I (NINDEV
+ TAD (201
+ DCA I (NINCTL
+ JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER
+ DCA I (NINREC
+ TAD (6000
+ DCA I (LOUBUF
+ TAD (7201
+ DCA I (NOUDEV
+ TAD (5777
+ DCA I (OUTPTR
+ TAD (6377
+ DCA I (CHRPTR
+ IFNZRO RALF <
+ TAD (1401
+ DCA I (KOUBUF >
+ TAD (7201
+FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN
+NEWDON, ISZ NEW /GET CORRECT ADDR
+ JMP I NEW
+NTEMP, 0
+NT1, 0 /DEV. NUM.
+NT2, 0 /0 IF NO 2PG HANDLERS YET
+INCHK, 0 /CHECK THE INPUT DEVICES
+ JMS NEW
+INLOC, 7617
+ TAD INLOC
+ DCA NEXTIN
+ANOTH, TAD NT1
+ SNA CLA /SKIP IF FILE USED
+ JMP I INCHK
+ TAD NT2
+ SZA CLA /SKIP IF STILL 1 PAGE HANDLERS
+ JMP I INCHK
+ TAD NP2
+ TAD NEXTIN
+ DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR
+ JMS NEW
+NEXTIN, 0
+ JMP ANOTH
+NP2, 2
+NOKBIN, CDF 10 /BELONGS WITH INIT CODE
+ TAD I [7600
+ AND NP17
+ TAD (7646
+ DCA WORD1 /CREATE POINTER INTO DEV TBL
+ TAD I WORD1
+ CDF 0
+ TAD (-7607
+ SNA CLA /IF ITS SYS, NO PROBLEMS
+ DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE
+ CDF 10
+ TAD I (7604
+ SZA
+ JMP FEND /AN EXT WAS SPECIFIED
+ IFZERO RALF <
+ TAD (0216 /.BN DEFAULT FOR FLAP
+ JMP FEND >
+ IFNZRO RALF <
+NOEXT, CDF 10
+ TAD I (7643 /CHECK IF L OR G SPEC
+ AND L41
+ SNA CLA
+ TAD (0610 /NO-NEEDS RL EXT
+ TAD (1404 > /YES-NEEDS LD
+FEND, DCA I (7604
+ CDF 0
+ JMP I (GBIN
+L41, 41
+TPNSH, 0
+ TAD (1401 /CHANGE OUTPUT BUFFER
+ DCA I (OUTBUF
+ IAC
+ JMP I TPNSH
+/
+ PAGE
+\fLDADR, RELOC OVBUFR
+ TAD ERRORS /ERROR COUNT
+ JMS I (DECOUT
+ JMS I (PRTXT /"ERRORS"
+ TXERR-1
+ -TXELN
+ JMS I [CRLF
+ IFZERO RALF <
+ TAD PASSNO /IF NOT LISTING PASS
+ SPA SNA CLA /ERROR COUNT IS ENUF
+ JMP I (RETSYS >
+ TAD NEXT
+ TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS
+ CLL RAR /DIVIDE
+ JMS I (OVER3 /BY 6
+ JMS I (DECOUT
+ JMS I (PRTXT /"SYMBOLS, "
+ TXSYM-1
+ -TXSLN
+ IFZERO RALF <
+ TAD LINKS
+ JMS I (DECOUT
+ JMS I (PRTXT /"LINKS"
+ TXLNK-1
+ -TXLLN >
+ IFNZRO RALF <
+ TAD ABREFS
+ JMS I (DECOUT
+ JMS I (PRTXT /"ABS REFS"
+ TXABR-1
+ -TXALN >
+ JMS I [CRLF
+ TAD (-33 /27 BUCKETS
+ DCA LTEMP
+ DCA BUCKET
+ CLA CMA
+ DCA OPCODE /SYMBOLS PER LINE COUNTER
+\fSTPRNT, TAD BUCKET
+ DCA EXTMP /BUCKET START ADDRESS
+LUPBKT, CDF FLD1
+ TAD I EXTMP /WAS THAT LAST SYMBOL ?
+ SNA
+ JMP NXTBKT /YES, GO GET NEXT BUCKET
+ DCA EXTMP /SAVE LINK ADDR
+ TAD EXTMP
+ DCA X14 /SET UP POINTER FOR NAME
+ ISZ OPCODE /IS LINE FULL?
+ JMP .+4 /NO
+ TAD (-4
+ DCA OPCODE
+ JMS I [CRLF
+ TAD BUCKET
+ SNA /WATCH FOR #
+ TAD (43
+ JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR
+ CDF FLD1
+ TAD I X14 /SYMBOL
+ JMS I [PRINT2 /PRINT 2 AND 3
+ CDF FLD1
+ TAD I X14
+ JMS I [PRINT2 /PRINT 4 AND 5
+ CDF FLD1
+ TAD I X14
+ IFNZRO RALF <
+ DCA OTEMP /HOLD
+ TAD OTEMP >
+ AND [7700 /PRINT 6 AND BLANK
+ JMS I [PRINT2
+ IFNZRO RALF <
+ TAD OTEMP /GET TYPE
+ AND [17
+ TAD (TYPCOD /POINT TO TABLE
+ DCA OTEMP
+ TAD I OTEMP /GET TYPE INDICATOR
+ JMS I [PRINT2 >
+ CDF FLD1
+ TAD I X14 /PRINT FIRST DIGIT
+ AND [7
+ JMS I (PDIG /FIELD DIGIT
+ CDF FLD1
+ TAD I X14 /LOW 12 BITS
+ JMS I [OCTOUT
+ JMS I [PRINT2 /TWO BLANKS
+ JMP LUPBKT
+\fNXTBKT, ISZ BUCKET /NEXT BUCKET CHAR
+ CDF FLD0
+ ISZ LTEMP /INCREMENT COUNT
+ JMP STPRNT
+ JMS I [CRLF /DO FINAL CRLF**
+ TAD (214 /DO NOT PAGEJ
+ JMS I PC /THAT WOULD GIVE A HEADING
+ JMS I (OCLOSE
+ JMP I (RETSYS /FINISH IT OFF
+ PAGE
+ RELOC
+\f/ PAGE 0 LITERALS
+ FIELD 1
+ *10000
+\f/
+/ SYMBOL TABLE IS IN FIELD ONE.
+/ EACH ENTRY HAS THE FOLLOWING FORMAT
+/
+/ 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
+/ 1: 2ND AND 3RD CHARS OF SYMBOL
+/ 2: 4TH AND 5TH
+/ 3: 6TH AND TYPE CODE
+/ 4: ESD # AND HIGH-ORDER VALUE
+/ 5: LOW-ORDER VALUE
+/
+ USER=1
+ XTERN=2
+ COMMN=3
+ SECTN=4
+ PSUDO=5
+ PDPMR=6
+ FPPMRF=7
+ FPPSF1=10 /JXN, TRAP
+ FPPSF2=11 /JA, SETB, SETX
+ FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM,
+ /PAUS, JAC, STARTD, STARTF
+ FPPSF4=13 /ALN, ATX, XTA
+ FPPSF5=14 /ADDX, LDX
+ FPPMRI=15 /%
+ FPPMRS=16 /'
+ FPPMRL=17 /#
+ PDPOP=20
+/
+/ THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
+/ THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
+/ THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
+/ IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
+/ DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
+/
+ *12000
+ NOPUNCH
+ *10000
+ ENPUNCH
+\f/
+/ BUCKETS FOR USER-DEFINED SYMBOLS
+/ AND PDP8 OPERATES AND IOTS
+/
+ PNDL
+ ZBLOCK 33
+\f/
+/ BUCKETS FOR INTERNALLY DEFINED SYMBOLS
+/
+ AL
+ BL
+ CL
+ DL
+ EL
+ FL
+ GL
+ HL
+ IL
+ JL
+ KL
+ LL
+ ML
+ NL
+ OL
+ PL
+ QL
+ RL
+ SL
+ TL
+ UL
+ VL
+ WL
+ XL
+ YL
+ ZL
+\fAL, .+5 /ADDR
+ 0404;2200
+ FPPSF2
+ 0
+ .+5 /ADDX
+ 0404;3000
+ FPPSF5
+ 0110
+ .+5 /ALN
+ 1416;0
+ FPPSF4
+ 0010
+ IFZERO RALF <
+ .+5 /AND
+ 1604;0
+ PDPMR
+ AND 0 >
+ IFNZRO RALF <
+ .+5 /AND .
+ 1604;0
+ PDPMR
+ 200
+ .+5 /AND%
+ 1604;0
+ PDPMR+500
+ 600
+ .+5 /ANDZ
+ 1604;3200
+ PDPMR
+ 0
+ .+5 /ANDZ%
+ 1604;3200
+ PDPMR+500
+ 400 >
+ 0 /ATX
+ 2430;0
+ FPPSF4
+ 0020
+BL, 0 /BASE
+ 0123;0500
+ PSUDO
+ BASEX
+CL, .+5 /CDF
+ 0406;0
+ PDPOP
+ CDF
+ .+5 /CIA
+ 1101;0
+ PDPOP
+ CIA
+ .+5 /CIF
+ 1106;0
+ PDPOP
+ CIF
+ .+5 /CLA
+ 1401;0
+ PDPOP
+ CLA
+ .+5 /CLL
+ 1414;0
+ PDPOP
+ CLL
+ .+5 /CMA
+ 1501;0
+ PDPOP
+ CMA
+ IFZERO RALF < 0 >
+ IFNZRO RALF < .+5 >
+ 1514;0 /CML
+ PDPOP
+ CML
+ IFNZRO RALF <
+ .+5 /COMMON
+ 1715;1517
+ PSUDO+1600
+ COMMX
+ 0 /COMMZ (8-MODE COMM SECT)
+ 1715;1532
+ PSUDO
+ SECT8X-1 >
+\fDL, IFZERO RALF <
+ .+5 /DCA
+ 0301;0
+ PDPMR
+ DCA 0 >
+ IFNZRO RALF <
+ .+5 /DCA .
+ 0301;0
+ PDPMR
+ 3200
+ .+5 /DCA%
+ 0301;0
+ PDPMR+500
+ 3600
+ .+5 /DCAZ
+ 0301;3200
+ PDPMR
+ DCA 0
+ .+5 /DCAZ%
+ 0301;3200
+ PDPMR+500
+ DCA I 0 >
+ IFZERO RALF < 0 > /DECIMAL
+ IFNZRO RALF < .+5 >
+ 0503;1115
+ PSUDO+0100
+ DECX
+ IFNZRO RALF < 0 /DPCHK
+ 2003;1013
+ PSUDO
+ DPCHKX >
+EL, .+5 /E
+ 0;0
+ PSUDO
+ EX
+ .+5 /END
+ 1604;0
+ PSUDO
+ ENDX
+ IFZERO RALF <
+ 0 /ENPUNCH
+ 1620;2516
+ PSUDO+0300
+ ENPNCX >
+ IFNZRO RALF <
+ .+5 /ENTRY
+ 1624;2231
+ PSUDO
+ ENTRX
+ 0 /EXTERN
+ 3024;0522
+ PSUDO+1600
+ EXTRNX >
+\fFL, .+5 /F
+ 0;0
+ PSUDO
+ FX
+ .+5 /FADD
+ 0104;0400
+ FPPMRF
+ 1000
+ .+5 /FADD#
+ 0104;0400
+ FPPMRL+300
+ 1000
+ .+5 /FADD%
+ 0104;0400
+ FPPMRI+500
+ 1000
+ .+5 /FADD'
+ 0104;0400
+ FPPMRS+700
+ 1000
+ .+5 /FADDM
+ 0104;0415
+ FPPMRF
+ 5000
+ .+5 /FADDM#
+ 0104;0415
+ FPPMRL+300
+ 5000
+ .+5 /FADDM%
+ 0104;0415
+ FPPMRI+500
+ 5000
+ .+5 /FADDM'
+ 0104;0415
+ FPPMRS+700
+ 5000
+ .+5 /FCLA
+ 0314;0100
+ FPPSF3
+ 0002
+\f .+5 /FDIV
+ 0411;2600
+ FPPMRF
+ 3000
+ .+5 /FDIV#
+ 0411;2600
+ FPPMRL+300
+ 3000
+ .+5 /FDIV%
+ 0411;2600
+ FPPMRI+500
+ 3000
+ .+5 /FDIV'
+ 0411;2600
+ FPPMRI+700
+ 3000
+ .+5 /FEXIT
+ 0530;1124
+ FPPSF3
+ 0
+ IFNZRO RALF <
+ .+5 /FIELD1 (8-MODE FIELD1 SECT)
+ 1105;1404
+ PSUDO+6100
+ SECT8X-2 >
+ .+5 /FLDA
+ 1404;0100
+ FPPMRF
+ 0000
+ .+5 /FLDA#
+ 1404;0100
+ FPPMRL+300
+ 0000
+ .+5 /FLDA%
+ 1404;0100
+ FPPMRI+500
+ 0000
+ .+5 /FLDA'
+ 1404;0100
+ FPPMRS+700
+ 0000
+\f .+5 /FMUL
+ 1525;1400
+ FPPMRF
+ 4000
+ .+5 /FMUL#
+ 1525;1400
+ FPPMRL+300
+ 4000
+ .+5 /FMUL%
+ 1525;1400
+ FPPMRI+500
+ 4000
+ .+5 /FMUL'
+ 1525;1400
+ FPPMRS+700
+ 4000
+ .+5 /FMULM
+ 1525;1415
+ FPPMRF
+ 7000
+ .+5 /FMULM#
+ 1525;1415
+ FPPMRL+300
+ 7000
+ .+5 /FMULM%
+ 1525;1415
+ FPPMRI+500
+ 7000
+ .+5 /FMULM'
+ 1525;1415
+ FPPMRS+700
+ 7000
+ .+5 /FNEG
+ 1605;0700
+ FPPSF3
+ 0003
+ .+5 /FNOP
+ 1617;2000
+ FPPSF3
+ 0040
+\f .+5 /FNORM
+ 1617;2215
+ FPPSF3
+ 0004
+ .+5 /FPAUSE
+ 2001;2523
+ FPPSF3+0500
+ 0001
+ .+5 /FPCOM
+ 2003;1715
+ PDPOP
+ 6553
+ .+5 /FPHLT
+ 2010;1424
+ PDPOP
+ 6554
+ .+5 /FPICL
+ 2011;0314
+ PDPOP
+ 6552
+ .+5 /FPINT
+ 2011;1624
+ PDPOP
+ 6551
+ .+5 /FPIST
+ 2011;2324
+ PDPOP
+ 6557
+ .+5 /FPRST
+ 2022;2324
+ PDPOP
+ 6556
+ .+5 /FPST
+ 2023;2400
+ PDPOP
+ 6555
+ .+5 /FSTA
+ 2324;0100
+ FPPMRF
+ 6000
+ .+5 /FSTA#
+ 2324;0100
+ FPPMRL+300
+ 6000
+ .+5 /FSTA%
+ 2324;0100
+ FPPMRI+500
+ 6000
+ .+5 /FSTA'
+ 2324;0100
+ FPPMRS+700
+ 6000
+ .+5 /FSUB
+ 2325;0200
+ FPPMRF
+ 2000
+ .+5 /FSUB#
+ 2325;0200
+ FPPMRL+300
+ 2000
+ .+5 /FSUB%
+ 2325;0200
+ FPPMRI+500
+ 2000
+ 0 /FSUB'
+ 2325;0200
+ FPPMRS+700
+ 2000
+\fGL= 0 /AINT NONE
+HL, 0 /HLT
+ 1424;0
+ PDPOP
+ HLT
+IL, .+5 /IAC
+ 0103;0
+ PDPOP
+ IAC
+ .+5 /IFFLAP
+ 0606;1401
+ PSUDO+2000
+ IFZERO RALF <TRUE>
+ IFNZRO RALF <FALSE>
+ .+5 /IFNDEF
+ 0616;0405
+ PSUDO+0600
+ IFNDFX
+ .+5 /IFNEG
+ 0616;0507
+ PSUDO
+ IFNEGX
+ .+5 /IFNSW
+ 0616;2327
+ PSUDO
+ IFNSWX
+ .+5 /IFNZRO
+ 0616;3222
+ PSUDO+1700
+ IFNZRX
+\f .+5 /IFPOS
+ 0620;1723
+ PSUDO
+ IFPOSX
+ .+5 /IFRALF
+ 0622;0114
+ PSUDO+0600
+ IFNZRO RALF <TRUE>
+ IFZERO RALF <FALSE>
+ .+5 /IFREF
+ 0622;0506
+ PSUDO
+ IFREFX
+ .+5 /IFSW
+ 0623;2700
+ PSUDO
+ IFSWX
+ .+5 /IFZERO
+ 0632;0522
+ PSUDO+1700
+ IFZROX
+ .+5
+ 1604;0530
+ PSUDO
+ INDXX
+ .+5 /IOF
+ 1706;0
+ PDPOP
+ IOF
+ .+5 /ION
+ 1716;0
+ PDPOP
+ ION
+ IFZERO RALF <
+ 0 /ISZ
+ 2332;0
+ PDPMR
+ ISZ 0 >
+ IFNZRO RALF <
+ .+5 /ISZ .
+ 2332;0
+ PDPMR
+ ISZ .&7600
+ .+5 /ISZ%
+ 2332;0
+ PDPMR+500
+ ISZ I .&7600
+ .+5 /ISZZ
+ 2332;3200
+ PDPMR
+ ISZ 0
+ 0 /ISZZ%
+ 2332;3200
+ PDPMR+500
+ ISZ I 0 >
+\fJL, .+5 /JA
+ 0100;0
+ FPPSF2
+ 1030
+ .+5 /JAC
+ 0103;0
+ FPPSF3
+ 0007
+ .+5 /JAL
+ 0114;0
+ FPPSF2
+ 1070
+ .+5 /JEQ
+ 0521;0
+ FPPSF2
+ 1000
+ .+5 /JGE
+ 0705;0
+ FPPSF2
+ 1010
+ .+5 /JGT
+ 0724;0
+ FPPSF2
+ 1060
+ .+5 /JLE
+ 1405;0
+ FPPSF2
+ 1020
+ .+5 /JLT
+ 1424;0
+ FPPSF2
+ 1050
+ IFZERO RALF <
+ .+5 /JMP
+ 1520;0
+ PDPMR
+ JMP 0
+ .+5 /JMS
+ 1523;0
+ PDPMR
+ JMS 0 >
+ IFNZRO RALF <
+ .+5 /JMP .
+ 1520;0
+ PDPMR
+ JMP .&7600
+ .+5 /JMP%
+ 1520;0
+ PDPMR+500
+ JMP I .&7600
+ .+5 /JMPZ
+ 1520;3200
+ PDPMR
+ JMP 0
+ .+5 /JMPZ%
+ 1520;3200
+ PDPMR+500
+ JMP I 0
+ .+5 /JMS .
+ 1523;0
+ PDPMR
+ JMS .&7600
+ .+5 /JMS%
+ 1523;0
+ PDPMR+500
+ JMS I .&7600
+ .+5 /JMSZ
+ 1523;3200
+ PDPMR
+ JMS 0
+ .+5 /JMSZ%
+ 1523;3200
+ PDPMR+500
+ JMS I 0 >
+\f .+5 /JNE
+ 1605;0
+ FPPSF2
+ 1040
+ .+5 /JSA
+ 2301;0
+ FPPSF2
+ 1120
+ .+5 /JSR
+ 2322;0
+ FPPSF2
+ 1130
+ 0 /JXN
+ 3016;0
+ FPPSF1
+ 2000
+KL, .+5 /KCC
+ 0303;0
+ PDPOP
+ KCC
+ .+5 /KRB
+ 2202;0
+ PDPOP
+ KRB
+ .+5 /KRS
+ 2223;0
+ PDPOP
+ KRS
+ 0 /KSF
+ 2306;0
+ PDPOP
+ KSF
+LL, .+5 /LAS
+ 0123;0
+ PDPOP
+ LAS
+ .+5 /LDX
+ 0430;0
+ FPPSF5
+ 0100
+ .+5 /LISTOFF
+ 1123;2417
+ PSUDO+0600
+ LSTOFX
+ 0 /LISTON
+ 1123;2417
+ PSUDO+1600
+ LSTONX
+\fML= 0 /NO LIST
+NL, IFZERO RALF < .+5 >
+ IFNZRO RALF < 0 >
+ 1720;0 /NOP
+ PDPOP
+ NOP
+ IFZERO RALF <
+ 0 /NOPUNCH
+ 1720;2516
+ PSUDO+0300
+ NOPNCX >
+OL, .+5 /OCTAL
+ 0324;0114
+ PSUDO
+ OCTALX
+ .+5 /ORG
+ 2207;0
+ PSUDO
+ ORGX
+ 0 /OSR
+ 2322;0
+ PDPOP
+ OSR
+ IFZERO RALF <
+PL, 0 /PAGE
+ 0107;0500
+ PSUDO
+ PAGEX >
+ IFNZRO RALF <PL=0 >
+QL= 0 /WHAT DID YOU EXPECT?
+RL, .+5 /RAL
+ 0114;0
+ PDPOP
+ RAL
+ .+5 /RAR
+ 0122;0
+ PDPOP
+ RAR
+ .+5 /RDF
+ 0406;0
+ PDPOP
+ RDF
+ .+5 /REPEAT
+ 0520;0501
+ PSUDO+2400
+ REPETX
+ .+5 /RIB
+ 1102;0
+ PDPOP
+ RIB
+ .+5 /RIF
+ 1106;0
+ PDPOP
+ RIF
+ .+5 /RMF
+ 1506;0
+ PDPOP
+ RMF
+ .+5 /RTL
+ 2414;0
+ PDPOP
+ RTL
+ 0 /RTR
+ 2422;0
+ PDPOP
+ RTR
+\fSL, .+5 /S
+ 0;0
+ PSUDO
+ SX
+ IFNZRO RALF <
+ .+5 /SECT
+ 0503;2400
+ PSUDO
+ SECTX
+ .+5 /8 MODE SECT
+ 0503;2470
+ PSUDO
+ SECT8X >
+ .+5 /SETB
+ 0524;0200
+ FPPSF2
+ 1110
+ .+5 /SETX
+ 0524;3000
+ FPPSF2
+ 1100
+ .+5 /SKP
+ 1320;0
+ PDPOP
+ SKP
+ .+5 /SMA
+ 1501;0
+ PDPOP
+ SMA
+ .+5 /SNA
+ 1601;0
+ PDPOP
+ SNA
+ .+5 /SNL
+ 1614;0
+ PDPOP
+ SNL
+ .+5 /SPA
+ 2001;0
+ PDPOP
+ SPA
+ .+5 /STARTD
+ 2401;2224
+ FPPSF3+0400
+ 0006
+ .+5 /STARTE
+ 2401;2224
+ FPPSF3+0500
+ 0050
+ .+5 /STARTF
+ 2401;2224
+ FPPSF3+0600
+ 0005
+ .+5 /STL
+ 2414;0
+ PDPOP
+ STL
+ .+5 /SZA
+ 3201;0
+ PDPOP
+ SZA
+ 0 /SZL
+ 3214;0
+ PDPOP
+ SZL
+\fTL, IFZERO RALF <
+ .+5 /TAD
+ 0104;0
+ PDPMR
+ TAD 0 >
+ IFNZRO RALF <
+ .+5 /TAD .
+ 0104;0
+ PDPMR
+ TAD .&7600
+ .+5 /TAD%
+ 0104;0
+ PDPMR+500
+ TAD I .&7600
+ .+5 /TADZ
+ 0104;3200
+ PDPMR
+ TAD 0
+ .+5 /TADZ%
+ 0104;3200
+ PDPMR+500
+ TAD I 0 >
+ .+5 /TCF
+ 0306;0
+ PDPOP
+ TCF
+ .+5 /TEXT
+ 0530;2400
+ PSUDO
+ TEXTX
+ .+5 /TLS
+ 1423;0
+ PDPOP
+ TLS
+ .+5 /TPC
+ 2003;0
+ PDPOP
+ TPC
+ .+5 /TRAP3
+ 2201;2063
+ FPPSF1
+ 3000
+ .+5 /TRAP4
+ 2201;2064
+ FPPSF1
+ 4000
+ .+5 /TRAP5
+ 2201;2065
+ FPPSF1
+ 5000
+ .+5 /TRAP6
+ 2201;2066
+ FPPSF1
+ 6000
+ .+5 /TRAP7
+ 2201;2067
+ FPPSF1
+ 7000
+ 0 /TSF
+ 2306;0
+ PDPOP
+ TSF
+\fUL= 0
+VL= 0
+WL= 0
+XL, 0 /XTA
+ 2401;0
+ FPPSF4
+ 0030
+YL= 0
+ZL, 0 /ZBLOCK
+ 0214;1703
+ PSUDO+1300
+ ZBLKX
+\f IFZERO RALF < PNDL=0 >
+ IFNZRO RALF <
+PNDL, .+6 /BLANK COMMON
+ 0;0
+ 3 /CODE FOR COMMON
+ 40;0 /ESD #2, LEN=0
+ 0 /#MAIN
+ 1501;1116
+ 4 /CODE FOR SECTION
+LMAIN, 20;0 /ESD #1, LEN=0>
+FREE,
+END, END /NICE WHEN FLAP ASSEMBLES
+ $
+\f
--- /dev/null
+RALF.PA(303:8) : error: illegal blank at Loc = 00366
+RALF.PA(424:8) : error: illegal blank at Loc = 00544
+RALF.PA(437:8) : error: illegal blank at Loc = 00563
+RALF.PA(992:8) : error: illegal blank at Loc = 01520
+RALF.PA(1033:8) : error: illegal blank at Loc = 01563
+RALF.PA(1535:8) : error: illegal blank at Loc = 02364
+RALF.PA(1536:8) : error: illegal blank at Loc = 02364
+RALF.PA(1537:8) : error: illegal blank at Loc = 02364
+RALF.PA(1538:8) : error: illegal blank at Loc = 02364
+RALF.PA(1614:19) : error: no literal value at Loc = 02462
+RALF.PA(1842:8) : error: illegal blank at Loc = 03000
+RALF.PA(1843:8) : error: illegal blank at Loc = 03000
+RALF.PA(1844:8) : error: illegal blank at Loc = 03000
+RALF.PA(2353:8) : error: illegal blank at Loc = 03562
+RALF.PA(2379:8) : error: illegal blank at Loc = 03630
+RALF.PA(2614:8) : error: illegal blank at Loc = 04167
+RALF.PA(2615:8) : error: illegal blank at Loc = 04167
+RALF.PA(3417:8) : error: illegal blank at Loc = 06325
+RALF.PA(3568:2) : error: duplicate label "STPRNT" at Loc = 06631
+RALF.PA(3570:1) : error: duplicate label "LUPBKT" at Loc = 06633
+RALF.PA(3615:2) : error: duplicate label "NXTBKT" at Loc = 06706
+RALF.PA(4025:8) : error: illegal blank at Loc = 10655
+RALF.PA(4232:8) : error: illegal blank at Loc = 11230
+RALF.PA(4261:8) : error: illegal blank at Loc = 11254
+RALF.PA(4425:8) : error: illegal blank at Loc = 11557
+RALF.PA(4426:8) : error: illegal blank at Loc = 11557
+RALF.PA(4427:8) : error: illegal blank at Loc = 11557
+RALF.PA(4432:8) : error: illegal blank at Loc = 11564
+
+ 28 detected errors
--- /dev/null
+START WITH "SUBMIT BUILD"!
--- /dev/null
+$JOB FORTRAN IV BUILD - MAIN PART
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ STUPID ASSEMBLER PROCEDURES
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ THE RALF ASSEMBLER REFUSES TO ACCEPPT THE .RA FILES AS THEY
+/ COME FROM KERMIT. I CANNOT INVESTIGATE WHICH PARITY IS GENERATED
+/ BY KERMIT-12. BUT I KNOW THAT PIP MAKES EVERYTHING RIGHT AGAIN.
+/ SO ALL .RA FILES ARE MOVED TROUGH PIP ONCE.
+/
+.R PIP
+*ABS.RA<ABS.RA/A
+*ACOS.RA<ACOS.RA/A
+*ADC.RA<ADC.RA/A
+*ALOG10.RA<ALOG10.RA/A
+*ALOG.RA<ALOG.RA/A
+*AMAX.RA<AMAX.RA/A
+*AMIN.RA<AMIN.RA/A
+*AMOD.RA<AMOD.RA/A
+*ASIN.RA<ASIN.RA/A
+*ATAN2.RA<ATAN2.RA/A
+*ATAN.RA<ATAN.RA/A
+*CABS.RA<CABS.RA/A
+*CARITH.RA<CARITH.RA/A
+*CEXP.RA<CEXP.RA/A
+*CHARS.RA<CHARS.RA/A
+*CHKEOF.RA<CHKEOF.RA/A
+*CLK8A.RA<CLK8A.RA/A
+*CLOCK.RA<CLOCK.RA/A
+*CLOG.RA<CLOG.RA/A
+*CMPLX.RA<CMPLX.RA/A
+*COSD.RA<COSD.RA/A
+*COSH.RA<COSH.RA/A
+*COS.RA<COS.RA/A
+*CSIN.RA<CSIN.RA/A
+*CSQRT.RA<CSQRT.RA/A
+*DABS.RA<DABS.RA/A
+*DATAN2.RA<DATAN2.RA/A
+*DATAN.RA<DATAN.RA/A
+*DATE.RA<DATE.RA/A
+*DBLE.RA<DBLE.RA/A
+*DCOS.RA<DCOS.RA/A
+*DEXP3.RA<DEXP3.RA/A
+*DEXP.RA<DEXP.RA/A
+*DIM.RA<DIM.RA/A
+*DLOG10.RA<DLOG10.RA/A
+*DLOG.RA<DLOG.RA/A
+*DMAX1.RA<DMAX1.RA/A
+*DMIN1.RA<DMIN1.RA/A
+*DMOD.RA<DMOD.RA/A
+*DSIGN.RA<DSIGN.RA/A
+*DSIN.RA<DSIN.RA/A
+*DSQRT.RA<DSQRT.RA/A
+*EXP3.RA<EXP3.RA/A
+*EXPCC.RA<EXPCC.RA/A
+*EXPCI.RA<EXPCI.RA/A
+*EXPDD.RA<EXPDD.RA/A
+*EXPDI.RA<EXPDI.RA/A
+*EXPDR.RA<EXPDR.RA/A
+*EXPIC.RA<EXPIC.RA/A
+*EXPID2.RA<EXPID2.RA/A
+*EXPID.RA<EXPID.RA/A
+*EXPII.RA<EXPII.RA/A
+*EXPIR.RA<EXPIR.RA/A
+*EXP.RA<EXP.RA/A
+*FLOAT.RA<FLOAT.RA/A
+*IDINT.RA<IDINT.RA/A
+*IFIX.RA<IFIX.RA/A
+*LTR.RA<LTR.RA/A
+*ONQIB.RA<ONQIB.RA/A
+*PAUSE.RA<PAUSE.RA/A
+*PLOT.RA<PLOT.RA/A
+*REAL.RA<REAL.RA/A
+*REALTM.RA<REALTM.RA/A
+*RFCV.RA<RFCV.RA/A
+*RFDV.RA<RFDV.RA/A
+*RSW.RA<RSW.RA/A
+*SIGN.RA<SIGN.RA/A
+*SIND.RA<SIND.RA/A
+*SINH.RA<SINH.RA/A
+*SNGL.RA<SNGL.RA/A
+*SQRT.RA<SQRT.RA/A
+*TAND.RA<TAND.RA/A
+*TANH.RA<TANH.RA/A
+*TAN.RA<TAN.RA/A
+*XFIX.RA<XFIX.RA/A$
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT IABS
+ ENTRY ABS
+ BASE 0
+ABS, FLDA 0 /GET RETURN ADDRESS
+ STARTD
+ FSTA RETRN
+ FADD TWO /GET ADDRESS OF ARG POINTER
+ FSTA 3
+ FLDA% 3 /GET ARG ADDRESS
+ FSTA 3
+ STARTF
+ FLDA% 3 /GET ARG
+ JGE RETRN /POSITIVE, SKIP NEGATE
+ FNEG
+RETRN, 0;0
+TWO, 0;2
+ END
+\f
--- /dev/null
+/
+/
+/ A C O S
+/ - - - -
+/
+/SUBROUTINE ACOS(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT ACOS
+ JA #ACOS
+ TEXT +ACOS +
+ACOSXR, SETX XRACOS
+ SETB BPACOS
+BPACOS, FNOP
+ 0
+ 0
+XRACOS, F 0.0
+ACOS8, F 0.0
+ACOS7, F 0.0
+FPI2AC, 1 /PI OVER 2
+ 3110
+ 3755
+F1ACOS, F 1.
+FPIACS, 2 /PI
+ 3110
+ 3755
+ ORG 10*3+BPACOS
+ FNOP
+ JA ACOSXR
+ 0
+ACSRTN, JA .
+ BASE 0
+#ACOS, STARTD
+ FLDA 10*3
+ FSTA ACSRTN
+ FLDA 0
+ SETX XRACOS
+ SETB BPACOS
+ BASE BPACOS
+ LDX 1,1
+ FSTA BPACOS
+ FLDA% BPACOS,1 /ADDR OF X
+ FSTA BPACOS
+ STARTF
+ FLDA% BPACOS /GET X
+ FSTA ACOS8 /SAVE IT
+ JEQ ACOSEQ /IF 0 RTN PI OVER 2
+ LDX -1,0 /JUMP TIME
+ JGE .+5
+ LDX 0,0
+ FNEG
+ FSUB F1ACOS /1-!X!
+ JLE ACOSOK /IS IT <1.?
+ EXTERN #ARGER
+ TRAP4 #ARGER
+ JA ACSRTN /AND RETURN
+ACOSOK, FLDA ACOS8 /X
+ FMUL ACOS8 /X^2
+ FNEG /-X^2
+ FADD F1ACOS /1-X^2
+ FSTA ACOS7
+ EXTERN SQRT
+ JSR SQRT /CALL SQRT
+ JA .+4 /SQRT (1-X^2)
+ JA ACOS7
+ FDIV ACOS8 /SQRT (1-X^2)/X
+ FSTA ACOS7
+ EXTERN ATAN
+ JSR ATAN /CALL ATAN
+ JA .+4 /ATAN (SQRT(1-X^2)/X)
+ JA ACOS7
+ JXN ACSRTN,0 /NO SIGN CHG NECESSARY
+ FADD FPIACS /ADD PI IF MINUE
+ JA ACSRTN
+ACOSEQ, FLDA FPI2AC /RTN PI OVER 2 IF 0
+ JA ACSRTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ ADSK=6534
+ ADRB=6533
+ ADST=6532
+ ADLM=6531
+ ADCL=6530
+ SAM=100
+ LINC=6141
+ ESF=4
+ PDP=2
+ SECT8 ADC /AD SAMPLER (UNBUFFERED, UNCOLCKED)
+ BASE 0
+ STARTD
+ FLDA 0 /GET RETURN ADDRESS
+ FSTA ADCRET
+ FADD L2 /GET ADDR OF ARG POINTER
+ FSTA 0
+ FLDA% 0 /GET ADDR OF CHANNEL NUMBER
+ FSTA 0
+ STARTF
+ FLDA% 0 /GET THE CHANNEL NUMBER
+ ALN 0 /FIX IT
+ FSTA CHANEL /STORE IT FOR ADC8
+ TRAP4 ADC8 /GO TO PDP8 CODE TO DO THE SAMPLING
+ FLDA SAMPLE
+ FNORM /GET THE SAMPLE AND NORMALIZE IT
+ FDIV L511 /SCALE BETWEEN -1 AND +1
+ADCRET, JA .
+L2, 0;2
+L511, F 511.
+SAMPLE, 13;0;0
+CHANEL, 0;0;0
+ADC8, 0 /PDP8 MODE END OF ADC
+ IFSW 8 <
+ ADCL /CLEAR AD LOGIC
+ TAD CHANEL+2 /SET MULTIPLEXOR CHANNEL
+ ADLM
+ ADST /START CONVERSION
+ ADSK /WAIT FOR IT
+ JMP .-1
+ ADRB /READ CONVERTOR BUFFER>
+ IFNSW 8 <
+ TAD CHANEL+2 /CREATE FIRST SAM
+ TAD SAM0
+ DCA DOSAM
+ IOF
+ LINC /ENTER LINC MODE WITHOUT INTERRUPTS
+ ESF /DISABLE FAST SAM
+DOSAM, 0
+ PDP
+ ION /BACK IN 8 MODE, TURN ON INTERRUPTS>
+ DCA SAMPLE+1 /SAVE SAMPLE
+ CIF CDF
+ JMP% ADC8
+ IFNSW 8 <
+SAM0, SAM 0>
+\f
--- /dev/null
+/
+/
+/ A L O G
+/ - - - -
+/
+/SUBROUTINE ALOG(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+ SECT ALOG
+ JA #ALOG
+ 0 /WORKING SPACE FOR EXPONENT DIDDLE.
+ 0
+ 0
+ALOGTM, 0
+ 0
+ 0
+ 0
+F2ALOG, F 2.
+FPI2, 1
+ 3110
+ 3755
+/
+ EXTERN #ARGER
+ALOG0, TRAP4 #ARGER
+ JA ALGRTN /RETURN NOW.
+/
+ EXTERN #ARGER
+ALOGM1, TRAP4 #ARGER
+ JA ALGRTN
+ TEXT +ALOG +
+ALOGXR,
+BPALOG, F 0.0
+XRALOG, F 0.0
+ALOG1, F 0.0
+ALOG2, F 0.0
+F1ALOG, F 1.
+/
+ALOGMG, 0
+ 0
+ 13 /CORRECT EXPONENT DIDDLER.
+/
+/
+/
+/
+ALOGL1, 0
+ 3777
+ 7742
+/
+ALOGE2, 0
+ 2613
+ 4414
+/
+ ORG 10*3+BPALOG
+ FNOP
+ JA ALOGXR
+ 0
+ALGRTN, JA .
+ALOGL2, 7777
+ 4000
+ 4100
+/
+ALOGL3, 7777
+ 2517
+ 0310
+/
+ALOGL4, 7776
+ 4113
+ 7211
+/
+ALOGL5, 7776
+ 2535
+ 3301
+/
+ALOGL6, 7775
+ 4746
+ 0771
+/
+ALOGL7, 7774
+ 2236
+ 4304
+/
+ALOGL8, 7771
+ 4544
+ 1735
+ BASE 0
+#ALOG, STARTD
+ FLDA 10*3
+ FSTA ALGRTN
+ FLDA 0
+ SETX XRALOG
+ SETB BPALOG
+ BASE BPALOG
+ LDX 1,1
+ FSTA BPALOG
+ FLDA% BPALOG,1 /ADDR OF X
+ FSTA BPALOG
+ STARTF
+ FLDA% BPALOG /GET X
+ JEQ ALOG0 /IF =0 THEN ERROR
+ JLT ALOGM1 /IF<0 THEN ERROR
+ LDX -1,0 /IF >0 THEN START DOING
+ FSTA ALOG1 /SAVE IN A TEMP.
+ FSUB F1ALOG /KNOCK OFF ONE.
+ JEQ ALGRTN /IF ZERO EXIT. LOG(1)=0
+ JGE ALOGST /IF POSITIVE LOG>0
+ FLDA F1ALOG /NEGITE. INVERT IT.
+ FDIV ALOG1 /BY DIVIDING INTO ONE.
+ FSTA ALOG1
+ LDX 0,0 /RESET SIGN TO NEGATIVE.
+ JA .+3 /AVOID USELESS LOAD INSTRUCTION.
+/
+ALOGST, FLDA ALOG1 /RECALL NUMBER.
+ FDIV F2ALOG /CUT IN HALF.
+ FSTA ALOGTM /PREPARE FOR EXPONENT DIDDLE.
+ FLDA ALOGMG /SET THE EXPONENT OF THE EXPONENT TO 13.
+ FSTA ALOGTM-3 /SO THAT NORMALIZE WILL DO JOB.
+ FSTA ALOGTM+1 /AND ALSO ZERO OUT LOW ORDER POART OF EX. MANT.
+ FLDA ALOGTM-1 /RECALL THE NUMBER
+ FNORM /NORMALIZE IT.
+ FMUL ALOGE2 /NOW MULITPLY EXPONENT BY LOG E 2
+ FSTA ALOG2 /AND SAVE IT FOR A SECOND.
+ FLDA ALOG1 /RECALL THE NUMBER AGAIN.
+ FSTA ALOGTM /STORE IN THE TEMPORARY WORKER.
+ FLDA FPI2-2 /RECALL WORD WITH LOW ORDER ONE.
+ FSTA ALOGTM-2 /STORE AWAY.
+ FLDA ALOGTM /RECALL NUMBER WITH AN EXPONENT OF 1
+ FSUB F1ALOG /SUBTRACT AWAY.
+ FSTA ALOG1 /AND STORE
+ FMUL ALOGL8 /MULTIPLY BY THE CONSTANT.
+ FADD ALOGL7 /ADD IN
+ FMUL ALOG1 /MULT.
+ FADD ALOGL6 /AND SO ON DOWN THE LINE.
+ FMUL ALOG1
+ FADD ALOGL5
+ FMUL ALOG1
+ FADD ALOGL4
+ FMUL ALOG1
+ FADD ALOGL3
+ FMUL ALOG1
+ FADD ALOGL2
+ FMUL ALOG1
+ FADD ALOGL1
+ FMUL ALOG1
+ FADD ALOG2 /CORRECT NOW.ADD IN EXPONENT.
+ JXN ALGRTN,0 /EXIT IF SIGN IS OK.
+ FNEG /ELSE NEGATE IT.
+ JA ALGRTN
+\f
--- /dev/null
+/
+/
+/ A L O G 1 0
+/ - - - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/SUBROUTINE ALOG10(X)
+ SECT ALOG10
+ JA #ALOG
+ TEXT +ALOG10+
+LOGXR, SETX XRLOG
+ SETB BPLOG
+BPLOG, FNOP
+ 0
+ 0
+XRLOG, F 0.0
+LOG1, F 0.0
+ALOG1C, 7777 /FUDGE CONSTANT
+ 3362
+ 6754
+ ORG 10*3+BPLOG
+ FNOP
+ JA LOGXR
+ 0
+LOGRTN, JA .
+ BASE 0
+#ALOG, STARTD
+ FLDA 10*3
+ FSTA LOGRTN
+ FLDA 0
+ SETX XRLOG
+ SETB BPLOG
+ BASE BPLOG
+ LDX 1,1
+ FSTA BPLOG
+ FLDA% BPLOG,1 /ADDR OF X
+ FSTA BPLOG
+ STARTF
+ FLDA% BPLOG /GET X
+ FSTA LOG1
+ EXTERN ALOG
+ JSR ALOG /CALL ALOG
+ JA .+4
+ JA LOG1
+ FMUL ALOG1C /CORRECT FOR THE LOG BASE E.
+ JA LOGRTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4/27/77 MH
+/
+ SECT AMAX0
+ ENTRY AMAX1
+ ENTRY MAX0
+ ENTRY MAX1
+ BASE 0
+AMAX1, SETX XR
+ LDX 1,3 /DON'T INTEGERIZE RESULT
+MAXCOM, STARTD
+ FLDA 0 /ADDRESS OF JA .+2+2*N
+ FSTA 3
+ FLDA 30 /RETURN ADDRESS
+ FSTA RETN
+ FLDA% 3 / JA .+2+2*N
+ FSUB 0 /-JA .
+ FSUB TWO /- 2
+ LDX 1,1
+ ALN 1 /DIVIDE BY TWO
+ FNEG /-N
+ ATX 1
+ LDX 0,2 /FOR ARG PICKUP
+ FLDA% 0,2+ /ADDRESS OF FIRST ARG
+ FSTA 3
+ STARTF
+NEW, FLDA% 3 /SAVE NEW MAX
+ FSTA MAX
+SAME, JXN MORMAX,1+ /ANY MORE ARGS ?
+ FLDA MAX /GET RESULT
+ JXN RETN,3 /DON'T FIX
+ JLT NEGFIX /NEGATIVE FIX
+ ALN 0
+ FNORM
+ JA RETN
+NEGFIX, FNEG
+ ALN 0
+ FNORM
+ FNEG
+RETN, JA .
+MORMAX, STARTD /NEXT ARG ADDRESS
+ FLDA% 0,2+
+ FSTA 3
+ STARTF
+ FLDA MAX /COMPARE
+ FSUB% 3
+ JGE SAME /SAME MAX
+ JA NEW /NEW MAX
+TWO, 0;2
+MAX, 0;0;0
+MAX0,
+MAX1, SETX XR
+ LDX 0,3 /INTEGERIZE RESULT
+ JA MAXCOM /GO DO IT
+XR, 0;0;0;0;0;0;0;0
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4/27/77 MH
+/
+ SECT AMIN0
+ ENTRY AMIN1
+ ENTRY MIN0
+ ENTRY MIN1
+ BASE 0
+AMIN1, SETX XR
+ LDX 1,3 /DON'T INTEGERIZE RESULT
+MINCOM, STARTD
+ FLDA 0 /ADDRESS OF JA .+2+2*N
+ FSTA 3
+ FLDA 30 /RETURN ADDRESS
+ FSTA RETN
+ FLDA% 3 / JA .+2+2*N
+ FSUB 0 /-JA .
+ FSUB TWO /- 2
+ LDX 1,1
+ ALN 1 /DIVIDE BY TWO
+ FNEG /-N
+ ATX 1
+ LDX 0,2 /FOR ARG PICKUP
+ FLDA% 0,2+ /ADDRESS OF FIRST ARG
+ FSTA 3
+ STARTF
+NEW, FLDA% 3 /SAVE NEW MIN
+ FSTA MIN
+SAME, JXN MORMIN,1+ /ANY MORE ARGS ?
+ FLDA MIN /GET RESULT
+ JXN RETN,3 /DON'T FIX
+ JLT NEGFIX /NEGATIVE FIX
+ ALN 0
+ FNORM
+ JA RETN
+NEGFIX, FNEG
+ ALN 0
+ FNORM
+ FNEG
+RETN, JA .
+MORMIN, STARTD /NEXT ARG ADDRESS
+ FLDA% 0,2+
+ FSTA 3
+ STARTF
+ FLDA MIN /COMPARE
+ FSUB% 3
+ JLE SAME /SAME MIN
+ JA NEW /NEW MIN
+TWO, 0;2
+MIN, 0;0;0
+MIN0,
+MIN1, SETX XR
+ LDX 0,3 /INTEGERIZE RESULT
+ JA MINCOM /GO DO IT
+XR, 0;0;0;0;0;0;0;0
+ END
+\f
--- /dev/null
+/
+/
+/
+/ A M O D
+/ - - - -
+/
+/SUBROUTINE AMOD(X,Y)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT AMOD
+ ENTRY MOD
+ JA #AMOD
+ TEXT +AMOD +
+AMODXR, SETX XRAMOD
+ SETB BPAMOD
+BPAMOD, F 0.0
+XRAMOD, F 0.0
+AMODX, F 0.0
+ ORG 10*3+BPAMOD
+ FNOP
+ JA AMODXR
+ 0
+ AMDRTN, JA .
+ EXTERN #ARGER
+AMODER, TRAP4 #ARGER
+ FCLA
+ JA AMDRTN
+ BASE 0
+MOD,
+#AMOD, STARTD
+ FLDA 10*3
+ FSTA AMDRTN
+ FLDA 0
+ SETX XRAMOD
+ SETB BPAMOD
+ BASE BPAMOD
+ LDX 1,1
+ FSTA BPAMOD
+ FLDA% BPAMOD,1 /ADDR OF X
+ FSTA AMODX
+ FLDA% BPAMOD,1+ /ADDR OF Y
+ FSTA BPAMOD
+ STARTF
+ FLDA% BPAMOD /GET Y
+ JEQ AMODER /Y=0 IS ERROR
+ JGT .+3
+ FNEG /ABS VALUE
+ FSTA BPAMOD
+ FLDA% AMODX /GET X
+ JGT .+5
+ FNEG /ABS VALUE
+ LDX 0,1 /NOTE SIGN
+ FSTA AMODX /SAV IN A TEMPORARY
+ FDIV BPAMOD /DIVIDE BY Y
+ JAL AMODER /TOO BIG.
+ ALN 0 /FIX IT UP NOW.
+ FNORM
+ FMUL BPAMOD /MULITPLY IT.
+ FNEG /NEGATE IT.
+ FADD AMODX /AND ADD IN X.
+ JXN AM,1 /CHECK SIGN
+ FNEG
+AM, JA AMDRTN
+\f
--- /dev/null
+/
+/
+/ A S I N
+/ - - - -
+/
+/SUBROUTINE ASIN(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT ASIN
+ JA #ASIN
+ASINEQ, FLDA FPI2AS /RETURN PI OVER TWO.
+ FMUL ASIN8 /TIMES ARG.
+ JA ASNRTN
+ TEXT +ASIN +
+ASINXR, SETX XRASIN
+ SETB BPASIN
+BPASIN, FNOP
+ 0
+ 0
+XRASIN, F 0.0
+ASIN8, F 0.0
+ASIN7, F 0.0
+F1ASIN, F 1.
+FPI2AS, 1 /PI OVER 2
+ 3110
+ 3755
+ ORG 10*3+BPASIN
+ FNOP
+ JA ASINXR
+ 0
+ASNRTN, JA .
+ BASE 0
+#ASIN, STARTD
+ FLDA 10*3
+ FSTA ASNRTN
+ FLDA 0
+ SETX XRASIN
+ SETB BPASIN
+ BASE BPASIN
+ LDX 1,1
+ FSTA BPASIN
+ FLDA% BPASIN,1 /ADDR OF X
+ FSTA BPASIN
+ STARTF
+ FLDA% BPASIN /GET X
+ FSTA ASIN8 /STORE ARG AWAY.
+ JGE .+3 /TAKE ABSOLUTE VALUE.
+ FNEG
+ FSUB F1ASIN /SEE IF >1
+ JLE ASINOK /CONTINUE PROCESS.
+ EXTERN #ARGER
+ TRAP4 #ARGER /TRAP OUT.
+ JA ASNRTN /RETURN.
+ASINOK, FLDA ASIN8 /X USES STRAIGHT TRIG RELATION.
+ FNEG
+ FMUL ASIN8 /-X^2
+ FADD F1ASIN /1.-X^2
+ JEQ ASINEQ /IF 0,FAC=PI OVER 2
+ FSTA ASIN7
+ EXTERN SQRT
+ JSR SQRT
+ JA .+4
+ JA ASIN7
+ FSTA ASIN7 /SQRT(1.-X^2)
+ FLDA ASIN8
+ FDIV ASIN7 /X/SQRT(1.X^2)
+ FSTA ASIN7
+ EXTERN ATAN
+ JSR ATAN /TAKE THE ARCTANGENT.
+ JA ASNRTN
+ JA ASIN7
+\f
--- /dev/null
+/
+/
+/ A T A N
+/ - - - -
+/
+/SUBROUTINE ATAN(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT ATAN
+ JA #ATAN
+ TEXT +ATAN +
+ATANXR, SETX XRATAN
+ SETB BPATAN
+BPATAN, F 0.0
+XRATAN, F 0.0
+ATAN1, F 0.0
+ATAN22, F 0.0
+ATAN3, F 0.0
+ATAN4, F 0.0
+F1ATAN, F 1.
+ ORG 10*3+BPATAN
+ FNOP
+ JA ATANXR
+ 0
+ATNRTN, JA .
+/
+ATANC1, -15 /LOWER LIMIT TEST.
+ 2000
+ 0000
+/
+ATANC2, 0 /UPPER LIMIT TEST.
+ 3777
+ 7000
+/
+ATANC3, -1
+ 2111
+ 4121
+/
+ATANC4, 1
+ 3355
+ 4754
+/
+ATANC5, 0
+ 2060
+ 2511
+/
+ATANC6, -3
+ 3023
+ 1227
+/
+ATANC7, -2
+ 5566
+ 7220
+/
+ATANC8, -2
+ 3146
+ 0740
+/
+ATANC9, -1
+ 5252
+ 5262
+/
+ATANCH, 1
+ 3110
+ 3755
+/
+ATANCJ, F -4.
+ BASE 0
+#ATAN, STARTD
+ FLDA 10*3
+ FSTA ATNRTN
+ FLDA 0
+ SETX XRATAN
+ SETB BPATAN
+ BASE BPATAN
+ LDX 1,1
+ FSTA BPATAN
+ FLDA% BPATAN,1 /ADDR OF X
+ FSTA BPATAN
+ STARTF
+ FLDA% BPATAN /GET X
+ LDX -1,0 /REMEMBER SIGN
+ JGE .+5
+ LDX 0,0 /SAVE THE SIGN.
+ FNEG /NEGATE THE FAC [ABS]
+ FSTA ATAN1 /AND STORE AWAY.
+ FSTA ATAN22
+ FSUB ATANC1 /TEST TO SEE IF TOO SMALL.
+ JLE ATANBG /IT IS. ATAN(X)=X
+ FSUB ATANC2 /TEST TO SEE IF TOO BIG.
+ JLE ATANLW /IT ISNT.
+ FLDA F1ATAN /TO BIG. INVERT IT.
+ FDIV ATAN1
+ FSTA ATAN1
+/
+ATANLW, FCLA /CLEAR OUT TEMP.
+ FSTA ATAN3
+ FLDA ATAN1 /RECALL NUMBER.
+ FSUB ATANC3 /START THE KNOCKING OFF PROCESS.
+ JLT ATANNT /WRONG SECTOR.
+ FLDA ATANC4 /BOP UP ORIGINAL.
+ FADDM ATAN1
+ FLDA ATANCJ /GET MAGIC NUMBER.
+ FDIV ATAN1
+ FADD ATANC4
+ FSTA ATAN1
+ FLDA ATANC5
+ FSTA ATAN3
+/
+ATANNT, FLDA ATAN1 /RECALL AND SQUARE IT.
+ FMUL ATAN1
+ FSTA ATAN4 /YET ANOTHER TEMP.
+ FLDA ATANC6
+ FMUL ATAN4
+ FADD ATANC7
+ FMUL ATAN4
+ FADD ATANC8
+ FMUL ATAN4
+ FADD ATANC9
+ FMUL ATAN4
+ FADD F1ATAN
+ FMUL ATAN1
+ FADD ATAN3
+ FSTA ATAN1
+ FLDA ATAN22
+ FSUB F1ATAN
+ JLE ATANBG
+ FLDA ATANCH
+ FSUB ATAN1
+ JA .+3
+/
+ATANBG, FLDA ATAN1
+ JXN ATNRTN,0
+ FNEG
+ JA ATNRTN
+\f
--- /dev/null
+/
+/
+/
+/ A T A N 2
+/ - - - - -
+/
+/SUBROUTINE ATAN2(Y,X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT ATAN2
+ JA #ATAN2
+ TEXT +ATAN2 +
+ATN2XR, SETX XRATN2
+ SETB BPATN2
+BPATN2, FNOP
+ 0
+ 0
+XRATN2, F 0.0
+YCOR, F 0.0
+XCOR, F 0.0
+FPIAT2, 2 /PI
+ 3110
+ 3755
+ATPI, F 1.570796 /PI/2
+ ORG 10*3+BPATN2
+ FNOP
+ JA ATN2XR
+ 0
+AT2RTN, JA .
+ BASE 0
+#ATAN2, STARTD
+ FLDA 10*3
+ FSTA AT2RTN
+ FLDA 0
+ SETX XRATN2
+ SETB BPATN2
+ BASE BPATN2
+ LDX 1,1
+ FSTA BPATN2
+ FLDA% BPATN2,1 /ADDR OF Y
+ FSTA YCOR
+ FLDA% BPATN2,1+ /ADDR OF X
+ FSTA XCOR
+ STARTF
+ FLDA% YCOR /GET Y - THE TAN
+ FSTA YCOR /SAV FOR A SECOND
+ LDX 1,2 /POSITIVE X
+ JEQ ATN0
+ JGT ATN1
+ LDX 0,2
+ATN1, FLDA% XCOR /GET X - THE QUADRAND
+ FSTA XCOR /+MOVE IT TO A SAFE PLACE
+ JEQ ATASP
+ FLDA YCOR /Y/X
+ FDIV XCOR
+ FSTA YCOR
+ EXTERN ATAN
+ JSR ATAN /CALL ATAN
+ JA .+4 /TAKE ARCTAN OF Y/X
+ JA YCOR
+ FSTA YCOR /SAVE IT AWAY
+ JGE A2 /SKIP IF 1 OR 3 Q
+ FADD FPIAT2 /ADD PI FOR 4TH Q
+ FSTA YCOR
+A2, JXN AT2RTN,2
+ FLDA YCOR
+ FSUB FPIAT2 /SUB PI FOR 2ND+3RD QUADS
+ JA AT2RTN
+ATASP, FLDA ATPI /X=0 MEANS +-PI/2
+ JXN ATNG,2
+ FNEG
+ATNG, JA AT2RTN
+ATN0, FLDA% XCOR
+ JLT POSX /IF X POS,ANS IS 0
+ FCLA
+ JA AT2RTN
+POSX, FLDA FPIAT2 /OTHERWISE,ANS IS PI
+ JA AT2RTN
+\f
--- /dev/null
+/
+/ C A B S
+/ - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/ENTER IN COMPLEX, EXIT IN REAL
+/
+/Z=X+IY
+/
+/CABS(Z)=SQRT(X^2+Y^2)
+/
+ DPCHK
+ SECT CABS
+ JA #CABS
+ TEXT +CABS +
+CABSXR, SETX XRCABS
+ SETB BPCABS
+ JA .+3
+BPCABS, F 0.0
+XRCABS, F 0.0
+ARG, F 0.0
+ F 0.0
+ ORG 10*3+BPCABS
+ FNOP
+ JA CABSXR
+ 0
+CABSRT, JA .
+ BASE 0
+#CABS, STARTD
+ FLDA 10*3
+ FSTA CABSRT
+ FLDA 0
+ SETB BPCABS
+ SETX XRCABS
+ BASE BPCABS
+ LDX 1,1
+ FSTA BPCABS
+ FLDA% BPCABS,1
+ FSTA BPCABS
+ STARTE
+ FLDA% BPCABS
+ FSTA ARG
+ STARTF
+ FLDA ARG
+ FMULM ARG /X^2
+ FLDA ARG+3 /Y
+ FMUL ARG+3 /Y^2
+ FADD ARG /X^2+Y^2
+ FSTA ARG
+ EXTERN SQRT
+ JSR SQRT
+ JA RT1
+ JA ARG
+RT1, JA CABSRT
+ EXTERN #CAC
+\f
--- /dev/null
+/COMPLEX ARITHMETIC ROUTINES
+/ (A+BI)+-*/(C+DI)
+/
+/ VERSION 5A 4-26-77 MH
+/
+ DPCHK
+ SECT #CAD
+ JA .
+ FSTA #CARG /SAVE SECOND ARG
+ STARTF
+ FLDA #CARG /STARTF ROUNDS
+ FADDM #CAC /A+C
+ FLDA #CARG+3
+ FADDM #CAC+3 /B+D
+ STARTE
+ JA #CAD
+ ENTRY #CSB
+#CSB, JA .
+ FSTA #CARG
+ STARTF
+ FLDA #CARG /STARTF ROUNDS
+ FNEG
+ FADDM #CAC /A-C
+ FLDA #CAC+3
+ FSUB #CARG+3 /B-D
+ FSTA #CAC+3
+ STARTE
+ JA #CSB
+ ENTRY #CNG
+#CNG, JA .
+ STARTF
+ FLDA #CAC
+ FNEG
+ FSTA #CAC
+ FLDA #CAC+3
+ FNEG
+ FSTA #CAC+3
+ STARTE
+ JA #CNG
+ ENTRY #CEQ
+#CEQ, JA .
+ JSA #CSB
+ STARTF
+ FLDA #CAC
+ JNE NOTEQ
+ FLDA #CAC+3
+ JNE NOTEQ
+ FLDA ONE
+ JA #CEQ
+NOTEQ, FCLA
+ JA #CEQ
+ONE, F 1.0
+ ENTRY #CML
+#CML, JA .
+ FSTA #CARG
+ STARTF
+ FLDA #CARG /STARTF ROUNDS
+ FMUL #CAC /A*C
+ FSTA TEMP
+ FLDA #CARG+3
+ FMUL #CAC+3 /B*D
+ FSTA TEMP2
+ FLDA #CARG
+ FMULM #CAC+3 /B*C
+ FLDA #CAC
+ FMUL #CARG+3 /A*D
+ FADDM #CAC+3 /A*D+B*C
+ FLDA TEMP
+ FSUB TEMP2 /A*C-B*D
+ FSTA #CAC
+ STARTE
+ JA #CML
+ ENTRY #CDV
+#CDV, JA .
+ FSTA #CARG
+ STARTF
+ FLDA #CARG /STARTF ROUNDS
+ FMUL #CAC+3 /B*C
+ FSTA TEMP
+ FLDA #CARG+3
+ FMUL #CAC /A*D
+ FSTA TEMP2
+ FLDA #CARG
+ FMULM #CAC /A*C
+ FLDA #CAC+3
+ FMUL #CARG+3 /B*D
+ FADDM #CAC /A*C+B*D
+ FLDA #CARG
+ FMULM #CARG /C*C
+ FLDA #CARG+3
+ FMUL #CARG+3 /D*D
+ FADDM #CARG /C*C+D*D
+ FLDA TEMP
+ FSUB TEMP2 /B*C-A*D
+ FDIV #CARG /(B*C-A*D)/(C*C+D*D)
+ FSTA #CAC+3
+ FLDA #CAC
+ FDIV #CARG /(A*C+B*D)/(C*C+D*D)
+ FSTA #CAC
+ STARTE
+ JA #CDV
+TEMP, 0;0;0
+TEMP2, 0;0;0
+#CARG, 0;0;0
+ 0;0;0
+ ENTRY #CAC
+#CAC, 0;0;0
+ 0;0;0
+ END
+\f
--- /dev/null
+/
+/ C E X P
+/ - - - -
+/
+/ COMPLEX EXPONENT ROUTINE
+/Z=X+IY
+/
+/ VERSION 5A 4-25-77 MH
+/
+/
+/CEXP(Z)=EXP(X)*(COS(Y)+I*SIN(Y))
+/ENTER+EXIT IN COMPLEX
+/EXTERNAL EXP,SIN,COS
+/
+ SECT CEXP
+ JA #CEXP
+ DPCHK
+ TEXT +CEXP +
+CEXPXR, SETX XR
+ SETB BP
+ JA .+3
+BP, F 0.0
+XR, F 0.0
+ARG, F 0.0
+ F 0.0
+ ORG 10*3+BP
+ FNOP
+ JA CEXPXR
+ 0
+RT, JA .
+ BASE 0
+#CEXP, STARTD
+ FLDA 10*3
+ FSTA RT
+ FLDA 0
+ SETB BP
+ SETX XR
+ BASE BP
+ LDX 1,1
+ FSTA BP
+ FLDA% BP,1
+ FSTA BP
+ STARTE
+ FLDA% BP
+ FSTA ARG
+ STARTF
+ EXTERN EXP
+ JSR EXP /EXP(X)
+ JA CEX1
+ JA ARG
+CEX1, FSTA ETEMP
+ EXTERN COS
+ JSR COS /COS(Y)
+ JA CEX2
+ JA ARG+3
+CEX2, FSTA ARG
+ EXTERN SIN
+ JSR SIN /SIN(Y)
+ JA CEX3
+ JA ARG+3
+CEX3, FSTA ARG+3
+ FLDA ETEMP
+ FMULM ARG
+ FMULM ARG+3
+ STARTE
+ FLDA ARG
+ FSTA #CAC
+ JA RT
+ EXTERN #CAC
+ETEMP, F 0.0
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT CHARS
+ ENTRY CGET
+ ENTRY CPUT
+ TEXT +CHARS+
+CHARXR, SETX XRCHAR
+ SETB BPCHAR
+BPCHAR, F 0.
+XRCHAR, F 0.
+FROM, F 0.
+NCHAR, F 0.
+ ORG 10*3+BPCHAR
+ FNOP
+ JA CHARXR
+ 0
+CHARTN, JA .
+ BASE 0
+START, JA .
+ STARTD
+ FLDA 10*3
+ FSTA CHARTN
+ FLDA 0
+ SETX XRCHAR
+ SETB BPCHAR
+ BASE BPCHAR
+ LDX 1,1
+ FSTA BPCHAR /STR SAVED IN BPCHAR
+ FLDA% BPCHAR,1
+ FSTA STR
+ FLDA% BPCHAR,1+
+ FSTA NCHAR
+ FLDA% BPCHAR,1+
+ FSTA FROM /ADDR OF F
+ STARTF
+ FLDA% NCHAR
+ ATX 0
+ JA START
+/
+CGET, JSA START
+ TRAP4 CGETIT
+ XTA 0
+ FSTA% FROM /TO 3 WORDS
+ JA CHARTN
+/
+CPUT, JSA START
+ FLDA% FROM
+ ATX 1
+ FCLA
+ TRAP4 CPUTIT
+ JA CHARTN
+/
+ SECT8 CHAR /ALL IN 1 PAGE
+CGETIT, 0
+ JMS FLDRTN
+ TAD O2FLD
+ DCA ORGFLD
+ TAD XFLD
+ DCA XR2FLD
+ TAD PFLD
+ DCA GFLD
+GFLD, 0 /STR FIELD
+ TAD% STR-1
+ORGFLD, 0 /THIS ROUTINE
+ DCA LOC
+ TAD XR /N
+ RAR
+ SNL CLA
+ JMP RIGHT
+ CLL
+ TAD LOC
+ RTR
+ RTR
+ RTR
+BOTH, AND P77
+XR2FLD, 0
+ DCA% QXR+1 /PASS TO FPP
+ CDF CIF 0
+ JMP% CGETIT
+RIGHT, TAD LOC
+ JMP BOTH
+CADD, ADDR CGETIT
+ 0
+STR, 0
+ 0
+/
+CPUTIT, 0
+ JMS FLDRTN
+ TAD QXR1
+ AND P7
+ RTL
+ RAL
+ TAD CDFINS
+ DCA XR1FLD
+ TAD O2FLD
+ DCA O1FLD
+ TAD O2FLD
+ DCA O3FLD
+ TAD PFLD
+ DCA P1FLD
+XR1FLD, 0
+ TAD% QXR1+1 /F VALUE
+O1FLD, 0
+ AND P77
+ DCA LOC
+P1FLD, 0
+ TAD% STR-1
+O3FLD, 0
+ DCA XR1FLD /USE AS A TMP
+ TAD XR
+ RAR
+ SNL CLA
+ JMP PRIGHT
+ CLL
+ TAD XR1FLD
+ AND P77 /SAVE RIGHT HALF
+ DCA XR1FLD
+ TAD LOC
+ RTL
+ RTL
+ RTL
+ TAD XR1FLD
+PFLD, 0
+ DCA% STR-1
+ CIF CDF 0
+ JMP% CPUTIT
+PRIGHT, TAD XR1FLD
+ AND P7700
+ TAD LOC
+ JMP PFLD
+/
+FLDRTN, 0
+ TAD CADD
+ AND P7
+ RTL
+ RAL
+ TAD CDFINS
+ DCA O2FLD
+ TAD QXR
+ AND P7
+ RAL
+ RTL
+ TAD CDFINS
+ DCA XFLD
+XFLD, 0
+ TAD% QXR+1
+O2FLD, 0
+ DCA XR
+ TAD XR
+ RAR
+ SNL
+ TAD M1
+ CLL
+ TAD STR+1
+ DCA STR-1
+ SZL CLA
+ IAC
+ CLL
+ TAD STR
+ AND P7
+ RAL
+ RTL
+ TAD CDFINS
+ DCA PFLD /STR FLD
+ JMP% FLDRTN
+P77, 77
+CDFINS, 6203
+P7, 7
+QXR, ADDR XRCHAR
+LOC, 0
+XR, 0
+M1, -1
+QXR1, ADDR XRCHAR+1
+P7700, 7700
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT CHKEOF
+/CHECKS END OF FILE CONDITION.
+/ZEROS PASSED VARIABLE + PASSES ITS ADDRESS TO #EOFSW
+/FRTS DOES REST
+ EXTERN #EOFSW
+ BASE CHKBAS
+ JA CODE
+NAME, TEXT +CHKEOF+
+CHKBAS, F 0.
+CHKXR, F 0.
+ BASE 0
+CODE, STARTD
+ FLDA 30
+ FSTA CHKRTN /RETURN ADDR
+ FLDA 0 /GET PTR TO VARIABLE LIST
+ BASE CHKBAS
+ SETB CHKBAS
+ SETX CHKXR
+ FSTA CHKBAS
+ LDX 1,1
+ FLDA% CHKBAS,1 /HERES PTR TO VAR ADDR
+ FSTA CHKBAS
+ JA PART2
+ ORG 10*3+CHKBAS
+ FNOP
+ JA NAME+3
+PART2, FLDA CHKBAS
+ FSTA #EOFSW /PASS ADDR TO SYS
+ STARTF
+ FCLA
+ FSTA% CHKBAS /ZERO VAR
+CHKRTN, JA .
--- /dev/null
+/PDP-8A OPTION 1 (100 HZ) CLOCK ROUTINE................CLK8A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,OR ANY OTHER
+/COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH A SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMENT CORPORATION.
+/
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USEOR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+
+
+
+/
+/E.P. 11/6/75
+/ VERSION 5A 4/26/77 MH
+/
+/
+
+\f
+
+
+
+
+
+ EXTERN #DISP /SYSTEM PAGE 0,NEEDED TO
+ /PUT CLOCK STATUS ON PG0
+ /(CSTAT) FOR USE BY GEN
+ /USER CLOCK SERVICE ROUTS
+ EXTERN #T812 /RTS CPTYP
+ EXTERN ONQI /INTERRUPT QUEUER
+ CLLE= 6135 /AC11=1 INTRRUPTS ON.
+ CLCL= 6136 /CLEAR CLOCK FLAG
+ CLSK= 6137 /SKIP ON CLOCK FLAG.
+ CSTAT=157 /IDOCLK PUTS CLSA BITS
+ /IN HERE
+ BASE FTMP0
+ INDEX FCNWD
+ FIELD1 SYNC
+ JSA SETUP /HERE TO READ A STRIG
+ /INITIALIZE ARGS
+ TRAP4 DOSYNC /FCNWD (XR) HOLDS STRIG
+ /TO READ
+ XTA FCNWD /=ANS=0,1
+ FSTA% FTMP1 /GIVE ANS TO CALLER
+ JA GOBAK
+FTMP0, F 0.0 /BASE PAGE
+FTMP1, F 0.0
+RPTR, 27;ADDR RTBL /PTR TO RATE TBL, ALSO
+ /USED TO FLT OVRCNT (NOTE
+ /THAT THE EXPONENT=27)
+MINRAT, F .02 /MIN ALLOWABLE RATE
+TOVR, F 0.0
+NAME, TEXT +CLOCK +
+ ORG 10*3+FTMP0
+ FNOP
+ JA NAME+3
+ 0
+GOBAK, JA .
+RTBL, F 16.0 /CONSTANT USED TO CHK FOR
+ /EXT CLK BIT IN FCNWD
+ /THIS CONST MUST BE NE 0
+MAXRAT,
+F4096, F 4096.0 /USED TO GET OVRFLO COUNT
+ F 100000.0 /FASTEST RATE IN HERTZ
+ F 10000.0 /NEXT FASTEST RATE
+ F 1000.0
+ F 100.0 /SLOWEST RATE
+ F 1.0 /USED BY TIME FOR EXT CLK
+\f BASE 0
+
+SETUP, 0;0 /HERE TO INIT ALL FPP SUBS
+ STARTD
+ FLDA 30 /PICK UP RTN TO CALLER
+ FSTA GOBAK
+ FLDA 0 /GET PTR TO CALLERS ARGS
+ SETX FCNWD /CLOCK XR AND BASE
+ SETB FTMP0
+ BASE FTMP0
+ FSTA FTMP1
+ FLDA% FTMP1,P1
+ FSTA FTMP0 /PTR TO 1ST ARG
+ FLDA% FTMP1,P2
+ FSTA FTMP1 /PTR TO 2ND ARG
+ FLDA #T812 /TELLS PDP8,PDP12
+ ATX CPTYP /0=8=DK8ES,1=12=KW12A
+ STARTF
+ FLDA% FTMP0 /=1ST ARG
+ ATX FCNWD /ALWAYS IN FCNWD
+ JA SETUP
+\f ENTRY CLOCK
+CLOCK, JSA SETUP /HERE FOR CLOCK START
+ FLDA% FTMP0
+ FSUB RTBL /FCNWD IS IN FAC,IF GE 16
+ JGE ITSEXT /(RTBL=16.0) THEN USER IS
+ /REQUESTING AN EXTERNAL
+ /CLOCK I.E. B8 OF FCNWD
+ /IS SET.
+ FLDA% FTMP1 /=REQUESTED RATE IN HERTZ
+ FSUB MINRAT /.LE. MINUMUM RATE
+ JLE GOTR-2 /MEANS STOP CLOCK.
+ FADD MINRAT
+ FSUB MAXRAT /CHK FOR TOO FAST
+ JGT GOTR-2
+ LDX -4,OVRFLO /THERE ARE 4 BASIC RATES
+ LDX 1,RATE /=INDEX INTO RTBL; UPON
+ /TRAP(CLOCK) RATE=(0,
+ /2,3,4,5,6) 0=STOP,
+ /6=EXTERNAL
+ /2-5=PROGRAMMABLE RATES
+LOP0, FLDA% RPTR,RATE+
+ /GET NEXT SLOWEST RATE
+ FDIV% FTMP1 /=REQUESTED RATE IN HZ.
+ /FAC=OVRFLO COUNT;
+ FSUB F4096 /MUST BE MODULO 12 BITS.
+ JLE GOTR /FOUND IT
+ JXN LOP0,OVRFLO+
+ LDX 0,RATE /RATE IS TOO SLOW, STOP
+ /CLOCK.
+GOTR, FADD F4096 /RESTORE
+ FSTA TOVR
+ ATX OVRFLO /OVER FLOW COUNT
+ TRAP4 SETCLK /GO START CLOCK
+ JA GOBAK /RTN TO CALLER
+ITSEXT, LDX 6,RATE /=RATE FOR EXT CLK
+ FLDA% FTMP1 /REQUESTED RATE IS
+ /INTERPRETED AS OVRFLO
+ JA GOTR+1 /WHEN RATE IS EXTERNAL
+\f/MAGIC TABLE USED BY SETCLK TO SET CLOCK ENABLE
+/BITS. EVEN NUMBERED ENTRIES ARE FOR THE DK8ES;
+/ODD NUMBERED ONES ARE FOR THE KW12A.
+
+CLKTBL, 0675 /"STANDARD" DK BITS
+ 300 /STND KW BITS
+ 1 /DK STRIG1 BIT
+ 60 /KW STRIG1 BITS
+ 2 /DK S2
+ 14 /KW S2
+ 4 /S3
+P3, 3 /S3
+ 40 /DK ADC ON OVR BIT
+ 400 /KW ADC ON OVR BIT
+
+ /IF NOT NEXT PAGE DO ORG
+ IFNEG .-200 < ORG .-SYNC&7600+200+SYNC >
+\fSETCLK, 0 /TRAP HERE TO START CLK
+ /THIS ROUT HANDLES BOTH
+ /DK8ES AND KW12A.
+ CLCL /TRY AND CLEAR IT HERE????
+/ CLLR /STOP KW AND SET MODE 0;
+ /NOP FOR DK.
+/ CLEN /CLR KW12 ENABLE OR
+ /READ DK ENABLE.
+/ CLA
+/ TAD P7540 /TOGGLE KW MODE 0 TO 1 TO
+/ CLLR /CLR CLK COUNTER, OR SET
+ /DK ENABLE BITS, RATE FOR
+/ CLA CMA /BOTH NOW=7=STOP.
+/ CLZE /CLR ALL DK ENABLE BITS,
+/ CLSA /CLR STATUS OF BOTH, ALL
+ CLA /IS NOW CLEAR.
+ TAD FCNTBL+1 /SET PTR TO CLKTBL FOR
+ /SETTING OF ENABLE REGS.
+ TAD CPTYP /=0 IF PDP8 =1 IF PDP12
+ DCA FCNPTR /TBL ENTRIES ALTERNATE
+ /FOR 8 AND 12. CPTYP SETS
+ /PTR TO 1ST 8 OR 1ST 12
+ /ENTRY
+ TAD IDOCLK /(AC=JMP AROUND). THE
+ /FOLLOWING IS ONCE ONLY
+ /CODE. THESE LOCS ARE
+ /SUBSEQUENTLY USED AS
+ /OPERANDS
+ DCA .-1
+ /THE TAG "ISVBIT" MUST BE
+ /IN FRONT OF THE STRIG
+ /FLAGS (STFLG) TO COVER
+ /THE ILLEGAL CASE OF
+ /STRIG 0 IN A FORT CALL
+ /TO SYNC.
+ISVBIT, TAD CPTYP /(AC=0,1) MAKE THE INST
+ /RAR CLL (FOR DK) OR THE
+ /INST RTR CLL FOR IDOCLK;
+STFLG, RAL CLL /BECAUSE STATUS BITS FOR
+ TAD RARCLL /STRIGS DIFFER ON DK,KW.
+ DCA LOP2+1 /SEE SUB IDOCLK.
+ /THE ABOVE 3 LOCS ARE
+ /SCHMITT TRIGGER FLAGS.
+ /THE ORDER IS S1,S2,S3
+ /FOR PDP8 AND S3,S2,S1
+ /FOR PDP12. (CHK THE STATUS
+ /BITS FOR DK AND KW).
+ JMS% KONQI+1 /PUT CLOCK ON THE
+ITMP0, CLSK /INTERRUPT QUE
+ /VIA ONQI.
+CLENAB, ADDR IDOCLK /THIS LOC WILL HOLD THE
+ /ENABLE BITS FOR DK,KW
+AROUND, TAD RATE /(AC=0,2,3,4,5,6) RATE IS
+ /SET BY FPP
+ RTR CLL /START TO POSITION RATE
+ RAR /BITS. B3-B5 FOR DK
+ /B0-B2 FOR KW
+ TAD CPTYP /(THIS IS TRICKY) NEED
+ RAR /CPTYP IN LNK BECAUSE
+ /POSITION OF RATE BITS
+ /DIFFER FOR DK KW.
+ TAD% FCNPTR /AC="STANDARD"
+ /ENABLE BITS FOR DK,KW.
+ SZL /IF ITS A KW THE RATE AND
+ /AND STND BITS ARE ALREADY
+ /POSITIONED AS FOLLOWS:
+ /RRR011000000
+ /B0-B3 AND B5 WILL GO TO
+ /KW CONTROL. B4,B5 WILL
+ /GO TO ENABLE. B3 IS ADC
+ /ON OVRFLO AND MAY BE SET
+ /BELOW. B5 ON CONTROL IS
+ /MODE 1. B4 AND B5 ON
+ /ENABLE ARE BUFF PRESET TO
+ /CLOCK COUNTER AND INTRUPT
+ /ON OVRFLO RESPECTIVELY.
+ JMP NOBIT-1 /ITS KW GO PUT IN CLENAB.
+ RTR /ITS DK; POSITION RATE TO
+ RAR /B3-B5. NOTE THAT THE LNK
+ /(CPTYP=0) IS BEING USED.
+ CMA /NOTE ALSO THAT THE RATE
+ /AND STND BITS ARE THE 1S
+ /COMP. OF WHAT THEY SHOULD
+ /BE, IE CPTYP=LNK=0
+ /BECOMES
+ /B2=1 OF ENABLE=BUFF
+ /PRESET TO CLK CNTR ON
+ /OVERFLO. LOOK AT THE RATE
+ /BITS IN THE HANDBOOK FOR
+ /BOTH DK,KW. R2,R5
+ /FOR DK IS 100HZ, 100KHZ
+ /RESPECTIVELY. R2,R5 FOR
+ /KW IS 100KHZ,100HZ.
+ /1S COMP.OF 2=5 ETC.
+ /SMARTEN UP STEVE!
+ /THE FINAL VALUE OF THE
+ /STND DK ENABLE BITS (1ST
+ /ENTRY IN CLKTBL) IS LEFT
+ /AS AN EXERCISE FOR THE
+ /PROGRAMMER.
+ JMP NOBIT-1 /GO PUT IN CLENAB
+LOP1, RAR CLL /ROT 1 FCN BIT INTO LNK.
+ /B7=EXT CLK AND IS
+ /IGNORED HERE. B8=ADC ON
+ /OVRFLO, B9-B11 ARE STRIG3
+ /-STRIG1 RESP. BX=1=ENABLE
+ /FCN. 0=DISABLE
+ DCA FCNWD /PUT IT BACK (FCNWD IS
+ /SET BY FPP)
+ SNL /ENABLE FCN ?
+ JMP NOBIT /NO
+ TAD% FCNPTR /GET BITS FROM THE MAGIC
+ TAD CLENAB /TABLE.
+ DCA CLENAB /UPDATE ENABLE WORD.
+NOBIT, ISZ FCNPTR /ADV TO NEXT
+ ISZ FCNPTR /TBL ENTRY.
+ TAD FCNWD /WHEN FCNWD GOES TO 0
+ AND P17 /WE ARE ALL DONE.
+ /THE "AND" IS DONE TO
+ /PROTECT AGAINST A BAD
+ /ARG FROM THE FORT CALL.
+P7540, SMA SZA /SMA IS SUPERFLOUS TO
+ /THE ROUT; BUT IT
+ /CREATES A NICE CONST.
+ JMP LOP1 /MORE TO DO
+ DCA STFLG /CLR THE SCHMITT
+\f DCA STFLG+1 /TRIGGER FLAGS.
+\f DCA STFLG+2
+ TAD OVRFLO /SET BUFF PRESET
+ CIA /(FPP SET THIS ARG)
+/ CLAB
+ CLA
+ TAD CLENAB /THIS IS FOR KW ONLY.
+ AND P377 /AC=3XX. 3= OR BUFF PRE
+ /INTO CLK CNTR AND ENAB
+ /INT ON OVRFLO.
+ /XX ARE THE STRIGS.
+/ CLEN /SET KW ENABLE OR
+ CLA /READ DK ENABLE.
+ DCA OVRCNT+1 /CLR NUM OF CLK OVRFLOS
+ DCA OVRCNT /SINCE TIME 0.
+ TAD CPTYP /NEED TYPE IN ORDER TO
+RARCLL, RAR CLL /ISOLATE CONTROL
+ TAD CLENAB /BITS FOR
+ SZL /KW ?
+ AND P7540 /YES, B0-B2 IS RATE,
+ /B3 IS ADC, B5 IS BUFF
+ /PRE TO CLK CNTR ON
+ /OVRFLO, B6 IS MOX NIX.
+ /IF DK ALL BITS MAY HAVE
+ /MEANING
+ CLA IAC /SET BIT 11
+ CLLE /ENABLE THE CLOCK INTERRUPTS
+/ CLLR /START THE CLOCK
+ CLA
+ CIF CDF
+ JMP% SETCLK /RTN TO RTS
+\fDOSYNC, 0 /HERE TO DISPOSITION A
+ /A SCHMITT TRIGGER.
+ TAD CPTYP /DK AND KW FLAGS ARE IN
+ RAR CLL /REVERSE ORDER. IF DK
+ /ARG IS OK; IF KW THEN
+ /MUST SET 1=3, 2=2, 3=1
+ /TO GET INDEX TO
+ /CORRECT FLAG.
+ TAD FCNWD /=REQUESTED STRIG=1,2,3
+ /(SET BY FPP)
+ SZL /DK ?
+ CIA /NO KW
+ AND P3 /IE 1 GOES TO -1 GOES
+ /TO 3 ETC. "AND" ALSO
+ /INSURES RANGE IS 0-3.
+ /IF ARG IS 0 RESULT IS
+ /ALWAYS 0.
+ TAD KSTFLG+1 /GET PTR TO FLAG
+ DCA SETCLK
+ TAD% SETCLK /FLAG=0 IF TRIG HAS NOT
+ /TRIPPED SINCE THE LAST
+ /CALL TO SYNC; =1
+ /OTHERWISE IE RTN 0=FALSE
+ DCA FCNWD /,1=TRUE (FPP WILL PICK
+ / UP FCNWD)
+ DCA% SETCLK /CLR FLAG ANYWAY
+ CIF CDF
+ JMP% DOSYNC /RTN TO RTS
+\fIDOCLK, JMP AROUND /HERE ON CLOCK INTERRUPT
+ /(JMP AROUND IS A ONCE
+ /ONLY CONSTANT).
+ CLCL /JUST TO MAKE SURE!
+ TAD KSTFLG+1 /SET PTR TO STRIG FLAGS.
+ DCA ITMP0
+/ CLSA /GET CLOCK BITS.
+ CLA CLL CML RAR /SIMULATE TICK
+ DCAZ CSTAT /SAVE THEM FOR SOME
+ TADZ CSTAT /BODY ELSE.
+ SPA /OVER FLOW ?
+ ISZ OVRCNT+1 /YES BUMP LO ORD CNTR
+ SKP
+ ISZ OVRCNT /BUMP HI ORD
+ JMP DOTRIG /(HI ORD ISZ SKP IS
+ /HARMLESS)
+LOP2, ISZ ITMP0 /ADV STRIG FLAG PTR.
+ RAR CLL /(OR RTR CLL IF KW)
+ /IE PUT STRIG BIT IN LNK.
+ /IF DK THE ORDER OF
+ /INTERROGATION IS S1,S2,S3
+ /IF KW THE ORDER IS S3,
+ /S2,S1. THE STATUS BITS
+ /FOR DK ARE ADJACENT IE
+ / B9(S3),B10(S2),B11(S1)
+ /FOR KW ITS EVERY OTHER,
+ /B6(S1),B8(S2),B10(S3).
+ DCA ISVBIT /SAVE WHATS LEFT.
+ RAL /COPY LNK INTO FLAG IF=1
+ SZA /IE DONT CLR FLAG WHEN
+ DCA% ITMP0 /ITS SET.
+ TAD ISVBIT
+DOTRIG, AND P377 /THE "AND" INSURES THAT
+ /THE HI ORD BITS ARE
+ /CLRED SO THAT ISVBIT
+ /GOES TO 0 WHEN ALL
+ /STRIGS HAVE BEEN
+ /DISPOSITIONED. IE
+ /CLR OVRFLO BIT FOR DK,KW
+ /AND CLR PRE-EVENT BIT
+ /ON KW IF IT IS SET
+ SZA /DONE ?
+ JMP LOP2 /NO
+ TAD #CLINT /CALL USER EXTENDED
+ SZA CLA /CLOCK ROUT ?
+ JMS% #CLINT+1 /YES
+ JMP% IDOCLK /RTN TO IHANDL
+\fFCNPTR,
+OVRCNT,
+KONQI, ADDR ONQI
+P17, 17
+P377, 377
+FCNWD, 0 /FPP XRS
+CPTYP, 0
+RATE, 0
+P1, 1
+P2, 2
+OVRFLO,
+FCNTBL, ADDR CLKTBL
+KSTFLG, ADDR STFLG-1
+ ENTRY #CLINT
+#CLINT, 0;0
+ ENTRY TIME /FIGURE WHAT TIME IT IS
+TIME, JSA SETUP
+ FLDA RPTR /=27;X;X IS USED TO FLOAT
+ STARTD
+ FLDA# OVRCNT /NUM OF CLK OVRFLOS SINCE
+ STARTF /TIME 0
+ FNORM
+ FMUL TOVR /=NUM OF BASIC TICKS PER
+ /CLOCK OVER FLOW.
+ /FAC=NUM OF TICKS SINCE
+ /TIME 0.
+ FDIV% RPTR,RATE /DIV BY BASIC RATE IN HZ
+ /OR 1 IF EXTERNAL CLK.
+ FSTA% FTMP0 /GIVE ANS TO CALLER, ALSO
+ /LEAVE ANS IN FAC IN
+ /CASE TIME WAS A FCN
+ /CALL. ANS=ELAPSED TIME IN
+ /SECONDS SINCE TIME 0 OR
+ /NUM OF EXTERNAL UNIT
+ JA GOBAK /TICKS
+\f
--- /dev/null
+/
+/ VERSION 5A 4/26/77 MH
+/
+ EXTERN #DISP /SYSTEM PAGE 0,NEEDED TO
+ /PUT CLOCK STATUS ON PG0
+ /(CSTAT) FOR USE BY GEN
+ /USER CLOCK SERVICE ROUTS
+ EXTERN #T812 /RTS CPTYP
+ EXTERN ONQI /INTERRUPT QUEUER
+ CLZE=6130 /CLOCK IOTS
+ CLSK=6131
+ CLLR=6132 /ALSO CLOE
+ CLAB=6133
+ CLEN=6134
+ CLSA=6135
+ CSTAT=157 /IDOCLK PUTS CLSA BITS
+ /IN HERE
+\f BASE FTMP0
+ INDEX FCNWD
+ FIELD1 SYNC
+ JSA SETUP /HERE TO READ A STRIG
+ /INITIALIZE ARGS
+ TRAP4 DOSYNC /FCNWD (XR) HOLDS STRIG
+ /TO READ
+ XTA FCNWD /=ANS=0,1
+ FSTA% FTMP1 /GIVE ANS TO CALLER
+ JA GOBAK
+FTMP0, F 0.0 /BASE PAGE
+FTMP1, F 0.0
+RPTR, 27;ADDR RTBL /PTR TO RATE TBL, ALSO
+ /USED TO FLT OVRCNT (NOTE
+ /THAT THE EXPONENT=27)
+MINRAT, F .02 /MIN ALLOWABLE RATE
+TOVR, F 0.0
+NAME, TEXT +CLOCK +
+ ORG 10*3+FTMP0
+ FNOP
+ JA NAME+3
+ 0
+GOBAK, JA .
+RTBL, F 16.0 /CONSTANT USED TO CHK FOR
+ /EXT CLK BIT IN FCNWD
+ /THIS CONST MUST BE NE 0
+MAXRAT,
+F4096, F 4096.0 /USED TO GET OVRFLO COUNT
+ F 100000.0 /FASTEST RATE IN HERTZ
+ F 10000.0 /NEXT FASTEST RATE
+ F 1000.0
+ F 100.0 /SLOWEST RATE
+ F 1.0 /USED BY TIME FOR EXT CLK
+\f BASE 0
+
+SETUP, 0;0 /HERE TO INIT ALL FPP SUBS
+ STARTD
+ FLDA 30 /PICK UP RTN TO CALLER
+ FSTA GOBAK
+ FLDA 0 /GET PTR TO CALLERS ARGS
+ SETX FCNWD /CLOCK XR AND BASE
+ SETB FTMP0
+ BASE FTMP0
+ FSTA FTMP1
+ FLDA% FTMP1,P1
+ FSTA FTMP0 /PTR TO 1ST ARG
+ FLDA% FTMP1,P2
+ FSTA FTMP1 /PTR TO 2ND ARG
+ FLDA #T812 /TELLS PDP8,PDP12
+ ATX CPTYP /0=8=DK8ES,1=12=KW12A
+ STARTF
+ FLDA% FTMP0 /=1ST ARG
+ ATX FCNWD /ALWAYS IN FCNWD
+ JA SETUP
+\f ENTRY CLOCK
+CLOCK, JSA SETUP /HERE FOR CLOCK START
+ FLDA% FTMP0
+ FSUB RTBL /FCNWD IS IN FAC,IF GE 16
+ JGE ITSEXT /(RTBL=16.0) THEN USER IS
+ /REQUESTING AN EXTERNAL
+ /CLOCK I.E. B8 OF FCNWD
+ /IS SET.
+ FLDA% FTMP1 /=REQUESTED RATE IN HERTZ
+ FSUB MINRAT /.LE. MINUMUM RATE
+ JLE GOTR-2 /MEANS STOP CLOCK.
+ FADD MINRAT
+ FSUB MAXRAT /CHK FOR TOO FAST
+ JGT GOTR-2
+ LDX -4,OVRFLO /THERE ARE 4 BASIC RATES
+ LDX 1,RATE /=INDEX INTO RTBL; UPON
+ /TRAP(CLOCK) RATE=(0,
+ /2,3,4,5,6) 0=STOP,
+ /6=EXTERNAL
+ /2-5=PROGRAMMABLE RATES
+LOP0, FLDA% RPTR,RATE+
+ /GET NEXT SLOWEST RATE
+ FDIV% FTMP1 /=REQUESTED RATE IN HZ.
+ /FAC=OVRFLO COUNT;
+ FSUB F4096 /MUST BE MODULO 12 BITS.
+ JLE GOTR /FOUND IT
+ JXN LOP0,OVRFLO+
+ LDX 0,RATE /RATE IS TOO SLOW, STOP
+ /CLOCK.
+GOTR, FADD F4096 /RESTORE
+ FSTA TOVR
+ ATX OVRFLO /OVER FLOW COUNT
+ TRAP4 SETCLK /GO START CLOCK
+ JA GOBAK /RTN TO CALLER
+ITSEXT, LDX 6,RATE /=RATE FOR EXT CLK
+ FLDA% FTMP1 /REQUESTED RATE IS
+ /INTERPRETED AS OVRFLO
+ JA GOTR+1 /WHEN RATE IS EXTERNAL
+\f/MAGIC TABLE USED BY SETCLK TO SET CLOCK ENABLE
+/BITS. EVEN NUMBERED ENTRIES ARE FOR THE DK8ES;
+/ODD NUMBERED ONES ARE FOR THE KW12A.
+
+CLKTBL, 0675 /"STANDARD" DK BITS
+ 300 /STND KW BITS
+ 1 /DK STRIG1 BIT
+ 60 /KW STRIG1 BITS
+ 2 /DK S2
+ 14 /KW S2
+ 4 /S3
+P3, 3 /S3
+ 40 /DK ADC ON OVR BIT
+ 400 /KW ADC ON OVR BIT
+
+ /IF NOT NEXT PAGE DO ORG
+ IFNEG .-200 < ORG .-SYNC&7600+200+SYNC >
+\fSETCLK, 0 /TRAP HERE TO START CLK
+ /THIS ROUT HANDLES BOTH
+ /DK8ES AND KW12A.
+ CLLR /STOP KW AND SET MODE 0;
+ /NOP FOR DK.
+ CLEN /CLR KW12 ENABLE OR
+ /READ DK ENABLE.
+ CLA
+ TAD P7540 /TOGGLE KW MODE 0 TO 1 TO
+ CLLR /CLR CLK COUNTER, OR SET
+ /DK ENABLE BITS, RATE FOR
+ CLA CMA /BOTH NOW=7=STOP.
+ CLZE /CLR ALL DK ENABLE BITS,
+ CLSA /CLR STATUS OF BOTH, ALL
+ CLA /IS NOW CLEAR.
+ TAD FCNTBL+1 /SET PTR TO CLKTBL FOR
+ /SETTING OF ENABLE REGS.
+ TAD CPTYP /=0 IF PDP8 =1 IF PDP12
+ DCA FCNPTR /TBL ENTRIES ALTERNATE
+ /FOR 8 AND 12. CPTYP SETS
+ /PTR TO 1ST 8 OR 1ST 12
+ /ENTRY
+ TAD IDOCLK /(AC=JMP AROUND). THE
+ /FOLLOWING IS ONCE ONLY
+ /CODE. THESE LOCS ARE
+ /SUBSEQUENTLY USED AS
+ /OPERANDS
+ DCA .-1
+ /THE TAG "ISVBIT" MUST BE
+ /IN FRONT OF THE STRIG
+ /FLAGS (STFLG) TO COVER
+ /THE ILLEGAL CASE OF
+ /STRIG 0 IN A FORT CALL
+ /TO SYNC.
+ISVBIT, TAD CPTYP /(AC=0,1) MAKE THE INST
+ /RAR CLL (FOR DK) OR THE
+ /INST RTR CLL FOR IDOCLK;
+STFLG, RAL CLL /BECAUSE STATUS BITS FOR
+ TAD RARCLL /STRIGS DIFFER ON DK,KW.
+ DCA LOP2+1 /SEE SUB IDOCLK.
+ /THE ABOVE 3 LOCS ARE
+ /SCHMITT TRIGGER FLAGS.
+ /THE ORDER IS S1,S2,S3
+ /FOR PDP8 AND S3,S2,S1
+ /FOR PDP12. THE MAIN
+ /REASON FOR REVERSING
+ /THE ORDER IS BECAUSE
+ /ENGINEERS NEVER CONSULT
+ /PROGRAMMERS WHEN THEY
+ /ARE BUILDING NEW
+ /HARDWARE (CHK THE STATUS
+ /BITS FOR DK AND KW).
+ JMS% KONQI+1 /PUT CLOCK ON THE
+ITMP0, CLSK /INTERRUPT QUE
+ /VIA ONQI.
+CLENAB, ADDR IDOCLK /THIS LOC WILL HOLD THE
+ /ENABLE BITS FOR DK,KW
+AROUND, TAD RATE /(AC=0,2,3,4,5,6) RATE IS
+ /SET BY FPP
+ RTR CLL /START TO POSITION RATE
+ RAR /BITS. B3-B5 FOR DK
+ /B0-B2 FOR KW
+ TAD CPTYP /(THIS IS TRICKY) NEED
+ RAR /CPTYP IN LNK BECAUSE
+ /POSITION OF RATE BITS
+ /DIFFER FOR DK KW.
+ TAD% FCNPTR /AC="STANDARD"
+ /ENABLE BITS FOR DK,KW.
+ SZL /IF ITS A KW THE RATE AND
+ /AND STND BITS ARE ALREADY
+ /POSITIONED AS FOLLOWS:
+ /RRR011000000
+ /B0-B3 AND B5 WILL GO TO
+ /KW CONTROL. B4,B5 WILL
+ /GO TO ENABLE. B3 IS ADC
+ /ON OVRFLO AND MAY BE SET
+ /BELOW. B5 ON CONTROL IS
+ /MODE 1. B4 AND B5 ON
+ /ENABLE ARE BUFF PRESET TO
+ /CLOCK COUNTER AND INTRUPT
+ /ON OVRFLO RESPECTIVELY.
+ JMP NOBIT-1 /ITS KW GO PUT IN CLENAB.
+ RTR /ITS DK; POSITION RATE TO
+ RAR /B3-B5. NOTE THAT THE LNK
+ /(CPTYP=0) IS BEING USED.
+ CMA /NOTE ALSO THAT THE RATE
+ /AND STND BITS ARE THE 1S
+ /COMP. OF WHAT THEY SHOULD
+ /BE, IE CPTYP=LNK=0
+ /BECOMES
+ /B2=1 OF ENABLE=BUFF
+ /PRESET TO CLK CNTR ON
+ /OVERFLO. LOOK AT THE RATE
+ /BITS IN THE HANDBOOK FOR
+ /BOTH DK,KW. R2,R5
+ /FOR DK IS 100HZ, 100KHZ
+ /RESPECTIVELY. R2,R5 FOR
+ /KW IS 100KHZ,100HZ.
+ /1S COMP.OF 2=5 ETC.
+ /SMARTEN UP STEVE!
+ /THE FINAL VALUE OF THE
+ /STND DK ENABLE BITS (1ST
+ /ENTRY IN CLKTBL) IS LEFT
+ /AS AN EXERCISE FOR THE
+ /PROGRAMMER.
+ JMP NOBIT-1 /GO PUT IN CLENAB
+LOP1, RAR CLL /ROT 1 FCN BIT INTO LNK.
+ /B7=EXT CLK AND IS
+ /IGNORED HERE. B8=ADC ON
+ /OVRFLO, B9-B11 ARE STRIG3
+ /-STRIG1 RESP. BX=1=ENABLE
+ /FCN. 0=DISABLE
+ DCA FCNWD /PUT IT BACK (FCNWD IS
+ /SET BY FPP)
+ SNL /ENABLE FCN ?
+ JMP NOBIT /NO
+ TAD% FCNPTR /GET BITS FROM THE MAGIC
+ TAD CLENAB /TABLE.
+ DCA CLENAB /UPDATE ENABLE WORD.
+NOBIT, ISZ FCNPTR /ADV TO NEXT
+ ISZ FCNPTR /TBL ENTRY.
+ TAD FCNWD /WHEN FCNWD GOES TO 0
+ AND P17 /WE ARE ALL DONE.
+ /THE "AND" IS DONE TO
+ /PROTECT AGAINST A BAD
+ /ARG FROM THE FORT CALL.
+ /IN A FRIENDLY ENIVORN,
+ /ITS NOT NECESSARY.
+ /NEVER TRUST A FORTRAN
+ /"PROGRAMMER".
+P7540, SMA SZA /SMA IS SUPERFLOUS TO
+ /THE ROUT; BUT IT
+ /CREATES A NICE CONST.
+ JMP LOP1 /MORE TO DO
+ DCA STFLG /CLR THE SCHMITT
+ DCA STFLG+1 /TRIGGER FLAGS.
+\f DCA STFLG+2
+ TAD OVRFLO /SET BUFF PRESET
+ CIA /(FPP SET THIS ARG)
+ CLAB
+ CLA
+ TAD CLENAB /THIS IS FOR KW ONLY.
+ AND P377 /AC=3XX. 3= OR BUFF PRE
+ /INTO CLK CNTR AND ENAB
+ /INT ON OVRFLO.
+ /XX ARE THE STRIGS.
+ CLEN /SET KW ENABLE OR
+ CLA /READ DK ENABLE.
+ DCA OVRCNT+1 /CLR NUM OF CLK OVRFLOS
+ DCA OVRCNT /SINCE TIME 0.
+ TAD CPTYP /NEED TYPE IN ORDER TO
+RARCLL, RAR CLL /ISOLATE CONTROL
+ TAD CLENAB /BITS FOR
+ SZL /KW ?
+ AND P7540 /YES, B0-B2 IS RATE,
+ /B3 IS ADC, B5 IS BUFF
+ /PRE TO CLK CNTR ON
+ /OVRFLO, B6 IS MOX NIX.
+ /IF DK ALL BITS MAY HAVE
+ /MEANING
+ CLLR /START THE CLOCK
+ CLA
+ CIF CDF
+ JMP% SETCLK /RTN TO RTS
+\fDOSYNC, 0 /HERE TO DISPOSITION A
+ /A SCHMITT TRIGGER.
+ TAD CPTYP /DK AND KW FLAGS ARE IN
+ RAR CLL /REVERSE ORDER. IF DK
+ /ARG IS OK; IF KW THEN
+ /MUST SET 1=3, 2=2, 3=1
+ /TO GET INDEX TO
+ /CORRECT FLAG.
+ TAD FCNWD /=REQUESTED STRIG=1,2,3
+ /(SET BY FPP)
+ SZL /DK ?
+ CIA /NO KW
+ AND P3 /IE 1 GOES TO -1 GOES
+ /TO 3 ETC. "AND" ALSO
+ /INSURES RANGE IS 0-3.
+ /IF ARG IS 0 RESULT IS
+ /ALWAYS 0.
+ TAD KSTFLG+1 /GET PTR TO FLAG
+ DCA SETCLK
+ TAD% SETCLK /FLAG=0 IF TRIG HAS NOT
+ /TRIPPED SINCE THE LAST
+ /CALL TO SYNC; =1
+ /OTHERWISE IE RTN 0=FALSE
+ DCA FCNWD /,1=TRUE (FPP WILL PICK
+ / UP FCNWD)
+ DCA% SETCLK /CLR FLAG ANYWAY
+ CIF CDF
+ JMP% DOSYNC /RTN TO RTS
+\fIDOCLK, JMP AROUND /HERE ON CLOCK INTERRUPT
+ /(JMP AROUND IS A ONCE
+ /ONLY CONSTANT).
+ TAD KSTFLG+1 /SET PTR TO STRIG FLAGS.
+ DCA ITMP0
+ CLSA /GET CLOCK BITS.
+ DCAZ CSTAT /SAVE THEM FOR SOME
+ TADZ CSTAT /BODY ELSE.
+ SPA /OVER FLOW ?
+ ISZ OVRCNT+1 /YES BUMP LO ORD CNTR
+ SKP
+ ISZ OVRCNT /BUMP HI ORD
+ JMP DOTRIG /(HI ORD ISZ SKP IS
+ /HARMLESS)
+LOP2, ISZ ITMP0 /ADV STRIG FLAG PTR.
+ RAR CLL /(OR RTR CLL IF KW)
+ /IE PUT STRIG BIT IN LNK.
+ /IF DK THE ORDER OF
+ /INTERROGATION IS S1,S2,S3
+ /IF KW THE ORDER IS S3,
+ /S2,S1. THE STATUS BITS
+ /FOR DK ARE ADJACENT IE
+ / B9(S3),B10(S2),B11(S1)
+ /FOR KW ITS EVERY OTHER,
+ /B6(S1),B8(S2),B10(S3).
+ DCA ISVBIT /SAVE WHATS LEFT.
+ RAL /COPY LNK INTO FLAG IF=1
+ SZA /IE DONT CLR FLAG WHEN
+ DCA% ITMP0 /ITS SET.
+ TAD ISVBIT
+DOTRIG, AND P377 /THE "AND" INSURES THAT
+ /THE HI ORD BITS ARE
+ /CLRED SO THAT ISVBIT
+ /GOES TO 0 WHEN ALL
+ /STRIGS HAVE BEEN
+ /DISPOSITIONED. IE
+ /CLR OVRFLO BIT FOR DK,KW
+ /AND CLR PRE-EVENT BIT
+ /ON KW IF IT IS SET
+ SZA /DONE ?
+ JMP LOP2 /NO
+ TAD #CLINT /CALL USER EXTENDED
+ SZA CLA /CLOCK ROUT ?
+ JMS% #CLINT+1 /YES
+ JMP% IDOCLK /RTN TO IHANDL
+\fFCNPTR,
+OVRCNT,
+KONQI, ADDR ONQI
+P17, 17
+P377, 377
+FCNWD, 0 /FPP XRS
+CPTYP, 0
+RATE, 0
+P1, 1
+P2, 2
+OVRFLO,
+FCNTBL, ADDR CLKTBL
+KSTFLG, ADDR STFLG-1
+ ENTRY #CLINT
+#CLINT, 0;0
+ ENTRY TIME /FIGURE WHAT TIME IT IS
+TIME, JSA SETUP
+ FLDA RPTR /=27;X;X IS USED TO FLOAT
+ STARTD
+ FLDA# OVRCNT /NUM OF CLK OVRFLOS SINCE
+ STARTF /TIME 0
+ FNORM
+ FMUL TOVR /=NUM OF BASIC TICKS PER
+ /CLOCK OVER FLOW.
+ /FAC=NUM OF TICKS SINCE
+ /TIME 0.
+ FDIV% RPTR,RATE /DIV BY BASIC RATE IN HZ
+ /OR 1 IF EXTERNAL CLK.
+ FSTA% FTMP0 /GIVE ANS TO CALLER, ALSO
+ /LEAVE ANS IN FAC IN
+ /CASE TIME WAS A FCN
+ /CALL. ANS=ELAPSED TIME IN
+ /SECONDS SINCE TIME 0 OR
+ /NUM OF EXTERNAL UNIT
+ JA GOBAK /TICKS
+\f
--- /dev/null
+/
+/ C L O G
+/ - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/COMPLEX LOG ROUTINE
+/
+/ENTER + EXIT IN COMPLEX
+/
+/Z=X+IY
+/LOG(Z)=LOG(ABS(Z))+I*THETA
+/ABS(Z)=SQRT(X*X+Y*Y)
+/THETA=ATAN(Y/X)
+/
+/CALLS REAL SQRT,LOG,ATAN2
+/
+ SECT CLOG
+ JA #CLOG
+ DPCHK
+ TEXT +CLOG +
+CLOGXR, SETX XR
+ SETB BP
+ JA .+3
+BP, F 0.0
+XR, F 0.0
+ F 0.0
+ARG, F 0.0
+ F 0.0
+ ORG 10*3+BP
+ FNOP
+ JA CLOGXR
+ 0
+RT, JA .
+ BASE 0
+#CLOG, STARTD
+ FLDA 10*3
+ FSTA RT
+ FLDA 0
+ SETB BP
+ SETX XR
+ BASE BP
+ LDX 1,1
+ FSTA BP
+ FLDA% BP,1
+ FSTA BP
+ STARTE
+ FLDA% BP
+ FSTA ARG
+ STARTF
+ EXTERN ATAN2
+ JSR ATAN2
+ JA CL1
+ JA ARG+3 /ATAN(Y/X)
+ JA ARG
+CL1, FSTA ETEMP
+ FLDA ARG
+ FMULM ARG
+ FLDA ARG+3
+ FMUL ARG+3 /X*X+Y*Y
+ FADD ARG
+ FSTA ARG
+ EXTERN SQRT
+ JSR SQRT /TAKE SQRT
+ JA CL2
+ JA ARG
+CL2, FSTA ARG
+ EXTERN ALOG /ALOG(ABS(Z))
+ JSR ALOG
+ JA CL3
+ JA ARG
+CL3, FSTA ARG /REAL PART
+ FLDA ETEMP /IMAGINARY PART
+ FSTA ARG+3
+ STARTE
+ FLDA ARG
+ FSTA #CAC
+ JA RT
+ EXTERN #CAC
+ETEMP, F 0.0
+\f
--- /dev/null
+/
+/ C M P L X
+/ - - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/ENTER IN REAL,EXIT IN COMPLEX
+/CMPLX(X,Y)
+/Z=X+IY
+/
+ SECT CMPLX
+ JA #CMPLX
+ DPCHK
+ TEXT +CMPLX +
+CMPXR, SETX XR
+ SETB BP
+BP, F 0.0
+XR, F 0.0
+PTR1, F 0.0
+ARG, F 0.0
+ F 0.0
+ ORG 10*3+BP
+ FNOP
+ JA CMPXR
+ 0
+RT, JA .
+ BASE 0
+#CMPLX, STARTD
+ FLDA 10*3
+ FSTA RT
+ FLDA 0
+ SETB BP
+ SETX XR
+ BASE BP
+ LDX 1,1
+ FSTA BP
+ FLDA% BP,1
+ FSTA PTR1 /ADDR OF X
+ FLDA% BP,1+
+ FSTA BP /ADDR OF Y
+ STARTF
+ FLDA% PTR1
+ FSTA ARG /X
+ FLDA% BP
+ FSTA ARG+3 /Y
+ STARTE
+ FLDA ARG /X+IY
+ FSTA #CAC /SAVE IN CMPLX AC
+ JA RT
+ EXTERN #CAC
+\f
--- /dev/null
+/
+/
+/ C O S
+/ - - -
+/
+/SUBROUTINE COS(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT COS
+ JA #COS
+ TEXT +COS +
+COSXR, SETX XRCOS
+ SETB BPCOS
+BPCOS, FNOP
+ 0
+ 0
+XRCOS, F 0.0
+COS1, F 0.0
+FPI2CS, 1 /PI DIVIDED BY 2
+ 3110
+ 3755
+ ORG 10*3+BPCOS
+ FNOP
+ JA COSXR
+ 0
+COSRTN, JA .
+ BASE 0
+#COS, STARTD
+ FLDA 10*3
+ FSTA COSRTN
+ FLDA 0
+ SETX XRCOS
+ SETB BPCOS
+ BASE BPCOS
+ LDX 1,1
+ FSTA BPCOS
+ FLDA% BPCOS,1 /ADDR OF X
+ FSTA BPCOS
+ STARTF
+ FLDA% BPCOS /GET X
+ FADD FPI2CS /ADD IN PI OVER 2
+ FSTA COS1
+ EXTERN SIN
+ JSR SIN /AND CALL THE SIN
+ JA COSRTN
+ JA COS1
+\f
--- /dev/null
+/
+/
+/
+/ C O S D
+/ - - - -
+/
+/SUBROUTINE COSD(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT COSD
+ JA #COSD
+ TEXT +COSD +
+COSDXR, SETX XRCOSD
+ SETB BPCOSD
+BPCOSD, FNOP
+ 0
+ 0
+XRCOSD, F 0.0
+COSD90, F 90.
+COSD91, 6
+ 3451
+ 3560
+COSD1, F 0.0
+ ORG 10*3+BPCOSD
+ FNOP
+ JA COSDXR
+ 0
+CSDRTN, JA .
+ BASE 0
+#COSD, STARTD
+ FLDA 10*3
+ FSTA CSDRTN
+ FLDA 0
+ SETX XRCOSD
+ SETB BPCOSD
+ BASE BPCOSD
+ LDX 1,1
+ FSTA BPCOSD
+ FLDA% BPCOSD,1 /ADDR OF X
+ FSTA BPCOSD
+ STARTF
+ FLDA% BPCOSD /GET X IN DEGREES
+ FADD COSD90 /ADD IN 90
+ FDIV COSD91 /CONVERT TO REDIANS
+ FSTA COSD1
+ EXTERN SIN
+ JSR SIN /CALL THE SINE
+ JA CSDRTN
+ JA COSD1
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+/ C O S H
+/ - - - -
+/
+/SUBROUTINE COSH(X)
+/
+/ VERSION 5A 4-27-77 PT
+ SECT COSH
+ JA #COSH
+COSHE, FLDA COSHB /GIVE INFINITY IN CASE OF NO REC
+ EXTERN #ARGER
+ TRAP4 #ARGER
+ TEXT +COSH +
+COSHXR, SETX XRCOSH
+ SETB BPCOSH
+BPCOSH, FNOP
+ 0
+ 0
+XRCOSH, F 0.0
+COSH7, F 0.0
+COSH8, F 0.0
+F1COSH, F 1.
+F2COSH, F 2.
+ ORG 10*3+BPCOSH
+ FNOP
+ JA COSHXR
+ 0
+CSHRTN, JA .
+/
+COSHLG, 0
+ 2613
+ 4412
+/
+COSHB, 3777
+ 3777
+ 7777
+/
+/
+COSH1, F 88.029 /LIMIT FACTOR.
+ BASE 0
+#COSH, STARTD
+ FLDA 10*3
+ FSTA CSHRTN
+ FLDA 0
+ SETX XRCOSH
+ SETB BPCOSH
+ BASE BPCOSH
+ LDX 1,1
+ FSTA BPCOSH
+ FLDA% BPCOSH,1 /ADDR OF X
+ FSTA BPCOSH
+ STARTF
+ FLDA% BPCOSH /GET X
+ FSTA COSH8 /SAVE ARGUMENT
+ JGE .+3 /ABS(X)
+ FNEG
+ FSTA COSH7
+ FSUB COSH1 /TEST FOR LIMITS.
+ JGE COSHBG
+ EXTERN EXP
+ JSR EXP /EXP(X)
+ JA .+4
+ JA COSH8
+ FSTA COSH7
+ FLDA F1COSH /1.
+ FDIV COSH7 / 1./EXP(X)
+ FADD COSH7 / EXP(X)+1./EXP(X)
+ FDIV F2COSH / (EXP(X)+1./EXP(X))2.
+ JA CSHRTN /AND THAT IS THE DEFINITION OF COSH.
+/
+/
+COSHBG, FSUB COSHLG /SEE IF TOO BIG
+ JGT COSHE /YEP. ERROR
+ FADD COSH1 /READD IN SUBTRACTION FACTOR.
+ FSTA COSH8 / EXP(ABS(X)-LN(2))
+ EXTERN EXP
+ JSR EXP
+ JA .+4
+ JA COSH8
+ JA CSHRTN / A VERY GOOD APPROXIMATION.
+\f
--- /dev/null
+/
+/ C S I N
+/ - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/COMPLEX SIN AND COS ROUTINE
+/
+/CCOS(X+I*Y)=COS(X)*COSH(Y)-SIN(X)*SINH(Y)
+/
+/CSIN(X+I*Y)=SIN(X)*COSH(Y)+COS(X)*SINH(Y)
+/
+/CALLS SIN,COS,COSH,SINH
+/
+ SECT CSIN
+ JA #CSIN
+ DPCHK
+ TEXT +CSIN +
+CSINXR, SETX XR
+ SETB BP
+ JA .+3
+BP, F 0.0
+XR, F 0.0
+ARG, F 0.0
+ F 0.0
+C, F 0.0
+CH, F 0.0
+S, F 0.0
+ ORG 10*3+BP
+ FNOP
+ JA CSINXR
+ 0
+
+RT, JA .
+SH, F 0.0
+ BASE 0
+#CSIN, SETX XR
+ LDX 0,0
+COM, STARTD
+ FLDA 10*3
+ FSTA RT
+ FLDA 0
+ SETB BP
+ BASE BP
+ LDX 1,1
+ FSTA BP
+ FLDA% BP,1
+ FSTA BP
+ STARTE
+ FLDA% BP
+ FSTA ARG
+ STARTF
+ EXTERN COS
+ JSR COS
+ JA CSA
+ JA ARG /COS(X)
+CSA, FSTA C
+ EXTERN SIN
+ JSR SIN
+ JA CSB
+ JA ARG
+CSB, FSTA S /SIN(X)
+ EXTERN SINH
+ JSR SINH
+ JA CSC
+ JA ARG+3
+CSC, FSTA SH /SINH(Y)
+ EXTERN COSH
+ JSR COSH
+ JA CSD
+ JA ARG+3
+CSD, FSTA CH /COSH(Y)
+/XR0 IS 0 FOR CSIN AND 1 FOR CCOS
+ JXN CALCOS,0
+ FLDA S
+ FMUL CH
+ FSTA ARG /SIN*COSH
+ FLDA C
+CSE, FMUL SH
+ FSTA ARG+3 /COS*SINH
+ STARTE
+ FLDA ARG
+ FSTA #CAC
+ JA RT
+ EXTERN #CAC
+/DO COS
+/
+CALCOS, FLDA C
+ FMUL CH
+ FSTA ARG
+ FLDA S
+ FNEG
+ JA CSE
+ ENTRY CCOS
+CCOS, SETX XR
+ LDX 1,0
+ JA COM
+\f
--- /dev/null
+/
+/ C S Q R T
+/ - - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/COMPLEX SQUARE ROOT ROUTINE
+/ENTER+ EXIT IN COMPLEX
+/Z=X+IX
+/
+/SQRT(Z)=SQRT(R)*COS(THETA)+SIN(THETA))
+/
+/R=SQRT(X*X+Y*Y)
+/THETA=ATAN2(Y/X)/2
+/
+/CALLS SQRT,ATAN2,SIN,COS
+/
+ SECT CSQRT
+ JA #CSQRT
+ DPCHK
+ TEXT +CSQRT +
+CSQRTX, SETX XR
+ SETB BP
+ JA .+3
+BP, F 0.0
+XR, F 0.0
+ARG, F 0.0
+ F 0.0
+THETA, F 0.0
+FP2, F 2.0
+ ORG 10*3+BP
+ FNOP
+ JA CSQRTX
+ 0
+RT, JA .
+ BASE 0
+#CSQRT, STARTD
+ FLDA 10*3
+ FSTA RT
+ FLDA 0
+ SETB BP
+ SETX XR
+ BASE BP
+ LDX 1,1
+ FSTA BP
+ FLDA% BP,1
+ FSTA BP
+ STARTE
+ FLDA% BP
+ FSTA ARG
+ STARTF
+ EXTERN ATAN2
+ JSR ATAN2 /ATAN(Y/X)
+ JA CSA
+ JA ARG+3
+ JA ARG
+CSA, FDIV FP2 /ATAN/2
+ FSTA THETA
+ FLDA ARG
+ FMULM ARG /X*X
+ FLDA ARG+3
+ FMUL ARG+3 /Y*Y
+ FADD ARG /X*X+Y*Y
+ FSTA ARG
+ EXTERN SQRT /SQRT(X*X+Y*Y)
+ JSR SQRT
+ JA CSB
+ JA ARG
+CSB, FSTA ARG /R
+ EXTERN SQRT
+ JSR SQRT
+ JA CSC
+ JA ARG /SQRT(R)
+CSC, FSTA ARG /SQRT(R)
+ EXTERN SIN
+ JSR SIN /SIN(THETA/2)
+ JA CSD
+ JA THETA
+CSD, FMUL ARG /*SQRT(X)
+ FSTA ARG+3
+ EXTERN COS
+ JSR COS /COS(THETA/2)*SQRT(R)
+ JA CSE
+ JA THETA
+CSE, FMUL ARG
+ FSTA ARG
+ STARTE
+ FLDA ARG
+ FSTA #CAC
+ JA RT
+ EXTERN #CAC
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DABS
+ BASE 0
+ DPCHK
+DPABS, FLDA 0 /GET RETURN ADDRESS
+ STARTD
+ FSTA RETRN
+ FADD TWO /GET ADDRESS OF ARG P7S
+ FSTA 3
+ FLDA% 3
+ FSTA 3
+ STARTE
+ FLDA% 3
+ JGE RETRN /POSITIVE, SKIP NEGATE
+ FNEG
+RETRN, 0;0
+TWO, 0;2
+ END
+\f
--- /dev/null
+/
+/
+/ SUBROUTINE DATAN(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+/X,THE ARGUMENT, IS REDUCED TO
+/0<X<1/2
+/BY THE IDENTITIES:
+/ATAN(-X)=-ATAN(X)
+/IF X>1.0 THEN ATAN(X)=PI/2 - ATAN(1/X)
+/IF .5<X<1.0 THEN ATAN(X)=ATAN(1/2)+ATAN(2*X-(1/(X+2)))
+/ATAN(X)=X FOR X<2^(-15)
+/
+/
+/
+ SECT DATAN
+ JA #DATAN
+ DPCHK
+/
+ TEXT +DATAN +
+DATNXR, SETX XRDATN
+ SETB BPDATN
+BPDATN, F 0.0
+XRDATN, F 0.0
+DATFP1, F 1.0
+ F 0.0
+DATLOW, -15
+ 2000
+ 0000
+ 0000
+ 0000
+ 0000
+/
+ ORG 10*3+BPDATN
+ FNOP
+ JA DATNXR
+ 0
+DATRTN, JA .
+/
+LAMBDA, 0004
+ 3057
+ 7537
+ 4017
+ 0276
+ 4536
+DATB0, 0005
+ 3221
+ 3522
+ 3121
+ 3352
+ 5066
+DATA1, 0007
+ 5372
+ 4104
+ 3437
+ 1766
+ 6167
+DATB1, 0003
+ 3135
+ 1757
+ 0565
+ 4141
+ 4270
+DATA2, 0001
+ 5473
+ 7524
+ 1112
+ 4701
+ 2723
+DATB2, 0002
+ 2065
+ 4070
+ 1015
+ 2710
+ 3176
+DATA3, 7775
+ 5374
+ 4326
+ 3317
+ 1675
+ 3124
+DATB3, 0001
+ 2410
+ 5255
+ 0370
+ 2076
+ 6374
+PIS2, 0001
+ 3110
+ 3755
+ 2421
+ 0264
+ 3013
+ATN1S2, 7777
+ 3553
+ 0634
+ 0530
+ 3443
+ 6406
+DATP5, 7777
+ 3777
+ 7777
+ 7777
+ 7777
+ 7776
+X, F 0.0
+ F 0.0
+C0, F 0.0
+ F 0.0
+DT1, F 0.0
+ F 0.0
+DATFP2, F 2.0
+ F 0.0
+Z, F 0.0
+ F 0.0
+/
+/PICK UP RETURN AND ARGUMENT
+ BASE 0
+#DATAN, STARTD
+ FLDA 10*3
+ FSTA DATRTN
+ FLDA 0
+ SETX XRDATN
+ SETB BPDATN
+ BASE BPDATN
+ LDX 1,1
+ FSTA BPDATN
+ FLDA% BPDATN,1
+ FSTA BPDATN
+ STARTE
+ FLDA% BPDATN /GET X
+ LDX -1,0 /SIGN
+ JGE .+5
+ LDX 0,0 /SAVE SIGN
+ FNEG
+ FSTA X /SAVE ARG
+/
+/CHECK ARGAINST LOWER LIMIT
+ FLDA X
+ FSUB DATLOW /TOO SMALL?
+ JLE DATGO /YES ATAN(X)=X
+ LDX -1,1
+ FCLA
+ FSTA C0
+/
+/REDUCE X TO RANGE 0<X<.5
+DATA, FLDA X
+ FSUB DATFP1
+ JLE DATB />1?
+ FLDA DATFP1 /YES
+ FDIV X /X=1/X
+ LDX 0,1 /SET FLAG
+ FSTA X
+DATB, FLDA X
+ FSUB DATP5 />= .5
+ JLT DATC
+ FLDA X /X=(2X-1)/(X+2)
+ FADD DATFP2
+ FSTA DT1 /TEMP
+ FLDA X
+ FMUL DATFP2
+ FSUB DATFP1
+ FDIV DT1
+ FSTA X
+ FLDA ATN1S2 /C0=ATAN(1/2)
+ FSTA C0
+/COMPUTE ATAN USING ALGORITHM
+DATC, FLDA X
+ FMUL X
+ FSTA Z /Z=X*X
+ FLDA Z
+ FADD DATB3 /Z+B3
+ FSTA DT1
+ FLDA DATA3
+ FDIV DT1 /A3/(Z+B3)
+ FADD DATB2
+ FADD Z /ADD Z+B2
+ FSTA DT1 /TEMP
+ FLDA DATA2 /A2/TEMP
+ FDIV DT1
+ FADD DATB1
+ FADD Z /ADD Z +B1
+ FSTA DT1 /TEMP
+ FLDA DATA1 /A1/TEMP
+ FDIV DT1
+ FADD DATB0 /ADD Z+B0
+ FADD Z
+ FSTA DT1
+ FLDA LAMBDA /LAMBDA*X
+ FMUL X
+ FDIV DT1 /DIV BY THE REST
+ FADD C0
+ FSTA X
+ JXN DATD,1 /WAS X>1 ORIGINALLY?
+ FLDA PIS2 /Y ATAN(X)=PI/2-ATAN(X)
+ FSUB X
+DATD, JXN DATRTN,0 /WAS X<0?
+ FNEG /Y
+ JA DATRTN
+DATGO, FLDA X
+ JA DATD
+\f
--- /dev/null
+/
+/
+/
+/ D A T A N 2
+/ - - - - - -
+/
+/SUBROUTINE DATAN2(Y,X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DATAN2
+ JA #DATN2
+ DPCHK
+ TEXT +DATAN2+
+ATN2XR, SETX XRATN2
+ SETB BPATN2
+BPATN2, FNOP
+ 0
+ 0
+XRATN2, F 0.0
+YCOR, F 0.0
+ 0;0;0
+XCOR, F 0.0
+ 0;0;0
+ ORG 10*3+BPATN2
+ FNOP
+ JA ATN2XR
+ 0
+AT2RTN, JA .
+FPIAT2, 2
+ 3110 /PI
+ 3755
+ 2421
+ 0264
+ 3016
+ATPI, 0001
+ 3110 /PI/2
+ 3755
+ 2421
+ 0264
+ 3016
+ BASE 0
+#DATN2, STARTD
+ FLDA 10*3
+ FSTA AT2RTN
+ FLDA 0
+ SETX XRATN2
+ SETB BPATN2
+ BASE BPATN2
+ LDX 1,1
+ FSTA BPATN2
+ FLDA% BPATN2,1 /ADDR OF Y
+ FSTA YCOR
+ FLDA% BPATN2,1+ /ADDR OF X
+ FSTA XCOR
+ STARTE
+ FLDA% YCOR
+ FSTA YCOR /SAVE FOR A SECOND
+ LDX 1,2 /POSITIVE Y
+ JEQ ATN0
+ JGT ATN1
+ LDX 0,2
+ATN1, FLDA% XCOR /GET X - THE QUADRAND
+ FSTA XCOR /+MOVE IT TO A SAFE PLACE
+ JEQ ATASP
+ FLDA YCOR /Y/X
+ FDIV XCOR
+ FSTA YCOR
+ EXTERN DATAN
+ JSR DATAN /CALL ATAN
+ JA .+4 /TAKE ARCTAN OF Y/X
+ JA YCOR
+ FSTA YCOR /SAVE IT AWAY
+ JGE A2 /SKIP IF 1ST OR 3RD QUADS
+ FADD FPIAT2 /ADD PI FOR 4TH QUAD
+ FSTA YCOR
+A2, JXN AT2RTN,2 /DONE IF 1 OR 4 Q
+ FLDA YCOR
+ FSUB FPIAT2 /2ND OR 3RD Q
+ JA AT2RTN
+ATASP, FLDA ATPI /PI/2
+ JXN ATNG,2
+ FNEG
+ATNG, JA AT2RTN
+ATN0, FLDA% XCOR
+ JLT POSX
+ FCLA /X POS, ANS =0
+ JA AT2RTN
+POSX, FLDA FPIAT2 /X LT 0, ANS = PI
+ JA AT2RTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4/28/77 PT
+/
+ SECT8 DATE
+ JA #ST
+ EXTERN #DATE
+#XR, ORG .+10
+ TEXT +DATE +
+#RET,
+#BASE, ORG .+3
+MONTH, ORG .+3
+DAY, ORG .+3
+YEAR, ORG .+3
+TEMP, ORG .+3
+DATADR, 0
+ JA #DATE-1 /ADDRESS OF PS8 DATE WORD
+ ORG 10*3+#BASE
+ FNOP
+ JA #RET
+ 0
+DRTN, JA .
+ BASE 0
+NEWDAT, 0
+ CDF 0
+ TAD% BIPCCL
+ AND BITMSK
+ CLL RTR
+ RTR
+ DCA DATEMP
+ CDF CIF 0
+ JMP% NEWDAT
+BIPCCL, 7777
+BITMSK, 600
+#ST, STARTD
+ 0210
+ FSTA DRTN
+ 0200
+ BASE #BASE
+ SETX #XR
+ SETB #BASE
+ LDX 0,1
+ FSTA #BASE
+ FLDA% #BASE,1+
+ FSTA MONTH
+ FLDA% #BASE,1+
+ FSTA DAY
+ FLDA% #BASE,1+
+ FSTA YEAR
+ FLDA% DATADR /GET THE PS-8 DATE WORD
+ FSTA TEMP /SAVE IT
+ FCLA
+ FSTA TEMP,0 /ZERO EXPONENT AND HIGH HALF OF MANTISSA
+ LDX 10,1 /SHIFT COUNT
+ FLDA TEMP /GET IT BACK
+ ALN 1 /ISOLATE THE MONTH
+ ATX 1 /SAVE THE MONTH
+ LDX -4,2 /DAY SHIFT COUNT
+ FLDA TEMP /GET BACK THE DATE
+ ALN 2 /SHIFT MONTH BITS INTO
+ /HIGH HALF OF MANTISSA
+ FSTA TEMP /SAVE THIS
+ FCLA
+ FSTA TEMP,0 /ISOLATING DAY/YEAR BITS
+ FLDA TEMP /GET THEM BACK
+ LDX 7,2 /NOW ISOLATE DAY
+ ALN 2
+ ATX 2 /AND SAVE IT IN 2
+ FLDA TEMP /GET DAY/YEAR BITS
+ LDX -5,3 /PREPARE TO REMOVE DAY BITS
+ ALN 3 /BY SHIFTING THEM INTO HIGH HALF OF MANTISSA
+ FSTA TEMP /SAVE THEM
+ FCLA
+ FSTA TEMP,0 /ZERO DAY BITS
+ FLDA TEMP /RESTORE YEAR BITS
+ LDX 11,3 /SHIFT BACK
+ ALN 3
+ ATX 3 /PUT THEM INTO XR 3
+ TRAP4 NEWDAT
+ STARTF /RE-ENTER F MODE
+ XTA 1 /GET MONTH
+ FSTA% MONTH /RETURN IN ARG
+ XTA 2 /NOW DAY
+ FSTA% DAY
+ ADDX 3662,3 /MAKE IT + 1970
+ ADDX 0,3
+ DATEMP=.-1
+ XTA 3 /NOW YEAR
+ FSTA% YEAR
+ JA DRTN /RETURN
+ END
+\f
--- /dev/null
+/ SUBROUTINE DBLE - REAL TO DBL PREC
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DBLE
+ BASE 0
+ DPCHK
+ FLDA 0
+ STARTD
+ FSTA RETRN /SAVE RETURN
+ FADD TWO /ADDR OF ARG POINTER
+ FSTA 3
+ FLDA% 3 /ADDR OF ARG
+ FSTA 3
+ STARTF
+ FLDA% 3 /GET ARG
+ FSTA DTEMP
+ FCLA
+ FSTA DTEMP+3 /0 FOR LAST 3 WORDS
+ STARTE
+ FLDA DTEMP
+RETRN, 0;0 /FLOAT IS A NOP
+TWO, 0;2
+DTEMP, F 0.0
+ F 0.0
+ END
+\f
--- /dev/null
+/
+/
+/ D C O S
+/ - - - -
+/
+/SUBROUTINE DCOS(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DCOS
+ JA #DCOS
+ DPCHK
+ TEXT +DCOS +
+COSXR, SETX XRCOS
+ SETB BPCOS
+BPCOS, FNOP
+ 0
+ 0
+ 0
+ 0
+ 0
+XRCOS, F 0.0
+ F 0.0
+COS1, F 0.0
+ F 0.0
+FPI2CS, 1 /PI DIVIDED BY 2
+ 3110
+ 3755
+ 2421
+ 0264
+ 3016
+ ORG 10*3+BPCOS
+ FNOP
+ JA COSXR
+ 0
+COSRTN, JA .
+ BASE 0
+#DCOS, STARTD
+ FLDA 10*3
+ FSTA COSRTN
+ FLDA 0
+ SETX XRCOS
+ SETB BPCOS
+ BASE BPCOS
+ LDX 1,1
+ FSTA BPCOS
+ FLDA% BPCOS,1 /ADDR OF X
+ FSTA BPCOS
+ STARTE
+ FLDA% BPCOS /GET X
+ FADD FPI2CS /ADD IN PI OVER 2
+ FSTA COS1
+ EXTERN DSIN
+ JSR DSIN /AND CALL THE SIN
+ JA COSRTN
+ JA COS1
+\f
--- /dev/null
+/
+/
+/ SUBROUTINE DEXP
+/
+/ VERSION 5A 4-26-77 MH
+/
+/E^X=2^(X*LOG2(E))
+/E^X=2^(M+F)
+/M=INTEGER; F=FRACTION
+/
+/2^(M+F)=2^(M+N+R)
+/WHERE 0<R<1/8
+/AND M+N+R=M+F=X*LOG2(E)
+/
+/(2^M)*(2^N)*(2^R)=E^X
+/
+/2^M IS CALCULATED BY SUCCESSIVE MULTIPLIES
+/2^N IS CALCULATED BY LOOK UP
+/2^R=1+<A4/((B4/R)-C4+(D4*R)+(H4/(R+(B4/R))))>
+/
+/RESTRICTIONS:
+/X=0 IMPLIES E^X=1
+/
+/X>88.028 IMPLIES E^X=3377/3377/3777/7777/777/7777
+/
+/X<-88.028 IMPLIES E^X=0
+/
+/
+/
+ SECT DEXP
+ JA #DEXP
+ DPCHK
+ TEXT +DEXP +
+/
+DEXPXR, SETX XRDEXP
+ SETB BPDEXP
+/
+/BEGINNING OF BASE PAGE
+/
+BPDEXP, F 0.0
+XRDEXP, F 0.0
+X, F 0.0
+ F 0.0
+/
+ ORG 10*3+BPDEXP
+ FNOP
+ JA DEXPXR
+ 0
+DEXRTN, JA .
+/
+TOPLIM, 3377
+ 3377
+ 3777
+ 7777
+ 7777
+ 7777
+M, F 0.0
+ F 0.0
+N, F 0.0
+ F 0.0
+R, F 0.0
+ F 0.0
+LOG2E, 0001 /1.4426950408889634
+ 2705
+ 2435
+ 4512
+ 7013
+ 7603
+DFP125, 7775 /.125
+ 3777
+ 7777
+ 7777
+ 7777
+ 7776
+DEXFP1, F 1.0
+ F 0.0
+/
+DFR1S8, 0001 /2^1/8
+ 2134
+ 5340
+ 7437
+ 2505
+ 7302
+DFP2S8, 0001 /2^2/8
+ 2301
+ 5770
+ 1214
+ 3334
+ 2524
+DFP3S8, 0001 /2^3/8
+ 2457
+ 7553
+ 2515
+ 4250
+ 4720
+DFP4S8, 0001 /2^4/8
+ 2650
+ 1171
+ 4637
+ 6357
+ 1425
+DFP5S8, 0001 /2^5/8
+ 3053
+ 1625
+ 0212
+ 5174
+ 3070
+DFP6S8, 0001 /2^6/8
+ 3272
+ 1176
+ 3126
+ 5516
+ 5532
+DFP7S8, 0001 /2^7/8
+ 3526
+ 0143
+ 3476
+ 7222
+ 0722
+/
+/
+DEXA4, 0006 /60.593191717336463
+ 3622
+ 7666
+ 6462
+ 2157
+ 5534
+DEXB4, 0007 /87.417497202235527
+ 2566
+ 5341
+ 0613
+ 6705
+ 7214
+DEXC4, 0005 /30.296595858668232
+ 3622
+ 7666
+ 6462
+ 2157
+ 5546
+DEXD4, 0001 /1.0500
+ 2063
+ 1463
+ 1463
+ 1463
+ 1462
+DEXH4, 0010 /214.17286814547704
+ 3261
+ 3040
+ 4261
+ 5654
+ 0240
+DTEMP1, F 0.0
+ F 0.0
+DFP2, F 2.0
+ F 0.0
+/
+ BASE 0
+#DEXP, STARTD
+ FLDA 10*3
+ FSTA DEXRTN
+ FLDA 0
+ SETX XRDEXP
+ SETB BPDEXP
+ BASE BPDEXP
+ LDX 1,1
+ LDX 73,2 /FOR ALIGNING
+ FSTA BPDEXP
+ FLDA% BPDEXP,1 /ADDRESS OF X
+ FSTA BPDEXP
+ STARTE
+ FLDA% BPDEXP /GET X
+ LDX 0,0
+ JGT DEX1 /CHECK SIGN
+ FNEG
+ LDX -1,0 /SET FLAG
+DEX1, JNE DEX2 /X=0
+ FLDA DEXFP1 /E^0=1
+ JA DEXRTN
+DEX2, FSTA X
+ JA DEX4
+DEX3, FCLA
+ JA DEXRTN /RETURN 0 FOR TOO SMALL
+/
+/SET UP M+N+R=X*LOG2(E)
+DEX4, FLDA LOG2E
+ FMULM X
+ FLDA X
+ ALN 2 /FIX
+ FNORM /FLOAT
+ FSTA M /INTEGER PART
+ FLDA X
+ FSUB M
+ FSTA N /FRACTION
+ JNE DEX50 /0 IS SPECIAL CASE
+ FLDA DEXFP1 /1.0
+ FSTA N /N
+ FSTA R /R
+ JA DEX20 /SKIP
+/
+/CALCULATE N+R
+DEX50, LDX 0,1
+ FLDA N
+ FSTA R /IF < .125 ALREADY
+DEX5, FSUB DFP125 /-.125
+ JLT DEX6 /DONE IF .LT.
+ FSTA R /STORE REMAINDER
+ ADDX 1,1 /NEXT POWER OF 2
+ JA DEX5 /AND AGAIN
+/
+/GET N FROM TABLE
+DEX6, FLDA DEXFP1,1
+ FSTA N
+/
+/NOW CALCULATE R
+ FLDA R /IF R=0
+ JNE DEX7
+ FLDA DEXFP1 /2^R=1
+ FSTA R
+ JA DEX20 /NO CALCULATION
+/
+/
+DEX7, FLDA DEXB4
+ FDIV R /(B4/R)
+ FSTA X
+ FLDA DEXD4 /D4*R
+ FMUL R
+ FADD X /+(B4/R)
+ FSUB DEXC4 /-C4
+ FSTA DTEMP1
+ FLDA R
+ FADD X /R+(B4/R)
+ FSTA R
+ FLDA DEXH4
+ FDIV R /H4/(R+B4/R)
+ FADD DTEMP1
+ FSTA DTEMP1
+ FLDA DEXA4
+ FDIV DTEMP1
+ FADD DEXFP1
+ FSTA R
+/
+/CALCULATE 2^M
+/
+DEX20, FLDA M
+ JNE DEX21
+ FLDA DEXFP1
+ FSTA M
+ JA DEX30
+DEX21, FNEG
+ ATX 1
+ FLDA DEXFP1
+ FSTA M
+ FLDA DFP2
+DEX22, FMULM M /M*2
+ JXN DEX22,1+
+/CALCULATE M*N*R
+DEX30, FLDA M
+ FMUL N
+ FMUL R
+ FSTA X
+ JXN DEX31,0 /WAS X MINUS
+ JA DEXRTN
+DEX31, FLDA DEXFP1 /.1/X IF -X
+ FDIV X
+ JA DEXRTN
+\f\1e
--- /dev/null
+/
+/
+/
+/ D E X P 3
+/ - - - - -
+/
+/SUBROUTINE DEXP3(B,E) FOR DOUBLE TO DOUBLE
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT DEXP3
+ JA #DEXP3
+ DPCHK
+ EXTERN #ARGER
+EXP3ER, TRAP4 #ARGER
+ TEXT +DEXP3 +
+EXP3XR, SETX XREXP3
+ SETB BPEXP3
+ JA .+3
+BPEXP3, FNOP
+ 0
+ 0
+XREXP3, F 0.0
+EXP31, F 0.0
+ F 0.0
+EXP32, F 0.0
+ F 0.0
+ ORG 10*3+BPEXP3
+ FNOP
+ JA EXP3XR
+ 0
+XP3RTN, JA .
+FP1XP3, F 1.
+ F 0.0
+ BASE 0
+#DEXP3, STARTD
+ FLDA 10*3
+ FSTA XP3RTN
+ FLDA 0
+ SETX XREXP3
+ SETB BPEXP3
+ BASE BPEXP3
+ LDX 1,1
+ FSTA BPEXP3
+ FLDA% BPEXP3,1 /ADDR OF B
+ FSTA EXP31
+ FLDA% BPEXP3,1+ /ADDR OF E
+ FSTA EXP32
+ STARTE
+ FLDA% EXP31 /GET B
+ JEQ XP3RTN /0 ^ X = 0
+ FSTA EXP31 /SAVE BASE
+ FLDA% EXP32 /GET E
+ JEQ EXP3ON /X ^ 0 = 1
+ FSTA EXP32 /SAVE EXPONENT
+ FLDA EXP31
+ JLT EXP3ER /ALL IS NOT WELL
+ EXTERN DLOG
+ JSR DLOG /CALL LOG
+ JA .+4 /TAKE LOG (B)
+ JA EXP31
+ FMUL EXP32 /MULT BY EXPONENT-E
+ FSTA EXP31
+ EXTERN DEXP
+ JSR DEXP /CALL EXP.
+ JA XP3RTN
+ JA EXP31
+EXP3ON, FLDA FP1XP3
+ JA XP3RTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DIM
+ ENTRY IDIM
+ JA #ST
+#XR, ORG .+10
+#BASE, ORG .+3
+A, ORG .+3
+B, ORG .+3
+ BASE #BASE
+IDIM,
+#ST, STARTD
+ 0210
+ FSTA #RTN,0
+ 0200
+ SETX #XR
+ SETB #BASE
+ LDX 0,1
+ FSTA #BASE
+ FLDA% #BASE,1+
+ FSTA A
+ FLDA% #BASE,1+
+ FSTA B
+ STARTF
+ FLDA% A
+ FSUB% B
+ JGE #RTN
+ FCLA
+#RTN, JA .
+ END
+\f
--- /dev/null
+/
+/
+/ D L O G
+/ - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/LOGE(X)
+/
+/X=2^N*F
+/
+/LOGE(X)
+ /= N*LOGE(2)+LOGE(F)
+/
+/
+ SECT DLOG
+ JA #DALOG
+ DPCHK
+/
+/IF X<=0 - IT IS AN ERROR
+ EXTERN #ARGER
+DALERR, TRAP4 #ARGER
+/
+ TEXT +DLOG +
+DALXR, SETX XRDAL
+ SETB BPDAL
+BPDAL, F 0.0
+XRDAL, F 0.0
+ F 0.0
+ ORG 10*3+BPDAL
+ FNOP
+ JA DALXR
+ 0
+DALRTN, JA .
+N, F 0.0
+ F 0.0
+F, F 0.0
+ F 0.0
+DAL1, F 1.0
+ F 0.0
+/
+DT7, 7776 /1/7
+ 2222
+ 2222
+ 2222
+ 2222
+ 2221
+DT6, 7776 /-1/6
+ 5252
+ 5252
+ 5252
+ 5252
+ 5252
+DT5, 7776 /1/5
+ 3146
+ 3146
+ 3146
+ 3146
+ 3146
+DT4, 7776 /-1/4
+ 4000
+ 0
+ 0
+ 0
+ 0
+DT3, 7777 /1/3
+ 2525
+ 2525
+ 2525
+ 2525
+ 2524
+DT2, 7777 /-1/2
+ 4000
+ 0
+ 0
+ 0
+ 0
+/
+A0, F 1.84375
+ F 0.0
+A1, F 1.65625
+ F 0.0
+A2, F 1.500
+ F 0.0
+A3, F 1.375
+ F 0.0
+A4, F 1.250
+ F 0.0
+A5, F 1.1875
+ F 0.0
+A6, F 1.09375
+ F 0.0
+A7, F 1.03125
+ F 0.0
+LA0, 0 /.6118015411059928976
+ 2344
+ 7603
+ 2325
+ 4250
+ 3144
+LA1, 0 /.5045560107523952859
+ 2011
+ 2512
+ 4551
+ 3503
+ 7657
+LA2, 7777 /.4054651081081643810
+ 3174
+ 6217
+ 5457
+ 7141
+ 1370
+LA3, 7777 /.3184537311185346147
+ 2430
+ 3057
+ 0207
+ 0573
+ 0232
+LA4, 7776 /.2231435513142097553
+ 3443
+ 7737
+ 0746
+ 5150
+ 4146
+LA5, 7776 /.1718502569266592214
+ 2577
+ 6301
+ 6051
+ 7117
+ 2356
+LA6, 7775 /.08961215868968712374
+ 2674
+ 1512
+ 1271
+ 2655
+ 1272
+LA7, 7773 /.030771658666753687
+ 3740
+ 5154
+ 1636
+ 0313
+ 7764
+D16, F 16.0
+ F 0.0
+D8, F 8.0
+ F 0.0
+CUM, F 0.0
+ F 0.0
+DLOGE2, 0
+ 2613
+ 4413
+ 7676
+ 4347
+ 5715
+/
+/PICK UP X
+ BASE 0
+#DALOG, STARTD
+ FLDA 10*3
+ FSTA DALRTN
+ FLDA 0
+ SETX XRDAL
+ SETB BPDAL
+ BASE BPDAL
+ LDX 1,1
+ FSTA BPDAL
+ FLDA% BPDAL,1 /ADDRESS
+ FSTA BPDAL
+ STARTE
+ FLDA% BPDAL /AND X
+ JLE DALERR /X <= 0 IS ERROR
+ FSUB DAL1 /SUB 1.0
+ JNE DALA
+ FCLA /LOG(1)=0
+ JA DALRTN
+/
+DALA, FADD DAL1 /ADD BACK
+ FSTA XRDAL /STORE AT X
+/EXPONENT STORED IN XR0
+/MANTISSA STORED IN XR1-5
+/PICK UP EXP + MULTIPLY BY LOGE(2)
+/
+ XTA 0
+ FMUL DLOGE2
+ FSTA N /N*LOGE(2)
+/XRDAL IS NOW FRACTION IN RANGE .5<=F<1.0
+/COMPUTE LOG(F) BY
+/LOG(F)=LOG(A(K1)*A(K2)...(F))-(LOG(A(K1))+
+/ LOG(A(K2))...)
+/FIT F IN A 1/16 RANGE
+/I.E. 1/2-9/16,9/16-10/16,ETC.
+/MULTIPLY F BY APPROPRIATE A(K) MULTIPLIER
+/KEEP RUNNING SUM OF LOG(A(K))
+/CONTINUE UNTIL F>1
+
+/
+ LDX 0,0
+ FLDA XRDAL
+ FSTA F
+ FCLA
+ FSTA CUM
+DALB, FLDA F
+ FMUL D16 /16 REAL PARTS
+ FSUB D8 /NEED JUST 8
+ ATX 1
+ FLDA A0,1 /GET MULTIPLIER
+ FMULM F
+ FLDA LA0,1 /ADD LOG(A(K)) TO SUM
+ FADDM CUM
+ FLDA F
+ FSUB DAL1
+ JLT DALB
+/NOW F>1. USE TAYLOR SERIES
+/LOG(T)=Z-(Z^2)/2+(Z^3)/3+... WHERE Z=T-1
+ FLDA F
+ FSUB DAL1 /F-1.0
+ FSTA F
+ FMUL DT7
+ FADD DT6
+ FMUL F
+ FADD DT5
+ FMUL F
+ FADD DT4
+ FMUL F
+ FADD DT3
+ FMUL F
+ FADD DT2
+ FMUL F
+ FADD DAL1
+ FMUL F
+ FSUB CUM
+ FADD N
+ JA DALRTN
+\f
--- /dev/null
+/
+/
+/ D L O G 1 0
+/ - - - - - -
+/
+/SUBROUTINE DPLOG10(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+ SECT DLOG10
+ JA #DLOG10
+ DPCHK
+ TEXT +DLOG10+
+LOGXR, SETX XRLOG
+ SETB BPLOG
+ JA .+3
+BPLOG, FNOP
+ 0
+ 0
+ 0;0;0
+XRLOG, F 0.0
+LOG1, F 0.0
+ 0;0;0
+ ORG 10*3+BPLOG
+ FNOP
+ JA LOGXR
+ 0
+LOGRTN, JA .
+ALOG1C, 7777 /DP .4342944819032518276
+ 3362
+ 6754
+ 2511
+ 5624
+ 1612
+ BASE 0
+#DLOG10, STARTD
+ FLDA 10*3
+ FSTA LOGRTN
+ FLDA 0
+ SETX XRLOG
+ SETB BPLOG
+ BASE BPLOG
+ LDX 1,1
+ FSTA BPLOG
+ FLDA% BPLOG,1 /ADDR OF X
+ FSTA BPLOG
+ STARTE
+ FLDA% BPLOG /GET X
+ FSTA LOG1
+ EXTERN DLOG
+ JSR DLOG /CALL ALOG
+ JA .+4
+ JA LOG1
+ FMUL ALOG1C /CORRECT FOR THE LOG BASE E.
+ JA LOGRTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DMAX1
+ BASE 0
+ DPCHK
+DPMAX, SETX XR
+MAXCOM, STARTD
+ FLDA 0 /ADDRESS OF JA .+2+2*N
+ FSTA 3
+ FLDA 30 /RETURN ADDRESS
+ FSTA RETN
+ FLDA% 3 / JA .+2+2*N
+ FSUB 0 /-JA .
+ FSUB TWO /- 2
+ LDX 1,1
+ ALN 1 /DIVIDE BY TWO
+ FNEG /-N
+ ATX 1
+ LDX 0,2 /FOR ARG PICKUP
+ FLDA% 0,2+ /ADDRESS OF FIRST ARG
+ FSTA 3
+ STARTE
+NEW, FLDA% 3 /SAVE NEW MAX
+ FSTA MAX
+SAME, JXN MORMAX,1+ /ANY MORE ARGS ?
+ FLDA MAX /GET RESULT
+RETN, JA .
+MORMAX, STARTD /NEXT ARG ADDRESS
+ FLDA% 0,2+
+ FSTA 3
+ STARTE
+ FLDA MAX /COMPARE
+ FSUB% 3
+ JGE SAME /SAME MAX
+ JA NEW /NEW MAX
+TWO, 0;2
+MAX, 0;0;0
+ 0;0;0
+XR, 0;0;0;0;0;0;0;0
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4/26/77 MH
+/
+ SECT DMIN1
+ BASE 0
+ DPCHK
+DPMIN, SETX XR
+MINCOM, STARTD
+ FLDA 0 /ADDRESS OF JA .+2+2*N
+ FSTA 3
+ FLDA 30 /RETURN ADDRESS
+ FSTA RETN
+ FLDA% 3 / JA .+2+2*N
+ FSUB 0 /-JA .
+ FSUB TWO /- 2
+ LDX 1,1
+ ALN 1 /DIVIDE BY TWO
+ FNEG /-N
+ ATX 1
+ LDX 0,2 /FOR ARG PICKUP
+ FLDA% 0,2+ /ADDRESS OF FIRST ARG
+ FSTA 3
+ STARTE
+NEW, FLDA% 3 /SAVE NEW MIN
+ FSTA MIN
+SAME, JXN MORMIN,1+
+ FLDA MIN
+RETN, JA .
+MORMIN, STARTD /NEXT ARG ADDRESS
+ FLDA% 0,2+
+ FSTA 3
+ STARTE
+ FLDA MIN /COMPARE
+ FSUB% 3
+ JLE SAME /SAME MIN
+ JA NEW /NEW MIN
+TWO, 0;2
+MIN, 0;0;0
+ 0;0;0
+XR, 0;0;0;0;0;0;0;0
+ END
+\f
--- /dev/null
+/
+/
+/
+/ D M O D
+/ - - - -
+/
+/SUBROUTINE DMOD(X,Y)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DMOD
+ JA #DMOD
+ DPCHK
+ TEXT +DMOD +
+AMODXR, SETX XRAMOD
+ SETB BPAMOD
+STHREE, 0007 /73
+ 2217
+ 7777
+ 7777
+ 7777
+ 7777
+BPAMOD, F 0.0
+ F 0.0
+XRAMOD, 0;1;73 /73 FOR ALIGNING ON 59
+XSTOR, F 0.0
+ F 0.0
+AMODX, F 0.0
+ F 0.0
+ ORG 10*3+BPAMOD
+ FNOP
+ JA AMODXR
+ 0
+AMDRTN, JA .
+ EXTERN #ARGER
+AMODER, TRAP4 #ARGER
+ FCLA
+ JA AMDRTN
+ BASE 0
+#DMOD, STARTD
+ FLDA 10*3
+ FSTA AMDRTN
+ FLDA 0
+ SETX XRAMOD
+ SETB BPAMOD
+ BASE BPAMOD
+ FSTA BPAMOD
+ LDX 1,1
+ FLDA% BPAMOD,1 /ADDR OF X
+ FSTA AMODX
+ FLDA% BPAMOD,1+ /ADDR OF Y
+ FSTA BPAMOD
+ STARTE
+ FLDA% BPAMOD /GET Y
+ JEQ AMODER /Y=0 IS ERROR
+ FLDA% BPAMOD
+ JGT .+3 /GET ABS VALUE
+ FNEG
+ FSTA BPAMOD
+ FLDA% AMODX /GET X
+ JGT .+5
+ FNEG /GET ABS VALUE OF X
+ LDX 0,1 /NOTE THE SIGN
+ FSTA AMODX /SAV IN A TEMPORARY
+ FDIV BPAMOD /DIVIDE BY Y
+ FSTA XSTOR /SAVE X/Y
+ XTA 3 /GET EXPONENT
+ FSUB STHREE /CHECK SIZE
+ JGE AMODER /TOO BIG
+ FLDA XSTOR /ABS VALUE X/Y
+ ALN 2 /FIX IT UP NOW.
+ FNORM
+ FMUL BPAMOD /MULITPLY IT.
+ FNEG /NEGATE IT.
+ FADD AMODX /AND ADD IN X.
+ JXN AMR,1
+ FNEG /RESTORE SIGN
+AMR, JA AMDRTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DSIGN
+ JA #ST
+#XR, ORG .+10
+ TEXT 'DSIGN '
+#BASE, ORG .+6
+A, ORG .+6
+B, ORG .+6
+ ORG #BASE+31
+ JA #BASE
+GOBACK, 0;0;0
+ BASE #BASE
+ DPCHK
+#ST, STARTD
+ 0210 /FLDA 10
+ FSTA GOBACK+1,0
+ 0200
+ SETX #XR
+ SETB #BASE
+ LDX 0,1
+ FSTA #BASE
+ FLDA% #BASE,1+
+ FSTA A
+ FLDA% #BASE,1+
+ FSTA B
+ STARTE
+ FLDA% B /NEG?
+ JLT #50 /B POS
+ FLDA% A
+ JLT #100
+ JA GOBACK+1 /A+,B+
+#50, FLDA% A
+ JLT GOBACK+1 /A-,B-
+#100, FNEG /OPP. SIGNS
+ JA GOBACK+1
+ END
+\f
--- /dev/null
+/
+/
+/ D S I N
+/ - - -
+/
+/SUBROUTINE DSIN(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DSIN
+ JA #DSIN
+ DPCHK
+ TEXT +DSIN +
+SINXR, SETX XRSIN
+ SETB BPSIN
+FPI2SN, 1 /PI DIVIDED BY 2
+ 3110
+ 3755
+ 2421
+ 0264
+ 3016
+FPISIN, 2 /PI
+ 3110
+ 3755
+ 2421
+ 0264
+ 3016
+F2PISN, 3 /TWO PI
+ 3110
+ 3755
+ 2421
+ 0264
+ 3016
+BPSIN, F 0.0
+XRSIN, F 0.0
+X, F 0.0
+ F 0.0
+ ORG 10*3+BPSIN
+ FNOP
+ JA SINXR
+ 0
+SINRTN, JA .
+SIN1, F 0.0
+ F 0.0
+F3PIB2, 0003 /4.71238898038468986
+ 2266
+ 2761
+ 7714
+ 6207
+ 2212
+F1SIN, F 1.0
+ F 0.0
+/
+SINC17, 7720 /1/17!
+ 3124
+ 5435
+ 6014
+ 1265
+ 1236
+SINC15, 7730 /-1/15!
+ 4506
+ 0060
+ 3063
+ 0437
+ 4133
+SINC13, 7740 /1/13!
+ 2604
+ 4430
+ 2352
+ 0664
+ 1151
+SINC11, 7747 /-1/11!
+ 4506
+ 3352
+ 3002
+ 5354
+ 3710
+SINC9, 7756 /1/9!
+ 2707
+ 3616
+ 4525
+ 5434
+ 6350
+/
+SINC7, 7764 /-1/7!
+ 4577
+ 4577
+ 4577
+ 4577
+ 4636
+/
+SINC5, 7772 /1/5!
+ 2104
+ 2104
+ 2104
+ 2104
+ 2104
+/
+SINC3, 7776 /-1/3!
+ 5252
+ 5252
+ 5252
+ 5252
+ 5244
+/
+SINTST, 7770
+ 2000
+ 0000
+ 0000
+ 0000
+ 0000
+SEVTHR, 0007
+ 2217
+ 7777
+ 7777
+ 7777
+ 7777
+ BASE 0
+#DSIN, STARTD
+ FLDA 10*3
+ FSTA SINRTN
+ FLDA 0
+ SETX XRSIN
+ SETB BPSIN
+ BASE BPSIN
+ LDX 1,1
+ LDX 73,2
+ FSTA BPSIN
+ FLDA% BPSIN,1 /ADDR OF X
+ FSTA BPSIN
+ STARTE
+ FLDA% BPSIN /GET X
+ LDX -1,0 /SET SIGN TO POSITIVE.
+ JGT SINMOD /IF POSITIVE BYPASS FUDGE.
+ JEQ SINRTN /IF ZERO EXIT.
+ FNEG /NEGATIVE. NEGATE AC. SIN(-X)=-SIN(X)
+ LDX 0,0 /SET SIGN TO MINUS.
+SINMOD, FSTA X
+ FDIV F2PISN /X/2PI
+ ALN 2
+ FNORM
+ FMUL F2PISN /*2PI
+ FSTA SIN1
+ FLDA X
+ FSUB SIN1
+ FSTA SIN1
+ FSTA X
+/CHECK FOR QUADRANT
+/1 0-PI/2 SIN(PI/2)=1
+/2 PI/2-PI SIN(PI)=0
+/3 PI-3PI/2 SIN(3PI/2)=-1
+/4 3PI/2-2PI SIN(2PI)=0
+/
+ FLDA FPI2SN /PI/2
+ FSUB SIN1
+ JGT TAYLOR
+ JEQ SPIB2 /=PI/2
+ FLDA FPISIN /PI
+ FSUB SIN1
+ JLT S1
+ JEQ SPI /=PI
+ FLDA FPISIN
+ FSUB SIN1 /SIN(X)=SIN(PI-X)
+ FSTA X
+ JA TAYLOR
+S1, FLDA F3PIB2 /3PI/2
+ FSUB SIN1
+ JLT S2
+ JEQ S3PIB2 /=3PI/2
+ FLDA SIN1
+ FSUB FPISIN
+ FNEG
+ FSTA X /SIN(X)=-SIN(X-PI)
+ JA TAYLOR
+S2, FLDA F2PISN /2PI
+ FSUB SIN1
+ JLT DSNER /ERROR
+ JEQ SPI
+ FNEG
+ FSTA X
+/CALCULATE SIN VIA TAYLOR SERIES
+TAYLOR, FLDA X /RECALL NUMBER TO BE WORKED ON.
+ FMUL X /MULTIPLY OUT.
+ FSTA SIN1
+ FMUL SINC17 /NOW DO THE STANDARD ITERATION.
+ FADD SINC15
+ FMUL SIN1
+ FADD SINC13
+ FMUL SIN1
+ FADD SINC11
+ FMUL SIN1
+ FADD SINC9
+ FMUL SIN1
+ FADD SINC7
+ FMUL SIN1
+ FADD SINC5
+ FMUL SIN1
+ FADD SINC3
+ FMUL SIN1
+ FADD F1SIN /ADD IN 1 FOR SERIES
+ FMUL X /DO THE FINAL MULTIPLY.
+SING, JXN SINRTN,0 /SHALL WE NEGATE
+ FNEG /YEP
+ JA SINRTN /AND RETURN.
+SPIB2, FLDA F1SIN
+ JA SING
+SPI, FCLA
+ JA SINRTN
+S3PIB2, FLDA F1SIN
+ FNEG
+ JA SING
+ EXTERN #ARGER
+DSNER, TRAP4 #ARGER
+\f
--- /dev/null
+/
+/
+/ D S Q R T
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT DSQRT
+ JA #DSQRT
+ DPCHK
+ TEXT +DSQRT +
+/
+DSQXR, SETX XRDSQ
+ SETB BPDSQ
+ JA .+3
+BPDSQ, F 0.0
+XRDSQ, F 0.0
+DARSAV, F 0.0
+ F 0.0
+DSQ2, F 2.0
+ F 0.0
+SNGL, F 0.0
+ F 0.0
+ ORG 10*3+BPDSQ
+ FNOP
+ JA DSQXR
+/
+ 0
+DSQRTN, JA .
+DSQ1, F 0.0
+ F 0.0
+/PICK UP ARGUMENTS
+ BASE 0
+#DSQRT, STARTD
+ FLDA 10*3
+ FSTA DSQRTN
+ FLDA 0
+ SETX XRDSQ
+ SETB BPDSQ
+ BASE BPDSQ
+ LDX 1,1
+ FSTA BPDSQ
+ FLDA% BPDSQ,1 /ADDR OF X
+ FSTA BPDSQ
+/
+/DO GENERAL TESTS ON THE ARGUMENT
+/
+ STARTE
+ FLDA% BPDSQ
+ JEQ DSQRTN /RETURN IF 0
+ JLT DSQER /<0 ERROR
+ FSTA DARSAV /SAVE DOUBLE
+ STARTF /F MODE + ROUND
+ FSTA SNGL /SAVE
+/
+/GET INITIAL APPROXIMATION BY CALLING
+/SINGLE PRECISION ROUTINE
+/
+ EXTERN SQRT
+ JSR SQRT
+ JA .+4
+ JA SNGL
+ FSTA SNGL /FIRST APPROX
+ STARTE /BACK TO E
+/
+/TAKE N ITERATIONS OF
+/X(K+1)=1/2(X(K)+X/X(K))
+/
+ LDX -3,0 /3 TIMES
+DSIT, FLDA DARSAV /GET X
+ FDIV SNGL /X(K)
+ FADD SNGL /X(K)
+ FDIV DSQ2 /DIVIDE BY 2
+ FSTA SNGL /X(K+1)
+ JXN DSIT,0+ /ITERATE
+ FLDA SNGL /GET ANSWER
+ JA DSQRTN /RETURN
+ EXTERN #ARGER
+DSQER, TRAP4 #ARGER
+\f
--- /dev/null
+/
+/
+/ E X P
+/ - - -
+/
+/SUBROUTINE EXP(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT EXP
+ JA #EXP
+ 0
+EXPFUD, 0
+ 0
+ 0
+/
+ EXTERN #ARGER
+EXPER, TRAP4 #ARGER
+ TEXT +EXP +
+EXPXR, SETX XREXP
+ SETB BPEXP
+BPEXP, F 0.0
+XREXP, F 0.0
+EXP1, F 0.0
+EXP2, F 0.0
+EXP33, F 0.0
+EXP4, F 0.0
+F1EXP, F 1.
+F2EXP, F 2.
+ ORG 10*3+BPEXP
+ FNOP
+ JA EXPXR
+ 0
+EXPRTN, JA .
+/
+EXPAF, 4
+ 2372
+ 1402
+/
+EXPBF, 7774
+ 2157
+ 5157
+/
+EXPCF, 12
+ 5454
+ 343
+/
+EXPDF, 7
+ 2566
+ 5341
+/
+EXP2E, 1
+ 2705
+ 2435
+ BASE 0
+#EXP, STARTD
+ FLDA 10*3
+ FSTA EXPRTN
+ FLDA 0
+ SETX XREXP
+ SETB BPEXP
+ BASE BPEXP
+ LDX 1,1
+ FSTA BPEXP
+ FLDA% BPEXP,1 /ADDR OF X
+ FSTA BPEXP
+ STARTF
+ FLDA% BPEXP /GET X
+ LDX -1,0 /PRESERVE SIGN.
+ JGE .+5
+ FNEG /IF NEGATIVE NEGATE IT.
+ LDX 0,0 /AND REMEMBER IT,BUBBY.
+ FMUL EXP2E /MULTIPLY TO BINARY TYPE.
+ FSTA EXP1 /AND SAVE IT AWAY.
+ JAL EXPER /CAN T FIX IT, ERROR.
+ ALN 0 /FIX IT UP.
+ FSTA EXP33 /AND SAVE IT.
+ FNORM /NOW NORMALIZE FOR OUR COMPUTATIONS.
+ FNEG /NEGATE THE FAC
+ FADD EXP1 /ADD IN BEFORE NORMAL.
+ FSTA EXP1 /AND STORE BACK. NO FADDM
+ FMUL EXP1 /NOW SQUARE IT.
+ FSTA EXP2 /AND SAVE IT.
+ FADD EXPDF /START THE ITERATION.
+ FSTA EXP4 /SAVE IN ANOTHER TEMP.
+ FLDA EXPCF /NEXT CONSTANT.
+ FDIV EXP4 /AND DIVIDE INTO IT.
+ FSUB EXP1 /SUBTRACT BACK NOW.
+ FADD EXPAF /NEXT CONSTANT.
+ FSTA EXP4 /AND SAVE AGAIN. KEEP THIS UP.
+ FLDA EXPBF
+ FMUL EXP2
+ FADDM EXP4
+ FLDA EXP1
+ FDIV EXP4
+ FMUL F2EXP
+ FADD F1EXP
+ FSTA EXPFUD /NOW FIDDLE THE EXPONENT.
+ STARTD
+ FLDA EXP33
+ FADDM EXPFUD-1 /EXPONENT UPDATE.
+ STARTF
+ JXN EXPP,0 /NO INVERSION NECESSARY. RETURN.
+ FLDA F1EXP /INVERT IT
+ FDIV EXPFUD
+ JA EXPRTN
+EXPP, FLDA EXPFUD /AN EXIT.
+ JA EXPRTN
+\f
--- /dev/null
+/
+/
+/
+/ E X P 3
+/ - - - -
+/
+/SUBROUTINE EXP3(B,E)
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT EXP3
+ JA #EXP3
+ EXTERN #ARGER
+EXP3ER, TRAP4 #ARGER
+ TEXT +EXP3 +
+EXP3XR, SETX XREXP3
+ SETB BPEXP3
+BPEXP3, FNOP
+ 0
+ 0
+XREXP3, F 0.0
+EXP31, F 0.0
+EXP32, F 0.0
+FP1XP3, F 1.
+ ORG 10*3+BPEXP3
+ FNOP
+ JA EXP3XR
+ 0
+XP3RTN, JA .
+ BASE 0
+#EXP3, STARTD
+ FLDA 10*3
+ FSTA XP3RTN
+ FLDA 0
+ SETX XREXP3
+ SETB BPEXP3
+ BASE BPEXP3
+ LDX 1,1
+ FSTA BPEXP3
+ FLDA% BPEXP3,1 /ADDR OF B
+ FSTA EXP31
+ FLDA% BPEXP3,1+ /ADDR OF E
+ FSTA EXP32
+ STARTF
+ FLDA% EXP31 /GET B
+ JEQ XP3RTN /0 ^ X = 0
+ FSTA EXP31 /SAVE BASE
+ FLDA% EXP32 /GET E
+ JEQ EXP3ON /X ^ 0 = 1
+ FSTA EXP32 /SAVE EXPONENT
+ FLDA EXP31
+ JLT EXP3ER /ALL IS NOT WELL
+ EXTERN ALOG
+ JSR ALOG /CALL LOG
+ JA .+4 /TAKE LOG (B)
+ JA EXP31
+ FMUL EXP32 /MULT BY EXPONENT-E
+ FSTA EXP31
+ EXTERN EXP
+ JSR EXP /CALL EXP.
+ JA XP3RTN
+ JA EXP31
+EXP3ON, FLDA FP1XP3
+ JA XP3RTN
+\f
--- /dev/null
+/
+/EXPCC
+/COMPLEX RAISED TO COMPLEX
+/
+/ VERSION 5A 4-26-77 MH
+/
+/(A+I*B)^(C+I*D)
+/A+B=0 YIELDS 0
+/B+D=0 MEANS USE EXP3 TO CALCULATTE A^C
+/A+B=0,C+D=0 YIELDS 1.0
+/ENTER + EXIT IN STARTE
+ SECT #EXPCC
+ DPCHK
+ EXTERN #CAC
+ EXTERN EXP
+ EXTERN COS
+ EXTERN SIN
+ EXTERN ALOG
+ EXTERN EXP3
+ EXTERN ATAN2
+ EXTERN SQRT
+ BASE 0
+EXPCC, JA .
+ FSTA C,0
+ FLDA 0
+ FSTA A,0
+ STARTF
+ BASE .+2000
+ XTA 0
+ FSTA T1 /SAVE XR 0
+ FLDA A
+ JNE EX1 /A NOT 0
+ FLDA B
+ JNE EX1
+ STARTE /A=B=0
+ FCLA
+EX, FSTA #CAC /RESULT = 0
+ JA EXPCC
+EX1, FLDA C /C+D=0?
+ JNE EX2
+ FLDA D
+ JNE EX2
+ STARTE
+ FLDA FP1 /RESULT = 1 IF C=D=0
+ JA EX
+EX2, FLDA B
+ JNE EX3 /USE EXP3 IF B=D=0
+ FLDA D
+ JNE EX3
+ STARTF
+ JSR EXP3
+ JA .+6
+ JA A
+ JA C
+ FSTA A
+ STARTE
+ FLDA A /RETURN AS REAL PART
+ JA EX
+EX3, STARTF
+/TH=ATAN(B/A)
+ JSR ATAN2
+ JA .+6
+ JA B
+ JA A
+ FSTA TH
+/
+/LOGR=ALOG(SQRT(A*A+B*B))
+ FLDA A
+ FMUL A
+ FSTA LOGR
+ FLDA B
+ FMUL B
+ FADDM LOGR
+ JSR SQRT
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+ JSR ALOG
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+/ARG=C*TH+D*LOGR
+ FLDA C
+ FMUL TH
+ FSTA ARG
+ FLDA D
+ FMUL LOGR
+ FADDM ARG
+/
+/CALCULATE IN AND COS OF ARG. SAVE SIGN OF EACH
+ JSR SIN
+ JA .+4
+ JA ARG
+ FSTA SINE
+ JSR COS
+ JA .+4
+ JA ARG
+ FSTA CSINE
+/CALL C*LOGR-D*TH
+ FLDA D
+ FMUL TH
+ FSTA REST
+ FLDA C
+ FMUL LOGR
+ FSUB REST
+ FSTA REST
+/REAL = EXP(REST+ALOG(CSINE))
+ FLDA CSINE /REAL
+ JLT .+6
+ LDX 0,1 /=1 IF POSITIVE
+ JA .+3
+ FNEG
+ JSA DO
+ JXN .+3,0 /SKIP IF POS
+ FNEG
+ FSTA A
+ FLDA SINE /IMAG
+ JLT .+6
+ LDX 0,1
+ JA .+5
+ LDX 0,0
+ FNEG
+ JSA DO
+ JXN .+3,0
+ FNEG /RESTORE SIGN
+ FSTA B
+ FLDA T1 /RESTORE XR0
+ ATX 0
+ STARTE
+ FLDA A
+ FSTA #CAC
+ JA EXPCC
+/
+DO, JA .
+ FSTA TH
+ JSR ALOG
+ JA .+4
+ JA TH
+ FADD REST
+ FSTA ARG
+ JSR EXP
+ JA .+4
+ JA ARG
+ FSTA ARG
+ FLDA TH /CHECK SIGN
+ JGE DOX
+ FLDA ARG
+ FNEG
+ FSTA ARG
+DOX, FLDA ARG
+ JA DO
+A, F 0.0
+B, F 0.0
+C, F 0.0
+D, F 0.0
+LOGR, F 0.0
+TH, F 0.0
+ARG, F 0.0
+SINE, F 0.0
+CSINE, F 0.0
+REST, F 0.0
+FP1, F 1.0
+ F 0.0
+T1, F 0.0
+\f
--- /dev/null
+/
+/EXPCI
+/COMPLEX RAISED TO INTEGER OR REAL
+/
+/ VERSION 5A 4-26-77 MH
+/
+/
+/C=A+I*B
+/C^D=R^D*EXP(D*I*THETA)
+/
+/C IS IN #BASE
+/D IS IN AC
+/
+/ENTER IN STARTF,EXIT IN STARTE
+/
+ SECT #EXPCI
+ ENTRY #EXPCR
+ DPCHK
+ EXTERN SQRT
+ EXTERN ATAN2
+ EXTERN SIN
+ EXTERN COS
+ EXTERN EXP3
+ EXTERN #CAC
+ BASE 0
+#EXPCR, JA .
+ FSTA EXPON,0
+ FLDA 0 /REAL
+ FSTA A,0
+ FLDA 3 /IMAG
+ FSTA B,0
+/SET DUMMY BASE PAGE
+ BASE .+2000
+/
+/R=SQRT(A*A+B*B)
+ FLDA A
+ FMUL A
+ FSTA R
+ FLDA B
+ FMUL B
+ FADDM R
+ JSR SQRT
+ JA .+4
+ JA R
+ FSTA R
+/R^EXPON
+ JSR EXP3
+ JA .+6
+ JA R
+ JA EXPON
+ FSTA R
+/THETA=ATAN(B/A)
+ JSR ATAN2
+ JA .+6
+ JA B
+ JA A
+/THETA*EXPON
+ FMUL EXPON
+ FSTA A /PHASE ANGLE
+/IMAG=R*SIN(PHASE)
+ JSR SIN
+ JA .+4
+ JA A
+ FMUL R
+ FSTA B
+/REAL=R*COS(PHASE)
+ JSR COS
+ JA .+4
+ JA A
+ FMUL R
+ FSTA A
+ JGE .+3 /SKIP IF RESULT IS POS
+ FNEG /IF NOT,MAKE IT POS
+ FSUB LOWLIM /TEST FOR ZERO
+ JGE .+5 /JUMP IF NOT 0
+ FCLA /ASSUME RESULT SHOULD BE 0
+ FSTA A /AND STORE A 0
+/RETURN RESULT IN #CAC AND STARTE
+ STARTE
+ FLDA A
+ FSTA #CAC
+ JA #EXPCR
+A, F 0.0
+B, F 0.0
+EXPON, F 0.0
+R, F 0.0
+LOWLIM, F 0.000009 /NUMBERS >= 1.E-5 OK
+\f
--- /dev/null
+/
+/ VERSION 5A 4-25-77 MH
+/
+ SECT #EXPDD
+ DPCHK
+ BASE 0
+ EXTERN DEXP3
+ JA .
+ FSTA EXPON,0 /EXPONENT
+ FLDA 0 /BASE
+ FSTA BASE,0
+ JSR DEXP3 /EXP3(BASE,EXPON)
+ JA .+6
+ JA BASE
+ JA EXPON
+ JA #EXPDD
+BASE, F 0.0
+ F 0.0
+EXPON, F 0.0
+ F 0.0
+ END
+\f
--- /dev/null
+ SECT #EXPDI
+/ B**E
+/ WHERE E IS INTEGER
+/ AND B IS DOUBLE PRECISION
+/
+/ VERSION 5A 4-26-77 MH
+/
+ DPCHK
+ BASE 0
+EXPDI, JA .
+ FSTA SIGN /SAVE SIGN OF EXPONENT
+ JGE POSINT /ITS POSITIVE
+ FNEG
+POSINT, FSTA EXP
+ XTA 1 /SAVE XR 1
+ FSTA XR1
+ LDX -27,1 /BIT COUNT
+ STARTE
+ FLDA ONE /START WITH ONE
+ FSTA PROD
+ STARTF
+ FLDA EXP
+LOOP, JEQ YES /DONE IF ITS ZERO
+ FDIV TWO /DIVIDE BY TWO
+ ALN 0 /INTEGERIZE
+ FNORM
+ FSTA TEMP /SAVE AT
+ FMUL TWO /IS EXPONENT ODD ?
+ FSUB EXP
+ STARTE
+ JLT ODD /YES, JUMP
+ FLDA 0 /SQUARE BASE
+SQUARE, FMULM 0
+ STARTF
+ FLDA TEMP /EXPONENT OVER 2
+ FSTA EXP
+ JXN LOOP,1+ /LOOP IF MORE BITS
+YES, FLDA XR1 /DONE, RESTORE XR 1
+ ATX 1
+ FLDA SIGN /CHECK SIGN OF EXPONENT
+ JLT INVERT /IT WS NEGATIVE, INVERT RESULT
+ STARTE
+ FLDA PROD /RETURN ANSWER
+ JA EXPDI
+INVERT, STARTE
+ FLDA ONE /RETURN WITH 1/PROD
+ FDIV PROD
+ JA EXPDI
+ODD, FLDA 0
+ FMULM PROD
+ JA SQUARE /GO SQUARE THE BASE
+ONE, F 1.0
+ F 0.0
+TWO, F 2.0
+PROD, F 0.0
+ F 0.0
+SIGN, F 0.0
+TEMP, F 0.0
+XR1, F 0.0
+EXP, F 0.0
+ F 0.0
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT #EXPDR
+ DPCHK
+ BASE 0
+ EXTERN DEXP3
+ JA .
+ FSTA EXPON,0 /EXPONENT
+ FCLA
+ FSTA EXPON+3 /MUST BE 6 WDS
+ STARTE
+ FLDA 0 /BASE
+ FSTA BASE,0
+ JSR DEXP3 /EXP3(BASE,EXPON)
+ JA .+6
+ JA BASE
+ JA EXPON
+ JA #EXPDR
+BASE, F 0.0
+ F 0.0
+EXPON, F 0.0
+ F 0.0
+ END
+\f
--- /dev/null
+/
+/EXPIC
+/INTEGER OR REAL RAISED TO COMPLEX
+/
+/ VERSION 5A 4-26-77 MH
+/
+/(A)^(C+I*D)
+/A=0 YIELDS 0
+/D=0 MEANS USE EXP3 TO CALCULATE A^C
+/C+D=0 YIELDS 1.0
+/ENTER + EXIT IN STARTE
+ SECT #EXPIC
+ DPCHK
+ EXTERN #CAC
+ EXTERN EXP
+ EXTERN COS
+ EXTERN SIN
+ EXTERN ALOG
+ EXTERN EXP3
+ EXTERN SQRT
+ BASE 0
+EXPIC, JA .
+ FSTA C,0
+ STARTF
+ FLDA 0 /BASE
+ FSTA A,0
+ BASE .+2000
+ XTA 0
+ FSTA T1 /SAVE XR 0
+ FLDA A
+ JNE EX1 /A NOT 0
+ STARTE /A=B=0
+ FCLA
+EX, FSTA #CAC /RESULT = 0
+ JA EXPIC
+EX1, FLDA C /C+D=0?
+ JNE EX2
+ FLDA D
+ JNE EX2
+ STARTE
+ FLDA FP1 /RESULT = 1 IF C=D=0
+ JA EX
+EX2, FLDA D
+ JNE EX3 /USE EXP3 IF D=0
+ JSR EXP3
+ JA .+6
+ JA A
+ JA C
+ FSTA A
+ STARTE
+ FLDA A /RETURN AS REAL PART
+ JA EX
+/
+/LOGR=ALOG(SQRT(A*A))
+EX3, FLDA A
+ FMUL A
+ FSTA LOGR
+ JSR SQRT
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+ JSR ALOG
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+/ARG=C+D*LOGR
+ FLDA D
+ FMUL LOGR
+ FADD C
+ FSTA ARG
+/
+/CALCULATE SIN AND COS OF ARG. SAVE SIGN OF EACH
+ JSR SIN
+ JA .+4
+ JA ARG
+ FSTA SINE
+ JSR COS
+ JA .+4
+ JA ARG
+ FSTA CSINE
+/CALL C*LOGR-D
+ FLDA C
+ FMUL LOGR
+ FSUB D
+ FSTA REST
+/REAL = EXP(REST+ALOG(CSINE))
+ FLDA CSINE /REAL
+ JLT .+6
+ LDX 0,1 /=1 IF POSITIVE
+ JA .+3
+ FNEG
+ JSA DO
+ JXN .+3,0 /SKIP IF POS
+ FNEG
+ FSTA C
+ FLDA SINE /IMAG
+ JLT .+6
+ LDX 0,1
+ JA .+5
+ LDX 0,0
+ FNEG
+ JSA DO
+ JXN .+3,0
+ FNEG /RESTORE SIGN
+ FSTA D
+ FLDA T1 /RESTORE XR0
+ ATX 0
+ STARTE
+ FLDA C
+ FSTA #CAC
+ JA EXPIC
+/
+DO, JA .
+ FSTA LOGR
+ JSR ALOG
+ JA .+4
+ JA LOGR
+ FADD REST
+ FSTA ARG
+ JSR EXP
+ JA .+4
+ JA ARG
+ FSTA ARG
+ FLDA LOGR /CHECK SIGN
+ JGE DOX
+ FLDA ARG
+ FNEG
+ FSTA ARG
+DOX, FLDA ARG
+ JA DO
+A, F 0.0
+C, F 0.0
+D, F 0.0
+LOGR, F 0.0
+ARG, F 0.0
+SINE, F 0.0
+CSINE, F 0.0
+REST, F 0.0
+FP1, F 1.0
+ F 0.0
+T1, F 0.0
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT #EXPID
+ DPCHK
+ BASE 0
+ EXTERN EXPID2
+EXPID, JA .
+ FSTA EXPON,0 /EXPONENT
+ STARTF
+ FLDA 0 /BASE
+ FSTA BASE,0
+ JSR EXPID2
+ JA .+6
+ JA BASE
+ JA EXPON
+ JA EXPID
+BASE, F 0.0
+EXPON, F 0.0
+ F 0.0
+ END
+\f
--- /dev/null
+/
+/
+/
+/ E X P I D 2
+/ - - - - - -
+/
+/SUBROUTINE EXPID2(B,E)
+/WHERE B IS INTEGER AND E IS DOUBLE
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT EXPID2
+ JA #EXID2
+ EXTERN #ARGER
+EXP3ER, TRAP4 #ARGER
+ TEXT +EXPID2+
+EXP3XR, SETX XREXP3
+ SETB BPEXP3
+BPEXP3, FNOP
+ 0
+ 0
+XREXP3, F 0.0
+EXP31, F 0.0
+ F 0.0
+EXP32, F 0.0
+FP1XP3, F 1.
+ F 0.0
+ ORG 10*3+BPEXP3
+ FNOP
+ JA EXP3XR
+ 0
+XP3RTN, JA .
+ BASE 0
+#EXID2, STARTD
+ FLDA 10*3
+ FSTA XP3RTN
+ FLDA 0
+ SETX XREXP3
+ SETB BPEXP3
+ BASE BPEXP3
+ LDX 1,1
+ FSTA BPEXP3
+ FLDA% BPEXP3,1 /ADDR OF B
+ FSTA EXP31
+ FLDA% BPEXP3,1+ /ADDR OF E
+ FSTA EXP32
+ STARTF
+ FLDA% EXP31 /GET B
+ JEQ XP3RTN /0 ^ X = 0
+ JLT EXP3ER
+ FSTA EXP31 /SAVE BASE
+ FCLA
+ FSTA EXP31+3
+ STARTE
+ LDX 73,1
+ EXTERN DLOG
+ JSR DLOG /CALL LOG
+ JA .+4 /TAKE LOG (B)
+ JA EXP31
+ FSTA EXP31
+ FLDA% EXP32 /GET EXPONENT
+ JEQ EXP3ON /X^0=1
+ FMULM EXP31
+ EXTERN DEXP
+ JSR DEXP /CALL EXP.
+ JA XP3RTN
+ JA EXP31
+EXP3ON, STARTE
+ FLDA FP1XP3
+ JA XP3RTN
+\f
--- /dev/null
+ SECT #EXPII
+/ B**E
+/ WHERE E IS INTEGER
+/ AND B IS REAL OR INTEGER
+/
+/ VERSION 5A 4/26/77 MH
+/
+ BASE 0
+ JA .
+ FSTA SIGN /SAVE SIGN OF EXPONENT
+ JGE POSINT /ITS POSITIVE
+ FNEG
+POSINT, FSTA 3 /PUT IT INTO 3
+ XTA 1 /SAVE XR 1
+ FSTA XR1
+ LDX -27,1 /BIT COUNT
+ FLDA ONE /START WITH ONE
+ FSTA PROD
+ FLDA 3 /GET EXPONENT
+LOOP, JEQ YES /DONE IF ITS ZERO
+ FDIV TWO /DIVIDE BY TWO
+ ALN 0 /INTEGERIZE
+ FNORM
+ FSTA TEMP /SAVE AT
+ FMUL TWO /IS EXPONENT ODD ?
+ FSUB 3
+ JLT ODD /YES, JUMP
+ FLDA 0 /SQUARE BASE
+SQUARE, FMULM 0
+ FLDA TEMP /EXPONENT OVER 2
+ FSTA 3
+ JXN LOOP,1+ /LOOP IF MORE BITS
+YES, FLDA XR1 /DONE, RESTORE XR 1
+ ATX 1
+ FLDA SIGN /CHECK SIGN OF EXPONENT
+ JLT INVERT /IT WS NEGATIVE, INVERT RESULT
+ FLDA PROD /RETURN ANSWER
+ JA #EXPII
+INVERT, FLDA ONE /RETURN 1/PROD
+ FDIV PROD
+ JA #EXPII
+ODD, FLDA 0 /MULT PROD BY BASE
+ FMULM PROD
+ JA SQUARE /GO SQUARE THE BASE
+ONE, F 1.0
+TWO, F 2.0
+PROD, F 0.0
+SIGN, F 0.0
+TEMP, F 0.0
+XR1, F 0.0
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT #EXPIR
+ BASE 0
+ EXTERN EXP3
+ JA .
+ FSTA EXPON,0 /EXPONENT
+ FLDA 0 /BASE
+ FSTA BASE,0
+ JSR EXP3 /EXP3(BASE,EXPON)
+ JA .+6
+ JA BASE
+ JA EXPON
+ JA #EXPIR
+BASE, F 0.0
+EXPON, F 0.0
+ END
+\f
--- /dev/null
+/4 OS/8 FORTRAN (PASS ONE)
+/
+/ VERSION 4A PT 16-MAY-77
+/
+/ OS/8 FORTRAN COMPILER - PASS 1
+/
+/ BY: HANK MAURER
+/ UPDATED BY: R.LARY + M. HURLEY
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+VERSON=4
+\f/CHANGES FOR MAINTENANCE RELEASE (S.R.):
+
+/1. BUMPED VERSION NUMBER TO 304
+/2. INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX
+/3. INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF)
+/4. FIXED PROBLEM IN DATA STATEMENT
+/5. STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL
+/ VARS TO INTEGER IN ARITHMETIC IF STATEMENT
+/6. FIXED BUG RE /A AND .RA EXTENSION
+
+/LAST MINUTE CHANGES:
+
+/7. ALLOWED PARITY INPUT
+/8. IGNORE NULLS ON INPUT
+/9. FIXED BUG RE IGNORING LAST LINE IF IN ERROR
+/ OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT
+/10. ALLOW MULTIPLE INPUT FILES
+/
+/
+/CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
+/ .PATCH LEVEL NOW CONTAINED IN LOCATION 1130
+\f *7
+LINENO, 1 /2.01/ LINE NUMBER
+X10, 0 /AUTO INDEX REGISTERS
+X11, 0
+X12, 0
+NEXT, FREE-1 /FREE SPACE POINTER
+STACK, STACKS-1 /STACK POINTER
+CHRPTR, 0 /INPUT BUFFER POINTER
+X16, 0
+X17, 0
+STKLVL, STACKS-1 /STACK BASE LEVEL
+BUCKET, 0 /FIRST CHAR OF NAME
+WORD1, 0 /SIX WORD LITERAL BUFFER
+WORD2, 0
+WORD3, 0
+WORD4, 0
+WORD5, 0
+WORD6, 0
+ACO, 0 /FLOATING AC OVERFLOW WORD
+OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER"
+OP2, 0
+OP3, 0
+OP4, 0
+OP5, 0
+OP6, 0
+OPO, 0
+CHAR, 0 /ICHAR PUTS CHARACTER HERE
+NOCODE, 0 /IS 1 IF CODE GENERATION OFF
+NCHARS, 0 /SIZE OF INPUT LINE
+NUMELM, 0 /NUMBER OF VARS IN TYPED LIST
+TEMP, 0
+TEMP2, 0
+DECPT, 0 /SET 1 IF NUMBER CONTAINED .
+ESWIT, 0 /1 FOR E 0 FOR D
+NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF .
+HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE
+SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER
+IFSWIT, 0 /=1 IF INSIDE LOGICAL IF
+EXPON, 0 /HOLDS EXPONENT FOR CONVERSION
+TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE
+ 0;0;0;0 /PASS2 OUTPUT FILE
+DOEND, 0 /SET 1 IF THIS STMT WAS A IF,
+ /GOTO, RETURN, PAUSE, OR STOP
+THSNUM, 0 /CURRENT STATEMENT NUMBER
+DIMNUM, 0 /LINEARIZED SS FOR EQ
+DPRDCT, 0 /HOLDS DIMENSION PRODUCT
+EQTEMP, 0 /TEMP FOR EQUIVALENCE
+MQ, 0 /MQ FOR 12 BIT MULTIPLY
+MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP
+MNUM, 0 /LINEARIZED SS FOR MASTER
+NSLAVE, 0 /NUMBER OF SLAVES IN GROUP
+PASS2O, 0 /START OF PASS 2 OVERLAY SECTION
+OUFILE, 0 /START OF PASS1 OUTPUT FILE
+DSERES, 0 /MAGIC NUMBER
+PROGNM, MAIN /POINTER TO PROG NAME
+ARGLST, 0 /POINTER TO ARG LIST
+FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE
+SETBIT, 0 /TEMPS FOR DECLARATION SCANNER
+BADBIT, 0
+DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS
+TLTEMP, 0 /TEMP FOR TYPE ROUTINE
+OWTEMP, 0 /TEMP FOR OUTWRD
+CNT72, -102 /72 COLUMN COUNTER
+DPUSED, 0 /=1 IF DOUBLE HARDWARE USED
+VERS, VERSON /VERSION NUMBER
+M211, -211
+P211, 211
+P240, 240
+IXLNP5, LINE+5 /**
+IXLINE, LINE
+IXLINM, LINE-1
+STMJMP, 0 /FOR DEFINE FILE
+\f/ OPCODES AND EQUS
+ MAXHOL=100 /MAXIMUM HOLLERITH LITERAL
+ COMREG=4600 /INTER-PASS COMMUNICATION REGION
+ STACKS=4700 /STACK AREA
+ NAME1=6200 /NAME AND HOLLERITH BUFFER (WAS 6400)**
+ LINE=6300 /LINE BUFFER (WAS 6500)**
+ INBUF=6600 /INPUT BUFFER (FIELD 1)
+ OUBUF=7200 /OUTPUT BUFFER (DITTO)
+ INDEVH=7200 /INPUT DEVICE HANDLER (WAS 7400)**
+ PAUSOP=22
+ DPUSH=PAUSOP+1
+ BINRD1=DPUSH+1 /OPCODE DEFINITIONS
+ FMTRD1=BINRD1+1
+ RCLOSE=FMTRD1+1
+ DARD1=RCLOSE+1
+ BINWR1=DARD1+1
+ FMTWR1=BINWR1+1
+ WCLOSE=FMTWR1+1
+ DAWR1=WCLOSE+1
+ DEFFIL=DAWR1+1
+ ASFDEF=DEFFIL+1
+ ARGSOP=ASFDEF+1
+ EOLCOD=ARGSOP+1
+ ERRCOD=EOLCOD+1
+ RETOPR=ERRCOD+1
+ REWOPR=RETOPR+1
+ STOROP=REWOPR+1
+ ENDOPR=STOROP+1
+ DEFLBL=ENDOPR+1
+ DOFINI=DEFLBL+1
+ ARTHIF=DOFINI+1
+ LIFBGN=ARTHIF+1
+ DOBEGN=LIFBGN+1
+ ENDFOP=DOBEGN+1
+ STOPOP=ENDFOP+1
+ ASNOPR=STOPOP+1
+ BAKOPR=ASNOPR+1
+ FMTOPR=BAKOPR+1
+ GO2OPR=FMTOPR+1
+ CGO2OP=GO2OPR+1
+ AGO2OP=CGO2OP+1
+ IOLMNT=AGO2OP+1
+ DATELM=IOLMNT+1
+ DREPTC=DATELM+1
+ DATAST=DREPTC+1
+ ENDELM=DATAST+1
+ PRGSTK=ENDELM+1
+ DOSTOR=PRGSTK+1
+/ ASSEMBLE STATEMENT
+ PAGE
+RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS**
+ JMS I [ICHAR /GET CHAR FROM INPUT FILE
+ JMP ENDLIN /END LINE OR CR
+ TAD M211 /CHECK FOR TAB**
+ SNA
+ TAD (240-211 /CONVERT TO BLANK
+ TAD P211 /**
+ DCA I CHRPTR /SAVE CHAR
+ ISZ CNT72 /PAST COLUMN 72 ?
+ SKP
+ JMP SKPLIN /SKIP 73 TO 80
+ TAD CHRPTR
+ CIA CLL
+ TAD (LINE+670
+ SZL CLA /TEST FOR TOO MANY CONTINUATIONS
+ JMP RDLOOP
+ JMS I [ERMSG /LINE TOO LONG
+ 1424
+SKPCOM, TAD X16 /RESTORE CHRPTR
+ DCA CHRPTR
+SKPLIN, CIF 10 /**
+ JMS I [ICHAR /SKIP REST OF LINE
+ JMP ENDLIN
+ CLA
+ JMP SKPLIN
+ENDLIN, TAD CHRPTR /SAVE CHAR POSITION
+ DCA X16
+ TAD CHRPTR
+ DCA X10 /SAVE POSITION FOR COMMENT CHECK
+ TAD (-102 /SET COLUMN COUNT
+ DCA CNT72
+ TAD M6
+ DCA NCHARS
+GET6, CIF 10 /**
+ JMS I [ICHAR /GET FIRST 6 CHARS
+ JMP SHORTL /IGNORE SHORT LINES
+ TAD M211 /IS CHAR A TAB ? **
+ SZA CLA
+ JMP NOTAB /NO
+ TAD P240 /TREAT FIRST TAB AS SIX BLANKS
+ DCA I CHRPTR
+ ISZ NCHARS
+ JMP .-3
+ TAD P240 /FAKE CONTINUATION CHECK
+ DCA CHAR
+ JMP CCHECK /GO TO COMMENT CHECK
+SHORTL, TAD X16 /RESET CHAR POINTER
+ DCA CHRPTR /TO IGNORE SHORT LINES
+ JMP ENDLIN
+NOTAB, TAD CHAR
+ DCA I CHRPTR
+ ISZ NCHARS
+ JMP GET6 /LOOP
+CCHECK, TAD I X10 /IS IT A COMMENT ?
+ TAD (-303
+ SNA CLA
+ JMP SKPCOM /COMMENT, SKIP REST
+NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ?
+ TAD MMM240
+ SNA CLA
+ JMP GOTLIN /YES, NO MORE CONTINUATIONS
+CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS
+ DCA CHRPTR
+ JMP RDLOOP /CONTINUE WITH THIS LINE
+GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1
+ CIA
+ TAD (LINE+4
+ DCA NCHARS
+ TAD [LINE-1 /RESET CHAR POINTER
+ DCA CHRPTR
+ JMS I [CKCTLC /CHECK FOR CONTROL C
+LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER
+ CLL CML RAR /SET LABEL DEFINE BIT
+ JMS I [STMNUM /GO LOOK FOR LABEL
+ JMP COMPIL /NONE THERE
+ TAD SNUM /SAVE STATEMENT NUMBER
+ DCA THSNUM
+ TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL
+ JMS I [OUTWRD
+ TAD SNUM
+ JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS
+COMPIL, JMS I [SAVECP
+ ISZ LINENO /2.01/ PUT LINE NUMBER
+ TAD LINENO /2.01/ INTO MQ
+ 7421 /2.01/
+ CLA IAC
+ DCA NOCODE /SET NOCODE SWITCH
+ JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE
+ 1513
+ JMS I [LEXPR /IS IT ARITHMETIC ?
+ JMP NOTAR /NO
+ JMS I [GETC /LOOK FOR =
+ JMP NOTAR /NOT ARITHMETIC
+ TAD MMM275 /=
+ SNA CLA
+ JMS I [EXPR /SCAN LEFT PART
+ JMP NOTAR
+ JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR
+ 1720
+ ISZ NCHARS /SHOULD BE NOTHING LEFT
+ JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC
+ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE
+ DCA NOCODE /ALLON CODE
+ JMS I [LEXPR /GET LEFT SIDE
+M6, -6 /V3C MUST BE HERE
+ JMS I [GETC /SKIP =
+MMM240, -240 /SHOULD NEVER GET HERE
+ CLA
+ JMS I [EXPR /GET RIGHT SIDE
+MMM275, -275 /SHOULD NEVER GET HERE
+ TAD (STOROP /OUTPUT STORE
+ JMS I [OUTWRD
+ JMP I [NEXTST /DO NEXT LINE
+NOTAR, JMS I [RESTCP /RESTART LINE
+ DCA NOCODE
+ JMS I [SAVECP /RESAVE CHAR POSITION
+ TAD (CMDLST-1
+ DCA X10
+ JMP I (CMDLUP /GO SEARCH FOR KEYWORD
+\f/ KEYWORD SEARCH
+ PAGE
+CMDLUP, CDF 10 /TABLE IN FIELD ONE
+ TAD I X10 /GET NEXT 2 CHARS OF KEYWORD
+ SZA
+ JMP CMDLP2 /NOT DONE YET
+ CLL CMA RAL /REMOVE CHAR POS FROM STACK
+ TAD STACK
+ DCA STACK
+ TAD I X10 /GET ROUTINE ADDRESS
+ CDF
+ DCA STMJMP
+ JMP I STMJMP /JUMP TO THE ROUTINE
+CMDLP2, DCA TEMP /SAVE THE TWO CHARS
+ CDF
+ JMS I [GET2C /GET TWO CHARS FROM THE INPUT
+ JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE
+ TAD TEMP /COMPARE
+ SNA CLA
+ JMP CMDLUP /MATCHES, KEEP GOING
+ JMS I [RESTCP /RESTORE CHAR POS
+ ISZ STACK
+ ISZ STACK /AND SAVE IT AGAIN
+ CDF 10
+ TAD I X10 /FIND END OF THIS COMMAND
+ SZA CLA
+ JMP .-2
+ ISZ X10 /SKIP ROUTINE ADDRESS
+ TAD I X10 /IS THE LIST EXHAUSTED ?
+ SZA
+ JMP CMDLP2 /NO, GO AGAIN
+BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT
+ERCODE, 0
+\f/ END OF STMT PROC
+NEXTLN,
+NEXTST,
+DOENDR, TAD STKLVL /RESET STACK POINTER
+ DCA STACK
+ JMS I [POP /LOOK FOR DO END
+ CIA
+ TAD THSNUM /DOES THIS LINE END A DO LOOP ?
+ SZA CLA
+ JMP NODOND /NO, REPLACE STACK AND COMPILE STMT
+ TAD (DOFINI
+ JMS I [OUTWRD /OUTPUT DO END COMMAND
+ JMS I [POP /GET INDEX VARIABLE
+ JMS I [OUTWRD
+ TAD STACK /RESET STACK BASE LEVEL
+ DCA STKLVL
+ TAD DOEND /WAS THIS A LEGAL ENDING STMT ?
+ SZA CLA
+ JMS I [ERMSG
+ 0504 /DO END ERROR
+ DCA DOEND /KILL SWITCH
+ JMP DOENDR
+NODOND, ISZ STACK /REPLACE STACK ENTRY
+ DCA DOEND /KILL SWITCH
+ TAD (EOLCOD /OUTPUT EOL CODE
+ JMS I [OUTWRD
+ DCA ERCODE /RESET ERROR CODE
+ DCA IFSWIT /KILL IF SWITCH
+ TAD (-6 /MOVE FIRST 6 CHARS
+ DCA NCHARS
+ TAD [LINE-1 /INTO START OF BUFFER
+ DCA CHRPTR
+ TAD I X16
+ DCA I CHRPTR
+ ISZ NCHARS
+ JMP .-3
+ JMP I (RDLOOP
+\f/ GOTO'S
+GOTO, ISZ DOEND /DO END ILLEGAL
+ JMS I [STMNUM /IS IT A SIMPLE GOTO ?
+ JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE
+ TAD (GO2OPR /OUTPUT GOTO OPERATOR
+ JMS I [OUTWRD
+ TAD SNUM /FOLLOWED BY STMT NUMBER
+ JMS I [OUTWRD
+ JMP I [NEXTST
+CMPGO2, JMS I [GETC /LOOK FOR (
+ JMP BADGO2 /BAD GOTO
+ TAD (-250
+ SZA CLA
+ JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO
+ TAD STACK /SAVE STACK POSITION
+ DCA X12
+ DCA TEMP /ZERO BRANCH COUNTER
+GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER
+ JMP BADGO2 /MUST BE THERE
+ TAD SNUM
+ JMS I [PUSH /SAVE IT TEMPORARILY
+ ISZ TEMP /BUMP BRANCH COUNT
+ JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN
+ JMP BADGO2 /NEITHER
+ JMP GO2LUP /COMMA, GO GET NEXT LABEL
+ JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA)
+ JMP BADGO2
+ CLA
+ TAD TEMP /SAVE COUNT
+ JMS I [PUSH /ON STACK
+ JMS I [EXPR /COMPILE INDEX EXPR
+ JMP I [NEXTST
+ TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR
+ JMS I [OUTWRD
+ JMS I [POP /GET COUNT
+ CIA
+ DCA TEMP /SAVE COMPLEMENT
+ TAD TEMP
+ CIA
+ JMS I [OUTWRD /OUTPUT COUNT
+ TAD X12 /RESTORE STACK POINTER
+ DCA STACK
+ TAD I X12 /MOVE STMT NUMBERS TO OUTPUT
+ JMS I [OUTWRD
+ ISZ TEMP
+ JMP .-3
+ JMP I [NEXTST
+ASNGO2, JMS I [BACK1 /PUT BACK NON (
+ JMS I [LEXPR /GET ASSIGN VAR
+ JMP BADGO2
+ TAD (AGO2OP /OUTPUT GOTO OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+BADGO2, JMS I [ERMSG
+ 0724
+ JMP I [NEXTST
+\f/ I/O STATEMENTS
+ PAGE
+RDWR, 0 /SUBR FOR IO STATEMENTS
+ JMS I [CHECKC /LOOK FOR (
+M250, -250
+ JMP BADRD
+ JMS I [EXPR /COMPILE UNIT
+ JMP I [BADCMD
+ JMS I [COMARP
+ JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O)
+ JMP RDFMT /,
+ TAD (BINRD1 /FORMATLESS READ/WRITE
+IOSTRT, TAD I RDWR /ADD ADJUSTOR
+ JMS I [OUTWRD /OUTPUT BINARY READ
+IOLIST, JMS I [PUSH /MARK STACK
+ JMS I [GETC /IS IT AN IMPLIED DO ?
+ JMP ENDIOL /NO, END OF LIST
+ TAD M250
+ SZA CLA
+ JMP TRYIOE /NO, LOOK FOR IO ELEMENT
+ JMS I [SAVECP /SAVE CHAR POS AT START OF IDO
+ DCA IDOPAR /ZERO PAREN COUNTER
+FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE
+XPURGE, PRGSTK /DON'T WORRY ITS A NOP
+ JMS I [GETC /GET A CHAR
+ JMP ENDIOL
+ TAD M251 /IS IT A ) ?
+ SNA
+ JMP RPIOL /YES
+ IAC /IS IT ( ?
+ SNA
+ JMP LPIOL /YES
+ TAD (250-275 /IS IT = ?
+ SZA CLA
+ JMP FINDND /NONE OF THESE
+ TAD IDOPAR /IS PAREN COUNT 0 ?
+ SZA CLA
+ JMP FINDND /NO, ITS FROM AN INNER LOOP
+ JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX
+ DCA DOINDX
+ JMS I (DOSTUF /COMPILE THE LOOP
+ JMP BADIOL /ERROR IN DO PARMS
+ JMS I [CHECKC /MUST HAVE )
+ -251
+ JMP BADIOL
+ TAD CHRPTR /SAVE CHAR POSITION
+ DCA TEMP
+ TAD NCHARS
+ DCA TEMP2
+ JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP
+ TAD TEMP2 /NOW SAVE POS AFTER LOOP
+ JMS I [PUSH
+ TAD TEMP
+ JMS I [PUSH
+ TAD DOINDX /AND DO INDEX
+ JMP IOLIST
+LPIOL, ISZ IDOPAR /( INCREASES COUNT
+ JMP FINDND
+RPIOL, CMA /) DECREASES COUNT
+ TAD IDOPAR
+ SMA
+ JMP FINDND-1
+ CLA
+BADIOL,
+BADRD, JMS I [ERMSG /BAD IO STMT
+ 2227
+ JMP I [NEXTST
+TRYIOE, JMS I [BACK1 /PUT BACK NON (
+ JMS I [LEXPR /GET IOLIST ELEMENT
+ JMP BADRD /NOT THERE, ERROR
+ JMS I [GETC /LOOK FOR A COMMA
+ JMP .+4 /EOL
+ TAD (-254
+ SZA
+ JMP NOTIOL /NOT AN ELEMENT
+ TAD (IOLMNT /OUTPUT OPCODE
+ JMS I [OUTWRD
+ JMP IOLIST+1
+NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO)
+ SZA CLA
+ JMP BADIOL /NO, BAD
+ JMS I [POP /GET STUFF FROM THE STACK
+ SNA
+ JMP BADIOL /ZERO IS BAD
+ DCA DOINDX /THIS IS THE INDEX
+ JMS I [RESTCP /GET THE CHAR POSITION
+ TAD XPURGE /OUTPUT PURGE OPERATOR
+ JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK
+ TAD (DOFINI /END LOOP
+ JMS I [OUTWRD
+ TAD DOINDX
+ JMS I [OUTWRD
+ JMS I [GETC /END OF LIST ?
+ JMP ENDIOL
+ TAD (-254
+ SZA CLA
+ JMP BADIOL /MUST BE A COMMA
+ JMP IOLIST+1
+IDOPAR, 0
+ENDIOL, JMS I [POP /IS THE MARK THERE ?
+ SZA CLA
+ JMP BADRD /NO, ERROR
+ TAD I RDWR
+ TAD (RCLOSE /END OF IO OPERATION
+ JMS I [OUTWRD
+ JMP I [NEXTST
+RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER
+ JMP RTFMT
+ JMS I [OUTWRD /OUTPUT PUSH COMMAND
+ TAD SNUM /OUTPUT STMT NUMBER OF FORMAT
+ JMS I [OUTWRD
+RDLIST, TAD (FMTRD1 /START OF FORMATTED READ
+ TAD I RDWR /ADD ADJUSTOR
+ JMS I [OUTWRD
+ JMS I [CHECKC /LOOK FOR )
+M251, -251
+ JMP BADRD
+ JMP IOLIST /GO GET IO LIST
+RTFMT, JMS I [LEXPR /GET R.T. FORMAT
+ JMP BADRD
+ JMP RDLIST /GET LIST
+\f/DIRECT ACCESS I/O
+ PAGE
+DAQUOT, JMS I [BACK1
+ JMS I [CHECKC /LOOK FOR '
+ -247
+ JMP BADRD /SYNTAX IS NO GOOD
+ JMS I [EXPR /GET RECORD NUMBER EXPR
+ JMP BADRD
+ JMS I [CHECKC /LOOK FOR )
+ -251
+ JMP BADRD
+ TAD (DARD1 /DIRECT ACCESS OPEN
+ JMP IOSTRT
+FIND, JMP I [NEXTST /COOL ISN'T IT ?
+DFINFL, JMS I [EXPR /COMPILE UNIT
+ JMP BADDEF /BAD DEFINE STMT
+ DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT
+ JMS I [CHECKC /(
+ -250
+ JMP BADDEF
+ JMS I [EXPR /NUMBER OF RECORDS
+ JMP BADDEF
+ JMS I [CHECKC /,
+ -254
+ JMP BADDEF
+ JMS I [EXPR /RECORD SIZE
+ JMP BADDEF
+ JMS I [CHECKC /,
+ -254
+ JMP BADDEF
+ JMS I [CHECKC /U
+ -325
+ JMP BADDEF
+ JMS I [CHECKC /,
+MCOMA, -254
+ JMP BADDEF
+ JMS I [GETNAM /GET INDEX VARIABLE
+ JMP BADDEF
+ JMS I [OUTWRD
+ JMS I [LOOKUP
+ JMS I [OUTWRD /OUTPUT INDEX VAR
+ TAD (DEFFIL /OUTPUT DEFINE OPERATOR
+ JMS I [OUTWRD
+ JMS I [CHECKC /)
+ -251
+ JMP BADDEF
+ JMS I [GETC /ANOTHER DEFINE ?
+ JMP I [NEXTST
+ TAD MCOMA /, ?
+ SNA CLA
+ JMP DFINFL /YES, ANOTHER FILE
+BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT
+ 0406
+ JMP I [NEXTST
+RESTCP, 0 /RESTORE CHAR POSITION FROM STACK
+ JMS I [POP
+ DCA CHRPTR
+ JMS I [POP
+ DCA NCHARS
+ JMP I RESTCP
+INTEGE, JMS I [CHECKC /INTEGER STMT
+ -322
+ JMP I [BADCMD
+ JMS I [TYPLST
+ 0101
+ 0100
+ NOP
+ JMP I [NEXTST
+PAUZE, JMS I [CHECKC /LOOK FOR E
+ -305
+ JMP I [BADCMD
+ JMS I [GETC /ANY EXPR ?
+ JMP NOARGP /MAKE IT PAUSE 1
+ JMS I [BACK1 /PUT IT BACK
+ JMS I [EXPR /GET PAUSE NUMBER
+XPAUZ, PAUSOP
+OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+NOARGP, JMS I [OUTWRD /PUSH 1.0
+ TAD [ONE
+ JMS I [OUTWRD
+ JMP OPAUZ /GO PUT OPERATOR
+READ, JMS I (RDWR /COMPILE READ STMT
+ 0
+WRITE, JMS I [CHECKC /LOOK FOR E
+ -305
+ JMP I [BADCMD
+ JMS I (RDWR /COMPILE WRITE
+ BINWR1-BINRD1
+CKCTLC, 6401 /CHECK FOR CONTROL C
+ TAD (7600
+ KRS
+ TAD (-7603 /^C
+ SNA CLA
+ KSF
+ JMP I CKCTLC
+ JMP I (7600
+
+XOCTAL, DCA WORD1 /**
+ DCA WORD2
+ DCA WORD3 /STATEMENT NUM LEFT THERE**
+ DCA WORD5
+ DCA WORD6
+XCTAL1, DCA WORD4
+ JMS I [DIGIT /GET NEXT DIGIT
+ JMP ENDOXT /NO DIGITS LEFT
+ AND [7 /THROW AWAY SOME BITS
+ DCA TEMP
+ JMS I (AL1 /MOVE WORD LEFT THREE
+ JMS I (AL1
+ JMS I (AL1
+ TAD WORD4 /ADD DIGIT TO WORD4
+ TAD TEMP
+ JMP XCTAL1 /LOOP
+ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE
+ DCA WORD1
+ TAD WORD3
+ DCA WORD2
+ TAD WORD4
+ DCA WORD3
+ JMP DATAFP /GO STUFF IT AWAY
+\f/ DIMENSION, COMMON, REAL
+ PAGE
+DIMENS, JMS I [IFCHEK
+ JMS I [CHECKC /CHECK FOR "N"
+ -316
+ JMP I [BADCMD /NO GOOD
+ JMS I [TYPLST /PROCESS LIST
+ 0000 /DIMENSION IS THE SIMPLEST CASE
+ 0000
+ NOP /ERROR RETURN
+ JMP I [NEXTST
+REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF
+ JMS I [TYPLST /PROCESS LIST
+ 0102 /TYPE-REAL
+ 0100
+ NOP
+ JMP I [NEXTST
+COMPLE, JMS I [CHECKC /CHECK FOR "X"
+ -330
+ JMP I [BADCMD
+ JMS I [IFCHEK
+ JMS I [TYPLST /PROCESS COMPLEX LIST
+ 0103
+ 0100
+ NOP
+ CLA IAC /SET DP SWITCH
+ DCA DPUSED
+ JMP I [NEXTST
+COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF
+ JMS I [GETC /CHECK FOR SLASH
+ JMP I [BADCMD
+ TAD M257
+ SZA CLA
+ JMP BLANKC /MUST BE BLANK COMMON
+ JMS I [GETNAM /GET NAME OF COMMON
+ JMP DBLSLS /MIGHT BE //
+ JMS I [CHECKC /LOOK FOR /
+M257, -257
+ JMP BADCOM
+ JMS I [LOOKUP /LOOKUP COMMON NAME
+ IAC
+ DCA COMNAM /SAVE ADDR OF TYPE WORD
+ CDF 10
+ TAD I COMNAM /LOOK AT TYPE
+ SZA
+ TAD (-111 /MUST BE COMMON OR UNDEF.
+ SZA CLA
+ JMP BADCOM
+ TAD (111 /SET CORRECT BITS
+ DCA I COMNAM
+ CDF
+DOCOMN, JMS I [TYPLST /HANDLE LIST
+ 4000
+ 5460
+ JMP I [NEXTST
+ TAD X12
+ DCA STACK /RESET STACK
+ CDF 10
+ ISZ COMNAM /POINTER TO COMMON INFO
+ DCA I NEXT /ZERO NEXT PTR WORD
+ TAD I COMNAM /LOOK FOR END OF LIST
+ SNA
+ JMP EOCL /THIS IS IT
+ DCA COMNAM /PROCEED DOWN LIST
+ JMP .-4
+EOCL, TAD NEXT /HOOK IN NEXT PART
+ DCA I COMNAM
+ TAD NUMELM
+ DCA I NEXT /NUMBER IN THIS PART
+ TAD NUMELM
+ CIA
+ DCA NUMELM
+ CDF
+ TAD I X12 /MOVE VARIABLE PTRS
+ CDF 10
+ DCA I NEXT
+ ISZ NUMELM
+ JMP .-5
+ CDF
+ JMS I [GETC /ANOTHER BLOCK ?
+ JMP I [NEXTST /NO
+ JMP COMMON+3 /MAYBE
+DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH
+ -257
+ JMP BADCOM
+ SKP
+BLANKC, JMS I [BACK1 /PUT BACK NON SLASH
+ TAD (BLNKCN /USE BLANK COMMON
+ DCA COMNAM
+ JMP DOCOMN
+BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT
+ 0317
+ JMP I [NEXTST
+COMNAM, 0
+\f/ EXTERNAL, FORMAT, BACKSPACE
+EXTERN, JMS I [TYPLST /PROCESS LIST
+ 1000
+ 6660
+ NOP
+ JMP I [NEXTST
+FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR
+ JMS I [OUTWRD
+ TAD NCHARS /GET NUMBER OF WORDS
+ CIA
+ CLL RAR /NWORDS=(NCHARS+1)/2
+FMTLUP, JMS I [OUTWRD /OUTPUT IT
+ JMS I [GETCWB /GET THE CHARS
+ JMP I [NEXTST /NO MORE
+ AND [77
+ CLL RTL /SHIFT LEFT 6
+ RTL
+ RTL
+ DCA TEMP
+ JMS I [GETCWB /GET OTHER HALF
+ NOP /IGNORE END OF LINE
+ AND [77
+ TAD TEMP /PUT THEM TOGETHER
+ JMP FMTLUP /LOOP
+ /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS ()
+ / IS PASSED TO THE CODE
+BACKSP, JMS I [CHECKC /CHECK FOR "E"
+ -305
+ JMP I [BADCMD
+ JMS I [EXPR /COMPILE UNIT EXPR
+ JMP I [BADCMD
+ TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+\f/ OUTPUT ROUTINE
+ PAGE
+OUPTR, OUBUF
+OCOUNT, -401
+OUTWRD, 0 /OUTPUT ROUTINE
+ DCA OWTEMP /SAVE WORD
+ TAD NOCODE
+ SZA CLA
+ JMP I OUTWRD /COOL IT IF NOCODE
+ ISZ OCOUNT /TEST FOR BUFFER FULL
+ JMP NOWRIT /STILL SOME ROOM
+ JMS OUDUMP /DUMP THE BUFFER
+ TAD OUBLOK-1 /RESET BUFFER PARAMETERS
+ DCA OUPTR
+ TAD (-400
+ DCA OCOUNT
+NOWRIT, TAD OWTEMP /PUT WORD
+ CDF 10
+ DCA I OUPTR /INTO BUFFER
+ CDF
+ ISZ OUPTR /MOVE POINTER
+ JMP I OUTWRD
+OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE
+OUDUMP, 0 /DUMP OUT BUFFER
+ TAD OULEN /ANY ROOM LEFT ?
+ SNA
+ JMP OUERR
+ IAC
+ DCA OULEN
+ JMS I (7607 /CALL SYSTEM HANDLER
+ 4210
+ OUBUF
+OUBLOK, 0
+ JMP OUERR
+ ISZ OUBLOK /INCREMENT BLOCK NUMBER
+ ISZ FILSIZ /ALSO SIZE OF FILE
+ JMP I OUDUMP
+OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE
+ 317
+ 306
+\f/ END PASS ONE
+XEND, JMS I [CHECKC /LOOK FOR "D"
+ -304
+ JMP I [BADCMD
+ JMS I [GETC /END MUST BE ALL
+ JMP ENDX
+L7700, SMA CLA /NEVER SKIPS
+ JMP I [BADCMD
+ENDX, CDF 0
+ TAD (ENDOPR /OUTPUT END OF FILE
+ JMS I [OUTWRD
+ JMS OUDUMP /DUMP BUFFER
+ CIF 10
+ JMS I L7700 /LOCK MONITOR IN
+ 10
+ CIF 10
+ CLA IAC
+ JMS I L200 /CLOSE TEMP FILE
+ 4
+ TMPFIL
+FILSIZ, 0
+ JMP OUERR
+ CIF 10
+ CLA IAC
+ JMS I L200 /OPEN PASS 2 OUTPUT FILE
+L3, 3
+OBLK, TMPFIL+4 /STARTING BLOCK
+ 0 /SIZE
+ JMP OUERR /ERROR
+ TAD (COMREG-1 /SAVE IMPORTANT STUFF
+ DCA X10
+ TAD NEXT /ADDR OF FREE SPACE
+ DCA I X10
+ TAD STKLVL /STACK LEVEL
+ DCA I X10
+ TAD OUFILE /START OF PASS1 OUTPUT FILE
+ DCA I X10
+ TAD FILSIZ /ALSO THE SIZE
+ DCA I X10
+ TAD PASS2O /START OF PASS2 OVERLAY
+ DCA I X10
+ TAD OBLK /START OF PASS2 OUTPUT FILE
+ DCA I X10
+ TAD OBLK+1 /AND MAX SIZE
+ DCA I X10
+ TAD PROGNM /POINTER TO PROG NAME
+ DCA I X10
+ TAD ARGLST /AND ARG LIST
+ DCA I X10
+ TAD FUNCTN /AND PROG SWITCH
+ DCA I X10
+ TAD DPUSED /STORE THE DP SWITCH
+ DCA I X10
+ TAD VERS /AND THE VERSION NUMBER
+ DCA I X10
+ CIF 10
+ JMS I L200 /CHAIN TO PASS TWO
+ 6
+PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1
+RETURN, TAD (RETOPR /OUTPUT RETURN CODE
+ JMS I [OUTWRD
+ ISZ DOEND /DO END ILLEGAL HERE
+ JMP I [NEXTST
+COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN
+ JMS I [GETC
+ JMP I COMARP
+ TAD [-254 /COMMA ?
+ SNA
+ JMP .+5
+ TAD L3 /RIGHT PAREN ?
+ SZA CLA
+ JMP I COMARP
+ ISZ COMARP
+ ISZ COMARP /COMMA INCR ONCE
+ JMP I COMARP
+LOGICA, JMS I [CHECKC /LOOK FOR L
+ -314
+ JMP I [BADCMD /NO GOOD
+ JMS I [TYPLST /PROCESS LIST
+ 0105
+ 0100
+L200, 0200 /NOP
+ JMP I [NEXTST
+\f/ EQUIVALENCE (UGH!)
+ PAGE
+EQUIV, JMS I [IFCHEK /BAD WITH IF
+ JMS I [CHECKC /LOOK FOR "E"
+ -305
+ JMP I [BADCMD
+EQVLUP, JMS I [CHECKC /LOOK FOR (
+ -250
+ JMP BADEQU
+ TAD STACK /SAVE STACK POS
+ DCA X17
+ DCA NSLAVE /NUMBER OF SLAVES = 0
+ JMS I [GETSS /GET THE MASTER
+ JMP BADEQU
+SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED
+ TAD I TEMP2 /1.03/
+ CDF /1.03/
+ AND (200 /1.03/ (AS A SLAVE)
+ SZA CLA /1.03/
+ JMP DOFUNY /3.01/BACK UP TO ITS MASTER
+ TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS
+ DCA MASTER
+ DCA SFUDGE /3.01/CLEAR OFFSET FUDGE
+ TAD DIMNUM /SAVE THE MASTER SUBSCRIPT
+ DCA MNUM
+GETSLV, JMS I [COMARP /LOOK FOR , OR )
+ JMP BADEQU
+ JMP DOSLAV /,
+ TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES
+ SNA
+ JMP ENDGRP /NO SLAVES
+ CIA
+ DCA NSLAVE
+ TAD X17 /RESTACK THE STORE
+ DCA STACK
+EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER
+ DCA TEMP
+ TAD I X17 /AND NEXT TYPE WORD ADDRESS
+ DCA TEMP2
+ CDF 10
+ TAD I TEMP2 /LOOK AT TYPE WORD
+ TAD (200 /SET EQUIVALENCE BIT
+ DCA I TEMP2
+ ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR
+ TAD I TEMP2 /PROPAGATE DIMENSION POINTER
+ DCA I NEXT /TO EQUIVALENCE INFO BLOCK
+ TAD NEXT /NOW STORE EQ INFO BLK ADDRESS
+ DCA I TEMP2 /INTO EQ-DIM POINTER WORD
+ CLA CMA
+ TAD MASTER /STORE S.T. ADDR OF MASTER
+ DCA I NEXT /INTO THE EQUIVALENCE BLOCK
+ TAD MNUM /OUTPUT NUMBERS
+ DCA I NEXT
+ TAD TEMP
+ DCA I NEXT
+ CDF
+ ISZ NSLAVE /ANY MORE SLAVES ?
+ JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED
+ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED
+ JMP I [NEXTST /EQUIVALENCED
+ TAD (-254 /IS NEXT CHAR A COMMA ?
+ SNA CLA
+ JMP EQVLUP /IF YES, DO NEXT GROUP
+BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE
+ 2123
+ JMP I [NEXTST
+EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR
+ 2114 /MORE THAN ONE COMMON VARIABLE
+ JMP I [NEXTST
+DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE
+ JMS I [GETSS /GET THE GOODS
+ JMP BADEQU
+ CDF 10
+ TAD I TEMP2 /LOOK AT THE TYPE
+ SMA CLA
+ JMP SVSLAV /IT ISN'T IN COMMON
+ TAD I MASTER /LOOK AT THE MASTERS TYPE
+ SPA CLA
+ JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD
+ CDF
+ TAD MNUM /SAVE THE MAGIC NUMBER
+ JMS I [PUSH
+ TAD MASTER
+ JMS I [PUSH /AND THE S.T. ADDRESS
+ JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER
+SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ?
+ AND (200 /1.03/
+ SZA CLA /1.03/
+ JMP EQUCOM /1.03/ YES, ERROR
+ TAD DIMNUM /SAVE THE NEW SLAVE
+ TAD SFUDGE /3.01/ADD OFFSET FUDGE
+ CDF
+ JMS I [PUSH
+ TAD TEMP2
+ JMS I [PUSH
+ JMP GETSLV /AND GO GET THE NEXT SLAVE
+
+SFUDGE, 0
+\f/ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING
+/THIS WHOLE PAGE IS 3.01
+
+DOFUNY, CLA IAC
+ TAD TEMP2
+ DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK
+ CDF 10
+ TAD I MASTER
+ DCA X12
+ CLA IAC
+ TAD I X12 /GET ADDRESS OF "REAL" MASTER'S
+ DCA MASTER /TYPE WORD
+ TAD I X12
+ TAD DIMNUM
+ DCA MNUM /OFFSETS ARE ADDITIVE
+ TAD I X12
+ DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD
+ CDF /TO SLAVES
+ JMP GETSLV / (PRAY)
+ PAGE
+\f/ EQUIVALENCE (UGH!)
+O1420, 1420 /1.03/ MUST BE FIRST ON PAGE
+GETSS, 0 /GET THE LINEARIZED SUBSCRIPT
+ DCA DIMNUM
+ JMS I [GETNAM /GET THE VARIABLE
+ JMP I GETSS
+ JMS I [LOOKUP
+ IAC /ADDRESS OF TYPE WORD
+ DCA TEMP2
+ CDF 10
+ TAD I TEMP2
+ CDF
+O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ?
+ SZA CLA
+ JMP I GETSS
+ TAD STACK
+ DCA X12 /SAVE STACK POSITION
+ DCA TEMP /ZERO NUMBER OF DIMENSIONS
+ TAD TEMP2
+ IAC
+ DCA EQTEMP /ADDRESS OF EQ-DIM POINTER
+ JMS I [GETC
+ JMP I GETSS
+ TAD (-250 /LOOK FOR (
+ SNA CLA
+ JMP DIMGET-1 /OK
+ JMS I [BACK1
+ JMP RGETSS
+ DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777
+DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT
+ CLA CMA
+ TAD EXPON /SS-1
+ JMS I [PUSH /SAVE SS
+ ISZ TEMP /BUMP COUNT OF SS
+ JMS I [COMARP /LOOK FOR , OR )
+ JMP I GETSS
+ JMP DIMGET /,
+ CLA IAC /)
+ DCA DPRDCT /SET DIMENSION PRODUCT TO 1
+ TAD X12 /RESTORE STACK POSITION
+ DCA STACK
+ TAD TEMP /COMPLEMENT NUMBER OF SS
+ CIA
+ DCA TEMP
+ CDF 10
+ CLL CML RTR /2000
+ AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ?
+ SNA CLA
+ JMP I GETSS /NO, THATS BAD
+ TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK
+ DCA EQTEMP
+ TAD I EQTEMP /IS NUMBER OF DIMENSIONS
+ TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ?
+ SZA CLA
+ JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT
+ CLA CLL IAC /+1 V3C
+ TAD I EQTEMP /+ NUMBER OF DIMENSIONS
+ TAD EQTEMP /+ ADDRESS OF COUNT WORD
+ DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION
+LINEAR, CDF
+ TAD I X12 /GET NEXT SS - 1
+ DCA MQ
+ TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT
+ JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,...
+ TAD DIMNUM /ACCUMULATE THE SUM
+ DCA DIMNUM
+ CDF 10
+ TAD I EQTEMP /ADDR OF LITERAL
+ IAC
+ DCA X11 /WORKING POINTER TO VALUE
+ TAD I X11 /GET DIMENSION INTO FAC
+ DCA WORD1
+ TAD I X11
+ DCA WORD2
+ TAD I X11
+ DCA WORD3
+ CDF
+ JMS I [FIXNUM /GO FIX IT
+ DCA MQ
+ TAD DPRDCT /OF THE D.P. SERIES (ABOVE)
+ JMS MUL12
+ DCA DPRDCT
+ CLA IAC /V3C BUMP POSITION POINTER
+ TAD EQTEMP
+ DCA EQTEMP
+ ISZ TEMP /ANY MORE SS ?
+ JMP LINEAR /YES
+RGETSS, ISZ GETSS
+ JMP I GETSS
+TRY1SS, CLA IAC /1.03/
+ TAD TEMP /1.03/ ONLY ONE SS ?
+ SZA CLA /1.03/
+ JMP I GETSS /1.03/ MORE, THATS NO GOOD
+ CDF /1.03/
+ TAD I X12 /1.03/ GET THE SUBSCRIPT
+ DCA DIMNUM /1.03/ AND RETURN IT
+ JMP RGETSS /1.03/
+MUL12, 0 /12 BIT UNSIGNED MULTIPLY
+ DCA OP2 /SAVE OPERAND
+ TAD (-15 /SET SHIFT COUNT
+ DCA SC
+ JMP STMUL
+M12LUP, TAD AC
+ SNL
+ JMP .+3
+ CLL
+ TAD OP2
+ RAR
+STMUL, DCA AC
+ TAD MQ
+ RAR
+ DCA MQ
+ ISZ SC
+ JMP M12LUP
+ TAD MQ /RETURN VALUE
+ JMP I MUL12
+ AC=OP3
+ SC=OP4
+\f/ IF STATEMENTS
+ PAGE
+IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION
+ JMP I [BADCMD
+ JMS I [STMNUM /IS IT ARITHMETIC IF ?
+ JMP LOGIF
+ TAD (ARTHIF /START IF COMMAND
+ JMS I [OUTWRD
+ CLL CMA RTL
+ DCA TEMP
+ ISZ DOEND /DO END ILLEGAL HERE
+ JMP IFLABL /GET IF LABELS
+IFLOOP, JMS I [CHECKC /LOOK FOR ,
+ -254
+ JMP I [NEXTST
+ JMS I [STMNUM /GET NEXT STMT NUMBER
+ JMP BADIF
+IFLABL, TAD SNUM /OUTPUT LABEL
+ JMS I [OUTWRD
+ ISZ TEMP
+ JMP IFLOOP
+ JMP I [NEXTST
+LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL
+ ISZ IFSWIT /CLEAR IF SWITCH
+ TAD (LIFBGN /START LOGICAL IF
+ JMS I [OUTWRD
+ JMP I (COMPIL /COMPILE THE STATEMENT
+DOSWT,
+IFCHEK, 0 /CHECK IF SWITCH
+ TAD IFSWIT
+ SNA CLA
+ JMP I IFCHEK
+BADIF, JMS I [ERMSG
+ 1111
+ JMP I [NEXTST
+\f/ CALL STMT
+CALL, JMS I [SAVECP /SAVE CHAR POS
+ JMS I [GETNAM /GET SUBROUTINE NAME
+ JMP BADCAL /NO NAME HERE IS BAD
+ JMS I [LOOKUP /GET ADDRESS OF TYPE WORD
+ IAC
+ DCA TEMP
+ CDF 10
+ TAD I TEMP /LOOK AT TYPE
+ AND (6640 /ANYTHING BUT EXT OR ARG ?
+ SZA CLA
+ JMP BADCAL /YES, BAD
+ TAD I TEMP /SET EXT BIT
+ AND (137 /LEAVE TYPE AND ARG BITS
+ TAD (1000
+ DCA I TEMP
+ CDF
+ JMS I [RESTCP /RESTORE CHAR POS
+ CLA IAC /SIGNAL THAT THIS IS A CALL
+ JMS I [LEXPR /COMPILE IT
+XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP
+ TAD OWTEMP /WHAT WAS THE LAST THING OUT ?
+ CLL
+ TAD (-63 /IF LESS THAN 63
+ SNL CLA
+ JMP I [NEXTST /IT WAS AN ARG COUNT
+ TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL
+ JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT
+ JMS I [OUTWRD
+ JMP I [NEXTST
+BADCAL, JMS I [ERMSG
+ 2316
+ JMP I [NEXTST
+\f/ DO DAH, DO DAH
+DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL
+ JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER
+ JMP I [BADCMD
+ JMS I [GETNAM /LOOKUP INDEX VARIABLE
+ JMP I [BADCMD
+ JMS I [LOOKUP
+ DCA DOINDX
+ JMS I [CHECKC /LOOK FOR =
+ -275
+ JMP I [BADCMD
+ ISZ DOEND /CAN'T END DO LOOP ON A DO
+ JMS DOSTUF /GET DO PARAMETERS
+ JMP BADDO
+ TAD DOINDX /PUSH DO INDEX
+ JMS I [PUSH
+ TAD SNUM /PUSH ENDING STMT NUMBER
+ JMS I [PUSH
+ TAD STACK
+ DCA STKLVL /SAVE NEW STACK BASE
+ JMP I [NEXTST
+
+DOSTUF, 0 /SUBR FOR DO LOOP STUFF
+ JMS I [OUTWRD /OUTPUT DO INDEX
+ TAD DOINDX
+ JMS I [OUTWRD
+ JMS I [EXPR /GET EXPR FOR INITIAL VALUE
+ JMP I DOSTUF
+ TAD XSTORE /YES
+ JMS I [OUTWRD
+ JMS I [CHECKC /LOOK FOR COMMA
+N254, -254
+ JMP I DOSTUF
+ JMS I [EXPR /GET EXPR FOR FINAL VALUE
+ JMP I DOSTUF
+ JMS I [GETC /LOOK FOR A COMMA
+ JMP STEP1 /USE STEP OF 1
+ TAD N254
+ SZA CLA
+ JMP STEP1-1
+ JMS I [EXPR /GET EXPR FOR STEP
+ JMP I DOSTUF
+DORET, ISZ DOSTUF
+ TAD (DOBEGN /DO BEGIN OPERATOR
+ JMS I [OUTWRD
+ JMP I DOSTUF
+ JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.)
+STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0
+ TAD (ONE
+ JMS I [OUTWRD
+ JMP DORET /FINISH DO STUFF
+BADDO, JMS I [ERMSG /BAD DO COMMAND
+ 0417
+ JMP I [NEXTST
+BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA
+ 0223
+ JMP I [NEXTST
+\f/ TYPE STATEMENT SUBROUTINE
+ PAGE
+TYPLST, 0 /HANDLE LIST FOR TYPE DELL
+ TAD STACK
+ DCA X12 /SAVE STACK POINTER
+ DCA NUMELM
+ TAD I TYPLST /GET SET BITS
+ DCA SETBIT
+ ISZ TYPLST
+ TAD I TYPLST /AND ILLEGAL BITS
+ DCA BADBIT
+ ISZ TYPLST
+LSTLUP, JMS I [GETNAM /GET VARIABLE
+ JMP BADLST
+ JMS I [LOOKUP /S.T. SEARCH
+ DCA TLTEMP /SAVE VAR ADDRESS
+ TAD TLTEMP /PUT IT ON THE STACK
+ ISZ TLTEMP /NOW POINT TO TYPE WORD
+ JMS I [PUSH /INCREMENT NUMBER
+ ISZ NUMELM /INCREMENT NUMBER
+ CDF 10
+ TAD I TLTEMP /COMPARE TYPES
+ AND BADBIT /CHECK FOR ILLEGAL BITS
+ SZA CLA
+ JMP TYPAGN /ATTEMPT TO RE-TYPE
+ TAD SETBIT /GET SET BITS
+ CMA /GENERATE MASK
+ AND I TLTEMP
+ TAD SETBIT /DO THE SET
+ DCA I TLTEMP /BUT NOT DIMENSION BIT
+ CDF
+GETDIM, JMS I [GETC
+ JMP EOL
+ TAD (-250 /LOOK FOR (
+ SZA
+ JMP NOTDIM /NOT DIMENSIONED
+ CLA IAC /INITIALIZE MAGIC NUMBER
+ DCA DSERES
+ CLA IAC
+ DCA DPRDCT /AND DIMENSION PRODUCT
+ TAD STACK
+ DCA X17 /SAVE STACK POINTER
+ DCA TEMP2 /DIMENSION COUNT=0
+ JMP I (DIMLUP /GET DIMENSIONS
+PUTDIM, TAD X17
+ DCA STACK /RESTORE STACK
+ CDF 10
+ TAD (3400 /DIM, EXT, SF ?
+ AND I TLTEMP
+ SZA CLA
+ JMP DIMAGN /ATTEMPT TP RE-DIMENSION
+ CLL CML RTR
+ TAD I TLTEMP /SET DIMENSION BIT
+ DCA I TLTEMP
+ ISZ TLTEMP
+ TAD TEMP2 /NUMBER OF DIMS.
+ DCA I NEXT
+ TAD I TLTEMP /GET EQUIVALENCE POINTER
+ SZA
+ DCA TLTEMP
+ TAD NEXT /STORE POINTER TO
+ DCA I TLTEMP /DIMENSION INFORMATION
+ TAD DPRDCT /SAVE DIM PRODUCT
+ DCA I NEXT
+ TAD DSERES /AND MAGIC NUMBER
+ DCA I NEXT
+ DCA I NEXT /ZERO MAGIC LITERAL POINTER
+ TAD TEMP2
+ CIA
+ DCA TEMP2 /LEAVE LAST DIM
+ CDF
+MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION
+ CDF 10 /1.03/
+ DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK
+ CDF /1.03/
+ ISZ TEMP2 /1.03/
+ JMP MOVDIM /1.03/
+NEXTEL, JMS I [GETC /LOOK FOR ,
+ JMP TLRETN
+ TAD (-254
+ SNA CLA
+ JMP LSTLUP /OK, GET NEXT MEMBER
+ENDLST, JMS I [BACK1
+ ISZ TYPLST
+ JMP I TYPLST
+BADDIM, JMS I [ERMSG /DIMENSION ERROR
+ 0204
+ JMP I TYPLST
+BADLST, JMS I [ERMSG /ERROR IN LIST
+ 2404
+ JMP I TYPLST
+TYPAGN, JMS I [ERMSG
+ 2224 /RE-TYPE
+ JMP GETDIM
+DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION
+ 2204
+ JMP NEXTEL
+NOTDIM, TAD (250-254 /IS IT A COMMA?
+ SZA CLA
+ JMP ENDLST
+ JMP LSTLUP /GET NEXT ELEMENT
+EOL,
+TLRETN, ISZ TYPLST
+ JMP I TYPLST /TAKE OK EXIT
+ENDFIL, JMS I [CHECKC /LOOK FOR "E"
+ -305
+ JMP I [BADCMD
+ JMS I [EXPR /COMPILE UNIT
+ JMP I [BADCMD
+ TAD (ENDFOP /OUTPUT ENDFILE OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+DOUBLE, JMS I [CHECKC /LOOK FOR N
+ -316
+ JMP I [BADCMD
+
+ JMS I [IFCHEK /NOT ON AN IF
+ JMS I [TYPLST /PROCESS LIST
+ 0104
+ 0100
+ NOP
+ CLA IAC /SET THE DP SWITCH
+ DCA DPUSED
+ JMP I [NEXTST
+\f/ SYMBOL TABLE LOOKERUPPER
+ PAGE
+LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY
+ TAD NOCODE /IS THIS IN NOCODE MODE ?
+ SZA CLA
+ JMP I LOOKUP /YES, DO NOTHING
+ TAD BUCKET
+ TAD (ALIST-1 /GET START OF CORRECT BUCKET
+ CDF 10
+LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY
+ TAD I OLDN3 /GET ADDR OF NEXT ENTRY
+ SNA
+ JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY
+ TAD (2 /SKIP OVER TYPE AND DIM POINTER
+ DCA X10
+ TAD (NAME1
+ DCA PNAME /SETUP POINTER TO NAME
+ CDF
+CHKNAM, TAD I PNAME /GET WORD NAME
+ CIA CLL
+ CDF 10
+ TAD I X10 /COMPARE WITH THIS ENTRY
+ SZA CLA
+ JMP NOTSAM /DIFFERENT
+ CDF
+ TAD I PNAME
+ AND [77 /WAS THIS THE END OF NAME?
+ ISZ PNAME
+ SZA CLA
+ JMP CHKNAM /NO, KEEP COMPARING
+ CDF 10
+RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY
+ CDF /AND RETURN IT IN THE AC
+ JMP I LOOKUP /RETURN ADDR OF SYMBOL
+NOTSAM, SZL
+ JMP HOOKIN /NEW SYMBOL <CURRENT ONE
+ TAD I OLDN3
+ JMP LOOK /CONTINUE SEARCH
+HOOKIN, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST
+ DCA I NEXT
+ TAD NEXT
+ DCA I OLDN3
+ DCA I NEXT /ZERO TYPE WORD
+ DCA I NEXT /ZERO EQUIVALENCE/DIMENSION POINTER
+ TAD (NAME1 /PREPARE TO STICK IN THE NAME
+ DCA PNAME
+ CDF
+ENTERN, TAD I PNAME /MOVE NAME INTO S.T.
+ CDF 10
+ DCA I NEXT
+ CDF
+ TAD I PNAME
+ ISZ PNAME /END OF NAME?
+ AND [77
+ SZA CLA
+ JMP ENTERN /NO, KEEP GOING
+ CDF 10
+STCHEK, TAD NEXT /CHECK FOR S.T. OVERFLOW
+ CIA CLL
+ TAD (4740 /5000 STARTS PASS2 SKELETON TABLES
+ SZL CLA
+ JMP RLOOKU
+ CDF
+ JMS I [ERMSG /S.T. FULL
+ 2324
+ JMP I (ENDX /TREAT AS END OF INPUT
+OLDN3, 0 /ADDR OF PREVIOUS ENTRY
+N3SIZE, 0 /SIZE OF ENTRY
+LTEMP,
+PNAME, /POINTER TO NAME BUFFER
+LUKUP2, 0 /LOOKUP FOR FIXED LENGTH SYMBOLS
+ TAD I LUKUP2 /GET THE BUCKET START
+ DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY
+ ISZ LUKUP2
+ TAD I LUKUP2 /GET THE ENTRY SIZE
+ ISZ LUKUP2
+ DCA N3SIZE
+ TAD LUKUP2 /SAVE RETURN ADDR
+ DCA LOOKUP
+ TAD NOCODE /IS CODE GENERATION OFF ?
+ SZA CLA
+ JMP I LOOKUP /YES, JUST RETURN
+ CDF 10
+LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY
+ SNA
+ JMP HOKIN2 /IF 0 ITS END OF LIST
+ IAC
+ DCA X10 /START OF VALUE INFO
+ TAD (WORD1-1 /SETUP POINTER TO PROTOTYPE
+ DCA X11
+ TAD N3SIZE /AND TEMP OF ENTRY SIZE
+ DCA LTEMP
+CHKVAL, CDF
+ TAD I X11
+ CIA CLL /COMPARE THIS WORD OF THE VALUE
+ CDF 10
+ TAD I X10
+ SZA CLA
+ JMP NOTSM2 /NOT THIS ONE
+ ISZ LTEMP /INCR SIZE COUNT
+ JMP CHKVAL /MORE STUFF
+ JMP RLOOKU /RETURN WITH THE GOODS
+NOTSM2, SZL
+ JMP HOKIN2 /NEW SYMBOL < CURRENT ONE
+ TAD I OLDN3 /CONTINUE SEARCH
+ DCA OLDN3
+ JMP LOOK2
+HOKIN2, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST
+ DCA I NEXT
+ TAD NEXT
+ DCA I OLDN3
+ TAD (WORD1-1 /PREPARE TO STICK IN THE VALUE
+ DCA X11
+ DCA I NEXT /ZERO TYPE WORD
+ CDF
+ENTERV, TAD I X11 /MOVE VALUE INTO S.T.
+ CDF 10
+ DCA I NEXT
+ ISZ N3SIZE /INCR SIZE COUNT
+ JMP ENTERV-1
+ JMP STCHEK /STORE TYPE AND CHECK FOR OVERFLOW
+STOP, TAD (STOPOP /OUTPUT STOP OPERATOR
+ JMS I [OUTWRD
+ ISZ DOEND /DO ILLEGAL ON STOP
+ JMP I [NEXTST
+\f/ EXPRESSION ANALYZER
+ PAGE
+EXPR, 0 /POLISHIZE EXPRESSION
+ TAD EXPR
+ JMS I [PUSH /SAVE RETURN ADDR
+ JMS I [PUSH /MARK STACK
+UNOPR, JMS I [GETC /LOOK FOR UNARY OPERATOR
+ JMP MISARG /THERE HAS TO BE AN OPERAND
+ TAD (-253 /UNARY+(NOP)
+ SNA
+ JMP UNOPR
+ TAD (253-255 /UNARY-
+ SNA
+ JMP UMINUS
+ TAD (255-256 /.NOT.
+ SZA CLA
+ JMP OPRAND
+ DCA BUCKET /FOR CKNOT
+ JMS I (TRUFAL /.TRUE. OR .FALSE. ?
+ JMP CKNOT /NEITHER, IS IT >.NOT.
+ JMP .+3 /.TRUE.
+ TAD (NOTOPR /FALSE=.NOT.TRUE
+ JMS I [PUSH
+ JMS I [OUTWRD
+ TAD (TRUE
+ JMS I [OUTWRD
+ JMP I (NOSS
+CKNOT, TAD BUCKET
+ TAD (-16
+ SZA CLA
+ JMP OPRAND /MIGHT BE LITERAL .XXXXXX
+ TAD (NOTOPR /PUSH .NOT. OPERATOR
+ JMS I [PUSH
+ JMP UNOPR
+UMINUS, TAD (UMOPR /PUSH UNARY MINUS
+ JMS I [PUSH
+ JMP UNOPR
+OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR
+ JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE
+ JMP NOTVAR /NOPE.
+ JMS I [LOOKUP /SYMBOL TABLE SEARCH
+ JMP I [OPR8R /GO OUTPUT PUSH-VAR
+NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL
+ JMP NOTNUM /NO KIND OF NUMBER
+ JMP HOLCHK /INTEGER
+ JMP DPLIT /DOUBLE PRECISION
+FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE
+ FPLIST
+ -3
+ JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS
+DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE
+ DPLIST
+ -6
+ JMP I [OPR8RL
+HOLCHK, JMS I [GETC /IS THIS HOLLERITH?
+ JMP .+5
+ TAD (-310
+ SNA CLA
+ JMP I (HFIELD /YES
+ JMS I [BACK1
+ JMS I [LUKUP2 /FIND THE ENTRY
+ INTLST
+ -3
+ JMP I [OPR8RL
+NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL
+ JMP MISARG /MISSING OPERAND
+ TAD (-250 /OPEN PAREN?
+ SZA
+ JMP QUOTE /GO LOOK FOR A STRING
+ JMS I [SAVECP /SAVE CHAR POSITION
+ JMS I [NUMBER /GET REAL PART
+ JMP I (NCMPLX /NO NUMBER
+ SKP /INTEGER-OK
+ JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX
+ JMS I [CHECKC /LOOK FOR ,
+ -254
+ JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT.
+ TAD WORD1 /SAVE REAL PART
+ DCA TEMP
+ TAD WORD2
+ DCA TEMP2
+ TAD WORD3
+ DCA CHAR
+ JMS I [NUMBER /GET IMAGINARY PART
+ JMP BADCL /NOT THERE, BAD
+ SKP /I
+ JMP BADCL /D-BAD
+ JMS I [CHECKC /LOOK FOR )
+ -251
+ JMP BADCL /NO ) BAD
+ TAD WORD1 /PUT IMAGINARY PART
+ DCA WORD4
+ TAD WORD2 /INTO SECOND AHLF
+ DCA WORD5
+ TAD WORD3 /OF COMPLEX LITERAL
+ DCA WORD6
+ TAD TEMP /NOW RESTORE REAL PART
+ DCA WORD1
+ TAD TEMP2
+ DCA WORD2
+ TAD CHAR
+ DCA WORD3
+ CLL CMA RAL /REMOVE CHAR POS FROM STACK
+ TAD STACK /SINCE OTHERWISE IT GOES OUT
+ DCA STACK /AS CODE
+ JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH
+ CMPLST /USE COMPLEX LIST
+ -6
+ JMP I [OPR8RL
+BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL
+ 0314
+ JMP I [BADEXP
+MISARG, JMS I [ERMSG /MISSING OPERAND
+ 1517
+ JMP I [BADEXP
+\f/ EXPRESSION ANALYZER
+ PAGE
+HQUOTE, 0 /SUBR FOR QUOTE STRINGS
+ JMS I [GETCWB /GET CHAR
+ JMP BADH
+ TAD [-247 /IS IT '
+ SZA
+ JMP NOTQ2 /NO
+ JMS I [GETCWB
+ JMP LUHOL
+ TAD [-247 /LOOK FOR ''
+ SNA CLA
+ JMP NOTQ2 /REPLACE '' BY '
+ JMS I [BACK1 /ITS END OF STRING
+ JMP LUHOL
+NOTQ2, TAD [247 /RESTORE CHAR
+ AND [77
+ JMP I HQUOTE
+HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER
+ SNA
+ JMP BADH /ZERO IS BAD
+ CMA CLL
+ DCA TEMP
+ TAD (HCOUNT /SET SUBR POINTER
+DOHOL, DCA HCHAR
+ TAD (-MAXHOL /SET COUNTER FOR MAX
+ DCA HOLCTR
+ TAD (NAME1 /SET UP NAME POINTER
+ DCA TEMP2
+PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING
+ JMS I HCHAR
+ CLL RTL
+ RTL
+ RTL
+ DCA I TEMP2
+ JMS I HCHAR
+ TAD I TEMP2
+ DCA I TEMP2
+ ISZ TEMP2
+ ISZ HOLCTR /CHECK FOR TOO MANY
+ JMP PAKHOL
+BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD
+ 1017
+ JMP I [BADEXP
+LUHOL, TAD (33 /LOOK UP THIS LITERAL
+ DCA BUCKET
+ JMS I [LOOKUP
+ JMP I [OPR8RL
+HCOUNT, 0
+ ISZ TEMP /CHECK COUNT
+ SKP
+ JMP LUHOL /EXPIRED
+ JMS I [GETCWB /GET CHAR
+ JMP BADH
+ AND [77 /6-BIT IZE IT
+ JMP I HCOUNT
+HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS
+NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL
+ JMS I [EXPR /MUST BE SUB EXPRESSION
+ JMP BADEXP
+ JMS I [GETC /LOOK FOR )
+ JMP PARMM
+ TAD (-251
+ SNA CLA
+ JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR
+PARMM, JMS I [ERMSG /MISSING )
+ 1515
+BADEXP, JMS I [POP /BAD EXPRESSION,
+ SZA CLA
+ JMP BADEXP /LOOK FOR STACK MARKER
+ JMS I [POP
+ DCA TEMP /RETURN ADDR.
+ JMP I TEMP
+ JMS I [BACK1 /PUT BACK TEMINAL CHAR
+ENDEXP, JMS I [POP /GET NEXT THING FROM STACK
+ SNA
+ JMP EXPDUN /IF ZERO, FINISH
+ IAC /GET ADDR OF OPERATION NUMBER
+ DCA TEMP
+ TAD I TEMP /GET OPERATOR VALUE
+ JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX
+ JMP ENDEXP /LOOP
+EXPDUN, JMS I [POP /GET RETURN ADDR
+ IAC
+ DCA TEMP
+ JMP I TEMP
+LETTER, 0 /GET A LETTER
+ JMS I [GETC
+ JMP I LETTER
+ TAD (-301
+ SPA
+ JMP NLETR
+ TAD (301-333
+ SMA
+ JMP NLETR
+ TAD (33
+ ISZ LETTER
+ JMP I LETTER
+NLETR, JMS I [BACK1
+ JMP I LETTER
+QUOTE, TAD (250-247 /IS IT '
+ SZA
+ JMP MISARG /NO, OPERAND IS MISSING
+ TAD (HQUOTE /SET SUBR POINTER
+ JMP DOHOL
+CHECKC, 0 /CHECK FOR A SINGLE CHAR
+ TAD I CHECKC /GET THE CHAR
+ DCA CCTEMP
+ ISZ CHECKC /SKIP PAST THE CHAR
+ JMS I [GETC /GET CHAR FROM INPUT
+ JMP I CHECKC /DIDN'T MAKE IT
+ TAD CCTEMP /IS THIS IT ?
+ SNA CLA
+ ISZ CHECKC /YES
+ JMP I CHECKC
+CCTEMP, 0
+\f/ EXPRESSION ANALYZER
+ PAGE
+BADFSS, JMS I [ERMSG
+ 2323
+ JMP I [BADEXP
+OPR8R, DCA TEMP
+ JMS I [OUTWRD /PUSH
+ TAD TEMP
+ JMS I [OUTWRD /OUTPUT OPERAND PTR
+ JMS I [GETC
+ JMP I [ENDEXP
+ TAD (-250 /IS IT S.S. OR FUNCTION
+ SZA
+ JMP NOTFSS
+ TAD STMJMP
+ TAD (-DFINFL
+ SNA CLA /FOR D.F.,PERMIT VARPARENS
+ JMP NOTFSS
+ ISZ TEMP /LOOK AT TYPE
+ CDF 10
+ TAD (3420 /DIM, EXT, SF, OR ARG ?
+ AND I TEMP
+ SZA CLA
+ JMP NOTFUN /NOT A FUNCTION REFERENCE
+ TAD I TEMP
+ TAD (1000 /SET EXT BIT
+ DCA I TEMP
+NOTFUN, CDF
+ SKP
+ JMS I [POP /PUT COUNT INTO AC
+SSFUN, IAC /INCREMENT ARG COUNT
+ JMS I [PUSH /SAVE IT ON THE STACK
+ JMS I [EXPR /GET ARG (OR S.S.)
+ JMP I [BADEXP
+ JMS I [COMARP /LOOK FOR , OR )
+ JMP BADFSS /NEITHER
+ JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?)
+ TAD (ARGSOP /YES, OUTPUT ARGLIST OPER
+ JMS I [OUTWRD
+ JMS I [POP /AND THE COUNT
+ JMS I [OUTWRD
+NOSS, JMS I [GETC /GET NEXT CHAR
+ JMP I [ENDEXP
+ TAD (-253 /PREPARE IT
+ JMP NOTFSS+1
+OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL
+ JMS I [OUTWRD
+ TAD TEMP
+ JMS I [OUTWRD
+ JMP NOSS
+\f/ TYPLST PART TWO
+DIMLUP, JMS I [NUMBER /GET DIMENSION
+ JMP VARDIM /MAYBE ITS VAR DIM ?
+ JMP .+3 /OK, INTEGER
+ JMP BADDIM
+ JMP BADDIM /DP AND FP ARE BAD
+ JMS I [FIXNUM /FIX IT FOR SOME STUFF
+ DCA MQ
+ TAD DPRDCT /GET NEW DIMENSION PRODUCT
+ JMS I [MUL12
+ DCA DPRDCT
+ ISZ TEMP2 /INCREMENT DIM COUNT
+ TAD WORD2 /IF WORD2 OR AC NON ZERO
+ TAD AC /DIM IS TOO BIG
+ SZA CLA /1.03/
+ JMP BADDIM /1.03/
+ JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER
+ JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST
+ INTLST /1.03/
+ -3 /1.03/
+PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK
+ JMS I [COMARP /LOOK FOR , OR )
+ JMP BADDIM
+ SKP /COMMA MEANS ANOTHER DIM FOLLOWS
+ JMP PUTDIM /) MEANS END OF DIMS
+ TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER
+ TAD DPRDCT
+ DCA DSERES
+ JMP DIMLUP /NOW LOOP FOR NEXT DIM
+VDTEMP, 0
+VARDIM, CDF 10 /IS ARRAY AN ARG ?
+ TAD I TLTEMP
+ CDF
+ AND (20
+ SNA CLA
+ JMP BADDIM /NO, BAD DIMENSION
+ JMS I [GETNAM /OK, GET DIMENSION
+ JMP BADDIM
+ JMS I [LOOKUP
+ IAC
+ DCA VDTEMP /ADDR OF TYPE WORD
+ CDF 10 /IS THA VARIABLE AN ARG ?
+ TAD I VDTEMP
+ AND (20
+ CDF
+ SNA CLA
+ JMP BADDIM /NO, THATS BAD
+ DCA DPRDCT /3.02 ZERO DIM PRODUCT
+ ISZ TEMP2 /INCREMENT DIM COUNT
+ CMA /1.03/
+ TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE
+ JMP PSHDIM /3.02 SAVE DIM ON STACK
+MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR
+ TAD I MESSAG /GET CHAR ONE
+ ISZ MESSAG
+ JMS I (TTYOUT
+ TAD I MESSAG /GET CHAR TWO
+ JMS I (TTYOUT
+ TAD (215 /CR
+ JMS I (TTYOUT
+ TAD (212 /LF
+ JMS I (TTYOUT
+ JMP I (7605 /EXIT TO MONITOR
+\f/ EXPRESSION ANALYZER REVISITED
+ PAGE
+NOTFSS, TAD (250-253 /IS IT +
+ SZA
+ JMP .+3
+ TAD (ADDOPR /YES
+ JMP GOTOPR
+ TAD (253-255 /IS IT -
+ SZA
+ JMP .+3
+ TAD (SUBOPR /YES
+ JMP GOTOPR
+ TAD (255-252 /IS IT *
+ SZA
+ JMP NOTMUL /NO
+ JMS I [GETC
+ JMP NOTEXP
+ TAD (-252 /IS IT **
+ SZA CLA
+ JMP .+3
+ TAD (EXPOPR /YES
+ JMP GOTOPR
+ JMS I [BACK1
+NOTEXP, TAD (MULOPR /IT WAS *
+ JMP GOTOPR
+NOTMUL, TAD (252-257 /IS IT /
+ SZA
+ JMP .+3
+ TAD (DIVOPR /YES
+ JMP GOTOPR
+ IAC /IS IT .
+ SZA CLA
+ JMP I (ENDEXP-1 /NO, END OF EXPR
+ JMS CKEOPR /LOOK FOR EXTENDED OPERATOR
+ JMP BADOPR /NONE THERE
+ JMS I [CHECKC /CHECK FOR CLOSING .
+ -256
+ JMP BADOPR /NOT THERE
+ CDF 10 /3.01/
+ TAD I X10 /GET OPERATOR POINTER
+ CDF
+ JMP GOTOPR
+CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR
+ JMS I [GETNAM /GET NAME
+ JMP I CKEOPR /NONE
+ TAD (OPRLST-1 /PTR TO LIST
+ DCA X10
+OPRLUP, CDF 10 /3.01/
+ TAD I X10 /COMPARE FIRST CHAR
+ CDF 0
+ SNA
+ JMP I CKEOPR /END OF LIST
+ TAD BUCKET
+ SZA CLA
+ JMP NOTHIS /NOT THIS ONE
+ CDF 10 /3.01/
+ TAD I X10
+ CDF
+ TAD I (NAME1 /COMPARE 2ND AND 3RD
+ SZA CLA
+ JMP NOTHIS+1 /NOT THIS ONE
+ ISZ CKEOPR /BUMP RETURN
+ JMP I CKEOPR
+NOTHIS, ISZ X10 /BUMP LIST PTR
+ ISZ X10 /AGAIN
+ JMP OPRLUP /KEEP GOING
+BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER.
+ 1720
+ JMP I [BADEXP
+GOTOPR, DCA NEWOP /SAVE NEWEST OPER.
+ JMS I [POP /GET STACK TOP
+ SNA
+ JMP PUSH2 /EMPTY
+ DCA OLDOP
+ TAD I OLDOP /COMPARE PREC.
+ CIA
+ TAD I NEWOP /NEW-OLD
+ SPA SNA CLA
+ JMP OUTOLD /OLD>NEW
+ TAD OLDOP
+PUSH2, JMS I [PUSH /OLD < NEW
+ TAD NEWOP /GO PUSH BOTH
+ JMS I [PUSH
+ JMP I (UNOPR /GO LOOK FOR NEXT OPERAND
+OUTOLD, ISZ OLDOP /OUTPUT OPERATOR
+ TAD I OLDOP
+ JMS I [OUTWRD
+ JMP GOTOPR+1 /TRY NEXT STACK ELEMENT
+ NEWOP=WORD1
+ OLDOP=WORD2
+\f/ UTILITIES
+GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS)
+ ISZ NCHARS
+ JMP .+4
+ CLA CMA
+ DCA NCHARS /RESET NCHARS
+ JMP I GETCWB
+ ISZ GETCWB
+ TAD I CHRPTR /GET THE CHAR
+ JMP I GETCWB
+SAVECP, 0 /SAVE CHAR POSITION
+ TAD NCHARS
+ JMS I [PUSH
+ TAD CHRPTR
+ JMS I [PUSH
+ JMP I SAVECP
+FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN)
+ TAD WORD1 /IS IT FIXED ?
+ TAD (-27
+ SNA
+ JMP RETFN /YES, EXPONENT IS 23
+ SMA CLA
+ JMP I FIXNUM /BAD IF EXP IS >23
+ JMS I (AR1 /RIGHT SHIFT ONE
+ JMP FIXNUM+1 /TEST AGAIN
+RETFN, TAD WORD3 /RETURN LOWEST 12 BITS
+ JMP I FIXNUM
+\f/ UTILITIES
+ PAGE
+GETC, 0 /GET A CHARACTER (IGNORING BLANKS)
+ ISZ NCHARS
+ JMP .+4
+ CLA CMA
+ DCA NCHARS
+ JMP I GETC
+ TAD I CHRPTR
+ TAD (-240 /IS IT A BLANK
+ SNA
+ JMP GETC+1 /YES IGNORE IT
+ TAD (240 /FIX CHAR
+ ISZ GETC
+ JMP I GETC
+ERMSG, 0 /ERROR MESSAGE HANDLER
+ CDF
+ TAD NOCODE /IS CODE GENERATION ON ?
+ SZA CLA
+ JMP NOTOUT /NO
+ TAD (ERRCOD /ERROR CODE TO OUTPUT FILE
+ JMS I [OUTWRD
+ TAD I ERMSG
+ ISZ ERMSG
+ JMS I [OUTWRD
+ JMP I ERMSG /RETURN
+NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE
+ ISZ ERMSG
+ DCA ERCODE
+ JMP I ERMSG
+POP, 0 /PUT TOP OF STACK INTO AC
+ TAD STACK
+ DCA ERMSG
+ CLA CMA
+ TAD STACK
+ DCA STACK /DECREMENT STACK POINTER
+ TAD I ERMSG
+ JMP I POP
+TRUFAL, 0 /CHECK FOR LOGICAL LITERALS
+ JMS I [GETNAM
+ JMP I TRUFAL
+ JMS I [CHECKC /LOOK FOR TERMINAL .
+ -256
+ JMP I TRUFAL
+ TAD BUCKET /LOOK AT FIRST CHAR
+ TAD (-24
+ SNA
+ JMP .+5 /ITS "T"
+ TAD (24-6
+ SZA CLA
+ JMP I TRUFAL /ITS NEITHER
+ ISZ TRUFAL /ITS "F"
+ ISZ TRUFAL
+ JMP I TRUFAL
+\f/ LEFT HALF EXPRESSION ANALYZER
+LEXPR, 0 /GET LEFT HAND EXPRESSION
+ DCA LETEMP /SAVE CALL SWITCH
+ JMS I [GETNAM /LOOK FOR VAR NAME
+ JMP MSNGOP /MUST BE THERE
+ JMS I [OUTWRD /OUTPUT A ZERO (PUSH)
+ JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR
+ DCA TEMP
+ TAD TEMP
+ JMS I [OUTWRD
+ JMS I [GETC /LOOK FOR DIMENSIONS
+ JMP LEXPOK /NO (
+ TAD (-250
+ SZA CLA
+ JMP LEXPOK-1 /NO (
+ ISZ TEMP /LOOK AT TYPE
+ CDF 10
+ CLL CML RTR /DIMENSIONED ?
+ AND I TEMP
+ TAD LETEMP /OR A CALL ?
+ TAD NOCODE /OR CODE OFF ?
+ SZA CLA
+ JMP NOTSF /YES, NOT AN ARITHMETIC S.F.
+ TAD I TEMP
+ AND (1420 /EXT, SF, OR ARG ?
+ SNA CLA /V3C
+ TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE
+ TAD LEXPR /V3C COMPARE WITH ENTRY PT
+ SZA CLA
+ JMP ASFERR /THIS IS BAD IF SO
+ TAD I TEMP
+ TAD (400
+ DCA I TEMP /SET A.S.F. BIT
+ CDF
+ TAD (ASFDEF /DEFINE ASF
+ JMS I [OUTWRD
+NOTSF, CDF
+ SKP
+ JMS I [POP /ARG COUNT TO AC
+SSLOOP, IAC /INCREMENT SS COUNT
+ JMS I [PUSH /SAVE ON THE STACK
+ JMS I [EXPR /COMPILE SUBSCRIPT
+ JMP FSSBAD+2 /ERROR WITHIN SS
+ JMS I [COMARP /LOOK FOR , OR )
+ JMP FSSBAD /NEITHER (THERE WAS A BUG HERE)
+ JMP SSLOOP-1 /, GET NEXT ARG/SS
+ TAD (ARGSOP /OUTPUT SS OPERATOR
+ JMS I [OUTWRD
+ JMS I [POP /THEN COUNT
+ JMS I [OUTWRD
+ SKP
+ JMS I [BACK1 /PUT BACK A CHARACTER
+LEXPOK, ISZ LEXPR
+ JMP I LEXPR /RETURN
+MSNGOP, JMS I [ERMSG /MISSING OPERAND
+ 1517
+ JMP I LEXPR
+FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS
+ 2323
+ JMS I [POP /GET ARG COUNT OFF STACK
+ CLA
+ JMP I LEXPR
+ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION
+ 2306
+ JMP NOTSF /DO THE REST OF THE ASF DEF
+LETEMP, 0
+\f/UTILITIES
+ PAGE
+G2CTMP,
+PUSH, 0 /PUT AC ONTO STACK
+ DCA I STACK /STORE
+ TAD (STACKS+100 /CHECK FOR STACK OVERFLOW
+ CIA CLL
+ TAD STACK
+ SNL CLA
+ JMP I PUSH /OK, RETURN
+ DCA NOCODE /SET CODE GENERATION ON
+ JMS I [ERMSG
+ 2004
+ JMP I [NEXTST
+GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD
+ JMS I [GETC /GET FIRST CHAR
+ JMP I GET2C
+ AND [77
+ CLL RTL
+ RTL
+ RTL
+ DCA G2CTMP
+ JMS I [GETC /GET SECOND CHAR
+ JMP I GET2C
+ ISZ GET2C /FIX RETURN ADDR
+ AND [77
+ TAD G2CTMP
+ JMP I GET2C
+STMNUM, 0 /PICK UP STATEMENT NUMBER
+ DCA WORD4 /SAVE DEFINED BIT (IF ANY)
+ DCA WORD2 /ZERO SOME STUFF
+ DCA WORD3
+ JMS DIGIT /GET A DIGIT
+ JMP I STMNUM /NONE THERE, NO STMT NUMBER
+ TAD (-60 /IS IT A LEADING 0 ?
+ SNA
+ JMP .-4 /YES, IGNORE IT
+ TAD (60
+ CLL RTL
+ RTL
+ RTL
+ DCA WORD1
+ JMS DIGIT /GET SECOND DIGIT
+ JMP ENDNUM /END OF NUMBER
+ TAD WORD1
+ DCA WORD1 /COMBINE FIRST AND SECOND
+ JMS DIGIT
+ JMP ENDNUM
+ CLL RTL
+ RTL
+ RTL
+ DCA WORD2
+ JMS DIGIT
+ JMP ENDNUM /COMBINE THIRD AND FOURTH
+ TAD WORD2
+ DCA WORD2
+ JMS DIGIT /GET FIFTH DIGIT
+ JMP ENDNUM
+ CLL RTL
+ RTL
+ RTL
+ DCA WORD3
+ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T.
+ SNLIST /STMT NUMBER LIST
+ -3
+ ISZ STMNUM
+ DCA SNUM /SAVE S.T. ADDRESS OF LABEL
+ CDF 10 /SET TYPE WORD
+ TAD SNUM /GET ADDR OF TYPE
+ IAC
+ DCA SNTEMP
+ TAD I SNTEMP /GET TYPE WORD
+ CLL
+ TAD WORD4 /PUT IN THE DEFINITION BIT
+ SNL
+ DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN
+ CDF
+ SNL CLA
+ JMP I STMNUM
+ JMS I [ERMSG
+ 1514
+ JMP I STMNUM
+SNTEMP,
+DIGIT, 0 /GET A DIGIT
+ JMS I [GETC /GET A CHAR
+ JMP I DIGIT
+ TAD (-272 /IS IT > 271 (9)
+ SMA
+ JMP NODIGT /YES, ITS GREATER
+ TAD (272-260 /IS IT < 260 (0)
+ SPA
+ JMP NODIGT /YES, ITS LESS
+ TAD (60
+ ISZ DIGIT
+ JMP I DIGIT /TAKE SUCCESSFUL RETURN
+NODIGT, JMS I [BACK1 /RESTORE NON DIGIT
+ JMP I DIGIT
+ASSIGN, JMS I [STMNUM /GET STMT NUMBER
+ JMP BADASN
+ JMS I [GET2C /LOOK FOR "TO"
+ JMP BADASN
+ TAD (-2417
+ SNA CLA
+ JMS I [LEXPR /GET ASSIGN VARIABLE
+ JMP BADASN
+ TAD (ASNOPR /OUTPUT ASSIGN OPERATOR
+ JMS I [OUTWRD
+ TAD SNUM /NOW STMT NUMBER
+ JMS I [OUTWRD
+ JMP I [NEXTST
+BADASN, JMS I [ERMSG
+ 0123
+ JMP I [NEXTST
+TTYOUT, 0 /TTY OUTPUT ROUTINE
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYOUT
+\f/ PRECEDENCE TABLE
+ PAGE
+ADDOPR, 100
+ 1
+SUBOPR, 100
+ 2
+MULOPR, 200
+ 3
+DIVOPR, 200
+ 4
+EXPOPR, 500
+ 5
+NOTOPR, 30
+ 6
+UMOPR, 400
+ 7
+EQOPR, 40
+ 16
+NEOPR, 40
+ 17
+GEOPR, 40
+ 10
+GTOPR, 40
+ 11
+LEOPR, 40
+ 12
+LTOPR, 40
+ 13
+ANDOPR, 20
+ 14
+OROPR, 10
+ 15
+XOROPR, 7
+ 20
+EQVOPR, 7
+ 21
+\f/ UTILITY ROUTINES
+BACK1, 0 /BACK UP ONE CHAR
+ CLA CMA
+ TAD NCHARS
+ DCA NCHARS
+ CLA CMA
+ TAD CHRPTR
+ DCA CHRPTR
+ JMP I BACK1
+OADD, 0 /ADD OPERAND TO FAC
+ CLL
+ TAD OPO
+ TAD ACO
+ DCA ACO
+ RAL
+ TAD OP6
+ TAD WORD6
+ DCA WORD6
+ RAL
+ TAD OP5
+ TAD WORD5
+ DCA WORD5
+ RAL
+ TAD OP4
+ TAD WORD4
+ DCA WORD4
+ RAL
+ TAD OP3
+ TAD WORD3
+ DCA WORD3
+ RAL
+ TAD OP2
+ TAD WORD2
+ DCA WORD2
+ JMP I OADD
+\f/ FLOATING POINT DIVIDE ROUTINE
+ PAGE
+FPDIV, 0
+ JMS I DAR1 /UNNORMALIZE AC BY ONE
+ TAD OP1 /COMPUTE FINAL EXPONENT
+ CIA
+ TAD WORD1
+ DCA OP1 /AND SAVE IT
+ TAD DM74 /SET ITERATION COUNTER
+ DCA DITCNT
+ TAD WORD2
+ RAL /INITIALIZE LINK
+FPDVLP, CLA RAR /COMPARE SIGNS
+ TAD OP2
+ SPA CLA
+ JMP .+3
+ TAD OPMAC /NEGATE OPERAND
+ JMS I DFNEG
+ JMS I DOADD /ADD OPERAND AND FAC
+ TAD D6 /RIGHT SHIFT QUOTIENT
+ RAL /PRESERVING ADD OVERFLOW BIT
+ DCA D6
+ TAD D5
+ RAL
+ DCA D5
+ TAD D4
+ RAL
+ DCA D4
+ TAD D3
+ RAL
+ DCA D3
+ TAD D2
+ RAL
+ DCA D2
+ JMS I DAL1 /LEFT SHIFT FAC ONE
+ ISZ DITCNT /TEST ITERATION COUNT
+ JMP FPDVLP
+ TAD OP1 /PUT QUOTIENT INTO FAC
+ DCA WORD1
+ TAD D2
+ DCA WORD2
+ TAD D3
+ DCA WORD3
+ TAD D4
+ DCA WORD4
+ TAD D5
+ DCA WORD5
+ TAD D6
+ DCA WORD6
+ DCA ACO
+ JMS I DNORM /NORMALIZE
+ JMP I FPDIV
+D2, 0
+D3, 0
+D4, 0
+D5, 0
+D6, 0
+DITCNT, 0
+DAR1, AR1
+DAL1, AL1
+DM74, -74
+OPMAC, OPO-ACO
+DFNEG, NEGFAC
+DOADD, OADD
+DNORM, ANORM
+ *STACKS-1
+ -1 /TO PREVENT SPURIOUS DO ENDS
+\f/ NUMERIC CONVERSION ROUTINE
+ PAGE
+NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE
+ DCA ESWIT /ZERO E/D SWITCH
+ DCA DECPT /ZERO DECIMAL POINT SWITCH
+ DCA WORD1 /ZERO FAC
+ DCA WORD2
+ DCA WORD3
+ DCA WORD4
+ DCA WORD5
+ DCA WORD6
+ DCA ACO
+ DCA SIGN /CLEAR SIGN SWITCH
+ JMS I [GETC /GET A CHAR
+ JMP I NUMBER /NO CHAR IS NO NUMBER
+ JMS CHKSGN /CHECK FOR SIGN
+SIGN, 0 /THIS SWITCH GETS SET
+ DCA NDIGIT /ZERO DIGIT COUNT
+CONVLP, JMS I [DIGIT /GET A DIGIT
+ JMP TRYDEC /IS THERE A DECIMAL POINT ?
+ AND [17
+ DCA NXTDGT /SAVE THE DIGIT
+ ISZ NDIGIT /INCR NUMBER OF DIGITS
+ TAD WORD2 /PREPARE TO MULT BY 10
+ DCA OP2
+ TAD WORD3
+ DCA OP3
+ TAD WORD4
+ DCA OP4
+ TAD WORD5
+ DCA OP5
+ TAD WORD6
+ DCA OP6
+ TAD ACO
+ DCA OPO
+ JMS I (AL1 /DOUBLE FAC
+ JMS I (AL1 /DOUBLE AGAIN
+ JMS I (OADD /TIMES FIVE
+ JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10
+ DCA OP2
+ DCA OP3 /PUT NEWEST DIGIT INTO OPERAND
+ DCA OP4
+ DCA OP5
+ DCA OP6
+ TAD NXTDGT
+ DCA OPO
+ JMS I (OADD /ADD IN NEWEST DIGIT
+ JMP CONVLP
+TRYDEC, TAD DECPT /DECIMAL ALREADY ?
+ SZA CLA
+ JMP TRYE2 /YES, LOOK FOR EXPONENT
+ JMS I [GETC /LOOK FOR .
+ JMP DIGTST /SEE IF THERE WAS ANYTHING
+ TAD (-256
+ SZA
+ JMP TRYE1 /TRY FOR E
+ JMS I [SAVECP /SAVE CHAR POS
+ JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE.
+ JMP NOLDRE /NOT LIT.RE.
+ JMS I [RESTCP
+ JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL
+DIGTST, TAD NDIGIT /ANY DIGITS ?
+ SNA CLA
+ JMP I NUMBER /NO, NO NUMBER
+ JMP INTEGR /TAKE INTEGER EXIT
+NOLDRE, ISZ DECPT /SET DECIMAL POINT SW
+ JMS I [RESTCP /RESTORE CHAR POS
+ JMP CONVLP-1 /LOOP FOR OTHER DIGITS
+TRYE1, JMS I [BACK1 /PUT BACK NON .
+ TAD NDIGIT /ANY DIGITS YET ?
+ SNA CLA
+ JMP I NUMBER /NO, NO NUMBER
+ JMS EORD /LOOK OR E OR D
+ JMP INTEGR
+TRYE2, JMS EORD /LOOK FOR E OR D
+FPNUM, ISZ NUMBER
+ ISZ NUMBER
+ DCA EXPON /ZERO EXPONENT
+ JMS I (DODEC /HANDLE DIGITS RIGHT OF .
+ JMP DOSIGN-1 /GO DO SIGN
+INTEGR, TAD (107 /PUT IN EXPONNT
+ DCA WORD1
+ JMS I (ANORM /NORMALIZE
+ ISZ NUMBER /BUMP RETURN
+DOSIGN, TAD SIGN /CHECK THE SIGN
+ SZA CLA
+ JMS I (NEGFAC /NEGATE IF NEGATIVE
+ JMP I NUMBER /RETURN
+CHKSGN, 0 /CHECK FOR SIGN
+ TAD (-255 /IS IT - ?
+ SNA
+ ISZ I CHKSGN /YES, SET SWITCH
+ SZA
+ TAD (255-253 /IS IT + ?
+ SZA CLA
+ JMS I [BACK1 /RETURN CHAR OTHERWISE
+ JMP I CHKSGN
+EORD, 0 /LOOK FOR E OR D
+ JMS I [GETC /LOOK FOR E OR D
+ JMP I EORD
+ TAD (-304
+ CLL RAR
+ SZA CLA /E OR D?
+ JMP NOEORD /NO
+ SZL
+ ISZ ESWIT /SET SWITCH IF E
+ SNL
+ ISZ DPUSED /SET D.P. SWITCH IF D
+ JMP I (GETEXP /OK, GET EXPONENT
+NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS
+ JMP I EORD
+NXTDGT, 0
+REWIND, JMS I [EXPR /COMPILE UNIT
+ JMP I [NEXTST
+ TAD (REWOPR /OUTPUT REWIND OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+\f/ NUMERIC CONVERSION ROUTINE
+ PAGE
+SMLNUM, 0 /INPUT A NUMBER <= 4095
+EXPLUP, DCA EXPON /ZERO THE EXPONENT
+ JMS I [DIGIT /GET THE NEXT DIGIT
+ JMP I SMLNUM /NUMBER DONE
+ AND [17
+ DCA OPO /SAVE THE DIGIT
+ TAD EXPON /MULT BY 10
+ CLL RAL
+ CLL RAL
+ TAD EXPON
+ CLL RAL
+ TAD OPO /ADD IN DIGIT
+ JMP EXPLUP /STORE BACK INTO EXPONENT
+GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH
+ JMS I [GETC /GET A CHAR
+ JMP I (FPNUM+1
+ JMS I (CHKSGN /IS IT A SIGN
+FPRTNE,
+ESIGN, 0 /THIS IS THE SWITCH TO SET
+ JMS SMLNUM /GO GET THE EXPONENT
+FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN
+ SNA CLA
+ JMP .+4
+ TAD EXPON /COMPLEMENT EXPONENT
+ CIA
+ DCA EXPON
+ JMS DODEC /GO HANLE EXPONENT
+ CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP)
+ TAD ESWIT /DEPENDING ON E/D SWITCH
+ TAD I [NUMBER
+ DCA I [NUMBER
+ JMP I (DOSIGN /CHECK THE SIGN
+DODEC, 0
+ TAD DO107 /NORMALIZE THE NUMBER
+ DCA WORD1
+ JMS I (ANORM
+ TAD DECPT /WAS THERE A DECIMAL POINT ?
+ SZA CLA
+ TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ?
+ CIA
+ TAD EXPON /SUBTRACT THAT NUMBER FROM EXP
+ SMA
+ JMP POSEXP /EXPONENT IS POSITIVE
+ CIA
+ DCA EXPON /ONLY NEED ABS VALUE
+ TAD (FPDIV /DO DIVIDES
+ JMP .+3
+POSEXP, DCA EXPON
+ TAD (FPMUL /DO MULTIPLIES
+ DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE
+ TAD (PETABL-1 /POWERS OF TEN TABLE
+ DCA X17
+EXPMUL, TAD EXPON /LOOK AT THE EXPONENT
+ SNA
+ JMP I DODEC /IF 0 ITS THRU
+ CLL RAR
+ DCA EXPON /PUT LOWEST BIT INTO LINK
+ SNL
+ JMP SKPEXP /THIS ONE DOESN'T COUNT
+ CDF 10 /3.01/
+ TAD I X17 /MOVE FACTOR INTO OPERAND
+ DCA OP1
+ TAD I X17
+ DCA OP2
+ TAD I X17
+ DCA OP3
+ TAD I X17
+ DCA OP4
+ TAD I X17
+ DCA OP5
+ TAD I X17
+ DCA OP6
+ DCA OPO
+ CDF
+ JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR
+ JMP EXPMUL /CHECK NEXT BIT
+SKPEXP, TAD X17 /SKIP OVER THIS FACTOR
+ TAD (6
+ JMP EXPMUL-1
+AR1, 0 /SHIFT FAC RIGHT ONE
+ TAD WORD2
+ CLL RAR
+ DCA WORD2
+ TAD WORD3
+ RAR
+ DCA WORD3
+ TAD WORD4
+ RAR
+ DCA WORD4
+ TAD WORD5
+ RAR
+ DCA WORD5
+ TAD WORD6
+ RAR
+ DCA WORD6
+ TAD ACO
+ RAR
+ DCA ACO
+ ISZ WORD1
+DO107, 107
+ JMP I AR1
+
+AL1, 0 /SHIFT FAC LEFT ONE
+ TAD ACO
+ CLL RAL
+ DCA ACO
+ TAD WORD6
+ RAL
+ DCA WORD6
+ TAD WORD5
+ RAL
+ DCA WORD5
+ TAD WORD4
+ RAL
+ DCA WORD4
+ TAD WORD3
+ RAL
+ DCA WORD3
+ TAD WORD2
+ RAL
+ DCA WORD2
+ JMP I AL1
+\f/ NUMERIC CONVERSION ROUTINE
+ PAGE
+FPMUL, 0 /FLOATING MULTIPLY ROUTINE
+ TAD WORD1 /COMPUTE NEW EXPONENT
+ TAD OP1
+ DCA OP1
+ TAD WORD2 /SAVE AC MANTISSA
+ DCA TW2
+ TAD WORD3
+ DCA TW3
+ TAD WORD4
+ DCA TW4
+ TAD WORD5
+ DCA TW5
+ TAD WORD6
+ DCA TW6
+ TAD (-74 /SET ITERATION COUNTER
+ DCA ITRCNT
+ DCA WORD2 /ZERO FAC MANTISSA
+ DCA WORD3
+ DCA WORD4
+ DCA WORD5
+ DCA WORD6
+ DCA ACO
+MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE
+ TAD TW2 /SHIFT MULTIPLIER RIGHT
+ CLL RAR
+ DCA TW2
+ TAD TW3
+ RAR
+ DCA TW3
+ TAD TW4
+ RAR
+ DCA TW4
+ TAD TW5
+ RAR
+ DCA TW5
+ TAD TW6
+ RAR
+ DCA TW6
+ SZL
+ JMS I (OADD /ADD IF LINK IS ONE
+ ISZ ITRCNT /BUMP COUNT
+ JMP MULLUP /LOOP
+ TAD OP1 /PUT IN CORRECT EXPONENT
+ DCA WORD1
+ JMS I (ANORM /NORMALIZE THE RESULT
+ JMP I FPMUL
+TW2, 0
+TW3, 0
+TW4, 0
+TW5, 0
+TW6, 0
+ANORM, 0 /NORMALIZE FAC
+ TAD WORD2 /IS MANTISSA 0 ?
+ SNA
+ TAD WORD3
+ SNA
+ TAD WORD4
+ SNA
+ TAD WORD5
+ SNA
+ TAD WORD6
+ SNA
+ TAD ACO
+ SNA CLA
+ JMP ZEXP /YES, ZERO EXPONENT
+NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000
+ TAD WORD2
+ SZA
+ JMP NO6000 /NO, SKIP THIS STUFF
+ TAD WORD3 /YES, IS THE REST 0 ?
+ SNA
+ TAD WORD4
+ SNA
+ TAD WORD5
+ SNA
+ TAD WORD6
+ SNA
+ TAD ACO
+ SZA CLA /SKIP IF 600000 ... 0000
+NO6000, SPA CLA
+ JMP I ANORM /NORM IS DONE WHEN BITS DIFFER
+ JMS I (AL1 /SHIFT LEFT ONE
+ CLA CMA /DECREMENT EXPONENT
+ TAD WORD1
+ DCA WORD1
+ JMP NORMLP /LOOP
+ZEXP, DCA WORD1
+ JMP I ANORM
+NEGFAC, 0 /NEGATE FAC
+ TAD (ACO /GET POINTER TO OPERAND
+ DCA NFPTR
+ TAD (-6 /SIX WORD NEGATE
+ DCA NFCNT
+ CLL
+NFLOOP, RAL
+ TAD I NFPTR /GET NEXT WORD
+ CLL CML CIA
+ DCA I NFPTR /RESTORE AFTER COMPLEMENTING
+ CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE
+ TAD NFPTR /AND ONCE AGAIN HERE
+ DCA NFPTR /RESTORE DECREMENTED POINTER
+ ISZ NFCNT
+ JMP NFLOOP
+ JMP I NEGFAC
+NFPTR, 0
+NFCNT, 0
+ITRCNT,
+DHLRTH, 0 /HOLLERITH IN DATA SUBR
+ ISZ TEMP
+ SKP
+ JMP I DHLRTH
+ ISZ DHLRTH
+ JMS I [GETCWB
+ JMP DHOLER
+ JMP I DHLRTH
+\f/ VARIABLE SCANNER
+ PAGE
+GETNAM, 0 /GET VARIABLE NAME
+ JMS LETTER /FIRST CHAR MUST BE ALPHABETIC
+ JMP I GETNAM /NO VARIABLE
+ DCA BUCKET /FIRST ONE IS THE BUCKET
+ TAD (NAME1
+ DCA NPTR /POINTER TO NAME BUFFER
+ CLL CMA RTL /SIX CHARS MAX (3 WORDS)
+ DCA NCNT
+PAKLUP, JMS LETTER /GET A LETTER
+ SKP
+ JMP .+3 /WE GOT IT
+ JMS I [DIGIT /NO LETTER, IS IT A DIGIT ?
+ JMP NDONE /NO, NAMES OVER
+ CLL RTL
+ RTL
+ RTL /MOVE CHAR TO A HIGHER PLACE
+ DCA I NPTR /STORE IT
+ ISZ NCNT /BUMP COUNTER
+ JMP MORNAM /MORE TO COME
+ SKP
+NDONE, DCA I NPTR /ZERO NEXT WORD
+ ISZ GETNAM /FIX RETURN ADDR
+ JMP I GETNAM
+MORNAM, JMS LETTER /GET NEXT CHAR
+ SKP
+ JMP .+3 /ITS A LETTER
+ JMS I [DIGIT
+ JMP NDONE+1 /NO GOOD, NAMES OVER
+ TAD I NPTR
+ DCA I NPTR /COMBINE TWO CHARS
+ ISZ NPTR
+ JMP PAKLUP
+NPTR, 0
+ NCNT=OADD
+\f/ DATA STATEMENT
+DATA, JMS I [IFCHEK /IF(..)DATA ????
+ TAD (DATAST /START DATA STATEMENT
+ JMS I [OUTWRD
+DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS
+ JMS I [GETSS /GET LIST ELEMENT
+ JMP DATAER
+ TAD (DPUSH /OUTPUT DPUSH OPERATOR
+ JMS I [OUTWRD
+ CMA
+ TAD TEMP2 /FOLLOWED BY POINTER
+ JMS I [OUTWRD
+ TAD DIMNUM /FOLLOWED BY NUMBER
+ JMS I [OUTWRD
+ CDF 10
+ TAD I TEMP2 /LOOK AT TYE TYPE
+ AND (20 /IS IT AN ARG ?
+ CDF
+ SZA CLA
+ JMP DATAER /YES, THATS BAD
+ JMS I [GETC /, ?
+ JMP DATAER
+ TAD (-254
+ SNA
+ JMP DATLUP /LOOK FOR MORE
+ TAD (254-257 // ?
+ SZA CLA
+ JMP DATAER
+ JMP DLOOP2 /GO LOOK FOR ELEMENT
+DATA3, TAD (WORD1-1
+ DCA X10 /POINTER TO THE GOODS
+ TAD I X10 /THEN STUFF
+ JMS I [OUTWRD
+ ISZ TEMP
+ JMP .-3
+NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT
+ JMS I [OUTWRD
+ JMS I [GETC /LOOK FOR COMMA
+ JMP DATAER
+ TAD (-254
+ SNA
+ JMP DLOOP2 /YES, GET MORE DATA
+ TAD (254-257 /SLASH ?
+ SZA CLA
+ JMP DATAER /NO, ERROR
+ JMS I [GETC /ANOTHER DATA GROUP ?
+ JMP I [NEXTST /NO
+ TAD (-254 /COMMA ?
+ SNA CLA
+ JMP DATA+1 /START A NEW DATA STMT
+DATAER, JMS I [ERMSG
+ 0401 /OK WHEN THIS IS AN AND
+ JMP I [NEXTST
+DHOLER, JMS I [ERMSG
+ 0410 /HOLLERITH DATA ERROR
+ JMP I [NEXTST
+DQUOTE, 0 /GET CHAR FOR QUOTED DATA
+ JMS I [GETCWB
+ JMP DHOLER
+ TAD [-247
+ SZA
+ JMP DNOTQ2
+ JMS I [GETCWB
+ JMP I DQUOTE
+ TAD [-247
+ SNA CLA
+ JMP DNOTQ2 /REPLACE '' BY '
+ JMS I [BACK1
+ JMP I DQUOTE
+DNOTQ2, TAD [247 /FIX CHAR
+ ISZ DQUOTE
+ JMP I DQUOTE
+OUT3WD, 0 /2.02/ OUTPUT 3 WORDS
+ TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD
+ JMS I [OUTWRD /2.02/
+ TAD (3 /2.02/ AND SIZE
+ JMS I [OUTWRD /2.02/
+ TAD WORD1 /2.02/ NOW THREE WORDS
+ JMS I [OUTWRD /2.02/
+ TAD WORD2 /2.02/
+ JMS I [OUTWRD /2.02/
+ TAD WORD3 /2.02/
+ JMS I [OUTWRD /2.02/
+ JMP I OUT3WD /2.02/
+\f/ DATA STATEMENT
+ PAGE
+DLOOP2, JMS I [GETC
+ JMP DATAER
+ TAD (-250 /IS CHAR ( ?
+ SZA
+ JMP NOCMPD /NO, NOT COMPLEX DATA
+ JMS I [NUMBER /GET REAL PART
+ JMP DATAER
+ SKP
+ JMP DATAER /DP IS NG WITH COMPLEX
+ JMS OUT3WD /2.02/ OUTPUT 3 WORDS
+ JMS I [CHECKC /LOOK FOR COMMA
+ -254
+ JMP DATAER /BAD IF NOT THERE
+ JMS I [NUMBER /GET IMAGINARY PART
+ JMP DATAER
+ SKP
+ JMP DATAER
+ JMS I [CHECKC /LOOK FOR )
+ -251
+ JMP DATAER /NOT THERE
+ JMP DATAFP /GO MOVE IMAGINARY PART
+NOCMPD, IAC /IS IT QUOTED STRING ?
+ SZA
+ JMP NQUOTD /NO
+ TAD (DQUOTE /GET SUBR ADDRESS
+ JMP HOLDAT /GO HANDLE IT
+NQUOTD, TAD (247-317 /IS IT AN O (OCTAL)
+ SNA
+ JMP I (XOCTAL /YES
+ TAD (317-256 /IS IT .
+ SNA CLA
+ JMS I (TRUFAL /CHECK FOR TRUE OR FALSE
+ JMP NOTF /NO TRUE-FALSE, TRY NUMBER
+ CLL CML RTR /2000
+ DCA WORD2
+ TAD WORD2
+ SZA CLA
+ IAC
+ DCA WORD1 /TRUE=1.0 FALSE=0.0
+ DCA WORD3
+ JMP DATAFP /GO PUT IT
+NOTF, JMS I [BACK1 /PUT BACK CHAR
+ JMS I [NUMBER /TRY FOR A NUMBER
+ JMP DATAER /ELEMENT MISSING
+ JMP TRYHOS /IF INTEGER, TRY FOR H OR *
+ TAD (-3
+DATAFP, TAD (-3 /FP DATA
+ DCA TEMP /SIZE OF ITEM
+ TAD [DATELM /DATA ELEMENT SIGNAL
+ JMS I [OUTWRD
+ TAD TEMP /THEN SIZE
+ CIA /ALWAYS POSITIVE
+ JMS I [OUTWRD
+ JMP DATA3 /GO OUTPUT THE DATA
+TRYHOS, JMS I [GETC /LOOK FOR H
+ JMP DATAER
+ TAD (-310
+ SZA
+ JMP TRYSTR /NOT H, MAYBE ITS *
+ JMS I [FIXNUM /INTEGERIZE IT
+ SNA
+ JMP DHOLER /HOLLERITH DATA ERROR
+ CMA
+ DCA TEMP /SAVE COUNT
+ TAD (DHLRTH /GET SUBR POINTER
+HOLDAT, DCA HCHAR
+ CLL CMA RTL /2.02/ COUNT
+ DCA TEMP2 /2.02/ BY THREES
+ TAD (WORD1-1 /2.02/
+ DCA X10 /2.02/ POINTER
+HDLOOP, JMS I HCHAR /GET A CHAR
+ JMP EOHD /2.02/
+ AND [77 /6 BITIZE IT
+ CLL RTL
+ RTL
+ RTL /UPPER-PART-OF-WORDIZE
+ DCA WORD3 /2.02/ STORAGIZE IT
+ JMS I HCHAR /GET ANOTHER
+ JMP LASTHD /LAST HALF WORD MUST GO OUT
+ AND [77
+ TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES
+ DCA I X10 /2.02/ STORE IT
+ ISZ TEMP2 /2.02/ THREE AT A TIME
+ JMP HDLOOP /2.02/
+ JMS OUT3WD /2.02/ OUTPUT THREE
+ JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS
+EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ?
+ TAD TEMP2 /2.02/
+ SPA CLA /2.02/
+ JMP NXTDE /2.02/ NO, DO NEXT ELEMENT
+ JMP .+4 /2.02/ YES, FILL IT OUT
+LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR
+ TAD (40 /2.02/ WITH A BLANK
+ DCA I X10 /2.02/
+ TAD (4040 /2.02/ THEN FILL REST
+ DCA I X10 /2.02/ WITH BLANKS
+ TAD (4040 /2.02/
+ DCA I X10 /2.02/
+ JMP DATAFP /2.02/ GO OUTPUT IT
+TRYSTR, TAD (310-252 /*
+ SNA CLA
+ JMP .+3
+ JMS I [BACK1 /PUT BACK THAT CHAR
+ JMP DATAFP /ITS JUST AN INTEGER
+ TAD (DREPTC /REPETITION COUNT
+ JMS I [OUTWRD
+ JMS I [FIXNUM
+ JMS I [OUTWRD /OUTPUT COUNT
+ JMP DLOOP2 /LOOP
+\f/ INITIALIZE READ IN
+ *6400
+INITLN, TAD IX7772 /READ FIRST SIX CHARS
+ DCA TEMP
+ TAD IXLINM
+ DCA CHRPTR
+INITLP, CIF 10
+ JMS I [ICHAR /READ A CHAR
+ JMP INITLN
+ TAD IXM211 /TAB ?
+ SZA CLA
+ JMP NIXTAB /NO THIS ONE
+ TAD IX0240
+ DCA I CHRPTR
+ ISZ TEMP
+ JMP .-3
+ JMP CHKCOM /DO COMMENT CHECK
+NIXTAB, TAD CHAR
+ DCA I CHRPTR /STORE THE CHAR
+ ISZ TEMP
+ JMP INITLP
+CHKCOM, TAD I IXLINE /COMMENT ?
+ TAD IXM303
+ SNA CLA
+ JMP IGNORE /IGNORE IT
+ TAD I IXLNP5 /CONTINUATION ?
+ TAD IXM240
+ SZA CLA
+ JMP IGNORE
+ TAD IX7700 /FIX CALL
+ CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE**
+ DCA I IXINCL
+ CDF /**
+ CIF 10
+ JMS I IX200 /REMOVE MONITOR
+ 11
+ CDF 10 /FIX FIELD ONE STUFF
+ TAD I MOV1
+ DCA I MOV2
+ ISZ MOV1
+ ISZ MOV2
+ ISZ MOVCNT
+ JMP .-5
+ CDF
+ JMP I IXRDFS /LOOK FOR PROG HEADER
+MOV1, 2020
+MOV2, 20
+MOVCNT, -160
+IGNORE, CIF 10 /**
+ JMS I [ICHAR /SKIP TILL CARRIAGE RETURN
+ JMP INITLN
+ CLA
+ JMP IGNORE
+IXRDFS, RDFRST
+IXINCL, INCALL
+IXM240, -240
+IXM303, -303
+IX0240, 0240
+IX200, 200
+IX7600, 7600
+IX7772, 7772
+IXM211, -211
+IX7700, 7700 /V3C
+\f/ SEARCH FOR PROGRAM HEADER
+ PAGE
+RDFRST, CIF 10 /**
+ JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE
+ JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE
+ TAD (-211
+ SNA
+ TAD (240-211
+ TAD (211
+ DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO
+ ISZ CNT72
+ SKP
+ JMP SKPFL2
+ TAD CHRPTR /PROTECT THE ASSEMBLY
+ CIA CLL /(IT GETS THE FIRST LINE
+ TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR
+/FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES**
+ SZL CLA /OR SOMETHING ELSE, IN WHICH CASE
+ JMP RDFRST /ITS THE MAIN PROGRAM)
+ JMS I [ERMSG /LINE TOO LONG
+ 1424
+ JMP SKPFL /SKIP REST
+SKPFL2, CIF 10 /**
+ JMS I [ICHAR
+ JMP ENDLNF
+ CLA
+ JMP SKPFL2
+SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR
+ DCA CHRPTR /MARIO DE NOBILI
+ENDLNF, TAD CHRPTR
+ DCA X16
+ TAD CHRPTR
+ DCA X10
+ TAD (-102
+ DCA CNT72
+ TAD (-6
+ DCA NCHARS
+GET6F, CIF 10 /**
+ JMS I [ICHAR
+ JMP SKPCMF
+ TAD (-211
+ SZA CLA
+ JMP NOTABF
+ TAD (240
+ DCA I CHRPTR
+ ISZ NCHARS
+ JMP .-3
+ TAD (240
+ DCA CHAR
+ JMP CCHEKF
+NOTABF, TAD CHAR
+ DCA I CHRPTR
+ ISZ NCHARS
+ JMP GET6F
+CCHEKF, TAD I X10
+ TAD (-303
+ SZA CLA
+ JMP NOCMTF
+SKPFL, CIF 10 /**
+ JMS I [ICHAR
+ JMP SKPCMF
+ CLA
+ JMP SKPFL
+NOCMTF, TAD CHAR
+ TAD (-240
+ SNA CLA
+ JMP GOTFST
+CCARDF, TAD X16
+ DCA CHRPTR
+ JMP RDFRST
+GOTFST, TAD CHRPTR
+ CIA
+ TAD (LINE+4
+ DCA NCHARS
+ TAD [LINE-1
+ DCA CHRPTR
+ JMS I [SAVECP
+ TAD (HDRLST-1
+ DCA X10 /PREPARE TO SEARCH THE LIST
+CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)**
+ TAD I X10 /OF LEGAL HEADER LINES
+ CDF
+ SZA /CODE IS AS UNDER 'CMDLUP'
+ JMP CLOOP2
+ CLA CMA RAL
+ TAD STACK
+ DCA STACK
+ CDF 10 /**
+ TAD I X10
+ CDF
+ DCA TEMP
+ JMP I TEMP
+CLOOP2, DCA TEMP
+ JMS I [GET2C
+ JMP BADCMF
+ CIA
+ TAD TEMP
+ SNA CLA
+ JMP CLOOP1
+SEARCH, CDF 10 /**
+ TAD I X10
+ CDF
+ SZA CLA
+ JMP SEARCH
+ ISZ X10
+ JMS I [RESTCP
+ ISZ STACK
+ ISZ STACK
+ CDF 10 /**
+ TAD I X10
+ CDF
+ SZA
+ JMP CLOOP2
+BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE
+ JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER
+BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS
+ 323 /S
+ 331 /Y
+\f/ ANALYZE PROGRAM HEADER
+ PAGE
+SUBRTN, CLA CMA /SET TO -1 FOR SUBR
+ JMP XXXFUN+1
+REAFUN, TAD (102 /SET TYPE TO REAL
+ DCA TYPE
+ JMP XXXFUN
+LOGFUN, IAC /SET TYPE OF FUN
+DBLFUN, IAC /WITH DOUBLEMINT GUM !
+CMPFUN, IAC
+ IAC
+INTFUN, TAD (101
+ DCA TYPE
+ JMS I [CHECKC /LOOK FOR 'N'
+ -316
+ JMP BADBGN
+XXXFUN, CLA IAC
+ DCA FUNCTN /SET SWITCH
+ CDF 10 /1.05/ KILL ENTRY FOR 'MAIN'
+ DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET
+ CDF /1.05/ CONTAINS ANYTHING USEFULL
+ JMS I [GETNAM /GET FUNC/SUBR NAME
+ JMP BADBGN
+ JMS I [LOOKUP /PUT INTO SYMBOL TABLE
+ DCA PROGNM
+ TAD PROGNM /SET UP TYPE
+ IAC
+ DCA TEMP
+ TAD STACK
+ DCA X12 /SAVE POINTER
+ DCA TEMP2 /ZERO ARG COUNTER
+ CDF 10
+ TAD TYPE /PUT IN THE TYPE BITS
+ TAD (1000
+ DCA I TEMP
+ CDF
+ JMS I [CHECKC /LOOK OFR (
+ -250
+ JMP ISITFN /IS IT A FUNCTION ?
+ARGLUP, JMS I [GETNAM /GET THE ARG
+ JMP BADBGN
+ JMS I [LOOKUP
+ IAC
+ DCA TEMP /ADDR OF TYPE WORD
+ CDF 10
+ TAD I TEMP
+ SZA CLA
+ JMP BADBGN /ALREADY AN ARG
+ TAD (20
+ DCA I TEMP
+ CDF
+ CMA
+ TAD TEMP /OUTPUT ADDR OF ARG
+ JMS I [PUSH
+ ISZ TEMP2 /KEEP COUNT
+ JMS I [COMARP /LOOK FOR , OR )
+ JMP BADBGN /NEITHER
+ JMP ARGLUP /,
+ TAD TEMP2 /) HOW MANY ARGS ?
+ CDF 10
+ DCA I NEXT /INTO ARG LIST
+ TAD TEMP2
+ CIA
+ DCA TEMP2
+ TAD NEXT /SAVE ADDR OF ARG LIST
+ DCA ARGLST
+ CDF
+ TAD X12 /RESTORE THE STACK
+ DCA STACK
+MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST
+ CDF 10
+ DCA I NEXT
+ CDF
+ ISZ TEMP2
+ JMP MOVARG
+ JMP I [NEXTST /DO NEXT LINE
+ TYPE=WORD6
+ISITFN, TAD FUNCTN /IS IT A FUNCTION
+ SPA SNA CLA /WITH NO ARGS ?
+ JMP I [NEXTST /NO, WE'RE OK
+BADBGN, JMS I [ERMSG
+ 2010
+ JMP I [NEXTST
+BDATA, JMS I [CHECKC /LOOK FOR A
+ -301
+ JMP BADBGN
+ CLL CMA RAL /SET FUNCTION SWITCH
+ DCA FUNCTN /2.02/ STORE IT DUMMY!!
+ TAD (BDLIST-1 /POINTER TO LIST OF PATCHES
+ DCA X10
+BDLOOP, CDF 10
+ TAD I X10 /GET PATCH LOCATION
+ CDF
+ SNA
+ JMP I [NEXTST /NO MORE PATCHES
+ DCA TEMP /SAVE PATCH ADDRESS
+ TAD BADJMP /GET ERROR JUMP
+ DCA I TEMP /STORE IT
+ JMP BDLOOP /LOOP
+BADJMP, JMP I [BDERR
+\f/ INITIAL SYMBOL TABLE
+ FIELD 1
+ *2020
+ NOPUNC
+ *20
+ ENPUNC
+ 0
+BLNKCN, 111;0 /BLANK COMMON SLOT
+ALIST, 0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0
+HOLIST, 0
+FPLIST, 0
+DPLIST, 0
+INTLST, ONE
+CMPLST, 0
+SNLIST, 0
+ONE, THREE;0;1;2000;0
+THREE, SIX;0;2;3000;0
+SIX, 0;0;3;3000;0
+TRUE, 0;0145;0
+MAIN, 0;1000;0;0111;1600
+FREE, 0
+\f/ BLOCK DATA PATCH LIST
+BDLIST, IF /BLOCK DATA PATCH LIST
+ DOUBLE
+ DO
+ GOTO
+ CALL
+ READ
+ REWIND
+ ENDFIL
+ FORMAT
+ WRITE
+ BACKSP
+ ASSIGN
+ STOP
+ PAUZE
+ DFINFL
+ FIND
+ ITSAR
+ 0
+\f/ INITIALIZATION
+ *2200
+START, SKP /NON-CHAINED ENTRY POINT
+ JMP .+5 /CCL ENTRY
+ CIF CDF 10 /START HERE
+ JMS I (200 /COMMAND DECODE
+ 5
+ 0624 /DEFAULT EXT IS .FT
+ TAD I L7600 /IS AN OUTPUT FILE GIVEN ?
+ SNA CLA
+ JMP MYFILE /NO, USE FORTRN.TM
+MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0
+ CDF
+ DCA I NAMEOF
+ CDF 10
+ ISZ NAMEOF
+ ISZ OFNAME
+ ISZ OFNSIZ
+ JMP MOVOFN
+EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS
+ SZA
+ JMP EXTSET
+ TAD I (7643
+ SPA
+ JMP GETRA /A WAS SET.USE RA
+ AND L41 /CHECK FOR L+G
+ SNA CLA
+ TAD (0610 /USE RL
+ TAD (1404 /USE LD
+EXTSET, DCA I (7604
+ TAD I (7604
+ CDF 0
+ DCA I NAMF
+ CDF 10
+ TAD I (7611
+ SNA
+ TAD (1423 /.LS FOR LISTING
+ DCA I (7611
+ TAD I (7616
+ SNA
+ TAD (1520 /.MP FOR LOAD MAP
+ DCA I (7616
+EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE
+ JMS I (200
+ 3
+OBLOK, TMPFL2
+OSIZE, 0
+ JMP OBAD /BADDIE
+ CDF
+ TAD OBLOK /SAVE STARTING BLOCK
+ DCA OUBLOK
+ TAD OBLOK
+ DCA I (OUFILE
+ TAD OSIZE
+ DCA OULEN
+ CDF 10
+ CLA IAC
+ JMS I (200 /GET PASS2
+ 2
+SPASS2, PASS2N
+ 0
+ JMP OBAD
+ CLA IAC
+ JMS I (200
+ 2
+SP2O, PAS2ON /GET PASS2 OVERLAY
+ 0
+ JMP OBAD
+ CDF /SAVE PASS2 AND PASS2O BLOCKS
+ TAD SPASS2
+ DCA PASS2B
+ TAD SP2O /SKIP FIRST BLOCK
+ IAC /ITS THE CORE TABLE
+ DCA I (PASS2O
+ CIF
+ JMP INITLN /GO START COMPILE
+MYFILE, CDF /PUT DEFAULT INTO 17600
+ TAD I NAMOF
+ DCA I NAMEOF
+ TAD I NAMOF /ALSO INTO PAGE 0
+ CDF 10
+ DCA I OFNAME
+ ISZ NAMOF
+ ISZ NAMEOF
+ ISZ OFNAME
+ ISZ OFNSIZ
+ JMP MYFILE
+ CLA IAC /SET DEV TO SYS
+ DCA I L7600
+ JMP EXTEST /GO OPEN FILE
+OBAD, CIF CDF
+ JMP BADDIE
+OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS)
+NAMEOF, TMPFIL+4
+NAMOF, TMPFIL
+OFNSIZ, -3
+TMPFL2, 0617;2224;2216;2415 /FORTRN.TM
+PASS2N, 2001;2323;6200;2326 /PASS2.SV
+PAS2ON, 2001;2323;6217;2326 /PASS2O.SV
+NAMF, TMPFIL+7
+L7600,
+GETRA, 7600 /CLA
+ TAD (2201 /V3C USE RA
+ JMP EXTSET
+L41, 41
+\f PAGE
+/ PROGRAM HEADER LIST
+HDRLST, TEXT 'INTEGERFUNCTIO'
+ INTFUN
+ TEXT 'REALFUNCTION'
+ REAFUN
+ TEXT 'COMPLEXFUNCTIO'
+ CMPFUN
+ TEXT 'DOUBLEPRECISIONFUNCTIO'
+ DBLFUN
+ TEXT 'LOGICALFUNCTIO'
+ LOGFUN
+ TEXT 'FUNCTION'
+ XXXFUN
+ TEXT 'SUBROUTINE'
+ SUBRTN
+ TEXT 'BLOCKDAT'
+ BDATA
+ 0
+\f/ PS-8 FILE INPUT ROUTINES
+/NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES
+/ALOT OF FIELD DIDDLING.
+ *5400
+MORCHR, TAD (214 /FIX CHAR
+ CDF 0 /**
+ DCA I QCHAR
+ CDF 10
+ TAD I (ICHAR
+ IAC /UPDATE ADDR
+ DCA TCHAR
+ CIF CDF 0
+ TAD I QCHAR /RETURN VALUE IN AC
+ JMP I TCHAR
+TCHAR, 0
+QCHAR, CHAR
+/ EXTENDED OPERATOR LIST
+OPRLST, -01;-1604;ANDOPR
+ -17;-2200;OROPR
+ -05;-2100;EQOPR
+ -16;-0500;NEOPR
+ -07;-0500;GEOPR
+ -07;-2400;GTOPR
+ -14;-0500;LEOPR
+ -14;-2400;LTOPR
+ -30;-1722;XOROPR
+ -05;-2126;EQVOPR
+ 0
+/ EXPONENT TABLE
+PETABL, 0004;2400;0000 /1E1
+ 0000;0000;0000
+ 0007;3100;0000 /1E2
+ 0000;0000;0000
+ 0016;2342;0000 /1E4
+ 0000;0000;0000
+ 0033;2765;7020 /1E8
+ 0000;0000;0000
+ 0066;2160;6744 /1E16
+ 6770;1000;0
+ 0153;2356;1326 /1E32
+ 6501;2670;2655
+ 0325;3023;6017 /1E64
+ 5117;7747;6466
+ 0652;2235;6443 /1E128
+ 7114;0164;6145
+ 1523;2523;7565 /1E256
+ 7734;7374;7357
+ 3245;3430;6320 /1E512
+ 2565;1407;2176
+ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C
+/FAKE END STATEMENT USED IF PROGRAM HAS NONE
+\f PAGE
+\f/MAIN PART OF OS/8 INPUT ROUTINES
+
+ICHAR, 0 /READ CHAR FROM INPUT FILE
+ CDF 10
+ ISZ INJMP /BUMP THREE WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+/ CDF **
+ TAD INEOF /DID LAST READ YEILD END OF FILE ?
+ SNA CLA
+ JMP INGBUF /NO, DO ANOTHER READ
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ JMP ENDIN /END OF INPUT
+INGBUF, TAD INCTR /BUMP RECORD COUNTER
+ CLL IAC
+ SNL
+ DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED
+ SZL
+ ISZ INEOF /SET END OF FILE SWITCH
+ CDF 10 /**
+ CIF 0 /**
+ JMS I INHNDL /DO THE READ
+ 0210 /ONE BLOCK TO FIELD 1
+INBUFP, INBUF
+INREC, 0
+ JMP INERR /HANDLER ERROR
+INBREC, ISZ INREC /BUMP RECORD NUMBER
+ TAD INBUFP /RESET BUFFER POINTER
+SVIBPT, DCA INPTR /V3C
+ TAD (-601 /SET CHAR COUNT
+ DCA INCHCT
+ TAD INJMPP /RESET THREE WAY JUMP SWITCH
+ DCA INJMP
+ JMP ICHAR+1 /GO AGAIN
+INERR, ISZ INEOF /EITHER EOF OR BADDIE
+ SMA CLA
+ JMP INBREC /END OF FILE, DO NEXT FILE
+ JMP TERR /INPUT ERROR, GIVE I F AND EXIT
+ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE
+ JMP SVIBPT
+
+/ENDIN, TAD INCALL /END OF INPUT IS USR IN CORE ?
+/ TAD (-200
+/ CIF 0 /**
+/ SZA CLA
+/ JMP I (ENDX /NO, ITS END OF PROG
+TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK**
+ 311
+ 306
+INJMP, HLT /3 WAY CHAR UNPACK BRANCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP /RESET JUMP SWITCH
+ DCA INJMP
+ TAD I INPTR
+ AND (7400 /COMBINE THE HIGH ORDER BITS
+ CLL RTR /OF THE TWO WORDS
+ RTR
+ TAD INTMP /TO FORM THE THIRD CHAR
+ RTR
+ RTR
+ ISZ INPTR /BUMP WORD POINTER
+ JMP ICHAR1+1 /DO SOME COMMON STUFF
+ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS
+ AND (7400
+ DCA INTMP /FOR THE THIRD CHAR
+ ISZ INPTR /GO TO THE SECOND WORD
+ICHAR1, TAD I INPTR /GET THE LOW 8 BITS
+/ CDF
+ AND (177 /AND I MEAN ONLY 8 !!
+ SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7
+ JMP ICHAR+1
+ TAD (-32 /IS IT ^Z (END OF FILE)
+ SNA
+ JMP GETNEW /YES, LOOK FOR THE NEXT FILE
+ TAD (232-212
+ SNA
+ JMP ICHAR+1 /IGNORE LINE FEEDS
+ TAD (212-215
+ SNA
+ JMP ICHARN /RETURN ON CARRIAGE RETURN **
+ IAC
+ SNA
+ JMP ICHAR+1 /IGNORE FORM FEEDS
+ JMP I (MORCHR /**
+ICHARN, CIF CDF 0
+ JMP I ICHAR
+INTMP, 0
+INFPTR, 7617 /POINTER TO INPUT FILE LIST
+INEOF, 1
+INCHCT,
+INNEWF, -1 /FETCH HANDLER FOR NEXT FILE
+ CDF 0 /**
+ TAD (INDEVH+1 /THIS IS WHERE IT GOES **
+ DCA INHNDL
+ CDF 10
+ TAD I INFPTR /GET NEXT INPUT FILE INFO
+ SNA
+ JMP I INNEWF /NO MORE FILES
+ CDF 10 /WAS CIF 10**
+ JMS I INCALL /CALL MONITOR
+ 1 /FETCH HANDLER
+INHNDL, 0 /ENTRY ADDR GOES HERE
+ JMP INERR+3 /THIS CAN'T HAPPEN HERE
+ TAD I INFPTR /GET LENGTH
+ AND (7760
+ SZA /A ZERO HERE MEANS >=256 BLOCKS
+ TAD (17 /PUT IN SOME MORE BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR /GET STARTING RECORD NUMBER
+ DCA INREC
+ ISZ INFPTR
+ DCA INEOF /CLEAR EOF FLAG
+ ISZ INNEWF
+ JMP I INNEWF
+INCTR, 0
+INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME
+INPTR, 0
+ PAGE
+\f/ KEYWORD LIST
+CMDLST, -1106;0;IF /IF
+ -0417
+ -2502
+ -1405
+ -2022
+ -0503
+ -1123
+ -1117;0;DOUBLE /DOUBLE PRECISION
+ -0417;0;DO /DO
+ -0717
+ -2417;0;GOTO /GOTO
+ -0317
+ -1515
+ -1716;0;COMMON /COMMON
+ -0317
+ -1520
+ -1405;0;COMPLE /COMPLEX
+ -0317
+ -1624
+ -1116
+ -2505;0;NEXTST /CONTINUE
+ -0301
+ -1414;0;CALL /CALL
+ -2205
+ -0114;0;REAL /REAL
+ -2205
+ -0104;0;READ /READ
+ -2205
+ -2711
+ -1604;0;REWIND /REWIND
+ -2205
+ -2425
+ -2216;0;RETURN /RETURN
+ -0516
+ -0406
+ -1114;0;ENDFIL /ENDFILE
+ -0516;0;XEND /END
+ -0411
+ -1505
+ -1623
+ -1117;0;DIMENS /DIMENSION
+ -0401
+ -2401;0;DATA /DATA
+ -0617
+ -2215
+ -0124;0;FORMAT /FORMAT
+ -2722
+ -1124;0;WRITE /WRITE
+ -0521
+ -2511
+ -2601
+ -1405
+ -1603;0;EQUIV /EQUIVALENCE
+ -0405
+ -0611
+ -1605
+ -0611
+ -1405;0;DFINFL /DEFINEFILE
+ -1116
+ -2405
+ -0705;0;INTEGE /INTEGER
+ -1417
+ -0711
+ -0301;0;LOGICA /LOGICAL
+ -0530
+ -2405
+ -2216
+ -0114;0;EXTERN /EXTERNAL
+ -0201
+ -0313
+ -2320
+ -0103;0;BACKSP /BACKSPACE
+ -0123
+ -2311
+ -0716;0;ASSIGN /ASSIGN
+ -2001
+ -2523;0;PAUZE /PAUSE
+ -2324
+ -1720;0;STOP /STOP
+ -0611
+ -1604;0;FIND /FIND
+ 0 /END OF LIST
+ $
+\f
--- /dev/null
+$JOB FORTRAN IV ASSEMBLY
+/
+.DATE
+/
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/ PAL-8 ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.PAL LIBRA
+.LOAD LIBRA
+.SAVE SYS LIBRA=0;200
+.DELETE LIBRA.BN
+/
+/ *******************************************************************
+/
+.PAL LOAD
+.LOAD LOAD
+.SAVE SYS LOAD=0;200
+.DELETE LOAD.BN
+/
+/ *******************************************************************
+/
+.PAL PASS2
+.LOAD PASS2
+.SAVE SYS PASS2
+.DELETE PASS2.BN
+/
+/ *******************************************************************
+/
+.PAL PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2=0,7605
+.DELETE PASS20.BN
+/
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/
+.R PAL8
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS
+.DELETE FRTS.BN
+/
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/ END OF JOB
+/
+/ *******************************************************************
+/ *******************************************************************
+$END
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT FLOAT
+ BASE 0
+ FLDA 0
+ STARTD
+ FSTA RETRN /SAVE RETURN
+ FADD TWO /ADDR OF ARG POINTER
+ FSTA 3
+ FLDA% 3 /ADDR OF ARG
+ FSTA 3
+ STARTF
+ FLDA% 3 /GET ARG
+RETRN, 0;0 /FLOAT IS A NOP
+TWO, 0;2
+ END
+\f
--- /dev/null
+/ VERSION 5A 4-27-77 PT
+/
+ SECT IDINT
+ JA #DINT
+ DPCHK
+ TEXT +DINT +
+DINTXR, SETX XRDINT
+ SETB BPDINT
+BPDINT, F 0.0
+ F 0.0
+XRDINT, 0;73;1
+ F 0.0
+ ORG 10*3+BPDINT
+ FNOP
+ JA DINTXR
+ 0
+#GOBAK, JA .
+ BASE 0
+#DINT, STARTD
+ SETX XRDINT
+ FLDA 10*3
+ FSTA #GOBAK,0
+ FLDA% 0,2
+ SETB BPDINT
+ BASE BPDINT
+ FSTA BPDINT
+ STARTE
+ FLDA% BPDINT
+ JLT NEGFIX /NEGATIVE ARG
+ ALN 1 /FIX POSITIVE ARG
+ FNORM
+ JA #GOBAK /RETURN
+NEGFIX, FNEG /FIRST MAKE POSITIVE
+ ALN 1 /THEN FIX
+ FNORM
+ FNEG /THEN RE-NEGATE
+ JA #GOBAK
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT IFIX
+ ENTRY AINT
+ ENTRY INT
+ BASE 0
+AINT,
+INT, FLDA 0 /ADDRESS OF CALL
+ STARTD
+ FSTA RETRN /SAVE RERN
+ FADD TWO /INCR BY TWO
+ FSTA 3 /GIVES ADDRESS OF ARG POINTER
+ FLDA% 3 /GET ADDR OF ARG
+ FSTA 3
+ STARTF
+ FLDA% 3 /GET ARG
+ JAL RETRN /LEAVE BIGGIES ALONE
+ JLT NEGFIX /NEGATIVE ARG
+ ALN 0 /FIX POSITIVE ARG
+ FNORM
+ JA RETRN /RETURN
+NEGFIX, FNEG /FIRST MAKE POSITIVE
+ ALN 0 /THEN FIX
+ FNORM
+ FNEG /THEN RE-NEGATE
+RETRN, JA .
+TWO, 0;2
+ END
+\f
--- /dev/null
+/LIBRA: F4 LIBRARIAN, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/LIBRA: FORTRAN IV LIBRARIAN
+/
+/
+/ BORN OF JUD LEONARD, UNDER THE
+/ SIGN FOR WHICH IT IS NAMED.
+/
+/
+/ CHANGES FOR V23
+/ .PRINT VERSION NUMBER
+/ .ACCEPT INPUT FROM CONSOLES WITHOUT PARITY
+/
+/
+/ CHANGES FOR OS/8 V3D BY PAULA TIRAK
+/ .CHANGED VERSION NUMBER TO 24A
+/ .PUT IN NEW DATE ALGORITHM
+/ .NO LONGER MISNAMES THE SECOND OUTPUT FILE
+/
+/
+/ OS/8 CONSTANTS:
+VERS=24
+PATCH="A
+/
+FETCH=1
+LOOKUP=2
+ENTER=3
+CLOSE=4
+DECODE=5
+CHAIN=6
+ERROR=7
+USRIN=10
+USROUT=11
+/
+OUTF1=7600 /LIBRARY
+OUTF2=7605 /CATALOG LISTING
+OUTF3=7612 /UNUSED
+INF=7617
+/
+EQHI=7642
+SWATOL=7643
+SWMTOX=7644
+SWYTO9=7645
+EQLO=7646
+DHRES=7647 /HANDLER RESIDENCY TABLE
+SYSDAT=7666 /SYSTEM DATE
+DCTLW=7760 /DEVICE CONTROL WORD TABLE
+/ DEVICE CONTROL WORDS HAVE THE FORM:
+/ BIT 0 FILE STRUCTURED
+/ BIT 1 READ ONLY
+/ BIT 2 WRITE ONLY
+/ BITS 3-8 DEVICE TYPE
+/ BITS 9-11 DIR BLOCK OF CURRENT TENTATIVE FILE
+/
+/ INTERNAL DEFINITIONS:
+F0=00
+F1=10
+CATBUF=2000 /IN FIELD 1
+CBUFS=1 /NUMBER OF BUFFERS FOR CATALOG
+MODBUF=2400 /LIKEWISE
+MBUFS=12 /BUFFERS FOR MODULE
+ODEVH=7200 /OUTPUT DEVICE HANDLER (ROOM FOR 2-PAGE)
+IDEVH=6600 /INPUT DEVICE HANDLER
+\f/
+/ PAGE 0 FOR LIBRA
+/
+ *1
+TMP1, 0
+TMP2, 0 /SOME TEMPS
+TMP3, 0
+TMP4, 0
+TMP5, 0
+TMP6, 0
+TMP7, 0
+X0, 0 /AUTO-INDEX
+X1, 0
+X2, 0
+X3, 0
+X4, 0
+X5, 0
+X6, 0
+X7, 0
+USR, 200 /CURRENT USR CALL ADDRESS
+ /LIBRA ASSUMES USR ALWAYS PRESENT
+LIBDVH, ODEVH /ADDRESS OF LIBRARY DEVICE HANDLER
+LIBU, 1 /UNIT CONTAINING LIBRARY; INITIALLY SYS:
+CATLEN, 0 /LENGTH OF CATALOG
+CATBLK, 0 /CURRENT CATALOG BLOCK IN CORE
+LAVAIL, 0 /NEXT AVAILABLE LIBRARY BLOCK
+LIBNAM, TEXT "FORLIBRL"
+ *.-1
+INFP, INF /CURRENT PLACE IN INPUT FILE LIST
+MODU, 0 /UNIT CONTAINING CURRENT MODULE
+MODDVH, IDEVH /INPUT DEVICE HANDLER ADDRESS
+MODLEN, 0 /LENGTH OF THIS MODULE
+MODBLK, 0 /FIRST BLOCK OF MODULE
+INLSW, 0 /NON-ZERO IF IN LIBRARY INPUT
+INFST, 0 /FIRST BLOCK OF INPUT FILE
+INBLK, 0 /NEXT INPUT BLOCK NUMBER
+THSBLK, 0 /READIN CONTROL
+FULFLG, 0 /-1 IF CAT FULL
+\fENAM1, 0
+ENAM2, 0 /HOLDER FOR ESD NAMES
+ENAM3, 0
+ 0 /TEXT STOPPER FOR ENAME
+ESDCTR, 0
+PCAT, CATBUF /POINTER TO CURRENT CATALOG BLOCK
+INCLUD, -1 /SW FOR NAME INCLUDED IN CATALOG
+CHANGD, 1 /0 IF CAT BLOCK MODIFIED
+PMOD, MODBUF /POINTER TO CURRENT MODULE BLOCK
+/
+TTFLAG, 0 /NON-ZERO WHEN TTY HAS INITIALIZED
+PCHR, TTO /OUTPUT ROUTINE
+TTPOS, 0 /TTY POSITION COUNTER
+CATCNT, 0
+IOERR, 0
+ 7421 /ERROR CODE TO MQ
+ JMP I .+1
+ IOMES /LOG THE ERROR
+\f/ LIBRA MAIN CONTROL
+/
+ *177 /MAKES IT EASY TO CALL START
+START, CDF F0
+ JMS TTWAIT /ALLOW TTY TO COMPLETE
+ CIF F1
+ JMS I USR
+ DECODE
+TXTRL, 2214 /RL DEFAULT EXT
+ TAD (INF /RESET INPUT FILE POINTER
+ DCA INFP
+ TAD (TTO /AND IO DEVICE
+ DCA PCHR
+ DCA FULFLG
+ CDF F1
+ TAD I (OUTF1
+ SNA /NEW LIBRARY SPECIFIED?
+ JMP LASTLB /NO, USE LAST ONE
+ DCA LIBU /GET LIBRARY UNIT
+ TAD (OUTF1
+ DCA X0
+ TAD I X0
+ DCA LIBNAM /MOVE
+ TAD I X0 /IN
+ DCA LIBNAM+1 /NEW
+ TAD I X0 /NAME
+ DCA LIBNAM+2
+ TAD I X0
+ SNA
+ TAD TXTRL /IF NO EXT, FORCE .RL
+ DCA LIBNAM+3
+LASTLB, TAD LIBU /REGET UNIT
+ AND (17
+ TAD (DCTLW-1 /ADDRESS DEV CTL TABLE
+ DCA TMP1
+ TAD I TMP1
+ CDF F0
+ SMA CLA /IS DEVICE FILE-STRUCTURED?
+ JMP NOTFS /NO, BOMB
+ TAD (ODEVH!1
+ DCA OHADDR /ALLOW 2-PAGE HANDLER
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR /GET THE HANDLER
+ FETCH
+OHADDR, ODEVH!1
+ JMS IOERR /YOU'RE KIDDING
+ TAD OHADDR /NOW THE REAL ADDRESS
+ DCA LIBDVH
+ JMP ZTEST
+\fNOTFS, JMS TTOTXT
+ FLSTR-1
+ JMS CRLF
+ JMP START
+/
+IOMES, CLA
+ TAD (TTO
+ DCA PCHR /ENSURE IT COMES OUT ON TTY
+ JMS TTOTXT
+ IOMSG-1
+ JMS CRLF
+ JMP START
+ PAGE
+\fZTEST, CDF F1 /FIND OR CREATE LIB.
+ TAD I (SWYTO9 /GET SWITCH WORD
+ AND (2000 /TEST FOR /Z
+ CDF F0
+ SZA CLA
+ JMP NEWLIB /YES, ENTER NEW ONE
+OLDLIB, JMS FNDLIB /LOOKUP THE LIBRARY
+ LOOKUP
+ JMP NEWLIB /COULDN'T FIND IT
+/
+ TAD LIBBLK /FIRST BLOCK OF LIBRARY
+ DCA ZCATB
+ TAD (CBUFS+MBUFS^200!F1
+ DCA ZCATC /READ ALL YOU CAN
+ JMS ZCAT /DO THE READ
+ CDF F1
+ TAD I (CATBUF /LOOK AT CONTROL WORD
+ CLL RAR
+ SZA CLA /IS IT A LIBRARY?
+ JMP NOTLIB /NO, ERROR
+ TAD I (CATBUF+3
+ CDF F0
+ DCA CATLEN /LENGTH IN BLOCKS
+ TAD LIBBLK
+ DCA LAVAIL /WILL BE UPDATED DURING SCAN
+ TAD LAVAIL
+ DCA CATBLK /CURRENT BLOCK IN BUFFER
+ TAD CATLEN
+ CIA
+ DCA TMP2 /COUNTER
+CSLOOP, TAD (CBUFS+MBUFS
+ TAD TMP2
+ SMA /WILL THE REST FIT IN BUFFER?
+ JMP CSLAST /YES
+ DCA TMP2
+ TAD (-CBUFS-MBUFS^100
+ DCA TMP1 /ENTRIES NOW IN CORE
+ JMS SCAT /SCAN CATALOG
+ TAD ZCATB /NEXT BLOCK WE'LL READ
+ DCA CATBLK
+ JMS ZCAT /READ SOME
+ JMP CSLOOP
+\fCSLAST, CIA /NO OF BLOCKS WE DON'T NEED
+ TAD (CBUFS+MBUFS
+ JMS R6L /NO OF ENTRIES WE CAN LOOK AT
+ CIA
+ DCA TMP1
+ JMS SCAT /LOOK FOR END
+FULCAT, JMS TTOTXT /RAN OFF THE END
+ CATFUL-1
+ JMS CRLF /**
+ JMP LCLOSE
+/
+SCAT, 0
+ TAD (CATBUF-1
+ DCA X0
+SCLOOP, CDF F1
+ TAD I X0
+ CMA /TEST FOR END
+ SNA CLA
+ JMP GETINF /THAT'S IT
+ ISZ X0
+ ISZ X0 /IGNORE REST OF NAME
+ TAD I X0 /GET LENGTH
+ TAD LAVAIL /ADD TO ST BLOCK OF FREE AREA
+ DCA LAVAIL
+ ISZ TMP1
+ JMP SCLOOP
+ CDF F0
+ JMP I SCAT /GO FOR NEXT BUFFER LOAD
+/
+NOTLIB, JMS PRLBNM /PRINT LIBRARY NAME
+ JMS TTOTXT
+ UNLIB-1
+ JMS CRLF
+ JMP START
+ PAGE
+\fNEWLIB, JMS FNDLIB
+ ENTER
+ JMS IOERR
+ TAD LIBU
+ AND (7760
+ CLL RTR
+ RTR
+ SNA /DID HE GIVE A LENGTH?
+ STL RTL /NO, USE 2
+ DCA CATLEN
+ CDF F1
+ TAD I (EQLO /HOW MANY EXTRA BLOCKS WANTED
+ CDF F0
+ TAD CATLEN /PLUS CATALOG REQUIREMENT
+ CLL
+ TAD LIBLEN /MINUS AVAILABLE LENGTH
+ SZL CLA /CHECK FOR ENUF ROOM
+ JMP LSZERR /NO ROOM, GIVE MESSAGE
+/
+/ WRITE EMPTY CATALOG
+/
+ TAD (CATBUF-1
+ DCA X0
+ TAD (-MBUFS-CBUFS^400
+ DCA TMP1
+ CDF F1
+ DCA I X0
+ ISZ TMP1
+ JMP .-2
+ TAD (CATBUF-1 /RESET FOR LATER USE
+ DCA X0
+ CLA CMA
+ TAD CATLEN
+ SPA SNA /MORE THAN ONE?
+ JMP CATB0 /JUST ONE
+ CIA
+ ISZ ZCATB /START WITH SECOND CAT BLOCK
+ZCLOOP, CLL
+ TAD (MBUFS+CBUFS
+ DCA TMP1
+ SZL /FULL WRITE?
+ TAD TMP1 /NO
+ CIA
+ TAD (MBUFS+CBUFS
+ JMS R6R
+ TAD (4000!F1
+ DCA ZCATC /SET CONTROL
+ JMS ZCAT
+ TAD TMP1
+ SPA
+ JMP ZCLOOP /MORE TO GO
+CATB0, CDF F1
+ CLA IAC /1 IS LIBRARY CODE
+ DCA I X0
+ TAD (VERS
+ DCA I X0 /MARK LIBRA VERSION #
+ TAD LIBLEN /JUST A GUESS
+ CIA
+ DCA I X0
+ TAD CATLEN
+ DCA I X0
+ CLA CMA /END OF CAT INDICATOR
+ DCA I X0 /MARKS FIRST AVAIL SLOT
+ CDF F0
+ DCA CHANGD /FORCE A WRITE ON THIS ONE
+ TAD ZCATB
+ DCA LAVAIL
+ TAD LIBBLK /LIBRARY START BLOCK
+ DCA CATBLK /IS CURRENTLY IN BUFFER
+ JMP GETINF /BEGIN
+/
+ZCAT, 0
+ CDF F0
+ JMS CCHK /LOOKOUT FOR CONTROL C
+ JMS I LIBDVH
+ZCATC, F1
+ CATBUF
+ZCATB, 0
+ JMS IOERR
+ TAD ZCATC
+ JMS R6L
+ AND (17
+ TAD ZCATB
+ DCA ZCATB
+ ISZ CHANGD /SET UNMODIFIED SW
+ JMP I ZCAT
+ JMP .-2
+/
+FNDLIB, 0
+ TAD I FNDLIB
+ DCA USRCOD
+ ISZ FNDLIB
+ TAD (LIBNAM
+ DCA LIBBLK
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR
+USRCOD, 0
+LIBBLK, LIBNAM
+LIBLEN, 0 /NEG, REMEMBER
+ JMP I FNDLIB /COULD'T DO IT
+ TAD LIBBLK /FIRST BLOCK
+ DCA ZCATB /OF CATALOG
+ ISZ FNDLIB
+ JMP I FNDLIB
+LSZERR, JMS TTOTXT
+ SMALL-1
+ JMS CRLF
+ JMP START /GO FOR MORE
+ PAGE
+\f/
+/ SETUP POINTERS AND THINGS FOR NEXT INPUT MODULE
+/
+GETINF, CLA CMA
+ DCA INCLUD /SET NO-NAME-INCLUDED SW
+ TAD INLSW /ARE WE GETTING INPUT FROM A LIBR?
+ SZA CLA
+ JMP INLIB /YES-GET NEXT MODULE THEREIN
+NXTINF, CDF F1
+ TAD I INFP /UNIT AND LEN OF NEXT IN FILE
+ SZA /IS THERE ONE?
+ JMP FTCHIN /YES
+ TAD I (SWATOL
+ AND (1000 /TEST FOR /C
+ CDF F0
+ SNA CLA
+ JMP LCLOSE /NO MORE
+ JMS SAVRES /PRESERVE DEV HANDLER RESIDENCY
+ JMS TTWAIT /FINISH ANY TYPING
+ CIF F1
+ JMS I USR /NEW LINE CONTINUES OLD
+ DECODE
+ 2214 /RL DEFAULT EXT
+ 0 /DO NOT DELETE TENTATIVE FILES
+ JMS RSTRES /RESTORE RESIDENCY TABLE
+ TAD (INF
+ DCA INFP /RESET INPUT FILE POINTER
+ JMP NXTINF /TRY AGAIN
+\fFTCHIN, DCA MODU /UNIT CONTAINING INPUT MOD
+ ISZ INFP
+ TAD I INFP
+ DCA INFST /START OF INPUT FILE
+ ISZ INFP
+ TAD INFST
+ DCA MODBLK /IN THIS CASE, FILE=MODULE
+ TAD MODU
+ AND (7760
+ CIA
+ CLL RTR
+ RTR
+ DCA MODLEN
+ TAD (IDEVH!1
+ DCA INDVH /TENTATIVE HANDLER ADDR
+ CDF F0
+ TAD MODU
+ AND (17
+ CIF F1
+ JMS I USR
+ FETCH
+INDVH, IDEVH!1 /TENTATIVE INPUT HANDLER ADDR
+ JMS IOERR /DON'T GIVE ME THAT
+ TAD INDVH
+ DCA MODDVH /DEVICE HANDLER ADDRESS
+ DCA THSBLK /FORCE READIN TO READ
+LUKMOD, TAD MODBLK /FIRST BLOCK OF MODULE
+ DCA INBLK /INITIALIZE READIN
+ JMS READIN /GET FIRST BLOCK
+ CDF F1
+ CLA CMA /-1
+ TAD I PMOD /LOOK AT IDENTIFIER
+ CDF F0
+ SNA
+ JMP GOTLIB /ITS A LIBRARY
+ CLL RTR
+ SZA CLA /IS IT A MODULE
+ JMP BADINF /BAD INPUT
+ TAD LIBBLK /MAKE SURE
+ CIA
+ TAD LIBLEN /THAT MODULE
+ TAD LAVAIL /FITS IN LIBRARY
+ CLL
+ SNA /CHECK FOR TOO LONG HERE TOO**
+ JMP OVFLO /IT IS TOO LONG
+ TAD MODLEN
+ SNL CLA
+ JMP NXTEBK /GO GETTUM
+OVFLO, JMS TTOTXT
+ TOOBIG-1
+ JMS CRLF
+ JMP GETINF
+\fBADINF, JMS TTOTXT
+ NOTMOD-1
+ JMS CRLF
+ JMP GETINF
+/
+GOTLIB, TAD MODLEN
+ SNA CLA
+ JMP LB2BIG /CAN'T DO A LOOKUP IF G. T. 255
+ ISZ INLSW /SET IN-LIBRARY SWITCH
+ JMP INLIB
+LB2BIG, JMS TTOTXT
+ L2BMSG-1
+ JMS CRLF
+ JMP START
+ PAGE
+\f/ GET NEXT MODULE FROM LIBRARY
+/
+INLIB, TAD INFST /START OF INPUT FILE
+ DCA INBLK /IS WHAT WE WANT
+ JMS READIN /BRING CATALOG INTO MODULE BUFFER
+ TAD (3
+ TAD PMOD
+ DCA TMP1
+ CDF F1
+ TAD I TMP1 /GET CATALOG LEN
+ CIA
+ DCA TMP1 /HOLD COUNTER IN CASE OF FULL CATALOG
+ TAD INFST
+ DCA INBLK /WE WANT THE SAME ONE AGAIN
+ TAD INFST
+ DCA TMP3 /INIT ACCUMULATED MODULE START BLOCK
+ DCA MODLEN /INITAIL MOD LEN IS ZERO
+INLSC1, JMS READIN /GET CATALOG BLOCK
+ TAD (-100
+ DCA TMP2 /COUNT ENTRIES IN CAT BLOCK
+INLSC2, CDF F1
+ TAD I PMOD /LOOK FOR END-OF-CATALOG WORD
+ CMA
+ SNA CLA
+ JMP NDLSC /END OF SCAN
+ TAD (3
+ TAD PMOD /POINT TO LENGTH
+ DCA TMP5
+ TAD I TMP5
+ SNA CLA /FIRST ENTRY FOR A MODULE?
+ JMP NOLEN /NO, DO NOT UPDATE
+ TAD MODLEN
+ TAD TMP3 /UPDATE MODULE STARTING BLOCK
+ DCA TMP3
+ TAD I TMP5 /GET THIS LENGTH
+ DCA MODLEN /FOR THIS MODULE
+NOLEN, TAD MODBLK /COMPARE LAST MODULE STARTING BLOCK
+ CMA CLL
+ TAD TMP3 /TO ACCUMULATED START BLOCK
+ SNL CLA /INTERESTING?
+ JMP NOTYET /NO
+ TAD I PMOD /YES; WAS NAME DELETED?
+ SZA CLA
+ JMP GLMOD /NO, WE'VE GOT A GOOD MODULE
+NOTYET, TAD (4
+ TAD PMOD /POINT TO NEXT NAME
+ DCA PMOD
+ ISZ TMP2 /END OF CAT BLOCK?
+ JMP INLSC2 /NO
+ ISZ TMP1 /YES; END OF CATALOG?
+ JMP INLSC1 /NO, GET NEW BLOCK
+NDLSC, DCA INLSW /YES, NO LONGER IN A LIBRARY
+ JMP NXTINF /GET ANOTHER FILE
+\fGLMOD, TAD TMP3 /GET STARTING BLOCK
+ DCA MODBLK /OF MODULE
+ JMP LUKMOD /AND GO GET THE MODULE
+L2BMSG, TEXT "INPUT LIBRARY TOO BIG";0
+ PAGE
+\f/ PROCESS LOOP FOR ONE MODULE
+/
+NXTEBK, TAD (3
+ TAD PMOD /ADDR OF FIRST ESD-1
+ DCA X0 /RESET POINTER TO NAMES
+ TAD (-52 /PER BLOCK COUNT
+ DCA ESDCTR
+ESDLUP, CDF F1
+ TAD I X0
+ DCA ENAM1
+ TAD I X0
+ DCA ENAM2
+ TAD I X0
+ DCA ENAM3
+ TAD I X0 /TYPE CODE
+ CDF F0
+ TAD (ESDTAB /DISPATCH FROM TBL
+ DCA TMP1
+ JMP I TMP1
+ESDTAB, JMP ESDEND /0=END OF ESD TABLE
+ JMP DUPLUK /1=ENTRY=LOOK FOR
+ /DUPLICATE NAME
+ JMP ESDLND /2=EXTERN=IGNORE NAME
+ JMP ESDLND /3=FORT COMMON=IGNORE
+ JMP DUPLUK /4=PROG SECTION
+ HLT /5=MUL ENTRY=DOESN'T
+ /EXIST
+ HLT /6=MUL SECTION=DITTO
+ JMP DUPLUK /7=SECT8
+ JMP ESDLND /10=COMMZ
+ JMP DUPLUK /11=FIELD1
+\f/
+/ LOOK FOR DUPLICATION OF THIS ESD SYMBOL
+/
+DUPLUK, TAD CATLEN
+ CIA
+ DCA TMP1 /COUNT LENGTH OF CAT
+ TAD CATBLK
+ CIA
+ TAD LIBBLK /ARE WE AT FIRST BLOCK?
+ SZA CLA
+ JMS CHGCHK /CHECK FOR BLOCK MODIFIED
+ TAD LIBBLK
+ DCA NXTCAT /SETUP FOR FIRST BLOCK OF CAT
+ TAD CATLEN
+ CIA
+ DCA CATCNT
+GETCB, JMS GCATB /GET IT
+ TAD (CATBUF-1
+ DCA X1
+ TAD (-100 /COUNT ENTRIES/BLOCK
+ DCA TMP2
+ CDF F1
+CBSRCH, TAD I X1 /LOOK AT NAME
+ CMA
+ SNA
+ JMP CHKI /END OF CATALOG-LOOK FOR /I
+ IAC /COMPLETE THE CIA
+ TAD ENAM1 /COMPARE
+ SZA CLA
+ JMP NOMTCH
+ TAD I X1
+ CIA
+ TAD ENAM2
+ SZA CLA
+ JMP NOMTCH
+ TAD I X1 /LAST CHANCE
+ CIA
+ TAD ENAM3
+ SNA CLA
+ JMP GOTMAT /EQUAL!
+NOMTCH, TAD X1
+ AND (-4
+ TAD (3 /BUMP TO NEXT
+ DCA X1
+ ISZ TMP2
+ JMP CBSRCH
+ JMS CHGCHK /CHECK FOR MODIFIED BLOCK
+ ISZ TMP1 /END OF CATALOG?
+ JMP GETCB /NO, GET NEXT
+ JMS TTOTXT
+ CATFUL-1
+ JMS CRLF
+ CLA CMA
+ DCA FULFLG
+ JMP ESDEND /PUT THAT, IF POSSIBLE
+\fGOTMAT, CDF F0
+ JMS TTOTXT
+ ENAM1-1 /PRINT THE NAME
+ JMS TTOTXT
+ NDUP-1 /WHICH TO KEEP?
+ CDF F1
+ TAD I (SWATOL
+ CDF F0
+ AND (10 /TEST /I
+ SNA CLA
+ JMP CHKR /NO, LOOK FOR /R
+GMASK, JMS TTOTXT
+ KEEP-1
+ JMS WAITOP
+ JMP ESDLND /DEFAULT TO THE OLD ONE
+ TAD (-"O
+ SNA
+ JMP ESDLND /KEEP OLD
+ IAC /IS IT "N"?
+ SZA CLA
+ JMP GMASK /TRY AGAIN
+ JMP DELTO /DELETE THE OLD
+ PAGE
+\fCHKR, JMS CRLF
+ CDF F1
+ TAD I (SWMTOX
+ AND (100 /TEST /R
+ SNA CLA
+ JMP ESDLND /DEFAULT:KEEP THE OLD ONE
+DELTO, CDF F1
+ TAD X1
+ AND (-4
+ CIA
+ CMA /BACK UP POINTER
+ DCA X1
+ DCA I X1 /CLEAR
+ DCA I X1 /OLD
+ DCA I X1 /NAME
+ ISZ X1 /SKIP OVER LENGTH
+ DCA CHANGD /BLOCK HAS BEEN MODIFIED
+ JMP NXTE /ENTER AT END OF LOOP
+NDSCN, CDF F1
+ TAD I X1 /LOOK AT NEXT
+ CMA
+ SNA CLA
+ JMP ENDCAT /NOW WE'RE THERE
+ TAD X1
+ TAD (3 /BUMP TO NEXT NAME
+ DCA X1
+NXTE, ISZ TMP2
+ JMP NDSCN
+ JMS CHGCHK /LOOK OUT FOR CHANGES
+ ISZ CATCNT /END OF CAT ?
+ SKP
+ JMP FULCAT /NO MORE PUSSY
+ JMS GCATB
+ TAD (CATBUF-1
+ DCA X1
+ TAD (-100
+ DCA TMP2
+ JMP NDSCN
+\fCHKI, TAD I (SWATOL /LOOK AT /I SW
+ AND (10
+ SNA CLA
+ JMP ENDCAT /NOT SET
+ JMS TTOTXT
+ ENAM1-1 /TYPE ESD NAME
+ JMS TTOTXT
+ NCLUD-1 /INCLUDE IT?
+IANS, JMS WAITOP
+ JMP ENDCAT /DEFAULT TO INCLUDE
+ TAD (-"Y
+ SNA
+ JMP ENDCAT /YES, INCLUDE
+ TAD ("Y-"N
+ SZA CLA /IS IT "N"?
+ JMP IANS /NO, TRY AGAIN
+ JMP ESDLND
+ENDCAT, TAD X1 /POINT TO EMPTY SLOT
+ AND (-4
+ CIA
+ CMA
+ DCA X1
+ JMP INSERT
+ PAGE
+\f/ THIS ESD GOES IN THE CATALOG
+/
+INSERT, CDF F1
+ TAD ENAM1 /MOVE
+ DCA I X1 /NAME
+ TAD ENAM2 /TO
+ DCA I X1 /LIBRARY
+ TAD ENAM3 /CATALOG
+ DCA I X1
+ ISZ INCLUD /IS THIS THE FIRST?
+ SKP
+ TAD MODLEN /YES, GET THE LENGTH
+ DCA I X1 /AND STORE 4TH WORD
+ DCA CHANGD /SET CAT MODIFIED SW
+ CLA IAC
+ TAD X1 /CHECK FOR END OF BLOCK
+ AND (377
+ SZA CLA
+ JMP MARKND /NO, MARK END OF CAT
+ JMS CHGCHK /WRITE THIS BLOCK
+ CDF F1
+ TAD (-400
+ DCA TMP1 /SET COUNT FOR BLOCK LEN
+ TAD (CATBUF-1
+ DCA X1 /SET POINTER
+ CLA CMA
+ DCA I X1
+ ISZ TMP1
+ JMP .-2 /CLEAR THE BLOCK
+ DCA CHANGD
+ ISZ CATBLK
+ JMP ESDLND
+MARKND, CLA CMA
+ DCA I X1 /MARK NEW END OF CAT
+ESDLND, CDF F0
+ CLA STL RTL /TWO TO SKIP VALUE
+ TAD X0
+ DCA X0
+ ISZ ESDCTR /DONE WITH BLOCK?
+ JMP ESDLUP /NO, GET NEXT
+ JMS READIN /GET NEXT BLOK
+ JMP NXTEBK /RESET POINTERS AND CONTINUE
+ESDEND, ISZ INCLUD /CHECK FOR ANY NAMES OUT
+ JMP CPYMOD /YES, COPY MODULE INTO LIBRARY
+ JMS TTOTXT /SORRY, DIDN'T MAKE IT
+ NONEIN-1
+ JMS CRLF
+ ISZ FULFLG
+ JMP GETINF /TRY NEXT
+ JMP LCLOSE
+\fCPYMOD, TAD MODBLK /GET IN FILE STRT BLOCK
+ DCA INBLK
+ TAD MODLEN
+ CIA
+ DCA TMP1
+ TAD LAVAIL /FIRST AVAILABLE BLOCK
+ DCA NXTOBK
+CPYLUP, JMS READIN /READ BLOCK OF INPUT
+ TAD PMOD
+ DCA PNXTOB
+ JMS I LIBDVH /CALL OUTPUT HANDLER
+ 4200!F1
+PNXTOB, MODBUF
+NXTOBK, 0 /NEXT OUTPUT BLOCK NUMBER
+ JMS IOERR
+ ISZ NXTOBK /BUMP BLOCK NUMBER
+ ISZ TMP1 /CHECK LENGH
+ JMP CPYLUP
+ TAD NXTOBK
+ DCA LAVAIL /UPDATE AVAILABLE POINTER
+ JMP GETINF /GO FOR NEXT
+ PAGE
+\fCHGCHK, 0
+ CDF F0 /PRECAUTION
+ TAD CHANGD /HAS BLOCK BEEN MODIFIED?
+ SZA CLA
+ JMP I CHGCHK /NO, NOTHING TO DO
+ TAD CATBLK
+ DCA ZCATB /WRITE THE BLOCK
+ TAD (4200!F1
+ DCA ZCATC
+ JMS ZCAT
+ JMP I CHGCHK /OK
+/
+/
+GCATB, 0
+ CDF F0
+ TAD NXTCAT
+ CIA
+ TAD CATBLK /IS IT IN CORE?
+ SNA CLA
+ JMP SOEZ /YES, ITS EZ
+ TAD NXTCAT
+ CIA
+ TAD LIBBLK
+ TAD CATLEN
+ SPA SNA CLA /CHECK FOR INTERNAL ERROR
+ JMP FULCAT /**
+ TAD NXTCAT
+ DCA ZCATB
+ TAD (200!F1 /SET FOR READ
+ DCA ZCATC
+ JMS ZCAT
+ TAD NXTCAT /NEXT BLOCK
+ DCA CATBLK /IS IN CORE
+SOEZ, ISZ NXTCAT
+ JMP I GCATB
+NXTCAT, 0
+ PAGE
+\fLCLOSE, JMS CHGCHK
+ TAD USRCOD
+ TAD (-ENTER /DID WE ENTER A NEW FILE?
+ SZA CLA
+ JMP CATLST /NO, GO LIST CATALOG
+ TAD LIBBLK /GET LEN
+ CIA
+ CDF F1
+ TAD I (EQLO /GET USER EXTENSION REQUEST
+ CDF F0
+ TAD LAVAIL /PLUS CURRENT END
+ DCA TMP1
+ TAD TMP1
+ CLL
+ TAD LIBLEN /CHECK FOR POSSIBLE
+ SNL CLA
+ JMP .+4
+ TAD LIBLEN /CAN'T GIVE ALL HE WANTS
+ CIA
+ SKP
+ TAD TMP1
+ DCA LCLEN /SET CLOSE LENGTH
+ TAD CATLEN
+ CMA
+ TAD LCLEN /COMPARE CAT LEN TO LIB LEN
+ SPA SNA CLA
+ JMP NOLIB /THERE'S NO POINT
+ TAD LIBBLK /GET FIRST BLOCK
+ DCA NXTCAT
+ JMS GCATB
+ CDF F1
+ TAD LCLEN /ACTUAL LIBRARY LENGTH
+ DCA I (CATBUF+2
+ CDF F0
+ DCA CHANGD
+ JMS CHGCHK /WRITE IT
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR
+ CLOSE
+ LIBNAM
+LCLEN, 0
+ JMS IOERR
+ JMP CATLST /GO LIST THE CATALOG
+/
+NOLIB, JMS TTOTXT
+ WHYCLS-1
+ JMS CRLF
+ JMP START
+ PAGE
+\f/ LIST THE CATALOG
+/
+CATLST, JMS OOPEN /OPEN LISTING FILE
+ JMP START /NONE DESIRED
+ TAD (OCHAR /SETUP FOR DEVICE-INDEPENDENT
+ DCA PCHR /OUTPUT
+ TAD (214 /AT TOP OF PAGE
+ JMS I PCHR
+ JMS CRLF
+ JMS TTOTXT
+ LBV-1
+ JMS TTOTXT
+ CATOF-1
+ JMS PRLBNM /PRINT THE NAME
+ CDF F1
+ TAD I (SYSDAT
+ CDF F0
+ SNA
+ JMP NODATE /DON'T KNOW THE DATE
+ DCA TMP1
+ JMS TTOTXT
+ ON-1
+ CLA /THE FOLLOWING CODE GETS THE DAY
+ DCA TMP2
+ TAD TMP1 /GET THE DATE
+ RTR /ROTATE THREE RIGHT AND MASK
+ RAR /TO GET THE DAY IN OCTAL
+ AND (37
+ JMS MAK8BT /MAKE IT 8-BIT AND PRINT
+ DCA TMP2
+ TAD TMP1 /GET THE DATE BACK
+ AND (7400 /MASK TO GET THE MONTH BITS
+ JMS R6R /MONTH*4 (IN OCTAL)
+ DCA TMP2 /PUT IN TEMP. VARIABLE TO SAVE IT
+ TAD TMP2 /GET IT BACK
+\f RTR /MONTH
+ TAD TMP2
+ TAD (MONTHS-6
+ DCA .+2 /ADDRESS OF MONTH FROM TABLE
+ JMS TTOTXT /PUT IT IN THE TEXT LINE
+ 0
+ TAD TMP1 /GET THE DATE---TO FIND THE YEAR
+ AND (7 /MASK TO GET THE YEAR OFFSET BITS
+ DCA TMP4 /SAVE THEM
+ DCA TMP2
+ TAD I (7777 /GET THE DATE EXTENSION BITS
+ AND (600
+ CLL RTR /ROTATE TO GET THEM INTO BIT
+ RTR /POSITIONS 7 AND 8
+ TAD (106 /ADD 70(ORIGINAL BASE YEAR)
+ TAD TMP4 /ADD IN THE YEAR OFFSET BITS
+ JMS MAK8BT /MAKE 8-BIT AND PRINT
+NODATE, JMS CRLF
+ JMP PRCAT /TITLE IS DONE, PRINT CAT
+MAK8BT, 0 /ROUTINE TO CONVERT TO 8-BIT AND PRINT
+ CLL /FIRST CONVERT TO DECIMAL
+CONVYR, TAD (-12 /KEEP SUBTRACTING 12
+ SPA /HAVE THE YEAR
+ JMP GETDG1
+ ISZ TMP2 /HOLDS THE FIRST DIGIT OF YEAR
+ JMP CONVYR
+GETDG1, TAD (12 /GET THE SECOND DIGIT
+ DCA TMP3 /SAVE IT
+ TAD TMP2 /GET THE FIRST DIGIT
+ SNA /FIRST DIGIT IS A ZERO
+ JMP PRDIG2 /PRINT THE SECOND DIGIT
+ TAD (260 /MAKE FIRST DIGIT OF YEAR 8-BIT
+ JMS I PCHR /PRINT IT
+PRDIG2, TAD TMP3 /GET THE SECOND DIGIT
+ TAD (260 /MAKE SECOND DIGIT OF YEAR 8-BIT
+ JMS I PCHR /PRINT IT
+ JMP I MAK8BT /RETURN
+ PAGE
+\f/ LIST ALL ENTRIES IN THE CATALOG
+/
+PRCAT, TAD CATLEN
+ CIA
+ DCA TMP1
+ TAD LIBBLK
+ DCA NXTCAT
+ CLA CMA
+ DCA TMP3 /SET LINE COUNTER
+CATLUP, JMS GCATB
+ TAD (CATBUF-1
+ DCA X0
+ TAD (-100
+ DCA TMP2
+CATLP2, CDF F1
+ TAD I X0 /GET FIRST WORD OF NAME
+ SNA
+ JMP EMPTY /NOT AN ESD NAME
+ CMA
+ SNA
+ JMP NDCATL /END OF CATALOG
+ CMA /RESTORE FIRST WORD
+ JMS TTO2 /PRINT
+ JMP NDNAM /A SHORT NAME
+ CDF F1
+ TAD I X0
+ JMS TTO2
+ JMP NDNAM
+ CDF F1
+ TAD I X0
+ JMS TTO2
+ NOP
+NDNAM, ISZ TMP3 /MORE ROOM ON THIS LINE?
+ JMP SAMLIN /SURE
+ JMS CRLF
+ TAD (-10 /SETUP FOR 8 PER LINE
+ DCA TMP3
+ JMP EMPTY
+SAMLIN, JMS TAB /SPACE OVER TO NEXT NAME
+EMPTY, TAD X0
+ AND (-4
+ TAD (3
+ DCA X0 /POINT TO NEXT
+ ISZ TMP2
+ JMP CATLP2 /GO FOR NEXT
+ ISZ TMP1 /MORE BLOCKS?
+ JMP CATLUP /YES
+ JMS CRLF
+ JMS TTOTXT
+ CATFUL-1
+NDCATL, JMS CRLF
+ TAD (214 /EJECT PAGE
+ JMS I PCHR
+ JMS OCLOSE /CLOSE THE FILE
+ JMP START
+ PAGE
+\f/ USEFUL OUTPUT THINGS
+/
+TTO, 0
+ DCA TTOCHR
+ JMS TTWAIT
+ TAD (200
+ KRS
+ TAD (-217 /CRTL/O CHECK
+ SNA CLA
+ KSF
+ SKP
+ JMP I TTO
+ TAD TTOCHR
+ TLS
+ DCA TTFLAG
+ JMP I TTO
+TTOCHR, 0
+TTWAIT, 0
+ TAD TTFLAG
+ SNA CLA
+ JMP I TTWAIT
+ JMS CCHK /BEWARE OF CTRL/C
+ TSF
+ JMP .-2 /WAIT TILL DONE
+ DCA TTFLAG /CLEAR BUSY FLAG
+ JMP I TTWAIT
+CCHK, 0
+ KSF
+ JMP I CCHK /NOTHING TO WORRY ABOUT
+ TAD (200
+ KRS
+ TAD (-203
+ SNA CLA /WAS IT CONTROL C?
+ JMP I (7600 /YES
+ JMP I CCHK
+TTO2, 0
+ DCA TMP7
+ TAD TMP7
+ JMS R6R
+ JMS TTO2A
+ TAD TMP7
+ JMS TTO2A
+ ISZ TTO2
+ JMP I TTO2
+TTO2A, 0
+ AND (77
+ SNA
+ JMP I TTO2
+ TAD (-40
+ SPA
+ TAD (100
+ TAD (240
+ JMS I PCHR
+ ISZ TTPOS /BUMP POSITION COUNT
+ JMP I TTO2A
+\fR6R, 0
+ CLL RTR
+ RTR
+ RTR
+ JMP I R6R
+R6L, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I R6L
+TTOTXT, 0
+ CDF F0
+ TAD I TTOTXT
+ DCA X7
+ ISZ TTOTXT /BUMP PAST POINTER
+ TAD I X7
+ JMS TTO2
+ JMP I TTOTXT
+ JMP .-3
+CRLF, 0
+ DCA TTPOS /RESET POSITION
+ TAD (215
+ JMS I PCHR
+ TAD (212
+ JMS I PCHR
+ JMP I CRLF
+TAB, 0 /PSEUDO-TAB GENERATOR
+ TAD (240
+ JMS I PCHR
+ ISZ TTPOS
+ TAD TTPOS
+ AND (7
+ SNA CLA /IS POSITION A MULTIPLE OF 8
+ JMP I TAB
+ JMP TAB+1 /NO, TRY MORE
+ PAGE
+\fWAITOP, 0
+ TAD (277 /QUESTION
+ JMS TTO
+ DCA RETCHR
+WREP, JMS TTI /WAIT FOR REPLY
+ TAD (-215
+ SNA
+ JMP DFALT
+ TAD (215-240 /PRINTING?
+ SPA
+ JMP WREP /NO, TRY AGIAN
+ TAD (240
+ DCA RETCHR
+ TAD RETCHR
+ECHO, JMS TTO
+ JMS TTI
+ TAD (-215
+ SNA
+ JMP GOTREP
+ TAD (215-377 /LOOKOUT FOR RUBOUT!
+ SNA
+ JMP RUBOUT
+ TAD (377
+ JMP ECHO
+RUBOUT, JMS CRLF
+ JMP WAITOP+1
+GOTREP, ISZ WAITOP /GOT A REAL ANSWER
+DFALT, JMS CRLF
+ TAD RETCHR
+ JMP I WAITOP
+RETCHR, 0
+/
+TTI, 0
+ KSF /WAIT FOR A KEY
+ JMP .-1
+ KRB
+ AND (177 /TAKE CARE OF PARITY
+ TAD (-3 /CTRL C?
+ SNA
+ JMP I (7600 /YES
+ TAD (203 /GET ORGINIAL CHAR BACK
+ JMP I TTI
+PAGE
+\f/
+/ INPUT BUFFERRER AND STUFF
+/
+READIN, 0
+ CDF F0
+ TAD INBLK
+ TAD THSBLK /-FIRST BLOCK FOLLOWING BUFFER CONTENTS
+ CLL
+ TAD (MBUFS
+ SNL /IS IT IN CORE?
+ JMP MUSTRD /NO, WE HAVE TO DO A READ
+ CLL RTR
+ RTR
+ RAR /TIMES 400
+SETP, TAD (MODBUF /PLUSS BUFFER ADDR
+ DCA PMOD /POINTS TO BLOCK
+ ISZ INBLK /READY FOR NEXT
+ JMP I READIN
+MUSTRD, CLA /THIS ONE'S HARDER
+ TAD INBLK
+ DCA RDBLK
+ TAD INBLK
+ TAD (MBUFS
+ CIA
+ DCA THSBLK
+ JMS I MODDVH
+ MBUFS^200!F1
+ MODBUF
+RDBLK, 0
+ JMS IOERR
+ JMP SETP /OK
+\f/ ROUTINES TO SAVE AND RESTORE
+/ DEVICE HANDLER RESIDENCY TABLE
+/
+SAVRES, 0
+ TAD (DHRES-1
+ DCA X0
+ TAD (SVRES-1
+ DCA X1
+ JMS MOVRES
+ JMP I SAVRES
+RSTRES, 0
+ TAD (SVRES-1
+ DCA X0
+ TAD (DHRES-1
+ DCA X1
+ JMS MOVRES
+ JMP I RSTRES
+MOVRES, 0
+ TAD (-17
+ DCA TMP1
+ CDF F1
+ TAD I X0
+ DCA I X1
+ ISZ TMP1
+ JMP .-3
+ CDF F0
+ JMP I MOVRES
+SVRES=7400
+\f/ PRINT THE LIBRARY NAME
+/
+PRLBNM, 0
+ TAD LIBNAM
+ JMS TTO2 /FIRST 2 CHARS
+ JMP PREXT
+ TAD LIBNAM+1
+ JMS TTO2
+ JMP PREXT
+ TAD LIBNAM+2
+ JMS TTO2
+ NOP
+PREXT, TAD (".
+ JMS I PCHR
+ TAD LIBNAM+3
+ JMS TTO2
+ JMP I PRLBNM
+ JMP I PRLBNM
+ PAGE
+\f/ OUTPUT HANDLERS STOLEN FROM PIP
+OUFLD=F1
+OUCTL=MBUFS^200!4000!F1
+OUBUF=MODBUF
+/
+/ INITIALIZE FOR OUTPUT
+/
+OUSETP, 0
+ TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
+ CIA /NEGATE IT (PAL10 BLOWS)
+ DCA OUDWCT
+ TAD (OUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
+ JMP I OUSETP
+/
+/ STORE CHARACTERS IN OUTPUT BUFFER
+/ IN PS8 FORMAT (YOU KNOW, 3 CHARS
+/ IN 2 WORDS THE WRONG WAY)
+/
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+ TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, CDF F0
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+/
+/ MOVE OUTPUT FILE NAME TO FIELD 0
+/
+OFNAME, 0
+ TAD (OUTF2
+ DCA X0 /NAME OF CAT LIST FILE
+ CDF F1
+ TAD I X0
+ DCA OUFNAM /FIRST 2 CHARS
+ TAD I X0
+ DCA OUFNAM+1
+ TAD I X0
+ DCA OUFNAM+2
+ TAD I X0
+ SNA
+ TAD TXTCA /DEFAULT CAT EXT
+ DCA OUFNAM+3
+ CDF F0 /RESTORE FIELD
+ JMP I OFNAME
+OUFNAM, ZBLOCK 4
+TXTCA, 301
+ PAGE
+\fOOPEN, 0
+ CDF F1
+ TAD I (OUTF2 /GET DEVICE CODE, LEN
+ DCA OUELEN /HOLD IT A MO
+ JMS I (OFNAME /GET FILE NAME INTO FIELD 0
+ TAD OUELEN /CHECK FOR NULL FILE
+ SNA CLA
+ JMP I OOPEN /NOTHING TO OPEN
+ TAD OUNAME /RESET ENTER CALL
+ DCA OUBLK
+ TAD (IDEVH!1
+ DCA OUHNDL
+ TAD OUELEN /THE UNIT
+ CIF F1
+ JMS I USR
+ FETCH /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ JMS IOERR /HUH?
+ TAD OUELEN /UNIT AGAIN
+ CIF F1
+ JMS I USR
+ ENTER /ENTER OUTPUT FILE
+OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMS IOERR /YOU BLEW IT!!!
+ DCA OUCCNT
+ JMS I (OUSETP
+ ISZ OOPEN
+ JMP I OOPEN
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE STARTING BLOCK
+ TAD OUCTLW
+ JMS R6L
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE SIZE OF FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /EXCEED GIVEN LENGTH ?
+ JMS IOERR /YES - ERROR
+ CDF F0
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMS IOERR
+ JMP I OUTDMP
+\fOCLOSE, 0
+ TAD (232 /OUTPUT A CTRL/Z
+ JMS I PCHR
+FILLLP, JMS I PCHR
+ TAD (77
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES DON'T DO IT
+ TAD (4000!OUFLD /PUT IN FIELD AND WRITE BITS
+ JMS OUTDMP
+NODUMP, CIF CDF F1
+ TAD I (OUTF2
+ CDF F0
+ JMS I USR
+ CLOSE /CLOSE THE OUTPUT FILE
+OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
+OUCCNT, 0
+ JMS IOERR /ERROR WHILE CLOSING - BAD!!
+ JMP I OCLOSE /ALL DONE
+ PAGE
+\f/ MESSAGES
+/
+LBV, TEXT "LIBRA V "
+*.-1
+VMESG, VERS&70^7+VERS+6060
+ PATCH&77^100+40
+ 4000
+NONEIN, TEXT "MODULE NOT INCLUDED";0
+FLSTR, TEXT "LIBRARY MUST BE ON A FILE-STRUCTURED DEVICE";0
+SMALL, TEXT "INSUFFICIENT SPACE FOR LIBRARY";0
+NOTMOD, TEXT "INPUT NOT A MODULE";0
+TOOBIG, TEXT "INPUT TOO BIG FOR LIBRARY";0
+UNLIB, TEXT " IS NOT A LIBRARY";0
+NDUP, TEXT " IS DUPLICATE NAME";0
+KEEP, TEXT "; KEEP OLD OR NEW";0
+CATFUL, TEXT "CATALOG IS FULL";0
+NCLUD, TEXT ": INCLUDE";0
+WHYCLS, TEXT "LIBRARY TOO SMALL FOR USE; START OVER";0
+IOMSG, TEXT "I/O ERROR";0
+CATOF, TEXT "CATALOG OF ";0
+ON, TEXT " ON ";0
+CS197, TEXT ", 197";0
+MONTHS, TEXT "-JAN-@@@@@-FEB-@@@@@-MAR-@@@@"
+ TEXT "-APR-@@@@@-MAY-@@@@@-JUN-@@@@"
+ TEXT "-JUL-@@@@@-AUG-@@@@@-SEP-@@@@"
+ TEXT "-OCT-@@@@@-NOV-@@@@@-DEC-@@@@"
+ $
+\f
--- /dev/null
+/ OS/8 F4 LOADER, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/ FIXES FOR V23 J.K. 1975
+/
+/ .CORE ROUTINE- RECONIZE CORE RESTRICTION
+/
+/
+/
+/ CHAMGES FOR OS/8 V3D AND OS/78 BY P.T.
+/ .CHANGED VERSION NUMBER TO 24A
+/ .PUT IN NEW DATE ALGORITHM
+/
+/
+VERNUM=24
+PATCH="A
+
+ESDPG= 7400 /START OF ESD REFERENCE PG IN FIELD 1
+LHDR= 7200 /WD0 IN CORE OF LDR HDR IN FIELD 1
+OS8SWS= 7643
+OSJSWD= 7746
+OS8DCB= 7760
+OSDATE= 7666
+AC7776= CLL STA RAL
+AC7775= CLL STA RTL
+AC4000= CLA STL RAR
+AC2000= CLA STL RTR
+AC0002= CLA STL RTL
+
+/ PASS0 DEFINITIONS
+/ ----- -----------
+
+MCTTBL= 6000 /MODULE COUNT TABLE BASE
+OVTLEN= 2^20^7+2+1 /2 WORDS/OVERLAY, 2 FOR MAIN & 1 FGL
+OVLTBL= MCTTBL-OVTLEN /(FGL = FOR GOOD LUCK)
+MODTBL= 21^7+MCTTBL+3 /START OF MODULE TABLE
+NUMMOD= 7200-MODTBL%3 /NUMBER OF ENTRIES IN MODULE TABLE
+PTRIO= NDX6 /FLD1;INIT SET TO 7617-1
+RALFBF= 7000 /FLD1;BLK TO READ"ESD"FOR FILE CHK
+\f/LOADER IMAGE HEADER BLOCK DUMMY SECTION
+
+ NOPUNCH
+ *LHDR
+ 2 /LOADER IMAGE FILE ID
+QRTSWP, ZBLOCK 2 /SWAPPER ARGS TO LOAD AND START USER MAIN
+QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED BY THIS PROGRAM
+QVERNO, 0 /LOADER VERSION NUMBER
+QDPFLG, 0 /"D.P. HARDWARE REQUIRED" FLAG
+QUSRLV, ZBLOCK 40 /USER OVERLAY LEVEL DSRN INFO
+LDBUFS, ZBLOCK 50 /PASS2 BUFFER POINTERS
+ ENPUNCH
+
+
+ /RTS ENTRY POINTS
+ /** SOME OF THESE MAY CHANGE IN FUTURE VERSIONS OF RTS **
+ /** (I HOPE NOT)
+
+JARGER= 204
+JBAK= 210
+JDATE= 203
+JDEF= 213
+JDISMS= 412
+JENDF= 211
+JEOFSW= 16
+JEXIT= 223
+JHANG= 524
+JIDLE= 227
+JINT= 403
+JRDAO= 217
+JREADO= 221
+JRENDO= 206
+JRETRN= 235
+JREW= 212
+JRSVO= 207
+JRUO= 215
+JSWAP= 222
+JT812= 225
+JUERR= 204
+JWDAO= 216
+JWRITO= 220
+JWUO= 214
+\f *0
+TMP0, 0 /TMP0-TMP4 FOR GEN. USE
+TMP1, 0
+TMP2, 0
+TMP3, 0
+
+ *10 /INDEX REGISTERS
+NDX0, 0
+NDX1, 0
+NDX2, 0
+NDX3, 0
+NDX4, 0
+NDX5, 0
+NDX6, 0
+NDX7, OVLTBL-1 /POINTER INTO OVERLAY LENGTH TABLE
+
+USR, 200 /USR CALL: COULD BE 200 OR 7700
+PPACK, PACK /CHANGED TO TTYO BY ERROR ROUTINE
+IOFLG, 0
+SYMTM3, SYMTBL-3
+ORGFLG, 0
+RFPTR1, 0
+GPTR, 0
+LBPTR, 0
+TRPCNT, 0
+P2FLG, 0
+CZFLG, 0
+F1FLG, 0
+S8FLG, 0
+OVRFLO, -1
+SWITZ, -1
+SVMAIN, -4 /0 IF /S SPECIFIED
+DPFLG, 0
+
+\f/MORE PAGE ZERO LOCATIONS
+GTYP, 0
+EPTR, 0
+EPT2, 0
+ETYP, 0
+BPTR, 0
+BPT2, 0
+REFPTR, 0
+RLEN, 0
+FTMP0, 0;0
+RBLK, 0
+FATAL, 0
+BP, LDBUFS /POINTER INTO PASS2 BUFFER ARRAY
+A1, 1;0 /CURRENT ADDRESS IN FIELDS 1-7
+LNONUM, 0
+LBCNT, 0
+BLKCNT, 0
+TRAPV, 0;0
+BLKSIZ, 0
+BSECTP, 0 /POINTER INTO BINARY SECTION TABLE (PASS 2)
+OUTINH, 0
+BLKBEG, 0
+NEWBLK, 0
+NEWLEN, 0
+MCNT, 0
+MBGCNT, 0
+TMP4, 0
+TMP5, 0
+ PAGE
+\f/LOADER STARTS AT 200
+
+ ISZ .+2 /NON-CHAIN ENTRY
+ JMP I .+1 /CHAIN ENTRY
+ START
+
+/COME HERE TO READ/WRITE THE LOADER IMAGE.
+
+LDRIO, 0 /AC=4000 FOR WRITE, 0 FOR READ
+ DCA LDRIOC /STORE READ/WRITE
+ JMS I (NEWBUF
+ TAD BP
+ DCA LDRIOA
+ ISZ LDRIOA
+ TAD I LDRIOA
+ DCA LDRIOB /BLOCK #
+ ISZ LDRIOA
+ TAD I LDRIOA /NUMBER OF BLOCKS LEFT IN SECTION
+ SPA SNA
+ JMP LDRIOR /NULL BUFFER - JUST IN CASE
+ TAD [-4
+ SMA
+ CLA /IF >4 BLOCKS LEFT ONLY DO 4
+ TAD [4
+ CLL RTR
+ RTR
+ RTR
+ TAD LDRIOC /ADD READ/WRITE
+ CDF 0
+ TAD I (OUTFLD
+ TAD (-CDF
+ DCA LDRIOC /STORE R/W + BLOCK COUNT + FLD BITS
+ TAD BLKBEG
+ DCA LDRIOA
+ JMS I [IOHAN /DF MUST BE 0 HERE!
+ LIMGU /LOADER IMAGE FILE
+LDRIOC, 0
+LDRIOA, 0
+LDRIOB, 0
+ CDF 10
+LDRIOR, CLA
+ JMP I LDRIO
+\fSETBGX, 0
+ CLA IAC
+ TAD GPTR
+ JMS SETBPT /EXTREMELY COMMON SEQUENCE
+ JMP I SETBGX
+
+SETBPT, 0
+ DCA BPTR /STORE BPTR
+ CLA IAC
+ TAD BPTR
+ DCA BPT2 /AND PTR TO NEXT WD
+ JMP I SETBPT
+ORGMSG, TEXT /ILLEGAL ORIGIN/
+SYMMSG, TEXT /OVER SYMB/
+IOMSG, TEXT %LOADER I/O ERROR%
+ENTMSG, TEXT %OS/8 ENTER ERROR%
+ PAGE
+\f/TTYHAN- TTY HANDLER FOR OUTPUT OF ANY MESSAGE IN ANY FIELD.
+/ MESSAGE MUST BE FIELD CONTAINED & TERMINATE WITH 0
+/ HANDLER CAN BE CALLED ACROSS FLDS WITH AC CLR.
+/ RTN WITH"IF & DF" SET TO CALLING FLD.
+/
+/ CALL CDF X /X=FLD OF CALLER*10
+/ CIF Y /Y=FLD OF TTYHAN*10
+/ JMS TTYHAN
+/ CDF Z /Z=FLD OF MESS.BUF
+/ BUFADR /MESS BUF. ADDR.
+/
+TTYHAN, 0
+ TAD (6203 /SETUP MICRO INSTR
+ RDF /CDF & CIF FOR RTN
+ DCA CRLFF+1
+ TAD I TTYHAN /SET UP FLD OF
+ DCA TTYCDF /MESS BUF
+ ISZ TTYHAN
+ CMA
+ TAD I TTYHAN /SET UP MESS BUFF ADDR-1
+ DCA MESADR
+ ISZ TTYHAN
+ DCA MESADR+1
+TTYCDF, 0
+ JMS CRLF
+TTYLP, ISZ MESADR+1
+ JMP .+3
+ TAD I MESADR
+ JMP HAF
+ ISZ MESADR
+ CLA CMA
+ DCA MESADR+1
+ TAD I MESADR
+ RTR
+ RTR
+ RTR
+HAF, AND [77
+ SNA
+ JMP CRLFF
+ TAD [240
+ AND [77
+ TAD [240
+ JMS TTYO
+ JMP TTYLP
+CRLFF, JMS CRLF
+ 0
+ JMP I TTYHAN
+MESADR, 0
+ 0
+\fRTNOS8, 0 /HERE ON PASS1 FATAL ERROR
+ STA
+ CDF 10
+ DCA I (OVLTBL /PRINT SYMBOL MAP W/O OVERLAY LENGTH TABLE
+DOMAP, JMS I (SYMMAP
+ CDF
+ TAD I RTNOS8 /ADDR OF TTY
+ DCA .+3 /MSG
+ JMS I [TTYHAN
+ CDF
+ 0
+ TAD (TTYO
+ DCA PPACK /FAKE OUT SYMBOL PRINTER
+ TAD LNONUM
+ DCA GTYP /PUT LEVEL AND OVERLAY IN GTYP
+ JMS I (CVLOVL /OUTPUT LEVEL AND OVERLAY
+ AC7775
+ DCA TMP5 /PRINT 3 DIGIT FILE-WITHIN-OVERLAY
+ TAD MCNT
+ TAD MBGCNT
+ IAC
+ CLL RTL
+ RAL
+ JMS I (CVRT
+ JMS CRLF /OUTPUT CRLF AFTERWARDS
+ JMP I .+1 /RTN TO
+ 7605 /OS8
+
+LDRNAM, 1;0617;2224;2216;1404 /SYS:FORTRN.LD
+ ZBLOCK 5 /NO DEFAULT SYMBOL MAP DEVICE
+
+TTYO, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYO
+/
+CRLF, 0
+ TAD (215
+ JMS TTYO
+ TAD (212
+ JMS TTYO
+ JMP I CRLF
+\f/OS8ER- USED WHEN AN OS/8 ERROR OCCURS WHICH IS FATAL
+
+OS8ER, 0
+ CDF 0
+ JMS I [TTYHAN
+ CDF 0 /FLD OF MESS BUF
+ SYSERR /ADR OFMESS BUF
+ JMP I [7605 /RTN TO OS8
+
+SYSERR, TEXT /SYSTEM ERROR/
+TYTBL, 4040 /CHARS FOR SMAP
+ 0530 /EX (EXTERN)
+ 4040 /GOOD TYPES ARE
+ 4040 /SPACES
+ 1505 /ME (MUL ENTRY)
+ 1523 /MS (MUL SECTN)
+ 4040 /GEN 8MOD SECT
+ 4040 /8MOD COM SECT
+ 4040 /8MOD F1 SECT
+ PAGE
+\f/IOHAN- I/O HANDLER 1)FETCHES A OS8 DEVICE HANDLER;
+/ 2)CHKS FOR E.O.FILE;3)ISSUES CALL TO THE HANDLER.
+/ RTN TO CALLER WITH "IOFLG" SET IF
+/ NUM OF BLKS TRANSF LESS THAN REQ AMT.
+/ CAN BE CALLED FROM ANY FLD
+/ IF AC=0,DO ALL OF THE ABOVE.
+/ IF AC=DEV NUM,DO ONLY "FETCH"PART
+/
+/ CALL CDF X
+/ CIF Y
+/ JMS IOHAN
+/ ADDR /PTR TO UNIT,LEN,STBLK OF FILE IN FLD 1
+/ ARG(1)/OS8 ARG: FCN CTRL WD
+/ ARG(2)/ " : TRNASF BUF ADR
+/ ARG(3)/ " : REL STBLK OF TRANSF
+/
+IOHAN, 0
+ DCA UNITSV /SAV DEV NUM IF ONE
+ DCA IOFLG /CLR FLG
+ RDF
+ TAD P6201
+ DCA GETCDF+1
+ TAD P6203 /SETUP CIF & CDF FOR
+ RDF /RTN JMP
+ DCA RTNIO
+/FETCH A DEV HANDLER OR LOOKUP ENTRY PT
+/IF DESIRED HANDLER IS IN CORE
+ TAD UNITSV /GET DEV NUM IF ONE
+ SNA CLA /JUST A FETCH?
+ JMP .+3 /NO
+ JMS INQIRE /YES
+ JMP RTNIO
+ TAD I IOHAN /GET PTR TO UNIT(DEV NUM)
+ DCA ULSADR
+ CDF 10
+ TAD I ULSADR /GET DEV NUM
+ AND [17
+ SNA
+ JMS I [OS8ER
+ DCA UNITSV
+ JMS INQIRE
+/CHK FOR E.O.FILE
+ ISZ IOHAN
+ JMS GETCDF
+ TAD I IOHAN /GET FCN CTRL WD
+ CLL RTL /NUM OF PAGES IS CONVRTED
+ RTL /TO NUM BLKS & PUT
+ RTL /IN BITS 8-11
+ AND [17
+ DCA TMP0 /NUM BLKS TO TRANSF
+\f/SETUP FCN CTRL WD; TRANSF BUF ADR; & ABS STBLK OF TRANSF
+/FOR OS8 CALL TO HANDLER
+ TAD I IOHAN /FCN CTRL WD
+ DCA FCNWD
+ ISZ IOHAN
+ TAD I IOHAN /TRANSF BUF ADR
+ DCA FCNWD+1
+ ISZ IOHAN
+ TAD I IOHAN /GET REL STBLK & BUILD
+ TAD TMP0 /ABS STBLK
+ CIA CLL
+ ISZ ULSADR
+ CDF 10
+ TAD I ULSADR /FILE LEN-(REL STB+NUM BLKS)
+ SNL SZA /E.O.FILE CONDITION?
+ JMP .+3 /YES
+ CLA /NO
+ JMP SETSBN
+ TAD TMP0
+ SMA SZA /ANY BLKS TO TRANSF?
+ JMP IOH /YES
+ CLA /NO
+/CHK IF FILE LEN=0; IF SO DO SEQ STUFF
+ TAD I ULSADR
+ SNA CLA /SEQ DEV?
+ JMP IOH+1 /YES
+ CMA /NO,=-1 IF NUM BLKS TRANSF L.T. REQ
+ DCA IOFLG
+ JMP RTNIO
+IOH, DCA TMP0 /THIS NUM OF BLKS
+/UPDATE FCN CTRL WD IN OS8 CALL
+ TAD FCNWD
+ AND (4077 /REMOVE REQ NUM OF PGS
+ DCA FCNWD /& PUT IN THE
+ TAD TMP0 /ALTERED NUM
+ CLL RTR
+ RTR
+ RTR
+ TAD FCNWD
+ DCA FCNWD
+ CMA /=-1 IF NUM BLKS TRANSF L.T. REQ
+ DCA IOFLG
+/SETUP STARTING BLK NUMBER
+/
+SETSBN, ISZ ULSADR
+ CDF 10
+ TAD I ULSADR /GET ABS STBLK
+ JMS GETCDF /GET DF
+ TAD I IOHAN /ADD REL STBLK
+ DCA FCNWD+2
+ TAD I IOHAN /UPDATE REL STBLK
+ TAD TMP0 /BY NUM BLKS OF TRANSF
+ DCA I IOHAN
+\f/CALL TO THE HANDLER
+P6203, CIF CDF 0 /IOHAN & OS8 DEV HAN IN FLD 0
+ KSF /CHK FOR CTRLC
+ JMP .+5
+ KRS
+ TAD (-203
+ SNA CLA
+ JMP I [7605
+ JMS I IOENT
+FCNWD, 0
+ 0
+ 0
+ JMP HNDERR /ERROR RETURN OF CALL
+ ISZ IOHAN
+RTNIO, 0 /CIF INSTR
+ JMP I IOHAN
+IOENT, 0
+ULSADR, 0
+UNITSV, 0
+/
+GETCDF, 0
+ 0
+ JMP I GETCDF
+
+HNDERR, JMS I [RTNOS8
+ IOMSG
+\f/INQIRE- DETERMINE IF DESIRED DEV HANDLER IS IN CORE
+/ & IF SO,GET ITS ENTRY PT
+ DVTBL=7647
+INQIRE, 0
+ CDF 10
+ TAD UNITSV
+ TAD (DVTBL-1
+ DCA IOENT /ADR OF ENRTY PT IN RESID. TBL
+ TAD I IOENT /GET ENTRY PT IF ONE
+ DCA IOENT
+ TAD IOENT
+ SZA CLA /DEV HAN WAS IN CORE?
+ JMP I INQIRE /YES
+ TAD (7201 /NO
+ DCA P6201+4
+ TAD UNITSV /GET DEV NUM BK
+P6201, CDF 0
+ CIF 10
+ JMS I USR
+ 1
+ 0
+ JMS I [OS8ER
+ TAD .-2
+ DCA IOENT
+ JMP I INQIRE
+ PAGE
+\fNXTESD, 0
+ ISZ EPTR /ADV PTR TO
+ ISZ EPTR /WD 0 OF
+ TAD EPTR /NEXT ENTRY
+ AND [377 /IF AT BLK
+ SNA CLA /BOUNDARY
+ TAD [4 /BUMP IT FOUR
+ TAD EPTR
+ JMS I [SETEPT
+ TAD [3 /CHECK FOR
+ TAD EPTR /END OF
+ DCA TMP0 /ESD
+ TAD I TMP0 /TYPE WD
+ AND [17 /TO AC B8-B11
+ SZA /LAST ESD?
+ ISZ NXTESD /NO
+ DCA ETYP /SAVE TYPE
+ JMP I NXTESD
+\fADVOVR, 0 /UPDATE PASS1 PASS2 ARGS
+ ISZ MCNT /MORE MODS IN THIS OVR?
+ JMP SAMOVR /YES
+ JMS NXTOVR /SET ARGS FOR NEXT OVER
+ JMP EOLVL /RTN HERE= END OF LEVEL
+ TAD P2FLG /DOING PASS2 ?
+ SMA CLA
+ JMP BY10 /NO
+ TAD (2 /GET NEW LDR
+ TAD BSECTP /IMAGE REL BLK
+ DCA TMP0 /FOR NEXT OVR
+ TAD TMP0
+ DCA NDX0
+ TAD I NDX0 /LENGTH OF OVERLAY
+ TAD I TMP0 /PLUS OLD RELATIVE BLOCK
+ DCA I TMP0 /EQUALS NEW RELATIVE BLOCK
+BY10, TAD LNONUM /ADD 1 TO BITS
+ TAD (20 /4-7 OF LEVEL
+ DCA LNONUM /AND OVR LAY NUM
+ JMP SAMOVR
+EOLVL, JMS NXTOVR /GET NXT OVR NEW LEVEL
+ JMP SAMOV4 /HERE=END OF ALL LEVELS
+ TAD LNONUM /ADD 1 TO
+ AND [3400 /THE LEVEL
+ TAD (400 /BITS (1-3)
+ DCA LNONUM /AND CLEAR THE OVR BITS
+ TAD P2FLG
+ SMA CLA /DOING PASS2 ?
+ JMP BY7 /NO
+ TAD [4
+ TAD BSECTP /UPDATE BIN SECTION PTR
+ DCA BSECTP
+ JMP SAMOVR
+\fBY7, ISZ I (LEVSYM+2 /SET THE INTERNAL LEVEL SYMBOL TO LEVLN+1
+ TAD (LEVSYM /ENTER NEW
+ JMS I [LOOK /LEVEL SYMBOL INTO GST
+ TAD [4
+ TAD LNONUM /SET TYPE
+ DCA I GPTR /TO PROG SECTION
+ IAC /SET PTR TO
+ TAD GPTR /NEW LEVEL
+ DCA I [LVPTR
+LEVRND, TAD I BPT2
+ CLL
+ TAD [377 /ROUND UP OLD LEVEL
+ AND [7400 /TO A BLOCK BOUNDARY
+ SZL
+ ISZ I BPTR /MIND THE CARRIES!
+ DCA I BPT2
+SAMOVR, TAD [3 /ADV PTR TO
+ TAD RFPTR1 /NXT RALF
+ DCA RFPTR1 /MODULE
+ JMP I ADVOVR
+SAMOV4, ISZ ADVOVR /BUMP RETURN
+ TAD P2FLG
+ SPA CLA
+ JMP SAMOVR /SKIP ROUNDUP IF PASS 2
+ JMS I (LEVLUP /MERGE OVERLAY SIZE INTO LEVEL SIZE
+ JMP LEVRND /AND RND UP LAST LEVEL
+\fNXTOVR, 0 /HERE AT END OF OVERLAY
+ ISZ MTBL /GET NUM OF
+ TAD I MTBL /MOD IN NXT
+ SNA /OVR
+ JMP I NXTOVR /=END OF LEVEL
+ DCA MBGCNT
+ TAD MBGCNT
+ CIA
+ DCA MCNT
+ TAD P2FLG
+ SMA CLA
+ JMS I (LEVLUP /SET CUR. LEVL =MAX (CUR LEVL, CURNT OVR)
+ ISZ NXTOVR /RTN P+1 IF
+ JMP I NXTOVR /NOT END OF LEVEL
+
+
+SETCNT, 0
+ TAD (MCTTBL+1 /PTR TO MOD
+ DCA MTBL /COUNT TBL
+ TAD I MTBL /-NUM IN
+ DCA MBGCNT
+ TAD MBGCNT
+ CIA /MAIN
+ DCA MCNT
+ TAD (MODTBL+3 /PTR TO TOP
+ DCA RFPTR1 /OF MOD TBL
+ DCA I (OVRSIZ
+ DCA I (OVRSIZ+1
+ JMP I SETCNT
+MTBL, 0
+ PAGE
+\f/LOOKUP OR ENTER A SYMBOL INTO
+/GLOBAL SYMBOL TABLE (GST). PTR
+/TO SYMBOL IN FIELD 1 IS IN
+/AC. USUALLY ITS AN ESD.
+/RTN P+1=NO MATCH
+/RTN P+2=MATCH
+
+LOOK, 0
+ DCA TMP0 /PTR TO SYM
+ CDF 10
+ TAD I TMP0 /SELECT
+ RTR /BUCKET
+ RTR /A-Z, SPACE
+ RTR /OR POUND
+ AND [77
+ TAD (BUCKET-1 /PTR TO BUCKET
+LOP5, DCA TMP1 /PTR TO PREV ENTRY
+ TAD I TMP1 /PTR TO NEXT ENTRY
+ SNA /0=BUCKET BOTTOM
+ JMP HOOKIN /NO MATCH
+ IAC /APPEND SYMBOL
+ DCA GPTR /LOOK FOR
+ AC7775 /3 WORD MATCH
+ DCA TMP2
+ TAD TMP0
+ DCA EPTR
+YUCCH, TAD I EPTR
+ CIA CLL
+ TAD I GPTR
+ SZA CLA
+ JMP YECCH /SYMBOLS DIFFER
+ ISZ EPTR
+ ISZ GPTR
+ ISZ TMP2 /ALL MATCH?
+ JMP YUCCH /NO
+ ISZ LOOK /BUMP RTN
+SETTYP, TAD I EPTR /GET ESD TYPE
+ AND [17
+ DCA ETYP
+ CLA IAC
+ TAD EPTR
+ JMS I [SETEPT /BUMP EPTR AND SET EPT2
+ TAD I EPTR /GET ESD NUM
+ RTR /IN B1-B7
+ RTR /AND SET
+ AND (177 /REFERENCE
+ TAD (ESDPG /POINTER
+ DCA REFPTR
+ TAD I GPTR /SET GST
+ AND [17 /TYPE
+ DCA GTYP /FIELD BITS OF
+ TAD I EPTR /VALUE WORDS
+ AND [7 /CLR
+ DCA I EPTR /HI 9
+ JMP I LOOK
+\fYECCH, SZL /IS NEW GUY LESS THAN GST ENTRY?
+ JMP HOOKIN /YES HOOK-IN HERE
+ TAD I TMP1
+ JMP LOP5 /TRY NEXT
+HOOKIN, TAD I TMP1 /GET FWD LINK
+ DCA I NDX4 /TO NEXT INTO
+ TAD NDX4 /NEW. PUT FWD
+ DCA I TMP1 /LINK TO NEW INTO PREV.
+ TAD TMP0 /3 SYM
+ DCA EPTR /INTO GST
+ AC7775
+ DCA TMP2
+ TAD I EPTR
+ DCA I NDX4
+ ISZ EPTR
+ ISZ TMP2
+ JMP .-4
+ ISZ NDX4 /SET PTR TO
+ TAD NDX4 /WORD 4 (TYPE)
+ DCA GPTR /OF GST
+ ISZ NDX4 /SET PTR TO NEXT
+ ISZ NDX4 /FREE ENTRY
+ TAD [7 /SEE IF
+ TAD NDX4 /GST IS FULL
+ TAD ENDSYM /END OF GST
+ SPA SNA CLA
+ JMP SETTYP /ITS OK
+ JMS I [RTNOS8 /SYMBOL TABLE
+ SYMMSG /OVER FLOW
+ENDSYM, 1-OVLTBL
+
+SETEPT, 0
+ DCA EPTR
+ CLA IAC
+ TAD EPTR
+ DCA EPT2 /SET PTR TO BOTH WDS OF DBLWD
+ JMP I SETEPT
+\fGETTYP, 0 /ADV GST PTR
+ TAD [7 /TO WD 4 OF
+ TAD GPTR /ENTRY
+ DCA GPTR /CHECK FOR
+ TAD GPTR
+ TAD ENDSYM
+ SMA CLA
+ JMP I GETTYP
+ TAD I GPTR /END OF GST.
+ SZA CLA /IF NOT END,
+ ISZ GETTYP /ISZ RETURN.
+ JMP I GETTYP
+
+OLINE, 0 /OUTPUT A LINE OF TEXT TO THE SYMBOL MAP
+ DCA TMP5
+OLINLP, TAD I TMP5
+ JMS I (HAFWD
+ TAD I TMP5
+ ISZ TMP5
+ AND [77
+ SZA CLA
+ JMP OLINLP
+ JMS I [PCRLF /DOUBLE SPACE AFTERWARDS
+ JMS I [PCRLF
+ JMP I OLINE
+ PAGE
+\f/HERE TO OUTPUT SYMBOL MAP
+/EACH SYMBOL IN GST IS 7 WORDS LONG
+/THE FORMAT IS:
+/WD0 PTR TO NEXT ALPHABETICAL SYMBOL
+/WD1 SYMBOL NAME IN PACKED SIX BIT
+/WD2 ASCII. 00 IS INTERPRETED AS SPACE
+/WD3 SIX CHARS MAX PER SYMBOL
+/WD4 B0=1=TRAP VECT SYMBOL ON PASS1 OR
+/ B0=1=PASS2 ERROR, B1-B3=LEVEL NUM
+/ (0-7) B4-B7=OVERLAY NUM (0-17)
+/ B8-B11=TYPE. TYPE FORMAT IS:
+/ 0=END OF ESD TBL (NA TO LDR)
+/ 1=ENTRY POINT
+/ 2=EXTERN
+/ 3=COMMON SECTION
+/ 4=PROGRAM SECTION
+/ 5=MULTIPLE ENTRY POINT
+/ 6=MULTIPLE SECTION
+/ 7=GENERAL 8-MODE SECTION
+/ 10=FIELD1 8-M0DE SECTION
+/ 11=COMMON PG0 8-MODE SECTION
+/ 12-17=UNDEFINED
+/
+/WD5 B0-B8=PTR TO PARENT SYMBOL (0R 0)
+/ ON PASS1 =TRAP VECTOR DISPLACEMENT
+/ ON PASS2
+/ B9-B11=FIELD BITS OF SYMBOL
+/WD6 ADDR BITS OF SYMBOL
+
+/OUTPUT FORMAT OF MAP IS:
+/
+/SYMBOL VALUE LEVEL OVRNUM TYPE(*)
+/
+/THE TYPE COLUMN IS EITHER 2 BLANKS OR
+/EX=EXTERN
+/ME=MULTIPLE ENTRY POINT
+/MS=MULTIPLE SECTION
+/ASTERISK MEANS SOME TYPE OF ILLEGAL
+/REFERENCE TO A SYMBOL AND USUALLY
+/MEANS A LOADER ORIGINATED TRAP HAS
+/BEEN GENERATED SOMEWHERE IN THE BINARY
+/E.G. SUBR GROG AT LEVEL 2 CALLS SUBR
+/COLUMBO AT LEVEL 1. A USER 7 TRAP
+/WOULD BE GENERATED IN SUBR GROG, AND
+/THE SYMBOL COLUMBO WOULD HAVE AN
+/ASTERISK ASIDE OF IT IN THE TYPE
+/COLUMN
+\fSYMMAP, 0
+ CDF
+ TAD I (LDRNAM+5 /MAP UNIT
+ SNA /IS IT 0 ?
+ JMP NOMAP /YES, NO MAP TO OUTPUT
+ JMS I [IOHAN /FETCH HANDLER
+ TAD I (LDRNAM+5 /ENTER OUTPUT
+ CIF 10
+ JMS I USR
+ 3
+MPBLK, LDRNAM+6
+ 0
+ JMP ENTERR /WHOOPS WE HAVE AN ENTER ERROR
+ TAD I (LDRNAM+5
+ AND [17
+ CDF 10
+ DCA I (SMAPU /STORE SYMBOL MAP UNIT
+ TAD (SMAPU /SYMMAP ARGS
+ DCA NDX0 /FOR I/O
+ TAD MPBLK+1 /LENGTH
+ CIA
+ DCA I NDX0
+ TAD MPBLK
+ DCA I NDX0
+ TAD (BUCKET /START AT 1ST
+ DCA RLEN /BUCKET (A)
+ TAD (-42 /DO UP UNTIL BUT NOT INCL.
+ DCA RBLK /POUND SIGN
+ AC7775 /INIT PACK ARGS
+ DCA FATAL
+ TAD (RALFBF
+ DCA TMP4
+ TAD SM600
+ DCA BLKCNT
+ JMS I [PCRLF
+ TAD (TLINE
+ JMS I (OLINE
+ TAD (STLINE
+ JMS I (OLINE /OUTPUT TITLE AND SUBTITLE
+ TAD I RLEN /1ST SYM
+LOP10, DCA GPTR
+ TAD GPTR /ANY MORE IN
+ SZA /THIS BUCKET ?
+ JMP JOUSYM /YES
+ ISZ RLEN /NXT BUCKET
+ ISZ RBLK /DONE ALL
+ JMP LOP10-1 /NO
+ ISZ SWITZ /BEEN HERE BEF?
+ JMP DUNMP /YES ALL DONE
+ CLA CMA /SET FOR JUST
+ DCA RBLK /POUND SYMS
+ TAD SVMAIN
+ SNA /DO ONLY #MAIN?
+ JMP LOP10-1 /NO - DO ALL # SYMBOLS
+PRMAIN, CLA /** REPLACED WITH JMS I (OUTSYM **
+\fDUNMP, TAD [-4 /OUT PUT
+ DCA TMP5 /THE HIGHEST LOCATION
+ TAD A1 /USED BY THE PROGRAM
+ TAD (4060 /FLD BITS
+ JMS HAFWD
+ TAD A1+1
+ JMS I (CVRT
+ TAD (HLINE
+ JMS I (OLINE /PRINT " = HIGHEST LOC USED"
+ JMS I (PROVLY /PRINT OVERLAY TABLE
+SM600, CLA /** AC NOT 0 ON RETURN**
+ TAD (214
+ JMS I PPACK
+ TAD (232 /CTRL Z
+OUFILP, JMS I PPACK
+ TAD BLKCNT /HAVE WE FILLED
+ TAD [600 /A BLOCK UP COMPLETELY?
+ SZA CLA
+ JMP OUFILP /NO
+ CDF /CLOSE SYMMAP
+ TAD I (SYLST /AC=LENGTH
+ DCA SMPCLN
+ TAD I (LDRNAM+5 /MAP UNIT
+ CIF 10
+ JMS I USR
+ 4
+ LDRNAM+6
+SMPCLN, 0
+ JMS I [OS8ER
+NOMAP, CDF 10
+ JMP I SYMMAP
+JOUSYM, JMS I (OUTSYM
+ TAD I GPTR /NEXT SYM TO DO
+ JMP LOP10
+\fHAFWD, 0 /OUTPUT THE 2 6 BIT ASCII CHARS IN AC
+ DCA TMP3
+ TAD TMP3 /LEFT HALF 1ST
+ RTR
+ RTR
+ RTR
+ JMS SIXTO8
+ TAD TMP3
+ JMS SIXTO8
+ JMP I HAFWD
+
+SIXTO8, 0 /CVRT AC FROM
+ AND [77 /6 TO 8 BIT ASCII
+ SZA
+ TAD [240 /TURN ZEROS TO BLANKS
+ AND [77
+ TAD [240
+ JMS I PPACK /PUT IN BUFF IN PS/8 FORMAT
+ JMP I SIXTO8
+
+ENTERR, DCA I (DOMAP /CANCEL SYMBOL MAP FROM RTNOS8
+ JMS I [RTNOS8 /AS WE MASY HAVE COME FROM SYMMAP
+ ENTMSG
+ PAGE
+\f/PACK ASCII IN AC INTO OUTPUT BUFF IN
+/OS/8 3 WORD FORMAT TO 2 12 BIT WORDS
+
+PACK, 0
+ ISZ FATAL /3RD WORD ?
+ JMP ONEOR2 /NO
+ DCA TMP0 /SAVE CHAR
+ AC7776 /BU BUFF PTR
+ TAD TMP4
+ DCA TMP4
+ AC7775
+ DCA FATAL /RESET CNTR
+ JMS ROL /POSITION HI
+ DCA I TMP4
+ ISZ TMP4
+ JMS ROL /POSITION LO
+ONEOR2, DCA I TMP4
+ ISZ TMP4
+ ISZ BLKCNT /BLOCK FULL ?
+ JMP I PACK /NO
+ JMS WRBUF
+ TAD SBPTR
+ DCA TMP4 /RESET ARGS
+ TAD (-600
+ DCA BLKCNT
+ JMP I PACK
+
+ROL, 0
+ TAD TMP0 /3RD CHAR
+ RTL /POSITION
+ RTL /BITS
+ DCA TMP0 /SAV FOR NXT CALL ON LO
+ TAD TMP0
+ AND [7400
+ TAD I TMP4 /ADD IN OLDY
+ JMP I ROL
+
+WRBUF, 0 /WRITE OUT
+ CDF /SYM MAP
+ JMS I [IOHAN /BUFFER
+ SMAPU /ADDR OF SYM U
+ 200^1!4000!10 /1 BLK OF FLD 1
+SBPTR, 7000 /1ST ADDR
+SYLST, 0 /REL BLK
+ CDF 10
+ JMP I WRBUF
+\fCVRT, 0 /CONVERT AC TO
+ DCA CVRTMP /ASCII NUM
+ TAD TMP5 /-NUM OF DIGITS
+ DCA TMP1 /TO CONVERT
+LOP7, TAD CVRTMP /CVRT LEFT TO
+ RTL /RIGHT
+ RAL /3 BITS PER
+ DCA CVRTMP /DIGIT
+ TAD CVRTMP
+ RAL
+ AND [7
+ TAD (260
+ JMS I PPACK
+ ISZ TMP1 /ENOUGH ?
+ JMP LOP7 /NO
+ JMS I (HAFWD /OUTPUT A PAIR
+ JMP I CVRT /OF SPACES
+
+OUTSYM, 0 /DO ONE SYMBOL
+ DCA NDX1 /ADDRESS IN AC ON ENTRY
+ AC7775
+ DCA TMP2
+ TAD I NDX1 /SYMBOL IS 1ST
+ JMS I (HAFWD
+ ISZ TMP2
+ JMP .-3
+ TAD I NDX1 /SAVE
+ DCA GTYP /TYPE
+ TAD I NDX1 /FLD OF SYMBOL
+ JMS PR15
+ JMS CVLOVL /CONVERT ADDR, LEVEL, OVERLAY
+ TAD GTYP /NOW DO TYPE
+ AND (17 /ITS B8-B11
+ TAD (TYTBL-1 /PTR TO TBL OF
+ DCA TMP0 /CHAR PAIRS FOR
+ CDF 0
+ TAD I TMP0 /TYPE EG EX FOR
+ CDF 10
+ JMS I (HAFWD /EXTERN
+ TAD GTYP /IF ERROR WAS
+ SPA CLA /FOUND DURING PASS2 B0 OF TYPE=1 EG ILLEGAL SUBR CALL. * ON MAP INDICATES
+ TAD (12 /PASS2 ERROR
+ TAD [240
+ JMS I PPACK
+ JMS PCRLF
+ JMP I OUTSYM
+
+CVRTMP, 0
+\fCVLOVL, 0
+ CLA CMA
+ DCA TMP5 /DO LEVEL NUM
+ TAD GTYP /ITS B1-B3 OF
+ RAL /OF TYPE WORD
+ JMS CVRT
+ AC7776 /DO OVER NUM
+ DCA TMP5 /ITS B4-B7 OF
+ TAD GTYP /TYPE WORD
+ RTL /POSITION INTO
+ AND (1700 /HI 2 DIGITS
+ JMS CVRT
+ JMP I CVLOVL
+
+PCRLF, 0
+ TAD (215 /EOL
+ JMS I PPACK
+ TAD (212
+ JMS I PPACK
+ JMP I PCRLF
+
+PR15, 0
+ AND [7
+ TAD (4060
+ JMS I (HAFWD
+ TAD [-4 /NOW DO ADDR OF
+ DCA TMP5 /SYMBOL
+ TAD I NDX1
+ JMS CVRT
+ JMP I PR15
+ PAGE
+\f/PASS 2 OF LOADER - TRANSFORMS BINARIES INTO LOADER IMAGE FILE
+
+PASS2, DCA LNONUM /SET FOR MAIN
+ JMS I (BLDTV /BUILD TRAP VECTOR
+ TAD LBCNT /PROCESS LIBR
+ CIA /MODULES 1ST
+ SNA /ANY TO DO?
+ JMP BY12 /NO
+ DCA LBCNT /=-NUM TO DO
+ TAD LBPTR /PTR TO 1ST
+ DCA RFPTR1 /LIBR MOD
+ JMS SETREF /INIT RELOC ARGS AND PROCESS TXT
+ TAD [3 /ADV TO NXT
+ TAD RFPTR1 /LIBR MOD.
+ DCA RFPTR1
+ ISZ LBCNT /DONE LIBR?
+ JMP .-5 /NO
+BY12, JMS I (SETCNT /SET ARGS TO PROCESS USER MODS.
+ JMS SETREF /DO 1 MOD
+ JMS I (ADVOVR /ADVANCE ARGS
+ JMP .-2 /RTN HERE IF MORE TO DO
+ JMS I (WRALL /WRITE OUT ALL THE RESIDENT BIN BLOCKS
+\f/END OF PASS 2 - RETURN TO OS8 OR CHAIN TO RSYS
+
+ TAD (7616
+ DCA NDX0
+ TAD I (LIMGU /SAVE UNIT AND BLOCK OF LOADER IMAGE
+ DCA I NDX0 /FILE IN CD AREA IN CASE WE CHAIN
+ TAD I (LIMGU+2
+ DCA I NDX0 /TO THE RUN-TIME-SYSTEM
+ DCA I NDX0 /A PRECAUTION
+ CDF 0
+ CIF 10
+ JMS I USR
+ 10 /LOCK USR IN
+ TAD (200
+ DCA USR
+ TAD I (LDRNAM
+ CIF 10
+ JMS I USR
+ 4
+ LDRNAM+1 /CLOSE LOADER IMAGE FILE
+LDCLEN, 0
+ JMS I [OS8ER /OOPS!
+ JMS I (SYMMAP /PRINT SYMBOL TABLE IF REQUESTED
+ TAD I (OS8SWS
+ CDF 0
+ AND (40 /TEST /G SWITCH
+ SNA CLA
+ JMP I [7605 /NOT ON - RETURN TO OS8
+ CLA IAC
+CHAIN, CIF 10
+ JMS I USR
+CHCODE, 2
+ RTSNAM /LOOKUP RTS
+ 0
+ JMP NORTS
+ TAD (6
+ DCA CHCODE /CHANGE LOOKUP TO CHAIN
+ JMP CHAIN
+
+NORTS, DCA I (LDRNAM+5 /KILL SECOND STORAGE MAP
+ JMS I [RTNOS8
+ RTSMSG
+RTSNAM, 0622;2423;0000;2326 /FRTS.SV
+\fSETREF, 0
+ JMS I (RDRLES /GET MODULE ESD TABLE
+ AC7776
+ DCA EPTR
+LOP12, JMS I .+4 /GET NXTESD
+ JMP BY11 /ALL DONE
+ TAD EPTR /LOOK UP
+ JMS I [LOOK /SYMBOL
+ NXTESD
+ CLA CMA /IGNORE ESD IF
+ TAD ETYP /ITS AN ENTRY
+ SNA CLA /POINT
+ JMP LOP12 /IGNORE
+ TAD GPTR /PUT ADDR OF
+ DCA I REFPTR /GST SYM IN
+ JMP LOP12 /ESD REF. PAGE
+BY11, CDF 0 /COMPUTE 1ST
+ TAD EPTR /TEXT BLK
+ AND [7400
+ CLL RTL
+ RTL
+ RAL
+ IAC
+ DCA I (TXTBLK
+ CLA CMA /SET CNT TO -1
+ DCA BLKCNT /TO KICK OFF 1ST TXT READ
+ TAD RFPTR1 /PTR TO
+ DCA I (TXTBLK-3 /RALF MOD
+ CDF 10
+ JMS I (TXTSCN /RELOCATE
+ JMP I SETREF /TEXT
+ PAGE
+\fBLDTV, 0 /BUILD UP
+ TAD TRPCNT /TRAP VECTOR
+ SNA CLA /ANY TO DO?
+ JMP I BLDTV /NO
+ TAD .+2 /GET BASE
+ JMS I [LOOK /ADDR OF
+ TRPSYM /TRAP VECT
+ ISZ GPTR
+ TAD I GPTR
+ DCA TMP0
+ ISZ GPTR
+ TAD I GPTR
+ DCA TMP1
+ TAD TMP0 /FOR SUBR
+ DCA TRAPV /TRPVEC
+ TAD TMP1
+ DCA TRAPV+1
+ JMS NEWORG /PROCESS NEW ORIGIN
+ DCA TRPCNT /WILL BE USED TO MARK GST SYMS
+ TAD .+2 /THAT HAVE A VECTOR ENTRY
+ JMS I [LOOK /GET SWAPPER
+ SWPSYM /ADDR
+ ISZ GPTR
+ ISZ GPTR
+ TAD I GPTR
+ DCA RFPTR1
+\f TAD SYMTM3 /SCAN GST
+LOP11, DCA GPTR /FOR ALL
+ JMS I [GETTYP /TRAP SYMS
+ JMP I BLDTV /ALL DONE
+ TAD I GPTR /IF TYPE WD
+ SMA CLA /B0=1, THEN SYMBOL NEEDS A VECTOR ENTRY
+ JMP LOP11+1 /TRY NEXT 1ST WD OF ENTRY IS
+ TAD (3000 /TRAP3
+ JMS I [PUTBIN
+ TAD RFPTR1 /NXT IS
+ JMS I [PUTBIN /SWAP ADDR
+ CLL CML CLA RAR /CLR B0
+ TAD I GPTR /OF TYPE WD
+ DCA I GPTR
+ TAD I GPTR
+ ISZ GPTR
+ RTL
+ RTL
+ DCA TMP0 /HAVE TO MUSH SOME BITS AROUND:
+ TAD TMP0 /OVERLAY NUMBER MOVES FROM B4-7 TO B0-3
+ AND [7400
+ DCA TMP1 /LEVEL NUMBER MOVES FROM B1-3 TO B6-8
+ TAD TMP0
+ RTL
+ RTL
+ AND (70
+ TAD TMP1
+ TAD I GPTR /ADD FLD BITS TO MESS
+ JMS I [PUTBIN
+ TAD TRPCNT /ADV VECT
+ TAD (10 /ENTRY NUM
+ DCA TRPCNT /COUNTER
+ TAD I GPTR /TAG HI 9
+ TAD TRPCNT /OF GST SYM
+ DCA I GPTR /WD5 WITH TV ENTRY NUMBER
+ ISZ GPTR
+ TAD I GPTR /ENTER
+ JMS I [PUTBIN /ADDR
+ AC7776
+ TAD GPTR
+ JMP LOP11 /FOR THIS SYM
+\fNEWORG, 0
+ TAD BSECTP
+ JMS I [SETEPT /SET PTR TO CURRENT SECTION
+ TAD I EPT2
+ CIA CLL
+ TAD TMP1
+ DCA TMP3
+ TAD TMP3
+ AND (6000
+ DCA TMP2 /DO A DOUBLE PRECISION SUBTRACT
+ CML RAL
+ TAD I EPTR
+ CIA CLL
+ TAD TMP0
+ SPA
+ JMP BADORG /OUT OF RANGE
+ CLL RAR
+ TAD TMP2 /COMBINE AND SHIFT RIGHT 8
+ RAL
+ RTL
+ RTL /(I.E. LEFT 5)
+ DCA TMP2
+ TAD TMP2
+ ISZ EPT2
+ TAD I EPT2 /ADD TO RELATIVE BLOCK OF SECTION
+ DCA NEWBLK
+ ISZ EPT2
+ TAD TMP2
+ CIA
+ TAD I EPT2
+ SPA
+ JMP BADORG /ORIGIN OUT OF RANGE
+ DCA NEWLEN
+ JMS I (NEWBB /GET BUFFER USING NEWBLK AND NEWLEN
+ TAD TMP3
+ AND (1777
+ TAD BLKBEG
+ DCA BLKSIZ /FORM POINTER INTO PROPER BUFFER
+ JMP I NEWORG
+BADORG, JMS I [RTNOS8
+ ORGMSG /ORIGIN OUT OF CURRENT FILE LIMITS
+ JMP I NEWORG
+ PAGE
+\fPROVLY, 0 /ROUTINE TO PRINT OVERLAY INFO IN SYMBOL MAP
+ JMS I [PCRLF
+ TAD (OTLINE
+ JMS I (OLINE
+ TAD (OVLTBL-1
+ DCA NDX1
+PROVLP, TAD I NDX1 /GET ENTRY
+ SPA /TEBLE ENDS WITH -1
+ JMP I PROVLY
+ DCA GTYP
+ TAD [240
+ JMS I PPACK
+ JMS I (CVLOVL /PRINT LEVEL AND OVERLAY
+ TAD GTYP
+ JMS I (PR15 /PRINT 15-BIT LENGTH
+ JMS I [PCRLF
+ JMP PROVLP
+
+RDRLES, 0 /READ A
+ TAD RFPTR1 /PTR TO RALF
+ DCA RLARG-1 /MOD
+ DCA RLARG+2 /STRT AT BLK 0
+ CDF /AND READ
+ JMS I [IOHAN /3 BLKS INTO
+ 0 /10000-11400
+RLARG, 200^3!10
+ 0
+ 0
+ CDF 10
+ JMP I RDRLES
+\f/STARTING WITH THE LATEST,
+/WRITE OUT ALL CORE RESIDENT
+/BINARY BUFFERS
+
+WRALL, 0
+ TAD BP
+ IAC /PTR TO
+ DCA TMP0 /CURNT BLK
+ TAD I TMP0
+ SNA CLA /ALL DONE ?
+ JMP I WRALL /YES
+ AC4000
+ JMS I (LDRIO /WRITE IT
+ TAD I BP
+ SNA
+ JMP I WRALL
+ DCA BP
+ JMP WRALL+1
+
+NOTREL, JMS I [RTNOS8
+ RELMSG
+
+RELMSG, TEXT /BAD INPUT FILE/
+
+RTSMSG, TEXT /NO FRTS/
+\fMERGE, 0
+ JMS I (GETTXT /COMBINE TXT
+ DCA FTMP0 /PAIR WITH
+ JMS I (GETTXT /PAIR WHOSE
+ DCA FTMP0+1 /ADDR IS IN BPTR
+ CLL
+ TAD I BPT2
+ TAD FTMP0+1
+ DCA TMP1
+ RAL
+ TAD I BPTR
+ TAD FTMP0
+ AND [7
+ DCA TMP0
+ TAD FTMP0 /GET THE OPCODE OR WHATEVER
+ AND [7770 /IS IN THE HIGH 9 BITS
+ TAD TMP0 /AND COMBINE THEM WITH THE RELOCATED ADDRESS
+ JMS I [PUTBIN /AND OUTPUT THE MESS
+ TAD TMP1
+ JMS I [PUTBIN /DON'T FORGET WORD 2
+ JMP I MERGE
+
+GETCTL, 0 /GET TEXT
+ JMS I (GETTXT /CTRL WORD
+ DCA TMP0 /B4-B11
+ TAD TMP0 /IS TYPE
+ AND [377 /INDICATOR
+ DCA REFPTR /SOMETIMES
+ TAD REFPTR /ITS AN ESD.
+ TAD (ESDPG /WHEN IT IS,
+ DCA GPTR /GPTR PNTS
+ TAD I GPTR /TO THE
+ DCA GPTR /CORRESPONDING GST SYM (WORD 4)
+ JMS I [SETBGX /AND BPTR POINTS TO THE VALUE
+ TAD TMP0 /TEXT TYPE
+ RTL /IS IN
+ RTL /B0-B3
+ RAL /PUT IN
+ AND [17 /AC8-AC11
+ TAD GETCTL
+ DCA GETCTL /USE IT TO BUMP RETURN ADDRESS
+ JMP I GETCTL
+ PAGE
+\f/COME HERE ON ORIGIN OR WHEN CROSSING
+/AN AREA BOUNDARY TO SELECT A BINARY
+/CORE BUFFER FOR A NEW LOADER IMAGE
+/AREA. THE BINARY BUFFER TABLE
+/ASSOCIATES CORE BUFFERS TO LOADER
+/IMAGE AREAS.
+
+/EACH ENTRY HAS FOUR WORDS - THEY CONTAIN:
+
+/WORD 1 POINTER TO BUFFER OF NEXT EARLIEST REFERENCE
+/WORD 2 RELATIVE BLOCK NUMBER (0 IF UNUSED)
+/WORD 3 NUMBER OF BLOCKS LEFT UNTIL END OF SECTION
+/WORD 4 BUFFER ADDRESS AND FIELD
+
+/EACH ENTRY MAPS FROM 1 TO 4 BLOCKS (400 TO 2000 OCTAL WORDS) FROM THE
+/ADDRESSES GENERATED BY THE LOADER ONTO THE LOADER IMAGE FILE.
+/THE RELATIVE BLOCK NUMBERS ARE ALWAYS OF THE FORM S+4N, WHERE
+/S IS THE RELATIVE BLOCK NUMBER OF THE NEAREST BINARY SECTION
+/ (A BINARY SECTION IS AN OVERLAY OR "MAIN").
+
+/THE BUFFERS ARE ORGANIZED AS A CHAIN IN ORDER OF REFERENCE,
+/WITH WORD 1 BEING THE LINK TO THE NEXT EARLIEST BUFFER. IN CASE
+/A BUFFER NEEDS TO BE WRITTEN THE CHAIN IS TRAVERSED AND THE LAST BUFFER
+/WRITTEN OUT, SINCE IT WAS THE LEAST RECENTLY ACCESSED.
+\fNEWBB, 0 /ENTER WITH NEW
+ TAD BP
+ DCA NDX5 /SAVE CURRENT "MOST RECENT" BUFFER
+ TAD I NDX5
+ CIA
+ TAD NEWBLK /CHECK WHETHER THE BUFFER WE WANT
+ SNA CLA /IS THE CURRENT BUFFER
+ JMP QUIKIE /YES - SAVE GRIEF
+NEWBB4, TAD BP /MAKE THE CURNT
+ DCA BPPREV /BUFFER THE PREVIOUS BUFF
+ TAD I BP /MAK THE BUF OF
+ DCA BP /NEXT EARLIEST REFERENCE THE NEW CURNT BUFF
+ TAD BP /GET THE PTR TO
+ IAC /LDR IMAGE BLK
+ DCA CURBLK /IN THIS BUFF
+ TAD I CURBLK /HAVE WE SCANNED
+ CIA /IS NEWBLK
+ TAD NEWBLK /IN CORE
+ SNA CLA /?
+ JMP GOTBLK /YES
+ TAD I BP /ARE WE AT THE
+ SZA CLA /BUFFER OF EARLIEST REF?
+ JMP NEWBB4 /NO DO NEXT
+ STL /INITIALIZE LINK AS FLAG
+ TAD I CURBLK /IS THERE A
+ SNA CLA /BLK TO WRITE?
+ JMP VIRGIN /NO - NONE TO READ, EITHER
+ AC4000
+ JMS I (LDRIO /YES WRITE IT
+ CLL /SET FLAG THAT BUFFER WAS WRITTEN
+VIRGIN, TAD NEWBLK
+ DCA I CURBLK
+ ISZ CURBLK
+ TAD NEWLEN /STORE NEW BLOCK # AND LENGTH
+ DCA I CURBLK /IN BUFFER CONTROL WORD
+ RAR /GET "VIRGIN FLAG"
+ DCA NEWBUF
+ TAD MAXBLK
+ CMA CLL
+ TAD NEWBLK /CHECK IF THE BLOCK WE'RE MAPPING
+ SNL CLA /IS LARGER THAN ANY OTHER SO FAR -
+ JMP .+3 /IF SO WE DON'T HAVE TO READ IT
+ TAD NEWBLK
+ DCA MAXBLK /UPDATE MAXBLK
+ TAD NEWBUF /LINK = MAX FLAG, SIGN = VIRGIN FLAG
+ SNL SMA CLA /IF NEITHER IS ON,
+ JMS I (LDRIO /READ THE BLOCKS INTO THE BUFFER
+GOTBLK, TAD I BP
+ DCA I BPPREV /BREAK NEW BUFFER OUT OF THE CHAIN
+ STA
+ TAD NDX5 /NDX5 CONTAINS PTR TO OLD "MOST RECENT" + 1
+ DCA I BP /MAKE NEW BUFFER THE BUFFER OF LATEST REFERENCE
+QUIKIE, JMS NEWBUF /SET UP FOR PUTBIN
+ JMP I NEWBB /AND RETURN
+\f/COME HERE TO CUMPUTE A 15 BIT
+/BUFFER ADDRESS FROM AN ENTRY
+/IN THE BINARY BUFFER TABLE.
+
+NEWBUF, 0
+ TAD [3
+ TAD BP
+ DCA OUTFLD
+ TAD I OUTFLD /LOAD ADRESS AND FIELD
+ AND (7600
+ DCA BLKBEG
+ TAD I OUTFLD
+ AND (70
+ TAD (CDF
+ DCA OUTFLD /DECOMPOSE INTO ADDRESS AND CDF
+ JMP I NEWBUF
+
+BPPREV, 0
+MAXBLK, 0
+\f/COME HERE TO STORE 1 WORD
+/IN SOME BINARY OUTPUT BUFFER
+
+PUTBIN, 0
+ DCA TMP2 /SAVE DATA
+ TAD ORGFLG /N.E. 0 MEANS
+ SZA CLA /INHIBIT
+ JMP I PUTBIN /BINARY OUTPUT BECAUSE OF NEW ORIGIN
+ TAD OUTINH /N.E. 0 MEANS
+ SNA CLA /INHIBIT BIN OUT BECAUSE OF BAD ORIGIN
+ JMP OUTFLD /ITS OK
+ TAD I OUTINH /SET B0 OF
+ RAL /OFFENDING GST
+ CLL CML RAR /SYMBOL
+ DCA I OUTINH /SEE SUBR REORG
+ JMP I PUTBIN /FOR DEFINITION OF C(OUTINH)
+OUTFLD, 0 /CDF X
+ TAD TMP2 /STORE IT
+ DCA I BLKSIZ /AWAY
+ CDF 10 /RESTORE FLD
+ ISZ BLKSIZ /BUMP PTR
+ TAD BLKBEG
+ CIA
+ TAD BLKSIZ /HAVE WE
+ AND (1777 /CROSSED A
+ SZA CLA /BLK BOUND?
+ JMP I PUTBIN /NO
+ TAD NEWBLK
+ TAD [4
+ DCA NEWBLK
+ TAD NEWLEN
+ TAD [-4
+ DCA NEWLEN /BUMP BLOCK NUMBER AND REMAINING BLOCKS
+ JMS NEWBB /SELECT A NEW BUFFER
+ TAD BLKBEG
+ DCA BLKSIZ /RE-INITIALIZE WORD POINTER
+ JMP I PUTBIN
+CURBLK, 0
+ PAGE
+\f/COME HERE TO SCAN AND RELOCATE
+/THE TEXT OF AN ENTIRE MODULE
+
+TXTSCN, 0 /SET CTRL WD
+ JMS I (GETCTL /ARGS. RTN TO .+1,2,3, OR 4
+ JMP RELC2 /SPECIAL TYPE
+ JMP RELC6 /DIRECT COPY
+ JMP REORG /NEW ORIGIN
+ TAD I GPTR /RELOCATE FPP
+ AND [17 /PAIR
+ DCA TMP0 /GST SYM TYPE
+ AC7776 /IS RELOCATION
+ TAD TMP0 /WITH RESPECT
+ SZA CLA /TO GST EXTERN?
+ JMP BY2 /NO
+SETTRP, JMS GETTXT /BAD TEXT.
+ CLA
+ JMS GETTXT /IGNORE RELOCATION AND MAKE AN ERROR TRAP
+ CLA
+ TAD (3000 /=TRAP3
+ JMS I [PUTBIN
+ TAD (JUERR /RTS ERROR
+ JMS I [PUTBIN /TRAP SUBR
+BY2M5, TAD I GPTR /SET ILLEGAL
+ RAL /REFERENCE
+ CLL CML RAR /BIT IN
+ DCA I GPTR /GST TYPE WD
+ JMP TXTSCN+1 /DO NEXT
+BY2, TAD (-5 /RELOCATE TO
+ TAD TMP0 /A MULTIPLE
+ SNA CLA /ENTRY?
+ JMP SETTRP /YES
+ TAD I GPTR /CHECK FOR LEGALITY OF REFERENCE
+ AND (0360 /WITH RESPECT TO LEVEL AND OVERLAY NUMBER
+ DCA TMP1 / = GST OVER NUM
+ TAD LNONUM /=CURNT MOD
+ AND [3400 /LEVEL NUM
+ DCA TMP2
+ TAD I GPTR
+ AND [3400
+ SNA /RELOCATE TO MAIN?
+ JMP RELC /YES, ITS OK
+ CIA /IS RELOCATION
+ TAD TMP2 /ACROSS LEVELS
+ SZA /?
+ JMP TSTTRP /YES
+ TAD LNONUM /=CURRENT MOD
+ AND (0360 /OVER NUM
+ CIA
+ TAD TMP1 /WITHIN LEVL CALL IS LEGAL ONLY
+ SNA CLA /IF WITHIN OVR ALSO.
+ JMP RELC /ITS OK
+\f /** TSTTRP REPLACED BY "SKP CLA" IF /U SPECIFIED
+TSTTRP, SMA CLA /NOT OK - IS X LEVL LO TO HI?
+ JMP SETTRP /NO
+ TAD I BPTR /TRAP VECT
+ TAD [7770 /SUBTRACT 1 FROM ENTRY NUM
+ AND [7770 /IN HIGH 9 BITS OF GST WD 5
+ CLL RAR /DIV BY 2 TO GET ENTRY NUM * 4
+ TAD TRAPV+1 /LINK IS 0
+ DCA I (SYMX+1 /STORE VECTOR ENTRY ADDRESS
+ RAL
+ TAD TRAPV /IN SYMX AS A DOUBLEWORD
+ DCA I (SYMX
+ TAD (SYMX
+ JMS I [SETBPT /COMBINE IT WITH TXT PAIR
+ JMS I (MERGE /I.E. RELOCATE TO TRAP VECT
+ TAD FTMP0
+ AND [7
+ SNA
+ TAD FTMP0+1
+ SNA CLA /WERE LOW ORDER 15 BITS OF TXT=0?
+ JMP TXTSCN+1 /YES, ITS OK
+ JMP BY2M5 /SET ILL REF BIT. NOTE TRAP IS NOT GENERATED
+
+RELC, JMS I (MERGE /MAKE FPP PAIR AND STORE IN BIN BUFFER
+ JMP TXTSCN+1 /DO NEXT
+RELC2, TAD REFPTR /CHK IND.
+ SNA CLA /FOR SPECIAL TYPE
+ JMP I TXTSCN /0=END OF TEXT
+ JMP TXTSCN+1 /1=IGNORE 1 WORD OF TEXT
+RELC6, TAD REFPTR /IND HOLDS
+ CIA /NUM OF WDS
+ DCA REFPTR /TO COPY
+ JMS GETTXT
+ JMS I [PUTBIN
+ ISZ REFPTR
+ JMP .-3
+ JMP TXTSCN+1
+REORG, ISZ ORGFLG /SET INHIBIT BIN OUT FLG
+ JMS I (MERGE /GET NEW ORIGIN
+ TAD I GPTR /SEE IF
+ AND (3760 /ORIGIN IS
+ CIA /TO A DIFFERENT
+ TAD LNONUM /BINARY SECTION
+ SZA CLA /?
+ TAD GPTR /YES - SET INHIBIT/ERROR FLAG
+ SNA
+ JMS I (NEWORG /NO - SET UP NEW ORIGIN
+ DCA OUTINH
+ DCA ORGFLG
+ JMP TXTSCN+1
+\fGETTXT, 0 /GET ONE WORD OF TEXT FROM THE BUFFER
+ ISZ BLKCNT
+ JMP RDTCDF
+ CDF /TO READ IN
+ JMS I [IOHAN /RALF TEXT
+ 0 /PTR TO UNIT
+ 200^4!10 /OR 200^17!20
+ 0
+TXTBLK, 2
+ TAD .-2 /SET TXT
+ DCA RBLK /BUF PTR
+ TAD TXTWDS /-NUM OF
+ DCA BLKCNT /WDS-1 IN
+RDTCDF, CDF 10 /OR CDF 20
+ TAD I RBLK
+ CDF 10
+ ISZ RBLK
+ JMP I GETTXT /RETURN
+TXTWDS, -2000 /OR -7400
+ PAGE
+\f/ENTER A SYMBOL INTO GST. PTR TO ESD
+/SYMBOL IS IN AC
+
+ JMP I PUTSYM /FOR XPAGE RTN
+PUTSYM, 0
+ JMS I [LOOK /LOOKUP SYMBOL
+ JMP I (NOMAT /NEW SYMBOL DISPOSITION
+/TYPE OF MATCH 2 EXTERNS, 2 COMMONS, ETC.
+/ETYP HOLDS SYM TYPE FOR ESD GTYP HOLDS GST TYPE
+
+ TAD (5
+ DCA TMP0 /FOR ME,MS
+ TAD ETYP
+ TAD (-7
+ SPA
+ TAD (2
+ TAD [4
+ RAR CLL
+ CMA
+ DCA TMP2
+ CML CMA /GET -1
+ TAD GTYP /RESTR LNK, GET GST TYP-1
+ RAL
+ TAD (MYSTIC /GET ADDR OF 4 CODES
+ DCA TMP1
+ CDF 0
+ TAD I TMP1 /GET 4 CODES
+ CDF 10
+CTST, ISZ TMP2 /WHICH CODE ?
+ JMP SHFT3 /NOT THIS 1
+ AND [7
+ TAD T2J /PICK UP JMP I
+ DCA .+1
+ 0
+T2J, JMP I .+1
+ ISCOM3 /FORT COMM N FLD1 SECTION
+ PUTSYM-1 /ESD IS EXT JUST EXIT
+ REP /GST IS EXT GO REPLACE
+ MULENT /MULTIPLE ENTS
+ ISCOM /2 F COMMS OR 2 COMMZS OR 2 FLD1S
+ BADDY /MULTIPLE SECTS
+ BADDY /UNDEF TYPES
+ BADDY
+ BADDY
+SHFT3, RAR
+ RTR
+ JMP CTST
+\fBADDY, TAD MCNT
+ TAD MBGCNT
+ DCA MTMCNT /SAVE PARAMS FOR ERROR MESSAGE LATER
+ CLA IAC
+ TAD LNONUM /MULTIPLE SECTION
+ DCA FATAL
+ ISZ TMP0 /IS FATAL
+MULENT, TAD I GPTR /SET TYPE TO
+ AND (7760 /5 FOR MUL ENT
+ TAD TMP0 /OR 6 FOR
+ DCA I GPTR /MUL. SECTION
+ JMP I PUTSYM
+
+ISCOM3, TAD (11 /F COMM N FLD1 (RITE9=11)
+ DCA I GPTR /SET TYP TO F1
+ ISZ F1FLG
+ISCOM, JMS I [SETBGX
+ TAD BPTR /UPDATE
+ DCA I REFPTR /ESD REFERENCE PTR
+ JMS I (MAXCOM /PUT LARGER OF 2 COMMONS INTO
+ JMP I PUTSYM /GST WORDS 5 AND 6
+MTMCNT, 0
+\f/THE FOLOWING TABLE IS USED TO
+/DISPOSITION SYMBOL MATCHES BETWEEN
+/A RALF ESD AND A GST SYMBOL
+/EACH DIGIT IN THE TABLE IS AN INDEX
+/INTO A TABLE THAT IS USED TO CALL
+/ROUTINES TO HANDLE THE VARIOUS TYPES
+/OF MATCHES:
+/ 0=FORT COMMON AND FLD1 SECTION
+/ 1=ANY MATCH WITH ESD EXTERN
+/ 2=ANY MATCH WITH GST EXTERN
+/ 3=MULTIPLE ENTRY POINTS
+/ 4=2 FORT COMMONS OR 2 FIELD1
+/ SECTIONS OR 2 COMMZ SECTS
+/ 5=MULTIPLE SECTIONS
+/ 6-7=UNDEFINED AND HALT
+/
+/THE FIRST 2 WORDS COVER ALL POSSIBLE
+/MATCHES WITH GST TYPE 1, THE SECOND
+/TWO WORDS ARE FOR GST TYPE 2 ETC
+/THE 4 DIGITS IN THE FIRST WORD OF
+/ANY PAIR CORRESPOND TO ESD TYPES
+/11,7,3,1 RESPECTIVELY
+/ESD CORRESPONDENCE FOR THE 2ND WORD
+/IS 12,10,4,2
+/ESD TYPE 12 IS UNDEFINED
+
+MYSTIC, 5553 /G1 E(11,7,3,1)
+ 7551 /E(12,10,4,2)
+ 2222 /G2 E(11,7,3,1)
+ 7221 /E(12,10,4,2)
+ 0545 /G3
+ 7551
+ 5555 /G4
+ 7551
+ 5553 /G5
+ 7551
+ 5555 /G6
+ 7551
+ 5555 /G7
+ 7551
+ 5555 /G10
+ 7451
+ 4505 /G11
+ 7551
+\f
+ESDSCN, 0
+ CLL STA RTL /-3
+ TAD I (0
+ SZA CLA
+ JMP I (NOTREL /NOT RALF MODULES - NASTY!
+ TAD I (2 /CHK FOR DP
+ SPA CLA /HARDWARE REQUIRED
+ ISZ DPFLG /ISZ=YES
+ AC7776 /ENTER ESD OF MODULE
+ DCA EPTR /INTO GST. ESD STARTS AT 10000
+ JMS I (NXTESD /GET NXT 1
+ JMP I ESDSCN /NO MORE
+ TAD EPTR
+ JMS PUTSYM /ENTER IT
+ JMP .-4 /DO ANOTHER
+
+MSMSG, TEXT /MULT SECT/
+CORMSG, TEXT /OVER CORE/
+LIMSG, TEXT /OVER IMAG/
+MNMSG, TEXT /NO MAIN/
+ PAGE
+\f/CONTINUATION OF SUB PUTSYM
+
+REP, DCA GTYP
+ AC7775 /REPLACE GST
+ TAD ETYP /EXTERN
+ SNA /IS IT A REF TO COMMON?
+ JMP MNSECN /YES
+ TAD M4 /IS IT A REF
+ SMA CLA /8 MODE SECN ?
+ JMP NOMAT
+ TAD I GPTR /NO CHK FOR
+ AND [3400 /CROSS LEVEL
+ CIA /REFERENCE
+ DCA TMP0 /COMPARE WITH
+ TAD LNONUM /CURNT LEVEL
+ AND [3400
+ SNA /DOING MAIN ?
+ JMP NOMAT /YES DONT CHK FOR TRAP ENTRY
+ TAD TMP0
+ SNA CLA /X LEVEL?
+ JMP NOMAT
+ ISZ TRPCNT /YES BUMP TRAP VECTOR COUNTER
+ AC4000 /SET B0=1, GST SYM WILL GO IN TRAP VECTOR
+NOMAT, DCA GTYP
+ TAD ETYP /ENTER GST
+ TAD (.+3-1 /WORDS 4,5,6.
+ DCA TMP0 /DISPATCH ESD
+ JMP I TMP0 /TYPE 1,2,3,4
+ JMP ENTMN2 /ENTRY POINT
+ JMP ENTMN /EXTERN
+ JMP MNSECN /COMMON SECN
+ JMP PRGSCN /PROGRAM SECN
+M4, -4
+M7, -7
+ JMP MNS8 /GEN 8 MODE SCT
+ JMP MNCZ /COMM 8 MODE
+ JMP MNF1 /FLD1 8 MODE
+\fPRGSCN, TAD LNONUM
+ AND [3400 /IS IT A MAIN
+ SNA CLA /?
+ JMP MNSECN /YES
+ TAD I [OVRSIZ
+ DCA TMP0
+ TAD I [OVRSIZ+1
+ DCA TMP1 /SAVE OLD OVERLAY SIZE
+ CLL
+ TAD I EPT2
+ TAD TMP1
+ DCA I [OVRSIZ+1
+ RAL
+ TAD I EPTR
+ TAD TMP0
+ DCA I [OVRSIZ /SET OVLY SIZE = OVLY SIZE + SECTION SIZE
+ TAD TMP0
+ DCA I EPTR
+ TAD TMP1
+ DCA I EPT2 /SET SECTION SIZE = OLD OVERLAY SIZE
+ TAD GPTR /PUT ADDR OF
+ IAC /GST WD5 OF
+ DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE
+ENTM2, TAD [LVPTR /SET REFERENCE
+ DCA REFPTR /TO PARENT SYM =WD5 OF #YLVLN
+ENTMN, TAD LNONUM /=CURNT OVRLAY AND CURNT LEVEL NUM
+ JMP MNSEC5
+\fENTMN2, TAD LNONUM /SEE IF ENTRY
+ AND [3400 /POINT IS IN
+ SNA CLA /MAIN?
+ JMP ENTMN /YES
+ TAD I REFPTR /IS PARENT
+ JMS I [SETBPT /REFERENCE TO
+ CLA CMA /COMMON?
+ TAD REFPTR /LOOK FOR
+ DCA TMP0 /TYPE CODE 3
+ AC7775
+ TAD I TMP0
+ SNA
+ JMP ENTMN /YES, HANDLE LIKE A MAIN ENTRY POINT
+ TAD M4 /IS IT A REF
+ SNA CLA /TO AN 8 SECT?
+ JMP MNSEC5 /YES HANDLE LIKE MAIN
+ CLL
+ TAD I BPT2
+ TAD I EPT2
+ DCA I EPT2 /SET OVR ENT = OVR ENT + OVR
+ RAL
+ TAD I BPTR
+ AND [7 /WATCH HIGH-ORDER BITS
+ TAD I EPTR
+ DCA I EPTR
+ JMP ENTM2 /SIZE OF SECTION
+MNF1, ISZ F1FLG /SET FOR NE TO
+ JMP MNSECN /0 SO DO8S WILL
+MNCZ, ISZ CZFLG /KNOW THESE
+ JMP MNSECN /TYPES OF SECTS
+\fMNS8, ISZ S8FLG /EXIST AND WILL FIT THEM INTO CORE
+MNSECN, TAD GPTR /PUT ADDR OF
+ IAC /GST WD5 OF
+ DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE
+ TAD (SYMX+1 /THIS VALUE
+ DCA REFPTR /YIELDS 0 IN HI 9 WD 5 OF GST SYM
+MNSEC5, TAD ETYP /SYM TYPE TO AC8-11. AC MAY HAVE
+ TAD GTYP /LEVEL AND OVR BITS (AC1-7) ALREADY SET
+ DCA I GPTR /GST WD4 HOLDS SYMBOL TYPE
+ JMS I [SETBGX /SET BPTR TO GST WORD
+ DCA TMP0 /PREPARE FOR DIVISION BY 7
+ TAD I REFPTR
+ TAD (2-SYMTBL /GET OFFSET FROM SYMTBL
+ TAD M7
+ ISZ TMP0
+ SMA
+ JMP .-3 /DIVIDE BY REPEATED SUBTRACTION
+ STA /AC IS NOT NECESSARILY ZERO!
+ TAD TMP0
+ CLL RTL /ROTATE SYMBOL NUMBER INTO AC BITS 0-8
+ RAL
+ TAD I EPTR /AND INSERT IT INTO THE ADDRESS
+ DCA I BPTR /DOUBLEWORD TO FORM THE GST
+ TAD I EPT2 /ADDRESS DOUBLEWORD
+ DCA I BPT2
+ JMP I .+1
+ PUTSYM-1
+ PAGE
+\fSTPAS1, DCA I NDX0 /ZERO OUT GST
+ ISZ STCNT /NDX0 SET UP BY PASS0
+ JMP STPAS1
+ JMS I (SETCNT /SET MOD CNTS
+ JMS I (RDRLES /READ A RALF ESD
+ JMS I (ESDSCN /PROCESS IT
+ JMS I (ADVOVR /UPDATE COUNTS
+ JMP .-3 /DO NEXT
+ TAD LIBRSW
+ SNA CLA /LIBRARY SEARCH POSSIBLE?
+ JMP I (DOCORE /NO - SKIP IT
+ TAD SYMTM3 /TOP OF
+ DCA GPTR /GST
+ TAD RFPTR1 /1ST FREE
+ DCA LBPTR /ENTRY IN MODULE TBL THIS IS WHERE LIBR MODULES WILL GO
+ JMS I (GETEXT /GET AN
+ JMP .+3 /EXTERN
+LOP4, JMS I (GETEXT
+ TAD RESFLG /=1 IF
+ DCA IOFLG /LIBR CAT IS ENTIRELY CORE RES
+ DCA LBREC /SET I/O FOR
+ DCA LSTBLK /BLK 0 OF LIBRARY
+ DCA RBLK /SET REL BLK
+ DCA RLEN /AND LENGTH
+ JMP BY3 /TO 0
+NXTENT, TAD NDX1 /ADV TO
+ AND [-4 /NXT ENTRY
+ TAD (2 /BUT GET
+ DCA NDX1 /LENGTH OF
+ JMS I (GETLEN /PREV ONE 1ST
+ ISZ NUMENT /MORE IN CORE?
+ JMP BY3+1 /YES
+ TAD IOFLG /END OF
+ SZA CLA /CATALOGUE?
+ JMP LOP4 /YES, NO MATCH ON THIS EXTERN
+BY3, JMS RDLBR /GET NEXT
+ TAD [-4 /CAT. BLKS
+ TAD GPTR /LOOK FOR
+ DCA NDX0 /LIBR MATCH
+ AC7775
+ DCA TMP0
+\fLBFLD, CDF 0 /CDF 20 IF GREATER THAN 8K CORE
+ TAD I NDX1
+ CDF 10
+ CMA /IS IT THE END
+ SNA /OF CAT ?
+ JMP LOP4 /YES
+ IAC
+ TAD I NDX0
+ SZA CLA /MATCH 1?
+ JMP NXTENT /NO TRY NXT LIBR ENTRY
+ ISZ TMP0 /ALL MATCH?
+ JMP LBFLD /NO
+ JMS I (GETLEN /UPDATE RBLK,
+ CLA CMA /RLEN
+ TAD RFPTR1 /ENTER MOD
+ DCA NDX0 /INTO TBL
+ TAD I (MODTBL /LIBR UNIT
+ DCA I NDX0
+ TAD RLEN /LENGTH OF
+ DCA I NDX0 /MODULE
+ TAD I (MODTBL+2 /STARTING BLOCK OF LIBRARY, +
+ TAD RBLK / RELATIVE BLOCK OF MODULE =
+ DCA I NDX0 / ABSOLUTE BLK OF MOD
+ ISZ LBCNT /=NUM OF LIBR MOD IN MAIN
+ TAD GPTR /SAVE GST
+ DCA LSTBLK /PTR
+ JMS I (RDRLES /READ IN ESD
+ DCA LNONUM /SET FOR MAIN
+ JMS I (ESDSCN /PROCESS ESD
+ TAD [3 /ADV MODULE
+ TAD RFPTR1 /TBL PTR
+ DCA RFPTR1
+ TAD LSTBLK
+ DCA GPTR
+ ISZ MLEFT /MOD TBL FULL?
+ JMP LOP4 /NO DO SOME MORE
+ JMP I (DOCORE
+
+LIBRSW, 0 /NON-ZERO IF LIBRARY SEARCH POSSIBLE
+STCNT, SYMTBL-OVLTBL
+\fRDLBR, 0
+ TAD IOFLG /IS THIS
+ SZA CLA /THE END
+ JMP ENDLB /OF CAT.?
+ CDF /NO
+ JMS I [IOHAN /READ SOME
+ MODTBL /MORE
+LBARG, 200^5 /OR 200^17!20
+ LB0BUF /OR 0
+LBREC, 0 /REL CAT BLK
+ TAD LBREC /GET -NUM OF
+ CIA /BLKS READ,
+ TAD LSTBLK /AND COMPUTE
+ DCA TMP0 /THE NUM OF
+ TAD (-100 /ENTRIES IN
+ ISZ TMP0 /CORE. THERE
+ JMP .-2 /ARE 100 PER
+ DCA OLDCNT /BLOCK
+ TAD LBREC /UPDATE
+ DCA LSTBLK /LSTBLK
+ENDLB, TAD OLDCNT
+ DCA NUMENT
+ CLA CMA /SET PTR TO
+ TAD LBARG+1 /1ST ENTRY
+ DCA NDX1
+ CDF 10
+ JMP I RDLBR
+LSTBLK, 0
+MLEFT, 0
+RESFLG, 1
+NUMENT, 0
+OLDCNT, 0
+ PAGE
+
+\f/END OF PASS 1 - FIT EVERYTHING INTO CORE
+
+DOCORE, TAD TRPCNT
+ SNA CLA
+ JMP LOP3-3 /NO OVRS
+ TAD (TRPSYM /ENTER TRAP
+ JMS I [LOOK /VECT. SYM
+ TAD [4 /ITS A
+ DCA I GPTR /MAIN SECN
+ ISZ GPTR /GST WD6
+ ISZ GPTR /HOLDS LENGTH
+ TAD TRPCNT /GET SIZE OF
+ RTL CLL /TRAP VECTOR
+ DCA I GPTR /= NUMBER OF ENTRIES * 4
+ JMS I (DO8S /GO DO ALL 8 MODE SECTIONS
+ TAD SYMTM3 /ALLOCATE
+ DCA GPTR /CORE FOR
+LOP3, JMS I [GETTYP /ALL MAIN NON 8 MODE
+ JMP DUNMN /SECTIONS
+ AC7775 /4=PROG
+ TAD I GPTR /SECN, 3=COMMON
+ RAR CLL
+ SNA CLA
+ JMS I (FIT /GO FIT SECN
+ JMP LOP3
+\fDUNMN, STA
+ DCA I NDX7 /TERMINATE OVERLAY LENGTH LIST
+ TAD A1
+ DCA I (OVLTBL /STORE ENTRY FOR LEVEL 0
+ TAD A1+1
+ DCA I (OVLTBL+1
+ TAD A1+1
+ CLL
+ TAD [377
+ AND [7400
+ SZL
+ ISZ A1 /(WATCH CARRY!)
+ DCA A1+1 /DITTO FOR NON-FIELD 0
+ CLA IAC /WILL HOLD
+ DCA BLKCNT /SIZE OF LOADER IMAGE
+ TAD (1460 /RESET INT.
+ DCA I (LEVSYM+2 /#YLVLN SYM
+ TAD (QUSRLV-1 /WHERE OVRLAY
+ DCA NDX3 /DSRN INFO GOES IN LHDR
+ CLA IAC
+ DCA I NDX3 /USER MAIN IS LEVEL 0
+ TAD (10
+ DCA I NDX3 /SET UP LOADING INFORMATION FOR USER MAIN
+ STA /IN THE USRLV TABLE JUST LIKE
+ TAD A1 /ANY OTHER OVERLAY LEVEL
+ CLL RAR
+ TAD A1+1 /LENGTH HAS TO BE COMPUTED FROM
+ RAL /CORE LENGTH
+ RTL
+ RTL
+ DCA TMP0
+ CLA IAC
+ DCA I NDX3 /USER MAIN FIRST THING IN LDR IMAGE
+ TAD TMP0
+ DCA I NDX3
+ TAD TMP0
+\fLOP6, TAD BLKCNT /UPDATE LENGTH
+ DCA BLKCNT /OF LDR IMAGE
+ ISZ I (LEVSYM+2 /NEXT LEVEL
+ TAD (LEVSYM /LOOKUP
+ ISZ NLVL
+ JMS I [LOOK /#YLVLN
+ JMP DUNLVL /DONE ALL OVR LEVELS
+ JMS I (FIT /FIT LEVEL
+ ISZ GPTR /IN CORE
+ TAD I NDX3 /NUMBER OF OVERLAYS ON THIS LEVEL - ALSO
+ CIA /SERVES AS AN INDICATOR TO THE RUN-TIME
+ DCA TMP0 /SYSTEM THAT THIS LEVEL IS INITIALLY
+ TAD I GPTR /UNINHABITED.
+ AND [7 /GET FIELD BITS
+ CLL RTL
+ RAL
+ ISZ GPTR
+ TAD I GPTR /AND ADDRESS BITS
+ DCA I NDX3 /PUT-EM OUT
+ TAD BLKCNT /STARTING BLOCK OF LEVEL
+ DCA I NDX3
+ TAD BLKSIZ
+ DCA I NDX3 /LENGTH OF A SINGLE OVERLAY IN THE LEVEL
+ TAD BLKSIZ /(NUM OF OVRS)*
+ ISZ TMP0 /NUM OF BLKS
+ JMP .-2 /AC=LENGTH OF LEVEL
+ JMP LOP6 /DO NEXT LEVEL
+NLVL, 0
+\fDUNLVL, CLA /AC NOT ZERO!
+ TAD SYMTM3 /NOW RESOLVE
+ DCA GPTR /ALL OTHER SYMBOLS
+LP1, JMS I [GETTYP
+ JMP I (ALLDN1 /ALL DONE
+ JMS I [SETBGX /SET BPTR TO GST WD5
+ TAD I BPTR
+ AND [7770
+ SNA
+ JMP LP1 /NO RELATIVE SYMBOL - DON'T RELOCATE
+ DCA EPTR
+ TAD EPTR /FIGURE OUT THE SYMBOL TABLE ADDRESS
+ CLL RTR /OF THE RELATIVE SYMBOL BY
+ STL CMA RAR /TAKING 7 * THE RELATIVE SYMBOL NUMBER
+ TAD EPTR /IN BITS 0-8 AND ADDING IN THE BASE
+ TAD (SYMTBL-1 /ADDRESS OF THE SYMBOL TABLE
+ JMS I [SETEPT
+ TAD I EPT2
+ CLL
+ TAD I BPT2
+ DCA I BPT2
+ RAL
+ TAD I BPTR
+ AND [7 /THROW AWAY THE OLD RELATIVE SYMBOL #
+ TAD I EPTR
+ DCA I BPTR /AND PERFORM THE RELOCATION
+ JMP LP1 /DO AGAIN
+ PAGE
+\fALLDN1, TAD A1
+ DCA I (QHGHAD /SAVE HIGHEST PROGRAM ADDRESS
+ TAD A1+1 /SO THAT RTS WILL KNOW HOW MUCH ROOM
+ DCA I (QHGHAD+1 /IT HAS FOR BUFFERS & THINGS
+ TAD FATAL /ANY MULTIPLE
+ SNA /SECTIONS?
+ JMP NOMSCT /NO
+ DCA LNONUM
+ CDF 0
+ TAD I (MTMCNT
+ DCA MBGCNT /RESTORE ERROR PARAMETERS
+ CDF 10
+ JMS I [RTNOS8
+ MSMSG
+NOMSCT, TAD (SASYM /GET STRT
+ JMS I [LOOK /ADDR MAIN
+ SKP /NO MAIN
+ JMP .+3
+ JMS I [RTNOS8
+ MNMSG
+ TAD SVMAIN /IF .NE. SET TO
+ SZA /POINT TO GST
+ TAD GPTR /FOR PND MAIN
+ DCA SVMAIN /FOR /S THINGS IN SYMMAP RT.
+ CDF 0
+ TAD I (JOUSYM
+ DCA I (PRMAIN /ENABLING PRINTING OF #MAIN ON ERRORS
+ CDF 10
+ ISZ GPTR
+ TAD I GPTR /MAKE SWAPPER CONTROL WORD
+ DCA I (QRTSWP /LEVEL 0, OVERLAY 0 IS MAIN
+ ISZ GPTR
+ TAD I GPTR /12 BIT ADDR
+ DCA I (QRTSWP+1
+ TAD DPFLG /N.E. MEANS LDR IMAGE NEEDS DP HRDWRE
+ DCA I (QDPFLG /RETAIN INFO IN LHDR FOR PASS3
+\f CDF 0 /FETCH LDR
+ TAD I (LDRNAM /IMAGE
+ JMS I [IOHAN /HANDLER
+ TAD BLKCNT
+ CLL RTL /SINCE WE KNOW THE LENGTH OF THE
+ SZL SPA /LDR IMAGE FILE, TELL IT TO THE USR
+ CLA /(UNLESS ITS >255)
+ RTL
+ SZL
+ CLA
+ TAD I (LDRNAM /OPEN LDR
+ CIF 10 /IMAGE
+ JMS I USR
+ 3
+LDRBLK, LDRNAM+1
+LDRLEN, 0
+ JMP I (ENTERR
+ TAD BLKCNT /SEE IF LDR
+ STL /IMAGE WILL
+ TAD LDRLEN /FIT ON
+ SZL SNA CLA /TENTATIVE FILE
+ JMP .+3 /IT FITS
+ JMS I [RTNOS8 /OUTPUT FILE
+ LIMSG /TOO SMALL
+ TAD BLKCNT /CLOSE LDR
+ DCA I (LDCLEN /IMAGE FILE
+ TAD (LIMGU-1 /PASS2
+ DCA NDX0
+ TAD I (LDRNAM
+ CDF 10
+ AND [17
+ DCA I NDX0 /UNIT
+ TAD BLKCNT
+ DCA I NDX0 /LENGTH
+ TAD LDRBLK
+ DCA I NDX0 /STRT BLK
+ CDF 0
+ JMS I [IOHAN
+ LIMGU /WRITE OUT LOADER IMAGE HEADER BLOCK
+ 4210
+ LHDR
+ 0 /IN RELATIVE BLOCK 0 OF LOADER IMAGE FILE
+ CDF 10
+\f/SET UP TABLE THAT RELATES
+/BINARY SECTINS TO LDR
+/IMAGE RELATIVE BLOCK NUMS.
+/1 DBL WD AND 2 SINGLE-WD ARGUMENTS PER
+/SECTION (15 BIT ADDR, RELATIVE
+/BLOCK, AND LENGTH). THERE ARE
+/8 SECTIONS
+/(MAIN, LEVL1,....,LEVL7)
+/TABLE STARTS AT LHDR AND
+/IS USED BY SUBR NEWORG
+
+ TAD (LHDR-1
+ DCA NDX1
+ TAD (QUSRLV /NOW DO THE
+ DCA NDX0 /8 LEVELS
+ TAD [-10
+ DCA TMP0
+SETSLP, TAD I NDX0
+ DCA BSECTP
+ TAD BSECTP
+ CLL RTR
+ RAR
+ AND [7
+ DCA I NDX1 /FIRST COMES 15-BIT ADDRESS
+ TAD BSECTP
+ AND [7400
+ DCA I NDX1
+ TAD I NDX0
+ DCA I NDX1 /THEN RELATIVE BLOCK NUMBER
+ TAD I NDX0
+ DCA I NDX1 /THEN LENGTH
+ ISZ NDX0 /SKIP OVER NEXT OVERLAY COUNT
+ ISZ TMP0
+ JMP SETSLP
+ TAD (LHDR /PTR TO TOP
+ DCA BSECTP /OF TABLE
+ CLA CMA /SET FLG
+ DCA P2FLG /FOR SUBR ADVOVR
+ JMP I .+1
+ PASS2
+ PAGE
+\fDO8S, 0 /DO 8 SECTIONS
+ TAD CZFLG /ANY 8 MODE
+ SZA CLA /COMMONS ?
+ JMS FIT8S /GO FIT IT
+ TAD F1FLG /ANY 8 MODE
+ SNA CLA /FIELD 1 ?
+ JMP .+3 /NO
+ STA
+ JMS FIT8S
+ TAD S8FLG /ANY GEN 8 MODE
+ SNA CLA /SECTIONS ?
+ JMP I DO8S /NO ALL DONE
+ TAD [7770 /THIS WILL
+ DCA OVRFLO /INHIBIT FLD1 OVER FLOW ERR
+ CLA IAC
+ JMS FIT8S
+ JMP I DO8S
+
+/FIT 8 MODE SECTIONS
+
+FIT8S, 0
+ TAD [7770
+ DCA STYPE /-8M0DE SECT TYPE (7-11)
+ TAD SYMTM3 /SEARCH GST FOR
+ DCA GPTR /8 MODE SECTNS
+F8SECT, JMS I [GETTYP
+ JMP I FIT8S /ALL DONE
+ TAD STYPE
+ TAD I GPTR
+ SZA CLA /8 SECTION ?
+ JMP F8SECT /NO
+ JMS I [SETBGX
+ TAD I BPT2
+ TAD (177 /ROUND SECTION LENGTH
+ AND (7600 /TO A PAGE BOUNDARY
+ DCA I BPT2
+ JMS I (FIT /NOW FIT IT
+ TAD OVRFLO /SEE IF FLD1
+ TAD A1 /IS OVR FLOWED ****
+ SPA SNA CLA /?
+ JMP F8SECT /DO ANOTHER
+TOOBIG, JMS I [RTNOS8
+ CORMSG /PRINT ERROR & GO AWAY
+STYPE, 0
+\fFIT, 0 /FIT SECTION
+ JMS I [SETBGX /SET BPTR TO POINT TO GST WD5
+ TAD I BPT2
+ AND [7400
+ CLL RAL
+ TAD I BPTR
+ RTL
+ RTL /GET LENGTH OF SEGMENT IN BLOCKS
+ DCA BLKSIZ
+ TAD I BPT2
+ CLL
+ TAD A1+1
+ DCA TMP5
+ TAD A1+1
+ DCA I BPT2
+ TAD TMP5
+ DCA A1+1 /SET BPTR = A1
+ RAL /WHILE SETTING A1 = A1 + BPTR
+ TAD I BPTR
+ TAD A1
+ DCA TMP5
+ TAD TMP5
+ AND [7770
+ SZA CLA /IF NEW ADDRESS IS > 77777,
+ JMP TOOBIG /THE THING WILL NEVER FIT
+ TAD A1
+ DCA I BPTR
+ TAD TMP5
+ DCA A1
+ JMP I FIT /RETURN
+\fLEVLUP, 0 /LEVEL = MAX (LEVEL, OVRSIZ); OVRSIZ=0
+ TAD I [OVRSIZ
+ TAD LNONUM
+ DCA I NDX7 /RECORD THE SIZE OF THIS OVERLAY
+ TAD I [OVRSIZ+1 /FOR THE SYMBOL MAP PRINTOUT
+ DCA I NDX7
+ TAD [OVRSIZ
+ JMS I [SETEPT
+ TAD I [LVPTR
+ JMS I [SETBPT
+ JMS MAXCOM
+ DCA I EPT2
+ DCA I EPTR
+ JMP I LEVLUP
+
+MAXCOM, 0 /BPTR = MAX (EPTR, BPTR)
+ TAD I EPTR
+ CIA CLL
+ TAD I BPTR
+ SZA CLA /CHECK HIGH-ORDER WORDS FIRST
+ JMP .+4 /THEY DIFFER
+ TAD I EPT2
+ CIA CLL
+ TAD I BPT2 /USE LOW ORDER WORDS IF HIGH ORDERS ARE =
+ SZL CLA /IS EPTR > BPTR?
+ JMP I MAXCOM /NO - EXIT
+ TAD I EPTR
+ DCA I BPTR
+ TAD I EPT2
+ DCA I BPT2 /YES - BPTR=EPTR
+ JMP I MAXCOM
+\fGETLEN, 0
+ CDF 0 /OR CDF 20
+ TAD I NDX1 /LEN OF ENTRY
+ CDF 10
+ SNA /=0 MEANS LENGTH HAS ALREADY
+ JMP I GETLEN /BEEN COMPUTED. NE 0 MEANS
+ DCA TMP0 /ENTRY POINT IS THE 1ST IN A NEW MODULE
+ TAD RLEN /UPDATE REL
+ TAD RBLK /BLOCK AND
+ DCA RBLK /LENGTH OF
+ TAD TMP0 /NEW MODULE
+ DCA RLEN
+ JMP I GETLEN
+
+GETEXT, 0 /LOOK FOR GST
+ JMS I [GETTYP /EXTERN
+ JMP I (DOCORE /END OF GST
+ TAD I GPTR /TYPE WD TO AC
+ AND [17 /B8-B11
+ RTR CLL /2=EXTERN
+ SZA CLA /GOT ONE?
+ JMP .-6 /NO, RETRY
+ JMP I GETEXT
+ PAGE
+
+LB0BUF= .
+\f/START OF PROGRAM
+
+START, ISZ XSTRT /IF CHAINED TO
+ CIF CDF 10
+ CLL STA RAL
+ AND I (7643 /AND OUT THE /L SWITCH
+ DCA I (7643
+ JMP I .+1
+XSTRT, PASS0
+\f/THIS SUBROUTINE SHOULD RESIDE IN THE
+/FIELD 0 I/O BUFFER SINCE IT
+/EXECUTES ONLY ONCE
+/SUBROUTINE TO DETERMINE CORE SIZE
+/
+/THIS WORKS ON ANY PDP-8 FAMILY COMPUTER.
+/THE VALUE,FROM 1 TO 10(OCTAL) OF THE 1ST NON-EXISTENT
+/MEMORY FLD IS RETURNED IN THE AC.
+/
+/NOTE--THIS ROUTN MUST BE PLACED IN FLD 0
+/
+CORE, 0
+ TAD (6203
+ RDF
+ DCA CORTN
+ CDF 0
+ TAD I (7777
+ AND COR70
+ SNA
+ JMP CORELP
+ CLL RTR
+ RAR
+ JMP CORTN
+CORELP, CDF 0 /NEEDED FOR PDP-8L
+ TAD TRYFLD /GET FLD TO TST
+ CLL RTL
+ RAL
+ AND COR70 /MASK USEFUL BITS
+ TAD CORELP
+ DCA .+1 /SET UP CDF TO FLD
+ 0
+ TAD I CORLOC /SAV CURRENT CONTENTS
+ NOP /HACK FOR PDP-8
+ DCA .-3
+ TAD .-2 /7000 IS A GOOD PATTERN
+ DCA I CORLOC
+COR70, 70 /HACK FOR PDP-8.,NO-OP
+ TAD I CORLOC /TRY TO READ BK 7000
+ 7400 /HACK FOR PDP-8,.NO-OP
+ TAD .-1 /GUARD AGAINST WRAP AROUND
+ TAD CORLOC+1 /TAD 1400
+ SZA CLA
+ JMP .+5 /NON EXISTENT FLD EXIT
+ TAD COR70-6 /RESTORE CONTENS DESTROYED
+ DCA I CORLOC
+ ISZ TRYFLD /TRY NXT HIGHER FLD
+ JMP CORELP
+ TAD TRYFLD
+ TAD (-1
+CORTN, 0
+ JMP I CORE
+CORLOC, COR70+2 /ADR TO TST IN EACH FLD
+ 1400 /7000+7400+1400=0
+TRYFLD, 1 /CURRENT FLD TO TST
+ PAGE
+\f *6600
+DATCHG, 0 /FIND THE MONTH/YEAR
+ CLL RTR /THIS CODE FINDS THE MONTH
+ RAR /BY CALCULATING THE ADDRESS
+ AND (777 /OF THE CORRECT MONTH
+ CLL RTR /IN THE TABLE OF MONTHS
+ RTR
+ AND (36
+ TAD (MONTHS-3 /HAVE THE ADDRESS OF MONTH-1
+ DCA NDX2 /SAVE IT IN FIELD 0, PAGE 0
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I NDX2 /GET FIRST 2 CHARS. OF MONTH
+ CDF 10 /CHANGE DATA FIELD TO 1
+ DCA I (LDATE+2 /INSERT INTO THE TEXT LINE
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I NDX2 /GET LAST 2 CHARS. OF MONTH
+ CDF 10 /CHANGE DATA FIELD TO 1
+ DCA I (LDATE+3 /INSERT INTO THE TEXT LINE
+ TAD I (OSDATE /GET THE DATE--FIND THE YEAR
+ AND (7 /GET THE YEAR OFFSET BITS
+ DCA I (YRTEMP /STORE THEM AWAY
+ CDF 0 /CHANGE DATA FIELD TO 0
+ TAD I (7777 /GET THE DATE EXTENSION BITS
+ CDF 10 /CHANGE DATA FIELD TO 1
+ AND (600 /MASK TO GET BITS 3 AND 4
+ CLL RTR /ROTATE TO GET THEM INTO
+ RTR /BIT POSITIONS 7 AND 8
+ TAD (106 /GET THE NEW BASE YEAR
+ TAD I (YRTEMP /ADD THE YEAR OFFSET BITS
+ CIF 10 /CHANGE THE DATA FIELD TO 1
+ JMP I DATCHG /HAVE THE YEAR
+\fGETDAT, 0
+ TAD I (YRTEMP /GET THE YEAR
+ AND (7700 /MASK AND ROTATE
+ CLL RTR /TO GET THE FIRST
+ RTR /DIGIT (IN SIXBIT)
+ RTR
+ TAD (5500 /STICK A HYPHEN IN FRONT
+ DCA I (LDATE+4 /PUT IN THE TEXT LINE
+ TAD I (YRTEMP /GET THE YEAR AGAIN
+ AND (77 /MASK AND ROTATE TO
+ CLL RTL /GET THE SECOND DIGIT
+ RTL /(IN SIXBIT)
+ RTL
+ TAD (40 /STICK A SPACE AFTER IT
+ CIF 10 /CHANGE INSTRUCTION FIELD TO 1
+ JMP I GETDAT
+\fMONTHS, 5512;0116 /-JAN
+ 5506;0502 /-FEB
+ 5515;0122 /-MAR
+ 5501;2022 /-APR
+ 5515;0131 /-MAY
+ 5512;2516 /-JUN
+ 5512;2514 /-JUL
+ 5501;2507 /-AUG
+ 5523;0520 /-SEP
+ 5517;0324 /-OCT
+ 5516;1726 /-NOV
+ 5504;0503 /-DEC
+ PAGE
+\f FIELD 1
+/PAGE 0 FLD1 TAGS FOR PASS0
+/(PASS 0 LIVES WITH THE USR RESIDENT)
+
+NMCTS= 20
+MODCNT= 21
+LVLCNT= 22
+OVRCNT= 23
+PTRULS= 24
+MXFLD= 25
+\f *2000
+
+/START OF GLOBAL SYMBOL TABLE
+/BUCKET COMES FIRST, INTERNAL
+/SYMBOLS AND FIELD 1 CONSTANTS ARE
+/HERE ALSO. GST RUNS FROM
+/SYMTBL TO OVLTBL-1
+
+BUCKET, AAAAAA;0;0;0;EEEEEE;0 /A,B,C,D,E,F
+ 0;0;0;0;0;0 /G-L
+ 0;0;0;0;0;0 /M-R
+ 0;0;0;0;0;0 /S-X
+ 0;0 /Y,Z
+ 0;0;0;0;0 /UNUSED BUCKETS MUST BE 0
+ 0 /SPACE (FOR BLANK COMMON)
+ 0;0
+ POUND /POUND SIGN FOR INTERNAL SYMBOLS, ALL ARE OF THE FORM (POUND XXXXX)
+\fTRPSYM, TEXT '#YTRAP'
+ 0 /TRAP VECTOR
+LEVSYM, TEXT '#YLVL0'
+ 0 /OVERLAY LEVEL
+SWPSYM, TEXT '#SWAP'
+ 0;0
+SASYM, TEXT '#MAIN'
+ 0;0 /STARTING ADDRESS
+
+/TITLE LINE FOR LOADER MAP
+
+TLINE, TEXT 'LOADER V'
+ *.-1
+LXX, VERNUM&70^7+VERNUM+6060 /VERNUM IN SIXBIT
+ PATCH&77^100+40 /PATCH LEVEL
+LDATE, TEXT ' NO-DA -TE '
+STLINE, TEXT 'SYMBOL VALUE LVL OVLY'
+HLINE, TEXT '= 1ST FREE LOCATION'
+OTLINE, TEXT 'LVL OVLY LENGTH'
+SMAPU, ZBLOCK 3 /SYMMAP UNIT, LENGTH, ST BLK #
+LIMGU, ZBLOCK 3 /LDR IMG "
+OVRSIZ, 0;0
+LVPTR, OVRSIZ
+SYMX, 1;SYMTBL-2
+\f/SYSTEM SYMBOL TABLE
+
+AAAAAA, 0
+ TEXT /ARGERR/
+ *.-1
+ 1;0
+ JARGER
+
+EEEEEE, 0
+ TEXT /EXIT/
+ 1;0
+ JEXIT
+
+POUND, .+7
+ TEXT /#ARGER/
+ *.-1
+ 1;0
+ JARGER
+ .+7
+ TEXT /#BAK/
+ 1;0
+ JBAK
+ .+7
+ TEXT /#DATE/
+ 1;0
+ JDATE
+ .+7
+ TEXT /#DEF/
+ 1;0
+ JDEF
+ .+7
+ TEXT /#DISMS/
+ *.-1
+ 1;0
+ JDISMS
+ .+7
+ TEXT /#ENDF/
+ 1;0
+ JENDF
+ .+7
+ TEXT /#EOFSW/
+ *.-1
+ 1;0
+ JEOFSW
+ .+7
+ TEXT /#EXIT/
+ 1;0
+ JEXIT
+ .+7
+ TEXT /#HANG/
+ 1;0
+ JHANG
+ .+7
+ TEXT /#IDLE/
+ 1;0
+ JIDLE
+ .+7
+ TEXT /#INT/
+ 1;0
+ JINT
+ .+7
+ TEXT /#RDAO/
+ 1;0
+ JRDAO
+ .+7
+ TEXT /#READO/
+ *.-1
+ 1;0
+ JREADO
+ .+7
+ TEXT /#RENDO/
+ *.-1
+ 1;0
+ JRENDO
+ .+7
+ TEXT /#RETRN/
+ *.-1
+ 1;0
+ JRETRN
+ .+7
+ TEXT /#REW/
+ 1;0
+ JREW
+ .+7
+ TEXT /#RSVO/
+ 1;0
+ JRSVO
+ .+7
+ TEXT /#RUO/
+ 1;0
+ JRUO
+ .+7
+ TEXT /#SWAP/
+ 1;0
+ JSWAP
+ .+7
+ TEXT /#T812/
+ 1;0
+ JT812
+ .+7
+ TEXT /#UE/
+ 0
+ 1;0
+ JUERR
+ .+7
+ TEXT /#WDAO/
+ 1;0
+ JWDAO
+ .+7
+ TEXT /#WRITO/
+ *.-1
+ 1;0
+ JWRITO
+ 0 /LAST ONE
+ TEXT /#WUO/
+ 1;0
+ JWUO
+SYMTBL, 0 /START OF GST
+\f/PASS0- THIS IS THE BEGINNING OF PASS0
+
+PASS0, JMP .+4 /NORMAL ENTRY PT
+ DCA CDSW /CHAINED TO ENTRY PT - NO DECODE 1ST TIME
+ TAD (7616
+ DCA PTRIO
+ TAD (-10
+ DCA LVLCNT /SET LEVEL AND OVERLAY COUNTERS
+ DCA OVRCNT
+ CIF 0
+ JMS I (CORE /DETERMINE CORE SIZE
+ DCA MXFLD
+ JMS I (CORMOV
+ CDF 0
+ 0-1
+ CDF 0
+ LB0BUF-1 /MOVE LOWER FIELD 0 TO A SAFE PLACE
+ -2000
+ CDF 0
+ TAD I (OSJSWD /GET JOB STATUS WORD
+ AND (376 /CLEAR DESIRED FLAGS
+ TAD (3403 /SET NO RESTART, USR AND CD AREAS CLEAR
+ DCA I (OSJSWD /AS WELL AS BATCH FLAG
+ CDF 10
+ TAD I (OSDATE
+ SNA
+ JMP NODATE
+ CLL RTR /ROTATE AND MASK TO GET THE DAY
+ RAR
+ AND (37
+ JMS MAKSXB /CONVERT TO SIXBIT
+ DCA I (LDATE+1 /PUT THE DAY INTO THE TEXT LINE
+ TAD I (OSDATE /GET THE DATE---FIND MONTH
+ CIF 0 /CHANGE DATA FIELD TO 0
+ JMS I (DATCHG /FIND THE MONTH/YEAR
+ JMS MAKSXB /CONVERT THE YEAR TO SIXBIT
+ DCA YRTEMP /STORE IT AWAY
+ CIF 0 /CHANGE INSTRUC. FIELD TO 0
+ JMS I (GETDAT /PRINT THE YEAR
+ DCA I (LDATE+5 /PUT REST OF YEAR IN TEXT LINE
+\f/SET UP OTHER POINTERS TO MODULE TABLES
+
+NODATE, TAD (-NUMMOD
+ DCA I (MCTTBL
+ TAD (MCTTBL+1
+ DCA NMCTS /INITIALIZE MODULE CT TBL PTR
+ TAD (MODTBL+2
+ DCA PTRULS /INITIALIZE MODULE TBL PTR
+ DCA MODCNT
+ DCA I (MODTBL /CLEAR LIBRARY UNIT
+ DCA I NMCTS /CLEAR FOR 1ST LEVEL MODULE COUNTS
+CDSW, JMP I (RALFLP /ZEROED IF CHAINED TO
+ JMP I (DECO
+
+MAKSXB, 0
+ DCA TMP0
+ DCA TMP1
+ TAD TMP0
+ TAD (-12
+ ISZ TMP1
+ SMA
+ JMP .-3 /SUBTRACT 10 IN A LOOP
+ TAD (5772 /AS GOOD A NUMBER AS ANY
+ DCA TMP0
+ TAD TMP1
+ CLL RTL
+ RTL
+ RTL /GET THE TENS DIGIT INTO POSITION
+ TAD TMP0
+ JMP I MAKSXB
+YRTEMP, 0
+ PAGE
+\f/DECODE COMMAND DECODER INPUT
+
+RALFLP, JMS I (200
+ 5 /COMMAND DECODE
+ 2214 /.RL DEFAULT EXTENSION
+ TAD (7616
+ DCA PTRIO
+ TAD I (OS8SWS+1
+ AND (40
+ CDF 0
+ SZA CLA /IS /S SWITCH ON?
+ DCA I (SVMAIN+LB0BUF /CLEAR (RELOCATED) SVMAIN
+DECO, CDF 10 /FOR FULL SYMBOL MAP LISTING
+ TAD I (7600 /CHK FOR LOADER IMAGE FILE
+ SNA /OUTPUT FILE?
+ JMP SM /NO
+ AND (0017 /MUST BE AN "MS" DEV
+ TAD (OS8DCB-1
+ DCA TMP0
+ TAD I TMP0
+ SPA CLA /IS IT?
+ JMP .+4 /YES
+SM1, TAD (DEVERR /NO,ERR
+ JMS I (ERORR
+ JMP RALFLP
+ TAD I P7604
+ SNA
+ TAD (1404 /.LD
+ DCA I P7604 /INTO EXTENSION IF NONE SPECIFIED
+ JMS I (CORMOV /MOVE LOADER IMAGE FILE NAME
+ CDF 10
+ 7600-1
+ CDF 0 /INTO FIELD 0
+ LDRNAM+LB0BUF-1
+ -5
+SM, TAD I (7605 /CHK FOR SYM MAP FILE
+ SNA
+ JMP SM2 /NONE
+ AND (17
+ TAD (OS8DCB-1
+ DCA TMP0
+ TAD I TMP0
+ RAL /LOOK AT "READ ONLY" BIT IN DCB
+ SPA CLA
+ JMP SM1 /ERROR - NO GOOD FOR OUTPUT
+ TAD I (7611
+ SNA
+ TAD (1423 /.LS DEFAULT MAP EXTENSION
+ DCA I (7611
+ JMS I (CORMOV /MOVE SYMMAP FILE NAME INTO FIELD 0
+ CDF 10
+P7604, 7605-1
+ CDF 0
+ LDRNAM+LB0BUF+4
+ -5
+\f/COLLECT INPUT FILES
+
+SM2, TAD I (OS8SWS
+ CLL RAR
+ SZL CLA / IS /L SWITCH ON?
+ JMP LIBRAR /YES - THIS IS A LIBRARY FILE
+FILELP, TAD I PTRIO
+ SNA
+ JMP FINLIN /NO MORE INPUT FILES
+ DCA TMP0
+ TAD TMP0
+ AND (17
+ ISZ PTRULS
+ DCA I PTRULS /STORE UNIT NUMBER
+ TAD TMP0
+ AND (7760
+ CLL RTR
+ RTR
+ TAD (7400
+ CIA
+ ISZ PTRULS
+ DCA I PTRULS /STORE LENGTH
+ TAD I PTRIO
+ ISZ PTRULS
+ DCA I PTRULS /STORE STARTING BLOCK NUMBER
+ ISZ MODCNT
+ JMP FILELP /CONTINUE
+
+FINLIN, JMS I (CORDSW /CHECK C AND O SWITCHES
+ TAD I (OS8SWS
+ AND (40
+ SZA CLA /IF THE /G SWITCH IS ON
+ JMP I (EOPAS0 /ITS THE END
+ TAD I (OS8SWS-1
+ SPA CLA /IF AN ALTMODE TERMINATED THE LINE,
+ JMP I (EOPAS0 /DITTO
+ TAD (-MCTTBL-1
+ TAD NMCTS
+ SZA CLA /ARE WE STILL IN THE MAIN SECTION?
+ JMS I (UPDMOD /NO - UPDATE OVERLAY & MODULE COUNTS
+ JMP RALFLP
+\fLIBRAR, TAD I PTRIO
+ AND (17
+ DCA I (MODTBL /STORE LIBRARY PARAMETERS
+ TAD I PTRIO /NEGLECTING LENGTH, WHICH WILL
+ DCA I (MODTBL+2 /BE FILLED IN LATER
+ TAD I PTRIO
+ SNA CLA
+ JMP FINLIN /ONLY ONE FILE ALLOWED ON THE LINE
+ TAD (MIERR
+ JMP SM1+1 /OTHERWISE ITS MIXED INPUT
+ PAGE
+\f/UPDMOD- UPDATE MODULE COUNT TBL
+
+UPDMOD,0
+ CLL
+ TAD MODCNT /UPDATE -NUM OF
+ TAD I (MCTTBL /UNUSED MODULES
+ DCA I (MCTTBL
+ SZL
+ JMP MAXRLF /MAX NUMBER EXCEEDED
+ ISZ OVRCNT /BUMP OVERLAY NUMBER
+SKPCLA, SKP CLA
+ JMP MAXOVL /MORE THAN 16 OVERLAYS IN A LEVEL
+ TAD MODCNT /UPDATE +NUM OF
+ TAD I NMCTS /MODULES IN LAST LEVEL
+ SNA /****
+ JMP I UPDMOD
+ DCA I NMCTS
+ ISZ NMCTS /ADV PTR TO NXT LOC
+ DCA I NMCTS /ZERO THE NXT LOC IN PREPARATION
+ DCA MODCNT /CLR CNT FOR NXT LEVEL
+ JMP I UPDMOD
+
+/CORDSW- LOOK FOR SWS C AND O
+
+CORDSW, 0
+ TAD I (OS8SWS+1
+ AND (10
+ SNA CLA /CHECK FOR /U SWITCH
+ JMP CHKCSW
+ CDF 0
+ TAD SKPCLA /INHIBIT LEVEL CHECKING
+ DCA I (TSTTRP
+ CDF 10
+CHKCSW, TAD I (OS8SWS
+ RTL
+ SPA CLA
+ JMP I (RALFLP
+ TAD I (OS8SWS+1
+ RTL
+ SMA CLA
+ JMP I CORDSW
+
+/O-SWITCH
+
+ JMS UPDMOD
+ ISZ NMCTS /ADV PTR FOR NXT GUY
+ DCA I NMCTS /CLR FOR NXT LEVEL MOD CNT
+ TAD (-21
+ DCA OVRCNT
+ ISZ LVLCNT /BUMP LEVEL COUNTER
+ JMP I (RALFLP
+ TAD (MXLERR
+ JMP MAXRLF+1 /TOO MANY LEVELS
+\fMAXRLF, TAD (MXRERR
+ JMS ERORR
+ CDF CIF 0
+ JMP I (7605
+MAXOVL, TAD (MXOERR
+ JMP MAXRLF+1
+
+/ERORR- PRINTS OUT ERROR MESSAGES OF A
+/ BUFR LOCATED IN FLD1
+/ ENTER WITN ADR OF BUFR IN AC
+/
+ERORR, 0
+ DCA BFADR
+ CDF 10 /CALL TTYHAN
+ JMS I (CORMOV
+ CDF 0
+ LB0BUF-1 /MOVE LOWER FIELD 0 BACK
+ CDF 0 /SO WE CAN USE THE MESSAGE HANDLER
+ 0-1
+ -2000
+ CIF 0
+ JMS I (TTYHAN
+ CDF 10
+BFADR, 0
+ JMP I ERORR
+\fMIERR, TEXT /MIXED INPUT/
+DEVERR, TEXT /BAD OUTPUT DEVICE/
+MXRERR, TEXT /TOO MANY RALF FILES/
+MXLERR, TEXT /TOO MANY LEVELS/
+MXOERR, TEXT /TOO MANY OVERLAYS/
+ PAGE
+\f/PASS1, PASS2 INITIALIZATION
+
+EOPAS0, JMS I (UPDMOD /BUMP COUNTS FOR LAST LINE OF INPUT
+ ISZ NMCTS
+ DCA I NMCTS /PUT IN A DOUBLE ZERO AT THE END
+ JMS I (CORMOV
+ CDF 0
+ LB0BUF-1
+ CDF 0
+ 0-1 /MOVE LOWER FIELD 0 BACK INTO PLACE
+ -2000
+ TAD I (MODTBL
+ SZA CLA /USER-SPECIFIED LIBRARY?
+ JMP RDLIBH /YES
+ CLA IAC
+ JMS I (200
+ 2 /LOOKUP
+ LIBRY
+ 0
+ JMP NOLIB /FORLIB.RL NOT FOUND
+ TAD .-3 /GET STARTING BLOCK
+ DCA I (MODTBL+2
+ CLA IAC
+ DCA I (MODTBL /STORE UNIT AND BLOCK #
+RDLIBH, STL RTR
+ DCA I (MODTBL+1 /JUST TO BE CAREFUL
+ CIF 0
+ JMS I (IOHAN /READ BLOCK 0 OF THE LIBRARY CATALOG
+ MODTBL
+ 0210
+PLB, RALFBF
+ 0
+ STA
+ TAD I PLB
+ SNA CLA /IS IT AN HONEST - TO - GOD LIBRARY?
+ JMP .+4 /YES
+NOLIB, DCA I (MODTBL
+ DCA I (MODTBL+2
+ DCA I (RALFBF+3 /ZERO COUNT WORD IN BUFFER
+ TAD I (RALFBF+3
+ DCA I (MODTBL+1 /STORE LENGTH OF CATALOGUE
+ TAD (LHDR-1
+ DCA NDX0
+ TAD (-400
+ DCA TMP0
+ DCA I NDX0 /0 OUT
+ ISZ TMP0 /LDR HDR
+ JMP .-2 /GET PAGE 0
+\f/PASS1 INITIALIZATION CONTINUED
+
+ TAD I (MCTTBL /UNUSED
+ DCA TMP2 /MODULES
+ TAD (MCTTBL+2 /GET NUMBER OF OVERLAYS
+ DCA NDX0 / IN EACH LEVEL
+ TAD (QUSRLV+4 /WHERE THE
+ DCA TMP0 /CNTS GO IN
+ JMP BY0 /LDR HDR BLK
+LOP0, ISZ I TMP0 /INCREMENT NUMBER OF OVERLAYS IN THIS LEVEL
+ TAD I NDX0
+ SZA CLA /END OF LEVEL?
+ JMP LOP0 /NO
+ TAD (4 /THIS LEVEL
+ TAD TMP0
+ DCA TMP0
+BY0, DCA I TMP0 /RESET CNT
+ TAD I NDX0 /0,0 ENDS
+ SZA CLA /MOD CNT TBL
+ JMP LOP0 /DO MORE PTR TO
+ TAD I (MODTBL+1 /GET LENGTH OF LIBRARY CATALOG
+ DCA TMP4 /BLOCKS
+ TAD TMP2 /CHK FOR MAX
+ SZA CLA /NUM OF RALFS 0=MOD TBL IS FULL
+ TAD I (MODTBL /CHK FOR NO
+ CDF
+ DCA I (LIBRSW /LIBRARY AND SET SWITCH ACCORDINGLY
+ TAD TMP2 /-NUM LEFT
+ DCA I (MLEFT /OF RALF MODS
+ TAD (SYMTBL-1 /PTR TO TOP
+ DCA I (NDX4 /OF GST
+ TAD I (OSJSWD
+ AND (7377 /KILL "BATCH PROTECTED" FLAG
+ DCA I (OSJSWD
+\f AC7776 /IS THERE
+ TAD MXFLD /GREATER THAN 12K OF CORE
+ SPA SNA CLA /?
+ JMP LS16K /NO
+ TAD (200^12!30 /SET TXT I/O
+ DCA I (TXTBLK-2 /BUFFS UP IN FLD 3
+ TAD (-5000 /-WDCNT (12
+ DCA I (TXTWDS /BLKS)
+ TAD (6231 /CDF 30
+ DCA I (RDTCDF
+LS16K, TAD (7700 /USR IS NOT
+ DCA I (USR /IN CORE
+ CDF 10
+ JMP I (INIBFS
+LIBRY, 0617;2214;1102;2214 /FORLIB.RL
+ PAGE
+\f/THIS IS THE INITIAL BINARY BUFFER TABLE
+
+R= LDBUFS-BUFTAB
+
+BUFTAB, .+4+R; 0; 0; 3200 /03200-05177
+B8KPT, .+4+R; 0; 0; 5200 /05200-07177
+ .+4+R; 0; 0; 0020 /20000-21777
+B12KPT, .+4+R; 0; 0; 2020 /22000-23777
+B16KPT, .+4+R; 0; 0; 4020 /24000-25777
+ .+4+R; 0; 0; 0040 /40000-41777
+B20KPT, .+4+R; 0; 0; 2040 /42000-43777
+ .+4+R; 0; 0; 4040 /44000-45777
+ .+4+R; 0; 0; 0050 /5000-51777
+ 0; 0; 0; 2050 /52000-53777
+\fINIBFS, TAD MXFLD
+ TAD (JMP STBPTR-1
+ DCA .+1
+ HLT /DISPATCH ON NUMBER OF FIELDS
+STBPTR, DCA B8KPT
+ DCA B12KPT
+ DCA B16KPT
+ DCA B20KPT
+ NOP
+ NOP /NOT SET UP TO USE MORE THAN 24K
+ NOP
+ JMS I (CORMOV
+ CDF 10
+ BUFTAB-1 /MOVE THE BINARY BUFFER TABLE
+ CDF 10
+ LDBUFS-1 /INTO A SAFE PLACE
+ -50
+ CDF 0
+ TAD LVLCNT /SET -NUM OF
+ TAD (11 /LEVELS
+ CIA
+ DCA I (NLVL
+ TAD (-5 /NUM OF LIBR
+ DCA TMP2 /BLKS FOR 8K
+ CLA CMA
+ TAD MXFLD
+ SNA CLA /GREATER THAN 8K CORE?
+ JMP TO8K /NO SET LIBR ARGS
+ DCA I (LBARG+1
+ TAD (200^12!20 /12 BLKS FLD2
+ DCA I (LBARG
+ TAD (6221 /CDF 20
+ DCA I (LBFLD
+ TAD (6221
+ DCA I (GETLEN+1
+ TAD (-12
+ DCA TMP2
+TO8K, TAD TMP2 /WILL LIBR
+ TAD TMP4 /BE CORE
+ SMA SZA CLA /RESIDENT?
+ DCA I (RESFLG /NO
+ TAD (SYMTBL-1
+ DCA I (NDX0
+\f CDF 10
+ TAD (ESDPG-1 /ENTER DEFAULT
+ DCA NDX0 /VALUES FOR
+ TAD (-200 /ESD REF PAGE
+ DCA TMP0 /IT SAVES
+ TAD (SYMTBL+5 /PROBLEMS WITH
+ DCA I NDX0 /EXTERNS
+ ISZ TMP0
+ JMP .-3
+ CLA STL RTL
+ DCA I (LHDR /STORE LOADER IMAGE CODE IN HEADER
+ TAD (VERNUM
+ DCA I (QVERNO /STORE LOADER VERSION NUMBER
+ CIF 0
+ JMP I (STPAS1
+ PAGE
+\f/CORMOV- A CORE MOVE FOR A CHUNK OF CORE IN
+/ ANY FLD TO ANY FLD.
+/
+/ CALL JMS CORMOV
+/ CDF Z1 /Z1=FROM FLD
+/ ADDR1 /ADDR OF (1ST LOC-1)
+/ CDF Z2 /Z2=TO FLD
+/ ADDR2 /ADDR OF (1ST LOC-1)
+/ -N /-OCT NUM OF WDS TO MOV
+/
+CORMOV, 0
+ CLA CMA
+ TAD CORMOV
+ DCA NDX0
+ TAD I NDX0
+ DCA TOCDF-2
+ TAD I NDX0
+ DCA NDX1
+ TAD I NDX0
+ DCA TOCDF
+ TAD I NDX0
+ DCA NDX2
+ TAD I NDX0
+ DCA TMP0
+ 0
+ TAD I NDX1
+TOCDF, 0
+ DCA I NDX2
+ ISZ TMP0
+ JMP TOCDF-2
+ CDF 10
+ JMP I NDX0 /RTN
+
+ $$$$$
+\f
--- /dev/null
+/ LTR (LOAD TRUTH) EMULATION ROUTINES
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT #LTR
+ ENTRY #EQ
+ FLDA TRUE
+ STARTF
+#EQ, JA .
+ JEQ #EQ-3
+ FCLA
+ JA #EQ-1
+ ENTRY #NE
+#NE, JA .
+ JEQ .+4
+ FLDA TRUE
+ STARTF
+ JA #NE
+ ENTRY #GE
+ FLDA TRUE
+ STARTF
+#GE, JA .
+ JGE #GE-3
+ FCLA
+ JA #GE-1
+ ENTRY #LE
+ FLDA TRUE
+ STARTF
+#LE, JA .
+ JLE #LE-3
+ FCLA
+ JA #LE-1
+ ENTRY #GT
+ FLDA TRUE
+ STARTF
+#GT, JA .
+ JGT #GT-3
+ FCLA
+ JA #GT-1
+ ENTRY #LT
+ FLDA TRUE
+ STARTF
+#LT, JA .
+ JLT #LT-3
+ FCLA
+ JA #LT-1
+TRUE, F 1.0
+ F 0.0
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4/28/77 PT
+/
+ FIELD1 ONQI
+ 0
+ JMP SETINT /SET UP #INT INITIALLY
+ ISZ ONQI /BUMP ARG POINTER
+ ISZ INTQ+1 /BUMP INTERRUPT Q POINTER
+ IOF /**
+ DCA% INTQ+1 /STICK IOT ONTO INT Q
+ TAD XSKP /FOLLOWED BY A SKIP
+ ISZ INTQ+1
+ DCA% INTQ+1 /ONTO INT Q
+ ISZ ONQI /SKIP FIRST WORD OF ADDR
+ ISZ INTQ+1
+ONQISW, TAD% ONQI /GET INT HANDLER ADDRESS
+ ISZ ONQI
+ DCA% INTADR+1 /ONTO ADDRESS STACK
+ TAD INTADR+1 /NOW MAKE JMS%
+ AND L177
+ TAD L4600
+ DCA% INTQ+1 /ONTO INT Q
+ ISZ INTADR+1
+ ION /::
+ ISZ IQSIZE /ROOM FOR MORE ?
+ JMP% ONQI /YES
+ TAD .-1 /NO, CLOSE OUT THESUBR
+ DCA ONQI+1
+ JMP% ONQI
+SETINT, TAD ONQISW /DO THIS PART ONLY ONCE
+ DCA ONQI+1
+ CDF
+ IOF /**
+ TAD XSKP /FIX UP #INT
+ DCA% XINT+1
+ ISZ XINT+1
+ TAD INTQ+1
+ DCA% XINT+1
+ ISZ XINT+1
+ TAD CIFCDF
+ DCA% XINT+1
+ ION /**
+CIFCDF, CDF CIF 10
+ JMP ONQI+1 /BACK TO ONQI
+ EXTERN #INT
+XINT, ADDR #INT
+INTQ, ADDR IHANDL
+INTADR, ADDR IHADRS
+IQSIZE, -5
+XSKP, SKP
+L177, 177
+L4600, 4600
+ CDF CIF
+ JMP% IHANDL
+IHANDL, 0
+ REPEAT 16
+ JMP IHANDL-2
+IHADRS, 0;0;0;0;0
+
+ ENTRY ONQB
+ONQB, 0
+ JMP SETBAK /SETUP #IDLE
+ TAD% ONQB /GET ADDRESS OF IDLE JOB
+ONQBSW, ISZ ONQB
+ DCA% BAKADR+1 /STORE ONTO BACKROUND JOB Q
+ TAD BAKADR+1 /MAKE A JMS%
+ ISZ BAKADR+1
+ AND L177
+ TAD L4600
+ ISZ BAKQ+1
+ DCA% BAKQ+1
+ ISZ BQSIZE /MORE ROOM ?
+ JMP% ONQB /YES
+ TAD .-1 /NO, CLOSE THE DOOR
+ DCA ONQB+1
+ JMP% ONQB
+SETBAK, TAD ONQBSW /CLOSE OFF #IDLE INITIALIZATION
+ DCA ONQB+1
+ CDF
+ TAD XSKP /FIX UP #IDLE
+ DCA% XIDLE+1
+ TAD BAKQ+1
+ ISZ XIDLE+1
+ DCA% XIDLE+1
+ ISZ XIDLE+1
+ TAD CIFCDF
+ DCA% XIDLE+1
+ CIF CDF 10
+ JMP ONQB+1
+ EXTERN #IDLE
+XIDLE, ADDR #IDLE
+BAKQ, ADDR BAKRND
+BAKADR, ADDR BHADRS
+BQSIZE, -5
+ CDF CIF
+ JMP% BAKRND
+BAKRND, 0
+ REPEAT 6
+ JMP BAKRND-2
+BHADRS, 0;0;0;0;0
+ END
+\f
--- /dev/null
+/ CONFIGURATION FILE TO GENERATE PASS2O (PH, APR 2008)
+OVERLY=1
--- /dev/null
+/3 OS/8 FORTRAN (PASS TWO)
+/
+/ VERSION 4A PT 16-MAY-77
+/
+/ OS/8 FORTRAN COMPILER - PASS 2
+/
+/ BY: HANK MAURER
+/ UPDATED BY: R. LARY + M. HURLEY
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+VERSON=4
+\f/SEE F4.PA FOR LIST OF MAINTENANCE RELEASE CHANGES -S.R.
+/ALSO, ADDED SAFETY CDF 0 TO BUMP ROUTINE TO FIX BUG
+/MASSAGED LINK IN THAT AREA TO GET ROOM
+/ALSO,
+/ FIXED BUG RE DN ERROR PRINTING WRONG LINE NUMBER
+/
+/
+/CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
+/.PATCH LEVEL FOR PASS2 IS IN LOCATION 327
+
+ IFNDEF OVERLY <OVERLY=0>
+ IFNZRO OVERLY <NOPUNCH>
+ *2 /V3C
+TEM, 1 /V3C
+LINENO, 1 /LINE NUMBER
+VERS, -VERSON /VERSION NUMBER
+ERRPTR, 5001 /POINTER TO THE ERROR LIST
+FILDEV, 0 /THIS IS THE FILE DESCRIPTOR
+FILBLK, 0 /FOR RALF
+X10, COMREG-1 /INTER PASS COM REGION
+X11, 0
+X12, 0
+X13, 0
+X14, 0
+X15, 0
+X16, 0
+X17, 0 /AUTO INDEX REGISTERS
+ENTRY, 0 /THINGS USED BY SYMBOL
+ /TABLE FIDDLER
+OENTRY, 0
+BUCKET, 0
+TYPE, 0
+TEMP, 0 /GENERAL TEMPS
+TEMP2, 0
+ARG1, 0 /ARGS AND TYPES
+BASE1, 0
+TYPE1, 0
+ARG2, 0
+BASE2, 0
+TYPE2, 0
+TMPCNT, 1 /TEMP COUNT
+TMPMAX, 0 /MAX TEMP COUNT
+LITNUM, 0 /LITERAL DISPLACEMENT
+ TMPBLK=2
+ OUBUF=4400
+ COMREG=4600
+ STACK1=4700
+ OVRLAY=5000
+ NPOVLY=700
+ XRBUFR=6600
+ STACK=7000 /STACK-5 CAN'T BE 0
+ INBUF=7200
+ NPPAS3=1600
+ARG, 0 /TEMP FOR CODE
+AC, 0 /AC FOR MULTIPLY ROUTINE
+XR, 0 /XR CHAR FOR OADDR
+MQ, 0 /MQ FOR MULTIPLY ROUTINE
+XRNUM, 0 /TEMP USED IN XR STUFF
+WHATAC, 0 /POINTER TO VAR
+WHATBS, 0 /JUST STORED
+FREEXR, 0 /NUMBER OF FREE
+ /INDEX REG
+DIMPTR, 0 /POINTER TO DIM INFO
+ /AFTER GETSS
+NARGS, 0 /ARG COUNT FOR SS VAR
+ /COMPILE
+GLABEL, 1 /GENERATED LABEL COUNTER
+STKLVL, STACK /STACK LEVEL (CHANGED
+ /BY DO)
+COMMA, 254 /,
+PLUS, 253 /+
+IFLABL, 0 /HOLDS LABEL FOR LOG IF
+DOTEMP, 7000 /DO LOOP TEMP COUNTER
+BINARY, 0 /BINARY IO=1, FORMATTED=0
+INPUT, 0 /INPUT=1 OUTPUT=0 FOR IO STMTS
+PROGNM, 0 /POINTER TO PROG/FUNC NAME
+FUNCTN, 0 /0=MAIN, 1=FUNC, -2=SUBR
+ARGLST, 0 /POINTER TO ARG LIST
+DATASW, 0 /=1 IF THIS IS A DATA STMT
+GCTEMP, 0 /TEMP USED BY GENCAL
+EXTLIT, 0 /EXTERNAL LITERALS LIST
+ELCNT, 0 /AND COUNT
+IOLOOP, 0 /IO LOOP SWITCH
+ARGIO, 0 /ARG IO SWITCH
+F1LNAM, 0617;2224;2216;2415 /FILE NAME FORTRN.TM
+DEVH, 7607 /DEVICE HANDLER ADDRESS
+ACSWIT, 0 /IS NON ZERO IF CALLING AN ARG
+IOSTMT, 0 /SET 1 IF IN IO STMT
+ /(FOR IMPLIED LOOPS)
+FMODE, 1 /1 IF IN F OR D MODE (0 IF E)
+ASFSWT, 0 /1 IF ASF PROLOG, -1 IF
+ /ASF END, 0 OTHER
+JSRLBL, 0 /LABEL NUMBER FOR CALLS TO ARGS
+DPUSED, 0 /=1 IF DP HARDWARE USED
+QM4, -4
+Q260, 260
+QTTYOU, TTYOUT
+QERMSG, ERMSG
+QNEXT, NEXT
+QNEXTM, NEXT-2
+QUCODE, UCODE
+QCODE, CODE
+QINWOR, INWORD
+QONUMB, ONUMBR
+QSAVEA, SAVEAC
+Q6M3,
+Q5, 5
+QGENCO, GENCOD
+QM6, -6
+QOPCOD, OPCOD
+QOPCDE, OPCODE
+QOADDR, OADDR
+Q17, 17
+QTTYMS, TTYMSG
+QXRTBL, XRTABL
+QCHKXR, CHEKXR
+QGENSF, GENSTF
+QGENSE, GENSTE
+QOSNUM, OSNUM
+QCRLF, CRLF
+QOTAB, OTAB
+QOUTSY, OUTSYM
+QGARG, GARG
+Q20, 20
+Q40, 40
+QOUTNA, OUTNAM
+QLITRL, LITRL
+Q200, 200
+Q255, 255
+Q3, 3
+QOLABE, OLABEL
+QGETSS, GETSS
+Q256, 256
+QSAVAC, SAVACT
+QSKPIR, SKPIRL
+QGENCA, GENCAL
+QLOADA, LOADA
+QMUL12, MUL12
+QGARGS, GARGS
+QOINS, OINS
+QOCHAR, OCHAR
+QNUMBR, NUMBRO
+QXRBUF, XRBUFR
+QTTYP2, TTYP2C
+QTTCRL, TTCRLF
+QM63, -63
+Q7605, 7605
+RELCD, 0
+QLABEL, NLABEL
+P0F1, 5274 /101-2605
+P0F2, VERROR
+\f/ OUTPUT UTILTIY ROUTINES
+ PAGE
+OCNT,
+CRLF, 0 /OUTPUT CR LF
+ TAD (215
+ JMS I QOCHAR
+ TAD (212
+ JMS I QOCHAR
+ TAD (200
+ KRS
+ TAD (-203
+ SNA CLA
+ KSF /CHECK FOR ^C
+ JMP I CRLF
+ JMP I (7605
+NCHAR,
+OSNUM, 0 /PRINT STMT NUMBER
+ IAC /SKIP POINTER WORD
+ DCA NAMPTR
+ TAD (6211 /ALWAYS IN FIELD 1
+ DCA NAMCDF
+ TAD OSNUM /SAVE ENTRY POINT
+ DCA OUTNAM
+ TAD (243 /GET FIRST CHAR (ALWAYS #)
+ JMP L6201 /GO PRINT NAME
+TTCHAR,
+OUTSYM, 0 /PRINT OPCODE
+ DCA NAMPTR /SAVE POINTER TO STUFF
+ TAD L6201 /ALWAYS FIELD 0
+ DCA NAMCDF
+ TAD OUTSYM /SAVE ENTRY
+ DCA OUTNAM
+ JMP NAMCDF /PRINT REST
+ONUMT,
+OUTNAM, 0 /OUTPUT NAME
+ DCA NAMPTR /SAVE ADDRESS OF NAME
+ RDF /GET FIELD OF NAME
+ TAD L6201
+ DCA NAMCDF /SAVE AS CDF
+ TAD I NAMPTR /GET FIRST CHAR (ALREADY ASCII)
+ ISZ NAMPTR /SKIP OVER TYPE AND DIM PTR
+ ISZ NAMPTR
+L6201, CDF
+ JMS I QOCHAR /OUTPUT CHAR
+ ISZ NAMPTR
+NAMCDF, 0
+ TAD I NAMPTR /GET NEXT TWO CHARS
+ CDF
+ SNA /IS NAME DONE ?
+ JMP I OUTNAM /YES
+ DCA NCHAR /SAVE TWO CHARS
+ TAD NCHAR
+ RTR /GET UPPER CHAR
+ RTR
+ RTR
+ TAD (240
+ AND (77
+ TAD (240
+ JMS I QOCHAR /OUTPUT IT
+ TAD NCHAR /NOW DO LOWER
+ AND (77
+ SNA
+ JMP I OUTNAM /NAME DONE
+ TAD (240
+ AND (77
+ TAD (240
+ JMP L6201+1 /GO AND OUTPUT IT
+ONUMBR, 0 /OUTPUT OCTAL NUMBER
+ DCA ONUMT /SAVE TEMPORARILY
+ TAD QM4 /4 DIGITS
+ DCA OCNT
+OLOOP, TAD ONUMT
+ CLL RTL
+ RAL
+ DCA ONUMT
+ TAD ONUMT
+ RAL
+ AND (7
+ TAD Q260
+ JMS I QOCHAR
+ ISZ OCNT
+ JMP OLOOP
+ JMP I ONUMBR
+TTYP2C, 0 /PRINT 2 CHARS ON THE TTY
+ DCA TTCHAR
+ TAD TTCHAR
+ RTR
+ RTR
+ RTR
+ JMS CONVRT
+ TAD TTCHAR
+ JMS CONVRT
+ JMP I TTYP2C
+NAMPTR,
+CONVRT, 6401 /CONVERT TO ASCII
+ AND (77
+ SZA
+ TAD (240
+ AND (77
+ TAD (240
+ JMS I QTTYOUT
+ JMP I CONVRT
+TTCRLF, 0
+ TAD (215
+ JMS I QTTYOUT
+ TAD (212
+ JMS I QTTYOUT
+ JMP I TTCRLF
+TTYMSG, 0 /PRINT 2 CHAR ERROR MESSAGE
+ CDF
+ TAD I TTYMSG
+ ISZ TTYMSG /PRINT ERROR MESSAGE
+ JMS I QERMSG
+FATAL, JMP I QNEXT /FATAL ERROR MESSAGE
+ TAD I FATAL
+ JMS I QERMSG
+ JMP I Q7605 /RETURN TO PS8
+DP2C1, TEXT '.+2,1'
+NEG, JMS I QUCODE /NEGATE CODE
+ NEGTBL-1
+ JMP I QNEXT
+ PAGE
+\f/ OPCODE JUMP TABLE
+
+ TAD TEMP2
+ SKP /CODE ALREADY READ
+NEXT, JMS I QINWORD /GET NEXT INPUT WORD
+ TAD (XPUSH /INDEX INTO JUMP TABLE
+ DCA TEMP2
+ CDF 10
+ TAD I TEMP2
+ CDF 0
+ DCA TEMP2 /GET JUMP ADDRESS
+ JMP I TEMP2 /GO THERE
+\f/OPTIMIZING RELATIONAL CODE FOR OS/8 F4
+/COMPLIMENTS OF R.L.
+
+LE, STL RTL /2
+LT, TAD QM4 /GENERATE -4 FOR LT, -2 FOR LE
+ JMP GE+1 /GO TO COMMON RELATIONAL CODE
+GT, STL RTL
+GE, IAC /GENERATE 1 FOR GE, 3 FOR GT
+ DCA RELCD /ALL THIS FUNNY STUFF IS BECAUSE SOME
+ JMS I QCODE /OF THE RELATIONAL SKELETONS OPTIMIZE BY
+ LETABL-6;5 /PERFORMING THE RELATIONAL ON THE NEGATIVE
+ TAD RELCD /OF THE FAC - WHEN THIS HAPPENS SPECIAL
+ SPA /CODE IN THE SKELETON DOES AN "ISZ RELCD",
+ CIA /CHANGING ABS(RELCD) TO ITS OPPOSITE RELATIONAL
+ JMP RELGEN /E.G. GE(1) TO LE(2), LE(-2) TO GE(-1)
+
+EQ, CLA IAC /SINCE EQ AND NE ARE SIGN-INDEPENDENT,
+NE, DCA RELCD /WE DON'T NEED THAT KLUDGE BUT FOR COMPATIBILITY
+ JMS I QCODE /WITH RTPS THE OS/8 FORTRAN SYSTEM FUNCTION
+ EQTABL-6;5 /"#CEQ" WORKS THE WRONG WAY - IT PRODUCES
+ CLA IAC /A 1.0 IF THE COMPLEX AC WAS (0.,0.)
+ AND RELCD /AND A 0.0 OTHERWISE - SO WE HAVE TO REVERSE
+ SZA CLA /THE SENSE OF COMPLEX .EQ. AND .NE. RELATIONS.
+RELGM1, TAD Q5
+RELGEN, DCA RELCD /STORE "FINAL" RELCD
+ JMS I QINWORD /GENTLY PROBE AHEAD IN THE INPUT
+ DCA TEMP2
+ TAD TEMP2
+ TAD (XPUSH-XLOGIF
+ SNA CLA /IF THIS WAS THE TOP RELATION OF A LOGICAL IF,
+ JMP LIFOPT /WE'RE IN A POSITION TO OPTIMIZE
+ TAD RELCD /OTHERWISE OUTPUT A CALL TO THE
+ CLL RAL /ROUTINE CORRESPONDING TO THE RELATIONAL
+ TAD (LTRNE
+ DCA .+3
+ CLA IAC
+ JMS I (OJSR /GENERATE A JSA #XX
+ 0
+ JMP I QNEXTM2 /PROCESS THE WHATCHIMACALLIT
+
+LIFOPT, TAD TYPE1 /SEE IF WE SHOULD GENERATE A "STARTF" FIRST
+ AND Q17 /ONLY WORRY ABOUT D.P.
+ TAD QM4 /SINCE THE ROUTINE #CEQ DOES A STARTF
+ DCA FMODE /FMODE=0 ONLY IF ARGS WERE D.P.
+ JMS I QGENSF /GENERATE STARTF IF NECESSARY
+ JMP I .+1
+ LIFBGN+1 /GO TO LOGICAL IF PROCESSOR
+
+EQV, JMS I QCODE /.EQV. LOGICAL OPERATOR
+ EQVTBL-6;0
+ JMP RELGM1
+\f/ PASS TWO OUTPUT ROUTINE
+OCHAR, 0 /OUTPUT A CHAR TO THE
+ /RALF INPUT FILE
+ AND (377
+ DCA OUTEMP /SAVE CHAR
+ ISZ OUJUMP /BUMP THREE WAY SWITCH
+OUJUMP, JMP .
+ JMP CHAR1
+ JMP CHAR2
+ TAD OUTEMP /HIGH FOUR BITS GO INTO
+ CLL RTL /THE HIGH ORDER BITS OF THE
+ RTL /FIRST WORD OF THE TWO WORD PAIR
+ AND (7400 /SEE NOTE * BELOW
+ TAD I OUPOLD /COMBINE WITH OTHER BITS
+ DCA I OUPOLD
+ TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR
+ CLL RTR /GO INTO THE HIGH ORDER FOUR
+ RTR /BITS OF THE SECOND
+ /WORD OF THE PAIR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR
+ TAD OUJMP /RESET 3 WAY BRANCH
+ DCA OUJUMP
+ ISZ OUPTR /BUMP BUFFER POINTER
+ ISZ OUWDCT /AND DOUBLE WORD COUNTER
+ JMP I OCHAR /BUFFER NOT FULL
+ JMS OUDUMP /DUMP IT
+ JMP I OCHAR
+CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER
+ DCA OUPOLD
+ ISZ OUPTR /GO TO SECOND WORD
+CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2
+ DCA I OUPTR
+ JMP I OCHAR
+OUTEMP,
+OUDUMP, 0 /BUMP THE DUFFER
+ TAD OSIZE /ANY ROOM LEFT ?
+ SNA
+ JMP OUERR
+ IAC
+ DCA OSIZE /YES, ITS OK
+ JMS I DEVH /WRITE
+ 4200 /CONTROL WORD
+ OUBUF /BUFFER POINTER
+OBLOCK, 0 /BLOCK NUMBER
+ JMP OUERR /ERROR
+ ISZ OBLOCK /INCREMENT BLOCK NUMBER
+ ISZ FILSIZ /AND FILE SIZE
+ TAD OBLOCK-1 /SET BUFFER POINTER
+ DCA OUPTR
+ TAD (-200 /SET DOUBLE WORD COUNT
+ DCA OUWDCT
+ JMP I OUDUMP
+OUERR, JMS I (FATAL /FATAL OUTPUT ERROR
+ 1706
+/ * THE PONY EXPRESS STARTED IN 1860 AND ONLY RAN
+/ FOR 19 MONTHS WHILE LOSING $200,000.
+OUPOLD, 0
+OUPTR, OUBUF
+OUJMP, JMP OUJUMP
+OUWDCT, -200
+OSIZE, 0
+DD1, TEXT '1'
+ PAGE
+\f/ READ FROM FORTRN.TM
+
+INWORD, 0 /READ A WORD FROM INPUT FILE
+ ISZ INBCNT /ANYTHING LEFT IN BUFFER ?
+ JMP NOREAD /YES
+ ISZ INRCNT /ANYTHING LEFT IN FILE?
+ SKP
+ JMP I (END /NO, END OF PROG
+ JMS I DEVH /READ NEXT BLOCK
+X200, 0200
+ INBUF
+INBLOK, 0
+ JMP INERR /INPUT ERROR
+ ISZ INBLOK /BUMP BLOCK NUMBER
+ TAD (-400 /RESET COUNTER
+ DCA INBCNT
+ TAD INBLOK-1 /RESET POINTER
+ DCA INBPTR
+NOREAD, TAD I INBPTR /GET WORD FROM BUFFER
+ ISZ INBPTR /BUMP BUFFER POINTER
+ JMP I INWORD
+INERR, JMS I (FATAL /FATAL INPUT ERROR
+ 1105
+INBCNT, -1 /FORCE READ FIRST TIME
+INBPTR, 0
+INRCNT, 0
+\f/ CODE UTILITIES
+GETSS, 0 /GET POINTER TO DIM INFO
+ CDF 10
+ IAC
+ DCA DIMPTR /ADDR OF TYPE WORD
+ TAD I DIMPTR
+ ISZ DIMPTR /MOVE TO DIM/EQUIV POINTER
+ AND X200 /EQUIV INFO ?
+ SNA CLA
+ JMP .+3 /NONE
+ TAD I DIMPTR /SKIP EQUIV INFO
+ DCA DIMPTR
+ TAD I DIMPTR /ADDRESS OF DIM INFO
+ JMP I GETSS
+NUMBRO, 0 /OUTPUT 15 BIT OCTAL NUMBER
+ TAD AC /IS HIGH DIGIT 0 ?
+ SNA
+ JMP .+3 /YES, PRINT 4 DIGITS ONLY
+ TAD Q260 /MAKE IT ASCII
+ JMS I QOCHAR /PUT IT
+ TAD MQ /NOW LOW FOUR DIGITS
+ JMS I QONUMBR
+ JMP I NUMBRO
+UCODE, 0 /GEN CODE FOR UNARY OPERATORS
+ JMS I QSAVEAC /SAVE AC IF NEEDED
+ JMS GARG
+ JMP OTERR /OPERATOR/TYPE ERROR
+ TAD ARG1 /IS ARG IN AC ?
+ SNA CLA
+ TAD Q5 /YES, USE SECOND HALF OF TABLE
+ TAD TYPE1
+ TAD I UCODE /PLUS TABLE ADDRESS
+ DCA USKEL
+ CDF 10
+ TAD I USKEL /ADDR OF SKELETON
+ SNA
+ JMP OTERR /0 MEANS BAD
+ /OPERATOR/TYPE COMBO
+ DCA USKEL /SAVE SKELETON ADDR
+ JMS I QGENCOD /GO DO THE CODE
+USKEL, 0
+ DCA I X16 /RESULT IN AC
+ ISZ X16 /BUMP STACK POINTER
+ ISZ X16 /TYPE IS ALREADY THERE
+ ISZ UCODE /FIX RET ADDR
+ JMP I UCODE
+GARG, 0 /GET ONE ARG
+ CLL CMA RTL /BACK UP ONE ENTRY
+ TAD X16
+ DCA X16
+ TAD X16 /USABLE POINTER
+ DCA X15
+ TAD I X15 /GET OPERAND
+ DCA ARG1
+ TAD I X15
+ DCA TYPE1
+ TAD I X15
+ DCA BASE1
+ TAD TYPE1 /CHECK TYPE
+ TAD QM6
+ SMA CLA
+ JMP I GARG /TAKE ERROR EXIT
+ ISZ ARG2 /MAKE SURE ARG2 ISN'T ZERO
+ JMS I (MPTRA1 /MOVE THE POINTER IF
+ /THERE IS ONE
+ ISZ GARG
+ JMP I GARG
+
+TTYOUT, 0 /OUTPUT TO THE TTY
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ KSF
+ JMP I TTYOUT /NO KEYBOARD FLAG
+ KRB
+ AND (177 /ACCEPT PARITY ASCII
+ TAD (-3 /^C ?
+ SNA
+ JMP I Q7605 /YES, BACK TO PS8
+ TAD (3-17 /^O ?
+ SZA CLA
+ JMP I TTYOUT /NO, RETURN
+ DCA TTYOUT+1 /KILL OUTPUT STUFF
+ DCA TTYOUT+2
+ DCA TTYOUT+3
+ JMP I TTYOUT /RETURN
+\fLTRNE, TEXT '#NE'
+ TEXT '#GE'
+ TEXT '#LE'
+ TEXT '#GT'
+ TEXT '#LT'
+ TEXT '#EQ'
+ PAGE
+\f/ SOME TEXT
+
+P2, TEXT '+2'
+XVAL, TEXT '#VAL'
+DP4, TEXT '.+4'
+FADD, TEXT 'FADD'
+FLDA, TEXT 'FLDA'
+FSUB, TEXT 'FSUB'
+\f/ SAVE AC ROUTINES
+SAVACT, 0 /SAVE TOP OF STACK IF
+ /NECESSARY
+ TAD SAVACT /SAVE RETURN ADDR
+ DCA SAVEAC
+ CLL CMA RAL
+ JMP SAVEAC+2 /BACK UP ONLY ONE ENTRY
+SAVEAC, 0 /STORE AC IF NEEDED
+ TAD (-5 /LOOK AT STACK TWO DOWN
+ TAD X16
+ DCA SATEMP
+ TAD I SATEMP /IF 0, RESULT WAS LEFT IN AC
+ SZA CLA
+ JMP I SAVEAC /NO, NO STORE NEEDED
+ TAD TMPCNT /STORE TEMP NUMBER
+ DCA I SATEMP
+ ISZ SATEMP /MOVE TO TYPE WORD
+ TAD I SATEMP /GET TYPE
+ JMS SAVE /GO DO ACTUAL STORE
+ JMP I SAVEAC
+SAVE, 0 /SAVE AC
+ DCA ACSTOR /THIS IS THE TYPE
+ TAD ACSTOR /IS IT COMPLEX OR DOUBLE?
+ TAD QM4
+ SNA
+ JMP NOC /ITS DOUBLE
+ IAC
+ SZA CLA
+ JMP NOCORD /NO
+ JMS I QGENCOD /STARTE; FLDA #CAC
+ SEGCAC-1
+NOC, JMS ACSTOR /%FSTA #TMP+XXXX
+ JMS TMPBMP /THIS USE TWO TEMPS
+ JMP I SAVE
+NOCORD, JMS ACSTOR /%FSTA #TMP+XXXX
+ JMP I SAVE
+\fSATEMP,
+ACSTOR, 0 /GENERATES FSTA TEMP+XXXX
+ JMS I QOPCOD /OUTPUT %FSTA %TEMP+XXXX
+ FSTA
+ JMS I QOADDR
+ TMPCNT /TMPCNT CONTAINS THE
+ /ARG NUMBER
+ JMS TMPBMP /BUMP TEMPORARY NUMBER
+ JMP I ACSTOR
+
+TMPBMP, 0 /ROUTINE TO BUMP TEMPORARIES
+ TAD TMPCNT /BIGGER THAN MAX?
+ CIA CLL
+ TAD TMPMAX
+ SZL CLA
+ JMP .+3 /GO BUMP TEMP CNT
+ TAD TMPCNT /NEW TEMP MAX
+ DCA TMPMAX
+ ISZ TMPCNT /INCR TEMP COUNT
+ JMP I TMPBMP
+\f/ PUSH ARG ONTO STACK
+PUSH, JMS SAVEAC /GO SAVE AC IF NEEDED
+ JMS I QINWORD /GET ADDR OF NEW VAR
+ DCA TEMP /SAVE IT
+ TAD TEMP /PUSH IT
+ DCA I X16
+ ISZ TEMP /GO TO TYPE
+ CDF 10
+ TAD I TEMP /GET TYPE
+ CDF
+ AND Q17 /PUSH TYPE
+ DCA I X16 /ONTO STACK
+CKPDL, DCA I X16 /ZERO BASE WORD
+ TAD X16 /IS STACK FULL ?
+ CIA CLL
+ TAD (STACK+177
+ SZL CLA
+ JMP I QNEXT /NO, OK
+ TAD STKLVL /RESET STACK LEVEL
+ DCA X16
+ JMS I QTTYMSG /PRINT MESSAGE
+ 2004
+DPUSH, JMS I QINWORD /GET THE VAR NAME PTR
+ DCA I X16 /PUSH IT
+ JMS I QINWORD /NOW GET THE DISPLACEMENT
+ JMP CKPDL-1 /GO CHECK FOR OVERFLOW
+STARTF, TEXT 'STARTF'
+\f/ ARITHMETIC IF
+ARTHIF, JMS I QUCODE /GET ARG INTO AC
+ AIFTBL-1
+ JMS I QGENSF /DO ALL TRANSFERS IN FMODE
+ TAD (JLT /FIRST OPCODE
+ DCA AJUMP
+AIFLUP, JMS I QINWORD /GET NEXT INPUT
+ DCA TEMP2 /SAVE IT IN CASE ITS NOT LABEL
+ TAD TEMP2
+ CLL
+ TAD (XPUSH-XLAST /IS IT A LABEL ?
+ SNL CLA
+ JMP I QNEXTM2 /NO, PROCEED
+ JMS I QOPCDE
+AJUMP, 0 /OUTPUT CORRECT JUMP
+ TAD TEMP2
+ CDF 10
+ JMS I QOSNUM /NOW THE LABEL
+ JMS I QCRLF
+ ISZ AJUMP /MOVE TO NEXT OPCODE
+ ISZ AJUMP
+ JMP AIFLUP
+DOT, TEXT '.'
+DP8, TEXT '.+10'
+ PAGE
+\f/ PICK UP TOP TWO ARGS
+
+GARGS, 0 /GET TOP 2 ARGS FROM STACK
+ TAD X16
+ TAD QM6 /BACK TWO OPERANDS
+ DCA X15
+ TAD X15
+ DCA X16 /AND OFFICIALLY POP THE STACK
+ TAD I X15 /GET FIRST ARG
+ DCA ARG1
+ TAD I X15 /AND TYPE
+ DCA TYPE1
+ TAD I X15
+ DCA BASE1 /AND FIRST BASE (IN
+ /CASE OF SS)
+ TAD I X15 /NOW SECOND ARG
+ DCA ARG2
+ TAD I X15
+ DCA TYPE2
+ TAD I X15
+ DCA BASE2
+ TAD TYPE1 /TYPES MUST BE LT 6
+ TAD QM6
+ SMA CLA
+ JMP I GARGS /RETURN BAD
+ TAD TYPE2
+ TAD QM6
+ SPA CLA
+ ISZ GARGS /FIX RETURN
+ JMS MPTRA1 /GET ARG1 POINTER IF NEEDED
+ TAD ARG2 /IS ARG2 A POINTER
+ TAD (-61
+ SZA CLA
+ JMP I GARGS /NO, RETURN
+ TAD ARG1 /IS ARG1 IN THE AC ?
+ SZA CLA
+ JMP .+5 /NO
+ TAD TMPCNT /YES, STORE THE AC
+ DCA ARG1
+ TAD TYPE1 /GET TYPE
+ JMS I (SAVE
+ TAD BASE2 /MOVE POINTER FROM TEMP
+ /TO BASE+3
+ DCA ARG2
+ JMS I QGENCOD
+ MPTR3-1
+ TAD (62 /ARG IS NOW POINTED TO
+ /BY BASE+3
+ DCA ARG2
+ JMP I GARGS
+MPTRA1, 0 /MOVE ARG1 POINTER TO BASE
+ TAD ARG1
+ TAD (-61
+ SZA CLA
+ JMP I MPTRA1
+ TAD ARG2
+ SZA CLA
+ JMP .+5
+ TAD TMPCNT
+ DCA ARG2
+ TAD TYPE2 /GET THE TYPE
+ JMS I (SAVE
+ TAD BASE1
+ DCA ARG1
+ JMS I QGENCOD
+ MPTR0-1
+ TAD (61
+ DCA ARG1 /SET ARG1 TO IND0
+ JMP I MPTRA1
+\f/ BINARY OPERATORS
+CODE, 0 /GENERATE CODE FOR
+ /BINARY OPERATORS
+ JMS GARGS /GET OPERANDS
+ JMP OTERR /BAD TYPE OPERATOR COMBO
+ TAD TYPE1 /INDEX INTO TYPE CHECK TABLE
+ CLL RTL
+ TAD TYPE1
+ TAD TYPE2
+ CLL RAL
+ TAD (TYPMIX-14 /POINTER TO CORRECT ENTRY
+ DCA SKEL
+ CDF 10
+ TAD I SKEL /RESULTING TYPE
+ SNA
+ JMP TYPERR /THIS MIX IS ILLEGAL
+ DCA TYPE1 /SAVE RESULT TYPE
+ ISZ SKEL /GET INDEX INTO
+ /SKELETON TABLE
+ TAD I SKEL
+ CDF
+ TAD I CODE /PLUS BASE GIVES ADDR
+ /OF M,AC CASE
+ DCA SKEL
+ CDF 10
+ TAD I SKEL /IS THIS TYPE OPER
+ /COMBO LEGAL ?
+ SNA CLA
+ JMP OTERR /NO
+ ISZ CODE /POINTS TO RESULTING TYPE
+ TAD ARG2
+ SZA CLA
+ ISZ SKEL /SECOND ARG IS IN MEMORY
+ TAD ARG1
+ SNA CLA /SKIP ON M,M CASE
+ ISZ SKEL /MOVE TO AC,M CASE
+ TAD I SKEL /PICK UP POINTER TO SKELETON
+ DCA SKEL
+ JMS I QGENCOD /GO DO THE CODE
+SKEL, 0
+ DCA I X16 /RESULT IS IN THE AC
+ TAD I CODE
+ SNA /IS TYPE SAME AS ARGS ?
+ TAD TYPE1 /YES
+ DCA I X16 /STORE IT
+ DCA I X16 /ZERO BASE WORD
+ TAD I CODE /IS TYPE SAME AS ARGS ?
+ SZA
+ DCA FMODE /NO, WE'RE NOW IN FMODE
+ JMP I CODE
+TYPERR, JMS BUMP /PUT FALSE VALUE ONTO STACK
+ JMS I QTTYMSG /OUTPUT ERROR
+ 1524
+OTERR, JMS BUMP /PUT FALSE VALUE ONTO STACK
+ JMS I QTTYMSG
+ 1724
+XDPP6, TEXT '#DPT+6'
+XFIX, TEXT '#FIX'
+ PAGE
+\f/ CODE GENERATOR (FROM SKELETONS)
+
+GENCOD, 0 /CODE GENERATOR ROUTINE
+ CDF
+ TAD X14
+ DCA TEMP14 /FIX COMPLEX FUNCTION BUG
+ TAD I GENCOD /GET SKELETON ADDRESS
+ ISZ GENCOD
+MPOPUP, DCA X14 /HERE ON MACRO END
+ DCA MRETN
+CODLUP, CDF 10 /STUFF IS IN FIELD 1
+ TAD I X14 /GET OPCODE
+ CDF
+ SNA
+ JMP ENDM /IS IT END OF A MACRO ?
+ SPA
+ JMP MACRO /ITS A MACRO REFERENCE
+ DCA .+2 /SAVE OPCODE
+ JMS I QOPCOD /OUTPUT IT
+ 0
+ CDF 10
+ TAD I X14 /ADDRESS ?
+ CDF
+ SNA
+ JMP NOADDR /NO OPERAND FOR THIS INSTR
+ SPA
+ JMP DOADDR /ADDRESS IS AN OPERAND
+ DCA TEMP
+ JMS I QOTAB /ADDRESS IS A SPECIFIC
+ TAD TEMP
+ JMS I QOUTSYM
+NOADDR, JMS I QCRLF
+ JMP CODLUP /DO NEXT LINE
+DOADDR, IAC /IS IT ARG1 ?
+ SZA CLA
+ JMP ITSA2 /NO, ITS ARG2
+ JMS I QOADDR /OUTPUT ARG1 ADDRESS FIELD
+ ARG1
+ JMP CODLUP
+ITSA2, JMS I QOADDR /OUTPUT ARG2 ADDRESS
+ ARG2 /FIELD
+ JMP CODLUP
+MACRO, TAD Q5 /CODES BETWEEN -1 AND -5 ARE SPECIAL
+ SPA
+ JMP .+4 /NOT ONE OF THEM
+ TAD (JMP MJTBL
+ DCA .+1
+ HLT /GO TO PROPER ROUTINE
+ DCA MSTART /SAVE START OF MACRO
+ TAD X14 /SAVE RETURN ADDRESS
+ DCA MRETN
+ TAD MSTART /GO DO MACRO
+ DCA X14
+ JMP CODLUP
+\fENDM, TAD MRETN /WAS THIS A MACRO ?
+ SZA
+ JMP MPOPUP /YES - GET OUT OF IT
+ TAD TEMP14
+ DCA X14 /RESTORE X14 FOR FUNCAL
+ JMP I GENCOD /AND EXIT
+
+LOADA1, JMS I (LOADA /GENERATE LOAD
+ ARG1 /IF NECESSARY
+ JMP CODLUP
+LOADA2, JMS I (LOADA /GENERATE LOAD
+ ARG2 /IF NECESSARY
+ JMP CODLUP
+DOSTE, JMS I QGENSE /STARTE IF IN F MODE
+ JMP CODLUP
+SGNNEG, ISZ RELCD /CHANGE SIGN OF RELATIONAL OPERATOR
+ JMP CODLUP
+ MSTART=TEMP
+MRETN, 0 /MACRO RETURN ADDRESS
+TEMP14, 0
+
+MJTBL, JMP SGNNEG /-5 - NEGATE RELATIONAL SIGN
+ JMP LOADA2 /-4 - LOAD ARG 2
+ JMP LOADA1 /-3 - LOAD ARG 1
+ JMP DOSTE /-2 - START E MODE
+ JMS I QGENSF /-1 - START F MODE
+ JMP CODLUP
+
+XSET, TEXT 'SETX'
+ZEROC1, TEXT '0,1'
+\f/ GOTO'S AND ASSIGN
+CGOTO, JMS GTSTUF /LOOK AT INDEX
+ JMS I QGENCOD /OUTPUT COMPUTED GOTO CODE
+ CGTCOD-1
+ JMS I QINWORD /GET COUNT
+ CIA
+ DCA TEMP2
+CGTLUP, JMS JAGEN
+ ISZ TEMP2
+ JMP CGTLUP
+ JMP I QNEXT
+GOTO, JMS I QGENSF /ALL TRANSFERS IN F MODE
+ JMS JAGEN
+ JMP I QNEXT
+
+JAGEN, 0
+ JMS I QOPCDE /OUTPUT JA'S
+ JA
+ JMS I QINWORD /GET THE LABEL
+ CDF 10
+ JMS I QOSNUM /OUTPUT IT AS THE ADDRESS
+ JMS I QCRLF
+ JMP I JAGEN
+
+GTSTUF, 0
+ JMS I QGARG /GET THE ARG
+ JMP GTTYPE
+ CLL CMA RTL /CHECK THE TYPE
+ TAD TYPE1
+ SMA CLA
+ JMP GTTYPE /NOT INTEGER OR REAL
+ TAD ARG1 /IS IT IN THE AC ?
+ SNA CLA
+ JMP I GTSTUF /YES ALREADY
+ JMS I QGENCOD
+ GI-1 /LOAD THE INDEX
+ JMP I GTSTUF
+GTTYPE, JMS I QTTYMSG /GOTO TYPE ERROR
+ 0726
+JAC, TEXT 'JAC'
+FSTA, TEXT 'FSTA'
+FNEG, TEXT 'FNEG'
+ PAGE
+\f/ ADDRESS FIELD OUTPUT
+OADDR, 0 /OUTPUT ADDRESS FIELD
+ TAD I OADDR /GET ADDRESS OF PARAMETERS
+ DCA ARG
+ ISZ OADDR
+ TAD I ARG /GET VALUE OF ARG
+ CLL
+ TAD (-52 /IS IT A TEMP REFNCE
+ SNL
+ JMP TMPREF /YES, 1-51
+ TAD (52-61 /IS IT AN ARRAY REFERENCE ?
+ SZL
+ JMP SSREF /YES, 52-60 IS XR1-XR7
+ SNA
+ JMP IND0 /INDIRECT THROUGH 0
+ TAD (61-7000 /CHECK FOR DO TEMP
+ SZL
+ JMP DOTMP
+ TAD (7000-62
+ SNA
+ JMP IND3 /INDIRECT THROUGH 3
+ TAD (63
+ DCA TEMP
+ CDF 10
+ TAD I TEMP /IS THIS AN ARG ?
+ AND Q20
+ CDF
+ SZA CLA
+ JMP INDARG /YES, REF IT INDIRECTLY
+ JMS I QOTAB
+ CDF 10
+ TAD I TEMP /LOOK AT TYPE WORD
+ AND (50 /IS IT LIT OR STMT NO.?
+ SNA
+ JMP OUTA /NO, JUST OUTPUT ADDRESS
+ AND Q40
+ SNA CLA
+ JMP OUTSN /OUTPUT STMT NUMBER
+ JMP OUTLIT /OUTPUT LITERAL
+OUTA, TAD PROGNM /IS THIS THE FUNCTION NAME ?
+ CIA
+ TAD TEMP
+ SNA CLA
+ JMP FUNNAM /YES, REFERENCE #VAL INSTEAD
+OUTA2, CLA CMA /SIMPLE LOCAL VARIABLE REFNCE
+ TAD TEMP /ADDRESS OF VAR
+ JMS I QOUTNAM /INTO ADDR FIELD
+ JMS I QCRLF
+ JMP I OADDR /END OF ADDRESS
+OUTLIT, ISZ TEMP /MOVE TO LITERAL NUMBER
+ TAD I TEMP
+ DCA TEMP /DISPLACEMENT FROM %LITRL
+ CDF
+ TAD QLITRL /OUTPUT #LIT+
+ JMS I QOUTSYM
+ TAD TEMP /DISPLACEMENT
+ JMS I QONUMBR
+ JMP OADRET-1
+FUNNAM, TAD (XVAL /#VAL
+ JMS I QOUTSYM
+ JMP OADRET-1
+SSREF, TAD (270 /MAKE IT AN ASCII DIGIT
+ DCA XR
+ ISZ ARG /POINT TO THE BASE WORD
+ TAD I ARG /GET THE ADDR OF THE BASE
+ DCA ARG
+ CDF 10
+ TAD ARG
+ IAC /GO TO TYPE OF BASE VAR
+ DCA TEMP2
+ TAD I TEMP2 /IS IT AN ARG TO THE SUBR ?
+ AND Q20
+ SNA CLA
+ JMP NOTARG /NO, NO INDIRECT STUFF
+ CDF
+ JMS SIT
+ TAD ARG /VAR NAME
+ CDF 10
+ JMS I QOUTNAM
+ TAD COMMA
+ JMS I QOCHAR
+ TAD XR /XR NUMBER
+ JMS I QOCHAR
+ JMS I QCRLF
+OADRET, JMP I OADDR
+IND3, TAD (XBASP3-XBASE /INDIRECT THRU #BASE+3
+IND0, TAD (XBASE /INDIRECT THRU #BASE
+ DCA TEMP
+ JMS SIT
+ TAD TEMP
+ JMP FUNNAM+1
+OUTSN, CLA CMA /OUTPUT STMT NUMBER
+ TAD TEMP
+ JMS I QOSNUM /OUTPUT THE NUMBER
+ TAD (P2 /+2 (HACK FOR FORMAT)
+ JMP FUNNAM+1
+INDARG, JMS SIT /INDIRECT INDICATOR
+ CDF 10
+ JMP OUTA2 /OUTPUT ARG NAME
+SIT, 0
+ TAD (245 /% (INDIRECT)
+ JMS I QOCHAR
+ JMS I QOTAB
+ JMP I SIT
+CEQ, TEXT '#CEQ'
+XBAC1P, TEXT '#BASE,1+'
+XUE, TEXT '#UE'
+ PAGE
+\f/ ADDRESS FIELD OUTPUT
+
+NOTARG, TAD I TEMP2 /GET TYPE WORD
+ DCA TEMP /SAVE IT
+ TAD TEMP
+ ISZ TEMP2
+ AND Q200 /EQUIVALENCED ?
+ SNA CLA
+ JMP .+3
+ TAD I TEMP2 /SKIP EQUIV INFO BLOCK
+ DCA TEMP2
+ CLL CML RTL
+ TAD I TEMP2 /ADDRESS OF MAGIC NUMBER
+ DCA TEMP2
+ TAD I TEMP2 /MAGIC NUMBER ITSELF
+ DCA TEMP2
+ CDF
+ JMS I QOTAB /TAB
+ TAD ARG /OUTPUT VARIABLE MINUS CONST
+ JMS VMC
+ TAD COMMA
+ JMS I QOCHAR
+ TAD XR /N
+ JMS I QOCHAR
+ JMS I QCRLF /END OF LINE
+ JMP OADRET
+DOTMP, DCA TEMP /ADDRESS RELATIVE TO %DOTMP
+ JMS I QOTAB
+ TAD (DOTMPN /OUTPUT #DOTMP
+ JMS I QOUTSYM
+ JMP PLUSN /GO OUTPUT +XXXX
+TMPREF, CLA
+ TAD I ARG /BUMP TEMPS BACK CORRECTLY (?)
+ DCA TMPCNT
+ JMS I QOTAB /TAB
+ CLA CMA
+ TAD I ARG /GET NUMBER
+ DCA TEMP /INTO TEMP
+ IFNZRO TMPBLK-2 <XXXXXX>
+ CLL STA RAL /V3C -2 (-TMPBLK)
+ /V3C LINK SET
+ TAD TEMP /V3C (SAVES A LITERAL)
+ SNL /V3C
+ DCA TEMP /YES, SAVE ALTERED DISPLACEMENT
+ SNL CLA /V3C
+ TAD (TEMPN2-TEMPN /USE %TEMPX
+ TAD (TEMPN /USE %TEMP
+ JMS I QOUTSYM
+PLUSN, TAD PLUS /PLUS CONSTANT
+ JMS I QOCHAR
+ TAD TEMP /DISPLACEMENT TIMES THREE
+ CLL RAL
+ TAD TEMP
+ JMS I QONUMBR /OUT IT
+ JMS I QCRLF
+ JMP OADRET
+\f/ UTILITIES
+VMC, 0 /OUTPUT VARIABLE MINUS CONST
+ CDF 10
+ JMS I QOUTNAM /PUT VAR NAME
+ TAD Q255 /-
+ JMS I QOCHAR
+ TAD TEMP /THIS CONTAINS THE TYPE
+ JMS SKPIRL /SKIP ON I,R OR L
+ TAD Q3 /USE SIX WORDS PER ENTRY
+ TAD Q3 /REAL, INTEGER, OR
+ /LOGICAL 3 WORDS
+ DCA MQ
+ TAD TEMP2
+ JMS MUL12 /DO MULTIPLY
+ JMS I QNUMBRO /OUTPUT 15 BIT NUMBER
+ JMP I VMC
+SC,
+SKPIRL, 0 /SKIP ON TYPE I R OR L
+ AND Q17 /ISOLATE TYPE CODE
+ TAD QM4 /IS IT DOUBLE ?
+ SZA
+ IAC /NO, IS IT COMPLEX ?
+ SZA CLA
+ ISZ SKPIRL /NEITHER, SKIP
+ JMP I SKPIRL /RETURN
+MUL12, 0 /12 BIT MULTIPLY
+ DCA OPRND
+ TAD (-15
+ DCA SC
+ JMP STMUL
+M12LUP, TAD AC
+ SNL
+ JMP .+3
+ CLL
+ TAD OPRND
+ RAR
+STMUL, DCA AC
+ TAD MQ
+ RAR
+ DCA MQ
+ ISZ SC
+ JMP M12LUP
+ JMP I MUL12
+OPRND,
+BUMP, 0 /PUT FALSE ENTRY ONTO STACK
+ CDF 0 /V3C IMPORTANT PROTECTION
+ DCA I X16
+ ISZ X16
+ ISZ X16 /THIS PREVENTS UNDER
+ /FLOWING THE STACK
+ JMP I BUMP /AFTER SOME ERRORS
+EXTERN, TEXT 'EXTERN'
+CADD, TEXT '#CAD'
+CNEG, TEXT '#CNG'
+CMUL, TEXT '#CML'
+JLE, TEXT 'JLE'
+ORG, TEXT 'ORG'
+STARTE, TEXT 'STARTE'
+XDPTMP, TEXT '#DPT'
+ PAGE
+\f/ RANDOM CODE GENERATORS
+
+ERROR, JMS I QINWORD /GET ERROR CODE
+ JMS I QERMSG /PRINT IT
+ JMP I QNEXT
+EOSTMT, TAD DATASW /WAS THIS A DATA STMT ?
+ SNA CLA
+ JMP OPTMYZ /NO
+ DCA DATASW /KILL SWITCH
+ JMS I QOPCDE
+ ORG /ORIGIN BACK TO THE PROGRAM
+ TAD GLABEL
+ JMS I QOLABEL
+ JMS I QCRLF
+ ISZ GLABEL /BUMP LABEL GENERATOR
+OPTMYZ, CLA /CHANGED TO CLA IAC IF /O
+ JMS I QXRTBL /CLEAR TABLE OR RESET FLAGS
+ ISZ LINENO /BUMP LINE NUM
+ TAD LINENO /DISPLAY IN MQ
+ 7421 /FOR COOLNESS
+ CLA /FOR NON-EAE FOLKS
+ TAD STKLVL /RESET STACK LEVEL
+ DCA X16
+ JMS IFEND /LOOK FOR END OF LOGICAL IF
+ JMS I (ASFEND /END OF A.S.F. DEFINITION ?
+DEBUG, JMP I QNEXT /OVERLAYED IF NO /N SWITCH
+ JMS I QOPCDE /OUTPUT LDX NNNN,0
+ LDX
+ TAD LINENO /THIS IS THE CURRENT ISN
+ JMS I QONUMBR
+ TAD COMMA
+ JMS I QOCHAR
+ TAD Q260
+ JMS I QOCHAR
+ JMS I QCRLF
+ JMP I QNEXT
+IFEND, 0 /OUTPUT IF END LABEL IF
+ TAD IFLABL /WAS THIS END OF LOG IF
+ SNA
+ JMP I IFEND /OUTPUT DEBUG STUFF
+ JMS I QLABEL /OUPTUT THE LABEL
+ JMS I QGENSF /ALL LOGICAL IFS MUST
+ /END IN FMODE
+ DCA WHATAC /CAN'T DEPEND ON
+ /AC HERE
+ JMS I QXRTBL /OR XR'S EITHER
+ DCA IFLABL /KILL THE SWITCH
+ JMP I IFEND
+OPCOD, 0 /TAB OPCODE
+ DCA WHATAC /AC HAS JUST BEEN
+ /MODIFIED
+ JMS I QOTAB
+ TAD I OPCOD
+ ISZ OPCOD
+ JMS I QOUTSYM
+ JMP I OPCOD
+DIV, JMS I QSAVACT /IF SECOND OPERAND IN AC, SAVE IT
+ JMS I QCODE /DIVIDE
+ DIVTBL-6;0
+ CLA CMA /WERE BOTH VARS INTEGER?
+ TAD TYPE1
+ SZA CLA
+ JMP I QNEXT /NO
+ JMS I QGENCOD
+ A0FN-1 /ALN 0;FNORM
+ JMP I QNEXT
+LIFBGN, DCA RELCD /ENTER HERE IF LAST OPCODE NOT A RELATIONAL
+ JMS I QGARG /ENTER HERE FROM RELATIONAL OPTIMIZER
+ JMP NOTLOG
+ TAD TYPE1 /MUST BE LOGICAL
+ TAD (-5
+ SZA CLA
+ JMP NOTLOG
+ TAD ARG1 /IS IT IN AC ?
+ SNA CLA
+ JMP .+3
+ JMS I QGENCOD
+ GI-1
+ JMS I QINWORD /IS IT IF(...)GOTO XX ?
+ DCA TEMP2
+ TAD TEMP2
+ TAD (XPUSH-XGOTO
+ SNA CLA
+ JMP IFGOTO /YES, TREAT AS SPECIAL CASE
+ TAD GLABEL /SET IF LABEL
+ DCA IFLABL
+ TAD RELCD
+ CIA
+ TAD Q5 /GENERATE THE OPPOSITE JUMP
+ JMS RELJMP /AROUND THE TARGET OF THE IF
+ TAD GLABEL
+ JMS I QOLABEL
+ ISZ GLABEL /INCREMENT LABEL GENERATOR
+ JMS I QCRLF
+ JMP I QNEXTM2
+IFGOTO, TAD RELCD
+ JMS RELJMP /GENERATE TRUE RELATIONAL JUMP IF "IF()GOTO"
+ JMS I QINWORD /GET THE LABEL
+ CDF 10
+ JMS I QOSNUM
+ JMS I QCRLF
+ JMP I QNEXT
+NOTLOG, JMS I QTTYMSG
+ 1411
+
+RELJMP, 0
+ CLL RAL
+ TAD (JNE
+ DCA .+2
+ JMS I QOPCDE
+ 0
+ JMP I RELJMP
+
+FMUL, TEXT 'FMUL'
+FDIV, TEXT 'FDIV'
+CAC, TEXT '#CAC'
+LITRL, TEXT '#LIT+'
+TEMPN, TEXT '#TMP'
+ PAGE
+\f/ DO LOOP COMPILER
+
+DOBEGN, JMS I QSAVACT /FOR EXPR IN LOOP PARAMS
+ TAD X16 /SET NEW STACK LEVEL
+ DCA STKLVL
+ JMS I QGARGS /GET LIMIT AND STEP
+ JMP DPERR /ERROR IN DO PARMS
+ JMS DOPARM /DO PARAMETER STUF FOR LIMIT
+ ARG1
+ JMS DOPARM
+ ARG2 /AND THEN FOR STEP
+ TAD ARG1 /REPLACE ALTERRED STACK
+ /ENTRIES
+ DCA I X16
+ ISZ X16 /REST OF ARG1 OK
+ TAD GLABEL /SAVE LOOP LABEL
+ DCA I X16
+ TAD ARG2
+ DCA I X16
+ ISZ X16
+ ISZ X16
+ JMS I QCRLF /CRLF BEFORE LABL
+ TAD GLABEL
+ JMS I QLABEL /OUPTUT LOOP LABEL
+ ISZ GLABEL /INCR LABEL GENERATOR
+ DCA WHATAC /FORGET AC AND
+ JMS I QXRTBL /XR'S AT DO BEGIN
+ JMP I QNEXT
+DOSTOR, JMS I QGARGS /LOOK AT INDEX AND
+ JMP DPERR /INITIAL VALUE
+ CLL CMA RTL /MUST BE INTEGER OR
+ TAD TYPE1 /REAL (L=1 AC=-3)
+ SZL CLA /SKIP IF >2
+ CLL CMA RTL /L=1 AC=-3
+ TAD TYPE2
+ SZL CLA /L=0 IS BAD
+ JMP I (STORE+2 /DO STORE IF OK
+DPERR, JMS I QTTYMSG /ERROR IN LIMITS
+ 0420 /DP
+DOFINI, JMS I QXRTBL /DON'T OPTIMIZE XR USAGE
+ /IN SUCCESSIVE IMPLIED DO LOOPS
+ TAD IOSTMT /INSIDE IO STMT ?
+ SNA CLA
+ JMS IFEND /IF NOT, END IF FIRST
+ JMS I QINWORD /GET THE INDEX
+ DCA ARG1
+ TAD ARG1 /GET THE TYPE WORD ADR
+ IAC
+ DCA TYPE1
+ CDF 10
+ TAD I TYPE1
+ CDF
+ AND Q17
+ DCA TYPE1 /TYPE OF INDEX VAR
+ TAD QM6
+ TAD STKLVL /BACK UP THE STACK
+ DCA X16
+ TAD X16 /RESET THE STACK LEVEL
+ DCA STKLVL
+ TAD I X16 /GET THE FINAL VALUE
+ DCA DOARG
+ ISZ X16
+ TAD I X16 /GET THE LOOP LABEL
+ DCA DARG
+ TAD I X16 /GET THE STEP
+ DCA ARG2
+ TAD I X16 /WHICH DO FIN CODE ?
+ CLL CML RAL
+ TAD TYPE1
+ TAD QM6
+ SNA CLA
+ TAD (DOFIN1-DOFIN0 /INDEX=I, STEP=R
+ TAD (DOFIN0-1 /ALL OTHER CASES
+ DCA .+2
+ JMS I QGENCOD /DO FINISH CODE
+ 0
+ JMS I QOPCOD /SUBTRACT UPPER LIMIT
+ FSUB
+ JMS I QOADDR
+ DOARG
+ JMS I QOPCDE /NOW THE JLT %%LOOP
+ JLE
+ TAD DARG /OUTPUT LABEL
+ JMS I QOLABEL
+ JMS I QCRLF
+ TAD STKLVL /FIX X16 INCASE MULTIPLE DO ENDER
+ DCA X16
+ JMP I QNEXT
+DOARG,
+DOPARM, 0 /SUBR FOR DO PARAMETERS
+ TAD I DOPARM
+ ISZ DOPARM /GET THE PARM POINTER
+ DCA DARG
+ CLL CML RTL /GET ADDR OF TYPE WORD
+ TAD DARG
+ DCA TYPE
+ CLL CMA RTL /CHECK TYPE
+ TAD I TYPE
+ SMA CLA
+ JMP DPERR /NOT I OR R
+ TAD I DARG
+ SNA
+ JMP STRTMP /ARG ALREADY IN AC
+ TAD QM63 /IS IT ARRAY REF?
+ SPA CLA
+ JMP SVLIMT /YES, SAVE LIMIT
+ TAD I DARG /REGET SYM ADDR
+ DCA X10 /ADR OF TYPE WORD
+ CDF 10
+ TAD I X10 /MAYBE ITS A LIT?
+ CDF
+ AND Q40
+ SZA CLA
+ JMP I DOPARM /YES, ITS LITERAL
+ /WE'RE ALWAYS IN F MODE HERE
+ /SINCE THE LAST THING
+ /WAS A DO STORE
+SVLIMT, JMS I QOPCOD /OTHERWISE LOAD IT
+ FLDA
+ JMS I QOADDR
+DARG, 0
+STRTMP, TAD DOTEMP /SET ARG TO NEXT DO TEMP
+ DCA I DARG
+ JMS I QOPCOD /GENERATE STORE
+ FSTA
+ ISZ DOTEMP /BUMP DO TEMP
+ TAD DARG
+ DCA .+2
+ JMS I QOADDR /DO TEMP ADDRESS FIELD
+ 0
+ JMP I DOPARM
+ PAGE
+\f/ SUBSCRIPT REFERENCE COMPILER
+
+ARGS, JMS I QINWORD /COMPILE ARGUMENT LIST
+ CMA
+ DCA NARGS /NUMBER OF ARGS
+ TAD NARGS /GET ADDRESS OF SUBSCRIPTED VAR
+ CLL RAL
+ TAD NARGS /ENTRY ON THE STACK
+ TAD X16
+ DCA X15
+ TAD X15 /SAVE POINTER TO START
+ /OF THIS ENTRY
+ DCA X14 /FOR POSSIBLE FUTURE USE
+ ISZ NARGS /NOW ITS THE 2'S COMPLEMENT
+ NOP
+ TAD I X15 /FETCH SS VARIABLE
+ DCA BASE1
+ TAD I X15 /ITS TYPE
+ DCA TYPE1
+ TAD BASE1 /STORE BASE WORD
+ DCA I X15
+ TAD BASE1 /GET ADDR OF TYPE WORD
+ IAC
+ DCA TEMP
+ CDF 10 /GET TYPE WORD
+ CLL CML RTR /TEST DIM BIT
+ AND I TEMP
+ SNA CLA
+ JMP TRYCAL /SOME KIND OF CALL
+ TAD BASE1 /NOW GET ADDRESS OF DIM INFO
+ JMS I QGETSS
+ DCA ARG1 /RETURNS WITH FIELD SET
+ TAD I ARG1 /CORRECT NUMBER OF DIMENSIONS?
+ TAD NARGS
+ CDF
+ SZA CLA
+ JMP DIMERR /NO
+ ISZ ARG1 /SKIP TOTAL SIZE
+ ISZ ARG1 /SKIP MAGIC NUMBER
+ ISZ ARG1 /AND ASSOCIATED LITERAL
+ DCA XRNUM /START WITH XR 1
+ TAD (-10 /SEVEN XRS
+ DCA XRCNT /COUNT FOR SEARCH
+ DCA FREEXR /ZERO FREE XR INDICATOR
+XRCHEK, CDF
+ ISZ XRCNT /ANY MORE XR EXPRS TO TEST ?
+ SKP /YES, GO CHECK THEM
+ JMP COMPSS /NO, MUST COMPILE
+ /XR ERPRESSION
+ ISZ XRNUM /BUMP XR NUMBER
+ TAD XRNUM
+ CLL RTL /TIMES 16
+ CLL RTL
+ TAD (XRBUFR-1 /PLUS BASE (-1)
+ DCA X13
+ TAD I X13 /LOOK AT THE
+ SPA /INDICATOR
+ JMP .+3 /-1=USED BY THIS STMT
+ SZA CLA /IF ZERO GO TO
+ /MTXR (EVENTUALLY)
+ TAD FREEXR /ANY FREE BEFORE THIS ONE ?
+ SZA CLA
+ JMP NOTMT /YES, ALREADY FOUND ONE
+ TAD XRNUM /THIS WILL BE
+ DCA FREEXR /THE XR WE USE
+ JMP XRCHEK /GO LOOK AT NEXT
+NOTMT, TAD X13 /SAVE FLAG ADDRESS
+ DCA XRFLAG /IN CASE WE NEED IT LATER
+ TAD I X13 /POINTER TO THE DIM INFO
+ DCA TEMP2
+ CDF 10
+ TAD I TEMP2 /SAME NUMBER OF DIMS ?
+ TAD NARGS
+ SZA CLA
+ JMP XRCHEK /NO, THIS XR WONT DO
+ TAD NARGS /SET COUNTER
+ DCA DCNT
+ TAD ARG1 /POINTER TO DIM FACTORS
+ DCA X12
+ ISZ TEMP2 /SKIP THREE WORDS
+ ISZ TEMP2
+ ISZ TEMP2
+DCHEK, ISZ DCNT /ANY MORE ?
+ SKP
+ JMP SSCHEK /DIMS OK, CHECK SS
+ ISZ TEMP2 /GET TO NEXT DIM
+ TAD I TEMP2 /ARE THEY EQUAL ?
+ CIA
+ TAD I X12
+ SZA CLA
+ JMP XRCHEK /NO, GO TRY NEXT ONE
+ JMP DCHEK
+SSCHEK, TAD NARGS /COUNT AGAIN
+ CDF
+ DCA DCNT
+ CLL CMA RAL /-2
+ TAD X16 /ADDR OF START OF TOP
+ /SS ON STACK
+ JMP .+3
+SSC2, CLL CMA RTL /-3
+ TAD XTMP /BACK UP TO NEXT LOWER SS
+ DCA XTMP /LINK IS ALWAYS ZERO HERE
+ TAD I XTMP /GET NEXT SS (WORKING
+ /RIGHT TO LEFT)
+ TAD (-61 /IS IT A VAR OR LITERAL?
+ SNL CLA
+ JMP XRCHEK /WE'RE JUST
+ /LOOKING FOR AN EMPTY
+ TAD I XTMP /RE GET SS POINTER
+ CIA
+ TAD I X13 /ARE THEY THE SAME ?
+ SZA CLA
+ JMP XRCHEK /NO
+ ISZ DCNT
+ JMP SSC2 /KEEP CHECKING
+ TAD XRNUM /THEY MATCH, STICK IN
+ /THE XR NUMBER
+ TAD (51
+ DCA I X14
+ CLL CML RTL
+ TAD X14 /PURGE SS FROM STACK
+ DCA X16
+ CLA CMA /SET FLAG TO
+ /'USED BY THIS STMT'
+ DCA I XRFLAG
+ JMP I QNEXT
+DCNT, 0
+XRFLAG, 0
+XTMP, 0
+ PAGE
+\f/ SUBSCRIPT REFERENCE COMPILER
+
+COMPSS, TAD FREEXR /GET XR EXPR AREA
+ CLL RTL /BY MULTIPLYING
+ /THE NUMBER
+ CLL RTL /BY 16
+ TAD (XRBUFR /AND ADDING THE
+ /BASE ADDRESS
+ DCA XREPTR /THIS IS IT
+ CLA CMA /SET USED BY THIS
+ /STMT FLAG
+ DCA I XREPTR
+ ISZ XREPTR
+ CLL CMA RTL /STORE THE DIB POINTER
+ TAD ARG1
+ DCA I XREPTR
+ TAD NARGS /GET ADDR OF POINTER TO LAST
+ CMA /DIMENSION FACTOR
+ TAD ARG1
+ DCA ARG1 /SINCE WE USE THEM IN
+ /REVERSE ORDER
+ JMS I QSAVEAC /STORE AC IF NEEDED
+ /FOLLOWING INSTRUCTION REMOVED FOR OPTOMIZATION
+/ JMS I QGENSF /ALL SUBSCRIPTS AR I OR R
+ TAD (FLDA /LOAD FIRST SS
+ SKP
+CSSLUP, TAD (FADD /ADD ALL SUBSEQUENT ONES
+ DCA OPC
+ CLL CMA RTL /BACK UP STACK BY ONE ENTRY
+ TAD X16
+ DCA X16
+ TAD X16 /GET A WORKING POINTER
+ DCA X15
+ TAD I X15 /GET THE NEXT SUBSCRIPT
+ DCA ARG2
+ CLL CMA RAL /MUST BE INTEGER
+ TAD I X15
+ SMA CLA
+ JMP DIMERR
+ TAD I X15
+ DCA BASE2
+ TAD ARG2 /STORE THE SS INTO THE
+ /XR EXPR
+ ISZ XREPTR /INCREMENT FIRST
+ DCA I XREPTR
+ TAD ARG2 /IS ARG2 THE AC (ONLY
+ /POSSIBLE IF
+ SNA CLA /ITS THE RIGHTMOST
+ /SUBSCRIPT)
+ JMP NLODSS /YES, DON'T LOAD IT
+ JMS I QOPCOD /OUTPUT LOAD OR ADD
+OPC, 0 /THIS LOCATION TELLS
+ /THE STORY
+ JMS I QOADDR /FOLLOWED BY THE OPERAND
+ ARG2 /POINTED TO BY ARG2
+NLODSS, ISZ NARGS /ANY MORE SUBSCRIPTS ?
+ JMP MORESS /YES, GO COMPILE THEM
+ TAD FREEXR /ANY FREE INDEX REG?
+ SZA CLA
+ JMP ASGNXR /YES, GO USE IT
+ TAD (61 /ITS A SPECIAL POINTER ENTRY
+ DCA I X14
+ ISZ X14
+ TAD TMPCNT /SAVE TEMP NUMBER
+ DCA I X14 /BEFORE WE BLOW X14
+ JMS I (GENPTR /GENERATE POINTER TO THE ARG
+ JMS I QGENCOD /BACK TO FMODE
+ SF-1
+ JMS I (ACSTOR /GENERATE STORE AC
+ JMP I QNEXT
+DIMERR, JMS I QTTYMSG /SS NOT OF CORRECT NUMBER
+ 2323
+XRCNT, 0
+TRYCAL, TAD ASFSWT /ASF DEFINITION
+ SMA SZA CLA
+ JMP DEFASF /YES, GO OUTPUT PROLOG
+ TAD I TEMP /IS IT A FUNCTION OR AN ARG?
+ CDF
+ AND (1420
+ SNA
+ JMP DIMERR /NO, SOME KIND OF ERROR
+ AND Q20
+ DCA ACSWIT /SAVE THE AC SWITCH
+ JMP FUNCAL /STANDARD FUNCTION CALL
+MORESS, JMS I QGENSF /MUST USE SINGLE PRECISION FOR MULTIPLY
+ JMS I QOPCOD /MULTIPLY BY DIM FACTOR
+ FMUL
+ CDF 10
+ TAD I ARG1 /PICK UP FACTOR ADDRESS
+ CDF
+ DCA ARG2
+ CLA CMA
+ TAD ARG1 /MOVE BACK ONE
+ DCA ARG1
+ JMS I QOADDR /OUTPUT MULTIPLY ADDRESS
+ ARG2
+ JMP CSSLUP /LOOP ON NEXT SS
+ASGNXR, JMS I QOPCDE /OUTPUT ATX N
+ ATX
+ TAD FREEXR /GET NUMBER OF FREE XR
+ TAD Q260
+ JMS I QOCHAR
+ JMS I QCRLF
+ TAD FREEXR
+ TAD (51 /COMPUTE PROPER NUMBER
+ DCA I X14 /PUT IT INTO TOP OF STACK
+ JMP I QNEXT
+XREPTR, 0
+\f/ RANDOM TEXT
+OTAB, 0
+ TAD (211
+ JMS I QOCHAR
+ JMP I OTAB
+FCLA, TEXT 'FCLA'
+STARTD, TEXT 'STARTD'
+TEMPN2, TEXT '#TMPX'
+CSUB, TEXT '#CSB'
+CDIV, TEXT '#CDV'
+ PAGE
+\f/ GENERAL CALL GENERATOR
+
+GENCAL, 0 /GENERATE A CALL; ALL ARGS ON STACK
+ /X15 POINTS TO START OF STACK INFO
+ /NARGS IS NEG NUMBER OF ARGS
+ /FUNCTION NAME IS FIRST ON STACK
+ TAD I GENCAL /GET FUN NAME SWITCH
+ DCA FNSWIT
+ TAD X15 /NEW STACK VALUE
+ DCA X16
+ TAD X15 /WORKING POINTER
+ DCA ARG2
+ TAD NARGS /WORKING COUNTER
+ SNA
+ JMP OUTJSR /NO ARGS, PUT JSR
+ DCA TYPE2
+CHKPTR, ISZ ARG2 /MOVE TO NUMBER
+ TAD ARG2
+ IAC /ADDR OF TYPE WORD
+ DCA BASE2
+ TAD I BASE2 /GET TYPE
+ DCA TYPE1 /TYPE OF ARG FOR GENPTR
+ ISZ BASE2 /POINT TO BASE WORD
+ TAD I BASE2
+ DCA BASE1 /FOR GENPTR
+ TAD I ARG2 /GET ARG NUMBER
+ CLL
+ TAD (-52 /IS IT INDEXED ?
+ SNL
+ JMP NOTINX /NO, ITS A TEMP
+ TAD (52-61 /IS IT INDIRECT ?
+ SZL
+ JMP INXR /NO, ITS IN AN XR
+ SNA
+ JMP INTMP /POINTER IN A TEMP
+ TAD (62 /GET TO TYPE WORD
+ DCA GCTEMP
+ CDF 10
+ TAD I GCTEMP /IS IT AN ARG
+ CDF
+ AND (1020 /ARG OR EXTERNAL ?
+ SNA
+ JMP NOTINX+1 /NEITHER
+ AND Q20
+ SZA CLA
+ JMP ARGARG /ARG SQUARED
+ JMP EXTARG /EXTERNAL ARG
+NOTINX, CLA
+ ISZ ARG2 /BUMP POINTER
+ ISZ ARG2
+ ISZ TYPE2 /INCR COUNT
+ JMP CHKPTR
+OUTJSR, TAD JSRLBL /DOES IT GET A LABEL ?
+ SNA
+ JMP .+3 /NO
+ JMS I QLABEL /OUPTUT THE LABEL+COMMA
+ DCA JSRLBL /KILL SWITCH
+ TAD X16 /ADDR OF POINTER TO FUN NAME
+ DCA TEMP
+FNSWIT, 0 /REAARANGED**
+ JMP I (IOFUN /IO FUNCTION CALL
+ JMS I QOPCDE /OUTPUT THE JSR
+ JSR
+ TAD I TEMP /NOW THE SUBR NAME
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ TAD NARGS /ANY ARGS ?
+ SNA CLA
+ JMP I GENCAL /NO, END OF CALL
+ JMS I QOPCDE /JUMP AROUND THE ARGS
+ JA
+ TAD Q256
+ JMS I QOCHAR /.
+ TAD PLUS
+ JMS I QOCHAR /+
+ CLL CLA CMA RAL /-2
+ TAD NARGS /-N-2
+ CLL CMA RAL /2*N+2
+ JMS I QONUMBR
+IOONLY, JMS I QCRLF
+ TAD X16 /WORKING POINTER
+ DCA X15
+PTRLST, TAD I X15 /GET NEXT ARG
+ SZA
+ JMP SARG /SIMPLE ARG
+ CLL CML RTL
+ TAD X15 /ADDR OF GENERATED
+ /LABEL NUMBER
+ DCA TEMP
+ TAD I TEMP /OUTPUT #GXXXX (THE
+ /GENERATED LABEL)
+ JMS I QLABEL /OUPTUT THE LABEL
+ JMS I QGENCOD
+ JADP2-1 /GENERATE A DUMMY JA
+ JMP BARGLP
+SARG, DCA ARG2 /STORE THE ARG NUMBER
+ JMS I QOPCOD /OUTPUT JA ARG
+ JA
+ JMS I QOADDR /NOW ADDRESS FIELD
+ ARG2
+BARGLP, ISZ X15 /BUMP POINTER
+ ISZ X15
+ ISZ NARGS /BUMP COUNT
+ JMP PTRLST
+ JMP I GENCAL
+INTMP, TAD I BASE2 /GET TEMP NUMBER
+ DCA ARG1 /THAT PTR IS STORED IN
+ JMS I QGENCOD /PICK UP POINTER
+ LDASTD-1
+STRPTR, JMS I QOPCDE /NOW STORE THE POINTER
+ FSTA
+ TAD GLABEL /OUTPUT THE LABEL
+ JMS I QOLABEL
+ JMS I QCRLF
+ TAD GLABEL /SAVE THE LABEL NUMBER
+ DCA I BASE2
+ DCA I ARG2 /ZERO ARG NUMBER
+ ISZ GLABEL /INCREMENT LABEL NUMBER
+ JMS I QGENCOD /BACK TO F MODE
+ SF-1
+ JMP NOTINX /CONTINUE LOOP
+NLABEL, 0
+ JMS I QOLABEL
+ TAD COMMA
+ JMS I QOCHAR
+ JMP I NLABEL
+ PAGE
+\f/ GENERATE SUBROUTINE CALL
+
+FUNCAL, JMS I QSAVEAC /SAVE NEXT TO LAST IF NEEDED
+ JMS I QSAVACT /SAVE LAST IF NEEDED
+ JMS I QGENSF /ALL CALLS DONE IN F MODE
+ DCA I X14 /RESULT RETURNED IN AC
+ TAD ACSWIT /IS THE SUBR AN ARG ?
+ SNA CLA
+ JMP MAKCAL /NO, ITS EASIER
+ JMS I QOPCOD /GET THE JSR TO THE SUBR
+ FLDA
+ JMS I QOADDR
+ BASE1 /BY GETTING THE VALUE
+ /OF THE ARG
+ JMS I QGENCOD /STARTD
+ SD-1
+ JMS I QOPCDE /STORE IT AHEAD
+ FSTA
+ TAD GLABEL /INTO THE JSR
+ ISZ GLABEL
+ DCA JSRLBL /SET THE SWITCH
+ TAD JSRLBL
+ JMS I QOLABEL
+ JMS I QCRLF
+ JMS I QGENCOD /STARTF
+ SF-1
+MAKCAL, ISZ BASE1 /MOVE TO TYPE WORD
+ CDF 10
+ TAD I BASE1 /GET TYPE OF FUNCTION
+ CDF
+ JMS I QSKPIRL /WHAT MODE WILL WE LEAVE IN?
+ DCA FMODE /PROBABLY E
+ JMS I QGENCAL /GO GENERATE THE CALL
+ SKP
+ 0 /THIS IS A FREE LOCATION
+ JMP I QNEXT
+ARGARG, JMS I QOPCDE /%FLDA
+ FLDA
+ TAD I ARG2 /POINTER
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ JMS I QGENCOD /%SD
+ SD-1
+ CDF 10
+ CLL CML RTR /IS IT AN ARRAY ?
+ AND I GCTEMP
+ CDF
+ SNA CLA
+ JMP STRPTR /GO STORE THE POINTER
+ TAD I ARG2 /GET THE LITERAL NUMBER
+ JMS I QGETSS
+ TAD Q3
+ DCA GCTEMP
+ TAD I GCTEMP
+ DCA OLABEL /SAVE IT
+ CDF
+ JMS I QOPCDE /%FADD LITERAL
+ FADD
+ TAD QLITRL
+ JMS I QOUTSYM
+ TAD OLABEL /XXXX
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMP STRPTR /GO STORE THE POINTER
+INXR, TAD (270 /MAKE AN ASCII CHAR
+ DCA XR
+ JMS I QOPCDE /XTA
+ XTA
+ TAD XR
+ JMS I QOCHAR /N
+ JMS I QCRLF
+ TAD BASE1 /FIND ADDR OF MAGIC
+ /NUMBER LITERAL
+ JMS I QGETSS
+ CDF
+ TAD Q3
+ DCA ARG1
+ JMS I (GENPTR /GENERATE THE POINTER
+ JMP STRPTR /GO STORE THE POINTER
+EXTARG, TAD I ARG2 /MAKE AN ENTRY IN THE EXT
+ CDF 10 /LITERAL LIST
+ DCA I X17
+ TAD DOTEMP /USE DO TEMPS FOR THIS
+ DCA I X17
+ CDF
+ TAD DOTEMP /SINCE OADDR CAN HANDLE THEM
+ DCA I ARG2
+ ISZ DOTEMP /BUMP COUNT
+ ISZ ELCNT /ALSO EXT LIT COUNT
+ JMP NOTINX /BACK TO PROCESSING ARGS
+\f/ UTILITY ROUTINES
+OLABEL, 0 /OUTPUT #GXXXX FOR GEN'D LABELS
+ DCA TEMP
+ TAD (243
+ JMS I QOCHAR
+ TAD (307
+ JMS I QOCHAR
+ TAD TEMP
+ JMS I QONUMBR
+ JMP I OLABEL
+OPCODE, 0 /TAD OPCODE TAB
+ DCA WHATAC /THIS INSTRUCTION ZAPS AC
+ JMS I QOTAB
+ TAD I OPCODE
+ ISZ OPCODE
+ JMS I QOUTSYM
+ JMS I QOTAB
+ JMP I OPCODE
+M1C2, TEXT '-1,2'
+GENSTE, 0 /GENERATE STARTE IF IN
+ /F MODE
+ TAD FMODE /LOOK AT THE SWITCH
+ SNA CLA
+ JMP I GENSTE /ALREADY IN E MODE
+ DCA FMODE /CLEAR THE SWITCH
+ JMS I QOPCOD /GENERATE THE STARTE
+ STARTE
+ JMS I QCRLF /CAN'T USE GENCOD FOR THAT
+ JMP I GENSTE
+D0, TEXT '0'
+DOTMPN, TEXT '#DOTMP'
+ PAGE
+\f/ OPCODES AND OTHER TEXT
+
+XBASE, TEXT '#BASE'
+XBASP3, TEXT '#BASE+3'
+DP3C0, TEXT '.+3,0'
+JXN, TEXT 'JXN'
+ALN, TEXT 'ALN'
+ATX, TEXT 'ATX'
+XTA, TEXT 'XTA'
+LDX, TEXT 'LDX'
+XREW, TEXT '#REW'
+XENDF, TEXT '#ENDF'
+XBAK, TEXT '#BAK'
+XEXIT, TEXT '#EXIT'
+XRTN, TEXT '#RTN'
+\fJNE, TEXT 'JNE'
+ TEXT 'JGE'
+ TEXT 'JLE'
+ TEXT 'JGT'
+JLT, TEXT 'JLT' /MUST BE IN THIS ORDER!!
+ TEXT 'JEQ'
+JA, TEXT 'JA'
+
+JSR, TEXT 'JSR'
+JSA, TEXT 'JSA' /MUST BE IN THIS ORDER!
+TRAP3, TEXT 'TRAP3'
+\f/ POINTER GENERATOR
+GENPTR, 0 /GENERATE A POINTER
+ JMS I QOPCOD /MULTIPLY BY 3. OR 6.
+ FMUL
+ TAD TYPE1 /D OR C ?
+ JMS I QSKPIRL /SKIP ON I, R, OR L
+ TAD Q6M3
+ TAD (THREE
+ DCA TEMP /POINTER TO CORRECT LITERAL
+ JMS I QOADDR
+ TEMP
+ JMS I QGENCOD /ALN 0; STARTD
+ A0SD-1
+ JMS I QOPCDE /FADD THE BASE LITERAL
+ FADD
+ ISZ BASE1 /GET ADDR OF TYPE WORD
+ CDF 10
+ TAD I BASE1 /GET TYPE WORD
+ AND Q20
+ SNA CLA
+ JMP NIARG /NOT AN ARG
+ CMA
+ TAD BASE1
+ JMS I QOUTNAM /IF AN ARG, THE LITERAL
+ /IS THE ARG
+ JMP OSF
+NIARG, CDF
+ TAD QLITRL /OTHERWISE ITS IN THE
+ /LITERAL BLOCK
+ JMS I QOUTSYM
+ CDF 10
+ TAD I ARG1 /LITERAL NUMBER
+ CDF
+ JMS I QONUMBR
+OSF, JMS I QCRLF
+ JMP I GENPTR
+\f/ MORE RANDOM CODE GENERATORS
+STOP, JMS I QGENCOD /CALL EXIT
+ STPCOD-1
+ JMP I QNEXT
+FORMAT, JMS I QINWORD /NUMBER OF WORDS OF TEXT
+ CMA
+ DCA TEMP
+ JMS I QOPCDE /JA AROUND THE STUFF
+ JA
+ TAD Q256
+ JMS I QOCHAR /.
+ TAD PLUS
+ JMS I QOCHAR
+ CLL CMA RAL /.+2+NWORDS
+ TAD TEMP
+ CMA
+ JMP .+3
+FMTLUP, JMS I QOTAB /TA
+ JMS I QINWORD /GET NEXT WORD
+ JMS I QONUMBR /OUTPUT IT
+ JMS I QCRLF
+ ISZ TEMP
+ JMP FMTLUP
+ JMP I QNEXT
+
+DFRTTM, 0 /ROUTINE TO DELETE "SYS:FORTRN.TM"
+ CLA IAC
+ CIF 10
+ JMS I Q200
+ 4
+ FTRNTM
+ 0
+ NOP
+ JMP I DFRTTM
+
+EQUDOT, TEXT '=.'
+XPAUSE, TEXT '#PAUSE'
+ PAGE
+\f/REWIND, ENDFILE, BACKSPACE
+
+REWIND, TAD (XREW-XENDF
+ENDFIL, TAD (XENDF-XBAK
+BAKSPC, TAD (XBAK
+ DCA REBSUB
+ JMS I QUCODE
+ AIFTBL-1 /GET UNIT INTO FAC
+ JMS I QGENSF /FORCE F MODE
+ CLA STL RTL
+ JMS I (OJSR
+REBSUB, 0
+ JMP I QNEXT
+\f/ DATA STATEMENT STUFF
+DATAST, TAD X16 /SAVE STACK
+ DCA DSTACK
+ TAD DATASW /MULTIPLE DATA STMT ?
+ SZA CLA
+ JMP FIXDAT-2 /YES, DON'T OUTPUT LABEL
+ ISZ DATASW /SET DATA SWITCH
+ JMS I QOTAB /DEFINE ORIGIN SYMBOL
+ TAD GLABEL
+ JMS I QOLABEL
+ TAD (EQUDOT /#GXXXX=.
+ JMS I QOUTSYM
+ JMS I QCRLF
+ CLA CMA /SET VAR TO NONE LEFT
+ DCA NUMELM
+FIXDAT, TAD QXRBUFR /USE XR BUFFER FOR DATA BUFFER
+ DCA DATPTR
+ CMA
+ DCA RCOUNT /SET REPETITION COUNT TO 1
+ JMP I QNEXT
+DREPTC, JMS I QINWORD /GET REPETITION COUNT
+ CIA
+ DCA RCOUNT
+ JMP I QNEXT
+DATELM, JMS I QINWORD /GET SIZE OF ELEMENT
+ CIA
+ DCA TEMP
+ JMS I QINWORD /GET ELEMENT
+ DCA I DATPTR
+ ISZ DATPTR /INTO DATA BUFFER
+ ISZ TEMP
+ JMP .-4
+ JMP I QNEXT
+ENDELM, TAD QXRBUFR /SETUP POINTER
+ DCA TEMP
+MORELM, ISZ NUMELM /ANY MORE FOR THIS VAR?
+ JMP SAMVAR /YES
+ TAD DSTACK /CHECK FOR MISMATCH
+ CIA
+ TAD X16
+ SNA CLA
+ JMP DLERR /OOOPS
+ ISZ DSTACK /GET TO NEXT VAR
+ JMS I QOPCDE /%ORG VAR
+ ORG
+ TAD I DSTACK /GET VAR
+ DCA TEMP2
+ TAD TEMP2
+ ISZ DSTACK /MOVE TO THE DISPLACEMENT
+ CDF 10 /OUTPUT VAR
+ JMS I QOUTNAM
+ CMA
+ DCA NUMELM /ASSUME UNDIMENSIONED
+ CDF 10
+ ISZ TEMP2 /MOVE TO TYPE WORD
+ TAD I TEMP2 /GET TYPE
+ JMS I QSKPIRL /SKIP ON I R L
+ CLL CMA RTL /YES
+ TAD (-3
+ DCA ELMSIZ /NUMBER OF WORDS PER ELEMENT
+ CLL CML RTR
+ AND I TEMP2
+ CDF
+ SNA CLA
+ JMP GOTSIZ /NOT DIMENSIONED
+ CLA IAC /IF DISP = 7777 , WHOLE ARRAY
+ TAD I DSTACK /LOOK AT DISPLACEMENT
+ SZA CLA
+ JMP GOTSIZ+1 /ONLY ONE ELEMENT OF THE ARRAY
+ CMA
+ TAD TEMP2 /GET TOTAL SIZE
+ JMS I QGETSS
+ IAC
+ DCA TEMP2
+ TAD I TEMP2
+ CIA /THIS IS THE NUMBER OF ELEMENTS
+ DCA NUMELM
+ CDF
+GOTSIZ, DCA I DSTACK /ZERO DISPLACEMENT
+ TAD PLUS /OUTPUT +XXXX
+ JMS I QOCHAR
+ TAD ELMSIZ /MULTIPLY DISP BY 3 OR 6
+ CIA
+ DCA MQ
+ TAD I DSTACK /GET DISP
+ JMS I QMUL12
+ JMS I QNUMBRO /OUTPUT THE ORG ALTERATION
+ JMS I QCRLF
+ ISZ DSTACK /MOVE TO NEXT ENTRY
+SAMVAR, TAD ELMSIZ /GET SET TO PICK UP AN ELEMENT
+ DCA NARGS
+ JMS I QOTAB
+ JMP .+3 /SKIP ; FIRST TIME
+ELMLUP, TAD (273 /SEMICOLON
+ JMS I QOCHAR
+ TAD I TEMP /GET A WORD FROM THE BUFFER
+ ISZ TEMP
+ JMS I QONUMBR
+ ISZ NARGS /ONE DATA LIST ELEMENT MUST FILL
+ JMP ELMLUP /ONE VARIABLE LIST ELEMENT
+ JMS I QCRLF /I.E. ONE ARRAY ELEMENT
+ TAD DATPTR /IS THIS DATA ELEMENT EXHAUSTED?
+ CIA CLL
+ TAD TEMP
+ SNL CLA
+ JMP MORELM /MORE LEFT
+ ISZ RCOUNT /REPEAT ?
+ JMP ENDELM /YES
+ JMP FIXDAT /NO, BACK FOR MORE DATA
+DLERR, JMS I QTTYMSG /DATA LIST ERROR
+ 0414
+ ELMSIZ=ARG1
+ NUMELM=TYPE1
+ DSTACK=BASE1
+ DATPTR=ARG2
+ RCOUNT=TYPE2
+ PAGE
+\f/ END STATEMENT PROCESSING
+
+END, TAD FUNCTN /WHAT WAS IT ?
+ SZA CLA
+ JMP .+3 /SUBR, RETURN
+ TAD (STPCOD-1 /MAIN PROG, CALL EXIT
+ DCA .+2
+ JMS I QGENCOD
+ RTNCOD-1
+ TAD DOTEMP /ANY DO TEMPS ?
+ TAD M7000
+ SPA SNA
+ JMP .+3 /NO
+ JMS OTMPS /OUTPUT THEM
+XDOTMP, DOTMPN
+ CLA
+ TAD TMPMAX /ANY EXTRA TEMPS ?
+ TAD (-TMPBLK
+ SPA SNA
+ JMP .+4
+ IAC /OUTPUT THEM + 1
+ JMS OTMPS
+ TEMPN2
+ CLA
+ TAD ELCNT /ANY EXTERNAL LITERALS?
+ SNA
+ JMP END2 /NO
+ CIA
+ DCA ELCNT
+ TAD EXTLIT /PICK UP THE POINTER
+ DCA X17
+ELLOOP, CDF 10
+ TAD I X17 /GET SYMBOL NAME
+ DCA TEMP
+ TAD I X17 /AND DO TEMP NUMBER
+ CDF
+ TAD (-7000 /MINUS BASE
+ DCA TEMP2
+ JMS I QOPCDE /ORIGIN
+ ORG
+ TAD XDOTMP /OUTPUT #DOTMP
+ JMS I QOUTSYM
+ TAD PLUS /+
+ JMS I QOCHAR
+ TAD TEMP2 /DISP
+ CLL CML RAL /*2+1
+ TAD TEMP2 /*3+1
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMS I QOPCDE /NOW OUTPUT JSR NAME
+ JSR
+ TAD TEMP
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ ISZ ELCNT
+ JMP ELLOOP
+END2, TAD (232 /^Z
+ JMS I QOCHAR
+ JMS I (OUDUMP /DUMP BUFFER
+ CIF 10
+ JMS I (7700 /GET USR
+ 10
+ CIF 10
+ CLA IAC
+ JMS I Q200 /CLOSE OUTPUT FILE
+ 4
+ F1LNAM
+FILSIZ, 0
+ JMP OUERR /BADDDDIE
+ TAD FILSIZ /FIX INPUT LIST
+ CLL RTL
+ RTL
+ JMP FINAL
+ERMSG, 0 /PRINT ERROR MESSAGE ON THE TTY
+ DCA TEMP /SAVE THE CODE
+ TAD QM4 /BACK UP THE ERROR
+ TAD ERRPTR /POINTER
+ DCA X10
+ CDF 10
+ DCA I X10 /ZERO END OF LIST
+ TAD TEMP /NOW STICK IN THE CODE
+ DCA I X10
+ TAD X10 /SAVE THE NEW POINTER
+ DCA ERRPTR
+ TAD LINENO /NOW THE LINE NUMBER
+ DCA I X10
+ CDF
+ TAD TEMP /PRINT ERROR CODE
+ JMS I QTTYP2C
+ JMS I QTTYP2C /NOW SOME SPACES
+ TAD QTTYOUT /FUDGE THE OUTPUT
+ /ROUTINE POINTER
+ DCA QOCHAR /SO THAT ONUMBR GOES TO
+ /THE TTY
+ TAD LINENO /PRINT THE LINE NUMBER
+ JMS I QONUMBR
+ TAD (OCHAR /FIXUP OUTPUT POINTER
+ DCA QOCHAR
+ JMS I QTTCRLF
+ JMS I QGENCOD /TRAP IF ERROR EXECUTED
+ ERCODE-1
+ JMP I ERMSG
+M7000,
+OTMPS, -7000 /OUTPUT TEMP BLOCK
+ DCA TEMP /SAVE SIZE
+ TAD I OTMPS
+ ISZ OTMPS
+ JMS I QOUTSYM /OUTPUT NAME
+ TAD COMMA
+ JMS I QOCHAR
+ JMS I QOPCDE /ORG
+ ORG
+ TAD Q256 /.
+ JMS I QOCHAR
+ TAD PLUS
+ JMS I QOCHAR
+ TAD TEMP
+ CLL RAL
+ TAD TEMP /SIZE TIMES THREE
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMP I OTMPS
+ PAGE
+\f/ CHAIN TO RALF
+/ PASS2O VERSION 4A PT 16-MAY-77
+/CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
+/FIXED THE Q OPTION
+/PATCH LEVEL IS IN LOCATION 26131
+ IFZERO OVERLY < /ANOTHER SCORE FOR PAL8
+ *OVRLAY
+ NOPUNCH>
+ IFNZRO OVERLY < /TO TAKE THE LEAD
+ FIELD 2
+ ENPUNCH
+ *OVRLAY> /LATE IN THE FINAL QUARTER
+GORALF, TAD FILDEV /GET SIZE AND DEVICE WORD
+ DCA I (7617 /PUT IT AWAY
+ ISZ (7617 /BUMP POINTER
+ TAD FILBLK /GET ORIGIN OF FIE
+ DCA I (7617 /STORE IT
+ ISZ (7617
+ DCA I (7617 /ZERO END OF LIST
+ TAD I RALFSV
+ CDF 0
+ SPA CLA /WAS /A SPECIFIED?
+ JMP I (7605 /YES - GET OUT
+ CLA IAC
+CHNLKP, CIF 10
+ JMS I Q200
+ 2 /LOOKUP RALF.SV
+ RALFNM
+RALFSV, 7643
+ JMP I (7605
+ TAD (6 /**
+ DCA CHNLKP+2
+ JMP CHNLKP
+RALFNM, 2201;1406;0000;2326 /RALF.SV
+PASS3N, 2001;2323;6300;2326 /PASS3.SV
+
+ADD, JMS I QCODE /GENERATE CODE FOR ADD
+ ADDTBL-6;0
+ JMP I QNEXT
+\f/ EXP OPERATOR
+ETYPE, 0
+EXP, JMS I QSAVACT /SAVE AC IF ITS SECOND ARG
+ JMS I QGARGS /GET THE TWO ARGS
+ JMP I (OTERR /TYPE/OPERATOR ERROR
+ TAD TYPE1 /GET PLACE IN TABLE
+ CLL RTL
+ TAD TYPE1 /TYPE1 TIMES TEN
+ TAD TYPE2 /**
+ CLL RAL
+ TAD (EXPTBL-15 /POINTER TO ENTRY MINUS ONE
+ DCA X10
+ CDF 10
+ TAD I X10 /GET RESULTING TYPE
+ SNA
+ JMP I (OTERR /BAD IF THIS WORD IS ZERO
+ DCA ETYPE /SAVE THE TYPE
+ TAD I X10 /GET THE SUBR NAME
+ CDF
+ DCA I (ESUBR+2 /PUT IT INTO ITS PLACE
+ TAD TYPE1 /GET INTO CORRECT MODE
+ JMS SETMOD
+ TAD ARG1 /IS ARG 1 ALREADY IN THE AC
+ SNA CLA
+ JMP .+5 /YES, SKIP THE LOAD
+ JMS I QOPCOD /OTHERWISE LOAD IT
+ FLDA
+ JMS I QOADDR
+ ARG1
+ JMS I QOINS /FSTA #BASE
+ FSTA;XBASE
+ TAD TYPE2 /SET MODE FOR ARG 2
+ JMS SETMOD
+ JMS I QOPCOD /NOW LOAD IT
+ FLDA
+ JMS I QOADDR
+ ARG2
+ JMS I QOINS /EXTERN FOR THE SUBR
+ EXTERN;ESUBR
+ JMS I QOINS /JSA TO THE SUBR
+ JSA;ESUBR
+ DCA I X16 /RESULT IS THE AC
+ TAD ETYPE /WITH THIS AS THE TYPE
+ DCA I X16
+ DCA I X16
+ TAD ETYPE /SET FMODE CORRECTLY
+ JMS I QSKPIRL
+ SKP
+ CLA IAC /RETURNED IN F MODE
+ DCA FMODE
+ JMP I QNEXT
+SETMOD, /SET MODE TO CORRESPOND
+ /TO THE ARG
+VOVER, VERSON /VERSION NUMBER FOR OVERLAY
+ JMS I QSKPIRL /SKIP IF WE WANT F MODE
+ JMP .+3 /SET TO E MODE
+ JMS I QGENSF /SET TO F MODE
+ JMP I SETMOD
+ JMS I QGENSE
+ JMP I SETMOD
+FINAL, CIA
+ IAC
+ DCA FILDEV /SAVE RALF INPUT SPEC
+ CMA
+ DCA I X7746 /DON'T SAVE CORE ARROUND CHAIN
+ JMS I (DFRTTM /DELETE FORTRN.TM
+ CDF 10
+ TAD I Q7605 /IS THERE A LISTING FILE?
+ SNA CLA
+ JMP GORALF /NO, JUST CHAIN TO RALF
+ CIF 10
+ CDF
+ CLA IAC
+ JMS I Q200 /FIND PASS 3
+ 2
+ PASS3N
+PAS3SV, 0
+ JMP I Q7605
+ TAD PAS3SV-1 /MOVE BLOCK TO CHAIN COMMAND
+ IAC /SKIP OVER CORE CONTROL BLOCK
+ DCA X7746
+ JMS I DEVH /READ IN PASS 3
+ NPPAS3
+SPASS3, 400
+X7746, 7746
+ JMP I Q7605
+ JMP I SPASS3 /GO DO PASS 3
+ PAGE
+\f/ I/O OPEN AND CLOSE
+
+STRTIO, 0 /ROUTINE FOR STARTING IO STMT
+ ISZ IOSTMT /SET IOSTMT SWITCH
+ /(INCASE OF IMPLIED LOOPS)
+ JMS I QSAVEAC /SAVE AC
+ JMS I QSAVACT /IF NECESSARY
+ TAD I STRTIO /GET NUMBER OF ARGS
+ DCA NARGS /SAVE IT
+ ISZ STRTIO /MOVE TOHE NME
+ TAD NARGS /BACKUP STACK BY THIS MUCH
+ TAD NARGS /THREE OR SIX
+ TAD NARGS
+ TAD X16
+ DCA X15
+ TAD X15
+ DCA TEMP /FUNCTION NAME GOES HERE
+ JMS I QOPCDE /EXTERN FOR SUBR
+ EXTERN
+ TAD I STRTIO /GET SUBROUTINE NAME
+ JMS I QOUTSYM /OUTPUT IT
+ JMS I QCRLF
+ TAD I STRTIO /PUT NAME
+ DCA I TEMP /ONTO STACK
+ JMS I QGENSF /ALL CALLS IN F MODE
+ JMS I QGENCAL /GENERATE THE CALL
+ NOP
+ JMP I QNEXT /NOTHING FOR R CLOSE
+FMTRD1, IAC /START FORMATTED READ
+ DCA INPUT /SET INPUT = 1
+ DCA BINARY /AND BINARY = 0
+ JMS STRTIO /GO MAKE THE CALL
+ -2;XREADO
+FMTWR1, DCA INPUT /SET SWITCHES
+ DCA BINARY
+ JMS STRTIO
+ -2;XWRITO
+BINRD1, CLA IAC
+ DCA BINARY
+ CLA IAC
+ DCA INPUT
+ JMS STRTIO
+ -1;XRUO
+BINWR1, DCA INPUT
+ CLA IAC
+ DCA BINARY
+ JMS STRTIO
+ -1;XWUO
+WCLOSE, CLA STL RTL /TRAP3 HERE TOO**
+ JMS OJSR /OUTPUT TRAP3 #WUC
+ XWUC
+ DCA IOSTMT /KILL IO SWITCH
+ JMP I QNEXT
+OJSR, 0 /OUTPUT EXTERN THEN JSR OR TRAP3
+ CLL RAL /AC ON ENTRY IS 0 (JSR), 1 (JSA) OR 2 (TRAP3).
+ TAD (JSR
+ DCA OJSROP
+ JMS I QOPCDE /FIRST EXTERN
+ EXTERN
+ TAD I OJSR
+ JMS I QOUTSYM
+ JMS I QCRLF
+ JMS I QOPCDE /THEN JSR
+OJSROP, 0
+ TAD I OJSR
+ ISZ OJSR
+ JMS I QOUTSYM
+ JMS I QCRLF
+ JMP I OJSR
+
+XWUC, TEXT '#RENDO' /**
+XREADO, TEXT '#READO'
+XWRITO, TEXT '#WRITO'
+XRUO, TEXT '#RUO'
+XWUO, TEXT '#WUO'
+RDRTNE, TEXT /#RSVO/
+RDDRTN, TEXT /#RFDV/
+FTRNTM, 0617;2224;2216;2415 /FORTRN.TM
+\fDNA, JMS I QCODE /AND CODE
+ ANDTBL-6;0
+ JMP I QNEXT
+PURGE, JMS I QGARG /LOOK AT THE TOP OF STACK
+ JMP I (IOTYPE /BAD TYPE
+ TAD ARG1 /IT MUST BE A SCALAR REFNCE
+ CLL
+ TAD QM63
+ SNL CLA
+ JMP I (IOTYPE /BAD TYPE
+ JMP I QNEXT
+PAUZE, JMS I QUCODE /GET ARG INTO FAC
+ AIFTBL-1
+ JMS I QGENCOD /OUTPUT JSR
+ PAZCOD-1
+ JMP I QNEXT
+ PAGE
+\f/DIRECT ACCESS I/O
+
+DARD1, CLA IAC /SET SWITCHES
+ DCA INPUT
+ CLA IAC
+ DCA BINARY /SAME AS UNFORMATTED
+ JMS I (STRTIO /GENERATE CALL
+ -2;XRDAO
+DAWR1, DCA INPUT /SAME AS UNFORMATTED WRITE OPEN
+ CLA IAC
+ DCA BINARY
+ JMS I (STRTIO /CALL
+ -2;XWDAO
+DEFFIL, TAD XDFARG /FAKE A CALL
+ DCA I (STRTIO /TO SKIP THE ISZ IOSTMT
+ JMP I (STRTIO+2
+XDFARG, .+1
+ -4;XDEF
+XDEF, TEXT '#DEF'
+XRDAO, TEXT '#RDAO'
+XWDAO, TEXT '#WDAO'
+\f/ RANDOM UNFITTING STUFF
+RETURN, JMS I QGENCOD /JA #RTN
+ RTNCOD-1
+ JMP I QNEXT
+GENSTF, 0 /GENERATE STARTF IF IN E MODE
+ TAD FMODE /LOOK AT THE SWITCH
+ SZA CLA
+ JMP I GENSTF /ALREADY THERE
+ ISZ FMODE /SET SWITCH
+ JMS I QOPCOD /OUTPUT STARTF
+ STARTF
+ JMS I QCRLF
+ JMP I GENSTF /RETURN
+NOT, JMS I QUCODE /.NOT.
+ NOTTBL-1
+ JMP I (RELGM1
+SUB, JMS I QCODE /SUBTRACT
+ SUBTBL-6;0
+ JMP I QNEXT
+MUL, JMS I QCODE /MULTIPLY
+ MULTBL-6;0
+ JMP I QNEXT
+ASFDEF, CLA IAC /SET SWITCH FOR ASF PROLOG
+ DCA ASFSWT
+ JMP I QNEXT
+OINS, 0 /OUTPUT TAB OPCODE TAB
+ /ADDRESS CRLF
+ DCA WHATAC /ZAPS AC
+ JMS I QOTAB
+ TAD I OINS /GET OPCODE
+ ISZ OINS
+ JMS I QOUTSYM
+ JMS I QOTAB
+ TAD I OINS /GET ADDRESS
+ SZA
+ JMS I QOUTSYM
+ JMS I QCRLF /END LINE
+ ISZ OINS
+ JMP I OINS
+\f/ CODE GENERATOR FOR STORE
+STORE, JMS I QGARGS /GET ARGS FOR STORE
+ JMP I (OTERR
+ TAD ARG1 /KILL ANY XR
+ /EXPRS. INVOLVING
+ JMS I QCHKXR /THE VARIABLE BEING STORED
+ TAD ARG2 /IS SECOND ARG IN AC ?
+ SNA CLA
+ TAD Q5 /YES, ADD 5 TO TYPE2
+ TAD TYPE2
+ DCA TYPE2
+ TAD TYPE1 /TYPE1 TIMES TEN
+ CLL RTL
+ TAD TYPE1
+ CLL RAL
+ TAD TYPE2 /PLUS TYPE2
+ TAD (STRTBL-13 /PLUS TABLE BASE
+ DCA SSKEL /GIVES ENTRY ADDRESS
+ CDF 10
+ TAD I SSKEL /POINTER TO SKELETON
+ DCA SSKEL
+ JMS I QGENCOD /GENERATE CODE
+SSKEL, 0
+ TAD ASFSWT /IS THIS END OF ASF ?
+ SZA CLA
+ JMP I QNEXT /YES, DON'T DO A STORE
+ TAD TYPE1 /MODE IS THE SAME
+ JMS I QSKPIRL /AS THE VARIABLE STORED IN
+ SKP
+ CLA IAC
+ DCA FMODE
+ JMS I QOPCOD /OUTPUT STORE
+ FSTA
+ JMS I QOADDR /ADDRESS FIELD
+ ARG1
+ TAD ARG1 /REMEMBER THE AC
+ CIA
+ DCA WHATAC /(REMEMBER THE
+ TAD BASE1 /ALAMO ?)
+ CIA /(WOULD YOU
+ DCA WHATBS /BELIEVE THE MAINE ???)
+ ISZ ARG1 /GO TO TYPE WORD
+ CDF 10
+ CLL /IF ARG1 IS
+ TAD ARG1 /A SS'D REFNCE
+ TAD QM63 /DON'T
+ SZL CLA /BOTHER CHECKING
+ TAD I ARG1 /LOOK AT SOME BITS
+ CDF
+ AND (3400 /DIM,EXT, OR ASF ?
+ SNA CLA
+ JMP I QNEXT
+ JMS I QTTYMSG /ATTEMPT TO STORE IN
+ 1720 /EXTERNAL OR ASF
+FLDAP, TEXT 'FLDA%'
+ PAGE
+\f/ARITHEMTIC STATEMENT FUNCTIONS (BLAH!)
+
+DEFASF, CDF /A.S.F. PROLOG
+ TAD FMODE /SAVE CPU MODE
+ DCA ASFMOD /SINCE WE JUMP ARROUND
+ TAD X14 /SET STACK POINTER
+ TAD (3 /SO THAT ASF NAME STAYS
+ DCA X16
+ CLA CMA /SET ASF SWITCH
+ DCA ASFSWT
+ TAD TMPMAX /USE UNIQUE TEMPS
+ IAC
+ DCA TMPCNT /FOR ALL ASF'S
+ JMS I QXRTBL /AND FORGET XR'S
+ JMS I QOPCDE /JA AROUND
+ JA
+ TAD GLABEL /SAVE ARROUND LABEL
+ DCA ASFSKP
+ ISZ GLABEL /BUMP LABEL GENERATOR
+ TAD ASFSKP /PUT LABEL AS ADDRESS OF JA
+ JMS I QOLABEL
+ JMS I QCRLF
+ TAD GLABEL /FUNCTIONS XR'S O HERE
+ JMS I QLABEL /OUPTUT THE LABEL
+ JMS I QOINS /#GXXXX, ORG .+10
+ ORG;DP8
+ TAD BASE1 /NOW OUTPUT FUNCTION NAME
+ CDF 10
+ JMS I QOUTNAM
+ TAD COMMA /AS TAG
+ JMS I QOCHAR /OF START OF FUNCTION
+ JMS I QOPCDE /SETX
+ XSET
+ TAD GLABEL /TO THE GENERATED LABEL
+ ISZ GLABEL
+ JMS I QOLABEL
+ JMS I QCRLF
+ JMS I QOINS /LDX 0,1
+ LDX;ZEROC1
+ JMS I QGENCOD /STARTD
+ SD-1 /JUST LIKE A SUBROUTINE
+ /ISN'T IT ?
+ JMS I QOINS /FLDA #BASE
+ FLDA;XBASE /GET RETURN JUMP
+ JMS I QOPCDE /STORE IT AHEAD
+ FSTA
+ TAD GLABEL /USING GENERATED LABEL
+ JMS I QOLABEL
+ JMS I QCRLF
+ASFARG, JMS I QOINS /FLDA% #BASE,1+
+ FLDAP;XBAC1P /GET ARG POINTER
+ JMS I QOINS /FSTA #BASE+3
+ FSTA;XBASP3 /SAVE IT
+ TAD I X15 /GET PARAMETER
+ DCA ARG2
+ TAD I X15
+ DCA TYPE2
+ ISZ X15
+ TAD TYPE2 /IS IT SINGLE OR DOUBLE?
+ JMS I QSKPIRL
+ JMP ASFASE /DOUBLE
+ JMS I QGENCOD /STARTF
+ SF-1
+ CLA IAC
+ARGSV, DCA FMODE /SET FMODE APPROPRIATELY
+ JMS I QOINS /FLDA% #BASE+3
+ FLDAP;XBASP3 /GET THE VALUE
+ JMS I QOPCOD
+ FSTA /AND SAVE IT
+ JMS I QOADDR
+ ARG2
+ ISZ NARGS /ANY MORE ARGS ?
+ SKP
+ JMP I QNEXT /NO, END OF ASF PROLOG
+ JMS I QGENCOD /STARTD
+ SD-1
+ JMP ASFARG /NEXT ARG
+ASFASE, JMS I QGENCOD /STARTE
+ SE-1
+ JMP ARGSV
+ASFEND, 0 /HANDLE END OF A.S.F.
+ TAD ASFSWT /IS THIS END OF ASF ?
+ SNA CLA
+ JMP PTCH /V3C NO
+ DCA ASFSWT /CLEAR SWITCH
+ JMS I QOINS /RESET XR'S
+ XSET;ZXR
+ TAD GLABEL /OUTPUT SPACE FOR RETURN ADDR
+ ISZ GLABEL
+ JMS I QLABEL /OUPTUT THE LABEL
+ JMS I QOINS /ORG .+2
+ ORG;DOTP2
+ TAD ASFSKP /OUTPUT SKIP ARROUND LABEL
+ JMS I QLABEL /OUPTUT THE LABEL
+ JMS I QCRLF
+ TAD ASFMOD /RESET MODE SWITCH
+ DCA FMODE
+ TAD TMPMAX /UNIQUE TEMPS
+ IAC
+ DCA TEM /V3C MUST BE USED
+ JMS I QXRTBL /AND XR'S LOST
+PTCH, TAD TEM /V3C
+ DCA TMPCNT /V3C
+ JMP I ASFEND /RETURN
+ASFMOD, 0
+ASFSKP, 0
+IOFUN, JMS I QOPCDE /CALLED BY TRAP3,NOT JSR**
+ TRAP3
+ TAD I TEMP
+ JMS I QOUTSYM /OUTPUT THE IO FUNCTION NAME
+ JMP I (IOONLY /DO SOME OTHER STUFF
+ESUBR, TEXT '#EXPXX' /THIS WILL BE THE CORRECT NAME
+ PAGE
+\f/ I/O LIST ELEMENT
+
+IOLMNT, JMS I QGARG /GET THE ARG
+ JMP IOTYPE /TYPE ERROR
+ DCA IOLOOP /CLEAR LOOP SWITCH
+ CLL STA RTL /-3
+ TAD TYPE1
+ DCA TYPE1 /TYPE1 = 0 IF COMPLEX, 1 IF D.P.
+ TAD ARG1 /ADDR OF TYPE WD
+ CLL IAC
+ DCA ARG2
+ TAD ARG1 /LOOK AT ARG
+ TAD QM63
+ SNL CLA
+ JMP NOLOOP /NOT ARRAY OUTPUT
+ CDF 10
+ CLL CML RTR /IS IT DIMENSIONED ?
+ AND I ARG2
+ CDF
+ SNA CLA
+ JMP NOLOOP /NO, NO LOOP
+ ISZ IOLOOP /SET SWITCH
+ TAD ARG1 /GET TO SS
+ JMS I QGETSS
+ IAC /TOTAL SIZE WORD
+ DCA BASE1
+ TAD I ARG2 /IS THIS ARRAY AN ARG ?
+ AND Q20
+ DCA ARGIO /SET SWITCH
+ TAD I BASE1 /IS IT VARIABLY DIMENSIONED ?
+ SNA
+ JMP I (VDAIO /YES, MUST COMPUTE SIZE
+ DCA BASE2 /SAVE SIZE
+ CDF
+ JMS I QOPCDE /PUT SIZE IN XR 1
+ LDX
+ TAD Q255
+ JMS I QOCHAR /-
+ TAD BASE2
+ JMS I QONUMBR
+ TAD COMMA
+ JMS I QOCHAR
+ TAD (261
+ JMS I QOCHAR
+ JMS I QCRLF
+ TAD ARGIO /IS IT AN ARG ?
+ SZA CLA
+ JMP I (ARGIOA /YES
+OLLABL, TAD GLABEL /OUTPUT LABEL
+ JMS I QOLABEL
+ DCA I (XRBUFR+20 /KILL XR1 ENTRY
+ TAD COMMA
+ JMS I QOCHAR
+NOLOOP, TAD INPUT /INPUT OR OUTPUT ?
+ SNA CLA
+ JMP OUTV /OUTPUT
+ JMS FIXCAL /SET PTR FOR OJSR**
+ JMS I (DUMSUB /NOW THE STORE
+ FSTA
+ TAD ARG1 /KILL ASSOCIATED
+ JMS I QCHKXR /XR EXPRESSIONS
+CDSFLP, TAD TYPE1 /IS IT C OR D ?
+ CLL RAR
+ SZA CLA
+ JMP ENDLUP /NO, NO STARTE
+ JMS I QGENCOD
+ SF-1
+ENDLUP, TAD IOLOOP /IS THERE A LOOP ?
+ SNA CLA
+ JMP I QNEXT /NO, DO NEXT LIST ELEMENT
+ JMS I QOPCDE /YES, OUTPUT JXN
+ JXN
+ TAD GLABEL
+ ISZ GLABEL /OUTPUT LABEL
+ JMS I QLABEL /OUPTUT THE LABEL
+ TAD (261
+ JMS I QOCHAR
+ TAD PLUS /OUTPUT PLUS (FOR
+ /INCREMENT DUMMY)
+ JMS I QOCHAR
+ JMS I QCRLF
+ JMP I QNEXT /DO NEXT LIST ELEMENT
+OUTV, TAD TYPE1 /D OR C ?
+ CLL RAR
+ SZA CLA
+ JMP .+3 /NO, NO STARTF NECCESSARY
+ JMS I QGENCOD
+ SE-1
+ JMS I (DUMSUB /OUTPUT FLDA
+ FLDA
+ JMS FIXCAL
+ JMP CDSFLP /THEN STARTF AND JXN IF ANY
+FIXCAL, 6401
+ TAD TYPE1 /IF VARIABLE IS COMPLEX,
+ CIA /OR IF VARIABLE IS DOUBLE AND
+ SZA /I/O IS BINARY,
+ TAD BINARY /GENERATE A JSR #RFDV
+ SNA CLA /ELSE GENERATE A TRAP3 #RSVO
+ JMP BINDIO
+ CLA STL RTL /SET PTR
+ JMS I (OJSR /NOW GO DO IT
+ RDRTNE /HERE'S THE NAME
+ JMP I FIXCAL
+BINDIO, JMS I (OJSR
+ RDDRTN
+ JMP I FIXCAL
+
+IOTYPE, JMS I QTTYMSG /IO TYPE ERROR
+ 1124
+DEFLBL, JMS I QCRLF /CRLF BEFORE LABL
+ JMS I QGENSF /ENTER F MODE BEFORE ALL LABELS
+ JMS I QINWORD /GET THE LABEL
+ CDF 10
+ JMS I QOSNUM /OUTPUT IT
+ TAD COMMA
+ JMS I QOCHAR
+ JMS I QXRTBL /KILL XR TABLE
+ DCA WHATAC /AND AC AT LABEL
+ JMP I QNEXT
+ PAGE
+\f/ I/O LIST ELEMENT
+
+VDAIO, CLL CMA RAL /GET ADDR OF NUMBER OF DIMS
+ TAD BASE1
+ DCA X10
+ TAD I X10 /GET DIM COUNT
+ CIA
+ DCA NARGS
+ ISZ X10 /SKIP SIZE
+ ISZ X10 /AND MAGIC NUMBER
+ ISZ X10 /AND LITERAL NUMBER
+ TAD (FLDA /LOAD FIRST DIM
+ SKP
+GSIZLP, TAD (FMUL /MULTIPLY THE REST
+ DCA OPCIO
+ CDF 10
+ TAD I X10 /GET THE NEXT DIMENSION
+ DCA TYPE2
+ CDF
+ JMS I QOPCOD /OUTPUT OPCODE
+OPCIO, 0
+ JMS I QOADDR /NOW THE DIMENSION
+ TYPE2
+ ISZ NARGS
+ JMP GSIZLP /KEEP GOING
+ JMS I QOPCOD /NEGATE THE FAC
+ FNEG
+ JMS I QCRLF
+ JMS I QGENCOD /PUT THE COUNT INTO XR1
+ ATX1-1
+ARGIOA, JMS I QGENCOD /PUT -1 INTO XR 2
+ LXM1C2-1
+ JMS I QOPCDE /LOAD THE ARG POINTER -
+ FLDA /CONST
+ DCA I (XRBUFR+40 /KILL XR 2 ENTRY
+ TAD ARG1
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ JMS I QOPCDE /NOW ADD THE MAGIC NUMBER
+ FADD
+ TAD QLITRL /OUTPUT #LIT+XXXX
+ JMS I QOUTSYM
+ CDF 10
+ ISZ BASE1
+ ISZ BASE1
+ TAD I BASE1
+ CDF
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMS I QOPCDE
+ FSTA /NOW STORE IN #BASE+3
+ TAD (XBASP3
+ JMS I QOUTSYM
+ JMS I QCRLF
+ JMS I QGENCOD /STARTF
+ SF-1
+ JMP I (OLLABL /NOW THE INSIDE OF THE LOOP
+DUMSUB, 0 /OUTPUT FLDA OR FSTA
+ /WITH SE IF NEEDED
+ TAD I DUMSUB /GET THE OPCODE
+ DCA LDASTA
+ ISZ DUMSUB
+ TAD TYPE1 /MUST WE SE ?
+ CLL RAR /TYPE1 IS 0 IF C, 1 IF D
+ SNA CLA
+ TAD Q3 /MULTIPLIER IS 6
+ TAD Q3 /OR 3
+ DCA MQ
+ JMS I QOPCOD /FLDA OR FSTA
+LDASTA, 0
+ TAD IOLOOP /IS IT A LOOP ?
+ SNA CLA
+ JMP EZVAR /NO
+ TAD ARGIO /IS IT AN ARG ?
+ SZA CLA
+ JMP IBASP3 /YES, INDIRECT THROUGH #BASE+3
+ JMS I QOTAB
+ TAD ARG1
+ CDF 10 /OUTPUT NAME
+ JMS I QOUTNAM
+ TAD (255 /-
+ JMS I QOCHAR
+ TAD BASE2 /NEGATIVE OF SIZE
+ CIA
+ JMS I QMUL12 /TIMES 6 OR 3
+ JMS I QNUMBRO
+ TAD COMMA /COMMA SEVEN
+ JMS I QOCHAR
+ TAD (261
+ JMS I QOCHAR
+ JMS I QCRLF
+ JMP I DUMSUB /RETURN
+EZVAR, JMS I QOADDR /ITS A SCALAR
+ ARG1
+ JMP I DUMSUB
+IBASP3, TAD (245 /INDIRECT THROUGH #BASE+3
+ JMS I QOCHAR
+ JMS I QOTAB
+ TAD (XBPC2P /FLDA% #BASE+3,2+
+ JMS I QOUTSYM
+ JMS I QCRLF
+ JMP I DUMSUB
+XBPC2P, TEXT '#BASE+3,2+'
+OR, JMS I QCODE
+ ORTABL-6;0
+ JMP I (RELGEN
+XOR, JMS I QCODE
+ EQVTBL-6;0
+ JMP I (RELGEN
+DOTP2, TEXT '.+2'
+ZXR, TEXT '#XR'
+ PAGE
+\f/ ASSIGNED GOTO AND ASSIGN
+
+AGOTO, JMS GTSTUF /LOOK AT THE ASSIGNED VAR
+ JMS I QGENCOD /GENERATE A JAC
+ AGTCOD-1
+ JMP I QNEXT
+ASSIGN, JMS I QGARG /GET THE ASSIGN VAR
+ JMP GTTYPE
+ CLL CMA RTL /MUST BE I OR R
+ TAD TYPE1
+ SMA CLA
+ JMP GTTYPE /GOTO TYPE ERROR
+ JMS I QGENCOD /GENERATE THE ASSIGN CODE
+ ASNCOD-1
+ JMS I (JAGEN
+ JMS I QGENCOD /NOW STORE IT
+ ASTOR-1
+ JMP I QNEXT
+\f/ OPTIMIZER SUBROUTINES
+CHEKXR, 0 /KILL XR EXPRS
+ CIA /ASSOCIATED WITH THIS VAR
+ DCA KILVAR /SINCE IT HAS
+ /JUST BEEN CHANGED
+ TAD (-7 /LOOK AT XR 1 THRU 7
+ DCA TEMP /COUNT
+ TAD (XRBUFR+20 /POINTER
+ DCA TEMP2
+KILLUP, TAD I TEMP2 /GET NEXT XR
+ /EXPR. INDICATOR
+ SNA CLA
+ JMP EOKL /NOTHING HERE
+ TAD TEMP2 /GET POINTER
+ DCA X13 /INTO AN XR
+ TAD I X13 /GET ADDR OF DIB
+ DCA DIMPTR /SAVE IT
+ CDF 10 /FIELD OF SYMBOL TABLE
+ TAD I DIMPTR /GET NUMBER OF
+ /DIMENSIONS
+ CMA /COMPLIMENTED
+ DCA NARGS /SAVE IT
+ CDF /BACK TO FIELD OF XRBUFR
+CHKKIL, ISZ NARGS /CHECK 1 LESS
+ /THAN THE NUMBER
+ SKP /OF DIMENSIONS
+ JMP EOKL
+ TAD I X13 /LOOK AT NEXT
+ /ELEMENT OF EXPR
+ TAD KILVAR /IS IT THE VAR
+ /JUST CHANGED ?
+ SNA CLA
+ DCA I TEMP2 /YES, KILL THIS EXPRESSION
+ JMP CHKKIL /LOOP
+EOKL, TAD TEMP2 /DO NEXT XR
+ TAD Q20
+ DCA TEMP2 /BUMP POINTER BY 16
+ ISZ TEMP
+ JMP KILLUP
+ JMP I CHEKXR /RETURN
+KILVAR,
+XRTABL, 0 /CLEAR OR RESET
+ /XR TABLE FLAGS
+ DCA TYPE /0=CLEAR 1=RESET
+ TAD (-7 /DO XR1 THRU 7
+ DCA TEMP /COUNT
+ TAD (XRBUFR+20 /POINTER
+ DCA TEMP2
+XRTLUP, TAD I TEMP2 /GET INDICATOR
+ SNA CLA
+ JMP .+3 /DON'T CHANGE IF ZERO
+ TAD TYPE /OTHERWISE SET TO
+ DCA I TEMP2 /'USED BY
+ /PREVIOUS STMT'
+ TAD TEMP2 /GET TO NEXT ONE
+ TAD Q20
+ DCA TEMP2 /BUMPING BY 16
+ ISZ TEMP
+ JMP XRTLUP /LOOP
+ JMP I XRTABL /DONE
+LOADA, 0 /GENERATE AN FLDA
+ TAD I LOADA /IF NECESSARY
+ DCA LODARG /GET ARG POINTER
+ ISZ LOADA /BUMP RETURN
+ TAD I LODARG /DOES AC MATCH ?
+ TAD WHATAC
+ SZA CLA
+ JMP DOLOAD /NO, MUST LOAD
+ TAD LODARG /GET ADDRESS
+ IAC /OF BASE
+ DCA ARG /IN CASE SS'D
+ TAD I ARG /DOES BASE MATCH?
+ TAD WHATBS
+ SNA CLA
+ JMP I LOADA /OK, DON'T LOAD
+DOLOAD, JMS I QOPCOD /GENERATE FLDA
+ FLDA
+ JMS I QOADDR /ADDRESS
+LODARG, 0
+ JMP I LOADA
+ PAGE
+\f/ INTER PASS EQUATES
+ BLNKCN=21
+ ALIST=23
+ INTLST=60
+ FPLIST=56
+ DPLIST=57
+ CMPLST=61
+ HOLIST=55
+ SNLIST=62
+ ONEI=63
+ THREE=70
+ SIX=75
+ TRUE=102
+\f/ START PASS 2 (INTER PASS COMMUNICATION)
+ IFNZRO OVERLY <
+ FIELD 0
+ NOPUNCH
+ *OVRLAY>
+ IFZERO OVERLY <
+ FIELD 0
+ ENPUNCH
+ *OVRLAY>
+START2, JMP I Q7605 /RETURN BUT DON'T SAVE CORE
+ TAD I X10 /PICK UP NEXT FROM PASS 1
+ DCA X17
+ TAD X17 /SAVE POINTER TO
+ /EXTERNAL LITERALS
+ DCA EXTLIT
+ TAD I X10 /PASS ONE STACK LEVEL
+ DCA X11
+ TAD I X10 /TEMP FILE START
+ DCA INBLOK
+ TAD I X10 /AND SIZE
+ CMA
+ DCA INRCNT
+ TAD I X10 /START OF PASS2O.SV
+ DCA PASS2O
+ TAD I X10 /START OF OUTPUT FILE
+ DCA FILBLK /SAVE IT FOR CHAINING TO RALF
+ TAD FILBLK
+ DCA OBLOCK
+ TAD I X10
+ DCA OSIZE /ALSO MAX SIZE
+ TAD I X10 /PICK UP PROG NAME
+ DCA PROGNM
+ TAD I X10
+ DCA ARGLST /AND ARG LIST ADDR
+ TAD I X10 /AND
+ /FUNCTION/SUBROUTINE/MAIN SWITCH
+ DCA FUNCTN
+ TAD I X10 /GET DP HARDWARE SWITCH
+ DCA DPUSED
+ TAD I X10 /CHECK FOR CROSSED VERSIONS
+ TAD VERS
+ SZA CLA
+ JMP VERROR /VERSION ERROR
+ STA STL /V3C
+DCLOOP, TAD X11 /V3C THIS ADD CLEARS THE LINK
+ DCA X11 /V3C
+ TAD X11
+ TAD (-STACK1
+ SNL CLA
+ JMP PSN /GO DO STMT NUMBERS
+ TAD I X11 /GET DO LOOP ENDING STMT NUMBER
+ IAC
+ DCA X10
+ CDF 10
+ TAD (0416 /DN DO END MISSING
+ JMS NPRNT /GO PRINT THE MESSAGE
+ /AND THE NUMBER
+ CDF
+ CLL CMA RTL
+ JMP DCLOOP /V3C BACK UP 2
+PSN, TAD (SNLIST /PROCESS STMT NUMBERS
+ CDF 10
+SNCLUP, DCA ENTRY /SAVE NEW ENTRY ADDR
+ TAD I ENTRY /GET ADDR OF NEXT ENTRY
+ SNA
+ JMP SNDONE /NO MORE STMT NUMBERS
+ IAC
+ DCA TEMP /ADDR OF TYPE WORD
+ TAD I TEMP /WAS STMT NUMBER DEFINED?
+ SPA CLA
+ JMP SNDEFN /YES
+ TAD TEMP
+ DCA X10
+ TAD (2523 /PRINT US MESSAGE
+ JMS NPRNT
+SNDEFN, TAD (0110 /SET TYPE WORD
+ DCA I TEMP
+ TAD I ENTRY /PROCEED
+ JMP SNCLUP
+SNDONE, CDF
+FIXELP, JMS I (TYPRTN
+ NEGSLV /FIX UP NEGATIVE EQUIVALENCE OFFSETS
+ CLL CML RTL /CHECK FOR BLOCK DATA
+ TAD FUNCTN /(FUNCTN=-2)
+ SNA CLA
+ JMP BDSTUF /IT IS
+ JMS I (TYPRTN /DO IMPLICIT TYPING
+ IMPLCT
+ JMS I (TYPRTN /REMOVE SUB ARGS FROM LIST
+ SUBARG
+ JMS I (TYPRTN /EXTERNALS
+ EXTRNL
+ JMP I (PROLG1 /MORE PROLOG
+BDSTUF, TAD I (BDSWIT /SET UP SWITCH
+ DCA I (PROLG2
+ TAD (END2 /ALTER END CODE
+ CDF 10
+ DCA I (XEND
+ CDF 0
+ DCA NODBUG /NO ISN'S
+ JMP I (HOLDUN /DO SOME STUFF
+SUBARG, 0 /REMOVE ARGS FROM ST
+ TAD I TYPE
+ AND Q20 /CHECK ARG BIT
+ SNA CLA
+ JMP I SUBARG
+ JMS UNHOOK
+ JMP TFUDGE
+
+UNHOOK, 0
+ TAD I ENTRY
+ DCA I OENTRY
+ TAD BUCKET
+ DCA I ENTRY
+ JMP I UNHOOK
+
+VERROR, TAD (2605 /PRINT VE (VERSION ERROR)
+ JMS I QTTYP2C
+ JMS I QTTCRLF
+ JMP I Q7605
+ PAGE
+\f/ GENERATE ARGUMENT STORAGE
+
+PROLG1, JMS I (INS2 / %JA #ST
+ JA;XST
+ JMS I (INS /#XR, %ORG .+10
+ XXR;ORG;DP8
+ JMS I QOPCDE / %TEXT #NAMEXX#
+ TEXTX
+ TAD PLUS
+ JMS I QOCHAR
+ CDF 10
+ TAD PROGNM
+ JMS I QOUTNAM
+ JMS I (FILL /FILL WITH BLANKS
+ TAD PLUS
+ JMS I QOCHAR
+ ISZ PROGNM
+ JMS I QCRLF
+ JMS I (INS /#RET, %SETX #XR
+ XRET;SETX;XXR
+ JMS I (INS2 / %SETB #BASE
+ SETB;XBASE
+ JMS I (INS2 / %JA .+3
+ JA
+XDP3, DP3
+ JMS I (INS /#BASE, %ORG .+6
+ XBASE;ORG;DP6
+ TAD ARGLST /ANY ARGS ?
+ SNA
+ JMP NOARGS /NO, SKIP THIS STUFF
+ DCA X10 /SAVE POINTER TO ARG LIST
+ CDF 10 /HOW MANY ?
+ TAD I ARGLST
+ CIA
+ DCA NARGS /THIS MANY
+ DCA TEMP2 /ARRAY ARG COUNTER
+ARGLP1, JMS PLSUB1 /OUTPUT DEFS FOR ARRAY
+ /ARGS FIRST
+ SNA CLA /SINCE THEY MUST BE
+ /INDIRECTABLY
+ JMP NOARAY /REFERENCABLE
+ ISZ TEMP2
+NOARAY, ISZ NARGS
+ JMP ARGLP1 /PROCESS ENTIRE ARG LIST
+ CDF 10
+ TAD I ARGLST /GO THRU ARGS AGAIN
+ CIA CLL
+ DCA NARGS
+ TAD ARGLST
+ DCA X10
+ TAD TEMP2 /HOW MANY ARRAY ARGS ?
+ TAD QM6
+ SNA
+ JMP NISA /NO INDIRECT LOCS LEFT
+ /FOR SCALARS
+ DCA TEMP2
+ SZL CLA
+ JMP TOOMNY /TOO MANY ARRAY ARGS (>6)
+ARGLP2, JMS PLSUB1 /NOW OUTPUT AS MANY INDIRECT
+ SZA CLA /SCALAR ARGS AS POSSIBLE
+ JMP NOSCLR /TO REDUCE THE PROLOG
+ ISZ TEMP2 /ROOM FOR ANY MORE
+ SKP
+ JMP NISA2 /NO, THE REST MUST MOVE VALUES
+NOSCLR, ISZ NARGS /LOOP SOME MORE
+ JMP ARGLP2
+ JMS I (PLSUB2 /OUTPUT SOME TRACEBACK STUFF
+ JMP I (MORE /GENERATE SCALAR,
+ /LITERAL AND TEMP STORAGE
+NISA2, JMS I (PLSUB2
+ JMP NDLP3 /OUTPUT TRACEBACK
+ /STUFF,THEN REST
+NISA, JMS I (PLSUB2 /GET PAST THE TRACEBACK STUFF
+ARGLP3, TAD XM3 /GENERATE ORG .+6 FOR D OR C
+ DCA XNOP
+ JMS PLSUB1 /OUTPUT REMAINING
+ /SCALAR ARG SPACE
+ SZA CLA
+ JMP NDLP3
+ CDF 10
+ TAD I TEMP /TURN OFF SUBARG BIT
+ AND (7757 /(THATS THE
+ /SECOND TIME I FIXED THIS)
+
+ DCA I TEMP
+NDLP3, ISZ NARGS
+ JMP ARGLP3
+ CDF
+ JMP I (MORE /GENERATE SCALAR,
+ /LITERAL AND TEMP STORAGE
+
+NOARGS, JMS I (PLSUB2 /NO ARGS, OUTPUT TRACEBACK STUFF
+ JMP I (MORE /GENERATE SCALAR,
+ /LITERAL AND TEMP STORAGE
+PLSUB1, 0
+ CDF
+ TAD I PLSUB1 /GET THE SKIP
+ DCA PLSKIP
+ ISZ PLSUB1
+ CDF 10
+ TAD I X10 /GET THE NEXT ARG
+ IAC
+ DCA TEMP /TYP WORD ADDR
+ CLL CML RTR /2000=DIM BIT
+ AND I TEMP
+PLSKIP, 0 /ARRAYS OR SCALARS ?
+ JMP I PLSUB1
+ ISZ PLSUB1
+ CLA CMA
+ TAD TEMP /DEFINE THIS VAR
+ JMS I QOUTNAM
+ TAD COMMA
+ JMS I QOCHAR
+ CDF 10
+ TAD I TEMP /LOOK AT THE TYPE
+ CDF
+ JMS I QSKPIRL /SKIP IF NOT C OR D
+XNOP, NOP /THIS IS CHANGED LATER (MAYBE)
+ TAD XDP3 /.+3 OR .+6
+ DCA .+3
+ JMS I (INS2 /ORG FOR THE VALUE
+ ORG;0
+ JMP I PLSUB1
+TOOMNY, TAD P0F1 /TOO MANY ARRAY ARGS
+ JMP I P0F2
+XM3, CLL CML RTL
+ PAGE
+\f/ SCALARS, LITERALS & TEMPS
+
+HOLLIT,
+MORE, JMS I (TYPRTN /OUTPUT SCALARS
+ SCALAR
+ TAD (TEMPS /OUTPUT FIRST FIVE TEMPS
+ JMS I (OUTVAR
+ TAD (LITRL2
+ JMS I QOUTSYM
+ TAD COMMA /OUTPUT %LITRL,
+ JMS I QOCHAR
+ JMS I (DOLIST
+ INTLST
+O141, 0141;-3 /OUTPUT INTEGER LITERALS
+ JMS I (DOLIST
+ FPLIST
+ 0142;-3 /OUTPUT FP LITERALS
+ JMS I (DOLIST
+ DPLIST
+ 0144;-6 /DOUBLE LITERALS
+ JMS I (DOLIST
+ CMPLST
+ 0143;-6 /COMPLEX LITERALS
+ JMS I (TYPRTN /OUTPUT DIMENSION FACTORS
+ DFLIT
+ JMS I (ADFLIT /OUTPUT ARG DIM FACTOR LITERALS
+ TAD (HOLIST /OUTPUT HOLLERITH LITERALS
+ DCA ENTRY
+HOLLUP, CDF 10
+ TAD I ENTRY
+ SNA
+ JMP HOLDUN
+ DCA ENTRY /SAVE NEW ENTYR
+ TAD ENTRY
+ DCA X10
+ TAD O141 /SET TYPE INFO
+ DCA I X10
+ TAD LITNUM
+ DCA I X10 /SAVE LIT DISP
+ CLL CMA RTL /SET UP COUNTER
+ DCA HOLLIT /BY THREES
+HOLOOP, CDF 10 /OUTPUT LITERAL AS OCTALS
+ TAD I X10
+ CDF
+ SNA
+ JMP HOFILL /FILL OUT REST
+ DCA ARG
+ TAD ARG
+ AND (77 /IS THIS LAST WORD?
+ SZA CLA
+ JMP .+4 /NO
+ TAD ARG /YES, STICK IN
+ TAD Q40 /BLANK
+ JMP HOFILL+1 /AND OUTPUT IT
+ TAD ARG /OUTPUT CHAR PAIR
+ JMS ONUM
+ ISZ HOLLIT
+ JMP HOLOOP
+ JMP HOLOOP-2
+HOFILL, TAD (4040 /FILL WITH BLANKS
+ JMS ONUM
+ ISZ HOLLIT
+ JMP HOFILL
+ JMP HOLLUP /DO NEXT HOLLERITH LITERAL
+HOLDUN, CDF
+ JMS I (TYPRTN /DO ARRAYS
+ ARRAYS
+ JMS I (TYPRTN /REMOVE COMMON VARS FROM S.T.
+ COMVAR
+ JMS I QOTAB
+ TAD (XLBLE /#LBL=.
+ JMS I QOUTSYM
+ JMS I QCRLF
+ CDF 10 /LOOK AT THE BLANK COMMON LIST
+ TAD I (ONEI+2 /MAKE TRUE=INTEGER ONE
+ DCA I (TRUE+2
+ TAD I (BLNKCN+1
+ CDF
+ SNA
+ JMP NOBC /NO BLANK COMMON
+ DCA TYPE /POINTER TO VARIABLE LIST
+ JMS I QOPCOD
+ COMMON
+ JMS I QCRLF
+ CDF 10
+BCLOOP, TAD TYPE /PROCESS THIS HUNK OF
+ /BLANK COMMON
+ DCA X10
+ TAD I X10
+ SNA
+ JMP NXTBC /EMPTY HUNK
+ CIA /SIZE OF HUNK
+ DCA TEMP
+ TAD I X10 /OUTPUT HUNK
+ JMS I (OUTVAR
+ CDF 10
+ ISZ TEMP
+ JMP .-4
+NXTBC, TAD I TYPE /ADDR OF NEXT HUNK
+ SNA
+ JMP NOBC /THAT WAS THE LAST HUNK
+ DCA TYPE
+ JMP BCLOOP /DO NEXT HUNK
+NOBC, CDF
+ JMS I (TYPRTN /DO NAMED COMMONS
+ COMNAM
+ JMS I (TYPRTN /NOW EQUIVALENCES
+ EQUIVS
+ JMS INS2
+ ORG;XLBL /%ORG #LBL
+ JMP I (PROLG2 /COMPLETE PROLOG
+ PAGE
+\f/ ARGUMENT PICKUP GENERATOR
+
+PROLG2, TAD FUNCTN /SECOND PART OF PROLOG
+ SZA CLA
+ JMP DORETN /NOT A MAIN PROG
+ JMS I (INS /#ST, BASE #BASE
+ XST;BASE;XBASE
+ JMS I (INS2 / SETB #BASE
+ SETB;XBASE
+ JMS I (INS2 / SETX #XR
+ SETX;XXR
+BDSWIT, JMP I (FINIST /GO GET OVERLAY
+DORETN, JMS I (INS /#RTN, BASE #BASE
+ XRTN;BASE;XBASE
+ TAD ARGLST /ANY ARGS ?
+ SNA
+ JMP JAGOBK /NO
+ DCA X10 /POINTER TO THE LIST
+ CDF 10
+ TAD I ARGLST /NUMBER OF ARGS
+ CIA
+ DCA NARGS
+ DCA TEMP2 /ZERO ARG COUNTER
+ CDF
+ TAD NARGS /WILL WE RESTORE ANY ?
+ TAD (6
+ SMA CLA
+ JMP JAGOBK /NO
+ JMS I (INS2 / FLDA #ARGS
+ FLDA;XARGS
+ JMS I (INS2 / FSTA #BASE
+ FSTA;XBASE
+RSLOOP, CDF 10
+ TAD I X10 /GET NEXT ARG
+ IAC
+ DCA TEMP /ADDR OF TYPE WORD
+ ISZ TEMP2 /INCR COUNT
+ TAD I TEMP /IS IT A VALUE TRANSMISSION ?
+ AND Q20
+ CDF
+ SZA CLA
+ JMP NOREST /NO, DON'T RESTORE IT
+ JMS I QOPCDE / %LDX XXXX,1
+ LDX
+ TAD TEMP2
+ JMS I QONUMBR
+ TAD (C1
+ JMS I QOUTSYM
+ JMS I QCRLF
+ JMS I QGENCOD /STARTD
+ SD-1
+ JMS I (INS2 /GET POINTER TO ARG
+ FLDAI;XBASC1
+ JMS I (INS2 /AND SAVE IN #BASE+3
+ FSTA;XBASP3
+ JMS STFORE /INTO CORRECT MODE
+ JMS I QOPCDE /FLDA VAR
+ FLDA
+ CMA
+ TAD TEMP
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ JMS I (INS2 / FSTA% #BASE+3
+ FSTAI;XBASP3
+NOREST, ISZ NARGS
+ JMP RSLOOP
+ JMS I QGENCOD /MAKE SURE WE'RE IN F MODE
+QSFM1, SF-1
+JAGOBK, TAD FUNCTN /WHAT WAS THIS ?
+ SPA CLA
+ JMP NOFVAL /NOT A FUNCTION
+ CDF 10 /GET TYPE
+ TAD I PROGNM
+ AND Q17
+ TAD (FVAL-1 /PLUS TABLE ADDRESS
+ DCA GVSKEL /GIVES POINTER TO
+ /SKELETON ADDRESS
+ TAD I GVSKEL /GET SKELETON ADDRESS
+ DCA GVSKEL
+ JMS I QGENCOD /PICK UP FUNCTION VALUE
+GVSKEL, 0
+NOFVAL, JMS I (INS2 / JA #GOBAK
+ JA;XGOBAK
+ JMS I (INS /#ST, %STARTD
+ XST;STARTD;0
+ JMS I QOTAB
+ TAD (210 / %FLDA' 10
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMS I (INS2 / %FSTA #GOBAK,0
+ FSTA;XGOBC0
+ JMP I (MORPLG
+
+STFORE, 0 /START F OR E
+ CDF 10
+ TAD I TEMP /GET TYPE
+ CDF
+ JMS I QSKPIRL /SKIP ON I R OR L
+ TAD (SE-SF /SE
+ TAD QSFM1 /SF
+ DCA .+2
+ JMS I QGENCOD
+ 0
+ JMP I STFORE /DON'T FORGET TO
+ /RETURN DUMMY
+XARGS, TEXT '#ARGS'
+ PAGE
+\f/ ENTRY AND EXIT CODE
+
+MORPLG, JMS I QOTAB
+ TAD Q200 / FLDA' 0
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMS I (INS2 / %SETX #XR
+ SETX;XXR
+ JMS I (INS2 / %SETB #BASE
+ SETB;XBASE
+ TAD ARGLST /ANY ARGS ?
+ SNA
+ JMP I (ENDPLG /NO, JUST STARTF
+ DCA ARG /SAVE POINTER TO THEM
+ JMS I (INS2 / %LDX 0,1
+ LDX;ZC1
+ JMS I (INS2 / %FSTA #BASE
+ FSTA;XBASE
+ JMS I (INS2 / %FSTA #ARGS
+ FSTA;XARGS
+ CDF 10
+ TAD I ARGLST /NUMBER OF ARGS
+ CIA
+ DCA NARGS
+GALOOP, CDF
+ JMS I (INS2 / %FLDA I #BASE,1+
+ FLDAI;XBAC1P
+ DCA TYPE /CLEAR THE SD SWITCH
+ CDF 10
+ ISZ ARG /GET TO NEXT ARG
+ TAD I ARG /LOOK AT ITS TYPE WORD
+ IAC
+ DCA TEMP
+ CLL CML RTR
+ AND I TEMP /WAS IT DIMENSIONED ?
+ SNA CLA
+ JMP I (TSTABT /NO, SEE IF ITS VALUE
+ CMA
+ TAD TEMP /GET ADDR OF DIM INFO
+ JMS I QGETSS
+ IAC /ADDR OF SIZE
+ DCA TEMP2
+ TAD I TEMP2
+ ISZ TEMP2
+ ISZ TEMP2
+ SNA CLA
+ JMP OUFSTA+1 /IT HAS A VARIABLE DIMENSION
+ TAD I TEMP2 /GET MAGIC NUMBER LIT DISP
+ DCA TEMP2
+ CDF
+ JMS I QOPCDE / %FSUB #LIT+XXXX
+ FSUB
+ TAD QLITRL
+ JMS I QOUTSYM
+ TAD TEMP2
+ JMS I QONUMBR
+ JMS I QCRLF
+ CDF 10
+OUFSTA, DCA I ARG /IT ISN'T VARIABLY DIMENSIONED
+ CDF
+ JMS I QOPCDE / %FSTA ARGN
+ FSTA
+ CDF 10
+ CMA
+ TAD TEMP
+ JMS I QOUTNAM
+ JMS I QCRLF
+ ISZ NARGS
+ SKP
+ JMP I (ENDPLG /END OF PROLOG
+ TAD TYPE /DID WE LEAVE D MODE
+ SNA CLA
+ JMP GALOOP /NO
+ JMS I QGENCOD /YES, OUTPUT AN %SD
+ SD-1
+ JMP GALOOP
+FINIST, CDF 10
+ TAD FUNCTN /WAS THIS A FUNCTION ?
+ SPA SNA CLA
+ JMP .+4 /NO, SKIP THIS
+ TAD I PROGNM /YES, TURN OFF EXT BIT
+ AND (6777 /ALLOWING STORING IN FUN NAME
+ DCA I PROGNM
+ TAD (2200 /CHECK /N /Q
+ AND I (7644
+ CDF
+ SNA CLA
+NODBUG, DCA I (DEBUG /IF NOT SET, PUT ISN'S
+ CDF 10 /INTO CODE
+ TAD I (7644 /IS /Q SET ?
+ CDF
+ AND (0200
+ SZA CLA
+ ISZ I (OPTMYZ /MAKE A CLA IAC FROM A CLA
+GFNAME, CDF 10
+ TAD I FNAME /MOVE FILE NAME
+ CDF
+ DCA I NAMEF /INTO PAGE
+ ISZ FNAME
+ ISZ NAMEF
+ ISZ NFCNT
+ JMP GFNAME
+ JMP I (RDOVLY /GO WHERE ?
+ /CALIFORNIA OF COURSE!!!!
+FNAME, 7601
+NAMEF, F1LNAM
+NFCNT, -4
+
+ONUM, 0
+ ISZ LITNUM /BUMP LITERAL COUNTER
+ DCA ARG
+ JMS I QOTAB
+ TAD ARG
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMP I ONUM
+ PAGE
+\f/ ENTRY AND EXIT CODE
+
+TSTABT, TAD I TEMP /VALUE TRANSMISSION ?
+ AND Q20
+ SZA CLA
+ JMP I (OUFSTA /NO
+ CDF
+ JMS I (INS2 / %FSTA #BASE+3
+ FSTA;XBASP3
+ JMS I (STFORE /ENTER CORRECT MODE
+ JMS I (INS2 / %FLDA% #BASE+3
+ FLDAI;XBASP3
+ ISZ TYPE /SET SWITCH
+ JMP I (OUFSTA-1
+ENDPLG, JMS I QGENCOD /%SF
+ SF-1
+ TAD ARGLST /ANY VARIABLY
+ /DIMENSIONED ARRAYS ?
+ SNA
+ JMP I (FINIST /NO ARGS AT ALL
+ DCA X10
+ CDF 10
+ TAD I ARGLST /NUMBER OF ARGS
+ CIA
+ DCA NSARGS
+VDIMLP, CDF 10
+ TAD I X10 /GET NEXT ARG
+ SNA
+ JMP NDVDIM /NOT A VARIABLY
+ /DIMENSIONED ARRAY
+ DCA VDTEMP
+ TAD VDTEMP /GET ADDR OF DIMENSION INFO
+ JMS I QGETSS
+ DCA VDTMP2
+ TAD I VDTMP2 /NUMBER OF DIMENSIONS
+ CIA
+ DCA NARGS
+ ISZ VDTMP2 /MOVE TO MAGIC NUMBER LITERAL
+ ISZ VDTMP2
+ ISZ VDTMP2
+ TAD I VDTMP2 /GET IT
+ CDF
+ DCA MNL /SAVE MAGIC NUMBER LITERAL
+ TAD (FLDA /JUST LOAD FIRST DIM
+ DCA MNOPC
+ TAD NARGS /GET ADDRESS
+ CIA /OF THE LAST
+ TAD VDTMP2 /DIMENSION
+ DCA VDTMP2 /FOR THE SIZE GETTER
+ JMP CMPMN3 /SKIP MULTIPLY FIRST TIME
+CMPMN1, TAD (FMUL /NEXT TIME USE A MULTIPLY
+ DCA MNOPC
+ JMS I QOPCOD /NEXT SUBSCRIPT (ALWAYS (1.0)
+ FADD
+ JMS I QOADDR /NOW ADDRESS
+ (ONEI
+CMPMN3, ISZ NARGS /ANY MORE SS ?
+ JMP CMPMN2 /YES
+ ISZ VDTEMP /GET TO TYPE
+ CDF 10
+ TAD I VDTEMP
+ CDF
+ JMS I QSKPIRL /SKIP ON I R L
+ TAD Q6M3 /YES
+ TAD (THREE
+ JMS LDAMUL /3.02
+ JMS I (INS2 /ALN 0
+ ALN;D0
+ JMS I QOPCDE
+ FSTA
+ TAD QLITRL /SAVE IN THE MAGIC
+ /NUMBER LITERAL
+ JMS I QOUTSYM
+ CLA CMA
+ TAD MNL
+ JMS I QONUMBR
+ JMS I QCRLF
+ JMS I (INS2 /FNEG
+ FNEG;0
+ JMS I (INS2 /ENTER D MODE
+ STARTD;0
+ JMS I QOPCDE
+ FADDM /NOW MODIFY THE POINTER
+ CMA
+ TAD VDTEMP
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ JMS I (INS2 /RETURN TO F MODE
+ STARTF;0
+NDVDIM, ISZ NSARGS /ANY MORE ARGS TO CHECK?
+ JMP VDIMLP /YES
+ CDF
+ JMP I (FINIST
+CMPMN2, CLA CMA /BACK UP THE POINTER
+ TAD VDTMP2 /BY ONE
+ DCA VDTMP2
+ CDF 10
+ TAD I VDTMP2 /GET IT
+ CDF
+ JMS LDAMUL /3.02
+ JMP CMPMN1 /LOOP
+VDTEMP, 0
+VDTMP2, 0
+NSARGS, 0
+MNL, 0
+DP12, TEXT '.+14'
+LDAMUL, 0 /3.02
+ DCA MNADR
+ JMS I QOPCOD
+MNOPC, 0
+ JMS I QOADDR
+ MNADR
+ JMP I LDAMUL
+MNADR, 0
+ PAGE
+/ RANDOM PROLOG STUFF
+
+ARRAYS, 0 /OUTPUT ARRAYS
+ TAD I TYPE
+ AND (6220 /IS IT AN ARRAY
+ SNA
+ JMP I ARRAYS
+ AND (4220 /NOT COMMON, EQUIV OR ARG
+ SZA CLA
+ JMP I ARRAYS
+ JMS I (UNHOOK /REMOVE FROM BUCKET
+ TAD ENTRY /OUTPUT VARIABLE
+ JMS I (OUTVAR
+ JMP TFUDGE-1
+FILL, 0 /FILL SUB NAME WITH BLANKS
+ CLL CML RTL
+ TAD PROGNM /PROGNM+2
+ CIA /-PROGNM-2
+ TAD I XNAMP /1,2,3
+ TAD QM4 /-3,-2,-1
+ DCA TEMP
+ JMP .+5
+ TAD (240 /TWO BLANKS FOR EACH WORD
+ JMS I QOCHAR
+ TAD (240
+ JMS I QOCHAR
+ ISZ TEMP /MORE ?
+ JMP .-5 /YES
+ JMP I FILL
+XNAMP, NAMPTR
+NPRNT, 0
+ JMS I QTTYP2C
+ JMS I QTTYP2C
+ TAD I X10 /NOW NUMBER
+ JMS I QTTYP2C
+ TAD I X10
+ JMS I QTTYP2C
+ TAD I X10
+ JMS I QTTYP2C
+ JMS I QTTCRLF
+ JMP I NPRNT
+\f/ROUTINE TO FIX UP NEGATIVE EQUIVALENCE OFFSETS
+
+NEGSLV, 0
+ TAD I TYPE
+ AND Q200
+ SNA CLA /IS VARIABLE A SLAVE?
+ JMP I NEGSLV /NO
+ TAD TYPE
+ DCA X10
+ TAD I X10 /GET POINTER TO EQUIV BLOCK
+ DCA X10
+ CLA IAC
+ TAD I X10 /GET POINTER TO MASTER
+ DCA OLDM /TYPE WORD
+ TAD I X10 /OFFSET FROM MASTER
+ CMA STL
+ TAD I X10 /SUBTRACT FROM SLAVE OFFSET
+ DCA SFUDGE /SAVE IN CASE WE NEED IT
+ TAD I OLDM /IF MASTER IS IN COMMON FORGET THE NEXT TEST:
+ SZL SPA CLA /IF MASTER OFFSET < SLAVE OFFSET THEN
+ JMP I NEGSLV /SLAVE WILL ORIGIN BEFORE MASTER -
+ TAD I TYPE /THEREFORE THE SLAVE MUST BECOME THE MASTER
+ AND (7577 /UNSLAVE THE SLAVE
+ DCA I TYPE
+ ISZ TYPE
+ TAD I TYPE
+ DCA TYPE1 /TYPE1 POINTS TO EQUIV BLOCK
+ CLA IAC
+ TAD TYPE1
+ DCA X10 /USE AUTO-XR TO CLEAR OFFSETS
+ TAD ENTRY
+ DCA NEWM
+ TAD I OLDM /GET OLD MASTER'S TYPE WD
+ TAD Q200
+ DCA I OLDM /MAKE IT A SLAVE
+ ISZ OLDM
+ TAD I TYPE1 /GET POINTER TO SLAVE DIMENSION BLOCK
+ DCA I TYPE /PUT IT IN SYMTAB AS BEFITTING A NEW MASTER
+ TAD I OLDM /GET OLD MASTERS DIM PTR
+ DCA I TYPE1 /PUT IT IN EQUIV BLOCK AS BEFITTING A NEW SLAVE
+ TAD TYPE1 /NOW ASSOCIATE THE EQUIV BLOCK
+ DCA I OLDM /WITH THE NEW SLAVE
+ DCA I X10 /AND MAKE BOTH OFFSETS 0
+ DCA I X10 /("FIXSLV" WILL ADJUST IT - NOTE THE "MASTER"
+ CDF 0 /WD OF THE BLOCK STILL POINTS TO THE OLD MASTER)
+ JMS I (TYPRTN /** RECURSIVE CALL ** - ACTUALLY WE DON'T CARE
+ FIXSLV /SINCE WE AREN'T RETURNING ANYWAY
+ JMP I (FIXELP /TRY AGAIN FROM SCRATCH
+\f/ROUTINE TO ADJUST ALL SLAVES OF THE OLD MASTER
+/TO BE SLAVES OF THE NEW MASTER
+
+FIXSLV, 0 /THROUGHOUT
+ TAD I TYPE
+ AND Q200
+ SNA CLA /IS IT A SLAVE?
+ JMP I FIXSLV /NO
+ ISZ TYPE
+ CLA IAC
+ TAD I TYPE
+ DCA TYPE /TYPE NOW POINTS TO THE EQUIV BLOCK
+ CLA IAC
+ TAD I TYPE /GET PTR TO THIS SLAVES MASTER (+1)
+ CMA
+ TAD OLDM /COMPARE MASTERS
+ SZA CLA
+ JMP I FIXSLV /NOT UNDER SAME MASTER - LEAVE
+ TAD NEWM
+ DCA I TYPE /"MEET THE NEW BOSS.....
+ ISZ TYPE / SAME AS THE OLD BOSS...."
+ TAD I TYPE / (THE WHO)
+
+ TAD SFUDGE /ADD IN THE DIFFERENCE BETWEEN OLD AND NEW
+ IAC /MASTERS TO THE MASTER OFFSET
+ DCA I TYPE
+ JMP I FIXSLV /THE SLAVE IS NOW -- A SLAVE!
+
+OLDM, 0
+NEWM, 0
+SFUDGE, 0
+ PAGE
+\f/ ENTRY AND EXIT CODE
+
+PLSUB2, 0 /DUMB SUBR FOR PROLOG
+ CDF
+ JMS INS2 / %ORG #BASE+30
+ ORG;XBAP30
+ JMS INS2 / %FNOP
+ FNOP;0
+ JMS INS2 / %JA #RET
+ JA;XRET
+ JMS INS2 / FNOP
+ FNOP;0
+ JMS INS /#GOBAK,ORG .+2
+ XGOBAK;DBLZRO;0 /**TO INSURE IT'S 0
+ TAD DPUSED /WAS DOUBLE PRECISSION USED ?
+ SNA CLA
+ JMP NDPUSD /NO, NO NEED FOR TEMP
+ JMS INS
+ XDPTMP;ORG;DP12 /#DPT, ORG .+12
+ JMS INS2
+ DPCHK;0
+NDPUSD, TAD FUNCTN /FUNCTION OR SUBR ?
+ SNA
+ JMP I PLSUB2 /ITS #MAIN, NO #VAL OR #ARGS
+ SPA CLA
+ JMP .+5 /ITS A SUBROUTINE, NO #VAL
+ JMS INS /#VAL, %ORG .+6
+ XVAL;ORG;DP6
+ JMS INS /#ARGS, %ORG .+3
+ XARGS;ORG;DP3
+ JMP I PLSUB2
+INS2, 0 / %OPCOD ADDR
+ TAD INS2 /COMMONIZE RETURNS
+ DCA INS
+ JMP INS3
+INS, 0 /TAG, %OPCOD ADDR
+ TAD I INS /GET TAG FIELD
+ ISZ INS
+ JMS I QOUTSYM /OUTPUT IT
+ TAD COMMA
+ JMS I QOCHAR
+INS3, JMS I QOTAB
+ TAD I INS /GET OPCODE
+ ISZ INS
+ JMS I QOUTSYM
+ TAD I INS /GET ADDR
+ SNA CLA
+ JMP .+4 /NO ADDRESS
+ JMS I QOTAB
+ TAD I INS
+ JMS I QOUTSYM
+ ISZ INS
+ JMS I QCRLF
+ JMP I INS
+SECT, TEXT 'SECT'
+XRET, TEXT '#RET'
+XXR, TEXT '#XR'
+XGOBAK, TEXT '#GOBAK'
+XST, TEXT '#ST'
+XGOBC0, TEXT '#GOBAK,0'
+XBAP30, TEXT '#BASE+30'
+FNOP, TEXT 'FNOP'
+SETX, TEXT 'SETX'
+SETB, TEXT 'SETB'
+TEXTX, TEXT 'TEXT'
+XBASC1, TEXT '#BASE,1'
+DP3, TEXT '.+3'
+DP6, TEXT '.+6'
+ZC1, TEXT '0,1'
+FLDAI, TEXT 'FLDA%'
+FSTAI, TEXT 'FSTA%'
+XLBLE, TEXT '#LBL=.'
+C1, TEXT ',1'
+XLBL, TEXT '#LBL' /STACK-5 CAN'T BE 0
+DBLZRO, TEXT '0;0'
+ PAGE
+\f/ SYMBOL TABLE PROCESSING ROUTINES
+
+IMPLCT, 0 /DO IMPLICIT TYPING
+ TAD I TYPE
+ AND O100 /WAS IT EXPLICITLY TYPED
+ SZA CLA
+ JMP I IMPLCT /YES
+ TAD BUCKET /IS IT INTEGER ?
+ TAD M317
+ CLL
+ TAD M006
+ SNL CLA
+ ISZ I TYPE /TYPE IT REAL
+ ISZ I TYPE /TYP IT INTEGER
+ JMP I IMPLCT
+O100,
+DFLIT, 100 /GENERATE FACTORS FOR CALLS
+ CLL CML RTR /DIMENSIONED ?
+ AND I TYPE
+ SNA CLA
+ JMP I DFLIT /NO
+ TAD I TYPE
+ DCA TEMP /SET PROPER WDS/ENTRY FOR VMC
+ TAD ENTRY /GET ADDR OF MAGIC NUMBER
+ JMS I QGETSS
+ TAD (2
+ DCA TYPE
+ TAD I ENTRY /SAVE LINK
+ DCA DFTEMP
+ TAD BUCKET /FIX NAME
+ DCA I ENTRY
+ TAD I TYPE /GET MAGIC NUMBER
+ DCA TEMP2
+ ISZ TYPE
+ CDF
+ JMS I (ONUM /OUTPUT A ZERO WORD
+ JMS I QOPCDE
+ JA
+ TAD ENTRY /OUTPUT VAR MINUS CONST
+ JMS I (VMC
+ JMS I QCRLF /END LITERAL
+ CDF 10
+ TAD LITNUM /SAVE NUMBER IN DIM INFO
+ DCA I TYPE
+ ISZ LITNUM /THEN BY 2 MORE
+ ISZ LITNUM
+ TAD DFTEMP /RESTORE ENTRY
+ DCA I ENTRY
+ JMP I DFLIT
+M006,
+DFTEMP,
+EXTRNL, 6 /DO EXTERNALS
+ TAD I TYPE
+ AND O1000 /IS IT EXT ?
+ SNA CLA
+ JMP I EXTRNL
+ JMS I (UNHOOK /REMOVE THIS SYMBOL
+ TAD PROGNM /IS IT THE PROG NAME ?
+ CIA
+ TAD ENTRY
+ SZA CLA
+ JMP .+5 /NO, OUTPUT EXTERN
+ TAD FUNCTN /IS IT A MAIN PROG ?
+ SNA CLA
+ JMP TFUDGE-1 /YES, NO SECT
+ TAD (SECT-EXTERN /NOT MAIN, OUTPUT SECT
+ TAD XTRN
+ DCA M317
+ CDF
+ JMS I QOPCDE
+M317, -317
+ TAD ENTRY /NOW VAR NAME
+ CDF 10
+ JMS I QOUTNAM
+ JMS I QCRLF
+ JMP TFUDGE-1
+O1000,
+EQUIVS, 1000 /OUTPUT EQUIVALENCES
+ TAD I TYPE
+ AND Q200 /IS THIS A SLAVE ?
+ SNA CLA
+ JMP I EQUIVS /NO
+ JMS I (UNHOOK /UNHOOK THE ENTRY
+ TAD I TYPE /SAVE THE TYPE WORD
+ DCA TYPE1
+ ISZ TYPE /POINT TO EQUIVALENCE BLOCK
+ TAD I TYPE
+ DCA X10
+ CDF
+ JMS I QOPCDE /OUTPUT ORG
+ ORG
+ CDF 10
+ TAD I X10 /MASTER NAME
+ DCA X11 /SAVE IT
+ TAD X11
+ JMS I QOUTNAM /OUTPUT IT
+ TAD PLUS /+
+ JMS I QOCHAR
+ CDF 10
+ TAD I X11 /MASTER SS
+ JMS SUBRX
+ TAD Q255 /MINUS
+ JMS I QOCHAR
+ CDF 10
+ TAD TYPE1 /SLAVE SS
+ JMS SUBRX
+ JMS I QCRLF /EOL
+ CDF 10
+ TAD ENTRY /NOW OUTPUT SLAVE
+ JMS I (OUTVAR
+ JMP TFUDGE-1
+XTRN,
+SUBRX, EXTERN
+ JMS I QSKPIRL /SIZE OF THING
+ TAD Q3
+ TAD Q3 /TIMES 3 OR 6
+ DCA MQ
+ TAD I X10
+ CDF
+ JMS I QMUL12 /MAKE THE PRODUCT
+ JMS I QNUMBRO /OUT WITH IT
+ JMP I SUBRX
+DPCHK, TEXT 'DPCHK'
+FADDM, TEXT 'FADDM'
+ PAGE
+\f/ SYMBOL TABLE PROCESSING ROUTINES
+
+BASE, TEXT 'BASE'
+OUTVAR, 0 /ALLOCATE STORAGE FOR A VARIABLE
+ DCA VARADR
+ RDF /GET FIELD OF VAR
+ TAD X6201
+ DCA OVFLD1
+ TAD OVFLD1
+ DCA OVFLD2
+ TAD VARADR /OUTPUT NAME,
+ JMS I QOUTNAM
+ TAD COMMA
+ JMS I QOCHAR
+ JMS I QOPCDE /OUTPUT ORG
+ ORG
+ ISZ VARADR /POINT TO TYPE WROD
+OVFLD1, 0
+ TAD I VARADR /GET TYPE
+X6201, CDF
+ JMS I QSKPIRL
+ TAD Q3 /PER ENTRY
+ TAD Q3 /INTEGER, REAL, AND
+ /LOGICAL 3WORDS
+ DCA MQ
+ DCA AC
+OVFLD2, 0
+ CLL CML RTR /CHECK DIM BIT
+ AND I VARADR
+ SNA CLA
+ JMP PLSDOT /NOT DIMENSIONED
+ TAD I VARADR /LOOK AT TYPE
+ ISZ VARADR /MOVE TO EQ DIM POINTER
+ AND Q200 /EQUIVALENCED ?
+ SNA CLA
+ JMP .+3 /NO
+ TAD I VARADR /YES, SKIP EQUIV INFO
+ DCA VARADR
+ TAD I VARADR /ADDRESS OF DIM INFO
+ IAC
+ DCA VARADR /ADDRESS OF SIZE
+ TAD I VARADR /GET TOTAL SIZE
+ CDF
+ JMS I QMUL12
+PLSDOT, CDF
+ TAD Q256
+ JMS I QOCHAR
+ TAD PLUS
+ JMS I QOCHAR
+ JMS I QNUMBRO
+ JMS I QCRLF
+ JMP I OUTVAR
+SCALAR, 0 /OUTPUT SCALARS
+ TAD I TYPE /IS IT A SCALAR ?
+ AND (7630 /COM, DIM, EXT, ASF,
+ /EQV, ARG, COMMONNAME
+ SZA CLA
+ JMP I SCALAR /NO
+ JMS I (UNHOOK /DELETE THIS FROM THE LIST
+ TAD ENTRY /OUTPUT THIS VARIABLE
+ JMS OUTVAR
+ JMP TFUDGE-1
+VARADR,
+DOLIST, 0 /PROCESS A LITERAL LIST
+ TAD I DOLIST /GET LIST START
+ DCA ENTRY
+ ISZ DOLIST
+ TAD I DOLIST
+ DCA TYPE /GET TYPE BITS
+ ISZ DOLIST
+ TAD I DOLIST
+ ISZ DOLIST
+ DCA LSIZE /GET LITERAL SIZE
+ CDF 10
+DLLOOP, TAD I ENTRY /GET NEXT ENTRY
+ SNA
+ JMP DLRETN /NO MORE
+ DCA ENTRY
+ TAD ENTRY
+ DCA X10 /ADDRESS OF TYPE WORD
+ TAD TYPE /PUT IN TYPE
+ DCA I X10
+ TAD X10 /SAVE THIS ADDR
+ DCA X11
+ TAD LSIZE /SIZE OF LITERAL
+ DCA TEMP
+LITLUP, CDF
+ JMS I QOTAB
+ CDF 10
+ TAD I X10
+ CDF
+ JMS I QONUMBR
+ JMS I QCRLF
+ ISZ TEMP
+ JMP LITLUP
+ CDF 10
+ TAD LITNUM /SAVE LITERAL NUMBER
+ DCA I X11
+ TAD LSIZE /INCREMENT LITERAL NUMBER
+ CIA
+ TAD LITNUM
+ DCA LITNUM
+ JMP DLLOOP
+DLRETN, CDF
+ JMP I DOLIST
+TEMPS, 243;2000;TMPSIZ;2415;2000
+TMPSIZ, 1;TMPBLK+1
+LSIZE,
+COMVAR, 0 /REMOVE COMMON VARS FROM ST
+ TAD I TYPE
+ AND (4400 /ALSO ASF NAMES
+ SNA CLA
+ JMP I COMVAR
+ JMS I (UNHOOK
+ JMP TFUDGE-1
+LITRL2, TEXT '#LIT'
+COMMON, TEXT 'COMMON'
+ PAGE
+\f/ SYMBOL TABLE PROCESSING ROUTINES
+
+TYPRTN, 0 /PROCESS ENTIRE SYMBOL TABLE
+ TAD I TYPRTN /GET ROUTINE ADDRESS
+ DCA ROUTNE
+ ISZ TYPRTN
+ TAD O301 /START WITH 'A'
+ DCA BUCKET
+ TAD M32 /BUCKET COUNT
+ DCA BCNT
+TYPLP2, TAD BUCKET /GET START OF NEXT LIST
+ TAD ALM301
+TYPLUP, DCA OENTRY /SAVE OLD ENTRY ADDRESS
+ CDF 10
+TFUDGE, TAD I OENTRY /GET ADDR OF NEXT ENTRY
+ SNA
+ JMP EOL /0 MEANS END OF LIST
+ DCA ENTRY
+ IAC
+ TAD ENTRY /ADDR OF TYPE WORD
+ DCA TYPE
+ JMS I ROUTNE /CALL ROUTINE
+ TAD I OENTRY /CONTINUE DOWN THE LIST
+ JMP TYPLUP
+EOL, ISZ BUCKET /DO NEXT LETTER
+ ISZ BCNT
+ JMP TYPLP2
+ CDF
+ JMP I TYPRTN /END OF PASS
+ BCNT=ARG1
+COMNAM, 0 /OUTPUT A COMMON BLOCK
+ TAD I TYPE /IS THIS A COMMON BLOCK NAME
+ TAD M111
+ SZA CLA
+ JMP I COMNAM /NO
+ CDF
+ JMS I QOPCDE
+ COMMON
+ CDF 10
+ JMS I (UNHOOK /REMOVE THE COMMON
+ /BLOCK FROM S.T.
+ TAD ENTRY
+ JMS I QOUTNAM /OUTPUT NAME
+ JMS I QCRLF
+ ISZ TYPE /GET TO COMMON STUFF POINTER
+CNLOOP, CDF 10
+ TAD I TYPE /GET ADDR OF NEXT HUNK
+ /OF COMMON
+ SNA
+ JMP TFUDGE /END OF IT
+ DCA TYPE
+ TAD TYPE /GET A WORKING POINTER
+ DCA X10
+ TAD I X10 /GET COUNT
+ SNA
+ JMP CNLOOP /NONE IN THIS HUNK
+ CIA
+ DCA TEMP2
+ TAD I X10 /GET VARIABLE ADDRESS
+ JMS I (OUTVAR /OUTPUT IT
+ CDF 10
+ ISZ TEMP2
+ JMP .-4 /DO NEXT ONE FROM THIS HUNK
+ JMP CNLOOP /DO NEXT HUNK
+O301, 301
+M32, -32
+ALM301, ALIST-301
+M111, -111
+ROUTNE,
+ADFLIT, 0 /OUTPUT ARG DF LITS
+ TAD ARGLST /ANY ARGS
+ SNA
+ JMP I ADFLIT
+ DCA X10
+ CDF 10
+ TAD I ARGLST /NUMBER OF ARGS
+ CIA
+ DCA NARGS
+ADFLUP, CDF 10
+ TAD I X10 /GET ARG ADDR
+ IAC
+ DCA TEMP /TYPE WORD ADDR
+ TAD I TEMP /GET TYPE INFO
+ DCA TEMP2
+ CLL CML RTR
+ AND I TEMP /DIMENSIONED ?
+ SNA CLA
+ JMP NDADFL /NO
+ ISZ TEMP /ADDR OF DIM INFO
+ CLL CML RTL
+ TAD I TEMP /ADDR OF MAGIC NUMBER
+ DCA TEMP
+ TAD I TEMP /MAGIC NUMBER
+ DCA MQ /PREPARE TO MULTIPLY
+ ISZ TEMP /ADDR OF LITERAL GOES HERE
+ TAD LITNUM /STICK IN THE ADDRESS
+ IAC
+ DCA I TEMP
+ CDF
+ JMS I (ONUM /OUTPUT A ZERO
+ TAD TEMP2 /LOOK AT TYPE
+ JMS I QSKPIRL /SKIP ON I R L
+ TAD (3 /DOUBLE OR COMPLEX
+ TAD (3
+ JMS I QMUL12
+ TAD AC /OUTPUT 2 WORD LITERAL
+ JMS I (ONUM
+ TAD MQ
+ JMS I (ONUM
+NDADFL, ISZ NARGS
+ JMP ADFLUP
+ JMP I ADFLIT
+RDOVLY, JMS I (7607 /READ IN OVERLAY
+ NPOVLY
+ OVRLAY
+PASS2O, 0
+ JMP I (INERR
+ TAD I (VOVER /CHECK VERSION OF OVERLAY
+ TAD VERS
+ SZA CLA
+ JMP I (VERROR /ERROR, MIXED VERSIONS
+ JMP I (EOSTMT /START PASS2 PROPER
+ PAGE
+\f FIELD 1
+ *5000
+ 0 /THIS IS THE START OF
+ /THE ERROR MESSAGE LIST
+ /WHICH WORKS BACKWARDS
+\f/OS/8 F4 COMPILER CODE SKELETONS
+
+ MAC=-6
+ NEGSGN=-5
+ FLDAA2=-4
+ FLDAA1=-3
+ ENTERE=-2
+ ENTERF=-1
+CGTCOD, ATX;DD1;STARTD;0;FLDA;DP2C1;STARTF;0
+AGTCOD, JAC;0;0
+ASNCOD, ENTERF;FLDA;DP3C0;JA;DP4;0
+ERCODE, EXTERN;XUE;TRAP3;XUE;0
+A0FN, EXTERN;XFIX;JSA;XFIX;0
+A0SD, ALN;D0
+SD, STARTD;0;0
+SE, STARTE;0;0
+SF, STARTF;0;0
+MPTR0, ENTERF;FLDAA1;FSTA;XBASE;0
+MPTR3, ENTERF;FLDAA2;FSTA;XBASP3;0
+JADP2, JA;DOT;0
+DOFIN0, ENTERF;FLDAA1;FADD;-2
+ASTOR, FSTA;-1;0
+DOFIN1, ENTERF;FLDAA1;FADD;-2;MAC+A0FN;FSTA;-1;0
+LDASTD, FLDAA1;STARTD;0;0
+ /CHALK UP ONE FOR PAL8
+ATX1, ATX;DD1;0
+LXM1C2, LDX;M1C2;STARTD;0;0
+FVAL, FVI-1;FVI-1;FVC-1;FVD-1;FVI-1
+FVI, FLDA;XVAL;0
+FVC, STARTE;0;FLDA;XVAL;MAC+PCAC;0
+FVD, STARTE;0;FLDA;XVAL;0
+RTNCOD, RTNX+MAC;JA;XRTN;0
+PAZCOD, ENTERF;EXTERN;XPAUSE;JSR;XPAUSE;0
+STPCOD, RTNX+MAC;EXTERN;XEXIT;JSR;XEXIT;0
+GIRL1, ENTERF;FLDAA1;ENTERE;0
+GIRL2, ENTERF;FLDAA2;ENTERE;0
+SEGCAC,
+GCAC, ENTERE;EXTERN;CAC;FLDA;CAC;0
+PCAC, EXTERN;CAC;FSTA;CAC;0
+GC1C2, ENTERE;FLDAA1;EXTERN;CAC;FSTA;CAC;FLDAA2;0
+GC1, ENTERE;FLDAA1;0
+GC2, ENTERE;FLDAA2;0
+JSACEQ, EXTERN;CEQ;JSA;CEQ;NEGSGN;0
+JSACNG, EXTERN;CNEG;JSA;CNEG;0
+JSACAD, EXTERN;CADD;JSA;CADD;0
+JSACSB, EXTERN;CSUB;JSA;CSUB;0
+JSACML, EXTERN;CMUL;JSA;CMUL;0
+JSACDV, EXTERN;CDIV;JSA;CDIV;0
+\f/ ADD, SUBTRACT, MULTIPLY, AND DIVIDE SKELETONS
+ADDTBL, AS-1;AS+2;AS+4
+ AX-1;AX+2;AX+5
+ AS-1;AD-1;AS+4
+ ASC-1;ASC+2;ASC+3
+ ASD-1;ASD+7;ASD+10
+ ACS-1;ACS+4;ACS+6
+ ADS-1;ADS+3;ADS+7
+ 0
+ FNEG;0
+AS, FADD;-1;0
+ ENTERF;FLDAA1
+ FADD;-2;0
+ JSACNG+MAC
+AX, GC1+MAC;JSACAD+MAC;0
+ GC1C2+MAC;JSACAD+MAC;0
+ GC2+MAC;JSACAD+MAC;0
+AD, ENTERE;FLDAA1;FADD;-2;0
+ JSACNG+MAC
+ASC, GIRL1+MAC;JSACAD+MAC;0
+ GIRL1+MAC
+ ENTERE;PCAC+MAC;GC2+MAC;JSACAD+MAC;0
+ FNEG;0
+ASD, FSTA;XDPTMP;ENTERF;FLDAA1;ENTERE;FADD;XDPTMP;0
+ GIRL1+MAC
+ ENTERE;FADD;-2;0
+ JSACNG+MAC
+ACS, ENTERE;PCAC+MAC;GC1+MAC;JSACAD+MAC;0
+ GC1+MAC;PCAC+MAC
+ GIRL2+MAC;JSACAD+MAC;0
+ FNEG;0
+ADS, ENTERE;FADD;-1;0
+ GIRL2+MAC;FADD;-1;0
+ FSTA;XDPTMP;GIRL2+MAC;FADD;XDPTMP;0
+SUBTBL, AS-3;SS-1;SS+1
+ AX-2;SX-1;SX+2
+ AS-3;SDBL-1;SS+1
+ ASC-2;SSX-1;SSX
+ ASD-3;SSD-1;SSD
+ ACS-2;SCS-1;SCS+1
+ ADS-3;SDS-1;SDS5-1
+ 0
+SS, ENTERF;FLDAA1
+ FSUB;-2;0
+SX, GC1C2+MAC;JSACSB+MAC;0
+ GC2+MAC;JSACSB+MAC;0
+SDBL, ENTERE;FLDAA1;FSUB;-2;0
+SSX, GIRL1+MAC
+ ENTERE;PCAC+MAC;GC2+MAC;JSACSB+MAC;0
+SSD, GIRL1+MAC
+ ENTERE;FSUB;-2;0
+SCS, GC1+MAC;PCAC+MAC
+ GIRL2+MAC;JSACSB+MAC;0
+SDS, GIRL2+MAC;FNEG;0;FADD;-1;0
+SDS5, FSTA;XDPTMP;GIRL2+MAC;FNEG;0;FADD;XDPTMP;0
+MULTBL, M1-1;M1+3-1;M1+5-1
+ M4-1;M4+3-1;M4+6-1
+ M1-1;M7-1;M7+2-1
+ M8-1;M8+3-1;M8+4-1
+ M11-1;M11+6-1;M11+7-1
+ M14-1;M14+5-1;M14+7-1
+ M18+1-1;M18-1;M18+5-1
+ 0
+M1, FMUL;-1;0
+ ENTERF;FLDAA1
+ FMUL;-2;0
+M4, GC1+MAC;JSACML+MAC;0
+ GC1C2+MAC;JSACML+MAC;0
+ GC2+MAC;JSACML+MAC;0
+M7, ENTERE;FLDAA1;FMUL;-2;0
+M8, GIRL1+MAC;JSACML+MAC;0
+ GIRL1+MAC
+ ENTERE;PCAC+MAC;GC2+MAC;JSACML+MAC;0
+M11, FSTA;XDPTMP;GIRL1+MAC;FMUL;XDPTMP;0
+ GIRL1+MAC
+ ENTERE;FMUL;-2;0
+M14, ENTERE;PCAC+MAC;GC1+MAC;JSACML+MAC;0
+ GC1+MAC;PCAC+MAC
+ GIRL2+MAC;JSACML+MAC;0
+M18, GIRL2+MAC
+ ENTERE;FMUL;-1;0
+ FSTA;XDPTMP;GIRL2+MAC;FMUL;XDPTMP;0
+DIVTBL, 1;D2-1;D2+2-1
+ 1;D5-1;D5+3-1
+ 1;D7-1;D7+2-1
+ 1;D9-1;D10-1
+ 1;D12-1;D13-1
+ 1;D14-1;D15-1
+ 1;D16-1;D17-1
+ 0
+D2, ENTERF;FLDAA1
+ FDIV;-2;0
+D5, GC1C2+MAC;JSACDV+MAC;0
+ GC2+MAC;JSACDV+MAC;0
+D7, ENTERE;FLDAA1;FDIV;-2;0
+D9, GIRL1+MAC
+D10, ENTERE;PCAC+MAC;GC2+MAC;JSACDV+MAC;0
+D12, GIRL1+MAC
+D13, ENTERE;FDIV;-2;0
+D14, GC1+MAC;PCAC+MAC
+D15, GIRL2+MAC;JSACDV+MAC;0
+D16, GIRL2+MAC;FSTA;XDPTMP;FLDAA1;FDIV;XDPTMP;0
+D17, FSTA;XDPP6;GIRL2+MAC;FSTA;XDPTMP;FLDA;XDPP6;FDIV;XDPTMP;0
+\f/ RELATIONALS AND LOGICALS SKELETON TABLES
+EQTABL, EQ1-1;EQ2-1;EQ3-1
+ EQ4-1;EQ5-1;EQ6-1
+ EQ1-1;EQ7-1;EQ3-1
+ EQ8-1;EQ9-1;EQ10-1
+ EQ11-1;EQ12-1;EQ13-1
+ EQ14-1;EQ15-1;EQ16-1
+ EQ17-1;EQ18-1;EQ19-1
+ EQ1-1;EQ2-1;EQ3-1
+EQ1, FSUB;-1;0
+EQ2, ENTERF;FLDAA1
+EQ3, FSUB;-2;0
+EQ4, GC1+MAC;JSACEQ+MAC;0
+EQ5, GC1C2+MAC;JSACEQ+MAC;0
+EQ6, GC2+MAC;JSACEQ+MAC;0
+EQ7, ENTERE;MAC+EQ2+1;0
+EQ8, GIRL1+MAC;JSACEQ+MAC;0
+EQ9, GIRL1+MAC
+EQ10, ENTERE;PCAC+MAC;GC2+MAC;JSACEQ+MAC;0
+EQ11, MAC+ASD-2;0
+EQ12, GIRL1+MAC
+EQ13, MAC+SSD+1;0
+EQ15, GIRL2+MAC
+EQ14, ENTERE;PCAC+MAC;GC1+MAC;JSACEQ+MAC;0
+EQ16, GIRL2+MAC;JSACEQ+MAC;0
+EQ18, GIRL2+MAC
+EQ17, MAC+ADS-2;0
+EQ19, MAC+SDS5;0
+\fLETABL, LE1-1;LE2-1;LE3-1
+ 0;0;0
+ LE1-1;LE4-1;LE3-1
+ 0;0;0
+ LE11-1;LE12-1;LE13-1
+ 0;0;0
+ LE17-1;LE18-1;LE19-1
+ 0
+LE1, FSUB;-1;NEGSGN;0
+LE2, ENTERF;FLDAA1
+LE3, FSUB;-2;0
+LE4, ENTERE;MAC+LE2+1;0
+LE11, MAC+ASD-2;0
+LE12, GIRL1+MAC
+LE13, MAC+SSD+1;0
+LE18, GIRL2+MAC
+LE17, MAC+ADS-2;0
+LE19, MAC+SDS5;0
+\fANDTBL, 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ M1-1;M1+3-1;M1+5-1
+ORTABL, 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ AS-1;AS+2;AS+4
+\fEQVTBL, 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ 0;0;0
+ EQ1-1;EQ2-1;EQ3-1
+\f/CONVERSION-FOR-STORE-OPERATOR SKELETONS
+STRTBL, SIIM-1;SIRM-1;SICM-1;SIDM-1;SIIM-1
+ SIIA-1;SIRA-1;SICA-1;SIDA-1;SIIA-1
+ SIIM-1;SIIM-1;SRCM-1;SRDM-1;SIIM-1
+ SIIA-1;SIIA-1;SRCA-1;SRDA-1;SIIA-1
+ SCIM-1;SCIM-1;SCCM-1;SCDM-1;SCIM-1
+ SCIA-1;SCIA-1;SCCA-1;SCDA-1;SCIA-1
+ SDIM-1;SDIM-1;SDCM-1;SDDM-1;SDIM-1
+ SDIA-1;SDIA-1;SDCA-1;SDDA-1;SDIA-1
+ SLIM-1;SLIM-1;SLCM-1;SLDM-1;SIIM-1
+ SLIA-1;SLIA-1;SLCA-1;SLDA-1;SIIA-1
+SIIM, ENTERF;FLDAA2
+SIIA, 0
+SIRM, ENTERF;FLDAA2
+SIRA, A0FN+MAC;0
+SICM, GC2+MAC;PCAC+MAC
+SICA, ENTERF;GCAC+1+MAC;A0FN+MAC;0
+SRCM, GC2+MAC;PCAC+MAC
+SRCA, ENTERF;GCAC+1+MAC;0
+ SCCM=GC2
+SCIM, ENTERF;FLDAA2
+SCIA, ENTERE;0
+ SCCA=GCAC
+SLIM, ENTERF;FLDAA2
+SLIA, JSA;LTRNE;0
+SLCM, GC2+MAC;ENTERF;SLIA+MAC;0
+SLCA, ENTERF;GCAC+1+MAC;SLIA+MAC;0
+SIDM, ENTERE;FLDAA2
+SIDA, ENTERF;SIRA+MAC;0
+SRDM, ENTERE;FLDAA2
+SRDA, ENTERF;0
+SCDM, ENTERE;FLDAA2
+SCDA, FSTA;TEMPN;ENTERF;FLDA;TEMPN;ENTERE;0
+SDIM, ENTERF;FLDAA2
+SDIA, ENTERE;0
+SDCM, ENTERE;FLDAA2;PCAC+MAC
+SDCA, ENTERF;GCAC+1+MAC;ENTERE;0
+SDDM, ENTERE;FLDAA2
+SDDA, 0
+SLDM, ENTERE;FLDAA2
+SLDA, JSA;LTRNE;0
+\f/ UNARY MINUS AND .NOT. SKELETONS
+NEGTBL, NIM-1;NIM-1;NCM-1;NDM-1;0
+ NIA-1;NIA-1;NCA-1;NIA-1;0
+NIM, ENTERF;FLDAA1
+NIA, FNEG;0;0
+NCM, GC1+MAC;PCAC+MAC;JSACNG+MAC;0
+ NCA=JSACNG
+NDM, ENTERE;NIM+1+MAC;0
+NOTTBL, 0;0;0;0;NOTM-1
+ 0;0;0;0;NOTA-1
+NOTM, ENTERF;FLDAA1
+NOTA, 0
+\f/ ARITHMETIC IF SKELETONS
+AIFTBL, GI-1;GI-1;GC-1;GD-1;GI-1 /V3C
+ GI+1;GI+1;GC+1;GD+1;GI+1 /V3C
+GI, ENTERF;FLDAA1;0
+GC, GC1+MAC;0
+GD, ENTERE;FLDAA1;0
+\f/OPERATOR DISPATCH TABLE
+
+XPUSH, PUSH
+ ADD
+ SUB
+ MUL
+ DIV
+ EXP
+ NOT
+ NEG
+ GE
+ GT
+ LE
+ LT
+ DNA
+ OR
+ EQ
+ NE
+ XOR
+ EQV
+ PAUZE
+ DPUSH
+ BINRD1
+ FMTRD1
+ WCLOSE /**
+ DARD1
+ BINWR1
+ FMTWR1
+ WCLOSE
+ DAWR1
+ DEFFIL
+ ASFDEF
+ ARGS
+ EOSTMT
+ ERROR
+ RETURN
+ REWIND
+ STORE
+XEND, END
+ DEFLBL
+ DOFINI
+ ARTHIF
+XLOGIF, LIFBGN
+ DOBEGN
+ ENDFIL
+ STOP
+ ASSIGN
+ BAKSPC
+ FORMAT
+XGOTO, GOTO
+ CGOTO
+ AGOTO
+ IOLMNT
+ DATELM
+ DREPTC
+ DATAST
+ ENDELM
+ PURGE
+XLAST, DOSTOR
+\f/ EXPONENTIATION TABLE (NOT A STANDARD SKELETON TABLE)
+EXPTBL, 1;1111;2;1122;3;1103;4;1104;0;0 /I**D=D
+ 2;1111;2;1122;3;1103;4;1104;0;0 /R**D=D
+ 3;0311;3;0322;3;0303;0;0;0;0
+ 4;0411;4;0422;0;0;4;0404;0;0
+ 0;0;0;0;0;0;0;0;0
+\f/ TYPE MIXING TABLE
+TYPMIX, 1;6;2;6;3;17;4;22;0;0
+ 2;6;2;6;3;17;4;22;0;0
+ 3;25;3;25;3;11;0;0;0;0
+ 4;30;4;30;0;0;4;14;0;0
+ 0;0;0;0;0;0;0;0;5;33
+RTNX, ENTERF;EXTERN;LTRNE;0
+ $
+\f
--- /dev/null
+/3 OS/8 FORTRAN (PASS THREE)
+/
+/ VERSION 4A PT 16-MAY-77
+/
+/ OS/8 FORTRAN IV COMPILER-PASS 3
+/
+/ BY: HANK MAURER
+/ UPDATED BY: R. LARY + M. HURLEY
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+VERSON=4
+\f/ PAGE ZERO STUFF
+ OUDEVH=7000 /PUT OUDEVH AND OUBUF IN DIFFERENT
+ INDEVH=6400
+ INBUF=6000
+ OUBUF=5400 /SEGMENTS, STAN KNOWS WHY
+ X10=10
+ X11=11
+ X12=12
+ NCHARS=20
+ CHAR=21
+ TEMP=22
+ FILDEV=6
+ FILBLK=7
+ DEV1CE=173 /THROUGH 177
+ DEVH=23
+ LINENO=24
+ SEVCHR=25 /THROUGH 33
+
+
+/ OS/8 V3C MAINTENANCE RELEASE FIXES:
+
+/1. EXTENDED RANGE OF PAGE NUMBERS TO 99
+/2 INTERCHANGED CR/LF FOR HASSINGER
+/3 CHANGED VERSION NO. TO 305
+/5. ADDED 'I' TO JMP (OFOO3
+/
+/
+/ CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
+/ .CHANGED VERSION NUMBER TO 4A
+/ .PUT IN NEW DATE ALGORITHM
+/
+/
+\f/START OF PASS 3
+ *400 /DON'T LOAD INTO 0-377
+SPASS3, CDF 10
+ TAD I (7666 /GET DATE
+ DCA TEMP
+ TAD I LSTFIL /COPY FILE NAME
+ CDF
+ DCA I FILLST
+ ISZ LSTFIL
+ ISZ FILLST
+ ISZ OFSIZE
+ JMP SPASS3
+ TAD DEV1CE /FETCH HANDLER FOR OUTPUT FILE
+ CIF 10
+ JMS I (200 /USR IS IN CORE
+ 1
+OH, OUDEVH+1 /TWO PAGE HANDLER IS OK
+ JMP I (OFOO3
+ CIF 10
+ TAD DEV1CE /OPEN THE LISTING FILE
+ JMS I (200
+ 3
+OB, DEV1CE+1
+OS, 0
+ JMP I (OFOO3
+ TAD OB /SAVE BLOCK NUMBER
+ DCA OBLOCK
+ TAD OS
+ DCA OSIZE /AND SIZE OF HOLE
+ TAD OH /SAVE HANDLER ADDRESS
+ DCA DEVH
+ TAD (NUMS-1 /SET UP NUMBER POINTER
+ DCA I (NUM
+ TAD TEMP /GET THE DATE--FOR YEAR ROUTINE
+ SNA
+ JMP I (PAJE /NO DATE
+ AND (7 /MASK OUT ALL BUT YEAR OFFSET BITS
+ DCA YRTEMP /INCREMENT FROM THE BASE YEAR
+ DCA TEMP1 /HOLDS THE FIRST DIGIT OF THE YEAR
+ TAD I (7777 /GET THE DATE EXTENSION BITS
+ AND (600 /MASK TO GET THE EXTENSION BITS
+ CLL RTR /ROTATE THEM INTO BIT
+ RTR /POSITIONS 7 AND 8
+ TAD (106 /ADD IN 70---OLD BASE YEAR
+ TAD YRTEMP /ADD IN THE YEAR OFFSET BITS
+ /TO FIND THE NEW BASE YEAR
+CONVYR, CLL /FIND THE YEAR IN DECIMAL
+ TAD (-12 /KEEP SUBTRACTING 12
+ SNL /ALMOST DONE
+ JMP SECDIG /FIND THE SECOND DIGIT OF THE YEAR
+ ISZ TEMP1 /FIND THE FIRST DIGIT OF THE YEAR
+ JMP CONVYR /TRY AGAIN
+SECDIG, TAD (72 /GET THE SECOND DIGIT OF THE YEAR
+ RTL /AND MAKE IT SIXBIT
+ RTL
+ RTL
+ DCA I (YEAR+1 /PUT IT IN THE PRINT LINE
+ TAD TEMP1 /GET THE FIRST DIGIT
+ TAD (5560 /MAKE IT SIXBIT
+ DCA I (YEAR /PRINT IT
+ TAD TEMP /GET THE DATE--NOW FIND THE MONTH/DAY
+ CLL RTR
+ RAR
+ AND (777
+ DCA TEMP
+SIMPLE, TAD TEMP /GET THE DAY
+ AND (37
+ TAD (DAYS-1 /THIS IS THE LAZY WAY
+ DCA NCHARS
+ TAD I NCHARS
+ DCA I (DAY
+ TAD TEMP /GET THE MONTH
+ CLL RTR
+ RTR
+ AND (36
+ TAD (MONTHS-3
+ DCA X10
+ TAD I X10
+ DCA I (MONTH
+ TAD I X10
+ DCA I (MONTH+1
+ JMP I (PAJE /WE GOT THE DATE
+LSTFIL, 7605
+FILLST, DEV1CE
+OFSIZE, -5
+YRTEMP, 0
+TEMP1, 0
+\f PAGE
+PAJE, JMP I (PRHDR /PRINT THE FIRST HEADING
+ CLL CML RTL /INITIALIZE LINE NUMBER
+ DCA LINENO
+ DCA TABCNT /**
+RDLUPE, TAD (SEVCHR-1 /SEVEN CHAR BUFFER
+ DCA X10
+ TAD (-6
+ DCA NCHARS
+RDLOOP, JMS I (ICHAR
+ JMP RDACHO /ECHO & IGNORE SHORT LINES
+ TAD (-211 /IS IT A TAB ?
+ SZA CLA
+ JMP NOTAB /NO
+ TAD (-2
+ DCA TABCNT /SET POINTER TO DO EXTRA SPACES LATER**
+ TAD (240
+ DCA I X10 /DO A TAB
+ ISZ NCHARS
+ JMP .-3
+ JMP WHAT /GO LOOK AT THE LINE
+NOTAB, TAD CHAR
+ DCA I X10 /SAVE THE CHAR
+ ISZ NCHARS
+ JMP RDLOOP
+WHAT, TAD SEVCHR /IS IT A COMMNET
+ TAD (-303
+ SNA CLA
+ JMP NOISN /YES, NO INTERNAL STMT NUMBER
+ TAD SEVCHR+5 /IS IT A CONTINUATION ?
+ TAD (-240
+ SZA CLA
+ JMP NOISN /YES, NO ISN
+ TAD LINENO /NEITHER OF THESE
+ JMS I (ONUMBR /PRINT ISN
+ TAD LINENO /2.01/ PUT LINE NUM
+ 7421 /2.01/ INTO MQ
+ CLA /2.01/ CLA IF NO EAE
+ ISZ LINENO /BUMP LINE NUMBER
+NOISN, TAD (211 /TAB
+ JMS I (OCHAR
+ TAD (SEVCHR-1 /PRINT FIRST SEVEN
+ DCA X10
+ TAD (-6
+ DCA NCHARS
+ TAD I X10
+ JMS I (OCHAR
+ ISZ NCHARS
+ JMP .-3
+ TAD TABCNT /SEE IF A TAB WAS 1ST
+ SMA CLA /IF YES,NEED 2 MORE SPACES
+ JMP NOTTAB
+ DCA TABCNT /WAS A TAB
+ TAD (240
+ JMS I (OCHAR
+ TAD (240
+ JMS I (OCHAR
+NOTTAB, JMS I (ICHAR /PRINT REST OF LINE
+ JMP ENDLIN
+ JMS I (OCHAR
+ JMP .-3
+ENDLIN, JMS I (CRLF /END LINE
+ JMS I (ERRCHK /CHECK ERROR LIST
+ JMP RDLUPE /DO NEXT LINE
+TABCNT, 0
+
+HEADER, TEXT ' FORTRAN IV 4AAAA '
+ *.-1
+DAY, 4040
+MONTH, 4040;4040
+YEAR, TEXT ' PAGE '
+ *.-1
+PAGENO, TEXT 'ONE'
+ ZBLOCK 7 /V3C ROOM FOR LARGE PAGE NUMBERS
+RDACHO, TAD (211
+ JMS I (OCHAR
+ JMP I (RDECHO
+ PAGE
+\f TEXT " "
+LOS, TEXT "ONE "
+NUMS,/ 2427;1740;4040
+/ 2410;2205;0540
+/ 0617;2522;4040
+/ 0611;2605;4040
+/ 2311;3040;4040
+/ 2305;2605;1640
+/ 0511;0710;2440
+/ 1611;1605;4040
+/ 2405;1640;4040
+/ 0514;0526;0516
+/ 2427;0514;2605
+ TEXT "TWO@@@@@"
+ TEXT "THREE@@@"
+ TEXT "FOUR@@@@"
+ TEXT "FIVE@@@@"
+ TEXT "SIX@@@@@"
+ TEXT "SEVEN@@@"
+ TEXT "EIGHT@@@"
+ TEXT "NINE@@@@"
+ TEXT "TEN@@@@@"
+ TEXT "ELEVEN@@"
+ TEXT "TWELVE@@"
+ TEXT "THIRTEEN"
+ TEXT "FOURTEEN"
+ TEXT "FIFTEEN@"
+ TEXT "SIXTEEN@"
+ TEXT "SEVENTEEN"
+ TEXT "EIGHTEEN"
+ TEXT "NINETEEN"
+HIS, TEXT " TWENTY "
+ *.-1
+ TEXT " THIRTY "
+ *.-1
+ TEXT " FORTY "
+ *.-1
+ TEXT " FIFTY "
+ *.-1
+ TEXT " SIXTY "
+ *.-1
+ TEXT "SEVENTY "
+ *.-1
+ TEXT " EIGHTY "
+ *.-1
+ TEXT " NINETY "
+ *.-1
+ TEXT "HUNDRED "
+ *.-1
+DAYS, 4061;4062;4063;4064;4065;4066;4067;4070;4071
+ 6160;6161;6162;6163;6164;6165;6166;6167;6170;6171
+ 6260;6261;6262;6263;6264;6265;6266;6267;6270;6271
+ 6360;6361
+MONTHS, 5512;0116 /-JAN
+ 5506;0502 /-FEB
+ 5515;0122 /-MAR
+ 5501;2022 /-APR
+ 5515;0131 /-MAY
+ 5512;2516 /-JUN
+ 5512;2514 /-JUL
+ 5501;2507 /-AUG
+ 5523;0520 /-SEP
+ 5517;0324 /-OCT
+ 5516;1726 /-NOV
+ 5504;0503 /-DEC
+ IFZERO .&100 <PAGE>
+\fENDX, TAD (-601 /2.02/ CLEAR END OF BUFFER
+ DCA LINENO /2.01/ FOR TV: REASONS
+ TAD X232 /2.01/ OUTPUT ^Z
+ JMS I (OCHAR /2.01/
+ ISZ LINENO /2.01/
+ JMP .-3 /2.01/
+ CIF 10 /CLOSE THE OUTPUT FILE
+ TAD DEV1CE
+ JMS I (200
+ 4
+ DEV1CE+1
+FILSIZ, 0
+ JMP (OFOO3
+ CDF 10 /LOOK AT OPTIONS
+ TAD I X7643
+ CDF
+M70, SPA CLA
+ JMP I (7605 //A MEANS DON'T CHAIN TO RALF
+ CIF CDF 10
+ TAD FILDEV /SET UP RALF INPUT LIST
+ DCA I (7617 /FILE SIZE AND DEVICE CODE
+ ISZ (7617
+ TAD FILBLK /FILE START
+ DCA I (7617
+ ISZ (7617 /ZERO END OF LIST
+ DCA I (7617
+ TAD I X7643 /IS IT /F (FULL LIST) ?
+ AND (100
+ CIF 0
+ SZA CLA /**
+ JMP LISTIT
+ CIF 10
+ TAD I (7644
+ AND (20 /LET /T SWITCH THRU ALSO
+ SNA CLA
+ DCA I (7605 /NO, INHIBIT RALF LISTING
+LISTIT, CIF 10
+ CLA IAC
+ CDF
+ JMS I (200 /LOOKUP RALF.SV
+ 2
+ RALFNM
+X7643, 7643
+ JMP (OFOO3
+ TAD .-3
+ DCA .+4
+ CIF 10 /CHAIN TO RALF
+ JMS I (200
+ 6
+X232, 232
+NCNT, 0
+ONUMBR, 0
+ DCA TEMP /OUTPUT ISN IN OCTAL
+ TAD (-4
+ DCA NCNT
+OLOOP, TAD TEMP
+ CLL RTL /ANYONE WHO CAN'T FOLLOW THIS
+ RAL /SHOULDN'T BE A PROGRAMMER
+ DCA TEMP
+ TAD TEMP
+ RAL
+ AND (7
+ TAD (260
+ JMS I (OCHAR
+ ISZ NCNT
+ JMP OLOOP
+ JMP I ONUMBR
+CONVRT, 0 /CONVERT TO ASCII AND PRINT
+ AND (77
+ SZA
+ TAD (-40
+ SPA
+ TAD (100
+ TAD (240
+ JMS I (OCHAR
+ JMP I CONVRT
+LINECT, -1 /EJECT FIRST TIME
+CRLF, PAJE+1
+ TAD (215 /CR LF
+ JMS I (OCHAR
+ TAD (212
+ JMS I (OCHAR
+ ISZ LINECT
+ JMP I CRLF
+ TAD (214
+ JMS I (OCHAR
+PRHDR, TAD M70 /RESET COUNT
+ DCA LINECT
+ TAD (HEADER /COPY HEADER OUT
+ DCA TEMP
+OHDR, TAD I TEMP
+ CLL RTR
+ CLL RTR
+ CLL RTR
+ JMS CONVRT
+ TAD I TEMP
+ JMS CONVRT
+ TAD I TEMP /END YET ?
+ ISZ TEMP
+ AND (77
+ SZA CLA
+ JMP OHDR
+ TAD (215 /V3C SKIP EXTRA LINE AFTER TITLE
+ JMS I (OCHAR
+ TAD (212 /V3C
+ JMS I (OCHAR /FOR CENTRONICS
+ JMP PUTNUM /GET NEW PAGE NUMBER
+\f/ OS/8 FILE INPUT ROUTINES
+ PAGE
+ICHAR, 0 /READ CHAR FROM INPUT FILE
+ ISZ INJMP /BUMP THREE WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF /DID LAST READ YEILD END OF FILE ?
+ SNA CLA
+ JMP INGBUF /NO, DO ANOTHER READ
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ JMP I (ENDX /NO FILE TO OPEN
+INGBUF, TAD INCTR /BUMP RECORD COUNTER
+ CLL IAC
+ SNL
+ DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED
+ SZL
+ ISZ INEOF /SET END OF FILE SWITCH
+ JMS I INHNDL /DO THE READ
+INCALL, 200
+INBUFP, INBUF
+INREC, 0
+ JMP INERR /HANDLER ERROR
+INBREC, ISZ INREC /BUMP RECORD NUMBER
+ TAD (-601 /SET CHAR COUNT
+ DCA INCHCT
+ TAD INJMPP /RESET THREE WAY JUMP SWITCH
+ DCA INJMP
+ TAD INBUFP /RESET BUFFER POINTER
+ DCA INPTR
+ JMP ICHAR+1 /GO AGAIN
+INERR, ISZ INEOF /EITHER EOF OR BADDIE
+ SMA CLA
+ JMP INBREC /END OF FILE, DO NEXT FILE
+ JMP OFOO3
+INJMP, HLT /3 WAY CHARACTER UUPACK SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP /RESET JUMP SWITCH
+ DCA INJMP
+ TAD I INPTR
+ AND (7400 /COMBINE THE HIGH ORDER BITS
+ CLL RTR /OF THE TWO WORDS
+ RTR
+ TAD INTMP /TO FORM THE THIRD CHAR
+ RTR
+ RTR
+ ISZ INPTR /BUMP WORD POINTER
+ JMP ICHAR1+1 /DO SOME COMMON STUFF
+ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS
+ AND (7400
+ DCA INTMP /FOR THE THIRD CHAR
+ ISZ INPTR /GO TO THE SECOND WORD
+ICHAR1, TAD I INPTR /GET THE LOW 8 BITS
+ AND (377 /AND I MEAN ONLY 8 !!
+ DCA CHAR
+ TAD CHAR
+ TAD (-232 /IS IT ^Z (END OF FILE)
+ SNA
+ JMP GETNEW /YES, LOOK FOR THE NEXT FILE
+ TAD (232-212
+ SNA
+ JMP ICHAR+1 /IGNORE LINE FEEDS
+ TAD (212-215
+ SNA
+ JMP I ICHAR /RETURN ON CARRIAGE RETURN
+ IAC
+ SNA CLA
+ JMP ICHAR+1 /IGNORE FORM FEEDS
+ TAD CHAR
+ ISZ ICHAR
+ JMP I ICHAR /RETURN TO THE CALLING WORLD
+INTMP, 0
+INFPTR, 7617 /POINTER TO INPUT FILE LIST
+INEOF, 1
+INCHCT,
+INNEWF, -1 /FETCH HANDLER FOR NEXT FILE
+ TAD (INDEVH+1 /THIS IS WHERE IT GOES
+ DCA INHNDL
+ CDF 10
+ TAD I INFPTR /GET NEXT INPUT FILE INFO
+ CDF
+ SNA
+ JMP I INNEWF /NO MORE FILES
+ CIF 10
+ JMS I INCALL /CALL MONITOR
+ 1 /FETCH HANDLER
+INHNDL, 0 /ENTRY ADDR GOES HERE
+ JMP OFOO3
+ CDF 10
+ TAD I INFPTR /GET LENGTH
+ AND (7760
+ SZA /A ZERO HERE MEANS >=256 BLOCKS
+ TAD (17 /PUT IN SOME MORE BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR /GET STARTING RECORD NUMBER
+ DCA INREC
+ ISZ INFPTR
+ DCA INEOF /CLEAR EOF FLAG
+ ISZ INNEWF
+ CDF
+ JMP I INNEWF
+INCTR, 0
+INPTR, 0
+/PUTNUM, TAD (PAGENO-1 /COPY THE NEW NUMBER
+/ DCA X10
+/ TAD I NUM
+/ ISZ NUM
+/ DCA I X10
+/ TAD I NUM
+/ ISZ NUM
+/ DCA I X10
+/ TAD I NUM
+/ ISZ NUM
+/ DCA I X10
+/ JMP CRLF+1
+RDECHO, /KEEP LINES WITH L.T. 6 CHARS OUT OF ISN COLUMN
+ TAD (SEVCHR-1
+ DCA X12
+RDECLP, TAD X12
+ CIA
+ TAD X10
+ SNA CLA
+ JMP ENDLIN /ONLY ECHO WHAT YOU READ
+ TAD I X12
+ JMS I (OCHAR
+ JMP RDECLP
+\f PAGE
+OUDUMP, 0 /BUMP THE DUFFER
+ TAD OSIZE /ANY ROOM LEFT ?
+ IAC
+ SNA
+ JMP OFOO3
+ DCA OSIZE /YES, ITS OK
+ JMS I DEVH /WRITE
+ 4200 /CONTROL WORD
+ OUBUF /BUFFER POINTER
+OBLOCK, 0 /BLOCK NUMBER
+ JMP OFOO3
+ ISZ OBLOCK /INCREMENT BLOCK NUMBER
+ ISZ FILSIZ /AND FILE SIZE
+ TAD OBLOCK-1 /SET BUFFER POINTER
+ DCA OUPTR
+ TAD (-200 /SET DOUBLE WORD COUNT
+ DCA OUWDCT
+ JMP I OUDUMP
+OCHAR, 0 /OUTPUT A CHAR TO THE RALF INPUT FILE
+ AND (377
+ DCA OUTEMP /SAVE CHAR
+ KSF /^C TEST
+ JMP NOSTOP
+ KRB
+ AND (177
+ TAD (-3
+ SNA CLA
+ JMP I (7605 /YES
+NOSTOP, ISZ OUJUMP /BUMP 3 WAY SWITCH
+OUJUMP, JMP .
+ JMP CHAR1
+ JMP CHAR2
+ TAD OUTEMP /HIGH FOUR BITS GO INTO
+ CLL RTL /THE HIGH ORDER BITS OF THE
+ RTL /FIRST WORD OF THE TWO WORD PAIR
+ AND (7400 /SEE NOTE * BELOW
+ TAD I OUPOLD /COMBINE WITH OTHER BITS
+ DCA I OUPOLD
+ TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR
+ CLL RTR /GO INTO THE HIGH ORDER FOUR
+ RTR /BITS OF THE SECOND WORD OF THE PAIR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR
+ TAD OUJMP /RESET 3 WAY BRANCH
+ DCA OUJUMP
+ ISZ OUPTR /BUMP BUFFER POINTER
+ ISZ OUWDCT /AND DOUBLE WORD COUNTER
+ JMP I OCHAR /BUFFER NOT FULL
+ JMS OUDUMP /DUMP IT
+ JMP I OCHAR
+CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER
+ DCA OUPOLD
+ ISZ OUPTR /GO TO SECOND WORD
+CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2
+ DCA I OUPTR
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, OUBUF
+OUJMP, JMP OUJUMP
+OUWDCT, -200
+OSIZE, 0
+ERRPTR, 5000
+ERRCHK, 0
+ CDF 10
+ TAD I ERRPTR /ANY ERRORS FOR THIS LINE
+ CDF
+ CMA
+ TAD LINENO
+ SZA CLA
+ JMP I ERRCHK /NO
+ CLL CMA RAL /BACK UP POINTER
+ TAD ERRPTR
+ DCA ERRPTR
+ TAD ERRPTR
+ IAC
+ DCA TEMP
+ CDF 10
+ TAD I TEMP /GET CODE
+ CDF
+ CIA
+ DCA TEMP /SAVE NEGATIVE
+ TAD (ERRLST-1
+ DCA X10
+FIND, TAD I X10 /LOOK FOR ERROR MESSAGE
+ SZA
+ TAD TEMP
+ SNA CLA
+ JMP .+3
+ ISZ X10
+ JMP FIND /SKIP POINTER WORD
+ CLA CMA
+ TAD I X10
+ DCA X10 /POINTER TO MESSAGE
+PMLOOP, TAD I X10 /GET TWO CHARS
+ DCA TEMP
+ TAD TEMP
+ RTR
+ RTR
+ RTR
+ JMS CONVRT /PRINT FIRST
+ TAD TEMP
+ JMS CONVRT /PRINT SECOND
+ TAD TEMP
+ AND (77 /END OF MESSAGE ?
+ SZA CLA
+ JMP PMLOOP /NO, LOOP
+ JMS I (CRLF
+ JMP ERRCHK+1 /SEE IF ANY MORE FOR THIS LINE
+RALFNM, FILENAME RALF.SV
+\f PAGE
+X304, 304
+X305, 305
+X7605, 7605
+OFOO3, TAD X304 /FATAL ERROR IN PASS 3
+ JMS TTY
+ TAD X305
+ JMS TTY
+ JMP I X7605
+TTY, 0 /PRINT ON TTY
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTY
+/ERROR MESSAGES
+ERRLST, 0724;GT
+ 1124;IT
+ 0504;ED
+ 2227;RW
+ 0317;CO
+ 0530;EX
+ 2123;QS
+ 2114;QL
+ 1106;IF
+ 0417;DO
+ 2316;SN
+ 2404;TD
+ 0204;BD
+ 2224;RT
+ 2204;RD
+ 2324;ST
+ 0314;CL
+ 1517;MO
+ 1017;HO
+ 1515;MM
+ 2323;SS
+ 1720;OP
+ 0123;AS
+ 0401;DA
+ 0410;DH
+ 1514;ML
+ 0405;DE
+ 0223;BS
+ 1424;LT
+ 1105;IE
+ 2010;PH
+ 1513;MK
+ 1724;OT
+ 2004;PD
+ 1524;MT
+ 0726;GV
+ 1411;LI
+ 0420;DP
+ 0414;DL
+ 0101;AA
+ 2306;SF
+ 0406;DF
+ 1111;II
+ 0;SYSERR
+SYSERR, TEXT 'UNDEFINED ERROR'
+II, TEXT 'ILLEGAL USE OF IF'
+GT, TEXT 'BAD GOTO STATEMENT'
+RW, TEXT 'BAD READ OR WRITE STATEMENT'
+CO, TEXT 'ARGS IN COMMON OR VAR IN TWO COMMONS OR SYNTAX BAD'
+IT, TEXT 'BAD IO LIST ELEMENT'
+EX, TEXT 'BAD EXTERNAL STMT'
+QS, TEXT 'SYNTAX ERROR IN EQUIVALENCE'
+QL, TEXT 'VARIABLE IS EQUIVALENCED MORE THAN ONCE'
+IF, TEXT 'THIS KIND OF STATEMENT NOT LEGAL AFTER LOGICAL IF'
+DO, TEXT 'BAD SYNTAX IN DO OR IMPLIED DO'
+SN, TEXT 'NOT LEGAL AS SUBROUTINE NAME'
+TD, TEXT 'SYNTAX ERROR IN TYPE STATEMENT'
+BD, TEXT 'DIMENSIONS TOO BIG, OR SYNTAX ERROR IN DIMENSION LIST'
+ED, TEXT 'ILLEGAL AS DO ENDING STATEMENT'
+RT, TEXT 'ATTEMPT TO RE-TYPE A VARIABLE'
+RD, TEXT 'ATTEMPT TO RE-DIMENSION A VARIABLE'
+ST, TEXT 'INTERNAL COMPILER ABORT NUMBER ONE'
+CL, TEXT 'ERROR IN COMPLEX LITERAL'
+MO, TEXT 'OPERAND EXPECTED, NONE PRESENT'
+HO, TEXT 'HOLLERITH COUNT WRONG, OR MISSING QUOTES'
+MM, TEXT 'MISMATCHED PARENTHESIS'
+SS, TEXT 'SUBSCRIPT OR ARGUMENT LIST ERROR'
+OP, TEXT 'ILLEGAL OPERATOR'
+AS, TEXT 'ASSIGN ???'
+DA, TEXT 'DATA STATEMENT ?'
+DH, TEXT 'HOLLERITH COUNT OR QUOTE ERROR IN DATA STATEMENT'
+ML, TEXT 'THIS LINE NUMBER IS ALREADY DEFINED'
+DE, TEXT "WRONG WAY TO END A DO LOOP"
+BS, TEXT 'ILLEGAL IN BLOCK DATA'
+LT, TEXT 'LINE TOO BIG'
+IE, TEXT 'INPUT FILE ERROR, TAKEN AS END STATEMENT'
+PH, TEXT 'THIS FUNCTION / SUBROUTINE STATEMENT IS UNACCEPTABLE'
+MK, TEXT 'YOU MISPELED A KEYWURD'
+OT, TEXT 'ILLEGAL OPERAND TYPE FOR THIS OPERATOR'
+PD, TEXT 'INTERNAL COMPILER ABORT NUMBER TWO'
+MT, TEXT "ILLEGAL VARIABLE TYPE MIXING"
+GV, TEXT 'VARIABLE IN ASSIGNED OR COMPUTED GOTO MUST BE INTEGER OR REAL'
+LI, TEXT 'EXPRESSION IN LOGICAL IF IS NOT TYPED LOGICAL'
+DP, TEXT 'DO PARAMETERS MUST BE INTEGER OR REAL'
+DL, TEXT "YOUR DATA AND VARIABLE LISTS ARE OF DIFFERENT LENGTHS"
+AA, TEXT 'SUBROUTINES MAY ONLY HAVE SIX ARGUMENTS THAT ARE DIMENSIONED'
+SF, TEXT 'BAD STATEMENT FUNCTION'
+DF, TEXT 'BAD DEFINE FILE'
+\fPAGEN, 1
+
+PUTNUM, ISZ PAGEN /BUMP PAGE NUMBER
+ TAD PAGEN
+ TAD (-24 /LT 20?
+ SMA CLA
+ JMP OVER19 /YES
+ TAD (-5 /NO
+ JMS MOVE /MOVE IN NUMBER
+NUM, 0
+ PAGENO-1
+ TAD NUM
+ TAD (5
+ DCA NUM /PT TO NEXT ONE
+ JMP I (CRLF+1
+
+TENS, 0
+ONES, 0
+KNT, 0
+
+OVER19, DCA TENS /CONVERT
+ TAD PAGEN /PAGE NUMBER TO ONES AND TENS
+O1, TAD (-12 /DIVIDE BY TEN
+ SPA
+ JMP .+3
+ ISZ TENS
+ JMP O1
+ TAD (12
+ DCA ONES
+ TAD TENS
+ CLL RTL
+ TAD (HIS-10-1
+ DCA HIP /POINT TO HIGH PART
+ TAD ONES
+ CLL RTL
+ TAD ONES
+ TAD (LOS-5-1
+ DCA LOP
+ TAD (-4
+ JMS MOVE
+HIP, 0
+ PAGENO-1
+ TAD (-5
+ JMS MOVE
+LOP, 0
+ PAGENO+4-1
+ JMP I (CRLF+1
+\fMOVE, 0
+ DCA KNT
+ TAD I MOVE
+ DCA X11
+ ISZ MOVE
+ TAD I MOVE
+ DCA X12
+ ISZ MOVE
+ TAD I X11
+ DCA I X12
+ ISZ KNT
+ JMP .-3
+ JMP I MOVE
+ $
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT8 #PAUSE /FORTRAN PAUSE HANDLER
+ EXTERN #WRITO
+ EXTERN #RSVO
+ EXTERN #RENDO
+ BASE 0
+ FSTA PNUM /SAVE ARGUMENT
+ STARTD
+ FLDA 0 /GET RETURN ADDRESS
+ FSTA PAURET
+ STARTF
+ TRAP3 #WRITO
+ JA ZERO
+ JA PAUFMT
+ FLDA PNUM /PRINT A MESSAGE "PAUSE N"
+ TRAP3 #RSVO
+ TRAP3 #RENDO
+ TRAP4 OPAUSE /DO ACTUAL PAUSE
+PAURET, JA . /RETURN
+
+OPAUSE, 0
+ AND% 0
+ AND% 0 /WASTE SOME TIME SO THAT THE LAST
+ AND% 0 /TWO CHARS OF THE MESSAGE WILL PRINT.
+ AND% 0
+ AND% 0
+ ISZ ZERO
+ JMP OPAUSE+1
+DPAUSE, IOF
+ KSF
+ JMP .-1
+ KRB
+ CLA
+ ION
+ CDF CIF 0
+ JMP% OPAUSE
+
+PNUM, F 0.0
+ZERO, F 0.0
+PAUFMT, TEXT %(' PAUSE'I6/)%
+ END
--- /dev/null
+/
+/ R E A L
+/ - - - -
+/
+/ A I M A G
+/ - - - - -
+/
+/ C O N J G
+/ - - - - -
+/
+/ VERSION 5A 4-27-77 PT
+/
+/REAL,AIMAG - ENTER IN COMPLEX,EXIT IN REAL
+/CONJG - ENTER + EXIT IN COMPLEX
+/
+ SECT REAL
+ JA #REAL
+ DPCHK
+ TEXT +REAL +
+REALXR, SETX XRREAL
+ SETB BPREAL
+BPREAL, F 0.0
+XRREAL, F 0.0
+ARG, F 0.0
+ F 0.0
+ ORG 10*3+BPREAL
+ FNOP
+ JA REALXR
+ 0
+REALRT, JA .
+ BASE 0
+#REAL, SETX XRREAL
+ LDX 0,2
+ LDX 1,0
+COMM, STARTD
+ FLDA 10*3
+ FSTA REALRT
+ FLDA 0
+ SETB BPREAL
+ BASE BPREAL
+ LDX 1,1
+ FSTA BPREAL
+ FLDA% BPREAL,1
+ FSTA BPREAL
+ STARTE
+ FLDA% BPREAL /GET ARG
+ FSTA ARG
+ JXN REAM,0
+ STARTF
+ FLDA ARG+3
+ FNEG
+ FSTA ARG+3
+ STARTE
+ FLDA ARG
+ FSTA #CAC
+ JA REALRT
+REAM, STARTF
+CON, FLDA ARG,2
+ JA REALRT
+ EXTERN #CAC
+/
+ ENTRY AIMAG
+AIMAG, SETX XRREAL
+ LDX 1,2
+ LDX 1,0
+ JA COMM
+/
+ ENTRY CONJG
+CONJG, SETX XRREAL
+ LDX 0,2
+ LDX 0,0
+ JA COMM
+\f
--- /dev/null
+/ A-D CLOCKED, BUFFERED SAMPLING ROUTINE
+/
+/ VERSION 5A 4-27-77 PT
+/
+ ADSK=6534
+ ADRB=6533
+ ADST=6532
+ ADLM=6531
+ ADLE=6536
+ ADCL=6530
+ CLZE=6130
+ ESF=4
+ LINC=6141
+ PDP=2
+ SAM=100
+ CLEN=6134
+ FIELD1 SAMPLE
+ 0 /INTERRUPT TIME AD SAMPLER
+ IFNSW 8 <
+ JMS LNCSAM /INITIATE SAMPLE
+NEXTCH, ISZ SAMINS /UPDATE SAM INST FOR NEXT CHAN
+ JMS LNCSAM /SAM AND INITIATE NEXT CHANNEL
+ >
+ TAD SAMPTR /SAVE THE OLD SAM BUFFER POINTER
+ DCA OLDPTR
+ TAD BUFFLD /AND THE FIELD
+ DCA OLDFLD
+ ISZ SAMPTR /BUMP BUFFER POINTER
+ JMP FLDOK /FIELD IS OK
+ TAD BUFFLD /BUMP FIELD
+ TAD L10
+ DCA BUFFLD
+FLDOK, ISZ SAMCNT /BUMP BUFFER COUNT
+ JMP BUFFLD /NOT END OF BUFFER
+ TAD ARRAY+2 /RESET POINTER TO START OF BUFFER
+ DCA SAMPTR
+ TAD FLDBUF /RESET BUFFER FIELD
+ DCA BUFFLD
+ TAD BUFSIZ /RESET COUNT
+ DCA SAMCNT
+BUFFLD, HLT /GET FIELD OF NEW ADB STOP CODE
+ TAD% SAMPTR /IS THIS THE SAM STOP CODE ?
+ TAD M3776 /(ILLEGAL AS A SAMPLE)
+ SZA CLA
+ JMP NOERR
+ ISZ TOOFAS /SET TOO FAST SWITCH
+SAMPLD, CDF 10
+ DCA% XCLINT+1 /STOP SAMPLING
+ JMP% SAMPLE
+NOERR, CLL CMA RAR /SET ADB STOP CODE
+ DCA% SAMPTR
+OLDFLD, HLT /GET TO FIELD OF SAMPLE
+ IFSW 8 <
+ ADRB /READ SAMPLE
+ >
+ IFNSW 8 <
+ TAD SAMTMP /GET PREVIOUSLY READ SAMPLE
+ >
+ DCA% OLDPTR /INTO BUFFER
+ ISZ NPOINT+2 /ANY MORE SAMPLES
+ SKP /YES
+ ISZ NPOINT+1 /MORE THAN 7777 ?
+ SKP /YES
+ JMP SAMPLD /NO
+ ISZ NCHANL+1 /ANY MORE CHANNELS TO SAMPLE ?
+ JMP NEXTCH /YES GO START SAMPLING
+ TAD CSTART+2 /STARTING CHANNEL
+ IFSW 8 <
+ ADLM
+ >
+ IFNSW 8 <
+ DCA SAMINS
+ JMS LNCSAM /SET CHANNEL TO START
+ /IN CASE CLOCK INITIATED
+ >
+ TAD NCHANL+2 /NUMBER OF CHANNELS
+ DCA NCHANL+1 /INTO COUNTER
+ CDF 10
+ JMP% SAMPLE
+ IFSW 8 <
+NEXTCH, ADST /SAMPLE NEXT CHANNEL
+ ADSK /WAIT FOR SAMPLE
+ JMP .-1
+ JMP SAMPLE+1
+ >
+ IFNSW 8 <
+LNCSAM, 0 /LINC SAM SUBROUTINE
+ LINC
+SAMINS, SAM 0 /SAMPLE AND SELECT NEXT CHANNEL
+ PDP
+ DCA SAMTMP /SAVE IT
+ JMP% LNCSAM
+ >
+ADSETU, 0 /SET UP ROUTINE
+ DCA TOOFAS /CLEAR TOO FAST SWITCH
+ TAD ARRAY+1 /GET FIELD OF BUFFER
+ AND L7
+ CLL RTL
+ RAL
+ TAD CDF0
+ DCA FLDBUF
+ TAD FLDBUF
+ DCA BUFFLD /SAVE IN SAMPLER CODE
+ TAD ARRAY+2 /SET SAMPLER BUFFER POINTER
+ IAC
+ DCA SAMPTR
+ TAD LENGTH+2 /SIZE OF BUFFER
+ CLL RAL
+ TAD LENGTH+2 /TIMES THREE
+ DCA BUFSIZ /SAVE IT
+ TAD BUFSIZ /SET INITIAL COUNT
+ IAC
+ DCA SAMCNT
+ TAD NCHANL+2 /SET CHANNEL COUNT
+ DCA NCHANL+1
+ IFSW 8 <
+ CLA CMA /STOP THE CLOCK
+ CLZE
+ CLA
+ ADCL /CLEAR AD LOGIC JUST IN CASE
+ TAD L300 /SET AD ENABLE BITS
+ ADLE
+ TAD CSTART+2 /STARTING CHANNEL NUMBER
+ ADLM
+ >
+ IFNSW 8 <
+ CLEN /STOP THE CLOCK
+ TAD CSTART+2 /SET UP INITIAL SAM INSTRUCTION
+ TAD L100
+ DCA CSTART+2
+ TAD CSTART+2
+ DCA SAMST /STARTING SAM
+ TAD SAMST /ALSO INTERRUPT TIME SAM
+ DCA SAMINS
+ TAD L100 /SET FAST SAM BIT
+ IOF /TURN OFF INTERRUPTS IN LINC MODE
+ LINC /ENTER LINC MODE
+ ESF
+SAMST, SAM 0 /SET INITIAL SAM CHANNEL
+ PDP
+ ION
+ CLA
+ >
+ CIF CDF
+ JMP% ADSETU
+BASEX, FNOP
+M3776, -3776
+L10, 10
+SAMPTR,
+ARRAY, 0;0;0
+LENGTH, 0;0
+BUFSIZ, 0
+SAMCNT,
+CSTART, 0
+OLDPTR, 0;0
+SAMTMP,
+NCHANL, 0;0;0
+NPOINT, 0;0;0
+FLDBUF,
+XCLINT, ADDR #CLINT
+ IFSW 8 <
+L300, 300
+ >
+ IFNSW 8 <
+L100, 100
+ >
+SAMXR, 0;0
+TOOFAS, 0
+ ORG 10*3+BASEX
+ 0
+ JA NAME+3
+ 0
+SAMRTN, JA .
+CDF0, CDF
+L7, 7
+\f SECT REALTM
+ BASE 0
+ STARTD
+ FLDA 30 /GET RETURN ADDR
+ FSTA SAMRTN
+ FLDA 0 /GET ARG POINTER
+ BASE BASEX
+ SETB BASEX
+ SETX SAMXR
+ FSTA NPOINT /SAVE ARG POINTER
+ FCLA
+ EXTERN #CLINT
+ FSTA #CLINT /STOP ANY SAMPLING NOW!
+ LDX 1,1
+ FLDA% NPOINT,1 /GET BUFFER ADDRESS
+ FSTA ARRAY
+ FLDA% NPOINT,1+ /GET ADDR OF LENGTH
+ FSTA LENGTH
+ FLDA% NPOINT,1+ /ADDR OFHANNEL START
+ FSTA CSTART
+ FLDA% NPOINT,1+ /ADDR OF # CHANNELS
+ FSTA NCHANL
+ FLDA% NPOINT,1+ /ADDR OF NUMBER OF POINTS
+ FSTA NPOINT
+ FLDA ARRAY /CREATE SETX INS
+ FADD STXMJA
+ FSTA BUFSTX
+ FSTA ADBSTX /AND SAVE IT IN TWO PLACES
+ STARTF
+ FLDA% LENGTH /INTEGERIZE AND NEGATE SOME ARGS
+ FNEG
+ ALN 0
+ FSTA LENGTH
+ FNORM
+ ATX 1 /SET BUFFER COUNT
+ FLDA% CSTART /GET STARTING CHANNEL
+ ALN 0
+ FSTA CSTART
+ FLDA% NCHANL
+ FNEG
+ ALN 0
+ FSTA NCHANL
+ FLDA% NPOINT
+ FNEG
+ ALN 0
+ FSTA NPOINT
+ LDX -1,2 /SET UP FOR BUFFER CLEAR
+ FCLA
+CLRBUF, FSTA% ARRAY,2+
+ JXN CLRBUF,1+
+ TRAP4 ADSETU /SET UP AD STUFF
+ FLDA LENGTH /RE-GET BUFFER SIZE
+ FNORM
+ ATX 1 /BUT NOW ITS TIMES THREE
+ FLDA STPCOD /STORE STOP CODES
+ FSTA% ARRAY /INTO FIRST 3 WORD
+ STARTD
+ FLDA SAMADR /SET UP SAMPLER INTERRUPT HANDLER
+ FSTA #CLINT
+ STARTF
+ JA SAMRTN /RETURN
+NAME, TEXT +RTMADB+
+SAMADR, ADDR SAMPLE
+STPCOD, 3776;3777;0
+STXMJA, 1100-1030;0
+L2047, F 2047.
+L511, F 511.
+\f ENTRY ADB
+ADB, BASE 0 /FETCH SAMPLE FROM BUFFER
+ STARTD
+ FLDA 30 /SAVE REUTRN
+ FSTA SAMRTN
+ SETB BASEX
+ SETX SAMXR
+ BASE BASEX
+ JXN SPEEDK,2 /CLOCK TOO FAST
+ FLDA ADBSTX /SAVE OLD SETX
+ FSTA OLDSTX
+ FADD L1 /ADD ONE TO IT
+ FSTA ADBSTX /AND SAVE IT BACK
+ JXN NORINQ,1+ /END OF BUFFER ?
+ FLDA BUFSTX /YES, RESTART
+ FSTA ADBSTX
+ FLDA LENGTH /RESET COUNT
+ ATX 1
+NORINQ, STARTF
+ADBSTX, SETX 0 /SET XR0 TO NEXT SAMPLE
+WAIT, XTA 0 /GET THE NEXT SAMPLE
+ FSUB L2047 /IS IT THE STOP CODE
+ JEQ WAIT /YES
+ XTA 0 /NO, FETCH THE SAMPLE
+ LDX 3776,0 /SET SAMPLE STOP CODE
+OLDSTX, SETX 0 /SET XR0 TO PREVIOUS STOP CODE
+ LDX 0,0 /NOW ZERO IT
+ JA SAMRTN /RETURN
+SPEEDK, EXTERN #WRITO /USE FORTRAN I/O
+ TRAP3 #WRITO /TO WRITE A MESSAGE
+ JA TTYUNT /ON THE TTY
+ JA MESSAG
+ EXTERN #RENDO
+ TRAP3 #RENDO /CLOSE THE RECORD
+ LDX 0,2 /KILL TOO FAST SWITCH
+ JA SAMRTN /RETURN FROM ADB
+TTYUNT, F 0.
+MESSAG, TEXT '(" SAMPLING TOO FAST")'
+BUFSTX, SETX 0
+L1, 0;1
+ END
+\f
--- /dev/null
+/
+/ VERSION 5A 4/26/77 MH
+/
+ SECT #RFCV /READ FORMATTED COMPLEX VARIABLE
+ ENTRY #WFCV
+ EXTERN #RFSV
+ EXTERN #WFSV
+ JA START
+ DPCHK
+ TEXT "#CIO "
+RETN, FNOP
+ FNOP
+ SETB BP
+ JA .+3
+BP, 0;0;0
+CVAL, 0;0;0;0;0;0
+ ORG BP+30
+ 0;JA RETN
+ 0
+GOBAK, JA .
+START, BASE 0
+ STARTD
+ 0210
+ FSTA GOBAK,0
+ STARTF
+ SETB BP
+ BASE BP
+ JSR #RFSV
+ FSTA CVAL
+ JSR #RFSV
+ FSTA CVAL+3
+ STARTE
+ FLDA CVAL
+ JA GOBAK
+ BASE 0
+#WFCV, FSTA CVAL,0
+ STARTD
+ 0210
+ FSTA GOBAK,0
+ SETB BP
+ BASE BP
+ STARTF
+ FLDA CVAL
+ JSR #WFSV
+ FLDA CVAL+3
+ JSR #WFSV
+ JA GOBAK
+ END
+\f
--- /dev/null
+/DOUBLE PRECISION BINARY AND DIRECT ACCESS I/O
+/FOR OS/8 FORTRAN
+/
+/ VERSION 5A 4-26-77 MH
+/
+/I/O CALLS ARE:
+/ TRAP3 #RSVO ALL SINGLE PRECISION I/O
+/ TRAP3 #RSVO ALL DOUBLE PRECISION FORMATTED I/O
+/ JSR #RFDV DOUBLE PRECISION BINARY + DIRECT ACCESS I/O
+/ TREATED AS 2 SINGLE PRECISION FORMATTED JOBS
+ SECT #RFDV
+ EXTERN #RSVO
+ BASE 0
+ STARTE
+ FSTA FTEMP3 /SAVE 6 WDS FOR A WRITE
+ STARTD
+ FLDA 0 /RETURN ADDRESS
+ FSTA RFDVRT /SAVE FOR EXIT
+ STARTF
+ FLDA FTEMP3 /PASS 1ST 3 WDS FOR A WRITE
+ TRAP3 #RSVO /DO THE READ OR WRITE
+ FSTA FTEMP3 /SAVE 1ST 3 WDS FROM A READ
+ FLDA FTEMP3+3 /GET 2ND 3 WDS FOR A WRITE
+ TRAP3 #RSVO /DO THE READ OR WRITE
+ FSTA FTEMP3+3 /SAVE 2ND 3 WDS FROM A READ
+ STARTE
+ FLDA FTEMP3 /GET ALL 6 WORDS FOR A READ
+RFDVRT, JA .
+
+FTEMP3, E 0.0
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+/THE FOLLOWING IS A SET OF 8 MODE (RALF TYPE)
+/ROUTINES THAT ENABLE PDP 12(8) HARDWARE OPTIONS
+/THESE ROUTINES ARE CALLABLE AT THE FORTRAN LEVEL
+/THE FOLLOWING OPTIONS ARE SUPPORTED:
+/
+/ 1 READ A BIT IN THE RIGHT SWITCHES
+/ 2 READ A BIT IN THE LEFT SWITCHES
+/ 3 READ A SENSE SWITCH
+/ 4 READ AN EXTERNAL LEVEL
+/ 5 OPEN OR CLOSE A RELAY
+/
+/IF THE REQUESTED BIT OR SWITCH IS SET THE
+/SUBROUTINE RETURNS WITH THE CALLERS ARG SET TO
+/A 1,OTHERWISE IT IS SET TO A 0
+/
+/
+\f SECT8 RSW
+ INDEX P17
+ BASE 0
+ JSA SETUP /CHECK ONE RSW BIT
+ TRAP4 DORITE /CALL 8 MODE ROUT USER
+ /ARG IS IN FPP XR3
+CONT, STARTD /ANSWER IS IN XR3
+ FLDA% 0,XR2 /GET PTR TO CALLER ANS
+ FSTA 3
+ STARTF
+ XTA XR3
+ FSTA% 3 /GIVE ANS TO CALLER
+GOBAK, FLDA 30 /RTN TO CALLER
+ JAC
+ ENTRY LSW
+LSW, JSA SETUP /READ 1 LSW BIT
+ TRAP4 DOLEFT /CALL 8MODE ROUT
+ JA CONT
+ ENTRY SSW
+SSW, STARTD /READ A SENSE SWITCH
+ FLDA ANSNSI
+ JA ESSW
+ ENTRY ROPEN
+ROPEN, STARTD /OPEN A RELAY
+ FLDA ABCLI
+ERCLOS, FSTA MASK /PLANT A BCLI OR BSEI IN
+ /8 MODE ROUTINE
+ JSA SETUP
+ TRAP4 RELAY
+ FLDA 30
+ JAC
+ ENTRY EXTLVL
+EXTLVL, STARTD /READ AN EXTERNAL LEVEL
+ FLDA ANSXL
+ESSW, FSTA LSKP /PLANT SXLI OR SNS IN
+ JSA SETUP /8 MODE ROUTINE
+ TRAP4 DOSXL
+ JA CONT
+ ENTRY RCLOSE
+RCLOSE, STARTD /CLOSE A RELAY
+ FLDA ABSEI
+ JA ERCLOS
+SETUP, 0;0 /GET ARGS AND SETUP RTN
+ STARTD
+ SETX P17
+ FLDA% 0,XR1 /GET PTR TO 1ST USER ARG
+ FSTA 3
+ STARTF
+ FLDA% 3 /USER ARG TO FAC
+ ATX XR3 /PUT IN XR FOR 8 MODE
+ JA SETUP
+\fDORITE, 0 /READ RIGHT SWITCHES
+ LAS
+ DCA MASK
+ JMS SETBIT /GET REQUESTED BIT
+ AND MASK /MASK RSW
+ SZA CLA /IF BIT IS SET,SET XR3=1
+ ISZ XR3
+ CIF CDF /RTN TO RTS
+ JMP% DORITE
+DOLEFT, 0 /READ LEFT SWITCHES
+ TAD DOLEFT
+ DCA DORITE
+ IOF
+ 6141 /LINC
+ 517 /LSW
+ 2 /PDP
+ ION
+ JMP DORITE+2
+DOSXL, 0 /READ SENSE SWITCH
+ /OR EXTERNAL LEVEL
+ TAD XR3 /=SSW OR LVL TO DO
+ AND P17
+ TAD LSKP
+ DCA LSKP
+ CLL CML /SET LNK=COND MET
+ IOF
+ 6141
+LSKP, 0 /=SNS I N OR SXL N
+ 261 /IF SKP FAILS THEN COND
+ /IS MET SO ROTATE LNK
+ /INTO AC(11) (261=ROL I 1)
+ 2 /PDP
+ ION
+ DCA XR3 /SAVE ANSWER
+ CIF CDF
+ JMP% DOSXL /RTN TO RTS
+RELAY, 0 /OPEN A RELAY
+ TAD CONT /=6
+ JMS SETBIT /GO SET RELAY BIT
+ DCA MASK+1
+ IOF
+ 6141
+ 15 /GET RELAYS
+MASK, 0 /BCL I OR BSE I
+ 0 /SET OR CLR 1 RELAY BIT
+ 14 /ATR PUT RELAYS BACK
+ 2
+ ION
+ CLA
+ CIF CDF
+ JMP% RELAY
+SETBIT, 0 /COME HERE TO POSITION
+ TAD XR3 /BIT IN AC ACCORDING TO
+ /C(AC)+XR3
+ CMA CLL CML /ROTATE BIT INTO POSITION
+ DCA XR3 /XR3 MUST=0 UPON EXIT
+ RAR /ROTATE LINK UNTIL
+ ISZ XR3 /XR3=0
+ JMP .-2
+ JMP% SETBIT /RTN WITH AC SET
+ABCLI, 1560 /BCL I
+ABSEI, 1620 /BSE I
+P17, 17 /FPP XR0
+XR1, 1
+XR2, 2
+XR3, 0
+ANSXL, 400 /SXL
+ 261 /ROL I 1
+ANSNSI, 460 /SNS I
+ 261
+\f
--- /dev/null
+/FORTRN 4 RTS LOADER
+/
+/ VERSION 5A PT 16-MAY-77
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/FORTRAN 4 RTS LOADER - RL
+/WITH DOUBLE PRECSION - MKH
+/AND RTS-8 SUPPORT - R. LARY
+
+/LAST EDITED 5/21/74
+/
+/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77
+/ .FIXED THE D AND B FORMAT (FPP) BUG
+/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED)
+/
+
+/PAGE 0 LOCATIONS FOR RTS LOADER
+
+X0= 10
+X1= 11
+X2= 12
+X3= 13
+
+HADR= 20
+UNIT= 21
+HCWORD= 22
+MXFLD= 23
+HLDADR= 24
+HGHFLD= 25
+HGHADR= 26
+RLTMP= 27
+HDIFF= 30
+CFLAG= 31
+
+/DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS
+/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED
+/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS.
+
+/*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN
+/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA.
+
+F0HBEG= 0
+F0HEND= 3000
+F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
+ /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG
+\f/RTS LOADER TABLES
+
+ *2000
+
+IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY
+HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE)
+TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE
+DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA
+
+ *IONTBL+5 /RK8 / RK8E
+ 1
+ *IONTBL+16 /DTA
+ 1
+ *IONTBL+6 /RF08 IN 4 FLAVORS
+ 1;1;1;1
+ *IONTBL+0 /TTY
+ 2 /FORMS CONTROL ON TTY
+ *IONTBL+4 /LPT
+ 2 /FORMS CONTROL ON LPT
+ *IONTBL+23
+ 1
+ *IONTBL+25
+ 1
+ PAGE
+\f/RTS LOADER
+
+RTSLDR, JMS I (RTINIT
+ JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT
+ JMP NOCD
+LICD, JMS I (200
+ 5
+ 1404 /.LD DEFAULT EXTENSION
+NOCD, JMS I (TSTSWS /TEST /E,/P,/V AND /H SWITCHES
+ TAD I (7617
+ SNA
+ JMP LICD
+ AND (17
+ JMS I (GETHAN /GET HANDLER TO LOAD WITH
+ 0 /DON'T PUT IT ANYWHERE
+ TAD I (7620
+ DCA LIBLK
+ JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION
+ CIF 0
+ JMS I HLDADR
+ 0100
+LHDR, QLHDR
+LIBLK, 0
+ JMP LDIOER
+ JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
+ CDF 0
+ TAD HADR
+ DCA I (OVHND
+ TAD HCWORD
+ DCA I (OVHCDW
+ TAD (QUSRLV-1
+ DCA X0
+ AC7776
+ TAD I LHDR
+ SZA CLA /VERIFY LOADER IMAGE INPUT
+ JMP NOTLI /GOOD THING WE CHECKED!
+ TAD DPFPP
+ TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION
+ SMA CLA
+ JMP .+3
+ JMS I (RLERR /YES - PRINT WARNING MESSAGE
+ NODPMS /BUT LET THE FOOL GO ON
+\f/SET UP RTS TABLES FROM LOADER IMAGE
+
+ CDF 0
+ TAD (OVLYTB-1
+ DCA X1
+ TAD (-10
+ DCA RLTMP
+OVRELP, TAD I X0
+ DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE,
+ TAD I X0
+ DCA I X1
+ TAD I X0
+ TAD LIBLK /RELOCATING THE BLOCK NUMBERS
+ DCA I X1
+ TAD I X0
+ DCA I X1
+ ISZ RLTMP
+ JMP OVRELP
+ TAD I (QRTSWP
+ AND (7770 /TURN THE LOADER INITIAL SWAP WORD
+ DCA I (STSWAP+2
+ TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD
+ AND (7 /SO THAT WE CAN HALT BETWEEN
+ TAD (JA /LOADING AND STARTING USERS PROGRAM.
+ DCA I (STJUMP
+ TAD I (QRTSWP+1
+ DCA I (STJUMP+1
+ TAD I (QHGHAD
+ DCA HGHFLD
+ CLA IAC
+ TAD HGHFLD
+ CMA
+ DCA I (FCNT
+ TAD I (QHGHAD+1
+ DCA HGHADR
+ JMS I (GETFIL /GET USER I/O FILES IF ANY
+ TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD
+ DCA I (VDATE-F0HBEG+F0TO
+ STL CLA
+ 6141 /TEST IF WE ARE ON A PDP-12
+ 0261 /ROL I 1 - PUTS LINK IN AC11
+ 0002 /PDP
+ DCA I (V8OR12+1-F0HBEG+F0TO
+ JMS I (MOVE
+ CDF 10
+ SPSTRT-1 /MOVE SPECIAL /P START CODE TO LOC 200
+ CDF 10
+ 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS)
+ -3
+ JMP I (MOVCOR
+
+DPFPP, 3777 /0 IF D.P. FPP AVAILABLE
+\fNOTLI, JMS I (RLERR
+ NOLI
+ JMP LICD
+
+LDIOER, JMS I (RLERR
+ LIOEMS
+ CDF CIF 0
+ JMP I (7605
+ PAGE
+\f/FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600
+
+MOVCOR, TAD I (HTOP
+ TAD HDIFF /GET BOTTOM OF HANDLER AREA
+ CIA
+ CLL /LENGTH OF HANDLER AREA IN AC
+ TAD HGHADR
+ SZL /TRICKY CODE - IF (L,AC)=0, AC GETS -1
+ STA /IF (L,AC) =0XXXX, AC GETS 0
+ SNA CLA /IF (L,AC) =1XXXX, AC GETS 1
+ STL STA /THERE OUGHTA BE A SHORTER WAY -
+ RAL /I'D APPRECIATE HEARING ONE.
+ TAD HGHFLD /USE MAGIC NUMBER TO ADJUST HGHFLD
+ CIA /BEFORE WE COMPARE IT TO TOP-OF-CORE
+ TAD MXFLD
+ SPA CLA
+ JMP TOOBIG /ALL THAT WORK FOR NOTHING!
+ TAD MXFLD
+ CLL RTL
+ RAL
+ TAD (CDF
+ DCA HCDF /PREPARE TO TRANSFER THE HANDLERS
+ JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE
+ CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE
+ TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM.
+ CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE
+ 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE.
+ -45
+ CIF 0
+ JMS I (7607
+ 4210
+ 7400
+ 37 /SUITABLE SCRATCH BLOCK
+ JMP SYSERR
+ TAD HDIFF
+ TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET
+ DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS.
+\f/SHUFFLE CORE AROUND AND START UP RTS
+
+HLOOP, STA
+ TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED
+ DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING
+ CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND
+ STA /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS.
+ TAD HPTR1
+ DCA HPTR1
+ STA
+ TAD HPTR2
+ DCA HPTR2
+ TAD I HPTR1
+HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0
+ DCA I HDIFF /TO FIELD N
+ CDF 10
+ TAD I HPTR2 /MEANWHILE RESTORE FIELD 0
+ CDF 0
+ DCA I HPTR1 /FROM FIELD 1
+ ISZ HMCT
+ JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT
+ CDF CIF 0
+ TAD (5606
+ DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS
+ TAD (PDPXIT
+ DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL.
+ FPICL /RE-INITIALIZE FPP (IF ANY)
+ FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP)
+ CLA IAC
+ 6654 /LOAD PRINTER BUFFER ON ANALEX PRINTER
+ SZA CLA /IS ANALEX PRESENT?
+ JMP I (FPSTRT /NO - START UP
+ DCA I (LPTEST /IF ANALEX TAKE OUT LPT INTERNAL HANDLER
+LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS
+ DCA I (LPTSNA
+ 6662 /CLEAR BUFFER ON ANALEX
+ TAD (6651
+ DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX
+ TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF.
+ DCA I (LPTERR+2
+ JMP I (FPSTRT
+
+TOOBIG, JMS I (RLERR
+ TOOMCH
+OS8RTN, CDF CIF 0
+ JMP I (7605
+
+SYSERR, JMS I (RLERR
+ SYSMSG
+ JMP OS8RTN
+
+HPTR1, F0HEND
+HPTR2, F0TO+F0HEND-F0HBEG
+HMCT, F0HBEG-F0HEND
+\f/MOVE ROUTINE
+
+MOVE, 0 /GENERAL MOVE SUBROUTINE
+ CDF 10
+ CLA
+ TAD MOVE
+ DCA X2
+ TAD I MOVE
+ DCA FRMFLD
+ TAD I X2
+ DCA X3
+ TAD I X2
+ DCA TOFLD
+ TAD I X2
+ DCA X1
+ TAD I X2
+ DCA MVC
+FRMFLD, HLT
+ TAD I X3
+TOFLD, HLT
+ DCA I X1
+ ISZ MVC
+ JMP FRMFLD
+ CDF 10
+ JMP I X2
+MVC, 0
+
+HNDERR, JMS I (RLERR
+ TOMNYH
+ JMP OS8RTN
+ PAGE
+\f/INITIALIZATION
+
+RTINIT, 0
+ ISZ RTINIT /SKIP RETURN
+ JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8
+ CIF 0
+ JMS I (CORE
+ DCA MXFLD
+ CLA IAC
+ JMS I (GETION /GET ION BIT FOR SYS HANDLER
+ DCA I (HCWTBL+13 /SAVE IT
+ SWAB /SET EAE MODE TO B (IF 8/E)
+ CLA IAC
+EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE
+ CLA IAC /LOW ORDER BITS 01
+ TAD (-2
+ SNA CLA /TEST FOR 8/E EAE
+ JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES
+ TAD (APT
+ FPST /START FPP ON "STARTE;FEXIT"
+ JMP NOFPP /DIDN'T START
+ JMS I (MOVE
+ CDF 10
+ FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE
+ CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE
+ FPPINT-1 /FPP INTERPRETER IN FIELD 0.
+ -1000 /COUNT FOR DBL PREC SPACE
+ FPRST /FPP HAD BETTER BE DONE BY NOW!!
+ AND (4 /GET D.P. STATUS BIT
+ SNA CLA
+ JMP NOFPP /NO DOUBLE PRECISION
+ DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE
+ CDF 0
+ TAD (DFMT
+ DCA I (DF /ENABLE D FORMAT
+ TAD (BFMT
+ DCA I (BF /AND B FORMAT
+ CDF 10
+\fNOFPP, JMS I (MOVE
+RICDF0, CDF 0
+ F0HBEG-1
+ CDF 10
+ F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING
+ F0HBEG-F0HEND
+ CDF 0
+ TAD I (OSJSWD /GET OS/8 STATUS WORD
+ AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB
+ TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR
+ DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF
+ TAD I (7612
+ TAD (-3 /CHECK FOR IN-CORE TD8E'S
+ SZA CLA
+ JMP NOTDSY
+ TAD MXFLD
+ CLL RTL
+ RAL
+ TAD RICDF0
+ DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF
+ TAD I (7642
+ AND (70
+ TAD RICDF0 /GET THE FIELD WE'RE COMING FROM
+ DCA TD8EFL
+ TAD TD8EFG
+ IAC
+ JMS I (TDSET /REDO THE CDF'S IN F0
+ JMS I (MOVE
+TD8EFL, CDF 20
+ 7577
+TD8EFG, 0
+ 7577
+ -174 /SPARE BATCH PARAMETERS IN TOP FIELD
+ TAD MXFLD /SET FLAG IN CLEANUP ROUTINE
+ DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2
+NOTDSY, CDF 10
+ TAD MXFLD
+ TAD (-7
+ SNA /32K?
+ JMP TAKCAR /YES - UNIQUE PROBLEMS
+ TAD (6
+ SNA CLA /8K?
+ JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP
+ JMS I (GBFLG /GET BATCH FLAG
+ TAD TD8EFG
+ SNA CLA /IF NO BATCH OR TD8E'S,
+ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD.
+STOHDF, TAD (-F0HEND-200
+ DCA HDIFF /OTHERWISE USE ONLY UP TO 7600
+ JMP I RTINIT
+\fTAKCAR, JMS I (GBFLG /GET BATCH FLAG
+ SNA CLA
+ JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM)
+ TAD (6 /BATCH - USE UP TO 67600
+ DCA MXFLD
+ JMP STOHDF
+NO32KB, TAD TD8EFG
+ SNA CLA /IF IN-CORE TD8E'S
+ TAD (7600 /LIMIT IS 77600 ELSE 77400
+ JMP STOHDF
+ PAGE
+\fGETHAN, 0 /GET HANDLER SUBROUTINE
+ AND (17
+ DCA UNIT
+ DCA H1
+ TAD UNIT
+ JMS I (200
+ 12 /INQUIRE
+H1, 0
+ NOP /ERROR RETURN ALWAYS SKIPPED
+ TAD H1
+ SNA
+ JMP NOTLDD /NOT IN CORE - MUST LOAD
+ JMS HCWTBA /IN CORE
+GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE
+ DCA HCWORD
+ TAD HLDADR
+ DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT
+ TAD (-4
+ AND HCWORD
+ SNA CLA /WERE WE RASH?
+ JMP RESHAN /NO
+ TAD HADR
+ AND (177
+ TAD (HPLACE /YES - I APOLOGIZE
+ DCA HADR
+RESHAN, TAD I GETHAN /GET DSRN NUMBER
+ SNA
+ JMP I GETHAN /NO DSRN NUMBER
+ CLL RTL
+ RAL
+ TAD I GETHAN
+ TAD (DSRN-12
+ DCA X0 /XR POINTS TO DSRN ENTRY
+ CDF 0
+ TAD HADR
+ DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT
+ TAD HCWORD
+ TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE
+ AND (7773 /KILL ANY OVERFLOW
+ DCA I X0
+ TAD HGHFLD
+ CLL RTL
+ RAL
+ TAD HGHADR
+ DCA I X0 /SAVE BUFFER ADDRESS, FIELD
+ TAD HGHADR
+ DCA I X0 /INITIALIZE WORD POINTER
+ TAD HGHADR
+ TAD (400
+ SNA
+ ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS
+ DCA HGHADR
+ AC7775
+ DCA I X0 /INITIALIZE CHAR CTR
+ CDF 10
+ JMP I GETHAN /RETURN
+\f/LOAD A NON-RESIDENT HANDLER
+
+NOTLDD, JMS GH
+ CLA IAC
+ JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN
+ HLT /ARRRGHHHH!!!
+
+GH, 0
+ DCA TPFLG
+ TAD HTOP
+ TAD (7600 /BUMP HANDLER CEILING DOWN
+ SNA
+ JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0
+ DCA HTOP
+ TAD TPFLG
+ TAD HTOP
+ DCA GHADR
+ TAD UNIT
+ JMS I (200
+ 1 /FETCH HANDLER
+GHADR, 0
+ JMP I GH /FAILED!
+ TAD GHADR /SAVE ACTUAL LOAD ADDRESS
+ JMS HCWTBA /INDEX INTO HCW TABLE
+ TAD GHADR
+ AND (7600
+ TAD HDIFF
+ DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS
+ TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8
+ CLL RTL
+ RAL
+ TAD GHADR
+ DCA GHADR
+ TAD UNIT
+ JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10
+ TAD GHADR
+ DCA I HCWPTR /STORE POINTER FOR THIS PAGE
+ JMP GHEXIT
+\fHCWTBA, 0
+ DCA HLDADR
+ TAD HLDADR
+ AND (7600
+ CLL RTL
+ RTL
+ RTL /GET PAGE NUMBER
+ TAD (HCWTBL-24
+ DCA HCWPTR /SAVE POINTER INTO TABLE
+ JMP I HCWTBA
+
+HTOP, F0HEND
+HCWPTR, 0
+TPFLG, 0
+
+SPSTRT, RELOC 200 / /P STARTUP CODE
+ SWAB /MAKE SURE EAE IS IN MODE B
+ JMP I .+1 /EXECUTES AT 200
+ FPSTRT /START UP IN FLAG CLEARING CODE
+ RELOC
+ PAGE
+\f/ROUTINE TO ACCEPT FILE SPECIFICATIONS
+
+GETFIL, 0
+ CDF 10
+ TAD I (OS8SWS-1
+ SPA CLA /ALTMODE MEANS NO MORE SPECS
+ JMP I GETFIL
+GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE
+ TAD I (7600
+ STL CIA
+ SNA /OUTPUT FILE?
+ TAD I (7605
+ SNA /IN OR OUT FILE?
+ TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER?
+ SNA CLA
+ JMP GETFIL+1 /NONE OF THE ABOVE
+ RAR /LINK MAGICALLY TELLS DIRECTION
+ DCA DIR
+ DCA DSRNUM
+ TAD I (OS8SWS+2
+ AND (777 /SWITCHES 1-9
+ SNA
+ JMP NONUM
+ CLL RTL
+DNUMLP, ISZ DSRNUM
+ RAL
+ SMA
+ JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER
+ TAD DIR /** AC IS NEGATIVE **
+ SPA CLA
+ TAD (5
+ TAD (7600
+ DCA FPTR /POINT TO FILE UNIT
+ TAD I FPTR
+ SNA
+ JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST
+ JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN
+DSRNUM, 0 /DSRN ENTRY NUMBER
+ TAD DIR
+ STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER)
+ DCA LKPNTR
+ TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER)
+ ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME
+ DCA FUNIT /SAVE UNIT NUMBER A SEC
+ TAD I FPTR /WATCH OUT FOR NULL FILE NAMES
+ SNA CLA /AS THEY WILL FAIL ON LOOKUPS
+ JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES
+ JMS I (SVHND /SAVE HANDLER
+ TAD FUNIT
+ JMS I (200
+LKPNTR, 0 /LOOKUP OR ENTER
+FPTR, 0 /FILE NAME
+FUNIT, 0 /GETS LENGTH
+ JMP FILERR /SOMETHING NOT KOSHER
+ JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
+\fSTDSRN, TAD FPTR
+ CDF 0
+ DCA I X0 /SAVE STARTING BLOCK
+ DCA I X0 /RELATIVE BLOCK
+ TAD FUNIT
+ SNA
+ IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE
+ CIA /TURN NEGATIVE COUNT TO POSITIVE
+ DCA I X0 /LENGTH
+ TAD X0
+ DCA FPTR /SAVE PTR TO LENGTH WORD
+ CDF 10
+ TAD DIR
+ SMA CLA /TENTATIVE FILE?
+ JMP GETFIL+1
+ TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN
+ DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY
+ JMS I (MOVE
+ CDF 10
+ 7600-1
+ CDF 10
+TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN
+ -5 /TENTATIVE FILE TABLE
+ TAD TFPTR
+ TAD (6
+ DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY
+ JMP GETFIL+1
+\fNONUM, JMS I (RLERR
+ NONMSG
+ JMP GETFCD
+FILERR, JMS I (RLERR
+ FILMSG
+ JMP GETFCD
+
+DIR, 0
+
+NONAME, DCA FPTR
+ DCA FUNIT /ZERO BLOCK # AND LENGTH
+ JMP STDSRN /USE ENTIRE DEVICE AS FILE
+
+INTHND, STA
+ TAD I (OS8SWS+3
+ AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER
+ TAD (IHTBL
+ DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS
+ TAD DSRNUM
+ CLL RTL
+ RAL
+ TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9
+ TAD (DSRN-11 /ADD TABLE BASE
+ DCA DSRNUM
+ TAD I HADR
+ CDF 0
+ DCA I DSRNUM
+ ISZ DSRNUM
+ AC7776
+ TAD CFLAG /DEPENDING ON THE C FLAG,
+ CIA
+ DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL
+ JMP GETFIL+1
+ PAGE
+\fTSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H
+ TAD I (OS8SWS
+ AND (20
+ CDF 0
+ SNA CLA /TEST FOR /H SWITCH
+ JMP .+3
+ TAD (HLT
+ DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM
+ CDF 10
+ TAD I (OS8SWS+1
+ AND (4
+ SNA CLA /TEST FOR /V SWITCH
+ JMP .+3 /NO
+ JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE
+ XVERMS
+ TAD I (OS8SWS
+ AND (200
+ CDF 0
+ SZA CLA /TEST FOR /E SWITCH
+ ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL
+ CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC)
+ TAD I (OS8SWS+1
+ AND (400
+ CDF 0
+ SNA CLA /TEST FOR /P SWITCH
+ JMP .+3 /NO, PRAISE BE!
+ TAD (SKP /GIVE THE DUMMY WHAT HE WANTS
+ DCA I (HLTNOP
+ CDF 10
+ TAD I (OS8SWS
+ RTL
+ SMA CLA
+ AC0002
+ DCA CFLAG /SAVE C FLAG IN PAGE0
+ JMP I TSTSWS
+
+MOVEAE, 0
+ TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE
+ CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE
+ DCA I (NORMX /NORMALIZE ROUTINE
+ JMS I (MOVE
+ CDF 10
+ FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1
+ CDF 0
+ FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0
+ -600
+ JMS I (MOVE
+ CDF 0 /SUBSTITUTE FAST FIX AND FLOAT
+ EFXFLT-1
+ CDF 0
+ EAEFIX-1
+ -FXFLTC
+ JMP I MOVEAE
+\fSPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE
+ JMS I (MOVE
+ CDF 10
+ OS8DVT-1
+ CDF 10
+ DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE
+ -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT
+ TAD I (HTOP /GET LOWEST HANDLER LOADED
+ RAL
+ SZL SPA CLA /DID WE LOAD ANY BELOW 02000?
+ JMP .+4 /NO
+ CDF 0
+ ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE
+ ISZ I (OSJSWD
+ CDF 10
+ JMS I (200
+ 5 /COMMAND DECODE
+ 5200 /SPECIAL MODE - WROUGHT WITH PERIL
+ 0 /DON'T CLEAR TENTATIVE FILES
+ JMS I (MOVE
+ CDF 10
+ DVTEMP-1
+ CDF 10
+ OS8DVT-1
+ -17 /MOVE DEVICE HANDLER TABLE BACK
+ JMS TSTSWS /CHECK FOR /E, /H, /P
+ JMP I SPMDCD
+
+IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE
+ PAGE
+\fGETION, 0
+ TAD (OS8DCB-1
+ DCA GMADR
+ TAD I GMADR /GET DCB WORD
+ CLL RTR
+ RAR
+ AND (77 /INDEX INTO TABLE
+ TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE
+ DCA GMADR /WITH INTERRUPTS ON
+ TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10
+ JMP I GETION
+
+GBFLG, 0
+ CDF 0
+ TAD I (7777 /SPECIAL FLAGS LOC
+ CDF 10
+ RTL
+ CLA RAL
+ JMP I GBFLG
+
+SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1
+ JMS GMADR /GET MOVE FROM ADDRESS
+ JMP I SVHND /NO HANDLER TO MOVE
+ DCA SVMOVE
+ JMS I (MOVE
+ CDF 0
+SVMOVE, 0
+ CDF 10
+ F0HSAV-1
+ -400
+ JMP I SVHND
+
+RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1
+ JMS GMADR
+ JMP I RSTHND /HANDLER IS SYS:
+ DCA RSTMOV
+ JMS I (MOVE
+ CDF 10
+ F0HSAV-1
+ CDF 0
+RSTMOV, 0
+ -400
+ JMP I RSTHND
+
+GMADR, 0
+ TAD HLDADR
+ SPA /CHECK THAT WE'RE NOT TRYING
+ JMP RESHND /TO SAVE A RESIDENT HANDLER -
+ AND RESHND /THAT COULD BE TRICKY
+ TAD (-1 /ECCH
+ ISZ GMADR
+ JMP I GMADR
+RESHND, 7600
+ JMP I GMADR
+\f/RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES
+
+RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0
+ CLA
+ CDF 10
+ TAD I RLERR
+ CDF 0
+ DCA RLTMP
+RELP, TAD I RLTMP
+ RTR
+ RTR
+ RTR
+ AND (77
+ JMS LTTY
+ TAD I RLTMP
+ AND (77
+ JMS LTTY
+ ISZ RLTMP
+ JMP RELP
+EOMSG, TAD (7515
+ JMS LTTY
+ TAD (7512
+ JMS LTTY
+ ISZ RLERR
+ CDF 10
+ JMP I RLERR /SOME MESSAGES ARE NOT FATAL
+
+LTTY, 0
+ SNA
+ JMP EOMSG
+ TAD (240
+ SMA
+ AND (77 /CONVERT SIXBIT TO EIGHTBIT
+ TAD (240
+ TLS
+ CLA
+ TSF
+ JMP .-1
+ JMP I LTTY
+\f/ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE
+/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE.
+/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED
+
+BAKTST, 0
+ FPICL /FIRST INITIALIZE FPP (IF ANY)
+ FPCOM /INCLUDING CLEARING EXTENDED APT POINTER
+ TCF /TEST FOR RTS-8 BACKGROUND BY CLEARING THE
+ TSF /TTY FLAG AND THEN TESTING IT - IF IT IS
+ JMP I BAKTST /STILL SET, WE ARE RUNNING UNDER SRT-8.
+ CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0
+BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED
+ SNA
+ JMP BAKRTN /ZERO - WE'RE DONE
+ DCA X0 /STORE IN AUTO-XR
+ ISZ BKRPTR
+BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE
+ ISZ BKRPTR
+ SNA
+ JMP BAKLP /ZERO MEANS END OF GROUP
+ DCA I X0
+ JMP BAKWLP
+BAKRTN, CDF 10 /RESET DATA FIELD TO 10
+ DCA I (EAEKIL /EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT
+ JMP I BAKTST /AND RETURN
+
+BKRPTR, BKRLST
+ PAGE
+
+F0TO= .
+\f/FLOATING POINT PROCESSOR HANDLER
+ *FPPINT
+
+RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE
+
+FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE
+ CDF 0
+ DCA STEFLG
+ TAD PC
+ DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL
+ TAD APT
+ DCA SAVAPT /OF RE-ENTRANTNESS
+ TAD I FPGO
+ DCA PC
+ TAD APT
+ AND (7770
+ DCA APT /SET UP ADDRESS IN APT
+FPREST, TAD (400 /ENABLE FPP INTERRUPTS
+ FPCOM /LOAD AND STORE ENTIRE APT
+ CLA /NECESSARY?
+ TAD STEFLG /0 OR 4000?(STARTF OR STARTE)
+ SZA
+ 6567 /A MNEMONIC?
+ CLA
+ TAD (APT
+ IOF
+ FPST /START UP FPP
+ JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START
+ CLA /NECESSARY?
+ JMS I (HANG /EXECUTE BACKGROUND
+ FPUHNG
+ FPRST /READ FPP STATUS
+ FPICL /RESET FPP
+ ION
+ RTL
+ SZL /TEST TRAP BIT
+ JMP TRAP /YUP - GO EXECUTE IT
+ AND (7400
+ SZA /ANY ERRORS?
+ JMP FPPER
+ TAD FSAVPC
+ DCA PC /RESTORE OLD PC
+ TAD SAVAPT
+ DCA APT
+ ISZ FPGO
+ JMP I FPGO
+\f/FLOATING POINT TRAP PROCESSOR
+
+TRAP, AC7775
+ TAD PC
+ DCA PC /BACK UP PC TO BEFORE THE TRAP
+ SZL
+ STA
+ TAD APT /INCLUDING THE FIELD BITS
+ DCA APT
+ TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS
+ JMS I MCDF
+ DCA I (PCCDF
+ JMS I (FETPC
+ DCA T
+ TAD T /GET TRAP WORD
+ JMS I MCDF
+ IAC /MAKE A "CDF CIF N"
+ IAC
+ DCA TRPCIF
+ JMS I (FETPC
+ DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS
+ TAD T
+TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS
+ SMA CLA /TRAP3 OR TRAP4?
+ JMP I ADR /TRAP3 - GO TO ADR
+ JMS I ADR /TRAP4 - CALL ADR
+FPPRTN, DCA STEFLG
+ ISZ PC /RESTORE PC FROM BEFORE TRAP
+ SKP
+ ISZ APT /INCLUDING FIELD
+ CDF 0
+ JMP FPREST /RESTART FPP
+
+FPPER, SPA
+ JMP I (FPPERR /FPHALT - FATAL ERROR
+ RTL
+ ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL
+ SZL
+ JMP FPDVER
+FPOVER, JMS I ERR
+ SKP
+FPDVER, JMS I ERR
+ TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE!
+ DCA ACX
+ AC2000
+ DCA ACH
+ JMP FPREST
+
+FSAVPC, 0
+SAVAPT, 0
+STEFLG, 0
+\f/RANDOM FPP CODE FOR D.P. I/O
+DFSTM2, FSTA+LONG
+ DFTMP2
+ FEXIT
+
+ PAGE
+\f/THIS IS DOUBLE PRECISION FORMATTED OUTPUT.
+/ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF
+/AND, OH JOY!, NO PAGE 0 LITERALS.
+DNXT, TAD RWFLAG /READ OR WRITE?
+ SMA CLA
+ AC4000 /ITS INPUT SO LEAVE IN STARTE MODE
+ JMS I (GETLMN
+ JMP .+3
+DFMT, STA
+BFMT, DCA EFLG
+ TAD D
+ DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT
+ TAD PFACT
+ DCA PFACTX
+ DCA SCALE
+ JMS I (SKPOUT /DONE?
+ JMP I (DPIN /ITS INPUT
+ STA /ITS OUTPUT
+ DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG
+ TAD EFLG
+ CLL RAL
+ CLL RAL
+ TAD W /GIVE ROOM FOR EXP FIELD (IF ANY)
+ CLL /NECESSARY?
+ DCA I (OW
+ TAD ACH
+ SNA
+ JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS
+ SMA CLA
+ JMP DSCLUP
+ JMS I (DFNEG /AC<0-NEGATE IT
+ DCA I (FFNEG / 0 <> 7777
+DSCLUP, DCA SCALE
+ TAD ACX
+ SMA SZA CLA /AC<1.0?
+ JMP DGT1 /NO
+ AC4000 /STARTE
+ JMS I (FPGO /Y-MULT BY 10.
+ FMUL10
+ STA
+ TAD SCALE /BUMP POWER OF TEN
+ JMP DSCLUP
+DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1)
+ AC4000
+ JMS I (FPGO /SAVE IT
+ FSTTMP
+ TAD (22
+ JMS I (OSCALE
+ AC4000
+ JMS I (FPGO
+ FADTMP
+ JMS I (DSCLDN
+\fSKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE
+ /INCLUDED IN THE SINGLE PREC ROUTINE
+ /MAKE NOTG ROUTINE A SUBROUTINE
+ SMA /EQUIV TO OUTNUM IN SINGLE PREC
+ JMP DASTRS
+ JMS I (OBLNKS
+ AC7775
+ ISZ I (FFNEG /IF SIGN IS NEG,
+ JMS I (DIGIT /PRINT A MINUS
+ CLA
+ TAD ACX
+ SNA /ALIGN FAC MANTISSA INTO A
+ JMS I (DAL1 /FRACTION (.1,1)
+ IAC
+ SPA
+ JMS I (DACSR
+ CLA
+ TAD EAC3
+ DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM
+ TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD
+ DCA EAC3
+ TAD EAC1
+ DCA EAC2
+ TAD ACL
+ DCA EAC1
+ TAD ACH
+ DCA ACL
+ TAD SCALE
+ SPA SNA /ANY DIGITS TO LEFT OF DEC PT?
+ JMP I (DPRZRO /N-PRINT A 0
+/JUST AS CHEAP TO DUPLICATE CODE
+ JMS I (DBLDIG /Y- PRINT THEM
+\fDRDCPT, AC7776
+ JMS I (DIGIT /PRINT A DEC PT
+ TAD SCALE
+ SMA CLA /NEED LEADING ZEROS?
+ JMP DNOLZR /NO
+ TAD SCALE
+ DCA T
+DLZERO, STA CLL
+ TAD OD /DECREASE D VALUE
+ SNL
+ JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE
+ DCA OD
+ JMS I (DIGIT /PRINT A 0
+ ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT
+ JMP DLZERO
+DNOLZR, TAD OD
+ SZA
+ JMS I (DBLDIG /PRINT REMAINING DIGITS
+DNOMAC, CLA
+ TAD EFLG
+ SZA /IF EFLG IS NOT ZERO IT IS -1,
+ JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E
+ JMP I (DNXT
+
+DASTRS, CLA
+ TAD W
+ JMS I (ASTRSK
+ JMP I (DNXT
+ PAGE
+\fDBLDIG, 0 /OUTPUT DIGITS
+ CIA
+ DCA T
+DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO
+ TAD AC1
+ DCA AC2 /START TO COPY THE FAC.THIS IS
+ TAD ACL /EAC3 SHIFTED DOWN 1 WORD
+ DCA OPL
+ TAD EAC1
+ DCA L1 /ACL
+ TAD EAC2
+ DCA DACSR /EAC1
+ TAD EAC3
+ DCA DSCLDN /EAC2
+ JMS DAL1
+ JMS DAL1
+ CLL
+ TAD AC2
+ TAD AC1
+ DCA AC1 /THIS IS FAC*5 COMING UP
+ RAL
+ TAD DSCLDN
+ TAD EAC3
+ DCA EAC3
+ RAL
+ TAD DACSR
+ TAD EAC2
+ DCA EAC2
+ RAL
+ TAD L1
+ TAD EAC1
+ DCA EAC1
+ RAL
+ TAD OPL
+ TAD ACL
+ DCA ACL
+ RAL
+ TAD ACH
+ DCA ACH
+ JMS DAL1
+ TAD ACH
+ JMS I (DIGIT
+ ISZ T
+ JMP DBDLOP
+ JMP I DBLDIG
+\fDSCLDN, 0 /USED AS A TEMP TOO
+ TAD ACX
+ SPA SNA CLA
+ JMP I DSCLDN /DONE IF FAC<1.
+ AC4000
+ JMS I (FPGO
+ FDIV10
+ ISZ SCALE
+ 0 /A FREE LOCN!
+ JMP DSCLDN+1
+
+DPRZRO, CLA
+ JMS I (DIGIT
+ JMP I (DRDCPT
+/6 WORD FAC LEFT SHIFT
+DAL1, 0
+ TAD AC1 /GET OVERFLO BIT
+ CLL RAL /SHIFT LEFT
+ DCA AC1
+ TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA
+ RAL
+ DCA EAC3
+ TAD EAC2
+ RAL
+ DCA EAC2
+ TAD EAC1
+ RAL
+ DCA EAC1
+ TAD ACL
+ RAL
+ DCA ACL
+ TAD ACH
+ RAL
+ DCA ACH
+ JMP I DAL1
+
+DFLTM2, FLDA+LONG
+ DFTMP2
+ FEXIT
+DFTMP2, 0;0;0;0;0;0
+\f/6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC
+/
+DACSR, 0 /USED AS A TEMP BY DBDLOP
+ DCA AC0 /STORE COUNT
+DLOP1, TAD ACH
+ CLL
+ SPA /PROPOGATE SIGN
+ CML
+ RAR
+ DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN
+ TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA
+ RAR
+ DCA ACL
+ TAD EAC1
+ RAR
+ DCA EAC1
+ TAD EAC2
+ RAR
+ DCA EAC2
+ TAD EAC3
+ RAR
+ DCA EAC3
+ ISZ ACX /INCREMENT EXPONENT
+ NOP
+ ISZ AC0 /DONE?
+ JMP DLOP1 /NOPE
+ RAR /YUP
+ DCA AC1 /SAVE 1 BIT OF OVERFLOW
+ JMP I DACSR
+L1, 0
+ PAGE
+\f/THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY)
+/IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES
+/ITS OWN FPP ROUTINES.
+DPIN, STA
+ DCA DDPSW /INITIALIZE DEC. PT. SWITCH
+ STA
+ DCA DINESW /AND EXPONENT SWITCH
+ TAD W
+ CMA
+ DCA FMTNUM /CHAR COUNT
+DINESM, DCA ACX /CLEAR FLOATING AC
+ DCA ACH
+ DCA ACL
+ DCA EAC1
+ DCA EAC2
+ DCA EAC3
+ STA
+DINMIN, DCA DFNEG
+DINLOP, ISZ FMTNUM
+ JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED
+DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE?
+ JMS I (DFNEG /YES-NEGATE
+ ISZ DINESW /SEEN A D YET?
+ JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER
+ TAD PFACTX /NO D- SCALE WITH P FACTOR
+DSCLIN, TAD OD /GET SCALING FACTOR
+ STL
+ SNA
+ JMP I (DNXT /NO SCALING NEEDED
+ SMA
+ CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN
+ DCA OD
+ RTL
+ RAL
+ TAD (FDIV10
+ DCA DIGFOP
+ AC4000
+ JMS I (FPGO /MULT OR DIVIDE BY 10
+DIGFOP, 0
+ ISZ OD
+ JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES
+ JMP I (DNXT /GET MORE
+DIND, ISZ DINESW /IS THERE A 2ND D?
+ JMP DINER /Y-A NO-NO
+ ISZ DDPSW /FORCE DEC. PT. SWITCH ON
+ TAD OD /USE SCALE FACTOR IF SEEN DEC. PT
+ DCA SCALE /SAVE SCALE FACTOR
+ ISZ DFNEG
+ JMS DFNEG /GET SIGN OF NUMBER
+ AC4000
+ JMS I (FPGO /SAVE IT TEMPORARILY
+ DFSTM2
+ JMP DINESM /GO COLLECT EXP
+\fDFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC???
+ TAD ACI
+ CIA
+ TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR
+ DCA OD
+ AC4000
+ JMS I (FPGO
+ DFLTM2 /GET NUMBER BACK IN FAC
+ JMP DSCLIN
+DINGCH, JMS I (FMTIN /GET A CHAR
+ JMS I (CHTYPE /CLASSIFY IT
+ 1234; DDIGIT
+ -56; DIDCPT /.
+ -53; DINLOP /+
+ -55; DINMIN /-
+ -4; DIND /D
+ -5; DIND /E - BE FORGIVING
+ -40; DINLOP /BLANK
+ -54; DINENM /,
+ 0
+DINER, JMP I (INER
+
+DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT
+ ISZ DDPSW /TEST + SET DEC PT SWITCH
+ JMP DINER /2 DEC. PT. IS NO GOOD
+ JMP DINLOP
+DDIGIT, TAD CHCH
+ DCA I (DGT+1 /SAVE DIGIT
+ AC4000
+ JMS I (FPGO
+ ACMDGT
+ TAD DDPSW
+ SNA CLA
+ ISZ OD /BUMP DIGIT IF DEC PT SEEN
+ JMP DINLOP
+DDPSW, 0
+\f/6 WORD FLOATING NEGATE
+
+DFNEG, 0
+ TAD EAC3
+ CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA
+ DCA EAC3 /STORE IT BACK
+ CML RAL /ADJUST OVERFLOW+CARRY
+ TAD EAC2 /CONTINUE WITH REST OF MANTISSA
+ CMA IAC
+ DCA EAC2
+ CML RAL
+ TAD EAC1
+ CMA IAC
+ DCA EAC1
+ CML RAL
+ TAD ACL
+ CMA IAC
+ DCA ACL
+ CML RAL
+ TAD ACH
+ CLL CMA IAC
+ DCA ACH
+ JMP I DFNEG
+DINESW, 0
+ PAGE
+\f *FPPKG /EAE PKG LOADS OVER REGULAR PKG
+
+LPBUF2, ZBLOCK 16
+ LPBUF5
+
+AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION
+ STA
+ TAD ACX
+ DCA ACX
+ JMS I (AL1
+ JMP I AL1BMP
+
+/EAE FLOATING POINT INTERPRETER
+/FOR PDP8/E WITH KE8-E EAE
+
+/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
+
+/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
+/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
+/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
+/(IN THE LOW ORDER, NATCHERLY)
+
+DDMPY, JMS I (DARGET
+ SKP
+FFMPY, JMS I (ARGET
+ JMS EMDSET /SET UP FOR MULT
+ CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ
+ OPH /THIS IS PRODUCT OF LOW ORDERS
+ MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT
+ TAD ACH /GET LOW ORDER(!) OF FAC
+ SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY
+ OPL /TO AC-WILL BE ADDED TO RESLT-THIS
+ DST /IS PRODUCT-LOW ORD FAC,HI ORD OP
+ AC0 /STORE RESULT
+ CLA
+ TAD ACL /HIGH ORDER FAC TO MQ
+ MQL
+ TAD OPX /GET OPERAND EXPONENT
+ TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS.
+ DCA ACX /STORE RESULT
+ MUY /MUL. HIGH ORDER FAC BY LOW ORD OP.
+ OPH /HIGH ORDER FAC WAS IN MQ
+ DAD /ADD IN RESULT OF SECOND MULTIPLY
+ AC0
+ DCA ACH /STORE HIGH ORDER RESULT
+ TAD ACL /GET HIGH ORDER FAC
+ SWP /SEND IT TO MQ AND LOW ORD. RESULT
+ DCA AC0 /OF ADD TO AC-STORE IT
+ RAL /ROTATE CARRY TO AC
+ DCA ACL /STORE AWAY
+ MUY /NOW DO PRODUCT OF HIGH ORDERS
+ OPL /FAC HIGH IN MQ, OP HIGH IN OPL
+ DAD /ADD IN THE ACCUMULATED #
+ ACH
+\f/MULTIPLIES DONE - MASSAGE RESULT
+
+ SNA /ZERO?
+ JMP RTZRO /YES-GO ZERO EXPONENT
+ NMI /NO-NORMALIZE (1 SHIFT AT MOST!)
+ DCA ACH /STORE HIGH ORDER RESULT
+ CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT?
+ SNA CLA
+ JMP SNCK /NO-JUST CHECK SIGN
+ TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY!
+ RAL
+ DCA AC0
+ SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON,
+ DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI)
+ CLA CMA /MUST DECREASE EXP. BY 1
+ TAD ACX
+RTZRO, DCA ACX /STORE BACK
+SNCK, TAD AC0
+ SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
+ DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
+ TAD ACH
+ SMA
+ JMP EMDONE /WE DIDN'T OVERROUND - GOODY
+ LSR
+ 1 /BUT OVERROUNDING IS EASILY CORRECTED!
+ ISZ ACX / (OVERCORRECTED??)
+ NOP
+
+/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE
+
+EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS?
+ SKP /NO
+ DCM /YES-DO IT
+ SNA
+ DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0
+ DCA ACH /STORE IT BACK
+ SWP
+ DCA ACL
+ TAD DFLG
+ SMA SZA CLA
+ TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0,
+ SNA /GO TO UNNORMALIZE RESULT
+ JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN.
+ CMA
+ JMS I (ACSR
+ JMP I FPNXT
+EMSIGN, 0
+\f/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
+
+EMDSET, 0
+ CLA CLL CMA RAL /MAKE A MINUS TWO
+ DCA EMSIGN /AND STORE IN EMSIGN.
+ DLD /GET HIGH ORDER MANTISSA OF OP.
+ OPH
+ SWP
+ SMA /NEGATIVE?
+ JMP .+3 /NO
+ DCM /YES-NEGATE IT
+ ISZ EMSIGN /BUMP SIGN COUNTER
+ SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
+ 1
+ DST /STORE BACK-OPH CONTAINS LOW ORDER
+ OPH / OPL CONTAINS HIGH ORDER
+ DLD
+ ACH
+ SWP
+ SMA /FAC LESS THAN 0?
+ JMP .+4 /NO
+ DCM
+ ISZ EMSIGN
+ NOP /EMSIGN MAY BUMP TO 0
+ DST /STORE BACK - ACH CONTAINS LOW ORDER
+ ACH / ACL CONTAINS HIGH ORDER
+ JMP I EMDSET
+ PAGE
+\f/FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE
+
+DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
+ JMS I ERR
+ TAD DBAD
+ DCA ACX /SET AC TO A LARGE POSITIVE NUMBER
+ AC2000
+ JMP I (EMDONE
+
+/FLOATING DIVIDE
+
+DDDIV, JMS I (DARGET
+ SKP
+FFDIV, JMS I (ARGET
+ JMS I (EMDSET /GET ARG. AND SET UP SIGNS
+ DVI /DIVIDE-ACH AND ACL IN AC,MQ
+ OPL /THIS IS HI (!) ORDER DIVISOR
+ DST /QUOT TO AC0,REM TO AC1
+ AC0
+ SZL CLA /DIVIDE ERROR?
+ JMP DBAD /YES - HANDLE IT
+ TAD OPX /DO EXPONENT CALCULATION
+ CMA IAC /EXP. OF FAC - EXP. OF OP
+ TAD ACX
+ DCA ACX
+ DPSZ /IS QUOT = 0?
+ SKP /NO-GO ON
+ DCA ACX /YES-ZERO EXPONENT
+DVLP, MUY /NO-THIS IS Q*OPL*2**-12
+ OPH
+ DCM /NEGATE IT
+ TAD AC1 /SEE IF GREATER THAN REMAINDER
+ SNL
+ JMP EDVOPS /YES-ADJUST FIRST DIVIDE
+ DVI /NO-DO Q*OPL*2**-12/OPH
+ OPL
+ SZL CLA /DIV ERROR?
+ JMP DBAD /YES
+EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
+ SMA /NEGATIVE?
+ JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
+ LSR /YES-MUST SHIFT IT RIGHT 1
+ 1
+ ISZ ACX /ADJUST EXPONENT
+ NOP
+ SGT /TEST SHIFTED OUT BIT
+ JMP I (EMDONE /ZERO - NO ROUND
+ DPIC /BUMP AC FRACTION
+ JMP EDVLP1+1 /MAYBE SHIFT AGAIN
+\f/CONTINUATION OF DIVIDE ROUTINE
+/WE ARE ADJUSTING THE RESULT OF THE
+/FIRST DIVIDE.
+
+EDVOPS, CMA IAC
+ DCA AC1 /ADJUST REMAINDER
+ TAD OPL /WATCH FOR OVERFLOW
+ CLL CMA IAC
+ TAD AC1
+ SNL
+ JMP EDVOP1 /DON'T ADJUST QUOT.
+ DCA AC1
+ CMA
+ TAD AC0
+ DCA AC0 /REDUCE QUOT BY 1
+EDVOP1, CLA CLL
+ TAD AC1 /GET REMAINDER
+ SNA /ZERO?
+ CAM /YES-ZERO EVERYTHING
+ DVI /NO
+ OPL
+ SZL CLA /DIV. OVERFLOW?
+ JMP DBAD /YES
+ DCM /NO-ADJUST HI QUOT (MAYBE)
+ JMP EDVLP1 /GO BACK
+
+/ROUTINE TO NORMALIZE THE FAC
+
+EFFNOR, 0
+ CDF 0
+ DLD /PICK UP MANTISSA
+ ACH
+ SWP /PUT IT IN CORRECT ORDER
+ NMI /NORMALIZE IT
+ SNA /IS THE # ZERO?
+ DCA ACX /YES-INSURE ZERO EXPONENT
+ DCA ACH /STORE HIGH ORDER BACK
+ SWP /STORE LOW ORDER BACK
+ DCA ACL
+ CLA SCA /STEP COUNTER TO AC
+ CMA IAC /NEGATE IT
+ TAD ACX /AND ADJUST EXPONENT
+ DCA ACX
+ JMP I EFFNOR /RETURN
+
+ADDRS, OPH
+ ACH
+
+LPBUF5, ZBLOCK 50
+ LPBUF7
+ PAGE
+\f/"OPNEG" MUST BE AT 0 IN PAGE
+
+OPNEG, 0 /ROUTINE TO NEGATE OPERAND
+ DLD
+ OPH
+ SWP
+ DCM
+ DCA OPH
+ MQA
+ DCA OPL
+ JMP I OPNEG
+
+/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS,
+/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-
+/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS.
+
+FFSUB, JMS I (ARGET
+ JMS OPNEG /NEGATE OPERAND
+ SKP
+FFADD, JMS I (ARGET /PICK UP ARGUMENTS
+ TAD OPH
+ SNA CLA /IF OPERAND IS 0,
+ JMP I FPNXT /RESULT IS ALREADY IN AC.
+ TAD ACH
+ SZA CLA /CHECK FOR AC=0
+ JMP BOTHN0 /NO
+ DLD
+ OPH /YES - ANSWER IS OPERAND
+ SWP
+ DCA ACH
+ JMP FADND /JUMP INTO CLEANUP CODE
+BOTHN0, TAD OPX /PICK UP EXPONENT OF OPERAND
+ MQL /SEND IT TO MQ FOR SUBTRACT
+ TAD ACX /GET EXPONENT OF FAC
+ SAM /SUBTRACT-RESULT IN AC
+ SPA /NEGATIVE RESULT?
+ CMA IAC /YES-MAKE IT POSITIVE
+ DCA CNT /STORE IT AS A SHIFT COUNT
+ TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED)
+ TAD (-27
+ SPA SNA CLA
+ CMA /NO-OK
+ DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
+ DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
+ ADDRS
+ SGT /WHICH EXP GREATER(GT FLG SET
+ /BY SUBTR. OF EXPS.)
+ SWP /OPERAND'S-SHIFT THE FAC
+ DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED
+ SWP /GET ADDRESS OF OTHER (0 TO MQ)
+ DCA DADR /THIS ONE JUST GETS ADDED
+ TAD ACX /GET FAC EXP.INTO AC
+ SGT /WHICH EXPONENT WAS GREATER?
+ DCA OPX /FAC'S-STORE FINAL EXP. IN OPX
+\f DLD /GET THE LARGER # TO AC,MQ
+DADR, 0
+ SWP /PUT IN THE RIGHT ORDER
+ ISZ AC0 /COULD EXPONENTS BE ALIGNED?
+ JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ
+ DST /YES-STORE THIS TEMPORARILY
+ AC0 /(IF ONLY FAC STORAGE WAS REVERSED)
+ DLD /GET THE SMALLER #
+SHFBG, 0
+ SWP /PUT IT IN RIGHT ORDER
+ ASR /DO THE ALIGNMENT SHIFT
+CNT, 0
+ DAD /ADD THE LARGER #
+ AC0
+ DST /STORE RESULT
+ AC0
+ SZL /OVERFLOW?(L NOT = SIGN BIT)
+ CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
+ SMA CLA
+ JMP NOOV /NOPE
+ CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
+ AND ACH
+ TAD OPH
+ SMA CLA /SIGNS ALIKE?
+ JMP OVRFLO /YES-OVERFLOW
+NOOV, AC4000 /NO-GET HIGH ORDER RESULT BACK
+ TAD AC1 /CHECK FOR 4000 0000 MANTISSA
+ DPSZ /IT WILL BE SET TO 0 BY NMI
+ JMP .+3 /OK-RESTORE NUMBER
+ AC2000 /GOT A 4000 0000-SET TO 6000 0000
+ JMP DOIT /AND INCREMENT EXPONENT
+ TAD (4000 /RESTORE NUMBER
+LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
+ DCA ACH /STORE FINAL RESULT
+ SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
+ CMA /NEGATE IT
+ADON, IAC
+FADND, TAD OPX /AND ADJUST FINAL EXPONENT
+ DCA ACX
+ SWP /GET AND STORE LOW ORDER
+ DCA ACL
+ JMP I FPNXT /RETURN
+OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
+ ASR /SHIFT IT RIGHT 1
+ 1
+DOIT, TAD (4000 /REVERSE SIGN BIT
+ DCA ACH /AND STORE
+ JMP ADON /DONE
+
+LPBUF7, ZBLOCK 34
+ LPBUFE
+ PAGE
+\f *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600
+
+CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR
+TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT"
+ TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD
+ CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION
+ RAL
+ TAD (CDF
+ DCA TDGTDF
+TDGTDF, HLT
+ TAD I TDPTR /MOVE THE TD8E ROUTINE
+ CDF 20
+ DCA I TDPTR /DOWN TO FIELD 2
+ ISZ TDPTR
+ JMP TDGTDF
+ CDF 0
+ TAD (CIF 20
+ JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2
+CTMP, CDF 0
+ TAD (6213
+ DCA I (7605
+ TAD (5267
+ DCA I (7606 /RESTORE PAGE 7600
+ AC7776
+ AND I (OSJSWD
+ IAC
+ DCA I (OSJSWD /MARK 10000-11777 AS USELESS
+ AND I 0
+ AND I 0 /DELAY A WHILE IN CASE ITS AN LA30
+ AND I 0
+ AND I 0
+ AND I 0
+ TSF
+ SKP
+ JMP WTOVR
+ ISZ ZERO
+ TAD I (TOCHR /IF TTY IS NOT IDLE,
+ SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE.
+ JMP CTMP
+WTOVR, TAD I (7777
+ CLL RAL
+ SMA CLA /IS BATCH EXECUTING?
+ JMP NOBTCH /NO - RELAX
+ TAD (212 /TO PREVENT OVERPRINTING, POP UP A LINE
+ TLS /ON THE TELETYPE
+ LLS /AND ON THE LINE PRINTER
+ TSF
+ JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE)
+ CLA
+\fNOBTCH, CDF 10
+CLOSLP, TAD I CFPTR
+ SNA /ANY MORE ENTRIES IN THE TENTATIVE
+ JMP GOAWAY /FILE TABLE?
+ DCA CTMP /YES - SAVE FILE LENGTH PTR
+ CDF 0
+ TAD I CTMP
+ CDF 10
+ SNA
+ JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED
+ DCA FLEN
+ JMS I USR
+ 10 /BRING USR IN
+ TAD (200
+ DCA USR /KEEP IT IN
+ TAD (HPLACE+1
+ DCA CHAND
+ JMS I USR
+ 13 /RESET DEVICE HANDLER TABLE
+ 0 /BUT NOT TENTATIVE FILES!
+ ISZ CFPTR
+ TAD I CFPTR /GET UNIT NUMBER
+ JMS I USR
+ 1
+CHAND, 0 /FETCH HANDLER
+ JMP CLSERR
+ TAD I CFPTR /GET UNIT AGAIN
+ ISZ CFPTR /BUMP PTR TO NAME
+ JMS I USR
+C4, 4
+CFPTR, 7600 /CLOSE THE FILE
+FLEN, 0
+ JMP CLSERR
+ SKP
+IGNORC, AC0002
+ TAD CFPTR
+ TAD C4
+ DCA CFPTR
+ JMP CLOSLP /LOOK FOR MORE
+
+TDSET, 0
+ DCA I (7721
+ TAD I (7721
+ DCA I (7727
+ TAD I (7721
+ IAC
+ DCA I (7642
+ JMP I TDSET
+\fGOAWAY, CDF CIF 0
+ JMP I (7605 /RETURN TO OS/8 AQAP
+CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"
+ 7
+ 2 /IT'S BETTER THAN HALTING
+
+TDPTR, 7600
+ZERO, 0
+USR, 7700
+ $$$-$$$-$$$
+\f
--- /dev/null
+/FORTRAN IV RUNTIME SYSTEM, V5A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/FORTRAN 4 RUNTIME SYSTEM - R.LARY
+/AND NOW WITH DOUBLE PRECISION! - MKH
+/RTS-8 SUPPORT ADDED 5/20/74 - RL
+/LAST EDITED 5/19/74
+
+XVERSN=5 /UPDATE WITH EVERY RELEASE!
+XPATCH="A /PATCH LEVEL A
+
+/NOTES TO MAINTAINERS:
+
+/THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE
+/CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL
+/BY "TAILORING" ITSELF AT INITIALIZATION TIME
+/BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES
+/THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER
+/KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS
+/LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE
+/MAKING EVEN "TRIVIAL" CHANGES.
+
+/ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE
+/HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE.
+
+/ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF
+/A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS
+/IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE
+/CAN BE FOUND IN THE TABLE "BKRLST".
+
+/ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER
+/SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY
+/A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN
+/PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES.
+
+/CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD
+/IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE
+/COMMENT SHOULD INDICATE WHAT IS GOING ON.
+/
+/
+/ FIXES FOR V4 J.K. 1975
+/
+/ .SCALE FACTOR PRINTED BY P FORMAT OPERATOR
+/ .FRTS /P
+/ .RK8E HANDLER TO RUN WITH INTERRUPTS ON
+/ .SLASH AT END OF FORMAT STATEMENT
+/
+/
+/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
+/ .CHANGED THE VERSION NUMBER TO 5A
+/ .FIXED THE FIELD OVERFLOW PROBLEM
+/ .FIXED THE "K=K+1" PROBLEM
+\f/DEFINITIONS:
+
+AC7775= STA CLL RTL
+AC7776= STA CLL RAL
+AC4000= CLA STL RAR
+AC3777= STA CLL RAR
+AC2000= CLA STL RTR
+AC0002= CLA STL RTL
+
+/DEFINITIONS OF KE-8/E INSTRUCTIONS
+
+MQL= 7421
+MQA= 7501
+CAM= CLA MQL
+SWP= MQA MQL
+SWAB= 7431
+SCA= 7441
+MUY= 7405
+DVI= 7407
+NMI= 7411
+SHL= 7413
+ASR= 7415
+LSR= 7417
+ACS= 7403
+SAM= 7457
+DAD= 7443
+DLD= 7663
+DST= 7445
+DPIC= 7573
+DCM= 7575
+DPSZ= 7451
+SGT= 6006
+
+/DEFINITIONS OF FPP IOT'S
+
+FPINT= 6551
+FPICL= 6552
+FPCOM= 6553
+FPHLT= 6554
+FPST= 6555
+FPRST= 6556
+\f/FPP OPCODES:
+
+FLDA= 0000
+FADD= 1000
+FSUB= 2000
+FDIV= 3000
+FMUL= 4000
+FADDM= 5000
+FSTA= 6000
+FMULM= 7000
+ LONG= 400 /TWO-WORD ADDRESSING
+ BASE= 200 /BASEPAGE ADDRESSING
+ IND= 600 /INDIRECT ADDRESSING
+
+FEXIT= 0000
+FNORM= 0004
+STARTF= 0005
+STARTD= 0006
+JAC= 0007
+XTA= 0030
+STARTE= 0050
+LDX= 0100
+
+JA= 1030
+JNE= 1040
+TRAP3= 3000
+
+/OS8 EQUIVALENCES:
+
+OS8SWS= 7643
+OSJSWD= 7746
+OS8DVT= 7647
+OS8DCB= 7760
+OS8DAT= 7666
+
+/VARIOUS OTHER IOT'S:
+
+LSF= 6661
+LCF= 6662
+LSE= 6663
+LIE= 6665
+LLS= 6666
+LIF= 6667
+\f/PAGE ZERO FOR FORTRAN IV RTS
+
+ *0 /INTERRUPT STUFF
+ 0
+ JMP I .+1
+ INTRPT
+LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER
+TOCHR, 0 /TELETYPE STATUS WORD
+KBDCHR, 0 /KEYBOARD INPUT CHARACTER
+POCHR, 0 /P.T. PUNCH COMPLETION FLAG
+RDRCHR, 0 /P.T. READER STATUS
+FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY
+INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE
+XR, 0
+XR1, 0
+
+*16
+VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS
+ 0 /*K* MUST BE IN AUTO - XR
+T, 0 /TEMPORARY
+DFLG, 0 /0 = F.P., 1 = D.P.
+INST, 0 /CURRENT INSTRUCTION WORD
+
+/IOH PAGE ZERO LOCATIONS
+
+RWFLAG, 0 /READ/WRITE FLAG
+FMTTYP, 0 /TYPE OF CONVERSION BEING DONE
+EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT
+N, 0 /REPEAT FACTOR
+W, 0 /FIELD WIDTH
+D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT
+
+DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD
+DATAF, 0 /CONTAINS VARIOUS CDF'S
+ JMP I DATCDF /RETURN
+
+ERR, ERROR /POINTER TO ERROR ROUTINE
+FATAL, 0 /FATAL ERROR FLAG - 0=FATAL
+MCDF, MAKCDF
+
+/FPP PARAMETER TABLE LOCATIONS:
+
+APT, 0 /VARIOUS FIELD BITS FOR FPP
+PC, DPTEST /FPP PROGRAM COUNTER
+XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS
+BASADR, 0 /FPP BASE PAGE ADDRESS
+ADR, 0 /ADDRESS TEMPORARY
+ACX, 0
+ACH, 0 /*** FLOATING ACCUMULATOR ***
+ACL, 0
+EAC1, 0
+EAC2, 0 /** FOR EXTENDED PRECISION OPTION **
+EAC3, 0
+\f/FLOATING POINT PACKAGE LOCATIONS
+
+AC0, 0
+AC1, 0 /FLOATING AC OVERFLOW WORD
+AC2, 0 /OPERAND OVFLOW WORD
+OPX, 0
+OPH, 0 /*** FLOATING OPERAND REGISTER ***
+OPL, 0
+
+/RTS I/O CONVERSION SYSTEM LOCATIONS
+
+FMTBYT, 0 /FORMAT BYTE POINTER
+IFLG, 0 /I FOEMAT FLAG
+GFLG, 0 /G FORMAT FLAG
+EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT
+OD, 0
+SCALE, 0
+PFACT, 0 /P-SCALE FACTOR
+PFACTX, 0 /TEMP FOR PFACT
+ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR
+CHCH, 0
+FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE
+CTCINH, 0 /^C INHIBIT FLAG
+LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE!
+PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN
+ 0 / SO FORMS CONTROL WILL WORK ON UNIT 0
+FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP
+
+/DSRN IMAGE
+
+HAND, 0 /HANDLER ENTRY POINT
+HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG
+BADFLD, 0 /BUFFER ADDRESS AND FIELD
+CHRPTR, 0 /ACTUALLY A WORD POINTER
+CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1
+STBLK, 0 /STARTING BLOCK OF FILE
+RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER
+TOTBLK, 0 /LENGTH OF FILE
+FFLAGS, 0 /FILE FLAGS:
+ /BIT 0 - "HAS BEEN WRITTEN" FLAG
+ /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS
+ /BIT 11 - "END-FILED" FLAG
+
+BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD
+BUFCDF, HLT
+ JMP I BUFFLD
+
+FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC
+ ONE /AND FALL INTO STORE CODE
+FGPBF, 0 /THESE THREE WORDS ARE USED
+BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS
+ FEXIT /FROM RANDOM MEMORY
+ PAGE
+\f/STARTUP CODE
+
+FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY
+ CDF CIF 10
+ JMP I .+1
+VDATE, RTSLDR /USED TO STORE OS/8 DATE
+
+/RTS ENTRY POINTS - "VERSION INDEPENDENT"
+
+VUERR, JMP I (USRERR /USER ERROR
+ /** LOADER MUST DEFINE #ARGER AS VARGER-1 **
+VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR
+VRENDO, ISZ RWFLAG /END OF I/O LIST
+VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN
+VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE
+VENDF, JMP I (ENDFL /"END FILE" ROUTINE
+VREW, JMP I (RWIND /"REWIND" ROUTINE
+VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE
+VWUO, AC4000 /UNFORMATTED WRITE
+VRUO, JMP I (RWUNF /UNFORMATTED READ
+VWDAO, AC4000 /DIRECT ACCESS WRITE
+VRDAO, JMP I (RWDACC /DIRECT ACCESS READ
+VWRITO, AC4000 /FORMATTED (ASCII) WRITE
+VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ
+VSWAP, JMP I (SWAP /OVERLAY PROCESSOR
+VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE
+V8OR12, 0;0 /0;1 IF CPU IS A PDP-12
+VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER
+ 0
+ CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY
+ JMS I .-2
+ JMP VBACKG
+
+/IOH GET VARIABLE ROUTINE.
+/THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S
+/PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER
+/ IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER
+/IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE.
+
+GETLMN, 0
+VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO?
+\f/INTERRUPT DRIVEN I/O HANDLERS
+
+LPT, 0 /RING-BUFFERED - LP08 OR LS8E
+ AND [377 /JUST IN CASE
+LPTSNA, SNA
+ JMP I (IOERR /CANNOT BE USED FOR INPUT
+YLPT, IOF
+ DCA I LPPUT
+ TAD LPGET
+ CIA
+ TAD LPPUT
+ SZA CLA /IS LPT QUIET?
+ JMP .+3 /NO
+ TAD I LPPUT
+ LLS /YES - START 'ER UP
+ CLA IAC
+ LIE /ENABLE LPT INTERRUPTS
+ TAD LPPUT /1 IN AC, REMEMBER?
+ DCA LPPUT
+ TAD I LPPUT
+ SPA
+ JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS
+ SZA CLA /ANY ROOM LEFT IN BUFFER?
+ JMS I (HANG
+ LPUHNG /WAIT FOR LINE PRINTER
+ ION /TURN INTERRUPTS BACK ON
+ JMP I LPT /RETURN
+
+LPPUT, LPBUFR
+
+PTP, 0 /PAPER TAPE PUNCH HANDLER
+YPTP, SNA
+ JMP I (IOERR /INPUT IS ERROR
+ DCA LPT /SAVE CHAR
+ IOF
+ TAD POCHR /IF PUNCH IS NOT IDLE,
+ SZA CLA /WE DISMISS JOB
+ JMS I (HANG
+ PPUHNG /WAIT FOR PUNCH INTERRUPT
+ TAD LPT
+ PLS /OUTPUT CHAR
+ DCA POCHR /SET FLAG NON-ZERO
+ ION
+ JMP I PTP
+
+/*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL
+
+ IFNZRO PPUHNG&7000 <__ERROR__>
+ IFNZRO TTUHNG&7000 <__ERROR__>
+ IFNZRO KBUHNG&7000 <__ERROR__>
+ IFNZRO RDUHNG&7000 <__ERROR__>
+ IFNZRO LPUHNG&7000 <__ERROR__>
+\f/INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER
+
+PTR, 0 /CRUDE READER HANDLER
+YPTR, SZA CLA
+ JMP I (IOERR /OUTPUT ILLEGAL TO PTR
+ IOF
+ RFC /START READER
+ JMS I (HANG
+ RDUHNG /HANG UNTIL COMPLETE
+ TAD RDRCHR /GET CHARACTER
+ ION
+ JMP I PTR /RETURN
+
+TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT
+YTTY, IOF /DELICATE CODE AHEAD
+ SNA /INPUT OR OUTPUT?
+ JMP KBD /INPUT
+ DCA LPT /OUTPUT - SAVE CHAR
+ TAD TOCHR /GET TTY STATUS
+ SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP
+ JMS I (HANG
+ TTUHNG /WAIT FOR LOG JAM TO CLEAR
+ TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY
+ CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF!
+ CLA CML RAR /COMPLEMENT OF BUSY IN SIGN
+ TAD LPT /GET CHAR
+ SPA /IF TTY NOT BUSY,
+ TLS /OUTPUT CHAR
+ DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY
+TTYRET, ION /TURN INTERRUPTS BACK ON
+ JMP I TTY /AND LEAVE
+\fKBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT?
+ SNA CLA
+ JMS I (HANG
+ KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS
+ TAD KBDCHR /GET CHARACTER
+ DCA LPT
+ DCA KBDCHR /CHEAR CHARACTER BUFFER
+ TAD LPT
+ JMP TTYRET /RETURN WITH INTERRUPTS ON
+
+KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT
+ ISZ .-1
+ JMP .-1 /WAIT FOR IT TO STOP
+ FPICL /CLEAN UP MESS HALT HAS MADE IN FPP
+BEEORC, SZL /^C OR ^B?
+ JMP I (7600 /^C - HIYO SILVER, AWAY!
+ KCC /CLEAR KBD FLAG ON ^B
+CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! **
+ PAGE
+\f/INTERRUPT SERVICE ROUTINES
+
+INTRPT, DCA INTAC
+ RAR
+ DCA INTLNK
+VINT, JMP .+4 /** MUST BE AT 403 **
+ IFNZRO VINT-403 <___ CHANGE LOADER!!!>
+ 0
+ CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE
+ JMS I .-2
+
+ FPINT /CHECK FOR FPP DONE
+ JMP LPTEST
+FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT
+
+VDISMS, JMP DISMIS /FOR USE BY USERS
+ JMP DISMIS
+ JMP DISMIS
+
+LPTEST, LSF
+ JMP NOTLPT
+LPTLCF, LCF /CLEAR FLAG
+ TAD I LPGET
+ SNA CLA /CHECK FOR SPURIOUS INTERRUPT
+JMPDIS, JMP DISMIS /GO AWAY IF SO
+ DCA I LPGET /ZERO CHAR JUST OUTPUT
+ ISZ LPGET
+ TAD I LPGET
+ SPA
+ DCA LPGET /TAKE CARE OF BUFFER LINKS
+ SNA
+ TAD I LPGET /MAKE SURE CHAR IS IN AC
+ SZA /IS THERE A CHARACTER?
+ LLS /YES - PRINT IT
+ CLA
+ LSF /CHECK FOR IMMEDIATE FLAG
+LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM
+ JMP LPTLCF /YES - LOOP
+
+NOTLPT, TSF /CHECK TTY
+ JMP NOTTTY
+ TCF /CLEAR FLAG
+ TAD TOCHR /GET TTY STATUS
+ SMA SZA /IF THERE IS A CHARACTER WAITING,
+ TLS /OUTPUT IT.
+ SMA SZA CLA /CHANGE "WAITING" TO "BUSY",
+ STL RAR /"BUSY" TO "IDLE".
+ DCA TOCHR
+TTUHNG, JMP DISMIS
+\f/KBD AND PTP INTERRUPTS
+
+NOTTTY, KSF
+ JMP NOTKBD
+ TAD [200
+ KRS /USE KRS TO FORCE PARITY BIT
+ DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8
+ TAD KBDCHR
+ TAD (-202 /CHECK FOR ^C OR ^B
+ CLL RAR
+ SNA CLA
+ JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION
+ KCC /DATA CHARACTER - CLEAR FLAG
+KBUHNG, JMP DISMIS
+
+CTCCTB, TAD CTCINH
+ SNA CLA /ARE WE IN A HANDLER?
+ JMP NOTINH /NO
+ TAD INTLNK
+ CLL RAL /YES - RETURN WITH INTERRUPTS OFF
+ TAD INTAC /TRUST IN GOD AND RTS
+ RMF
+ JMP I 0
+
+NOTKBD, PSF
+ JMP NOTPTP
+ PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG
+ DCA POCHR /CLEAR SOFTWARE FLAG
+PPUHNG, JMP DISMIS
+
+NOTPTP, RSF
+ JMP LPTERR
+ TAD [200
+ RRB /GET RDR CHAR
+ DCA RDRCHR
+RDUHNG, JMP DISMIS
+
+LPTERR, LSE /TEST FOR LP08 ERROR FLAG
+ SKP
+ LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON
+DISMIS, TAD INTLNK
+ CLL RAL
+ TAD INTAC /RESTORE AC AND LINK
+ RMF
+ ION
+ JMP I 0 /RETURN FROM THE INTERRUPT
+
+INTAC, 0
+INTLNK, 0
+\f/BACKGROUND INITIATE/TERMINATE ROUTINE
+
+HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF!
+ TAD I HANG /GET POINTER TO UNHANGING LOCATION
+ DCA UNHANG
+ RDF /GET FIELD CALLED FROM
+ TAD HCIDF0
+ DCA HNGCDF /SAVE FOR RETURN
+HCIDF0, CDF CIF 0
+ TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC
+ DCA I UNHANG /TO A "JMP RESTRT"
+ TAD BACKLK
+ CLL RAL
+ TAD BACKAC /SET UP BACKGROUND AC AND LINK
+BAKCIF, CIF 0
+BAKCDF, CDF 0
+ ION
+ JMP I BACKPC /INITIATE BACKGROUND
+
+/ COME HERE WHEN THE HANG CONDITION HAS GONE AWAY
+
+RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION
+ DCA I UNHANG
+ TAD INTAC /SUSPEND THE BACKGROUND
+ DCA BACKAC
+ TAD INTLNK
+ DCA BACKLK
+ TAD 0
+ DCA BACKPC
+ RIB
+ AND [70
+ TAD HCIDF0
+ DCA BAKCIF
+ RIB
+ JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF
+ DCA BAKCDF
+ ISZ HANG
+HNGCDF, HLT
+ JMP I HANG /INTERRUPTS ARE OFF - RETURN
+
+NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT
+ DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE!
+ JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR
+
+UNHANG, 0
+BACKAC, 0
+BACKLK, 0
+BACKPC, VBACKG
+VHANG= HANG
+ IFNZRO VHANG-0524 <__ CHANGE LOADER!>
+ PAGE
+\f/I-O CONVERSION ROUTINES - STARTUP CODE
+
+RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)"
+ 2000 /"FORMATTED" BIT
+ JMS I [FETPC /GET ADDRESS OF FORMAT STMT
+ DCA FMTDF
+ JMS I [FETPC
+ DCA FMTADR
+ DCA FMTTYP
+ DCA PFACT /CLEAR SCALE FACTOR
+ JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE
+
+ TAD (FMTPDL-1
+FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER
+ TAD I FMTPXR
+ DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0)
+\f/MAIN FORMAT DECODING LOOP
+
+FMTFLP, TAD FMTBYT
+ DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK
+FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER
+FMTCLP, JMS FMTGCH /GET A CHARACTER
+ ISZ FMTBYT /BUMP BYTE POINTER
+ JMS I [CHTYPE /CLASSIFY CHAR
+ 1234; FMTDIG /DIGIT
+ -42; DBLQOT /"
+ -44; ABORTO /$
+ -55; FMINUS /-
+ -56; FMTPER /.
+ -57; SLASH //
+ -54; COMMA /,
+ -50; LPAREN /(
+ -51; RPAREN /)
+ -47; KWOTE /'
+ -40; FMTCLP /SPACE
+ 0 /ANYTHING ELSE
+
+ TAD FMTTYP
+ SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING
+ JMP I (FMTERR /IF WE DO - ERROR
+ TAD CHCH /GET FIELD CHARACTER
+ DCA FMTTYP
+ TAD FMTNUM
+ SNA /IF REPEAT COUNT WAS MISSING OR ZERO
+ IAC /MAKE IT ONE
+ CMA
+ DCA N /STORE -(REPEAT COUNT +1)
+ DCA W /CLEAR WIDTH INITIALLY
+ ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS
+ TAD FMTTYP
+ AND [7 /IS THE CHARACTER P, X, OR H?
+ SNA CLA /IF SO, DON'T WAIT
+COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION
+ JMP FMTFLP /BACK FOR MORE
+
+FMTADR, 0 /ADDRESS OF FORMAT
+\fFMTGCH, 0 /GET CHARACTER FROM FORMAT
+ JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH
+ CDF 0
+ JMS I (FMTGLR /EXTRACT CHARACTER
+ JMP I FMTGCH
+
+FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET
+ TAD FMTBYT /GET OFFSET
+ CLL RAR
+ CLL
+ TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2]
+ DCA D
+ RAL
+ TAD FMTDF
+ JMS I MCDF /SET UP PROPER DATA FIELD
+ DCA .+1
+ HLT
+ TAD FMTBYT
+ RAR
+ CLA /LEAVE L/R SWITCH IN LINK
+ TAD I D
+ JMP I FMTGAD /RETURN WITH WORD IN AC
+
+FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11
+
+FMTDIG, TAD FMTNUM /DIGIT PROCESSOR
+ CLL RTL
+ TAD FMTNUM
+ CLL RAL /MULTIPLY FMTNUM BY 10
+ TAD CHCH /ADD IN THE DIGIT
+ JMP FMTDLP /STORE IT BACK AND CONTINUE
+\f/PARENTHESIS AND DIGIT ROUTINES
+
+LPAREN, TAD FMTPXR
+ TAD (2-FMTPDL
+ SZA /ARE WE AT PARENTHESIS LEVEL 1?
+ JMP .+3 /NO
+ TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE
+ DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN
+ /AS THE LOOP POINTER FOR LEVEL 1
+ TAD [7
+ SPA CLA /PUSHDOWN OVERFLOW?
+FPOERR, JMS I ERR /YES
+ AC7775
+ TAD FMTPXR
+ DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER
+ TAD FMTBYT
+ DCA I FMTPXR /SAVE BYTE POINTER
+ TAD FMTNUM
+ SNA
+ IAC /NO GROUP COUNT MEANS COUNT = 1
+ CIA
+ DCA I FMTPXR /SAVE LOOP COUNT
+ DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE!
+RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO
+ TAD FMTPXR /BACK UP FORMAT PDL POINTER
+ JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST
+
+FMPBYT, 0
+
+RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY
+ TAD FMTPXR
+ TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN?
+ SNA CLA
+ JMS I [ENDREC /YES - CHECK FOR END OF FORMAT
+ ISZ I FMTPXR /BUMP COUNT
+ JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER (
+ ISZ FMTPXR /POP UP PARENTHESES STACK
+ JMP FMTFLP /CONTINUE PAST RIGHT PAREN
+ PAGE
+\f/QUOTE AND HOLLERITH FORMAT PROCESSORS
+
+KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR
+DBLQOT, TAD (-42 /QUOTE PROCESSOR
+ DCA KWODEL /SAVE TERMINATOR
+ JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY
+ SKP
+KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER
+ JMS I [FMTGCH /GET THE NEXT FORMAT CHAR
+ TAD KWODEL
+ SZA CLA /IS IT THE TERMINATOR?
+ JMP KWOTLP /NO - PROCESS IT AND CONTINUE
+ ISZ FMTBYT /BUMP OVER TERMINATOR
+ JMS I [FMTGCH
+ TAD KWODEL
+ SNA CLA /IS THIS ANOTHER TERMINATOR?
+ JMP KWOTLP /TWO TERMINATORS PRINT AS ONE
+ JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP
+
+HFMT, JMS MORE /MORE CHARACTERS?
+ JMS FMTHCV /YES - PROCESS ONE
+ JMP HFMT /AND LOOP
+
+FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS
+ TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT
+H7700, SMA CLA /IN OR OUT?
+ JMP FMTHIN /IN
+ JMS I [FMTGCH /OUT - GET THE CHAR
+ JMS I [FMTOUT /PRINT IT
+ JMP FMTHCR /RETURN
+FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE
+ DCA W /SAVE IT
+ JMS I (FMTGAD
+ SZL /WHICH SIDE?
+ JMP FHRGHT /RIGHT SIDE
+ AND [77 /LEFT - KEEP RIGHT CHAR
+ DCA MORE
+ TAD W
+ CLL RTL
+ RTL
+ RTL
+ TAD MORE /ADD NEW CHAR IN ON THE LEFT
+ JMP .+3
+FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT
+ TAD W /ADD NEW CHAR IN ON THE RIGHT
+ DCA I D /RESTORE ALTERED WORD
+ CDF 0
+FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER
+ JMP I FMTHCV
+
+KWODEL, 0 /MUST BE UNIQUE!
+\fMORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO
+ ISZ N
+ JMP I MORE
+DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED
+ JMP I DOFMT /RETURN FROM "DOFMT"
+
+DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION
+ TAD FMTNUM /GET THE CURRENT NUMBER
+ DCA D /STORE IT AS DECIMAL POINT SPEC
+ DCA IFLG
+ DCA EFLG
+ DCA GFLG /ZERO CONVERSION FLAGS
+ TAD FMTTYP
+ SNA CLA /ANY SPECIFICATION WAITING?
+ JMP I DOFMT /NO - JUST RETURN
+ TAD W
+ TAD D /IF THERE WAS NO W OR D SPECIFICATION,
+ SNA CLA
+ JMP FMTERR /ITS AN ERROR
+ TAD FMTTYP
+ JMS I [CHTYPE /YES - WHICH ONE?
+ -30; XFMT /X
+ -24; TFMT /T
+ -20; PFMT /P
+ -14; LFMT /L
+ -11; IFMT /I
+ -10; HFMT /H
+ -7; GFMT /G
+ -6; FFMT /F
+MINUS5, -5; EFMT /E
+ -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP
+ -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP
+ -1; AFMT /A
+ 0 /NONE OF THE ABOVE - ERROR
+FMTERR, JMS I ERR
+\fENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O
+ JMS I [EOLINE
+ CLA IAC
+ AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG
+ SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST
+ JMP I ENDREC
+ JMP I [ENDIO /NOW FINISH UP AND LEAVE
+
+SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY
+ JMS I [EOLINE /TERMINATE CURRENT LINE
+ JMP I (FMTFLP
+
+PFMT, CLA CMA
+ TAD FMTNUM
+ ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE
+ CIA
+ DCA PFACT
+ STA /FALL INTO CODE TO CLEAR MINFLG
+ DCA MINFLG /SET FLAG ON MINUS
+ JMP DOFRTN
+
+FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC
+ DCA MINFLG /CLEAR MINUS FLAG
+ JMP I (FMTFLP
+
+MINFLG, -1
+
+FMTPER, TAD FMTNUM /PERIOD PROCESSOR
+ DCA W /STORE WIDTH
+ JMP I (FMTFLP
+
+ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS
+ DCA EOLSW /FAKE BEGINNING OF LINE
+ DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT
+ JMP I [ENDIO /GO AWAY
+ PAGE
+\fCHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS
+ DCA CHCH /SAVE CHAR
+ JMP CHLOOP+1
+CDIGIT, TAD CHCH /CHECK FOR DIGIT
+ TAD (-72
+ CLL
+ TAD [12
+ SZL /IS CHAR A DIGIT?
+ JMP JMPOUT /YES
+CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS
+ CLA
+ TAD I CHTYPE
+ ISZ CHTYPE
+ SMA /END OF LIST?
+ JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC
+ TAD CHCH
+ SZA CLA /DOES CHAR MATCH CHAR ON LIST?
+ JMP CHLOOP /NO - KEEP LOOKING
+JMPOUT, DCA CHCH /ZERO CHAR
+ TAD I CHTYPE
+ DCA CHTYPE /SET UP TO RETURN INDIRECTLY
+JMPOTX, SZA CLA /IS THIS THE END?
+ JMP CDIGIT /NO - GO CHECK FOR DIGIT
+ JMP I CHTYPE /GO TO SPECIFIED ADDRESS
+
+
+SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS
+ JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED
+ TAD RWFLAG
+ CLL RAR
+ SZA CLA /IF OUTPUT,
+ ISZ SKPOUT /SKIP RETURN
+ SZL CLA /IF END OF I/O LIST,
+ JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY
+ JMP I SKPOUT
+\f/A FORMAT PROCESSOR
+
+AINPUT, TAD (4040
+ DCA ACH
+ TAD (4040
+ DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS
+AINPTL, JMS GADR
+ SZL /LEFT OR RIGHT?
+ JMP AINPTR /RIGHT
+ JMS I [FMTIN
+ STL RTL /INPUT CHAR GOES IN HIGH-ORDER
+ RTL /WITH BLANK IN LOW-ORDER
+ RTL
+ JMP AINPTC
+AINPTR, JMS I [FMTIN
+ TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF
+ TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE
+AINPTC, DCA I FMTGLR /STORE WORD
+ ISZ W
+ JMP AINPTL /LOOP AROUND WIDTH
+ANXT, JMS I [GETLMN /GET NEXT ELEMENT
+AFMT, TAD D
+ CIA
+ DCA W /SAVE FIELD WODTH AS A COUNT
+ JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR
+ JMP AINPUT
+AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE
+ TAD I FMTGLR
+ JMS FMTGLR /GET BYTE
+ JMS I [FMTOUT /PRINT IT
+ ISZ W
+ JMP AOTPUT /LOOP ON WIDTH
+ JMP ANXT
+
+FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD
+ SZL
+ JMP .+4 /RIGHT HALF
+ RTR
+ RTR
+ RTR /LEFT HALF - ROTATE INTO RIGHT HALF
+ AND [77
+ JMP I FMTGLR
+
+GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR
+ TAD D
+ TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1
+ CLL RAR
+ TAD (ACX
+ DCA FMTGLR
+ JMP I GADR /LEAVE WITH L/R FLAG IN LINK
+\f/"STOP" ROUTINE - TERMINATES JOB
+
+CALXIT, TAD EXDVNO
+ CIA
+ DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS.
+ DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE
+ JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED
+ SNA CLA /AND HAS NOT BEEN ENDFILED,
+ JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT
+ CLA IAC /IS A FORMATTED OUTPUT FILE) AND
+ AND FFLAGS /END-FILE IT
+ SNA CLA
+ JMS I (ENDFL
+XITISZ, ISZ EXDVNO
+ JMP CALXIT
+LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO
+ TAD TOCHR /GO QUIET.
+ SZA CLA
+ JMP LPTTWT
+ ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES
+PDPXIT, IOF /ENTER HERE FROM 7605
+ CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S
+ JMS I (7607
+ 0210
+ 7400 /READ IN CLEANUP ROUTINE
+ 37 /AND OS/8 PAGE 17600
+ JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO!
+ CDF CIF 10
+ JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT
+CLNADR, CLNUP
+EXDVNO, -11
+
+ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG
+ JMS I [FETPC
+ AND [7 /THROW AWAY OPCODE (JA)
+ TAD FLDTM2
+ DCA FGPBF
+ JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION
+ DCA BIOPTR
+ JMS I [FPGO
+ FGPBF
+ JMP I ARGLD
+
+FLDTM2, FLDA+LONG
+ FTEMP2
+ FEXIT
+ PAGE
+\f/SUBROUTINE TO OPEN A UNIT FOR I/O
+
+RWINIT, 0
+ DCA RWFLAG /DIRECTION IN AC ON ENTRY
+ AC7776
+ AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE
+ SZA CLA /UNIT NUMBER IS IN FAC
+ JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER
+ JMS I [FFIX
+ TAD ACI
+ CLL CMA
+ TAD [12
+ SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9
+ JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0
+ SNA CLA /IS UNIT INITIALIZED?
+UNTERR, JMS I ERR /NO - ERROR
+ TAD RWFLAG
+ SPA /IF WE ARE WRITEING FOR THE FIRST TIME
+ TAD FFLAGS /ON A UNIT WHICH WAS BEING READ,
+ CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN
+ SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE
+ JMS I (RD2WR /BETWEEN READ AND WRITE
+ TAD I RWINIT
+ TAD RWFLAG /OR THE I/O TYPE AND
+ CMA
+ AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD
+ TAD I RWINIT
+ TAD RWFLAG
+ DCA FFLAGS
+ TAD FFLAGS
+ CMA RTL
+ SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN
+ JMP UNTERR /FORMATTED AND UNFORMATTED MODES
+ ISZ RWINIT
+ TAD ACI
+ CLL RAL
+ TAD ACI
+ TAD (DATABL-4
+ DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE
+ JMP I RWINIT
+\f/REWIND AND END FILE
+
+RWIND, JMS RWINIT /GET THE DSRN ENTRY
+ 0 /DON'T PLAY WITH MODES
+ AC2000
+ TAD FFLAGS
+ SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D
+ JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR
+ATLDMK, CLA IAC
+ AND FFLAGS /KILL ALL FLAG BITS
+ DCA FFLAGS /EXCEPT "END-FILED" BIT
+ TAD BADFLD
+ AND [7400
+ DCA CHRPTR
+ AC7775
+ DCA CHRCTR /INITIALIZE BUFFER POINTERS
+ DCA RELBLK /AND RELATIVE BLOCK #
+ JMP I [ENDIO /RESTORE DSRN AND EXIT
+
+ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT
+ 1 /GET DSRN, SET "END FILE" FLAG
+ TAD FFLAGS /IF THE FILE IS UNFORMATTED,
+ CMA RAL /OR WAS NOT OUTPUT ONTO,
+ SNL SMA CLA /THEN ENDFILE DOES NOTHING.
+ JMS DMPBUF /ELSE DUMP THE FINAL BUFFER
+ AC3777
+ AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY
+SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE
+ TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE,
+ DCA TOTBLK /AND SO WE WON'T READ PAST EOF.
+ENDIO, JMS INITMV /SET UP DSRN POINTERS
+ TAD I XR1
+ DCA I XR /STORE BACK THE DSRN ENTRY
+ ISZ T /FOR THIS LOGICAL UNIT
+ JMP .-3
+ DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ
+ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM
+ JMP I ENDFL /*K* OR RETURN TO CALXIT
+
+INITMV, 0 /ROUTINE TO SET UP STUFF
+ICDF0, CDF 0
+ TAD LOGUNT
+ DCA XR
+ TAD (HAND-1
+ DCA XR1
+ TAD (-11
+ DCA T
+ JMP I INITMV
+\f/ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END
+
+DMPBUF, 0
+ ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF
+ TAD (7712 /OUTPUT A LINE FEED
+ JMS I [FMTOUT
+ TAD HAND /IF THE FILE IS BEING OUTPUT VIA
+ SMA CLA /AN OS/8 HANDLER,
+ JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY.
+ TAD (32
+CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES.
+ JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS
+ TAD CHRPTR
+ AND [377
+ TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO
+ IAC /A BLOCK BOUNDARY AND CHRCTR = -3
+Z7700, SMA CLA /WE ARE THEN AT BUFFER-END
+ JMP CTZLP
+CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE
+ JMP I DMPBUF /RETURN
+
+/ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0
+
+LDDSRN, 0
+ TAD ACI / READ/WRITE INIT SINGS THIS SONG,
+ CLL RTL / (DOO DAH, DOO DAH,)
+ RAL / DSRN ENTRIES 9 WORDS LONG
+ TAD ACI / (OH, DEE DOO DAH DAY).
+
+ SNA /DEVICE NUMBER 0 IS SPECIAL -
+ TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE
+ TAD (DSRN-12
+ DCA LOGUNT
+ JMS INITMV /SET UP FOR MOVE
+ TAD I XR
+ DCA I XR1 /PUT DSRN ENTRY IN PAGE 0
+ ISZ T
+ JMP .-3
+ TAD BADFLD
+ AND [70
+ TAD ICDF0
+ DCA BUFCDF /SAVE BUFFER FIELD AS A CDF
+ TAD HAND
+ JMP I LDDSRN
+ PAGE
+\f/BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES
+
+BKSPC, JMS I [RWINIT
+ 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE
+ TAD HAND
+ SMA CLA
+ JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED
+ AC2000
+ AND FFLAGS
+ SZA CLA /IS FILE FORMATTED?
+ JMP BKASCI /YES - PAIN IN NECK
+ JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK
+ TAD CHRPTR
+ TAD [377
+ DCA T
+ JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER
+ TAD I T /LOOK AT LAST WORD IN BUFFER
+ CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD
+ TAD RELBLK
+ DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC
+ JMP I [ENDIO
+
+BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ
+ CMA CLL /AC MAY NOT BE 0 ON ENTRY
+ TAD RELBLK
+ DCA RELBLK /BUMP BLOCK BACK
+ SNL
+ JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS
+ DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO
+ JMS I [MASSIO /READ A BLOCK
+ JMP I BMPBLK
+
+/**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE ****
+
+NULLJB, TAD N2525
+NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN"
+ JMP NULLLP /IN THE AC LIGHTS
+ ISZ NUMISZ
+ JMP NULLLP
+ CML CMA RAR
+ DCA N2525
+ TAD [-4
+ DCA NUMISZ
+ JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO?
+N2525, 2525
+NUMISZ, -4
+\f/BACKSPACE FOR FORMATTED FILES
+
+BKLORD, TAD I CHRPTR
+ ISZ CHRPTR
+ NOP
+ AND [177 /GET 7 BITS
+ TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED
+ SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS
+ JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!)
+BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE
+ SKP /CHARACTER POINTER BACK TWO PLACES
+ JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE
+ TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD
+ AND [7400 /BE A CARRIAGE RETURN).
+ CIA
+ TAD CHRPTR
+ CLL RAR
+ SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER
+ JMP BKNORD /NO
+ TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD
+ DCA GETCH3
+ DCA CHRPTR
+ AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE,
+ TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE
+ SPA /CURRENT BUFFER BY WRITING IT OUT.
+ JMP .+4
+ DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE
+ AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT)
+ JMS I [MASSIO
+ CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN,
+ JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE
+ TAD GETCH3 /BEFORE THAT.
+ DCA CHRCTR
+ TAD CHRCTR
+ TAD (401
+ SKP /COMPUTE WORD POINTER FROM CHAR POINTER
+BKNORD, STA
+ TAD CHRPTR
+ DCA CHRPTR /BUMP WD PTR BACK 1
+BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT
+ JMP BKLORD /LIKE THE INPUT ROUTINE
+ JMS GETCH3
+ JMP BKLORD+1
+\fGETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT
+ TAD I CHRPTR
+ AND [7400
+ DCA BMPBLK /HANDY TEMPORARY
+ ISZ CHRPTR
+ TAD I CHRPTR
+ AND [7400
+ CLL RTR
+ RTR /COMBINE TWO 4-BIT QUANTITIES
+ TAD BMPBLK /INTO A CHARACTER
+ CLL RTR
+ RTR
+ JMP I GETCH3
+
+DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE
+ PAGE
+\f/I,E,F,AND G FORMAT CONVERSIONS
+
+IFMT, TAD D
+ DCA W /SET WIDTH PROPERLY
+ DCA D /FOR SCALING PURPOSES
+ STA
+ DCA IFLG
+ JMP FFMT
+
+GFMT, STA
+ DCA GFLG /SET G AND E FLAGS
+
+EFMT, STA
+ DCA EFLG /SET E FLAG
+ JMP FFMT
+
+IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME
+FFMT, TAD D
+ DCA OD /SAVE COUNT OF POST-D.P. DIGITS
+ TAD IFLG
+ SNA CLA /APPLY THE P-SCALE FACTOR
+ TAD PFACT /ONLY IF THE FORMAT IS NOT I
+ DCA PFACTX
+ DCA SCALE /DON'T LOOK FOR TROUBLE
+ JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION
+ JMP I (IGEFIN /INPUT
+ STA
+ DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG
+ TAD EFLG
+ CLL RAL
+ CLL RAL /0 IF NOT E, -4 IF E
+ TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT)
+ DCA OW /OR THE 4 TRAILING SPACES (IF G FMT)
+ TAD ACH
+ SNA
+ JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT
+ SPA CLA
+ JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER)
+SCALUP, DCA SCALE
+ TAD ACX
+ SMA SZA CLA /AC<1.0?
+ JMP GT1 /NO
+ JMS I [FPGO /YES - MULTIPLY BY 10.0
+ FMUL10
+ STA
+ TAD SCALE /BUMP POWER OF TEN
+ JMP SCALUP
+\f/I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0
+
+GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1)
+ JMS I [FPGO /SAVE IT AWAY
+ FSTTMP
+ TAD [7
+ JMS OSCALE
+ JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT
+ FADTMP
+ JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000...
+SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0
+ SNA CLA
+ JMP NOTG /NOT G FORMAT
+ TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE
+ TAD PFACTX
+ CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE))
+ TAD OD
+ SNL
+ JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET)
+ DCA OD /REDUCE D VALUE BY SCALE FACTOR
+ DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS
+USEE, CLA
+ JMP NOTG
+
+/SET UP TO PRINT DIGITS
+
+
+DIGCNT, 0
+ TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT
+ CIA
+ TAD SCALE
+ DCA FMTNUM
+ TAD EFLG
+ SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P.
+ TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT
+ TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G
+ DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P.
+ TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1
+ SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON
+ ISZ OW /THIS LOCATION BEING BELOW 4000.
+ TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #)
+ SPA SNA
+ CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1
+ TAD OD /REDUCE THE WIDTH BY THIS NUMBER
+ CMA
+ TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT
+ CIA
+ TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT)
+ JMP I DIGCNT
+OW, 0
+\f/I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR
+
+OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES
+ DCA NPLCS /MAX IN AC ON ENTRY
+ DCA ACX
+ AC2000 /FORM A FLOATING 0.5 IN ORDER
+ DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING.
+ DCA ACL
+ TAD EFLG /FIGURE OUT HOW TO SCALE IT -
+ SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED
+ TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT
+ DCA T /PRINTING DIGITS. THIS CAN BE
+ TAD SCALE /EXPRESSED AS:
+ CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F))
+ TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE).
+ SZL CLA /THE SCALE FACTOR IS < 0 FOR
+ TAD GFLG /NUMBERS < .1, WHICH REDUCES
+ SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS.
+ TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS
+ TAD T /IT DOESN'T MATTER WHAT WE DO
+ TAD OD /SINCE THE NUMBER WILL PRINT AS
+ SMA /0.00000 ANYWAY.
+ CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS
+ TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE
+ SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD
+ DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL
+ CIA /FOR NUMBERS OF UP TO NPLCS+2
+ TAD NPLCS /SIGNIFICANT DIGITS.
+ CIA
+ DCA T
+ JMP .+3
+FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES
+ FDIV10
+ ISZ T
+ JMP FDIVLP
+ JMP I OSCALE
+NPLCS, 0
+ONE, 1;2000;0
+ PAGE
+\f/I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION
+
+OUTNUM, SMA /CHECK FOR FIELD OVERFLOW
+ JMP ASTSK1 /YES - PRINT *******
+ JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0!
+ /***IMPORTANT - OBLNKS CLEARS AC1 ***
+ AC7775
+ ISZ I [FFNEG /IF SIGN IS NEGATIVE,
+ JMS DIGIT /OUTPUT A MINUS SIGN
+ CLA /OTHERWISE OUTPUT NOTHING
+ TAD ACX
+ SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD
+ JMS I [AL1 /FRACTION IN THE RANGE [.1,1)
+ IAC /THIS INVOLVES SHIFTING THE MANTISSA
+ CMA /RIGHT BY (-ACX-1) PLACES
+ SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT.
+ JMS I [ACSR
+ CLA
+ TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT
+ DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS
+ TAD ACH /IN THE HIGH-ORDER WORD
+ DCA ACL
+ TAD SCALE
+ SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.?
+ JMP PRZERO /NO - PRINT A ZERO THERE
+ JMS DIGITS /YES - PRINT THEM
+PRDCPT, TAD IFLG
+ SZA CLA
+ JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW
+ AC7776
+ JMS DIGIT /OTHERWISE PRINT DECIMAL POINT
+ TAD SCALE
+ SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS
+ JMP NOLZRO /NO
+ TAD SCALE
+ DCA T
+LZLOOP, STA CLL
+ TAD OD /BUMP D VALUE DOWN BY ONE
+ SNL /IF IT GOES NEGATIVE,
+ JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH
+ DCA OD
+ JMS DIGIT /PRINT A ZERO
+ ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT
+ JMP LZLOOP
+NOLZRO, TAD OD
+ SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED,
+ JMS DIGITS /PRINT THEM
+\f/I,G,E,F OUTPUT CONVERSION - FINISH UP
+
+NOMOAC, CLA
+ TAD EFLG
+ SNA CLA /E FORMAT?
+ JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F
+ JMS EXPFLD
+ JMP I (IGEF
+EXPFLD, 0
+ TAD (5
+ JMS I [FMTOUT /OUTPUT "E"
+ TAD FMTNUM /GET EXPONENT
+ CLL
+ SPA
+ CML CIA /SEPARATE INTO MAGNITUDE AND SIGN
+ DCA FMTNUM /SAVE MAGNITUDE
+ RTL
+ TAD (-5 /PRINT + OR -
+ JMS DIGIT
+ DCA T /INITIALIZE QUOTIENT OF DIVISION
+DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT
+ TAD [-12
+ SPA /DID IT GO NEGATIVE?
+ JMP PRNTXP /YES - DONE
+ DCA FMTNUM /NO - STORE IT BACK
+ ISZ T /BUMP QUOTIENT
+ JMP DVELP /LOOP
+PRNTXP, CLA
+ TAD T
+ TAD [-12
+ SMA CLA
+ JMP ASTSK3
+ TAD T
+ JMS DIGIT
+ TAD FMTNUM
+ JMS DIGIT /PRINT TWO DIGITS OF EXPONENT
+ JMP I EXPFLD
+
+CHKG, TAD GFLG
+ SNA /WAS IT G FORMAT?
+ JMP I (IGEF /NO - F OR I - DONE
+ DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE
+ TAD (-5
+ JMS OBLNKS /OUTPUT 4 BLANKS
+ JMP I (IGEF /DONE WITH G FORMAT OUTPUT
+
+PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P.
+ JMS DIGIT /PRINT A ZERO
+ JMP PRDCPT /CONTINUE
+
+ASTSK3, AC0002
+ JMP .+3
+ASTSK1, CLA /CLEAR THE AC
+ TAD W /GET THE FIELD WIDTH
+ JMS I [ASTRSK
+ JMP I (IGEF
+\f/I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES
+
+OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS
+ DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT
+ JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON
+ TAD [40
+ JMS I [FMTOUT /OUTPUT A BLANK
+ ISZ AC1
+ JMP .-3 /LOOP
+ JMP I OBLNKS /RETURN
+
+DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS
+ CIA
+ DCA T
+DGLOOP, TAD AC1
+ DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON
+ TAD ACL
+ DCA OPL
+ DCA ACH /CLEAR "OVERFLOW WORD"
+ JMS I [AL1
+ JMS I [AL1 /FAC=FAC*4
+ DCA OPH
+ JMS I [OADD
+ JMS I [AL1 /FAC=ORIGINAL FAC*10
+ TAD ACH /GET OVERFLOW
+ JMS DIGIT /PRINT IT
+ ISZ T /LOOP FOR SPECIFIED NUMBER
+ JMP DGLOOP
+ JMP I DIGITS /RETURN
+
+DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT
+ TAD [60
+ JMS I [FMTOUT /TRIVIAL, ISN'T IT?
+ JMP I DIGIT
+ PAGE
+\f/I,G,E,F INPUT CONVERSION
+
+IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT
+ DCA DPSW /INITIALIZE D.P. SW
+ STA
+ DCA INESW /DITTO EXPONENT SWITCH
+ TAD W
+ CMA
+ DCA FMTNUM /GET CHAR COUNT
+INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E"
+ DCA ACH /CLEAR FLOATING AC
+ DCA ACL
+ STA
+ JMP INMINS /SET SIGN PLUS
+
+INGCH, JMS I [FMTIN /GET A CHAR
+ JMS I [CHTYPE /CLASSIFY IT
+ 1234; IDIGIT /DIGIT
+ -56; INDCPT /.
+ -53; INLOOP /+
+ -55; INMINS /-
+ -5; INE /E
+ -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD
+ -54; INEONM /,
+ 0 /OTHER - ERROR
+INER, JMS I ERR
+
+INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P.
+ ISZ DPSW /TEST AND SET D.P. SWITCH
+ JMP INER /WHOOPS - TWO D.P.S IN A NUMBER
+ JMP INLOOP /KEEP GOING
+
+IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER
+ SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING
+ JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION.
+
+IDIGIT, TAD CHCH
+ DCA DGT+1 /SAVE THE DIGIT
+ JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC
+ ACMDGT
+ TAD DPSW
+ SNA CLA
+ ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN
+ JMP INLOOP
+\fINMINS, DCA I [FFNEG /SET SIGN NEGATIVE
+
+INLOOP, ISZ FMTNUM
+ JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED
+INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE
+ JMS I [FFNEG /YES - NEGATE
+ ISZ INESW /SEE IF "E" SEEN
+ JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER
+ TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR
+
+SCALIN, TAD OD /GET SCALING FACTOR
+ STL
+ SNA
+ JMP I (IGEF /NO SCALING NECESSARY
+ SMA
+ CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN
+ DCA OD
+ RTL
+ RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY
+ TAD (FDIV10
+ DCA IGEFOP
+ JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0
+IGEFOP, 0
+ ISZ OD
+ JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES
+ JMP I (IGEF /RETURN FOR MORE
+
+INE, ISZ INESW /SEE IF THIS IS THE SECOND "E"
+ JMP INER /YES - ERROR
+ ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E)
+ TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN
+ DCA SCALE /SAVE SCALE FACTOR
+ ISZ I [FFNEG
+ JMS I [FFNEG /GET SIGN OF NUMBER CORRECT
+ JMS I [FPGO /SAVE IT TEMPORARILY
+ FSTTM2
+ JMP INERSM /GO COLLECT EXPONENT
+
+FIXUPE, JMS I [FFIX
+ TAD ACI /GET EXPONENT
+ CIA
+ TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR
+ DCA OD
+ JMS I [FPGO /GET NUMBER BACK IN FAC
+ FLDTM2
+ JMP SCALIN
+
+DPSW, 0
+DGT, 13;0;0;0;0;0
+NOTG, JMS I (DIGCNT
+ DCA SCALDN
+ TAD IFLG
+ SNA CLA
+ JMP NOTI
+ TAD SCALE
+ TAD (-7
+ SPA CLA
+NOTI, TAD SCALDN
+ JMP I (OUTNUM
+\fSCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0
+ TAD ACX
+ SPA SNA CLA /IS THE FAC => 1.0?
+ JMP I SCALDN /NO - WE'RE DONE
+ JMS I [FPGO /DIVIDE BY TEN
+ FDIV10
+ ISZ SCALE /BUMP POWER OF TEN
+ 0 /BACKUP FOR WIDTH
+ JMP SCALDN+1 /LOOP
+
+ASTRSK, 0
+ CIA
+ DCA T
+ TAD (52
+ JMS I [FMTOUT
+ ISZ T
+ JMP .-3
+ JMP I ASTRSK /GET NEXT ELEMENT
+
+INESW, 0 /"E SEEN" SWITCH ON INPUT
+ PAGE
+\f/L AND X FORMATS , T FORMAT INPUT
+
+TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
+ CLA /BY FETCHING AND WASTING A CHARACTER
+ TAD (INBUFR
+ DCA INXR
+ DCA EOLSW /SET TO BEGINNING OF LINE
+ JMP XFMT
+XFMTIN, JMS I [FMTIN
+H7600, 7600 /WASTE AN INPUT CHAR
+XFMT, JMS I [MORE /ANY MORE CHARS?
+ TAD RWFLAG /YES - IN OR OUT?
+ SMA CLA
+ JMP XFMTIN /IN
+TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT
+ JMS I [FMTOUT /OUT
+ JMP XFMT
+
+LINGCH, JMS I [FMTIN
+ JMS I [CHTYPE /GET AND CLASSIFY CHARACTER
+ -40; LINLP /BLANK
+ -24; LINTRU /T
+ -6; LINFLS /F
+ 0 /OTHER - ERROR
+ JMP I (INER
+
+LINTRU, TAD (4001
+LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC
+ DCA ACH
+ DCA ACL
+ RAL
+ DCA ACX
+LINLP, ISZ W
+ JMP LINGCH /LOOP ON FIELD WIDTH
+
+LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O
+LFMT, TAD D
+ CMA
+ DCA W /SAVE WIDTH AS A COUNT
+ JMS I [SKPOUT /IN OR OUT?
+ JMP LINFLS /IN
+ CLA IAC
+ TAD W
+ JMS I (OBLNKS /OUTPUT W-1 BLANKS
+ TAD ACH
+ SZA CLA
+ TAD (16
+ TAD (6 /NON-ZERO IS TRUE, ZERO FALSE
+ JMS I [FMTOUT /OUTPUT T OR F
+ JMP LNXT /NEXT VICTIM
+\f/T FORMAT OUTPUT AND RANDOM SUBROUTINES
+
+TFMT, TAD D
+ CIA
+ DCA N /USE N TO FAKE OUT "X" FMT ROUTINE
+ TAD RWFLAG
+ SMA CLA
+ JMP TFMTIN /INPUT
+ TAD N
+ TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE
+ SPA
+ JMP TPBLNK /AFTER - SPACE TO IT
+ JMS EOLINE /OUTPUT CR AND ZERO EOLSW
+ JMS I [MORE /KLUDGE FOR "T1" FORMAT
+ TAD (13 /FAKE X FORMAT INTO PRINTING
+ JMP TPPLBL /A + AND (N-1) SPACES
+TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS
+ JMP XFMT /GO SPACE OUT
+
+EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE
+ TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0
+ SPA CLA /INPUT OR OUTPUT?
+ JMP EOOUTL /OUTPUT
+ JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
+ CLA
+ TAD (INBUFR-1
+ DCA INXR /SET XR TO NEGATIVE WORD AT THE
+ JMP .+3 /BEGINNING OF THE INPUT BUFFER
+EOOUTL, TAD (7715
+ JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN
+ DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT
+ JMP I EOLINE
+\f/ROUTINE TO MOVE A HANDLER INTO FIELD 0
+
+GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY
+ DCA HCW /SAVE HANDLER CODE WORD
+ TAD [7774
+ AND HCW /KNOCK OUT ION AND FORMS CTL BITS
+ CIA
+ SZA /IF HANDLER IS NOT RESIDENT,
+ TAD HKEY /SEE IF THE HANDLER IS ALREADY
+ SNA CLA /IN THE HANDLER AREA IN FIELD 0
+ JMP HINF0 /YES
+ TAD HCW /NO - PUT IT THERE
+ AND [70
+ TAD HCDF0
+ DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES
+ TAD HCW
+ AND H7600
+ TAD (-1 /GET POINTER TO HANDLER ADDRESS
+ DCA XR1 /IN THAT FIELD
+ TAD (HPLACE-1
+ DCA XR /ALSO TO HANDLER AREA IN FIELD 0
+ TAD [7400 /SET UP COUNT OF 7400
+ DCA HKEY /INDEPENDENT OF HANDLER SIZE
+HNDCDF, HLT
+ TAD I XR1
+HCDF0, CDF 0
+ DCA I XR /MOVE HANDLER INTO HANDLER AREA
+ ISZ HKEY
+ JMP HNDCDF
+ TAD [7774
+ AND HCW
+ DCA HKEY /SET NEW KEY CODE WORD
+HINF0, CLA IAC
+ AND HCW
+ SNA CLA /INTERRUPTS ALLOWED?
+YHIOF, IOF /NO - TOO BAD
+ ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL
+ JMP I GETHND
+HKEY, 0
+HCW, 0
+ PAGE
+\f/CHARACTER INPUT ROUTINE - LINE AT A TIME
+
+FMTIN, 0
+ TAD EOLSW
+ SNA /END OF LINE ALREADY FOUND?
+ TAD I INXR /NO - GET CHAR FROM LINE BUFFER
+ SPA /TIME TO READ A NEW LINE?
+ JMP READLN /YES
+ SNA /END OF LINE?
+ JMP INEOL /YES - SET INDICATOR
+ AND [77 /CONVERT TO SIXBIT
+ JMP I FMTIN /RETURN WITH IT
+INEOL, TAD [40
+UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK
+ JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN
+READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0
+ TAD HAND
+ TAD (-TTY
+ SNA CLA /IS IT TELETYPE INPUT?
+ STA /YES - SET TTY FLAG
+ DCA TTYFLG
+ JMS ECHO
+TTYLF, 12 /ECHO LF IF TTY INPUT
+ TAD [12 /TTYLF IS ZEROED BY ABORTO
+ DCA TTYLF
+
+READLP, CLA
+ TAD HAND
+ SPA CLA /CHARACTER ORIENTED DEVICE?
+ JMP MASSIN /NO - UNPACK CHAR FROM BUFFER
+ JMS I HAND /GET A CHARACTER
+GOTCHR, AND [177 /STRIP OFF PARITY
+ JMS I [CHTYPE /CLASSIFY IT
+ -15; INCRET /CARRIAGE RETURN
+ -177; RUBOUT /RUBOUT
+ -11; INTAB /TAB
+ -25; CTRLU /^U
+ -32; INEOF /^Z
+ 0 /ANYTHING ELSE
+ TAD CHCH
+ TAD [-40
+ SMA /IF CHARACTER IS >37,
+ JMS INPUTC /STORE IT AND ECHO IT IF TTY
+ JMP READLP
+\f/CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS
+
+INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS
+ TAD INXR
+ AND [7
+ SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED
+ JMP INTAB
+ JMP READLP
+
+RUBOUT, TAD EOLSW
+ CIA
+ TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY
+ AND TTYFLG
+ SNA CLA
+ JMP READLP /OR IF NON-TTY INPUT
+ JMS ECHO
+ 134 /ECHO A BACKSLASH
+IBAKUP, STA
+ TAD INXR
+ DCA INXR /BACK UP LINE POINTER
+ STA
+ TAD EOLSW
+ DCA EOLSW /AND CHAR COUNTER
+ JMP READLP
+
+INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE
+ SNA /WAS HE EXPECTING AN EOF?
+EOFERR, JMS I ERR /NO
+ JMS I MCDF
+ DCA .+1
+ HLT /CDF TO FIELD OF INDICATOR VARIABLE
+ AC2000
+ DCA I VEOFSW+1 /SET VARIABLE TO .5
+ CDF 0 /FALL INTO CARRIAGE RETURN CODE
+
+INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE
+ SKP
+CTRLU, STA /SNEAKY, SNEAKY!
+ TAD (INBUFR
+ DCA INXR /RESET XR TO FETCH LINE CHARS
+ JMS ECHO
+ 15 /ECHO THE C.R.
+ JMP UNPKLN /BACK TO FETCH FIRST CHAR
+
+INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR
+ TAD [40
+ DCA INTMP
+ JMS ECHO
+INTMP, 0 /ECHO CHAR IF TTY INPUT
+ TAD INTMP
+ DCA I INXR /STORE CHAR IN LINE BUFFER
+ ISZ EOLSW
+ JMP I INPUTC /RETURN IF NO OVERFLOW
+ JMP IBAKUP /IGNORE CHAR IF OVERFLOW
+\fECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT
+ TAD I ECHO /GET CHAR
+ AND TTYFLG
+ SZA /SHOULD WE ECHO?
+ JMS I HAND /YES
+ JMP I ECHO /RETURN TO CHARACTER - ITS SMALL
+TTYFLG, 0
+
+/CHARACTER INPUT ROUTINE - MASS STORAGE SECTION
+
+MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER
+ JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD
+ JMS I (GETCH3 /USE COMMON SUBROUTINE
+ JMP MASICM /GO TO COMMON CODE
+
+INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD
+ JMS BUFFLD /SET FIELD OF BUFFER
+ TAD I CHRPTR
+MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR
+ NOP /WATCH END OF FIELD FUNNYBUSINESS!
+ CDF 0 /RESET DATA FIELD
+ JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER
+
+MASBMP, 0
+ JMS BUFFLD /SET TO BUFFER'S DATA FIELD
+ ISZ CHRCTR /BUMP CHAR COUNTER
+ JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT
+ AC7775
+ DCA CHRCTR /CHAR 3 - RESET CHAR CTR
+ AC7776
+ TAD CHRPTR /BUMP BACK CHAR PTR
+ DCA CHRPTR
+ ISZ MASBMP
+ JMP I MASBMP /SKIP RETURN
+ PAGE
+\f/CHARACTER OUTPUT ROUTINE
+
+FMTOUT, 0
+ TAD [40 /FIRST CONVERT SIXBIT TO ASCII
+ SMA /CTL CHARS COME IN NEGATIVE
+ AND [77
+ TAD (240
+ DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT)
+ TAD EOLSW
+ SZA CLA
+ JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL
+ AC0002 /CHECK TO SEE IF THIS UNIT
+ AND HCODEW /SHOULD RECEIVE FORMS CONTROL
+ SZA CLA
+ JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR
+ TAD OCHAR
+ JMS I [CHTYPE /CLASSIFY CONTROL CHAR
+ -261; OUTFFX /1 - TOP OF FORM
+ -260; OUT2LF /0 - DOUBLE SPACE
+ -253; NOLF /+ - OVERPRINT
+ 0 /ANYTHING ELSE - SINGLE SPACE
+ JMP OUTLF
+
+OUTFFX, TAD HAND
+ TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS
+ SZA CLA /INSTEAD OF A FORM FEED
+ JMP OUTFF
+OUT2LF, TAD [12
+ DCA OCHAR /SET 2ND CHAR TO LINE FEED
+LFPLCH, STA
+ DCA EOLSW /SET SWITCH FOR 2ND CHAR
+ TAD OCHAR
+ DCA CHCH /SAVE CHARACTER AWAY
+OUTLF, AC7776
+OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL
+ DCA OCHAR /FOR THE CHARACTER
+NOT1ST, TAD HAND
+ SPA CLA /CHARACTER ORIENTED DEVICE?
+ JMP MASOUT /NO - PACK CHAR INTO BUFFER
+ TAD OCHAR
+ JMS I HAND /OUTPUT CHAR
+NOLF, ISZ EOLSW /BUMP CHAR CTR
+ JMP I FMTOUT /NO - RETURN
+ TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT
+ JMP OUTFF+1 /GO TO IT
+\f/CHARACTER OUTPUT - MASS STORAGE OUTPUT
+
+MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER
+ JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD
+ JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE
+ JMS OSUBR /PACK SECOND HALFBYTE
+ AC4000
+ JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER
+MASOCM, CDF 0
+ JMP NOLF /GO RETURN OR REENTER
+
+OULORD, TAD OCHAR
+ DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS
+ ISZ CHRPTR /BUMP CHAR PTR
+F214, 214 /GUARD AGAINST OVFLO
+ JMP MASOCM /RETURN
+
+OSUBR, 0 /ROUTINE TO PACK A HALFBYTE
+ TAD OCHAR
+ CLL RTL
+ RTL /SHIFT CHAR 4 LEFT
+ DCA OCHAR
+ TAD I CHRPTR /CLEAR OUT ANY RESIDUE
+ AND [377 /FROM HIGH-ORDER OF BUFFER WORD
+ DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE.
+ TAD OCHAR
+ AND [7400 /GET 4 BITS
+ TAD I CHRPTR
+ DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD
+ ISZ CHRPTR /BUMP POINTER
+ 200 /OVERFLOW!
+ JMP I OSUBR
+
+MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY
+ CDF 0
+ TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC
+ TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON
+ DCA IOCTL /STORE I/O CONTROL WORD
+ TAD CHRPTR
+ AND [377
+ SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY
+ JMP I MASSIO /YES - RETURN DOING NOTHING
+ TAD RELBLK
+ TAD STBLK /STORE BLOCK # IN HANDLER CALL
+ DCA BLOCK
+ TAD BADFLD
+ AND [7400
+ DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL
+\f/CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED
+
+ TAD TOTBLK
+ CIA CLL
+ TAD RELBLK
+ SZL CLA /CHECK FOR FILE OVERFLOW
+IOVFLO, JMS I ERR /YES - ERROR
+ TAD HCODEW
+ JMS I (GETHND /GET HANDLER INTO FIELD 0
+ JMS I HAND /CALL HANDLER
+IOCTL, 0
+BUFFER, 0
+BLOCK, 0
+ SMA CLA /HANDLER ERROR - ABORT
+ SKP /IF NOT EOF
+IOERR, JMS I ERR
+ JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER
+ ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER
+ TAD BUFFER
+ DCA CHRPTR /RESET CHAR PTR
+ JMP I MASSIO /RETURN
+/FPP CODE FOR I/O CONVERSION
+
+FDIV10, FDIV+LONG
+ TEN
+ FEXIT
+OCHAR, 0 /*** NEEDED FOR PADDING ***
+FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4
+ TEN
+ FEXIT
+
+FWTOBL, FSUB+LONG
+ ONE
+ FDIV+LONG
+ FLTG85
+ FEXIT
+ PAGE
+\f/UNFORMATTED (BINARY) INPUT-OUTPUT
+
+RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)"
+ 1000 /"UNFORMATTED" BIT
+ TAD SZLCLA /ENABLE SEQUENCE CHECKING
+UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA"
+ DCA RECCTR /ENTER HERE FROM DIRECT ACCESS
+ TAD HAND
+ SMA CLA /CHECK FOR MASS-STORAGE HANDLER
+ JMP I [UNTERR /NO - ERROR
+ JMS I [GETLMN /GET FIRST VARIABLE
+ TAD RWFLAG
+ SPA CLA
+RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE,
+ CMA /-1 FOR READ
+ DCA CHRCTR
+ TAD BADFLD
+ AND [7400
+ DCA BIOPTR /INITIALIZE BUFFER POINTER
+ TAD BADFLD
+ AND [70
+ IAC
+ CLL RTR /AC BIT 0 NOW ON
+ TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG
+ CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD
+ TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD
+ DCA FGPBF
+ JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE
+BFINCR, JMS I [FPGO
+ FGPBF /LOAD OR STORE A BUFFER ENTRY
+ ISZ BIOPTR
+ ISZ BIOPTR /INCREASE BUFFER POINTER
+ ISZ BIOPTR
+ JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM
+UIOVLP, TAD RWFLAG
+ CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG
+ SZL CLA
+ JMP ENDUIO /NO MORE VARIABLES - TERMINATE
+ ISZ CHRCTR /BUMP COUNTER
+ JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE
+ JMS UDOIO /GET A NEW BUFFER
+ JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS
+
+ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED
+ SPA CLA /WRITE?
+ JMS UDOIO /YES - WRITE OUT THE LAST BUFFER
+ JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT
+
+RECCTR, 0
+\f/DIRECT-ACCESS I/O
+
+RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)"
+ 1000 /DIRECT ACCESS IS UNFORMATTED I/O
+ TAD I XR
+ DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE
+ JMS I [ARGLD /GET RECORD NUMBER
+ JMS I [FFIX /CONVERT TO INTEGER
+ TAD T
+ TAD ACI
+ ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD
+ JMP .-2 /TO GET RELATIVE BLOCK NUMBER
+ DCA RELBLK
+ TAD I XR
+ SNA /THIS LOC SHOULD NOT BE ZERO!
+DAERR, JMS I ERR
+ DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD
+ TAD I XR /IN WHICH THE CONTROL VARIABLE IS
+ DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS
+ JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD
+ FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR
+ TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE
+ JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE
+
+UDOIO, 0
+ ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED
+ TAD BADFLD
+ AND [7400
+ TAD [377 /FORM POINTER TO LAST WORD IN BUFFER
+ DCA BIOPTR
+ TAD RECCTR
+ JMS BUFFLD
+ DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD
+UDOIOL, DCA CHRPTR
+ AC4000
+ AND RWFLAG
+ JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O)
+ JMS BUFFLD
+ TAD RECCTR
+ CMA STL /FOR READ, CHECK THE INPUT
+ TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS
+ CDF 0 /NO LARGER THAN THE ONE WE EXPECT.
+SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE
+ JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST
+ JMP UDOIOL /RECORD AND SO WE READ AGAIN.
+\f/DEFINE FILE PROCESSOR
+
+DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE
+ 1000 /DIRECT ACCESS I/O IS UNFORMATTED
+ JMS I [ARGLD /GET NUMBER OF RECORDS
+ JMS I [FFIX
+ TAD ACI
+ CIA
+DUMPIT, DCA T /SAVE IT FOR MULTIPLY
+ JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD
+ JMS I [FPGO /CONVERT WORDS TO BLOCKS
+ FWTOBL
+ JMS I [FFIX /CONVERT TO INTEGER
+ ISZ ACI
+ TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD
+ ISZ T /BY THE NUMBER OF RECORDS
+ JMP .-2
+ DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS
+ TAD ACI
+ CIA
+ DCA I XR /STORE NUMBER OF BLOCKS/RECORD
+ JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE
+ TAD FGPBF
+ TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE
+ DCA I XR /SAVE "FSTA CONTROL-VARIABLE"
+ TAD BIOPTR
+ DCA I XR
+ TAD TOTBLK
+ CMA CLL
+ TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE
+SZLCLA, SZL CLA
+DFERR, JMS I ERR /WE DON'T
+ AC7776
+ AND FFLAGS
+ IAC /FORCE "END-FILED" BIT FOR CLOSE
+ JMP I (SETTOT /SET LENGTH AND EXIT
+ PAGE
+\f/SWAPPER AND ERROR ROUTINE
+
+SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE:
+ DCA T / TRAP3 SWAP
+ TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR
+ AND [7
+ TAD (JA
+ DCA STRTUP /STORE JA TO ENTRY POINT
+ JMS I [FETPC
+ DCA STRTUP+1
+ TAD T
+ AND [70
+ CLL RAR /FORM 4*LVL
+ TAD (OVLYTB /INDEX INTO LEVEL TABLE
+ DCA ADR
+ TAD T
+ AND [7400
+ DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3
+ CDF 0 /WATCH D.F.!
+ TAD I ADR
+ TAD T /SEE IF THIS OVERLAY IS IN CORE
+ SNA CLA
+ JMP ITSIN /YES - DON'T LOAD
+ TAD T
+ CIA
+ DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST)
+ ISZ ADR
+ TAD I ADR
+ AND [7400
+ DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS
+ TAD I ADR
+ AND [70
+ DCA OVIOW /AND FIELD
+ ISZ ADR
+ TAD I ADR /GET STARTING BLOCK OF THIS LEVEL
+ DCA OVBLK
+ ISZ ADR
+ TAD I ADR
+ DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS
+OVADLP, TAD T /LEVEL STARTING BLOCK +
+ SNA /(OVERLAY #) * (OVERLAY LENGTH)
+ JMP LOADOV /= OVERLAY STARTING BLOCK
+ TAD [7400
+ DCA T
+ TAD OVBLK
+ TAD OVLEN
+ DCA OVBLK
+ JMP OVADLP
+\f/SWAPPER - CONTINUED
+
+LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH
+ TAD OVIOW /GET LAST READ CONTROL WORD
+ RAL
+ AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT
+ TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0)
+ DCA OVADR
+ RTL
+ RTL /USE THE CARRY
+ TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY
+ AND [70
+ DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW
+
+LOADOV, TAD OVADR
+ CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS
+ SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME
+ TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES
+ CLL RTL
+ RTL /SO WE MUST BREAK UP THE OVERLAY READ
+ CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH.
+ TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY:
+ CMA /MINIMUM(B,L,15)
+ SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD
+ CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY
+ TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ
+ DCA T / ANSWER IN T
+ TAD T
+ CLL RTR
+ RTR
+ RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT
+ TAD OVIOW
+ DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD
+ TAD OVHCDW /GET OVERLAY HANDLER CODE WORD
+ JMS I (GETHND /LOAD HANDLER INTO FIELD 0
+ JMS I OVHND
+OVIOW, 0
+OVADR, 0
+OVBLK, 0
+OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR
+ JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER
+ TAD T
+ TAD OVBLK
+ DCA OVBLK /UPDATE BLOCK NUMBER
+ TAD T
+ CIA
+ TAD OVLEN /BUMP DOWN RECORD COUNT
+ SZA /SEE IF WE ARE DONE
+ JMP LOADLP /NO - PREPARE FOR NEXT READ
+\f/OVERLAY IN CORE - EXECUTE IT
+
+ITSIN, JMS I [FPGO /START UP FPP
+ STRTUP /AND JA TO ENTRY POINT
+
+TRAP5I,
+TRAP6I,
+TRAP7I,
+FPAUSE,
+FPPERR, JMS I ERR /SHOULD NEVER GET HERE
+
+STRTUP, 0;0 /JA ENTRY
+OVLEN, 0
+OVHND, 0 /SET BY LOADER
+OVHCDW, 0 /SET BY LOADER
+
+RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS
+ DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS.
+YRCOVR, NOP
+ NOP
+ NOP
+ NOP /RIGHT NOW I DON'T KNOW OF ANY.
+ NOP
+ NOP
+ NOP
+ NOP
+ ION
+ JMP I RECOVR
+
+FSTTMP, FSTA+LONG
+ FTEMP
+ FEXIT
+
+TEN, 4;2400;0;0;0;0 /10.0D0
+FLTG85, 7;2520;0 /85.0
+ PAGE
+\f/INPUT BUFFER - CONTAINS STARTUP CODE
+
+INBUFR, -206 /LENGTH
+ 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING,
+
+/RTS EXECUTION INITIALIZATION - IN INPUT BUFFER
+
+FPSTRT, 6601 /CLEAR DF32 FLAG
+ PCF /HSP FLAG
+ RRB /HSR FLAG
+PP7600, 7600 /CLEAR READER CHAR
+ 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS
+ CLA
+ 6132 /STOP KW12 CLOCKS
+ 6134 /DISABLE KW12 INTERRUPTS
+ 6530 /CLEAR AD8-EA FLAGS
+ 6050 /CLEAR VC8/E FLAG
+ 6500 /DISABLE XY8/E INTERRUPTS
+ STA
+ 6130 /DISABLE DK8-EP INTERRUPTS
+ CLA /LEAVE SPACE FOR ADDITIONAL CLEARS
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ DCA EOLSW
+LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP
+ STSWAP
+HLTNOP, NOP /SET TO HLT IF /H SPECIFIED,
+ JMP PRTCR /SKP IF /P SPECIFIED
+ TAD .-1
+ DCA LDPROG /BYPASS LOADING ON STARTUP
+ TAD PCHWD /HLT
+ DCA I (PDPXIT+1
+\f/ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED)
+
+PPTR, TAD P11
+PCKSUM, DCA ACI
+ JMS I (LDDSRN
+ SMA CLA
+ JMP I [UNTERR
+ JMP LDRTLR
+FLDLP, DCA PPTR
+ DCA PCKSUM
+ TAD (100
+ JMS SIXOUT
+ JMS SIXOUT
+ TAD FLD
+ AND [70
+JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3
+ TAD (100
+ JMS SIXOUT
+ JMS SIXOUT
+FLD, CDF 0
+ TAD I PPTR
+ CDF 0
+ JMS PCHWD
+ ISZ PPTR
+P11, 11
+ ISZ PCTR
+ JMP FLD
+ TAD PCKSUM
+ JMS PCHWD
+ TAD FLD
+ TAD (10
+ DCA FLD
+LDRTLR, TAD PP7600
+ DCA ACH
+ TAD [200
+ JMS SIXOUT
+ ISZ ACH
+ JMP .-3
+ ISZ FCNT
+ JMP FLDLP
+ TAD (6000
+ DCA FFLAGS
+ DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT
+ JMS I (ENDFL
+ DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8
+ JMP I (PDPXIT-1
+\fPCHWD, HLT
+ DCA ACH
+ TAD ACH
+ RTR
+ RTR
+ RTR
+ AND [77
+ JMS SIXOUT
+ TAD ACH
+ AND [77
+ JMS SIXOUT
+ JMP I PCHWD
+
+SIXOUT, 0
+ DCA T
+ CLA IAC
+ DCA EOLSW
+ TAD PCKSUM
+ TAD T
+ DCA PCKSUM
+ TAD T
+ TAD (-300
+ JMS I [FMTOUT
+ JMP I SIXOUT
+
+PCTR, 200 /DON'T PUNCH 07600!
+FCNT, 0
+\fPRTCR, TAD (215
+ JMS I PTTY /PRINT CARRIAGE RETURN
+ TAD JFMOUT
+ DCA I (ERRENB /ENABLE ERROR TRACEBACK
+ JMS I [FPGO
+ STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE
+STSWAP, TRAP3 /TRAP3
+ SWAP
+ 0
+ .+1
+ TRAP3
+ HLTNOP
+ PAGE
+STJUMP, 0
+ 0
+ ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER
+\f/OVERLAY AND DSRN TABLES
+
+ *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM
+
+OVLYTB, ZBLOCK 40 /OVERLAY TABLE
+
+DSRN, PTR; ZBLOCK 10
+ PTP; ZBLOCK 10
+ LPT; ZBLOCK 10
+ TTY; 0;0
+ 1234 /*K* PREVENT PROBLEM IN
+ ZBLOCK 5 /RWINIT INVOLVING WRITE
+ /AFTER READ ON TELETYPE
+ ZBLOCK 55
+
+ ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST
+FMTPDL, 0 /GUARD WORD
+ PAGE
+\f/SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED
+/EVEN IF FLOATING HARDWARE IS PRESENT
+
+/** MUST NOT DESTROY FAC! **
+
+FFIX, 0 /ROUTINE TO FIX FAC
+ STA /ANSWER IS RETURNED IN ACI
+TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048
+ CLL /DETERMINE IF FAC EXPONENT IS
+ TAD (-13 /BETWEEN 1 AND 14
+ SNA
+ JMP FIXBIG /14 IS A SPECIAL CASE
+EAEFIX, DCA ACI
+ SZL
+ JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0
+ TAD ACH
+ JMP FIXISZ
+FIXLP, CLL /0 IN LINK
+ SPA /IS IT LESS THAN 0?
+ CML /YES-PUT A 1 IN LINK
+ RAR /SCALE RIGHT
+FIXISZ, ISZ ACI /DONE YET?
+ JMP FIXLP /NO
+FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI
+ JMP I FFIX /RETURN
+
+FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION
+ RAL /LEFT ONE PLACE TO INTEGERIZE IT.
+ CLA
+ TAD ACH
+ RAL
+ JMP FIXDNE /STORE ANSWER AND RETURN
+
+SETB, TAD DATAF
+ DCA I (BASCDF /SET BASE PAGE LOCATION
+ TAD ADR
+ DCA BASADR
+ JMP I FPNXT
+\f/
+/SHIFT FAC LEFT 1 BIT
+/
+AL1, 0
+ TAD AC1 /GET OVERFLOW BIT
+ CLL RAL /SHIFT LEFT
+ DCA AC1 /STORE BACK
+ TAD ACL /GET LOW ORDER MANTISSA
+ RAL /SHIFT LEFT
+ DCA ACL /STORE BACK
+ TAD ACH /GET HI ORDER
+ RAL
+ DCA ACH /STORE BACK
+ JMP I AL1 /RETN.
+/
+/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
+/
+ACSR, 0
+ CMA /AC CONTAINS COUNT-1
+ DCA AC0 /STORE COUNT
+LOP1, TAD ACH /GET HIGH ORDER MANTISSA
+ CLL
+ SPA /PROPAGATE SIGN
+ CML
+ RAR /SHIFT RIGHT 1, PROPAGATING SIGN
+ DCA ACH /STORE BACK
+ TAD ACL /GET LOW ORDER
+ RAR /SHIFT IT
+ DCA ACL /STORE BACK
+ ISZ ACX /INCREMENT EXPONENT
+ NOP
+ ISZ AC0 /DONE?
+ JMP LOP1 /NO-LOOP
+ RAR
+ DCA AC1 /SAVE 1 BIT OF OVERFLOW
+ JMP I ACSR /YES-RETN-AC=L=0
+/
+/FLOATING NEGATE
+/
+FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE)
+ TAD ACL /GET LOW ORDER FAC
+ CLL CMA IAC /NEGATE IT
+ DCA ACL /STORE BACK
+ CML RAL /ADJUST OVERFLOW BIT AND
+ TAD ACH /PROPAGATE CARRY-GET HI ORD
+ CLL CMA IAC /NEGATE IT
+ DCA ACH /STORE BACK
+ JMP I FFNEG
+\fOADD, 0 /ADD OPERAND TO FAC
+ CLL
+ TAD AC2 /ADD OVERFLOW WORDS
+ TAD AC1
+ DCA AC1
+ RAL /ROTATE CARRY
+ TAD OPL /ADD LOW ORDER MANTISSAS
+ TAD ACL
+ DCA ACL
+ RAL
+ TAD OPH /ADD HI ORDER MANTISSAS
+ TAD ACH
+ DCA ACH
+ JMP I OADD /RETN.
+
+FETPC, 0
+ ISZ PC
+ JMP PCCDF /NO FIELD BUMP
+ ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS)
+FPC10, 10 /PROTECTION FOR ISZ
+ TAD PCCDF
+ TAD FPC10
+ DCA PCCDF
+PCCDF, HLT
+ TAD I PC
+ JMP I FETPC
+
+EEPUT, STL /EXTENDED PRECISION STORE
+EEGET, DCA ADR /EXTENDED PRCISION FETCH
+ TAD [-6
+ DCA DATCDF
+ SNL
+ AC2000 /SET UP "TAD ACX" OR "DCA ACX"
+ TAD TADACX
+ DCA EEINST
+EELOOP, SNL /LINK=1 MEANS STORE
+ TAD I ADR
+EEINST, HLT
+ SZL
+ DCA I ADR
+ ISZ ADR
+ SKP
+ JMS I (DFBUMP
+ ISZ EEINST
+ ISZ DATCDF
+ JMP EELOOP
+ JMP I FPNXT
+
+FSTTM2, FSTA+LONG
+ FTEMP2
+ FEXIT
+/
+FTEMP, ZBLOCK 6
+/
+ PAGE
+\f/RUN-TIME SYSTEM ERROR LIST
+
+ERRLST, VARGER; ARGMSG
+ UERR; UMSG
+ FPOERR; FPOMSG
+ FMTERR; FMTMSG
+ UNTERR; UNTMSG
+ CTLBER; CTLBMS
+ INER; INMSG
+ IOVFLO; IOVMSG
+ IOERR; IOMSG
+ DAERR; DAMSG
+ FPPERR; FPPMSG
+ OVERR; OVMSG
+ EOFERR; INEMSG
+ FPOVER; OFLMSG
+ DFERR; DFMSG
+ -1; DV0MSG /BY ELIMINATION
+\f/RTS ERROR MESSAGES
+
+ARGMSG, TEXT /BAD ARG/
+UMSG, TEXT /USER ERROR/
+FPOMSG, TEXT /PARENS TOO DEEP/
+FMTMSG, TEXT /FORMAT ERROR/
+UNTMSG, TEXT /UNIT ERROR/
+INMSG, TEXT /INPUT ERROR/
+OVMSG, TEXT /OVERLAY /
+ *.-1
+IOMSG, TEXT %I/O ERROR%
+DAMSG, TEXT /NO DEFINE FILE/
+FPPMSG, TEXT /FPP ERROR/
+INEMSG, TEXT /EOF ERROR/
+DV0MSG, TEXT /DIVIDE BY 0/
+DFMSG, TEXT /D.F. TOO BIG/
+IOVMSG, TEXT /FILE /
+ *.-1
+OFLMSG, TEXT /OVERFLOW/
+CTLBMS, TEXT /^B/
+
+USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL
+ DCA FATAL
+UERR, JMS I ERR /PRINT MESSAGE
+ JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING
+ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED
+
+TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES
+ PRTNAM /BY THE ERROR TRACEBACK ROUTINE
+ PAGE
+\fMAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11
+ RTL
+ RAL
+ AND [70
+ TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT?
+ JMP I MAKCDF
+
+RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING
+ STA /FROM READ TO WRITE. (CALLED ONLY ONCE!)
+ TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #"
+ DCA RELBLK /TO "THIS BUFFER'S BLOCK #".
+ TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A
+ IAC /BUFFER, WRITE ROUTINE EXPECTS US TO
+ SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER,
+ JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS
+ JMP I RD2WR
+
+/RUN-TIME-SYSTEM ERROR ROUTINE
+
+ERROR, 0
+ERCDF, CDF 0
+ CLA
+ TAD (ERRLST-2
+ DCA XR
+ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS
+ TAD I XR /ERROR LIST CONTAINS
+ CMA
+ SZA /CALLING ADDRESSES AND
+ TAD ERROR /CORRESPONDING MESSAGES
+ SZA CLA
+ JMP ERRLP
+ TAD I XR
+ DCA I (FMTADR
+ DCA I (FMTDF
+ TAD PTTY
+ DCA HAND /QUICK FUDGE FOR TTY OUTPUT
+ DCA HCODEW /TO SET CARRIAGE CONTROL
+ AC4000
+ DCA RWFLAG
+ JMS I [EOLINE /TYPE CARRET AND SET EOLSW
+ DCA FMTBYT /INITIALIZE MESSAGE PTR
+ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME
+ JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES
+ ISZ FMTBYT
+ SZA
+ JMP ERPTLP /LOOP UNTIL 0 CHAR
+\f/PRINT ROUTINE NAME AND LINE NUMBER
+
+PRTNAM, TAD [40
+ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS
+/ PREVIOUS LINE REPLACED WITH:
+/ JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES)
+ JMS I [FPGO /START UP FPP
+ GTNMPT /GET POINTER TO NAME IN FAC
+ TAD ACH
+ DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE
+ TAD ACL /TO GET CHARACTERS OF ROUTINE NAME
+ DCA I (FMTADR
+ DCA FMTBYT
+ TAD [-6
+ DCA ISN /6 CHARACTER NAME
+PRTNML, JMS I [FMTGCH
+ SNA
+ TAD [40 /AVOID PRINTING RANDOM @S
+ JMS I [FMTOUT /GET AND PRINT A CHARACTER
+ ISZ FMTBYT
+ ISZ ISN
+ JMP PRTNML
+ TAD [40
+ JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE
+ TAD [-4 /FROM THE LINE NUMBER.
+ DCA ISN
+PTLNLP, TAD ISN+1
+ CLL RTL
+ RAL
+ DCA ISN+1 /PRINT LINE NUMBER IN OCTAL
+ TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS
+ RAL /IN THE FORTRAN PROGRAM LISTING
+ AND [7
+ JMS I (DIGIT
+ ISZ ISN
+ JMP PTLNLP
+
+ JMS I [EOLINE /OUTPUT FINAL CR
+ TAD FATAL
+ SNA CLA /FATAL ERROR?
+ JMP TRCBAK /YES - GIVE FULL TRACEBACK
+ DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME
+ JMP I ERROR
+TRCBAK, JMS I [FPGO /START UP FPP
+ UP1LEV /MOVE UP TO CALLING ROUTINE
+ /FPP CODE DOES A "TRAP3 PRTNAM"
+ISN, 0;0
+\f/FPP CODE FOR ERROR ROUTINE
+
+GTNMPT, STARTD
+ XTA 0 /LOAD LINE NUMBER FROM XR 0
+ FSTA+LONG
+ ISN /STORE AWAY
+ FLDA+BASE 10 /LOAD POINTER TO PROLOGUE
+ FSUB+LONG
+ THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE
+ STARTF /FOR NON-FPP VERSION
+THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0
+
+UP1LEV, STARTD
+ FLDA+BASE 11 /GET THE UPWARD POINTER
+ JNE
+ NOTMN /ZERO MEANS MAIN PROGRAM
+ TRAP3
+E7605, 7605 /GO AWAY IF MAIN PROGRAM
+NOTMN, FSTA+BASE 0
+ LDX 1
+ 2 /WE WILL STORE A "TRAP3 PRTNAM"
+ FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE,
+ TRPPRT
+ FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB.
+ FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN
+ JAC /JUMP TO IT.
+
+ACMDGT, FMUL+LONG
+ TEN
+ FSTA+LONG
+ FTEMP
+ FLDA+LONG
+ DGT /GET UNNORMALIZED DIGIT INTO AC
+ FNORM /NORMALIZE IT
+FADTMP, FADD+LONG
+ FTEMP
+ FEXIT
+LPBUFR, ZBLOCK 4
+ LPBUF2
+ PAGE
+\fHPLACE, /ZBLOCK 400 /HANDLER SWAP AREA
+
+/VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA
+
+QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE
+QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN
+QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED
+QVERNO, 0 /LOADER VERSION #
+QDPFLG, 0 /"PROGRAM USES D.P." FLAG
+QUSRLV, ZBLOCK 40 /USER OVERLAY INFO
+
+/EAE OVERLAY TO FIX AND FLOAT
+
+EFXFLT, RELOC EAEFIX
+
+FIXEAE, CMA
+ DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12
+ SZL
+ JMP FIX0 /NOT INTEGERIZABLE
+ TAD ACH
+ ASR
+FIXSH, 0
+FIX0, DCA ACI
+ JMP I FFIX
+
+FXFLTC= .-FIXEAE
+ RELOC
+\f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
+/BANKS IN AC.
+/MUST RUN IN FIELD 0.
+
+CORE, 0
+ TAD C6203
+ RDF
+ DCA CORRET
+CORELP, CDF 0 /NEEDED FOR PDP-8L
+ TAD I C7777
+ AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO,
+ CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE
+ RAR /WHICH WE SHOULD USE.
+ SZA
+ JMP CORRET /SO RETURN THAT AMOUNT
+ TAD TRYFLD /GET FLD TO TST
+ CLL RTL
+ RAL
+ AND COR70 /MASK USEFUL BITS
+ TAD CORELP
+ DCA COR706 /SET UP CDF TO FLD
+COR706, 0
+ TAD I CORLOC /SAV CURRENT CONTENTS
+ NOP /HACK FOR PDP-8
+ DCA .-3
+ TAD .-2 /7000 IS A GOOD PATTERN
+ DCA I CORLOC
+COR70, 70 /HACK FOR PDP-8.,NO-OP
+ TAD I CORLOC /TRY TO READ BK 7000
+CO7400, 7400 /HACK FOR PDP-8,.NO-OP
+ TAD CO7400 /GUARD AGAINST WRAP AROUND
+ TAD CORLOC+1 /TAD 1400
+ SZA CLA
+ JMP .+5 /NON EXISTENT FLD EXIT
+ TAD COR706 /RESTORE CONTENS DESTROYED
+ DCA I CORLOC
+ ISZ TRYFLD /TRY NXT HIGHER FLD
+ JMP CORELP
+ STA
+ TAD TRYFLD
+CORRET, 0
+ JMP I CORE
+CORLOC, CO7400 /ADR TO TST IN EACH FLD
+ 1400 /7000+7400+1400=0
+TRYFLD, 1 /CURRENT FLD TO TST
+C6203, 6203
+C7777, 7777
+
+DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION
+ FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED
+\f/TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION
+/UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1
+/ (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES).
+
+BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE
+ RELOC YLPT
+ LLS
+ CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR.
+ JMS CTCBCK /CHECK FOR ^C OR ^B
+ JMP I LPT
+FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS
+ JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER
+ RELOC
+ 0
+
+ YPTP-1 /PAPER-TAPE PUNCH ROUTINE
+ CLA /ALL PAPER-TAPE I/O ILLEGAL
+ 0
+ YPTR-1 /PAPER TAPE READER ROUTINE
+ CLA /ALL PAPER-TAPE I/O ILLEGAL
+ 0
+
+ YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE
+ RELOC YTTY
+ SNA
+ JMP KBDRTS /AC=0 MEANS INPUT
+ TSF
+ JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL
+ TLS
+ CLA
+ JMS CTCBCK /CHECK FOR ^C OR ^B TYPED
+ JMP I TTY
+KBDRTS, KSF
+ JMP .-1 /HANG UNTIL CHAR RECEIVED
+ JMS CTCBCK /CHECK FOR ^C OR ^B
+ KRB
+ AND KB177 /STRIP PARITY
+ TAD KB177
+ IAC /NOW FORCE PARITY BIT ON (177+1=200)
+ JMP I TTY
+
+CTCBCK, . /*K* CAN'T BE 0!
+ KRS /PEEK AT NEXT CHAR IN BUFFER
+ AND KB177
+ TAD KBM2
+ CLL RAR
+ SNA CLA /IS IT ^C OR ^B?
+ KSF /AND IS IT REALLY PENDING?
+ JMP I CTCBCK /NO - JUST RETURN WITH AC=0
+ JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG
+KB177, 177
+KBM2, -2
+ RELOC
+ 0
+\f/CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS
+
+ YHIOF-1 /"GET OS/8 HANDLER" ROUTINE
+ NOP /ELIMINATE "IOF" INSTRUCTION
+ 0
+
+ YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE
+ RELOC YRCOVR
+ JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES
+ RELOC /AN "ION"
+ 0
+
+ YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION
+ FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE
+ 0 /RETURNING TO THE INTERPRETER
+
+ 0 /** LIST TERMINATOR **
+\f/ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER
+/*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER!
+
+ IFNZRO .-HPLACE-200&4000 <__ERROR__>
+
+NOLI, TEXT /NOT A LOADER IMAGE/
+NONMSG, TEXT /NO NUMERIC SWITCH/
+FILMSG, TEXT /FILE ERROR/
+SYSMSG, TEXT /SYSTEM DEVICE ERROR/
+TOOMCH, TEXT /MORE CORE REQUIRED/
+TOMNYH, TEXT /TOO MANY HANDLERS/
+LIOEMS, TEXT /CAN'T READ IT!/
+NODPMS, TEXT /CAUTION - NO DP/
+XVERMS, TEXT /FRTS V/
+ *.-1
+ XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT
+ XPATCH&77^100+40 /PATCH LEVEL
+ TEXT / /
+ PAGE
+\f/FPP INTERPRETER STARTUP ROUTINE
+
+FPPINT= . /FOR FPP OVERLAY
+RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT
+
+FPGO, 0
+FPGCDF, CDF 0 /NECESSARY?
+ CLA
+ TAD PC
+ DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS
+ TAD I (PCCDF
+ DCA SPCCDF
+ STA
+ TAD I FPGO
+ DCA PC
+ ISZ FPGO
+ TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY
+ DCA I (PCCDF
+ JMP I FPNXT
+
+EXIT, TAD SAVPC
+ DCA PC
+ TAD SPCCDF
+ DCA I (PCCDF /RESTORE OLD PC
+ JMP I FPGO /RETURN TO PDP-8 CODE
+SAVPC, 0
+SPCCDF, 0
+
+FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE
+ DCA ACX
+ JMS DATCDF
+ TAD I ADR
+CLFAC, DCA ACL
+ TAD ACL
+ SPA CLA /SIGN-EXTEND 12-BIT WORD
+ STA /INTO FAC FRACTION
+ DCA ACH
+NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD
+ TAD DFLG
+ SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE,
+ JMS I NORMX /NORMALIZE THE FAC
+ JMP I FPNXT
+\f/MISCELLANEOUS JUMP CLASS INSTRUCTIONS
+
+JSA, TAD ADR
+ DCA PUTM
+ TAD DATAF
+ DCA JSCDF /SET UP LOC TO SAVE PC IN
+ AC0002
+ TAD ADR
+ DCA ADR /BUMP ADDRESS BY 2
+ RTL
+ RTL
+ TAD DATAF
+ DCA DATAF /INCLUDING DATA FIELD
+JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE
+ CLL RTR
+ RAR
+ ISZ PC /BUMP PC BEFORE STORING
+ SKP
+ IAC /INCLUDING FIELD BITS
+ TAD (JA-2620 /FORM "JA" INSTRUCTION
+JSCDF, HLT
+ DCA I PUTM
+ ISZ PUTM
+ SKP
+ JMS I (DFBUMP /BUMP TARGET ADDRESS
+ TAD PC
+ DCA I PUTM
+ JMP I (DOJMP /NOW JUMP TO DESTINATION
+
+JSR, CLA CLL IAC
+ TAD BASADR
+ DCA PUTM
+ RTL
+ RTL
+ TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1
+ DCA JSCDF
+ JMP JSAR
+
+FPJAC, TAD ACL
+ DCA ADR
+ TAD ACH
+ JMS I MCDF
+ DCA DATAF
+ JMP I (DOJMP
+
+SPCATX, TAD ACL
+ SKP
+FPLDX, JMS I [FETPC
+ JMS DATCDF
+ DCA I ADR /SET XR TO NEXT INST WD
+ JMP I FPNXT
+\f/MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS
+
+ADDX, JMS I [FETPC
+ JMS DATCDF
+ TAD I ADR /ADD NEXT INST WD TO XR
+ JMP FPLDX+1
+
+ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE
+ SMA SZA CLA
+ JMP SPCATX
+ JMS I NORMX /FAC MAY NOT BE NORMALIZED
+ JMS I [FFIX
+ TAD ACI
+ JMP FPLDX+1
+
+OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER
+ TAD AD1
+ DCA AD2
+ RDF
+ CLL RTR
+ RAR
+ TAD KLUDGM /FORM FSTA X INSTRUCTION
+ DCA PUTM
+ AC2000
+ AND INST /TURN OP 5 TO OP 1,
+ SZA CLA
+ TAD [3000 / OP 7 TO OP 4.
+ TAD [3000
+ TAD PUTM /STICK IN FIELD BITS
+ DCA OPM
+ JMS I [FPGO
+ KLUDGM
+ JMP I FPNXT
+
+KLUDGM, FSTA+LONG
+ FTEMP /SAVE AC
+OPM, 0
+AD1, 0 /PERFORM OP
+PUTM, 0
+AD2, 0 /STORE RESULT
+ FLDA+LONG
+ FTEMP /RESTORE AC
+ FEXIT
+
+NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE
+ PAGE
+\f/MAIN INTERPRETER LOOP
+
+NEGFAC, JMS I [FFNEG
+
+ICYCLE, CLA
+ JMS I [FETPC /GET INST
+ DCA INST
+ TAD INST
+ CLL RTL
+ RTL
+ SMA /SKIP IF BASEPAGE ADDRESSING
+ JMP LONGI
+ AND [7
+ TAD BASJMP
+ DCA OPJMP /SAVE OPCODE CALL ADDRESS
+ TAD INST /DATA FIELD IS STILL SET UP
+ SZL /SO IS LINK (WITH INSTRUCTION BIT 3)
+ JMP BPAGEI /INDIRECT ADDRESSING
+ CLL RAL
+ TAD INST /MULTIPLY BASE OFFSET BY 3
+ TAD [200 /ELIMINATE ANY
+ AND (777 /HIGH ORDER BITS
+IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE
+ TAD BASADR /ADD IN BASE PAGE ORIGIN
+BASCDF, HLT /CDF TO BASE PAGE FIELD
+ SZL
+ JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED
+OPJCLL, CLL
+OPJMP, HLT /JMP I EXECUTIONROUTINE
+
+BPAGEI, AND [7
+ DCA ADR
+ TAD ADR
+ CLL CML RAL
+ TAD ADR /FORM 3*OFFSET+1
+ TAD BASADR
+ DCA ADR
+ RTL
+ RTL
+ TAD BASCDF /FORM PROPER CDF
+ DCA ADDRLO
+ADDRLO, HLT /EXECUTE IT
+ TAD I ADR /GET FIELD BITS OF REAL ADDRESS
+ DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC
+ ISZ ADR
+ SKP
+ JMS DFBUMP /WATCH FOR FIELD OVERFLOW
+ TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD
+ JMP INDEX /NOW GO DO INDEXING (IF ANY)
+\f/COME HERE IF BIT 4 OF INSTRUCTION IS OFF
+
+LONGI, AND [7
+ SNL /TEST BIT 3 OF INSTRUCTION
+ JMP I (SPECAL /SPECIAL INSTRUCTION
+ TAD BASJMP
+ DCA OPJMP
+ TAD INST
+ DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD
+ JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
+INDEX, DCA ADDRLO
+ TAD INST
+ AND [70
+ SNA /IS XR NUMBER 0?
+ JMP NOINDX /YES - NO INDEXING
+ JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED)
+ AC7775
+ TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE
+ DCA DCDIDX
+ TAD ADDRLO
+XRADLP, CLL
+ TAD I T
+ SZL
+ ISZ ADDRHI
+ ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES
+ JMP XRADLP
+ DCA ADDRLO
+NOINDX, TAD ADDRHI
+ JMS I MCDF
+ DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF
+ADDRHI, HLT /AND EXECUTE IT
+ TAD ADDRLO
+ JMP OPJCLL /GO EXECUTE THE INSTRUCTION
+
+DFBUMP, 0 /BUMP DATA FIELD
+ DCA DFTMP /SAVE AC
+ RDF
+ TAD (CDF 10
+ DCA .+1
+ HLT
+ TAD DFTMP /RESTORE AC
+ JMP I DFBUMP
+DFTMP, 0
+\fDCDIDX, 0
+ CLL RTR
+ RAR
+ TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY
+XRCDF, HLT /CDF TO XR ARRAY FIELD
+ SZL
+ JMS DFBUMP /OR MAYBE NEXT FIELD
+ DCA T /SAVE POINTER TO XR
+ TAD INST
+ AND DCD100
+ SZA CLA /INCREMENT BIT ON?
+ ISZ I T /YES - BUMP XR
+DCD100, 100 /** PROTECTION
+ JMP I DCDIDX
+
+BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE
+
+JMPTB1, FFGET / F MODE (FLOATING POINT)
+ FFADD
+ FFSUB
+ FFDIV
+ FFMPY
+ OPMEM /FADDM
+ FFPUT
+ OPMEM /FMULM
+
+ DDGET / D MODE ( DOUBLE PRECISION INTEGER)
+ DDADD
+ DDSUB
+ DDDIV
+ DDMPY
+ OPMEM /DADDM
+ DDPUT
+ OPMEM /DMULM
+
+ EEGET / E MODE ( 6 WD FLOATING POINT)
+ FFADD
+ FFSUB
+ FFDIV
+ FFMPY
+ OPMEM
+ EEPUT
+ OPMEM
+ PAGE
+\f/MORE I CYCLE
+
+SPECAL, SNA
+ JMP XRINST /OPCODE 0 HAS MANY MANSIONS
+ TAD SPECOP
+ DCA SPCJMP /GET OPCODE JUMP ADDRESS
+ JMS I [FETPC
+ DCA ADR
+ TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS
+ JMS I MCDF /SO FORM THE ADDRESS NOW
+ DCA DATAF
+ CDF 0
+ TAD INST
+SPCJMP, HLT
+
+XRINST, TAD INST
+ AND (7770
+ CDF 0
+ SNA CLA /IF SUB-OPCODE IS ZERO,
+ JMP OPERAT /DECODE SUB-SUB-OPCODE
+ TAD INST
+ AND [7
+ CLL
+ TAD XRBASE
+ DCA ADR /COMPUTE INDEX REGISTER ADDRESS
+ RTL
+ RTL
+ TAD I (XRCDF
+ DCA DATAF
+XJCOMN, TAD INST
+ CLL RTR
+ RAR
+ AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0
+OXCOMN, TAD (JMP I SP2
+ DCA .+1 /EXECUTE APPROPRIATE JUMP
+ HLT
+
+OPERAT, TAD INST
+ CIA
+ JMP OXCOMN
+
+SETX, TAD DATAF /SET XR0 LOC
+ DCA I (XRCDF
+ TAD ADR
+ DCA XRBASE
+ JMP I FPNXT
+\f/JUMP DECODER
+
+JUMPS, AND (100 /INSTRUCTION IN AC
+ CLL RTR /20 IN AC IF NOT COND. JUMP
+ SZA /IF NOT COND. JUMP, DECODE FURTHER
+ JMP XJCOMN
+ TAD INST
+ AND [70
+ CLL RTR
+ RAR
+ TAD (CNDSKT
+ DCA T /INDEX INTO CONDITIONAL SKIP TABLE
+ TAD I T
+ DCA CNDSKP
+ TAD ACH
+ SZA
+ JMP CNDSKP
+ TAD ACL
+ SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED.
+ IAC /USE LOW ORDER ON 0/NOT 0 BASIS
+CNDSKP, HLT /TEST AC
+ JMP I FPNXT /FAILED - DON'T JUMP
+
+DOJMP, STA CLL
+ TAD ADR
+ DCA PC
+ SNL
+ TAD (-10
+ TAD DATAF
+ CDF 0
+ DCA I (PCCDF /ADDRESS-1 TO PC
+ JMP I .+1
+YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8
+
+JXN, AND [70 /GET XR FIELD
+ JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING
+ TAD I T
+ SNA CLA /ZERO?
+ JMP I FPNXT /YES
+ JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT?
+
+CNDSKT, SZA CLA /JEQ
+ SPA CLA /JGE
+ SMA SZA CLA /JLE
+ SKP CLA /JA
+ SNA CLA /JNE
+ SMA CLA /JLT
+ SPA SNA CLA /JGT
+ JMP TSTALN /JAL
+
+TSTALN, CLA
+ TAD ACX
+ TAD (-27
+ SPA SNA CLA
+ JMP I FPNXT
+ JMP DOJMP
+\f/OPCODE TABLES
+
+SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE
+ JUMPS
+ JXN
+ TRAP3I
+ TRAP4I
+ TRAP5I
+ TRAP6I
+ TRAP7I
+
+ FPJAC
+ STRTD
+ STRTF
+ NRMFAC
+ NEGFAC
+ CLFAC
+ FPAUSE
+SP2, EXIT
+ ALN
+ ATX
+ FPXTA
+ ICYCLE /NOP
+ STRTE
+ ICYCLE /UNDEF OP
+ ICYCLE /"
+ FPLDX
+ ADDX
+ SETX
+ SETB
+ JSA
+ JSR
+ PAGE
+\f/MISCELLANEOUS OPCODE ROUTINES
+
+TRAP3I,
+TRAP4I, AC0002
+ TAD DATAF
+ DCA .+1 /FORM CDF CIF N
+ HLT /EXECUTE IT
+ TAD INST
+ SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS,
+ JMP I ADR /TRAP3 JMP'S TO IT
+ JMS I ADR
+ JMP I FPNXT
+
+ALN, TAD ACX /ALIGN SIMULATOR
+ DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE
+ TAD DFLG
+ SMA SZA CLA
+ DCA ACX /ZERO EXP IF D.I. MODE
+ JMS DATCDF /SET TO XR FIELD
+ TAD INST
+ AND [7
+ TAD DFLG /IF WE'RE IN FLOATING POINT MODE,
+ SNA CLA /AND DOING AN "ALN 0",
+ TAD [27 /ALIGN UNTIL EXPONENT = 23
+ SNA
+ TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
+ CDF 0
+ CIA
+ TAD ACX
+ CMA /FORM DIFFERENCE - 1
+ SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT,
+ JMP ALNSHL /SHIFT LEFT
+ JMS I [ACSR /OTHERWISE SHIFT RIGHT
+ALNXIT, TAD DFLG
+ SPA SNA CLA /IF DOUBLE INTEGER MODE,
+ JMP I FPNXT
+ TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED
+ DCA ACX
+ JMP I FPNXT
+ALNSHL, DCA T /STORE SHIFT COUNT
+ SKP /SHIFT LEFT ONE LESS THAN COUNT
+ JMS I [AL1BMP
+ ISZ T
+ JMP .-2
+ JMP ALNXIT /GO TO COMMON CODE
+\f/ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS
+
+DARGET, 0
+ DCA ADR
+ TAD DARGET
+ DCA ARGET
+ DCA ACX
+ JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE
+
+ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC.
+ DCA ADR /STORE ADDRESS OF OPERAND
+ TAD I ADR /PICK UP EXPONENT
+ ISZ ADR /MOVE POINTER TO HI MANTISSA WD
+ SKP
+ JMS I (DFBUMP
+ARGET2, DCA OPX
+ TAD I ADR /PICK IT UP
+ DCA OPH /STORE
+ ISZ ADR /MOVE PTR. TO LO MANTISSA WD.
+ SKP
+ JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS!
+ TAD I ADR /PICK IT UP
+ DCA OPL /STORE IT
+ CDF 0
+ JMP I ARGET /RETURN
+
+STRTE, TAD DFLG /START EXTENDED PRECISION MODE
+ SPA CLA
+ JMP .+4 /CLEAR EXTENDED FAC
+ DCA EAC1 /IF NOT ALREADY IN E MODE
+ DCA EAC2
+ DCA EAC3
+ AC7775
+ DCA DFLG
+ JMP DFECMN
+
+STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE
+STRTF, DCA DFLG /START FLOATING POINT MODE
+ TAD DFLG
+DFECMN, TAD (CLL
+ DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC"
+ TAD DFLG
+ SPA
+ CMA /CHANGE -3 FOR E MODE TO +2
+ CLL RTL
+ RAL
+ TAD (JMPTB1&177+5600
+ DCA I (BASJMP
+ JMP I FPNXT
+\f/DOUBLE PRECISION INTEGER OPERATORS
+
+DDSUB, JMS DARGET
+ JMS I (OPNEG
+ SKP
+DDADD, JMS DARGET
+ DCA AC1 /CLEAR OVERFLOW JUSTINCASE
+ JMS I [OADD
+ JMP I FPNXT
+
+FFGET, DCA ADR /GET A FLOATING POINT NUMBER
+ TAD I ADR
+ DCA ACX /SAVE EXPONENT
+ ISZ ADR
+ JMP .+3 /NO FIELD OVERFLOW
+ JMS I (DFBUMP /BUMP DATA FIELD
+DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET
+ TAD I ADR
+ DCA ACH
+ ISZ ADR
+ SKP
+ JMS I (DFBUMP
+ TAD I ADR
+ DCA ACL
+ JMP I FPNXT
+
+FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER
+ TAD ACX /GET FAC AND STORE IT
+ DCA I ADR /AT SPECIFIED ADDRESS
+ ISZ ADR
+ JMP .+3
+ JMS I (DFBUMP
+DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT
+ TAD ACH
+ DCA I ADR
+ ISZ ADR
+ SKP
+ JMS I (DFBUMP
+ TAD ACL
+ DCA I ADR
+ JMP I FPNXT
+ PAGE
+\fFPPKG= . /FOR EAE OVERLAY
+
+/23-BIT FLOATING PT INTERPRETER
+/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
+
+LPBUF2, ZBLOCK 16
+ LPBUF3
+
+AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER
+ STA
+ TAD ACX
+ DCA ACX
+ JMS I [AL1
+ JMP I AL1BMP
+
+/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
+DDMPY, JMS I (DARGET
+ SKP
+FFMPY, JMS I (ARGET /GET OPERAND
+ JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN.
+ TAD ACX /DO EXPONENT ADDITION
+ DCA ACX /STORE FINAL EXPONENT
+ DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE
+ DCA AC2
+ TAD ACH /IS FAC=0?
+ SNA CLA
+ DCA ACX /YES-ZERO EXPONENT
+ JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR.
+ TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
+ DCA OPL
+ JMS MP24
+ TAD AC2 /STORE RESULT BACK IN FAC
+ DCA ACL /LOW ORDER
+ TAD MDSET /HIGH ORDER
+ DCA ACH
+ TAD ACH /DO WE NEED TO NORMALIZE?
+ RAL
+ SMA CLA
+ JMS AL1BMP /YES-DO IT FAST
+ TAD AC1
+ SPA CLA /CHECK OVERFLOW WORD
+ ISZ ACL /HIGH BIT ON - ROUND RESULT
+ JMP MDONE
+ ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER
+ TAD ACH
+ SPA /CHECK FOR OVERFLOW TO 4000 0000
+ JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE
+ CLA
+\fMDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???)
+ ISZ MSIGN /SHOULD RESULT BE NEGATIVE?
+ SKP /NO
+ JMS I [FFNEG /YES-NEGATE IT
+ TAD ACH
+ SNA CLA /A ZERO AC MEANS A ZERO EXPONENT
+ DCA ACX
+ TAD DFLG
+ SMA SZA CLA /D.P. INTEGER MODE?
+ TAD ACX /WITH ACX LESS THAN 0?
+ SNA
+ JMP I FPNXT /NO - RETURN
+ CMA
+ JMS I [ACSR /UN-NORMALIZE RESULT
+ JMP I FPNXT /RETURN
+\f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
+/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
+/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
+/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
+/DATA FIELD SET PROPERLY FOR OPERAND.
+
+MDSET, 0
+ CLA CLL CMA RAL /SET SIGN CHECK TO -2
+ DCA MSIGN
+ TAD OPH /IS OPERAND NEGATIVE?
+ SMA CLA
+ JMP .+3 /NO
+ JMS I (OPNEG /YES-NEGATE IT
+ ISZ MSIGN /BUMP SIGN CHECK
+ TAD OPL /AND SHIFT OPERAND LEFT ONE BIT
+ CLL RAL
+ DCA OPL
+ TAD OPH
+ RAL
+ DCA OPH
+ DCA AC1 /CLR. OVERFLOW WORF OF FAC
+ TAD ACH /IS FAC NEGATIVE
+ SMA CLA
+ JMP LEV /NO-GO ON
+ JMS I [FFNEG /YES-NEGATE IT
+ ISZ MSIGN /BUMP SIGN CHECK
+ NOP /MAY SKIP
+LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC
+ JMP I MDSET
+MSIGN, 0
+\f/24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL
+/MULTIPLICAND IS IN ACH AND ACL
+/RESULT LEFT IN MDSET,AC2, AND AC1
+
+MP24, 0
+ TAD (-14 /SET UP 12 BIT COUNTER
+ DCA OPX
+ TAD OPL /IS MULTIPLIER=0?
+ SZA
+ JMP MPLP1 /NO-GO ON
+ DCA AC1 /YES-INSURE RESULT=0
+ JMP I MP24 /RETURN
+MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER
+MPLP1, RAR /OF MULTIPLIER AND INTO LINK
+ DCA OPL
+ SNL /WAS IT A 1?
+ JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT
+ TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
+ TAD ACL /LOW ORDER
+ DCA AC2
+ CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK!
+ TAD ACH /HI ORDER
+MPLP2, TAD MDSET
+ RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
+ DCA MDSET
+ TAD AC2
+ RAR
+ DCA AC2
+ TAD AC1
+ RAR /OVERFLOW TO AC1
+ DCA AC1
+ ISZ OPX /DONE ALL 12 MULTIPLIER BITS?
+ JMP MPLP /NO-GO ON
+ JMP I MP24 /YES-RETURN
+ PAGE
+\f/DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE
+
+DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
+ JMS I ERR /GIVE ERROR MSG
+ TAD DBAD
+ DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER
+ AC2000
+ JMP FD
+
+/FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD
+
+DDDIV, JMS I (DARGET
+ SKP
+FFDIV, JMS I (ARGET /GET OPERAND
+ JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
+ CMA IAC /NEGATE EXP. OF OPERAND
+ TAD ACX /ADD EXP OF FAC
+ DCA ACX /STORE AS FINAL EXPONENT
+ TAD OPH /NEGATE HI ORDER OP. FOR USE
+ CLL CMA IAC /AS DIVISOR
+ DCA OPH
+ JMS DV24 /CALL DIV.--(ACH+ACL)/OPH
+ TAD ACL /SAVE QUOT. FOR LATER
+ DCA AC1
+ TAD OPL
+ SNA CLA
+ JMP DVL2 /AVOID MULTIPLYING BY 0
+ TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY
+ DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY
+ JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
+
+/DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0)
+
+DV24, 0
+ TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND
+ TAD OPH /DIVISOR IN OPH (NEGATIVE)
+ SZL CLA /IS IT?
+ JMP DBAD /NO-DIVIDE OVERFLOW
+ TAD (-15 /YES-SET UP 12 BIT LOOP
+ DCA AC2
+ JMP DV1 /GO BEGIN DIVIDE
+DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT
+ RAL
+ DCA ACH /RESTORE HI ORDER
+ TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER
+ TAD OPH /DIVIDEND
+ SZL /GOOD SUBTRACT?
+ DCA ACH /YES-RESTORE HI DIVIDEND
+ CLA /NO-DON'T RESTORE--OPH.GT.ACH
+DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT
+ RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL
+ DCA ACL
+ ISZ AC2 /DONE 12 BITS OF QUOT?
+ JMP DV2 /NO-GO ON
+ JMP I DV24 /YES-RETN W/AC2=0
+\f/DIVIDE ROUTINE CONTINUED
+
+MP12L, DCA OPL /STORE BACK MULTIPLIET
+ TAD AC2 /GET PRODUCT SO FAR
+ SNL /WAS MULTIPLIER BIT A 1?
+ JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT
+ CLL /YES-CLEAR LINK AND ADD MULTIPLICAND
+ TAD ACL /TO PARTIAL PRODUCT
+ RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
+ DCA AC2 /RESULT-STORE BACK
+DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER
+ RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
+ ISZ DV24 /DONE ALL BITS?
+ JMP MP12L /NO-LOOP BACK
+ CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
+ DCA ACL /NEGATE AND STORE
+ CML RAL /PROPAGATE CARRY
+ TAD AC2 /NEGATE HI ORDER PRODUCT
+ STL CIA
+ TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV.
+ SZL /WELL?
+ JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
+ DCA ACH /OK - DO (REM - (Q*OPL)) / OPH
+DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND)
+DVL1, TAD AC1 /GET QUOT. OF FIRST DIV.
+ SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
+ JMP FD /NO-ITS NORMALIZED-DONE
+SHR1, CLL
+ ISZ ACL /ROUND AND SHIFT RIGHT ONE
+ SKP
+ IAC /DOUBLE PRECISION INCREMENT
+ RAR
+ DCA ACH /STORE IN FAC
+ TAD ACL /SHIFT LOW ORDER RIGHT
+ RAR
+ DCA ACL /STORE BACK
+ ISZ ACX /BUMP EXPONENT
+ NOP
+ TAD ACH
+ JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN
+FD, DCA ACH /STORE HIGH ORDER RESULT
+ JMP I (MDONE /GO LEAVE DIVIDE
+
+DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0
+ JMP DVL3 /SAVE SOME TIME
+\f/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
+/REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL
+
+DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER
+ DCA ACH
+ CLL
+ TAD OPH
+ TAD ACH /WATCH FOR OVERFLOW
+ SNL
+ JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
+ DCA ACH /NO OVERFLOW-STORE NEW REM.
+ CMA /SUBTRACT 1 FROM QUOT OF
+ TAD AC1 /FIRST DIVIDE
+ DCA AC1
+DVOP1, CLA CLL
+ TAD ACH /GET HI ORD OF REMAINDER
+ SNA /IS IT ZERO?
+DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO
+ DCA ACH
+ JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR
+ TAD ACL /NEGATE THE RESULT
+ CLL CMA IAC
+ DCA ACL
+ SNL /IF QUOT. IS NON-ZERO, SUBTRACT
+ CMA /ONE FROM HIGH ORDER QUOT.
+ JMP DVL1 /GO TO IT
+
+LPBUF3, ZBLOCK 12
+ LPBUF4
+ PAGE
+\f/"OPNEG" MUST BE AT 0 ON PAGE
+
+OPNEG, 0 /ROUTINE TO NEGATE OPERAND
+ TAD OPL /GET LOW ORDER
+ CLL CIA /NEGATE AND STORE BACK
+ DCA OPL
+ CML RAL /PROPAGATE CARRY
+ TAD OPH /GET HI ORDER
+ CLL CIA /NEGATE AND STORE BACK
+ DCA OPH
+ JMP I OPNEG
+/
+/FLOATING SUBTRACT AND ADD
+/
+FFSUB, JMS I (ARGET /PICK UO THE OP.
+ JMS OPNEG /NEGATE OPERAND
+ SKP
+FFADD, JMS I (ARGET /PICK UP OPERAND
+ TAD OPH /IS OPERAND = 0
+ SNA CLA
+ JMP I FPNXT /YES-DONE
+ TAD ACH /NO-IS FAC=0?
+ SNA CLA
+ JMP CLROFL /CLEAR OUT THE OVERFLOW BITS
+ TAD ACX /NO-DO EXPONENT CALCULATION
+ CLL CIA
+ TAD OPX
+ SMA SZA /WHICH EXP. GREATER?
+ JMP FACR /OPERANDS-SHIFT FAC
+ CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1
+ TAD (-30
+ SMA /TEST FOR INSIGNIFICANCE
+ JMP OPINSG /YES - ANSWER IS FAC
+ TAD (30
+ JMS OPSR
+ JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT
+DOADD, TAD OPX /SET EXPONENT OF RESULT
+ DCA ACX
+ JMS I [OADD /DO THE ADDITION
+ JMS FFNOR /NORMALIZE RESULT
+ JMP I FPNXT /RETURN
+FACR, TAD (-30
+ SMA /TEST FOR INSIGNIFICANCE
+ JMP ACINSG /YES - ANSWER IS OPR
+ TAD (30
+ JMS I [ACSR /SHIFT FAC = DIFF.+1
+ JMS OPSR /SHIFT OPR. 1 PLACE
+ JMP DOADD /DO ADDITION
+
+OPINSG, CLA
+ JMP I FPNXT
+\f/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC
+
+OPSR, 0
+ CMA /- (COUNT+1) TO SHIFT COUNTER
+ DCA AC0
+LOP2, TAD OPH /GET SIGN BIT
+ CLL /TO LINK
+ SPA
+ CML /WITH HI MANTISSA IN AC
+ RAR /SHIFT IT RIGHT, PROPAGATING SIGN
+ DCA OPH /STORE BACK
+ TAD OPL
+ RAR
+ DCA OPL /STORE LO ORDER BACK
+ ISZ OPX /INCREMENT EXPONENT
+ NOP
+ ISZ AC0 /DONE ALL SHIFTS?
+ JMP LOP2 /NO-LOOP
+ RAR /SAVE 1 BIT OF OVERFLOW
+ DCA AC2 /IN AC2
+ JMP I OPSR /YES-RETN.
+
+FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC
+ TAD ACH /GET THE HI ORDER MANTISSA
+ SNA /ZERO?
+ TAD ACL /YES-HOW ABOUT LOW?
+ SNA
+ TAD AC1 /LOW=0, IS OVRFLO BIT ON?
+ SNA CLA
+ JMP ZEXP /#=0-ZERO EXPONENT
+NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC
+ TAD ACH /ADD HI ORDER MANTISSA
+ SZA /HI ORDER = 6000
+ JMP .+3 /NO-CHECK LEFT MOST DIGIT
+ TAD ACL /YES-6000 OK IF LOW=0
+ SZA CLA
+ SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS.
+ JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7)
+ JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN
+ JMP NORMLP /GO BACK AND SEE IF NORMALIZED
+ZEXP, DCA ACX
+FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1
+ JMP I FFNOR /RETURN
+
+ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION
+ DCA ACH
+ DCA ACL
+ JMP DOADD-1 /FAKE AN ADD WITH OPR=0
+
+LPBUF4, ZBLOCK 40
+ LPBUFE
+CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD
+ DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD
+ JMP DOADD /FAC=0; DO THE ADD
+ PAGE
+\f/PAGE 7400 UNUSED RIGHT NOW
+
+LPBUFE, ZBLOCK 177
+ LPBUFR
+ FIELD 1
+\f
--- /dev/null
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT SIGN
+ ENTRY ISIGN
+ JA #ST
+#XR, ORG .+10
+ TEXT 'SIGN '
+#BASE, ORG .+3
+A, ORG .+3
+B, ORG .+3
+ ORG #BASE+31
+ JA #BASE
+GOBACK, 0;0;0
+ BASE #BASE
+ISIGN,
+#ST, STARTD
+ 0210
+ FSTA GOBACK+1,0
+ 0200
+ SETX #XR
+ SETB #BASE
+ LDX 0,1
+ FSTA #BASE
+ FLDA% #BASE,1+
+ FSTA A
+ FLDA% #BASE,1+
+ FSTA B
+ STARTF
+ FLDA% B
+ JLT #50
+ FLDA% A
+ JLT #100
+ JA GOBACK+1
+#50, FLDA% A
+ JLT GOBACK+1
+#100, FNEG
+ JA GOBACK+1
+ END
+\f
--- /dev/null
+/
+/
+/ S I N
+/ - - -
+/
+/SUBROUTINE SIN(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT SIN
+ JA #SIN
+ EXTERN #ARGER
+SINER, TRAP4 #ARGER
+ TEXT +SIN +
+SINXR, SETX XRSIN
+ SETB BPSIN
+BPSIN, F 0.0
+XRSIN, F 0.0
+SIN1, F 0.0
+SIN2, F 0.0
+F1SIN, F 1.
+FPI2SN, 1 /PI DIVIDED BY 2
+ 3110
+ 3755
+FPISIN, 2 /PI
+ 3110
+ 3755
+F2PISN, 3 /TWO PI
+ 3110
+ 3755
+ ORG 10*3+BPSIN
+ FNOP
+ JA SINXR
+ 0
+SINRTN, JA .
+/
+SINC9, 7764
+ 2501
+ 7015
+/
+SINC7, 7771
+ 5464
+ 5515
+/
+SINC5, 7775
+ 2431
+ 5362
+/
+SINC3, 0000
+ 5325
+ 0414
+/
+SINTST, 7770
+ 2000
+ 0000
+ BASE 0
+#SIN, STARTD
+ FLDA 10*3
+ FSTA SINRTN
+ FLDA 0
+ SETX XRSIN
+ SETB BPSIN
+ BASE BPSIN
+ LDX 1,1
+ FSTA BPSIN
+ FLDA% BPSIN,1 /ADDR OF X
+ FSTA BPSIN
+ STARTF
+ FLDA% BPSIN /GET X
+ LDX -1,0 /SET SIGN TO POSITIVE.
+ JGT SINMOD /IF POSITIVE BYPASS FUDGE.
+ JEQ SINRTN /IF ZERO EXIT.
+ FNEG /NEGATIVE. NEGATE AC. SIN(-X)=-SIN(X)
+ LDX 0,0 /SET SIGN TO MINUS.
+SINMOD, JAL SINER /IF SIGN CAN T INT, THEN ERROR.
+ FDIV F2PISN /REDUCE TO BELOW TWO PI.
+ FSTA SIN1 /SAVE IN A TEMP.
+ ALN 0
+ FNORM /INTERGIZE IT.
+ FNEG
+ FADD SIN1 /RECALL NUMBER. AC NOW <0
+ FMUL F2PISN /NOW MULTIPLY BACK.
+ FSTA SIN2 /AND SAVE AWAY.
+ FSUB FPISIN /SUBTRACT OFF PI.
+ JLT SINP /LESS THEN PI.
+ FSTA SIN2 /RESTORE AS 2.
+ XTA 0 /INVERT THE SIGN.
+ FNEG
+ FSUB F1SIN /SIN(X-PI)=-SIN(X)
+ ATX 0 /AND PUT BACK.
+/
+SINP, FLDA SIN2 /RECALL MAGIC GOODY.
+ FSUB FPI2SN /TEST TO SEE IF X<PI/2
+ JLT SINPP /YEP.
+/
+ FLDA FPISIN /SIN(X)=SIN(PI-X)
+ FSUB SIN2
+ FSTA SIN2 /AND STORE IT BACK.
+/
+SINPP, FLDA SIN2 /GET THE MAGIC NUMBER.
+ FSUB SINTST /SEE IF ITS CLOSE TO AN EDGE
+ JGT SINPPP /IT IS NOT
+ FLDA SIN2 /RECALL NUMBER IF TOO SMALE
+ JXN SINRTN,0 /EXIT IF SAME SIGN.
+ FNEG /ELSE NEGATE IT.
+ JA SINRTN
+SINPPP, FLDA SIN2 /RECALL NUMBER TO BE WORKED ON.
+ FDIV FPI2SN /DIVIDE BY PI OVER TWO.
+ FSTA SIN2 /AND STORE BACK.
+ FMUL SIN2 /MULTIPLY OUT.
+ FSTA SIN1
+ FMUL SINC9 /NOW DO THE STANDARD ITERATION.
+ FADD SINC7
+ FMUL SIN1
+ FADD SINC5
+ FMUL SIN1
+ FADD SINC3
+ FMUL SIN1
+ FADD FPI2SN /ADD IN PI OVER 2
+ FMUL SIN2 /DO THE FINAL MULTIPLY.
+ JXN SINRTN,0 /SHALL WE NEGATE
+ FNEG /YEP
+ JA SINRTN /AND RETURN.
+\f
--- /dev/null
+/
+/
+/ S I N D
+/ - - - -
+/
+/SUBROUTINE SIND(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT SIND
+ JA #SIND
+ TEXT +SIND +
+SINDXR, SETX XRSIND
+ SETB BPSIND
+BPSIND, FNOP
+ 0
+ 0
+XRSIND, F 0.0
+SIND91, 6
+ 3451
+ 3560
+SIND1, F 0.0
+ ORG 10*3+BPSIND
+ FNOP
+ JA SINDXR
+ 0
+SNDRTN, JA .
+ BASE 0
+#SIND, STARTD
+ FLDA 10*3
+ FSTA SNDRTN
+ FLDA 0
+ SETX XRSIND
+ SETB BPSIND
+ BASE BPSIND
+ LDX 1,1
+ FSTA BPSIND
+ FLDA% BPSIND,1 /ADDR OF X
+ FSTA BPSIND
+ STARTF
+ FLDA% BPSIND /GET X IN DEGREES
+ FDIV SIND91 /CONVERT TO RADIANS
+ FSTA SIND1
+ EXTERN SIN
+ JSR SIN /CALL THE SINE
+ JA SNDRTN
+ JA SIND1
+\f
--- /dev/null
+/
+/
+/ S I N H
+/ - - - -
+/
+/SUBROUTINE SINH(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT SINH
+ JA #SINH
+ TEXT +SINH +
+SINHXR, SETX XRSINH
+ SETB BPSINH
+BPSINH, FNOP
+ 0
+ 0
+XRSINH, F 0.0
+SINH6, F 0.0
+SINH7, F 0.0
+SINH8, F 0.0
+F1SINH, F 1.
+F2SINH, F 2.
+ ORG 10*3+BPSINH
+ FNOP
+ JA SINHXR
+ 0
+SNHRTN, JA .
+/
+SINHLG, 0
+ 2613
+ 4412
+/
+SINH1, F .1
+/
+SINH2, F 87.929
+/
+SINH3, F 6.
+/
+SINH4, F 120.
+ BASE 0
+#SINH, STARTD
+ FLDA 10*3
+ FSTA SNHRTN
+ FLDA 0
+ SETX XRSINH
+ SETB BPSINH
+ BASE BPSINH
+ LDX 1,1
+ FSTA BPSINH
+ FLDA% BPSINH,1 /ADDR OF X
+ FSTA BPSINH
+ STARTF
+ FLDA% BPSINH /GET X
+ FSTA SINH8 /SAVE THE ARGUMENT.
+ JGE .+3 /MAKE IT POSITIVE.
+ FNEG
+ FSTA SINH7 /AND SAVE ABS VALUE IN CASE WE NEED IT.
+ FSUB SINH1 /IS IT LESS THEN .1?
+ JLE SINHSR /YES. USE SERIES APPROXIMATION.
+ FSUB SINH2 /IS IT GREATER THEN 88.029?
+ JGE SINHAP /YES. USE LOG(2) APPROXIMATION.
+ EXTERN EXP
+ JSR EXP /EXP(X)
+ JA .+4
+ JA SINH8
+ FSTA SINH7
+ FLDA F1SINH
+ FDIV SINH7 /1/EXP(X)
+ FNEG /-1/EXP(X)
+ FADD SINH7 /EXP(X)-1/EXP(X)
+ FDIV F2SINH / 1/2(EXP(X)-1/EXP(X))
+ JA SNHRTN /AND RETURN NOW.
+/
+/
+SINHAP, FLDA SINH7 /RECALL ABSOULTE VALUE.
+ FSUB SINHLG /ABS(X)-LN(2)
+ FSTA SINH7 /EXP(ABS(X)-LN(2))
+ EXTERN EXP
+ JSR EXP
+ JA .+4
+ JA SINH7
+ FSTA SINH7
+ FLDA SINH8 /GET SIGN OF ARGUMENT.
+ JGE SPLR /LOAD POSITIVE IF ARG WAS POSITIVE.
+ FLDA SINH7
+ FNEG /ELSE NEGATE IT.
+ JA SNHRTN /AND RETURN.
+SPLR, FLDA SINH7
+ JA SNHRTN
+/
+/
+SINHSR, FLDA SINH8 /X SERIES IF X<.1
+ FMUL SINH8 /X^2
+ FSTA SINH7 /X^2
+ FMUL SINH8 /X^3
+ FSTA SINH6 /X^3
+ FMULM SINH7 /X^5
+ FDIV SINH3 /X^3/6
+ FADDM SINH8 /X+X^3/6
+ FLDA SINH7 /X^5
+ FDIV SINH4 /X^5/120
+ FADD SINH8 /X+X^3/6+X^5/120
+ JA SNHRTN /VOILA. WE ARE DONE.
+\f
--- /dev/null
+/ SUBROUTINE SNGL - DBL PREC TO REAL
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT SNGL
+ DPCHK
+ BASE 0
+ FLDA 0
+ STARTD
+ FSTA RETRN
+ FADD TWO
+ FSTA 3
+ FLDA% 3
+ FSTA 3
+ STARTE
+ FLDA% 3
+ STARTF
+ JA RETRN
+RETRN, 0;0
+TWO, 0;2
+\f
--- /dev/null
+/
+/
+/ S Q R T
+/ - - - -
+/
+/SUBROUTINE SQRT(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT SQRT
+ JA #SQRT
+ 0 /THE MANTISSA ND EXPOENT DIDDLE AREAS.
+ 0
+SQRTEX, 0
+ 0
+SQRT13, 0
+ 0
+ 13 /PHONEY EXPONENT PATCH.
+/
+ EXTERN #ARGER
+SQRTM1, TRAP4 #ARGER
+ TEXT +SQRT +
+SQRTXR, SETX XRSQRT
+ SETB BPSQRT
+BPSQRT, F 0.0
+XRSQRT, F 0.0
+SQRT1, F 0.0
+SQRT2, F 0.0
+SQRT3, F 0.0
+F1SQRT, F 1.
+F2SQRT, F 2.
+ ORG 10*3+BPSQRT
+ FNOP
+ JA SQRTXR
+ 0
+SQTRTN, JA .
+SQRTS1, 0 /IF BETWEEN 1/4 & 1/2
+ 3200
+ 0
+ 0 /IF BETWEEN 1/2 & 1
+ 2240
+ 0
+/
+SQRTS2, 7777 /IF BETWEEN 1/4 & 1/2
+ 2327
+ 7772
+ 7777 /IF BETWEEN 1/2 & 1
+ 3300
+ 0
+ BASE 0
+#SQRT, STARTD
+ FLDA 10*3
+ FSTA SQTRTN
+ FLDA 0
+ SETX XRSQRT
+ SETB BPSQRT
+ BASE BPSQRT
+ LDX 1,1
+ FSTA BPSQRT
+ FLDA% BPSQRT,1 /ADDR OF X
+ FSTA BPSQRT
+ STARTF
+ FLDA% BPSQRT /GET X
+ JEQ SQTRTN /IF =0 JUST RTN
+ JLT SQRTM1 /IF <0 THEN ERROR
+ FSTA SQRTEX+1 /SAVE NUMBER AWAY FOR A SECOND.
+ FLDA SQRT13 /GET A RIGHT ADJUSTED 13 IN THE FAC.
+ FSTA SQRTEX-2 /STORE AWAY RIGHT AHEAD OF THE EXPONENT.
+ FLDA SQRTEX /NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD.
+ ALN 0 /CHOP OFF CRAP.
+ JEQ SQRTSC /IS IT EXACTLY ZERO? IF SO, SPECIAL CASE.
+ FNORM /NORMALIZE IT.
+ FSUB F1SQRT /NOW SUBTRACT ONE FROM IT.
+ FDIV F2SQRT /CHOP IT IN HALF NOW.
+ FSTA SQRT1 /AND SAVE 1/2 EXP IN A TEMP.
+ ALN 0 /NOW FIX THE EXPONENT.
+ FNORM /AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS.
+ FSUB SQRT1 /NOW SUBTRACT OFF EXTRANEOUS BITS.
+ FMUL F2SQRT /EXPAND IT AGAIN [FAC =0 OR -1], OR 0 TO +1
+ JGE .+3 /MAKE SURE ITS POSITIVE.
+ FNEG /NOW MAKE IT 0 IF NO BIT OR +1 IF BIT
+SQRTBK, ATX 1 /SAVE IN AN INDEX.
+ FSUB F1SQRT /SUBTRACT ONE TO MAKE IT -1 IF NO BIT OR 0 IF BIT.
+ ALN 0 /AND NOW SHIFT IT RIGHT.
+ FSTA SQRTEX-1 /AND SAVE IT OVER THE OLD EXPONENT.
+ FLDA SQRT1 /RECALL OLD PART
+ ALN 0 /FIX IT UP, NOW.
+ FSTA SQRT1 /AND STORE IT BACK FOR LATER USE
+/
+/ SQRTEX IS NOW 1/4 <X< 1
+/
+ FLDA SQRTEX+1 /RECALL NUMBER.
+ FSTA SQRT2 /SAVE IN A TEMP.
+/
+ FMUL SQRTS1,1 /MULTIPLY BY CORRECT CONSTANT.
+ FADD SQRTS2,1 /AND NOW ADD IN CORRECT CONSTANT.
+/
+/ NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR
+/ 1/2<X<1
+/
+ FSTA SQRT3 /SAVE IN A SECOND TEMP.
+ FLDA SQRT2 /RECALL INITIAL.
+ FDIV SQRT3 /CALCULATE X(0)/X(1)
+ FADD SQRT3 /X(1)+X(0)/X(1)
+ FDIV F2SQRT /1/2(X(1)+X(0)/X(1))
+ FSTA SQRT3 /SAVE AGAIN. NOW X(2)
+ FLDA SQRT2 /RECALL ORIGINAL.
+ FDIV SQRT3 /X(0)/X(2)
+ FADD SQRT3 /X(2)+X(0)/X(2)
+ FSTA SQRTEX+1 /NOW STORE AWAY FOR FINAL EXPONENT DIDDLING.
+/
+ STARTD
+/
+ FCLA /ZERO HIGH ORDER EXPONENT PART.
+ FSTA SQRTEX-1
+ FLDA SQRT1 /RECALL MODIFIED EXPONENT.
+ FADDM SQRTEX /UPDATE FRACTIONAL EXPONENT.
+/
+ STARTF /RETRUN TO FLOATING MODE.
+/
+ FLDA SQRTEX+1 /PICK UP THE ANSWER.
+ JA SQTRTN /AND RTN
+/
+SQRTSC, FSUB F1SQRT /SPECIAL CASE FUDGE.
+ FSTA SQRT1 /SET EXPONENT ADD ON TO -1.
+ FNEG /AND SET ODD BIT ON.
+ JA SQRTBK /AND GO BACK UP.
+\f
--- /dev/null
+/
+/
+/ T A N
+/ - - -
+/
+/SUBROUTINE TAN(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT TAN
+ JA #TAN
+ EXTERN #ARGER
+TANER, TRAP4 #ARGER
+ TEXT +TAN +
+TANXR, SETX XRTAN
+ SETB BPTAN
+BPTAN, FNOP
+ 0
+ 0
+XRTAN, F 0.0
+TAN1, F 0.0
+TAN2, F 0.0
+ ORG 10*3+BPTAN
+ FNOP
+ JA TANXR
+ 0
+TANRTN, JA .
+ BASE 0
+#TAN, STARTD
+ FLDA 10*3
+ FSTA TANRTN
+ FLDA 0
+ SETX XRTAN
+ SETB BPTAN
+ BASE BPTAN
+ LDX 1,1
+ FSTA BPTAN
+ FLDA% BPTAN,1 /ADDR OF X
+ FSTA BPTAN
+ STARTF
+ FLDA% BPTAN /GET X
+ JEQ TANRTN /IF 0 RTN NOW
+ FSTA TAN1 /SAVE FOR A SECOND
+ EXTERN COS
+ JSR COS /TAKE COS(X)
+ JA .+4
+ JA TAN1
+ JEQ TANER /COS=0. A NO-NO
+ FSTA TAN2 /SAV IT
+ EXTERN SIN
+ JSR SIN /NOW TAKE SIN(X)
+ JA .+4
+ JA TAN1
+ FDIV TAN2 /DIV BY COS(X)
+ JA TANRTN
+\f
--- /dev/null
+/
+/
+/ T A N D
+/ - - - -
+/
+/SUBROUTINE TAND(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT TAND
+ JA #TAND
+ TEXT +TAND +
+TANDXR, SETX XRTAND
+ SETB BPTAND
+BPTAND, FNOP
+ 0
+ 0
+XRTAND, F 0.0
+TAND91, 6
+ 3451
+ 3560
+TAND1, F 0.0
+ ORG 10*3+BPTAND
+ FNOP
+ JA TANDXR
+ 0
+TNDRTN, JA .
+ BASE 0
+#TAND, STARTD
+ FLDA 10*3
+ FSTA TNDRTN
+ FLDA 0
+ SETX XRTAND
+ SETB BPTAND
+ BASE BPTAND
+ LDX 1,1
+ FSTA BPTAND
+ FLDA% BPTAND,1 /ADDR OF X
+ FSTA BPTAND
+ STARTF
+ FLDA% BPTAND /GT X IN DEGREES
+ FDIV TAND91 /CONVERT TO RADIANS
+ FSTA TAND1
+ EXTERN TAN
+ JSR TAN /CALL THE TANGENT
+ JA TNDRTN
+ JA TAND1
+\f
--- /dev/null
+/
+/
+/ T A N H
+/ - - - -
+/
+/SUBROUTINE TANH(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT TANH
+ JA #TANH
+ TEXT +TANH +
+TANHXR, SETX XRTANH
+ SETB BPTANH
+BPTANH, FNOP
+ 0
+ 0
+XRTANH, F 0.0
+TANH1, F 0.0
+TANH2, F 0.0
+ ORG 10*3+BPTANH
+ FNOP
+ JA TANHXR
+ 0
+TNHRTN, JA .
+ BASE 0
+#TANH, STARTD
+ FLDA 10*3
+ FSTA TNHRTN
+ FLDA 0
+ SETX XRTANH
+ SETB BPTANH
+ BASE BPTANH
+ LDX 1,1
+ FSTA BPTANH
+ FLDA% BPTANH,1 /ADDR OF X
+ FSTA BPTANH
+ STARTF
+ FLDA% BPTANH /GET X
+ FSTA TANH1 /SAV IT
+ EXTERN COSH
+ JSR COSH /CALL COSH
+ JA .+4
+ JA TANH1
+ FSTA TANH2 /SAVE COSH(X)
+ EXTERN SINH
+ JSR SINH /CALL SINH
+ JA .+4
+ JA TANH1
+ FDIV TANH2 /SINH/COSH=TANH
+ JA TNHRTN
+\f
--- /dev/null
+/
+/ VERSION 5A 4-26-77 MH
+/
+ SECT #FIX
+ JA .
+ JLT NEGFIX
+ ALN 0
+ FNORM
+ JA #FIX
+NEGFIX, FNEG
+ ALN 0
+ FNORM
+ FNEG
+ JA #FIX
+ END
+\f
--- /dev/null
+/
+/
+/ T A N D
+/ - - - -
+/
+/SUBROUTINE TAND(X)
+/
+/ VERSION 5A 4-27-77 PT
+/
+ SECT TAND
+ JA #TAND
+ TEXT +TAND +
+TANDXR, SETX XRTAND
+ SETB BPTAND
+BPTAND, FNOP
+ 0
+ 0
+XRTAND, F 0.0
+TAND91, 6
+ 3451
+ 3560
+TAND1, F 0.0
+ ORG 10*3+BPTAND
+ FNOP
+ JA TANDXR
+ 0
+TNDRTN, JA .
+ BASE 0
+#TAND, STARTD
+ FLDA 10*3
+ FSTA TNDRTN
+ FLDA 0
+ SETX XRTAND
+ SETB BPTAND
+ BASE BPTAND
+ LDX 1,1
+ FSTA BPTAND
+ FLDA% BPTAND,1 /ADDR OF X
+ FSTA BPTAND
+ STARTF
+ FLDA% BPTAND /GT X IN DEGREES
+ FDIV TAND91 /CONVERT TO RADIANS
+ FSTA TAND1
+ EXTERN TAN
+ JSR TAN /CALL THE TANGENT
+ JA TNDRTN
+ JA TAND1
+\f
--- /dev/null
+This area contains directories that hold the files associated with the
+original release DECtapes of the system sources of OS/8 Version 3D. Each
+area contains a README file that describes the particular section of the
+release.
+
--- /dev/null
+/3 TTY HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -1
+DEVICE AS33;DEVICE TTY;0;1;ZBLOCK 2
+
+ TTYVERSION="A&77
+
+/V3 FIXES:
+
+/1. NOW RECOGNIZES PARITY ^Z ON OUTPUT
+/2. NOW RECOGNIZES ^Z ON OUTPUT EVEN IF NOT
+/ FOLLOWED BY 0'S
+/3. VERSION # IS NOW 1.
+
+ *200
+ /TELETYPE HANDLER - NOT VERY INTELLEGENT.
+ /ONLY RECOGNIZES ^Z AND ^C ON INPUT
+ /AND ^C AND ^O ON OUTPUT
+ /OH WELL, WHAT CAN YOU EXPECT IN ONE PAGE.
+ / THE LOGIC IS VERY SIMILIAR TO THE PTR AND PTP HANDLERS.
+TTY360, 360 /MUST BE FIRST LOC ON PAGE!
+TTY, TTYVERSION
+TT7600, 7600
+ RDF
+ TAD TTYCIF
+ DCA TTYXIT /SAVE RETURN FIELD
+ TAD I TTY
+ AND TT70
+ TAD TTCDF
+ DCA TTYCDF /DATA FIELD OF BUFFER
+ CLA CLL CML RAR
+ TAD I TTY
+ AND TT3700
+ CMA
+ DCA TTYWC
+ ISZ TTY
+ TAD I TTY
+ DCA TTYCA /SAVE BUFFER ADDRESS
+ ISZ TTY
+ ISZ TTY
+ JMP TTKLG
+TTYLP, SNL CLA
+ JMP TTYGLP /ZER LINK MEANS READ
+ JMS TTYTST /TEST FOR ^C
+ TAD TTYM14 /-203-14=-217 =-"^O"
+ SNA CLA
+ JMP TTYCTO
+ TAD I TTYCA /CHARACTER 1 IS LOW ORDER 8 BITS OF WORD 1
+ JMS TTYPCH
+ DCA TTYGCH
+ ISZ TTYCA
+TT7400, 7400
+ TAD I TTYCA /CHARACTER 2 IS LOW ORDER 8 BITS OF WORD 2
+ JMS TTYPCH
+ CLL RTR
+ RTR
+ TAD TTYGCH
+ CLL RTR
+ RTR /CHARACTER 3 IS HIGH ORDER 4 BITS OF WORDS 1 AND 2
+ JMS TTYPCH /WILL SET LINK ON!
+TTLOOP, ISZ TTYCA /AC HAPPENS TO BE ZERO HERE
+TT70, 70
+TTKLG, ISZ TTYWC
+ JMP TTYLP
+TTYRTN, TAD TTYCDF
+ CLL CIA
+ SNL CLA
+ ISZ TTY /SKIP PAST ERROR RETURN
+TTYXIT, HLT /RESTORE CALLING FIELDS
+ RAL
+ JMP I TTY
+TTYPCH, 0 /MUST SET LINK ON!
+ DCA TTYTST
+ TAD TTYTST
+ TAD TTYM32 /ONLY CARE IF LOW ORDER 7 BITS ARE -32
+ AND TTY177 /SO ONLY LOOK AT THESE BITS
+ SNA CLA
+ JMP TTYRTN /WAS A ^Z
+ TAD TTYTST /GET BACK ALL 12 BITS
+ JMS TTPRNT
+ AND TT7400 /BUT RETURN ONLY LEFT THIRD
+ STL /**** CRUD
+ JMP I TTYPCH
+TTY212, 212
+ IFNZRO .-TTY360-100 <ER3700,QQQQ>
+TTYCA, 0
+TTYWC, 0
+TTYTST, 0
+TTYCDF, 0
+ TAD TTY200
+ KRS /TEST FOR ^C WITH FLAG UP
+ TAD TTM203
+ SNA
+ KSF
+ JMP I TTYTST
+TTYCIF, CDF CIF 0
+ JMP I TT7600
+TTPRNT, 0
+ TLS
+ TSF
+ JMP .-1
+ JMP I TTPRNT
+TTCDF, CDF 0
+
+/FOLLOWING CODE READS TTY AND PACKS IN BUFFER.
+TTYGLP, JMS TTYGCH
+ DCA I TTYCA
+TTYM32, JMS TTYGCH
+ DCA TTYPCH
+ JMS TTYGCH
+ RTL
+ RTL
+ DCA TTYGCH
+ TAD TTYGCH
+ AND TT7400
+ TAD I TTYCA
+TT3700, DCA I TTYCA
+ TAD TTYGCH
+TTY200, AND TTY360
+ CLL RTL
+ RTL /CLEARS LINK
+ TAD TTYPCH
+ ISZ TTYCA
+ DCA I TTYCA
+ JMP TTLOOP
+ IFNZRO .-TTY360-146 <TTYERR,QQQQQ>
+TTYGCH, 0 /MUST BE AT REL LOC 146
+ TAD TTYCDF
+TT7700, SMA CLA
+ JMP I TTYGCH
+ ISZ TTYTST
+ JMP TTYKSF
+ TAD TTY212
+ JMP TTECHO
+TTYKSF, KSF
+ JMP .-1
+ JMS TTYTST
+ TAD TTM27
+ SNA /IS IT A ^Z?
+ DCA TTYCDF /YES - SET END-OF-FILE FLAG
+ TAD TTY14
+ DCA TTYTST /TTYTST=-1 IF CARRIAGE RETURN
+ KRB
+TTECHO, JMS TTPRNT /ECHO THE INPUT CHARACTER
+ JMP I TTYGCH
+TTM203, -203
+TTM27, -27
+TTYM14, -14
+TTY177, 177
+ IFNZRO .-TTY360-175 <NICE,QQ>
+TTYCTO, 6032 /SHOULD BE AT REL LOC 175 FOR PATCHERS
+ JMP TTYRTN
+TTY14, 14
+ $
+\f
--- /dev/null
+/SECONDARY BOOTSTRAP V5A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1973,1974 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+/ DEC-8E-OC2BA-A-LA
+/ COPYRIGHT 1972
+/ DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASS. 01754
+
+/ S.R.
+
+ VERSON= 5 /5= VERSION 5, ETC
+ SUBVER= 01 /01=A, ETC
+
+ BSW=7002
+ KSDR=6701
+ KSDF=6701
+ KSBF=6703
+ KLSA=6704
+ KGOA=6706
+ KRSB=6707
+ NOPUNCH
+ *3602
+ ENPUNCH
+
+BIN, STA
+ DCA GRKNT
+ITSFLD, TAD CDF0
+ DCA FLD
+ITSORG, DCA ORG /ASSUMES ORIGIN ALWAYS APPEARS
+ /AFTER FIELD SETTING
+BINLDR, STA
+ DCA ORGSW
+ JMS GETBYT
+FOOL, BSW
+ CLL RTR
+ SZL
+ JMP SPEC /BIT 4=1
+ SPA /BIT 4=0 (TWO WORD COMMAND)
+ ISZ ORGSW /IS ORIGIN
+N7000, NOP
+ RAL
+ CLL RAL
+ DCA TEM
+ JMS GETBYT
+ TAD TEM /COMBINE
+ ISZ ORGSW
+ JMP ITSORG /ORIGIN
+FLD, HLT
+ DCA I ORG
+ ISZ ORG
+CDF0, CDF 0
+ JMP BINLDR
+SPEC, SMA
+ JMP MON
+ RTL
+ AND N7000
+ BSW
+ JMP ITSFLD
+\fGETBYT, 0
+ ISZ GRKNT
+ JMP RDBYTE
+ TAD X260
+ KLSA
+ KGOA
+ KSBF
+ JMP .-1
+ KRSB
+ AND X7774
+ SZA CLA
+ HLT
+ ISZ FIRST
+ JMP NOTFST
+ JMS RESET
+ TAD X270
+ STL
+ JMP I X4002
+NOTFST, TAD X7600
+ DCA GRKNT
+ TAD X200
+ KLSA
+ KGOA
+ KSDF
+ JMP .-1
+RDBYTE, KGOA
+ KSDF
+ JMP .-1
+ JMP I GETBYT
+
+ ZBLOCK 3701-. /LOCATION 3701 IS SKIPPED BY PRIMARY LOADER
+
+
+ NOPUNCH
+ 0
+ ENPUNCH
+\fMON, CDF CIF 10
+ JMP I .+1
+ 5200
+
+ORG, 0
+TEM, 0
+ORGSW, 0
+
+X200, 200
+X260, 260
+X270, 270
+X7737, 7737
+XKNT, 4035
+XPTR, 4036
+X4002, 4002
+GRKNT, 0
+X7774, 7774
+FIRST, -1
+X7600, 7600
+RESET, 0 /SET UP PRIMARY BOOTSTRAP FOR REUSE
+ TAD X7737
+ DCA I XKNT
+ DCA I XPTR
+ TAD X3211 /A "DCA ." FOR LOCATION 4011
+ DCA I X4011
+ JMP I RESET
+X3211, 3211
+X4011, 4011
+ ZBLOCK 4000-.
+ BIN
+ JMP I .-1 /MUST END IN OCTAL 00
+ $
+\fGETBYT, 0 /DF IS RAANDOM ON ENTRY
+ CDF 10
+ ISZ GRKNT
+ JMP TB
+ TAD (-200
+ DCA GRKNT
+ TAD (BINBUF
+ DCA GRPTR
+ CALL (HANDLER
+ READ+F1
+ BINBUF
+ HLT
+ CALL XWAIT
+TB, TAD I GRPTR
+ INCR GRPTR
+ EXIT GETBYT
+
+GRKNT, 0
+GRPTR, 0
+
+/ 00 DATA
+/ 01 ORIGIN
+/ 11 FIELD
+/ 10 LEADER/TRAILER
+ PAGE
+ $
--- /dev/null
+/2 PDP-8 OS/8 CROSS REFERENCE
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+\r/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+\f/CREF IS A CROSS REFERENCING PROGRAM FOR THE OS/8 ASSEMBLERS,
+/PAL8 AND SABR. THE PURPOSE OF CREF IS:
+
+/ 1) PROVIDE A SEQUENCE NUMBERED (DECIMAL) OUTPUT LISTING
+
+/ 2) PROVIDE A LIST OF ALL USER DEFINED SYMBOLS AND LITERALS
+/ AND THE SEQUENCE NUMBER OF THE LINES IN WHICH THEY OCCUR
+
+/FIXES FOR MAINTENANCE RELEASE:
+
+/1. 1975 COPYRIGHT, VERSION 4, EDIT 1
+/2. UNIFIED PAGE SIZE INTO ONE PLACE (& MADE IT WORK)
+/3. OUTPUT EXTRA FORM FEED AT END
+/4. MADE /A MEAN KEEP CREFLS.TM INSTEAD OF /E
+
+/FIXES FOR V3D:
+
+/INSTALLED ALL PUBLISHED PATCHES
+\f
+/DETAILS OF CREF.
+
+/CORE UTILIZED
+/FIELD 0
+
+/0-3377: MAINLINE CREF CODE
+/4200-4577: INITIALIZATION CODE.EXECUTED ONCE AT BEGINNING
+/5600-6177: LATER OVERWRITTEN
+/DEVICE HANDLERS + BUFFERS ALLOCATED ACCORDING
+/TO REQUIREMENTS OF DEVICES.
+/USES 3400-5577 FOR INPUT HANDLER, OUTPUT HANDLER, + INPUT BUFFER
+/7200-7577: OUTPUT BUFFER
+/5600-7174: USED FOR REFERENCE STORAGE
+
+/FIELD 1
+
+/0-NSYM*4+10 NSYM=NO. OF SYMBOLS.(USER+PERMANENT+LITERALS).
+/7424-7577 PSEUDO OP TABLE
+/THE REMAINDER IS USED FOR REFERENCES DURING PASSES GREATER THAN ONE
+
+/SYSTEM SCRATCH USED.
+/IF CREF DECIDES THAT MORE THAN 2 PASSES ARE REQUIRED, THE SYMBOL
+/TABLE IS SEGMENTED AT AN OPTIMUM POINT, AND PART IS SAVED
+/IN SCRATCH BLOCKS 27-50 FOR A THIRD (OR LARGER) PASS.
+
+
+/MAJOR ROUTINES AND CODE SECTIONS
+
+/MAIN-START OF TEXT PROCESSING.CHECKS FOR VALID LINE.READS AND WRITES
+ /TEXT LINES
+/CVTSEQ CONVERTS SEQUENCE NUMBERS FROM OCTAL TO DECIMAL AND
+/ WRITES THEM INTO THE OUTPUT BUFFER
+
+/GETLIN- GET A LINE OF INPUT INTO LINE BUFFER
+
+/WRTLIN- WRITE A LINE OF TEXT INTO OUTPUT BUFFER
+
+/ANALYZ- LINE SCANNING BEGINS.ALL SYMBOLS COLLECTED HERE
+
+/PACK- CHARACTER PACKING ROUTINE. THE SCHEME USED MAPS LETTERS
+ /A-Z AND [,],\,^ INTO 0-37. 0-9 INTO 40-51
+/ THE PACKING IS: CHAR1-300^52+CHAR2-300
+
+/SYMCHK- BINARY SYMBOL TABLE SEARCH
+
+/ENTRY- MAKES ENTRIES IN USER SYMBOL TABLE
+
+/BUMP- BUMPS REFERENCE COUNTER OF SYMBOLS IN PASS 1
+
+/ENDPAS- TERMINATES A PASS THROUGH INPUT
+
+/PASSN2- FILLS IN REFERENCE STORAGE ARE DURING PASSES
+/ AFTER PASS ONE
+
+/DUMP- DUMPS CREF TABLE TO OUT BUFFER
+
+
+/SWITCHES IN CREF:
+ /Q=INPUT IS SABR CODE
+ /R=INPUT IS RALF CODE
+ /P=DISABLE LISTING OUTPUT. RE ENABLE FOR CREF TABLE
+ /X=DON'T CREF LITERALS
+ /M=MAMMOTH FILE(2 PASSES)
+ /E=DON'T ELIMINATE CREFLS.TM
+ /U=/P + NO SYMBOL TABLE
+\f DECIMAL
+
+ PAGLEN=66 /V3C MOST PAPER HAS 66 LINES PER PAGE
+
+ OCTAL
+
+ PAGLEN=PAGLEN-6 /HEADINGS
+
+
+ VERSN="5
+ PATCHL="A
+/PAGE ZERO FOR CREF
+
+ *10
+/AUTO INDEX REGISTERS
+
+XRLINE, SYMTAB-1 /USED TO MOVE UP SYMBOL TABLE
+XRLIT, -1 /DITTO
+XRSYM1, 0
+XRSYM2, 0 /THESE ARE USED IN SEARCHING SYMBOLS
+OUSAVX, 7611 /USED TO SAVE ARGS FOR /M
+
+ *20
+TXTBEG, LINBUF+12 /TEXT STARTS HERE
+MARGIN, LINBUF-1 /LINE BUFFER
+COUNT, 0 /GENERAL COUNTER
+CHAR, 0 /HOLDS CHARACTER TO EXAMINE
+SEQNO, 0 /SEQUENCE NO.
+SAVE, 0
+TEMP, 0
+TEMP1, 0 /THESE THREE ARE TEMPORARY STORAGE
+DSWIT, 0
+RSWIT, 0 /CD SWITCH WORDS
+MLF, -212 /-LINE FEED
+SYMCNT, -6 /ALLOW 6 CHARACTER SYMBOLS
+ISYM, SYM1 /POINTER TO SYMBOL COLLECTOR
+PSWCH, 0 /PACK SWITCH..LEFT OR RIGHT HALF
+SYM1, 0
+SYM2, 0
+SYM3, 0 /COLLECT SYMBOLS HERE
+USER, 0 /USER MUST FOLLOW SYM3!
+ 110 /INITIAL SYMBOL TABLE ENTRIES
+PSEUDO, 0
+ 0 /THESE 2 GET FILLED IN AT INITIALIZATION
+PASN2, PASSN2 /IF NOT PASS 1 GO HERE WITH A SYMBOL
+PASSG1, -1 /=0 IF NOT PASS1
+MAXFLD, 0 /-# OF FIRST NON-EXISTENT FIELD
+CONST, 0 /EITHER 0 OR 96(10)
+FLDPTR, 0 /POINTER TO CORE FIELD
+USR, 200 /MONITOR IN CORE..CHANGED TO 7700
+DOLLAR, DOLL1
+SYMFLD, 2 /FIELDS WITH SYMBOLS: BITS 5-11
+MASKF, 0 /MASK FOR ABOVE WORD
+
+/THESE ARE THE DEFAULT PARAMETERS FOR THE I/O ROUTINES
+/AJUSTED ACCORDING TO REQUIREMENTS OF DEVICES REQUESTED
+
+OUCTL=4200
+OUBUF=7200
+OUDEVH=4000 /VARIABLE-MAY ALSO BE 3600
+OUFLD=OUCTL&70
+
+INCTL=0400
+INBUF=4600 /ALSO 4200
+INDEVH=3400
+INRECS=2 /ALSO 3
+INFLD=INCTL&70
+/(SUBJECT TO CHANGE WITHOUT NOTICE!)
+
+SYMADD, 0 /CONTAINS SYMBOL ADDRESS
+SYMNUM, 0 /ABOVE MOD 4
+K0=USER
+BUFFER, 0 /POINTER FOR UNPACKING
+R=52
+RAD=52 /RADIX FOR CONVERTING SYMBOLS
+
+ADDER, 0
+SYSM, 0
+BASE, 0 /THESE ARE USED TO END A PASS
+SYMLIM, 0 /UPPER LIMIT FOR SYMBOL REF TABLE
+FINI, 0
+
+IOSR, 0
+ JMS I [7607
+CNTROL, 4010 /THIS IS ON PAGE ZERO MAINLY
+CTPTR, 4 /BECAUSE CTPTR IS USED A LOT
+SCRATCH=27
+ SCRATCH /SYSTEM SCRATCH FOR OVERFLOW
+ SKP /ERROR ON SYS!!!
+ JMP I IOSR
+HIOERR, JMS I [ERROR
+ HNDERR
+LNPRPG, -PAGLEN /# LINES OF TEXT PER PAGE
+LINES, -PAGLEN /V3C MASTER COPY
+THOUS, 6030 /CONVERSION TABLE..OCTAL-DECIMAL
+ 7634
+ 7766
+ 7777
+
+FPUT, STORIT /INITIALLY POINTS TO DCA I XRLINE
+
+M12=THOUS+2
+M1=THOUS+3
+
+DPAT, 0
+ DCA I (NOFIRM
+ DCA I (NOFORM
+ JMP I DPAT
+\f
+ *200
+ JMP I (ST1 /INITIALIZATION GETS DESTROYED
+BREAK, JMP I (CHAIN /CHAIN ENTRY POINT
+ ZBLOCK 7 /BREAK TABLE. HOLDS SYMBOL
+ /NUMBERS DURING VARIOUS PASSES
+ /OF CREF. THE ENTRIES ARE THE NUMBER
+ /OF THE LARGEST SYMBOL
+ /WHOSE REFERENCES ARE IN A PARTICULAR
+ /FIELD. THE 0TH ENTRY CORRESPONDS TO
+ /FIELD 0.
+ERROR, 0
+ CLA
+ CDF 0
+ TAD I ERROR
+ DCA BUFFER
+ TAD [-6
+ DCA SYMCNT /12 CHARACTER MESSAGES
+ TAD TTY /POINT TO TTY OUT ROUTINE
+ DCA [OCHAR
+
+ TAD I BUFFER
+ JMS I [DIVIDE /CONVERT AND PRINT MESSAGE
+ ISZ SYMCNT
+ JMP .-3
+ JMP I [7605
+TTY, TTYPRT
+
+
+/THE INPUT LINE IS STORED HERE. XRLINE POINTS TO VARIOUS
+/PLACES THROUGHOUT THE SCAN, AND CHAR HOLDS THE CORRESPONDING
+/CHARACTER WHILE WE EXAMINE IT.
+
+ LINBUF=.
+ LITBUF=.+6
+ VERTST=.+4
+
+
+ *251
+FILEXT, 0
+ CDF 10
+ TAD I (7604
+ CDF 0
+ SNA
+ TAD (1423
+ CDF 10
+ DCA I (7604
+ CDF 0
+ JMP I FILEXT
+P2ADJ, 0
+ TAD I (PASS2
+ SNA
+ JMP I P2ADJ
+ DCA I (OUBLK /LAST BLOCK WRITTEN TO
+ CDF 10
+ TAD I OUSAVX
+ CDF 0
+ DCA I (OUELEN /SIZE OF HOLE
+ CDF 10
+ TAD I OUSAVX
+ DCA LNPRPG /NO. LINES IN LAST BLK WRITTEN
+ TAD I OUSAVX /NO. BLKS WRITTEN SO FAR
+ CDF 0
+ JMP I (MP2 /NO ENTER
+MORCOR, 0
+ CLA CLL IAC
+ DCA MAXFLD /IN CASE NOT DEFINED
+ TAD I (7777
+ AND (70
+ SNA
+ JMP I MORCOR /USE OLD WAY TO DETERMINE
+ CLL RTR
+ RAR /NEED IT HI 3
+ DCA MAXFLD
+ JMP I (DONCOR
+
+OTYPE, 0
+ CDF 10
+ TAD I [7600 /DETERMINE WHAT TYPE OF DEVICE
+ AND [17
+DCB=7760
+ TAD (DCB-1
+ DCA Q
+ TAD I Q /CHECK DEVICE CONTROL BLOCK
+ CDF 0
+ JMP I OTYPE
+Q, 0
+\f *400
+
+/MAIN IS THE START OF CREF.(IF SABR, NXTLIN IS START).
+/AT MAIN WE SCAN A LINE OF TEXT FOR BINARY DATA. IF NONE IS FOUND,
+/THE LINE IS WRITTEN OUT AND A NEW LINE READ. IF BINARY IS FOUND,
+/THE SEQUENCE NUMBER OF THE LINE IS PLACED IN THE OUTPUT
+/BUFFER AND THE ANALYSIS BEGINS AT ANALYZ.
+
+MAIN, JMS I [FORM /FORM FEED (CR/LF)
+ JMS I [HEADER /SKIP HEADER
+ JMS I (GETLIN /AND ONE CR/LF
+NOTBIN, JMS WRTLIN
+NXTLIN, JMS I (GETLIN
+ TAD I XRLINE
+ DCA CHAR
+ JMS I [CHECK /CHECK FOR ALPHA LINE
+ 301
+ -336
+ JMP NOALPH
+NOFIRM, ISZ LNPRPG /NEED A FORM FEED YET?
+ JMP NOTBIN /NOT YET
+ JMS I [FORM /NOW!!!
+ JMP NOTBIN
+NOALPH, TAD CHAR
+ TAD MCTLD /IF RUB OUT, USED /D
+ SNA
+ JMP I [ENDPAS /CAN'T OUTPUT SYM TABLE
+ TAD (163 /CHECK FOR FORM FEED
+ SNA
+ JMP MAIN /YES..
+ TAD (-41 /IF ------, HE USED /T(DUMMY!)
+ SNA CLA
+ JMP MAIN /GIVE HIM A FORM FEED
+NOFORM, ISZ LNPRPG /=0 AFTER PASS1 NEW PAGE?
+ SKP /SKIP A FORM FEED
+ JMS I [FORM
+ ISZ SEQNO /BUMP SEQUENCE
+ JMP MAIN2
+ TAD [140
+ DCA CONST
+MAIN2, JMS I [PASTST /STILL PASS ONE?
+ JMP MAIN3
+ TAD SEQNO
+ JMS CVTSEQ
+ TAD [-3 /3 SPACES
+ JMS I [SPACE
+MAIN3, TAD CHAR
+ TAD [-215
+ SNA CLA
+ JMP NOTBIN
+ JMP I [ANALYZ
+MCTLD, -377 /RUB OUT
+
+/THIS ROUTINE CONVERTS SEQUENCE NUMBERS TO DECIMAL NUMBERS AND
+/PUTS THEM INTO THE OUTPUT BUFFER. IT IS USED WHEN PRINTING
+/THE CREF TABLE ALSO
+/THE CALLING SEQUENCE IS: AC=OCTAL NUMBER TO BE CONVERTED.
+/THE OUTPUT IS AUTOMATICALLY 4 DIGITS.
+
+
+POSPT=TEMP1
+DIGPT=MASKF
+
+CVTSEQ, 0
+ TAD CONST
+ DCA SAVE /TEMP STORE
+ TAD CONST
+ SZA CLA
+ TAD [4
+ DCA DIGIT1
+ DCA DIGIT1+1
+ DCA DIGIT1+2
+ DCA DIGIT1+3 /ZERO CONVERSION AREA
+ TAD [-4
+ DCA COUNT
+ TAD SAVE
+ CLL /SEE IF SEQUENCE IS ABOVE 8000(10)
+ TAD CONST /EITHER 0 OR 140(8)
+ SNL
+ JMP CVT2 /O.K.
+ DCA SAVE /CORRECTED NUMBER
+ TAD [10
+ DCA DIGIT1 /PUT AN 8 INTO THERE FOR PRINTING
+CVT2, CLA
+ TAD (DIGIT1
+ DCA DIGPT
+ TAD (THOUS
+ DCA POSPT
+ TAD SAVE
+RPEAT, CLL
+ TAD I POSPT /POINTS TO -1000,-100,-10, OR -1
+ SNL /IF LINK ON,WE DID TOO MUCH
+ JMP ADDUP /COLLECT THE CONVERTED DIGIT
+ ISZ I DIGPT /BUMP THE COUNTER DIGIT1-DIGIT1+3
+ JMP RPEAT
+
+ADDUP, CIA /RESTORE THE LAST ONE
+ TAD I POSPT
+ CIA
+ ISZ POSPT
+ ISZ DIGPT
+ ISZ COUNT /DONE ALL 4?
+ JMP RPEAT
+ TAD [-4 /YES..OUTPUT THE CONVERTED NUMBERS
+ DCA COUNT
+ TAD (DIGIT1
+ DCA DIGPT
+SPCLUP, TAD I DIGPT
+ TAD ZSPRES /LEADING ZERO SUPPRESSION
+ DCA ZSPRES
+ TAD ZSPRES
+ SNA CLA /ZSPRES IS 0 UNTIL A VALID # IS FOUND
+ TAD (-20
+ TAD I DIGPT
+ TAD [260
+ JMS I [OCHAR
+ ISZ DIGPT
+ ISZ COUNT
+ JMP SPCLUP
+ DCA ZSPRES
+ JMP I CVTSEQ
+
+DIGIT1, 0
+ 0
+ 0
+ 0
+ZSPRES, 0
+\f /WRTLIN TRANSFERS INPUT LINE TO OUTPUT BUFFER
+
+WRTLIN, 0
+ TAD MARGIN
+ DCA XRLINE /RESET MARGIN TO LEFT
+OLINE, TAD I XRLINE /PICK UP TEXT CHARACTER
+ DCA CHAR
+ TAD CHAR
+ SNA /IF NULL,WAS PREMATURE TERMINATOR
+ JMP FLUSH /YES. READ AND WRITE THE REST
+ JMS I [OCHAR /OUTPUT THE CHARACTER
+ TAD CHAR
+ TAD MLF /WAS THIS END OF LINE?
+ SZA CLA
+ JMP OLINE /NO..LOOP AGAIN
+ JMP I WRTLIN
+
+FLUSH, JMS I [HEADER
+ JMP I WRTLIN /OVERFLOW NOT IN BUFFER
+\f
+ *600
+/ANALYZ IS A WORK HORSE. IN IT CHARACTERS ARE EXAMINED AND
+/SYMBOLS ARE BUILT UP. IF A SYMBOL OR A REFERENCE TO A
+/SYMBOL IS FOUND,THE APPROPRIATE ACTION IS TAKEN;I.E.
+/EITHER ENTERING A NEW SYMBOL, BUMPING THE RFERENCE COUNTER,
+/OR BOTH.
+
+ANALYZ, TAD SEMISV /IF #0, LAST WAS SEMICOLON
+ SNA
+ TAD TXTBEG /IF=0, START NORMALLY
+ DCA XRLINE
+
+SCAN, TAD I XRLINE
+ DCA CHAR
+ JMS I [CHECK /ALPHANUMERIC CHECK
+ 301
+ -332
+ SKP /NONE..TEST FOR SPECIAL CHARS
+ JMP PAKIT /FOUND A LETTER PACK AWAY
+ JMS I [CHECK /TEST FOR 0-9
+ 260
+ -271
+ SKP /NOPE..COULD BE SABR
+ JMP SCAN1
+SCAN3, JMP TSTIT /IF SABR, THIS LOC IS AND 0
+ JMS I [CHECK /TEST FOR [,],\,AND ^
+ 333
+ -336
+ SKP
+ JMP PAKIT /VALID SABR CHARACTERS
+
+TSTIT, JMS REPACK
+ TAD CHAR /IS THIS A ;?
+ TAD (-273 /IF SO, SAVE PLACE ON LINE
+ SZA CLA
+ JMP .+3 /IF ; SAVE PLACE ON LINE
+ TAD XRLINE
+ DCA SEMISV
+ TAD SYM1 /IS THERE A LEGAL SYMBOL?
+ SNA CLA
+ JMP TSTEND /NO..LOOK FOR A LINE FEED
+ TAD CHAR
+ TAD (-257
+ SNA CLA /A COMMENT?
+ IAC /YES..NEED SPECIAL RETURN
+ DCA SLSWIT
+
+ JMS I [SYMCHK /THIS IS EITHER A REFERENCE OR A
+ /DEFINITION OR A PERMANENT SYMBOL,PSEUDO
+ PSEUDO /CHECK PSEUDOS FIRST
+HC1, JMP USSYM /NOT A PSEUDO-OP
+ /BECOMES JMP PATCH IF /M USED
+ TAD SYMADD
+ TAD [3
+ DCA SAVE /SYMCHK RETURNS ADDRESS OF SYMBOL IN SYMADD
+ CDF 10
+ TAD I SAVE
+ DCA SAVE
+ CDF 0
+ JMS I (CLEAR /WIPE OUT PSEUDO OP
+ JMP I SAVE /PERFORM THE NECESSARY OP FOR PSEUDO
+PATCH, TAD SYM1
+ RTL
+PATCH1, CLA SZL SPA /LG-LH SPLIT
+ JMP B
+
+USSYM, JMS I [PASTST
+ JMP I PASN2
+ JMS I [SYMCHK
+ USER /CHECK PERMANENT AND USER SYMBOLS
+ JMP NTER /DIDN'T FIND IT; SO WE HAVE TO ENTER IT
+ JMS I (TSTPRM /FOUND;TEST FOR PERMANENT SYMBOL
+ JMP B /WAS A PERMANENT SYMBOL
+ JMP BMPIT /FOUND AND NOT PERMANENT;INCREASE THE
+ /REFERENCE COUNTER BY ONE
+
+NTER, JMS I [ENTRY /ENTER THE SYMBOL BY PUSHING DOWN ALL
+ /THE ONES BELOW IT
+BMPIT, JMS I [BUMP /AND INCREASE THE REFERENCE COUNT
+B, JMS I (CLEAR /SETUP FOR NEXT
+ TAD SLSWIT /WAS LAST A /?
+ SZA CLA
+ JMP I (NOTBIN
+ JMP SCANER
+
+TSTEND, TAD CHAR
+ TAD MLF /ARE WE DONE WITH THIS LINE?
+ SZA CLA
+ JMP .+3 /IF LF, CLEAR OUT SEMICOLON
+CLRSEM, DCA SEMISV
+ JMP I (NOTBIN
+ TAD CHAR
+ TAD (-257
+ SNA /COMMENT LINE?
+ JMP CLRSEM
+ TAD (15 /A "?
+ SNA
+ ISZ XRLINE /YES..SKIP NEXT LETTER
+ TAD [-2 /A $?
+ SNA
+ JMP I DOLLAR
+ TAD [-4
+ SNA /TEST FOR (
+ JMP I (LIT1
+ TAD (-63
+ SZA CLA /TEST FOR [
+ JMP SCANER /NONE OF THEM KEEP GOING
+ JMP I (LIT2
+
+SCAN1, TAD SYM1 /IF WE DON'T HAVE A SYMBOL
+ SNA CLA /DON'T PACK THIS CHARACTER
+ JMP SCAN
+PAKIT, TAD CHAR
+ JMS I [PACK /PACK A CHARACTER
+ JMP SCAN
+
+REPACK, 0 /RESET SYMBOL AREA
+ TAD [-6
+ DCA SYMCNT /SYMBOL COUNTER..6 CHARS
+ TAD (SYM1
+ DCA ISYM
+ DCA PSWCH
+ JMP I REPACK
+
+SEMISV, 0
+SLSWIT, 0
+
+SCANER, TAD CHAR /IF LAST WAS ; READ IN OVERLAY
+ TAD (-273
+ SNA CLA
+ JMP I (NOTBIN
+ JMP SCAN
+
+SUB3, 0 /SUBTRACTS 3 FROM CTPTR
+ TAD [-3
+ TAD CTPTR
+ DCA CTPTR
+ JMP I SUB3
+ *1000
+
+
+/THE PACKING SCHEME IS THE SAME AS THAT USED IN PAL8. THAT IS
+/IN EACH WORD WE HAVE 2 CHARS. CHAR1-300^45+CHAR2-300.
+/PERMANENT SYMBOLS HAVE THE FIRST WORD SET TO A NEGATIVE.
+
+PACK, 0
+ DCA BLAH
+ TAD SYMCNT
+ SMA CLA /OVERFLOW PROTECT
+ JMP I PACK
+ TAD BLAH
+ AND [77 /STRIP IT
+ TAD (-37 /INCLUDE VALID SABR CHARS
+ SMA SZA
+ TAD (-20 /NUMBERS GET MAPPED: 40-51
+ TAD (37 /LETTERS ARE MAPPED:01-37
+ ISZ PSWCH /WHICH HALF?
+ JMP LEFT
+ TAD I ISYM
+ DCA I ISYM
+ ISZ ISYM
+ JMP PCKOUT
+LEFT, CLL RAL /*2
+ DCA TLOW
+ TAD TLOW
+ CLL RTL
+ DCA SAVE /*10
+ TAD SAVE
+ CLL RTL /*40
+ TAD SAVE
+ TAD TLOW /*52!!
+ DCA I ISYM
+ CLA CMA /RESET FLIP FLOP
+ DCA PSWCH
+PCKOUT, ISZ SYMCNT
+ NOP
+ JMP I PACK
+BLAH, 0
+
+
+
+\f
+/SYMCHK IS THE BINARY SEARCH ROUTINE FOR CREF. SYMBOLS
+/ARE A GROUP OF FOUR ENTRIES:THE FIRST THREE WORDS ARE
+/THE STRIPPED-40 REPRESENTATION OF THE SYMBOL. THE LAST
+/IS THE REFERENCE COUNTER (IN THE CASE OF A USER SYMBOL) OR
+/A -1 (IN THE CASE OF A PERMANENT SYMBOL). IN PSEUDO OPS
+/THE FOURTH WORD DESCRIBES THE DESTINATION OR ACTION
+/TO BE PERFORMED BY THAT PSEUDO OP.
+/THE TABLE USER,0 HAS ENTRIES WHICH ARE THE SYMBOL NUMBER
+/AND NOT THE ABSOLUTE CORE LOCATION OF A SYMBOL.
+
+/CALLING SYMCHK:
+/ JMS SYMCHK
+/ TABLE /FIRST WORD OF TWO WHICH GIVES THE LIMITS
+/MOD 4 OF THE APPROPRIATE TABLE
+/SYMCHK RETURNS WITH THE NUMBER OF THE SYMBOL IN SYMNUM
+/AND THE CORE ADDRESS OF THE SYMBOL IN SYMADD. IF THE
+/SYMBOL IS NOT FOUND, THESE WORDS CONTAIN THE PROPER LOCATION
+/FOR THE SYMBOL.
+
+SYMCHK, 0
+ TAD I SYMCHK
+ DCA THI
+ DCA LAST
+ TAD I THI /GET LIMITS OF TABLE
+ DCA TLOW /LOW LIMIT
+ ISZ THI
+ TAD I THI
+ DCA THI /HIGH LIMIT
+
+COMP, TAD TLOW
+ CIA
+ TAD THI
+ CLL RAR /HALF DIFFERENCE BETWEEN THE LIMITS
+ SNA /IF THIS IS ZERO, WE'RE DONE
+ ISZ LAST /THIS WILL BE LAST TRY
+ TAD TLOW /FORM THE NUMBER OF THE ENTRY
+ DCA SYMNUM /WE ARE GOING TO TEST NOW
+ JMS SETXR /SET UP INDICES FOR TEST
+ ISZ COUNT /WE ONLY WANT -3 IN COUNT!
+
+S1, CLL
+ CDF 10
+ TAD I XRSYM2 /SYMBOL TABLE ENTRY
+ CDF 0
+ AND [3777 /MASK PERMANENT SYMBOL BIT
+ CMA /USE ONE'S COMPLEMENT
+ TAD I XRSYM1 /OUR COLLECTED SYMBOL
+ CMA /0 AC IF EQUAL
+ SZA CLA /WATCH THE LINK!!
+ JMP COMPR /NOW TEST FOR HI OR LOW COMPARISON
+ ISZ COUNT
+ JMP S1
+ ISZ SYMCHK /TAKE FOUND ENTRY
+ JMP OUT1
+
+
+COMPR, TAD LAST /LAST GASP?
+ SZA CLA
+ JMP OUT2 /YEP
+ TAD SYMNUM /LINK TELLS THE TALE!
+ SNL
+ JMP COMP-1 /ADJUST HIGH LIMIT
+ DCA TLOW
+ JMP COMP
+
+
+OUT2, TAD SYMNUM
+ SZL
+ IAC
+ DCA SYMNUM
+OUT1, TAD SYMNUM /ADDING THE FIRST ENTRY AFTER
+ SZA /AN EXPUNGE WILL CAUSE SYMNUM TO BE 0
+ /AUTOMATICALLY IT HAS TO BE 1
+ JMP .+3
+ ISZ SYMNUM
+ JMP OUT1
+ CLL RTL /FORM SYMADD FROM SYMNUM
+ DCA SYMADD /CORE ADDRESS OF THE SYMBOL
+ ISZ SYMCHK
+ JMP I SYMCHK
+
+THI, 0
+TLOW, 0
+
+LAST, 0
+
+
+
+/THESE TABLES DEFINE THE LIMITS OF CORE STORAGE IN CREF.
+/BASTBL GIVES THE START LOC WHERE REFERENCES WILL BE STORED.
+/LTTBL GIVES THE LO CORE LIMIT OF THOSE REFS. THERE IS ONE ENTRY FOR
+/EACH FIELD
+
+BASTBL, 7174 /THIS TABLE GIVES THE BASE
+ 7424 /LOCATIONS INEACH FIELD WHERE THE
+ 7574 /REFERENCES BEGIN
+ 7574 /REFS START HERE AND BUILD TOWARD LOWER
+ 7574 /CORE ADDRESSES
+ 7574
+ 7574
+ 7574
+LTTBL, DOLL1 /THIS TABLE GIVES THE LOW
+ 10 /CORE ADDRESS OF THE REFS IN EACH FIELD
+ 4 /NOTE:ENDPAS JUGGLES THESE AROUND
+ 4 /TO OPTIMIZE CREF STORAGE
+ 4
+ 4
+ 4
+ 4
+
+DIVE, 0
+ SNA /IF 0, PRODUCE A SPACE
+ JMP DIVSPC
+ TAD (-37
+ SMA SZA
+ TAD [-60
+ TAD [77
+DIVSPC, TAD [240
+ JMP I DIVE
+
+SETXR, 0 /SETUP INDEX REGS FOR SEARC,ENTRY
+ TAD SYMNUM /SETUP WHEN FOUND SYMBOL
+ CLL RTL /CORE ADDRESS OF SYMBOL
+ TAD M1
+ DCA XRSYM2
+ TAD [SYM1-1
+ DCA XRSYM1
+ TAD [-4
+ DCA COUNT
+ JMP I SETXR
+\f
+ *1200
+/ENTRY IS SLOW! IT ENTERS A SYMBOL BY PUSHING DOWN WHAT IS
+/BELOW THE PROPER ENTRY.ENTRY CAN ONLY BE USED IN MAKING
+/ENTRIES IN THE PERMANENT (USER) SYMBOL TABLE.
+/ENTRY CONDITIONS:AC SHOULD BE CLEAR!
+/ SYMNUM SHOULD HAVE THE SYMBOL NUMBER OF THE
+/ PROPOSED ENTRY. SYMCHK RETURNS THIS WHEN THE
+/ SEARCH IS UNSUCCESSFUL.
+
+ENTRY, 0
+ JMS I (SETXR /SETUP INDEX REGISTERS
+ TAD USER+1 /CHECK FOR POSSIBLE OVERFLOW
+ CMA /WE DON'T WANT TO WIPE PSEUDO TABLE
+ TAD PSEUDO
+ SPA SNA CLA
+ JMP NMOR /BAD!OVERFLOW HAS OCCURRED
+ ISZ USER+1 /OK..BUMP SYMBOL COUNT
+ TAD USER+1
+ CLL RTL /CORE ADDRESS OF ENTRY
+ DCA TEMP1
+ TAD TEMP1
+ TAD [-4 /GIVES BOTTOM OF TABLE NOW
+ DCA SAVE
+ TAD SAVE /TEST FOR AN 'ADD-ON' ENTRY
+ CMA
+ TAD SYMADD
+ DCA COUNT /-# OF WORDS TO MOVE
+
+ CDF 10
+NTR1, TAD I SAVE
+ DCA I TEMP1 /THE BAD LOOP!
+ CMA
+ TAD SAVE
+ DCA SAVE /I WISH WE HAD A DSZ!(DECREMENT &SKIP ON 0
+ CMA
+ TAD TEMP1
+ DCA TEMP1
+ ISZ COUNT /DONE?
+ JMP NTR1 /UNFORTUNATELY NOT
+
+ CDF 0
+ENTER, CLA /NOW PUT IN OUR ENTRY
+ TAD [-4
+ DCA COUNT /THE 4TH IS A 0 WORD (USER FOLLOWS SYM3)
+NTR2, TAD I XRSYM1
+ CDF 10
+ DCA I XRSYM2
+ CDF 0
+ ISZ COUNT
+ JMP NTR2
+ JMP I ENTRY
+
+NMOR, JMS I [ERROR /SYMBOL OVERFLOW
+ SYMERR
+\f
+
+TXT, JMS GETC
+ TAD (-240 /IGNORE SPACES
+ SNA CLA
+ JMP TXT
+ TAD CHAR
+ CIA /STRING DELIMITER
+ DCA DELMIT
+TXT2, JMS GETC
+ TAD DELMIT /REACHED END OF STRING?
+ SNA CLA
+ JMP I [B /YES
+ TAD CHAR /NO..END OF LINE?
+ TAD [-215
+ SNA CLA
+ JMP I [B
+ JMP TXT2
+
+GETC, 0
+ TAD I XRLINE
+ DCA CHAR
+ TAD CHAR
+ JMP I GETC /GET A CHAR;STORE IT, RETURN IN AC
+DELMIT, 0
+
+\f
+
+
+BUMP, 0 /ROUTINE TO BUMP REFERENCE COUNTERS
+ TAD SYMADD
+ TAD [3
+ DCA SAVE /ADDRESS OF REFERENCE COUNTER
+ CDF 10
+ TAD I SAVE
+ SPA CLA /IF 4000 BIT ON, AN EXTRA ENTRY HAS
+ /ALREADY BEEN MADE FOR THIS SYMBOL
+ JMP ONEISZ
+ TAD CONST
+ SNA CLA /IS SEQNO >4095?
+ JMP ONEISZ /NOT YET
+ TAD [4000
+ TAD I SAVE
+ DCA I SAVE /MARK IT AS BEING NOTED
+ CMA
+ONEISZ, TAD M1 /EITHER -1 OR -2
+ DCA COUNT
+BUMP2, TAD [3777 /THIS CODE PROTECTS AGAINST
+ AND I SAVE />2048 REFS. IF SIGN BIT EVER BECOMES
+ ISZ I SAVE /NEG. ON THE ISZ,KILL IT!!
+ NOP /USELESS PROTECTION
+ TAD [3 /IF AC GOES NEG. HE DIES!!
+ SPA CLA
+ JMP ERR7
+ ISZ COUNT
+ JMP BUMP2
+ CDF 0
+ JMP I BUMP
+
+ERR7, CDF 0
+ JMS I [ERROR
+ REFERR
+
+PTRSET, 0 /THIS ROUTINE TAKES
+ TAD [3 /THE SYMBOL TABLE THAT
+ DCA BUFFER /PRODUCED AND SETS UP EACH REFERENCE
+ DCA SYMNUM /AREA WITH A POINTER INTO THE AREA
+ CLA CMA
+ TAD USER+1 /AND A 0 LOCATION TO HOLD THE DEFINITION
+ CIA /SEQUENCE NO.
+ DCA COUNT
+PTRST1, TAD [4 /START PICKING UP POINTERS
+ TAD BUFFER
+ DCA BUFFER
+ ISZ SYMNUM /CORRESPONDING SYMBOL NUMBER
+ JMS I (GETFLD /FORM CDF N FOR REFERENCE AREA
+ DCA CDTFLD
+ CDF 10
+ TAD I BUFFER /IF PERMANENT SYMBOL, THIS LOC=0
+ SNA /IF SO, SKIP IT
+ JMP PTRST2
+ TAD M1
+ DCA SAVE
+CDTFLD, HLT
+ DCA I SAVE
+ ISZ SAVE /POINT TO INDEX WORD
+ TAD [2
+ DCA I SAVE
+PTRST2, CDF 0
+ ISZ COUNT
+ JMP PTRST1
+ JMP I PTRSET
+\f
+ *1400
+/ENDPAS IS ARRIVED AT WHEN A PASS THROUGH THE INPUT HAS BEEN
+/COMPLETED.SOME COMPLICATED DIDDLING GOES ON HERE.
+
+ENDPAS, ISZ PASSG1
+ JMP I (DUMP /DUMP WHAT WE HAVE
+ JMS I (ENDFIX
+ IAC /POINT TO END OF NEW TABLE
+ DCA USER+1 /YES..THAT BECOMES THE TOTAL NO.
+ /OF SYMBOLS IN OUR NEW TABLE
+ TAD [3777 /O.K...NOW READ IN A SEGMENT
+ AND CNTROL /NOW FORMING READ CONTROL
+ DCA CNTROL
+ TAD [4 /READ SYMBOLS INTO F1 AT LOC.4
+ DCA CTPTR
+ JMS IOSR /DO THE READ
+NDPS1, DCA FLDPTR /INITIALLY AT FIELD 0
+ TAD [6034
+ DCA I [OUTSW
+END2, DCA ADDER /ADDER HOLDS THE COUNT OF THE NUMBER
+ /OF REFERENCES TO THE SYMBOLS THUS FAR
+ /EXAMINED. THIS IS COMPARED TO THE AVAILABLE
+ /CORE IN A PARTICULAR FIELD. WHEN THAT OVER-
+ /FLOWS WE HAVE TO EITHER MOVE TO ANOTHER FIELD
+ /FOR THE REFERENCES OR WRITE PART OF THE SYMBOL
+ /TABLE ONTO SYS.
+ TAD (BASTBL
+ TAD FLDPTR
+ DCA TEMP1 /INITIAL BASE OF REFS
+ TAD I TEMP1
+ DCA BASE
+ TAD FLDPTR /NOW GET MASK FOR QUESTION..
+ CMA /DOES THIS FIELD HAVE SYMBOLS?
+ DCA COUNT
+ CLL CML
+ RAL
+ ISZ COUNT
+ JMP .-2
+ DCA MASKF
+ TAD FLDPTR /GET ADDRESS OF UPPER LIMIT
+ TAD (LTTBL /FOR LATER
+ DCA SYMLIM
+ TAD FLDPTR /SET NEW LIMIT IN FIELD 1
+ TAD [BREAK
+ DCA NUSER /THE NEW LIMIT FOR REFS IS
+ DCA I NUSER /ZERO SYMBOL IN CURRENT FIELD LOC.
+ TAD I SYMLIM
+FUJ1, TAD CTPTR /IF MORE THAN 2 FIELDS EXIST
+ /THIS BECOMES A NOP. THE LIMIT IN
+ /FIELD 1 IS AT THE BOTTOM OF THE
+ /SYMBOL TABLE
+ DCA LIMIT
+NDPS2, TAD CTPTR /CTPTR HOLD THE CORE ADDRESS OF THE
+ /THE 4TH LOCATION OF A GIVEN SYMBOL. THIS
+ /IS ALSO THE REFERENCE COUNTER FOR THAT SYMBOL
+ CLL RTR /FORM SYMBOL NUMBER
+ AND [1777
+ DCA COUNT /SAVE FOR LATER
+ TAD ADDER
+ CIA
+ TAD BASE /NEXT REFERENCE AREA
+ DCA SAVE /IF IT FITS IN THIS AREA
+ /USED WHEN WE MAKE ACTUAL REF ENTRIES
+ CDF 10
+ TAD I CTPTR /# REFS FOR THIS SYMBOL
+ DCA TEMP
+ TAD [3
+ TAD CTPTR
+ DCA CTPTR
+ TAD TEMP
+ SPA CLA /PERMANENT SYMBOL
+ JMP PRMSYM /YES
+ TAD I CTPTR
+ AND [3777 /MASK GT 4095 BIT
+ TAD ADDER
+ DCA ADDER /SEE IF THIS SYMBOL WILL FIT IN THE
+ /CURRENT FIELD HOLDING REFS
+ CDF 10 /MUST ADD UP NEW REFS ALSO
+ TAD I CTPTR
+ AND [3777
+ CDF 0
+ CLL
+ TAD LIMIT /IF LINK GOES ON, REFS WON'T FIT
+ SZL
+ JMP CUTSYM
+ CMA CLL /WHEN UPPER MEETS LOWER,QUIT
+ TAD SAVE
+ SNL CLA
+ JMP CUTSYM /OK..QUIT!
+ CDF 10
+ TAD SAVE /FITS..PUT IN BASE WHERE THIS SYMBOL'S
+ /REFS BEGIN
+ DCA I CTPTR
+ ISZ ADDER
+ ISZ ADDER /2 EXTRA FOR BOOKKEEPING
+PRMSYM, CDF 0
+ TAD COUNT /SYMBOL NUMBER..REMEMBER?
+ DCA I NUSER
+ TAD SYMFLD /BUT..IF THIS FIELD HAS SYMBOLS,
+ AND MASKF /LET'S REDUCE HIS AVAILABLE SPACE
+ SNA CLA
+ JMP .+4 /NO SYMBOLS
+ TAD [4
+ TAD LIMIT
+ DCA LIMIT
+ TAD COUNT /SEE IF WE ARE DONE
+ CMA
+ TAD USER+1
+ SNA
+ JMP I (DONE /YES!! PROBABLY FORGOT SOMETHING
+ DCA SYSM /BECOMES # SYMBOLS TO WRITE OUT IN CASE
+ /WE RUN OUT OF ROOM
+ ISZ CTPTR
+ JMP NDPS2 /CYCLE FOR NEXT SYMBOL
+\f
+CUTSYM, CLA
+ ISZ FLDPTR /GO TO ANOTHER FIELD
+ TAD FLDPTR /DOES IT EXIST?
+ CLL
+ TAD MAXFLD
+ SNL CLA
+ JMP END3 /YES..GROOVY
+ TAD SYSM /NOPE..HAVE TO WRITE REMAINDER OUT
+ CLL RAL /CONVER TO PAGES
+ AND (3700 /FORM CONTROL WORD FOR WRITE
+ TAD [4110
+ DCA CNTROL
+ JMS I (SUB3 /RESET CTPTR
+ TAD I NUSER
+ IAC /FUDGE LAST ENTRY IN TABLE
+ DCA USER+1 /NEW END OF TABLE
+ JMS IOSR /WRITE THE SEGMENT
+ CDF 10 /PUT A 7777 AT END OF CURRENT SEG.
+ CLA CMA
+ DCA I CTPTR
+ CDF 0
+ JMP I (DONE+1 /NOT DONE YET!!
+
+END3, JMS I (SUB3
+ JMP END2 /AND RESUME THY WORK!!
+NUSER, 0
+LIMIT, 0
+\f\f *1600
+
+/PASSN2 IS ENTERED WHEN WE HAVE COLLECTED SOME SORT OF A
+/SYMBOL AND IT IS NOT PASS ONE. WE HAVE TO MAKE SURE IT
+/IS A USER SYMBOL OR LITERAL. IF IT IS, WE HAVE TO ENTER
+/THE SEQUENCE # IN THE AREA SET UP FOR REFERENCES TO THIS
+/SYMBOL. ALSO, IF THE REFERENCE IS A DEFINITION, THE SECOND
+/LOCATION IN THE REFERENCE AREA IS LOADED WITH THE SEQUENCE
+/NO. OF THE LINE WE ARE DOING.
+
+PASSN2, JMS I [SYMCHK
+ USER /IS IT KNOWN TO US?
+ JMP I [B /NO..BUT IT MIGHT BE IN A SEGMENT EITHER
+ /ALREADY DONE OR YET TO BE DONE!!
+ JMS TSTPRM /TEST FOR A PERMANENT SYMBOL
+ JMP I [B /PERMANENT SYMBOL
+/NOTE:SAVE IS SET UP IN TSTPRM TO CONTAIN THE ADDRESS OF THE
+/INDEX WORD. WE USE THIS LATER ON
+
+ JMS GETFLD
+ DCA CDFN /DETERMINE WHAT FIELD THIS SYMBOL HAS ITS
+ /REFS IN AND FORM A CDF N
+ TAD CHAR
+ TAD MCOMMA /IS THIS A DEFINITION?
+ SZA
+ TAD MEQ /AN= MAYBE?
+ SNA CLA
+ IAC /ONE OR OTHER..MARK AS DEFINITION
+ DCA DEF
+ CDF 10
+ TAD I SAVE /PICK UP POINTER TO REFERENCE AREA
+ DCA SAVE
+ TAD CDFN
+ DCA .+1
+ HLT /I HATED TO DO THIS!!!
+ TAD I SAVE
+ SPA CLA /IF THIS IS NEGATIVE, IT MEANS THAT THE
+ /SEQUENCE NUMBER HAS WRAPPED AROUND, BUT WE HAVE
+ /ALREADY MADE A 0 ENTRY TO SHOW THAT
+ JMP P2
+ TAD CONST /HAS THE SEQUENCE # WRAPPED?
+ SNA CLA
+ JMP P2 /NOT YET
+ JMS REFENT /YES..MAKE A 0 ENTRY
+ TAD CDFN
+ DCA .+1
+ HLT
+ TAD I SAVE /MARK AS HAVING A 0 ENTRY
+ TAD [4000
+ DCA I SAVE
+P2, CDF 0
+ TAD SEQNO /NOW MAKE A REAL ENTRY
+ JMS REFENT
+ TAD DEF
+ SNA CLA /SHOULD WE FILL IN THE DEFINITION LOC?
+ JMP I [B /NO
+ CLA CMA
+ TAD SAVE /YES..POINT TO IT
+ DCA SAVE
+ TAD CDFN
+ DCA .+1
+ HLT /THIS IS SLOPPY, BUT SO AM I
+ TAD SEQNO
+ CIA
+ DCA I SAVE
+CDFZ, CDF 0
+ JMP I [B
+DEF, 0
+MEQ, -21
+MCOMMA, -254
+\f
+/REFENT, MAKES REFERENCES IN THE SYMBOLS AREA AND BUMPS THE
+/FIRST LOCATION TO POINT TO THE NEXT LOC.
+
+REFENT, 0
+ DCA TEMP1 /SAVE SEQNO
+CDFN, HLT
+ TAD I SAVE
+ AND [3777 /MASK OFF WRAP AROUND BIT
+ CIA
+ TAD SAVE /FORM ADDRESS OF THIS REFERENCE
+ DCA TEMP
+ TAD TEMP1
+ DCA I TEMP
+ ISZ I SAVE /BUMP POINTER
+ CDF 0
+ JMP I REFENT
+
+/TSTPRM TESTS THE SYMBOL WE HAVE FOUND FOR BEING A PERMANENT SYMBOL
+/PERMANENT SYMBOLS ARE DISTINGUISHED BY HAVING THE 4000 BIT ON.
+
+TSTPRM, 0
+ TAD SYMADD
+ TAD [3
+ DCA SAVE /WE USE THIS ON RETURN!!
+ CDF 10
+ TAD I SYMADD
+ CDF 0
+ SMA CLA /IS IT MINUS?
+ ISZ TSTPRM
+ JMP I TSTPRM
+
+/GETFLD DETERMINES WHAT FIELD A PARTICULAR SYMBOL HAS ITS
+/REFS IN. IT DOES IT BY COMPARING THE CURRENT SYMBOLS NUMBER
+/WITH THE ENTRIES IN THE BREAK TABLE.
+
+GETFLD, 0
+ DCA FLDPTR
+GF1, TAD [BREAK
+ TAD FLDPTR /GET BREAK TABLE ENTRY
+ DCA TEMP
+ TAD I TEMP
+ CIA
+ TAD SYMNUM /SYMNUM WAS SET UP WHEN WE FOUND THE SYMBOL
+ SPA SNA CLA
+ JMP GF2 /FIRST NEG. VALUE GIVE FLDPTR
+ ISZ FLDPTR /TRY NEXT
+ JMP GF1
+GF2, JMS CHDF /FORM THE CDF N
+ JMP I GETFLD
+
+CHDF, 0
+ TAD FLDPTR
+ CLL RTL
+ RAL
+ TAD CDFZ
+ JMP I CHDF
+
+SPACE, 0 /GENERATES AS MANY SPACES AS ARE IN AC
+ DCA CHDF
+ TAD [240
+ JMS I [OCHAR
+ ISZ CHDF
+ JMP SPACE+2
+ JMP I SPACE
+
+CHECK, 0
+ TAD I CHECK /SUBROUTINE TO TEST CHAR
+ CIA /AGAINST PRESCRIBED LIMITS
+ TAD CHAR
+ CLL
+ TAD I CHECK
+ ISZ CHECK
+ TAD I CHECK
+ ISZ CHECK
+ SNL
+ SKP CLA /VERY UNESTHETIC..BUT IT WORKS!
+ SNA CLA
+ ISZ CHECK
+ JMP I CHECK
+
+DONE, ISZ FINI /SET COMPLETION FLAG
+ JMS I (IOPEN /SET FOR REREAD
+ JMS I (PTRSET /PREPARE REFERENCE AREAS
+ DCA SEQNO /BACK TO BASICS
+ DCA CONST
+ JMP I (FIRST /READ FIRST RECORDS
+\f
+ *2000
+/DUMP DOES A LITTLE FORMATTING OF THE OUTPUT, AND DUMPS THE
+/CROSS REFERENCING TABLE ONTO THE OUTPUT DEVICE.
+/ANY FIDDLING WITH THE BUFFERS OR DEVICE HANDLERS WILL HAVE TO
+/BE DONE IN DUMP
+
+
+COUNTR=BASE
+REFBUF=IOSR
+SCHAR=ADDER
+
+DUMP, CLA CMA
+ DCA PASSG1 /FORCES ANOTHER PASS AT ENDPAS
+DMP7, SKP /V3C
+ JMP DMP8 /SKIP FIRST-TIME STUFF
+ ISZ LINES /V3C
+ ISZ LINES /DIF NO. LINES PER PAGE NOW
+ JMS I [FORM /FIRST TIME THRU GETS A FORM FEED
+ DCA DMP7 /FUTURE PASSES DON'T
+DMP8, TAD USER+1
+ CIA
+ DCA COUNTR /# SYMBOLS TO PROCESS NOW
+ TAD [3
+ DCA BUFFER /FIRST SYMBOL IS HERE
+ JMP DMP6 /GET NO. LINES RIGHT FIRST TIME
+DMP5, JMS I [CRLF /V3C
+DMP, ISZ LNPRPG /IS FORM FEED NEEDED?
+ SKP /NOT YET
+ JMS I [FORM
+DMP6, TAD [-3
+ DCA SYMCNT /2 CHARACTERS PER PASS
+ DCA CONST /RESET FOR <4096
+ TAD M12
+ DCA LINENO
+NXTDV, ISZ BUFFER
+ CDF 10
+ TAD I BUFFER /PICK UP PACKED WORD
+ CDF 0
+ SPA /PERMANENT SYMBOL?
+ JMP DPERM /YES
+ JMS I [DIVIDE /CONVERT 2 CHARS AND PRINT
+ ISZ SYMCNT
+ JMP NXTDV+1
+ TAD [-4
+ JMS I [SPACE /GENERATE(AC) SPACES
+ TAD BUFFER
+ CLL RTR /GET SYMBOL NUMBER
+ AND [1777
+ DCA SYMNUM
+ JMS I (GETFLD
+ DCA CDFNA /CDF N
+ CDF 10
+ TAD I BUFFER
+ DCA REFBUF /BASE OF REFS FOR SYMBOL
+CDFNA, HLT
+ TAD I REFBUF /IF THIS IS NEGATIVE,
+ SPA CLA /WE LEFT A REF FOR A 0 ENTRY
+ TAD M1 /IN THAT CASE,DON'T INCLUDE THAT ONE AS
+ TAD [-2 /A REAL ENTRY.
+ DCA SYMCNT
+ TAD I REFBUF
+ AND [3777 /NOW CALCULATE REAL NO. ENTRIES
+ TAD SYMCNT
+ CIA
+ DCA SYMCNT
+ CLA CMA
+ TAD REFBUF
+ DCA REFBUF
+ TAD I REFBUF /SEQUENCE # OF DEF.
+ DCA DEFSEQ
+DMP2, CLA CMA
+ TAD REFBUF
+ DCA REFBUF
+ TAD CDFNA
+ DCA .+1
+ HLT
+ TAD I REFBUF /PICK UP A REFERENCE
+ TAD DEFSEQ /IS THIS THE DEF?
+ SZA CLA
+ JMP NODEF
+ DCA DEFSEQ /ONLY 1 DEF PER LINE
+ TAD [3 /YES..PRINT # AFTER SEQ #
+NODEF, TAD [240 /IF NO, PRINT 2 SPACES
+ DCA SCHAR
+ TAD I REFBUF
+ SZA CLA /IF A 0, ALL FOLLOWING REFS ARE >4095
+ JMP .+4
+ TAD [140
+ DCA CONST
+ JMP DMP2 /IGNORE ZERO ENTRY!!
+ TAD I REFBUF
+ CDF 0
+ JMS I (CVTSEQ /WRITE THE DECIMAL SEQUENCE #
+ TAD SCHAR
+ JMS I [OCHAR /EITHER # OR SPACE
+ CLA CMA
+ JMS I [SPACE
+ ISZ SYMCNT /MORE TO DO?
+ JMP DMP0 /NO, BUT IS CR/LF REQUIRED?
+GETMOR, ISZ COUNTR /EXHAUSTED ALL SYMBOLS?
+ JMP DMP5
+ TAD FINI /YES..ARE WE ALL DONE
+ SNA CLA
+ JMP I [ENDPAS /NO..READ IN NEXT SEGMENT
+ JMP I (OCLOSE
+
+DMP0, ISZ LINENO /A CR/LF NEEDED?
+ JMP DMP2
+ TAD M12
+ DCA LINENO /RESET ENTRIES PER LINE
+ JMS I [CRLF /V3C
+ ISZ LNPRPG /FORM FEED?
+ SKP
+ JMS I [FORM
+ TAD M12 /AND INDENT NEXT LINE
+ JMS I [SPACE
+ JMP DMP2
+
+DPERM, CLA
+ TAD [3 /PERMANENT SYMBOL
+ TAD BUFFER
+ DCA BUFFER /LOOK AT NEXT
+ ISZ COUNTR
+ JMP NXTDV
+ JMP GETMOR+2
+
+FIRST, JMS I (ASHDLR /RESET INPUT FOR READ
+ JMS I (RDREC /AND READ SOME RECORDS
+ JMP I (NXTLIN /START READING TEXT
+
+
+DEFSEQ, 0
+LINENO, -12
+PASTST, 0 /SR WHICH DETERMINE IF PASS > 1
+ TAD PASSG1
+ SPA CLA /IF >0=> PASS >1
+ ISZ PASTST
+ JMP I PASTST
+\f *2200
+
+/I/O ROUTINES FOR OS/8
+
+OUSETP, 0
+ TAD (OUCTL&3700
+ CIA
+ DCA OUDWCT /SIZE OF BUFF IN DOUBLEWORDS
+ TAD XOUBUF
+ DCA OUPTR /INITIALIZE POINTER
+ TAD OUJMPE
+ DCA OUJMP /RESET 3 WAY SWITCH
+ JMP I OUSETP
+
+OCHAR, 0
+ AND (377 /CALLED WITH CHARACTER IN AC
+ DCA OUTEMP
+ JMS I [PASTST
+ JMP I OCHAR
+OUTSW, KRS /TEST FOR ^C WITH FLAG OR
+ /JMP I OCHAR IF /P,/U OR PASS 2 /M
+ TAD (-203
+ SNA CLA
+ KSF
+ JMP .+2
+ JMP I [7600 /SAVE CORE FOR SOME REASON
+ ISZ OUJMP /BUMP 3 WAY SWITCH
+OUJMP, HLT
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP /PICK UP CHARACTER
+ CLL RTL
+ RTL
+ AND (7400 /3RD WORD MERGED INTO 2 BUFFER WORDS
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR
+ TAD OUJMPE
+ DCA OUJMP /RESET FOR NEW SET OF 3 CHARS
+ ISZ OUPTR /BUMP BUFFER POINTER
+
+ ISZ OUDWCT
+ JMP OUCOMN
+ TAD OUCT /YEP
+ JMS OUTDMP /WRITE IT
+ JMS OUSETP /RESET OUT BUFFER
+ JMP I OCHAR
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /FOR LATER
+ ISZ OUPTR /SECOND WORD GOES HERE
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, JMP I OCHAR
+
+
+OUTEMP, 0 /TEMP STORE
+OUPOLD, 0 /HOLDS OLD POINTER
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUCT, OUCTL
+\f
+
+OOPEN, 0 /OPEN AN OUTPUT FILE;FETCH HANDLER
+ TAD (OFILE
+ DCA OUBLK /POINT TO FILE NAME
+ TAD XOUDEV
+ DCA OUHNDL /LEAVE ROOM FOR 2 PAGE HANDLER
+ CDF 10
+ TAD I [7600 /OUTPUT DEVICE #
+ CDF 0
+ CIF 10
+ JMS I USR /ASSIGN,FETCH HANDLER
+ 1
+OUHNDL, HLT /GETS ENTRY POINT OF HANDLER
+ JMP HIOERR /HANDLER FAILURE
+OUENTR, JMS I (P2ADJ
+ CDF 10
+ TAD I [7600
+ CDF 0
+ CIF 10
+ JMS I USR
+ 3 /ENTER OUTPUT FILE
+OUBLK, OFILE
+OUELEN, 0 /RETURNS WITH LENGTH OF HOLE
+ JMP OEFAIL
+MP2, DCA I (OUCCNT
+ TAD OUBLK /STARTING RECORD
+ DCA OUREC
+ JMS OUSETP /SETUP OUTPUT AREA
+ JMP I OOPEN
+XOUDEV, 4001 /MAY BE ALTERED
+
+OEFAIL, CDF 10
+ TAD I [7600
+ AND (7760 /GET LENGTH PART
+ SNA CLA /WAS IT 0?
+ JMP ERR3 /YEP..HE LOSES
+ TAD I [7600
+ AND [17 /TRY WITH INDETERMINATE LENGTH
+ DCA I [7600
+ JMP OUENTR
+
+OUTDMP, 0 /WRITE ACTUAL OUTPUT
+ DCA OUCTLW
+ JMS I (OUNREC /FIGURE # RECS TO WRITE
+ TAD I (OUCCNT
+ DCA I (OUCCNT /UPDATE CLOSE LENGTH
+ TAD I (OUCCNT
+ CLL CML
+ TAD OUELEN /ROOM FOR THIS WRITE?
+ SNL CLA
+ JMP ERR4 /HE LOSES
+ JMS I OUHNDL /NJ WRITE IT
+OUCTLW, 0
+XOUBUF, OUBUF
+OUREC, 0
+ JMP HIOERR /A HANDLER BADNESS
+ JMS I (OUNREC
+ TAD OUREC /UPDATE OUTPUT RECORD #
+ DCA OUREC
+ JMP I OUTDMP
+
+ERR4, JMS I [ERROR
+ FULERR
+ERR3, JMS I [ERROR
+ ENTERR
+\f
+ *2400
+OCLOSE, TAD HCREF
+ SZA CLA /IF NOT LAST PASS
+ JMP NOVERS /NO NEED FOR VERSION NO.
+ JMS CRLF
+ TAD ("V-300^R+VERSN-"0+40
+ JMS I [DIVIDE
+ TAD (PATCHL /PATCH NO.-ON PAGE
+ JMS I [OCHAR
+ JMS CRLF
+ JMS FORM /V3C
+NOVERS,
+ TAD HCREF
+ SNA CLA /IF /M PASS 1
+ TAD (232
+ JMS I [OCHAR /NO 232
+ JMS I [OCHAR
+FILLIP, JMS I [OCHAR /FILL WITH 0'S
+ TAD (177
+ AND I (OUDWCT
+ SZA CLA /TO BOUNDARY YET?
+ JMP FILLIP /NO..KEEP FILLING
+ TAD I (OUDWCT
+ TAD (OUCTL&3700
+ SNA /FULL WRITE LEFT?
+ JMP NODUMP /YES..BUT ^Z IS OUT
+ TAD (4000+OUFLD /FORM WRITE
+ JMS I (OUTDMP
+NODUMP, CIF 10
+ JMS I USR
+ 10 /LOCK IN MONITOR
+ TAD I (OUREC
+ CDF 10
+ DCA I OUSAVX
+ CDF 0
+ TAD I (OUELEN
+ CDF 10
+ DCA I OUSAVX
+ TAD LNPRPG
+ DCA I OUSAVX
+ TAD OUCCNT
+ DCA I OUSAVX
+ TAD I [7600
+ CDF 0
+ ISZ HCREF
+ JMP NOD1
+ CIF 10
+ JMS I [200
+ 6
+BLK, 0
+ 0
+NOD1, CIF 10
+ JMS I [200
+ 4 /CLOSE OUTPUT FILE
+ OFILE /POINTER TO FILE NAME
+OUCCNT, 0 /CLOSING LENGTH
+ JMP ERR5 /SORRY
+/FOR LONG FILES(/M), IT WILL CHAIN TO ITSELF ON FIRST PASS.
+/ON SECOND PASS,IT WILL DELETE FILE CREFTM.LS(IF NO E)
+ ISZ SLSWH /DELETE TEMP FILE SWITCH
+ JMP ALDONE
+ CLA IAC /SYS
+ CDF 0
+ CIF 10
+ JMS I [200
+ 4 /DELETE CREFLS.TM
+ CHANNM
+ 0
+ CLA
+ALDONE, JMP I [7605
+HCREF, 0
+SLSWH, 0
+
+ERR5, JMS I [ERROR
+ CLSERR
+ERR6, JMS I [ERROR
+ INPERR
+
+
+OFILE, ZBLOCK 4 /OUTPUT FILE NAME GOES HERE
+
+FORM, 0 /GENERATE 214 IF NOT TTY
+ JMS I [PASTST /IF PASS>1, NO FORM FEED
+ JMP I FORM
+ TAD TTYSWT
+ SZA CLA
+ JMP FORM2
+ TAD LNPRPG /FILL TO END OF PAGE
+ SNA /IF 0, GENERATE 8 LINE FEEDS
+ TAD [-4
+ DCA COUNT
+ JMS CRLF
+ ISZ COUNT
+ JMP CRLF1 /HA! GENERATE EXTRA LINE FEED!!
+ TAD [-6
+ DCA COUNT
+ TAD ("- /GENERATE ------
+ JMS I [OCHAR
+ ISZ COUNT
+ JMP .-3
+ TAD [-4
+ DCA COUNT
+FORM3, JMS CRLF
+ ISZ COUNT
+ JMP CRLF1
+ TAD LINES /V3C
+ NOP
+ DCA LNPRPG /RESET TO TOP OF PAGE
+ JMP I FORM
+
+FORM2, CLA CMA
+ DCA COUNT
+ CMA
+ JMP FORM3 /USE [215 TO GENERATE A 214
+
+CRLF, 0 /GENERATE CRRIAGE RET AND LINE FEED
+ TAD [215
+ JMS I [OCHAR
+CRLF1, TAD [212
+ JMS I [OCHAR
+ JMP I CRLF
+
+TTYSWT, 0
+
+\f
+ *2600
+IOPEN, 0
+ CLA CMA
+ DCA INCHCT /FORCE READ OF NEW FILE
+ ISZ INEOF
+ TAD (7617
+ DCA INFPTR
+ JMP I IOPEN
+
+INPTR, INBUF
+
+ICHAR, 0
+INCHAR, ISZ INJMP /PACKING SWITCH
+ ISZ INCHCT /BUFFER EXHAUSTED?
+INJMPP, JMP INJMP /NOPE
+ TAD INEOF /WAS LAST AN EOF?
+ SNA CLA
+ JMP INGBUF /NO..GET NEXT INPUT
+ CDF 10
+ TAD I INFPTR
+ CDF 0
+ SNA CLA /MORE INPUT?
+ JMP I ICHAR /NO..EOF RETURN
+
+ JMS ASHDLR /SET UP STRT RECORD
+INGBUF, JMS RDREC /AND READ SOME RECORDS
+ JMP INCHAR
+ /THIS IS DONE TO OPTIMIZE THE DECTAPE
+ /ROCKING. INITIALIZATION DOES THESE
+ /THE FIRST TIME.
+
+
+INJMP, JMP . /3 WAY SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND (7400 /CONTENTS OF BUFFER
+ CLL RTR
+ RTR
+ TAD INCTLW
+ RTR
+ RTR /GETS THIRD WORD FROM 1 AND 2
+ ISZ INPTR /NEXT BUFFER LOC
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND (7400
+ DCA INCTLW /TEMP SAVE
+ ISZ INPTR
+ICHAR1, TAD I INPTR
+INCOMN, AND (177 /PARITY TEST
+ SNA /IF 200 CODE..IGNORE IT
+ JMP INCHAR
+ TAD [200
+ TAD (-232 /IS IT ^Z?
+ SNA
+ JMP I ICHAR /YES..NOMMORE!!
+ TAD (232
+ ISZ ICHAR /SKIP EOF RETURN
+ DCA CHAR
+ JMP I ICHAR
+INCHCT, 0
+INFPTR, 7617
+INEOF, 0
+INCTR, 0
+INHAND, 0
+
+ASHDLR, 0
+
+ CDF 10
+ TAD I INFPTR
+ AND (7760 /LENGTH PART OF WORD
+ SZA /0 IMPLIES .GTE. 256
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA INCTR
+ ISZ INFPTR /BUMP TO NEXT
+ TAD I INFPTR /GET STARTING RECORD
+ DCA INREC
+ ISZ INFPTR
+ DCA INEOF
+ CDF 0
+ JMP I ASHDLR
+XINREC, 2 /DEFAULT CONDITIONS
+XINCL1, 401
+
+RDREC, 0
+ TAD INCTR
+ CLL
+ TAD XINRECS /LINK ON IF OVERFLOW AND LAST READ
+ SNL
+ DCA INCTR /UPDATE IF NO OVERFLOW
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR /CONTROL WORD FROM OVERFLOW
+ RTR
+ RTR
+ TAD XINCL1
+ DCA INCTLW
+ CDF 0
+ JMS I INHAND
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMP INERRX /FATAL OR EOF
+INBREC, TAD INREC
+ TAD XINREC
+ DCA INREC /UPDATE # READ
+ TAD INCTLW
+ AND [7600
+ CLL RAL
+ TAD INCTLW
+ AND [7600
+ CMA
+ DCA INCHCT /NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP
+ TAD INBUFP
+ DCA INPTR
+ JMP I RDREC
+
+INERRX, ISZ INEOF /FATAL OR EOF
+ SMA CLA
+ JMP INBREC /EOF..NEXT FILE
+ JMS I [ERROR
+ INPERR
+
+TTYPRT, 0 /SIMPLE TTY OUTPUT ROUTINE
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYPRT
+
+
+ *3000
+HNDERR, "H-300^R+"A-300 /HANDLER FAIL
+ "N-300^R+"D-300
+ "L-300^R+"E-300
+ "R-300^R
+ "F-300^R+"A-300
+ "I-300^R+"L-300
+
+SYMERR, "S-300^R+"Y-300
+ "M-300^R
+ "O-300^R+"V-300
+ "E-300^R+"R-300
+ "F-300^R+"L-300
+ "O-300^R+"W-300
+
+LPTERR, "D-300^R+"E-300 /DEV LPT BAD
+ "V-300^R
+ "L-300^R+"P-300
+ "T-300^R
+ "B-300^R+"A-300
+ "D-300^R
+
+ENTERR, "E-300^R+"N-300
+ "T-300^R+"E-300
+ "R-300^R
+ "F-300^R+"A-300
+ "I-300^R+"L-300
+ "E-300^R+"D-300
+
+FULERR, "O-300^R+"U-300
+ "T-300^R
+ "D-300^R+"E-300
+ "V-300^R
+ "F-300^R+"U-300
+ "L-300^R+"L-300
+
+CLSERR, "C-300^R+"L-300
+ "O-300^R+"S-300
+ "E-300^R
+ "F-300^R+"A-300
+ "I-300^R+"L-300
+ "E-300^R+"D-300
+
+INPERR, "I-300^R+"N-300
+ "P-300^R+"U-300
+ "T-300^R
+ "E-300^R+"R-300
+ "R-300^R+"O-300
+ "R-300^R
+
+REFERR, 2664 /2045 REFS
+ 3015
+ "R-300
+ "E-300^R+"F-300
+ "S-300^R
+ 0
+
+/LITERAL PROCESSORS. LITERALS ARE HANDLED ACCORDING TO THEIR
+/BINARY DEFINITION. A CURRENT PAGE LITERAL AT,SAY, 0377 WILL
+/BE CALLED _L0377. A PAGE ZERO LITERAL AT LOCATION 0100 WILL
+/BE CALLED _L0100
+/IF ASSEMBLED WITH NEW PAL8, LITERAL INCLUDES FIELD
+/SO 00377 IS _00377, 10377 IS _10377
+
+LIT2, TAD (2540 /PAGE 0..FIRST NUMBER ALWAYS 0
+ DCA SYM2 /_L GOES IN SYM1 FOR BOTH
+ JMS LCHK
+ ISZ ISYM
+ ISZ ISYM /POINT TO SYM3 FOR LAST 2 DIGITS
+ JMP LIT3 /COMMON CODE
+LIT1, JMS LCHK
+ ISZ ISYM /POINT TO SECOND WORD
+ TAD I XRLIT /FIRST BINARY DIGIT
+ JMS I [PACK
+ TAD I XRLIT
+ AND (266 /THIS KNOCKS OFF RELATIVE ADDRESS BIT
+ JMS I [PACK /GOES INTO RIGHT HALF OF SYM2
+LIT3, TAD DSWIT /IF /D, DON'T CREF LITERALS
+ SZA CLA
+ JMP LITEX /DON'T DO ANYTHING BUT CLEAR COUNTERS
+ TAD (LITBUF+1 /NOW PICK UP RELATIVE ADD BIT FROM INSTRUCT.
+ DCA XRLIT
+ TAD I XRLIT
+ AND (1
+ TAD SYM2
+ DCA SYM2 /FORMING ADDRESS OF LITERAL!
+ TAD I XRLIT
+ JMS I [PACK
+ TAD I XRLIT
+ JMS I [PACK /LOAD UP SYM3
+ TAD ENDFIX /WILL PRINT FIELD WITH LIT IF NEW PAL8
+ AND (57
+ TAD [2426
+ DCA SYM1 /PUT IN _ (NEGATIVE!)
+ JMS I (REPACK
+
+ JMP I XUSSYM /DO THE BOOKKEEPING
+LITEX, JMS I (REPACK
+ JMP I [B
+XUSSYM, USSYM /WILL BE CHANGED TO PATCH IF /L
+LCHK, 0
+ TAD MARGIN
+ DCA XRLIT
+ TAD I XRLIT
+ DCA ENDFIX
+ TAD ENDFIX
+ TAD (-240
+ SNA CLA
+ JMP LITEX
+ JMP I LCHK
+
+GLIN5, TAD CRCNT
+ SNA CLA
+ JMP CROUT /NEED THIS CR
+ ISZ CRCNT
+ JMP CROUT /NEED CR AFTER HEADER
+ JMP I (GETLIN
+CROUT, TAD [212
+ JMS I FPUT
+ TAD MARGIN
+ DCA XRLINE
+ JMP I (GLIN6
+CRCNT, 0
+CHANNM, FILENAME CREFLS.TM
+ENDFIX, 0 /TEMP ALSO
+ JMS I (DOLOT2
+ DCA .-1 /ONCE ONLY
+ TAD SYSM
+ SNA
+ JMP I (NDPS1
+ JMP I ENDFIX
+\f *3200
+OUNREC, 0 /ESTIMATE # RECS
+ TAD I XOCTLW
+ CLL RTL
+ RTL
+ RTL /ITS NOT AN ESTIMATE, BUT EXACT!!
+ AND [17
+ JMP I OUNREC
+XOCTLW, OUCTLW
+
+DIVIDE, 0
+ DCA DIV45B
+ DCA DIV45C
+ JMP DIV45D /START UP HERE
+
+DIV45A, ISZ DIV45C /BUMP THE QUOTIENT
+ DCA DIV45B /NEW DIVIDEND
+DIV45D, TAD DIV45B
+ TAD (-52 /DIVIDE BY 52
+ SMA
+ JMP DIV45A /STILL +; KEEP LOOPING
+ TAD (52 /REMAINDER IN AC AFTER ADD
+ JMS I (DIVE /LETTER OR NUMBER?
+ DCA DIV45B
+ TAD DIV45C
+ JMS I (DIVE
+ JMS I [OCHAR
+ TAD DIV45B
+ JMS I [OCHAR
+ ISZ BUFFER
+ JMP I DIVIDE
+
+
+DIV45B, 0
+DIV45C, 0
+
+\fGETLIN, 0 /GET A LINE OF INPUT AND STORE
+ TAD MARGIN /IT AT LINBUF
+ DCA XRLINE
+INLINE, JMS I (ICHAR
+ JMP EN
+ TAD RLSKIP /IF RALF HEADER,ELIM 2 LF
+ SNA CLA
+ JMP REGULR /NOT RALF
+ ISZ RLSKIP /CATCH 2ND LINE
+ JMP INLINE
+ TAD [7776 /ELIM EXTRA CR AFTER HEADER
+ DCA I (CRCNT
+REGULR, TAD CHAR /LINE FEED TERMINATES THIS ROUTINE
+ TAD MLF
+ SNA
+ JMP INLINE /IGNORE LF'S ON INPUT
+ TAD [212-215 /LF-CR
+ SNA CLA
+ JMP GLIN3
+ TAD XRLINE
+ TAD (-375
+ SMA CLA
+ JMP .+3
+ TAD CHAR
+ JMS I FPUT
+ TAD CHAR
+ TAD [-214
+ SZA CLA
+ JMP INLINE
+GLIN3, TAD [215
+ JMS I FPUT
+GLIN4, JMP I (GLIN5
+GLIN6, TAD [200 /TEST FOR ^C
+ KRS
+ TAD (-203
+ SNA CLA
+ KSF
+ JMP I GETLIN
+ JMP I [7605 /FOUND ^C
+RLSKIP, 0
+
+ALLOCT, 0
+ JMS I (DEVCHK
+ 7617 /CHECK INPUT DEVICE
+ SPA CLA
+ IAC /2 PAGE HANDLER
+ DCA BUFCNT
+ JMS I (DEVCHK
+ 7600 /CHECK SIZE OF OUTPUT DEV HANDLER
+ SPA CLA
+ TAD [2 /2 PAGES
+ TAD BUFCNT
+ DCA BUFCNT
+ CLL
+ TAD BUFCNT
+ RAR
+ CLA
+ SZL CLL /IF 1 OR 3,IN DEV IS 2 PGS
+ TAD [200
+ TAD (3601
+ DCA I (XOUDEV
+ TAD [-2
+ TAD BUFCNT
+ SMA SZA CLA
+ JMP I ALLOCT /2 2PAGERS IS DEFAULT
+ TAD (4200 /IF NOT 2 2PAGERS,INBUF AT 4200
+ DCA I (INBUFP
+ TAD I (INBUFP
+ DCA I (INPTR
+ TAD [3
+ DCA I (XINREC
+ TAD (601
+ DCA I (XINCL1
+ JMP I ALLOCT
+BUFCNT, 0
+CLEAR, 0 /ROUTINE TO CLEAN OUT OLD SYMBOL
+ DCA SYM1
+ DCA SYM2
+ DCA SYM3
+ JMP I CLEAR
+
+EN, JMS DPAT /V3D
+ JMP I [ENDPAS
+\f
+
+ /THIS INITIALIZATION CODE IS DESTROYED WHEN DATA IS READ
+/INTO THE BUFFER. FOR THAT REASON, CREF IS NOT RESTARTABLE
+
+ *4200
+ST1, CDF 0
+KLUD, CIF 10
+ JMS I USR
+ 5
+ 1423 /DEFAULT EXTENSION IS .LS
+CHAIN, CDF 10
+ TAD I (7617 /IF NO INPUT, RESTART CD
+ SNA CLA
+ JMP ST1
+ TAD I [7600 /IF NO OUTPUT, GIVE HIM LPT!!
+ SZA CLA
+ JMP ST2
+ CDF 0
+ CIF 10
+ JMS I [200
+ 12 /ASSIGN-NO FETCH
+ 1420
+DEVS, 2400
+ 0
+ JMP ERRTWO /DEFAULT DEVICE IS BAD
+ TAD DEVS
+ CDF 10
+ DCA I [7600
+ST2, CDF 0
+ JMS I (SWITCH
+ CDF 10
+ TAD I OUSAVX
+ CDF 0
+ DCA PASS2
+BLUE0, TAD [-4
+ DCA COUNT
+BLUE, CDF 10
+ TAD I XNAME
+ CDF 0
+ DCA I (OFILE
+ ISZ XNAME
+ ISZ (OFILE
+ ISZ COUNT
+ JMP BLUE
+ JMS I (ALLOCT
+ JMS I (OTYPE
+ AND (770 /CHECK FOR TTY AS OUTPUT (CAN CLA IF DEBUGGING)
+ DCA I (TTYSWT
+ TAD I (TTYSWT /IF LPT IS OUTPUT,
+ SZA CLA /NO INTERNAL FORM FEEDS GENERATED
+ DCA I (NOFORM
+
+
+
+/NOW WE MOVE UP THE PERMANENT AND PSEUDO-OP TABLES.
+/THE Y WERE ASSEMBLED IN FIELD 0 TO SAVE DECTAPE MOTION
+/WHEN LOADING.
+ JMS I (FTEST /GET MACHINE SIZE
+ TAD MAXFLD
+ CIA
+ DCA MAXFLD /- NO.FIELDS
+ CDF 10 /ASSIGN THE INPUT HANDLER
+ TAD I (7617
+ CDF 0
+ CIF 10
+ JMS I USR
+ 1
+INHNDL, INDEVH+1
+ HLT /YECH!!!
+ TAD INHNDL
+ DCA I (INHAND /SETUP ENTRY POINT
+ JMS I (ASHDLR /SET UP FIRST READ
+ TAD (7700
+ DCA USR /SAVE SYMBOL TABLE
+ TAD I (7746
+ AND KLUD
+ TAD [1000 /MARK NOT RESTARTABLE
+ DCA I (7746 /SAVE CORE BIT
+ TAD I XRLINE
+ DCA COUNT /INITIAL LOAD PROVIDES PARAMETERS FOR
+ /THE SYMBOL TABLE. THIS IS # WORDS TO MOVE
+ JMS MOVEM
+ TAD RSWIT
+ SNA CLA /DETERMINE WHICH PSEUDO-OPS
+ TAD (PPSEUD-SPSEUD
+ TAD (SPSEUD-1
+ DCA XRLINE
+ TAD I XRLINE
+ DCA PSEUDO /TABLES INITIALLY HAVE A SHORT HEADER
+ /WHICH CONTAINS INFORMATION ABOUT THEM
+ /PSEUDO CONTAINS STARTING # OF FIRST
+
+\f
+
+ TAD I XRLINE
+ DCA PSEUDO+1 /LAST ENTRY #
+ TAD I XRLINE
+ DCA COUNT /# ENTRIES TO MOVE
+ TAD I XRLINE
+ DCA XRLIT /WHERE THEY GO IN FIELD 1
+ JMS MOVEM
+ JMP I (XFIRST /READ FIRST RECORDS
+
+
+MOVEM, 0
+ TAD I XRLINE
+ CDF 10
+ DCA I XRLIT
+ CDF 0
+ ISZ COUNT
+ JMP .-5
+ JMP I MOVEM
+ERRTWO, JMS I [ERROR /THIS IS AN IMPOSSIBLE ERROR
+ LPTERR
+CHANCK, 0
+ CLL RTL /CHECK FOR /C+/E
+ RAL
+ SNL
+ JMP I CHANCK //C IS MINIMUM CONDITION
+ RTR /V3C USE /1 TO MEAN KEEP CREFLS.TM
+ SNL CLA
+ CMA /-1 IF NO E (I.E. DO ELIMINATE)
+ DCA I (SLSWH
+ JMP I CHANCK
+XNAME, 7601
+PASS2, 0
+
+PATCHA, TAD (35
+ DCA USER+1
+ JMP BLUE0
+\f *4400
+SWITCH, 0
+ JMS I (FILEXT
+ CLA IAC
+ CDF 10
+ AND I (7644 /TEST FOR /X
+ DCA DSWIT
+ TAD I (7643
+ CDF 0
+ JMS I (CHANCK
+ CDF 10
+ CLA CLL
+ TAD I (7644
+ AND (410 /P OR /U USED?
+ SNA
+ JMP ST3
+ CDF 0
+ AND [10
+ SNA CLA
+ JMP TXONLY /JUST /P
+ TAD XDOLL
+ DCA I (DOLL12 /NO SYMBOL TABLE
+TXONLY, TAD KILOUT /YES..DISABLE PASS ONE OUTPUT
+ DCA I [OUTSW
+ST3, CLA
+ CDF 10
+ TAD I (7644
+ CDF 0
+ AND (300 /IF SABR (Q), SET RSWIT AND DSWIT
+ SNA
+ JMP HCR1 /PAL8
+ AND [200 /CHECK FOR RALF
+ SNA CLA
+ JMP RALFCD /Y
+ ISZ RSWIT
+ ISZ DSWIT
+ DCA I (SCAN3 /ENABLE CHECK FOR SABR CHARS
+HCR1, CLA
+ CDF 10
+ TAD I (7644 /CHECK FOR M- MAMMOTH FILE(HCREF)
+ CDF 0
+ SMA CLA
+ JMP I (BLUE0 /NOT LONG FILE
+/PUT IN NECESSARY PATCHES
+ CLL
+ TAD XPATCH
+ DCA I (HC1
+ TAD XPTCH1
+ DCA I (XUSSYM
+ CDF 10
+ TAD I (7645
+ RAR /CHECK IF PASS1 OR 2 FOR /M
+ SNL
+ JMP CHNPS1 /PASS 1
+ RAL CLL /IT'S PASS 2
+ DCA I (7645 /RESTORE TBL
+ CDF 0
+ CIF 10
+ JMS I (7700 /RESTORE USR
+ 10
+ TAD KILOUT
+ DCA I [OUTSW /NO LIST
+ TAD XDOLL
+ DCA I (DOLL12
+ TAD [7720
+ DCA I (PATCH1 /ANOTHER PATCH
+ JMP I SWITCH
+CHNPS1, CLL CML RAL
+ DCA I (7645 /SET /9 SWITCH
+ CDF 0
+ CLA CMA
+ DCA I (HCREF /7777 DURING PASS1
+ JMS I (CHNSET /LOOKUP CREF.SV
+ JMP I (PATCHA
+XPATCH, PATCH&177+5200
+XPTCH1, PATCH
+XDOLL, DOLL13&177+5200
+RALFCD, TAD [7776 /FOR 2 EXTRA LINE FEEDS
+ DCA I (RLSKIP
+ JMP HCR1
+KILOUT, OCHAR&177+5600 /JMP I OCHAR
+
+
+/SUBROUTINE TO DETERMINE CORE SIZE
+FTEST, 0
+ JMS I (MORCOR
+COR0, CDF 0
+ TAD MAXFLD /GET FIELD TO TEST
+ RTL
+ RAL
+ AND COR70
+ TAD COREX
+ DCA .+1
+COR1, CDF /FIELD TO TEST
+ TAD I CORLOC
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC
+CORX, 7400
+ TAD CORX
+ TAD CORV
+ SZA CLA
+ JMP COREX /NON-EXISTENT FIELD
+ TAD COR1
+ DCA I CORLOC
+ ISZ MAXFLD
+ JMP COR0
+COREX, CDF 0
+DONCOR, JMP I FTEST
+CORLOC, CORX
+CORV, 1400
+\f\f\f\f
+ FIELD 0
+/THESE ARE THE PERMANENT AND PSEUDO OP TABLES FOR CREF
+/RAD IS THE BASE USED TO PACK THE CHARACTERS. FOR SABR IT MAY
+/HAVE TO BE MOVED TO 51 RATHER THAN 45.
+
+RAD=52
+
+ *4600
+
+SYMTAB, -453 /INITIAL ENTRIES
+
+ NOPUNCH
+ *0
+ ENPUNCH
+ ZBLOCK 4 /DUMMY ENTRY..SYMCHK NEEDS IT
+
+
+ "A-300^RAD+"N-300+4000 /AND
+ "D-300^RAD
+ ZBLOCK 2
+
+ "B-300^RAD+"S-300+4000 /BSW
+ "W-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"A-300+4000 /CAF
+ "F-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"D-300+4000 /CDF
+ "F-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"I-300+4000 /CIA
+ "A-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"I-300+4000 /CIF
+ "F-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"L-300+4000 /CLA
+ "A-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"L-300+4000 /CLL
+ "L-300^RAD
+ ZBLOCK 2
+
+ "C-300^RAD+"M-300+4000 /CMA
+ "A-300^RAD
+ ZBLOCK 2
+
+R=52
+
+ "C-300^R+"M-300+4000 /CML
+ "L-300^R
+ ZBLOCK 2
+
+ "D-300^R+"C-300+4000 /DCA
+ "A-300^R
+ ZBLOCK 2
+\f "G-300^R+"L-300+4000 /GLK
+ "K-300^R
+ ZBLOCK 2
+
+ "G-300^R+"T-300+4000 /GTF
+ "F-300^R
+ ZBLOCK 2
+
+ "H-300^R+"L-300+4000 /HLT
+ "T-300^R
+ ZBLOCK 2
+
+ "I-300^R+"A-300+4000 /IAC
+ "C-300^R
+ ZBLOCK 2
+
+ "I-300^R+"O-300+4000 /IOF
+ "F-300^R
+ ZBLOCK 2
+
+ "I-300^R+"O-300+4000 /ION
+ "N-300^R
+ ZBLOCK 2
+
+ "I-300^R+"O-300+4000 /IOT
+ "T-300^R
+ ZBLOCK 2
+
+ "I-300^R+"S-300+4000 /ISZ
+ "Z-300^R
+ ZBLOCK 2
+
+ "J-300^R+"M-300+4000 /JMP
+ "P-300^R
+ ZBLOCK 2
+
+ "J-300^R+"M-300+4000 /JMS
+ "S-300^R
+ ZBLOCK 2
+
+ "K-300^R+"C-300+4000 /KCC
+ "C-300^R
+ ZBLOCK 2
+
+ "K-300^R+"C-300+4000 /KCF
+ "F-300^R
+ ZBLOCK 2
+
+ "K-300^R+"I-300+4000 /KIE
+ "E-300^R
+ ZBLOCK 2
+
+ "K-300^R+"R-300+4000 /KRB
+ "B-300^R
+ ZBLOCK 2
+
+ "K-300^R+"R-300+4000 /KRS
+ "S-300^R
+ ZBLOCK 2
+
+ "K-300^R+"S-300+4000 /KSF
+ "F-300^R
+ ZBLOCK 2
+
+ "L-300^R+"A-300+4000 /LAS
+ "S-300^R
+ ZBLOCK 2
+
+ "M-300^R+"Q-300+4000 /MQA
+ "A-300^R
+ ZBLOCK 2
+
+ "M-300^R+"Q-300+4000 /MQL
+ "L-300^R
+ ZBLOCK 2
+
+ "N-300^R+"O-300+4000 /NOP
+ "P-300^R
+ ZBLOCK 2
+
+ "O-300^R+"P-300+4000 /OPR
+ "R-300^R
+ ZBLOCK 2
+
+ "O-300^R+"S-300+4000 /OSR
+ "R-300^R
+ ZBLOCK 2
+
+ "P-300^R+"C-300+4000 /PCE
+ "E-300^R
+ ZBLOCK 2
+
+ "P-300^R+"C-300+4000 /PCF
+ "F-300^R
+ ZBLOCK 2
+
+ "P-300^R+"L-300+4000 /PLS
+ "S-300^R
+ ZBLOCK 2
+
+ "P-300^R+"P-300+4000 /PPC
+ "C-300^R
+ ZBLOCK 2
+
+ "P-300^R+"S-300+4000 /PSF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"A-300+4000 /RAL
+ "L-300^R
+ ZBLOCK 2
+
+ "R-300^R+"A-300+4000 /RAR
+ "R-300^R
+ ZBLOCK 2
+
+ "R-300^R+"D-300+4000 /RDF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"F-300+4000 /RFC
+ "C-300^R
+ ZBLOCK 2
+
+ "R-300^R+"I-300+4000 /RIB
+ "B-300^R
+ ZBLOCK 2
+
+ "R-300^R+"I-300+4000 /RIF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"M-300+4000 /RMF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"P-300+4000 /RPE
+ "E-300^R
+ ZBLOCK 2
+
+ "R-300^R+"R-300+4000 /RRB
+ "B-300^R
+ ZBLOCK 2
+
+ "R-300^R+"S-300+4000 /RSF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"T-300+4000 /RTF
+ "F-300^R
+ ZBLOCK 2
+
+ "R-300^R+"T-300+4000 /RTL
+ "L-300^R
+ ZBLOCK 2
+
+ "R-300^R+"T-300+4000 /RTR
+ "R-300^R
+ ZBLOCK 2
+
+ "S-300^R+"G-300+4000 /SGT
+ "T-300^R
+ ZBLOCK 2
+
+ "S-300^R+"K-300+4000 /SKON
+ "O-300^R+"N-300
+ ZBLOCK 2
+
+ "S-300^R+"K-300+4000 /SKP
+ "P-300^R
+ ZBLOCK 2
+
+ "S-300^R+"M-300+4000 /SMA
+ "A-300^R
+ ZBLOCK 2
+
+ "S-300^R+"N-300+4000 /SNA
+ "A-300^R
+ ZBLOCK 2
+
+ "S-300^R+"N-300+4000 /SNL
+ "L-300^R
+ ZBLOCK 2
+
+ "S-300^R+"P-300+4000 /SPA
+ "A-300^R
+ ZBLOCK 2
+
+ "S-300^R+"R-300+4000 /SRQ
+ "Q-300^R
+ ZBLOCK 2
+
+ "S-300^R+"T-300+4000 /STA
+ "A-300^R
+ ZBLOCK 2
+
+ "S-300^R+"T-300+4000 /STL
+ "L-300^R
+ ZBLOCK 2
+
+ "S-300^R+"W-300+4000 /SWP
+ "P-300^R
+ ZBLOCK 2
+\f
+ "S-300^R+"Z-300+4000 /SZA
+ "A-300^R
+ ZBLOCK 2
+
+ "S-300^R+"Z-300+4000 /SZL
+ "L-300^R
+ ZBLOCK 2
+
+ "T-300^R+"A-300+4000 /TAD
+ "D-300^R
+ ZBLOCK 2
+
+ "T-300^R+"C-300+4000 /TCF
+ "F-300^R
+ ZBLOCK 2
+
+ "T-300^R+"F-300+4000 /TFL
+ "L-300^R
+ ZBLOCK 2
+
+ "T-300^R+"L-300+4000 /TLS
+ "S-300^R
+ ZBLOCK 2
+
+ "T-300^R+"P-300+4000 /TPC
+ "C-300^R
+ ZBLOCK 2
+
+ "T-300^R+"S-300+4000 /TSF
+ "F-300^R
+ ZBLOCK 2
+
+ "T-300^R+"S-300+4000 /TSK
+ "K-300^R
+ ZBLOCK 2
+ -1
+ -1
+ -1
+ -1 /DUMMY LOW ENTRY
+
+\f
+/PSEUDO OP TABLES. ENTRIES ARE SAME FORMAT AS PAL8
+/SYMBOLS.
+
+ *.+SYMTAB
+
+SPSEUD, 1706 /SABR PSEUDOS. BEGINS AT 1706*4
+ 1737 /ENDS AT 1737*4
+ -150 /150 LOCATIONS LONG
+ 7427 /STARTS LOADING AT 17430
+
+ NOPUNCH
+ *7430
+ ENPUNCH
+
+ ZBLOCK 4
+
+
+ "A-300^R+"B-300 /ABSYM
+ "S-300^R+"Y-300
+ "M-300^R
+ B /RETURN POINT
+
+ "A-300^R+"R-300 /ARG
+ "G-300^R
+ 0
+ B
+
+ "B-300^R+"L-300 /BLOCK
+ "O-300^R+"C-300
+ "K-300^R
+ B
+
+ "C-300^R+"A-300 /CALL
+ "L-300^R+"L-300
+ 0
+ B
+
+ "C-300^R+"O-300 /COMMON
+ "M-300^R+"M-300
+ "O-300^R+"N-300
+ B
+
+ "C-300^R+"P-300 /CPAGE
+ "A-300^R+"G-300
+ "E-300^R
+ B
+
+ "D-300^R+"E-300 /DECIM
+ "C-300^R+"I-300
+ "M-300^R
+ B
+
+ "D-300^R+"U-300 /DUMMY
+ "M-300^R+"M-300
+ "Y-300^R
+ B
+
+ "E-300^R+"A-300 /EAP
+ "P-300^R
+ 0
+ B
+
+ "E-300^R+"N-300 /END
+ "D-300^R
+ 0
+EPASS, DOLL1 /BECOMES ENDPAS
+
+ "E-300^R+"N-300 /ENTRY
+ "T-300^R+"R-300
+ "Y-300^R
+ B
+
+ "F-300^R+"O-300 /FORTR
+ "R-300^R+"T-300
+ "R-300^R
+ B
+
+ "I-300^R
+ 0
+ 0
+ B /I
+
+ "I-300^R+"F-300 /IF
+ 0
+ 0
+ B
+
+ "I-300^R+"N-300 /INC
+ "C-300^R
+ 0
+ B
+
+ "L-300^R+"A-300 /LAP
+ "P-300^R
+ 0
+ B
+
+ "O-300^R+"C-300 /OCTAL
+ "T-300^R+"A-300
+ "L-300^R
+ B
+
+ "O-300^R+"P-300 /OPDEF
+ "D-300^R+"E-300
+ "F-300^R
+FXR2, FXMR
+
+ "P-300^R+"A-300 /PAGE
+ "G-300^R+"E-300
+ 0
+ B
+
+ "P-300^R+"A-300 /PAUSE
+ "U-300^R+"S-300
+ "E-300^R
+ B
+
+ "R-300^R+"E-300 /REORG
+ "O-300^R+"R-300
+ "G-300^R
+ B
+
+ "R-300^R+"E-300 /RETRN
+ "T-300^R+"R-300
+ "N-300^R
+ B
+
+ "S-300^R+"K-300 /SKPDF
+ "P-300^R+"D-300
+ "F-300^R
+FXR3, FXMR
+
+ "T-300^R+"E-300 /TEXT
+ "X-300^R+"T-300
+ 0
+ TXT
+
+ -1
+ -1
+ -1
+ -1
+
+\f
+
+/PAL8 PSEUDOS. SAME FORMAT AS OTHERS
+
+ *5424
+ ENPUNCH
+
+PPSEUD, 1706
+ 1737
+ -150
+ 7427
+
+ NOPUNCH
+ *7430
+ ENPUNCH
+
+ ZBLOCK 4
+
+
+ "D-300^R+"E-300 /DECIMAL
+ "C-300^R+"I-300
+ "M-300^R+"A-300
+ B
+
+ "D-300^R+"E-300 /DEVICE
+ "V-300^R+"I-300
+ "C-300^R+"E-300
+ B
+
+ "D-300^R+"T-300 /DTORG
+ "O-300^R+"R-300
+ "G-300^R
+ B
+
+ "E-300^R+"J-300 /EJECT
+ "E-300^R+"C-300
+ "T-300^R
+ NOTBIN /SKIP ANY MORE TEXT
+
+ "E-300^R+"N-300 /ENPUNCH
+ "P-300^R+"U-300
+ "N-300^R+"C-300
+ B
+
+ "E-300^R+"X-300 /EXPUNGE
+ "P-300^R+"U-300
+ "N-300^R+"G-300
+XPJ, XPUNJ
+
+ "F-300^R+"I-300 /FIELD
+ "E-300^R+"L-300
+ "D-300^R
+ B
+
+ "F-300^R+"I-300 /FILENAME
+ "L-300^R+"E-300
+ "N-300^R+"A-300
+ B
+
+ "F-300^R+"I-300 /FIXMRI
+ "X-300^R+"M-300
+ "R-300^R+"I-300
+FXR, FXMR
+
+ "F-300^R+"I-300 /FIXTAB
+ "X-300^R+"T-300
+ "A-300^R+"B-300
+FXT, FXTAB
+
+ "I-300^R /I
+ ZBLOCK 2
+ B
+
+ "I-300^R+"F-300 /IFDEF
+ "D-300^R+"E-300
+ "F-300^R
+ B
+
+ "I-300^R+"F-300 /IFNDEF
+ "N-300^R+"D-300
+ "E-300^R+"F-300
+ B
+
+ "I-300^R+"F-300 /IFNZRO
+ "N-300^R+"Z-300
+ "R-300^R+"O-300
+ B
+
+ "I-300^R+"F-300 /IFZERO
+ "Z-300^R+"E-300
+ "R-300^R+"O-300
+ B
+
+ "N-300^R+"O-300 /NOPUNCH
+ "P-300^R+"U-300
+ "N-300^R+"C-300
+ B
+
+ "O-300^R+"C-300 /OCTAL
+ "T-300^R+"A-300
+ "L-300^R
+ B
+
+ "P-300^R+"A-300 /PAGE
+ "G-300^R+"E-300
+ 0
+ B
+
+ "P-300^R+"A-300 /PAUSE
+ "U-300^R+"S-300
+ "E-300^R
+ B
+
+ "R-300^R+"L-300 /RELOC
+ "L-300^R+"O-300
+ "C-300^R
+ B
+
+ "T-300^R+"E-300 /TEXT
+ "X-300^R+"T-300
+ 0
+ TXT
+
+ "X-300^R+"L-300 /XLIST
+ "I-300^R+"S-300
+ "T-300^R
+ B
+
+ "Z-300^R /Z
+ ZBLOCK 2
+ B
+
+ "Z-300^R+"B-300 /ZBLOCK
+ "L-300^R+"O-300
+ "C-300^R+"K-300
+ B
+
+ -1
+ -1
+ -1
+ -1
+
+
+
+\f *5600
+/THIS CODE IS EXECUTED DURING PASS ONE ONLY. LATER PASSES
+/USE THIS AREA TO BUILD A REFERENCE TABLE.
+
+
+HEADER, 0 /HEADER SWITCHES FPUT TO JMS I [OCHAR
+ TAD CPCHIT
+ DCA FPUT /ADDRESS OF PUNCH ROUTINE
+ JMS I CGTLIN /CALL GETLIN
+ TAD CSTRIT /RESTORE FPUT
+ DCA FPUT
+ JMP I HEADER
+CPCHIT, PNCHIT
+CGTLIN, GETLIN
+CSTRIT, STORIT
+
+PNCHIT, 0
+ JMS I COCHAR
+ JMP I PNCHIT
+
+STORIT, 0
+ DCA I XRLINE
+ JMP I STORIT
+COCHAR, OCHAR
+
+DOLL1, TAD (ENDPAS
+ DCA DOLLAR
+ JMS DPAT
+DOLL12, TAD (KRS /BECOMES JMP .+2 IF /M PASS 2 OR /U
+ DCA I (OUTSW /RE ENABLE OUTPUT
+DOLL13, CDF 10
+ TAD RSWIT
+ SNA CLA
+ JMP DOLL2 /PAL8 PSEUDOS
+ TAD (B
+ DCA I (FXR2
+ TAD (B
+ DCA I (FXR3
+ TAD (ENDPAS
+ DCA I (EPASS /END PSEUDO NOW TO ENDPAS
+ JMP DOLOUT
+DOLL2, TAD (B
+ DCA I (XPJ
+ TAD (B
+ DCA I (FXR
+ TAD (B
+ DCA I (FXT
+DOLOUT, CDF 0
+ JMS DOLOT2
+ JMP I (NOTBIN
+FUDGE, NOP
+
+
+XPUNJ, DCA COUNT
+ CLA CMA
+ TAD USER+1 /SKIP LAST ENTRY (7777)
+ CLL RTL
+XPUNJ3, DCA BUFFER /POINTER INTO SYMBOLS
+ CDF 10
+ TAD I BUFFER
+ TAD (5336 /IS THIS A LITERAL?
+ SNA CLA
+ JMP XPUNJ1 /YES..NEXT ENTRY
+ TAD COUNT /NO..NOW PUSH ALL LITERALS UP
+ CLL RTL /BUT IF COUNT =0, THERE ARE NONE
+ CMA
+ DCA SAVE
+ TAD (3
+ TAD BUFFER /SETTING UP TO DO TRANSFER. IF COUNT=0
+ DCA XRSYM1 /ONLY THE 7777 GETS TRANSFERRED
+ TAD (3
+ DCA XRSYM2
+ TAD I XRSYM1
+ DCA I XRSYM2
+ ISZ SAVE /ALL COMPLETED?
+ JMP .-3
+ TAD COUNT
+ IAC /INCLUDE 7777 ENTRY!
+ DCA USER+1
+ CDF 0
+ JMP I (B
+XPUNJ1, TAD (-4
+ TAD BUFFER
+ ISZ COUNT
+ JMP XPUNJ3
+
+XFIRST, JMS I (OOPEN
+ JMP I (FIRST+1
+
+DOLOT2, 0
+ STL RTL /IF WE HAVE MORE THAN 2 FIELDS,
+ TAD MAXFLD /WE SHALL LEAVE THE SYMBOL TABLE IN ONE
+ /PIECE. THAT ALLOWS US TO USE THE UPPER
+ SZL CLA /CORE PROFITABLY
+ JMP I DOLOT2
+ TAD USER+1
+ CLL RTL
+ TAD (4 /CLEARS SYMBOL TABLE
+ DCA I (LTTBL+1 /FIX PERMANENT LIMIT IN FIELD 1
+ DCA SYMFLD /AND FAKE THAT FLD 1 HAS NO SYMBOLS
+ TAD FUDGE /DISABLE RESET OF FIELD 1 LIMIT
+ DCA I (FUJ1
+ JMP I DOLOT2
+
+CHNSET, 0
+ CLA IAC /SYS DEV ONLY
+ CIF 10
+ JMS I (200
+ 2 /LOOKUP
+STBLK, CREFNM /GET CREF STARTING BLK
+ 0
+ JMP I (ERR6
+ TAD STBLK
+ DCA I (BLK
+ JMP I CHNSET
+CREFNM, FILENAME CREF.SV
+\f PAGE
+
+FXMR, TAD I XRLINE /SHOULD CONTAIN FIRST CHAR IN INSTR.
+ DCA CHAR
+ JMS I (CHECK /CHECK IT
+ 301
+ -332
+ JMP .+4 /NOPE;A NUMBER MAYBE?
+FX2, TAD CHAR
+ JMS I (PACK
+ JMP FXMR
+ JMS I (CHECK
+ 260
+ -271 /CHECK FOR DIGIT 0-9
+ SKP /NOPE. IF THERE IS A SYMBOL, THIS IS TERMINATOR
+ JMP FX2
+ JMS I (REPACK
+ TAD SYM1
+ SNA CLA
+ JMP FXMR
+ CDF 10
+ TAD I (7644 /M RULES FOR FIXMRI TOO
+ CDF 0
+ SMA CLA
+ JMP FXNTR /NO M
+ TAD I (PATCH1
+ DCA PATCH2 /APPROPRIATE SWITCH
+ TAD SYM1
+ RTL
+PATCH2, HLT /SPA SZA OR SMA SNL + CLA
+ JMP I (B
+FXNTR, JMS I (SYMCHK
+ USER
+ JMS I (ENTRY /ENTER AS USER SYMBOL
+ JMS I (BUMP
+ JMP I (B
+FXTAB, CLA CMA /DON'T INCLUDE 7777 ENTRY
+ TAD USER+1
+ CIA
+ DCA COUNT /# ENTRIES TO EXAMINE
+ DCA SAVE
+FXTB2, TAD (4
+ TAD SAVE
+ DCA SAVE
+FXTB9, CDF 10
+ TAD I SAVE /STOP AS SOON AS LITERAL FOUND
+ TAD (5336
+ SNA CLA
+ JMP FXTB3
+ TAD I SAVE /IF ALREADY NEG. ITS A PERM SYMBOL
+ SMA
+ TAD (4000 /MAKE IT PERMANENT
+ DCA I SAVE
+ ISZ COUNT
+ TAD (3
+ TAD SAVE
+ DCA SAVE
+ DCA I SAVE
+ ISZ SAVE
+ JMP FXTB9 /LOOP FOR DURATION
+FXTB3, CDF 0
+ JMP I (B
+
+DEVCHK, 0
+ TAD I DEVCHK
+ DCA T2 /SAVE TBL START
+ ISZ DEVCHK
+ CDF 10
+ TAD I T2 /HANDLER NUMBER
+ AND (17
+ DCA T2
+ CLA CMA
+ TAD I (37 /TBL LOCN IN 10037
+ TAD T2
+ DCA T2
+ TAD I T2
+ CDF 0
+ JMP I DEVCHK
+T2, 0
+/THAT'S ALL FOLKS!!
+$$$$$$$$$$$$$$$$$$
+\f
--- /dev/null
+/EPIC PROGRAM, V5A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1973, 1975, 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/EPIC PROGRAM
+/COPYRIGHT 1973,1977
+/DIGITAL EQUIPMENT CORP.
+/MAYNARD, MASS.01754
+
+ PTAPE=1
+ *0
+VERS, 10
+ *10
+NDX0, 0
+NDX1, 0
+NDX2, 0
+ *20
+BCC1, 0
+BCC2, 0
+BLKLEN, 13
+BUFFLD, 10
+BUFPTR, 0
+BYTCNT, 0
+ CLOC=BYTCNT
+CHKC, CTRLC
+CRLF, TYCRLF
+DATBUF, HDATA
+DOCRC, CRC
+EBLKHI, 0
+EFLG, -1
+EOTFLG, 0
+EQBLK, 0
+ERCODE, 0
+ EOLWD=ERCODE
+FLEN, 0
+FNPTR, 0
+FRMPTR, 0
+ MODF=FRMPTR
+GETCD, DECOD
+HANADR, 0
+IDOFLG, 0
+ MODB=IDOFLG
+IMPFLG, 0
+INCHR, 0
+INPTR, 0
+IOERR, PHYSIO
+LPWT, LPWAIT
+LSPFLG, 0
+MAXCNT, 0
+MAXLEN, -MXPBLK
+MIFLG, 0
+M4, -4
+NAME, 0
+OCNT, 0
+OUDEV, 0;0;0
+OUTCHR, 0
+OUTPTR, 0
+PARCHR, 0
+ MSKWD=PARCHR
+PARPTR, PARADR
+PATFLG, 0
+P17, 17
+P200, 200
+RDCHR, 0
+ SRWD=RDCHR
+RDPBLK, PREAD
+RDSWIT, SWITCH
+RELBLK, HDATA+5
+RBLK, 0
+SATOL, 0
+SBLK, 0
+SLPTR, 0
+SMTOX, 0
+SYTO9, 0
+TMP0, 0
+TMP1, 0
+TMP2, 0
+TMP3, 0
+TMP4, 0
+TNAME, TYPNAM
+TYDEV, TYPDEV
+TYPTXT, TTOTXT
+USR, DOUSR
+USRDEV, 0
+WRCHR, 0
+
+ PAGE
+\f
+START, NOP
+ CIF 10 /START OF PROG
+ JMS I (7700
+ USRIN
+ TAD MAXLEN
+ DCA MAXCNT
+ TLS
+ PLS
+ RFC
+DECOD, TAD (-PTAP
+ TAD MODE
+ SZA CLA
+ JMP .+4
+ TAD LSPFLG
+ SZA CLA
+ JMS I LPWT
+ JMS I CRLF
+ TSF
+ JMP .-1
+ CIF 10
+ JMS I P200
+ DECODE
+ 0
+ TLS /INIT. TTY
+ JMS I (SETDV
+ JMS I (CHKMI
+ CDF 10
+ TAD I (MTOX
+ CDF 0
+ CLL RTR
+ RAR
+ SNL
+ JMP NOVERS
+ JMS I CRLF
+ JMS I TYPTXT /IF /V,TYPE VERSION NUMBER
+ VERSON
+ JMS I CRLF
+NOVERS, TAD (FNAME
+ DCA NAME
+ TAD (7600 /GET NAME
+ DCA NDX0
+ TAD NAME
+ DCA TMP2
+ TAD DATBUF
+ DCA TMP3
+ TAD VERS
+ DCA I TMP3
+ ISZ TMP3
+ TAD M4
+ DCA TMP0
+ CDF 10
+ TAD I (YTO9
+ RAL /CHK /Z
+ SMA CLA
+ JMP .+3
+ DCA EQBLK
+ DCA EBLKHI
+ TAD I (ATOL
+ AND (20 /H ?
+ SZA CLA
+ FOURK /YES
+ DCA TMP1
+ CLA CLL CMA RAR /=3777
+ AND I (7642 /HI EQUALS N
+ TAD TMP1
+ SZA
+ DCA EBLKHI
+ TAD I (7642
+ DCA TMP1
+ TAD I (7646
+ SZA
+ DCA EQBLK /=N LO ORD
+ TAD I (ATOL
+ DCA SATOL
+ TAD I (YTO9
+ DCA SYTO9
+ TAD I (MTOX
+ DCA SMTOX
+ JMS I (DODFN
+ TAD TMP1
+ SMA CLA
+ JMP GOTMOD
+ TAD (MODTBL-1 /GET NEW MODE
+ DCA TMP1
+ TAD SYTO9
+ RAL CLL CML
+ RAL
+ ISZ TMP1
+ SMA /FOUND IT ?
+ JMP .-3
+ CLA
+ TAD I TMP1
+ DCA MODE
+ JMS I CRLF
+GOTMOD, JMP I MODE
+MODTBL, PTAP
+ FED
+ COMPAR
+ IFNZRO PTAPE <
+ DECOD
+ >
+ DECOD
+ DECOD
+ DECOD
+ DECOD
+ DECOD
+ DECOD
+MODE, DECOD
+
+VERSON, TEXT "V 5A "
+ 0
+ PAGE
+\f
+DODFN, 0
+ TAD I (7601
+ SZA CLA
+ JMP LOP0
+ TAD SYTO9
+ SPA CLA
+ JMP LOP0
+ ISZ TMP2
+ ISZ TMP3
+ ISZ TMP0
+ JMP .-3
+ CDF
+ JMP I DODFN
+LOP0, CDF 10
+ TAD I NDX0
+ CDF
+ DCA I TMP2
+ TAD I TMP2
+ DCA I TMP3
+ ISZ TMP2
+ ISZ TMP3
+ ISZ TMP0
+ JMP LOP0
+ JMP I DODFN
+
+HSPRDR, 0
+ JMS IOWAIT
+ RSF
+ RRB
+ DCA INCHR
+ RFC
+ TAD INCHR
+ JMP I HSPRDR
+
+HSPPCH, 0
+ DCA OUTCHR
+ JMS IOWAIT
+ PSF
+ TAD OUTCHR
+ PLS
+ CLA
+ JMP I HSPPCH
+
+LSPRDR, 0
+ JMS IOWAIT
+ KSF
+ KRB
+ DCA INCHR
+ TAD INCHR
+ JMP I LSPRDR
+
+LSPPCH, 0
+ DCA OUTCHR
+ JMS IOWAIT
+ TSF
+ TAD OUTCHR
+ TLS
+ CLA
+ JMP I LSPPCH
+
+IOWAIT, 0
+ TAD I IOWAIT
+ DCA IOTSKP
+ ISZ IOWAIT
+ TAD IOTSKP
+ RTL
+ RAL
+ AND (700
+ TAD VERS
+IOTSKP, 0
+ JMP .-1
+ CLA
+ JMP I IOWAIT
+
+CTRLC, 0
+ KSF
+ JMP I CTRLC
+ TAD [200 /FORCE BIT 8 ON
+ KRS
+ TAD (-203
+ SZA CLA
+ JMP I CTRLC
+ KCC
+CTRLC0, JMS I CRLF
+ TAD (336
+ JMS I (LSPPCH
+ TAD (303
+ JMS I (LSPPCH
+ JMS I CRLF
+ TSF
+ JMP .-1
+ JMP I .+1
+ 7605
+
+ PAGE
+\f
+/HERE FOR SYS:<PTP
+
+PTIN, TAD LSPFLG
+ SNA CLA
+ JMP .+4
+ IAC
+ DCA I (OUTTBL
+ TAD (LSPRDR-HSPRDR
+ TAD (HSPRDR
+ DCA RDCHR
+ TAD I (OUTTBL
+ DCA USRDEV
+ RFC
+ JMS I RDPBLK /GET 1ST PBLK
+ JMS RDERR
+ TAD DATBUF /GET NAME
+ DCA NDX0
+ TAD NAME
+ DCA TMP1
+ TAD M4
+ DCA TMP0
+ TAD I NDX0
+ DCA I TMP1
+ ISZ TMP1
+ ISZ TMP0
+ JMP .-4
+ ISZ NDX0 /BY RELBLK
+ TAD I NDX0
+ DCA BLKW /FILE LEN
+ TAD PATFLG
+ SZA CLA /RDING A PATCH?
+ TAD (LOOKUP-ENTER
+ TAD (ENTER /ENTER=NO PATCH
+ JMS I USR
+ CLL
+ TAD FLEN
+ TAD BLKW
+ SNA /DOES IT FIT?
+ JMP .+3
+ SZL CLA
+ JMP NOFIT
+ TAD BLKW
+ DCA FLEN
+ DCA RBLK
+ TAD FLEN
+ CIA
+ DCA FCNT
+ JMS I (ICHKB /SEE IF WE GOT
+ /THE RIGHT BLK
+LOP3, TAD SBLK /ABS STR BLK
+ TAD I RELBLK
+ DCA BLKW /=BLK TO DO
+ JMS I HANADR
+ 4200 /WRITE 1 BLK
+ BUFADR
+BLKW, 0
+ JMP I IOERR
+ ISZ RBLK
+ ISZ FCNT
+ JMP BY3
+ TAD (CLOSE
+ JMS I USR
+ JMP I GETCD
+BY3, JMS I RDPBLK
+ SKP
+ JMP LOP3
+ MTHREE
+ TAD ERCODE /EOT IS ONLY
+ /LEGAL ERROR
+ SNA CLA
+ JMP IFEOT
+ JMS RDERR /RETRY
+ JMP LOP3-1
+IFEOT, TAD PATFLG
+ SZA CLA
+ JMP I GETCD /PATCH MODE
+ /TERMS ON EOT
+ JMS I TYPTXT
+ EOTMSG
+ JMS I TYPTXT
+ NTMSG
+ JMS I CRLF
+ CLA CMA
+ JMS I LPWT
+ JMS I RDPBLK
+ JMS RDERR
+ JMP LOP3-1
+
+\f
+RDERR, 0
+ MTWO
+ DCA ERCNT
+LOP4, TAD ERCODE
+ TAD (AMSG
+ DCA TMP0
+ TAD I TMP0
+ DCA .+2
+ JMS I TYPTXT
+ 0
+ JMS I CRLF
+ CLA CMA
+ JMS I LPWT
+ JMS I RDCHR
+ CLA
+ JMS I RDPBLK
+ SKP
+ JMP I RDERR
+ ISZ ERCNT
+ JMP LOP4
+ JMP I IOERR
+ERCNT, 0
+FCNT, 0
+
+NOFIT, TAD (16
+ JMS I TYDEV
+ TAD NAME
+ JMS I TNAME
+ JMS I TYPTXT
+ BIGMSG
+ TAD USRDEV
+ JMS I TYDEV
+ JMP I GETCD
+
+ PAGE
+\f
+PTAP, JMS I RDSWIT
+ PSTBL
+ TAD I NAME
+ SNA CLA
+ JMP I (PTIN /PTAP INPUT
+ TAD I (OUTTBL
+ DCA USRDEV
+ TAD LSPFLG
+ SNA CLA
+ TAD (HSPPCH-LSPPCH
+ TAD (LSPPCH
+ DCA WRCHR
+ PLS
+ TAD (LOOKUP
+ JMS I USR
+ TAD PATFLG
+ SNA CLA /PUNCH PATCH ?
+ JMP NOPAT
+ CLL
+ TAD EQBLK /CHK FOR =N
+ TAD FLEN /OUT OF RANGE
+ SNL CLA /?
+ JMP .+4
+ JMS I TYPTXT
+ BEQMSG
+ JMP I GETCD
+ TAD EQBLK
+NOPAT, DCA TMP0
+ TAD TMP0
+ TAD SBLK
+ DCA BLKR /1ST BLK TO PCH
+ TAD TMP0 /PUT REL BLK
+ DCA I TMP3 /IN HDR
+ TAD FLEN
+ CIA /=FILE LEN
+ ISZ TMP3
+ DCA I TMP3
+ ISZ TMP3
+ DCA I TMP3 /0 TO LST HDR
+ /WORD
+ TAD PATFLG /ONLY 1 BLK
+ SZA /PATCHES AT A
+ DCA FLEN /TIME
+ TAD LSPFLG
+ SNA CLA
+ JMP .+3
+LOP2, CLA CMA
+ JMS I LPWT /ON PUNCH
+ TAD MAXLEN
+ CIA
+ TAD MAXCNT
+ SZA CLA /PCH L/T ?
+ JMP .+3 /NO
+ JMS WLT
+ JMS WLT
+LOP1, JMS I HANADR /READ 1 BLK
+ 200 /OF FILE
+ BUFADR
+BLKR, 0
+ JMP I IOERR
+ ISZ BLKR
+ JMS I (PWRITE
+ ISZ I RELBLK
+ ISZ FLEN
+ JMP BYDUN
+ TAD EOTFLG
+ SNA CLA /PCH EOT ?
+ JMS EOT /YES
+ JMP I GETCD
+BYDUN, ISZ MAXCNT
+ JMP LOP1
+ JMS EOT /PHYSICAL END
+ /OF PTP
+ TAD LSPFLG
+ SZA CLA
+ JMS I LPWT
+ JMS I TYPTXT
+ EOTMSG
+ JMS I CRLF
+ JMP LOP2 /NEXT PTP
+
+\f
+WLT, 0
+ TAD LTCNT
+ DCA TMP0
+ TAD P200
+ JMS I WRCHR
+ JMS I CHKC
+ ISZ TMP0
+ JMP .-4
+ JMP I WLT
+LTCNT, -LTLEN
+
+EOT, 0
+ TAD (377
+ JMS I WRCHR
+ JMS WLT
+ JMS WLT
+ JMS WLT
+ TAD MAXLEN
+ DCA MAXCNT
+ JMP I EOT
+
+ PAGE
+\f
+PREAD, 0 /READ A PTP BLK
+ JMS I RDCHR
+ SNA
+ JMP PREAD+1 /ITS L/T
+ TAD (-200
+ SNA
+ JMP PREAD+1 /L/T
+ RAR CLL /201 PCH MUST
+ SNA CLA /SEPARATE L/T
+ /AND DATA
+ JMP ONBLK
+ TAD (-377 /ONLY OTHER
+ TAD INCHR /POSSIBILTY IS
+ SNA CLA /END OF PTP
+ IAC /EOT CODE
+ IAC /L/T ERR
+BYTERR, IAC
+BLKERR, DCA ERCODE
+ JMP I PREAD /P+1=ERR RTN
+ONBLK, JMS I (ISETB
+ DCA PARFLG
+ JMS GETBYT
+ ISZ BYTCNT
+ JMP .-2
+ JMS I RDCHR
+ CIA
+ TAD BCC1
+ SZA CLA
+ JMP BLKERR
+ JMS I RDCHR
+ CIA
+ TAD BCC2
+ SZA CLA
+ JMP BLKERR
+ TAD PARFLG
+ SPA CLA
+ JMP BYTERR
+ ISZ PREAD /GOOD BLK
+ JMP BLKERR+1
+
+\f
+GETBYT, 0
+ TAD LSPFLG
+ SNA CLA
+ JMS I CHKC
+ DCA PARCHR
+ TAD M4
+ DCA CNTR0
+LOP6, MTHREE
+ DCA CNTR1
+LOP5, JMS I RDCHR
+ DCA I FRMPTR
+ ISZ FRMPTR
+ TAD INCHR
+ JMS I DOCRC
+ ISZ CNTR1
+ JMP LOP5
+ MTHREE
+ TAD FRMPTR
+ DCA FRMPTR
+ JMS PACK
+ ISZ CNTR0
+ JMP LOP6
+ JMS I RDCHR
+ JMS I DOCRC
+ TAD INCHR
+ CIA
+ TAD PARCHR
+ SNA CLA
+ JMP NOPAR
+ CLA CMA
+ DCA PARFLG
+ TAD ABORT
+ SPA CLA
+ JMP BYTERR
+ FOURK
+NOPAR, TAD INCHR
+ DCA I PARPTR
+ ISZ PARPTR
+ JMP I GETBYT
+
+\f
+/HERE TO PACK 3 8 BIT FRAMES INTO
+/2 12 BIT WORDS
+
+PACK, 0
+ TAD I FRMPTR
+ RTL CLL
+ RAL /1ST FRM TO
+ DCA I BUFPTR /B1-B8
+ ISZ FRMPTR
+ TAD I FRMPTR /PUT HI HALF OF
+ RTR CLL /2ND FRM INTO
+ RTR /B9-B11 AND LNK
+ RAR
+ DCA HOLDW2
+ TAD HOLDW2 /PUT 1ST FRM IN
+ AND (7 /B0-B7,AND PUT
+ TAD I BUFPTR /HI HALF OF 2ND
+ RAL /IN B8-B11
+ DCA I BUFPTR /YOU AINT SEEN
+ TAD I BUFPTR /NOTHING YET.
+ JMS I (DOPAR
+ TAD HOLDW2 /LO HAF OF 2ND
+ AND (7400 /FRM IS IN
+ ISZ FRMPTR /B0-B3. PUT
+ TAD I FRMPTR /WITH 3RD FRM
+ ISZ BUFPTR
+ DCA I BUFPTR
+ TAD I BUFPTR
+ JMS I (DOPAR
+ ISZ FRMPTR
+ ISZ BUFPTR
+ JMP I PACK
+PARFLG, 0
+CNTR0, 0
+CNTR1, 0
+ABORT, -1
+HOLDW2, 0
+
+ PAGE
+\f
+PWRITE, 0 /HERE TO WRITE
+ /1 BLK OF PTP
+ JMS ISETB
+ JMS I (WLT
+ TAD (201 /START OF DATA
+ /BLK CHAR
+ JMS I WRCHR
+ JMS PUTBYT
+ ISZ BYTCNT
+ JMP .-2
+ TAD BCC1
+ JMS I WRCHR
+ TAD BCC2
+ JMS I WRCHR
+ JMP I PWRITE
+
+ISETB, 0
+ TAD (FRMADR
+ DCA FRMPTR
+ TAD (PARADR
+ DCA PARPTR
+ TAD DATBUF
+ DCA BUFPTR
+ DCA BCC1
+ DCA BCC2
+ TAD (-NBYTS
+ DCA BYTCNT
+ JMP I ISETB
+
+LPWAIT, 0
+ HLT
+ RFC
+ CLA
+ JMP I LPWAIT
+
+\f
+PUTBYT, 0
+ DCA PARCHR
+ TAD M4
+ DCA CNTR2
+LOP7, TAD I BUFPTR
+ JMS DOPAR
+ TAD I BUFPTR /PUT 2 WORDS IN
+ RTR CLL /3 8 BIT FRMS
+ RTR
+ DCA F2
+ TAD F2 /B0-B7 OF 1ST
+ AND (377 /FOR FRM 1
+ DCA F1
+ TAD F2 /LO 4 BITS OF
+ RAR /WORD 1
+ AND (7400 /TO B0-B3 OF
+ DCA F2 /FRM 2
+ TAD F1
+ JMS I WRCHR
+ TAD F1
+ JMS I DOCRC
+ ISZ BUFPTR
+ TAD I BUFPTR
+ JMS DOPAR
+ TAD I BUFPTR /PUT B0-B3
+ AND (7400 /OF WD2
+ RTR CLL /INTO B4-B8
+ RTR
+ TAD F2 /NOW PUT LO 4
+ RTR /BITS OF WD1
+ RTR /(B0-B3) AND HI
+ /4 BITS OF W2
+ /INTO B4-B11
+ JMS I WRCHR
+ TAD OUTCHR /=CHR JST PCHED
+ JMS I DOCRC
+ TAD I BUFPTR
+ AND (377 /LO 8 OF 2ND
+ JMS I WRCHR
+ TAD OUTCHR /=F3
+ JMS I DOCRC
+ ISZ BUFPTR
+ ISZ CNTR2
+ JMP LOP7
+ TAD PARCHR
+ JMS I WRCHR
+ TAD PARCHR
+ JMS I DOCRC
+ JMS I CHKC
+ JMP I PUTBYT
+CNTR2, 0
+F2, 0
+F1, 0
+
+
+\f
+/HERE TO COMPUTE PARITY (EVEN ODD)
+/12 BIT WORD IS IN AC.
+/AFTER EACH (SPA,CML,RAR) SEQUENCE
+/AC B0=0 IF THE
+/NUMBER OF ALREADY PROCESSED 1
+/STATE BITS IS EVEN. OTHERWISE AC B0=1.
+
+DOPAR, 0
+ DCA TMP0
+ TAD (-13 /-13 BECAUSE 2
+ /BITS ARE
+ /PROCESSED
+ /INITIALLY
+ DCA TMP1
+ TAD TMP0
+ RTR /LNK HOLDS
+ /NEWBIT,AC B0
+ /HOLDS STATUS
+ /TO DATE.
+ SPA /CHNG FROM ODD
+ /TO EVEN ?
+ CML /YES CHANGE
+ /STATUS
+ RAR /GET NXT
+ ISZ TMP1 /DONE ?
+ JMP .-4 /NO
+ CMA RAL /SET LNK=1=EVEN
+ CLA /LNK=0=ODD
+ TAD PARCHR /UPDATE PARITY
+ RAL
+ DCA PARCHR
+ JMP I DOPAR
+
+ PAGE
+\f
+TTOTXT, 0
+ TAD I TTOTXT
+ DCA TMP0
+ ISZ TTOTXT
+LOP8, TAD I TMP0
+ RTR
+ RTR
+ RTR
+ JMS DOHAF
+ JMP I TTOTXT
+ TAD I TMP0
+ JMS DOHAF
+ JMP I TTOTXT
+ ISZ TMP0
+ JMP LOP8
+
+DOHAF, 0
+ AND (77
+ SNA
+ JMP I DOHAF
+ ISZ DOHAF
+ TAD (-40
+ SPA
+ TAD (100
+ TAD (240
+ JMS I (LSPPCH
+ JMP I DOHAF
+
+TYCRLF, 0
+ TAD (215
+ JMS I (LSPPCH
+ TAD (212
+ JMS I (LSPPCH
+ JMP I TYCRLF
+
+PHYSIO, JMS I TYPTXT
+ IOMSG
+ JMP I GETCD
+
+\f
+TYPNAM, 0
+ DCA TMP2
+ TAD TMP2
+ DCA TMP0
+ MTHREE
+ DCA TMP1
+LOP9, TAD I TMP0
+ RTR
+ RTR
+ RTR
+ JMS DOHAF
+ JMP DOEXT
+ TAD I TMP0
+ JMS DOHAF
+ JMP DOEXT
+ ISZ TMP0
+ ISZ TMP1
+ JMP LOP9
+DOEXT, TAD P3
+ TAD TMP2
+ DCA TMP0
+ TAD I TMP0
+ SNA CLA
+ JMP P3+1
+ TAD P256 /.
+ JMS I (LSPPCH
+ TAD I TMP0
+ RTR
+ RTR
+ RTR
+ JMS DOHAF
+P256, 256
+ TAD I TMP0
+ JMS DOHAF
+P3, 3
+ TAD (240
+ JMS I (LSPPCH
+ JMP I TYPNAM
+
+\f
+OCTOUT, 0
+ RAL
+ DCA TMP0
+ TAD M4
+ DCA TMP1
+LOP11, TAD TMP0
+ RTL
+ RAL
+ DCA TMP0
+ RAL
+ DCA TMP2
+ TAD TMP0
+ AND (7
+ TAD (260
+ JMS I (LSPPCH
+ TAD TMP2
+ RAR CLL
+ ISZ TMP1
+ JMP LOP11
+ TAD (240
+ JMS I (LSPPCH
+ JMP I OCTOUT
+
+ PAGE
+\f
+/HERE TO SEE IF WE READ THE CORRECT
+/BLK OF THE CORRECT FILE.
+
+ICHKB, 0
+ TAD PATFLG /DONT CHK IF
+ SZA CLA /IN PATCH MODE
+ JMP I ICHKB
+LOP12, TAD M4
+ DCA TMP0
+ TAD LSPFLG
+ SNA CLA
+ JMS I CHKC
+ TAD DATBUF /COMPARE NAMES
+ DCA NDX0
+ TAD NAME
+ DCA TMP1
+LOP10, TAD I NDX0
+ CIA
+ TAD I TMP1
+ SZA CLA
+ JMP NAMERR
+ ISZ TMP1
+ ISZ TMP0
+ JMP LOP10
+ TAD RBLK /CHK BLK
+ CIA
+ TAD I RELBLK
+ SNA CLA
+ JMP I ICHKB /GOOD BLK
+ JMS I TYPTXT
+ NMSG
+ TAD RBLK
+ JMS I (OCTOUT
+ JMS I TYPTXT
+ FMSG
+ TAD I RELBLK
+ JMS I (OCTOUT
+RECHK, JMS I CRLF
+ CLA CMA
+ JMS I LPWT
+ JMS I RDPBLK
+ JMS I (RDERR
+ JMP LOP12
+NAMERR, JMS I TYPTXT
+ NMSG
+ TAD NAME
+ JMS I TNAME
+ JMS I TYPTXT
+ FMSG
+ TAD DATBUF
+ IAC
+ JMS I TNAME
+ JMP RECHK
+
+\f
+/CRC GENERATOR
+/COURTESY OF MARIO S. ROOT
+/COUSIN TO MARIO LEONARD
+
+CRC, 0
+ DCA TMP0
+ TAD (-7
+ DCA TMP1
+ TAD TMP0
+ AND BCC2
+ CIA
+ CLL RAL
+ TAD TMP0
+ TAD BCC2
+ CLL RTR
+ SPA
+ CML
+ RAR
+ ISZ TMP1
+ JMP .-4
+ SPA
+ JMP .+4
+ DCA TMP1
+ TAD BCC1
+ JMP .+5
+ DCA TMP1
+ TAD BCC1
+ RAR
+ CML RAL
+ DCA BCC2
+ TAD TMP1
+ AND (60
+ CLL RTL
+ DCA BCC1
+ TAD BCC1
+ AND BCC2
+ CIA
+ CLL RAL
+ TAD BCC1
+ TAD BCC2
+ DCA BCC2
+ TAD TMP1
+ CLL RTR
+ RTR
+ DCA BCC1
+ TAD BCC1
+ CLL RAR
+ CLL RAR
+ DCA TMP1
+ TAD TMP1
+ AND BCC1
+ CIA
+ CLL RAL
+ TAD BCC1
+ TAD TMP1
+ DCA BCC1
+ JMP I CRC
+
+ PAGE
+\f
+/CHK FOR MASTER INPUT DEVICE ONLY
+
+CHKMI, 0
+ TAD (INTBL-1
+ DCA NDX0
+ TAD I NDX0
+ SNA CLA
+ JMP BY1 /NO MI
+ TAD (-10
+ DCA TMP0
+ ISZ NDX0
+ TAD I NDX0 /MUST HAVE NO
+ SZA CLA /OTHER IN DEVS
+ JMP BY1 /FOUND 1
+ ISZ TMP0
+ JMP .-5
+ CLA CMA /MI ONLY SET
+BY1, DCA MIFLG /MI FLAG
+ JMP I CHKMI
+
+
+\f
+DOUSR, 0 /HERE TO DO A
+ DCA N1-1 /USR CALL
+ TAD NAME /EITHER LOOKUP
+ DCA N1 /,ENTER OR
+ TAD FLEN /CLOSE
+ DCA N1+1
+ TAD USRDEV
+ JMS I (GETHAN
+ CIF 10
+ TAD USRDEV
+ AND P17
+ JMS I P200
+ 0
+N1, 0;0
+ JMP USRERR
+ TAD N1
+ DCA SBLK
+ TAD N1+1
+ DCA FLEN
+ JMP I DOUSR
+USRERR, JMS I TYPTXT
+ USRMSG
+ TAD N1-1
+ JMS I (OCTOUT
+ TAD USRDEV
+ JMS I TYDEV
+ TAD NAME
+ JMS I TNAME
+ JMS I CRLF
+ JMP I GETCD
+
+ PAGE
+\f
+SETDV, 0
+ JMS CHKP37
+ 7600-1 /OUTPUT INFO
+ OUTTBL-1
+ 4
+ -3
+ JMS CHKP37
+ 7617-1 /INPUT INFO
+ INTBL-1
+ 1
+ -11
+ JMP I SETDV
+
+CHKP37, 0
+ DCA TMP0
+ TAD (TM-1
+ DCA NDX1
+ TAD I CHKP37 /P37 ADDR
+ DCA NDX0
+ ISZ CHKP37
+ TAD I CHKP37
+ DCA TMP1 /PERM TBL
+ ISZ CHKP37
+ TAD I CHKP37
+ DCA TMP3 /ENTRY LEN-1
+ ISZ CHKP37
+ TAD I CHKP37
+ DCA TMP2 /-NUM TO DO
+XLOP2, CDF 10
+ TAD I NDX0
+ SZA /BLANK ENTRY ?
+ ISZ TMP0 /NO
+ CDF
+ DCA I NDX1 /TMP SAV
+ TAD NDX0 /ADV PTR TO NXT
+ TAD TMP3
+ DCA NDX0
+ ISZ TMP2 /DONE?
+ JMP XLOP2 /NO
+ TAD TMP0 /WAS P37
+ SNA CLA /BLANK ?
+ JMP BY0 /YES USE SET OF
+ /DEV LAST
+ /SPECIFIED
+ TAD TMP1
+ DCA NDX1
+ TAD (TM-1
+ DCA NDX0
+ TAD I CHKP37
+ DCA TMP0
+ TAD I NDX0 /NEW UNIT
+ DCA I NDX1
+ DCA I NDX1 /0 TO SBLK
+ ISZ TMP0
+ JMP .-4
+ DCA I NDX1
+BY0, ISZ CHKP37
+ JMP I CHKP37
+
+\f
+/ROUT TO INTERPRET PS/8 SWITCHES
+
+SWITCH, 0
+ TAD I SWITCH /PTR TO TBL
+ DCA TMP0
+ ISZ SWITCH
+ CLL
+ TAD (7757
+ AND SATOL
+ TAD SMTOX
+ SNA SZL CLA
+ JMP I SWITCH /NONE TO READ
+XLOP0, TAD I TMP0
+ SNA /END OF TBL ?
+ JMP I SWITCH /YES
+ DCA TMP1 /PTR TO FLAG
+ CLA CMA /SET TO YES
+ DCA I TMP1 /STATE
+XLOP1, ISZ TMP0
+ TAD I TMP0 /AC=P37 SW ADDR
+ ISZ TMP0 /=PTR TO MASK
+ SNA /MORE ARGS FOR
+ /THIS SWIT ?
+ JMP XLOP0 /NO DO NXT
+ DCA TMP2
+ TAD I TMP2
+ AND I TMP0 /CLR NON SWITCH
+ /BITS
+ CIA /COMP WITH MASK
+ TAD I TMP0
+ SZA CLA /IF ALL OK
+ /LEAVE SWITCH
+ /ALONE
+ DCA I TMP1
+ JMP XLOP1
+
+\f PAGE
+\f
+WRITE, 0
+ TAD WRITE
+ DCA READ
+ FOURK
+ JMP READ+1
+
+READ, 0
+ DCA RWBIT
+ JMS I CHKC
+ TAD I READ
+ DCA DVPTR
+ ISZ READ
+ TAD I DVPTR /UNIT
+ JMS I (GETHAN
+ ISZ DVPTR
+ TAD I DVPTR /PUT NUM BLKS
+ AND P17 /IN B1-B5
+ RTL CLL
+ RTL
+ RTL
+ RAL
+ TAD BUFFLD
+ TAD RWBIT
+ DCA IOLST
+ ISZ DVPTR
+ TAD I DVPTR
+ DCA IOLST+2 /SBLK
+ JMS I HANADR
+IOLST, 0
+ 2000
+ 0
+ JMP .+3
+ ISZ READ /NON ERR RTN
+ JMP I READ
+ CLA
+ JMS I TYPTXT
+ IOMSG
+ MTWO
+ TAD DVPTR
+ DCA TMP0
+ TAD I TMP0
+ JMS I TYDEV
+ TAD I NAME
+ SNA CLA
+ JMP .+3
+ TAD NAME
+ JMS I TNAME
+ TAD IOLST+2
+ JMS I (OCTOUT
+ TAD RWBIT
+ SMA CLA
+ JMP DONALL
+ TAD (337
+ JMS I (LSPPCH /BACK ARROW
+DONALL, JMS I CRLF
+ JMP I READ
+RWBIT, 0
+DVPTR, 0
+
+ PAGE
+\f
+\f
+GETHAN, 0
+ AND P17
+ DCA TMP1
+ TAD TMP1
+ TAD (DEVRES-1
+ DCA TMP0
+ CDF 10
+ TAD I TMP0 /IS HANDLER IN
+ CDF /IN CORE ?
+ SZA
+ JMP NOFET /YES
+ MTWO
+ TAD TMP1
+ SNA CLA
+ TAD (1200
+ TAD (6001 /ENABLE 2 PG HANDLERS
+ DCA .+5
+ TAD TMP1
+ CIF 10
+ JMS I P200
+ FETCH
+ 0
+ JMP FETERR
+ TAD .-2
+NOFET, DCA HANADR
+ JMP I GETHAN
+
+FETERR, JMS I TYPTXT
+ USRMSG
+ TAD (FETCH
+ JMS I (OCTOUT
+ JMP I GETCD /ABORT
+ /COMMAND
+
+TYPDEV, 0
+ AND P17
+ TAD (DMTBL-1
+ DCA TMP0
+ TAD I TMP0
+ DCA .+2
+ JMS I TYPTXT
+ 0
+ JMP I TYPDEV
+
+ PAGE
+\f
+COMPAR, JMS I RDSWIT
+ CSTBL
+ TAD I (OUTTBL
+ DCA USRDEV
+ TAD USRDEV
+ DCA CD1
+ TAD (INTBL
+ DCA INPTR
+ TAD I NAME
+ SNA CLA
+ JMP CDEV
+ TAD (LOOKUP
+ JMS I USR
+ TAD SBLK
+ DCA CD1+2
+ TAD I INPTR
+ DCA CD2
+ CDF 10
+ TAD I (7620
+ CDF
+ DCA CD2+2
+ JMS DOCOMP
+CDEV, JMP I GETCD
+
+DOCOMP, 0
+LOP14, JMS I (READ
+ CD1
+ JMP I GETCD
+ TAD (2400
+ DCA I (IOLST+1
+ JMS I (READ
+ CD2
+ JMP CERR
+ CLA CMA
+ DCA BADB
+ TWOK
+ DCA I (IOLST+1
+ TAD (1777
+ DCA NDX0
+ TAD (2377
+ DCA NDX1
+ TAD (-400
+ DCA ZCNT
+ CDF 10
+LOP13, TAD I NDX0
+ CIA
+ TAD I NDX1
+ SZA CLA
+ JMP BADCOM
+LOP15, ISZ ZCNT
+ JMP LOP13
+ CDF
+ ISZ CD1+2
+ ISZ CD2+2
+ ISZ FLEN
+ JMP LOP14
+ JMP I DOCOMP
+BADCOM, CDF
+ ISZ BADB
+ JMP BYBLK
+ TAD CD1
+ JMS I TYDEV
+ TAD CD1+2
+ JMS I (OCTOUT
+ TAD CD2
+ JMS I TYDEV
+ TAD CD2+2
+ JMS I (OCTOUT
+ JMS I CRLF
+BYBLK, TAD BADFO
+ SZA CLA
+ JMP I GETCD
+ TAD BADBO
+ SZA CLA
+ JMP DOMORE
+ TAD (400
+ TAD ZCNT
+ JMS I (OCTOUT
+ TAD NDX0
+ DCA TMP0
+ CDF 10
+ TAD I TMP0
+ CDF
+ JMS I (OCTOUT
+ TAD NDX1
+ DCA TMP0
+ CDF 10
+ TAD I TMP0
+ CDF
+ JMS I (OCTOUT
+ JMS I CRLF
+DOMORE, JMS I CHKC
+ CDF 10
+ JMP LOP15
+CERR, TWOK
+ DCA I (IOLST+1
+ JMP I GETCD
+CD1, 0;1;0
+CD2, 0;1;0
+BADB, 0
+BADBO, 0
+BADFO, 0
+ZCNT, 0
+
+ PAGE
+\f
+/FILE EDITOR FOR OS/8.
+
+FED, TAD I (OUTTBL
+ AND P17
+ DCA USRDEV
+ TAD I NAME
+ SZA CLA
+ JMP ITSNAM
+ TAD USRDEV
+ TAD (DLTBL-1
+ DCA TMP0
+ TAD I TMP0
+ DCA FLEN
+ DCA SBLK
+ JMP .+3
+ITSNAM, TAD (LOOKUP
+ JMS I USR
+ DCA SRWD
+ CLA CMA
+ DCA MSKWD
+ DCA MODF
+ TAD USRDEV
+ DCA OUDEV
+ IAC
+ DCA OUDEV+1
+ JMS I (RD
+LOP16, JMS I (GINP
+ JMS I (G6BIT
+ JMP GOTCMD
+ DCA ENDCT
+ TAD (CMDTBL-2
+ DCA NDX0
+ ISZ NDX0
+ TAD I NDX0
+ CIA
+ TAD ENDCT
+ SZA CLA
+ JMP .-5
+ TAD I NDX0
+ DCA CMDTBL-1
+GOTCMD, JMS I CMDTBL-1
+ JMP LOP16
+
+ QMARK
+CMDTBL, 2200
+ R
+ 2700
+ W
+ 0300
+ C
+ 2300
+ SR
+ 1700
+ O
+ 0500
+ EX
+ENDCT, 0
+ QMARK
+
+QMARK, 0
+ TAD (277
+ JMS I (LSPPCH
+ JMS I CRLF
+ JMP I QMARK
+
+\f
+C, 0 /STATUS COMMAND
+ TAD RBLK
+ JMS I (OCTOUT
+ TAD MODF
+ SNA CLA
+ JMP .+3
+ TAD (306
+ JMS I (LSPPCH
+ TAD MODB
+ SNA CLA
+ JMP .+3
+ TAD (302
+ JMS I (LSPPCH
+ TAD (240
+ JMS I (LSPPCH
+ TAD CLOC
+ JMS I (OCTOUT
+ TAD SRWD
+ JMS I (OCTOUT
+ TAD MSKWD
+ JMS I (OCTOUT
+ JMS I CRLF
+ JMP I C
+
+ PAGE
+\f
+GETC, 0 /GET AN INPUT
+ TAD I BUFPTR /CHAR
+ TAD EOLWD
+ SNA CLA
+ JMP I GETC
+ TAD I BUFPTR
+ DCA INCHR
+ ISZ BUFPTR
+ TAD INCHR
+ TAD (-254 /,
+ SNA CLA
+ JMP I GETC
+ ISZ GETC
+ TAD INCHR
+ JMP I GETC
+
+G6BIT, 0 /8 TO 6 BIT
+ JMS GETC
+ JMP I G6BIT
+ AND (77
+ RTL CLL
+ RTL
+ RTL
+ DCA TMP0
+ JMS GETC
+ JMP EX6
+ AND (77
+ TAD TMP0
+ DCA TMP0
+ JMS GETC
+ JMP EX6
+ JMS BUPTR
+ JMS BUPTR
+ JMS BUPTR
+ JMP I G6BIT
+EX6, TAD TMP0
+ ISZ G6BIT
+ JMP I G6BIT
+
+\f
+GOCTAL, 0 /GET OCTAL DIGIT
+ TAD BUFPTR
+ DCA TMP2
+ JMS GETC
+ JMP I GOCTAL
+ JMS BUPTR
+LOP17, DCA TMP1
+ JMS GETC
+ JMP FOCT
+ TAD (-260
+ DCA TMP0
+ TAD TMP0
+ AND (7770
+ SNA CLA
+ JMP .+4
+ TAD TMP2
+ DCA BUFPTR
+ JMP I GOCTAL
+ TAD TMP1
+ RTL CLL
+ RAL
+ TAD TMP0
+ JMP LOP17
+FOCT, ISZ GOCTAL
+ TAD TMP1
+ JMP I GOCTAL
+
+BUPTR, 0
+ CLA CMA
+ TAD BUFPTR
+ DCA BUFPTR
+ JMP I BUPTR
+
+\f
+RD, 0 /READ A BLK
+ DCA TMP0 /=REL BLK TO DO
+ CLL
+ TAD FLEN
+ TAD TMP0
+ SNL CLA
+ JMP .+3
+ JMS I (QMARK
+ JMP I RD
+ TAD TMP0
+ DCA RBLK
+ TAD RBLK
+ TAD SBLK
+ DCA OUDEV+2
+ JMS I (READ
+ OUDEV
+ JMP I IOERR
+ DCA MODB
+ DCA CLOC
+ JMP I RD
+
+R, 0 /R COMMAND
+ JMS GOCTAL
+ TAD RBLK
+ JMS RD
+ JMP I R
+
+W, 0 /WRITE COMMAND
+ TAD MODB
+ SNA CLA
+ JMP .+5
+ JMS I (WRITE
+ OUDEV
+ JMP I IOERR
+ CLA CMA
+ DCA MODF
+ TAD RBLK
+ IAC
+ JMS RD
+ DCA MODB
+ JMP I W
+
+EX, 0 /EXIT TO DECODE
+ TAD MODB
+ SNA CLA
+ JMP I GETCD
+ JMS I (WRITE
+ OUDEV
+ JMP I IOERR
+ JMP I GETCD
+
+ PAGE
+\f
+GINP, 0 /GET KBRD INPUT
+ TAD MAXLEN
+ DCA OCNT
+ TAD (BUFADR
+ DCA BUFPTR
+ JMS I [LSPRDR
+ AND [177
+ TAD [200
+ DCA INCHR
+ TAD INCHR
+ TAD (-212
+ SNA
+ JMP LFEND
+ TAD (212-203
+ SNA
+ JMP I [CTRLC0
+ TAD (203-215
+ SNA
+ JMP LFEND-1
+ TAD (215-225
+ SZA
+ JMP TRYRUB
+ TAD (336
+ JMS I (LSPPCH
+ TAD (325
+ JMS I (LSPPCH
+ JMS I CRLF
+ JMP GINP+1
+TRYRUB, TAD (225-377
+ SZA CLA
+ JMP PUTC
+ TAD MAXLEN
+ CIA
+ TAD OCNT
+ SNA CLA
+ JMP GINP+5
+ CLA CMA
+ TAD OCNT
+ DCA OCNT
+ CLA CMA
+ TAD BUFPTR
+ DCA BUFPTR
+ TAD (334
+ JMS I (LSPPCH
+ JMP GINP+5
+PUTC, TAD INCHR
+ JMS I (LSPPCH
+ TAD INCHR
+ TAD (-240
+ SNA CLA
+ JMP GINP+5
+ TAD INCHR
+ DCA I BUFPTR
+ ISZ BUFPTR
+ ISZ OCNT
+ JMP GINP+5
+ IAC
+LFEND, DCA I BUFPTR
+ TAD I BUFPTR
+ CIA
+ DCA EOLWD
+ TAD (BUFADR
+ DCA BUFPTR
+ JMS I CRLF
+ JMP I GINP
+
+\f
+O, 0 /OPEN LOC N
+ JMS I (GOCTAL
+ JMP .+3
+ AND (377
+LOP20, DCA CLOC
+ JMS DOLOC
+ TAD EOLWD
+ SZA CLA
+ JMP I O
+ TAD CLOC
+ IAC
+ AND (377
+ SZA
+ JMP LOP20
+ JMS I (W
+ JMP LOP20+1
+
+DOLOC, 0
+ JMS GETWRD
+ JMS I (OCTOUT
+ TAD (257
+ JMS I (LSPPCH
+ JMS GINP
+ JMS I (GOCTAL
+ JMP I DOLOC
+ JMS PUTWRD
+ JMP I DOLOC
+
+GETWRD, 0
+ TAD CLOC
+ TAD I (IOLST+1
+ DCA TMP0
+ CDF 10
+ TAD I TMP0
+ CDF
+ JMP I GETWRD
+
+PUTWRD, 0
+ DCA TMP0
+ TAD CLOC
+ TAD I (IOLST+1
+ DCA TMP1
+ TAD TMP0
+ CDF 10
+ DCA I TMP1
+ CDF
+ CLA CMA
+ DCA MODB
+ JMP I PUTWRD
+
+ PAGE
+\f
+SR, 0 /SEARCH COMM.
+ JMS I (GOCTAL
+ SKP
+ DCA SRWD
+ JMS I (GOCTAL
+ SKP
+ DCA MSKWD
+ TAD EOLWD
+ DCA ISVEOL
+ DCA MATFLG
+ TAD SRWD
+ AND MSKWD
+ CIA
+ DCA BCC1
+ CLA CMA
+ DCA SRBFLG
+LOP18, JMS I (GETWRD
+ AND MSKWD
+ TAD BCC1
+ SNA CLA
+ JMP SRMAT
+LOP19, ISZ CLOC
+ TAD CLOC
+ AND (377
+ SZA CLA
+ JMP LOP18
+ TAD (377
+ DCA CLOC
+ TAD ISVEOL
+ SZA CLA
+ JMP EXS
+ JMS I (W
+ TAD CLOC
+ SNA CLA
+ JMP LOP18-2
+ JMP EXS
+SRMAT, TAD SRBFLG
+ SNA CLA
+ JMP .+3
+ TAD RBLK
+ JMS I (OCTOUT
+ CLA CMA
+ DCA MATFLG
+ DCA SRBFLG
+ TAD CLOC
+ JMS I (OCTOUT
+ JMS I CRLF
+ JMS I (DOLOC
+ TAD EOLWD
+ SNA CLA
+ JMP LOP19
+EXS, TAD MATFLG
+ SNA CLA
+ JMS I (QMARK
+ JMP I SR
+SRBFLG, 0
+MATFLG, 0
+ISVEOL, 0
+
+ PAGE
+\f
+/TABLES FOR FPIP
+
+DLTBL, -6260 /DEVICE LENGTHS
+ -6260 /FOR UNITS 1-17
+ 0 /SYS,DSK,TTY
+ 0 /LPT
+ -1341;-1341 /DTA0-
+ -1341;-1341 /DTA7
+ -1341;-1341
+ -1341;-1341
+ 0
+ 0
+ 0
+
+DMTBL, SYMSG
+ DKMSG
+ TTMSG
+ LPMSG
+ D0MSG
+ D1MSG
+ D2MSG
+ D3MSG
+ D4MSG
+ D5MSG
+ D6MSG
+ D7MSG
+ PPMSG
+ PRMSG
+ CDMSG
+
+AMSG, PARMSG
+ PARMSG
+ LTMSG
+ EOTMSG
+\f
+PSTBL, EOTFLG
+ SATOL
+ 200 /E
+ 0
+ LSPFLG
+ SATOL
+ 1 /L
+ 0
+ PATFLG
+ SMTOX
+ 400 /P
+ 0;0
+CSTBL, BADBO
+ SATOL
+ 2000 /B
+ 0
+ BADFO
+ SATOL
+ 4000
+ 0;0
+
+\f
+TM, 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+OUTTBL, 1;0
+ 0;0
+ 0;0
+ 0
+INTBL, 5;0
+ 0;0
+ 0;0
+ 0;0
+ 0;0
+ 0;0
+ 0;0
+ 0;0
+ 0;0
+ 0
+
+\f
+S0FLG, 0 /CM
+\f
+SYMSG, TEXT "SYS:"
+ 0
+DKMSG, TEXT "DSK:"
+ 0
+TTMSG, TEXT "TTY:"
+ 0
+LPMSG, TEXT "LPT:"
+ 0
+D0MSG, TEXT "DTA0:"
+ 0
+D1MSG, TEXT "DTA1:"
+ 0
+D2MSG, TEXT "DTA2:"
+ 0
+D3MSG, TEXT "DTA3:"
+ 0
+D4MSG, TEXT "DTA4:"
+ 0
+D5MSG, TEXT "DTA5:"
+ 0
+D6MSG, TEXT "DTA6:"
+ 0
+D7MSG, TEXT "DTA7:"
+ 0
+PPMSG, TEXT "PTP:"
+ 0
+PRMSG, TEXT "PTR:"
+ 0
+CDMSG, TEXT "CDR:"
+ 0
+EOTMSG, TEXT "END OF TAPE "
+ 0
+NTMSG, TEXT "ENTER NEXT "
+ 0
+BIGMSG, TEXT "IS TOO BIG FOR "
+ 0
+PARMSG, TEXT "PARITY ERROR "
+ 0
+LTMSG, TEXT "L/T ERROR "
+ 0
+USRMSG, TEXT "USR "
+ 0
+IOMSG, TEXT "I/O ERROR "
+ 0
+NMSG, TEXT "NEED: "
+ 0
+FMSG, TEXT "FOUND: "
+ 0
+BEQMSG, TEXT "BAD =BLK"
+ 0
+
+\f
+PARADR, 0
+ *PARADR+41
+FNAME, 0;0;0;0;0
+FRMADR, 0
+ *614+FRMADR
+AAFREE, 0
+ *6600-10
+HDATA, 0 /TYPE (HOLDS
+ /VERS FOR NOW)
+ 0;0;0;0 /NAME
+ 0 /REL BLK
+ 0 /LEN
+ 0 /CONTINUATION
+ /WD 0 FOR NOW
+BUFADR, 0
+
+ LTLEN=124
+ MXPBLK=40
+ NBYTS=41
+ MTHREE=7346 /CLA CLL CMA RTL
+ MTWO=7344 /CLA CLL CMA RAL
+ TWOK=7332 /CLA CLL CML RTR
+ FOURK=7330 /CLL CML CLA RAR
+ FETCH=1
+ LOOKUP=2
+ ENTER=3
+ CLOSE=4
+ DECODE=5
+ CHAINE=6
+ ERROR=7
+ USRIN=10
+ USROUT=11
+ INQUIRE=12
+ RESET=13
+ PLS=6026
+ PSF=6021
+ RFC=6014
+ RRB=6012
+ RSF=6011
+ DEVRES=7647
+ ATOL=7643
+ MTOX=7644
+ YTO9=7645
+ IFZERO PTAPE <
+ NSLOTS=S0END-S0FLG
+ >
+
+
+ $
+\f
--- /dev/null
+/ FLOATING POINT MATH PACKAGE
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 5A
+/ APRIL 28, 1977
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/ ENTRIES
+/
+ ENTRY FAD
+ ENTRY FSB
+ ENTRY FMP
+ ENTRY FDV
+ ENTRY STO
+ ENTRY FLOT
+ ENTRY FLOAT
+ ENTRY FIX
+ ENTRY IFIX
+ ENTRY IFAD
+ ENTRY ISTO
+ ENTRY ABS
+ ENTRY CHS
+
+/THE FOLLOWING DEFINITIONS ENABLE LIBRARY OPTIMIZATIONS
+/WHERE CRITICAL TIMING CONSIDERATIONS EXIST.
+/THEY SHOULD BE USED WITH EXTREME CAUTION, AND MUST
+/REFERENCE CURRENT PAGE AND PAGE ZERO SYMBOLS ONLY.
+
+OPDEF TADI 1400
+OPDEF DCAI 3400
+OPDEF JMSI 4400
+OPDEF JMPI 5400
+SKPDF JMSKP 4000
+/
+/
+ABSYM HAC 20
+ABSYM MAC 21
+ABSYM LAC 22
+ABSYM SRH 23
+ABSYM SRM 24
+ABSYM SRL 25
+ABSYM ACS 26
+ABSYM ACX 27
+ABSYM SRS 30
+ABSYM SRX 31
+ABSYM MQH 30
+ABSYM MQM 31
+ABSYM MQL 32
+
+// ADDITION AND SUBTRACTION ROUTINE
+//
+
+ LAP /LEAVE AUTO PAGING
+
+ADSRAD, ADSRAC /SOME INDIRECTS TO SAVE CORE...
+ARSAB, ARS
+GTSPLA, GTSPLT
+NORMAD, NORMAC
+COMAD, COM
+
+FSB, BLOCK 1
+ 5 /FLOATING POINT SUBTRACT
+ TAD FSB / CALL 1,FSB
+ DCA FAD / ARG <F.P. VARIABLE>
+ TAD FSB#
+ DCA FAD#
+ CLA CLL CML RAR
+ JMP ED1
+/
+ER1, FAD
+FAD, BLOCK 1
+ 5 /FLOATING POINT ADD SUBROUTINE
+ED1, DCA FSB / CALL 1,FAD
+ TAD FAD / ARG <VARIABLE>
+ DCA FAD1
+FAD1, NOP /CDF TO PICK UP ARGUMENT
+ TADI FAD#
+ INC FAD#
+ DCA 7
+ CLA CMA
+ TADI FAD#
+ INC FAD#
+ DCA 10
+FADENT, TAD ER1
+ DCA ER0
+ TAD ACH /EXAMINE THE FLOATING AC
+ SNA CLA
+ JMP FADLD /IT'S ZERO, DO A LOAD...
+ JMSI GTSPLA
+ JMP FADEND
+ TAD SRS
+ TAD FSB
+ DCA SRS
+ TAD ACX
+ SNA
+ JMP SHFAC
+ CIA
+ TAD SRX
+ SMA
+ JMP SHFAC
+ DCA FSB
+SHFSR, TAD SRH
+ CLL RAR
+ DCA SRH
+ TAD SRM
+ RAR
+ DCA SRM
+ TAD SRL
+ RAR
+ DCA SRL
+ ISZ FSB
+ JMP SHFSR
+ JMP JD1
+/
+SHFAC, CMA
+ DCA FSB
+ TAD SRX
+ DCA ACX
+ JMP ED3A
+ED3, JMSI ARSAB
+ED3A, ISZ FSB
+ JMP ED3
+/
+JD1, TAD ACS
+ SMA CLA
+ JMP ED4
+ CLA CLL CMA RTL / GENERATE -3
+ JMSI COMAD
+ED4, TAD SRS
+ SPA CLA
+ JMSI COMAD
+ JMSI ADSRAD
+ TAD HAC
+ SMA CLA
+ JMP ED5
+ CLA CLL CMA RTL
+ JMSI COMAD
+ CLA CLL CML RAR
+ED5, DCA ACS
+ DCA RSW
+FADEND, JMSI NORMAD
+ JMP FADEX
+
+
+FADLD, TAD 7 /FLOATING LOAD WHEN AC=0
+ DCA FADSB#
+ JMS FADSB
+ SZA /CHECK FOR 0.-0. DON'T GIVE -0.
+ TAD FSB
+ AND ABSSW
+ DCA ACH
+ JMS FADSB
+ DCA ACM
+ JMS FADSB
+ DCA ACL
+FADEX, CLA CMA
+ DCA ABSSW
+ DCA FSB /FOR IFAD AFTER SUBTRACT
+ CLA STL RTL /=0002
+ TAD FAD /HIGH SPEED RETURN
+ DCA FAD3
+FAD3, NOP
+ JMPI FAD#
+
+ABSSW, 7777 /ABSOLUTE VALUE SWITCH
+
+FADSB, 0 /TIME SAVING SUBROUTINE
+ NOP /CHANGED TO CDF
+ TADI 10
+ JMPI FADSB
+
+/ FLOATING POINT ABSOLUTE VALUE FUNCTION
+
+ABS, BLOCK 1
+ 5 / CALL 1,ABS
+ TAD ABS / ARG <F.P. VARIABLE>
+ DCA FAD
+ TAD ABS#
+ DCA FAD#
+ CLL STA RAR /=3777
+ DCA ABSSW
+ JMP ED1 /GO INTO ADD ROUTINE...
+
+ PAGE
+\f
+
+/ ROUTINE TO GET OPERAND INTO SR, SEPARATE SIGNS AND
+/ EXPONENTS OF AC AND SR, AND MOVE GLOBAL AC TO LOCAL AC.
+/
+
+GTSPLT, 0
+ TAD 7
+ DCA GTS1
+GTS1, NOP
+ TADI 10 /PICK UP HIGH ORDER WORD
+ JMS SPLIT /MUST NOT CHANGE DATA FIELD****
+ DCA SRH
+ TAD ACX
+ SZA
+ INC GTSPLT
+ DCA SRX
+ TAD ACS
+ DCA SRS
+ TADI 10 /PICK UP WORD 2
+ DCA SRM
+ TADI 10 /PICK UP WORD 3
+ DCA SRL
+ TAD ACH
+ JMS SPLIT /EXPAND THE FLOATING AC...
+ DCA HAC
+ DCA RSW
+GTS2, TAD ACM /NEEDS LABEL TO FORCE CDF!
+ DCA MAC
+ TAD ACL
+ DCA LAC
+ JMPI GTSPLT
+/
+
+SPLIT, 0 /BREAK UP SIGN, EXPON, AND HI-ORD BITS
+ DCA TMP /ROUTINE MUST NOT CHANGE DATA FIELD****
+ TAD TMP
+ RAR
+ RTR
+ AND (377
+ DCA ACX
+ CLA CLL CML RAR / = 4000
+ AND TMP
+ DCA ACS
+ TAD TMP
+ AND (7
+ JMPI SPLIT
+TMP, 0
+/
+/
+
+ALS, 0 /LOCAL AC SHIFT LEFT SUBROUTINE
+ TAD LAC
+ CLL RAL
+ DCA LAC
+ TAD MAC
+ RAL
+ DCA MAC
+ TAD HAC
+ RAL
+ DCA HAC
+ JMPI ALS
+/
+/ ADD SR TO AC
+/
+
+ADSRAC, 0 /ADD LOCAL SR TO LOCAL AC
+ CLL
+ TAD LAC
+ TAD SRL
+ DCA LAC
+ CLA RAL
+ TAD MAC
+ TAD SRM
+ DCA MAC
+ CLA RAL
+ TAD HAC
+ TAD SRH
+ DCA HAC
+ JMPI ADSRAC
+/
+/ ROUTINE TO NORMALIZE AND RECOMBINE ACCUMULATOR,
+/ AND PLACE LOCAL ACC. IN GLOBAL ACC.
+/
+ARSAD, ARS /SOME CORE SAVING INDIRECTS
+ERRAD, ERR
+RSW, 0 /ROUNDING BIT
+
+NORMAC, 0 /NORMALIZE AND PACKING SUBROUTINE
+ED6, TAD HAC
+ TAD (7770
+ SPA CLA
+ JMP RUND
+ JMSI ARSAD
+ ISZ ACX
+ JMP ED6
+/
+/ ROUNDOFF ROUTINE
+/
+RUND, TAD RSW
+ SNA CLA
+ JMP LEFTST
+ ISZ LAC
+ JMP LEFTST
+ ISZ MAC
+ JMP LEFTST
+ ISZ HAC
+ DCA RSW
+ JMP ED6
+/
+LEFTST, TAD ACX
+ SNA SPA
+ JMP ZEROUT
+ DCA ACX
+ CLA CLL CMA RTL / = -3
+ TAD HAC
+ SMA SZA CLA
+ JMP COMBIN
+ JMS ALS
+ CLA CMA
+ JMP LEFTST
+/
+COMBIN, TAD ACX
+ CLL RAL
+ RTL
+ SPA
+ JMPI ERRAD
+ TAD HAC
+ TAD ACS
+ED7, DCA ACH
+ TAD MAC
+ DCA ACM
+ TAD LAC
+ DCA ACL
+ JMPI NORMAC
+
+ZEROUT, CLA
+ DCA LAC
+ DCA MAC
+ JMP ED7
+
+ PAGE
+\f/
+/ INDIRECT STORE
+/
+
+ISTO, BLOCK 1
+ 5 /FLOATING POINT INDIRECT STORE
+ TAD ISTO / CALL 1,ISTO
+ DCA IST1 / ARG <2WORD ADDRESS>
+IST1, NOP
+ TADI ISTO#
+ INC ISTO#
+ DCA IST2
+ TADI ISTO#
+ DCA 7
+ TAD ISTO
+ DCA STO
+ TAD ISTO#
+ DCA STO#
+IST2, NOP
+ TADI 7
+ INC 7
+ DCA ISTO
+ CLA CMA
+ TADI 7
+ DCA 10
+ TAD ISTO
+ DCA STOSB#
+ JMP STOX
+/
+/
+/ ROUTINE TO STORE CONTENTS OF FL. PT. ACC AND CLEAR IT
+/
+STO, BLOCK 1
+ 5 / CALL 1,STO
+ TAD STO / ARG <F.P. VARIABLE>
+ DCA STO1
+STO1, NOP /REPLACED BY CDF
+ TADI STO#
+ INC STO#
+ DCA STOSB#
+ CLA CMA
+ TADI STO#
+ DCA 10
+STOX, TAD ACH
+ JMS STOSB
+ DCA ACH
+ TAD ACM
+ JMS STOSB
+ DCA ACM
+ TAD ACL
+ JMS STOSB
+ DCA ACL
+ INC STO#
+ CLA STL RTL /=0002
+ TAD STO /SOME TIME SAVING CODE...
+ DCA STO3
+STO3, NOP /REPLACED BY CIF CDF
+ JMPI STO#
+
+STOSB, 0 /TIME SAVING SUBROUTINE
+ NOP /CHANGED TO A CDF DESTINATION
+ DCAI 10
+ JMPI STOSB
+/
+/ FLOATING POINT TO FIXED POINT CONVERSION
+/
+FXER, 4611
+ 3040 /"FIX" ERROR
+FIX, BLOCK 1
+ 5
+FIXX, TAD ACH
+ JMS SPLIT
+ DCA HAC
+ TAD ACM
+ DCA MAC
+ TAD ACX
+ TAD (-214
+ SMA
+ JMP FIXERR
+ TAD (-3
+ DCA SRM
+RSH, JMS ARS
+ ISZ SRM
+ JMP RSH
+ TAD ACS
+ RAL
+ TAD MAC
+ SZL
+ CIA
+FIXRTN, DCA ACS
+ DCA ACH
+ DCA ACM
+ DCA ACL
+ TAD ACS
+ RETRN FIX
+/
+IFIX, BLOCK 1
+ 5
+ TAD IFIX
+ DCA ADDR
+ TAD IFIX#
+ DCA ADDR#
+ CALL 1,IFAD
+ADDR, ARG 0
+ TAD IFIX
+ DCA FIX
+ CLA CLL CML RTL / = 2
+ TAD IFIX#
+ DCA FIX#
+ JMP FIXX
+
+FIXERR, CALL 1,ERROR
+ ARG FXER
+ CLA CLL CMA RAR
+ JMP FIXRTN /RETURN WITH 2047 IN FIXED AC
+
+ PAGE
+\f
+/
+/ FLOATING POINT MULTIPLICATION
+/
+
+ADSRAE, ADSRAC /SOME TIME SAVING INDIRECTS
+ARSAE, ARS
+COMAF, COM
+GTSPLB, GTSPLT
+NORMAG, NORMAC
+ER4, FDV
+ER01, ER0
+ER3, FMP
+FMP, BLOCK 1
+ 5
+ TAD ER3
+ DCAI ER01
+ TAD FMP
+ DCA FMP1
+FMP1, NOP /CDF TO FIELD OF CALLING PROGRAM
+ TADI FMP#
+ INC FMP#
+ DCA 7
+ CLA CMA
+ TADI FMP#
+ INC FMP#
+ DCA 10
+ JMSI GTSPLB /WARNING ***THIS INSTRUCTION SKIPS***
+ JMP MULZRO
+ TAD ACS
+ TAD SRS
+ DCA ACS
+ TAD ACX
+ TAD SRX
+MULZRO, TAD (-201
+ DCA ACX
+ TAD HAC
+ DCA MQH
+ TAD MAC
+ DCA MQM
+ TAD LAC
+ DCA MQL
+ DCA HAC
+ TAD (-33
+ DCA FMP1
+/
+MULT, JMSI ARSAE
+ TAD MQH
+ RAR
+ DCA MQH
+ TAD MQM
+ RAR
+ DCA MQM
+ TAD MQL
+ RAR
+ DCA MQL
+ SZL
+ JMSI ADSRAE
+ ISZ FMP1
+ JMP MULT
+ JMSI NORMAG
+ RETRN FMP
+/
+/
+/ FLOATING POINT DIVISION
+/
+DIVZ, 4411
+ 2632
+FDV, BLOCK 1
+ 5
+ TAD ER4
+ DCAI ER01
+ TAD FDV
+ DCA FDV0
+FDV0, NOP /CDF TO FIELD OF CALLING PROGRAM
+ TADI FDV#
+ INC FDV#
+ DCA 7
+ CLA CMA
+ TADI FDV#
+ INC FDV#
+ DCA 10
+ JMSI GTSPLB
+ JMP DIVERR
+ TAD ACS
+ TAD SRS
+ DCA ACS
+ TAD SRX
+ CIA
+ TAD ACX
+ TAD (177
+ DCA ACX
+ DCA MQL
+ TAD (-35
+ DCA FDV0
+DVID, CLA CLL CML RAR / = 4000
+ AND SRH
+ TAD HAC
+ SPA CLA
+ JMP FDV1
+ JMSI COMAF
+FDV1, JMSI ADSRAE
+ TAD MQL
+ RAL
+ DCA MQL
+ TAD MQM
+ RAL
+ DCA MQM
+ TAD MQH
+ RAL
+ DCA MQH
+ JMS ALS
+ ISZ FDV0
+ JMP DVID
+/
+ TAD MQH
+ DCA HAC
+ TAD MQM
+ DCA MAC
+ TAD MQL
+ DCA LAC
+ JMSI NORMAG
+FDVRET, RETRN FDV
+
+DIVERR, CALL 1,ERROR
+ ARG DIVZ
+ CLA CLL CMA RAR
+ DCA ACH
+ JMP FDVRET
+
+ PAGE
+\f/
+/ ROUTINE TO GET TWO'S COMPLEMENT OF TRIPLE WORD NUMBER
+/ IF NO ADDRESS IN AC UPON ENTRY, SR IS ASSUMED.
+/
+COM, 0
+ TAD (25 /ADDRESS OF SRL
+ DCA PTR2
+ CLA CLL CMA RTL / = -3
+ DCA CTR2
+ED8, TAD I PTR2
+ CMA
+ SZL
+ CLL IAC
+ DCA I PTR2
+ CLA CMA CML
+ TAD PTR2
+ DCA PTR2
+ ISZ CTR2
+ JMP ED8
+ JMP I COM
+PTR2, 0
+CTR2, 0
+/
+/ CONVERT FIXED POINT TO FLOATING POINT
+/
+ CPAGE 14
+
+FLOAT, BLOCK 1
+ 5 /FLOAT FUNCTION
+ TAD FLOAT / CALL 1,FLOAT
+ DCA FLO1 / ARG <INT. VARIABLE>
+FLO1, NOP
+ TADI FLOAT#
+ INC FLOAT#
+ DCA FLO2
+ TADI FLOAT#
+ INC FLOAT#
+ DCA 7
+ TAD FLOAT
+ DCA FLOT
+ TAD FLOAT#
+ DCA FLOT#
+FLO2, NOP /CDF TO FIELD OF ARGUMENT
+ TADI 7
+ JMP FLOTX
+/
+/ INTEGER TO FLOATING POINT CONVERSION
+/
+FLOT, BLOCK 1
+ 5 / CALL 0,FLOT
+FLOTX, CLL /ASSUMES INTEGER VARIABLE IN AC
+ SPA
+ CIA CML
+ DCA MAC
+ DCA HAC
+ DCA LAC
+ RAR
+ DCA ACS
+ TAD (217
+ DCA ACX
+ DCA RSW
+ JMS NORMAC
+ RETRN FLOT
+
+/ INDIRECT FLOATING POINT ADD
+
+ CPAGE 36
+IFAD, BLOCK 1
+ 5 / CALL 1,IFAD
+ TAD IFAD / ARG <2WORD ADDRESS>
+ DCA IFA1
+IFA1, NOP
+ TADI IFAD#
+ INC IFAD#
+ DCA IFA2
+ CLA CMA
+ TADI IFAD#
+ INC IFAD#
+ DCA 10
+IFA2, NOP
+ TADI 10
+ DCA 7
+ CLA CMA
+ TADI 10
+ DCA 10
+ TAD IFAD
+ DCA FAD
+ TAD IFAD#
+ DCA FAD#
+ JMP FADENT
+
+
+ARS, 0 /LOCAL AC SHIFT RIGHT SUBROUTINE
+ TAD HAC
+ CLL RAR
+ DCA HAC
+ TAD MAC
+ RAR
+ DCA MAC
+ TAD LAC
+ RAR
+ DCA LAC
+ CLA RAL
+ DCA RSW
+ JMPI ARS
+
+FPER, 5726
+ 0614 /"OVFL" ERROR
+CHS, BLOCK 1
+ 5 /FLOATING POINT NEGATION
+ TAD ACH / CALL 0,CHS
+ SZA
+ TAD (4000
+CHSRET, DCA ACH
+ RETRN CHS
+/
+/ ERROR ROUTINES
+/
+ER0, 0 /CONTAINS ADDRESS OF CURRENT ENTRY PT
+ERR, CLA
+ TAD I ER0 /BANK CALL IS FROM
+ DCA CHS
+ ISZ ER0 /INDEX TO ADDRESS
+ TAD I ER0 /ADDRESS
+ DCA CHS#
+ CALL 1,ERROR
+ ARG FPER
+ CLA CLL CMA RAR
+ JMP CHSRET
+
+ END
+\f
--- /dev/null
+/LIBSET - LIBRARY BUILDER PROGRAM
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f FIELD 1
+ HILOC=20
+ INFPTR=21
+ IFPTR=22
+ TEMP=23
+ NAMPTR=24
+/VERSION=3
+/PATCH="A
+
+ *2600
+START, SKP
+ JMP .+4
+CALLCD, JMS I (200
+ 5
+RL, 2214
+ 0 /DON'T RESET OUTPUT FILES
+ ISZ FIRST
+ JMP NOTFST
+ TAD I (7604
+ SNA
+ TAD RL
+ DCA I (7604
+ TAD I (7600
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP OUTYES /YES
+ CLA IAC
+ DCA I (7600 /NO - MAKE SYS:LIB8.RL THE OUTPUT FILE
+ TAD (1411
+ DCA I (7601
+ TAD (0270
+ DCA I (7602
+ TAD I (7617
+ SNA CLA /HOW ABOUT INPUT FILES?
+ TAD I (MPARAM+1
+ AND (40 /IF NO INPUT FILES,
+ SNA CLA /AND /S OPTION IS ON,
+ JMP OUTYES
+ DCA PTRCOD /USE PTR: FOR INPUT
+ JMS I (200
+ 12
+ 4224
+PTRCOD, 0
+ 0
+ JMP I PERROR /NO PTR - BAD
+ TAD PTRCOD
+ DCA I (7617
+OUTYES, JMS I (XOPEN
+ JMS I (OCHAR
+ JMS I (DMPREC /PUT OUT NOTHIN IN FIRST RECORD
+ TAD (7000
+ DCA NAMPTR
+ TAD (7376
+ DCA INFPTR
+NOTFST, TAD (7617
+ DCA IFPTR
+FILELP, TAD I IFPTR
+ SNA CLA
+ JMP NEXTCD
+ TAD IFPTR
+ JMS I (IOPEN
+READLP, CLA CMA
+ TAD I (OUCCNT
+ DCA FLEN
+ DCA HILOC
+ JMS I (IREAD /READ AND COPY A RELOCATABLE PROGRAM
+ SZA CLA /TEST CHECKSUM
+ JMP I PERROR
+ TAD HILOC
+ AND (7600
+ TAD FLEN
+ DCA I INFPTR
+ JMS I (DMPREC
+ ISZ INFPTR
+ DCA I INFPTR
+ CLA CLL CMA RTL
+ TAD INFPTR
+ DCA INFPTR
+ TAD I (MPARAM+1
+ AND (40
+ SZA CLA
+ JMP READLP /IF /S SWITCH ON , CONTINUE READING TAPES UNTIL A ^Z
+NXFIL, ISZ IFPTR
+ ISZ IFPTR
+ JMP FILELP
+NEXTCD, TAD I (MPARAM-1
+ SMA CLA
+ JMP CALLCD
+ DCA I NAMPTR
+ ISZ NAMPTR
+ ISZ NAMPTR
+ ISZ NAMPTR
+ DCA I NAMPTR
+ TAD NAMPTR
+ CMA IAC
+ TAD INFPTR
+ SMA CLA
+ JMP I (FINISH
+ JMP I .+1
+ TOOBIG
+
+FIRST, -1
+FLEN, 0
+
+JTABL, DATAWD
+ DATAWD
+ ERROR
+ SYMDEF
+ ORIGIN
+ DATAWD
+ DATAWD
+PERROR, ERROR
+ ENDTAP
+ ERROR
+ COMMON
+ ERROR
+ ERROR
+ ERROR
+ ERROR
+ TRANVC
+
+VERSON, 6301 /VERSION AND PATCH LEVEL
+\f *3000
+IREAD, 0
+ TAD (200
+ DCA LOC
+ILEADR, JMS I (ICHAR
+ DCA CKSM
+ TAD CKSM
+ AND (177
+ SNA CLA
+ JMP ILEADR
+ TAD CKSM
+ TAD (-232
+ SNA CLA
+ JMP I (NXFIL
+ TAD (200
+ JMS I (OCHAR
+ TAD CKSM
+ JMS I (OCHAR
+ TAD CKSM
+ SKP
+NXTFRM, JMS RCHAR
+ CLL RTR
+ RTR
+ RAR
+ DCA CHAR1
+ TAD CHAR1
+ RAL
+ AND (17
+ TAD JMPTAB
+ DCA BTMP
+ TAD I BTMP
+ DCA BTMP
+ JMP I BTMP
+JMPTAB, JTABL
+
+RCHAR, 0
+ JMS I (ICHAR
+ DCA CHAR
+ TAD CKSM
+ TAD CHAR
+ DCA CKSM
+ TAD CHAR
+ JMS I (OCHAR
+ TAD CHAR
+ JMP I RCHAR
+
+DATAWD, JMS RCHAR
+ CLA CLL
+ TAD LOC
+ CMA
+ TAD HILOC
+ SZL CLA
+ JMP .+3
+ TAD LOC
+ DCA HILOC
+ ISZ LOC
+ JMP NXTFRM
+
+SYMDEF, JMS RCHAR
+ CLA CLL CMA RTL
+ DCA CHAR1
+GTNMLP, JMS RCHAR
+ AND (77
+ CLL RTL
+ RTL
+ RTL
+ DCA BTMP
+ JMS RCHAR
+ AND (77
+ TAD BTMP
+ DCA I NAMPTR
+ ISZ NAMPTR
+ ISZ CHAR1
+ JMP GTNMLP
+ TAD INFPTR
+ AND (377
+ DCA I NAMPTR
+ ISZ NAMPTR
+ TAD NAMPTR
+ CIA
+ TAD INFPTR
+ SPA SNA CLA
+ JMP I (TOOBIG
+ JMP NXTFRM
+
+ORIGIN, JMS RCHAR
+ CLA
+ TAD CHAR1
+ AND (7400
+ TAD CHAR
+ DCA LOC
+ JMP NXTFRM
+
+COMMON, JMS RCHAR
+ CLA
+ JMP NXTFRM
+
+TRANVC, JMS RCHAR
+ CLL RAL
+ TAD CHAR
+ CLL RAL
+ CIA
+ DCA BTMP
+ JMS RCHAR
+ CLA
+ ISZ BTMP
+ JMP .-3
+ JMP NXTFRM
+
+ENDTAP, TAD CKSM
+ CIA
+ TAD CHAR
+ DCA BTMP
+ JMS RCHAR
+ CLA
+ TAD CHAR1
+ AND (7400
+ TAD CHAR
+ TAD BTMP
+ JMP I IREAD
+
+LOC, 0
+CHAR1, 0
+CHAR, 0
+BTMP, 0
+CKSM, 0
+
+\f *3200
+XOPEN, 0
+ TAD (7577
+ DCA 10
+ TAD (FILENM-1
+ DCA 11
+ TAD (-5
+ DCA 12
+ TAD I 10
+ DCA I 11
+ ISZ 12
+ JMP .-3
+ JMS I (OOPEN
+ TAD I (OUBLK
+ DCA CTLWRI
+ TAD I (OUHNDL
+ DCA ODVH
+ JMP I XOPEN
+
+DMPREC, 0
+ JMS I (OCHAR
+ JMS I (OCHAR
+ TAD I (OUDWCT
+ TAD (200
+ SZA CLA
+ JMP .-4
+ JMP I DMPREC
+
+FINISH, JMS I (OCLOSE
+ CIF 0
+ JMS I ODVH
+ 4210
+ 7000
+CTLWRI, 0
+ JMP OUTERR
+ CDF CIF 0
+ JMP I (7605
+FILENM, ZBLOCK 5
+ODVH, 0
+
+TOOBIG, ISZ ERRNO
+ERROR, ISZ ERRNO
+OUTERR, ISZ ERRNO
+INERR, ISZ ERRNO
+ERR, TAD ERRNO
+ TAD (ERR0
+ DCA EPCH
+ DCA ERRNO
+ TAD I EPCH
+ DCA ODVH
+ERRLP, TAD I ODVH
+ RTR
+ RTR
+ RTR
+ JMS EPCH
+ TAD I ODVH
+ JMS EPCH
+ ISZ ODVH
+ JMP ERRLP
+ERXIT, CDF CIF 0
+ JMP I .+1
+ 7605
+
+EPCH, 0
+ AND (77
+ SNA
+ JMP ERXIT
+ TAD (-40
+ SPA
+ TAD (100
+ TAD (240
+ 6046
+ 6041
+ JMP .-1
+ CLA
+ JMP I EPCH
+
+ERRNO, 0
+\f *3400
+ /ERROR MESSAGES
+ERR0, HELP
+ INPER
+ OUPER
+ RELER
+ BIGER
+
+HELP, TEXT /HELP!/ /THIS ERROR CANNOT OCCUR
+INPER, TEXT /INPUT ERROR/
+OUPER, TEXT /ERROR WHILE WRITING OUTPUT FILE/
+RELER, TEXT /BAD FORMAT OR CHECKSUM - TRY AGAIN./
+BIGER, TEXT /LIBRARY DIRECTORY OVERFLOW - TOUGH/
+\f INBUF=0
+ INCTL=2400
+ OUBUF=6000
+ OUCTL=4200
+ INDEVH=6400
+ OUDEVH=7000
+ INRECS=12
+ MPARAM=7643
+ DCB=7760
+ INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
+ *2000
+IN7400, 7400
+IOPEN, 0
+ DCA INXPTR
+ CLA CMA
+ DCA INCHCT /SET INCHCT TO FORCE A READ
+ ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+ RDF
+ TAD INCDIF
+ DCA .+1
+INPTR, HLT /RESTORE CALLING FIELDS
+ JMP I IOPEN
+
+ICHAR, 0
+IN7600, 7600
+ RDF
+ TAD INCDIF
+ DCA INRTRN /SAVE CALLING FIELDS
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SNA CLA /DID LAST READ YIELD END-OF-FILE?
+ JMP INGBUF /NO - DO ANOTHER
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ JMP I (ERROR
+INGBUF, TAD INCTR
+ CLL
+ TAD (INRECS
+ SNL
+ DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CONTROL WORD
+ TAD (INCTL+1
+ DCA INCTLW
+INCDIF, CDF CIF 0
+ CDF 10
+ JMS I INHNDL /CALL THE DEVICE HANDLER
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMP INERRX /SOME KIND OF HANDLER ERROR
+INBREC, TAD INREC
+ TAD (INRECS
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
+ SMA CLA /WHICH TYPE WAS IT?
+ JMP INBREC /END OF FILE - RESUME THY PROCESSING
+ JMP I (INERR
+INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+IN200, AND IN7400
+ CLL RTR
+ RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND (377
+INRTRN, 0 /RESTORE CALLING FIELDS
+ JMP I ICHAR /AND RETURN
+INXPTR, 0
+INEOF, 1 /THESE PARAMETERS ARE SET UP SO THAT
+ /IOPEN IS UNNECESSARY.
+INNEWF, -1
+ INCHCT=INNEWF
+ CDF 10
+ TAD (INDEVH+1
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ TAD I INXPTR
+ SNA /ANY MORE?
+ JMP I INNEWF /NO - OUT OF INPUT
+ JMS I IN200
+ 1 /ASSIGN, FETCH HANDLER
+INHNDL, 0
+ HLT /HUH?
+ TAD I INXPTR
+ AND (7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH >=256
+ TAD (17 /ADD HIGH-ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INXPTR
+ TAD I INXPTR
+ DCA INREC /STORE STARTING RECORD NUMBER OF FILE
+ ISZ INXPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+ ISZ INNEWF
+ JMP I INNEWF
+ INCTR=IOPEN
+\fPTP=20
+ *2200
+OOPEN, 0
+OU7600, 7600
+ RDF
+ TAD OUCDIF
+ DCA OORETN
+ JMS OUASGN
+OUENTR, TAD I OU7600
+ JMS I (200
+ 3 /ENTER OUTPUT FILE
+OUBLK, FILENM+1
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
+ DCA OUCCNT
+ JMS I (OUSETP
+OORETN, HLT /RESTORE CALLING FIELDS
+ JMP I OOPEN
+OEFAIL, TAD I OU7600
+ AND (7760 /GET REQUESTED LENGTH
+ SNA CLA /WAS IT AN INDEFINITE REQUEST
+ JMP I (OUTERR
+ TAD I OU7600
+ AND (17 /MAKE THE REQUESTED LENGTH ZERO
+ DCA I OU7600
+ JMP OUENTR /TRY, TRY AGAIN
+OUASGN, 0
+ TAD (OUDEVH+1
+ DCA OUHNDL
+ CDF 10
+ TAD I (FILENM
+ AND (17 /STRIP OFF ANY LENGTH INFO
+ SNA /IS THERE AN OUTPUT DEVICE?
+ JMP I (OUTERR
+ JMS I (200
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ HLT /HUH?
+ JMP I OUASGN
+OUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
+ JMP I (OUTERR
+OUCDIF, CDF CIF 0
+ CDF 10
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMP I (OUTERR
+ JMP I OUTDMP
+OCLOSE, 0
+ RDF
+ TAD OUCDIF
+ DCA OCRET
+ JMS I (OCHAR
+ JMS I (OCHAR
+FILLLP, JMS I (OCHAR
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+ TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
+ TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
+ JMS OUTDMP
+NODUMP, JMS OUASGN /REASSIGN OUTPUT HANDLER
+ TAD I (FILENM
+ JMS I (200
+ 4 /CLOSE THE OUTPUT FILE
+OU7601, FILENM+1
+OUCCNT, 0
+ JMP I (OUTERR
+OCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCLOSE
+\f *2400
+OUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
+ TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
+ CIA /NEGATE IT
+ DCA OUDWCT
+ TAD (OUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
+ JMP I OUSETP
+
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ RDF
+ TAD (CDF CIF 0
+ DCA OUCRET
+OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN,
+OUCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+
+OTYPE, 0
+ RDF
+ TAD (CDF CIF 0
+ DCA OTRTN
+ CDF 10
+ TAD I (7600
+ AND (17
+ TAD (DCB-1
+ DCA OUTEMP
+ TAD I OUTEMP
+OTRTN, HLT
+ JMP I OTYPE
+CTCTST, 0
+ KRS
+ TAD (-203
+ SNA CLA /IS THE TELETYPE BUFFER A ^C
+ KSF /WITH THE TELETYPE FLAG ON?
+ JMP I CTCTST /NO
+ CDF CIF 0 /YES - GO TO MONITOR
+ JMP I (7605 /THROUGH THE "DON'T SAVE CORE" RETURN
+ $
+\f
--- /dev/null
+/OS8 FORTRAN II RELOCATING LOADER V4
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1973, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/LOADER.07 DECEMBER 5, 1973
+/
+/
+/CHANGES MADE FOR V4 J.K. 1975
+/
+/ .VERSION NUMBER PRINTED ON MAP
+/ .BIT ZERO OF 17645 IS USED INSTEAD OF THE WHOLE
+/ WORD TO INDICATE THAT THE LOADER WAS CHAINED
+/ TO FROM SABR
+/ .CORE ROUTINE STANDARIZED
+/ .CHECK FOR BATCH CORRECTED
+/
+/
+/FIELD 0, PAGE 0
+
+ VERSION=6400 /PRINTS ON MAP
+ PATCH=01
+ JSTFLD= 7744
+ JSTADR= 7745
+ JSBITS= 7746
+ MOFILE= 7600
+ MIFILE= 7617
+ MPARAM= 7643
+ DCB= 7760
+ MSTCDF= 7772
+ MSTADR= 7775
+ SHNDLR= 7607
+ MGET= 7667
+ MTEMP= 27
+ OLDT9= 7 /LOCATION OF HANDLER ENTRY OF DEVICE
+ /WITH DIRECTORY IN CORE
+
+ *0
+ZERO, JMS I XSHNDLR
+ONE, 2010
+ 3600
+ MTEMP+11
+ HLT
+FIVE, JMP I .+1
+ 7600
+XSHNDLR,SHNDLR
+X1, 0
+X2, 0
+X3, 0
+X4, 0
+
+ *16
+ NOPUNC
+ *100
+ ENPUNC
+
+DFRSTR, CIF 10
+ JMS I DF200
+ 11 /KICK OUT MONITOR
+DFSAVE, 0 /RESTORE CALLING FIELD
+ JMP I CDZSKP /AND EXIT
+
+SAVEDF, 0 /COMMON SAVE-FIELD PROCESSOR FOR FORTRAN I/O
+ DCA CDZSKP /CALLING ADDRESS
+ RDF
+ TAD .+2
+ DCA DFSAVE /CALLING FIELD
+ CDF CIF 0
+ JMP I SAVEDF
+DF200, 200
+\f/RUN-TIME SYSTEM PAGE 0 - PROPAGATED TROUGH ALL FIELDS
+
+*33
+ BNK=00
+/
+/ COMMON SUBROUTINE CALL LINKAGE ROUTINE
+/
+LINK, 0
+K6201, CDF BNK /SET DATA FIELD TO THIS BANK
+K6202, CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MLINKP /EXIT TO MASTER LINKAGE ROUTINE
+MLINKP, MLINK
+/
+/ COMMON SUBROUTINE RETURN LINKAGE ROUTINE
+/
+RTN, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MRTNP /EXIT TO MASTER RETURN ROUTINE
+MRTNP, MRTN
+/
+/ CHANGE DATA FIELD TO CURRENT AND SKIP
+/
+CDFSKP, 0
+ ISZ CDFSKP /INDEX ADDRESS FOR SKIPPING
+ CDF BNK /CHANGE DATA FIELD TO CURRENT BANK
+ JMP I CDFSKP /EXIT
+/
+/ CHANGE DATA FIELD TO ZERO AND SKIP
+/
+CDZSKP, 0
+ ISZ CDZSKP /INDEX RETURN ADDRESS FOR SKIPPING
+ CDF 10 /CHANGE DATA FIELD TO ZERO
+ JMP I CDZSKP /EXIT
+/
+/ OFF BANK INDIRECT SUBROUTINE
+/
+OBISUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MOBIP /EXIT TO MASTER OFF BANK INDIRECT SUBROUTINE
+MOBIP, MOBI
+/
+/ OFF PAGE INDIRECT SUBROUTINE
+/
+OPISUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO BANK 0
+ JMP I MOPIP /EXIT TO MASTER OFF PAGE INDIRECT SUBROUTINE
+MOPIP, MOPI
+\f/
+/ ROUTINE TO HANDLE DUMMY ARGUMENTS
+/
+DUMSUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO BANK 0
+ JMP I MDUMP /EXIT TO MASTER DUMMY ARGUMENT ROUTINE
+MDUMP, MDUM
+
+/ PAGE 0 CELLS FOR FORTRAN EXECUTION TIME I/O
+/ CELLS SET UP BY LINKING LOADER - CANNOT GO PAST 77
+
+INHNDL, 0 /PAGE FOR INPUT HANDLER IF /I SWITCH WAS ON
+OUHNDL, 0 /PAGE FOR OUTPUT HANDLER IF /O SWITCH WAS ON
+ELENGT, 0 /"DESIRED LENGTH" FOR FORTRAN OUTPUT FILES - USUALLY 0
+
+ *DF200+1
+/OTHER PAGE 0 LOCATIONS
+
+FOPOLD, 0
+FINPTR, 0
+FICHCT, 0 /MUST BE INIT. TO -1 AT LOOKUP
+FINTMP, 0 /MUST BE INIT. TO 10 AT LOOKUP
+OHNDLR, 0 /SET BY FENTER - CLEARED BY FCLOSE
+IHNDLR, 0 /SET BY FLUKUP - NEVER CLEARED
+FOUPTR, 0
+FOCHCT, 0
+\f *200
+LSTART, JMP I (LDRZZ1
+SSTART, CDF 10
+ TAD I (MPARAM+2
+ SMA CLA
+ JMP NOTSBR
+ TAD I (MPARAM+2
+ AND (3777
+ DCA I (MPARAM+2
+ TAD I (MOFILE
+ SNA CLA
+ JMP LDRYYY
+ TAD (MOFILE+11
+ DCA X1
+ TAD (MOFILE
+ DCA SEVEN
+ TAD (-5
+ DCA SIX
+ TAD (TEMP-1
+ DCA X2
+MOVLP1, TAD I SEVEN
+ CDF 0
+ DCA I X2
+ CDF 10
+ TAD I X1
+ DCA I SEVEN
+ ISZ SEVEN
+ ISZ SIX
+ JMP MOVLP1
+ TAD TEMP+1 /GET BLOCK NUMBER WHICH SABR PLACED HERE
+ DCA I (MIFILE+1
+ DCA I (MIFILE+2
+ CLA CLL CMA RAL
+ AND I (MPARAM
+ DCA I (MPARAM /REMOVE /L SWITCH FROM SABR INPUT
+ CDF 0
+ CIF 10
+ CLA IAC
+ JMS I (200
+ 4 /DELETE
+ FORTRL /THE FILE "FORTRL.TM" IF IT EXISTS
+ 0
+ NOP /IT DIDN'T EXIST - BIG DEAL
+ TAD TEMP
+LDRYYY, CDF 10
+ DCA I (MIFILE
+NOTSBR, CIF 10
+ CDF 0
+ JMS I (200
+ 12 /GET DEVICE NUMBER WITHOUT HANDLER
+ 2424 /TT
+TTYNUM, 3100 /Y
+ 1000 /RANDOM NUMBER
+ JMP LWOWIE /WHAT - NO TELETYPE???
+ CIF 10
+ CLA IAC /DEVICE "SYS"
+ JMS I (200
+ 2
+PTSLIB, SYSLIB
+ 0 /USELESS LENGTH WORD
+ CLA SKP
+ TAD PTSLIB
+ CDF 10
+ DCA I (PSYSLB
+ TAD TTYNUM
+ DCA I (TTYNO /STORE AWAY TTY DEVICE NUMBER
+ JMS I (BATCK
+CORO, TAD CORSIZ /GET FLD OF TEST
+ RTL
+ RAL
+ AND COR70
+ TAD COREX /MASK USEFUL BITS
+ DCA .+1
+COR1, CDF
+ TAD I CORLOC /SAVE CURRENT CONTENTS
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC /TRY TO READ BACK
+CORX, 7400
+ TAD CORX
+ TAD CORV /TAD (1400)
+ SZA CLA
+ JMP COREX /NON-EXISTENT FLD EXIT
+ TAD COR1
+ DCA I CORLOC /RESTORE LOC
+ ISZ CORSIZ
+ JMP CORO
+COREX, CDF 0
+ TAD CORSIZ
+ CIA
+FOUNDX, CDF CIF 10
+ DCA I (WROVLY /POSTPONE SPREADING FIELD ZERO RESIDENT
+ TAD (TTYOUT / THRU FIELDS UNTIL /I,/O AND /H ARE TESTED
+ DCA I (TYPE
+ JMP I .+1
+ LDRXXX
+\fSIX, 0
+SEVEN, 0
+
+LWOWIE, CDF CIF 10
+ JMP I (SIOERR
+CORLOC, CORX
+CORV, 1400
+CORSIZ, 1
+TEMP, 0;0;0;0
+ PAGE
+\f/FULL LINKAGE ROUTINES FOR RUN-TIME SYSTEM
+
+ *400
+K77A, 0077 /MUST BE FIRST LOC ON PAGE
+/
+/ MASTER OFF PAGE INDIRECT ROUTINE
+/
+MOPI, DCA AC /SAVE AC
+ TAD I OPIP /PICK UP ADDRESS OF PARAMETER
+ DCA DUMSUB
+ TAD I DUMSUB /ACTUAL PARAMETER
+ DCA 7 /TO A TEMP
+ TAD I 7 /PICK UP FINAL DATA
+ DCA I K7 /TO LOCATION 7 IN FROM BANK
+ RDF /FROM BANK
+ATVX, TAD K6202 /MAKE A CIF FROM INSTRUCTION
+ DCA ATV /SAVE IN THIS SEQUENCE
+ JMP ATV-1
+/
+/ MASTER OFF BANK INDIRECT ROUTINE
+/
+MOBI, DCA AC /SAVE AC
+ TAD I OBIP /ADDRESS OF PARAMETER
+ DCA DUMSUB
+ TAD I DUMSUB /ACTUAL COMMON ADDRESS
+ DCA 7 /SAVE IT
+ RDF /FROM BANK
+ TAD K6201 /MAKE A CDF FROM INSTRUCTION
+ DCA .+3 /PLACE IN THIS SEQUANCE
+ CDF 10 /CHANGE DATA FIELD TO COMMON
+ TAD I 7 /ACTUAL DATA
+ NOP /BECOMES CDF AND CIF FROM INSTRUCTION
+ DCA I K7 /TO LOCATION 7 IN FROM BANK
+ RDF
+ CDF 10
+ JMP ATVX
+\f/ MASTER INDIRECT DUMMY ARGUMENT SUBROUTINE
+
+MDUM, DCA AC /SAVE AC
+ TAD I DUMP /PICK UP ADDRESS OF PAR
+ DCA DUMSUB
+ TAD I DUMSUB /PICK UP POINTER TO 2 WORD VECTOR
+ DCA DUMTEM /TO A TEMPORARY
+ TAD I DUMTEM /FIELD DATA IS IN AS A CDF
+ DCA ABCRT /TO THIS SEQUANCE
+ RDF /FROM FIELD
+ TAD K6202 /MAKE A CIF INSTRUCTION
+ DCA ATV /TO THIS SEQUANCE FOR EXIT
+ ISZ DUMTEM /POINT TO LOCATION IN FIELD
+ TAD I DUMTEM /ACTUAL LOCATION IN UNKNOWN FIELD
+ DCA I K7 /TO FROM FIELD LOCATION 7
+ABCRT, NOP /BECOMES CDF UNKNOWN
+ ISZ DUMSUB /BUMP RETURN ADDRESS
+ATV, NOP /BECOMES CIF FROM
+ TAD AC /RESTORE AC
+ JMP I DUMSUB /EXIT
+AC= CDZSKP
+DUMTEM= OBISUB
+OPIP, OPISUB
+OBIP, OBISUB
+DUMP, DUMSUB
+/
+/ MASTER LINKAGE ROUTINE
+/
+MLINK, DCA AC /SAVE AC
+ RDF
+ TAD K6201 /MAKE A CDF
+ DCA DUMTEM
+ TAD I LINKP /ADDRESS OF CODE WORD
+ JMS RTS1
+ TAD DUMTEM /CDF FROM INSTRUCTION
+ DCA I DUMSUB /TO FIRST WORD OF 2 WORD VECTOR
+ ISZ DUMSUB /POINT TO DISPLACEMENT
+ TAD LINK /ADDRESS OF CODE WORD
+ IAC /INCR. TO FIRST ARG
+ DCA I DUMSUB /TO SECOND WORD OF 2 WORD VECTOR
+ JMP ATVX-1
+/
+/ MASTER RETURN ROUTINE
+/
+MRTN, DCA AC /SAVE AC
+ TAD I RTNP /ADDRESS OF CODE WORD
+ JMS RTS1
+ TAD I DUMSUB /FIELD TO RETURN TO AS A CDF INSTRUCTION
+ TAD K2
+ DCA ATV
+ ISZ DUMSUB
+ TAD I DUMSUB
+ DCA DUMSUB
+ JMP ATV
+\f/DATA
+
+K100A, 100
+K7700A, 7700
+LINKP, LINK
+RTNP, RTN
+/
+/SUBROUTINE 1
+/
+RTS1, 0
+ DCA LINK
+ TAD I LINK /CODE WORD
+K200A, AND K77A /MASK OUT NUMBER OF ARGUMENTS
+ TAD K200A /+DISPLACEMENT
+ DCA ABCRT /GIVES ADDRESS OF BCRT ENTRY
+ TAD ABCRT
+ TAD K100A /+DISPLACEMENT
+ DCA ATV /GIVES ADDRESS OF TV DISPLACEMENT
+ CDF CIF 0 /(TABLES IN FIELD 0!)
+ TAD I ABCRT /TO CDF INSTRUCTION
+ DCA RTSCDF /TO FIRST WORD OF 2 WORD VECTOR
+ TAD I ATV /TO BANK DISPLACEMENT
+ SNA /WAS IT LOADED?
+ JMP NOTIN /NO
+
+ DCA DUMSUB /TO SECOND WORD OF 2 WORD VECTOR
+RTSCDF, 0
+ JMP I RTS1
+
+NOTIN, CIF 10
+ JMS I K7700A
+K7, 7
+ 1 /USER ERROR 1 - PROGRAM NOT LOADED
+\fFASIGN, 0 /CALLED FROM SABR - DOES ASSIGN AND
+ DCA CDFSKP /EITHER LOOKUP,ENTER OR CLOSE
+ TAD FASIGN
+ JMS SAVEDF
+ CIF 10
+ JMS I K7700A
+ 10 /CALL USR IN
+ CIF 10
+ JMS I K200A
+ 1 /ASSIGN HANDLER
+ASDEV, 0;0 /SET UP BY SABR
+ASPAGE, 0 /DITTO
+ JMP ASERR /ASSIGN FAILURE
+ZRONAM, DCA FLUNAM /ZERO FILENAME FOR LOOKUP
+ TAD ASDEV+1 /PUT DEVICE NUMBER IN AC
+ JMP I CDFSKP /JUMP TO APPROPRIATE ROUTINE
+
+ *567 /MUST CROSS PAGE BOUNDARY JUST SO
+FLUKUP, CIF 10
+ JMS I K200A
+K2, 2 /LOOKUP FILE
+FLUNAM, 0 /REPLACED BY BLOCK NUMBER
+FLUCNT, 0 /REPLACED BY LENGTH (UNUSED)
+ASERR, ISZ CDZSKP /SKIP RETURN IF ERROR
+ TAD ASPAGE
+ DCA IHNDLR /SET UP INPUT HANDLER ENTRY AND FLAG
+ TAD FLUNAM
+FINRXX, DCA FINREC /***** THIS SHOULD BE AT LOC 600! *****
+ CLA CMA
+ DCA FICHCT
+ TAD FIN10
+ DCA FINTMP
+ JMP FRESET /RESET I/O AND RETURN FROM FASIGN
+ IFNZRO FINRXX-600 <FINERR,_ERROR>
+\f /GET A CHARACTER ROUTINE.
+ /RETURNS TO .+1 IF ERROR, .+2 IF NORMAL
+ /CHAR IN AC ON OUTPUT
+ /DOES NOT HANDLE END-OF-FILE VERY WELL
+
+FICHAR, 0
+ TAD FICHAR
+ JMS SAVEDF /SAVE RETURN FIELD AND ADDRESS
+FNXTCH, ISZ FICHCT /BUMP CHAR COUNT
+ JMP FIGET
+ JMS I IHNDLR /IT OVERFLOWED - READ IN A NEW BUFFER
+FI200, 200
+FINBUF, 1200
+FINREC, 0
+FI7700, SMA CLA
+ SKP /END - OF - FILE ERROR - IGNORE
+ JMP DFSAVE /ERROR RETURN
+ ISZ FINREC
+ CLA CMA
+ TAD FINBUF
+ DCA FINPTR
+ TAD FI7200
+ DCA FICHCT /INITIALIZE FOR NEW RECORD
+FIGET, TAD FINTMP /GET HIGH-ORDER-BIT BUFFER
+ SPA /IS IT FULL?
+ JMP FITHRD /YES - OUTPUT COMBINED HIGH-ORDER BITS
+FI7200, CLA
+ ISZ FINPTR
+ TAD I FINPTR /GET A LOC FROM THE BUFFER
+ AND FI7400
+ RAL CLL
+ TAD FINTMP /PUT THE HIGH ORDER BITS ONTO THE HOB BUFFER
+FINXX, RTL
+ RTL
+ DCA FINTMP
+ TAD I FINPTR
+ JMP DFEXIT /RETURN WITH SKIP
+FITHRD, DCA I FINPTR /FUDGE THIRD CHAR INTO BUFFER
+ CLL CML
+ JMP FINXX /RESET FINTMP TO 10
+\f /PUT A CHARACTER
+ /RETURNS TO .+1 IF ERR, .+2 IF NORMAL
+ /CALLED WITH CHAR IN AC
+
+FOCHAR, 0
+ DCA FOUTMP /SAVE CHAR
+ TAD FOCHAR
+ JMS SAVEDF /SAVE CALLING FIELD AND LOC
+FOLOOP, ISZ FOUJMP
+ ISZ FOCHCT /BUMP CHAR COUNT
+FOJMP, JMP FOUJMP /TAKE A BRANCH OF THE THREE-WAY JUMP
+ JMS I OHNDLR
+ 4200
+FOUBUF, 1200
+FOUREC, 0
+ JMP DFSAVE /OUTPUT ERROR
+ ISZ FOUREC
+ JMS FOSETP
+ ISZ FOCCNT /BUMP FILE LENGTH
+ ISZ FOOCNT /ALSO ENTER COUNT
+ JMP FOLOOP /NOW GO PUT THE CHAR INTO THE NEW BUFFER
+ JMP DFSAVE /ENTER COUNT OVERFLOWED - ERROR RETURN
+
+FOUJMP, JMP . /THREE-WAY SWITCH
+ JMP FOUCH1
+ JMP FOUCH2
+FOUCH3, TAD FOUTMP
+ RTL
+ RTL
+ DCA FOUTMP
+ TAD FOUTMP
+ AND FI7400
+ TAD I FOPOLD /PUT HIGH ORDER BITS OF CHAR3
+ DCA I FOPOLD /INTO HIGH ORDER BITS OF CHAR 1
+ TAD FOUTMP
+ RTL
+ RTL
+ AND FI7400
+ TAD I FOUPTR /PUT LOW ORDER BITS OF CHAR 3
+ DCA I FOUPTR /INTO HIGH ORDER BITS OF CHAR 2
+ TAD FOJMP
+ DCA FOUJMP
+ ISZ FOUPTR
+ JMP DFEXIT /RETURN NORMALLY
+FOUCH2, TAD FOUPTR
+ DCA FOPOLD /SAVE POINTER TO CHAR 1
+ ISZ FOUPTR
+FOUCH1, TAD FOUTMP
+ DCA I FOUPTR /STORE CHAR 1 OR 2
+DFEXIT, ISZ CDZSKP /INCREMENT RETURN ADDR
+ JMP DFSAVE /AND GO THERE
+\fFOSETP, 0
+ TAD FO7177
+ DCA FOCHCT
+ TAD FOUBUF
+ DCA FOUPTR
+ TAD FOJMP
+ DCA FOUJMP
+ JMP I FOSETP
+
+FO7177, 7177
+FIN10, 10
+
+FENTER, TAD ELENGT /ELENGT=0 UNLESS SOME KLUDGE SETS IT UP
+ CIF 10 /FENTER JUMPED TO BY FASIGN
+ JMS I FI200
+ 3
+FOONAM, 0 /FILE NAME IN LOCS 0-3
+FOOCNT, 0
+ ISZ CDZSKP /FOR ENTER, ERROR RETURN IS SKIP RETURN
+ TAD FOONAM
+ DCA FOUREC /INITIALIZE OUTPUT RECORD #
+ JMS FOSETP /SET UP CHARACTER POINTERS
+ DCA FOONAM /SET FOONAM FOR NEXT ENTER
+ TAD I PASPAG
+ JMP STOHND /GO TO COMMON CODE WITH "FCLOSE"
+PASPAG, ASPAGE
+
+FCLOSE, CIF 10 /JUMPED TO BY FASIGN
+ JMS I FI200 /CALL I/O MONITOR
+ 4
+FOCNAM, 0 /FILE NAME IN 0-3
+FOCCNT, 0 /CLOSING LENGTH
+ ISZ CDZSKP /ERROR - BUMP RETURN
+STOHND, DCA OHNDLR
+ DCA FOCCNT /INITIALIZE CLOSING COUNT FOR NEXT FILE
+FRESET, CIF 10
+ JMS I FI200
+ 13 /RESET ALL DEVICE HANDLER ENTRIES
+ 0 /BUT RETAIN ANY OPEN OUTPUT FILES
+ JMP DFRSTR /RETURN FROM FASIGN AFTER KICKING MONITOR OUT
+FOUTMP= FICHAR
+FI7400, 7400
+ PAGE
+\f *1000
+PROPGT, 0 /CALLED FROM FIELD 1 LOADER WHEN 1ST
+ CDF 10 /CHECKING FOR I/O SWITCHES.
+ DCA I LTOPCOR /-# OF CORE FIELDS IN AC
+ TAD I LTOPCOR
+ DCA I LFCTR
+ TAD I LTOPCOR
+ CDF 0
+ CMA /GET # OF HI CORE FIELD
+PROPLP, DCA FC
+ CLA CMA
+ TAD FC
+ SNA CLA
+ JMP FIELD1
+ TAD FC
+ JMS CHGBNK
+ JMS STOBNK
+ CLA CMA
+ TAD FC
+ JMP PROPLP
+FIELD1, CLA IAC
+ JMS CHGBNK
+ JMS I LSHNDLR
+ 4100
+ 0
+ MTEMP
+ JMP I LLWOWIE
+ JMS I LSHNDLR
+ 4201
+ 400
+ MTEMP+21 /WRITE OUT RUN-TIME ROUTINES
+ JMP I LLWOWIE
+ JMS CHGBNK
+ TAD L6001
+ DCA I LJSBITS
+ TAD L6213
+ DCA I LJSTFLD
+ TAD LLRSTRT
+ DCA I LJSTADR
+ CDF CIF 10 /PROPGT IS CALLED FROM FIELD 1 ONLY
+ JMP I PROPGT
+FC, 0
+\fCHGBNK, 0
+ CLL RTL
+ RAL
+ TAD LCDF
+ DCA X1
+ TAD X1
+ DCA LINK+1
+ TAD X1
+ DCA RTN+1
+ TAD X1
+ DCA CDFSKP+2
+ TAD X1
+ DCA OBISUB+1
+ TAD X1
+ DCA OPISUB+1
+ TAD X1
+ DCA DUMSUB+1
+ JMP I CHGBNK
+
+STOBNK, 0
+ TAD LLINK1
+ DCA X2
+ TAD X2
+ DCA X3
+ TAD LLINK2
+ DCA X4
+ TAD X1
+ DCA STOCDF
+STOLUP, CDF 0
+ TAD I X2
+STOCDF, HLT
+ DCA I X3
+ ISZ X4
+ JMP STOLUP
+ CDF 0
+ JMP I STOBNK
+SYSLIB, TEXT /LIB8/
+ 2214 /.RL
+
+LTOPCOR,TOPCOR
+LSHNDLR,SHNDLR
+LFCTR, FCTR
+LLWOWIE,LWOWIE
+L6001, 6001
+LJSBITS,JSBITS
+LJSTADR,JSTADR
+LJSTFLD,JSTFLD
+L6213, 6213
+LCDF, CDF
+LLINK1, LINK-1
+LLINK2, LINK-MDUMP-2
+\fLDRZZ1, CDF 10 /COME HERE IF NOT CHAINED TO
+ DCA I LMOFIL
+ ISZ LMOFIL
+ ISZ LMOCNT
+ JMP .-3
+ CLA CLL CMA RAL /-2
+ DCA I LDOPRP
+ CDF 00
+ JMP I .+1
+ LDRYYY
+LMOFIL, 7600
+LMOCNT, -47
+LLRSTRT,LRSTRT
+LDOPRP, DOPROP
+FORTRL, FILENAME FORTRL.TM
+ PAGE
+\f *1200 /LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS
+INPENB, 0
+ ISZ INPFLG
+ JMP INRTRN /ALREADY HAVE A /I
+ JMS TWOPAG /HAS USER SPECIFIED 2-PG. HNDLRS?
+ TAD OUPFLG
+ SPA CLA
+ JMP INVRGN
+ TAD K2200
+ DCA INHNDL
+ TAD (FINBUF
+ DCA I (ST1600 /MARK THE INPUT BUFFER IN PAGE 1600
+ TAD K2377
+ JMS SETHLA
+INRTRN, CDF CIF 10
+ JMP I INPENB
+
+INVRGN, TAD K1000
+ DCA INHNDL
+ TAD K1577
+ JMP INRTRN-1
+
+OUPENB, 0
+ ISZ OUPFLG
+ JMP OURTRN
+ JMS TWOPAG /HAS USER SPECIFIED 2 PG. HNDLRS?
+ TAD INPFLG
+ SPA CLA
+ JMP OUVRGN
+ TAD K2200
+ DCA OUHNDL
+ TAD (FOUBUF
+ DCA I (ST1600 /MARK OUTPUT BUFFER IN 1600
+ TAD K2377
+ JMS SETHLA
+OURTRN, CDF CIF 10
+ JMP I OUPENB
+
+OUVRGN, TAD K1000
+ DCA OUHNDL
+ TAD K1577
+ JMP OURTRN-1
+
+INPFLG, -1
+OUPFLG, -1
+K1000, 1000 /SET TO 1001 FOR 2 PAGE HANDLERS
+K2200, 2200 /SET TO 2401 FOR 2 PAGE HANDLERS.
+K2377, 2377 /SET TO 2577 FOR 2 PAGE HANDLERS.
+K1577, 1577 /SET TO 1777 FOR 2 PAGE HANDLERS.
+\f/SUBROUTINE TO CHECK FOR /H SWITCH MEANING USER
+/WANTS RUN TIME DEVICE INDEPENDENT I/O TO
+/BE ABLE TO USE 2 PAGE DEVICE HANDLERS
+/
+TWOPAG, 0
+ CDF 10
+ TAD I (MPARAM
+ AND (20 /IS /H SWITCH SET?
+ SNA CLA
+ JMP I TWOPAG /NO-RETURN (DATA FLD=1)
+ TAD (1001 /YES-RESET HANDLR FETCH TO ACCEPT
+ DCA K1000 /TWO PAGE HANDLERS
+ TAD (2401 /RESET FETCH FOR SECOND HANDLER
+ DCA K2200
+ TAD (2777
+ DCA K2377 /RESET HLA CONSTANT FOR 2 PG HANDLRS
+ TAD (1777
+ DCA K1577 /RESET 2ND HLA CONSTANT FOR 2 PG
+ TAD (2000
+ DCA I (K1600 /RESET BUFR. ADDRESS-SEE *LDRXIT*
+ CDF 00
+ TAD (1400
+ DCA I (FINBUF /RESET IN AND OUT BUFFER ADDRESSES
+ TAD (1400 /TO MAKE ROOM FOR 2 PG HANDLR
+ DCA I (FOUBUF
+ CDF 10
+ JMP I TWOPAG /RETN. DATA FLD=1
+
+SETHLA, 0
+ DCA I (HLAZ
+ TAD I (HLAZ
+ CIA
+ DCA I (HLAIO
+ CDF 0
+ JMP I SETHLA
+BATCK, 0
+ CDF 0
+ TAD I (7777
+ AND (70
+ SNA
+ JMP I BATCK
+ CLL RTR
+ RAR
+ CMA
+ DCA TMPC
+ TAD I (7777
+ RAL
+ SPA CLA
+ IAC
+ TAD TMPC
+ JMP I (FOUNDX
+TMPC, 0
+ PAGE
+\f FIELD 1
+/FIELD 1 PAGE 0 EQUIVALENCES - FIT INTO USR CRACKS
+
+ DEVHND=20
+ BANK=21
+ TM1=22
+ TM2=23
+ RECNO=24
+ OVLYFG=25
+ CUR=26
+ WORD=27
+ HLAPTR=30
+ HLA=31
+ RCON=32
+ COML=33 /HI COMMON LOC, 0 IF NONE
+ TYPE=34
+ CSUM=35
+ NSUB=36
+
+ *3600
+LRSTRT, DCA I (MIFILE
+LDRZZZ, JMS I (IONULL
+LDRXXX, TAD (MIFILE
+ DCA FILPTR
+ DCA OVLYFG
+ DCA I (WRBFSW
+ JMS I (START
+ JMP IOCHEK /GO TEST FOR /I, /O ALD /0-7
+LDRLP, DCA BANK
+ TAD I FILPTR
+ SNA
+ JMP GETCD
+ JMS GETHND
+ TAD I FILPTR
+ ISZ FILPTR
+ DCA RECNO
+ TAD I (MPARAM
+ RAR
+ SZL CLA
+ JMP I (LBRY
+ JMS I (LOAD
+ JMP LDRLP
+GETCD, TAD I (MPARAM+3
+ SNA
+ JMP LKATMP
+ DCA I (LSTADR
+ TAD I (MPARAM-1
+ CLL RAL
+ AND (17
+ CLL RTL
+ TAD (CDF CIF 0
+ DCA I (LSTFLD /FALL INTO NEXT PAGE
+\fLKATMP, JMS I (WRPGBF
+ TAD I (MPARAM
+ AND (40
+ SZA CLA
+ JMP BUILD
+ TAD I (MPARAM-1
+ SPA CLA
+ JMP BUILD
+ JMS MAP
+CDCALL, JMS I (200
+ 5
+ 2214
+ TAD I (MPARAM+1
+ AND (100
+ SZA CLA
+ JMP LDRZZZ
+IOCHEK, JMS I (IOTEST
+ DCA TM1
+ TAD (MIFILE
+ DCA FILPTR
+ TAD I (MPARAM+2
+ AND (1774
+ SNA
+ JMP LDRLP
+ RAL
+ ISZ TM1
+ SNL
+ JMP .-3
+ CLA CMA CLL RTL
+ TAD TM1
+ JMP LDRLP
+FILPTR, 0
+MAP, 0
+ TAD I (MPARAM+1
+ AND (4410 /"M","P" AND "U" OPTIONS
+ SNA
+MAPRTN, JMP I MAP
+ CLL RTR
+ RTR
+ AND (200
+ SZA CLA
+ CLL CML IAC
+ CML RAL /FORM 0 IF /U, 1 IF /P AND 2 IF /M
+ DCA TM1
+ JMP I (MAPIO
+\fBUILD, TAD (SHNDLR
+ DCA DEVHND
+ TAD PSYSLB
+ SZA
+ JMS I (LBSRCH
+ JMS MAP
+ JMP I (BUILDX
+PSYSLB, 0
+
+GETHND, 0
+ AND (17
+ DCA I (EASGN
+ TAD (401
+ DCA LASGN
+ TAD I (EASGN
+ ISZ FILPTR
+ JMS I (200
+ 1 /ASSIGN
+LASGN, 401
+ JMP I (HNDERR /BAD HANDLER
+ TAD LASGN
+ DCA DEVHND
+ JMP I GETHND
+ PAGE
+\fBUILDX, TAD LSTADR
+ SZA CLA
+ JMP ALREDY
+ TAD (MAIN-1
+ DCA X1
+ JMS I (SETS1
+ JMS I (SEARCH
+ JMP I (ERSTAD
+ TAD (TVEC-1
+ TAD I (SYMNUM
+ DCA TM1
+ CDF 0
+ TAD I TM1
+ SNA
+ JMP I (ERSTAD
+ DCA LSTADR
+ TAD TM1
+ TAD (7700
+ DCA TM1
+ CLA CLL CML RTL /CHANGE CDF TO CDF CIF
+ TAD I TM1
+ DCA LSTFLD
+ALREDY, CDF 10
+ JMS I (WROVLY
+ TAD (1400
+ JMS STOINF
+ DCA OLDT9
+ TAD (HLA7
+ DCA TM1
+ TAD (-10
+ DCA X3
+ DCA I X1
+ DCA X4
+BLDLP, CLA CLL CML RTL
+ TAD X3
+ SNA CLA
+ JMP BFLD1 /TREAT FIELD 1 (COMMON AREA) DIFFERENTLY
+BLDLPX, TAD I TM1
+ AND (7600
+ SNA
+ JMP BLDSKP
+BLDLPY, TAD (170
+ CLL CML CMA RTR
+ RTR
+ TAD X3
+ CLL CMA RTL
+ RAL
+ DCA I X1
+ DCA I X1
+ ISZ X4
+BLDSKP, CLA CMA
+ TAD TM1
+ DCA TM1
+ ISZ X3
+ JMP BLDLP
+ TAD X4
+ CIA
+ DCA I (1400
+ CIF 0
+ JMS I (SHNDLR
+ 4210
+ 1200
+ MTEMP+10
+ HLT
+ CDF 0
+ TAD (JSTFLD-1
+ JMS STOINF
+ TAD LSTADR
+ DCA I (MSTADR
+ TAD LSTFLD
+ DCA I (MSTCDF
+ JMP I (LDRXIT
+
+BFLD1, TAD COML
+ SNA /IS THERE ANY COMMON?
+ JMP BLDLPX /NO
+ CLL CMA
+ TAD I TM1
+ SNL CLA /IS THERE ANY CODE IN FIELD 1?
+ JMP BLDSKP /NO
+ TAD (110 /SAVE FIELD 1 IN TWO SEGMENTS - PAGE 0 AND
+ DCA I X1 /THE CODE FOLLOWING THE END OF THE COMMON AREA
+ ISZ X4 /(THIS IS TO ENABLE "CHAIN" TO WORK PROPERLY)
+ TAD COML
+ IAC
+ DCA I X1
+ TAD COML
+ CMA
+ TAD I TM1
+ AND (7600
+ JMP BLDLPY
+\fCVTREC, 0
+ TAD CUR
+ CLL RTL
+ RTL
+ RAL
+ AND (7
+ JMP I CVTREC
+
+STOINF, 0
+ DCA X1
+ TAD LSTFLD
+ DCA I X1
+ TAD LSTADR
+ DCA I X1
+ DCA I X1
+ JMP I STOINF
+LSTADR, 0
+LSTFLD, 0
+ PAGE
+
+\fMAPIO, TAD I ML7600
+ SNA
+ TAD TTYNO /TELETYPE IS DEFAULT LISTING DEVICE
+ JMS I (GETHND
+ TAD I ML7604 /PICK UP EXTENSION WORD.
+ SNA /NON-ZERO?
+ TAD (1520 /NO-SUPPLY '.MP' EXTENSION.
+ DCA I ML7604 /YES-LEAVE ALONE
+ TAD ML7601
+ DCA MNAME
+ TAD I (EASGN
+ TAD (100 /4 SHIFTED LEFT INTO THE "DESIRED LENGTH" POSITION
+ JMS I (200
+ 3
+MNAME, 0
+MECNT, 0
+ JMP I (OUERR
+ TAD MNAME
+ DCA ORECNO
+ JMS OUSETP
+ DCA MCCNT
+ TAD (OCHAR
+ DCA TYPE
+ TAD TM1
+ CLL CML RAR
+ JMP I (MAPX
+OCHAR, 0
+ DCA OUTEMP
+ ISZ OJMP
+ ISZ OCHCNT
+OJMPE, JMP OJMP
+ CIF 0
+ JMS I DEVHND
+ 4210
+OUBUF, 4600
+ORECNO, 0
+ JMP I (OUERR
+ ISZ ORECNO
+ ISZ MCCNT
+ JMS OUSETP
+ ISZ MECNT
+ JMP OCHAR+2
+ JMP I (OUERR
+\fOUSETP, 0
+ TAD (-601
+ DCA OCHCNT
+ TAD OUBUF
+ DCA OUPTR
+ TAD OJMPE
+ DCA OJMP
+ JMP I OUSETP
+
+OJMP, HLT /THREE-WAY JUMP FOR CHAR OUTPUT
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OJMPE
+ DCA OJMP
+ TAD OUTEMP
+ RTL
+ RTL
+ DCA OUTEMP
+ TAD OUTEMP
+ AND OU7400
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD OUTEMP
+ RTL
+ RTL
+ AND OU7400
+ TAD I OUPTR
+ DCA I OUPTR
+ ISZ OUPTR
+ JMP OUCOM
+OCHAR2, TAD OUPTR
+ DCA OUPOLD
+ ISZ OUPTR
+OCHAR1, TAD OUTEMP
+ AND OU377
+ DCA I OUPTR
+OUCOM, JMP I OCHAR
+OCHCNT, 0
+ OUPOLD=OUSETP
+OUTEMP, 0
+OU7400, 7400
+OUPTR, 0
+OU377, 377
+\f/CLOSE OUTPUT FILE
+
+OCLOS, TAD (232
+ JMS OCHAR
+ TAD OCHCNT
+ CMA
+ SZA CLA
+ JMP .-4
+ JMS OCHAR
+ TAD I (EASGN
+ JMS I (200
+ 4
+ML7601, 7601
+MCCNT, 0
+ JMP I (OUERR
+ TAD (TTYOUT
+ DCA TYPE
+ JMP I (MAPRTN
+
+TTYOUT, 0
+ 6046
+ 6041
+ JMP .-1
+ML7600, 7600
+ JMP I TTYOUT
+TTYNO, 0 /SET TO TTY DEVICE NUMBER BY INITIALIZATION
+IONULL, 0
+ TAD ML7600
+ DCA I (HLASZA
+ML7604, 7604 /POINTER TO FILE EXT. WORD
+ JMP I IONULL
+ PAGE
+\fLOAD, 0
+ DCA LREQUR
+ TAD BANK
+ TAD (HLAZ
+ DCA HLAPTR
+ JMS I (SETRCN /SET UP HLA AND RCON
+ TAD RCON
+ CLL CML
+ TAD LREQUR
+ TAD (400
+ SNL SZA CLA
+ JMP LFAILD
+ TAD RECNO
+ DCA LRECNO
+ CLA CMA
+ DCA INCHCT
+ JMS ICHAR
+ SNA CLA
+ JMP .-2
+ JMP I (MORE
+
+ICHAR, 0
+ TAD XX7600 /PARITY TTY HACK
+ KRS
+ TAD (-7603
+ SNA CLA
+ KSF
+ SKP
+ JMP I (MGET /17667=07605
+ ISZ IJMP
+ ISZ INCHCT
+IJMPE, JMP IJMP
+ CIF 0
+ JMS I DEVHND
+INCTLW, 0410
+INBUF, 4600
+LRECNO, 0
+ JMP INCKEF
+INISZ, ISZ LRECNO
+ ISZ LRECNO
+ TAD IN6377
+ DCA INCHCT
+ TAD INBUF
+ DCA INPTR
+ TAD IJMPE
+ DCA IJMP
+ JMP ICHAR+1
+\fIJMP, HLT /THREE-WAY JUMP FOR CHAR INPUT
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD IJMPE
+ DCA IJMP
+ TAD I INPTR
+ ISZ INPTR
+ AND IN7400
+ CLL RTR
+ RTR
+ TAD INTEMP
+ RTR
+ RTR
+ JMP INCOM
+ICHAR2, TAD I INPTR
+ ISZ INPTR
+ AND IN7400
+ DCA INTEMP
+ICHAR1, TAD I INPTR
+INCOM, AND IN377
+ JMP I ICHAR
+INCKEF, SMA CLA
+ JMP LRECNO+2
+ JMP I (INERR
+INPTR, 0
+INCHCT, 0
+INTEMP, 0
+IN7400, 7400
+IN377, 377
+IN6377, 6377
+\fXX7600,
+XER2, 7600
+ TAD EASGN
+ TAD (DCB-1
+ DCA TM2
+ TAD I TM2
+ SPA CLA
+ JMP DIRDEV
+ TAD (2205
+ JMS I (TTWO
+ TAD (1417
+ JMS I (TTWO
+ TAD (0104
+ JMS I (TTWO
+ JMS I (CRLF
+DIRDEV, TAD I HLAPTR
+ ISZ BANK
+ CMA
+ AND XX7600
+ JMP LOAD+1
+LFAILD, ISZ BANK
+ JMP LOAD+2
+EASGN, 0
+LREQUR, 0
+LOADOK, JMS I (WRPGBF
+ JMP I LOAD
+
+SETS1, 0
+ TAD (S1-1
+ DCA X2
+ TAD I X1
+ DCA I X2
+ TAD I X1
+ DCA I X2
+ TAD I X1
+ DCA I X2
+ JMP I SETS1
+ PAGE
+\f/ 4600-5177 USED FOR LOADER MAP OUTPUT BUFFER
+/ 5200-5577 USED FOR LIBRARY DIRECTORY BUFFER
+
+ *5600
+
+/** CAN ONLY USE FIRST HALF OF THIS PAGE - 2ND HALF IS PART OF MST
+/** NO LITERALS IN THIS PAGE!
+
+LBRY, TAD RECNO
+ JMS LBSRCH
+ JMP I .+1
+ GETCD
+
+LBSRCH, 0 /LIBRARY SEARCH ROUTINE
+ DCA LBREC /SAVE START BLK OF LIBRARY
+ CIF 0
+ JMS I DEVHND /READ LIBRARY DIRECTORY
+LBCTLW, 0210
+L5200, 5200
+LBREC, 0
+ JMP I LIOERR
+ TAD LBCTLW
+ DCA I LINCTL
+ TAD L7177
+ DCA I LIN6377
+ DCA I LINISZ
+ TAD L5177
+ DCA X1 /INITIALIZE FOR SEARCH
+LBRYLP, JMS I LSETS1 /GET NEXT DIRECTORY ENTRY
+ TAD I X1
+ SNA
+ JMP I LBSRCH /END OF DIRECTORY
+ TAD L5200
+ DCA LBFPTR
+ JMS I LSEARCH /IS IT IN SYMTAB?
+ JMP LBRYLP /NO
+ TAD I LSYMNUM
+ TAD LTVEC1
+ DCA TM1
+ CDF 0
+ TAD I TM1
+ CDF 10
+ SZA CLA /IS SYMBOL ALREADY DEFINED?
+ JMP LBRYLP /YES
+LBLDLP, TAD I LBFPTR /GET MODULE TO LOAD
+ SNA
+ JMP LBRYLP-2 /NO MORE MODULES TO LOAD
+ AND L177
+ IAC
+ TAD LBREC
+ DCA RECNO
+ DCA BANK
+ TAD I LBFPTR
+ AND L7600
+ JMS I LLOAD /LOAD LIBRARY MODULE
+ ISZ LBFPTR
+ JMP LBLDLP /GET NEXT MODULE
+
+LBFPTR, 0
+LIOERR, INERR
+LINCTL, INCTLW
+L7177, 7177
+LIN6377, IN6377
+L5177, 5177
+LSETS1, SETS1
+LSEARCH, SEARCH
+L177, 177
+L7600, 7600
+LLOAD, LOAD
+LSYMNUM, SYMNUM
+LINISZ, INISZ
+LTVEC1, TVEC-1
+ IFZERO .-5700&4000 <LBRERR, _ERROR>
+\f/MAIN LOADING CODE
+/MODIFIED VERSION OF
+/PAPER-TAPE LINKING LOADER
+
+/DEFINITIONS
+
+BCRT= 200
+TVEC= 300
+ORGT= 100 /LOCAL SYMBOL TABLE NOW IN FIELD 0
+MST= 6177 /MAIN SYMBOL TABLE
+
+*6200
+
+/START OF PROGRAM - INITIALIZATION
+
+START, 0
+ TAD K7600 /SET COUNTER FOR 200
+ DCA NSUB
+ TAD BCRTA /POINTER TO BANK TABLE
+ DCA X3
+ CDF 00
+ DCA I X3 /CLEAR BANK TABLE & TV TABLE
+ ISZ NSUB
+ JMP .-2 /NOT DONE
+ CDF 10
+ TAD M10
+ DCA NSUB
+ TAD HLAZA
+ DCA X3
+ TAD K777
+ DCA I X3 /BANK0 HIGHEST LOADED ADDR. =777
+ ISZ NSUB /NSUB INCREMENTS TO ZERO
+ JMP .-2
+ DCA COML /INIT. OLD COMMON AT 0000
+ JMP I START
+\f/REENTRY FOR NEXT ROUTINE TO BE LOADED
+
+MORE, DCA LMTC /CLR LOCAL SYMBOL COUNT
+ DCA CSUM /CLR CHECKSUM
+ TAD MORE1A /SET FOR RETURN TO MORE1 IF LEADER
+ DCA EOF
+MORE1, JMS RWORD
+ TAD RC10A /RESET EOF TO WATCH FOR TRAILER
+ DCA EOF
+ TAD CODE /CK FOR HIGH COMMON
+ TAD M12
+ SZA CLA
+ JMP I ER5P /NOT THERE
+ TAD COML
+ CIA
+ CLL CML /IF NO COMMON EXISTS, OR
+ TAD WORD /IF NEW COMMON .LE. OLD IT'S
+ SNL SZA CLA /OK, ELSE ERROR
+ JMP I ER3P
+ TAD COML
+ SNA CLA
+ TAD WORD /IF NO PREVIOUS COMMON AND IF
+ AND K7600 /THIS PROGRAM HAS COMMON ABOVE 177
+ SNA /THEN SET COMMON LIMIT TO LIMIT OF THIS PROG
+ JMP GETSW
+ AND K7400
+ TAD K377 /HIGH COMMON MUST BE AT A MULTIPLE OF 400
+ DCA COML
+ TAD I HLA1P /IF WE HAVE LOADED
+ SZA CLA /ANY CODE INTO FIELD 1
+ JMP I ER3P /IT'S AN ERROR
+ TAD COML /SET BANK1 HIGHEST LOADED ADDRESS
+ DCA I HLA1P
+ JMS I (SETRCN /SET UP HLA AND RCON AGAIN JUST IN CASE
+GETSW, TAD BANK /BANK NUMBER
+ TAD TOPCOR /OK FOR NON-EX. MEM.
+ SMA CLA
+ JMP I ER2I /TOO BIG
+/
+/MAIN LOADING LOOP
+/
+LOOP, JMS RWORD
+ TAD BASE /LOCATE CORRECT FUNCTION
+ TAD CODE /IN TRANSFER TABLE
+ DCA CODE
+CODE, 0 /TRANSFER TO APPROPRIATE ADDRESS
+\f/READ 12-BIT COMPUTER WORD & 4-BIT RELOCATION CODE
+/FROM 2 INPUT CHARACTERS
+
+RWORD, 0
+ JMS I HSRPA /FIRST FRAME
+ DCA WORD
+ TAD WORD /EXTRACT RELOC. CODE
+ RTR
+ RTR
+ AND K17
+ DCA CODE
+ TAD CODE /CK FOR LEADER
+ TAD M10
+ SNA CLA
+ JMP I EOF /YES
+ TAD WORD /ADD TO CHECKSUM
+ TAD CSUM
+ DCA CSUM
+ JMS FORMWD
+ JMS I RCHARP
+ TAD WORD
+ DCA WORD
+ JMP I RWORD
+
+FORMWD, 0
+ TAD WORD
+ RTR
+ RTR
+ RAR
+ AND K7400 /ISOLATE HI 4 BITS
+ DCA WORD /FROM 1ST CHAR
+ JMP I FORMWD
+
+/DATA
+
+EOF, 0
+LMTC, 0
+K17, 17
+K377, 377
+K777, 777
+K7400, 7400
+K7600, 7600
+M10, -10
+M12, -12
+BASE, JMP I TRTAB
+BCRTA, BCRT-1
+HLAZA, HLAZ-1
+HSRPA, ICHAR
+MORE1A, MORE1
+RCHARP, RCHAR
+TOPCOR, 0
+HLA1P, HLA1
+ER2I, ER2
+\f/RELOCATION CODE TRANSFER TABLE
+
+TRTAB, RC0 /LOAD AS IS
+ RC1 /ADD RELOCATION CONSTANT
+ ER5
+ RC3 /DEFINE SYMBOL
+ RC4 /ORIGIN
+ RC5 /CDF TO CURRENT BANK
+ RC6 /REPLACE LOCAL # WITH GLOBAL #
+ ER5
+RC10A, RC10 /LEADER-TRAILER
+ ER5
+ER3P, ER3 /HIGH COMMON
+ER5P, ER5
+ ER5
+ ER5
+ ER5
+ RC17 /EXTERNAL SYMBOL SPECIFICATION
+ PAGE
+\f/NEW ORIGIN
+
+RC4, TAD WORD /NEW ORIGIN
+ CLL
+ TAD RCON /+ RELOCATION CONSTANT
+ DCA CUR /= NEW LOADING ADDRESS
+ SZL
+ JMP I OVERFP /FIELD OVERFLOW
+ JMP I LOOPP1
+/
+/CHANGE CDF TO CURRENT BANK
+/
+RC5, TAD BANK /MOVE BANK TO BITS 6-8
+ CLL RTL
+ RAL
+ TAD WORD /PICK UP CDF
+ JMP RC1+2
+/
+/REPLACE LOCAL EXTERNAL SYMBOL NUMBER WITH GLOBAL EXT. SYM. NO.
+/
+RC6, TAD WORD
+ AND K77 /EXTRACT LOCAL NUMBER
+ DCA B1
+ TAD B1 /CK IF LOCAL # .LE. LOCAL SYM. COUNT
+ CIA
+ TAD I LMTCP1
+ SPA CLA
+ JMP I ER5I /NO
+ TAD B1 /ADD LOCAL # TO BASE OF TABLE
+ TAD ORGTA
+ DCA B1
+ TAD WORD /LOAD ARG COUNT
+ AND K7700
+KCDF, CDF 0
+ TAD I B1 /+ GLOBAL #
+ CDF 10
+ JMP RC1+2 /AT CURRENT LOADING ADDRESS
+\f/ADD RELOCATION CONSTANT TO WORD
+
+RC1, TAD WORD
+ TAD RCON
+ DCA WORD
+/
+/LOAD WORD DIRECTLY AS IT IS
+/
+RC0, TAD HLA /CK FOR CURRENT ADDRESS TO LOAD
+ CIA CLL /.GE. HIGHEST ALREADY LOADED
+ TAD CUR
+ SNL CLA
+ JMP .+3 /NO
+ TAD CUR /YES, RESET HIGHEST
+ DCA HLA
+ CLL
+ TAD CUR /CK FOR ATTEMPT TO LOAD TOP PAGE
+ TAD K200
+ SZL CLA
+ JMP I OVERFP /YES, ROUTINE IS TOO BIG
+ CLA CMA
+ TAD BANK
+ SZA CLA
+ JMP JUSTLD
+ CLL CML CLA RTR
+ TAD CUR
+ SZL SPA CLA
+ JMP GT2000
+ TAD OVLYFG
+K7700, SMA CLA
+ JMP OFFSET
+ JMS I (CVTREC
+ TAD (-11
+ JMP PAGEX2
+GT2000, TAD CUR
+ CLL
+ TAD (-3600
+ SZL CLA
+ JMP PAGEX1
+ JMS I (WROVLY
+ CLA CMA
+ DCA OVLYFG
+ JMP JUSTLD
+PAGEX1, TAD K200
+ JMS I (CVTREC
+PAGEX2, TAD (MTEMP+11
+ JMS I (WRPGBF
+ CLA CLL CML RTR
+ TAD CUR
+ SZL SPA CLA
+ TAD K200
+ TAD CUR
+ AND (377
+ TAD (1400
+ JMP JUSTLD+1
+OFFSET, CLA IAC
+ DCA OVLYFG
+ TAD (1600
+JUSTLD, TAD CUR
+ DCA CURX
+ TAD BANK
+ CLL RTL
+ RAL
+ TAD KCDF
+ DCA .+2
+ TAD WORD
+ HLT
+ DCA I CURX
+ CDF 10
+ ISZ CUR
+ JMP I LOOPP1
+CURX, 0
+/
+/DATA
+/
+K77, 77
+K200, 200
+ER5I, ER5
+LMTCP1, LMTC
+LOOPP1, LOOP
+ORGTA, ORGT
+OVERFP, OVERFL
+HLAZ, 0 /HLA GROUP MUST REMAIN IN GIVEN ORDER
+HLA1, 0
+HLA2, 0
+HLA3, 0
+HLA4, 0
+HLA5, 0
+HLA6, 0
+HLA7, 0
+B1,
+
+HLATST, 0
+ TAD HLAZ
+ TAD HLAIO
+HLASZA, SZA CLA /SET TO CLA BY /R AND RESTART
+ JMP I (UIOERR
+ JMP I HLATST
+HLAIO, -777
+ PAGE
+\f/SYMBOL DEFINITION
+
+RC3, JMS I GTSYMP
+ TAD TVM1 /ADJUSTED BASE OF TRANSFER VECTOR TABLE
+ TAD SYMNUM /+ NUM. OF SYMBOL IN MST
+ DCA C1
+ TAD RCON /LOADING ADDRESS OF THE SYMBOL
+ TAD WORD
+ CDF 00
+ DCA I C1 /TO THE TRANS. VEC. TABLE
+ TAD C1 /GET POINTER INTO TRANSFER VECTOR TABLE
+ TAD M100A /FORM CORRESPONDING POINTER INTO BANK TABLE
+ DCA C1 /=PTR. TO BANK TABLE STORAGE
+ TAD BANK /GET BANK IN BITS 6-8
+ CLL RTL
+ RAL
+ DCA I C1 /STORE IN BANK TABLE
+ CDF 10
+RC3A, TAD NSUB /CHECK FOR TOO MANY SYMBOLS
+ TAD M100A
+ SPA SNA CLA
+ JMP I LOOPP2 /NO
+ JMP ER1
+/
+/TRANSFER VECTOR
+/
+RC17, TAD WORD /COUNTER OF SYMBOLS TO COME
+ CIA
+ DCA C2
+RC17A, JMS I GTSYMP
+ ISZ I LMTCP2 /INC. LOCAL SYM. CTR.
+ TAD ORGTA2 /GET PTR TO STORAGE IN ORIG. TABLE
+ TAD I LMTCP2
+ DCA C1
+ CMA /SYM. # -1 TO ORIG. TABLE
+ TAD SYMNUM
+ CDF 0
+ DCA I C1
+ CDF 10
+ ISZ C2 /CK CTR.
+ JMP RC17A /NOT DONE
+ JMP RC3A
+\f/ERRORS
+
+SIOERR,
+H7600, 7600
+ DCA ERBACK
+ IAC
+HNDERR, IAC
+ERSTAD, IAC
+INERR, IAC
+OUERR, IAC
+ER5, IAC /ILLEGAL INPUT FORMAT
+ER4, IAC /CHECKSUM ERROR
+ER3, IAC /HIGHEST COMMON NOT FIRST
+ER2, IAC /PROGRAM TOO LARGE
+ER1, IAC /SYMBOL TABLE OVERFLOW
+UIOERR, DCA C3
+ JMS CRLF
+ TAD K0522 /"ER"
+ JMS TTWO
+ TAD K2217 /"RO"
+ JMS TTWO
+ TAD K2240 /"R "
+ JMS TTWO
+ TAD C3 /#
+ JMS TOCT
+ JMS I (WRPGBF
+ERBACK, JMP I (CDCALL
+ CDF CIF 0
+ JMP I H7600 /RETURN TO MONITOR
+/
+/TYPE A CARRIAGE RETURN & LINE FEED
+/
+CRLF, 0
+ TAD K215
+ JMS I TYPE
+ TAD K212
+ JMS I TYPE
+ JMP I CRLF
+/
+/UNPACK & TYPE 2 6-BIT CHARACTERS
+/
+TTWO, 0
+ DCA C1
+ CMA /SET FLAG FOR 1ST CHARACTER
+ DCA C2
+ TAD C1 /MOVE LEFT HALF DOWN
+ RTR
+ RTR
+ RTR
+ SKP
+TTWO1, TAD C1 /GET RIGHT HALF
+ AND C77
+ TAD M40 /200 OR 300 GROUP?
+ SPA
+ TAD K100 /300 + 6BIT
+ TAD K2240 /200 + 6BIT
+ JMS I TYPE
+ ISZ C2 /2ND CHARACTER DONE?
+ JMP I TTWO
+ JMP TTWO1 /NO
+/
+/TYPE OCTAL CONTENTS OF AC
+/
+TOCT, 0
+ DCA C1
+ TAD M4B
+ DCA C2
+TOCT1, TAD C1 /MOVE NEXT DIGIT INTO BITS 9-11
+ RTL
+ RAL
+ DCA C1
+ TAD C1 /GET DIGIT
+ RAL
+ AND KK7
+ TAD C260 /CONVERT TO ASCII
+ JMS I TYPE
+ ISZ C2
+ JMP TOCT1 /MORE TO GO
+ JMP I TOCT
+/
+/DATA
+/
+C1, 0
+C2, 0
+C3,
+SYMNUM, 0
+KK7, 7
+C77, 77
+K100, 100
+K212, 212
+K215, 215
+C260, 260
+K0522, 0522
+K2217, 2217
+K2240, 2240
+M4B, -4
+M40, -40
+M100A, -100
+GTSYMP, GETSYM
+LMTCP2, LMTC
+LOOPP2, LOOP
+ORGTA2, ORGT
+TVM1, TVEC-1
+ PAGE
+\f/STORE OR LOOK UP SYMBOL IN SYMBOL TABLE
+
+DEFN, 0
+
+/READ A SYMBOL FROM INPUT ASCII - 6 FRAMES
+
+ CLA CLL CMA RTL
+ DCA D1
+ TAD S1A /POINTER TO 3 WORD BUFFER
+ DCA X3
+RSYM1, JMS RCHAR
+ AND K0077 /EXTRACT 6-BIT
+ CLL RTL
+ RTL
+ RTL
+ DCA D3 /SAVE LEFT HALF
+ JMS RCHAR
+ AND K0077 /GET RIGHT HALF
+ TAD D3
+ DCA I X3
+ ISZ D1
+ JMP RSYM1 /NOT DONE
+ JMP I DEFN
+/
+/SEARCH SYMBOL TABLE FOR CURRENT SYMBOL (IN S1-S3)
+/
+SEARCH, 0
+ DCA I SYMNMP /CLR SYMBOL COUNTER
+ TAD MSTA /SET SYMBOL TABLE PTR
+ DCA D4
+ TAD NSUB /SET CTR FOR NUMBER OF SYMBOLS
+ CMA /+1 (IN CASE NSUB=0)
+ DCA D5
+ JMP SRCH2
+SRCH1, ISZ I SYMNMP /KEEP COUNT
+ TAD D4 /TEST TABLE ENTRY
+ DCA X4 /SYM. TAB. PTR
+ CLA CLL CMA RTL
+ DCA D2 /COUNTER
+ TAD S1A
+ DCA X3 /PTR TO S1/S3
+COMP1, TAD I X4 /COMPARE WORDS
+ CIA
+ TAD I X3
+ SZA CLA
+ JMP NOMACH /NOT ALIKE
+ ISZ D2
+ JMP COMP1 /TRY NEXT WORD OF TRIPLET
+ ISZ SEARCH
+ JMP I SEARCH
+NOMACH, CLA CLL CMA RTL
+ TAD D4
+ DCA D4
+SRCH2, ISZ D5
+ JMP SRCH1 /NOT DONE
+ JMP I SEARCH
+/
+/ENTER A SYMBOL IN THE SYMBOL TABLE
+/
+INSERT, 0
+ TAD NSUB /(NUMBER OF SYMBOLS)*3
+ CLL RAL
+ TAD NSUB
+ CIA /SUBTRACT FROM BASE OF TABLE
+ TAD MSTA
+ DCA X3 /FOR POINTER
+ TAD S1 /1ST WORD
+ DCA I X3
+ TAD S2 /2ND
+ DCA I X3
+ TAD S3 /3RD
+ DCA I X3
+ ISZ NSUB /COMPUTE SYM. TAB. NUMBER
+ TAD NSUB
+ DCA I SYMNMP
+ JMP I INSERT
+/
+/CORE OVERFLOW
+/
+OVERFL, TAD BCRTA3
+ DCA D1
+ TAD TVECA3
+ DCA D2
+ TAD M100
+ DCA D3
+ CDF 00
+OVERF2, TAD I D1 /CK FOR CDF IN BCRT
+ SPA CLA
+ JMP .+3 /YES
+ DCA I D1 /NO, CLEAR IT
+ DCA I D2 /CLEAR TV WORD
+ ISZ D1
+ ISZ D2
+ ISZ D3
+ JMP OVERF2 /MORE TO GO
+ CDF 10
+ JMP I ER2P
+
+GETSYM, 0 /GET SYMBOL AND SEARCH TABLE
+ JMS DEFN
+ JMS SEARCH
+ JMS INSERT
+ JMP I GETSYM
+\f/READ 1 FRAME & ADD TO CHECKSUM
+
+RCHAR, 0
+ JMS I HSRPB
+ DCA D4
+ TAD D4
+ TAD CSUM
+ DCA CSUM
+ TAD D4
+ JMP I RCHAR
+
+SETRCN, 0 /SUBR TO SET HIGHEST-LOADED ADDRESS (HLA)
+ TAD I HLAPTR /AND RELOCATION CONSTANT (RCON)
+ DCA HLA
+ TAD HLA
+ AND (7600
+ DCA RCON
+ JMP I SETRCN
+
+MAIN, 1501;1116;4040 /"MAIN"
+
+/
+/DATA
+/
+D1, 0
+D2, 0
+D3, 0
+D4, 0
+D5, 0
+S1, 0
+S2, 0
+S3, 0
+K0077, 77
+M100, -100
+BCRTA3, BCRT
+ER2P, XER2
+HSRPB, ICHAR
+MSTA, MST-3
+S1A, S1-1
+SYMNMP, SYMNUM
+TVECA3, TVEC
+ PAGE
+\f/TRAILER CODE EXIT
+
+RC10, JMS I (FORMWD
+ JMS I HSRP /GET LOW ORDER PART
+ TAD WORD
+ CIA
+ TAD CSUM /COMPARE WITH ACCUMULATED SUM
+ SZA CLA
+ JMP I ER4P /NOT EQUAL
+ TAD BCRTA4
+ DCA T1
+ TAD TVECA
+ DCA X2
+ TAD M100D
+ DCA T3
+K6201A, CDF 00
+RC10Z, TAD I X2 /GET TV ENTRY
+ SNA CLA
+ JMP .+5 /NOT DEFINED; IGNORE IT
+ TAD I T1 /GET BCRT WORD
+ AND K70 /EXTRACT BANK
+ TAD K6201A /COMBINE CDF
+ DCA I T1
+ ISZ T1
+ ISZ T3
+ JMP RC10Z /NOT DONE YET
+ CDF 10
+ TAD HLA /STORE HIGHEST LOADED ADDRESS
+ DCA I HLAPTR /IN PROPER LOC. (HLA0-7)
+ JMP I (LOADOK
+\f/LOADER MAP PRINT ROUTINE CONTINUED
+
+MAPX, SNL CLA /IF LINK=1 ONLY PRINT PAGE COUNTS,
+ TAD NSUB /OTHERWISE PRINT SYMBOLS
+ CMA
+ DCA T1 /CTR OF ROUTINES
+ TAD MSTA4 /SYMB. TAB. PTR.
+ DCA X1
+ TAD TVECA /TV PTR
+ DCA X2
+ TAD BCRTA4 /BCRT PTR
+ DCA T4
+ TAD (2640 /PRINT V#
+ JMS I TTWOP
+ TAD (VERSION+PATCH
+ JMS I TTWOP
+ JMS I CRLFP
+ JMP PRINT1
+PRINT, TAD TM1
+ RTR CLL
+ CDF 0
+ TAD I X2
+ CDF 10
+ DCA TM2
+ TAD TM2
+ SNL SZA CLA
+ JMP PIGNOR
+ TAD I X1
+ JMS I TTWOP
+ TAD I X1
+ JMS I TTWOP
+ TAD I X1
+ JMS I TTWOP
+ TAD K4040 /2 SPACES
+ JMS I TTWOP
+ CDF 00
+ TAD I T4 /PRINT BANK NUMBER
+ CDF 10
+ RTR
+ RAR
+ AND K7B
+ TAD K260
+ JMS I TYPE
+ TAD TM2 /PRINT SYMBOL VALUE
+ JMS I TOCTP
+ TAD TM2 /IF ADDRESS=0,IT IS UNDEFINED
+ SZA CLA
+ JMP .+3 /ITS OK
+ TAD K4025 /TYPE SPACE,U
+ JMS I TTWOP
+ JMS I CRLFP
+ TAD M03
+PIGNOR, TAD M03
+ TAD X1
+ DCA X1
+ ISZ T4
+PRINT1, ISZ T1
+ JMP PRINT /JUMP IF MORE SYMBOLS, ELSE FALL INTO NEXT PG
+\fPAGES, TAD FCTR /SET CTR FOR CORRECT # OF BANKS
+ DCA T1
+ TAD (HLAZ-1 /INIT. PTR. TO HLA LIST
+ DCA X1
+ TAD I X1 /GET HLA OF NEXT BANK
+ CMA RTL /DIVIDE BY 200 AND COMPLEMENT
+ RTL
+ RTL
+ AND K37 /=NUMBER OF PAGES LEFT + 1
+ SZA
+ TAD (-1 /REDUCE IF NON-ZERO
+ JMS I TOCTP
+ JMS I CRLFP
+ ISZ T1
+ JMP PAGES+4 /NOT DONE WITH ALL BANKS
+ JMP I (OCLOS
+
+/
+/DATA
+/
+FCTR, 0 /# OF HIGHEST MEM. FIELD
+K37, 37
+T1, 0
+T3, 0
+T4, 0
+K7B, 7
+K70, 70
+K260, 260
+K4025, 4025
+K4040, 4040
+M03, -3
+BCRTA4, BCRT
+CRLFP, CRLF
+ER4P, ER4
+HSRP, ICHAR
+MSTA4, MST-3
+TOCTP, TOCT
+TTWOP, TTWO
+TVECA, TVEC-1
+M100D, 7700
+ PAGE
+\f/WROVLY IS USED TO STORE THE FIELD COUNT FOR THE PROPGT
+/ROUTINE- PROPGT IS CALLED THE FIRST TIME THAT IOTEST IS
+/CALLED-SEE LOC.325 IN FIELD ZERO(APPROX.)
+
+BC1000, 1000
+WROVLY, 0
+ TAD OVLYFG
+ SPA SNA CLA
+ JMP I WROVLY
+ CIF 0
+ JMS I (SHNDLR
+ 0110
+ 1600
+ MTEMP
+ JMP I (SIOERR
+ CIF 0
+ JMS I (SHNDLR
+ 5010
+ 1600
+ MTEMP
+ JMP I (SIOERR
+ DCA OVLYFG
+ JMP I WROVLY
+
+WRPGBF, 0
+ DCA PRECNO
+ TAD WRBFSW
+ SNA
+ JMP PREAD
+ CIA
+ TAD PRECNO
+ SNA CLA
+ JMP I WRPGBF
+ CIF 0
+ JMS I (SHNDLR
+ 4210
+ 1400
+WRBFSW, 0
+ JMP I (SIOERR
+PREAD, DCA OLDT9
+ TAD PRECNO
+ SNA CLA
+ JMP SETBF
+ CIF 0
+ JMS I (SHNDLR
+ 0210
+ 1400
+PRECNO, 0
+ JMP I (SIOERR
+SETBF, TAD PRECNO
+ DCA WRBFSW
+ JMP I WRPGBF
+\f/LOADER CLEANUP CODE - PREPARES TO RETURN TO OS/8
+
+LDRXIT, CDF 10
+ TAD I (HLA1
+ TAD BC200
+L7700, SMA CLA /DID WE LOAD OVER THE LOADER?
+ TAD (FIVE /NO
+ DCA WROVLY /WROVLY=0 OR 5
+ CIF 0
+ JMS I (SHNDLR
+ 0201
+ 400
+ MTEMP+21 /READ BACK THE RUN-TIME ROUTINES
+ JMP I (SIOERR /BADDIE
+ TAD K1600
+ CDF 0
+ DCA I ST1600
+ TAD I P4
+ DCA I P5
+ ISZ P4
+ ISZ P5
+ ISZ P6
+ JMP .-5 /ALSO MOVE 16-32 INTO LOC 100
+ CDF 10
+ JMS I BC200
+ 13 /RESET EVERYTHING
+ TAD I (MPARAM
+ AND (40 /GET "/G" SWITCH
+ SNA CLA
+ JMP CALMON /GO SWITCH NOT ON
+ JMS I BC200
+ 11 /KICK MONITOR OUT
+ CDF CIF 0
+ TAD (MSTCDF
+ DCA I (FIVE+1 /GO TO PROGRAM START ADR INSTEAD OF 7600
+ ISZ I (ONE /OPTOMIZE READ A LITTLE ON DECTAPE
+ JMP I WROVLY
+
+CALMON, CLA CMA
+ DCA I L7700 /INDICATE I/O MONITOR IS IN CORE
+ CDF CIF 0
+ JMP I WROVLY /GET OUT
+
+ST1600, 177 /THIS IS SET TO "FINBUF" OR "FOUBUF" BY /I AND /O
+P4, 16
+P5, 100
+P6, -15
+\f/ROUTINE TO TEST FOR /I AND /O SWITCHES
+
+IOTEST, 0
+ TAD I (MPARAM
+ AND (10
+ SNA CLA //I?
+ JMP .+4
+ JMS I (HLATST
+ CDF CIF 0
+ JMS I (INPENB
+ TAD I (MPARAM+1
+BC200, AND BC1000
+ SNA CLA //O?
+ JMP .+4
+ JMS I (HLATST
+ CDF CIF 0
+ JMS I (OUPENB
+ ISZ DOPROP /SHOULD WE PROPAGATE RESIDENT(AND WRITE OUT
+ JMP .+4 /THE RUN-TIME ROUTINES?)--NO
+ TAD WROVLY /YES-FIELD COUNT IS IN WROVLY
+ CDF CIF 0
+ JMS I (PROPGT /DO IT
+ JMP I IOTEST
+K1600, 1600 /RESET TO 2000 IF TWO PG.DEV.HNDLRS AT RUN TIME
+DOPROP, 7777 /ONCE-ONLY FLAG FOR PROPAGATING FIELD ZERO
+ /RESIDENT AND WRITING OUT RUNTIME ROUTINES
+ /NOT RESET AFTER /R!!!!
+ /SET TO -2 IF CALLED BY ".R LOADER"
+ /BECAUSE OF USELESS INIT CALL TO IOTEST
+ PAGE
+ $
+\f
--- /dev/null
+This area contains the files contained on system release DECtape #1.
+
+Directory of OS/8 V3D DECtape 1 labeled: AL-4691C-SA 2/15/78
+ OS/8 V3D SRC DT 1 OF 7
+ (replaces DEC-S8-OSYSB-B-UA1)
+
+
+EPIC .PA 65 01-AUG-77 TD8EC .PA 20 01-AUG-77
+CREF .PA 148 01-AUG-77 TD8ED .PA 20 01-AUG-77
+RK08SY.PA 16 01-AUG-77 FLOAT .SB 27 01-AUG-77
+RK08NS.PA 11 01-AUG-77 LIBSET.PA 32 01-AUG-77
+ASR33 .PA 10 01-AUG-77 SRCCOM.PA 63 01-AUG-77
+TD8EA .PA 20 01-AUG-77 C2BOOT.PA 8 01-AUG-77
+TD8EB .PA 20 01-AUG-77 LOADER.PA 99 01-AUG-77
+
+ 14 files in 559 blocks - 171 free blocks
+
+
--- /dev/null
+/3 RK8 NON SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -4
+
+DEVICE RK01;DEVICE RKA0;4050;20;ZBLOCK 2
+DEVICE RK01;DEVICE RKA1;4050;21;ZBLOCK 2
+DEVICE RK01;DEVICE RKA2;4050;22;ZBLOCK 2
+DEVICE RK01;DEVICE RKA3;4050;23;ZBLOCK 2
+
+ DLDC=6732
+ DCLS=6742
+ DRDS=6741
+ DSKD=6745
+ DSKE=6747
+ DCLA=6751
+ DLWC=6753
+ DLCA=6755
+ DLDR=6733
+
+ RKVERSION="A&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. A FULL 4K READ OR WRITE IS NOW LEGAL
+
+ *200
+/THE ENTRY POINTS FOR RK8 ARE SET AT 20-23. VITAL!!
+
+RLOC, 0 /FOR BUFFER ADDRESS
+RREC, 0 /HOLDS RECORD NO.
+R76, 76
+RDLDR, DLDR
+RKANO, 0
+RKAISZ, ISZ RKANO
+RBLKCT, 0 /HOLDS TOTAL WORD COUNT
+RERRCT, 0 /# ERROR TRIES
+R177, 177
+R40, 40
+RM3, -3
+R400, 400
+R7400, 7400
+RKA, 0 /HOLDS ARGUMENT ADDRESS
+R34, 34
+RZERO, RKVERSION
+ IFNZRO .-220 <ADRERR,QQQ>
+RKA0, ISZ RKANO
+RKA1, ISZ RKANO
+RKA2, ISZ RKANO
+RKA3, ISZ RKANO
+R7600, 7600
+ TAD RM3
+ DCA RERRCT /3 TRIES ON ERROR
+ TAD RKANO /THIS CODE RESTORES THE ISZ RKANO
+ CMA /WHICH WAS DESTROYED IN THE CALL
+ TAD RKATAD
+ DCA RFUNCT
+ CLA CLL CML RTR
+ TAD RFUNCT /FORM DCA RKAN,WHERE RKAN WAS CALLED
+ DCA RKADCA
+ RDF
+ TAD RCDIF /RESTORE TO PROPER FIELD
+ DCA REXIT
+RFUNCT, HLT /CONTAINS TAD RKAN WHEN EXECUTED
+ DCA RKA /SO WE SAVE ADDRESS OF ARGUMENTS
+ TAD RKAISZ /AND NOW RESTORE THE ISZ RKANO
+RKADCA, HLT
+ TAD I RKA /FUNCTION WORD
+ DCA RFUNCT
+ ISZ RKA
+ CLA CMA /BUFFER ADDRESS -1
+ TAD I RKA
+ DCA RLOC
+ ISZ RKA
+ TAD I RKA /RECORD NUMBER
+ DCA RREC
+ TAD RFUNCT /NOW FORM RK8 IOT FROM FUNCTION.
+ CLL RAL /READ/WRITE TO LINK
+ AND R7600 /ISOLATE WORD COUNT
+ DCA RBLKCT
+ RTL /READ=6733,WRITE=6735
+ TAD RDLDR
+ DCA RINST
+\fRLOOP, TAD RLOC /LOAD CURRENT ADDRESS
+ DLCA
+ TAD RBLKCT /TEST WORD COUNT FOR SIZE.
+RKATAD, TAD R7600 /FULL=256, HALF=128
+ SZA CLA
+ TAD R7600
+ TAD R7600
+ DLWC /LOAD WORD COUNT
+ TAD RFUNCT /LOADING COMMAND WORD WITH FIELD
+ CMA RAR /AND DISK SELECTION
+ AND R34
+ TAD RKANO
+ CMA RAL
+ AND R76
+ DLDC
+ DCLS /CLEARS SELECT ERROR IF STILL UP
+ TAD RREC
+RINST, HLT /GETS DISK IOT
+ DSKD /TEST COMPLETION FLAG
+ SKP CLA /NOT DONE YET
+ JMP RCTLC /DONE. CHECK FOR ^C
+ DSKE /IS ERROR UP?
+ JMP .-4
+RERROR, ISZ RERRCT /ERROR BUMP COUNT
+ JMP .+4
+ DCA RKANO /IT'S ALL OVER. CLEAR FOR RECALL
+ CLA CLL CML RAR
+ JMP RETRN+1 /FATAL ERROR
+ DRDS /LOOK AT STSTUS
+ AND R40 /TRACK NOT FOUND BIT
+ ISZ RZERO /CARRY OVER FROM SYSTEM HANDLER
+ JMP .-1
+ SNA CLA
+ JMP RLOOP /TRY AGAIN
+ DCLA /RECALIBRATE
+ DSKD
+ JMP .-1
+ JMP RLOOP /AND TRY AGAIN
+\fRNEXT, DSKE /TRANSFER DONE. IS ERROR UP?
+ SKP
+ JMP RERROR /YEP.TOUGH LUCK
+ ISZ RREC /BUMP RECORD NUMBER
+ TAD RLOC
+ TAD R400 /BUMP CURRENT ADDRESS
+ DCA RLOC
+ TAD RBLKCT /DONE WITH ALL TRANSFERS?
+ SNA
+ JMP RDONE /V3 0 OK HERE
+ CLL CML
+ TAD R7400
+ SZL SNA
+ JMP RDONE
+ DCA RBLKCT /NO..UPDATE TOTAL WORD COUNT
+ JMP RLOOP /AND DO THE TRANSFER
+RDONE, CLA
+ DCA RKANO /CLEAR FOR RECALL
+RETRN, ISZ RKA
+ ISZ RKA
+REXIT, HLT
+ JMP I RKA
+
+RCTLC, KRS /TEST FOR ^C IN KEYBOARD BUFFER
+ AND R177 /WITH THE FLAG UP
+ TAD RM3
+ SNA CLA
+ KSF
+ JMP RNEXT /NO ^C, KEEP GOING
+RCDIF, CIF CDF 0
+ JMP I R7600
+ $
+\f
--- /dev/null
+/10 OS/8 RK8 SYSTEM HANDLER V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/SYSTEM HANDLER ALSO HAS RESIDENT THE NONSYSTEM HANDLER RKA1:
+
+/ SOFSET=7747
+
+ RKVERSION="D&77
+
+ DLDA=6731 /LOAD DISK ADDRESS (MAINT ONLY)
+ DLDC=6732 /LOAD COMMAND REGISTER
+ /0: ENABLE CHANGE IN INTERRUPT STATUS
+ /1: ENABLE PROGRAM INTERRUPT ON TRANSFER DONE
+ /2: ENABLE INTERRUPT ON ERROR
+ /3: UNUSED
+ /4: SEEK TRACK AND SURFACE ONLY
+ /5: ENABLE READ/WRITE OF 2 HEADER WORDS
+ /6-8: EXTENDED MEMORY ADDRESS
+ /9-10: DISK FILE NUMBER
+ /11: UNUSED
+ DLDR=6733 /LOAD DISK ADDRESS AND READ, THEN CLEAR AC
+ /0-7: TRACK ADDRESS
+ /8: SURFACE BIT
+ /9-11: SECTOR ADDRESS
+ DRDA=6734 /READ DISK ADDRESS
+ DLDW=6735 /LOAD DISK ADDRESS AND WRITE, THEN CLEAR AC
+ DRDC=6736 /READ DISK COMMAND REGISTER
+ DCHP=6737 /LOAD DISK ADDRESS AND CHECK PARITY
+ DRDS=6741 /READ DISK STATUS REGISTER
+ /0: ERROR
+ /1: TRANSFER DONE
+ /2: CONTROL BUSY ERROR
+ /3: TIME OUT ERROR
+ /4: PARITY OR TIMING ERROR
+ /5: DATA RATE ERROR
+ /6: TRACK ADDRESS ERROR
+ /7: SECTOR NO GOOD ERROR
+ /8: WRITE LOCK ERROR
+ /9: TRACK CAPACITY EXCEEDED ERROR
+ /10: SELECT ERROR
+ /11: BUSY
+ DCLS=6742 /CLEAR STATUS REGISTER
+ DMNT=6743 /LOAD MAINTENANCE REGISTER
+ /SEE PAGE 7-145 IN 1972 SMALL COMPUTER HANDBOOK
+ DSKD=6745 /SKIP ON DISK DONE
+ DSKE=6747 /SKIP ON DISK ERROR
+ DCLA=6751 /CLEAR ALL
+ DRWC=6752 /READ WORD COUNT REGISTER
+ DLWC=6753 /LOAD WORD COUNT REGISTER
+ DLCA=6755 /LOAD CURRENT ADDRESS REGISTER
+ DRCA=6757 /READ CURRENT ADDRESS REGISTER
+\f *0
+
+ -3
+ DEVICE RK8;DEVICE SYS;4051;2007;0;6260
+ DEVICE RK8;DEVICE RKA0;4051;1007;0;6260
+ DEVICE RK8;DEVICE RKA1;4051;RKA1&177+1000;0;6260
+
+/V3D CHANGES:
+
+/FIXED BUG CONCERNING RETRY COUNT IF LINK SET ON CALL
+/REMOVED 'SOFSET'
+\f BOOT-ENDB-1
+
+ NOPUNC
+ *1
+ ENPUNC
+
+BOOT, TAD I BOOTX1
+ DCA I BOOTX2
+ TAD I BOOTX3
+ CDF 10
+ DCA I BOOTX4
+ CDF 0
+ TAD BOOTX2
+ SZA CLA
+ JMP BOOT
+ JMP BGETUT
+BOOTX1, 200
+BOOTX2, 7577
+BOOTX3, 47
+BOOTX4, 7646
+BGETUT, DRDC
+ RAR
+ AND BOOT3
+ DCA I BOOTUT
+ JMP I B7605
+BOOT3, 3
+BOOTUT, DEFUNIT
+ ZBLOCK 27-.
+B7605, 7605
+ DSKD /MUST LOAD OVER LOC. 30
+ JMP .-1 /MUST LOAD OVER 31
+ENDB, JMP BOOT
+\f /THE BOOTSTRAP FOR THE RK8 IS AS FOLLOWS: (UNIT 0)
+
+ / LOCATION CONTENTS
+ / 30 6733
+ / 31 5031
+
+ /LOAD ADDRESS 30 AND START
+
+/THE BOOTSTRAP FOR OTHER UNITS IS AS FOLLOWS:
+
+/ 26 7604
+/ 27 6732
+/ 30 6733
+/ 31 5031
+
+/LOAD ADDRESS 26, PUT UNIT NUMBER IN SWITCH REGISTER BITS 9-10,
+/CLEAR, CONTINUE
+\f *200
+
+ NOPUNCH;*7600;ENPUNCH
+
+ ZBLOCK 7
+RK8, RKVERSION
+ CLA
+ TAD DEFUNIT /USE DEFAULT UNIT FOR SYSTEM HANDLER
+ JMP COMN
+DEFUNIT,0
+RKBAD, STL CLA RAR /4000
+ SKP
+RKOVER, ISZ RK8 /POINT TO GOOD RETURN
+SFIELD, HLT /CONTAINS CIF CDF TO USER'S FIELD
+ JMP I RK8 /RETURN
+ IFNZRO .&177-21 <BADLOC,XXXX>
+RKA1, RKVERSION
+ CLA
+ TAD RKA1
+ DCA RK8
+ CLA IAC
+COMN, DCA RKANO
+ CLL STA RTL /V3D
+ DCA RKCNT /SET # OF RETRIES ON AN ERROR TO 3
+ RDF
+ TAD LCIFCDF /CALLING FIELD FOR RETURN
+ DCA SFIELD
+RKRETRY,TAD I RK8 /GET FN WORD
+ AND L70 /ISOLATE FIELD OF BUFFER
+ TAD RKANO
+ TAD RKANO /INCLUDE UNIT # (TIMES 2)
+ DLDC /SET FIELD
+ TAD I RK8 /GET FN WORD BACK
+ RAL /MOVE R/W BIT TO LINK
+ AND L7600 /ISOLATE # OF WORDS TO READ
+ SZA
+ CIA /NEGATE
+ DLWC /LOAD WORD COUNT THEN CLEAR AC
+ RTL /MOVE R/W BIT TO AC 10
+ TAD LDLDR
+ DCA RKINST /CREATE READ (6733) OR WRITE (6735)
+ ISZ RK8 /POINT TO BUFFER ADDRESS
+ STA
+ TAD I RK8 /GET CURRENT ADDRESS-1
+ DLCA /LOAD CURENT ADDRESS AND CLEAR AC
+ ISZ RK8 /POINT TO BLOCK #
+ DCLS /CLEAR STATUS REGISTER
+ DSKE /CHECK FOR NON-EXISTENT DISK ERROR
+L7760, SMA SZA SNL CLA /OK, BUT SKIP ALWAYS
+ JMP RKBAD /IT'S BAD
+/V3D TAD RKANO /! CAN'T HAVE OFFSETS ON OTHER UNITS THAN 0
+/V3D SNA CLA
+/V3D TAD SOFSET
+ TAD I RK8 /GET BACK #
+ ISZ RK8 /POINT TO ERROR RETURN
+RKINST, HLT /GO (EITHER 6733 OR 6735)
+ SZA CLA /CHECK FOR NO DISK AT ALL
+ JMP RKBAD /IOT DIDN'T CLEAR AC
+/THE ABOVE TWO LINES ARE USELESS. HOW DID HE BOOTSTRAP IF DISK WASN'T THERE?
+ DSKD /WAIT FOR DONE
+ JMP .-1
+ DSKE
+ JMP RKOVER /NO ERROR
+L70, 70
+L20, 20
+L7600, 7600
+L4, 4
+ SKP CLA
+ IFNZRO .-7701 <NZERR,XXX>
+ HLT /SAFETY HALT AT 7701
+ DRDS /READ STATUS REGISTER
+ AND L4 /CHECK FOR TRACK OVERFLOW
+ SZA CLA
+ JMP RKTKOV
+ ISZ RKCNT /SOME OTHER ERROR - BADNESS [SIC]
+ JMP RKOK /TRY AGAIN
+ JMP RKBAD /3 TRIES IS ENOUGH
+RKOK, DRDS /READ STATUS REGISTER
+ AND L40 /TRACK SEEK ERROR?
+ DCLS /CLEAR STATUS REGISTER
+ SNA CLA
+ JMP RKBACK
+ DCLA /YES - RECALIBRATE
+ DSKD /WAIT 'TILL DONE
+ JMP .-1
+RKBACK, CLL STA RTL /-3
+ TAD RK8
+ DCA RK8 /POINT BACK TO FUNCTION WORD
+ JMP RKRETRY /GO TRY AGAIN
+
+RKTKOV, DCLS /CLEAR STATUS REGISTER
+ DRDA /READ TRACK ADDRESS STUFF
+ AND L7760 /ISOLATE JUST TRACK (NEEDED ??)
+ TAD L20 /BUMP TRACK NUMBER BY 1
+ JMP RKINST /GO BACK AND CONTINUE TRANSFER
+LCIFCDF,CIF CDF 0
+LDLDR, DLDR
+L40, 40
+RKCNT, 0
+RKANO, 0
+/ MUST NOT GO INTO LOCATION 7744
+ IFZERO .&177-145&4000 <TOOBIG,XXXX>
+ $
--- /dev/null
+/1 OS8 SOURCE COMPARE (SRCCOM)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/LAST EDITED 4/28/77
+/
+/
+/COPYRIGHT 1973,1977
+/DIGITAL EQUIPMENT CORPORATION
+/MAYNARD, MASS. 01754
+/
+/PDP-8 SOURCE COMPARISON PROGRAM
+/STOLEN FROM PDP-10 SRCCOM BY R. LARY
+
+VERSION= 4 /CHANGE EVERY MAJOR EDIT
+PATCH="A
+
+ IFNDEF CORE <CORE=2 /DEFAULT IS 8K SYSTEM>
+ MPARAM=7643 /COMMAND DECODER PARAMETER BLOCK
+
+ IFZERO CORE-2 <F1=0 /FIELD FOR FILE 1
+ F2=10 /FIELD FOR FILE 2
+ LNBEG=2000 /BEGINNING OF LINE BUFFER
+>
+ IFZERO CORE-4 <F1=20
+ F2=30
+ LNBEG=20
+>
+ BUFLIM=FBLOCK-1001 /END OF LINE BUFFER
+ INBUF=FBLOCK-1000 /INPUT BUFFER
+\f/SRCCOM FIELD 0 PAGE 0
+
+ FIELD 0
+
+ XR=10
+
+ *20
+SCT, 0 /TEMPORARY
+OFILNM, ZBLOCK 4 /OUTPUT FILE NAME
+IFPTR, 0 /TEMPORARY
+SETUP1, NOPUNCH
+ *7556 /JAM PARAMETERS UP AGAINST TOP OF USER CORE
+FBLOCK, ENPUNCH
+
+/LAYOUT OF FILE PARAMETER TABLE
+/THERE IS A COPY OF THIS TABLE IN FIELDS F1 AND F2. EACH COPY
+/CONTAINS ALL THE INFORMATION ABOUT THE FILE WHOSE BUFFERS
+/ARE IN THE SAME FIELD
+
+
+PGNUM, 1 /CURRENT INPUT PAGE
+CURLIN, 0 /CURRENT LINE (IN LINE BUFFER)
+TOPLIN, 0 /NUMBER OF LINES IN LINE BUFFER
+TMPLIN, 0 /TEMPORARY STORAGE FOR "CURLIN"
+OLDLIN, 1 /LINE OPTIMIZATION COUNTER
+OLDPTR, LNBEG /LINE OPTIMIZATION POINTER
+ /THE NEXT SEVERAL WORDS ARE A SUBROUTINE
+ /WHICH READS A BUFFER IN FROM THE INPUT FILE
+INTEMP, 0 /SHIFT REGISTER FOR "GCHAR" ROUTINE
+ CIF 0
+ JMS I INHNDL
+INCHCT, 7777 /COUNT OF CHARACTERS IN BUFFER
+INPTR, 0 /POINTS TO CURRENT WORD IN BUFFER
+INREC, 0 /CONTAINS CURRENT INPUT RECORD
+ ISZ INTEMP /SUBROUTINE SKIPS ON INPUT ERROR
+ CIF 10
+ JMP I INTEMP
+INHNDL, 0 /POINTS TO ENTRY POINT OF INPUT HANDLER
+
+INEOF, 0 /END-OF-FILE INDICATOR
+INRCNT, 0 /COUNT OF RECORDS REMAINING IN THIS FILE
+ IFNZRO .-7600 <_ERROR_>
+ *SETUP1+.-FBLOCK/PUT ASSEMBLER LOCATION COUNTER BACK
+ SETUP2=.
+\f
+
+ /CORE ALLOCATION FOR 8K SYSTEM
+
+/ FIELD 0
+/
+/0000-0377 CONTROL CODE
+/0400-0777 INPUT HANDLER 1
+/1000-1377 INPUT HANDLER 2
+/1400-1777 OUTPUT HANDLER
+/2000-6555 FILE 1 LINE BUFFER
+/6556-7555 FILE 1 INPUT BUFFER
+/7556-7577 FILE 1 CONTROL BLOCK
+/
+/ FIELD 1
+/
+/0000-1377 SRCCOM PROPER
+/1400-1777 OUTPUT BUFFER
+/2000-6555 FILE 2 LINE BUFFER
+/6556-7555 FILE 2 INPUT BUFFER
+/7556-7577 FILE 2 CONTROL BLOCK
+/
+/
+/ FORMAT OF LINE BUFFER:
+/ THE LINE BUFFER CONSISTS OF SOURCE LINES. THE FIRST WORD
+/ OF EACH LINE IS A LENGTH WORD GIVING THE LENGTH OF THE
+/ LINE (INCLUDING THE LENGTH WORD ITSELF) AS A POSITIVE
+/ NUMBER. THE NEXT WORD IS THE NUMBER OF THE SOURCE PAGE
+/ ON WHICH THIS LINE WAS FOUND. SUBSEQUENT WORDS CONTAIN THE
+/ CHARACTERS OF THE LINE ITSELF, PACKED ONE PER WORD.
+
+
+NODFMS, "N;"O;" ;"D;"I;"F;"F;"E;"R;"E;"N;"C;"E;"S;0
+\fSETUP, 0 /ROUTINE TO SET UP FILE PARAMETERS
+ TAD [SETUP1-SETUP2
+ DCA SCT
+ TAD [TAD SETUP1
+ DCA INST2
+ TAD [FBLOCK-1
+ DCA XR
+INST2, HLT /MOVE THE SKELETON PARAMETER BLOCK
+ DCA I XR /UP INTO THE DESIRED FIELD
+ ISZ INST2
+ ISZ SCT
+ JMP INST2
+ RDF
+ TAD [6201
+ DCA SETCDF /SAVE FIELD NUMBER
+ CDF 10
+ TAD I IFPTR
+ CDF 0
+ SNA
+ JMP I [INERR1 /NO INPUT FILE - BAD
+ CIF 10
+ JMS I [200 /ASSIGN DEVICE HANDLER
+ 1
+DVPAGE, 0
+ HLT /NEVER HOPPEN
+ CDF 10
+ TAD I IFPTR
+ AND [7760 /COMPUTE FILE LENGTH
+ SZA
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA SCT /SAVE IT AWAY TEMPORARILY
+ ISZ IFPTR
+ TAD I IFPTR
+SETCDF, HLT /RESET DATA FIELD
+ DCA I [INREC /SAVE STARTING BLOCK NUMBER
+ TAD SCT
+ DCA I [INRCNT /SAVE FILE LENGTH
+ TAD DVPAGE
+ DCA I [INHNDL /SAVE DEVICE HANDLER ENTRY POINT
+ ISZ IFPTR
+ JMP I SETUP /RETURN
+\f *200 /INITIALIZATION CODE
+SRCCOM, ISZ NOCHN
+ CIF 10
+ JMS I [7700
+ 10 /BRING USR INTO CORE
+SRCCD, TAD NOCHN /HAVE WE BEEN CHAINED TO?
+ SNA CLA
+ JMP NOSRCD /YES
+ CIF 10
+ JMS I [200
+ 5 /COMMAND DECODE
+ 0 /NO DEFAULT EXTENSIONS
+NOSRCD, TAD [7617
+ DCA IFPTR /SET IFPTR POINTING TO FILE 1
+ TAD [401
+ DCA DVPAGE /FILE 1 HANDLER GOES IN 400-777
+ CDF F1
+ JMS SETUP /SET UP FILE 1 PARAMETER AREA
+ TAD [1001
+ DCA DVPAGE /FILE 2 HANDLER GOES INTO 1000-1377
+ CDF F2
+ JMS SETUP /SET UP FILE 2 PARAMETER AREA
+ TAD [1401
+ DCA OUPAGE /OUTPUT HANDLER GOES INTO 1400-1777
+GTOUHN, CDF 10
+ TAD I [7600 /GET OUTPUT DEVICE #
+ CDF 0
+ SZA /IS THERE ONE?
+ JMP ASSOUT
+ DCA TTYNO
+ CIF 10 /NO - LOOK UP "TTY"
+ JMS I [200
+ 12 /INQUIRE
+ 5524 /=2424+3100 = TTY
+TTYNO, 0
+ 0
+ JMP OUERR1 /NO TELETYPE
+ TAD TTYNO
+ CDF 10
+ DCA I [7600
+ JMP GTOUHN /BACK TO GET IT AGAIN
+ASSOUT, CIF 10
+ JMS I [200
+ 1
+OUPAGE, 0
+ JMP OUERR1
+\f TAD [-4
+ DCA SCT
+ TAD [7600
+ DCA XR
+ TAD [DCA OFILNM
+ DCA INST1
+ CDF 10 /MOVE OUTPUT FILE NAME INTO FIELD 0
+ TAD I XR
+INST1, HLT
+ ISZ INST1
+ ISZ SCT
+ JMP INST1-1
+ TAD PFILNM
+ DCA ORCNO /SET UP ENTER
+ TAD OFILNM+3
+ SNA
+ TAD [1423 /ASSUMED OUTPUT EXTENSION = .LS
+ DCA OFILNM+3
+ TAD I [7600
+ CDF 0
+ CIF 10
+ JMS I [200
+ 3
+ORCNO, 0 /POINTS TO FILE NAME
+OLEN, 0
+ JMP OUERR1
+ CIF 10
+ JMS I [200
+ 11 /KICK USR OUT OF CORE
+ DCA OCOUNT
+ CDF CIF 10
+ TAD ORCNO
+ DCA I [OUREC
+ TAD OUPAGE
+ JMP I .+1
+ SRCOPT /GO SET UP OPTION SWITCHES AND COMPARE
+\fOCLOSE, CIF 10
+ JMS I [7700
+ 10 /GET USR INTO CORE
+ CDF CIF 10
+ TAD I [7600 /GET OUTPUT DEVICE NUMBER
+ CDF 0
+ JMS I [200
+ 4 /CLOSE OUTPUT FILE
+PFILNM, OFILNM
+OCOUNT, 0 /COUNT OF BLOCKS WRITTEN
+ JMP OUERR1 /ERROR ON CLOSE
+SRCATS, ISZ NOCHN /IN CASE WE LOOP, CLEAR "CHAINED TO" FLAG
+ CDF 10
+ TAD I [MPARAM-1 /GET ALTMODE FLAG
+ CDF 0
+ SPA CLA
+ JMP I [7605 /GO AWAY IF ALTMODE
+ JMP SRCCD /GO BACK FOR MORE
+
+NOCHN, 0
+
+INERR1, RDF
+ CLL RTR
+ RAR
+ TAD [-4
+OUERR1, TAD [4005
+NOROOM, TAD [260
+ DCA SETUP
+ TAD [277
+ JMS TYPE /OUTPUT "?N" WHERE N IS THE ERROR NUMBER
+ TAD SETUP
+ JMS TYPE
+ TAD [215
+ JMS TYPE
+ TAD [212
+ JMS TYPE
+ TAD SETUP
+ SPA CLA /IS THE USR IN CORE?
+ JMP SRCATS /YES - DON'T LOAD IT
+ CIF 10
+ JMS I [7700 /NO - LOAD IT
+ 10
+ JMP SRCATS
+
+TYPE, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TYPE
+\f/ PAGE 0 LITERALS
+ FIELD 1
+\f /PAGE 0 FOR SRCCOM
+
+ *0
+T1, 0
+T2, 0
+T, 0
+CT, 0
+
+ XR1=11
+ XR2=12
+
+ *20
+
+/*************** SRCCOM SWITCHES ***************
+
+CSW, 0 /"C" SWITCH - ON=-257, MEANING IGNORE COMMENTS
+ / OFF=+521, MEANING COMPARE COMMENTS
+SSW, 0 /"S" SWITCH - ON=-240, MEANING IGNORE SPACES & TABS
+ / OFF=-200, MEANING COMPARE SPACES&TABS
+TSW, 0 /"T" SWITCH - ON=20 , MEANING CONVERT TABS ON OUTPUT
+ / OFF=0 , MEANING PRINT TABS ON OUTPUT
+XSW, 0 /"X" SWITCH - ON=1 , MEANING DON'T INPUT COMMENTS
+ / OFF=0 , MEANING INPUT COMMENTS INTO CORE
+ALLSW, 0 /"B" SWITCH - ON=2000, MEANING COMPARE BLANK LINES
+ / OFF=0 , MEANING IGNORE BLANK LINES
+NUMLIN, 0 /NUMERICAL ARGUMENT - NUMBER OF LINES CONSTITUTING
+ /A MATCH - SET TO -3 IF NO NUMERICAL ARGUMENT
+
+MLIMIT, 0
+GETCNT, 0
+GETFIL, 0
+CHAR, 0
+IPTR, 0
+NUMTMP, 0
+PLNCNT, 0
+PNTPGN, 0
+OUHNDL, 0 /THESE 5 WORDS ARE USED BY OUTPUT ROUTINE
+OUCHCT, 0
+OUPTR, 0
+OUXPTR, 0
+OUTEMP, 0
+TABCT, 0
+DIFFS, 0 /DIFFERENCES FOUND FLAG
+
+CTCCHK, 0
+ TAD [200
+ KRS /GET A CHAR FROM THE TELETYPE
+ TAD [-203 /CHECK FOR EITHER PARITY ^C
+ SNA CLA
+ KSF /WITH THE KEYBOARD FLAG UP
+ JMP I CTCCHK /NOPE
+ CDF CIF 0 /YUP - RETURN TO OS/8
+ JMP I [7600
+\f PAGE
+
+SETONE, 0 /ROUTINE TO FIND WHERE A LINE IS
+ TAD I [CURLIN /GET LINE NUMBER
+ DCA TLNNUM /SAVE IT AWAY
+ TAD I [OLDPTR /GET THE POINTER TO THE LATEST LINE
+SETOPT, DCA T /SAVE THE STARTING POINTER
+ TAD TLNNUM /GET THE TARGET LINE
+ CMA CLL
+ TAD I [OLDLIN /IS IT BEFORE OR AFTER THE LATEST LINE?
+ SZL
+ JMP SETRST /BEFORE - WE MUST START SEARCHING FROM LINE 1
+ DCA CT /AFTER - START SEARCHING FROM LATEST LINE
+TLOOP, ISZ CT
+ JMP KEEPON /NOT THERE YET
+ TAD TLNNUM /WE FOUND IT - MAKE THIS LINE
+ DCA I [OLDLIN /THE NEW "LATEST LINE"
+ TAD T /TO SPEED UP
+ DCA I [OLDPTR /FUTURE SEARCHES.
+ CLA CMA
+ TAD T
+ JMP I SETONE /RETURN POINTER FOR AUTO-XR
+KEEPON, TAD I T
+ TAD T /ADD LENGTH OF THIS LINE TO POINTER
+ DCA T /TO GET POINTER TO NEXT LINE
+ JMP TLOOP
+TLNNUM, 0 /TEMPORARY FOR SETONE - DO NOT USE ANYWHERE ELSE
+
+SETRST, CLA IAC /RESET THE "LATEST LINE" POINTERS TO THE FIRST
+ DCA I [OLDLIN /LINE, SINCE THE LINE WE SEEK IS BEFORE
+ TAD [LNBEG /THE CURRENT "LATEST LINE"
+ JMP SETOPT /GO BACK AND FIND THE LINE
+\fMOVEUP, 0 /SUBR TO DELETE LINES FROM CORE
+ TAD I [CURLIN /GET FIRST LINE NOT TO BE DELETED
+ CIA
+ TAD I [TOPLIN
+ DCA I [TOPLIN /REDUCE THE NUMBER OF LINES IN THE BUFFER
+ TAD I [TOPLIN /GET NEW LINE COUNT
+ SNA /IF ALL LINES DELETED, DON'T MOVE CORE
+ JMP MOVXIT /JUST CLEAN UP AND GET OUT
+ IAC
+ JMS SETONE /GET POINTER TO LAST LINE+1
+ CIA
+ DCA MLIMIT /SAVE AS LIMIT ON MOVE
+ IAC
+ JMS SETONE /GET POINTER TO THE FIRST LINE NOT TO DELETE
+ DCA XR1
+ TAD [LNBEG-1
+ DCA XR2
+MLOOP, TAD I XR1
+ DCA I XR2 /AREN'T AUTO-XRS WONDERFUL
+ TAD XR1
+ TAD MLIMIT /(ACTUALLY, NO)
+ SZA CLA
+ JMP MLOOP
+MOVXIT, CLA IAC /AFTER MOVING CORE AROUND, WE MUST
+ DCA I [OLDLIN /RESET THE "LATEST LINE" POINTERS TO THE FIRST
+ TAD [LNBEG /LINE SINCE IT IS THE ONLY ONE WHICH
+ DCA I [OLDPTR /HAS A KNOWN POSITION.
+ JMP I MOVEUP
+\fCOMPL, 0 /SUBROUTINE TO COMPARE TWO LINES
+ CDF F1
+ JMS SETONE /GET POINTER TO CURRENT LINE IN FILE 1
+ TAD [2 /SKIP OVER PROLOGUE
+ DCA XR1
+ CDF F2
+ JMS SETONE /GET POINTER TO CURRENT LINE IN FILE 2
+ TAD [2 /SKIP OVER PROLOGUE
+ DCA XR2
+COMP1, CDF F1
+ TAD I XR1 /GET A CHAR FROM FILE 1
+ DCA T1
+COMP2, CDF F2
+ TAD I XR2
+ DCA T2 /AND A CHAR FROM FILE 2
+COMP0, TAD T2
+ CIA
+ TAD T1
+ SZA CLA /ARE THEY EQUAL?
+ JMP COMP4 /NO
+COMP5, TAD T1
+ SZA
+ TAD CSW /IF AT END OF LINE, OR IF AT A "/"
+ SZA CLA /AND "IGNORE COMMENTS" SWITCH ON,
+ JMP COMP1
+ JMP I COMPL /TAKE "LINES MATCH" RETURN
+
+COMP3, CDF F1
+ TAD I XR1 /GET THE NEXT CHAR FROM FILE 1
+ DCA T1
+COMP4, TAD T1
+ TAD SSW /IF T1 IS A BLANK OR A TAB
+ SZA
+ TAD [27 /(27=BLANK-TAB)
+ SNA CLA /AND WE ARE IGNORING BLANKS,
+ JMP COMP3 /THEN IGNORE T1
+ TAD T2
+ TAD SSW /DO THE SAME WITH T2
+ SZA
+ TAD [27
+ SNA CLA
+ JMP COMP2
+ TAD T1
+ CIA
+ TAD T2 /NOW THAT WE HAVE (MAYBE) ELIMINATED BLANKS
+ SNA CLA /ARE T1 AND T2 STILL UNEQUAL?
+ JMP COMP5 /NO - THERE'S STILL HOPE
+ TAD T1 /YES - NOW TEST COMMENT SWITCH
+ CMA
+ AND T2
+ TAD CSW /IF T1 IS A CARRIAGE RETURN AND T2 IS A "/"
+ SNA CLA /WITH THE COMMENT SWITCH ON WE'VE SUCEEDED
+ JMP I COMPL /SO TAKE "LINES MATCH" RETURN
+ TAD T2
+ CMA
+ AND T1 /SAME IF T2=CARRIAGE RETURN AND T1="/"
+ TAD CSW
+ SZA CLA
+ ISZ COMPL /OTHERWISE TAKE "LINES DON'T MATCH" RETURN
+ JMP I COMPL
+
+GETTWO, 0 /SUBROUTINE TO GET A LINE FROM EACH FILE
+ CLA CLL CMA RTL
+ DCA GETCNT
+ DCA GETFIL /ZERO INDICATOR AS TO WHICH FILE IS NULL
+ CDF F1
+ JMS I [GLINE /GET A LINE FROM FILE 1
+ CDF F2
+ JMS I [GLINE /DITTO FILE 2
+ ISZ GETCNT /HOW MANY LINES DID WE GET?
+ JMP I GETTWO /LESS THAN TWO - TAKE EOF RETURN
+ ISZ GETTWO
+ JMP I GETTWO /TAKE NORMAL RETURN
+
+ PAGE
+\fGLINE, 0 /SUBROUTINE TO GET A LINE FROM A FILE
+ TAD I [CURLIN
+ CIA
+ TAD I [TOPLIN
+ SZA CLA /IS THE LINE IN CORE?
+ JMP GLEXIT /YES
+ CLA IAC
+ JMS I [SETONE /GET POINTER TO THIS LINE
+ DCA XR1
+ CLA CLL CML RTL
+ DCA I XR1 /SET WORD COUNT TO 2
+ TAD XR1
+ DCA T /SAVE POINTER TO LENGTH WORD
+ JMS CTCCHK /CHECK FOR ^C TYPED
+ ISZ XR1
+GLINE2, JMS GCHAR /MAIN LOOP - GET A CHARACTER
+ JMS I [TSTXSW /SEE WHETHER WE SHOULD INPUT COMMENTS
+ CLA CLL CMA RAL
+ TAD CHAR
+ TAD ALLSW /IF THE CHAR IS A CARRIAGE RETURN AND THE
+ TAD I T /"B" SWITCH IS OFF AND THE LINE COUNT IS 2,
+ SNA CLA /THEN WE SHOULD IGNORE THIS BLANK LINE.
+ JMP GLINE2
+ TAD CHAR
+ DCA I XR1 /SALT IT AWAY
+ TAD XR1
+ CLL
+ TAD [4-BUFLIM /COMPARE AGAINST END OF BUFFER
+ SNL CLA
+ JMP .+3
+ CDF CIF 0 /LINE OVERFLOWS CORE - BAD!
+ JMP I [NOROOM /TELL THE WORLD
+ ISZ I T /BUMP COUNTER OF WORDS IN LINE
+ TAD CHAR
+ SZA CLA /WAS IT A CARRIAGE RETURN?
+ JMP GLINE2 /NO
+ ISZ I [TOPLIN /YES - BUMP COUNT OF LINES IN CORE
+ ISZ T
+ TAD I [PGNUM
+ DCA I T
+GLEXIT, ISZ GETCNT /BUMP COUNTER OF # OF LINES GOTTEN
+ RDF
+ TAD [6201
+ DCA GETFIL /INDICATE THAT THIS FILE WAS NOT NULL
+ ISZ I [CURLIN /BUMP CURRENT LINE POINTER
+ JMP I GLINE
+\fGCHAR, 0 /SUBROUTINE TO GET A CHAR FROM A FILE
+ TAD I [INPTR
+ DCA IPTR /SAVE POINTER TO CURRENT BUFFER WORD
+ ISZ I [INCHCT /BUMP CHAR COUNTER
+ JMP GETIN
+ TAD I [INEOF /END OF BUFFER
+ SZA CLA /END OF FILE??
+ JMP GEOF+1 /YES
+ CLA CLL CML RTL
+ TAD I [INRCNT /BUMP COUNT OF REMAINING RECORDS BY 2
+ SZL /OVERFLOW?
+ ISZ I [INEOF /YES - SET END OF FILE FLAG
+ SNL
+ DCA I [INRCNT /RESTORE COUNTER IF NO OVERFLOW
+ CLL CMA CML RTL
+ RTL
+ RTL
+ TAD [401 /COMPUTE INPUT CONTROL WORD
+ RDF
+ DCA I [INCHCT
+ TAD [INBUF
+ DCA I [INPTR /PUT BUFFER ADDRESS INTO CALLING SEQUENCE
+ RDF
+ TAD [6203
+ DCA .+1
+ NOP /SET INSTRUCTION FIELD TO DATA FIELD
+ JMS I [INTEMP /CALL SUBR TO READ IN BUFFER
+ JMP .+4 /NO ERROR
+ SPA CLA /FATAL ERROR?
+ JMP I [INERR /YES
+ ISZ I [INEOF /NO - SET END OF FILE FLAG
+ ISZ I [INREC
+ ISZ I [INREC /BUMP RECORD NUMBER BY 2
+ TAD [10
+ DCA I [INTEMP /INITIALIZE SHIFT REGISTER
+ TAD I [INCHCT
+ CLL RAL
+ TAD I [INCHCT
+ AND [7600
+ CMA
+ DCA I [INCHCT /COMPUTE CHAR COUNT FROM BUFFER CONTROL WD
+ JMP GCHAR+1 /START ALL OVER WITH NEW BUFFER
+\fGETIN, TAD I [INTEMP
+ SPA /IF WE HAVE A CHAR IN THE SHIFT BUFFER
+ DCA I IPTR /WRITE OVER THE CURRENT BUFFER WORD WITH IT
+ DCA I [INTEMP /AND ZERO THE SHIFT BUFFER
+ TAD I IPTR /GET THE CURRENT BUFFER WORD
+ AND [7400
+ CLL RAL
+ TAD I [INTEMP
+ RTL /SHIFT THE HIGH ORDER 4 BITS
+ RTL /INTO THE SHIFT BUFFER
+ SMA /DID WE GET A COMPLETE CHARACTER?
+ ISZ I [INPTR /NO - BUMP WORD POINTER
+ DCA I [INTEMP
+ TAD I IPTR
+ AND [177 /USE LOW ORDER 7 BITS OF THE CURRENT WORD
+ SZA /AS THE CHARACTER
+ TAD [-177 /IGNORING BLANK TAPE, RUBOUTS, LINE-FEEDS
+ SZA /AND VERT. TABS
+ TAD [177-13
+ SZA
+ IAC
+ SNA
+ JMP GCHAR+1
+ TAD [12-14
+ SNA
+ JMP FFEED /FORM FEED IS SPECIAL
+ TAD [14-32
+ SNA
+ JMP GEOF /^Z SIGNIFIES END-OF-FILE
+ TAD [32-15
+ SZA
+ TAD [215 /AND CARRIAGE RETURN IS MAPPED INTO 0
+ DCA CHAR
+ JMP I GCHAR
+
+FFEED, ISZ I [PGNUM /BUMP THE PROPER PAGE COUNT ON A FORM FEED
+ JMP GCHAR+1 /BUT OTHERWISE IGNORE IT
+
+GEOF, ISZ I [INEOF /SET END-OF-FILE FLAG
+ CLA CMA
+ DCA I [INCHCT /FORCE AN EMPTY BUFFER
+ JMP I GLINE /RETURN FROM GLINE WITHOUT SETTING GETFIL
+
+ PAGE
+\f/ INITIALIZATION
+STARTC, JMS I [OUSETP /INITIALIZE OUTPUT BUFFER POINTERS
+ CLA IAC
+ DCA PNTPGN /FUDGE PNTPGN WHILE PRINTING HEADER LINES
+ TAD [HEDING-1
+ JMS I [PNTHDG /PRINT SRCCOM HEADING LINE
+ JMS I [GETTWO /GET TITLE LINES
+ JMP FINISH /ONE FILE IS EMPTY - ABORT COMPARISON
+ CDF F1
+ JMS I [PNTTXT /PRINT FILE 1 HEADER
+ CDF F2
+ JMS I [PNTTXT /AND FILE 2 HEADER
+ DCA PNTPGN /INITIALIZE PAGE NUMBER
+ STA
+ DCA DIFFS /INITIALIZE FLAG TO NO DIFFERENCES
+
+/ MAIN LOOP
+
+MAIN, CDF F1
+ JMS I [MOVEUP
+ CDF F2
+ JMS I [MOVEUP /DELETE ANY USELESS LINES
+MAINST, CDF F1
+ DCA I [CURLIN
+ CDF F2
+ DCA I [CURLIN
+ JMS I [GETTWO /GET TWO INPUT LINES
+ JMP MAIN15 /ONE FILE IS EMPTY
+ JMS I [COMPL /COMPARE THE LINES
+ JMP MAIN /EQUAL - DELETE AND CONTINUE
+ DCA DIFFS /UNEQUAL - CLEAR "NO DIFFERENCES" FLAG
+
+MAIN10, JMS I [GETTWO /GET TWO MORE LINES
+ JMP MAIN15 /ONE FILE RAN OUT
+ CDF F1
+ DCA I [CURLIN /INITIALIZE FILE 1 LINE NO.
+MAIN12, ISZ I [CURLIN /BUMP TO NEXT LINE IN FILE 1
+ JMS I [COMPL /COMPARE NEW LINE FROM FILE 2
+ JMS MULTI /WITH THIS LINE FROM FILE 1
+ CDF F2 /AND IF MATCH IS FOUND CHECK MULTIPLE LINES
+ TAD I [CURLIN
+ CIA
+ CDF F1
+ TAD I [CURLIN
+ SZA CLA /THROUGH WITH FILE 1 LINES?
+ JMP MAIN12 /NO
+ CDF F2
+ CLA IAC
+ DCA I [CURLIN /NOW INITIALIZE FILE 2 LINE NO.
+MAIN14, TAD I [CURLIN
+ CIA
+ CDF F1
+ TAD I [CURLIN
+ SNA CLA /HAVE WE EXHAUSTED FILE 2 LINES?
+ JMP MAIN10 /YES - NO MATCH AT ALL
+ JMS I [COMPL /NO - COMPARE ALL FILE 2 LINES
+ JMS MULTI /AGAINST NEW FILE 1 LINE
+ CDF F2 /AND, IF MATCH, CHECK MULTIPLE LINES
+ ISZ I [CURLIN /GO TO NEXT FILE 2 LINE
+ JMP MAIN14 /AND LOOP
+
+MAIN15, TAD GETFIL
+ SNA /FIND WHICH FILE WAS EMPTY
+ JMP FINISH /BOTH - ALL DONE
+ DCA MAIN18
+ CDF F1
+ TAD I [CURLIN
+ CDF F2
+ SZA CLA
+ TAD I [CURLIN
+ SNA CLA /IS EITHER FILE EXHAUSTED IN CORE?
+ JMP MAIN18 /YES - PRINT ALL OF OTHER FILE
+ TAD MAIN18 /GET CDF OF LONG FILE
+ CIA
+ TAD [4402+F1+F2 /COMPUTE CDF OF SHORT FILE
+ DCA MAIN17
+MAIN17, NOP
+ TAD I [CURLIN
+ CMA CLL
+ TAD I [TOPLIN
+ SNL CLA /IS CURLIN < TOPLIN?
+ JMP MAIN10 /NO - WE STILL HAVE SOME COMPARING TO DO
+ ISZ I [CURLIN
+ JMS I [COMPL
+ JMS MULTI
+ JMP MAIN17
+
+MAIN18, NOP /SET DF TO DATA FIELD OF LONG FILE
+ JMS I [PNTTXT /PRINT IT
+ JMP MAIN
+
+FINISH, CDF F1
+ TAD I [CURLIN
+ CDF F2
+ TAD I [CURLIN
+ SZA CLA /ARE BOTH CORE BUFFERS EMPTY?
+ JMS I [PNTBTH /NO - PRINT THEM
+ JMP I [EOCOMP
+\f/ MULTI-LINE COMPARATOR
+MULTI, 0
+ CDF F1
+ TAD I [CURLIN
+ DCA I [TMPLIN
+ CDF F2
+ TAD I [CURLIN
+ DCA I [TMPLIN /STORE CURLIN AWAY IN A TEMPORARY
+ TAD NUMLIN
+ DCA NUMTMP /GET COUNT OF LINES TO COMPARE
+ JMP MULT6
+
+MULT2, JMS I [GETTWO /GET TWO LINES
+ JMP MULT4 /ONE FILE HAS NO MORE
+ JMS I [COMPL /COMPARE THEM
+ JMP MULT6 /THEY COMPARE - KEEP GOING
+MULT4, JMS SWAPCT /RESET OLD CURLIN
+ JMP I MULTI
+MULT6, ISZ NUMTMP /LINE COUNT EXHAUSTED?
+ JMP MULT2 /NO - KEEP COMPARING
+ JMS SWAPCT /RESTORE OLD CURLIN
+ JMS I [PNTBTH /PRINT OUT DIFFERENCES
+ TAD [-10
+ JMS I [PNTAST /PRINT OUT SEPARATOR
+ JMS SWAPCT /RE-SWAP FOR DELETION
+ JMP MAIN /DELETE THRU MATCHING LINES AND CONTINUE
+
+SWAPCT, 0
+ CDF F1
+ JMS SWAPX /SWAP CURLIN AND TMPLIN FOR FILE 1
+ CDF F2
+ JMS SWAPX /DITTO FOR FILE 2
+ JMP I SWAPCT
+SWAPX, 0
+ TAD I [CURLIN
+ DCA NUMTMP
+ TAD I [TMPLIN
+ DCA I [CURLIN
+ TAD NUMTMP
+ DCA I [TMPLIN
+ JMP I SWAPX
+
+ PAGE
+\fPNTBTH, 0 /PRINT BOTH TEXT BUFFERS
+ TAD [212
+ JMS I [OCHAR /SEPARATOR
+ CDF F1
+ JMS PNTTXT /PRINT FILE 1 BUFFER
+ TAD [-4
+ JMS PNTAST /PRINT SEPARATOR
+ CDF F2
+ JMS PNTTXT /PRINT FILE 2 BUFFER
+ TAD [212
+ JMS I [OCHAR /SEPARATOR
+ JMP I PNTBTH
+
+PNTTXT, 0 /PRINT A TEXT BUFFER
+ TAD I [CURLIN
+ CIA
+ DCA PLNCNT /GET # OF LINES TO PRINT
+PNTLP, DCA TABCT /ZERO TAB COUNTER (IN CASE "T" SW ON)
+ RDF
+ CLL RTR
+ RAR /GET FILE NUMBER
+ TAD [261 /260 FOR 12K VERSION
+ JMS I [OCHAR
+ TAD [251
+ JMS I [OCHAR /PRINT RPAR
+ TAD PLNCNT
+ IAC
+ JMS I [SETONE /GET POINTER TO LINE
+ IAC
+ DCA XR1
+ TAD I XR1 /GET THE PAGE NUMBER OF THE LINE
+ DCA T
+ TAD T
+ CIA
+ TAD PNTPGN
+ SNA CLA /DID THE PAGE NUMBER JUST CHANGE?
+ JMP PNTTAB /NO - DON'T PRINT IT
+ TAD TENTAD
+ DCA PNTTAD
+ TAD T
+ DCA PNTPGN /UPDATE THE CURRENT PAGE NUMBER
+ CLA CLL CMA RTL
+ DCA CT /PRINT 3 DECIMAL DIGITS
+DIGLP1, DCA T1
+ JMP .+3
+DIGLP2, DCA T
+ ISZ T1
+ TAD T
+PNTTAD, HLT /ADD IN A POWER OF 10
+ SMA
+ JMP DIGLP2 /KEEP GOING
+PN7200, CLA
+ ISZ PNTTAD /GOT A DIGIT - GO TO NEXT POWER OF 10
+ TAD T1
+ TAD [260
+ JMS I [OCHAR /PRINT DIGIT
+ ISZ CT /THROUGH?
+ JMP DIGLP1 /NO
+PNTTAB, TAD TSW
+ SNA CLA /SHOULD WE SIMULATE TABS?
+ JMP PNTCHR /NO
+ TAD [240 /YES - PRINT A BLANK
+ JMS I [OCHAR
+ TAD TABCT
+ AND [7
+ SZA CLA /KEEP PRINTING BLANKS UNTIL WE REACH A MULTIPLE OF
+ JMP PNTTAB /EIGHT COLUMNS.
+PNTCLP, TAD I XR1 /GET A CHARACTER FROM THE LINE
+ SNA /END?
+ JMP PNTCR /YES
+ TAD [-211
+ SNA /IS IT A TAB?
+ JMP PNTTAB /YES
+PNTCHR, TAD [211 /NO - RESTORE THE CHAR
+ JMS I [OCHAR
+ JMP PNTCLP /PRINT IT AND LOOP
+PNTCR, TAD [215 /PRINT CRLF
+ JMS I [OCHAR
+ TAD [212
+ JMS I [OCHAR
+ ISZ PLNCNT
+ JMP PNTLP /LOOP FOR EACH LINE IN BUFFER
+ JMP I PNTTXT
+\fPNTAST, 0 /ROUTINE TO PRINT ASTERISKS
+ DCA CT /SAVE COUNTER
+ TAD ["*
+ JMS I [OCHAR
+ ISZ CT
+ JMP .-3 /PRINT REQUIRED NUMBER OF ASTERISKS
+ TAD [215
+ JMS I [OCHAR /TERMINATE THE LINE
+ TAD [212
+ JMS I [OCHAR
+ DCA PNTPGN /KILL CURR. PAGE NUMBER
+ JMP I PNTAST
+
+EOCOMP, ISZ DIFFS /ANY DIFFERENCES?
+ JMP .+4 /YES
+ CDF 0 /MESSAGE IN FIELD 0
+ TAD [NODFMS-1
+ JMS I [PNTHDG /NO - PRINT MESSAGE
+ TAD PN7200 /ROUTINE TO FINISH UP OUTPUT
+ DCA CT
+ TAD [214
+ JMS I [OCHAR /TERMINATE THE OUTPUT FILE
+ TAD [232 /WITH A FORM FEED AND A ^Z
+ JMS I [OCHAR
+ ISZ CT
+ JMP .-2 /FILL WITH ZEROS TO FORCE BUFFER OUT
+ CDF CIF 0
+ JMP I .+1 /GO TO FIELD 0 TO FINISH UP AS WE WILL BE
+ OCLOSE /OVERLAYED BY THE USR DURING THE CLOSE
+
+TENTAD, TAD .+1 /TABLE OF POWERS OF TEN
+ -144
+ -12
+ -1
+
+INERR, RDF /INPUT ERROR - ERROR NUMBER=FILE NUMBER
+ CLL RTR
+ RAR
+ IFZERO CORE-2 <IAC>
+ IFZERO CORE-4 <TAD [-1>
+ CDF CIF 0
+ JMP I [NOROOM /GO TO COMMON ERROR ROUTINE
+
+PNTHDG, 0 /ROUTINE TO PRINT A LITERAL LINE
+ DCA XR1 /POINTER TO LINE IN AC
+ TAD PNTHDG
+ DCA PNTTXT /WE WORK BY FAKING OUT PNTTXT
+ STA
+ DCA PLNCNT /SET LINE COUNTER TO 1
+ JMP PNTCLP
+
+ PAGE
+\fOCHAR, 0 /LOW LEVEL OUTPUT ROUTINE
+ AND [377
+ DCA OUTEMP
+ ISZ TABCT /BUMP TAB COUNTER
+ RDF
+ TAD [6201
+ DCA OCDF
+ CDF 10
+ TAD OUCHCT /GET CHAR COUNTER - CHAR COUNTER COUNTS
+ RTR /FOUR TIMES FOR EACH THREE CHARACTERS.
+ CML /WHEN THE LOW ORDER BITS OF THE COUNT ARE 10,
+ SZL SPA CLA /ITS TIME TO SQUEEZE A CHAR INTO THE HIGH
+ JMP OUNORM /ORDER BITS - OTHERWISE JUST STORE IT
+ ISZ OUCHCT /WE MUST SQUEEZE - BUMP OUCHCT AN EXTRA
+ TAD OUTEMP /TIME
+ RTL
+ RTL
+ AND [7400
+ TAD I OUXPTR /FIRST WORD OF DOUBLET
+ DCA I OUXPTR
+ TAD OUTEMP
+ RTR
+ RTR
+ RAR
+ AND [7400
+ TAD I OUPTR /SECOND WORD OF DOUBLET
+ JMP OUCOMN
+
+OUNORM, TAD OUPTR
+ DCA OUXPTR /REMEMBER LAST WORD
+ ISZ OUPTR
+ TAD OUTEMP
+OUCOMN, DCA I OUPTR
+ ISZ OUCHCT /BUMP CHAR COUNT
+ JMP OCDF /RETURN
+ CIF 0 /CHAR COUNT OVFLO - OUTPUT BUFFER
+ JMS I OUHNDL
+ 4210
+ 1400
+OUREC, 0
+ JMP OUERR2
+ JMS OUSETP /INITIALIZE FOR NEXT BUFFER
+ ISZ OUREC /BUMP RECORD NUMBER
+ CDF 0
+ ISZ I [OCOUNT /BUMP CLOSING COUNT
+ ISZ I [OLEN /AND LENGTH OF HOLE
+ JMP OCDF
+OUERR2, CLL CML RTL /OUTPUT ERROR OR FILE TOO BIG - GENERATE
+ IAC /A 3 OR A 4 MESSAGE, RESPECTIVELY
+ CDF CIF 0
+ JMP I [NOROOM
+OCDF, HLT /RESTORE DATA FIELD
+ JMP I OCHAR /RETURN
+\fOUSETP, 0
+ TAD [7000 /4 COUNTS FOR 2 WORDS
+ DCA OUCHCT
+ TAD [1377
+ DCA OUPTR
+ JMP I OUSETP
+
+TSTXSW, 0 /SUBROUTINE TO IGNORE COMMENTS ON INPUT
+ TAD CHAR /IF "X" SWITCH SET
+ TAD [-257
+ SNA CLA
+ TAD XSW /IF XSW IS OFF OR THE CURRENT CHAR ISN'T A /
+ SNA CLA
+ JMP I TSTXSW /RETURN
+ JMS I [GCHAR
+ TAD CHAR /SKIP CHARACTERS UNTIL CARRIAGE RETURN
+ SZA CLA
+ JMP .-3
+TSTXLP, CLA CLL CMA RAL
+ TAD I T
+ SNA CLA /ARE WE AT THE BEGINNING OF A LINE?
+ JMP I TSTXSW /YES - GLINE WILL DELETE IT IF NECESSARY
+ TAD XR1
+ DCA TX
+ TAD I TX
+ TAD [-240
+ SZA /IS THE PREVIOUS CHARACTER A SPACE
+ TAD [240-211
+ SZA CLA /OR A TAB?
+ JMP I TSTXSW /NO
+ CMA
+ TAD XR1
+ DCA XR1 /BACK UP CHAR PTR
+ CMA
+ TAD I T
+ DCA I T /AND CHAR CTR
+ JMP TSTXLP /LOOP
+TX, 0
+\fSRCOPT, DCA OUHNDL
+ TAD I [MPARAM
+ CMA
+ AND [1000 /"C" OPTION
+ TAD [-257
+ DCA CSW
+ CLA CLL CML RTR
+ AND I [MPARAM
+ DCA ALLSW /"B" OPTION
+ TAD I [MPARAM+1
+ CMA
+ AND [40 /"S" OPTION
+ TAD [-240
+ DCA SSW
+ TAD I [MPARAM+1
+ AND [20 /"T" OPTION
+ DCA TSW
+ CLA IAC
+ AND I [MPARAM+1
+ DCA XSW /"X" OPTION
+ TAD I [MPARAM+3
+ CIA /GET NEGATIVE OF NUMERICAL ARGUMENT
+ SNA
+ CLA CLL CMA RTL /DEFAULT VALUE IS 3
+ DCA NUMLIN /TO NUMBER OF LINES NECESSARY FOR A MATCH
+ JMP I .+1
+ STARTC
+
+HEDING, "S;"R;"C;"C;"O;"M;" ;"V;VERSION+"0;PATCH;212;0
+\f/PAGE 0 LITERALS FOR FIELD 1
+ $-$-$ /END OF ASSEMBLY OF SRCCOM
+\f
--- /dev/null
+/4 TD8E HANDLER FOR BUILD..TD8E-A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -2
+DEVICE TD8A;DEVICE DTA0;4210;4010;ZBLOCK 2
+DEVICE TD8A;DEVICE DTA1;4210;4014;ZBLOCK 2
+
+ SDSS=6771 /SKIP ON SINGLE LINE FLAG
+ SDST=6772 /SKIP ON TIME ERROR
+ SDSQ=6773 /SKIP ON QUAD LINE FLAG
+ SDLC=6774 /LOAD TAPE COMMAND REGISTER
+ SDLD=6775 /LOAD DATA REGISTER
+ SDRC=6776 /READ COMMAND REGISTER
+ SDRD=6777 /READ DATA REGISTER
+
+ TDVERSION="D&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. PARITY ^C IS NOW LEGAL
+/3. ^C CHECK NO LONGER WILL ADVANCE READER
+
+/MAINTENANCE RELEASE CHANGES:
+
+/4. FIXED ^C BUG
+/5. MADE CODE IMPROVEMENTS
+/6. FIXED RETRY BUG
+
+
+ *200
+
+NXINIT, 7600 /CLEAR AC HERE!!!
+ JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART
+BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT
+ JMP JINIT
+
+BUFF, 0
+PGCT, 0
+FUNCT, 0
+C1000, 1000
+
+DTA0, TDVERSION /ENTRY FOR UNIT 0
+ CLA CLL
+ JMP DTA1X
+UNIT, 0 /FILLER WORD
+DTA1, TDVERSION /ENTRY FOR UNIT 1
+ CLA CLL CML
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /UNIT # FROM LINK
+ RDF
+ TAD C6203
+ DCA LEAVE /SET UP EXIT FROM HANDLER
+ TAD I DTA0
+ DCA FUNCT /SAVE FUNCTION WORD
+ TAD FUNCT
+ CLL RAL
+C200, AND CM200 /GET A PAGE COUNT
+ DCA PGCT
+ TAD FUNCT
+C374, AND C70 /ISOLATE FIELD OF TRANSFER
+ TAD C6203
+ DCA XFIELD
+ ISZ DTA0 /POINT TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /POINT TO RECORD
+ TAD I DTA0
+ CLL RAL /CONVERT TO DECTAPE BLOCKS
+ DCA TBLOCK
+ ISZ DTA0 /POINT TO ERROR RET.
+C6203, CIF CDF 0
+\f
+JINIT, JMP INIT /FIRST TIME THRU IT GETS EXECUTED
+ /THE RETURN FROM INIT ZEROES IT
+ CLA CLL CMA RTL
+ DCA ERCNT /3 ERROR TRIES
+ TAD UNIT
+ DCA I CXUNIT
+ JMS I CSELCT /CHECK FOR SELEC ERROR
+ JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR
+ TAD FUNCT
+ CLL RAR
+ JMP GO /OK.. START THE SEARCH
+TRWCOM, SDST /TIME OR CHECK SUM ERROR?
+ SZA CLA
+ JMP TRY3 /YES TRY UP TO 3 TIMES
+ TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED?
+ TAD CM200
+ SNA
+ JMP EXIT /YES.. DONE THIS TRANSFER
+ DCA PGCT /NEW PAGE COUNT
+ ISZ TBLOCK
+ TAD BUFF
+ TAD C200 /GET NEW BUFFER ADDRESS
+ DCA BUFF
+ CLL CML /FORCE FORWARD MOTION
+GO, CLA CML RTR /PUT IN DIRECTION BIT
+ TAD C1000
+ TAD UNIT
+ SDLC /INITIATE THE MOTION
+ JMS I CRDQAD /WAIT FOR 8 LINES TO PASS
+ JMS I CRDQAD
+M20, 7760 /DON'T CARE IF IT DOES SKIP!!!
+TSRCH, SDSS /WAIT\ f FOR BLOCK MARK OR END ZONE
+ JMP .-1
+ SDRC
+ CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9
+ AND C374 /ISOLATE M.T BITS
+ TAD M110 /IS IT END ZONE?
+ SNA
+ JMP ENDZ /YES..DO SOMETHING REASONABLE
+ TAD M20 /HOW ABOUT BLOCK MARK?
+ SZA CLA
+ JMP TSRCH /NEITHER..KEEP LOOKING
+ SDRD /WHAT IS THIS BLOCK'S #?
+ SZL /IF IN REVERSE, LOOK FOR 3 BEFORE
+ TAD TC3 /THE ACTUAL TARGET BLOCK
+ CMA
+ TAD TBLOCK
+ CMA
+ SNA /IS THIS THE BLOCK?
+ JMP TFOUND /YES..HAVE CORRECT ONE
+M110, SZL SNA CLA /ARE WE HEADED PROPERLY?
+ JMP TSRCH /YES.. KEEP LOOKING
+ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE
+ CLL RTL
+ JMP GO /EXECUTE TURN AROUND AND SEARCH
+\fTRY3, CLA CLL /V3C
+ ISZ ERCNT /TRIED 3 TIMES?
+ JMP GO
+ JMP FATAL
+EXIT, ISZ DTA0 /NORMAL RETURN
+ CLL CML
+FATAL, TAD UNIT /STOP TAPE FIRST
+ SDLC
+ CLA CML RAR /EITHER 0 OR 4000 IN AC
+LEAVE, HLT /GETS CIF CDF N
+ JMP I DTA0
+
+INIT, JMS . /FIND OUT WHERE WE GOT LOADED
+BASE, TAD CRDQAD
+ SPA /NEGATIVE ENDS LIST
+ JMP NXINIT
+ TAD INIT
+ DCA CRDQAD
+ ISZ .-1
+ ISZ BASE
+ JMP BASE
+
+CRDQAD, R4LINE-BASE
+CINIT2, INIT2-BASE
+CSELCT, SELECT-BASE
+CXUNIT, XUNIT-BASE
+
+ *367
+TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION
+ JMP GO /NOT YET
+ TAD FUNCT
+ CLL RAL /R/W TO LINK
+ CLA
+C70, 70
+TC3, 3
+ TAD BUFF
+XFIELD, HLT /CONTROL 'TRICKLES THROUGH
+
+TBLOCK=DTA1
+ERCNT=INIT+1
+CM200=NXINIT
+DTA2=DTA0
+DTA3=DTA1
+DTA4=DTA0
+DTA5=DTA1
+DTA6=DTA0
+DTA7=DTA1
+\f *400
+ CIF 0 /WE ARE IN FIELD 0
+ DCA XBUFF
+ RAR
+ DCA XFUNCT /READ/WRITE TO FUNCTION
+RGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD PATTERN
+ SDRC
+ AND K77
+ TAD CM32
+ SZA CLA /IF NOT REV. GUARD, KEEP LOOKING
+ JMP RGRD
+ TAD C7600
+ DCA WORDS /128 WORDS/BLOCK
+ TAD XFUNCT
+K7700, SMA CLA /IS IT READ OR WRITE?
+ JMP TREAD
+ SDRC /CHECK FOR WRITE LOCKOUT
+ AND TC300
+ CLL /SETUP TO RETRY IF WRITE LOCK
+ SZA CLA
+ JMP I CTRY3 /IF LOCKED OUT, ERROR
+ JMS R4LINE /SKIP A WORD
+C7600, 7600 /CLA
+ TAD C1400
+ TAD XUNIT
+ SDLC /TURN ON WRITE HEAD
+ CLA CMA
+ JMS W4LINE /7777 IN REV. CHECKSUM
+ CLA CMA
+ DCA CSUM /AND ALSO TAPE CHECKSUM
+WRTLP, TAD I XBUFF
+ JMS W4LINE
+ ISZ XBUFF /INCREMENT BUFF. ADD.
+K77, 77
+ ISZ WORDS /DONE A BLOCK?
+ JMP WRTLP
+ JMS W4LINE /A 129 TH WORD OF 0
+ JMS GCHK /GET 6 BIT CHECKSUM
+ JMS W4LINE /WRITE IT TO TAPE
+ JMS W4LINE /LET CHECK SUM FINISH
+ JMP I CRWCOM /SEE IF WE ARE FINISHED
+\f
+TREAD, JMS R4LINE
+ JMS R4LINE /SKIP CONTROL WORDS
+ JMS R4LINE
+ AND K77 /CHECKSUM
+ TAD K7700
+ DCA CSUM
+RDLP, JMS R4LINE
+ JMS EFUN /ADD WORD TO CHECKSUM
+ DCA I XBUFF
+ ISZ XBUFF
+TC300, 300
+ ISZ WORDS /DONE BLOCK?
+ JMP RDLP
+ JMS R4LINE
+ JMS EFUN /CHECK SUM 129 TH WORD
+ JMS R4LINE
+ AND K7700 /READ CHECKSUM
+ JMS EFUN
+ JMS GCHK /COMPARE TAPE AND OUR CHECKSUM
+ JMP I CRWCOM
+
+W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT
+ JMS EFUN /WORD
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD
+ CLA /AC IS NOT CLEARED AFTER SDLD
+ JMP I W4LINE
+
+R4LINE, 0 /WAIT FOR QUAD FLAG AND READ
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I R4LINE
+
+EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD
+ AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME
+ CLL RAL /AND CONDENSE LATER.
+ TAD ETMP /IDENTITIES USED ARE:
+ TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EFUN
+
+\fGCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CSUM
+ CLL CMA RTL
+ RTL
+ RTL
+ JMS EFUN
+ CLA CLL CML
+ TAD CSUM
+ AND K7700
+ JMP I GCHK
+
+INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2
+INIT3, TAD CTRY3
+ SNA
+ JMP I INIT2 /0 ENDS LIST
+ TAD INIT2
+ DCA CTRY3 /UPDATE THE LIST
+ ISZ .-1
+ ISZ INIT3
+ JMP INIT3
+
+CTRY3, TRY3-BASE2
+CRWCOM, TRWCOM-BASE2
+XBUFF, 0 /0 MUST TERMINATE IT!!
+CM32, -32
+C1400, 1400
+
+SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT
+ TAD XUNIT /AND ^C TYPED
+ SDLC
+ SDRC /GET STATUS AND SEE IF SELECT ERROR ON
+ AND C100
+ SNA CLA
+ ISZ SELECT /NOPE .TAKE NORMAL OUT
+ KSF /SEE IF FLAG IS UP
+ JMP I SELECT /NO..EXIT
+ TAD C7600
+ KRS
+ TAD (-7603 /IS IT A ^C?
+ SZA CLA
+ JMP I SELECT /NO..EXIT
+ JMP I C7600
+
+C100, 100
+
+XFUNCT=INIT2
+CSUM=XFUNCT+1
+WORDS=CSUM+1
+ETMP=WORDS+1
+XUNIT=ETMP+1
+$$$$$$$
+\f
--- /dev/null
+/4 TD8E HANDLER FOR BUILD..TD8E-B
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -2
+DEVICE TD8B;DEVICE DTA2;4210;4011;ZBLOCK 2
+DEVICE TD8B;DEVICE DTA3;4210;4015;ZBLOCK 2
+
+ SDSS=6761 /SKIP ON SINGLE LINE FLAG
+ SDST=6762 /SKIP ON TIME ERROR
+ SDSQ=6763 /SKIP ON QUAD LINE FLAG
+ SDLC=6764 /LOAD TAPE COMMAND REGISTER
+ SDLD=6765 /LOAD DATA REGISTER
+ SDRC=6766 /READ COMMAND REGISTER
+ SDRD=6767 /READ DATA REGISTER
+
+ TDVERSION="D&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. PARITY ^C IS NOW LEGAL
+/3. ^C CHECK NO LONGER ADVANCES READER
+
+/MAINTENANCE RELEASE CHANGES:
+
+/4. FIXED ^C BUG
+/5. MADE CODE IMPROVEMENTS
+/6. FIXED RETRY BUG
+
+
+
+ *200
+
+NXINIT, 7600 /CLEAR AC HERE!!!
+ JMS I CINIT2
+BASE2, DCA JINIT
+ JMP JINIT
+CRDQAD, R4LINE-BASE
+CINIT2, INIT2-BASE
+CSELCT, SELECT-BASE
+CXUNIT, XUNIT-BASE
+BUFF, 4000 /MUST BE NEGATIVE INITIALLY
+
+
+DTA0, TDVERSION /ENTRY FOR UNIT 0
+ CLA CLL
+ JMP DTA1X
+UNIT, 0 /FILLER WORD
+DTA1, TDVERSION /ENTRY FOR UNIT 1
+ CLA CLL CML
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /UNIT # FROM LINK
+ RDF
+ TAD C6203
+ DCA LEAVE /SET UP EXIT FROM HANDLER
+JINIT, JMP INIT
+ TAD I DTA0
+ DCA FUNCT /SAVE FUNCTION WORD
+ TAD FUNCT
+ CLL RAL
+C200, AND CM200 /GET A PAGE COUNT
+ DCA PGCT
+ TAD FUNCT
+C374, AND C70 /ISOLATE FIELD OF TRANSFER
+ TAD C6203
+ DCA XFIELD
+ ISZ DTA0 /POINT TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /POINT TO RECORD
+ TAD I DTA0
+ CLL RAL /CONVERT TO DECTAPE BLOCKS
+ DCA TBLOCK
+ ISZ DTA0 /POINT TO ERROR RET.
+C6203, CIF CDF 0
+\f
+ /THE RETURN FROM INIT ZEROES IT
+ CLA CLL CMA RTL
+ DCA ERCNT /3 ERROR TRIES
+ TAD UNIT
+ DCA I CXUNIT
+ JMS I CSELCT /CHECK FOR SELEC ERROR
+ JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR
+ TAD FUNCT
+ CLL RAR
+ JMP GO /OK.. START THE SEARCH
+TRWCOM, SDST /TIME OR CHECK SUM ERROR?
+ SZA CLA
+ JMP TRY3 /YES TRY UP TO 3 TIMES
+ TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED?
+ TAD CM200
+ SNA
+ JMP EXIT /YES.. DONE THIS TRANSFER
+ DCA PGCT /NEW PAGE COUNT
+ ISZ TBLOCK
+ TAD BUFF
+ TAD C200 /GET NEW BUFFER ADDRESS
+ DCA BUFF
+ CLL CML /FORCE FORWARD MOTION
+GO, CLA CML RTR /PUT IN DIRECTION BIT
+ TAD C1000
+ TAD UNIT
+ SDLC /INITIATE THE MOTION
+ JMS I CRDQAD /WAIT FOR 8 LINES TO PASS
+ JMS I CRDQAD
+M20, 7760 /DON'T CARE IF IT DOES SKIP!!!
+TSRCH, SDSS /WAIT\ f FOR BLOCK MARK OR END ZONE
+ JMP .-1
+ SDRC
+ CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9
+ AND C374 /ISOLATE M.T BITS
+ TAD M110 /IS IT END ZONE?
+ SNA
+ JMP ENDZ /YES..DO SOMETHING REASONABLE
+ TAD M20 /HOW ABOUT BLOCK MARK?
+ SZA CLA
+ JMP TSRCH /NEITHER..KEEP LOOKING
+ SDRD /WHAT IS THIS BLOCK'S #?
+ SZL /IF IN REVERSE, LOOK FOR 3 BEFORE
+ TAD TC3 /THE ACTUAL TARGET BLOCK
+ CMA
+ TAD TBLOCK
+ CMA
+ SNA /IS THIS THE BLOCK?
+ JMP TFOUND /YES..HAVE CORRECT ONE
+M110, SZL SNA CLA /ARE WE HEADED PROPERLY?
+ JMP TSRCH /YES.. KEEP LOOKING
+ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE
+ CLL RTL
+ JMP GO /EXECUTE TURN AROUND AND SEARCH
+\fTRY3, CLA CLL /V3C
+ ISZ ERCNT /TRIED 3 TIMES?
+ JMP GO
+ JMP FATAL
+EXIT, ISZ DTA0 /NORMAL RETURN
+ CLL CML
+FATAL, TAD UNIT /STOP TAPE FIRST
+ SDLC
+ CLA CML RAR /EITHER 0 OR 4000 IN AC
+LEAVE, HLT /GETS CIF CDF N
+ JMP I DTA0
+
+INIT, JMS . /FIND OUT WHERE WE GOT LOADED
+BASE, TAD CRDQAD
+ SPA /NEGATIVE ENDS LIST
+ JMP NXINIT
+ TAD INIT
+ DCA CRDQAD
+ ISZ .-1
+ ISZ BASE
+ JMP BASE
+
+PGCT, 0
+FUNCT, 0
+C1000, 1000
+
+ *367
+TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION
+ JMP GO /NOT YET
+ TAD FUNCT
+ CLL RAL /R/W TO LINK
+ CLA
+C70, 70
+TC3, 3
+ TAD BUFF
+XFIELD, HLT /CONTROL 'TRICKLES THROUGH
+
+TBLOCK=DTA1
+ERCNT=INIT+1
+CM200=NXINIT
+DTA2=DTA0
+DTA3=DTA1
+DTA4=DTA0
+DTA5=DTA1
+DTA6=DTA0
+DTA7=DTA1
+\f *400
+ CIF 0 /WE ARE IN FIELD 0
+ DCA XBUFF
+ RAR
+ DCA XFUNCT /READ/WRITE TO FUNCTION
+RGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD PATTERN
+ SDRC
+ AND K77
+ TAD CM32
+ SZA CLA /IF NOT REV. GUARD, KEEP LOOKING
+ JMP RGRD
+ TAD C7600
+ DCA WORDS /128 WORDS/BLOCK
+ TAD XFUNCT
+K7700, SMA CLA /IS IT READ OR WRITE?
+ JMP TREAD
+ SDRC /CHECK FOR WRITE LOCKOUT
+ AND TC300
+ CLL /SETUP TO RETRY IF WRITE LOCK
+ SZA CLA
+ JMP I CTRY3 /IF LOCKED OUT, ERROR
+ JMS R4LINE /SKIP A WORD
+C7600, 7600 /CLA
+ TAD C1400
+ TAD XUNIT
+ SDLC /TURN ON WRITE HEAD
+ CLA CMA
+ JMS W4LINE /7777 IN REV. CHECKSUM
+ CLA CMA
+ DCA CSUM /AND ALSO TAPE CHECKSUM
+WRTLP, TAD I XBUFF
+ JMS W4LINE
+ ISZ XBUFF /INCREMENT BUFF. ADD.
+K77, 77
+ ISZ WORDS /DONE A BLOCK?
+ JMP WRTLP
+ JMS W4LINE /A 129 TH WORD OF 0
+ JMS GCHK /GET 6 BIT CHECKSUM
+ JMS W4LINE /WRITE IT TO TAPE
+ JMS W4LINE /LET CHECK SUM FINISH
+ JMP I CRWCOM /SEE IF WE ARE FINISHED
+\f
+TREAD, JMS R4LINE
+ JMS R4LINE /SKIP CONTROL WORDS
+ JMS R4LINE
+ AND K77 /CHECKSUM
+ TAD K7700
+ DCA CSUM
+RDLP, JMS R4LINE
+ JMS EFUN /ADD WORD TO CHECKSUM
+ DCA I XBUFF
+ ISZ XBUFF
+TC300, 300
+ ISZ WORDS /DONE BLOCK?
+ JMP RDLP
+ JMS R4LINE
+ JMS EFUN /CHECK SUM 129 TH WORD
+ JMS R4LINE
+ AND K7700 /READ CHECKSUM
+ JMS EFUN
+ JMS GCHK /COMPARE TAPE AND OUR CHECKSUM
+ JMP I CRWCOM
+
+W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT
+ JMS EFUN /WORD
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD
+ CLA /AC IS NOT CLEARED AFTER SDLD
+ JMP I W4LINE
+
+R4LINE, 0 /WAIT FOR QUAD FLAG AND READ
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I R4LINE
+
+EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD
+ AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME
+ CLL RAL /AND CONDENSE LATER.
+ TAD ETMP /IDENTITIES USED ARE:
+ TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EFUN
+
+\fGCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CSUM
+ CLL CMA RTL
+ RTL
+ RTL
+ JMS EFUN
+ CLA CLL CML
+ TAD CSUM
+ AND K7700
+ JMP I GCHK
+
+INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2
+INIT3, TAD CTRY3
+ SNA
+ JMP I INIT2 /0 ENDS LIST
+ TAD INIT2
+ DCA CTRY3 /UPDATE THE LIST
+ ISZ .-1
+ ISZ INIT3
+ JMP INIT3
+
+CTRY3, TRY3-BASE2
+CRWCOM, TRWCOM-BASE2
+XBUFF, 0 /0 MUST TERMINATE IT!!
+CM32, -32
+C1400, 1400
+
+SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT
+ TAD XUNIT /AND ^C TYPED
+ SDLC
+ SDRC /GET STATUS AND SEE IF SELECT ERROR ON
+ AND C100
+ SNA CLA
+ ISZ SELECT /NOPE .TAKE NORMAL OUT
+ KSF /SEE IF FLAG IS UP
+ JMP I SELECT /NO..EXIT
+ TAD C7600
+ KRS
+ TAD (-7603 /IS IT ^C?
+ SZA CLA
+ JMP I SELECT /NO..EXIT
+ JMP I C7600
+
+C100, 100
+
+XFUNCT=INIT2
+CSUM=XFUNCT+1
+WORDS=CSUM+1
+ETMP=WORDS+1
+XUNIT=ETMP+1
+$$$$$$$
+\f
--- /dev/null
+/4 TD8E HANDLER FOR BUILD..TD8E-C
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -2
+DEVICE TD8C;DEVICE DTA4;4210;4012;ZBLOCK 2
+DEVICE TD8C;DEVICE DTA5;4210;4016;ZBLOCK 2
+
+ SDSS=6751 /SKIP ON SINGLE LINE FLAG
+ SDST=6752 /SKIP ON TIME ERROR
+ SDSQ=6753 /SKIP ON QUAD LINE FLAG
+ SDLC=6754 /LOAD TAPE COMMAND REGISTER
+ SDLD=6755 /LOAD DATA REGISTER
+ SDRC=6756 /READ COMMAND REGISTER
+ SDRD=6757 /READ DATA REGISTER
+
+ TDVERSION="D&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. PARITY ^C IS NOW LEGAL
+/3. INITIALIZATION BUG FIXED
+/4. ^C CHECK NO LONGER ADVANCES READER
+/MAINTENANCE RELEASE CHANGES:
+
+/5. FIXED ^C BUG
+/6. MADE CODING IMPROVEMENTS
+/7. FIXED RETRY BUG
+
+
+
+ *200
+
+NXINIT, 7600 /CLEAR AC HERE!!!
+ JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART
+BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT
+ JMP JINIT
+CRDQAD, R4LINE-BASE
+CINIT2, INIT2-BASE
+CSELCT, SELECT-BASE
+CXUNIT, XUNIT-BASE
+
+BUFF, 4000 /V3
+PGCT, 0
+
+DTA0, TDVERSION /ENTRY FOR UNIT 0
+ CLA CLL
+ JMP DTA1X
+UNIT, 0 /FILLER WORD
+DTA1, TDVERSION /ENTRY FOR UNIT 1
+ CLA CLL CML
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /UNIT # FROM LINK
+ RDF
+ TAD C6203
+ DCA LEAVE /SET UP EXIT FROM HANDLER
+JINIT, JMP INIT
+ TAD I DTA0
+ DCA FUNCT /SAVE FUNCTION WORD
+ TAD FUNCT
+ CLL RAL
+C200, AND CM200 /GET A PAGE COUNT
+ DCA PGCT
+ TAD FUNCT
+C374, AND C70 /ISOLATE FIELD OF TRANSFER
+ TAD C6203
+ DCA XFIELD
+ ISZ DTA0 /POINT TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /POINT TO RECORD
+ TAD I DTA0
+ CLL RAL /CONVERT TO DECTAPE BLOCKS
+ DCA TBLOCK
+ ISZ DTA0 /POINT TO ERROR RET.
+C6203, CIF CDF 0
+\f
+ CLA CLL CMA RTL
+ DCA ERCNT /3 ERROR TRIES
+ TAD UNIT
+ DCA I CXUNIT
+ JMS I CSELCT /CHECK FOR SELEC ERROR
+ JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR
+ TAD FUNCT
+ CLL RAR
+ JMP GO /OK.. START THE SEARCH
+TRWCOM, SDST /TIME OR CHECK SUM ERROR?
+ SZA CLA
+ JMP TRY3 /YES TRY UP TO 3 TIMES
+ TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED?
+ TAD CM200
+ SNA
+ JMP EXIT /YES.. DONE THIS TRANSFER
+ DCA PGCT /NEW PAGE COUNT
+ ISZ TBLOCK
+ TAD BUFF
+ TAD C200 /GET NEW BUFFER ADDRESS
+ DCA BUFF
+ CLL CML /FORCE FORWARD MOTION
+GO, CLA CML RTR /PUT IN DIRECTION BIT
+ TAD C1000
+ TAD UNIT
+ SDLC /INITIATE THE MOTION
+ JMS I CRDQAD /WAIT FOR 8 LINES TO PASS
+ JMS I CRDQAD
+M20, 7760 /DON'T CARE IF IT DOES SKIP!!!
+TSRCH, SDSS /WAIT\ f FOR BLOCK MARK OR END ZONE
+ JMP .-1
+ SDRC
+ CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9
+ AND C374 /ISOLATE M.T BITS
+ TAD M110 /IS IT END ZONE?
+ SNA
+ JMP ENDZ /YES..DO SOMETHING REASONABLE
+ TAD M20 /HOW ABOUT BLOCK MARK?
+ SZA CLA
+ JMP TSRCH /NEITHER..KEEP LOOKING
+ SDRD /WHAT IS THIS BLOCK'S #?
+ SZL /IF IN REVERSE, LOOK FOR 3 BEFORE
+ TAD TC3 /THE ACTUAL TARGET BLOCK
+ CMA
+ TAD TBLOCK
+ CMA
+ SNA /IS THIS THE BLOCK?
+ JMP TFOUND /YES..HAVE CORRECT ONE
+M110, SZL SNA CLA /ARE WE HEADED PROPERLY?
+ JMP TSRCH /YES.. KEEP LOOKING
+ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE
+ CLL RTL
+ JMP GO /EXECUTE TURN AROUND AND SEARCH
+\fTRY3, CLA CLL /V3C
+ ISZ ERCNT /TRIED 3 TIMES?
+ JMP GO
+ JMP FATAL
+EXIT, ISZ DTA0 /NORMAL RETURN
+ CLL CML
+FATAL, TAD UNIT /STOP TAPE FIRST
+ SDLC
+ CLA CML RAR /EITHER 0 OR 4000 IN AC
+LEAVE, HLT /GETS CIF CDF N
+ JMP I DTA0
+
+INIT, JMS . /FIND OUT WHERE WE GOT LOADED
+BASE, TAD CRDQAD
+ SPA /NEGATIVE ENDS LIST
+ JMP NXINIT
+ TAD INIT
+ DCA CRDQAD
+ ISZ .-1
+ ISZ BASE
+ JMP BASE
+
+FUNCT, 0
+C1000, 1000
+
+ *367
+TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION
+ JMP GO /NOT YET
+ TAD FUNCT
+ CLL RAL /R/W TO LINK
+ CLA
+C70, 70
+TC3, 3
+ TAD BUFF
+XFIELD, HLT /CONTROL 'TRICKLES THROUGH
+
+TBLOCK=DTA1
+ERCNT=INIT+1
+CM200=NXINIT
+DTA2=DTA0
+DTA3=DTA1
+DTA4=DTA0
+DTA5=DTA1
+DTA6=DTA0
+DTA7=DTA1
+\f *400
+ CIF 0 /WE ARE IN FIELD 0
+ DCA XBUFF
+ RAR
+ DCA XFUNCT /READ/WRITE TO FUNCTION
+RGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD PATTERN
+ SDRC
+ AND K77
+ TAD CM32
+ SZA CLA /IF NOT REV. GUARD, KEEP LOOKING
+ JMP RGRD
+ TAD C7600
+ DCA WORDS /128 WORDS/BLOCK
+ TAD XFUNCT
+K7700, SMA CLA /IS IT READ OR WRITE?
+ JMP TREAD
+ SDRC /CHECK FOR WRITE LOCKOUT
+ AND TC300
+ CLL /SETUP TO RETRY IF WRITE LOCK
+ SZA CLA
+ JMP I CTRY3 /IF LOCKED OUT, ERROR
+ JMS R4LINE /SKIP A WORD
+C7600, 7600 /CLA
+ TAD C1400
+ TAD XUNIT
+ SDLC /TURN ON WRITE HEAD
+ CLA CMA
+ JMS W4LINE /7777 IN REV. CHECKSUM
+ CLA CMA
+ DCA CSUM /AND ALSO TAPE CHECKSUM
+WRTLP, TAD I XBUFF
+ JMS W4LINE
+ ISZ XBUFF /INCREMENT BUFF. ADD.
+K77, 77
+ ISZ WORDS /DONE A BLOCK?
+ JMP WRTLP
+ JMS W4LINE /A 129 TH WORD OF 0
+ JMS GCHK /GET 6 BIT CHECKSUM
+ JMS W4LINE /WRITE IT TO TAPE
+ JMS W4LINE /LET CHECK SUM FINISH
+ JMP I CRWCOM /SEE IF WE ARE FINISHED
+\f
+TREAD, JMS R4LINE
+ JMS R4LINE /SKIP CONTROL WORDS
+ JMS R4LINE
+ AND K77 /CHECKSUM
+ TAD K7700
+ DCA CSUM
+RDLP, JMS R4LINE
+ JMS EFUN /ADD WORD TO CHECKSUM
+ DCA I XBUFF
+ ISZ XBUFF
+TC300, 300
+ ISZ WORDS /DONE BLOCK?
+ JMP RDLP
+ JMS R4LINE
+ JMS EFUN /CHECK SUM 129 TH WORD
+ JMS R4LINE
+ AND K7700 /READ CHECKSUM
+ JMS EFUN
+ JMS GCHK /COMPARE TAPE AND OUR CHECKSUM
+ JMP I CRWCOM
+
+W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT
+ JMS EFUN /WORD
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD
+ CLA /AC IS NOT CLEARED AFTER SDLD
+ JMP I W4LINE
+
+R4LINE, 0 /WAIT FOR QUAD FLAG AND READ
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I R4LINE
+
+EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD
+ AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME
+ CLL RAL /AND CONDENSE LATER.
+ TAD ETMP /IDENTITIES USED ARE:
+ TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EFUN
+
+\fGCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CSUM
+ CLL CMA RTL
+ RTL
+ RTL
+ JMS EFUN
+ CLA CLL CML
+ TAD CSUM
+ AND K7700
+ JMP I GCHK
+
+INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2
+INIT3, TAD CTRY3
+ SNA
+ JMP I INIT2 /0 ENDS LIST
+ TAD INIT2
+ DCA CTRY3 /UPDATE THE LIST
+ ISZ .-1
+ ISZ INIT3
+ JMP INIT3
+
+CTRY3, TRY3-BASE2
+CRWCOM, TRWCOM-BASE2
+XBUFF, 0 /0 MUST TERMINATE IT!!
+CM32, -32
+C1400, 1400
+
+SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT
+ TAD XUNIT /AND ^C TYPED
+ SDLC
+ SDRC /GET STATUS AND SEE IF SELECT ERROR ON
+ AND C100
+ SNA CLA
+ ISZ SELECT /NOPE .TAKE NORMAL OUT
+ KSF /SEE IF FLAG IS UP
+ JMP I SELECT /NO..EXIT
+ TAD C7600
+ KRS
+ TAD (-7603 /IS IT ^C?
+ SZA CLA
+ JMP I SELECT /NO..EXIT
+ JMP I C7600
+
+C100, 100
+
+XFUNCT=INIT2
+CSUM=XFUNCT+1
+WORDS=CSUM+1
+ETMP=WORDS+1
+XUNIT=ETMP+1
+$$$$$$$
+\f
--- /dev/null
+/4 TD8E HANDLER FOR BUILD..TD8E-D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -2
+DEVICE TD8D;DEVICE DTA6;4210;4013;ZBLOCK 2
+DEVICE TD8D;DEVICE DTA7;4210;4017;ZBLOCK 2
+
+ SDSS=6741 /SKIP ON SINGLE LINE FLAG
+ SDST=6742 /SKIP ON TIME ERROR
+ SDSQ=6743 /SKIP ON QUAD LINE FLAG
+ SDLC=6744 /LOAD TAPE COMMAND REGISTER
+ SDLD=6745 /LOAD DATA REGISTER
+ SDRC=6746 /READ COMMAND REGISTER
+ SDRD=6747 /READ DATA REGISTER
+
+ TDVERSION="D&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. PARITY ^C IS NOW LEGAL
+/3. INITIALIZATION BUG FIXED
+/4. ^C CHECK NO LONGER ADVANCES READER
+
+/MAINTENANCE RELEASE CHANGES:
+
+/5. FIXED ^C BUG
+/6. MADE CODE IMPROVEMENTS
+/7. FIXED RETRY BUG
+
+
+
+
+ *200
+
+NXINIT, 7600 /CLEAR AC HERE!!!
+ JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART
+BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT
+ JMP JINIT
+CRDQAD, R4LINE-BASE
+CINIT2, INIT2-BASE
+CSELCT, SELECT-BASE
+CXUNIT, XUNIT-BASE
+
+BUFF, 4000 /V3
+PGCT, 0
+FUNCT, 0
+
+DTA0, TDVERSION /ENTRY FOR UNIT 0
+ CLA CLL
+ JMP DTA1X
+UNIT, 0 /FILLER WORD
+DTA1, TDVERSION /ENTRY FOR UNIT 1
+ CLA CLL CML
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /UNIT # FROM LINK
+ RDF
+ TAD C6203
+ DCA LEAVE /SET UP EXIT FROM HANDLER
+JINIT, JMP INIT
+ TAD I DTA0
+ DCA FUNCT /SAVE FUNCTION WORD
+ TAD FUNCT
+ CLL RAL
+C200, AND CM200 /GET A PAGE COUNT
+ DCA PGCT
+ TAD FUNCT
+C374, AND C70 /ISOLATE FIELD OF TRANSFER
+ TAD C6203
+ DCA XFIELD
+ ISZ DTA0 /POINT TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /POINT TO RECORD
+ TAD I DTA0
+ CLL RAL /CONVERT TO DECTAPE BLOCKS
+ DCA TBLOCK
+ ISZ DTA0 /POINT TO ERROR RET.
+C6203, CIF CDF 0
+\f
+ CLA CLL CMA RTL
+ DCA ERCNT /3 ERROR TRIES
+ TAD UNIT
+ DCA I CXUNIT
+ JMS I CSELCT /CHECK FOR SELEC ERROR
+ JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR
+ TAD FUNCT
+ CLL RAR
+ JMP GO /OK.. START THE SEARCH
+TRWCOM, SDST /TIME OR CHECK SUM ERROR?
+ SZA CLA
+ JMP TRY3 /YES TRY UP TO 3 TIMES
+ TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED?
+ TAD CM200
+ SNA
+ JMP EXIT /YES.. DONE THIS TRANSFER
+ DCA PGCT /NEW PAGE COUNT
+ ISZ TBLOCK
+ TAD BUFF
+ TAD C200 /GET NEW BUFFER ADDRESS
+ DCA BUFF
+ CLL CML /FORCE FORWARD MOTION
+GO, CLA CML RTR /PUT IN DIRECTION BIT
+ TAD C1000
+ TAD UNIT
+ SDLC /INITIATE THE MOTION
+ JMS I CRDQAD /WAIT FOR 8 LINES TO PASS
+ JMS I CRDQAD
+M20, 7760 /DON'T CARE IF IT DOES SKIP!!!
+TSRCH, SDSS /WAIT\ f FOR BLOCK MARK OR END ZONE
+ JMP .-1
+ SDRC
+ CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9
+ AND C374 /ISOLATE M.T BITS
+ TAD M110 /IS IT END ZONE?
+ SNA
+ JMP ENDZ /YES..DO SOMETHING REASONABLE
+ TAD M20 /HOW ABOUT BLOCK MARK?
+ SZA CLA
+ JMP TSRCH /NEITHER..KEEP LOOKING
+ SDRD /WHAT IS THIS BLOCK'S #?
+ SZL /IF IN REVERSE, LOOK FOR 3 BEFORE
+ TAD TC3 /THE ACTUAL TARGET BLOCK
+ CMA
+ TAD TBLOCK
+ CMA
+ SNA /IS THIS THE BLOCK?
+ JMP TFOUND /YES..HAVE CORRECT ONE
+M110, SZL SNA CLA /ARE WE HEADED PROPERLY?
+ JMP TSRCH /YES.. KEEP LOOKING
+ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE
+ CLL RTL
+ JMP GO /EXECUTE TURN AROUND AND SEARCH
+\fTRY3, CLA CLL /V3C
+ ISZ ERCNT /TRIED 3 TIMES?
+ JMP GO
+ JMP FATAL
+EXIT, ISZ DTA0 /NORMAL RETURN
+ CLL CML
+FATAL, TAD UNIT /STOP TAPE FIRST
+ SDLC
+ CLA CML RAR /EITHER 0 OR 4000 IN AC
+LEAVE, HLT /GETS CIF CDF N
+ JMP I DTA0
+
+INIT, JMS . /FIND OUT WHERE WE GOT LOADED
+BASE, TAD CRDQAD
+ SPA /NEGATIVE ENDS LIST
+ JMP NXINIT
+ TAD INIT
+ DCA CRDQAD
+ ISZ .-1
+ ISZ BASE
+ JMP BASE
+
+C1000, 1000
+
+ *367
+TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION
+ JMP GO /NOT YET
+ TAD FUNCT
+ CLL RAL /R/W TO LINK
+ CLA
+C70, 70
+TC3, 3
+ TAD BUFF
+XFIELD, HLT /CONTROL 'TRICKLES THROUGH
+
+TBLOCK=DTA1
+ERCNT=INIT+1
+CM200=NXINIT
+DTA2=DTA0
+DTA3=DTA1
+DTA4=DTA0
+DTA5=DTA1
+DTA6=DTA0
+DTA7=DTA1
+\f *400
+ CIF 0 /WE ARE IN FIELD 0
+ DCA XBUFF
+ RAR
+ DCA XFUNCT /READ/WRITE TO FUNCTION
+RGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD PATTERN
+ SDRC
+ AND K77
+ TAD CM32
+ SZA CLA /IF NOT REV. GUARD, KEEP LOOKING
+ JMP RGRD
+ TAD C7600
+ DCA WORDS /128 WORDS/BLOCK
+ TAD XFUNCT
+K7700, SMA CLA /IS IT READ OR WRITE?
+ JMP TREAD
+ SDRC /CHECK FOR WRITE LOCKOUT
+ AND TC300
+ CLL /SETUP TO RETRY IF WRITE LOCK
+ SZA CLA
+ JMP I CTRY3 /IF LOCKED OUT, ERROR
+ JMS R4LINE /SKIP A WORD
+C7600, 7600 /CLA
+ TAD C1400
+ TAD XUNIT
+ SDLC /TURN ON WRITE HEAD
+ CLA CMA
+ JMS W4LINE /7777 IN REV. CHECKSUM
+ CLA CMA
+ DCA CSUM /AND ALSO TAPE CHECKSUM
+WRTLP, TAD I XBUFF
+ JMS W4LINE
+ ISZ XBUFF /INCREMENT BUFF. ADD.
+K77, 77
+ ISZ WORDS /DONE A BLOCK?
+ JMP WRTLP
+ JMS W4LINE /A 129 TH WORD OF 0
+ JMS GCHK /GET 6 BIT CHECKSUM
+ JMS W4LINE /WRITE IT TO TAPE
+ JMS W4LINE /LET CHECK SUM FINISH
+ JMP I CRWCOM /SEE IF WE ARE FINISHED
+\f
+TREAD, JMS R4LINE
+ JMS R4LINE /SKIP CONTROL WORDS
+ JMS R4LINE
+ AND K77 /CHECKSUM
+ TAD K7700
+ DCA CSUM
+RDLP, JMS R4LINE
+ JMS EFUN /ADD WORD TO CHECKSUM
+ DCA I XBUFF
+ ISZ XBUFF
+TC300, 300
+ ISZ WORDS /DONE BLOCK?
+ JMP RDLP
+ JMS R4LINE
+ JMS EFUN /CHECK SUM 129 TH WORD
+ JMS R4LINE
+ AND K7700 /READ CHECKSUM
+ JMS EFUN
+ JMS GCHK /COMPARE TAPE AND OUR CHECKSUM
+ JMP I CRWCOM
+
+W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT
+ JMS EFUN /WORD
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD
+ CLA /AC IS NOT CLEARED AFTER SDLD
+ JMP I W4LINE
+
+R4LINE, 0 /WAIT FOR QUAD FLAG AND READ
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I R4LINE
+
+EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD
+ AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME
+ CLL RAL /AND CONDENSE LATER.
+ TAD ETMP /IDENTITIES USED ARE:
+ TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EFUN
+
+\fGCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CSUM
+ CLL CMA RTL
+ RTL
+ RTL
+ JMS EFUN
+ CLA CLL CML
+ TAD CSUM
+ AND K7700
+ JMP I GCHK
+
+INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2
+INIT3, TAD CTRY3
+ SNA
+ JMP I INIT2 /0 ENDS LIST
+ TAD INIT2
+ DCA CTRY3 /UPDATE THE LIST
+ ISZ .-1
+ ISZ INIT3
+ JMP INIT3
+
+CTRY3, TRY3-BASE2
+CRWCOM, TRWCOM-BASE2
+XBUFF, 0 /0 MUST TERMINATE IT!!
+CM32, -32
+C1400, 1400
+
+SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT
+ TAD XUNIT /AND ^C TYPED
+ SDLC
+ SDRC /GET STATUS AND SEE IF SELECT ERROR ON
+ AND C100
+ SNA CLA
+ ISZ SELECT /NOPE .TAKE NORMAL OUT
+ KSF /SEE IF FLAG IS UP
+ JMP I SELECT /NO..EXIT
+ TAD C7600
+ KRS
+ TAD (-7603 /IS IT ^C?
+ SZA CLA
+ JMP I SELECT /NO..EXIT
+ JMP I C7600
+
+C100, 100
+
+XFUNCT=INIT2
+CSUM=XFUNCT+1
+WORDS=CSUM+1
+ETMP=WORDS+1
+XUNIT=ETMP+1
+$$$$$$$
+\f
--- /dev/null
+/1 BATCH INPUT STREAM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -1 /NUMBER OF DEVICES
+ DEVICE BAT /DEVICE TYPE NAME
+ DEVICE BAT /DEVICE NAME
+ 2220 /READ ONLY, CODE=22
+ 0 /ONE PAGE
+ ZBLOCK 2
+
+BATIN= 5400
+\f BATVERSION="B&77
+
+
+ *200
+BAT, BATVERSION
+ CLA /PROTECTION
+ RDF /GET USER'S FIELD
+ TAD BATCDF /MAKE CDF CIF
+ DCA BATXIT /SAVE FOR EXIT
+ TAD BATISZ /RESET SUCCESS ISZ
+ DCA BATXIT-1
+ TAD I BAT
+ AND BA7700
+ CIA
+ DCA BATWC /SAVE WORD COUNT (DIVIDED BY 2)
+ TAD I BAT
+ AND BA0070
+ TAD BATCDF /CREATE CDF TO BUFFER FIELD
+ TAD (-2
+ DCA BATBUF
+BATISZ, ISZ BAT
+ TAD I BAT
+ DCA BATCA /GET ADDRESS OF BUFFER
+ ISZ BAT
+ ISZ BAT /IGNORE BLOCK NUMBER
+ TAD BATWC /WAS COMMAND WRITE OR BUFFER LENGTH ZERO?
+BA7700, SMA CLA
+ JMP BATER1 /YES - ERROR
+BATCDF, CDF CIF 0
+ TAD I BA7777 /IS BATCH RUNNING?
+ RAL
+ SMA CLA
+ JMP BATER2 /NO - ERROR
+ TAD I BA7777
+ AND BA0070
+ TAD BATCDF /CREATE CDF TO BATCH FIELD
+ DCA BATCAL /CREATE CDF CIF TO BATCH FIELD
+
+
+
+BATLP, JMS BATGET /GET CHAR
+ DCA I BATCA /SAVE IN BUFFER
+ JMS BATGET /GET NEXT CHAR
+ DCA BATTMP /SAVE IT FOR PACKING
+ JMS BATGET /GET NEXT CHAR
+ RTL
+ RTL
+ DCA BATTM2 /SAVE IT
+ TAD BATTM2
+ AND BA7400 /ADD FIRST HALF
+ TAD I BATCA /TO FIRST CHAR
+ DCA I BATCA /SAVE THEM IN BUFFER
+ ISZ BATCA /UPDATE POINTER
+BA7400, 7400 /PROTECT THE ISZ
+ TAD BATTM2 /GET SECOND HALF OF CHAR
+ RTL
+ RTL
+ AND BA7400
+ TAD BATTMP /ADD TO SECOND CHAR
+ DCA I BATCA /SAVE IN BUFFER
+ ISZ BATCA /UPDATE POINTER
+BA0070, 0070 /PROTECT THE ISZ
+ ISZ BATWC /DONE?
+ JMP BATLP /NO - LOOP
+
+ ISZ BAT /SUCCESS RETURN (ON EOF THIS BECOMES CLA IAC)
+BATXIT, HLT /CDF CIF TO USER FIELD
+ JMP I BAT /RETURN
+
+BATWC, 0 /WORD COUNT (DIVIDED BY 2)
+BATCA, 0 /POINTER INTO BUFFER
+BATTM2,
+BATCHR, 0 /CHAR RETURNED BY BATGET
+BATTMP, 0
+BA7777, 7777
+
+
+BATER1,
+BATER2, CLA STL RAR
+ JMP BATXIT
+\f/THIS ROUTINE GETS THE NEXT CHARACTER TO BE PUT INTO THE BUFFER
+BATGET, 0
+ 0 /IF LAST CHAR WAS <CR> THIS IS "JMP BATLF"
+BATCAL, HLT /CIF CDF BATCH FIELD (ON EOF THIS IS "JMP BATBUF")
+ TAD I BATVFY
+ TAD (-2214 /VERIFY MAGIC LOCATION IN BATCH
+ SZA /AGAINST EQUALLY MAGIC CONTENTS
+ CDF CIF 0
+ SZA CLA
+ JMP BATER2 /BATCH IS DESTROYED!
+ CDF /WE ARE IN FIELD ZERO
+ JMS I BATINN /CALL THE BATCH INPUT ROUTINE
+ JMP BATEOF /NO SKIP = END OF FILE
+ DCA BATCHR /SAVE CHARACTER RETURNED
+ TAD BATCHR
+ TAD BMCR /CARRIAGE RETURN?
+ SNA
+ JMP BATCR /YES
+ TAD BCRMLF /LINE FEED?
+ SNA
+ JMP BATCAL /YES - IGNORE IT
+ TAD BLFMDO /DOLLAR SIGN?
+ SNA CLA
+ JMP BATDO /YES
+BATGEX, DCA BCRFLG /NO SPECIAL CHAR
+ TAD BATCHR /RETURN WITH CHAR IN AC
+BATBUF, HLT /CDF USER BUFFER
+ JMP I BATGET /RETURN
+
+BLFJMP, JMP BATLF
+BATCR, TAD BLFJMP /SET NEXT CALL TO RETURN <LF>
+ DCA BATGET+1
+ CLA CMA /SET TO INDICATE <CR>
+ JMP BATGEX
+
+BATLF, DCA BATGET+1 /ZAP THE JMP TO HERE
+ TAD BLF /RETURN <LF>
+BATGEJ, JMP BATBUF
+
+BATDO, TAD BCRFLG /IS THE "$" FIRST ON THIS LINE?
+ SNA CLA
+ JMP BATGEX /NO - NOTHING SPECIAL
+ TAD I BA7777 /YES - SET FLAG SO THAT
+ RTR /THE BATCH INPUT ROUTINE
+ STL RTL /WILL PUT THE DOLLAR-SIGN BACK
+ DCA I BA7777
+ /RETURN CURRENT CHARACTER AGAIN
+BATEOF, TAD BATCTZ /RETURN CTRL-Z THIS TIME
+ DCA BATCHR
+ DCA BATXIT-1 /SET HANDLER TO RETURN TO ERROR RETURN
+ TAD BATGEJ /SET BATGET TO RETURN ZEROES
+ DCA BATCAL
+ JMP BATCR+2 /AND FLAG NEW LINE FOR NEXT CALL
+
+BATINN, BATIN /ENTRY ADDRESS OF BATCH INPUT ROUTINE
+BATVFY, BATIN+200
+BLF, 212
+BMCR, -215
+BCRMLF, 215-212
+BLFMDO, 212-"$
+BCRFLG, -1
+BATCTZ, 32 /CTRL-Z
+
+$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+\f
--- /dev/null
+/1 DF32 NON SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/ SR
+
+ RF08=0 /CHANGE TO 1 FOR RF08 HANDLER
+
+/THE NUMBER OF PLATTERS MUST EITHER BE SET AT ASSEMBLY TIME,
+/OR MUST BE CHANGED VIA THE ALTER COMMAND IN BUILD
+
+ *0
+
+ -1
+ IFNZRO RF08 <
+ DEVICE RF;DEVICE RF;4064;RF&177;ZBLOCK 2
+ >
+ IFZERO RF08 <
+ DEVICE DF;DEVICE DF;4124;DF&177;ZBLOCK 2
+ >
+
+ SCA=7751
+ SWC=7750
+
+ RFVERSION="A&77
+\f *200
+
+SYSER, CLA CLL CML RAR /4000
+ ISZ SYSCNT /TRY AGAIN?
+ SKP CLA
+ JMP SFIELD /WHY BOTHER
+ CLA CLL CMA RTL
+ TAD RF
+ DCA RF /RESET PARAMETERS AND TRY AGAIN
+ JMP RETRY
+SCIF, CIF 0
+SYSCNT, 0
+S6603, 6603
+S70, 70
+S7400, 7400
+ IFZERO RF08 <S3700, 3700>
+ IFNZRO RF08 <S377, 0377>
+T1, 0
+T2, 0
+ ZBLOCK 224-.
+ IFNZRO .-224 <ADRERR,QQQQ> /ENTRY PT MUST BE RELATIVE 24
+DF,
+RF, RFVERSION
+ CLA CLL CMA RTL /-3
+ DCA SYSCNT /# TRYS ON ERROR
+RETRY, TAD I RF /HANDLER RUNS IN USER'S DATA FIELD
+ RAL
+ CLA RTL
+ TAD S6603
+ DCA SFUN /EITHER A READ OR WRITE
+ TAD I RF
+ AND S70
+ DCA SFIELD /GET FIELD OF BUFFER
+ TAD I RF
+ RAL
+ AND S7600
+ CIA
+ DCA T1 /SET UP WORD COUNT
+ CLA CMA
+ ISZ RF
+ TAD I RF
+ DCA T2 /BUFFER ADDRESS-1
+ ISZ RF
+ RDF
+ TAD (CDF 0
+ DCA RESRDF
+ CDF 0
+ TAD T1
+ DCA I (SWC
+ TAD T2
+ DCA I (SCA
+RESRDF, HLT /RESTORE USER'S DATA FIELD
+ IFZERO RF08 <
+ TAD I RF
+ RTL
+ AND S3700
+ >
+ TAD SFIELD
+ 6615 /LOAD DISK EXTENDED MEMORY
+S7600, 7600
+ IFNZRO RF08 <
+ TAD I RF
+ RTR
+ RTR
+ AND S377
+ 6643 /LOAD HIGH ORDER
+ >
+ TAD I RF
+ RTR
+ RTR
+ RAR
+ AND S7400
+SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE)
+ RDF
+ TAD SCIF
+ DCA SFIELD
+ IFZERO RF08 <6622>
+ IFNZRO RF08 <6623>
+ JMP .-1
+ KRS
+ AND (177
+ TAD (-3
+ SNA CLA
+ KSF
+ JMP .+3
+ CIF CDF 0 /RETURN TO OS/8 IF USER TYPED ^C
+ JMP I S7600
+ ISZ RF
+ 6621 /SKIP ON ERROR
+ IFNZRO RF08 <SKP /SENSE OF SKIP IS REVERSED>
+ JMP SYSER
+ ISZ RF
+SFIELD, HLT /RETURN TO PROPER FIELD
+ 6601 /CLEAR TROUBLESOME FLAG
+ JMP I RF
+ $
+\f
--- /dev/null
+/2 DF32 SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/MAINTENANCE RELEASE CHANGES:
+
+/1. TOOK OUT SOFSET
+
+DF32=1
+ RF08=0
+ VERSION="B&77
+
+ *0
+ -1
+ DEVICE DF32;DEVICE SYS;4124;2007;0;177
+
+ STARTB-ENDB-1
+
+ NOPUNC
+ *6604
+ ENPUNC
+
+STARTB, NOP /FOR "SWAP"
+B6653, 6653
+B7647, 7647
+B7577, 7577
+B200, 200
+B7605, 7605
+B7751, 7751
+ ZBLOCK 6622-.
+ TAD I B6653
+ CDF 10
+ DCA I B7647
+ CDF 0
+ ISZ B6653
+ ISZ B7647
+ JMP .-6 /MOVE FIELD 1 RESIDENT UP
+ IFNZRO RF08 <6643>
+ 6615
+ 7600
+ TAD B7577
+ DCA I B7751
+ TAD B200
+ 6603 /NOW READ IN FIELD 0 RESIDENT FROM RECORD 1/2
+
+ IFNZRO RF08 <6623>
+ IFNZRO DF32 <6622>
+ JMP .-1
+ 6621
+ IFNZRO RF08 <SKP>
+ HLT /ERROR READING SYSTEM IN
+ENDB, JMP I B7605
+\f /BOOTSTRAP FOR DISK MONITOR IS AS FOLLOWS:
+
+ / LOCATION CONTENTS
+ / 7750 7600
+ / 7751 6603
+ / 7752 6622
+ / 7753 5352
+ / 7754 5752
+\f *200
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+ ZBLOCK 7
+SHNDLR, VERSION
+ CLA CLL CMA RTL /-3
+ DCA SYSCNT /# TRYS ON ERROR
+ TAD I SHNDLR
+ RAL
+ CLA RTL
+ TAD S6603
+ DCA SFUN /EITHER A READ OR WRITE
+ TAD I SHNDLR
+ AND S70
+ DCA SFIELD /GET FIELD OF BUFFER
+ TAD I SHNDLR
+ RAL
+ AND S7600
+ CIA
+ DCA SWC /SET UP WORD COUNT
+ CLA CMA
+ ISZ SHNDLR
+ TAD I SHNDLR
+ DCA SCA /BUFFER ADDRESS-1
+ ISZ SHNDLR
+ IFNZRO DF32 <
+ TAD I SHNDLR
+ RTL
+ AND S3700>
+ TAD SFIELD
+ 6615 /LOAD DISK EXTENDED MEMORY
+S7600, 7600
+ IFNZRO RF08 <
+ TAD I SHNDLR
+ RTR
+ RTR
+ AND S377
+ 6643 /LOAD HIGH ORDER>
+ TAD I SHNDLR
+ RTR
+ RTR
+ RAR
+ AND S7400
+SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE)
+ RDF
+ TAD SCIF
+ DCA SFIELD
+ IFNZRO DF32 <6622>
+ IFNZRO RF08 <6623>
+ JMP .-1
+ ISZ SHNDLR
+ 6621 /SKIP ON ERROR
+ IFNZRO RF08 <SKP /SENSE OF SKIP IS REVERSED>
+ JMP SYSER
+ ISZ SHNDLR
+SFIELD, HLT /RETURN TO PROPER FIELD
+ 6601 /CLEAR TROUBLESOME FLAG
+ JMP I SHNDLR
+ ZBLOCK 2
+SYSER, CLA CLL CML RAR /4000
+ ISZ SYSCNT /TRY AGAIN?
+ SKP CLA
+ JMP SFIELD /WHY BOTHER
+ CLA CLL CMA RTL
+ TAD SHNDLR
+ DCA SHNDLR /RESET PARAMETERS AND TRY AGAIN
+ IFNZRO RF08 <IFNZRO .-7700 <NZERR>; SKP; HLT>
+ JMP SHNDLR+3
+SCIF, CIF 0
+SYSCNT, 0
+ IFNZRO DF32 <IFNZRO .-7700 <NZERR>; SKP; HLT>
+S6603, 6603
+S70, 70
+S7400, 7400
+ IFNZRO DF32 <S3700, 3700>
+ IFNZRO RF08 <S377, 377>
+ SCA=7751
+ SWC=7750
+ $
+\f
--- /dev/null
+/OS8 FORTRAN II COMPILER V5
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971,1974,1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/ SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8)
+/ FOR USE WITH DISK/DECTAPE MONITOR SYSTEM
+/ CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN
+/ASSEMBLE AND SAVE
+/ .PAL FORT.PA
+/ .PAL FPATCH.PA
+/
+/ .LO FORT.BN$FPATCH.BN$
+/
+/ .SA SYS FORT
+/
+/
+
+ FIELD 0
+ *200
+INBUF, TEXT /PDP-8 FORTRAN DEC-08-A2B1-5A/
+
+ *1000
+BEGIN, PLS /INITIALIZATION ROUTINE
+ TLS
+ RFC
+ CDF 00
+ TAD CM1300 /SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1)
+ DCA INDX
+ TAD BSYMP
+ DCA TPTT
+LP, DCA I TPTT
+ ISZ INDX
+ JMP LP
+ TAD CM60
+ DCA INDX
+ TAD BTTAB
+ DCA TPTT
+ DCA I TPTT /ZERO OUT TEMPORARY TABLES IN FIELD 0
+ ISZ INDX
+ JMP .-2
+ CDF 10
+ TAD MIN104 /ZERO EVERYTHING FROM ZERO TO 107
+ DCA INDX
+ TAD CP6
+ DCA TPTT
+LPP, DCA I TPTT
+ ISZ INDX
+ JMP LPP
+ TAD TPT /MOVE DATA FROM TABLE TO FIELD 0
+ DCA TPTT
+REP, CDF 00
+ TAD I TPTT
+ SNA /END OF FIELD 0 INITIALIZATION?
+ JMP DN /YES
+ DCA LOC
+ TAD I TPTT
+ CDF 10
+ DCA I LOC
+ JMP REP
+DN, TAD I TPTT /MOVE DATA FROM TABLE TO FIELD 1
+ SNA /END FIELD 1 INITIALIZATION
+ JMP DNN /YES
+ DCA LOC
+ TAD I TPTT
+ DCA I LOC
+ JMP DN
+DNN, CIF 10
+ JMP I STRT
+LOC, 0
+INDX, 0
+MIN104, L7-ASSIGN
+CP6, L7-1
+CM1300, -1300
+CM60, -60
+BTTAB, ITTAB-1
+BSYMP, BSYM-1 /BOTTOM OF TEMPORARY SYMBOL TABLE
+STRT, FORST /STARTING POINT AFTER INITIALIZATION
+TPTT=10
+TPT, TABLE-1
+TABLE,
+PUNCH
+ LTTYPE
+15
+ DOEND
+45
+ FTTAB
+51
+ ITTAB
+47
+ TSYM-3
+50
+ TSYM
+55
+ -25
+56
+ BSYM
+57
+ BSYM
+71
+ 5777
+74
+ 3000
+MIKE4
+ 3377
+POINTZ
+ 3377
+BASE
+ INBUF
+BASE2
+ INBUF+100
+SCOUNT
+ 0
+SCOUNT+1
+ 0
+SCOUNT+2
+ 0
+QONE
+ 0
+QONE+1
+ 0
+QONE+2
+ 0
+QONE+3
+ 0
+QONE+4
+ 0
+QONE+5
+ 0
+QONE+6
+ 0
+0 /THIS TERMINATES FIELD ZERO INITIALIZATION
+2375
+ 4000
+2376
+ 4000
+2377
+ 4000
+0
+
+\f/ ERROR MESSAGE TABLE AND TEXT
+
+ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION
+ -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION
+ -ERR3-1; IE
+ -ERR6-1; IE
+ -ERR9-1; EMSG3
+ -ERR10-1; EMSG4
+ -ERR12-1; EMSG4
+ -ERR14-1; EMSG4
+ -ERR15-1; EMSG3
+ -ERR16-1; EMSG5
+ -ERR17-1; EMSG6
+ -ERR18-1; SE /SYNTAX ERROR
+ -ERR28-1; SE
+ -ERR29-1; SE
+ -ERR30-1; EMSG8 /ILLEGAL VARIABLE
+ -ERR31-1; SE
+ -ERR35-1; SE
+ -ERR36-1; EMSG36
+ -ERR37-1; CE
+ -ERR38-1; EMSG9 /ILLEGAL DO NESTING
+ -ERR39-1; SE
+ -ERR40-1; IE
+ -ERR41-1; EMSG10 /EXPRESSION TOO BIG
+ -ERR42-1; IE
+ -ERR43-1; EMSG11 /MIXED MODE
+ -ERR44-1; EMSG9
+ -ERR47-1; SF /SUBR. OR FUNCT. STMT. NOT FIRST
+ -ERR48-1; SE
+ -ERR50-1; SE
+ -ERR51-1; SE
+ -ERR52-1;IE
+ -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT
+ -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING
+ -ERR59-1; SE
+ -ERR60-1; EMSG3
+ 0; EMSG14 /COMPILER MALFUNCTION
+
+EMSG1, TEXT /ILLEGAL CONTINUATION/
+IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/
+EMSG3, TEXT /ILLEGAL STATEMENT/
+EMSG4, TEXT /ILLEGAL CONSTANT/
+EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/
+EMSG6, TEXT /SYMBOL TABLE EXCEEDED/
+SE, TEXT /SYNTAX ERROR/
+EMSG8, TEXT /ILLEGAL VARIABLE/
+EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/
+EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/
+EMSG11, TEXT /MIXED MODE EXPRESSION/
+EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/
+EMSG13, TEXT /ILLEGAL EQUIVALENCING/
+EMSG14, TEXT /COMPILER MALFUNCTION/
+CE, TEXT /UNBALANCED QUOTES/
+SF, TEXT /SUBR. OR FUNCT. STMT. NOT FIRST/
+EMSG36, TEXT /ARRAY TOO LARGE/
+\fITTAB=710
+FTTAB=ITTAB+30
+DOEND=2377
+BSYM=6300
+TSYM=7600
+
+/ THE STATEMENT TYPE TABLE FOLLOWS
+ *2600
+STYPE, 7361 /-DO
+ 0000
+ LDO
+ 6672 /-IF
+ 0000
+ LIF
+ 7061 /-GO
+ 5361 /-TO
+ LGOTO
+ 7477 /-CA
+ 6364 /-LL
+ CAL
+ 5573 /-RE
+ 5353 /-TU
+ LRET
+ 7461 /-CO
+ 6154 /-NT
+ LCONT
+ 5454 /-ST
+ 6060 /-OP
+ LSTOP
+ 5777 /-PA
+ 5255 /-US
+ LPAUSE
+ 5573 /-RE
+ 7674 /-AD
+ LREAD
+ 5056 /-WR
+ 6654 /-IT
+ LWRIT
+ 7161 /-FO
+ 5563 /-RM
+ LFRMAT
+ 7262 /-EN
+ 7400 /-D
+ LLAST
+ 7461 /-CO
+ 6263 /-MM
+ LCOMON
+ 7367 /-DI
+ 6273 /-ME
+ LDIMEN
+ 7257 /-EQ
+ 5267 /-UI
+
+ EQUI
+ -0611 /-FI
+ -1611 /-NI
+ LFIN
+XXSUBR, 5453 /-SU
+ 7556 /-BR
+ LSUB
+ 7153 /-FU
+ 6175 /-NC
+ LFUNC
+ 0000 /THIS IS THE END OF LIST
+AREA1, 0
+AREA2, 0
+
+/ THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR
+ -45 / PREC('%') = 7 NOTE: '%' REPLACES '**'
+ 700
+ -52 / PREC('*') = 5
+ 500
+ -57 / PREC('/') = 5
+ 500
+ -53 / PREC('+') = 4
+ 400
+ -55 / PREC('-') = 4
+ 400
+ -75 / PREC('=') = 1
+ 100
+ -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT
+ 100
+ 1 /THIS IS THE END OF THE TABLE
+THOU, -1750
+ -144
+ -12
+ -1
+
+/ THE PERMANENT SYMBOL TABLE BEGINS HERE
+ *6000
+ 1501 /MAIN
+ 1116
+ 0001
+ 0601 /FAD
+ 0400
+ 0001
+ 2324 /STO
+ 1700
+ 0001
+ 0623 /FSB
+ 0200
+ 0001
+ 0615 /FMP
+ 2000
+ 0001
+ 0604 /FDV
+ 2600
+ 0001
+ 1520 /MPY
+ 3100
+ 0001
+ 0411 /DIV
+ 2600
+ 0001
+ 2205 /READ
+ 0104
+ 0001
+ 2722 /WRITE
+ 1124
+ 0501
+ 1117 /IOH
+ 1000
+ 0001
+ 5060 /(0
+ 0000
+ 0001
+ 1215 /JMP
+ 2000
+ 0001
+ 1617 /NOP
+ 2000
+ 0001
+ 0516 /ENTRY
+ 2422
+ 3101
+ 0501 /EAP
+ 2000
+ 0001
+ 2001 /PAUSE
+ 2523
+ 0501
+OPTADI, 2401 /TAD I
+ 0440
+ 1101
+OPTAD, 2401 /TAD
+ 0400
+ 0001
+OPDCA, 0403 /DCA
+ 0100
+ 0001
+OPJMPI, 1215 /JMP I
+ 2040
+ 1101
+ 2205 /RETRN
+ 2422
+ 1601
+ 0320 /CPAGE
+ 0107
+ 0501
+OPSNA, 2316 /SNA
+ 0100
+ 0001
+ 2320 /SPC
+ 0300
+ 0001
+ 0301 /CALL
+ 1414
+ 0001
+ 0313 /CKIO
+ 1117
+ 0001
+ 1014 /HLT
+ 2400
+ 0001
+OPCLA, 0314 /CLA
+ 0100
+ 0001
+ 0614 /FLOT
+ 1724
+ 0001
+ 1106 /IFAD
+ 0104
+ 0001
+ 0311 /CIA
+ 0100
+ 0001
+ 0310 /CHS
+ 2300
+ 0001
+ 0611 /FIX
+ 3000
+ 0001
+ 1123 /ISTO
+ 2417
+ 0001
+ 2001 /PAGE
+ 0705
+ 0001
+BLCK, 0214 /BLOCK
+ 1703
+ 1301
+ 0516 /END
+ 0400
+ 0001
+ 1401 /LAP
+ 2000
+ 0001
+ 0317 /COMMN
+ 1515
+ 1601
+ 1123 /ISZ
+ 3200
+ 0001
+ 2325 /SUBSC
+ 0223
+ 0301
+DUMMY, 0425 /DUMMY
+ 1515
+ 3101
+ 0122 /ARG
+ 0700
+ 0001
+ 0314 /CLEAR
+ 0501
+ 2201
+ 1111 /IIPOW
+ 2017
+ 2701
+ 0611 /FIPOW
+ 2017
+ 2701
+ 1106 /IFPOW
+ 2017
+ 2701
+ 0606 /FFPOW
+ 2017
+ 2701
+ 0403 /DCA I
+ 0140
+ 1101
+ 0103 /ACH
+ 1000
+ 0001
+OPEN, 1720 /OPEN
+ 0516
+ 0001
+ 0522 /ERROR
+ 2217
+ 2201
+ 1116 /INC
+ 0300
+ 0001
+FORTR, 0617 /FORTR
+ 2224
+ 2201
+OPCMA, 0315 /CMA
+ 0100
+ 0001
+OPIAC, 1101 /IAC
+ 0300
+ 0001
+EXIT, 0530 /EXIT
+ 1124
+ 0001
+\f FIELD 1
+ *0
+FIRSTF, 1
+ *7
+L7, 0
+L10, 0
+L11, 0
+L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION
+ 0
+L14, 0
+L15, 2377 /POINTER INTO DOEND LIST
+L16, 0
+L17, 0
+L20, 0 /FLAG, NON-ZERO IF '=' SEEN
+L21, 0
+L22, 0 /SUBSCRIPT NESTING LEVEL
+L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH
+L24, 0 /LINE POINTER
+L25, 0 /HIGHEST SUBSCRIPT TEMP USED
+L26, 0 /USED FOR DIMENSION INFORMATION
+ 0 /UNUSED
+L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY
+L31, 0
+L32, 0
+L33, 0
+L34, 0
+L35, 0
+L36, 0
+L37, 0
+L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER
+L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST
+L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR
+L43, 0 /
+L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT
+L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED
+L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC
+L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE
+L50, 7600 /CONTAINS START OF DIMENSION TABLE
+L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED
+L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE
+L53, 0 /CONTAINS THE LAST CREATED LABEL
+L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT
+L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS
+L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE
+L57, 6300 /CONTAINS END OF SYMBOL TABLE
+L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN
+L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT
+L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY
+L63, 0 /CONTAINS THE CURRENT OPERATOR
+L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK
+L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR
+BPAREN, 0 /PARENTHESIS COUNTER
+L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE
+L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME
+L71, 5777 /BEGINNING OF PUSHDOWN LIST
+L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED
+L73, 0 /
+L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS
+L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER
+L76, 0 /
+L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE
+ /THE FOLLOWING THREE LOCS ARE USED BY THE
+ /LITERAL COLLECTER
+COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT
+ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE
+FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT
+MIKE4,MA, 3377
+MIKE8,TOTAL, 0
+INTA, 0
+INTB,MIKE7, 0
+SNUM,MB, 0
+POINTZ, 3377
+CHK, 0
+IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG
+KOUNT, 0
+ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS
+PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER
+PROP, LPROP /PRINTS OPCODES
+PRCRL, LPRCRL /PRINTS CREATED LABELS
+PRINT, LPRINT /PRINTS ONE ASCII CHAR
+P2, LP2 /PRINT TWO PACKED ASCII CHARS
+GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER
+LUNCH, LLUNCH /PRINTS ERROR COMMENTS
+MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT
+LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT
+ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS
+ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER
+SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE
+DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT
+PRSYM, LPRSYM /PRINTS SYMBOLS
+CREATE, LCREAT /CREATES LABELS
+PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL
+PLAB, LPLAB /PRINTS LABELS
+PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC
+TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION
+GENER, LGENER /GENERATES THE TRIPLES
+LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE
+CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE
+STORE, LSTORE /STORES THE CONTENTS OF THE AC
+FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES
+ZER, LZER
+DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS
+DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES
+PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE
+C2, 2
+C3, 3
+\fC40, 40
+C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE
+C77, 77
+CM40, -40
+CM4046, -4046
+CM50, -50
+CM51, -51
+CM54, -54
+CM2, -2
+CM3, -3
+CHECK, LCHECK
+SMODE, LSMODE
+BSS, LBSS
+ARG, LARG
+C54, 54
+BASE, INBUF
+BASE2, INBUF+100
+C4000, 4000
+GNB, LGNB
+\f *177
+START, CLA /COME HERE AT BEGINNING OF EACH STMT
+ DCA FIRSTF
+START1, TAD IMPDO
+ SZA CLA
+ JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON
+ /CONTINUATIONS (I THINK)
+ ISZ CHK /IS THERE A STMT IN THE BUFFER?
+ JMP .+3
+ JMS I SWAP /YES, SWITCH BUFFER POINTERS
+ JMP .+3
+ TAD BASE
+ JMS I RCD /NO, READ THE NEXT LINE
+TEST, TAD L15
+ TAD CM3
+ DCA L16 /SET UP XR FOR DO TERMINATION TEST
+ TAD L54
+ CIA
+ TAD I L16
+ SZA CLA /ARE WE TERMINATING A DO?
+ JMP ATRY
+ JMS LDNEXT /TERMINATE DO LOOP
+ JMP TEST /SEE IF THERE IS ANY MORE...
+ATRY, TAD L61
+ SZA CLA /A COMMENT?
+ JMP CMNT
+ TAD CHK
+ SZA CLA /ILLEGAL CONTINUATION?
+ERR1, JMS I LUNCH
+ JMS I STMT /GET THE STMT NR...
+ TAD L32
+ SNA
+ JMP .+4 /NO STMT NUMBER
+ CIA
+ TAD L12
+ SZA CLA /CAN WE OMIT A TERMINAL JMP?
+ JMS I PRINT
+ DCA L24
+FLST, JMS LIST /PUNCH SOURCE STMT
+ JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE
+ TAD L32
+ DCA L54
+ TAD CM2
+ DCA L64
+ SKP
+ACA, DCA I BAREA1
+ JMS I GETCH
+ JMP ALPH
+ NOP
+ JMS I PUTCH /PUT CHARACTER BACK
+ALPH, RTL CLL
+ RTL
+ RTL
+ DCA L65
+ JMS I GETCH
+ JMP ALPH2
+ NOP
+ JMS I PUTCH /PUT CHARACTER BACK
+ALPH2, TAD L65
+ ISZ L64
+ JMP ACA
+ DCA I BAREA2
+ DCA CHK
+ TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE
+ DCA L17
+TRY, TAD I L17
+ SNA /END OF THE TABLE?
+ JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT
+ TAD I BAREA1
+ SZA CLA
+ JMP NOHIT2
+ TAD I BAREA2
+ TAD I L17
+ SZA CLA
+ JMP NOHIT1
+ TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER...
+ DCA L30
+ JMP I L30
+NOHIT2, ISZ L17
+NOHIT1, ISZ L17
+ JMP TRY /DOESN'T MATCH, TRY AGAIN
+
+LDNEXT, 0
+ TAD L15 /RESET THE DO END POINTER
+ TAD CM3
+ DCA L15
+ TAD L15
+ IAC
+ DCA L16
+ CMA
+ TAD L55
+ DCA L55
+ JMS I PROP /PUNCH 'JMP <LABEL>'
+ 6044
+ TAD I L16
+ JMS I PRCRL
+ JMS I PRINT
+ TAD I L16 /PUNCH '<LABEL>,'
+ JMS I CLAB
+ JMS I PRINT
+ JMP I LDNEXT
+
+PTEM, 0
+
+LIST, 0 /PUNCH THE SOURCE STATEMENT
+ TAD BASE /GET THE POINTER
+ DCA PTEM
+ TAD I PTEM /PUNCH A CHARACTER PAIR...
+ JMS I P2
+ TAD I PTEM
+ ISZ PTEM
+ AND C77
+ SZA CLA /END OF THE BUFFER?
+ JMP LIST+3
+ JMS I PRINT /YES, PUNCH A CR-LF AND RETURN
+ JMP I LIST
+
+CMNT, JMS I PRINT /WE HAVE A COMMENT
+ DCA L24
+ JMS LIST
+ JMP START1 /ALLOW COMMENTS BEFORE SUBR. OR FUNCTION STMT.
+
+
+BAREA1, AREA1
+BAREA2, AREA2
+RCD, LRCD
+SSTYP, STYPE-1 /POINTER TO STATMENT TABLE IN FIELD 1
+WIPE, LWIPE
+STMT, LSTMT
+SWAP, LSWAP
+\f *400
+/ THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC
+/ IT PUTS ONE LINE INTO THE BUFFER,
+/ CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A
+/ CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN
+/
+LRCD, 0
+ DCA TEM1 /SAVE THE BUFFER POINTER
+ DCA I TEM1
+ DCA CHK /ZERO CONTINUATION FLAG
+ DCA L20 /ZERO THE EQUALS FLAG
+ DCA L61 /ZERO THE COMMENT FLAG
+ TAD CM111 /BUFFER LIMIT IS 72 CHARACTERS
+ DCA IX
+LRCDL, CLA
+ JMS LPTRIN
+ AND D177
+ SZA /LEADER OR BLANK TAPE?
+ TAD CM177
+ SNA /RUBOUT?
+ JMP LRCDL
+ TAD (177-15
+ SNA
+ JMP LCAR
+ TAD (15-11
+ SNA
+ JMP TAB
+ TAD (11-40
+ SPA
+ JMP LRCDL
+ TAD (40-75
+ SNA /AN '=' ?
+ ISZ L20
+ TAD C75 /CHAR OK... RESTORE IT & PUT IN BUFFER
+ JMS KRONK /PUT IT IN THE BUFFER...
+ JMP LRCDL /AND GET ANOTHER
+
+LCAR, TAD IX /PROCESS A CAR RETURN...
+ CIA
+ TAD CM111
+ SNA CLA /NULL STATEMENT?
+ JMP LRCDL /YES, IGNORE
+ JMS KRONK /PUT A ZERO IN THE BUFFER
+ TAD I TEM1
+ TAD CM3
+ SNA
+ JMP COMNT
+ TAD CM20
+ SZA CLA /TEST FOR "S" IN COLUMN ONE
+ JMP TINUE
+ JMP I (SCODE
+COMNT, ISZ L61 /SET COMMENT FLAG...
+ TAD C40
+ JMP STORSL
+
+TINUE, TAD TEM1 /CHECK FOR CONTINUATION...
+ TAD C3
+ DCA P /SET THE POINTER TO COLS. 6 AND 7
+ TAD I P
+ AND C5700 /NON-ZERO OR NON BLANK IN COL 6
+ TAD C4000 /MAKES THIS A CONTINUATION...
+ SNA CLA /IS IT?
+ JMP LRCDA /MAYBE...
+LRCDX, TAD B7 /YES, MAKE IT START IN COL 7
+ DCA KOUNT
+ ISZ CHK /INCREMENT THE CONTINUATION FLAG
+ TAD I TEM1
+STORSL, TAD C5700 /MAKE THIS INTO A COMMENT LINE
+ DCA I TEM1
+ JMP I LRCD /THEN RETURN
+
+LRCDA, TAD I P /NUMERIC AND NON-ZERO IN COL 7 MAKES
+ AND C77 /THIS A CONTINUATION...
+ TAD CM61
+ SPA CLA /IS IT?
+ JMP LRCDX+3 /NO, RETURN
+ IAC /YES, MAKE IT START IN COL 8
+ JMP LRCDX
+
+TAB, TAD C40 /PROCESS TAB CHARACTERS...
+ JMS KRONK /PUT SOME SPACES IN THE BUFFER
+ TAD IX
+ TAD C3 /MAKE 1ST TAB GO TO COL 7
+ SMA /ARE WE AT END OF THE BUFFER?
+ CLA /YES, FORCE TERMINATION
+ AND B7
+ SZA CLA /MODULO 8?
+ JMP TAB /NO, PUNCH SOME MORE SPACES
+ JMP LRCDL /YES, GET ANOTHER CHAR
+
+KRONK, 0 /PUT A CHARACTER IN THE BUFFER...
+ DCA CAR
+ CLA IAC
+ TAD IX /FIRST COMPUTE BUFFER ADDRESS...
+ SNA /PAST COL. 72?
+ JMP I KRONK /YES-RETN.
+ TAD C111 /NO
+ CLL RAR
+ TAD TEM1
+ DCA P
+ TAD CAR /PICK UP THE CHARACTER
+ AND C77
+ SZL /ZERO LINK SAYS WE WANT THE LEFT HALF
+ JMP .+5
+ RTL
+ RTL
+ RTL
+ DCA I P
+ TAD I P /ADD IN THE LEFT 6 BITS
+ DCA I P /AND SALT THEM AWAY...
+ ISZ IX /BUFFER OVERFLOW?
+ JMP I KRONK
+
+LPTRIN, 0 /PAPER TAPE READER INPUT ROUTINE
+ RSF
+ JMP .-1
+ RRB RFC
+ JMP I LPTRIN
+
+CAR, 0 /TEMPORARY, HOLDS THE CURRENT CHARACTER
+P, 0 /THIS IS THE BUFFER POINTER
+TEM1, 0 /THIS CONTAINS THE CURRENT BUFFER ADDRESS
+IX, 0 /THIS IS THE CHARACTER COUNTER
+CM111, -111 /MINUS THE BUFFER LIMIT PLUS ONE
+C111, 111 /THIS IS THE BUFFER LIMIT PLUS ONE
+D177, 177
+CM177, -177
+C75, 75
+B7, 7
+C5700, 5700
+CM61, -61
+CM20, -20
+M1700, -1700
+\f *600
+CAL, TAD KOUNT /SUBROUTINE CALL STMT PROCESSOR
+ DCA COUNT3
+ JMS I ENTITY
+ JMP I ASSIGN
+ JMP ON
+COUNT3, 0
+Q12, 12
+ JMP I ASSIGN
+ON, JMS I GNB
+ SNA /ANY ARGUMENTS?
+ JMP CR2 /NO
+ TAD CM50
+ SZA /MAYBE, IS THIS A '(' ?
+ JMP I ASSIGN
+ JMS I ZZZ /YES, PUNCH STMT NR, IF ANY
+ TAD COUNT3
+ DCA KOUNT
+ ISZ L44
+ DCA L46 /AC SWITCH
+ DCA L52 /IF STATEMENT SWITCH
+ JMS I GENER /LET TRIPLE GENERATOR PROCESS IT
+ DCA L46 /ZERO AC AGAIN
+ JMP START /COMPLETE, GET NEXT STATEMENT
+CR2, ISZ L32 /NO ARGUMENTS
+ JMS I SYMTAB
+ TAD L77
+ DCA GLU
+ JMS I ZZZ /PUNCH '<LABEL>, CALL 0,<NAME>'
+ JMS I FPROP
+GLU, 0
+ JMP START
+LGNB, 0
+ JMS LGTC
+ DCA GLU
+ TAD GLU
+ TAD CM40
+ SNA CLA
+ JMP LGNB+1
+ TAD GLU
+ JMP I LGNB
+LGETCH, 0
+ JMS I GNB
+ SNA /IS IT A END OF CARD
+ JMP PUNC /YES ITS PUNTUATION
+ TAD QM32
+ SPA SNA /IS IT ALPHABETIC
+ JMP ALPHA //YES
+ TAD CM40
+ CLL
+ TAD Q12
+ SZL /IS IT NUMERIC?
+ ISZ LGETCH /NUMERIC
+PUNC, ISZ LGETCH /PUNCTUATION
+ALPHA, CLA /ALPHABETIC
+ TAD GLU
+ JMP I LGETCH /RETURN
+/ THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER
+/ ROUTINE SKIPS IF SYMBOL IS INTEGER
+LMODE, 0
+ SMA /IF ITS PLUS WE HAVE AN INTEGER
+ JMP AINT /WE HAVE AN INTEGER
+ RAL /GET NEXT BIT
+ SPA /CHECK THIS BIT
+ JMP FV /ITS EITHER A FCON OR VARIABLE
+ RTL /GET NEXT TWO BITS
+ SNL /IS IT AN OPERATOR
+ERR2, JMS I LUNCH /YES
+AFP, SMA CLA /CHECK THIS BIT
+ JMP AINT /ITS AN INTEGER
+ JMP I LMODE /SYMBOL WAS F P MODE
+FV, RAR /RESTORE AC TO ORIGINAL CONTENTS
+ CIA /SET NEGATIVE
+ TAD L47 /ADD START OF FCON TABLE
+ SPA /IS /SYMBOL FCON
+ JMP AFP /YES
+ CIA /NO /RESTORE AC AGAIN
+ TAD L47
+ DCA ATEM /SAVE THE RESTORED NUMBER
+ TAD I ATEM /GET THE POINTER TO THE VARIABLE
+ TAD CM1100 /SUBTRACT AN I
+ SPA /IS IT LESS THAN I
+ JMP AFP /YES ITS FLOATING POINT
+ TAD CON1 /NOW SUBTRACT AN N
+ SPA CLA /IS IT LESS THAN N
+AINT, ISZ LMODE /YES
+CON1, CLA /CLEAR THE AC FOR THE RETURN
+ JMP I LMODE
+ATEM, 0
+CM1100, -1100
+QM32, -32
+LGTC, 0 /GET A CHARACTER FROM THE BUFFER
+ TAD KOUNT
+ ISZ KOUNT
+ CLL RAR /LINK TELLS IF LEFT OR RIGHT HALF
+ TAD BASE
+ DCA GLU
+ TAD I GLU
+ SZL /WHICH CHARACTER
+ JMP MMSK
+ RTR
+ RTR
+ RTR
+MMSK, AND C77
+ SZA
+ JMP I LGTC
+ TAD CHK
+ SPA CLA /DO WE WANT A NEW LINE YET?
+ JMP I LGTC /NOT YET...
+ TAD BASE2 /YES, USE THE ALTERNATE BUFFER
+ JMS I RLCD
+ TAD CHK
+ SZA CLA /IS IT A CONTINUATION?
+ JMP .+4
+ CMA /NO, SET FLAG AND RETURN W ZERO AC
+ DCA CHK
+ JMP I LGTC
+ JMS LSWAP /YES, SWITCH BUFFERS AND CONTINUE
+ DCA CHK
+ JMP LGTC+1
+
+RLCD, LRCD
+LSWAP, 0 /SWITCH THE LINE BUFFER POINTERS
+ TAD BASE
+ DCA ATEM
+ TAD BASE2
+ DCA BASE
+ TAD ATEM
+ DCA BASE2
+ JMP I LSWAP
+\f *1000
+/ THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS
+/ IN LOC 41, THE CURRENT TRIPLE NUMBER IS IN LOCATION 40
+/ LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT.
+PBEGN, AREA2 /START OF THE PRECEDENCE LIST
+BINTEG, TAD L32 /HERE IF ENTITY SENT AN INTEGER
+ JMP I BPUSH /PUSH IT INTO STACK
+FLPT, JMS I FCON /HERE IF ENTITY FOUND A FLOATING POINT CON
+ SKP /ENTER IT INTO FPTABLE
+BLPHA, JMS I SYMTAB /HERE IF ENTITY FOUND A VARIABLE
+ TAD L77 /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN
+ JMP I BPUSH /PUSH IT DOWN
+LABELX, JMP I LGENER
+LGENER, 0 /ENTRY POINT
+ TAD C5000
+ DCA L40 /*
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ TAD L71
+ DCA L41 /SET PUSH DOWN POINTER
+ DCA L22
+ DCA BPAREN /ZERO OUT THE PAREN SWITCH
+ TAD C4000
+ DCA I L41 /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0
+BNEXT, JMS I ENTITY /THIS WILL GET THE NEXT DATUM TO BE PROCESSE
+ JMP HOO /END OF STATEMENT RETURN,TREAT LIKE PUNCTION
+ JMP BLPHA /VARIABLE RETURN
+ JMP BINTEG /INTEGER RETURN
+ JMP FLPT /FLOATING POINT RETURN
+HOO, TAD CM50 /PUNCTIOATION RETURN,
+ SNA /IS IT (
+ JMP I BPAR /YES
+ TAD C7753
+ SZA /IS IT AN '=' ?
+ JMP BRET
+ TAD L44 /WE HAVE AN '=', IS IT LEGAL?
+ SNA CLA
+ JMP BRET /IT IS
+ TAD IMPDO
+ SZA CLA /ARE WE IN AN IMPLIED DO LOOP?
+ JMP I PIOEQL /YES - TERMINATE LOOP CODE
+ERR3, JMS I LUNCH
+PIOEQL, IOEQL
+BRET, TAD C0075
+ DCA L63
+ TAD I L41 /CHECK FOR A UNARY OPERATOR
+ TAD C4000
+ AND C7000
+ SZA CLA /WAS IT AN OPERAATOR AT ALL
+ JMP PREC /NO, STILL NOT UNARY OPERATOR
+ TAD L63
+ TAD C7725
+ SNA /IS IT A '+'
+ JMP BNEXT /YES, IGNORE IT
+ TAD CM2 /NO
+ SZA CLA /IS IT A '-' ?
+ JMP ERR3
+ TAD C4643 /THIS IS THE UNARY MINUS
+ JMP I BPUSH
+PREC, TAD PBEGN /HERE IS WHERE WE FIND THE PRECIDENCE
+ DCA L17
+ DCA L65
+ SKP
+RETUR, ISZ L17 /PICK UP NEXT OP CODE IN LIST
+ TAD I L17 /TO GET THE NEXT LIST ITEM
+ SMA SZA /IS THIS THE END OF THE LIST
+ JMP BMORE /NO, THE ASSUMPTION IS THAT THE PRECIDENCE
+ TAD L63 /IS ZERO
+ SZA CLA /IS THIS THE RIGHT TABLE ENTRY
+ JMP RETUR /TRY AGAIN (IT WASN"T)
+ TAD I L17 /TO GET THE PRECEDENCE
+ DCA L65
+BMORE, CLA IAC /HERE WE ARE GOING TO SEE IF THERE IS A PREC
+ TAD L41
+ DCA L64 /L64 NOW POINTS TO THE PREVIOUS OPERATOR
+ TAD I L64
+ TAD C4000
+ AND C7000
+ SZA /IS THERE A VALID OPERATOR ON THE STACK?
+ JMP ERR3 /APPARENTLY NOT...
+ TAD I L64 /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR
+ AND C700 /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER
+ SNA /THAN OR EQUAL TO THE PRECEDENCE OF THE
+ JMP NO /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS
+ CIA /OPERATOR; IF NOT WE WILL PROBABLY PUT
+ TAD L65 /THE CURRENT OPERATOR ON THE STACK AND GET
+ SMA SZA CLA /ANOTHER ITEM FROM THE STATEMENT BUFFER...
+ JMP NO
+ ISZ L40 /YES, INCREMENT THE TRIPLE NUMBER AND....
+ JMS I TRIPL /PROCESS THE PREVIOUS OPERATOR
+ ISZ L41 /*****NOTE WHAT IF IT WAS UNARY************
+ TAD I L41
+ TAD C3135 /THIS IS MINUS UNARY MINUS
+ SZA CLA
+ ISZ L41 /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR
+ TAD L46
+ DCA I L41
+ JMP BMORE /TRY FOR ANOTHER TRIPLE
+NO, TAD L63
+ SNA /IS IT A END OF STATEMENT MARK
+ JMP I LCDONE /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING
+ TAD CM51
+ SNA /IS IT A ')' ?
+ JMP I LKPAR /YES
+ TAD CM3
+ SZA /IS IT A ',' ?
+ JMP NCOMMA /NO
+ TAD BPAREN
+ SNA CLA /IS A COMMA LEGAL HERE?
+ JMP I LCDONE /MAYBE...
+NCOMMA, TAD CM21
+ SNA CLA /IS IT AN EQUALS SIGN?
+ ISZ L44 /YES - SET EQUALS SWITCH ON
+ TAD L63 /PUT THE OPERATOR ON THE STACK
+ TAD L65 /ADD THE PRECEDENCE
+ TAD C4000
+ JMP I BPUSH
+/
+BPUSH, PUSH
+C5000, 5000
+BPAR, ALPAR
+C7753, 7753
+C0075, 75
+C7000, 7000
+CM21, -21
+C7725, 7725
+C4643, 4643
+C700, 700
+C3135, 3135
+LCDONE, CDONE
+LKPAR, KPAR
+FCON, LFCON
+\f *1200
+PUSH, DCA L63
+ CLA CMA
+ TAD L41 /SPACE THE POINTER UP ONE
+ DCA L41 /*
+ TAD L63
+ DCA I L41 /*
+ JMP I LBNEXT /BACK TO BEGINING
+/ THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS---
+/ IF ARITHMETIC, JUST DELETE BOTH ( AND )
+KPAR, TAD I L64
+ TAD C3730 /MINUS LEFT PAREN
+ SZA /IS IT (
+ JMP BCON /NO-- CHECK SOME MORE
+ TAD I L41 /DELETE PARENS
+ DCA I L64
+ ISZ L41 /UPDATE POINTER
+LAPP, ISZ BPAREN /DO PARENS BALENCE
+ JMP I LBNEXT
+ TAD L52 /YES
+ SNA CLA /SHOULD WE RETURN IF BALANCED
+ JMP I LBNEXT
+ TAD L46
+ SZA CLA
+ JMP CDONE
+ TAD I L41
+ DCA L77
+ JMS I XTAD /GENERATE TAD OR (TAD I)
+ DCA I L41 /ZERO IS INTEGER
+CDONE, TAD L41
+ CMA
+ TAD L71
+ SZA /WELL...
+ERR6, JMS I LUNCH /HA...YOU GOOFED
+ JMS I XZQ
+ JMP I .+1
+ LABELX
+BCON, IAC /IS IT FUNCTION
+ ISZ L40
+ SNA
+ JMP BFOUT /YES
+ IAC /NO-- NOW IS IT SUBSCRIPT
+ SNA
+ JMP SOUT /YES
+ TAD C7772 /NO
+ SZA /IS IT COMMA
+ JMP ERR6 /NO - BYE BYE CHARLIE
+ ISZ L64
+ ISZ L64
+ TAD I L64
+ TAD C3724 /IS IT A COMMA
+ SNA
+ JMP BFOUT /FOUND TWO COMMAS,MUST BE FUNCTION
+ TAD C5 /NO
+ SNA /IS IT A PRIME
+ JMP BFOUT /GOT A FUNCTION
+ IAC /NO
+ SZA CLA
+ JMP ERR6 /SORRY, IT AIN'T NUTTIN
+SOUT, JMS I PLSBSC /PROCESS A SUBSCRIPT
+ CMA
+ TAD L22
+ DCA L22
+ SKP
+BFOUT, JMS I FUNCT
+ JMP LAPP
+FUNCT, LFUNCT
+/ THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR
+ALPAR, CMA
+ TAD BPAREN
+ DCA BPAREN
+ TAD I L41
+ TAD C4000
+ AND B7000 /IS IT AN OPERAND
+ SZA CLA
+ JMP CUNT /NO , TRY SOME MORE
+ IAC
+ JMP PRIME
+CUNT, TAD I L41 /PICK UP TOP LIST ITEM
+ TAD C2 /ADD TWO TO FIND THE DIMENSION INTO(INFO)
+ DCA L64
+ TAD I L64
+ AND C20 /JUST WANT ONLY THIS ONE BIT(DIMENSION)
+ SNA CLA /IS IT DIMENSIONED
+ JMP PRIME /NO ITS GOT TO BE A FUNCTION CALL
+ ISZ L22
+ CMA
+PRIME, TAD C4047
+ JMP PUSH /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN
+XZQ, LXZQ
+LBNEXT, BNEXT
+C3730, 3730
+C7772, 7772
+C3724, 3724
+C5, 5
+D7, 7
+B7000, 7000
+C20, 20
+C4047, 4047
+XTAD, LXTAD
+LPUTCH, 0
+ CLA CMA
+ TAD KOUNT
+ DCA KOUNT
+ JMP I LPUTCH
+
+LASIGN, TAD L20 /ARITHMETIC STATEMENT PROCESSOR
+ SNA CLA /IS THERE AN '=' IN THE STMT?
+ERR9, JMS I LUNCH /NO, BETTER COMPLAIN...
+ TAD D7 /SET POINTER TO COL 7
+ DCA KOUNT
+ JMS I ZZZ /PUNCH THE LABEL, IF ANY
+ DCA L46
+ DCA L44
+ DCA L52
+ JMS I GENER /PROCESS IT...
+ TAD L63
+ SZA CLA /WAS TERMINATOR A <CR/LF> ?
+ JMP ERR9 /NO, ILLEGAL STATEMENT ERROR ...
+ JMP START
+PLSBSC, LSUBSC
+
+LPRCRL, 0 /SUBROUTINE PRINTS CREATED LABELS
+ DCA LPRCTM
+ TAD C36 /PUNCH '^'
+ JMS I PRINT
+ TAD LPRCTM /PUNCH THE LETTERS
+ JMS I P2
+ JMP I LPRCRL
+C36, 36
+LPRCTM, 0
+\f *1400
+PRET, ISZ LENTT /PUNCTIONATION EXIT POINT
+FRET, ISZ LENTT /FLOATING POINT EXIT POINT
+XIRET, ISZ LENTT /INTEGER EXIT POINT
+XARET, ISZ LENTT /VARIABLE EXIT
+ERET, JMP I LENTT /CR END OF LINE EXIT
+LENTT, 0 /ENTRY POINT
+ CLA /WIPE OUT PSEUDO ACCUMULATOR
+ DCA L32
+ DCA L31
+ DCA COUNT2 /RESET ALL KINDS OF THINGS TO ZERO
+ DCA L36
+ DCA L37
+ DCA L30
+ DCA FPSW
+ DCA ESIGN
+ TAD CM6
+ DCA L65 /SET UP FOR MAXIMUM OF 6 CHARS
+ JMS I GETCH /GET THE FIRST INPUT CHARACTER
+ JMP .+3 /ALPHA RETURN
+ JMP PUNCT /PUNCTIONATION RETURN
+ JMP DIG /DIGIT RETURN
+ JMS PACK /STORE THIS CHARACTER
+ JMS I GETCH /GET ANOTHER CHACTER
+ JMP .-2 /ALPHA- IS OK
+ SKP /PUNCTUATION
+ JMP .-4 /DIGIT--IS OK PROCESS IT
+ JMS I PUTCH /PUT THAT PUNCTUATION BACK IN THE BUFFER
+ TAD L32
+ AND CC7700 /MAKE SURE NAME IS <= 5 CHARACTERS LONG
+ DCA L32
+ JMP XARET /RETURN WITH VARIABLE
+
+PACK, 0 /THIS PACK CHARS INTO L30 L31 AND L32
+ DCA L64 /SAVE THE CHAR...
+ TAD L65
+ SNA /DO WE HAVE SIX CHARS ALREADY?
+ JMP I PACK /YES - IGNORE
+ STL; RAR
+ TAD P33
+ DCA LTEM
+ ISZ L65
+C7, 7
+ TAD L64
+ CDF 10
+ SNL /DO WE HAVE LEFT OR RIGHT HALF?
+ JMP .+5
+ CLL RTL /MUST BE LEFT HALF...
+ RTL
+ RTL
+ SKP
+ TAD I LTEM
+ DCA I LTEM
+ CDF 00
+ JMP I PACK
+LTEM, 0
+
+PUNCT, SNA /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET
+ JMP ERET /YES, GO RIGHT BACKTO THE CALLER....BY-BY
+ TAD C7722 /IS IT A PERIOD
+ SNA
+ JMP CC /YES--WE ASSUME THAT THIS LENTT IS A FLOATING
+ TAD C7
+ SNA /IS IT A QUOTE?
+ JMP I QUOTE /YES - CHARACTER LITERAL
+ TAD CM3
+ SZA /IS IT AN ASTERISK
+ JMP NAH /NO
+ JMS I GETCH /YES- PEEK AT NEXT CHAR
+ JMP NOASS /ALPHA-- PUT IT BACK
+ JMP ASSCK /PUNCTUATION-- CHECK FOR AN ASTERISK
+NOASS, JMS I PUTCH /DIGIT---PUT IT BACK
+NAH, TAD X52 /RESTORE CHARACTER TO WHAT IT WAS
+ JMP PRET /THATS ALL---IT WAS PUNCTIONATION
+ASSCK, TAD CM52 /ANOTHER PUNCTUATION--IS IT (*)
+ SZA
+ JMP NOASS /NO---PUT IT BACK
+ TAD C45 /IT WAS-- CHANGE ** TO PERCENT
+ JMP PRET /---ALTERED PUNCTUATION
+DIG, AND C17 /FIRST CHAR WAS A DIGIT, DONT KNOW IS INTEGER O
+ DCA L32 /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER
+CA, JMS I GETCH /GET ANOTHER CHACTER
+ JMP I LTESTE /ALPHA--GO SEE IF IT IS AN -E-
+ SKP /PUNCT
+ JMP BONT /DIGIT GO PROCESS IT
+ TAD C7722 /PUNCTUATION HERE, IS IT A PERIOD
+ SZA
+ JMP I LCOP / IT IS . WE HAVE A FLOATING POINT NUMBER
+CC, TAD FPSW
+ SZA
+ERR10, JMS I LUNCH /TOO MANY (.)
+ ISZ FPSW
+ DCA COUNT2
+ JMP CA /GO BACK AND GET ANOTHER CHAR
+BONT, AND C17 /***COME HERE WITH ANOTHER DIGIT.
+ DCA L36 /SAVE IT
+ ISZ COUNT2
+ JMS I LMUL10 / AC = AC * 10 + DIGIT
+ JMP CA /GO GET ANOTHER CHAR
+P33, L30+3
+CM6, -6
+C7722, 7722
+X52, 52
+CM52, -52
+C17, 17
+LTESTE, TESTE
+C45, 45
+LCOP, COP
+LMUL10, MUL10
+QUOTE, LQUOTE
+
+
+DMPLIN, 0 /SUBROUTINE TO DUMP "LAST LINE" BUFFER
+ ISZ L24
+ TAD I L24 /GET NEXT CHAR
+ JMS I PUNCH /PUNCH IT
+ TAD I L24
+ TAD CM212
+ SZA CLA /IS CHAR A LINE FEED?
+ JMP DMPLIN+1 /NO
+ CLA IAC
+ DCA L24 /RESET POINTER
+ DCA L12 /ZERO CONTENTS FLAG
+ JMP I DMPLIN /RETURN
+CM212, -212
+CC7700, 7700
+\f *1600
+TESTE, TAD C7773 /IS IT E
+ SZA
+ JMP COP /NO, GO PUT IT BACK AND PROCESS
+/ HERE IF EXPONENT FOLLOWES
+ DCA L37 /IT WAS AN E
+/ THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE
+/
+ ISZ FPSW /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED
+ JMS I GETCH /GET ANOTHER CHAR
+ JMP ERR12 /ALPHA , CANT BE-- SO LONG, ITS BEEN NICE
+ SKP /PUNCT
+ JMP CD /DIGIT, GO PROCESS IT
+ TAD X7725 /IS IT PULS SIGN
+ SNA
+ JMP CF /YES, IGNOR IT
+ TAD CM2
+ SZA /IS IT MINUS
+ JMP COP /NO, GO PROCESS THE FLOATING POINT NUMBER
+ CLA CMA
+ DCA ESIGN /YES- REMEMBER THAT THE EXPONENT WAS MINUS
+CF, JMS I GETCH /GET ANOTHER CHAR
+ JMP COP /ALPHA, ALL READY TO PROCESS
+ JMP COP /PUNCTUATION, READY TO PROCESS
+CD, AND X17 /DIGIT
+ DCA L36 /SAVE IT IN 36 AND..
+ TAD L37 /MULTIPLY THE - EXPONENT TO DATE- BY 10
+ RAL CLL
+ DCA L37
+ TAD L37
+ RAL CLL
+ RAL CLL
+ TAD L37
+ TAD L36 /AND ADD IN THIS DIGIT I.E. 37C10*
+ DCA L37 / L37 = 10 * L37 + L36
+ JMP CF /GO DO IT AGAIN
+COP, JMS I PUTCH
+ CLA CLL /PROCESS THIS NUMBER
+ TAD FPSW /IS IT AN INTEGER
+ SZA CLA
+ JMP CH /NO, MUST BE FLOATING POINT
+/ INTEGER IS IN ACC
+ TAD L30 /YESS
+ SNA /MAKE SURE INTEGER IS VALID
+ TAD L31
+ SZA CLA
+ JMP ERR12
+ TAD L32
+ SPA CLA
+ERR12, JMS I LUNCH /TOO BIG
+ JMP I .+1 /TAKE INTEGER RETURN WITH INTEGER IN 32
+ XIRET
+CH, TAD L37 /WAS THIS AN E-CONVERSION NUMBER
+ ISZ ESIGN /EXPONENT POSITIVE?
+ CIA /YES
+ TAD COUNT2 /ADD POST-DECIMAL COUNTER
+ CLL
+ SNA
+ JMP CM /NOTHING TO DO
+ SMA /DETERMINE WHETHER TO
+ CML CIA /MULTIPLY OR DIVIDE
+ DCA COUNT2
+ RAL
+ TAD CJ
+ DCA CK
+ JMS XFLOAT /SET UP THE NUMBER
+CK, HLT /JMP I (MULT OR JMP I (DIVIDE
+ ISZ COUNT2
+ JMP CK /LOOP ON COUNT
+ JMP I LPOLIS /FINISH UP
+
+CM, JMS XFLOAT
+ JMP I LPOLIS
+CJ, JMS I .+1
+ MULT
+ DIVIDE
+
+/ THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT
+XFLOAT, 0
+ CLA CLL
+ TAD L32 /CHECK IF THE ACCUMULATED NUMBER IS ZERO
+ SNA
+ TAD L31
+ SNA
+ TAD L30
+ SNA CLA
+ JMP I LFRET /IT WAS ZERO SEND A FLOATING POINT ZERO BACK--
+ TAD C2440 /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10
+ DCA L37
+ JMS NORMAL /GO TO THE NORMALIZE ROUTINE
+ JMP I XFLOAT /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA
+/ ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U
+/ NORMAL IZATION OF A F P NUMBER
+NORMAL, 0
+DA, TAD L30 /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N
+ SPA CLA
+ JMP I NORMAL /IT IS NEG., ALL DONE
+ JMS I LLSHIF /GO DO A TRIPLE PRECISION LEFT SHIFT
+ TAD L37 /AND SUBTRACT ONE FROM THE EXPONENT
+ TAD C7770 /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED
+ SPA /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW
+ JMP ERR12 /BY-BY NUMBER TOO LARGE FOR THE MACHINE
+ DCA L37
+ JMP DA
+/ THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ
+C7773, 7773
+X7725, 7725
+X17, 17
+C7770, 7770
+LPOLIS, POLISH
+LFRET, FRET
+C2440, 2440
+LLSHIF, LSHIFT
+
+SCODE, CDF 10 /SHIFT S-CODE 2 COLS. LEFT
+ TAD I (TEM1
+ CDF 0
+ DCA SLOC1
+ TAD SLOC1
+ IAC
+ DCA SLOC2
+ ISZ L61 /SET COMMENT FLAG
+SCODL, TAD I SLOC2
+ DCA I SLOC1
+ TAD I SLOC2
+ AND C77
+ SNA CLA /END OF LINE?
+ JMP I (STORSL+2
+ ISZ SLOC1
+ ISZ SLOC2
+ JMP SCODL /AND CONTINUE PROCESS
+
+SLOC1, 0
+SLOC2, 0
+\f *2000
+XSAVE, 0 /-- THE F.P. AC IS IN LOCS 30-32
+ TAD L30 /-- THE "MQ" IS IN LOCS 33-35
+ DCA L33 /---THE EXPONENT IS IN LOCS 37
+ TAD L31
+ DCA L34
+ TAD L32
+ DCA L35
+ JMP I XSAVE
+/ SHIFTS THE PSEUDO-ACC LEFT ONE PLACE
+LSHIFT, 0
+ CLA CLL
+ TAD L32
+ RAL
+ DCA L32
+ TAD L31
+ RAL
+ DCA L31
+ TAD L30
+ RAL
+ DCA L30
+ JMP I LSHIFT
+/ THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC
+ADD, 0
+ CLA CLL
+ TAD L32
+ TAD L35
+ DCA L32
+ RAL
+ TAD L31
+ TAD L34
+ DCA L31
+ RAL
+ TAD L30
+ TAD L33
+ DCA L30
+ JMP I ADD
+/ THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE
+RSHIFT, 0
+ CLA CLL
+ TAD L30
+ RAR
+ DCA L30
+ TAD L31
+ RAR
+ DCA L31
+ TAD L32
+ RAR
+ DCA L32
+ JMP I RSHIFT
+/
+/
+MULT, 0 /ACCCACC*10 MQ
+ JMS RSHIFT
+ JMS XSAVE
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS ADD /THIS FINISHES THE MULT BY 10
+ TAD L37 /NOW DIDDLE THE EXPONENT
+ TAD C40
+ SPA /OVERFLOW TEST
+ERR14, JMS I LUNCH /FLOATING POINT OVERFLOW
+ DCA L37
+ JMS I LNRMAL /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO
+ JMP I MULT
+DIVIDE, 0 /DIVIDE THE F P NUMBER BY 10
+ JMS RSHIFT /BASED ON THE FACT THAT .1 BASE 10 C .000110011
+ JMS XSAVE /THAT IS WE MULTIPLE BY ONE TENTH
+ TAD C7766 /THIS IS A COUNTER**********************
+ DCA ZCTR
+DB, JMS RSHIFT
+ JMS ADD
+ ISZ ZCTR
+ SKP
+ JMP DC
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS ADD
+ JMP DB
+DC, TAD L37
+ TAD C7750 /********INSERT HERE THE CONSTANT************
+ DCA L37 /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP
+ JMS I LNRMAL /MAKE SURE IT IS STILL NORMALIZ D
+ JMP I DIVIDE
+ZCTR, 0
+MUL10, 0 /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E
+ JMS LSHIFT /BY 10
+ JMS XSAVE
+ JMS LSHIFT
+ JMS LSHIFT
+ JMS ADD
+ TAD L36 /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH
+ DCA L35 /*
+ DCA L34
+ DCA L33
+ JMS ADD /AND ADD IT TO THE ACC
+ JMP I MUL10 /IN OTHER WORDS ACCCACC*10 DIGIT
+POLISH, CLA CLL /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT.
+ TAD C400 /AND PUTS THEM INTO 7090 FORM. THIS IS THE R-U
+ DCA L35 /27 DIGITS
+ DCA L34 /ROUND FACTOR IS CRAMED INTO THE MQ
+ DCA L33
+ JMS ADD /AND ADDED TO THE INTEGER IN THE ACC
+ SNL /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY
+ JMP POLSH /WE DIDNT
+ TAD C4000 /SET THE ACC TO .1000000000 (THE REST OF IT IS
+ DCA L30
+ TAD L37 /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N
+ TAD J10
+ SNA
+ JMP ERR14 /EXPONENT OVERFLOW ...
+ DCA L37
+POLSH, TAD C7767 /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES
+ DCA ZCTR /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E
+HOOP, JMS RSHIFT
+ ISZ ZCTR
+ JMP HOOP
+ TAD L37 /CRAM THE EXP
+ TAD L30 /INTO THE ACC
+ DCA L30 /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX
+ JMP I .+1
+ FRET
+LNRMAL, NORMAL
+C7766, 7766
+C7750, 7750
+C400, 400
+J10, 10
+C7767, 7767
+\f *2200
+/ THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER
+LSTMT, 0
+ JMS I CLEAR /CLEAR THE PSEUDO ACC AND MQ
+ TAD C7240 /DON'T LET LGTC GET ANOTHER LINE YET(CHK MUST BE NEG., BUT NOT 4000!!)
+ DCA CHK
+ IAC
+ DCA KOUNT
+LABEL, JMS I GTCL /GET A CHARACTER
+ SNA /IS THIS A CAR RET?
+ERR15, JMS I LUNCH /YES, INCOMPLETE STATEMENT
+ TAD CM40
+ SNA /SPACE?
+ JMP SPACE
+ TAD CM32
+ CLL
+ TAD C12
+ SNL / 260 <= CHAR < 272 ?
+ERR16, JMS I LUNCH
+ DCA L36 /SAVE THIS DIGIT...
+ JMS I MULT10 / ACC = 10 * ACC + L36
+SPACE, TAD KOUNT
+ TAD DM6
+ SPA CLA /END OF STMT NR FIELD?
+ JMP LABEL /NOT YET...
+ JMS I GTCL /SKIP OVER COL 6
+ SNA CLA /IS IT A CAR RET?
+ JMP ERR15
+ TAD L31 /SEE IF STMT NR IS LEGAL...
+ SZA
+ JMP ERR16
+ TAD L32
+ SPA CLA /IS STMT NR < 2048 ?
+ JMP ERR16 /NO, STMT NR TOO BIG
+ JMP I LSTMT
+CLEAR, LCLEAR
+GTCL, LGTC
+MULT10, MUL10
+CM32, -32
+DM6, -6
+C12, 12
+/
+/ SUBROUTINEE TO PRINT A SYMBOL
+/
+/ JMS I PRSYM
+/
+LPRSYM, 0 /THIS ROUTINE PRINTS SYMBOLS
+ DCA LCH
+ TAD LCH
+ SMA /IS IT AN INTEGER CONSTANT
+ JMP ICON /YES PROCESS IT
+ RTL /SHIFT THE NEXT BIT INTO THE LINK
+ SNL /IS IT A TEMPORARY
+ JMP TEMPO /ITS A TEMPORARY
+ RTR /RESTORE THE SYMBOL
+ CIA /SET IT NEGATIVE
+ TAD L47 /SUBTRACT THE BEGINNING OF THE XFCON TABLE
+ SPA CLA /DO WE HAVE AN FCON
+ JMP XFCON /YES PROCESS IT
+ TAD LCH
+ TAD C2 /ADD TWO TO THE SYMBOL TABLE POINTER
+ DCA LP2 /AND SAVE IT
+ TAD I LP2 /GET THE CONTROL BITS FOR THE SYMBOL
+ RAR /GET EXTERNAL SUBROUTINE BIT IN LINK
+ SZL CLA /IS THIS AN EXTERNAL SUBROUTINE
+ JMP SKPIT /YES...DONT PUT OUT THE BACK SLASH
+ TAD C34
+ JMS I PRINT
+SKPIT, TAD I LCH
+ JMS LP2 /PRINT THEM
+ ISZ LCH
+ TAD I LCH
+ JMS LP2 /AND PRINT THEM
+ ISZ LCH
+ TAD I LCH
+ AND X7700 /MASK SO WE DONT PUT OUT CONTROL BITS
+ JMS LP2 /AND PRINT IT
+ JMP I LPRSYM /NOW RETURN
+LP2, 0 /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS
+ DCA UNCH /SAVE THE CHARS
+ TAD UNCH /GET THEM AGAIN
+ RTR /ROTAT FIRST CHAR INTO POSITION
+ RTR
+ RTR
+ AND C77 /MASK SECOND CHARACTER
+ SZA /IS IT AN ACTUAL CHARACTER
+ JMS I PRINT /YES PRINT IT
+ TAD UNCH /GET THE TWO CHARS AGAIN
+ AND C77 /MASK OUT FIRST CHARACTER
+ SZA /IS IT ACTUALLY A CHARACTER
+ JMS I PRINT /YES PRINT IT
+ JMP I LP2 /AND RETURN
+ICON, CLA /INTEGER CONSTANT, PUNCH A '('
+ TAD K50
+ JMS I PRINT
+ TAD LCH /AND THE NUMBER
+PROCT, JMS I PROTAC
+ JMP I LPRSYM /RETURN
+TEMPO, RTL
+ SPA CLA /SUBSCRIPT TEMPORARY?
+ JMP SBSCR
+ RTL
+ TAD D33 /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT
+ JMS I PRINT /AND PRINT IT
+ TAD LCH
+ SPA /DO WE STILL HAVE A TEMPORARY
+ JMS I TEMPOR /YES GET THE TEMPORARY NUMBER
+ JMS I PRINT /AND PRINT IT
+ JMP I LPRSYM /RETURN
+SBSCR, TAD D33 /SUBSCRIPT TEMPORARY, PUNCH A '['
+ JMS I PRINT
+ TAD LCH
+ JMS I SUBTEM /AND 4 DIGITS
+ JMP PROCT
+XFCON, TAD C35 /FLOATING POINT CONSTANT...
+ JMS I PRINT /PUNCH A ']'
+ TAD LCH
+ CIA
+ TAD L50 /SUBTRACT FROM END OF TABLE
+ JMP PROCT
+D33, 33
+C35, 35
+K50, 50
+C34, 34
+X7700, 7700
+LCH, 0
+UNCH, 0
+SUBTEM, LSBTEM
+TEMPOR, LTMPOR
+\f *2400
+/
+/ SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS
+/
+C300, 300
+C212, 212
+C215, 215
+SCOUNT, 0 /CURRENT NUMBER OF SYMBOLS
+XCTR, 0 /COUNTER
+FCOUNT, 0 /CURRENT NUMBER OF FCONS
+LSYMTB, 0
+ CLA /CLEAR THE AC
+LOOP1, TAD L56 /GET BEGINNING OF SYMBOL TABLE
+ DCA LSYMTM /AND SAVE IN TABLE
+ TAD SCOUNT /GET NUMBER OF SYMBOLS CURRENTLY
+ CMA
+ DCA XCTR /USE AS A COUNTER
+ TAD C7700 /GIVE SEARCH A MASK TO USE ON LAST SYMBOL
+ JMS SEARCH /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE
+ JMP ZCHECK /SYMBOL IS IN TABLE CHECK IT
+ TAD L57 /TELL ENTER WHERE TO PUT THE SYMBOL
+ JMS ENTER /ENTER THE SYMBOL
+ TAD C3 /UPDATE THE POINTER
+ DCA L57 /AND SAVE IT
+ DCA L21 /ZERO SWITCH SINCE SYMBOL JUST LOADED
+ ISZ SCOUNT /UPDATE COUNT OF SYMBOLS
+ JMP LOOP1 /GO BACK AND CHECK IT
+ZCHECK, TAD L77 /GET POINTER INTO SYMBOL TABLE
+ TAD C2 /MOVE TO LAST WORD
+ DCA LSYMTM /SAVE IT
+ TAD I LSYMTM /GET THE CONTROL BITS
+ AND L21 /AND THE MASK
+ SZA CLA /ARE ANY ILLEGAL BITS ON
+ERR54, JMS I LUNCH /ERROR 54 ... PROBABLY IN EQUIVALENCING ...
+ TAD L32 /NOW OR IN NEW BITS
+ CMA
+ AND I LSYMTM
+ TAD L32
+ DCA I LSYMTM
+ JMP I LSYMTB /RETURN
+/ FLOATING CONSTANT IS IN 30 THRU 32
+LFCON, 0
+ CLA
+MLOOP, TAD L47 /GET BEGINNING OF FCON TABLE
+ TAD C3 /MOVE TO ACTUAL START OF TABLE
+ DCA LSYMTM /AND SAVE
+ TAD FCOUNT /GET NUMBER OF FCONS SO FAR
+ CMA
+ DCA XCTR /AND USE FOR A COUNTER
+ CMA /GIVE SEARCH A MASK FOR THE LAST WORD
+ JMS SEARCH /SEARCH THE TABLE FOR THE CURRENT FCON
+ JMP I LFCON /ITS ALREADY IN THERE JUST RETURN
+ TAD L47 /TELL ENTER WHERE TO PUT THE FCON
+ JMS ENTER /ENTER THE FCON
+ TAD CM3 /AND UPDATE IT
+ DCA L47 /AND SAVE
+ ISZ FCOUNT /UPDATE NUMBER OF FCONS
+ JMP MLOOP /GO BACK AND CHECK
+/ THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR
+/ OCCURRENCES OF THE CURRENT SYMBOL OR FCON
+SEARCH, 0
+ DCA ENTER /SAVE THE MASK
+MBACK, ISZ XCTR /SEE IF WE HAVE PROCESSED ALL SYMBOLS
+ SKP /NO GO ON
+ JMP QRET /YES
+ TAD I LSYMTM /GET FIRST WORD OF SYMBOL
+ CIA /NEGATE
+ TAD L30 /SUBTRACT FIRST WORD OF CURRENT SYMBOL
+ ISZ LSYMTM /INCREMENT POINTER
+ SZA CLA /DO THEY MATCH
+ JMP I1 /NO GO TO NEXT SYMBOL
+ TAD I LSYMTM /YES GET SECOND WORD OF SYMBOL
+ CIA
+ TAD L31 /SUBTRACT SECOND WORD OF CURRENT SYMBOL
+ ISZ LSYMTM /ADVANCE POINTER
+ SZA CLA /DO THEY MATCH
+ JMP I2 /NO GO TO NEXT SYMBOL
+ TAD I LSYMTM /SEE IF NEXT WORD MATCHES
+ AND ENTER /MASK OUT DESIRED PORTIONS
+ CIA
+ TAD L32 /SUBTRACT THIRD CURRENT WORD
+ AND ENTER /K AGAIN
+ ISZ LSYMTM /ADVANCE POINTER
+ SZA CLA /DO THEY MATCH
+ JMP MBACK /NO GO TO NEXT SYMBOL
+ TAD LSYMTM /YES
+ TAD CM3 /MOVE BACK POINTYER
+ DCA L77 /PUT POINTER IN PAGE ZERO
+ JMP I SEARCH /RETURN
+QRET, ISZ SEARCH /SET UP RETURN FOR NOT FOUND
+ JMP I SEARCH /RETURN
+I1, ISZ LSYMTM /ADVANCE POINTER
+I2, ISZ LSYMTM /ADVANCE PIINTER
+ JMP MBACK /GO TO NEXT SYMBOL
+/ THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED
+ENTER, 0
+ DCA LSYMTM /SAVE ADDRESS
+ TAD L47 /GET BEGINNING OF FCON TABLE
+ CMA
+ TAD L57 /SUBTRACT END OF SYMBOL TABLE
+C7700, SMA CLA /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON
+ERR17, JMS I LUNCH /NO
+ TAD L30 /YES GEYT FIRST WORD
+ DCA I LSYMTM /STORE IT
+ TAD LSYMTM
+ DCA L11 /SET UP AUTO - XR
+ TAD L31
+ DCA I L11
+ TAD L32
+ DCA I L11
+ TAD LSYMTM /GET THE ADDRESS BACK INTO THE AC
+ JMP I ENTER /AND RETURN
+DUMPLN, DMPLIN
+LSYMTM=.
+LPRINT, 0 / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII
+ DCA LFCON /SAVE THE CHARACTER
+ TAD L75 /S GET THE SUPPRESS PRINTING WITCH
+ SZA CLA
+ JMP I LPRINT
+ ISZ L24 /IS THIS A NEW LINE?
+ SKP /NO
+ JMS I DUMPLN /YES - DUMP THE OLD ONE FIRST
+ TAD LFCON /NO...GET THE CHARACTER
+ SNA /IS IT A CR
+ JMP CRLF /YES...PUT OUT CRLF
+ AND C40 /CHECK BIT SIX
+ CLL RAL
+ CIA /AC CONTAINS 0 OR -100
+ TAD C300 /NOW CONTAINS 300 OR 200
+ TAD LFCON /NOW ADD THE CHARACTER IN
+\fPRIT, DCA I L24 /AND STORE IT IN THE BUFFER
+ JMP I LPRINT
+CRLF, TAD C215 /GET AN EIGHT BIT CR
+ DCA I L24 /STORE IT IN THE BUFFER
+ ISZ L24
+ TAD C212
+ DCA I L24 /STORE A LINE FEED TOO
+ CLA CMA
+ DCA L24 /SET SWITCH TO DUMP LINE ON NEXT CHAR
+ JMP I .+1
+ PRIT+1
+\fLCOMON, CLA
+ JMS I LOOK /CHECK REST OF STATEMENT NAME
+ -2 /TWO CHARACTERS
+ -17 /O
+ -16 /N
+GETVAR, JMS I ENTITY /GET A VARIABLE
+ SKP /NOT A VARIZBLE
+ JMP VARI /WE GOT A VARIABLE
+ NOP
+B20, 20
+ERR18, JMS I LUNCH /ERROR
+VARI, TAD C40
+ TAD L32 /PUT IN COMMON BIT
+ DCA L32
+ TAD K37 /GET MASK FOR SYMBOL TABLE SWITCH
+ DCA L21 /PUT IN THE SWITCH
+ JMS I SYMTAB /PUT SYMBOL IN TABLE
+ JMS I ENTITY /LOOK FOR A COMMA
+ JMP START /THAT'S ALL GOT A CR-LF...
+K37, 37
+K27, 27
+ JMP .+3 /ERROR
+ TAD CM54 /CHECK FOR COMMA
+ SZA CLA /IS IT A COMMA
+ JMP ERR18 /NO...ERROR
+ JMP GETVAR /GET ANOTHER VARIABLE
+LDIMEN, JMS I LOOK /LOOK FOR REST OF STATEMENT
+ -5 /FIVE CHARS
+ -16 /N
+ -23 /S
+ -11 /I
+ -17 /O
+ -16 /N
+QAGAIN, CLA CMA /-U
+ DCA REDY /SET SWITH FOR VARIABLE
+QGET, JMS I ENTITY /GET WHATEVER IS NEXT IN LINE
+ JMP QDONE /IT EAS A CR
+ JMP .+4 /IT WAS A VARIABLE
+ JMP ASUBSC /IT WAS ONE OF THE SUBSCRIPTS
+ JMP ERR18 /WE BETTER NOT GET ANY FP NUMBERS
+ JMP QPUNC /IT WAS A PUNCTION
+ ISZ REDY
+ JMP ERR18 /WE WERENT READY FOR A VAR
+ TAD B20
+ TAD L32
+ DCA L32
+ TAD K27 /GET THE MASK FOR THE SYMBOL TABLE
+ DCA L21 /PUT IN THE SWITCH
+ JMS I SYMTAB /PUT SYMBOL IN TABLE
+ CMA CLA
+ TAD L47 /GET BEGINNING OF TABLE
+ DCA L16
+ TAD L77 /GET TABLE ADDRESS
+ DCA I L16
+ CLA CMA
+ DCA V /SET WITCH TO SAY WEVE GOTTEN A VAR
+ JMP QGET /GET NEXT THING
+QPUNC, TAD CM54
+ SNA /IS IT A COMMA
+ JMP COMMA /YES
+ TAD C3
+ SNA
+ JMP QRPAR /RIGHT PAREN
+ IAC
+ SNA /IS IT A LEFT PAREN
+ ISZ V /PRECEDED BY A VAR
+ JMP ERR18 /NO - ERROR
+ CLA CMA
+ DCA XLP /SET SWITCH TO SHOW LPAR
+ JMP QGET
+ASUBSC, ISZ XLP /DID WE JUST GET LPAR
+ JMP SECOND /NO...BETTER BE SECOND SUBSC
+ TAD L32 /GET INTEGER
+ DCA I L16 /PUT IN DIMTAB
+ CMA CLA
+ DCA QONE /SET SWITCH TO SHOW WE HAVE ONE SUBSC
+ JMP QGET
+COMMA, ISZ QONE /DOES THIS COMMA SEPARATE SUBSCS
+ JMP RIGHT /NO...LAST CHAR BETTER HAVE BEEN L RPAR
+ CMA CLA
+ DCA SEC /SET SWITCH TO EXPECT SECOND SUBSCRIPT
+ JMP QGET
+SECOND, ISZ SEC /IS THIS SECOND SUBSCRIPT
+ JMP ERR18 /NO...ERROR
+ TAD 32 /GET INTEGER
+ DCA I L16
+ CMA CLA
+ DCA R /SET SWITCH FOR RPAR
+ JMP QGET
+QRPAR, ISZ QONE /HAVE WE GOTTEN ONE SUBSC
+ JMP QTWO /NO...CHECK FOR TWO
+ IAC /ONLY ONE SO USE 1 AS SECOND
+ DCA I L16
+QBACK, CMA CLA
+ DCA RIG
+ TAD L47 /GET BEGINNING OF TABLE
+ DCA L50 /SAVE IN LOW CORE
+ TAD L47
+ TAD CM3 /SUBTRACT THREE FROM ADDRESS
+ DCA L47 /AND SAVE
+ JMP QGET /WE EXPECT COMMA OR CR
+QTWO, ISZ R /HAVE WE GOTTEN TWO
+ JMP ERR18 /NO...ERROR
+ JMP QBACK
+RIGHT, ISZ RIG /DID WE JUST GET RPAR
+ JMP ERR18 /NO...ERROR
+ JMP QAGAIN
+QDONE, ISZ RIG
+ JMP ERR18
+ JMP START
+QONE, 0
+RIG, 0
+R, 0
+REDY, 0
+V, 0
+XLP, 0
+SEC, 0
+\f *3000
+LGOTO, TAD L74
+ DCA L16 /USE AUTO INDEXING
+ DCA L76
+ JMS I ENTITY
+ NOP
+ SKP
+ JMP ALAB /WE HAVE A LABEL
+ JMP I ASSIGN
+ TAD CM50 /IF PUNCT...CHECK FOR LEFT PAREN
+ SZA CLA /IS IT (
+ JMP I ASSIGN
+ANEXT, JMS I ENTITY
+ NOP
+ SKP
+ JMP THERE /WE HAVE A LABEL
+ NOP
+ERR28, JMS I LUNCH
+THERE, TAD L32 /GET THE LABEL
+ DCA I L16 /PUT IN LIST
+ ISZ L76
+ JMS I GNB
+ TAD CM54 /CHECK FOR BEING A COMMA
+ SNA /IS IT A COMMA
+ JMP ANEXT /YES GET ANOTHER LABEL
+ TAD C3 /CHECK FOR BEING A RIGHT PAREN
+ SZA CLA /IS IT A )
+ JMP I ASSIGN
+ JMS I GNB
+ TAD CM54 /CHECK FOR ANOTHER COMMA
+ SZA /IS IT ANOTHER
+ JMS I PUTCH /IGNORE ANYTHING ELSE ...
+ JMS I ENTITY /GET THE CONTROL VARIABLE
+ SKP
+ JMP .+4 /WE GOT IT
+ NOP
+ NOP
+ERR29, JMS I LUNCH
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB /PUT VARIABLE IN SYMBOL TABLE
+ TAD L77 /GET ADD RESS OF SYMBOL
+ JMS I MODE /CHECK THE MODE OF THE VAIABLE
+ERR30, JMS I LUNCH /ITS FLOATING POINT
+ JMS I ZZZ /PUT OUT STMT LABEL
+ JMS LXTAD /LOAD VARIABLE WITH TAD OR TAD*
+ JMS I PROP /PUT OUT OP CODE
+Q6066, 6066 /OP CODE IS TAD
+ JMS I CREATE /GET THE NEXT CREATED LABEL
+ JMS I PRCRL /PRINT THE CREATED LABEL
+ JMS I PRINT /PUT OUT CR LF
+ JMS I PROP /PUT OUT OP CODE
+ 6071 /OP CODE IS DCA
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT /PUT OUT CRLF
+ JMS I PROP /PUNCH 'TAD I 7'
+ OPTADI
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ JMS I PROP /PUNCH 'DCA 7'
+ OPDCA
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ JMS I PROP /PUNCH 'JMP I 7'
+ OPJMPI
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ TAD L76 /PUNCH 'CPAGE <N+1>'
+ IAC
+ JMS I PIFF
+ TAD L53 /PUNCH '<CR.LABEL2>, <CR.LABEL2>'
+ JMS I CLAB
+ TAD L53
+ JMS I PRCRL
+ JMS I PRINT
+ TAD L76 /NOW PUNCH THE LABELS
+ CIA /SET NEGATIVE
+ DCA L76
+ TAD L74
+ DCA L16 /USE AUTO INDEXING AGAIN
+ TAD I L16 /GET THE NEXT LABEL
+ JMS I PLAB /PRINT THE LABEL
+ JMS I PRINT /PUT OUT CRLF
+ ISZ L76
+ JMP .-4 /NO
+ JMP START
+/ THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S
+ALAB, JMS I ZZZ
+ TAD L32
+ JMS PRJUMP /PUT OUT A JUMP TO THE LABEL IN "L32"
+ JMP START
+
+LXTAD, 0
+ TAD L77 /GET ADDRESS AGAIN
+ JMS I DUMARG
+ TAD CM3
+ TAD Q6066 /TAD OR TAD*
+ DCA OP /USE AS OPERATOR
+ JMS I PROP /PUT OUT OP CODE
+OP, 0
+ TAD L77 /GET ADDRESS AGAIN
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT A CR LF
+ JMP I LXTAD
+
+LLEAD, 0 /PUNCH SOME LEADER...
+ DCA L7
+ JMS I PUNCH
+ ISZ L7
+ JMP .-2
+ JMP I LLEAD
+GO7, 7
+
+PRJUMP, 0 /SUBROUTINE TO PUT OUT A JUMP
+ DCA LLEAD /STORE THE LABEL
+ JMS I PROP
+ 6044 /JMP
+ TAD LLEAD
+ JMS I PLAB /PUT OUT THE LABEL
+ JMS I PRINT /PUT OUT A CRLF
+ TAD LLEAD
+ DCA L12 /SET CONTENTS OF LAST LINE TO LABEL
+ JMP I PRJUMP
+\f *3200
+/ THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS
+
+LPRTAC, 0
+ DCA TMP /SAVE THE NUMBER
+ DCA TM
+ TAD CM4 /PUT OUT FOUR CHARACTERS
+ DCA DCTR /CHARACTER COUNTER
+BK, TAD TMP /GET THE NUMBER
+ RAL /ROTATE IT LEFT ONE
+ RTL /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT
+ DCA TMP /SAVE THE ROTATED NUMBER
+ TAD TMP /GET IT IN ACCUMULATOR
+ AND C3
+ RAL /GET THE DIGIT INTO THE LOW-ORDER AC
+ ISZ DCTR /IS THIS THE LAST DIGIT?
+ JMP .+4 /NO, CONTINUE
+ TAD C60 /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT
+ JMS I PRINT /PRINT THE DIGIT
+ JMP I LPRTAC
+ SZA /DO WE HAVE A ZERO DIGIT?
+ JMP .+4
+ TAD TM
+ SNA CLA /YES, IS IT A LEADING ZERO?
+ JMP BK /YES, IGNORE IT
+ TAD C60
+ JMS I PRINT
+ ISZ TM /DON'T SUPPRESS ZEROS ANY MORE
+ JMP BK /NOW...PUT OUT ANOTHER
+TMP, 0
+TM, 0
+CM4, -4
+C60, 60
+LIF, TAD CM4
+ DCA COUNT1 /SET UP COUNTER
+ JMS I GNB
+ TAD CM50 /CHECK FOR LEFT PAREN
+ SZA CLA /IS IT A (
+ JMP I ASSIGN
+ JMS I PUTCH /YES...PUT IT BACK FOR GENER
+ JMS I ZZZ
+ ISZ L52 /SET BALANCED PARENS SWITCH FOR GENER
+ ISZ L44 /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN
+ JMS I GENER /NOW CALL GENER AND PROCESS EXPRESSION
+ TAD I L41
+ JMS I MODE /WHAT IS ITS MODE
+ JMS I GETHI /GET HI ORDER P.P. AC
+ TAD CDCA41
+ DCA LIFDCA /SET UP INSTRUCTION TO STORE LABELS
+LABL, JMS I ENTITY /GET A LABEL
+D34, 34
+ SKP
+ JMP INTEG /WE GO A LABEL
+C46, 46
+ERR31, JMS I LUNCH /DIDNT GET A LABEL
+INTEG, TAD L32 /GET THE LABEL
+ ISZ LIFDCA
+LIFDCA, .-. /STORE LABELS IN L42 THROUGH L44
+ DCTR=LIFDCA
+ ISZ COUNT1 /HAVE WE GOTTEN TOO MANY LABELS
+ SKP /NO
+ JMP ERR31 /YES
+ JMS I GNB
+ SNA /SEE IF ITS A CR
+ JMP .+5 /ITS A CR
+ TAD CM54 /CHECK FOR COMMA
+ SZA CLA /IS IT A COMMA
+ JMP ERR31
+ JMP LABL /YES
+ ISZ COUNT1 /DID WE GET THE RIGHT NUMBER OF LABELS
+ JMP ERR31 /NO
+ TAD L42
+ CIA
+ TAD L44
+ SNA CLA /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL
+ JMP ISPECL /WE CAN SAVE SOME CODE
+ TAD L43
+ CIA
+ TAD L44
+ SNA CLA /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL
+ JMP SPCONL /WE CAN ALSO SAVE SOME CODE
+ JMS I PROP /PUT OUT OP CODE
+ 6105 /OP CODE IS SNA
+ JMS I PRINT /PUT OUT CRLF
+ TAD L43
+ JMS I PRJMP /OUTPUT THE ZERO BRANCH
+SPCONL, JMS I PROP /PUT OUT OP CODE
+ 6110 /OP CODE IS P SPA CLA
+ JMS I PRINT /PUT OUT CRLF
+ TAD L42 /OUTPUT THE NEGATIVE BRANCH
+IFCOMN, JMS I PRJMP
+ TAD L44
+ JMS I PRJMP /OUTPUT THE POSITIVE (>0) BRANCH
+ DCA L46 /ZERO AC
+ JMP START /GO GET NEXT STATEMENT
+ISPECL, JMS I PROP /PUNCH 'SNA CLA'
+ OPSNA
+ JMS I PROP
+ OPCLA
+ JMS I PRINT
+ TAD L43
+ JMP IFCOMN /OUTPUT THE ZERO AND POSITIVE BRANCHES
+PRJMP, PRJUMP
+COUNT1, 0
+LCREAT, 0
+ ISZ L53 /INCREMENT BY ONE...
+ TAD L53
+ AND C77
+ TAD CM33
+ SMA CLA /HAVE WE BEEN HERE 26 TIMES?
+ TAD C46 /YES, BUMP THE HIGH ORDER DIGIT
+ TAD L53
+ DCA L53 /AND SAVE
+ TAD L53 /NOW RETURN IT IN AC
+ JMP I LCREAT /RETURN
+LPLAB, 0 /THIS PRINTS REGULAR LABELS
+ DCA TMP /FIRST SAVE LABEL
+ TAD D34 /NOW PUNCH A '\'
+ JMS I PRINT
+ TAD TMP /GET LABEL
+ JMS I DECOUT /AND PRINT IT
+ JMP I LPLAB /RETURN
+GETHI, LGETHI
+CDCA41, DCA L41
+CM33, -33
+DECOUT, LDCOUT
+
+/TELETYPE OUTPUT ROUTINE FOR ERROR MESSAGES
+LTTYPE, 0
+ TSF
+ JMP .-1
+ TLS
+ CLA
+ JMP I LTTYPE
+
+\f *3400
+DORET, JMP I XDO
+ISZDO, JMS I PROP
+ 6170 /ISZ
+ TAD L30
+ JMS I PRSYM
+ JMS I PRINT
+ JMP DOSUBT /GO GENERATE THE LIMIT TEST
+NUMB, 0
+SWIT, 0
+DM5, -5
+CM24, -24
+C5001, 5001
+LEQI, EQI
+
+LDO, JMS I ZZZ
+ JMS I ENTITY /LOOK FOR THE SCOPE LABEL
+C55, 55
+ SKP
+ JMP SLAB /WE GOT THE SCOPE LABEL
+E53, 53
+ JMP I ASSIGN
+SLAB, TAD L32 /GET THE INTEGER
+ JMS XDO /PUT OUT DO-LOOP CODE
+ JMP START /NORMAL EXIT
+ JMP ERR35 /IMPLIED DO EXIT - ERROR
+
+XDO, 0 /DO LOOP SUBROUTINE - ENTERED WITH
+ /TARGET LABEL IN AC
+ DCA I L15 /PUT IN DO END PUSH DOWN LIST
+ TAD L74
+ DCA L16 /SET UP LIST OF DO ENDS
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ CMA CLA
+ DCA SWIT /SET SWITCH FOR CONTROL VARIABLE
+ TAD DM5
+ DCA NUMB /SET COUNTER OF NUMBER OF PARAMETERS
+GETMOR, JMS I ENTITY /LOOK FOR A PARAMETER
+ JMP .+3 /ERR
+ JMP CVAR /GOT A VARIABLE
+ JMP DPAR /GOT AN INTEGER
+C21, 21
+ JMP ERR35
+CVAR, JMS I SYMTAB /PUT SYMBOL IN TABLE
+ TAD L77 /GET ADDRESS
+ JMS I MODE /DETERMINE MODE OF SYMBOL
+ JMP ERR35
+ TAD L77 /GET ADDRESS AGAIN
+DOSTOR, DCA I L16 /SAVE
+ ISZ NUMB /HAVE WE GOTTEN TOO MANY PARAMS
+ SKP /NO
+ERR35, JMS I LUNCH /YES, DO ERROR ...
+ JMS I GNB
+ SNA /IS IT CR
+ JMP ALLDNE+1 /YES WERE DONE
+ TAD CM51
+ SNA /IS IT A RIGHT PAREN?
+ JMP ALLDNE /YES-FINISH UP AND TAKE IMPLIED DO EXIT
+ TAD CM24
+ SZA /IS IT =
+ JMP MCOM /NO
+ ISZ SWIT /IS SWITCH SET FOR IT
+ JMP ERR35 /NO
+ JMP GETMOR /YESS...GO BACK FOR ANOTHER PARAMETER
+MCOM, TAD C21 /CHECK FOR COMMA
+ ISZ SWIT /IF NO EQUAL SIGN YET
+ SZA /OR IF THIS ISN'T A COMMA
+ JMP ERR35 /THEN ITS AN ERROR
+ JMP GETMOR /GET ANOTHER
+DPAR, TAD L32 /GET THE INTEGER
+ ISZ SWIT /HAVE WE SEEN AN EQUAL SIGN?
+ JMP DOSTOR /YES - SAVE THE INTEGER AND PROCEED
+ JMP ERR35 /NO
+ALLDNE, ISZ XDO /BUMP RETURN POINTER IF TERMINATOR WAS RPAR
+ CLA IAC
+ DCA I L16 /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT
+ TAD C2
+ TAD NUMB
+ SPA CLA /DID WE GET AT LEAST THREE ARGS?
+ JMP ERR35 /NO
+ ISZ L44
+ TAD L74 /GET ERASABLE LOCATIONS
+ DCA L16 /USE THE AUTO INDEX REGISTERS
+ TAD I L16 /GET CONTROL VARIABLE
+ DCA L30 /AND PUT IN THIRTY
+ TAD I L16 /GET INITIAL VALUE
+ DCA L31 /AND SAVE IT
+ TAD I L16 /GET FINAL VALUE
+ DCA L32 /AND SAVE IT
+ TAD I L16 /GET INCREMENT
+ DCA L33 /AND SAVE IT
+ TAD L74 /GET ADDR OF ERASABLE AGAIN
+ IAC /INCREMENT ONCE
+ DCA L41 /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES
+ TAD L74 /GET IT AGAIN
+ DCA L16 /USE AUTO INDEX TO STORE TRIPLE
+ DCA L46 /ZERO THE AC
+ TAD C5001 /SET UP INITIAL TRIPLE NUMBER
+ DCA L40
+ TAD L33
+ CIA
+ TAD L31
+ SNA CLA /IF INITIAL VALUE = STEP SIZE
+ JMP STCTLV /NO NEED TO COMPUTE THE DIFFERENCE
+ TAD L33 /GET STEP SIZE
+ DCA I L16 /PUT IN TRIPLE
+ TAD C55 /PUT IN A MINUS SIGN
+ DCA I L16
+ TAD L31 /GET INITIAL VALUE
+ DCA I L16
+ JMS I TRIPL /PROCESS THE TRIPLE
+STCTLV, JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
+ JMS I CLAB /PUT A CDREATED LABVEL ON THE NEXT STATEMENT
+ TAD L53 /GET THE CREATED LABEL
+ DCA I L15 /AND PUT IN DO END LIST
+ TAD L74
+ DCA L16
+ TAD L33 /GET STEP SIZE
+ CLL RAR
+ SNA /IF STEP SIZE=1 THEN
+ JMP ISZDO /WE CAN USE AN ISZ TO INCREMENT
+ RAL
+ DCA I L16
+ TAD E53 /WERE GOING TO ADD
+ DCA I L16
+/ L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI"
+ JMS I TRIPL /ADD STEP SIZE TO CONTROL VARIABLE
+ JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
+DOSUBT, TAD L74
+ DCA L16
+ TAD L30 /GET THE CONTROL VARIABLE
+ DCA I L16
+ TAD C55 /WERE GOING TO SUBTRACT
+ DCA I L16
+ TAD L32 /GET FINAL VALUE
+ DCA I L16
+ JMS I TRIPL /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
+\f DCA L46 /CLEAR THE AC FLAG
+ JMS I PROP
+ 6110 /SPA CLA
+ JMS I PRINT
+ JMS I PROP
+ 6044 /PUT OUT A JMP
+ JMS I CREATE /TO A CREATED LABEL
+ DCA I L15 /PUT CREATED LABEL IN DO END LIST
+ TAD L53 /GET LABEL
+ JMS I PRCRL /AND PRINT IT
+ JMS I PRINT /CRLF
+ ISZ L55 /INCREMENT UNENDED DO COUNTER
+ SKP
+ERR38, JMS I LUNCH /TOOO MANY UNENDED DOS
+ JMP I .+1
+ DORET /RETURN FROM SUBROUTINE "XDO"
+
+EQI, 0
+ TAD L74
+ DCA L16
+ TAD L46 /GET RESULT OF PREVIOUS COMPUTATION
+ DCA I L16
+ TAD E75 /GET EQUALS SIGN
+ DCA I L16
+ TAD L30 /GET CONTROL VARAIBLE
+ DCA I L16
+ JMS I TRIPL /PROCESS
+ DCA L46 /WIPE AC SWITCH
+ JMP I EQI /RETURN
+LFUNCT, 0
+ DCA ARGCNT
+ TAD L46 /GET AC
+ SZA CLA /IS IT ZERO
+ JMS I STORE /NO...STORE THE AC
+ TAD L53 /GET CURRENT CREATED LABEL
+ DCA L73 /AND SAVE
+ CLA CMA /AC IS MINUS ONE
+ TAD L41 /PUSH LIST POINTER
+ DCA L42 /PUSH LIST POINTER MINUS ONE
+CKFNCT, ISZ L42 /INCREMENT POINTER
+ ISZ L42 /AGAIN
+ TAD I L42 /GET THE OPERATOR
+ TAD CM4047 /SUBTRACT THE FUNCTION OPERATOR
+ SZA /IS THIS THE FUNCTION OPERATOR
+ JMP CKSBSC /NO
+ CLA IAC /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO
+ TAD L42 /THIS POINTS TO IT
+ DCA SAVE /AND SAVE
+ TAD I SAVE
+ TAD C2
+ DCA EQI
+ TAD I EQI
+ AND CM2
+ IAC
+ DCA I EQI
+MOR, CLA CMA /NOW EXAM THE ARGUMENTS
+ TAD L42 /WERE POINTING TO THE FIRST ARGUMENT
+ DCA L42 /SAVE THE POINTER
+ ISZ ARGCNT
+ JMS I LCHNG /CHECK L42 FOR ZERO OR DUMMY ARG
+ DCA I L42 /REPLACE IT BY UPDATED VALUE
+ TAD L42 /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT
+ CIA
+ TAD L41 /SUBTRACT THE END OF ARGUMENT LIST
+ SNA CLA /IS IT ZERO
+ JMP OUT /YES...WE'VE COMPLETED THIS PHASE
+ CLA CMA /NO...MOVE THE POINTER BACK ONE
+ TAD L42
+ DCA L42 /AND SAVE
+ JMP MOR /NOW CHECK THE NEXT ARGUMENT
+OUT, TAD SAVE /GET THE POINTER TO THE FUMCTION NAME AGAIN
+ DCA L42 /AND PUT IN 42
+ TAD I L42 /GET THE ARGUMENT
+ DCA FUNOP /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION
+ TAD ARGCNT /GIVE FPROP THE NUMBER OF ARGUMENTS
+ JMS I FPROP /PUT OUT THE CALL TO THE FUNCTION
+FUNOP, 0
+ TAD L73 /NOW RESTORE THE CREATED LABEL LOCATION
+ DCA L53
+MNEXT, TAD L42 /GET THE POINTER
+ TAD CM2 /MOVE POINTER TO ARGUMENT
+ DCA L42 /AND SAVE
+ TAD I L42 /GET NEXT ARGUMENT
+ JMS I PSYMOT /GENERATE AN "ARG" FOR THE ARGUMENT
+ TAD L42 /GET THE POINTER
+ CIA /SET IT NEGATIVE
+ TAD L41 /ADD
+ SZA CLA /ARE THEY EQUAL
+ JMP MNEXT /NO THERE ARE MORE ARGS
+ TAD I SAVE /YES...GET THE FUNCTION NAME
+ JMS I MODE /WHAT MODE IS IT
+ TAD E400 /ITS FLOATING POINT
+ TAD L40 /ITS INTEGER
+ DCA L46 /PUT THE TRIPLE NUMBER IN THE AC SWITCH
+ TAD SAVE /YES...CHANGE PUSH LIST POINTER
+ DCA L41 /STORE POINTER TO NAME IN PUSH LIST POINTER
+ TAD L46 /GET CURRENT TRIPLE NUMBER
+ DCA I L41 /AND PUT IT IN THE PUSH LIST
+ JMP I LFUNCT /RETURN
+CKSBSC, IAC
+ SZA CLA /IS IT THE SUBSCRIPT OPERATOR?
+ JMP I CKF /NO - KEEP LOOKING
+ JMP I .+1
+ ERR39
+PSYMOT, SYMOUT
+SAVE, 0
+ARGCNT, 0
+E75, 75
+CM4047, -4047
+E400, 400
+
+ TAD C47
+ JMS I PPACK
+LQUOTE, JMS I PGTC /GET A CHARACTER
+ SNA
+ERR37, JMS I LUNCH /CARRIAGE RETURN - ERROR
+ TAD CM47
+ SZA
+ JMP LQUOTE-2 /IF NOT A QUOTE, STORE IT
+ JMP I .+1
+ FRET
+C47, 47
+CM47, -47
+PGTC, LGTC
+PPACK, PACK
+CKF, CKFND
+\f *4000
+LCONT, JMS I LOOK /CHECK REST OF LINE
+ -4 /LOOK FOR FOUR CHARACTERS
+ -11 /I
+ -16 /N
+ -25 /U
+ -5 /E
+ JMS I ZZZ
+ JMS I PROP /PUNCH 'NOP'
+ 6047
+ JMS I PRINT /PUT OUT A CRLF
+ JMP START /GO GET NEXT STATEMENT
+
+LPAUSE, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -1 /JUST ONE CHARACTER
+ -5 /E
+ CLA CMA
+LSTOP, DCA SW /SET SWITCH FOR STOP OR PAUSE
+ DCA L32
+ JMS I ENTITY /LOOK FOR THE OPTIONAL INTEGER
+ JMP MCR /WE GOT A CR
+ SKP /ERR
+ JMP .+3 /WE GOT AN INTEGER
+ NOP /ERR
+ JMP I ASSIGN
+
+MCR, JMS I ZZZ
+ ISZ SW /PAUSE OR STOP?
+ JMP STOP
+ JMS I FPROP /PUNCH 'CALL 0,CKIO'
+ 6116
+ JMS I PROP /PRINT OP CODE
+ 6066 /OPCODE IS TAD
+ TAD L32 /GET THE INTEGER
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /CR
+ JMS I PROP
+ 6121
+ JMS I PRINT
+ JMS I PROP
+ 6124
+ JMS I PRINT /PUT OUT CRLF
+ JMP START /GO GET NEXT STATEMENT
+
+STOP, JMS OSTOP
+ JMP START
+
+OSTOP, 0 /PUNCH 'CALL 0,CKIO'
+ JMS I FPROP
+ 6116
+ JMS I CLAB /PUNCH '<LAB>, HLT'
+ JMS I PROP
+ 6121
+ JMS I PRINT
+ JMS I PROP /PUNCH 'JMP <LAB>'
+ 6044
+ TAD L53
+ JMS I PRCRL
+ JMS I PRINT
+ JMP I OSTOP
+
+SW, 0
+LFRMAT, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -2 /TWO CHARACTERS
+ -1 /A
+ -24 /T
+ ISZ OSTOP
+ TAD L74
+ DCA L10
+ DCA L76
+ JMS I PROP
+ 6044
+ JMS I CREATE
+ JMS I PRCRL
+ JMS I PRINT
+ JMS I GNB /READ UNTIL A PAREN IS GOTTEN
+ TAD CM50 /SUBTRACT A (
+ SZA CLA /IS IT A (
+ERR39, JMS I LUNCH /NO...ILLEGAL CHARACTER
+ TAD C50 /GET A LEFT PAREN
+ JMP PAREN /AND GO START COUNTING PARENS
+AGAIN, JMS I GTC
+ SNA /IS IT A CR
+ JMS I PUTCH
+PAREN, RTL CLL /SHIF CHAR LEFT
+ RTL
+ RTL
+ DCA L32 /SAVE THE CHAR
+ JMS I GTC
+ SNA /IS IT A CR
+ DCA OSTOP
+ TAD L32 /PACK THE TWO CHARS (SOME DONE AT FRMTCK)
+ JMP I FRMTCK /GO CHECK IF FORMAT STMT. TOO BIG
+FRMT, TAD OSTOP /GET BALANCED PAREN SWITCH
+ SZA CLA /ARE THEY BALANCED
+ JMP AGAIN /NO GET SOME MORE CHARS
+ TAD L76
+ JMS I PIFF
+ TAD L74
+ DCA L10
+ TAD L76
+ CIA
+ DCA L76
+ JMS I ZZZ
+ TAD I L10
+ JMS I PROTAC
+ JMS I PRINT
+ ISZ L76
+ JMP .-4
+ TAD L53 /PUNCH '<LABEL>,'
+ JMS I CLAB
+ JMS I PRINT
+ JMP START
+GTC, LGTC
+PXSUBR, XXSUBR
+C50, 50
+
+LPIFF, 0 /PUNCH 'IFF <N>'
+ DCA LZZZ /ENTER WITH N IN THE AC
+ JMS I PROP
+ 6102
+ TAD LZZZ
+ JMS I PROTAC
+ JMS I PRINT
+ JMP I LPIFF
+
+LZZZ, 0 /PUNCH THE CURRENT LABEL, IF ANY
+ TAD L54
+ SNA /IS THERE A LABEL?
+ JMP ZZZRET /NO
+ JMS I PLAB /PUNCH '<LABEL>, '
+ TAD C7240
+ JMS I P2
+ZZZRET, DCA I PXSUBR /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL
+ JMP I LZZZ
+FRMTCK, CKFRMT
+\f *4200
+LTRIPL, 0
+ JMS I XZQL /FIRST CHECK IF A TRIPLE IS LEGAL HERE
+ TAD L41 /GET PUSH LIST POINTER
+ IAC /INCREMENT TO POINT TO OPERATOR
+ DCA L42 /OPERATOR POINTER
+ TAD L42 /GET IT AGAIN
+ IAC /INCREMENT IT
+ DCA L43 /OPERAND TWO POINTER
+ TAD I L42 /GET OPERATOR
+ AND C77 /MASK GARBAGE BITS
+ TAD CM41 /SUBTRACT AN ADD INDIRECT OPERATOR
+ SNA CLA /IS OPERATOR <DOLLAR>
+ JMP I LADDIN /YES PROCESS IT
+ TAD I L43 /NO...GET OPERAND TWO
+ JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
+ SKP /YES IT IS
+ JMP CK2 /NO ..CHECK THE OTHER ARGUMENT
+ TAD I L42 /YES GET THE OPERATOR
+ AND C77 /MASK GARBAGE BITS
+ TAD EM75 /IS IT AN EQUALS SIGN
+ SNA /IS OP C
+ JMP LEQUIN /YES USE C*
+ IAC /SEE IF ITS ALREADY EQUALS INDIRECT
+ SZA CLA /IS OP C*
+ JMS I LDUMTW /YES TWO IS DUMMY ARG
+CK2, CLA
+ TAD I L41 /NO IS OPND ONE A SYMBOL
+ JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
+ JMS I LDUMON /IT IS
+ CLA CLL /NOW LETS SEE WHAT THE OPERATOR IS
+ TAD I L42 /GET THE OPERATOR
+ AND C77 /MASK OUT GARBAGE BITS
+ TAD CM53
+ SNA /IS IT
+ JMP I LAADD /YES
+ IAC
+ SNA /IS IT *
+ JMP I LMUL /YES
+ TAD CM3
+ SNA /IS IT -
+ JMP I LASUB /YES
+ TAD CM2
+ SNA /IS IT /
+ JMP I LDIV /YES
+ TAD CM16
+ SNA /IS IT C
+ JMP I LEQU /YES
+ IAC
+ SNA /IS IT C*
+ JMP I LEIND /YES
+ TAD J27
+ SNA /IS IT **
+ JMP I LEXP /YES
+ TAD C2
+ SNA /IS IT A UNARY MINUS
+ JMP I LUMIN /YES
+ERR40, JMS I LUNCH /NO BETTER COP OUT
+LDMARG, 0
+ SMA /IS HIGH ORDER BIT ON
+ JMP INC /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER
+ RAL /GET NEXT BIT
+ SMA /IS IT ON
+ JMP MAYBE /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH
+ RAR /YES...RESTOR THE PARAMETER
+ CIA /SET IT NEGATIVE
+ TAD L47 /SUBTRACT IT FROMTHE START OF THE FCON TABLE
+ SPA /IS THE RELULT POSITIVE
+ JMP INC /NO...ITS AN FCON NOT A SYMBOL
+ CIA /YESS...RESTORE ORIGINAL PARAMETER
+ TAD L47
+ TAD C2 /YES MOVE POINTER TO CONTROL BITS
+ DCA L23 /SAVE
+ TAD I L23 /GET THE CONTROL BITS
+ AND C10 /MASK ALL BUT DUMMY ARG BIT OUT
+INC1, SNA CLA /IS THIS SYMBOL. A DUMMY ARG
+INC, ISZ LDMARG /NO...INCREMENT THE RETURN
+ CLA /CLEAR THE ACCUMULATOR
+ JMP I LDMARG /AND RETURN
+MAYBE, AND F400 /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER
+ JMP INC1 /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG
+ARET, JMP I LTRIPL /THIS IS THE RETURN FROM TRIPLE
+
+LEQUIN, TAD C74
+ DCA I L42 /SET OP TO =*
+ JMP CK2
+C74, 74
+/
+/ THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT
+LLOOK, 0
+ JMS GLOOK /GET CHARACTER COUNT
+ DCA LTRIPL
+ABACK, JMS I GNB
+ JMS GLOOK /ADD IN THE TEST CHAR
+ SZA CLA /WERE THEY EQUAL
+ JMP I ASSIGN /NO...IT MUST BE AN ASSIGNMENT STATEMENT
+ ISZ LTRIPL /THEY MATCH...ARE WE DONE
+ JMP ABACK /NO
+ JMP I LLOOK /RETURN
+
+GLOOK, 0
+ CDF 10
+ TAD I LLOOK
+ ISZ LLOOK
+ CDF 00
+ JMP I GLOOK
+/
+LAADD, AADD
+LADDIN, ADDIND
+LASUB, ASUB
+LEQU, EQU
+LEIND, EIND
+LEXP, EXP
+LUMIN, UMIN
+CM41, -41
+EM75, -75
+LDUMTW, DUMTWO
+CM16, -16
+C10, 10
+F400, 400
+LDUMON, DUMONE
+CM53, -53
+LMUL, MUL
+LDIV, DIV
+XZQL, LXZQ
+J27, 27
+
+CKFND, TAD L42 /SEE IF POINTER IS INTO SYMB. TABLE
+ TAD K2000 /(IT HAS HAPPENED!)
+ SZA CLA
+ JMP I CKFNCP
+ JMP I .+1 /YES-ERROR
+ ERR39
+CKFNCP, CKFNCT
+K2000, 2000
+\f *4400
+ / FIGURE OUT WHATS IN AC
+LCHECK, 0
+ TAD L46 /GET WHATS IN THE AC
+ CIA /SET NEGATIVE
+ TAD I L41 /SUBTRACT
+ SNA CLA /ARE THEY EQUAL
+ JMP ONE /YES
+ TAD L46 /GET AC AGAIN
+ CIA /SET NEGATIVE
+ TAD I L43 /SUBTRACT TWO
+ SNA CLA /ARE THEY EQUAL
+ JMP TWO /YES
+ TAD L46 /GET THE AC
+ SNA CLA /IS IT ZERO
+ JMP NONE /NO YES YES YES
+ JMP SOME /JUST SIMETHING IN AC
+ONE, ISZ LCHECK
+NONE, ISZ LCHECK
+SOME, ISZ LCHECK
+TWO, JMP I LCHECK
+
+/ FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO
+
+LTMPOR, 0
+ DCA LFPROP /SAVE TRIPLE NUMBER
+ TAD LFPROP
+ JMS I MODE /DETERMINE ITS MODE
+ TAD C30 /FLOATING POINT
+ TAD TTAB /INTEGER
+ DCA LCHECK
+ TAD CM30
+ DCA FOP /SET UP COUNT FOR SEARCH
+LTLP1, TAD I LCHECK
+ CIA
+ TAD LFPROP
+ SNA CLA /IS THIS THE ONE?
+ JMP ZEROIT /YES - ZERO IT OUT AND RETURN IT
+ ISZ LCHECK
+ ISZ FOP
+ JMP LTLP1 /LOOP OVER ENTIRE TABLE
+ TAD LCHECK /NOT FOUND - WE HAVE TO ASSIGN IT
+ TAD CM30
+ DCA LCHECK /RESET POINTERS FOR ZERO SEARCH
+ TAD CM30
+ DCA FOP
+LTLP2, TAD I LCHECK
+ SNA CLA /IS THIS TEMPORARY FREE?
+ JMP TEMPTY /YES
+ ISZ LCHECK
+ ISZ FOP
+ JMP LTLP2 /CHECK THEM ALL
+ERR41, JMS I LUNCH /OUT OF TEMPORARIES
+TEMPTY, TAD LCHECK
+ CIA
+ TAD L45
+ SNA CLA /ADJUST THE NUMBER OF FLOATING POINT TEMPS
+ ISZ L45
+ TAD LCHECK
+ CIA
+ TAD L51
+ SNA CLA /ADJUST THE NUMBER OF INTEGER TEMPS
+ ISZ L51
+ TAD LFPROP /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT
+ZEROIT, DCA I LCHECK
+ TAD FOP
+ TAD C31 /GET POSITIVE NUMBER FROM TABLE COUNTER
+ JMP I LTMPOR /RETURN
+C31, 31
+
+LFPROP, 0 /THIS ROUTINE PUNCHES SUBROUTINE CALLS
+ DCA FOP /SAVE THE NUMBER OF ARGUMENTS
+ JMS I PROP
+ 6113 /PUT OUT THE CALL
+ TAD FOP /GET THE NUMBER OF ARGUMENTS
+ JMS I PROTAC /PRINT IT
+ TAD C54 /GET A COMMA
+ JMS I PRINT /PRINT IT
+ CDF 10
+ TAD I LFPROP
+ CDF 00
+ JMS I PRSYM
+ JMS I PRINT
+ ISZ LFPROP /INCREMENT RETURN
+ JMP I LFPROP /RETURN
+FOP, 0
+/ COME HERE IF OP IS -
+ASUB, JMS I SMODE /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE
+ TAD I L43 /GET OPERAND TWO
+ JMS I MODE
+ JMP FSUB /ITS FLOATING POINT
+ JMS LCHECK /ITS INTEGER...CHECK WHATS IN THE AC
+ JMP STWO /TWO IS IN THE AC
+ JMS I STORE /SMETHING IS IN THE AC
+ JMS I LADDON /NOTHING IS IN THE AC...ADD ONE TO IT
+ASBCMN, JMS I LCOMP /ONE IS IN AC...COMPLEMENT IT
+ JMS I LADDTW /ADD TWO TO IT
+ JMP I LRETUR /AND RETURN
+STWO, JMS I LCOMP /TWO IS IN AC...COMPLEMENT IT
+ JMS I LADDON /ADD ONE TO IT
+ JMS I LCOMP /AND COMPLEMENT IT AGAIN
+ JMP I LRETUR /AND RETURN
+FSUB, JMS LCHECK /FLOATING POINT...CHECK THE AC
+ JMP FS /TWO IS IN AC
+ JMS I STORE /SOMETHING IN AC...STORE IT
+ JMP FAS /NOTHING IN AC
+ JMP ASBCMN /ONE IS IN AC - COMPLEMENT AND ADD TWO
+FAS, JMS I LADDTW /NOTHING IN AC...ADD TWO IN
+FS, IAC /WE HAVE ONE ARG
+ JMS I FPROP
+ 6011
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L41 /GET ARGUMENT ONE
+IRET, JMS I PRSYM /AND PUT IT OUT
+ JMS I PRINT /PUT OUT CRLF
+ JMP I LRETUR
+TTAB, ITTAB /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE
+LCOMP, COMP
+LADDON, ADDONE
+C30, 30
+CM30, -30
+LRETUR, RETURN
+LADDTW, ADDTWO
+
+/CHECK SIZE OF FORMAT STMT.
+/
+CKFRMT, DCA I L10 /CONTINUE PACK ROUTINE
+ ISZ L76
+ TAD L76
+ TAD M174 /IS IT TOO BIG
+ SMA CLA
+ JMP I ILCON /YES-GIVE IT ILLEGAL CONT. MESSAGE
+ JMP I LFRMT /NO-GO BACK
+LFRMT, FRMT
+M174, -174
+ILCON, ERR1 /ILLEGAL CONTINUATION MESSAGE
+\f *4600
+/ PROCESS *
+ADDIND, JMS I CHECK /CHECK WHATS IN THE AC
+ NOP /TWO IS IN AC
+ SKP /N SOMETHING IS IN AC
+ SKP /NOTHING IS IN AC
+ JMS I STORE /STORE WHATEVER IS IN AC
+ TAD I L41 /GET OPERAND ONE
+ JMS I MODE /WHAT MODE IS IT
+ JMP FLOT /YES IT FLOATING POINT
+ JMS I PROP /IST INTEGER...
+ 6063 /PUT OUT A TAD*
+LOOP6, TAD I L41 /GET THE FIRST OPERAND AGAIN
+ JMP I LIRET /GO TO THE RETURN ROUTINE
+FLOT, IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6132 /PUT OUT A CALL TO FLOATING INDIRECT ADD
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP LOOP6 /AND JUMP BACK
+/ THIS PUTS OUT OPCODES FOR AN ADD
+ADDL, 0
+ CLL RAR
+ SNA /TEST FOR 0 OR 1
+ JMP ADSPCL
+ RAL /NOT 0 OR 1, TREAT NORMALLY
+ JMS I MODE /WHAT MODE ARE WE IN
+ JMP LOOP7 /YES
+ JMS I PROP /PUT OUT A TAD
+ 6066
+ JMP I ADDL /RETURN
+LOOP7, IAC /WE ONLY HAVE ONE ARGUMENT
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6003 /PUT OUT A FLOATING ADD
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP I ADDL /AND RETURN
+ADSPCL, ISZ ADDL
+ ISZ ADDL /BUMP RETURN POINT PAST ARGUMENT TO "TAD"
+ SNL /0?
+ JMP I ADDL /YUP - DON'T PUT OUT NUTTIN
+ JMS I PROP
+ OPIAC /PUT OUT "IAC"
+ JMP I ADDL
+
+/ STORES CONTENTS OF AC IN TEMPORARY
+/ PUT OUT DCA OR CALL STO
+/ FOLLOWED BY THE TEMPORARY LOC
+LSTORE, 0
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP FSTO /ITS FLOATING POINT
+ JMS I PROP
+ 6071 /ITS INTEGER...PUT OUT A DCA
+STORET, TAD L46 /GET THE AC AGAIN
+ JMS I PRSYM /PRINT WHATEVER IS IN IT
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L46 /ZERO THE AC
+ JMP I LSTORE /AND RETURN
+FSTO, IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6006 /PUT OUT A CALL TOFLOATING STORE
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP STORET /AND JMP BACK
+COMP, 0
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP FCOM /ITS FLOATING POINT
+ JMS I PROP /ITS INYTEGER
+ 6135 /PUT OUT A CIA
+ JMS I PRINT /PUT OUT A CRLF
+ JMP I COMP /AND RETURN
+FCOM, JMS I FPROP
+ 6140 /TO FLOATING CHANGE SIGN
+ JMP I COMP
+/ COME HERE IF OP IS *
+MUL, JMS I SMODE /CHECK FOR SAME MODE
+ JMS I CHECK /CHECK WHATS IN THE AC
+ JMP TMUL /TWO IS IN THE AC
+ JMS I STORE /SOMETHING IS IN AC...STORE IT
+ JMS I KADDON /NOTHING IS IN AC..GET ONE IN AC
+AMUL, TAD I L43 /GET OPERND TWO
+ JMS I MODE /WHAT MODE IS IT
+ TAD EM6
+ TAD C6022
+ DCA FML /SAVE OPCODE
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FML, 0
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L43 /GET OPERAND TWO
+ JMP I LIRET /AND GO TO THE RETURN ROUTINE
+TMUL, TAD I L41 /GET OPERAND ONE AND REPLACE OPERAND TWO
+ DCA I L43
+ JMP AMUL /AND JUMP BACK
+KADDON, ADDONE
+LIRET, IRET
+EM6, -6
+C6022, 6022
+
+LSUB, JMS I LOOK /CHECK REST OF STATEMENT
+ -6 /
+ -17 /O
+ -25 /U
+ -24 /T
+ -11 /I
+ -16 /N
+ -5 /E
+ JMP I .+1
+ TART
+
+LCLEAR, 0 /CLEAR THE PSEUDO ACC AND MQ
+ DCA L30
+ DCA L31
+ DCA L32
+ DCA L33
+ DCA L34
+ DCA L35
+ JMP I LCLEAR
+ *5000
+/ THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG
+DUMTWO, 0
+ TAD I L41 /GET OPND ONE
+ DCA FDV /AND SAVE
+ TAD I L43 /GET OPND TWO
+ DCA I L41 /ZERO OPND ONE
+ JMS DUMONE /PROCESS DUMMY ARGUMENT
+ TAD FDV /GET SAVED OPERAND
+ DCA I L41 /AND USE AS OPERAND
+ TAD L46 /GET TRIPLE NUMBER
+ DCA I L43 /AND REPLACE
+ JMP I DUMTWO /RETURN
+/ TAKES CARE OF ONE BIING DUMMY ARG
+DUMONE, 0
+ TAD I L42 /GET OPERATOR
+ DCA ASTOP /AND SAVE
+ TAD E41 /GET ADD INDIRECT OPERATOR
+ DCA I L42 /AND REPLACE OPERATOR
+ CDF 10
+ TAD I TRIPL
+ CDF 00
+ DCA FEX /AND SAVE RETURN
+ JMS I TRIPL /CALL TRIPL
+ TAD L46 /GET TRIPLE NUMBER
+ DCA I L41 /AND REPLACE OPERAND
+ TAD ASTOP /RESTORE OPERATOR
+ DCA I L42
+ ISZ L40 /ADVANCE TRIPLE
+ TAD FEX /RESTORE RETURN
+ CDF 10
+ DCA I TRIPL
+ CDF 00
+ JMP I DUMONE /RETURN
+/ COME HERE IF OP IS /
+DIV, JMS I SMODE /CHECK FOR SAME MODE
+ JMS I CHECK /CHECK WHATS IN THE AC
+ JMP DIVE /TWO IS IN AC
+\f JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ SKP /NOTHING IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I MADDTW /GET TWO INTO THE AC
+DIVE, TAD I L41 /GET OPERAND ONE
+ JMS I MODE /WHAT MODE IS IT
+ TAD FM6
+ TAD C6025
+ DCA FDV /SAVE OERATOR
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FDV, 0
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L41 /GET OPERAND ONE
+ JMP I MIRET /JUMP TO RETURN ROUTINE
+/ COME HERE IF OP IS **
+EXP, JMS I CHECK /CHECK WHATS IN THE AC
+ JMP FEXP /TWO IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ SKP /NOW NOTHING IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I MADDTW /GET TWO IN AC
+FEXP, TAD I L41
+ JMS I MODE
+ TAD C6
+ DCA FDV
+ TAD I L43 /GET OPERAND TWO
+ JMS I MODE /WHAT IS ITS MODE
+ TAD C3 /FLOATING POINT
+ TAD C6207 /INTEGER
+ TAD FDV
+ DCA FEX /SAVE REOUTINE POINTER
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FEX, 0
+ TAD I L41 /GET OPERAND ONE
+ DCA I L43 /SAVE IN OPERAND TWO
+ TAD FEX /GET THE OP CODE JUST PUT OUT
+ TAD CM6207 /SUBTRACT THE INTEGER TO INTEGER CASE
+ SZA CLA /WAS THIS THE INTEGER INTEGER CASE
+ TAD L50 /NO, GET A FLOATING POINT POINTER
+ DCA I L41 /AND SUBSTITUTE IT FOR OPERAND ONE
+ JMS I ARG /PUT OUT THE PSEUDO OP ARG
+\f TAD I L43 /GET THE REAL OPERAND ONE IN THE AC
+ JMP I MIRET /JUMP TO THE RETURN ROUTINE
+/COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED
+EIND, TAD C132 /GET AN ASTERISK
+ DCA L60 /PUT IT IN SIXTY
+/COMES HERE IF THE OPERATOR IS AN '='
+EQU, JMS I CHECK /CHECK WHATS IN THE AC
+ NOP /TWO IS IN THE AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I TADDON /NOTHING IS IN AC...ADD ONE TO IT
+ TAD I L43 /GET OPERA ND TWO
+ JMS I MODE /WHAT IS ITS MODE
+ JMP FEQU /ITS FLOATING POINT
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP I LFIX /ITS FLOATING POINT
+EFIX, TAD L60 /GET EQUALS INDIRECT LOCATION
+ TAD C6071 /ADD A DCA
+ DCA ASTOP /AND SAVE OPCODE
+ JMS I PROP /POT OUT THE OPCODE
+ASTOP, 3
+EQRET, DCA L46 /ZERO THE AC
+ TAD I L43 /GET OPERAND TWO
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L60 /ZERO SIXTY
+ JMP I .+1 /AND RETURN
+ ARET
+FEQU, TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ SKP /ITS FLOATING POINT
+ JMS I LFLOAT /ITS INTEGER...FLOAT IT
+ JMP I .+1
+ XXX
+
+LARG, 0
+ JMS I PROP
+ 6201
+ JMP I LARG
+
+TADDON, ADDONE
+E41, 41
+MADDTW, ADDTWO
+FM6, -6
+C6025, 6025
+MIRET, IRET
+C6, 6
+C6207, 6207
+LFIX, FIX
+C6071, 6071
+LFLOAT, FLOAT
+CM6207, -6207
+C132, 132
+\f *5200
+XXX, TAD L60 /GET THE INDIRECT EQUALS SWITCH
+ SNA CLA /IS THE SWITCH ON
+ TAD CM140 /NO, FLOATING POINT STORE
+ TAD C6146 /YES...ISTO
+ DCA FSTOP /SAVE OPCODE
+ IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FSTOP, 6146
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP I .+1 /JUMP BACK
+ EQRET
+/ THIS ADDS OPERAND ONE TO THE AC
+ADDONE, 0
+ TAD I L41 /GET OPERAND ONE
+ JMS I LADDL /PUT OUT OPCODES FOR AN ADD
+ TAD I L41 /GET FIRST OPERAND
+ JMS I PRSYM /PUT OUT SYMBOL
+ JMS I PRINT /PUT OUT CR LF
+ TAD I L41 /GET OPERAND ONE
+ DCA L46 /PUTN THE AC
+ JMP I ADDONE /RETURN
+UMIN, JMS I CHECK /CHECK WHATSN THE AC
+ NOP /TWOSN AC
+ JMS I STORE /THERES SOMETHINGN THE AC...STORET
+ JMS ADDONE /NOTHINGSN AC NOW...PUT ONEN AC
+ JMS I MCOMP /AND COMPLEMENTT
+ JMP RETURN /AND RETURN
+AADD, JMS I SMODE
+ JMS I CHECK /CHECK WHATSN THE AC
+ JMP AONE /TWOSN AC
+ JMS I STORE /THERES SOMETHINGN THE AC...STORET
+ JMS ADDONE /GET ONEN AC
+ JMS ADDTWO /ONESN AC
+ JMP RETURN /RETURN
+AONE, JMS ADDONE /ADD ONE TO TWO
+ JMP RETURN /AND RETURN
+LPROP, 0
+ CDF 10
+ TAD I LPROP
+ CDF 00
+ JMS I PRSYM /AND PRINT THE SYMBOL
+ TAD C40 /GET A SPACE
+ JMS I PRINT /PUT OUT
+ ISZ LPROP /INCREMENT RETURN
+ JMP I LPROP /AND RETURN
+/ THIS ADDS OPERAND TWO TO THE AC
+ADDTWO, 0
+ TAD I L43 /GET OPERAND TWO
+ JMS I LADDL /PUT OUT OPCODES FOR AN ADD
+ TAD I L43 /GET SECOND OPERAND
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT CR LF
+ TAD I L43 /GET OPERAND TWO
+ DCA L46 /AND PUTN AC
+ JMP I ADDTWO /RETURN
+LXZQ, 0 /CHECK FOR EXPRESSION LEFT OF =
+ CLA
+ TAD L22 /GET SUBSCRIPT NESTING DEPTH
+ TAD L44 /GET EQUALS SIGN SWITCH
+ SNA CLA /ARE THEY BOTH ZERO
+ERR42, JMS I LUNCH /N YES ...THATS AN ERROR
+ JMP I LXZQ /RETURN
+RETURN, TAD I L41 /THISS THE RETURN...GET OPERAND ONE
+ JMS I MODE /WHAT MODEST
+ TAD G400 /ITS FLOATING POINT...TURN F.P. BIT ON
+ TAD L40 /ADD CURRENT TRIPLE NUMBER
+ DCA L46 /PUTN AC SW
+ JMP I NARET /AND NOW RETURN FROM THE ROUTINE
+FLOAT, 0
+ JMS I FPROP /PUT OUT A CAL TO THE FLOAT ROUTINE
+ 6127
+ JMP I FLOAT /AND RETURN
+FIX, JMS I FPROP /PUT OUT A CAL
+ 6143 /TO THE FIX ROUTINE
+ JMP I .+1 /AND JUMP BACKLADDL, ADDL
+ EFIX
+C6146, 6146
+LADDL, ADDL
+MCOMP, COMP
+G400, 400
+NARET, ARET
+LSMODE, 0
+ TAD I L43 /GET FIRST OPERAND
+ JMS I MODE /FIND WHAT ITS MODE IS
+ JMP IBM /ITS FLOATING POINT
+ TAD I L41 /GET OPERAND TWO
+ JMS I MODE /THIS BETTER BE INTEGER TOO
+ JMP .+5 /ITS NOT, LUNCH
+ JMP I LSMODE /GREAT, RETURN
+IBM, TAD I L41 /GET OPERAND TWO
+ JMS I MODE /THIS BETTER BE F.P. TOO
+ JMP I LSMODE /IT IS RETURN
+ERR43, JMS I LUNCH /ERROR
+LPUNCH, 0
+ PSF /IS PUNCH READY
+ JMP .-1 /NO, TRY AGAIN
+ PLS /YES, PUNCH THE CHARACTER
+ CLA /CLEAR THE ACCUMULATOR
+ JMP I LPUNCH /AND RETURN
+CM140, -140
+
+LFINI, 0 /FINAL CLEANUP AT END OF COMPILATION
+ JMS I FPROP /PUNCH 'CALL 0,OPEN'
+ OPEN
+ JMS I PROP /PUNCH A 'PAUSE'
+ 6060
+ JMS I PRINT
+ JMS I PRINT /FORCE LAST LINE OUT
+ TAD CM100
+ JMS I LEADR /PUNCH SOME LEADER
+ CDF 10
+XFINI, HLT /JMP I LFINI, FOR DISK SYSTEM ...
+ CIF 0
+ JMP I D1000 /BEGIN NEXT COMPILATION
+D1000, 1000
+CM100, -100
+LEADR, LLEAD
+
+FORST, JMS I PRINT /FORTRAN STARTING POINT
+ JMS I (LIST
+ DCA .-1
+ TAD (LPUNCH
+ DCA PUNCH
+ TAD CM50
+ JMS I LEADR
+ JMS I PROP
+ FORTR
+ JMS I PRINT
+ JMP I .+1
+ START1
+
+PAGE
+\f *5400
+LLAST, TAD C4000 /END OF COMPILATION, SET CHK SO THAT
+ DCA CHK /LGTC WILL NOT READ ANOTHER LINE...
+ JMS I GNB
+ SZA
+ JMP I ASSIGN
+ JMS I (OSTOP /PUNCH A 'HLT' ETC.
+ TAD L55
+ TAD C25
+ SZA CLA /IS DO LIST EMPTY?
+ERR44, JMS I LUNCH /NO, COMPLAIN...
+MORDUM, TAD L56 /GET POINTER INTO SYMBOL TABLE
+ TAD C2 /ADD TWO TO IT FOR CONTROL BITS
+ DCA L72 /SAVE ADDRESS OF CONTROL BITS
+ TAD I L72 /GET THE CONTROL BITS
+ AND E10 /MASK ALL BUT THE DUMMY ARG BIT
+ SNA CLA /IS THE DUMMY ARG BIT ON
+ JMP LEDOUT /NO, PUT OUT DUMMY SUBSCRIPT DEFNS
+ JMS I DEFN /YES, PUT OUT THE VARIABLE NAME
+ JMS I PROP /PUT OUT THE OP CODE
+ 6154 /WHICH IS BSS
+ TAD C2 /RESERVE TWO LOCATIONS
+ JMS I PROTAC /PRINT THE TWO
+ JMS I PRINT
+ ISZ L56 /ADVANCE THE POINTER
+ ISZ L56
+ ISZ L56
+ JMP MORDUM /GO BACK AND DO THE NEXT ONE
+LEDOUT, DCA L72 /ZERO LOCATION 72
+LEDOT1, TAD L25 /GET THE NUMBER OF SUBSCRIPT TEMPS
+ CMA
+ TAD L72 /SUBTRACT FROM THE NUMBER WEVE DEFINED
+ SNA CLA /HAVE WE DEFINED THEM ALL YET
+ JMP GOOON /YES, NOW PUT OUT THE END
+ TAD K5200 /GET SUBSCRIPT DESIGNATOR
+ TAD L72 /GET WHICH SUBSCRIPT
+ JMS I PRSYM /AND PRINT IT
+ TAD C7240 /GET THE TERMINATOR
+ JMS I P2 /PRINT IT
+ JMS I PROP /PRINT THE OP CODE
+ 6154 /WHICH IS BSS
+ TAD C2 /RESERVE TWO LOCATIONS
+ JMS I PROTAC
+ JMS I PRINT /CRLF
+ ISZ L72 /GO ON TO THE NEXT ONE
+ JMP LEDOT1
+GOOON, JMS I PROP
+ 6157 /PUT OUT AN END
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L65 /ZERO THE PSEUDO LOCATION COUNTER
+ TAD START /CLA = -600
+ JMS I LEAD /PUT OUT LOTS OF LEADER CODE
+ JMS I PROP
+ 6162 /PUT OUT A LAP
+ JMS I PRINT
+SYM, TAD L57
+ CIA
+ TAD L56
+ SZA CLA /ARE THERE ANY SYMBOLS
+ JMP SYM1
+ TAD MIKE8
+ SZA CLA /NO, IS THERE ANY EQUIVALENCING?
+ JMP I LPTEMP
+ JMP I .+1
+ PTEMP
+SYM1, TAD L56
+ TAD C2
+ DCA L72
+ TAD I L72 /GET THE CONTROL BITS
+ DCA L72 /SAVE THEN
+ TAD L72 /GET THE BITS
+ AND E7 /MASK
+ SZA CLA /ARE THEY FUNCT NAME,
+ JMP UP /YES
+ JMS I DEFN /PUT IT OUT
+ TAD L72
+ AND E20 /MASK ALL BUT THE DIMEN
+ SNA CLA /IS EITHER ONE ON
+ JMP NORM /NO
+ TAD L56
+ JMS I DIM
+ DCA L26
+ TAD I L14 /GET THE SECOND DIMENSION
+ CLL CIA /AND NEGATE
+ DCA L73 /SAVE
+ SZL
+ERR36, JMS I LUNCH
+ TAD L26
+ ISZ L73
+ JMP .-4
+ACK, DCA L26
+ TAD L56
+ JMS I MODE /DETERMINE MODE OF SYMBOL
+ TAD L26
+ RAL CLL
+ TAD L26
+ SZL
+ JMP ERR36
+ DCA L26
+ TAD L72
+ AND C40
+ SZA CLA
+ JMP COM
+ JMS I BSS
+UP, ISZ L56
+ ISZ L56
+ ISZ L56
+ JMP SYM
+NORM, IAC
+ JMP ACK
+C25, 25
+E7, 7
+K5200, 5200
+DEFN, LDEFN
+E20, 20
+E10, 10
+LPTEMP, EEK
+LEAD, LLEAD
+COM, JMS I PROP
+ 6165
+ TAD L26
+ JMS I PROTAC
+ JMS I PRINT
+ JMP UP
+\f *5600
+C7600, 7600
+C177, 177
+LBSS, 0
+ TAD L65 /GET THE LOCATION COUNTER
+ TAD L26 /ADD THE CURRENT AMOUNT TO IT
+ AND C7600 /MASK ALL BUT THE PAGE BITS
+ DCA L64 /SAVE THE NUMBER OF PAGES
+ TAD L65 /GET THE LOCATION COUNTER AGAIN
+ TAD L26 /ADD THE CURRENT DISPLACEMENT AGAIN
+ AND C177 /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE
+ DCA L65 /AND SAVE
+L, TAD L64 /GET THE NUMBER OF PAGES TO BE RESERVED
+ SNA /ARE THERE ANY TO BE RESERVED
+ JMP CRAM /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS
+ TAD C7600 /YES...SUBTRACT ONE FROM THE PAGE COUNT
+ DCA L64 /AND SAVE IT
+ TAD L65 /GET THE NUMBER OF EXTRA LOCATIONS
+ DCA L26 /AND PUT IN THE DISPLACEMENT LOCATION
+ JMS I PROTAC /PUT OUT A ZERO
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP /PUT OUT THE OPCODE
+ 6151 /WHICH IS THE PAGE PSEUDO OP
+ JMS I PRINT /PUT OUT A CRLF
+ JMP L /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES
+CRAM, JMS I PROP /NOW PUNCH 'BLOCK <N>'
+ BLCK
+ TAD L26
+ JMS I PROTAC
+ JMS I PRINT
+ JMP I LBSS
+LDEFN, 0
+ TAD L56 /GET THE POINTER TO THE SYMBOL
+ JMS I PRSYM /PRINT THE SYMBOL
+ TAD C7240 /GET THE TERMINATOR
+ JMS I P2 /PRINT IT
+ JMP I LDEFN /AND RETURN
+AFCON, TAD L47 /GET START OF FCON TABLE
+ TAD C3 /UPDATE IT
+ DCA L56 /SAVE UPDATED ADDRESS
+FLOOP, TAD L50 /GET END OF FCON TABLE
+ CIA
+ TAD L56 /SUBTRACT FROM CURRENT POINTER
+ SNA CLA /ARE WE DONE
+ JMP ALTHRU /YES
+ TAD CM3 /NO, GET MINUS THREE
+ DCA L63 /TO USE AS A COUNTER
+ JMS LDEFN /DEFINE IT
+ TAD I L56 /GET THE FIRST WORD
+ ISZ L56 /ADVANCE THE POINTER TO THE NEXT WORD
+ JMS I PROTAC /PRINT THE WORD
+ JMS I PRINT /PUT OUT A CRLF
+ ISZ L63 /HAVE WE PUT OUT ALL THREE WORDS
+ JMP .-5 /NO...PUT OUT ANOTHER
+ JMP FLOOP /YES...GET THE NEXT CONSTANT
+PTEMP, TAD K561
+ DCA L56
+FTLOOP, TAD L45
+ CMA
+ TAD L56
+ SNA CLA
+ JMP ITEMP
+ TAD C3
+ DCA L26
+ TAD K5400 /GET F.P. DESIGNATOR
+ JMS LDEFN /PRINT THE SYMBOL
+ JMS I BSS /RESERVE THE LOCATIONS FOR IT
+ ISZ L56 /INCREMENT THE POINTER
+ JMP FTLOOP
+ITEMP, TAD K531
+ DCA L56
+ILOOP, TAD L51
+ CMA
+ TAD L56
+ SNA CLA
+ JMP SUBOUT
+ IAC
+ DCA L26
+ TAD K5000 /GET THE INTEGER TEMP DESIGNATOR
+ JMS LDEFN /PRINT IT
+ JMS I BSS /RESERVE LOCATIONS FOR IT
+ ISZ L56 /INCREMENT THE POINTER
+ JMP ILOOP
+ALTHRU, TAD D6 /PUNCH AN 'IFF 6'
+ JMS I PIFF /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE
+ JMS I PROP
+ 6055 /PUT OUT AN EAP
+ JMS I PRINT
+ TAD L70 /GET THE SUBROUTINE FUNCTION POINTER
+ SZA CLA /IS IT ZERO
+ JMP THRU /NO...WE MUST BE IN A SUBR OR A FUNC
+ JMS I PROP /YES ...WERE IN A MAIN PROGRAM
+ 6052 /PUT OUT ENT
+ TAD C6000 /POINTER TO THE SYMBOL MAIN
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT A CRLF
+ TAD C6000 /GET THE POINTER TO MAIN AGAIN
+ JMS I PRSYM /PRINT IT
+ TAD C7240 /GET A COLON
+ JMS I P2 /PRINT THEM
+ JMS I PROP
+ 6047
+ JMS I PRINT /PUT OUT A CRLF
+THRU, JMS I FINI
+ 6201 /CDF FIELD 0
+ JMP I C7600 /AND RETURN TO THE MONITOR ...
+C6000, 6000
+SUBOUT, DCA L56
+SUBOT1, TAD L25
+ CMA
+ TAD L56
+ SNA CLA
+ JMP AFCON
+ JMS I PROP /PUT OUT THE OP CODE
+ 6176 /WHICH IS DUMMY
+ TAD X5200 /GET SUBSCRIPT DESIGNATOR
+ TAD L56 /GET THE POINTER
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /CRLF
+ ISZ L56
+ JMP SUBOT1
+K5000, 5000-ITTAB
+K5400, 5400-FTTAB
+K531, ITTAB+1
+K561, FTTAB+1
+X5200, 5200
+FINI, LFINI
+D6, 6
+\f *6000
+/FUNCTION AND SUBROUTINE STATEMENT PROCESSOR
+LFUNC, JMS I LOOK /CHECK REST OF STATEMENT
+MFOUR, -4 /
+ -24 /T
+ -11 /I
+ -17 /O
+ -16 /N
+ CLA IAC /SET SWITCH
+TART, DCA L67 /THIS IS THE SWITCH
+ TAD FIRSTF
+ SNA CLA /INSURE SUBR. OR FUNCT. IS FIRST STMT.
+ERR47, JMS I LUNCH
+ JMS SUBB
+ CLA CMA
+ TAD C6275 /THIS IS THE PLACE TO STORE FUNCTION NAME
+ DCA L11 /USE AUTO INDEXING TO STORE THE NAME
+ TAD L30 /GET THE FIRST WORD
+ DCA I L11 /PUT IT IN THE SYMBOL TABLE
+ TAD L31 /GET THE SECOND WORD
+ DCA I L11 /PUT IT IN THE TABLE
+ TAD L32 /GET THE THIRD WORD
+ IAC /TURN THE EXTERNAL SYMBOL BIT ON
+ DCA I L11 /AND PUT IT IN THE TABLE
+ TAD C6275 /GET THE POINTER
+ DCA L70 /AND PUT IT IN LOC 70
+ JMS I PROP
+ 6052 /PUT OUT AN ENT
+ TAD L70 /GET THE SUBROUTINE NAME
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ CLA CMA
+ DCA READY /SET SWITCH
+ TAD L70 /GET THE SUB NAME
+ JMS I PRSYM /PUT IT OUT
+ TAD C7240
+ JMS I P2 /PUT IT OUT
+ JMS I PROP /PUT OUT THE OP CODE 'BLOCK 2'
+ BLCK
+ TAD C2
+ JMS I PROTAC
+ JMS I PRINT
+ DCA WHICH /ZERO THE SWITCH WHICH TELLS WHICH WORD
+MORE, JMS I GNB
+ SNA /CHECK FOR END OF CARD
+ JMP CKCR
+ TAD CM50 /CHECK FOR LEFT PAREN
+ SNA /IS IT A LPAR
+ JMP GET1 /YES
+ TAD MFOUR
+ SNA /IS IT A COMMA
+ JMP XGET /YES
+ TAD C3
+ SNA CLA /IS IT A LPAR
+ JMP START /YES
+ JMP ERR48 /NO
+GET1, ISZ READY /WERE WE READY FOR LPAR
+ JMP ERR48 /NO, ERROR ...
+XGET, JMS SUBB
+ TAD L32
+ TAD TEN
+ DCA L32
+ TAD C77 /GET MASK FOR SYMBOL TABLE
+ DCA L21 /AND PUT INTO THE SWITCH
+ JMS I SYMTAB /AND PUT IN SYMBOL TABLE
+ JMS I PROP
+ DUMMY
+ TAD L77
+ JMS I PRSYM
+ JMS I PRINT
+DLOOP, JMS I PROP
+ 6063 /PUT OUT A TAD*
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /AND PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6071 /PUT OUT A DCA
+ TAD L77 /GET ADDRESS OF SYMBOL
+ JMS I PRSYM /PRINT IT
+ TAD WHICH /GET THE WHICH SWITCH
+ RAR /GET THE LOW BIT INTO THE LINK
+ SNL CLA /IS THE WHICH SWITCH BIT SWITCHED
+ JMP NEXT /NO...THAT MEANS WERE ON THE FIRST WORD
+ TAD E43 /YES...WERE ON SECOND WORD...GET A "#"
+ JMS I PRINT /PRINT IT
+NEXT, JMS I PRINT
+ JMS I PROP /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP)
+ 6237
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /AND PRINT IT
+ TAD E43
+ JMS I PRINT
+ JMS I PRINT /PUT OUT A CRLF
+ ISZ WHICH /INCREMENT THE SHICH SWITCH
+ TAD WHICH /GET THE SWITCH
+ RAR /GET LOW BIT IN THE LINK
+ SZL CLA /IS THE LOW BIT ON
+ JMP DLOOP /YES...WORK ON THE SECOND WORD
+ JMP MORE /GO GET SOME MORE
+READY, 0
+SUBB, 0
+ JMS I ENTITY
+ SKP
+ JMP I SUBB
+E43, 43
+TEN, 10
+ JMP ERR48
+WHICH, 0
+C6275, 6275 /SUBROUTINE OR FUNCTION NAME POINTER
+CKCR, ISZ READY
+ERR48, JMS I LUNCH
+ JMP START
+
+IOEQL, CLA CMA /ROUTINE TO TERMINATE IMPLIED DO LOOPS
+ TAD IMPDO
+ DCA IMPDO /REDUCE THE DEPTH BY 1
+ JMS I DONEXT /GENERATE END-OF-LOOP CODE
+ JMS I GNB
+ TAD CM51
+ SZA CLA /SKIP TO A RIGHT PAREN
+ JMP .-3
+ JMP I .+1
+ IOH0
+DONEXT, LDNEXT
+\f *6172
+C6030, 6030
+LWRIT, JMS I LOOK /LOOK FOR REST OF STATEMENT
+ -1
+ -5
+ TAD C3
+LREAD, TAD C6030 /GET THE POINTER TO READ AND WRITE
+ DCA IOP /USE AS A PARAMETER WITH FPROP
+ JMS I GNB
+ TAD CM50
+ SZA CLA /IS THIS A LEFT PAREN?
+ JMP I ASSIGN
+ JMS SUBA
+ JMS I ZZZ
+ TAD C2
+ JMS I FPROP
+IOP, 0
+ JMS I ARG
+ TAD L32
+ JMS I PRSYM
+ JMS I PRINT
+ JMS I ARG
+ JMS I GNB
+ TAD CM54 /IS IT A COMMA
+ SZA CLA
+ JMP ERR50 /NO, ERROR ...
+ JMS SUBA
+ TAD L32 /GET FORMAT
+ SMA
+ JMS I PLAB
+ SPA
+ JMS I PRSYM
+ JMS I GNB
+ TAD CM51 /CHECK FOR A RIGHT PAREN
+ SZA CLA /IS IT?
+ERR50, JMS I LUNCH
+ JMS I PRINT
+IOH0, JMS I GNB
+ SNA
+ JMP IOH2
+ TAD CM54
+ SNA CLA /IS IT A COMMA
+ JMP IOH3 /YES ...
+IOH1, JMS I PUTCH /NO...PUT IT BACK
+ JMS I GNB /THIS STMT IS TRANSFERRED TO!
+ TAD CM50
+ SNA CLA
+ JMP I IOPEN /OPEN PAREN - MAY BE IMPLIED DO-LOOP
+IOH1BK, JMS I PUTCH
+ DCA L52 /SET SWITCHES FOR GENER
+ DCA L46
+ ISZ L44
+ JMS I GENER /START PROCESSING THE IO LIST
+ TAD L41
+ DCA L42
+ TAD L53
+ DCA L73 /SAVE CREATED LABEL LOC
+ DCA L23 /ZERO TEMPORARY FOR "DUMARG"
+ JMS I LCHNG /TEST FOR 0 OR DUMMY ARG
+ DCA I L41
+ TAD L23 /GET TEMPORARY FROM "DUMARG"
+ SZA CLA /ZERO MEANS NON-VARIABLE NAME
+ TAD I L23 /NON-ZERO POINTS TO FLAG WORD OF VAR
+ AND Q20
+ SNA CLA /DO WE HAVE AN ARRAY NAME?
+ JMP NOSYMB /NO
+ JMS I PROP
+ OPCMA /PUT OUT A "CMA" TO DISTINGUISH THIS CALL
+ JMS I PRINT /FROM A REGULAR CALL TO "IOH"
+ TAD C2
+ JMS I FPROP
+ 6036 /OUTPUT A "CALL 2,IOH"
+ JMS I ARG
+ TAD L23
+ TAD CM2
+ JMS I DIM /GET THE DIMENSIONS
+ DCA IOP
+ TAD I L14
+ CIA
+ DCA L44
+ TAD L23
+ TAD CM2
+ JMS I MODE /GET THE MODE OF THE ARRAY
+ TAD C4000 /FLOATING POINT - ADD 4000 TO AC
+ TAD IOP
+ ISZ L44
+ JMP .-2 /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT
+ JMS I PROTAC /PRINT IT
+ JMS I PRINT
+ JMP IOHRSM /GO PRINT ARRAY NAME
+NOSYMB, TAD L46
+ SZA CLA
+ JMS I STORE
+ IAC /THERE WILL BE ONE ARGUMENT
+ JMS I FPROP /PUT OUT THE CALL TO IOH
+ 6036
+IOHRSM, TAD L73
+ DCA L53 /RESTORE CREATED LABEL LOC
+ TAD I L41
+ JMS I QSYMOT
+ TAD L63 /GET TERMINATING CHAR
+ SNA CLA /WAS IT A <CR>?
+ JMP IOH2 /YES
+IOH3, JMS I GNB /GENTLY LOOK AHEAD ...
+ SNA CLA /DO WE HAVE A ',<CR>' ?
+ JMP START /YES, DO NOT TERMINATE YET ...
+ JMP IOH1 /NO, PUSH IT BACK & PROCESS NEXT ITEM
+IOH2, IAC /THERE WILL BE ONE ARGUMENT
+ JMS I FPROP /PUT OUT A CALL TO IOH
+ 6036
+ JMS I ARG /PUT OUT THE PSEUDO OP ARG
+ JMS I PROTAC
+ JMS I PRINT
+ JMP START
+SUBA, 0
+ JMS I ENTITY
+ JMP ERR51 /ITS A CR
+ JMP ERR51+1 /ITS A VARIABLE
+ JMP I SUBA
+Q20, 20
+ERR51, JMS I LUNCH
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB
+ TAD L77
+ JMS I MODE
+ JMP ERR51
+ TAD L77
+ DCA L32
+ TAD L32
+ JMS I DUMARG
+ JMP ERR51
+ JMP I SUBA
+IOPEN, IOOPEN
+QSYMOT, SYMOUT
+\f *6400
+LRET, JMS I LOOK /CHECK REST OF STATEMENT
+ -2
+ -22
+ -16
+ JMS I ZZZ
+ TAD L70
+ SNA CLA /ARE WE COMPILING MAIN PROGRAM?
+ERR60, JMS I LUNCH /YES
+ TAD L67
+ SNA CLA
+ JMP INT /ITS A SUBROUTINE
+ TAD L70 /GET HE NAME OF THE FUNCTION
+ JMS I MODE /IS IT FP OR INTEGER
+ JMP .+4 /ITS FP
+ JMS I PROP
+ 6066 /OPCODE IS TAD
+ JMP .+5 /PUT OUT THE SYMBOL
+ IAC /THERE IS ONE ARGUMENT
+ JMS I FPROP
+ 6003
+ JMS I ARG
+ TAD F34 /GET A BACK SLASH
+ JMS I PRINT
+ TAD L70 /GET THE NAME OF THE FUNCTION
+ JMS I PRSYM /PRINT THE NAME
+ JMS I PRINT /PUT OUT A CRLF
+INT, JMS I PROP
+ 6077 /OPCODE IS RTN
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMP START /WERE DONE
+
+LGETHI, 0 /PUNCH 'TAD ACH'
+ JMS I PROP
+ 6066
+ JMS I PROP /PRINT THE OP CODE
+ 6226 /WHICH IS ACH (HIGH ORDER AC)
+ JMS I PRINT
+ JMS I FPROP /PUNCH 'CALL 0,CLEAR'
+ 6204
+ JMP I LGETHI
+LDIM, 0 /GETS THE 1ST DIMENSION OF THIS VARIABLE
+ DCA LGETHI /SYMBOL TABLE ADDRESS IS IN THE AC
+ CMA
+ TAD L50
+ DCA L14
+LK, TAD I L14 /SEARCH THE DIMENSION TABLE
+ CIA
+ TAD LGETHI
+ SNA CLA
+ JMP .+4
+ ISZ L14
+ ISZ L14
+ JMP LK
+ TAD I L14 /EXIT WITH DIMENSION IN THE AC
+ JMP I LDIM
+/ THIS PROCESSES SUBSCRIPTS
+SUBRET, JMP I LSUBSC /RETURN FROM SUBSC
+LSBTEM, 0 /THIS ROUTINE MAKES AN ENTRY
+ DCA TRIP /IN SUBSCRIPT TEMPORARY TABLE
+ TAD FBASE
+ DCA POINT
+ TAD CM40
+ DCA PCTR
+LOOP, TAD I POINT /LOOK FOR CURRENT TRIPLE NR
+ SNA /OR END OF TABLE...
+ JMP YES
+ CIA
+ TAD TRIP
+ SNA CLA
+ JMP GOT
+ ISZ POINT
+ ISZ PCTR
+ JMP LOOP
+ERR53, JMS I LUNCH
+YES, TAD TRIP
+ DCA I POINT
+GOT, TAD FBASE
+ CIA
+ TAD POINT
+ DCA POINT
+ TAD POINT
+ CIA
+ TAD L25
+ SPA CLA /IF TEMPORARY NR > L25
+ ISZ L25 /BUMP L25
+ TAD POINT
+ JMP I LSBTEM
+LWIPE, 0 /ZERO THE SUBSCRIPT TEMP. TABLE
+ TAD FBASE
+ DCA POINT
+ TAD CM40
+ DCA PCTR
+LOOP2, DCA I POINT
+ ISZ POINT
+ ISZ PCTR
+ JMP LOOP2
+ JMP I LWIPE
+LZER, 0
+ ISZ LZER /INCREMANT
+ JMS I PROTAC /PUT OUT A ZERO
+ JMP I LZER /AND REUTURN
+LCLAB, 0
+ SNA /IF NO LABEL IN AC,
+ JMS I CREATE /CREATE A LABEL
+ JMS I PRCRL /AND PRINT IT
+ TAD C7240 /PUT OUT A COLON AND SPACE
+ JMS I P2
+ JMP I LCLAB /RETURN
+FBASE, 4600
+POINT, 0
+PCTR, 0
+TRIP, 0
+F34, 34
+LSUBSC, 0
+ TAD L46
+ SZA /IS THERE ANYTHING IN THE AC?
+CHANGE, SKP CLA /********************************
+/ TRY CHANGING THIS LOCATION TO A "JMS I MODE"
+/ TO LIMIT THE CHECK TO THE INTEGER AC!
+/ COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P.
+/ EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS)
+ SKP /NOTHING IN THE AC
+ JMS I STORE /YES - STORE IT
+ IAC
+ DCA L63
+ TAD L53
+ DCA L73
+ TAD L41
+ DCA L42
+ ISZ L41
+ TAD I L41
+ TAD CM4046
+ SNA CLA /WAS IT A PRIME
+ JMP BACK
+ JMS I LCHNG
+ DCA L63
+ ISZ L41
+ ISZ L41
+ ISZ L42
+\f ISZ L42
+ IAC
+BACK, ISZ L41
+ DCA SYMOUT
+ JMS CHNG
+ DCA L65
+ ISZ L42
+ ISZ L42
+ JMS CHNG
+ DCA LDUM /SAVE ARRAY POINTER (OR 0 IF DUMMY)
+ TAD L73 /NOW RESTORE THE CREATED LABEL LOC
+ DCA L53
+ TAD SYMOUT
+ SNA CLA /HOW MANY SUBSCRIPTS?
+ JMP .+7 /ONE - SKIP OUTPUTTING "TAD"
+ JMS I PROP
+ 6066
+ TAD I L41
+ JMS I DIM
+ JMS I PRSYM
+ JMS I PRINT
+ TAD I L41
+ JMS I MODE
+ JMP FP
+CASUB, TAD H200
+ TAD L40
+ DCA I L41 /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK
+ TAD SYMOUT /GET NUMBER OF ARGUMENTS (2 OR 3)
+ TAD C2
+ JMS I FPROP /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE
+ 6173 /TO THE SUBSCRIPTING ROUTINE
+ TAD SYMOUT
+ SNA CLA /ONLY ONE ARG?
+ JMP .+3 /YES - DON'T OUTPUT FIRST SUBSCRIPT
+ TAD L63
+ JMS SYMOUT
+ TAD L65
+ JMS SYMOUT
+ TAD LDUM /GET THE ARRAY NAME
+ JMS SYMOUT /OUTPUT IT AS AN ARGUMENT
+ TAD I L41
+ JMS I PRSYM /OUTPUT THE DESTINATION TEMPORARY
+ JMS I PRINT
+ TAD I L41
+ DCA L12 /MARK IT AS THE CONTENTS OF THE LAST LINE
+ JMP I FSUBSC /RETURN
+FP, JMS I PROP
+ OPCMA /OPCODE IS CMA
+ JMS I PRINT
+ TAD H400 /SET MODE TO FLOATING POINT
+ JMP CASUB
+SYMOUT, 0
+ DCA CHNG
+ TAD CHNG
+ SNA CLA
+ JMS I CLAB /CREATE LABEL IF DUMMY ARG
+ JMS I ARG
+ TAD CHNG
+ SNA /IS IT ZERO
+ JMS I ZER /YES PUT OUT A ZERO
+ JMS I PRSYM /OTHERWISE PUT OUT SUBSCRIPT
+ JMS I PRINT /PUT OUT A CRLF
+ JMP I SYMOUT
+
+LDSPCL, DCA L24
+ JMS I CREATE
+ JMS I PRCRL /CHANGE LAST LINE TO STORE IN NEW DESTINATION
+ DCA L12 /MARK LAST LINE USELESS FOR OPTOMIZATION
+ JMP LDMRET
+LDUM, 0
+ ISZ LDUM /INCREMENT RETURN
+ TAD I L42 /GET THE THING WHICH IS DUMMY
+ CIA
+ TAD L12 /DID WE JUST PUT THIS OUT AS A SUBSCRIPT
+ SNA CLA /DESTINATION??
+ JMP LDSPCL /YES - SAVE OODLES OF CODE
+ JMS I PROP
+ 6066 /PUT OUT A TAD
+ TAD I L42
+ JMS I PRSYM /PUT IT OUT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6071 /PUT OUT A DCA
+ JMS I CREATE /CREATE A LABEL
+ JMS I PRCRL /AND PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6066
+ TAD I L42
+ JMS I PRSYM
+ TAD H43
+ JMS I PRINT
+ JMS I PRINT
+ JMS I PROP
+ 6071
+ TAD L53
+ JMS I PRCRL
+ TAD H43
+ JMS I PRINT
+LDMRET, JMS I PRINT
+ JMP I LDUM /RETURN
+CHNG, 0
+ TAD I L42 /NO...THERES TWO SUBSCRIPTS
+ SNA
+ TAD H6041
+ DCA I L42
+ TAD I L42
+ JMS I DUMARG /SEE IF SECOND SUBSC IS A DUMMY ARG
+ JMS I DUM /YES IT IS A DUMMY ARG
+ TAD I L42 /GET THE SECOND SUBSC
+ JMP I CHNG
+
+H400, 400
+H200, 200
+H43, 43
+FSUBSC, SUBRET
+H6041, 6041
+\f *7000
+IOHTMP,MCHAR, 0
+NPOINT,LLUNCH, 0
+ CLA
+ DCA L75
+ DCA L24 /ZERO "BUFFER WAITING TO PRINT" FLAG
+ DCA IMPDO /ZERO IMPLIED DO LOOP FLAG
+ TAD TTYPE /CHANGE TO TTY OUTPUT
+ DCA PUNCH
+ JMS I LLIST /TYPE THE CURRENT LINE
+ CLL CMA RAL
+ TAD KOUNT /USE THE BUFFER POINTER AS AN INDEX
+ SMA
+ CMA
+ DCA L7
+ TAD C40 /NOW PUT OUT SOME SPACES...
+ JMS I PRINT
+ ISZ L7
+ JMP .-3
+ TAD D36 /AND AN '^'
+ JMS I PRINT
+ JMS I PRINT
+ TAD LELIST /NOW TYPE THE ERROR MESSAGE
+ DCA L10
+UNCH1, TAD I L10
+ SZA /END OF TABLE?
+ TAD LLUNCH
+ SNA CLA /IS THIS THE MSG WE WANT?
+ JMP UNCH2
+ ISZ L10 /NO
+ JMP UNCH1
+UNCH2, TAD BASE
+ CIA
+ TAD I L10
+ JMS I LLIST /FAKE LISTER INTO PRINTING ERROR MESG
+ JMS I PRINT /FORCE BUFFER
+ TAD EPNCH /BACK TO PUNCH OUTPUT
+ DCA PUNCH
+ ISZ L75 /SET THE NON-PRINT SWITCH
+ TAD CHK /IF ERROR OCCURED WHILE PROCESSING END STMT.
+ TAD C4000 /CHK WILL BE 4000-WANT TO ABORT IMMEDIATELY
+ SZA CLA /WAS IT END STMT?
+ JMP START /NO-GO PROCESS NEXT STMT.
+ JMP I (THRU /YES-CLEAN UP AND ABORT
+LLIST, LIST
+D36, 36
+LELIST, ELIST-1 /ERROR LIST ...
+TTYPE, LTTYPE
+EPNCH, LPUNCH
+CTR, 0
+TEM, 0
+/ THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL
+PARCT,LDCOUT, 0
+ DCA TEM /SAVE THE AC
+ TAD CM3 /WE WILL PUT OUT FOUR CHARACTERS
+ DCA CTR
+ TAD ASE /THIS IS THE ASE OF THE CONVERSION TABLE
+ DCA NPOINT /SAVE IT IN THE POINTER
+ DCA FLAG
+LOP, DCA MCHAR /ZERO OUT THE CHARACTER
+ TAD TEM /GET THE NUMBER AGAIN
+ TAD I NPOINT /TO GET THE ITEM IN THE TABLE
+ SPA /IS THE RESULT POSITIVE
+ JMP LOPRST /NO...RESTORE THE NUMBER
+ DCA TEM /AND SAVE THIS VALUE
+ TAD D60
+ DCA FLAG /SET FLAG TO SHOW THAT WE HAVE SOMETHING
+ ISZ MCHAR /YES...INCREMENT THE OUTPUT CHARACTER
+ JMP LOP+1 /TRY THE SEQUENCE AGAIN
+LOPRST, CLA
+ TAD MCHAR
+ TAD FLAG
+ SZA /DO WE HAVE A SIGNIFICANT DIGIT?
+ JMS I PRINT /YES - PRINT IT
+ ISZ NPOINT
+ ISZ CTR
+ JMP LOP /AND GET THE NEXT DIGIT
+ TAD TEM /GET THE CHARACTER TO OUTPUT
+ TAD D60 /PUT IT IN TRIMMED ASCII FORM
+ JMS I PRINT /PRINT IT
+ JMP I LDCOUT /YES...RETURN TO CALLING PROGRAM
+ASE, THOU
+FLAG, 0
+
+
+IOOPEN, TAD KOUNT
+ DCA IOHTMP /SAVE POINTER TO LEFT PAREN +1
+ CLA CMA
+ DCA PARCT /INITIALIZE PAREN COUNTER
+ TAD KOUNT
+ DCA TEM /TEM POINTS TO ENTITY (OR PREV ONE IF A VAR)
+IOPENL, JMS I ENTITY /GET SOMETHING
+ERR52, JMS I LUNCH /END OF STMT - BAD
+ JMP IOPENL /VARIABLE - DON'T UPDATE TEM
+D60, 60
+ JMP IOPENL-2 /CONSTANT - UPDATE TEM
+ TAD CM51 /PUNCTUATION - TEST FOR RIGHT PAREN
+ SNA
+ JMP IORPAR /YES
+ IAC
+ SNA /LEFT PAREN?
+ JMP IOLPAR
+ TAD CM25
+ SNA CLA /IF CHAR IS AN EQUAL SIGL
+ TAD PARCT
+ IAC
+ SZA CLA /AND WE ARE ON THE TOP LEVEL OF PARENTHESES
+ JMP IOPENL-2
+ TAD TEM /THEN WE HAVE AN IMPLIED DO
+ DCA KOUNT
+ JMS I DO /GENERATE DO LOOP CODE
+ JMP ERR52 /NOT TERMINATED WITH RPAR - ERROR
+ ISZ IMPDO /BUMP IMPLIED DO COUNT
+ TAD IOHTMP
+ DCA KOUNT /RESTORE CHAR PTR TO BEGINNING OF LOOP
+ JMP I .+1
+ IOH1+1 /COMPILE INNARDS OF LOOP
+
+IOLPAR, CLA CMA
+ TAD PARCT
+ JMP IOPENL-3 /BUMP PAREN COUNT UP AND LOOP
+
+IORPAR, ISZ PARCT /BUMP PAREN COUNT DOWN
+ JMP IOPENL-2 /LOOP IF NOT BALANCED
+ TAD IOHTMP
+ DCA KOUNT /BALANCED - NOT AN IMPLIED DO
+ JMP I .+1
+ IOH1BK /COMPILE NORMALLY
+CM25, -25
+DO, XDO
+\f *7200
+EQUI, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -7 /THERE ARE 7 MORE CHARACTERS
+ -26 /V
+ -1 /-A
+ -14 /-L
+ -5 /-E
+ -16 /-N
+ -3 /-C
+ -5 /-E
+RETA, ISZ SNUM /INCREMENT THE STRING NUMBER
+ JMS CCCC /GET AND CHECK THE NEXT NON-BLANK CHARACTER
+ SKP /ONLY LEGAL CHAR HERE IS A "("
+ JMP RETB /WE GOT THE "("
+ NOP
+ JMP ERR59
+RETB, JMS I ENTITY /LOOK FOR A VARIABLE
+ SKP
+ JMP LA /GOT IT, ANYTHING ELSE IS AN ERROR
+ NOP
+ NOP
+ JMP ERR59
+LA, ISZ L32 /TURN EQUIVALENCE BIT ON
+ ISZ L32
+ TAD K57 /GET MASK FOR SYMBOL TABLE
+ DCA L21 /PUT IN THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB /PUT IN SYMBOL TABLE
+ TAD L77 /GET THE POINTER
+ ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
+ DCA I MIKE4
+ TAD SNUM /GET THE CURRENT STRING NUMBER
+ ISZ MIKE4 /AND PUT IT IN THE EQUIVALENCE TABLE
+ DCA I MIKE4
+ ISZ MIKE8 /INCREMENT NUMBER OF ENTRIES
+ JMS CCCC /GET NEXT PUNCTUATION
+ JMP ERR59 /C/R, THAT'S AN ERROR ...
+ JMP .+3 /LEFT PAREN, VARIABLE IS SUBSCRIPTED
+ JMP LB /COMMA, NOT SUBSCRIPTED, STRING CONTINUES
+ JMP LC /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING
+ JMS I ENTITY /LOOK FOR SUBSCRIPT
+ NOP
+ SKP
+ JMP LD /GOT IT, ANYTHING ELSE IS ERROR
+ NOP
+ JMP ERR59
+LD, CLA CMA /SUBTRACT ONE FROM
+ TAD L32 /FIRST SUBSCRIPT
+ DCA INTA /AND SAVE
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP /CR IS ILLEGAL HERE
+ JMP RETB-1 /SO IS LEFT PAREN
+ SKP /COMMA, DOUBLY SUBSCRIPTED
+ JMP LF /RIGHT PAREN, SINGLY SUBSCRIPTED
+ JMS I ENTITY /GET OTHER SUBSCRIPT
+ NOP
+ SKP
+ JMP LG /GOT IT
+ NOP
+ JMP LD-1
+LG, TAD L32 /SET IT NEGATIVE
+ CIA
+ DCA INTB /AND SAVE IT
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP
+ NOP
+ERR59, JMS I LUNCH
+ TAD L77 /RIGHT PAREN IS ONLY LEGAL CHARACTER
+ JMS I DIM /GET DIMENSION INFORMATION
+ DCA CCCC /AND SAVE
+ SKP /GO TO TEST PART OF LOOP
+ TAD CCCC /THIS LOOP IS A MAKESHIFT MULTIPLY
+ ISZ INTB /ARE WE DONE
+ JMP .-2 /NO
+ TAD INTA /YES, ADD FIRST SUBSCRIPT
+ DCA INTA /AND SAVE
+LF, TAD L77 /GET POINTER TO VARIABLE
+ JMS I MODE /WHAT MODE IS IT
+ TAD INTA /F.P., MULTIPLY BY THREE
+ RAL CLL /INTEGER
+ TAD INTA
+ IAC /ADD ONE TO ANSWER
+ ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
+ DCA I MIKE4
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP
+ JMP RETB-1 /CR AND "(" ARE ILLEGAL HERE
+ JMP RETB /COMMA MEANS STRING NOT FINISHED
+ JMP LI /")" MEANS STRING FINISHED
+LC, CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE
+ ISZ MIKE4
+ DCA I MIKE4
+LI, JMS CCCC /WE FINISHED A STRING, ARE THERE MORE
+ JMP START /NO
+ SKP
+ JMP RETA /YES
+ JMP RETB-1 /"(" AND ")" ARE ILLEGAL HERE
+LB, CLA IAC /CRAM A ONE INTO TABLE
+ ISZ MIKE4
+ DCA I MIKE4
+ JMP RETB /AND GO BACK
+/
+/ THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR
+/
+CCCC, 0
+ JMS I GNB
+ SNA /PUNCTUATION IS WHAT WE WANT
+ JMP I CCCC /ITS A CR
+ TAD CM54
+ SNA /IS IT A COMMA
+ JMP XCOMMA /YES
+ TAD C3
+ SNA /IS IT A ")"
+ JMP XRPAR /YES
+ IAC
+ SNA /IS IT A "("
+ JMP XLPAR /YES
+ JMP RETB-1 /NONE OF THE ABOVE
+XRPAR, ISZ CCCC
+XCOMMA, ISZ CCCC
+XLPAR, ISZ CCCC
+ JMP I CCCC
+K57, 57
+
+LFIN, JMS I GNB
+ SZA CLA
+ JMP I ASSIGN
+ JMS I ZZZ /PRINT LABEL ON "FINI"
+ JMP I .+1
+ IOH2
+
+/THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE
+/AT THE END OF A COMPILATION
+\f *7376
+EEK, ISZ MIKE4
+ ISZ MIKE4
+ DCA I MIKE4 /SET END OF LIST
+ JMS INIT /INITIALIZE POINTERS
+AAB, TAD MA /SET POINTERS TO STRING NUMBERS
+ TAD C3
+ DCA MB
+ ISZ MA
+ ISZ MA
+AAC, ISZ MB
+AA, ISZ MB
+ TAD I MA /GET FIRST STRING NUMBER
+ CIA
+ TAD I MB /SUBTRACT FROM SECOND
+ SZA CLA /ARE THEY THE SAME
+ JMP KICK1 /NO, ADVANCE POINTERS
+ ISZ MA /YES, MOVE TO LINEAR SUBSCRIPT
+ ISZ MB
+ TAD I MA /GET FIRST SUBSC
+ CIA
+ TAD I MB /SUBTRACT FROM SECOND
+ SPA CLA SNA /IS FIRST ONE SMALLER
+ JMP KICK2 /NO, JUST ADVANCE POINTERS
+ TAD MA /YES, SWITCH PLACES
+ TAD CM2
+ DCA MA
+ TAD MB
+ TAD CM2
+ DCA MB
+ TAD CM3
+ DCA INIT
+RAUCH, TAD I MA
+ DCA L76
+ TAD I MB
+ DCA I MA
+ TAD L76
+ DCA I MB
+ ISZ MA
+ ISZ MB
+ ISZ INIT
+ JMP RAUCH
+ TAD MA
+ TAD CM2
+ DCA MA
+ JMP AA /NOW THEYRE SWITCHED, CHECK AGAIN
+KICK2, CLA CMA /MOVE BACK FIRST POINTER
+ TAD MA
+ DCA MA
+ JMP AAC
+KICK1, ISZ MA /MOVE UP FIRST POINTER
+ ISZ MIKE7 /ARE WE OUT OF ENTRIES
+ JMP AAB /NO
+/
+/ NOW THE SORTING IS DONE
+/
+ JMS INIT /INITIALIZE POINTERS
+ DCA TOTAL /ZERO OUT TOTAL
+MIKE2, ISZ MA
+ TAD I MA
+ JMS I PRSYM /PUT OUT THE SYMBOL
+ TAD C7240
+ JMS I P2 /PUT OUT THE TERMINATOR
+ IAC
+ TAD I MA
+ DCA L14
+ TAD I L14 /GET CONTROL BITS FROM SYMBOL TABLE
+ AND P20
+ SNA CLA /IS IT DIMENSIONED
+ JMP MIKE5 /NO
+ TAD I MA /YES, COMPUTE THE TOTAL LENGTH
+ JMS I DIM
+ DCA L26
+ TAD I L14
+ CIA
+ DCA L73
+ TAD L26
+ ISZ L73
+ JMP .-2
+ SKP /GOT IT
+MIKE5, IAC /IF NOT DIMENSIONED, USE ONE A LENGTH
+ DCA MB /SAVE LENGTH
+ TAD I MA
+ JMS I MODE /WHAT IS THE MODE OF THE SYMBOL
+ TAD MB /FP, MULTIPLY BY THREE
+ RAL CLL
+ TAD MB
+ DCA INIT /SAVE IT
+ TAD TOTAL /GET TOTAL REMAINING LENGTH OF STRING
+ CIA
+ TAD INIT /SUBTRACT CURRENT LENGTH FROM IT
+ SPA CLA /WHICH IS BIGGER
+ JMP .+3 /REMAINING PORTION IS BIGGER
+ TAD INIT /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION
+ DCA TOTAL
+ ISZ MA
+ TAD MA
+ TAD C3
+ DCA MB
+ TAD I MB /GET NEXT ENTRY STRING NUMBER
+ CIA
+ TAD I MA /SUBTRACT CURRENT STRING NUMBER
+ SZA CLA /ARE THEY EQUAL
+ JMP MIKE1 /NO
+ ISZ MA /YES, GET THE DIFFERENCE
+ ISZ MB
+ TAD I MB
+ CIA
+ TAD I MA
+ DCA MB /AND SAVE
+ TAD MB /SUBTRACT DIFFERENCE FROM TOTAL REMAINING
+ CIA
+ TAD TOTAL
+MIKE6, DCA TOTAL /SAVE
+ TAD MB /GET THE DIFFERENCE
+ DCA L26
+ JMS I BSS /RESERVE THAT MANY LOCATIONS
+ ISZ MIKE7 /ARE WE DONE
+ JMP MIKE2 /NO
+ JMP I ROGER /YES
+MIKE1, TAD TOTAL /SWITCH TOTAL TO THE CURRENT LOCATION
+ DCA MB
+ ISZ MA /EQUALIZE POINTERS
+ JMP MIKE6
+/
+INIT, 0
+ TAD MIKE8 /GET ENTRY COUNT
+ CIA /SET NEGATIVE
+ DCA MIKE7 /SAVE
+ TAD POINTZ /GET TABLE POINTER
+ DCA MA /SAVE
+ JMP I INIT
+/
+ROGER, PTEMP
+P20, 20
+$
+
+\f
--- /dev/null
+/OS8 FORTRAN II COMPILER OVERLAY V5 ***FPATCH.05***
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/FIXES TO FPATCH FOR V4 J.K. 1975
+/
+/ .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
+/ BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
+/ TO FORM FORT INSTEAD OF WHOLE WORD
+/
+/ .VERSION NUMBER VIA /V--OPTION
+/ WILL BE PASSED ONTO SABR
+/
+/
+/
+ FIELD 0
+ JSBITS=7746
+ MOFILE=7600
+ MPARAM=7643
+ LLUNCH=7001 /TAKE OUT WHEN MERGING WITH COMPILER
+ DO=7173 /"
+ ELIST=1162 /"
+ EMSG1=1270 /"
+ EMSG14=1520 /"
+ FLST=242 /"
+ FORST=5362 /"
+ FPROP=144 /"
+ GOOON=5455 /"
+ KOUNT=113 /"
+ LPTRIN=545 /"
+ LPUNCH=5333 /"
+ LTTYPE=3372 /"
+ L75=75 /"
+ OSTOP=4052 /"
+ XFINI=5354 /"
+\f *200
+START, CLA CMA
+ DCA FCHFLG
+ CIF 10
+ JMS I (7700
+ 10 /ESCAPE
+ ISZ FCHFLG
+ JMP .+5
+ CIF 10
+ JMS I (200
+ 5 /COMMAND DECODE
+ 0624 /.FT ASSUMED EXTENSION
+ CDF 10
+ TAD I (MPARAM+1
+ CDF 0
+ AND (4
+ SZA CLA
+ JMS VERNUM
+ CLA IAC
+ CIF 10
+ JMS I (200
+ 4 /CLOSE OPERATOR USED AS DELETE
+ OUSNAME /DELETE FORTRN.TM IF IT EXISTS
+ 0
+ CLA /IT DIDN'T EXIST
+ CLA IAC /ENTER A FILE ON "SYS" - MAXIMUM SIZE
+ CIF 10
+ JMS I (200
+ 3 /ENTER
+OUSREC, OUSNAME
+HOLSIZ, 0
+ JMP I (OUERR /WHATS GOING ON HERE?
+ CLA IAC /DEVICE "SYS"
+ CIF 10
+ JMS I (200
+ 2
+PTSABR, SABR
+FCHFLG, 0 /USELESS LENGTH WORD
+ JMP I (BIGGIE
+ TAD PTSABR
+ DCA I (CLSABR
+ TAD OUSREC
+ DCA I (OUTREC
+ TAD HOLSIZ
+ DCA I (OURCNT
+ TAD (1000
+ TAD I (JSBITS
+ DCA I (JSBITS /SET "UNSTARTABLE" STATUS BIT
+ JMS I (FNEWF /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE
+ CDF 10
+ TAD OUSREC
+ DCA I (7620
+ CLA IAC
+ DCA I (7617
+ CLA CLL CML RTL
+ AND I (MPARAM
+ TAD I (MOFILE+5
+ SNA CLA
+ DCA I (FLST
+ TAD I (7600
+ SNA CLA
+ TAD I (MPARAM
+ AND (41
+ SNA CLA /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A
+ JMP FCDF0-3 /RELOCATABLE OUTPUT FILE?
+FTADNM, TAD BDFALT /YES - GIVE HIM ONE
+ DCA I B7600 /NAMED "FORTRL.TM"
+ ISZ FTADNM
+ ISZ B7600
+ ISZ B7773
+ JMP FTADNM
+ CLA CLL CML RAR
+ TAD I (7645
+ DCA I (7645 /SABR IT WAS CHAINED TO BY FORT
+FCDF0, CDF 0
+ JMP I (1003 /START COMPILATION
+
+BDFALT, 1 /DEVICE "SYS"
+ TEXT /FORTRLTM/
+B7600, 7600
+B7773, 7773
+/
+VERNUM, 0
+ TAD I POINT
+ CDF CIF 10
+ JMS I VPRINT
+ ISZ POINT
+ ISZ COUNT
+ JMP .-5
+ JMP I VERNUM
+/
+POINT, VERN
+COUNT, -12
+VERN, 306
+ 317
+ 322
+ 324
+ 240
+ 326
+ 265
+ 301
+ 215
+ 212
+/
+VPRINT, VERPRT
+
+\f /ADDITIONS TO FORTRAN ERROR MESSAGES
+
+ *ELIST+1
+ NUMSG1
+ *EMSG1-2
+ -ERR61-1; EMSG15
+ -ERR62-1; EMSG16
+ -ERR63-1; EMSG17
+ -ERR64-1; EMSG20
+ 0 ; EMSG14
+ /DUMMY PAGES TO CONSOLIDATE CORE IMAGE
+ *1600
+ 0
+ *2000
+ 0
+ *2400
+ 0
+ *3000
+ 0
+ *5600
+ 0
+\f *5400
+FNEWF, 0
+ CDF 10
+ TAD I FILPTR
+ SNA
+ JMP EOFERR /END OF INPUT REACHED BEFORE END STATEMENT
+ DCA INWCNT
+ TAD I FILPTR
+ AND (7760
+ SZA
+ TAD (17
+ CLL CML RTR
+ RTR
+ DCA INRCNT
+ ISZ FILPTR
+ TAD I FILPTR
+ DCA INREC
+ ISZ FILPTR
+ TAD (5001 /FORTRAN ALLOWS TWO-PAGE HANDLERS
+ DCA INHNDL
+ TAD INWCNT
+ CDF 0
+ CIF 10
+ JMS I (200
+ 1 /ASSIGN AND FETCH HANDLER
+INHNDL, 5000 /LOCATIONS 5000-5377 ARE FREE
+ JMP IOERR /SOMETHINGS SCREWY
+ CLA CMA
+ DCA INWCNT
+ DCA INEOF
+ JMS MOUCOR
+ JMP I FNEWF
+FILPTR, 7617
+GETCH, 0
+ KSF
+ JMP .+5
+ KRS
+ TAD (-203
+ SNA CLA
+ JMP I (7600
+ ISZ JMPGET
+ ISZ INWCNT
+JMPG, JMP JMPGET
+ TAD INEOF
+ SNA CLA
+ JMP JUSTRD
+GETNXT, CIF 10
+ JMS I G7700
+ 10 /ESCAPE
+ JMS FNEWF
+JUSTRD, JMS I INHNDL /INHNDL CONTAINS LOCN OF DEVICE HANDLER
+ 0200 /READ 2 HALF-RECORDS INTO FIELD 0
+INBFPT, INBUF
+INREC, 0
+ JMP RERROR
+ ISZ INREC
+ ISZ INRCNT
+ SKP
+ENDFIL, ISZ INEOF
+ TAD (-601
+ DCA INWCNT
+ TAD JMPG
+ DCA JMPGET
+ TAD INBFPT
+ DCA INPTR
+ JMP GETCH+1
+JMPGET, JMP .
+ JMP INCHR1
+ JMP INCHR2
+INCHR3, TAD JMPG
+ DCA JMPGET
+ TAD I INPTR
+ AND (7400
+ CLL RTR
+ RTR
+ TAD INTMP
+ RTR
+ RTR
+ ISZ INPTR
+ JMP GCHCOM
+INCHR2, TAD I INPTR
+ AND (7400
+ DCA INTMP
+ ISZ INPTR
+INCHR1, TAD I INPTR
+GCHCOM, AND (377
+ TAD (-232
+ SNA
+ JMP GETNXT
+ TAD (232
+ CIF 10
+ ISZ GETCH
+ JMP I GETCH
+RERROR, SMA CLA
+ G7700=RERROR
+ JMP ENDFIL
+IOERR, JMS I (SFATAL
+ CIF 10
+ERR62, JMS I (LLUNCH
+INPTR, 0
+INWCNT, 0
+INTMP, 0
+INRCNT, 0
+INEOF, 0
+EOFERR, JMS MOUCOR /KICK MONITOR OUT
+ JMS I (SFATAL
+ CIF 10
+ERR61, JMS I (LLUNCH
+MOUCOR, 0
+ CDF 0
+ CIF 10
+ JMS I (200
+ 11
+ JMP I MOUCOR
+\f *3200
+P377, 377
+P7400, 7400 /WARNING ***DO NOT MOVE THIS***
+
+PUTCH, 0
+ DCA PUTMP
+ RAL
+ DCA PUTLNK
+PUTCHX, ISZ JMPPUT
+ ISZ OUWDCT
+JMPP, JMP JMPPUT
+ CLA CLL CML RTL
+ TAD OURCNT
+ SZL
+ JMP OUERR+1
+ DCA OURCNT
+ ISZ CLOSCT
+ ISZ CLOSCT
+ JMS I (7607
+ 4400
+OUBFPT, OUBUF
+OUTREC, 0
+ JMP I (IOERR
+ ISZ OUTREC
+ ISZ OUTREC
+ TAD (-1401
+ DCA OUWDCT
+ TAD OUBFPT
+ DCA OUPTR
+ TAD JMPP
+ DCA JMPPUT
+ JMP PUTCHX
+JMPPUT, JMP .
+ JMP PUTCH1
+ JMP PUTCH2
+PUTCH3, TAD PUTMP
+ RTL
+ RTL
+ DCA PUTMP
+ TAD JMPP
+ DCA JMPPUT
+ TAD PUTMP
+ AND P7400
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD PUTMP
+ RTL
+ RTL
+P201, AND P7400
+ TAD I OUPTR
+ DCA I OUPTR
+ ISZ OUPTR
+ JMP PCHCOM
+PUTCH2, TAD OUPTR
+ DCA OUPOLD
+ ISZ OUPTR
+PUTCH1, TAD PUTMP
+P200, AND P377
+ DCA I OUPTR
+PCHCOM, CIF 10
+ TAD PUTLNK
+ CLL RAR
+ JMP I PUTCH
+
+EOFORT, SZA CLA /ANY ERRORS?
+ JMP I SF7600 /YES, DO NOT ASSEMBLE
+ DCA PCHCOM
+ TAD (232
+ JMS PUTCH
+ TAD OUWDCT
+ TAD (1400
+ SZA CLA
+ JMP .-5 /FILL BUFFER WITH ^Z
+ TAD I (JSBITS
+ RAR
+ CLL CML RAL
+ DCA I (JSBITS /NO NEED TO SAVE CORE ON THIS MONITOR CALL
+ CIF 10
+ JMS I (7700
+ 10 /ESCAPE
+ CLA IAC /DEVICE "SYS"
+ CIF 10
+ JMS I P200
+ 4 /CLOSE
+ OUSNAM
+CLOSCT, 0 /CLOSING LENGTH
+ JMP OUERR-3
+ CIF 10
+ JMS I P200
+ 6 /RUN
+CLSABR, 0
+BIGGIE, JMS I (MOUCOR
+ JMS SFATAL
+ CIF 10
+ERR63, JMS I (LLUNCH
+ CLA CLL CMA RTL
+ AND I (JSBITS
+ DCA I (JSBITS /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL
+OUERR, JMS I (MOUCOR
+ JMS SFATAL
+ CIF 10
+ERR64, JMS I (LLUNCH
+ INBUF=1600
+ OUBUF=3600
+OURCNT, 0
+OUPTR, OUBUF
+OUWDCT, -1401
+PUTMP, 0
+OUPOLD, 0
+SFATAL, 0
+ PUTLNK=SFATAL
+SF7600, 7600 /CLEAR AC
+ CDF 10
+ TAD SCDIF0
+ DCA I (177
+ TAD (5601
+ DCA I P200
+ TAD SF7600
+ DCA I P201
+SCDIF0, CDF CIF 0
+ JMP I SFATAL
+\f *2200 /CANNOT GO PAST 2373
+SABR, TEXT /SABR/
+ TEXT /SV/
+OUSNAM, TEXT /FORTRNTM/
+NUMSG1, TEXT /ILLEGAL CONTINUATION/
+EMSG15, TEXT /NO END STATEMENT/
+EMSG16, TEXT #I/O ERROR#
+EMSG17, TEXT /SABR.SV NOT FOUND/
+EMSG20, TEXT /NO ROOM FOR OUTPUT/
+\f FIELD 1
+ /THESE ARE THE PATCHES OVER THE COMPILER.
+
+
+ *FORST /HEADER PRINTER
+ NOP
+ NOP
+ NOP
+
+ *FORST+5 /LEADER OUTPUT
+ CLA CLL CMA RTL /3 CHARACTERS OF LEADER
+
+ *LPTRIN+1 /HIGH-SPEED READER ROUTINE
+ CIF 0
+ JMS I .+1
+ GETCH
+
+ *OSTOP+1
+ JMS I FPROP /PUNCH 'CALL 0,EXIT'
+ 6253
+ JMP I OSTOP
+
+ *LPUNCH+1 /PUNCH ROUTINE
+ CIF 0
+ JMS I .+2
+ CLA SKP
+ PUTCH
+
+ *XFINI-3 /TRAILER PRINTER
+ CLA CLL CMA RTL /3 CHARACTERS OF TRAILER
+
+ *XFINI-1 /ENDING SEQUENCE
+ CDF CIF 0
+ TAD L75 /PICK UP ERROR FLAG
+ JMP I .+1
+ EOFORT
+
+ *GOOON+4 /TRAILER AFTER "END" STATEMENT
+ CLA CLL CMA RTL /3 CHARS ETC.
+
+
+ *LTTYPE+1 /REVERSE TTY WAIT MODE
+ TLS
+ TSF
+ JMP .-1
+
+/
+*4753
+VERPRT, 0
+ JMS I VPUNCH
+ CDF CIF 0
+ JMP I VERPRT
+VPUNCH, 3372
+/
+ $
+\f
--- /dev/null
+This area contains the files contained on system release DECtape #2.
+
+Directory of OS/8 V3D DECtape 2 labeled: AL-4692C-SA 2/7/78
+ OS/8 V3D SRC DT 2 OF 7
+ (replaces DEC-S8-OSYSB-B-UA2)
+
+
+FORT .PA 264 01-AUG-77 BAT .PA 12 01-AUG-77
+FPATCH.PA 21 01-AUG-77 RK8ESY.PA 15 01-AUG-77
+SABR .PA 296 01-AUG-77 RF08SY.PA 9 01-AUG-77
+SPATCH.PA 48 01-AUG-77 DF32SY.PA 9 01-AUG-77
+SABR .CO 44 01-AUG-77 DF32NS.PA 8 01-AUG-77
+
+ 10 files in 726 blocks - 4 free blocks
+
+
--- /dev/null
+/2 RF08 SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/MAINTENANCE RELEASE CHANGES:
+
+/1. REMOVED SOFSET
+/2. CHANGED LENGTH OF PLATTER
+
+ DF32=0
+ RF08=1
+ VERSION="B&77
+
+ *0
+ -1
+ DEVICE RF08;DEVICE SYS;4064;2007;0;1777
+
+ STARTB-ENDB-1
+
+ NOPUNC
+ *6604
+ ENPUNC
+STARTB, NOP /FOR "SWAP"
+B6653, 6653
+B7647, 7647
+B7577, 7577
+B200, 200
+B7605, 7605
+B7751, 7751
+ ZBLOCK 6622-.
+ TAD I B6653
+ CDF 10
+ DCA I B7647
+ CDF 0
+ ISZ B6653
+ ISZ B7647
+ JMP .-6 /MOVE FIELD 1 RESIDENT UP
+ IFNZRO RF08 <6643>
+ 6615
+ 7600
+ TAD B7577
+ DCA I B7751
+ TAD B200
+ 6603 /NOW READ IN FIELD 0 RESIDENT FROM RECORD 1/2
+ IFNZRO RF08 <6623>
+ IFNZRO DF32 <6622>
+ JMP .-1
+ 6621
+ IFNZRO RF08 <SKP>
+ HLT /ERROR READING SYSTEM IN
+ENDB, JMP I B7605
+\f /BOOTSTRAP FOR DISK MONITOR IS AS FOLLOWS:
+
+ / LOCATION CONTENTS
+ / 7750 7600
+ / 7751 6603
+ / 7752 6622
+ / 7753 5352
+ / 7754 5752
+\f *200
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+ ZBLOCK 7
+SHNDLR, VERSION
+ CLA CLL CMA RTL /-3
+ DCA SYSCNT /# TRYS ON ERROR
+ TAD I SHNDLR
+ RAL
+ CLA RTL
+ TAD S6603
+ DCA SFUN /EITHER A READ OR WRITE
+ TAD I SHNDLR
+ AND S70
+ DCA SFIELD /GET FIELD OF BUFFER
+ TAD I SHNDLR
+ RAL
+ AND S7600
+ CIA
+ DCA SWC /SET UP WORD COUNT
+ CLA CMA
+ ISZ SHNDLR
+ TAD I SHNDLR
+ DCA SCA /BUFFER ADDRESS-1
+ ISZ SHNDLR
+ IFNZRO DF32 <
+ TAD I SHNDLR
+ RTL
+ AND S3700>
+ TAD SFIELD
+ 6615 /LOAD DISK EXTENDED MEMORY
+S7600, 7600
+ IFNZRO RF08 <
+ TAD I SHNDLR
+ RTR
+ RTR
+ AND S377
+ 6643 /LOAD HIGH ORDER>
+ TAD I SHNDLR
+ RTR
+ RTR
+ RAR
+ AND S7400
+SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE)
+ RDF
+ TAD SCIF
+ DCA SFIELD
+ IFNZRO DF32 <6622>
+ IFNZRO RF08 <6623>
+ JMP .-1
+ ISZ SHNDLR
+ 6621 /SKIP ON ERROR
+ IFNZRO RF08 <SKP /SENSE OF SKIP IS REVERSED>
+ JMP SYSER
+ ISZ SHNDLR
+SFIELD, HLT /RETURN TO PROPER FIELD
+ 6601 /CLEAR TROUBLESOME FLAG
+ JMP I SHNDLR
+ ZBLOCK 2
+SYSER, CLA CLL CML RAR /4000
+ ISZ SYSCNT /TRY AGAIN?
+ SKP CLA
+ JMP SFIELD /WHY BOTHER
+ CLA CLL CMA RTL
+ TAD SHNDLR
+ DCA SHNDLR /RESET PARAMETERS AND TRY AGAIN
+ IFNZRO RF08 <IFNZRO .-7700 <NZERR>; SKP; HLT>
+ JMP SHNDLR+3
+SCIF, CIF 0
+SYSCNT, 0
+ IFNZRO DF32 <IFNZRO .-7700 <NZERR>; SKP; HLT>
+S6603, 6603
+S70, 70
+S7400, 7400
+ IFNZRO DF32 <S3700, 3700>
+ IFNZRO RF08 <S377, 377>
+ SCA=7751
+ SWC=7750
+ $
+\f
--- /dev/null
+/3 RK8E SYSTEM HANDLER FOR OS/8 BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f VERSION="C&77
+
+ *0
+
+ DECIMAL;RKLEN=3248;OCTAL
+
+ -3
+ DEVICE RK8E;DEVICE SYS;4231;2007;0;RKLEN
+ DEVICE RK8E;DEVICE RKA0;4231;1007;0;RKLEN
+ DEVICE RK8E;DEVICE RKB0;4231;SHNDL1&177+1000;0;RKLEN
+/ONE RK8E IS TREATED AS TWO LOGICAL DISKS
+/EACH OF 3248 OS/8 BLOCKS.
+
+/THIS HANDLER CONTAINS ENTRY POINTS FOR THE SYSTEM DEVICE
+/AND RKA1.
+/THIS HANDLER ALLOWS BOOTING OFF OF ANY UNIT
+
+ DCLR=6742
+ DLAG=6743
+ DLDC=6746
+ DRST=6745
+ DSKP=6741
+ DLCA=6744
+ DMAN=6747
+
+ RKEBLK=7750 /12 BITS OF BLOCK NUMBER
+ SERRCT=7751 /HOLDS RETRY COUNT
+ PAGCNT=7752 /PAGE COUNT
+ RKECMD=7753 /BASE OF DLDC COMMAND
+ CHKHED=7754 /CHECK HEADER FLAG
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. FIXED BUG RE INTERACTION WITH NON-SYSTEM HANDLER
+/ [APRIL DSN]
+\f BOOT-BLAST
+
+ RELOC 0
+
+BOOT, TAD I BOOTX1
+ DCA I BOOTX2
+ TAD I BOOTX3
+ CDF 10
+ DCA I BOOTX4
+ CDF 0
+ TAD BOOTX2
+ SZA CLA
+ JMP BOOT
+ JMP I B7605
+BOOTX1, 177
+BOOTX2, 7577
+BOOTX3, 46
+BOOTX4, 7646
+
+ ZBLOCK 30-. /DSKP GOES OVER 30
+
+ DSKP
+ JMP .-1
+ AND RK6
+ DCA I RKUNIT
+ JMP BOOT
+
+RK6, 6
+RKUNIT, SYSUNT+400 /CHANGED BEFORE IT IS MOVED
+B7605, 7605
+BLAST, RELOC
+\f /THE BOOTSTRAP IS RK8E ONLY
+ /30 6743
+ /31 5031
+
+ /LOAD ADDRESS 30 AND START
+
+/BOOTSTRAP FOR OTHER UNITS:
+
+/ 25 7604
+/ 26 6746
+/ 27 6743
+/ 30 7604
+/ 31 5031
+
+/LOAD ADDRESS 25, PUT UNIT # IN BITS 9&10 OF SWITCH REGISTER,
+/CLEAR CONTINUE.
+\f *200
+
+ RELOC 7600
+
+ ZBLOCK 7
+SHNDLR, VERSION /SYSTEM HANDLER ENTRY POINT
+ CLA CLL /GUARD AGAINST RANDOM AC
+ TAD SHNDLR
+ DCA SHNDL1 /SETUP COMMON EXIT AND PARM ADDR'S
+ JMP SHNDC /JUMP TO COMMON CODE
+
+/VARIOUS CONSTANTS TO PAD E.P. FOR RKA1 TO 7621
+S6260, 6260 /SIZE OF ONE LOGICAL DISK
+S4070, 4070 /USED TO GET READ/WRITE AND DF BITS
+S3700, 3700 / " TO GET PAGE COUNT
+SCIF, CIF 0 / " TO RESTORE USERS FIELD
+S37, 37 /USED TO CHECK FOR CYLINDER CHANGE
+
+ IFNZRO .-7621 <ERROR1, BARF>
+
+SHNDL1, VERSION /2ND E.P. FOR RKB0 AND TEMPORARY
+ CLA /GUARD AGAINST NON-ZERO AC
+ TAD S6260 /RKB1 IS SECOND HALF OF PACK
+SHNDC, DCA SHNDLR /SET BLOCK DISPLACEMENT ACCORDING TO SYS OR RKB0
+ CLA CLL CMA RTL /AC=-3
+ DCA SERRCT /RETRY COUNT
+ RDF
+ TAD SCIF
+ DCA SFIELD /RESET USER INST FIELD FOR EXIT
+RETRY, TAD SHNDL1 /AC=-2 IF ERROR ENRTY
+ DCA SHNDL1
+ TAD I SHNDL1 /GET ARG1
+ AND S4070 /GET R/W AND DF BITS
+ TAD SYSUNT
+ DCA RKECMD /BASE COMMAND TO RK8E(DLDC)
+ TAD I SHNDL1 /GET ARG1 AGAIN
+ ISZ SHNDL1 /POINT TO ARG2
+ AND S3700
+ SNA
+ STL CLA RAR /4000
+ DCA PAGCNT /SAVE PAGE COUNT
+ TAD I SHNDL1 /GET ARG2
+ ISZ SHNDL1 /POINT TO ARG3
+ DLCA /LOAD CURRENT ADDRESS REGISTER
+ TAD I SHNDL1 /GET ARG3
+ CLL
+ TAD SHNDLR /SYS OR RKB0 DISPLACMENT
+ DCA RKEBLK /LOW PART OF RK8E BLOCK NUMBER
+ SZL /STILL OFF IF BELOW BLOCK 10000
+OVRFLO, ISZ RKECMD /TURN ON EXTENDED BIT IF OVERFLOWED
+RELOOP, DCA CHKHED /SET CHECK HEADER FLAG TO EITHER
+ /0 OR 4000(WHICH GETS RTR'D BEFORE USED)
+ /AND CAUSES EITHER A "DATA" OR "ALL"
+ /TRANSFER
+ TAD PAGCNT /TEST TO SEE IF ONLY 1 PAGE WANTED
+ AND S7600
+ SNA CLA
+ TAD S400 /100 WAS IN PAGCNT
+ TAD CHKHED /ADD IN CHECK HEADER FLAG
+ CLL RTR /SHIFT TO CORRECT BITS
+ TAD RKECMD /ADD IN BASE COMMAND
+ DLDC /LOAD COMMAND REGISTER
+ TAD RKEBLK
+ DLAG /LOAD BLOCK REGISTER AND GO
+ DSKP /WAIT ON FLAG
+ JMP .-1
+ DRST /READ COMPLETION REGISTER
+ CLL RAL /GET RID OF SUCCESS BIT
+ SZA CLA /AND SEE IF ANYTHING LEFT
+ JMP SERROR /AN ERROR
+ IFNZRO .-7700 <ERROR2, DOUBLE BARF>
+ SKP /PROTECTION AGAINST JMS I 7700 FIELD 0
+ HLT /HE'S HAD IT
+ TAD PAGCNT
+ TAD S7600
+ SPA SNA
+ JMP RKDONE
+ DCA PAGCNT
+ TAD RKEBLK
+ CMA
+ AND S37 /IF BLOCK IS AT A 37 MAKE
+ /NEXT OPERATION DO A CHECK HEADER
+ SZA CLA
+ STL RAR /SET AC TO "ALL" FLAG
+ ISZ RKEBLK /BUMP BLOCK NUMBER
+ JMP RELOOP /TRANSFER SOME MORE
+ JMP OVRFLO /PAST BLOCK 7777-SET EXTENDED BIT
+\f /RECALIBRATE ON ALL ERRORS
+SERROR, DCLR /CLEAR STATUS REGISTER
+ STL RTL /AC=2
+ DCLR /RECALIBRATE DRIVE
+ DSKP /WAIT ON FLAG
+ JMP .-1
+ DCLR /CLEAR STATUS REGISTER
+ DRST /WAIT FOR STATUS TO CLEAR
+ SZA CLA
+ JMP .-3 /V3C STILL DOING RECALIBRATE
+ CLA CLL CMA RAL /AC=-2
+ ISZ SERRCT /SKIP IF WE TRIED 3 TIMES
+ JMP RETRY /TRY AGAIN
+ JMP .+3 /ERROR EXIT
+RKDONE, ISZ SHNDL1 /NORMAL RETURN
+S7600, 7600 /GROUP 2 CLA
+ ISZ SHNDL1 /IF JUMPED TO HERE- ERROR RETURN
+SFIELD, HLT /RESET USERS INST FIELD- WE NEVER TOUCHED DF
+ JMP I SHNDL1 /EXIT
+
+S400, 400 / " FOR 128 WORD TRANSFER MODE(RTR'D IN CODE)
+SYSUNT, 0 /SYSTEM DEV UNIT # (SET BY BOOTSTRAP)
+ RELOC
+ $
--- /dev/null
+/SABR ASSEMBLER, V17
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/NOTE: WHENEVER ABOVE VERSION NUMBER IS CHANGED
+/BE SURE TO ALSO CHANGE VERSION NUMBER FOR TYPEOUT.
+/THIS IS AT VERSN+13 (ABOUT P. 83)
+/
+/THERE ARE TWO BASIC PHASES OF OPERATION WITHIN
+/SABR:(A) COLLECTION AND (B) ASSEMBLY. IN PASS 1
+/SABR COLLECTS A FULL PAGE OF DATA AND THEN
+/ASSEMBLES THE FULL PAGE. IN PASS2 COLLECTION
+/AND ASSEMBLY ARE CARRIED OUT ON A LINE-
+/BY-LINE BASIS RATHER THAN PAGE-BY-
+/PAGE. FOLLOWING IS A DESCRIPTIVE FLOW CHART OF
+/THE PRINCIPAL METHODS OF OPERATION USED IN
+/THE PROGRAM DURING PASS1.
+/(1) BEGINNING AT START THERE ARE TWO ROUTINES NECESSARY
+/TO INTIALIZE THE ENTIRE PROGRAM. IOINIT CARRIES
+/OUT THE DIALOG WITH THE USER TO DETERMINE WHICH
+/I/O DEVICES WILL BE USED. INITA INTIALIZES ALL
+/THE FLAGS AND TABLES WHICH ARE USED CONTINOUSLY
+/THROUGHOUT THE PROGRAM.
+/(2) THE DRIVER FOR THE FULL PAGE-BY-PAGE ASSEMBLER
+/IS CONTAINED IN THE LOOP THAT RUNS FROM RSTRT
+/TO RSTRT6-1. THIS LOOP OPERATES AS FOLLOWS.
+/FIRST IT CALLS INILPT WHICH INITIALIZES ALL
+/THOSE FLAGS AND TABLES WHICH MUST BE
+/REFRESHED OR REBUILT FOR EACH PAGE OF CODE.
+/THEN IT CALLS THE MAIN LINE-BY-LINE
+/COLLECTION LOOP (WHICH IS DESCRIBED IN ITEM 3).
+/WHEN A FULL PAGE OF CODE HAS BEEN COLLECTED
+/THE DRIVER THEN CALLS L55 TO ASSEMBLE THE
+/PAGE (SEE ITEM 8).
+/(3) THE COLLECTION LOOP RUNS FROM RSTRT1 THROUGH
+/THE CODE AT RSTRT6. THIS LOOP FIRST CALLS
+/INCPT WHICH PREPARES FLAGS AND INCREMENTS
+/TABLE POINTERS FOR EACH LINE OF CODE. IT
+/THEN CALLS THE LINE DECODER DCIL (SEE
+/ITEM 4) FOLLOWED BY SETCT, THE ROUTINE WHICH
+/INCREMENTS THE PAGE COUNTERS AS REQUIRED
+/FOR THE GIVEN LINE (SEE ITEM 6). THEN
+/THE COLLECTIONS LOOP PROCEEDS TO INTERPRET
+/THE DATA LEFT BY DCIL AND STORE IT, PROPERLY
+/CODED, ON THE PAGE TABLE. IF THERE WAS
+/A TAG ("LFS" FOR "LOCATION FIELD SYMBOL") IT
+/IS NECESSARY TO CALL RECT FOR A PAGE RECOUNT.
+/(SEE ITEM 7). THEN THE SIZE OF THE PAGE SO
+/FAR COLLECTED IS TALLYED UP BY CPGES. IF
+/IT IS STILL .LE. 200. EVERYTHING IS FINE AND WE
+/RUN THROUGH THE LOOP AGAIN. IF NOT WE
+/FIRST SAVE (USING PUSHIN)
+/ALL THE KEY INFORMATION ABOUT THE LINE WHICH
+/CAUSED THE OVERFLOW AND THEN EXIT FROM THE
+/COLLECTION LOOP TO ASSEMBLE THE PAGE.
+/(4) CERTAIN NOTES ABOUT DCIL MAY BE HELPFUL. THIS
+/ROUTINE CONTROLS INPUT OF THE SOURCE. INDEV
+/(SET BY IOINIT) POINTS TO THE PROPER INPUT
+/ROUTINE, HSR OR ASR. THESE ROUTINES
+/READ ONE CHARACTER AT A
+/TIME FROM THE INPUT DEVICE. THE ROUTINE CALLED
+/R DRAWS CHARACTERS ONE AT A TIME FROM THE
+/INPUT BUFFER (DATA). WHEN THIS BUFFER IS
+/EMPTY R REFILLS IT USING @INDEV. FETCH
+/USES R TO EXTRACT ONE CHARACTER AT A TIME FROM
+/THE INPUT BUFFER AND DOES SOME PRELIMINARY
+/SCREENING. RLN USES FETCH TO READ A
+/FULL LINE OF CODE INTO THE LINE BUFFER.
+\f/L65 READS ONE CHARACTER AT A TIME FROM
+/THE LINE BUFFER. GTSYM READS THE LINE
+/ITEM-BY-ITEM. IF THE ITEM IS A SYMBOL, GTSYM
+/CALLS SRSYM TO LOOK UP THE ITEM IN THE
+/MAIN SYMBOL TABLE OR ENTER IT IF IT IS NOT
+/ALREADY THERE(SEE ITEM 5).
+/**IMPORTANT**
+/WHEN A SYMBOL HAS BEEN PLACED ON THE SYMBOL
+/TABLE THE ADDRESS OF THE FIRST WORD OF THE
+/ENTRY IS RETURNED AT "SYMBOL." THIS ADDRESS
+/IS UNIQUE FOR EACH SYMBOL AND IN THE
+/RANGE 2000-7575. THIS NUMBER IS USED
+/THROUGHOUT THE PROGRAM AS THE IDENTIFIER FOR
+/THIS SYMBOL. ** DCIL CONSIDERS EACH ITEM
+/OF THE LINE AND ACTS APPROPRIATELY. FOR
+/STANDARD INSTRUCTIONS A STRING OF KEY DATA ABOUT
+/THE LINE IS LEFT. IF THE LINE IS A PSUEDO-OP
+/DCIL WILL IMMEDIATELY CALL THE APPROPRIATE PSUEDO-OP
+/HANDLER TO TAKE ALL NECESSARY ACTION. MOST
+/OF THE PSUEDO-OP HANDLERS RETURN TO THE
+/BEGINNING OF DCIL WHERE THE NEXT LINE CAN BE
+/PROCESSED AS IF NOTHING UNUSUAL HAPPENED. THE
+/EXCEPTIONS TO THIS ARE THOSE PSUEDO-OPS WHICH
+/CAUSE A PREMATURE PAGE ASSEMBLY.
+/THE ROUTINE SKIPL IS ACTUALLY A SMALL PART OF
+/DCIL. IT HAS TWO PURPOSES. ONE, IT WATCHES
+/FOR LINES WHICH SHOULD BE IGNORED BECAUSE THE
+/FORTR PSUEDO-OP IS IN EFFECT. SECONDLY IT
+/MUST WATCH FOR SEMI-COLONS SO THAT
+/IF ONE IS ENCOUNTERED(OUTSIDE A COMMENT)
+/THE REMAINDER OF THE LINE CAN BE SAVED FOR
+/PROCESSING AS THE "NEXT" LINE.
+/(5)ONLY TWO MAIN ROUTINES SRSYM AND
+/OBSYM, TOGETHER WITH THEIR SUBSIDIARYS RUSVL AND SUSVL
+/MAY DIRECTLY CONTACT THE MAIN SYMBOL TABLE.
+/THESE ROUTINES COMMUNICATE WITH THE REST OF
+/THE PROGRAM THROUGH FOUR IMPORTANT
+/CELLS IN PAGE 0:
+/USE CONTAINS THE CODE WORD FOR THE SYMBOL ENTRY.
+/VAL CONTAINS THE VALUE OF THE SYMBOL.
+/SYMBOL CONTAINS THE ADDRESS OF THE FIRST WORD OF THE
+/ENTRY(NAMELY THE CODE WORD).
+/VALPTR CONTAINS THE ADDRESS OF THE VALUE WORD
+/OF THE ENTRY.
+/SRSYM, AFTER LOCATING A GIVEN SYMBOL IN THE TABLE
+/(OR ENTERING IT IF NECESSARY)
+/CALLS SUSVL TO FILL THE FOUR CELLS WITH THE
+/PROPER INFORMATION ABOUT THE SYMBOL.
+
+\f/OBSYM USES A SYMBOL IDENTIFIER TO GET
+/THE FOUR ESSENTIAL BITS OF INFORMATION, AGAIN
+/CALLING SUSVL TO DO THE WORK. HOWEVER
+/BEFORE EITHER SRSYM OR OBSYM DO ANYTHING
+/THEY BOTH MAKE USE OF RUSVL. RUSVL IS A
+/VERY IMPORTANT ROUTINE. HERE IS HOW IT WORKS.
+/LET US SUPPOSE THAT THE PROGRAM HAS OBTAINED
+/USE, VAL, SYMBOL AND VALPTR FOR A GIVEN
+/SYMBOL(USING SRSYM OR OBSYM). FURTHER, LET
+/US SUPPOSE THAT THE PROGRAM WISHES TO
+/MODIFY BOTH OR EITHER OF THE CODE AND VALUE
+/WORDS FOR THIS SYMBOL IN THE SYMBOL TABLE.
+/THE PROGRAM DOES NOT DIRECTLY ACCESS THESE
+/WORDS IN THE SYMBOL TABLE. INSTEAD THE
+/PROGRAM MERELY MAKES THE DESIRED MODIFICATIONS
+/TO USE AND VAL. NOW SYMBOL AND VALPTR
+/ARE THE POINTERS FOR STORING THIS NEW INFORMATION
+/BACK IN THE TABLE. IT IS VERY IMPORTANT THAT
+/NO PART OF THE PROGRAM EXCEPT SRSYM AND OBSYM
+/EVER MODIFY SYMBOL OR VALPTR, AND BEFORE
+/EITHER OF THESE MODIFY THEM THEY ALWAYS CALL
+/RUSVL. RUSVL TAKES USE AND VAL
+/INCLUDING ANY MODIFICATIONS THAT HAVE BEEN
+/MADE TO THEM AND STORE THESE WORDS BACK
+/IN THE TABLE USING THE STILL UNCHANGED POINTERS
+/SYMBOL AND VALPTR. IN THIS WAY MODIFICATIONS
+/TO THE SYMBOL TABLE ARE MADE IN TWO STAGES.
+/THE FIRST STAGE CONSISTS OF A SIMPLE REFERENCE
+/TO ONE OF TWO PAGE 0 LOCATIONS, AND THE
+/SECOND STAGE IS TAKEN CARE OF AUTOMATICALLY
+/DURING FURTHER OPERATION OF THE PROGRAM.
+/(6)SETCT AND CPGES DEAL WITH FIVE SEPARATE PAGE
+/COUNTERS. THE SUM OF THESE IS THE NUMBER
+/OF WORDS OF CORE NECESSARY TO ASSEMBLE THE CURRENT
+/COLLECTED DATA. PTSZE (PAGE TABLE SIZE) IS THE
+/NUMBER OF ITEMS - CONSTANTS,ADDRESS PARAMETERS
+/AND INSTRUCTIONS - WHICH HAVE BEEN SO FAR
+/COLLECTED. LTSZE IS THE NUMBER OF DISTINCT LITERALS
+/WHEN ARE REQUIRED ON THE CURRENT PAGE. PGEESC
+/WILL BE EITHER 2 OR 4. IT IS
+/2 IF THE LAST COLLECTED INSTRUCTION WAS NOT A
+/SKIP INSTRUCTION, 4 OTHERWISE. THESE ARE THE
+/NUMBER OF WORDS REQUIRED FOR THE PAGE
+/ESCAPE. THIS ITEM IS IGNORED WHEN THE AUTO-
+/MATIC PAGING SWITCH IS NON-ZERO. OPSCTR
+/IS THE NUMBER OF POINTERS TO OFF-PAGE SYMBOLS
+/WHICH ARE REQUIRED ON THE CURRENT PAGE.
+
+\f/THIS ITEM IS DETERMINED BY USE OF THE
+/PAGE SYMBOL TABLE. TWO TYPES OF SYMBOLS
+/ARE STORED ON THIS TABLE: TAGS(LFS'S) ON THE
+/CURRENT PAGE AND SYMBOLS WHICH ARE REFERENCED
+/BY MEMORY REFERENCE INSTRUCTIONS(AFS'S) ON THE
+/CURRENT PAGE. IN THIS TABLE SABR KEEPS TRACK OF
+/WHETHER THE SYMBOL IS ON-PAGE(I.E. IF IT OCCURS AS
+/A TAG ON THE PAGE) AND WHETHER IT HAS BEEN
+/REFERENCED EITHER SIMPLY OR WITH A NUMBER SIGN
+/(MEANING <SYM>+1). IF THE SYMBOL IS OFF-PAGE
+/AND HAS BEEN REFERENCED ON THE PAGE, ONE POINTER
+/IS REQUIRED ON THE ASSEMBLED PAGE FOR
+/EACH TYPE OF REFERENCE USED (SIMPLE OR #).
+/IN ADDITION CERTAIN INFORMATION REGARDING OBACTR
+/IS KEPT IN THE P.S.T. OBACTR KEEPS COUNT OF
+/THE NUMBER OF EXTRA INSTRUCTIONS WHICH MUST
+/BE GENERATED ON THE CURRENT PAGE. THESE
+/INCLUDE CDF'S TO CURRENT BANK (CODE05 6201'S),
+/CDF 00'S FOR REFERENCE TO COMMON, /(*)
+/JMS CDFSK/SKP PAIRS FOR CDF CUR'S FOLLOWING
+/SKIP INSTRUCTIONS, AND JMS CDZSK/SKP PAIRS FOR
+/CDF 00'S FOLLOWING SKIP INSTRUCTIONS. SUCH
+/CDF'S ARE NEEDED FOR OFF-PAGE REFERENCES WHENEVER
+/THE BANK REFERENCED IS NOT THE SAME AS PREVIOUSLY
+/(0 INSTEAD OF CURRENT=1 OR VICE-VERSA) OR WHEN
+/THE BANK IS UNKNOWN (=-1) AS AFTER A TAG,
+/AT THE START OF A PAGE, OR FOR ALL JMS'S.
+/OBACTR ALSO KEEPS COUNT OF EXTRA INSTRUCTIONS
+/NEEDED TO GENERATE OFF-PAGE INDIRECT REFERENCES.
+/FOR THESE EITHER 2 OR 4 EXTRA INSTRUCTIONS
+/ARE NEEDED DEPENDING ON WHETHER OR NOT THE
+/PREVIOUS INSTRUCTION WAS A SKIP INSTRUCTION.
+/IN THE PST AN UP-TO-DATE RECORD IS KEPT OF THE
+/NUMBER OF INCREMENTS TO OBACTR SPECIFICALLY
+/DUE TO EACH OFF-PAGE SYMBOL. IN VIEW
+/OF THE RECOUNT PROCEDURE DESCRIBED IN ITEM 7
+/IT WOULD SEEM THAT THIS INFORMATION IS REDUNDANT
+/AND UNNECESSARY. HOWEVER, DURING THE DEBUGGING
+/STAGE OF THE PROGRAM WITH PASS 2 INCLUDED
+/I ENCOUNTERED SEVERAL SITUATIONS, WHICH I FIND
+/VERY DIFFICULT TO DESCRIBE, WHERE MORE IMMEDIATE
+/INFORMATION ABOUT OBACTR WAS NEEDED. I
+/AM NOT EVEN COMPLETELY SURE I UNDERSTAND WHY.
+/OBACTR MUST BE WATCHED CLOSELY. AT 6652 IN THE
+/PROGRAM THERE IS SOME CODE TO ASSIST IN
+/DEBUGGING THE PROGRAM IF PROBLEMS ARISE WITH
+/THE PAGE COUNT.
+/WHENEVER A NEW TAG IS ENCOUNTERED ON A
+/PAGE, SETCT USES CPLFS TO REDUCE
+/BOTH OPSCTR AND OBACTR APPROPRIATELY
+/SINCE WHAT PREVIOUSLY WERE OFF-PAGE REFERENCES
+/MAY NOW HAVE BECOME ON-PAGE REFERENCES.
+\f/(7) WHENEVER A TAG IS ENCOUNTERED ON A GIVEN
+/PAGE RECT IS CALLED TO GO THROUGH THE
+/ENTIRE CURRENT PAGE TABLE AND RECOUNT
+/THE PAGE. IT DOES THIS BY CALLING SETCT
+/AGAIN, ONCE FOR EACH ITEM ON THE PAGE TABLE.
+/THE ONLY THING REALLY ACCOMPLISHED HERE
+/IS THAT OBACTR IS RESET. OPSCTR IS
+/UNCHANGED AS WELL AS THE OTHER PAGE COUNTERS.
+/THE NEED TO RECOUNT OBACTR IS SHOWN
+/BY THE FOLLOWING EXAMPLE:
+/ A, TAD B
+/ TAD C
+/ B, 0
+/ <PAGE FILLS UP>
+/ C, 0
+/NOW BECAUSE BANK IS UNKNOWN AFTER "A,"
+/AND B IS UNDEFINED AS YET, "TAD B"
+/REQUIRES A CDF CUR. HENCE INCREMENT OBACTR.
+/"TAD C" IS OFF PAGE TOO, BUT REQUIRES NO
+/CDF SINCE IT IS IN THE SAME BANK.
+/HOWEVER WHEN B IS DEFINED ON PAGE, THE
+/CDF IT CAUSED IS NO LONGER NECESSARY,
+/BUT NOW THE "TAD C" REQUIRES A CDF.
+/(8) THE ROUTINE L55 CAUSES EACH PAGE TO BE ASSEMBLED.
+/DURING PASS 1 THERE ARE TWO SUB-PHASES TO THE ASSEMBLY.
+/FOR THE MOST PART BOTH PHASES RUN THROUGH THE
+/ENTIRE PAGE OF COLLECTED CODE USING THE
+/SAME ASSEMBLY ROUTINES. THE DIFFERENCE IS
+/THAT DURING PHASE 1 (ACTR=0)
+/ACTUAL OUTPUT IS SUPPRESSED. THE KEY
+/PURPOSE OF PHASE 1 IS TO DEFINE ALL THE
+/TAGS THAT OCCUR ON THE PAGE. CLEARLY THE
+/TAGS COULD NOT BE DEFINED DURING COLLECTION
+/BECAUSE AT THAT POINT WE WERE NOT SURE
+/WHAT SYMBOLS EVEN WERE ON PAGE, AND THUS
+/NOT SURE HOW MANY EXTRA INSTRUCTIONS
+/WOULD BE NECESSARY. THUS SUB-PHASE 1 OF THE
+/ASSEMBLY IS REQUIRED SO THAT IN THE
+/SECOND PHASE OF THE ASSEMBLY ON-PAGE
+/FORWARD REFERENCES CAN BE RESOLVED. HENCE
+/L55 CALLS THE ASSEMBLY ROUTINE ASMBL
+/TWICE FOR EACH PAGE OF CODE.
+/(9)AFTER INITIALIZING THE VARIOUS PAGE TABLE POINTERS
+/ASMBL GOES INTO A LOOP WHEREIN THE
+/LINE-BY-LINE ASSEMBLY ROUTINE ASM02 IS
+/CALLED ONCE FOR EACH ITEM ON THE PAGE TABLE.
+/ASM02 IS A HUGE ROUTINE OCCUPYING ABOUT
+/THREE FULL PAGES OF CODE. ASM02 FIRST
+\f/EXAMINES THE CODED DATA PERTAINING TO THE GIVEN
+/ITEM ON THE PAGE TABLE TO DETERMINE WHAT
+/TYPE OF INSTRUCTION IS TO BE ASSEMBLED AND
+/WHAT THE CURRENT BANK AND SKIP SETTINGS
+/ARE. THEN DEPENDING ON THIS ANALYSIS THE ROUTINE
+/TRANFERS TO THE PROPER SUBSECTION OF ITSELF
+/FOR HANDLING THIS TYPE OF INSTRUCTION. THERE
+/ARE A DOZEN OR MORE CASES WHICH MUST
+/BE DEALT WITH. THEN THE ROUTINE MOVES
+/TO ONE OF ITS VARIOUS EXIT STRINGS
+/TO COMPLETE THE ACTION AND SET THE BANK AND
+/SKIP CONDITIONS FOR THE NEXT LINE. AFTER ALL
+/ITEMS ON THE PAGE TABLE HAVE BEEN ASSEMBLED
+/IN THIS WAY ASMBL THEN CALLS THE ROUTINE
+/A2. A2 PRODUCES (IN PHASE 2) THE PAGE ESCAPE AND
+/THEN OUTPUTS THE ENTIRE LITERAL TABLE WITH
+/ALL THE OFF-PAGE POINTERS INTERMINGLED.
+/(10) SPECIAL CONSIDERATION SHOULD BE GIVEN TO OFF-
+/PAGE FORWARD REFERENCES SINCE THEY WILL REMAIN
+/UNRESOLVED WHEN THE CURRENT PAGE HAS BEEN
+/ASSEMBLED. DURING ASSEMBLY WHEN
+/A REFERENCE TO AN OFF-PAGE, OR AN AS YET
+/UNDEFINED SYMBOL IS ENCOUNTERED THE SYMBOL'S
+/IDENTIFIER IS STORED ON THE LITERAL/OFF-PAGE POINTER
+/TABLE. THEN WHEN A2 IS OUTPUTTING THE
+/LITERAL TABLE ANY STILL UNDEFINED SYMBOLS ARE
+/DEALT WITH AS FOLLOWS. THE SYMBOL'S INDENTIFIER
+/TOGETHER WITH THE LOCATION RESERVED IN THE CURRENT
+/PAGE FOR ITS VALUE ARE STORED ON THE OCCURRENCE
+/TABLE. THE LOCATION WHERE THE POINTER MUST BE
+/STORED IN THE CURRENT PAGE IS MERELY LEFT
+/BLANK AT THIS TIME. THEN LATER ON WHEN THIS SYMBOL IS
+/ENCOUNTERED AS A TAG THE ROUTINE LFSCK
+/WHICH PROCESSES TAGS DURING ASSEMBLY WILL
+/REMOVE THE ITEM FROM THE OCCURRENCE TABLE AND
+/OUTPUT IT PRECEEDING THE POINTER BY AN ORIGIN
+/TO THE CORRECT LOCATION.
+/(11) DURING PASS2 (THE LISTING PASS) MOST OF
+/THE SAME CODE IS USED TO PRODUCE THE
+/ASSEMBLY LISTING. HOWEVER THE TIMING IS
+/DIFFERENT. NOW THE COLLECTION-ASSEMBLY
+/ALTERATION IS CARRIED OUT ON A LINE-BY-LINE
+/BASIS RATHER THAN ON A PAGE-BY-PAGE BASIS.
+/(HOWEVER ALL THE PAGE TABLES AND COUNTERS MUST
+/STILL BE MAINTAINED JUST AS IN PASS1.) THE
+/PASS2 OPERATION DIFFERS FROM PASS1 IN THE
+\f/FOLLOWING RESPECTS. EACH TIME A LINE HAS
+/BEEN COLLECTED AND ITS DATA ENTERED INTO THE
+/PAGE TABLE IN THE NORMAL FIRST PASS WAY,
+/A CALL IS ISSUED TO THE LINE-BY-LINE
+/ASSEMBLY ROUTINE ASM02. SINCE ALL SYMBOLS
+/ARE NOW DEFINED THERE WILL BE NO UNRESOLVED
+/FORWARD REFERENCES ON OR OFF-PAGE. ASM02 ACTS
+/DURING PASS2 EXACTLY AS IT DOES DURING PASS1
+/WITH ONE BIG EXCEPTION: THE BINARY OUTPUT ROUTINE
+/OUTBN IN SUPPRESSED AND IN ITS PLACE IS
+/SUBSTITUTED THE LISTING ROUTINE WRITE.
+/WHEN THE PAGE COUNTERS INDICATE THAT THE PAGE
+/IS FULL THE DRIVER ROUTINE WILL CALL L55 AS
+/USUAL. HOWEVER IN PASS2 THE TWO CALLS
+/TO ASMBL ARE BY-PASSED AND INSTEAD A SINGLE
+/CALL TO A2 IS ISSUED SO AS TO GET THE
+/LISTING TO THE PAGE ESCAPE, THE LITERALS AND
+/THE OFF-PAGE POINTERS.
+/(12) THE REASON FOR HAVING SEPARATE LITERAL TABLES FOR THE
+/COLLECTION AND THE ASSEMBLY PHASES OF
+/THE PROGRAM IS THAT DURING PASS2 BOTH
+/PHASES OF THE PROGRAM ARE OPERATING SIMUTANEOUSLY
+/AND BOTH ARE BUILDING LITERAL TABLES IN A
+/DIFFERENT WAY.
+/(13) THE PAGE ESCAPE TABLE, PEBSE, IS NECESSARY
+/IS THAT DURING PASS2 LOCATIONS
+/CANNOT BE ASSIGNED FOR LITERALS AND OFF-PAGE
+/POINTERS UNLESS THE FINAL PAGE ESCAPE
+/FOR THE PAGE IS KNOWN. HENCE THESE NUMBERS
+/ARE SAVED DURING PASS1.
+/(14) THE PAGE OP TABLE IS ACTUALLY A PART OF
+/THE PAGE TABLE.
+/(15) EXTERNAL SYMBOLS ARISE IN TWO WAYS:
+/FROM ENTRY STATEMENTS AND FROM CALL STATEMENTS.
+/THEY ARE ENTERED IN THE E.S.T. IN ORDER OF
+/APPEARANCE IN THE PROGRAM AND NUMBERED
+/ACCORDINGLY. THESE ARE THE NUMBERS WHICH THE
+/LOADER REFERS TO AS "LOCAL EXTERNAL NUMBERS."
+/(16) EQUIVALENCING OF TAGS
+/IS TREATED AS A PSEUDO-OP AND IS
+/HANDLED BY THE ROUTINE PBSS2. (INCIDENTALLY
+/SOME OF THE ODD NAMES IN THE SOURCE WERE
+/PASSED ON TO ME FROM THE ORIGINAL ICS
+/PROGRAM. I DID NOT CHANGE THEM MERELY BECAUSE
+/THEY MADE NO SENSE.) THE OPERATION IS THIS:
+/ALL EXTRA TAGS TO BE DEFINED AT A GIVEN LOCATION ARE
+/ENTERED AS A GROUP IN THE EQUIVALENCE TABLE,
+/AND A CODE BIT IS SET ON THE PAGE TABLE TO
+/INDICATE THAT SUCH A GROUP IS TO BE DEFINED
+/WHEN THE LOCATION HAS BEEN DETERMINED DURING
+/ASSEMBLY. ANUMCK DOES THE WORK OF DEFINITION.
+\f/(*)
+/V03 CHANGE NOTICE:
+/ AS OF V03 THE SABR SYSTEM HAS
+/ BEEN CHANGED SUCH THAT COMMON
+/ WILL RESIDE IN FIELD 1 INSTEAD
+/ OF FIELD 0.
+/ THE ONLY CHANGES REQUIRED TO SABR
+/ ITSELF ARE AS FOLLOWS
+/ (1) HICOM=177 INSTEAD OF 777;
+/ (2) PARG & ASMBL MUST NOW OUTPUT 6211'S
+/ INSTEAD OF 6201'S FOR CDF'S TO COMMON.
+/ NOTE:
+/ THE COMMENTS HAVE NOT BEEN CHANGED TO
+/ REFLECT THIS CHANGE.
+/ ALSO, BANK = 0 IS STILL THE CONDITION
+/ FOR REFERENCES TO COMMON. (BANK=1
+/ STILL MEANS BANK KNOWN TO BE CURRENT
+/ AND BANK = -1 STILL MEANS BANK UNKNOWN.)
+\f
--- /dev/null
+/SABR ASSEMBLER V18
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971,1974,1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/ VERSION SABR.17
+/ OCTOBER 26, 1971
+/ C. MCCOMAS
+/ R. LARY
+/ B. CLOGHER
+/SABR.V17 DEC-08-A2D2-17
+/ OCTOBER 26,1971
+/COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD MASSACHUSETTS 01754
+/ C. MCCOMAS/R. LARY/B. CLOGHER
+
+
+//
+/
+/FIXES TO SABR FOR V18 J.K 1975
+/
+/ .LITERAL POOL OVERFLOW
+/ .INCORRECT LINE NUMBER WITH ERROR MESSAGE
+/
+/
+/ASSEMBLY, LOAD AND SAVE INSTRUCTIONS
+/
+/ .PAL SABR.PA
+/ .PAL SPATCH.PA
+/
+/ .LO SABR$SPATCH$
+/
+/ .SA SYS SABR
+/
+/
+FIELD 1
+/
+/
+/ DEFINE LOCATIONS OF MONITOR SUBROUTINES
+/
+DISPL=10
+CDFSK=35+DISPL
+CDZSK=41+DISPL
+DUMS=57+DISPL
+LINK=23+DISPL
+OBIS=45+DISPL
+OPIS=52+DISPL
+RTN=30+DISPL
+
+
+*1
+USE, 0
+VAL, 0
+SYMBOL, 0 /PTR TO CURRENT USE WORD IN MST
+M7, -7
+AS0, S0
+OTP, CORE1-1 /OCC. TAB. PTR (NEXT FREE WORD BELOW)
+STT, STTP /PTR TO 1ST FREE WORD OF SYM. TAB.
+ /(KEEP STT AFTER OTP FOR INITA)
+
+X0, 0 /LINE BUFFER INDEX
+X1, 0 /TEMP AUTOS
+X2, 0
+X3, 0 /HSR BUFFER INDEX
+
+K2, 2
+K4, 4
+K3, 3
+K130, 130
+K30, 30
+
+/ INDIRRECT REFERENCES
+/
+ICPLFS, CPLFS /CHECK FOR AND PROCESS COLLECTION LFS
+CPGESI, CPGES
+CTYPE, L61 /CHARACTER TYPEOUT ROUTINE
+CRLF, L73
+DUMMY, DUM /DUMMY ROUTINE
+GETCHR, L65 /ROUTINE TO READ NEXT CHAR
+GETSYM, GTSYM /ROUTINE TO INPUT AND DECODE NEXT SYMBOL
+INI, INILPT
+LFSCHK, LFSCK /CHECK FOR A LFS
+OBSYM, OBNSYM /OBTAIN SYMBOL FROM MST
+DCIL1, RDL1
+NULLP, NULL
+OTYPE, L62 /OCTAL TYPEOUT ROUTINE
+OUTBIN, OUTBN /ROUTINE TO OUTPUT COMP WORD AND REL BITS
+OUTSKP, OUTSK /ROUTINE TO OUTPUT A SKIP INSTRUCTION
+POPEXP, POPEX
+PRSYMP, PRSYM
+PUNCH, L63 /BINARY PUNCH ROUTINE
+RDIL, DCIL /READ AND DECODE ONE INPUT LINE
+RECTI, RECT
+L55I, L55
+SKIPL, L72 /SKIPS UNTIL A RETURN OR SEMICOLON
+SLITAB, SLTAB /SEARCH LITERAL TABLE
+SPSTAB, SPSTB /SEARCH PAGE SYMBOL TABLE
+SREST, L66 /ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
+STCE, SETCT
+TEST, TSCHR /ROUTINE TO TEST CHARACTERS FOR EQUALITY
+TYPE, L64 /TTY TYPE ROUTINE
+WLNP, WLN
+WRITEP, WRITE
+/
+/ IMPORTANT VARIABLES
+/
+ACTR, 0 /ASSEMBLY COUNTER
+BSSSW, 0 /BSS 0 IN PROCESS SWITCH
+CHR, 0 /LOC TO HOLD CURRENT CHARACTER
+CSUM, 0 /BINARY CHECK SUM
+EQVOPR, EQUTB /EQUIVALENCE TABLE OUTPUT POINTER
+EQVIPR, EQUTB /EQ. TB. INPUT PTR.
+ILC, 0 /CURRENT LOCATION
+LFSPTR, 0 /POINTER TO LFS TABLE ENTRY
+LINE, 0 /NO OF LINES SINCE LAST LFS
+LITSZE, 0 /SIZE OF LIT TAB (ASM PHASE)
+LTSZE, 0 /SAME FOR COLL. PHASE
+LSTSKP, 0 /LAST INSTRUCTION SKIP INDICATOR
+LSTBNK, 0 /LAST INSTRUCTION BANK INDICATOR
+OBACTR, 0 /OFF BANK INSTRUCTION ADDITION COUNTER
+OPSCTR, 0 /OFF PAGE SYMBOL COUNTER
+/***** KEEP ITEMS SO INCLOSED IN THE GIVEN ORDER FOR INITA
+HICOM, 0177
+PAG, 0200 /CURRENT PAGE BITS
+ESTSIZ, 0 /HOLDS SIZE OF EXTERNAL SYMBOL TABLE
+EQVBIT, 0
+APMSW, 0 /AUTOMATIC PAGING MODE SWITCH
+TEM7, 1 /SPECIAL VARIABLE USED BY ASME5
+CPSW, 1
+DSW, 0
+FORFLG, 0 /FORTR PSUEDO-OP FLAG
+ /POS NON-0 MEANS IGNORE DATA
+SCOLON, 0
+/*****
+PASS, 0
+PGEESC, 0 /HOLDS SIZE OF PAGE ESCAPE REQUIRED FOR CUR PAGE
+PUPGE, 0
+PHASE, 0 /PHASE SWITCH
+PSTCPR, 0 /PAGE SYMBOL TABLE CODE POINTER
+PSTSPR, 0 /PAGE SYMBOL TABLE SYMBOL POINTER
+PSTSZE, 0 /SIZE OF PST
+PTCPR, 0 /PAGE TABLE CODE POINTER
+PTOPR, 0 /PAGE TABLE OP CODE POINTER
+PTSPR, 0 /PAGE TABLE SYMBOL POINTER
+PTSZE, 0 /SIZE OF PT
+TEM1, 0
+TEM2, 0
+TEM3, 0
+TEM4, 0
+TEM5, 0
+PTSIZ=PTSZE /KEYPUNCHING ERROR
+LITSIZ=LITSZE /KEYPUNCHING ERROR
+/
+/LISTING VARIABLES
+LFLG, 0 /0 IF NULL LINE
+EFLG, 0 /ERROR FLAG, 6BIT CHAR. IN LEFT HALF
+VFLG, 0 /0 IF NO VALUE TO OUTPUT
+AFLG, 0 /DITTO FOR ADDRESS
+CODE, 0 /RELOCATION CODE
+ADDRES, 0 /INSTR. ADDRESS
+VALUE, 0 /INSTR. VALUE
+
+/LINE INFO
+LFS, 0 /KEEP THIS LIST ORDERED AS GIVEN
+OP, 0 /TO AGREE WITH TLFS LIST
+IB, 0
+AFS, 0
+UMIC, 0
+NSGN, 0
+EXP, 0
+SK, 0
+CURSKP=SK
+BANK, 0
+S0, 0
+S1, 0
+S2, 0
+S3, 0
+
+
+/ FREQUENTLY USED CONSTANTS
+/
+K5, 5
+K7, 0007
+K10, 0010
+K20, 0020
+K40, 0040
+K77, 0077
+K100, 100
+K177, 0177
+K200, 0200
+K240, 240
+K400=L55I
+K600=GETSYM
+K3000=LFSCHK
+K1000=INI
+K4000=PRSYMP
+K7600, 7600
+M200=K7600
+M254, -254
+LINAX, LINBUF-1
+M2, -2
+M3, -3
+K2000=RDIL
+M3000=STCE
+M7600=K200
+/
+/ CORE LAYOUT POINTERS
+/
+PTOPTB=K200 /PAGE OP CODE TABLE 1 IN BANK 1
+BSEEST=K100 /BASE OF EXTERNAL SYMBOL TABLE IN BANK 1
+MST=K2000 /BASE MAIN SYM. TAB IN BANK1
+LFSBSE=K600 /BASE OF LOCATION FIELD SYMBOL TABLE IN BANK 1
+LITBSE=L55I /BASE OF ASSEMBLY PHASE LITERAL TABLE IN BANK 1
+PSTBSE, PSTB /BASE OF PAGE SYMBOL TABLE IN BANK 0
+PTBSE, PTB /BASE OF PAGE TABLE IN BANK 0
+LTBSE=K1000 /BASE OF COLL. PHASE LIT. TABLE IN BANK 1
+PTB=7176
+PSTB=6776
+
+
+
+IERROR=JMP I . /ERROR MESSAGES
+ ERRI
+CERROR=JMP I .
+ ERRC
+SERROR=JMP I .
+ ERRS
+
+\f*0200
+/
+/ MAIN CONTROL LOGIC
+/
+START, CLA
+ JMS I INITIO
+ DCA PASS
+ DCA I ICALSW
+ JMS I INITAP
+RSTRT, JMS I INI /INITIALIZE PAGE TABLE POINTERS
+ SKP
+RSTRT1, JMS I INCPTI /INCREMENT PAGE TABLE POINTERS
+ JMS I RDIL /INPUT AND DECODE ONE LINE
+ JMS I CKCSWP /CK FOR MISSING ARG
+ DCA BSSSW /ALSO CLR BSS IS PROGRESS SW
+ JMS I STCE /SET COUNTERS FOR CURRENT LINE
+ TAD OP /OP CODE
+ CDF 00
+ DCA I PTOPR /TO PT OP CODE WORD
+ CDF 10
+ TAD SK /OR IN SKIP BIT
+ SZA CLA
+ TAD K40 /SKIP INST
+ TAD I PTCPR /IN CASE LFS BIT IN ALREADY
+ DCA TEM1
+ TAD IB /OR IN INDIRECT BIT
+ SZA CLA
+ TAD K400 /YES
+ TAD TEM1
+ DCA TEM1 /FOR NEW PT CODE WORD
+ TAD EXP /DO WE HAVE A PAR?
+ SZA CLA
+ JMP RSTRT5 /YES
+ TAD UMIC /A MICRO INST?
+ SNA CLA
+ JMP RSTRT4 /NO AN MRI
+ TAD K4 /OR IN OPERATE BIT
+ JMP COMP /EXIT TO COMPUTE PAGE SIZE
+/
+/ PAR FOR AN OP CODE
+/
+RSTRT5, TAD K10 /PLACE PAR BIT ON PAGE TABLE
+ TAD TEM1
+ DCA TEM1
+RSTRT4, TAD M2
+ TAD AFS /IS AFS A CONSTANT
+ SZA
+ JMP .+6 /NO
+ TAD K20 /YES ... CONSTANT BIT
+RSTRT2, TAD TEM1 /+PT CODE WORD
+ DCA TEM1 /FOR NEW PT CODE WORD
+ TAD S0 /ACTUAL BINARY CONSTANT
+ JMP COMPGO /EXIT TO COMPUTE PAGE SIZE
+ IAC
+ SZA CLA /IS AFS A LITERAL
+ JMP .+3 /NO
+ TAD K2 /YES ... LITERAL BIT
+ JMP RSTRT2 /SAVE AS CONSTANT FROM THIS POINT
+ TAD AFS /PLACE AFS ON PST
+COMPGO, DCA I PTSPR
+ TAD NSGN /CK FOR # REF
+ SZA CLA
+ TAD K2000 /YES
+COMP, TAD TEM1 /GET ALL THE BITS
+ DCA I PTCPR /TO THE CODE WORD
+/
+/ NOW COMPUTE THE CURRENT PAGE SIZE
+/
+ TAD LFS /IS THERE AN LFS
+ SZA CLA
+ JMS I RECTI /YES ... EXIT TO RECOUNT PAGE
+ JMS I CPGESI /COMPUTE ACTUAL PAGE SIZE
+ TAD M200 /SUBTRACT PHYSICAL PAGE SIZE
+ SPA SNA CLA /IS SIZE .GT. PHYSICAL SIZE
+ JMP RSTRT6 /NO ... GET NEXT
+ JMS I PSHINI /YES ... PUSH CURRENT INPUT LINE
+ TAD PUPGE /RESTORE LAST PAGE ESCAPE
+ DCA PGEESC
+ CLA CMA /DECREMENT PAGE TABLE SIZE
+ TAD PTSZE
+ DCA PTSZE
+/
+/ ASSEMBLE THE CURRENT PAGE
+/
+ JMS I L55I /ASSEMBLE CURRENT PAGE
+ JMS I UDPG
+ JMS I FIXI /FIX ILC IF PASS 2
+ JMS I POPINI /POP LAST INPUT LINE
+ JMS I INI /INITIALIZE PT POINTERS
+ DCA I RECTI /CLR RECOUNT FLAG FOR CPLFS
+ JMP RSTRT1+2 /EXIT TO PROCESS POPPED LINE
+/
+RSTRT6, TAD PGEESC /SAVE CURRENT PAGE ESCAPE
+ DCA PUPGE /IN CASE NEXT LINE OVERFLOWS PAGE
+ TAD PASS
+ SZA CLA
+ JMS I LASMP
+ JMP RSTRT1
+LASMP, ASM02
+INITAP, INITA
+ICALSW, CALLSW
+INCPTI, INCPT
+POPINI, POPIN
+PSHINI, PUSHIN
+FIXI, FIXILC
+CKCSWP, CKCSW
+/ PAGE PSEUDO OPERATION
+/
+PPAGE, JMS I SKIPL
+ CLA CMA /DECREMENT PAGE TABLE SIZE
+ TAD PTSZE
+ SNA /WATCH FOR ZERO
+ JMP .+3
+ DCA PTSZE /FOR NEW PAGE TABLE SIZE
+ JMS I L55I /ASSEMBLE CURRENT PAGE
+ JMS I UDPG
+ JMP RORGX /INITIALIZE AND INPUT ANOTHER LINE
+/
+/ REORG PSEUDO OPERATOIN
+/
+PRORG, JMS I GETSYM /GET NEXT INPUT ITEM
+ NOP /NOTHING THERE
+ SKP /SYMBOL
+ SKP CLA /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ TAD S0 /NEW RELOCATABLE ORIGIN
+ AND K7600 /MASK OFF PAGE DISPLACEMENT BITS
+ SNA /ARE WE TRYING TO REORIGIN BELOW 200
+ IERROR /YES ... NOT ALLOWED
+ DCA RORG1 /SAVE NEW ORIGIN
+ CLA CMA /DECREMENT PAGE TABLE SIZE
+ TAD PTSZE
+ SNA /IS THIS THE BEGINNING OF A PAGE
+ JMP .+3 /YES
+ DCA PTSZE
+ JMS I L55I
+ TAD RORG1 /NEW ORIGIN
+ DCA PAG /TO PROPER LOCATION
+RORGX, JMS I FIXI
+ TAD RSTRTX /RETURN AT RSTRT INSTEAD OF RDL1
+ DCA DCIL1
+ JMP I NULLP /RE-INITIALIZE AND GO
+RORG1, 0
+RSTRTX, RSTRT
+UDPG, UDPAGE
+INITIO, IOINIT
+\f*0400
+/
+/ ROUTINE TO CAUSE CURRENT PAGE TO BE ASSEMBLED
+
+/THIS ROUTINE ACTS AS THE DRIVER FOR THE ASSEMBLY
+/PROCESS. MOST OF THE ACTUAL ASSEMBLY WORK
+/IS DONE BY ASMBL,A1,A2,& ASM02.
+/FUNCTION:(PASS1)
+/ CALL ASMBL TWICE. THE FIRST TIME
+/ (ACTR=0) PROHIBIT OUTPUT BY CONVERTING
+/ "JMS OUTBIN" TO "JMS DUMMY". BUT
+/ ALSO CONVERT "JMS DUMMY" TO "JMS OUTBN"
+/ SO THAT OUTPUTTING OF OCCURANCES
+/ WILL OCCUR IN FIRST CALL TO ASMBL.
+/ IN GENERAL, IN THE FIRST RUN THRU ASMBL
+/ NOTHING HAPPENS EXCEPT THAT TAGS ARE
+/ DEFINED (BY LFSCK). AS THE TAGS ARE
+/ DEFINED LFSCK ALSO CAUSES THE
+/ OCC.TAB. TO BE SEARCHED FOR PREVIOUSLY
+/ UNRESOLVED FORWARD REFERENCES TO THIS
+/ TAG. IF FOUND, RELOCATABLE POINTERS TO
+/ THE TAG ARE OUTPUT AT ALL REQUIRED
+/ ADDRESSES DURING PHASE1 OF ASMBL.
+/ AFTER THE 1ST ASMBL, OUTBIN & DUMMY ARE
+/ SWITCHED BACK TO NORMAL & ASMBL
+/ IS CALLED AGAIN. DURING 2ND ASMBL
+/ THE TAG DEFN. SECTION OF LFSCK IS
+/ BY-PASSED & ALL CODE EXCEPT OCCURANCES
+/ IS OUTPUT.
+/ (PASS2)
+/ DURING THE LISTING PASS MOST OF THE
+/ ASSEMBLY IS DONE ON A LINE-BY-LINE
+/ BASIS BY ASM02 SO L55 HAS LITTLE
+/ TO DO. IT JUST CALLS A2 TO
+/ OUTPUT THE LITERAL POOL & THEN
+/ A1 TO INIT. ASSEMBLY OF THE NEXT
+/ PAGE.
+/
+L55, 0
+ JMP I L55B /CHANGED FROM V16 TO FIX LISTING BUG
+L55C, TAD PASS
+ SZA CLA
+ JMP L55L
+ JMS I L55A /CHECK COMMON PUNCHED
+ TAD L56 /SET DUMMY ROUTINE TO OUTPUT
+ DCA DUMMY
+ TAD L56+1 /SET OUTPUT ROUTINE TO DUMMY
+ DCA OUTBIN
+ DCA ACTR /CLEAR ASSEMBLY COUNTER
+ TAD EQVOPR /SAVE FOR 2ND ASSEMBL
+ DCA TEM55
+ JMS I ASSMBL /ASSEMBLE PAGE FIRST TIME
+ TAD L56 /RESTORE OUTPUT ROUTINE
+ DCA OUTBIN
+ TAD L56+1 /RESTORE DUMMY ROUTINE
+ DCA DUMMY
+ ISZ ACTR /SET ASSEMBLY COUNTER
+ TAD TEM55 /RESTORE AS BEFORE 1ST ASSEMBL
+ DCA EQVOPR
+ JMS I ASSMBL /ASSEMBLE AND OUTPUT THIS TIME
+ JMP I L55 /RETURN
+L56, OUTBN
+ DUM
+ASSMBL, ASMBL
+L55A, HCBPS
+L55B, EQVFIX
+TEM55, 0
+
+
+
+L55L, JMS I A2P
+ JMS I A1P /INITIALIZE NEXT PAGE
+ JMP I L55
+A2P, A2
+A1P, A1
+
+
+
+/
+/COLLECTION PHASE ROUTINE
+/RECOUNT THE CURRENT PAGE BECAUSE OF AN LFS
+/CALL WITH AC=0, LEAVES AC=0
+/FUNCTION:WHEN A NEW TAG IS DEFINED ON PAGE
+/ OPSCTR & OBACTR MAY NEED TO BE
+/ REDUCED. CPLFS TAKES CARE OF OPSCTR
+/ BUT OBACTR REQUIRES REVIEWING THE
+/ ENTIRE PAGE.
+/OPERATION: (1) CALL CLNPST TO CLEAR BITS 1-9
+/ OF ALL PST CODE WORDS-WIPES OUT
+/ SHARE OF OBACTR DUE TO EACH SYM.
+/ (2) RE-INIT PAGE & CLR OBACTR
+/ (3) FETCH ITEM FROM PAGE TABLE
+/ (4) SET ALL INSTR.TYPE FLAGS ACCORDINGLY
+/ (5) CALL SETC
+/ (6) INC PAGE TABLE PTRS TO NEXT ITEM
+/ & LOOP BACK TO (3)
+/ CONTINUE THRU ENTIRE TABLE.
+/
+RECT, 0
+ TAD PSTSZE /ANYTHING ON PST?
+ SZA
+ JMP I CLENUP /YES, CLEAN PST CODES
+
+RECRET, JMS I INISS /DO INITS.
+ DCA OBACTR /ZERO OFF BANK ADDITION COUNTER
+ TAD PTSZE /SIZE OF PT
+ CIA
+ DCA RECT1 /TO INDEX LOCATION
+/
+/ THIS IS THE RECOUNT LOOP
+/
+RECT2, CDF 00
+ TAD I PTOPR /OP CODE FROM PT
+ CDF 10
+ DCA OP
+ TAD I PTCPR /CK FOR SKIP INST
+ AND K40
+ DCA SK
+ TAD I PTCPR /CK FOR # REF
+ AND K2000
+ DCA NSGN
+ TAD I PTCPR /PT CODE WORD
+ AND K4 /IS IT AN OPERATE INSTRUCTION
+ DCA UMIC
+ TAD I PTCPR /CK FOR PAR EXP
+ AND K10
+ DCA EXP
+ TAD I PTCPR /PAGE TABLE CODE WORD
+ AND K400 /MASK OFF INDIRECT BIT
+ DCA IB /PLACE IT IN PROPER LOCATION
+ TAD I PTCPR /PT CODE WORD
+ AND K20 /IS AFS A CONSTANT
+ CLL RTR
+ SZA
+ JMP .+3 /YES
+ TAD I PTCPR /PT CODE WORD
+ AND K2 /IS AFS A LITERAL
+ CLL RAR
+ SNA
+ TAD I PTSPR /ADDRESS FIELD SYMBOL
+ DCA AFS
+ TAD I PTSPR /ACTUAL LITERAL
+ DCA S0 /TO LITERAL LOCATION
+/
+/ AREA WHICH CALLS COUNT ROUTINE
+/
+RECT3, TAD I PTCPR /PT CODE WORD
+ AND K201 /IS THERE A TAG OR AN EQUIVALENCED TAG?
+ SNA CLA
+ JMP .+3 /NO
+ CLA CMA /YES ... SET BANK UNKNOWN
+ DCA BANK
+ JMS I STCE /CALL COUNT ROUTINE
+ ISZ RECT1 /OVER YET
+ SKP /NO
+ JMP I RECT /EXIT
+ JMS I ISZPT1
+ JMP RECT2 /GO GET NEXT LINE
+RECT1=L55
+INISS, INISUB
+CLENUP, CLNPST
+K201, 201
+ISZPT1, ISZPT
+PAUS1, PPAUS1
+/
+/ END PSEUDO OPERATION
+/
+PEND, TAD FORFLG /IF FLAG ON, TURN OFF &
+ SMA SZA CLA /GO TO RDL1
+ JMP I PAUS1 /GO TURN OFF FORTR P-OP
+ CLA CMA /DECREMENT PT SIZE
+ TAD PTSZE
+ SNA /ARE WE AT THE BEGINNING OF A PAGE
+ JMP PCSM /YES
+ DCA PTSZE /NO ... NEW PAGE TABLE SIZE
+ TAD PAG /CHECK FOR OVERFLOW INTO 7600 PAGE
+ TAD K200
+ SNA CLA
+ SERROR /OVERFLOW-ERROR S
+ ISZ APMSW /LEAVE AUTO PAGING MODE FOR LAST PAGE
+ JMS L55 /ASSEMBLE CURRENT PAGE
+PCSM, JMS I OUTBIN /OUTPUT CKSUM
+ CSUM
+ 10
+ TAD PASS
+ SZA CLA
+ JMP ENDEND
+ JMS I LEAD /OUTPUT TRAILER CODE
+ JMS I PRSYMP /TYPE OUT SYMBOL TABLE
+ ISZ PASS
+ JMS I INITAI
+ JMS I A1P
+ HLT
+ JMP I REE
+ENDEND, JMS I WLNP /LIST THE "END" STATMT
+ HLT CLA
+ JMP I K200 /RESTART AT 200
+REE, RSTRT
+INITAI, INITA
+LEAD, LEADER
+
+
+\f*600
+/READ INPUT ITEM
+/ IGNORES SPACES & TABS TO 1ST CHAR OF ITEM
+/ASSUMES AC=0
+/CALLING SEQ: JMS I GETSYM
+/ NULL RETURN (IF NO ITEM FOUND BEFORE CR ; / *
+/ SYMBOL RET. (WITH SYM PACKED IN S1-S3
+/ AND S0=SYMBOL LENGTH)
+/ CONST. RET. (WITH VALUE IN S0)
+/ LITERAL RET. (WITH VALUE IN S0)
+/SYNTAX: LITERALS: (000 NUMERIC LIT.
+/ (-000 NEG.
+/ (K000 OCTAL
+/ (D000 DECIMAL
+/ ("A ASCII LIT.
+/ (-"A NEGATIVE ASCII
+/ CONSTANTS: 000,-000,"A,OR -"A
+/ NOTE: AFTER A VALID QUOTE ANY ASCII CHAR MAY APPEAR
+/ AND WILL BE STORED AS THE CONST OR LIT VALUE.
+/ THIS INCLUDES CR ; / * SO THESE DO NOT
+/ TERMINATE A LINE AFTER A QUOTE.
+/ALL EXITS LEAVE AC=0
+/NOTE: TO PROVIDE A CHECK OF THE PUNCTUATION
+/CHAR. FOLLOWING PREVIOUSLY READ SYMBOL, GTSYM
+/DECREMENTS THE LINE PTR BEFORE STARTING
+/THE READ. IF THIS IS NOT WANTED
+/CALL TO GTSYM MUST BE PRECEDED
+/BY "ISZ X0"
+
+GTSYM, 0
+ CMA /DECREMENT CHARACTER PTR
+ TAD X0
+ DCA X0
+ TAD DSW /SAVE NUMERIC MODE
+ DCA TEM4
+ CMA /SIGN=-1 FOR POSITIVE
+ITM4, DCA SIGN /SIGN=0 TO FORCE NEGATION
+ITM2, JMS I RC /READ 1ST CHAR
+ JMP ITM5 /DIGIT: GET NUMERIC CONST
+ JMP ITM3 /ALPHA: GET SYMBOL
+ JMS I TEST /SORT LEADING PUNCT.
+ SL2-1
+ BL2-SL2
+ CERROR /ILLEGAL CHAR
+/
+/READ IN A SYMBOL
+/ASSUMES 1ST CHAR ALREADY READ IN & SAVED IN CHR
+/LEAVES SYMBOL PACKED IN 6BIT CHAR PAIRS IN S1-S3
+/ S0=NUMBER OF CHAR PAIRS ACTUALLY USED
+
+ITM3, ISZ SIGN /CK FOR -SYMBOL
+ CERROR /YES
+ DCA S0 /CLR FOR SYM LENGTH COUNT
+ DCA TEM1 /CLR FOR CHAR COUNT
+ DCA TEM3 /SET PTR FOR LEFT BYTE
+ TAD AS0 /AUTO-INDEX STORAGE IN S1-S3
+ DCA X2
+RSM2, ISZ TEM1 /COUNT CHAR
+ TAD TEM1 /ARE MORE THAN 6 CHARS IN?
+ TAD M7
+ SMA CLA
+ JMP RSM1 /YES, IGNORE
+ TAD CHR /NO, GET ASCII
+ AND K77 /MASK TO 6BIT
+ ISZ TEM3 /WHICH BYTE?
+ JMP RSM3 /LEFT
+ TAD TEM2 /ADD ON LEFT HALF
+ DCA I X2 /STORE CHAR PAIR IN S1-S3
+ JMP RSM1
+RSM3, RTL CLL /MOVE 6BIT TO LEFT BYTE
+ RTL
+ RTL
+ DCA TEM2 /SAVE WHILE WAITING ON RT BYTE
+ CMA /SET PTR FOR RT BYTE
+ DCA TEM3
+ ISZ S0 /COUNT 1 SYMBOL WORD
+RSM1, JMS I RC /READ NEXT CHAR
+ JMP RSM2 /DIGIT
+ JMP RSM2 /ALPHA
+ ISZ TEM3 /PUNCT=END OF SYM: CHECK BYTE PTR
+ JMP .+3 /NOTHING IN TEM2
+ TAD TEM2 /SAVE THE ODD CHAR
+ DCA I X2
+ TAD I IFCTP /SKIP SYM TAB IF IF-COUNT NOT UP
+ SMA CLA
+ JMS I SRS /LOOK IT UP IN SYM TAB. & ENTER IF NEC.
+ JMP ITM14 /EXIT
+
+/READ DIGIT STRING
+/ASSUMES 1ST DIGIT ALREADY READ AND ASCII SAVED IN CHR
+/ SGN=-1 IF NUM. IS TO BE NEGATED
+/ DSW=0 FOR OCTAL CONVERSION, 1 FOR DECIMAL
+/LEAVES AC=OCTAL VALUE OF DIGIT STRING (NEG IF SGN=-1)
+/ CHR=ASCII FOR TERMINAL PUNCTUATION
+
+ITM5, DCA TEM1 /CLEAR FOR ACCUMULATION
+RDS1, TAD CHR /REDUCE CHR TO OCTAL VALUE
+ TAD M260A
+ DCA TEM2
+ TAD DSW /OCTAL OR DECIMAL CONVERSION?
+ SZA CLA /OCTAL, CK FOR 8 OR 9
+ JMP MUL1 /DECIMAL, 8 OR 9 IS OK
+ TAD TEM2 /VALUE = 8 OR 9?
+ TAD M7
+ SMA SZA CLA /NO, GO ON
+ CERROR /YES
+ /MULT. PREV. VAL. BY CONV. FACTOR
+ TAD TEM1
+ CLL RTL /ARG *4
+ JMP MUL1+3
+MUL1, TAD TEM1
+ CLL RTL /ARG * 4
+ TAD TEM1 /PLUS ARG=ARG*5
+ RAL /*2
+ TAD TEM2 /ADD NEW DIGIT
+ DCA TEM1 /SAVE ACCUMULATED VALUE
+ JMS I RC /READ NEXT CHAR.
+ JMP RDS1 /DIGIT
+ CERROR /ALPHA
+ TAD TEM1 /PUNCT.; GET TOTAL
+ITM6, ISZ SIGN /IS NEGATE SW. SET?
+ CIA /YES
+ DCA S0 /STORE CONST VALUE
+ TAD TEM4 /RESTORE NUMERIC MODE
+ DCA DSW
+ JMP ITM13 /EXIT
+ITM7, JMS I GETCHR /READ ALPHA CONST.
+ SNA
+ IERROR /NOTHING THERE
+ DCA TEM1
+ JMS I GETCHR /READ NEXT CHAR FOR BENEFIT OF SKIPL
+ CLA
+ TAD TEM1
+ JMP ITM6
+ITM8, JMS I CKIFP /MOVE PTR TO LITERAL EXIT
+ITM9, JMS I RC /READ 1ST CHAR OF LIT.
+ JMP ITM5 /DIGIT: NUMERIC LIT.
+ NOP /ALPHA: MUST BE K OR D
+ JMS I TEST /LOOK FOR K,D,",-
+ SL3-1
+ BL3-SL3
+ CERROR /ILLEGAL CHAR
+ITM10, DCA SIGN /SET FLAG FOR NEG. LIT.
+ JMP ITM9
+ITM11, IAC /FORCE DECIMAL LIT.
+ITM12, DCA DSW /FORCE OCTAL LIT.
+ JMP ITM9
+ITM13, JMS I CKIFP /CONST. EXIT
+ITM14, JMS I CKIFP /SYMBOL EXIT
+ITM15, JMP I GTSYM /NULL EXIT
+M260A, -260
+SRS, SRSYM
+RC, RCH
+SIGN, 0
+IFCTP, IFCTR
+CKIFP, CKIF
+AERROR=JMP I .
+ ERRA
+CALLSP, CALLSW
+/
+/CHECK FOR TOO FEW ARGS
+/AERROR IF CALLSW MINUS
+/
+CKCSW, 0
+ TAD I CALLSP /CK
+ SMA CLA
+ JMP I CKCSW /OK
+ ISZ I CALLSP /COUNT MISSING ARG
+ NOP
+ AERROR /FLAG
+/
+/CHECK FOR TOO MANY ARGS
+/AERROR IF CALLSW POSITIVE
+/
+CKCLS, 0
+ TAD I CALLSP /DO WE WANT THIS ARG?
+ SMA CLA
+ AERROR /NO, ARG COUNT OVERFLOW
+ ISZ I CALLSP /YES, COUNT THIS ARG
+ NOP
+ JMP I CKCLS
+\f*1000
+/
+/ ROUTINE TO INITIALIZE POINTERS FOR THE COLLECTION OF A PAGE
+/
+INILPT, 0
+ CLA IAC
+ DCA PTSZE /SET PAGE TABLE SIZE
+ DCA PSTSZE /ZERO PAGE SYMBOL TABLE SIZE
+ DCA LTSZE /ZERO LITERAL TABLE SIZE (COLL. PHASE)
+ DCA LITSZE /& ASMBLY PHASE LIT TABL
+ DCA OPSCTR /ZERO OFF PAGE SYMBOL COUNTER
+ DCA PHASE /SET PHASE SWITCH TO COLLECTION
+ JMS INISUB
+ CLA CMA
+ DCA I BNKSV
+ CLA IAC
+ DCA I LSTSKK
+ TAD EQVBIT /ANY EQUIV. LEFT FROM LAST PAGE?
+ SZA
+ JMP EQSAV /YES, SKIP TABLE REINIT & SAVE BIT
+ DCA EQVIPR /NO, RE-INIT EQ. TAB. PTRS
+ DCA EQVOPR
+EQSAV, DCA I PTCPR /INITIALIZE PAGE TABLE CODE WORD
+ DCA I PTSPR /INITIALIZE PAGE TABLE SYMBOL WORD
+ CDF 00
+ DCA I PTOPR /INITIALIZE PT OP CODE WORD
+ CDF 10
+ TAD LFSBSE /INITIALIZE LFS TABLE POINTER
+ DCA LFSPTR
+ DCA OBACTR /ZERO OFF BANK ADDITION COUNTER
+ TAD RDL1X /RESTORE IN CASE OF REORG OR PAGE PSUEDO
+ DCA DCIL1
+ JMP I INILPT /RETURN
+
+RDL1X, RDL1
+BNKSV, BNKSAV
+LSTSKK, SKPSAV
+M211, -211
+
+
+/
+/GENERAL PAGE TABLE INITALIZATION
+/DOES PARTS OF INITALIZ. COMMON TO SEVERAL
+/ROUTINES
+/
+INISUB, 0
+ TAD PTBSE /INITIALIZE PAGE TABLE CODE POINTER
+ DCA PTCPR
+ TAD PTBSE /INITIALIZE PAGE TABLE SYMBOL POINTER
+ IAC
+ DCA PTSPR
+ TAD PTOPTB /INITIALIZE PT OP CODE POINTER
+ DCA PTOPR
+ CLA CMA /SET LAST BANK UNKNOWN
+ DCA LSTBNK
+ CLA IAC /SET LAST INSTRUCTION SKIP INDICATOR ON
+ DCA LSTSKP
+ CLA CMA /SET CURRENT BANK UNKNOWN
+ DCA BANK
+ JMP I INISUB
+
+
+/
+/SUBR. TO WRITE A LINE
+/MAY BE USED ONLY DURING PASS 2 (LISTING)
+/FUNCTION:TYPES (OR PUNCHES) EACH LINE OF SOURCE
+/ WITH PROPER ASSEMBLY ADDR. & CODES
+/ AT BEGINNING OF LINE (OR SPACES IF
+/ THESE ARE OMITTED).
+/LINE FORMAT:
+/ADDR VALU RC CONTENTS OF LINE BUFFER
+/ERROR FLAGS TYPED BETWEEN ADDR & VALU
+/COLUMNS. RC=RELOCATION CODE. THE LINE
+/BUFFER IS IN FIELD 1 AT "LINBUF."
+/
+WLN, 0
+ TAD LFLG /NULL LINE?
+ SNA CLA
+ JMP WLN3 /YES
+ TAD AFLG
+ SZA CLA
+ JMP .+4
+ JMS I CTYPE /IF AFLG=0 TYPE 4 SPACES
+ JMS I CTYPE
+ JMP .+3
+ TAD ADDRES /OTHERWISE TYPE 4 DIGITS
+ JMS I OTYPE
+ TAD EFLG /TYPE ERR. FLAG & SPACE
+ JMS I CTYPE
+ TAD VFLG /SAME TREATMENT FOR VALUE
+ SZA CLA /AS FOR ADDRES
+ JMP .+4
+ JMS I CTYPE
+ JMS I CTYPE
+ JMP .+3
+ TAD VALUE
+ JMS I OTYPE
+ TAD K240 /SPACE
+ JMS I TYPE
+ TAD CODE /2 DIGITS OR 2 SPACES
+ JMS I CTYPE
+ CDF 00
+ TAD I LINEB /IS THERE ANY LINE TO TYPE?
+ CDF 10
+ SNA CLA
+ JMP WLN3 /NO, EXIT
+ JMS I CTYPE /2 SPACES
+ TAD K240 /3RD SPACE
+ JMS I TYPE
+ TAD LINAX /INDEX LINE BUFFER
+ DCA X1
+ DCA CHARCT /CLR COUNTER
+WLN1, CDF 00
+ TAD I X1 /GET CHAR
+ CDF 10
+ SNA
+ JMP WLN3 /END OF LINE
+ DCA CHR
+ TAD CHR /CK FOR TAB
+ TAD M211
+ SNA CLA
+ JMP WLN2 /YES
+ ISZ CHARCT /COUNT 1 CHAR
+ TAD CHR /OUTPUT IT
+ JMS I TYPE
+ JMP WLN1
+WLN2, TAD K240 /SIMULATE TAB
+ ISZ CHARCT
+ JMS I TYPE
+ TAD CHARCT
+ AND K7
+ SZA CLA
+ JMP WLN2 /CONTINUE TAB
+ JMP WLN1
+WLN3, JMS I CRLF
+ DCA VFLG
+ DCA EFLG
+ DCA AFLG
+ DCA CODE
+ CDF 00
+ DCA I LINEB
+ CDF 10
+ JMP I WLN
+
+LINEB, LINBUF
+CHARCT=TEM5
+/
+/PATCH FOR SETCT
+/NOT USED BY ANY OTHER PART OF PROGRAM
+/(ADDED AT V15)
+/
+/FUNCTION: SET BANK=1 AFTER A "CALL"
+/(MUST BE DONE FOR BENEFIT OF RECT ROUTINE)
+/
+SETCAL, 0
+ TAD I PTCPR /CK FOR CALL CONST.
+ AND K100
+ SNA CLA
+ JMP .+3 /NO
+ IAC /YES, BANK TO CURRENT
+ DCA BANK
+ TAD EXP /DO 2 INSTRUCTIONS THAT
+ TAD UMIC /WERE KNOCKED OUT OF SETCT
+ JMP I SETCAL
+
+
+\f*1200
+/
+/ ASSEMBLY PHASE PAR
+
+/
+/PPAR1 IS ACTUALLY A PART OF THE BASIC ASSEMBLY
+/ROUTINE ASM02.
+/IT ASSEMBLES ALL PARAMETERS
+/TYPES ARE: RC=00 ABSOLUTE CONSTANT
+/ RC=01 RELOCATABLE ADDRESS
+/ RC=05 CDF TO CURRENT FIELD
+/ RC=06 CALL CONSTANT (#ARGS+EXT.SYM.#)
+/ ALSO LITERALS USED IN ARG STATEMENTS
+/ SUCH LITS. ARE PUT IN LIT. POOL
+/ AND RC=01 ADDRESS OF LIT. PUT WHERE
+/ THE ARG STATEMT OCCURS.
+/ADDRESS PARAMETERS ARE ACUALLY TAKEN
+/CAR OF BY SUBR. PPAR3S.
+/
+/
+PPAR1, DCA PPARY /CLR OUTPUT CODE
+ TAD I PTCPR /CK FOR LITERAL ARG OR PARAM.
+ AND K2
+ SZA CLA
+ JMP PARLIT /YES
+ TAD I PTCPR /PT CODE WORD
+ AND K20 /IS IT PAR CONSTANT
+ SNA CLA
+ JMP PPAR3 /NO
+ TAD I PTSPR /YES ... ACTUAL CONSTANT
+ DCA TEM1 /TO DIRECTLY ADDRESSABLE LOC
+ TAD I PTCPR /IS THIS A SPECIAL CONSTANT USED BY CALL
+ AND K100
+ SNA CLA
+ JMP .+5
+ IAC /YES, SET BANK TO CURRENT (NEW IN V15)
+ DCA BANK
+ IAC /& FORCE CODE=06
+ JMP .+5
+ TAD I PTCPR /IS THIS A CDF INSTRUCTION TO THIS BANK
+ AND K1000
+ SNA CLA
+ JMP .+3
+ TAD K5
+ DCA PPARY
+ JMS I WRITEP
+ JMS I OUTBIN /OUTPUT IT
+ TEM1 /NO RELOCATION
+PPARY, 0
+ SKP
+PPAR3, JMS PPAR3S /DO ALL WORK
+ JMP I PPAR5-1
+SERALI, SRALT
+
+PARLIT, TAD I PTSPR /PUT LIT ON TAB.
+ DCA S1
+ IAC
+ DCA S0
+ JMS I SERALI
+ AND K177 /GET PAGE ADDRESS
+ TAD PAG /+ PAGE BITS
+ DCA TEM1
+ ISZ PPARY /CODE FOR RELOCATABLE ADDR.
+ JMP PPARY-3
+/
+/ SUBROUTINE TO ASSEMBLE PAR SYMBOL
+
+/
+/ASSEMBLE ADDRESS PARAMETER
+/SYMBOL MAY BE ABSOLUTE OR RELOCATABLE
+/NORMAL OR # REF.
+/IF SYMBOL IS YET UNDEFINED, AN ENTRY IS
+/MADE FOR IT & THE CURRENT ADDRESS IN THE
+/OCCURANCE TABLE.
+/
+/
+PPAR3S, 0
+ DCA PPARX /CLR OUTPUT CODE
+ TAD ACTR /WHCH TIME ARE WE ASSEMBLING THIS PAGE
+ /NOTE: ACTR REMAINS 1 DURING PASS 2
+ SNA CLA
+ JMP I PPAR3S /FIRST TIME JUST RETURN
+ TAD I PTSPR /SYMBOL
+ DCA AFS /TO DIRRECTLY ADDRESSABLE LOCATION
+ JMS I OBSYM /GET IT FROM MST
+ AFS
+ TAD USE /MST USE WORD
+ AND K400 /IS IT DEFINED YET
+ SNA CLA
+ JMP PPAR4 /NO ... OCCURANCE
+ TAD USE /MST USE WORD
+ AND K3000 /IS SYMBOL ABSOLUTE
+ SZA CLA
+ ISZ PPARX /OUTPUT RELOCATABLE
+ JMS I NSCHKI
+ TAD VAL /INCREMENT IF # REF.
+PPAR6, DCA TEM1
+ JMS I WRITEP
+ JMS I OUTBIN
+ TEM1
+PPARX, 0
+ JMP I PPAR3S /RETURN
+PPAR4, TAD AFS /SYMBOL
+ DCA I PPAR5 /TO SUBROUTINE LOCATION
+ TAD ILC /CUR LOC
+ DCA I PPAR5+1 /TO SUBROUTINE LOC
+ JMS I NSCHKI
+ CLL RTL
+ DCA I PPAR5+3 /SET ATEM2 FOR NORMAL OR # REFERENCE
+ JMS I PPAR5+2 /CREATE AN OCCURANCE
+ JMP PPAR6 /OUTPUT ZERO WORD FOR LOADER
+ ASM01
+PPAR5, ATEM3
+ ATEM4
+ L53B
+ ATEM2
+NSCHKI, NSCHK
+
+/
+/TWO CHARACTER TYPEOUT
+/FROM PACKED ASCII PAIR
+/CALL WITH 6-BIT PAIR IN AC
+/L61A ACTS AS SUBR FOR L61
+/
+L61, 0
+ DCA TEM1 /SAVE CHARACTERS
+ TAD TEM1
+ RTR /SHIFT HIGH 6 BITS TO LOW
+ RTR
+ RTR
+ JMS L61A /MASK AND TYPE FIRST CHARACTER
+ TAD TEM1
+ JMS L61A /MASK AND TYPE SECOND CHARACTER
+ JMP I L61 /RETURN
+
+L61A, 0
+ AND K77 /MASK CHAR TO 6 BITS
+ SNA /ZERO MEANS SPACE
+ JMP L61B
+ JMP I L61CP /HAVE DO SOME OF THIS WORK ON ANOTHER PAGE
+L61D, JMS I TYPE /TYPE CHAR
+ JMP I L61A /RETURN
+L61B, TAD K240 /SPACE
+ JMP L61D
+L61CP, L61C
+
+/
+/ ROUTINE TO TEST CHARACTERS AND TAKE SELECTIVE EXITS
+/
+/ CALL IS
+/ JMS I TEST
+/ SORT LIST ADDR -1
+/ BRANCH LIST ADDR - SORT LIST ADDR
+/ RETURN IF ALL TESTS UNSUCCESSFUL
+/ ASSUMES AC=0 & CHAR TO LOOK FOR IS IN CHR
+
+/SORT ENDS UNSUCCESSFULLY AT
+/NEGATIVE NUMBER FOLLOWING SORT LIST
+/IF SORT IS SUCCESSFUL, A BRANCH IS
+/TAKEN VIA BR. LIST ITEM CORRESPONDING
+/TO MATCHING SORT LIST ITEM.
+/
+TSCHR, 0
+ CLA
+ TAD I TSCHR /GET SORT LIST ADDR -1
+ DCA X1 /AUTO-INDEX SORT LIST
+ ISZ TSCHR /MOVE ARG PTR
+ CDF 00
+TSCHR2, TAD I X1 /GET SORT LIST ITEM
+ SPA
+ JMP TSCHR3 /NEG = END OF SORT LIST
+ CIA /COMPARE ITEM WITH CHR
+ TAD CHR
+ SZA CLA /0 = MATCH FOUND
+ JMP TSCHR2 /NO MATCH, TRY NEXT ITEM
+ TAD X1 /GET ADDR. OF MATCH
+ CDF 10
+ TAD I TSCHR /+BR. LIST ADDR - SORT LIST ADDR
+ DCA TSCHR /= PTR TO BR. LIST ITEM
+ CDF 00
+ TAD I TSCHR /GET BR. LIST ITEM
+ DCA TSCHR /= BRANCH PTR FOR THE MATCH
+ SKP
+TSCHR3, ISZ TSCHR /NO MATCH ON LIST
+ CLA CLL
+ CDF 10
+ JMP I TSCHR / RETURN UNSUCCESSFUL
+
+
+\f*1400
+/
+/ CALL PSEUDO OPERATION
+/
+PCALL, JMS I GETSYM /GET NEXT INPUT ITEM
+ NOP /NOTHING THERE
+ SKP /SYMBOL
+ TAD CHR /CONSTANT
+ TAD M254 /LITERAL
+ SZA CLA /IS BREAK CHARACTER A COMMA
+ JMP CALERR /NO ... ERROR
+ TAD S0 /SAVE ARG COUNT
+ DCA ARGCT
+ ISZ X0 /PROHIBIT FLAGGING THE COMMA
+ JMS I GETSYM /GET SUBROUTINE NAME
+ SKP /NONE THERE
+ JMP .+3 /SYMBOL
+ NOP /CONSTANT
+CALERR, IERROR /LITERAL
+ JMS I SKIPL
+ JMS I SREST /SEARCH EXTERNAL SYMBOL TABLE AND OUTPUT TV DEF
+ DCA PCALL1 /SAVE EXTERNAL SYMBOL NUMBER
+ TAD LFS
+ DCA I CALLFS
+ TAD ARGCT /SET ARG COUNT IN DYNAMIC LOCATION
+ CIA
+ DCA CALLSW /SET CALL - ARG IN PROCESS SWITCH & COUNTER
+ TAD ARGCT /COUNT OF ARGS
+ RAL CLL /*2
+ TAD ARGCT /*3 IN CASE USING LITERAL ARGS
+ TAD K2 /+2
+ JMS I PARG2 /CAN THE CURRENT PAGE HOLD IT
+ SKP /YES
+ JMS I INI /NO ... INITIALIZE PT PTRS ... HAD TO ASSEMBLE PAG
+ TAD I CALLFS
+ DCA LFS
+ JMS I ICPLFS /PROCESS COLLECTION LFS
+ TAD I PTCPR /PT CODE WORD
+ TAD K30 /ADD CONSTANT BIT & PAR BIT
+ DCA I PTCPR /TO PT CODE WORD
+ TAD PARG6 /PLACE JMS LINK INSTRUCTION
+ DCA I PTSPR /AS CONSTANT
+ JMS PARG5 /INC PT PTRS & ASSMBL IF PASS 2
+ TAD K130 /CORRECT BIT PATTERN FOR CALL
+ DCA I PTCPR /TO PT CODE WORD
+ IAC /A CALL FORCES BANK TO CURRENT
+ DCA LSTBNK /(NEW IN V15)
+ IAC
+ DCA BANK
+ TAD ARGCT /COUNT OF ARGS
+ CLL RTL /TO HIGH ORDER AC
+ RTL
+ RTL
+ TAD PCALL1 /OR IN EXTERNAL SYMBOL NUMBER
+ DCA I PTSPR /PLACE IN PT SYMBOL WORD
+ JMP ARGPP0 /COMMON EXIT
+/
+/ ARG PSEUDO OPERATION
+/
+PARG, JMS I GETSYM /GET NEXT INPUT ITEM
+ IERROR /NOTHING THERE
+ JMP PARGSM /SYMBOL
+ JMP PARGCN /CONSTANT CODE IS 2
+ JMS I SKIPL /FIXES BUG IN V16
+ JMS I SLITAB /PUT LIT ON TABLE
+ CMA /LIT CODE IS 1
+PARGCN, TAD K2
+ SKP
+PARGSM, TAD SYMBOL /PAR ADDRESS
+ DCA AFS
+ JMS I SKIPL
+ JMS I CKCLSP /CK FOR TOO MANY ARGS
+/
+/ ROUTINE TO PUT A CDF IN THE PAGE TABLE
+/
+ TAD K30 /PT CODE WORD
+ DCA I PTCPR /TO PT
+ JMS I ICPLFS /PROCESS ANY LFS
+ TAD K6201 /CDF
+ DCA I PTSPR /TO PT SYMBOL WORD
+ TAD M2
+ TAD AFS /IS AFS A CONSTANT
+ SNA
+ JMP ARGPP4 /YES
+ IAC /IS AFS A LITERAL
+ SNA CLA
+ JMP ARGPP5 /YES
+ JMS I OBSYM /NO ... SYMBOL ... GET ITS POINTERS TO MST
+ AFS
+ TAD USE /AFS MST USE WORD
+ AND K40 /IS IT A COMMON SYMBOL
+ SNA CLA
+ JMS CDFCHG /NO
+ JMS ARGPP2 /INCREMENT PT PTRS AND PUT OUT A PAR
+ TAD AFS
+ DCA I PTSPR /PLACE SYMBOL IN PT SYMBOL WORD
+ARGPP0, JMS PARG5 /INC PT PTRS &ASSMBL IF PASS 2
+ JMP I POPEXP /EXIT TO GET NEXT LINE
+
+/
+ARGPP5, JMS CDFCHG
+ JMS ARGPP2 /INCREMENT PTRS AND PUT OUT A PAR
+ TAD K2 /SET LITERAL BIT
+ JMP .+3 /SAVE AS CONSTANT FROM HERE
+/
+ARGPP4, JMS ARGPP2 /INCREMENT PTRS AND PUT OUT A PAR
+ TAD K20 /SET CONSTANT BIT
+ TAD I PTCPR /PT CODE WORD
+ DCA I PTCPR /FOR PROPER WORD
+ TAD S0 /PLACE CONSTANT IN PROPER LOCATION
+ DCA I PTSPR
+ JMP ARGPP0
+/
+/ ROUTINE TO INCREMENT POINTERS AND SET UP FOR A PAR IN THE PAGE TABLE
+/
+ARGPP2, 0
+ JMS PARG5 /INC PT PTRS & ASSMBL IF PASS 2
+ TAD K10
+ DCA I PTCPR
+ JMP I ARGPP2 /RETURN
+K6201, CDF 10
+
+ASMIF1, 0
+ TAD PASS
+ SZA CLA
+ JMS I ASM02S /ASSMBL NOW IF LISTING PASS
+ JMS I INC
+ JMP I ASMIF1
+
+ASM02S, ASM02
+INC, INCPT
+
+ARGCT, 0
+CALLFS=PRSYMP /TEMP
+CALLSW, 0
+PARG2, IFFSUB
+CKCLSP, CKCLS
+PARG5=ASMIF1
+PARG6, JMS LINK
+M10, -10
+
+/ROUTINE TO CHANGE CDF 10 TO CDF *
+CDFCHG, 0
+ TAD I PTCPR
+ TAD K1000 /SET CDF * BIT IN P.T.
+ DCA I PTCPR
+ TAD I PTSPR /CHANGE 6211
+ TAD M10 /TO 6201
+ DCA I PTSPR
+ JMP I CDFCHG
+PCALL1=CDFCHG /TEMP
+
+
+\f*1600
+/
+/ COMMN PSEUDO OPERATION
+/
+PCOMMN, JMS I GETSYM /GET ADDRESS FIELD SYMBOL
+ NOP /NOTHING THERE
+ SKP /SYMBOL THERE
+ SKP CLA /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ TAD LFS
+ SNA CLA /IS THERE AN LFS
+ JMP COMMN2 /NO ... JUST INCREMENT COUNTERS
+ JMS I OBSYM /GET POINTERS TO LFS
+ LFS
+ TAD USE /MST USE WORD
+ AND K3 /SAVE SYMBOL LENGTH
+ TAD K440 /ADD CORRECT BITS
+ DCA USE /FOR NEW MST USE WORD
+ TAD S0 /NO OF COMMON LOCATIONS
+ SNA CLA /ARE THERE ZERO
+ JMP COMMN1 /YES ... EQUIVALENCE OUTPUT
+ TAD HICOM /NO ... HIGHEST COMMON LOCATION USED
+ TAD S0 /+SIZE OF THIS BLOCK
+ DCA TEM1 /FOR TENTATIVE NEW HIGHEST
+ TAD TEM1 /ACTUAL ADDRESS
+ AND K7600 /ARE WE OVERFLOWING ONTO THE LAST PAGE
+ TAD M7600
+ SZL CLA
+ SERROR /YES ... ERROR
+ TAD HICOM /LAST COMMON ASSIGNMENT
+ IAC /+1
+ DCA VAL /GIVES NEW ADDRESS
+ TAD TEM1 /NEW HIGHEST COMMON LOCATION
+ DCA HICOM /TO PROPER LOC
+COMMN0, TAD VAL
+ JMP I NULLP /GO GET NEXT LINE
+/
+/ EQUIVALENCE GENERATED COMMON OUTPUT
+/
+COMMN1, TAD HICOM /PLACE LAST COMMON ASSIGNMENT
+ IAC /+1
+ DCA VAL /IN MST AS ADDRESS
+ JMP COMMN0 /EXIT
+/
+/ NON LOCATION FIELD SYMBOL COMMON ASSIGNMENT
+/
+COMMN2, TAD HICOM /LAST HIGHEST
+ TAD S0 /+CUR ASSIGNMENT
+ DCA HICOM /FOR NEW HIGHEST
+ TAD HICOM /NEW HIGHEST
+ AND K7600 /ARE WE OVERFLOWING ONTO THE LAST PAGE
+ TAD M7600
+ SZL CLA
+ SERROR /YES ... ERROR
+ JMP COMMN0 /NO ... EXIT
+K440, 0440
+
+/TEXT PSUEDO-OP
+
+PTEXT, TAD FORFLG
+ SMA SZA CLA
+ JMP I DCIL1
+ JMS I GETCHR /LOOK FOR STRING START
+ JMS I TEST
+ SL1-1
+ BL1-SL1
+ TAD CHR /SAVE OPENING DELINEATOR
+ CIA
+ DCA DELIN
+ DCA TEXCTR /CLR CHAR CTR
+ TAD X0 /SAVE AUTO-INDEX TO START OF STR
+ DCA TEXSUB
+TEX1, JMS I GETCHR /LOOK FOR END OF STRING
+ SNA
+TEXERR, IERROR /TOO SOON END OF LINE
+ TAD DELIN
+ SNA CLA
+ JMP TEX2 /THE END OF THE LINE
+ ISZ TEXCTR /KEEP STRING TALLY
+ JMP TEX1
+TEX2, JMS I GETCHR /MOVE LINE PTR TO CHAR. AFTER DELINEATOR
+ CLA
+ JMS I SKIPL
+ JMS I PUSH /SAVE INFO FOR A MINUTE
+ TAD TEXCTR
+ IAC
+ CLL RAR /DIV BY 2
+ JMS I IFFS /SEE IF STR WILL FIT ON PAGE
+ SKP CLA
+ JMS I INI /HAD TO ASSMBL: RE-INIT PT
+ JMS I POP /POP LINE INFO
+ JMS I ICPLFS /PROCESS LFS
+ TAD TEXCTR
+ CIA
+ DCA TEXCTR
+ TAD TEXSUB /RE-INIT STRING INDEX
+ DCA X0
+ DCA BYTE /SET FOR LEFT BYTE
+TEX5, JMS I GETCHR
+ AND K77 /EXTRACT 6 BIT
+ ISZ BYTE
+ SKP
+ JMP TEX4 /RIGHT BYTE
+ CLL RTL
+ RTL /MOVE LEFT
+ RTL
+ DCA TXSV
+ CMA /SET PTR TO RT BYTE
+ DCA BYTE
+ SKP
+TEX4, JMS TEXSUB
+ ISZ TEXCTR
+ JMP TEX5 /NOT DONE
+ ISZ BYTE /CK FOR ODD CHAR LEFT OVER
+ SKP /NO
+ JMS TEXSUB /YES
+ JMP I POPEXP
+
+TEXSUB, 0
+ TAD TXSV /COMBINE LEFT & RT BYTES
+ DCA I PTSPR
+ TAD K30 /PAR CONST BITS
+ TAD I PTCPR
+ DCA I PTCPR
+ TAD X0 /SAVE INDEX
+ DCA TXSV
+ JMS I ASIF /INC PTRS & ASSMBL IF PASS 2
+ TAD TXSV /RESTOR INDEX
+ DCA X0
+ JMP I TEXSUB
+
+PUSH, PUSHIN
+POP, POPIN
+ASIF, ASMIF1
+IFFS, IFFSUB
+DELIN, 0
+TEXCTR, 0
+TXSV=S3
+BYTE=DELIN
+
+
+
+/
+/WRITE LINE IF IN PASS 2
+/
+WLNIF1, 0
+ TAD PASS /WHICH PASS?
+ SZA CLA
+ JMS I WLNP /LISTING
+ JMP I WLNIF1
+
+/
+\f*2000
+
+/READ & DECODE 1 LINE
+/IGNORES NULL LINES & COMMENT LINES
+/ EXP=NON-0 IF NO OPERATION ON LINE (CONST, LIT,
+/ OR ADDRESS ONLY)
+/ SK=NON-0 IF SKIP INSTR.
+/ UMIC=NON-0 IF OP CODE IS 6 OR 7
+/ IB=NON-0 IF INSTR IS INDIRECT
+/ NSGN=NON-0 IF AFS IS # SYMBOL
+/ OP=OP CODE
+/ LFS=PTR TO LFS IN SYM. TAB., IF ANY
+/*** AFS=2 IF CONSTANT PARAMETER OR CONST. AFS***
+/*** AFS=1 IF LITERAL PARAMETER OR LIT. AFS***
+/ AFS=SYM. TAB. PTR. TO ADDRESS PARAMETER OR AFS
+/
+DCIL, 0
+RDL1, JMS I RLNP /READ IN A LINE
+ DCA LFS /CLR STORAGE FOR LINE INFO
+ DCA EXP
+ DCA OP
+ DCA SK
+ DCA IB
+ DCA NSGN
+ DCA UMIC
+ DCA I RECTI /CLR RECOUNT FLAG FOR CPLFS
+ ISZ LINE /INC LINE COUNT
+ ISZ X0 /DO NOT BACK UP X0
+ JMS I GETSYM /READ 1ST ITEM
+ JMP RDL11 /NULL LINE OR COMMENT
+ JMP RDL7 /SYMBOL - POSSIBLE LFS
+ JMP .+3 /SET AFS=2 FOR CONSTANT
+RDL3, JMS I SLITAB /PUT LIT ON TAB
+ CMA /AFS=1 FOR LITERAL
+RDL2, TAD K2
+ ISZ EXP /SET PARAMETER EXPRESSION FLAG
+RDL5, DCA AFS
+ JMS I SKIPL /SKIP TO END OF LINE
+ JMP I DCIL /RETURN
+RDL7, TAD CHR /CK FOR COMMA
+ TAD M254
+ SZA CLA
+ JMP RDL9 /NO, SHOULD BE SPACE,TAB,CR,OR ;
+ JMS I WHATPP
+ SKP
+ IERROR /OP SYMBOL AS TAG
+ TAD SYMBOL /NO, ENTER PTR TO LFS
+ DCA LFS
+ ISZ X0 /PROHIBIT FLAGGING COMMA
+ JMS I GETSYM /GET ITEM AFTER LFS
+ JMP I PB0 /NULL AFTER LFS IS BSS0
+ JMP RDL9 /SYMBOL-OP OR PARAMETER
+ JMP RDL2 /CONSTANT
+ JMP RDL3 /LITERAL
+RDL9, JMS I WHATPP
+ JMP RDL4 /NO-MUST BE ADDRESS PARAMETER
+ TAD USE /IS SYMBOLE A PSUEDO-OP
+ AND K40
+ SZA CLA /NO
+ JMP RDL18 /YES
+ TAD USE /IS SYMBOL AN MRI?
+ AND K400
+ SNA CLA
+ JMP RDL14 /NO-OPR OR I/O INSTR.
+ TAD USE /MRI-PUT OP SKIP BIT
+ AND K20 /INTO SKIP FLAG
+ DCA SK
+ TAD VAL
+ DCA OP
+ SKP
+RDL10, ISZ IB / SET INDIRECT FLAG
+ JMS I GETSYM /READ SYMBOL AFTER MRI
+ IERROR /NOTHING THERE
+ JMP RDL12 /SYMBOL
+ IAC /AFS=2 FOR CONST. AFS
+ IAC /AFS=1 FOR LIT.AFS
+ JMP RDL5 /SKIP TO END OF LINE
+
+RDL12, TAD SYMBOL /CK FOR I
+ CIA
+ TAD IBTI /SYM. ADDR-I ADDR
+ SNA CLA /NOT I
+ JMP RDL10 /IT IS I
+ JMS I WHATPP
+ JMP .+3
+ IERROR /AFS NOT USER SYMBOL
+RDL4, ISZ EXP /ENTER HERE ON ADDRESS PAR.
+ TAD CHR /CK FOR #
+ TAD M243
+ SZA CLA
+ JMP .+4
+ ISZ NSGN /YES
+ JMS I GETCHR /PREVENT FLAGGING #
+ CLA
+ TAD SYMBOL /SET PTR TO AFS
+ JMP RDL5
+RDL13, JMS I WHATPP
+ IERROR /ELIM USER SYM
+ TAD USE /CK FOR OPR OR I/O INST.
+ AND K4440 /ELIM. MRI, PSUEDO
+ SZA CLA /OK
+ IERROR /ILLEGAL SYMBOL
+RDL14, TAD USE /COMPARE NEW MICRO-GRP
+ AND K300 /WITH OLD, IF ANY
+ SNA
+ JMP RDL16 /GRP0 OK WITH ANYTHING
+ DCA TEM1 /NEW IS NOT 0
+ TAD MGRP /CK OLD MGP, IF ANY
+ SNA /THERE IS ONE
+ JMP RDL15 /0 OK WITH ANY NEW
+ CIA /COMPARE OLD
+ TAD TEM1 /WITH NEW
+ SZA CLA /SAME-OK
+ IERROR /ILLEGAL COMBINATION
+RDL15, TAD TEM1 /MICRO-GRP=NEW
+ DCA MGRP
+RDL16, TAD VAL /OR NEW VALUE INTO OLD OP
+ CMA /NOT A
+ AND OP /AND B
+ TAD VAL /+A
+ DCA OP /=A OR B
+ TAD USE /GET NEW SKIP BIT
+ AND K20
+ SZA CLA /NON-SKIP
+ ISZ SK /SET SKIP FLAG
+ JMS I GETSYM /GET NEXT INSTR OF STRING
+ JMP RDL17 /NONE THERE - END OF SRTING
+ JMP RDL13 /SYMBOL (AS EXPECTED)
+ NOP /CONST, ILLEGAL
+ IERROR /LIT ILLEGAL
+RDL17, ISZ UMIC /SET MICRO INST FLAG
+ JMP RDL5 /SKIP TO END OF LINE
+IBTI, II
+MGRP=UMIC
+RLNP, RLN
+PB0, PBSS2
+K4440, 440
+K300, 300
+WHATPP, WHATYP
+M243, -243
+
+/NULL LINE OR COMMENT
+
+RDL11, JMS I SKIPL
+ JMP I NULLP
+
+/PSUEDO-OP
+
+RDL18, TAD VAL /GET PSUEDO-OP ADDRESS
+ DCA TEM1 /STORE PTR
+ JMP I TEM1 /TO PROPER PSUEDO-OP HANDLER
+
+\f*2200
+/
+/END OF LINE PROCESSOR FOR COLLECTION PHASE
+/LOOKS FOR SEMI-COLON BEFORE A SLASH
+/STAR OR SLASH OR 000 (CR) MEANS NORMAL
+/END OF LINE. SEMI-COLON MEANS WE MUST
+/SAVE CURRENT ADDRESS IN LINE BUFFER FOR
+/START OF "NEXT" LINE.
+/THIS ROUTINE ALSO HAS THE IMPORTANT
+/FUNCTION OF WATCHING THE FORTR PSUEDO-OP
+/FLAG. IF FLAG IS ON L72 CAUSES LINE
+/TO BE TREATED AS NON-EXISTENT. L72 MUST
+/BE CALLED FOR EVER INSTR. LINE OR PSUEDO-OP
+/LINE (EXCEPT END, PAUSE, FORTR) BEFORE
+/ACTUAL PROCESSING OF THAT LINE BEGINS.
+/
+L72, 0
+ SKP
+ JMS I GETCHR
+ JMS I TEST
+ SL6-1
+ BL7-SL6
+ IERROR
+L72S, TAD X0
+ DCA SCOLON
+L72X, TAD FORFLG /IF FLG=1 WE ARE SKIPPING
+ SMA SZA CLA /1ST HALF OF FORTRAN OUTPUT
+ JMP I DCIL1
+ JMP I L72
+
+/KLUDGE TO RESET ILC BECAUSE A1 COMES BEFORE UDPAGE IN PASS 2
+
+FIXILC, 0
+ TAD PASS
+ SNA CLA
+ JMP I FIXILC
+ TAD PAG
+ DCA ILC
+ JMP I FIXILC
+
+
+
+/
+/COLLECTION PHASE ROUTINE
+/SEARCH PAGE SYMBOL TABLE FOR SYMBOL
+/CALLING SEQUENCE: (ASSUMES SYM.ID.IS IN "SYMBOL")
+/ JMS SPSTB
+/ RETURN IF NOT FOUND (HAD TO ENTER IT)
+/ RETURN IF FOUND
+/THE SEARCH IS AT L31; ENTERING DONE BY L32.
+/
+SPSTB, 0
+ TAD PSTSZE /SIZE OF PST
+ SZA /IS IT EMPTY
+ JMP L31 /NO
+L32, TAD PSTSZE /IS PST FULL?
+ TAD PSTMAX
+ SMA CLA
+ SERROR /YES
+ TAD PSTSZE /SIZE OF PST*2
+ RAL CLL
+ TAD PSTBSE /+BASE
+ DCA PSTSPR /GIVES POINTER TO SYMBOL
+ ISZ PSTSZE / INCREMENT COUNTER
+ TAD SYMBOL /PHYSICALLY MOVE SYMBOL
+ DCA I PSTSPR
+ TAD PSTSPR
+ IAC /ADD 1
+ DCA PSTCPR /FOR CODE WORD POINTER
+ TAD PASS
+ SNA CLA
+ JMP L32A /ASSEMBLY: JUST ZERO CODE WORD
+ JMS I OBSYM /LISTING
+ SYMBOL
+ TAD VAL /CK IF SYM IS ON PAGE FORWARD REF.
+ AND K7600 /EXTRACT PAGE BITS
+ CIA
+ TAD PAG
+ SZA CLA
+ JMP L32A /NOT ON PAGE
+ TAD K4000 /ON PAGE: SET DEFINED BIT
+ ISZ SPSTB /& SET FOR "FOUND" RETURN
+L32A, DCA I PSTCPR
+ JMP I SPSTB /NOT FOUND
+/
+L31, CIA /PLACE - COUNT OF TABLE
+ DCA TEM1 /IN INDEX LOC
+ TAD PSTBSE /PLACE TABLE BASE
+ DCA TEM2 /IN ADDRESS LOC
+L31B, TAD I TEM2 /-SYMBOL
+ CIA
+ TAD SYMBOL /+ REQUESTED SYMBOL
+ SNA CLA
+ JMP L31A /FOUND
+ ISZ TEM2 /NOT FOUNE ... INCREMENT ADDRESS
+ ISZ TEM2
+ ISZ TEM1 /OVER
+ JMP L31B /NO ... TRY AGAIN
+ JMP L32 /YES ... PLACE ON TABLE
+L31A, ISZ SPSTB /FOUND ... INDEX FOR EXIT
+ TAD TEM2 /POINTER TO SYMBOL
+ DCA PSTSPR /TO PROPER LOC
+ TAD PSTSPR /SYMBOL POINTER
+ IAC /+1
+ DCA PSTCPR /GIVES CODE POINTER
+ JMP I SPSTB /EXIT
+/
+PSTMAX, -100 /MUST BE (PSTB-PTB)/2
+
+
+
+/
+/OUTPUT 6 CHARACTER ASCII NAME
+/TO BINARY TAPE
+/FOR EXTERNAL SYMBOL DEFN.
+/USED BY LFSCK (FOR RC=03) & 666 (FOR RC=17)
+/OUTPUT GOES VIA TYPE PTR, BUT PTR IS
+/CHANGED TO L66E SO CHAR CAN BE PUNCHED
+/& ADDED TO CK.SUM INSTEAD OF TYPED.
+/668 IS USED ONLY IN PAS1-
+/ASSEMBLY PHASE1
+/
+L68, 0
+ TAD PASS
+ SZA CLA
+ JMP I L68 /EXIT IF LISTING
+ TAD L66B /FOOL OUTPUT ROUTINE
+ DCA TYPE /SO IT THINKS PUNCH IS TTY
+ DCA S1
+ DCA S2
+ DCA S3
+ TAD AS0
+ DCA X1
+ TAD SYMBOL /MST SYMBOL ADDRESS - 1
+ DCA X2 /TO AUTO X2
+ TAD USE /MST USE WORD
+ AND K3 /SYMBOL LENGTH
+ CIA
+ DCA TEM4 /-WORDS TO LOC
+ CDF 00
+ TAD I X2 /OBTAIN SYMBOL
+ CDF 10
+ DCA I X1
+ ISZ TEM4
+ JMP .-5
+ TAD AS0
+ DCA X2
+ TAD M3
+ DCA TEM4
+ TAD I X2
+ JMS I CTYPE /PUNCH IT EXPANDED
+ ISZ TEM4 /MORE
+ JMP .-3 /YES
+ TAD L66D /RESTORE TYPE ROUTINE
+ DCA TYPE
+ JMP I L68
+/
+/ DUMMY TYPE ROUTINE FOR EST TV DEFINITION
+/
+T8=SPSTB /SCRATCH LOC
+L66E, 0
+ DCA T8 /SAVE CHAR
+ TAD T8
+ TAD CSUM /ADD CHAR TO BINARY CHECK SUM
+ DCA CSUM
+ TAD T8
+ JMS I PUNCH /OUTPUT CHAR ON BINARY TAPE
+ JMP I L66E /RETURN
+L66B, L66E
+L66D, L64
+
+
+/
+/INITIALIZATION THAT WONT FIT IN "INITA"
+/
+INITMR, 0
+ DCA I VALPTP
+ DCA I LLFSP
+ DCA LINE
+ JMP I INITMR
+VALPTP, VALPTR
+LLFSP, LLFS
+
+\f*2400
+
+
+/
+/COLLECTION PHASE ROUTINE.
+/SEARCH LITERAL TABLE FOR VALUE IN S0.
+/PLACES LITERAL ON TABLE IS NOT THERE.
+/OTHERWISE DOES NOTHING.
+/
+SLTAB, 0
+ CLA
+ TAD LTSZE /SIZE OF TABLE
+ SZA /IS TABLE EMPTY
+ JMP SLITB1 /NO ... SEARCH IT
+ TAD LTBSE /BASE COLL. PHASE LIT. TABLE)
+ TAD LTSZE /+DISPLACEMENT
+ DCA TEM1 /GIVES ADDRESS POINTER
+ TAD S0 /PHYSICALLY MOVE LITERAL
+ CDF 00
+ DCA I TEM1
+ ISZ LTSZE /INCREMENT COUNT
+ CDF 10
+ JMP I SLTAB /RETURN
+SLITB1, CIA /PLACE - COUNT
+ DCA TEM1
+ CMA
+ TAD LTBSE /LTBSE-1
+ DCA X1 /TO AUTO X1
+SLITB2, CDF 00
+ TAD I X1 /-TABLE
+ CDF 10
+ CIA
+ TAD S0 /+REQUESTED LITERAL
+ SNA CLA /SAME
+ JMP I SLTAB /YES, RETURN
+ ISZ TEM1 /MORE SYMBOLS TO TEST
+ JMP SLITB2 /YES
+ JMP SLTAB+5 /NO
+
+
+/
+/COLLECTION PHASE EQUIVALENCE PROCESSOR
+/(FORMERLY CALLED BSS0 PROCESSOR)
+/ENTERS SYMBOL ID. IN EQ. TAB
+/
+PBSS2, JMS I SKIPL
+ TAD LFS /LOCATION FIELD SYMBOL
+ SNA CLA /IS THERE ANY
+ JMP I NULLP /NO
+ CDF 00
+ TAD BSSSW /ARE WE PROCESSING A BSS 0 SEQUENCE
+ SZA CLA
+ JMP .+5 /YES ... SKIP INITIALIZING
+ TAD EQVIPR /NO ... INITIALIZE
+ DCA CTPTR /SET INPUT POINTER TO COUNT LOCATION
+ DCA I CTPTR /ZERO COUNT
+ ISZ EQVIPR /INCREMENT INPUT POINTER
+ TAD LFS /LOCATION FIELD SYMBOL
+ DCA I EQVIPR /PLACE LFS ON EQUIVALENCE TABLE
+ ISZ I CTPTR /INCREMENT COUNT
+ CDF 10
+ JMS I ICPLFS /PROCESS IT FOR COLLECTION
+ CLA CMA /REMOVE LFS FROM LFS TABLE
+ TAD LFSPTR
+ DCA LFSPTR
+ ISZ BSSSW /SET BSS 0 IN PROGRSS SWITCH
+ CMA /REMOVE EXTRA LFS BIT
+ TAD I PTCPR
+ AND K7577X /REMOVE EXTRA BSS0 BIT
+ TAD K200 /PLACE BSS0 BIT ON PT
+ DCA I PTCPR
+ TAD PSTCPR /SAVE PST ADDRESS IN CASE NEXT LINE OVERFLOWS
+ DCA EQVBIT
+ ISZ EQVIPR /INCREMENT POINTER
+ JMP I NULLP /EXIT FOR NEXT LINE
+CTPTR, EQUTB
+LFSBSI, LFSBSS
+K7577X, 7577
+
+/
+/ASSEMBLY PHASE EQUIVALENCE PROCESSOR
+/EXTRACTS ENTIRE GROUP OF TAGS EQUIVALENCED
+/TO SAME ADDRESS FROM TABLE & DEFINES
+/THEM BY USING LFSCK FROM LFSBSS ON.
+/
+ANUMCK, 0
+ TAD I PTCPR /PT CODE WORD
+ AND K200 /MASK OUT BSS 0 BIT
+ SNA CLA /IS IT A BSS 0 SYMBOL
+ JMP I ANUMCK /NO ... EXIT
+ CMA
+ DCA BANK /BANK UNKNOWN
+ TAD AANUM7 /CHEAT RETURN ADDRESS
+ DCA I LFSCHK /SO IT LOOKS LIKE A JMS FROM SOMEWHERE ELSE
+ JMS GNEQ /GET COUNT
+ CIA /NEGATE
+ DCA OPICTR /SAVE IN INDEX LOC
+ JMS GNEQ /GET SYMBOL
+ JMP I LFSBSI /PROCESS SYMBOL
+ANUM7, JMS I SPSTAB /SET DEFINED BIT ON PST IN CASE
+ NOP /THIS WAS CARRIED OVER
+ JMS I PSTD /THE LAST PAGE
+ ISZ OPICTR /ANY MORE ?
+ JMP ANUM7-2 /YES
+ JMP I ANUMCK /EXIT
+PSTD, PSTDEF
+AANUM7, ANUM7
+/
+/ ROUTINE TO GET NEXT ITEM OFF EQUIVALENCE TABLE
+/
+GNEQ, 0
+ CDF 00
+ TAD I EQVOPR
+ ISZ EQVOPR
+ CDF 10
+ JMP I GNEQ
+/
+/SUBR. TO LIST A LINE IF IN PASS 2
+/
+/CALLING SEQUENCE: JMS I WRITEP
+/ JMS I OUTBIN
+/ LOCATION OF WORD TO OUTPUT
+/ CONSTANT=RELOC. CODE
+/ RETURN
+/(CALL TO OUTBN MUST ALWAYS FOLLOW CALL
+/TO WRITE.)
+/ASSUMES CURRENT PC IS IN "ILC"
+/SETS FLAGS FOR PROPER LISTING
+/& CALLS WLN TO DO THE DRUDGE WORK.
+/
+WRITE, 0
+ TAD PASS
+ SNA CLA
+ JMP I WRITE /PASS 1
+ ISZ WRITE
+ TAD I WRITE /ADDRESS OF VALUE
+ DCA VALUE
+ TAD I VALUE /GET VALUE
+ DCA VALUE
+ ISZ VFLG
+ ISZ WRITE
+ TAD I WRITE /GET RELOC. CODE
+ DCA CODE
+ TAD CODE
+ SNA
+ JMP WRITE2
+ RTR /CONVERT TO 6BIT
+ RAR
+ AND K7
+ TAD K60
+ CLL RTL
+ RTL
+ RTL
+ DCA ADDRES /TEM SAVE
+ TAD CODE
+ AND K7
+ TAD K60
+ TAD ADDRES
+ DCA CODE
+WRITE2, TAD ILC /CURRENT ADDRESS
+ DCA ADDRES
+ ISZ AFLG
+ ISZ LFLG
+ JMS I WLNP /LIST
+ ISZ WRITE
+ JMP I WRITE
+K60, 60
+OPICTR=WRITE
+CDZSKP, JMS CDZSK
+\f*2600
+/
+/ BLOCK PSEUDO OPERATOR
+/
+PBSS, JMS I GETSYM /GET NEXT INPUT ITEM
+ JMP I PBSS2I /NOTHING THERE (BSS 0)
+ SKP /SYMBOL
+ SKP CLA /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ JMS I IPSHIN /SAVE ALL CURRENT INFO
+ JMP I PBSS4I /CHECK BLOCK SIZE
+PBSS5, JMS IFFSUB /CAN THIS FIT IN CORE
+ SKP CLA /YES
+ JMS I INI /NO ... INITIALIZE PT POINTERS
+ JMS I IPOPIN /POP CURRENT INFORMATION
+ DCA BSSSW /CLEAR BSS0 SWITCH
+ JMS I ICPLFS /PROCESS CURRENT LFS
+ TAD S0 /-BLOCK CONSTANT
+ CIA
+ DCA TEM12 /TO INDEX LOCATION
+PBSS1, TAD K30 /PAR CONSTANT PT BIT STRUCTURE
+ TAD I PTCPR /DONT LOSE LFS AND BSS 0 INFORMATION
+ DCA I PTCPR
+ JMS I ASMIF /DO THEM INDIVIDUALLY IF PASS 2
+ ISZ TEM12 /MORE
+ JMP PBSS1 /YES
+ JMP I POPEXP /EXIT TO GET NEXT LINE
+PBSS2I, PBSS2
+TEM12, 0 /RESRV STORAGE CTR
+PBSS4I, PBSS4
+
+/
+/ CPAGE PSEUDO OPERATION
+/
+PIFF, JMS I GETSYM /GET NEXT INPUT ITEM
+ NOP /NONE THERE
+ SKP /SYMBOL
+ SKP CLA /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ JMS I WLNIF /LIST IF PASS 2
+ TAD S0 /BINARY CONSTANT
+ JMS IFFSUB /USE GLOBAL IFF SUBROUTINE
+ JMP I DCIL1 /DIDNT HAVE TO ASSEMBLE PAGE
+ JMP I RSTRTI /GO INITIALIZE
+/
+/ IFF SUBROUTINE
+/ CALL IS TAD PAGE INCREMENT
+/ JMS IFFSUB
+/ OK RETURN
+/ HAD TO ASSEMBLE PAGE RETURN
+
+/FUNCTION: TO SEE IF GIVEN NO. OF WORDS
+/WILL FIT ON CUR. PAGE; IF SO, RETURN
+/AT OK RET.; OTHERWISE ASSEMBLE PAGE WE
+/HAVE NOW & INIT A NEW PAGE & RET. AT
+/SECOND RET. LOC.
+/IFFSUB IS USED BY CPAGE,BLOCK &
+/SEVERAL OTHER P-OPS
+/
+/
+IFFSUB, 0
+ DCA TEM1 /SAVE INCREMENT
+ JMS I ICPGES /COMPUTE PAGE SIZE
+ TAD TEM1 /ADD INCREMENT
+ TAD M201 /IS TOTAL .GT. PAGE SIZE (1 EXTRA BECAUSE
+ SPA SNA CLA /PTSZE INCREMENTED BEFORE PSUEDO-OP
+ JMP I IFFSUB /NO ... RETURN
+ CLA CMA /YES ... DECREMENT PAGE TABLE SIZE
+ TAD PTSIZ
+ SNA /WATCH FOR AN EMPTY PAGE
+ JMP .+4 /LEAVE THINGS ALONE IF PAGE EMPTY
+ DCA PTSIZ
+ JMS I L55I /ASSEMBLE THE PAGE
+ JMS I UPDATE
+ JMS I FIXIL
+ ISZ IFFSUB /INCREMENT FOR EXIT
+ JMP I IFFSUB /RETURN
+IPSHIN, PUSHIN
+IPOPIN, POPIN
+WLNIF, WLNIF1
+ASMIF, ASMIF1
+RSTRTI, RSTRT
+UPDATE, UDPAGE
+ICPGES=CPGESI
+M201, -201
+FIXIL, FIXILC
+
+
+/ ERROR ROUTINE
+/
+K6200, 6200
+FATAL, 0
+
+ERRE, TAD K6200 /0500
+ERRS, ISZ FATAL /SET FATAL ERROR SWITCH
+ TAD K600 /2300
+ JMP .+3
+ERRM, TAD LFS
+ DCA I LLFSI
+ TAD K400 /1500
+ERRI, TAD K600 /1100
+ERRC, TAD K200 /0300
+ERRA, TAD K100 /0100
+ DCA EFLG
+ TAD PASS
+ SZA CLA
+ JMP ERREX /LISTING PASS
+ JMS I CRLF /TYPE CRLF
+ TAD EFLG /TYPE E#
+ JMS I CTYPE
+ TAD AT
+ JMS I CTYPE
+ JMS I CTYPE /TYPE 2 SPACES
+ TAD I LLFSI
+ DCA INDEX
+ CDF 00
+ TAD I INDEX
+ ISZ INDEX
+ AND K3
+
+ CMA
+ DCA COUNT
+ TAD M3 /SET 6 CHAR PRINT CTR
+ DCA MSCTR
+ ISZ COUNT
+ SKP /NOT DONE YET WITH SYMBOL
+ JMP ERR1 /DONE : SEE IF SPACES NEEDED
+ CDF 00
+ TAD I INDEX
+ CDF 10
+ ISZ INDEX
+ JMS I CTYPE /TYPE THE LETTERS OR SPACES
+ ISZ MSCTR
+ JMP .-11
+ERR11, TAD SPPLUS /TYPE SPACE +
+ JMS I TYPE
+ TAD LINE /TYPE LINS FROM LAST LFS
+ JMS I OTYPE
+ JMS I CRLF
+ERREX, TAD FATAL /FATAL ERROR?
+ SNA CLA
+ JMP .+3 /NO
+ HLT
+ JMP I K200 /IF YES GO TO START AFTER HALT
+ TAD PHASE /WHAT PHASE ARE WE IN
+ SZA CLA
+ JMP I ERR2 /ASSEMBLY
+ JMP I NULLP /COLLECTION
+ERR2, ASM02R
+
+LLFSI, LLFS
+INDEX=S1
+COUNT=S2
+MSCTR=S3
+AT, 0124
+SPPLUS, 253
+
+ERR1, JMS I CTYPE /FILL OUT THE REST WITH SPACES
+ ISZ MSCTR
+ JMP .-2
+ JMP ERR11
+
+\f*3000
+
+/
+/ASSEMBLY PHASE ROUTINE TO CHECK FOR A
+/LOC. TAG (LFS) & PROCESS IF FOUND.
+/FUNCTION: (ASMBLY PHASE 1 - ACTR=0)
+/ (1) DEFINE TAG
+/ (2) OUTPUT VALUE AT PAST OCCURANCES OF
+/ FORWARD REF. TO THIS TAG
+/ (3) CONDENSE OCC. TAB IF POSSIBLE.
+/
+/ (ASMBLY PHASE 2 - ACTR=1
+/ (THIS INCLUDES ALL OF PASS 2 AS
+/ ACTR STAYS=1 IN PASS 2)
+/ (1) OUTPUT EXT. SYM. DEFN. ON REL-TAPE
+/
+
+LFSCK, 0
+ TAD I PTCPR /PT CODE WORD
+ RAR
+ SNL CLA /IS THERE A LFS
+ JMP I LFSCK /NO ... RETURN
+ CMA
+ DCA BANK /BANK UNKNOWN
+ TAD PASS /MOVE BACK PTR IF IN LISTING PASS
+ CIA
+ TAD LFSPTR
+ DCA LFSPTR
+ CDF 00
+ TAD I LFSPTR /ACTUAL LFS
+ CDF 10
+ ISZ LFSPTR
+LFSBSS, DCA LFS
+ JMS I OBSYM /OBTAIN LFS FROM MST
+ LFS
+ TAD ACTR /WHICH TIME ARE WE ASSEMBLING THIS PAGE
+ /ACTR REMAINS 1 DURING PASS2
+ SZA CLA
+ JMP L67 /SECOND TIME: NO TEST
+ TAD USE /CK FOR MULTI DEF.
+ AND K400
+ SZA CLA
+ MERROR /YES
+ JMP LFSCK1
+L67, TAD USE /MST USE WORD
+ AND K200 /(L67 HAS NO EFFECT IN PASS 2)
+ SNA CLA /IS IT AN ENTRY
+ JMP LFSCK1 /NO
+/
+/ EXTERNAL SYMBOL DEFINITION
+/
+ JMS I OUTBIN /OUTPUT BINARY DEFINITION
+ ILC
+ 3
+ JMS I L68I /PUNCH SYMBOL ON TAPE
+LFSCK1, TAD ILC /CUR ILC
+ DCA VAL /PLACE ON MST AS DEFINITION
+ TAD USE /SYMBOL TABLE USE WORD
+ AND K7377 /MASK OUT DEFINED BIT
+ TAD K400 /ADD IN DEFINED BIT
+ DCA USE /SYMBOL IS NOW DEFINED IN MST
+/
+/ NOW LETS SEARCH OCCURANCE TABLE TO SEE IF WE
+/ CAN CLEAR OFF A FEW
+/
+ TAD OTP /SIZE OF OCCURANCE TABLE
+ CMA
+ TAD TOPCOR
+ SNA
+ JMP I LFSCK /RETURN IF EMPTY
+ CIA
+ DCA TEM1 /PLACE - SIZE IN INDEX LOC
+ TAD OTP /PLACE TABLE BASE IN TEM2
+ DCA TEM2 /TEM2=PTR TO SYMBOL
+ CDF 00
+L51, DCA L51FLG /CLR # SWITCH
+ ISZ TEM2
+ CMA /CK 1ST WORD FOR # FLAG
+ TAD I TEM2
+ SZA CLA
+ JMP .+4 /NO
+ ISZ L51FLG /YES, SET SWITCH
+ ISZ TEM2 /MOVE PTR & CTR
+ ISZ TEM1 /PAST EXTRA WORD
+ TAD I TEM2 /- OCCURRING SYMBOL
+ CIA
+ TAD SYMBOL /+SYMBOL JUST DEFINED
+ SNA CLA /ARE THEY EQUAL
+ JMP .+7
+ ISZ TEM2
+L51E, ISZ TEM1 /NO ... ARE THERE MORE
+ ISZ TEM1 /(2 WORDS PER OCCURRANCE)
+ JMP L51 /YES
+ CDF 10
+ JMP I LFSCK /NO ... RETURN
+/
+/ AN OCCURANCE FOUND ... OUTPUT IT
+/
+ ISZ TEM2
+ TAD I TEM2 /ACTUAL ADDRESS
+ CDF 10
+ DCA TEM4
+ JMS I DUMMY /OUTPUT ADDRESS AS ORIGIN
+ TEM4
+ 4
+ TAD VAL
+ TAD L51FLG /ADD 1 IF # REF
+ DCA TEM4
+ JMS I DUMMY /OUTPUT SYMBOL VALUE AS RELOCATABLE DEF
+ TEM4
+ 1
+ CDF 00
+/
+/ NOW MOVE OCCURANCE TABLE UP 2
+/
+L51G, TAD OTP
+ DCA TEM4 /SAVE
+ TAD TEM2
+ DCA OTP /RESET
+ TAD L51FLG
+ TAD K2
+ CIA
+ TAD TEM2
+ CIA
+ TAD TEM4
+ SNA
+ JMP L51E /NOTHING TO MOVE
+ DCA TEM3 /CTR FOR MOVE UP
+ TAD TEM3
+ CIA
+ TAD TEM4
+ DCA TEM4 /TO PTR
+L51J, TAD I TEM4
+ DCA I OTP
+ CMA
+ TAD TEM4
+ DCA TEM4
+ CMA
+ TAD OTP
+ DCA OTP
+ ISZ TEM3
+ JMP L51J
+ JMP L51E
+
+
+L68I, L68
+K7377, 7377
+TOPCOR, CORE1
+MERROR=JMP I .
+ ERRM
+
+/
+/ PUNCH ROUTINE
+/
+L63, 0
+ PLS /SELECT IT
+ PSF /WAIT FOR PUNCH
+ JMP .-1
+ CLA /EXIT WITH CLEAR AC
+ JMP I L63
+
+
+
+
+/
+/UPDATE "PAGE" TO NEXT CORE PAGE
+/I.E., PAGE =PAGE+200
+/
+UDPAGE, 0
+ CLA
+ TAD PAG /OLD PAGE SETTING
+ TAD K200 /+SIZE OF ONE PAGE
+ DCA PAG /FOR NEW PAGE SETTING
+ JMP I UDPAGE /EXIT
+
+L51FLG=UDPAGE
+\f*3200
+/
+/ SUBROUTINE TO OUTPUT ASSEMBLY PHASE LITERAL
+/ TABLE AND REMEMBER OCCURANCES
+/
+OAPLT, 0
+ TAD ACTR /SKIP IT THE 1ST TIME
+ SNA CLA
+ JMP I OAPLT
+ JMS I SAVLNI /PREVENT ANY LINE TYPEOUT
+ TAD LITSIZ /SIZE OF TABLE
+ SNA
+ JMP I OAPLT /RETURN IF NONE
+ CIA
+ DCA ATEM1 /PLACE - SIZE IN LOC
+ CLA CMA
+ TAD LITBSE /BASE - 1
+ DCA X2 /TO AUTO 12
+ TAD APMSW /ARE WE IN AUTO PAGING MODE
+ SZA CLA
+ JMP .+3 /NO ... OK
+ TAD PGEESC /YES ... SUBRTACT SIZE OF PAGE ESCAPE
+ RAR CLL /DIVIDED BY 2
+ TAD LITSIZ /& SUBTR. LITSIZ
+ CIA
+ DCA LITPTR /TEM SAVE
+ TAD LITPTR
+ TAD PAG /INITIALIZE PAGE ADDRESS
+ TAD K200
+ DCA ILC
+ TAD LITSIZ /INIT LIT TBL PTR
+ CLL RAL /(MULT BY 2)
+ TAD LITBSE
+ DCA LITPTR
+ IAC
+ SKP
+/
+L52, ISZ ILC /INC PAGE LOC
+ TAD M3 /DECREMENT LIT TBL PTR
+ TAD LITPTR
+ DCA LITPTR
+ CDF 00
+ TAD I LITPTR /CODE
+ DCA ATEM2
+ ISZ LITPTR
+ TAD I LITPTR /SYMBOL OR LITERAL
+ DCA ATEM3
+ CDF 10
+ CLA CMA
+ TAD ATEM2 /IS CODE 1 ... LITERAL
+ SZA CLA
+ JMP L53 /NO ... SYMBOL
+ JMS I ILC4P /YES ... OUTPUT PAGE ADDRESS AS ORIGIN
+ JMS I WRITEP
+ JMS I OUTBIN /OUTPUT LITERAL WITH NO RELOCATION
+ ATEM3
+ 0
+L52A, ISZ ATEM1 /MORE
+ JMP L52 /YES
+ ISZ ILC /SET FOR ESCAPE
+ JMP I OAPLT /NO ... RETURN
+L53, JMS I OBSYM /OBTAIN SYMBOL FROM MST
+ ATEM3
+ TAD USE /MST USE WORD
+ AND K400 /IS SYMBOL DEFINED
+ SNA CLA
+ JMP L53A /NO ... OCCURANCE
+ JMS I ILC4P /YES ... OUTPUT ORIGIN
+ TAD ATEM2
+ AND K4
+ SZA CLA
+ IAC /ITS A #
+ TAD VAL /ACTUAL VALUE
+ DCA ATEM3 /TO DIRRECTLY ADDRESSABLE LOC
+ JMS I WRITEP
+ JMS I OUTBIN /OUTPUT VALUE
+ ATEM3
+ 1 /RELOCATABLE
+ JMP L52A /TRY MORE
+L53A, TAD ILC
+ DCA ATEM4
+ JMS L53B /PLACE ON OCCURANCE TALBE
+ JMP L52A /TRY MORE
+/
+/ SUBROUTINE TO CREATE AN OCCURANCE IN OCCURANCE TABLE
+/
+L53B, 0
+ TAD OTP
+ CIA CLL
+ IAC /ALLOW FOR # FLAG
+ TAD STT /+TOP OF MST
+ SZL CLA /OVERFLOW?
+ SERROR /YES ... OUT OF CORE
+ TAD M2
+ TAD OTP /OT SIZE - 2
+ DCA OTP /GIVES ADDRESS ON OCCUR TABLE
+ TAD OTP
+ DCA X1
+ CDF 00
+ TAD ATEM3 /SYMBOL
+ DCA I X1 /TO OCCUR TABLE
+ TAD ATEM4 /PAGE ADDRESS
+ DCA I X1 /TO OCCUR TABLE
+ TAD ATEM2 /CK FOR #
+ AND K4
+ SNA CLA
+ JMP .+6 /NO
+ IAC /SET FLAG WORD
+ DCA I OTP
+ CMA /MOVE DOWN PTR
+ TAD OTP /PAST EXTRA WORD
+ DCA OTP
+ CDF 10
+ JMP I L53B /TRY MORE
+/
+ATEM1, 0
+ATEM2, 0
+ATEM3, 0
+ATEM4, 0
+SAVLNI, SAVLIN
+LITPTR, 0
+
+PFORT, ISZ FORFLG /SET TO 1 FOR 1ST PASS THRU FORTRAN CODE
+ NOP /END PSUEDO SETS IT TO -1 TO NULLIFY
+ JMS I SKIPL /SO BACK TO 0 FOR 2ND PASS
+ JMP I NULLP
+
+/
+/DO SOME WORK FOR L61A
+/
+L61C, DCA TEM2 /SAVE 6-BIT CODE
+ TAD TEM2
+ AND K40
+ SNA CLA
+ TAD K100 /ADD CORRECT LEADING BITS
+ TAD K200
+ TAD TEM2 /ADD CHAR BITS
+ JMP I L61DP
+L61DP, L61D
+ILC4P, ILC4
+
+\f*3400
+/
+/ ROUTINE TO PUNCH WORD AND RELOCATION BITS ON TAPE
+/ CALL IS
+/ JMS OUTBN
+/ ADDRESS OF WORD
+/ BITS
+/
+OUTBN, 0
+ CLA CLL
+ TAD I OUTBN /ADDRESS OF WORD
+ DCA OUT1
+ ISZ OUTBN
+ TAD I OUTBN /RELOCATION BITS
+ RTL /SHIFT LEFT 4
+ RTL
+ DCA OUT2 /SAVE
+ TAD PASS
+ SZA CLA
+ JMP OUTEX
+ TAD I OUT1 /ACTUAL WORD
+ DCA OUT1 /MUST DO THIS SINCE WE DO A JMS OUTBN;CSUM;10
+ TAD OUT1 /AT LOC. PCSM, AND OTHERWISE CSUM WOULD CHANGE AFTER CALL TO SUM.
+ RTL /ROTATE HIGH 4 BITS TO LOW
+ RTL
+ RAL
+ AND K17 /MASK
+ TAD OUT2 /ADD REL BITS
+ JMS SUM /ADD TO CHECK SUM
+ JMS I PUNCH /PUNCH IT
+ TAD OUT1 /REMAINDER OF WORD
+ AND K377 /MASK TO 8 BITS
+ JMS SUM /ADD TO CHECK SUM
+ JMS I PUNCH /PUNCH IT
+OUTEX, ISZ OUTBN /INDEX FOR EXIT
+ JMP I OUTBN /RETURN
+SUM, 0
+ DCA TSUM
+ TAD CSUM
+ TAD TSUM
+ DCA CSUM
+ TAD TSUM
+ JMP I SUM
+TSUM=NSGN
+OUT1=IB
+OUT2=TEM5
+K377, 377
+K17, 17
+/
+/ ROUTINE TO SEARCH ASSEMBLY PHASE LITERAL TABLE
+/ FOR 2 WORD ENTRY IN S0-S1
+/ PLACES ON TABLE IF NOT THERE
+/ RETURNS PAGE ADDRESS IN AC
+/
+SRALT, 0
+ CLA
+ DCA TEM2 /ZERO SEARCH COUNTER
+ CDF 00
+ TAD LITSIZ /NO OF ENTRYS
+ SZA
+ JMP L40 /NON ZERO ... SEARCH
+L39, TAD LITSIZ /NO OF ENTRYS - 1
+ RAL CLL /MULTIPLY BY 2
+ TAD LITBSE /ADD BASE OF TABLE
+ DCA TEM1 /GIVES ADDRESS OF NEW ENTRY
+ ISZ LITSIZ /INCREMENT COUNT
+ TAD S0 /FIRST WORD
+ DCA I TEM1 /TO TABLE
+ ISZ TEM1 /INCREMENT ADDRESS
+ TAD S1 /SECOND WORD
+ DCA I TEM1 /TO TABLE
+ TAD LITSIZ /ENTRY NO
+
+/ COMPUTE PAGE ADDRESS FROM DISPLACEMENT IN TABLE
+/ AND STATUS OF AUTOMATIC PAGING MODE SWITCH AND SIZE OF PAGE
+/ ESCAPE REQUIRED
+/
+L40A, DCA TEM1 /SAVE LOCATION IN TABLE
+ TAD PASS
+ SZA CLA
+ JMP L40C /LISTING
+ TAD APMSW /ARE WE IN AUTOMATIC PAGING MODE?
+ SNA CLA
+ TAD PGEESC /YES - COUNT ESCAPE WORDS
+L40DR, CLL RAR /(OVER 2)
+L40D, TAD TEM1 /NO ... COMPUTE PAGE ADDRESS
+ CIA /BY STRAIGNT COMPLEMENTATION METHOD
+ AND K377 /MASK
+ CDF 10
+ JMP I SRALT /EXIT
+ /FOR AUTO PAGING MODE
+
+L40, CIA
+ DCA TEM1 /- NO OF ENTRYS TO LOC
+ CLA CMA
+ TAD LITBSE /BASE OF TABLE - 1
+ DCA X1 /TO AUTO 10
+L41, ISZ TEM2 /INCREMENT SEARCH COUNTER
+ TAD I X1 /- FIRST WORD FROM TABLE
+ CIA
+ TAD S0 /+FIRST COMP WORD
+ SZA CLA
+ JMP L40B /NO MATCH
+ TAD I X1 /-SECOND TABLE WORD
+ CIA
+ TAD S1
+ SZA CLA
+ JMP .+4 /NO MATCH
+ TAD TEM2 /MATCH ... CTR TO AC
+ JMP L40A /RETURN
+L40B, ISZ X1 /INCREMENT FOR NO SECOND COMPARISON
+ ISZ TEM1 /OVER
+ JMP L41 /NO ... TRY MORE
+ JMP L39 /YES ... PLACE ON TABLE
+L40C, CDF 10
+ TAD I REDUCP /GET PAGE ESC COMPUTED BY A1
+ JMP L40DR
+REDUCP, REDUCE
+
+/
+/ HAS COMMON BEEN PUNCHED YET SUBROUTINE
+
+/IF IT HAS ALREADY BEEN PUNCHED, EXIT
+/IF NOT, PUNCH IT & SET FLAG
+/THIS ROUTINE IS CALLED ONLY ONCE PER PROGRAM
+/BUT IT COULD BE CALLED FROM ANY OF SEVERAL PLACES
+/
+HCBPS, 0
+ TAD CPSW /COMMON PUNCHED SWITCH
+ SNA CLA /HAS IT BEEN PUNCHED
+ JMP I HCBPS /YES ... RETURN
+ DCA CPSW /NO ... CLEAR SWITCH
+ JMS I OUTBIN /AND PUNCH HIGHEST COMMON ASSIGNED
+ HICOM
+ 12
+ JMP I HCBPS /EXIT
+
+DUMSUB, JMS DUMS
+
+
+/
+/INCREMENT PAGE TABLE PTRS
+/TO PREPARE FOR NEXT INSTRUCTION (OR PARAMETER)
+/
+INCPT, 0
+ ISZ PTSZE /INCREMENT PAGE TABLE SIZE
+ JMS I ISZPT2
+ DCA EQVBIT /CLR
+ DCA I PTCPR /INITIALIZE PAGE TABLE CODE WORD
+ DCA I PTSPR /INITIALIZE PAGE TABLE SYMBOL WORD
+ CDF 00
+ DCA I PTOPR /INITIALIZE PT OP CODE POINTER
+ CDF 10
+ TAD CURSKP /MOVE CURRENT SKIP INSTRUCTION INDICATOR
+ DCA LSTSKP /TO LAST INSTRUCTION SKIP INDICATOR
+ TAD BANK /MOVE CURRENT BANK
+ DCA LSTBNK /TO LAST BANK
+ JMP I INCPT /RETURN
+ISZPT2, ISZPT
+//
+//FOLLOWING CODE MOVED HERE TO MAKE ROOM FOR V03 IN ASME3
+ASMEXT, JMS I OUTSKP /YES, OUTPUT SKP
+ TAD ILC /GET PG.LOC.PTR.
+ AND K177
+ TAD K5204 /OUTPUT JMP .+4
+ DCA TEM1
+ JMP I .+1
+ REEASM
+K5204, 5204
+
+
+\f*3600
+
+/ ABSYM PSEUDO OPERATOR
+/
+PABSYM, TAD K400
+ JMS DEFSUB
+ CLA
+ JMP DEF1
+
+/SKPDF & OPDEF PSUEDO-OPS
+
+
+SKPDEX, TAD K20 /PUT IN SKIP BIT
+OPDEX, TAD K3010 /STANDARD OP BITS
+ JMS DEFSUB
+ CLL
+ AND K7000 /CK TYPE OF INST
+ TAD K2000
+ SNA CLA
+ JMP DEF1 /IOT
+ SNL
+ JMP DEF3 /MRI
+ TAD S0 /OPR, BUT WHICH GRP?
+ AND K401
+ CLL RAR
+ SNA CLA
+ JMP DEF2 /GRP1
+ SZL
+ TAD K100 /GRP3
+ TAD K200 /GRP2
+DEF1, TAD TEM5
+ DCA USE
+ TAD S0
+ DCA VAL
+ TAD VAL
+ JMP I NULLP
+DEF2, TAD K100
+ JMP DEF1
+DEF3, TAD K400
+ JMP DEF1
+K401, 401
+K3010, 3010
+
+
+/
+/UTILITY FOR PABSYM & OPDEX
+/CALL WITH MST CODE WORD EXCEPT BITS 10-11
+/IN AC. EXITS WITH SYMBOL VALUE
+/AS DEF. BY SOURCE TAPE IN S0 & IN AC.
+/
+DEFSUB, 0
+ DCA TEM5
+ JMS I GETSYM /GET THE SYMBOL NAME
+ JMP DEFERR /NULL
+ JMP .+3 /SYMBOL
+K7000, NOP
+ JMP DEFERR /CONST. OR LIT.
+ TAD S0 /ADD IN SYM LENGTH
+ TAD TEM5
+ DCA TEM5
+ JMS I GETSYM /GET VALUE
+ NOP /NULL
+ SKP /SYMBOL
+K7410, SKP /CONST
+DEFERR, IERROR /LIT.
+ JMS I SKIPL
+ TAD S0 /VALUE
+ JMP I DEFSUB
+
+/
+/OCTAL TYPEOUT
+/CALLING SEQUENCE: TAD (OCTAL#)
+/ JMS L62
+/ RET. AC=0
+/
+
+L62, 0
+ CLL RAL /PUSH THRU LINK
+ DCA TEM1
+ TAD M4 /SET CTR
+ DCA TEM2
+L62A, TAD TEM1
+ RTL
+ RAL
+ DCA TEM1
+ TAD TEM1
+ AND K7
+ TAD K260
+ JMS I TYPE
+ ISZ TEM2
+ JMP L62A
+ JMP I L62
+M4, -4
+K260, 0260
+
+/
+/DUMMY OUTPUT ROUTINE
+/REPLACES OUTBN DURING ASMBLY PHASE 1
+/CALLING SEQUENCE: JMS DUMMY
+/ ADDR. OF ARG
+/ RELOC. CONST.
+/ RETURN
+/NOTE: SAME CALLING SEQ. AS OUTBN
+/
+DUM, 0
+ CLA CLL
+ ISZ DUM /INDEX FOR PROPER EXIT
+ ISZ DUM /INDEX FOR PROPER EXIT
+ JMP I DUM
+/
+/ ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
+/ FOR CUR SYMBOL - RETURNS EXTERNAL SYMBOL
+/ NUMBER IN AC - PLACES SYMBOL ON TABLE
+/ AND OUTPUTS BIN CODE FOR TV IF NOT ON TABLE
+/
+L66, 0
+ TAD ESTSIZ /IS TABLE FULL?
+ TAD M100
+M100, SMA CLA
+ SERROR /YES
+ TAD ESTSIZ /SIZE OF EST
+ SZA /IS TABLE EMPTY
+ JMP L66A1 /NO ... SEARCH IT
+L66A3, CLA CMA /YES ... PLACE SYMBOL ON IT
+ ISZ ESTSIZ /INCREMENT TABLE SIZE
+ TAD BSEEST /BASE
+ TAD ESTSIZ /+SIZE
+ DCA TEM1 /GIVES ADDRESS OF NEW ENTRY
+ TAD SYMBOL /PHYSICALLY PLACE ON TABLE
+ CDF 00
+ DCA I TEM1
+ CDF 10
+ TAD USE /MST CODE WORD
+ AND K403A /SAVE LENGTH AND DEFINITION BIT
+ TAD K2000 /ADD EXTERNAL BITS
+ DCA USE
+ JMP L66A /GO TO PUNCH TV DEF
+L66A1, CIA
+ DCA TEM2 /PLACE -SIZE IN INDEX LOC
+ DCA TEM3 /ZERO COUNT
+ CLA CMA
+ TAD BSEEST /BASE OF EST - 1
+ DCA X1 /TO AUTO X1
+L66A2, ISZ TEM3 /INCREMENT COUNT LOC
+ CDF 00
+ TAD I X1 /-TABLE SYMBOL
+ CDF 10
+ CIA
+ TAD SYMBOL /+ CUR SYMBOL
+ SNA CLA /COMPARE
+ JMP .+4 /SAVE
+ ISZ TEM2 /NOT SAME ... ANY MORE
+ JMP L66A2 /YES ... KEEP TRYING
+ JMP L66A3 /NO ... PLACE ON TABLE
+ TAD TEM3 /PLACE COUNT IN AC
+ JMP I L66 /RETURN
+/
+/ OUTPUT BINARY EXTERNAL SYMBOL
+/
+ HCBPS
+L66A, JMS I .-1 /CHECK TO SEE IF COMMON HAS BEEN PUNCHED
+ JMS I OUTBIN /TV DEF FOR 1 SYMBOL
+ K1
+ 17
+ JMS I L62A1 /PUNCH ASCII CHARS
+ TAD ESTSIZ /EST NO TO AC
+ JMP I L66 /RETURN
+L62A1, L68
+K403A, 403
+K1, 1
+
+\f*4000
+
+
+
+/
+/SYMBOL TABLE LISTING ROUTINE
+/TYPES TABLE FROM "STTP" UP
+/WITH NAME-VALUE-FLAG
+/POSSIBLE FLAGS ARE: EXT, COM, UNDF, ABS, OP
+/FLAGS TYPED BY "STFT"
+/TABLE LISTED ALPHABETICALLY WITH NUMERIC
+/CHARACTERS .GT. ALPHABETIC
+/
+
+PRSYM, 0
+ DCA PFLG /CLR PRSYM-PASS FLAG
+ TAD I LSTDEP
+ SNA CLA
+ JMP .+3
+ TAD PUNCH /LIST ON H.S. PUNCH
+ DCA TYPE
+ JMS I CRLF
+PRS1, TAD PST /INIT SPTR AT TOP OF PERM. S.T.
+ DCA SPTR
+ TAD M3 /FILL S1,S2,S3 WITH 7777'S (MAX)
+ DCA ALEN
+ TAD APTR
+ DCA X1
+ CMA
+ DCA I X1
+ ISZ ALEN
+ JMP .-3
+ TAD K3 /AND LENGTH=3
+ DCA ALEN
+ DCA FOUND /CLR EXIT FLAG
+PRS2, TAD STT /HAS SEARCH HIT END OF TABLE?
+ CIA
+ TAD SPTR
+ SNA CLA
+ JMP PRS7 /YES, USE THE A-SYM WE HAVE
+ JMS I OBSYM /NO, GET NEXT MST ENTRY
+ SPTR
+ TAD BCODE /EXTRACT LENGTH
+ AND K3
+ DCA BLEN
+ TAD BPTR /INDEX NEW ENTRY
+ DCA X2
+ TAD BLEN /SET ENTRY CTR
+ CIA
+ DCA BCTR
+ TAD ALEN /SET A-SYM CTR
+ CIA
+ DCA AACTR
+ TAD APTR /INDEX A-SYM
+ DCA X1
+ TAD PFLG /IS THIS THE FIRST TIME THRU THE TABLE?
+ SZA CLA
+ JMP PRS3 /NO
+ TAD BCODE /YES, CLR ENTRY BIT 0
+ AND K3777 /(THE HAS-BEEN-PRINTED FLAG)
+ DCA BCODE
+PRS3, TAD BCODE /HAS THIS SYMBOL BEEN PRINTED ALREADY?
+ SPA CLA
+ JMP PRS6 /YES, IGNORE IT
+PRS4, TAD I X1 /NO, COMRARE A-SYM WORD
+ CIA CLL
+ CDF 00
+ TAD I X2 /WITH B-SYM WORD
+ CDF 10
+ SNA
+ JMP .+4 /MATCH SO FAR
+ SNL CLA
+ JMP PRS5 /A-SYM WORD IS BIGGER-- USE B-SYM
+ JMP PRS6 /VICE-VERSA
+ ISZ AACTR /IS A-SYM DONE?
+ SKP /NO
+ JMP PRS6 /YES, STICK WITH A-SYM
+ ISZ BCTR /IS B-SYM DONE
+ JMP PRS4 /NO, TRY NEXT WORD
+PRS5, ISZ FOUND /YES, B-SYM IS NEW A-SYM
+ /SET CONTINUE FLAG
+ TAD BPTR /INDEX B-SYM
+ DCA X2
+ TAD APTR /CLR STORAGE FOR NEW A-SYM
+ DCA X1
+ DCA I X1
+ DCA I X1
+ DCA I X1
+ TAD APTR /RESET A-SYM INDEX
+ DCA X1
+ TAD BLEN /CTR FOR TRANSFER
+ CIA
+ DCA ALEN
+ CDF 00
+ TAD I X2 /MOVE B-SYM TO A-SYM
+ CDF 10
+ DCA I X1
+ ISZ ALEN
+ JMP .-5
+ TAD BLEN /NEW LENGTH
+ DCA ALEN
+ TAD BVAL /NEW VALUE
+ DCA AVAL
+ TAD BPTR /NEW PTR
+ DCA ASAV
+PRS6, TAD BPTR /MOVE SPTR TO NEXT MST ENTRY
+ TAD BLEN
+ TAD K2
+ DCA SPTR
+ JMP PRS2 /CONTINUE SEARCH
+PRS7, TAD FOUND /HAS ANOTHER SYMBOL BEEN FOUND?
+ SNA CLA
+ JMP PRS8 /NO, EXIT
+ JMS I OBSYM /YES
+ ASAV
+ TAD USE
+ TAD K4000
+ DCA USE /SET HAS-BEEN-PRINTED BIT
+ ISZ PFLG /SET PASS FLAG
+ JMS I CRLF /POSITION PRINT
+ TAD APTR /INDEX SYMBOL
+ DCA X1
+ TAD M3 /SET CTR
+ DCA ALEN
+ TAD I X1 /PRINT SYMBOL
+ JMS I CTYPE
+ ISZ ALEN
+ JMP .-3
+ JMS I CTYPE /PRINT 2 SPACES
+ TAD AVAL /PRINT VALUE
+ JMS I OTYPE
+ TAD USE /MOVE TYPE BITS TO LOW AC
+ RTL /& DEF. BIT TO LINK
+ RTL
+ JMS I STFTI /TYPE FLAGS IF ANY
+ JMP PRS1 /LOOK FOR ANOTHER SYMBOL TO PRINT
+
+PRS8, JMS I CRLF
+ JMS I CRLF
+ JMP I PRSYM
+
+
+STFTI, STFT
+ASAV=UMIC
+PFLG=TEM3
+PST, STTP /TOP OF PERMANENT SYMBOL TABLE
+ALEN=S0
+APTR=AS0
+BPTR=SYMBOL
+BVAL=VAL
+BCODE=USE
+FOUND=TEM4
+SPTR=TEM5
+BLEN=LFS
+BCTR=OP
+AACTR=IB
+AVAL=AFS
+K3777, 3777
+LSTDEP, LSTDEV
+
+
+\f*4200
+
+/
+/ROUTINE TO PUSH DOWN CUR.LINE FOR NEXT PAGE.
+/SAVES ENTIRE LIST OF VITAL INFO
+/(LFS, OP, IB,...,BANK, S0) IN TEMP.LOCS
+/(TLFS, TOP, TIB,..., TS0)
+/BOTH LISTS MUST BE KEPT IN SPECIFIED
+/ORDER.
+/IF THERE IS AN LFS ON LINE MUST MARK IT
+/NO-LONGER-DEFINED-ON-PAGE IN PST.
+/
+
+PUSHIN, 0
+ TAD LFS /IS THERE AN LFS
+ SNA CLA
+ JMP PSHIN2 /NO
+ JMS I OBSYM
+ LFS
+ JMS I SPSTAB /GET ITS POINTERS TO THE PAGE SYMBOL TABLE
+ NOP
+ TAD I PSTCPR /KILL THE DEFINED BIT
+ AND K3777A
+ DCA I PSTCPR /SET PAGE SYMBOL TABLE CODE WORD OFF PAGE
+PSHIN2, JMS PUSHER
+ LFS-1
+ TLFS-1
+ JMP I PUSHIN /RETURN
+/
+/ ROUTINE TO POP UP A PUSHED DOWN INSTRUCTION
+/
+POPIN, 0
+ CLA
+ JMS PUSHER
+ TLFS-1
+ LFS-1
+ JMP I POPIN /RETURN
+TLFS, 0 /KEEP THIS LIST ORDERED AS GIVEN
+TOP, 0
+TIB, 0
+TAFS, 0
+TUMIC, 0
+TNSGN, 0
+TEXP, 0
+TSKZ, 0
+TBANK, 0
+TS0, 0
+
+
+/
+/TRANSFER ANY LIST OF 10 (12 OCTAL) ITEMS
+/FROM ONE LIST TO ANOTHER
+/CALL SEQ.: JMS PUSHER
+/ ADDR-1 OF FROM-LIST
+/ ADDR-1 OF TO-LIST
+/ RET.
+/
+
+PUSHER, 0
+ TAD M12A
+ DCA TEM1 /CTR
+ TAD I PUSHER
+ DCA X1 /INDEX FROM LIST
+ ISZ PUSHER
+ TAD I PUSHER
+ DCA X2 /INDEX TO LIST
+ TAD I X1
+ DCA I X2
+ ISZ TEM1
+ JMP .-3
+ ISZ PUSHER
+ JMP I PUSHER
+M12A, -12
+K3777A, 3777
+/RETRN PSUEDO-OP
+/
+PRTN, JMS I GETSYM /GET NEXT INPUT ITEM
+ SKP /NOTHING
+ JMP .+3 /SYMBOL
+ NOP /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ JMS I SREST /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
+ DCA PRTN0 /SAVE SYMBOL ID
+ JMS PUSHIN /PUSH LFS INFO IN CASE OF PAGE ASSEMBLY
+ TAD K2 /SET AC TO 2
+ JMS I PRTN1 /ARE THERE 2 LOCATIONS ON THIS PAGE
+ SKP CLA /YES
+ JMS I INI /NO ... HAD TO ASSEMBLE PAGE ... INITIALIZE PT
+ JMS POPIN /POP LFS INFO FROM PAGE PUSH LIST
+ JMS I ICPLFS /PROCESS ANY LFS
+ TAD I PTCPR /PT CODE WORD WITH POSSIBLE LFS BIT
+ TAD K30 /ADD SPECIAL RELOCATION BIT
+ DCA I PTCPR /PLACE PROPER CODE WORD ON PT
+ TAD DOTRTN
+ DCA I PTSPR /PLACE JMS .RTN INSTRUCTION IN PT SYMBOL WORD
+ JMS I PRTN3 /INCREMENT PT POINTERS
+ TAD K130 /PROPER BIT PATTERN
+ DCA I PTCPR /TO PT CODE WORD
+ TAD PRTN0 /PLACE EXTERNAL SYMBOL NUMBER ON PT
+ DCA I PTSPR /AS SYMBOL WORD
+ JMS I PRTN3 /INCREMENT PT POINTERS
+ JMP I POPEXP /EXIT FOR NEXT LINE
+DOTRTN, JMS RTN
+PRTN0, 0
+PRTN1, IFFSUB
+PRTN3, ASMIF1
+
+/
+/ @PAUSE@ PSEUDO OPERATION
+/
+PPAUSE, JMS I WLNIFI /LIST IF PASS 2
+ CLA HLT /WAIT FOR OPERATOR ACTION
+ RFC /SELECT READER
+ JMS I INITRP
+ JMS I SKIPL
+PPAUS1, CMA /WE REACH THIS ONLY IF FORFLG. LE. 0(ALSO COME FROM *PEND*)
+ DCA FORFLG /SHUT OFF FORTR IN CASE GUY
+ /HAS STARTED HIS TAPE IN
+ /THE MIDDLE
+ JMP I DCIL1 /RETURN FOR NEXT LINE
+
+WLNIFI, WLNIF1
+
+
+/
+/OVERAL ASSEMBLY INITIALIZATION
+/
+INITA, 0
+ CDF 10
+ DCA I FATALP
+ JMS I CRLF
+ JMS I CRLF
+ TAD PEB
+ DCA I PEPTRP
+ JMS PUSHER /INIT HICOM, PAGE, ESTSIZ, EQVBIT & APMSW ETC
+ K777-1
+ HICOM-1
+ JMS I INITRP
+ TAD PASS
+ SZA CLA
+ JMP I INITA
+ DCA SYMBOL /PROTECT FROM RUSVL
+ JMS I INITMP
+ DCA CSUM
+ TAD K10 /SET PUSH CTR=-2
+ JMS PUSHER /INIT OTP & STP
+ OTPR-1
+ OTP-1
+ JMS I LEADI
+ JMP I INITA
+OTPR, CORE1-1 /KEEP STTR IMMEDIATELY AFTER OTPR
+STTR, STTP
+/***** KEEP ITEMS SO INCLOSED IN GIVEN ORDER
+K777, 177
+ 200
+ 0
+ 0
+ 0
+ 1
+ 1
+ 0
+ 0
+ 0
+/******************
+INITRP, INITR
+FATALP, FATAL
+PEPTRP, PEPTR
+LEADI, LEADER
+PEB, PEBSE
+INITMP, INITMR
+\f*4400
+/
+/ ROUTINE TO SEARCH SYMBOL TABLE FOR SYMBOL IN S0-S3
+/ PLACES SYMBOL ON TABLE IF NOT THERE
+/ CALL IS
+/ JMS SRSYM
+/ NOT FOUND EXIT
+/ FOUND EXIT
+
+/RETURNS WITH SYMBOL CODE BITS IN "USE"
+/SYMBOL VALUE (0 IF NOT DEFINED)
+/IN "VAL"
+/& PTR TO SYM.TAB. ENTRY IN "SYMBOL"
+/THE LATTER ADDRESS IS REFERRED TO HERE IN
+/AS THE SYMBOL "ID"
+/SRSYM CALL RUSVL TO STORE USE & VAL
+/OF LAST REFERENCED SYMBOL IN MST
+/IN CASE THEY HAVE BEEN CHANGED
+/IN THE MEANWHILE.
+
+/
+SRSYM, 0
+ JMS RUSVL
+ TAD MST /START AT SYM. TAB. BASE
+SRS1, DCA SYMBOL /SET PTR. TO NEXT ENTRY
+ TAD STT /COMPARE PTR. WITH SYM. TAB. TOP
+ CIA
+ TAD SYMBOL
+ SNA CLA /CONTINUE SEARCH
+ JMP SRS2 /NAME NOT IN TABLE ENTER IT
+ CDF 00
+ TAD I SYMBOL /GET ENTRY CODE WORD
+ CDF 10
+ AND K3 /EXTRACT SYMBOL LENGTH
+ DCA TEM2
+ TAD TEM2
+ CIA /NEGATE FOR COMPARE & CTR.
+ DCA TEM1
+ TAD TEM1 /COMPARE ENTRY & LOOK-UP SYMBOL LENGTHS
+ TAD S0
+ SZA CLA /SAME LENGTH; COMPARE LETTERS
+ JMP SRS5 /NOT SAME; GO TO NEXT ENTRY
+ TAD AS0 /AUTO-INDEX LOOP-UP SYMBOL
+ DCA X1
+ TAD SYMBOL /AUTO-INDEX TABLE ENTRY
+ DCA X2
+SRS3, CDF 00
+ TAD I X2 /GET TABLE ENTRY CHAR. PAIR
+ CIA
+ CDF 10
+ TAD I X1 /COMPARE LOOK-UP SYMBOL CHAR. PAIR
+ SZA CLA /SAME
+ JMP SRS5 /NO MATCH
+ ISZ TEM1 /CK SYM. LEN. CTR.
+ JMP SRS3 /NOT DONE, TRY NEXT CHAR. PAIR
+SRS4, JMS SUSVL /GET USE & VAL WORDS
+ JMP I SRSYM
+
+SRS5, TAD SYMBOL /PTR TO LAST ENTRY
+ TAD K2 /+2 FOR USE & VAL WORDS
+ TAD TEM2 /+ENTRY SYMBOL LENGTH
+ JMP SRS1 /=PTR TO NEXT ENTRY
+/
+/CURRENT SYMBOL NOT ON TABLE ... PLACE IT THERE
+/
+
+SRS2, TAD OTP /WILL NEW ENTRY FIT BELOW
+ CIA CLL /OCCURANCE TABLE?
+ TAD SYMBOL
+ TAD S0
+ SZL CLA /0 LINK=YES
+ SERROR /NO, SYMBOL TABLE OVERFLOW
+ TAD S0 /ENTRY CODE WORD = SYM. LEN.
+ TAD K1000 /+REL BIT
+ CDF 00
+ DCA I STT /PUT CODE IN 1ST WORD OF NEW ENTRY
+ TAD STT /AUTO-INDEX ENTRY
+ DCA X2
+ TAD AS0 /AUTO-INDEX SYMBOL TO BE STORED
+ DCA X1
+ TAD S0 /SET SYM. LEN. CTR.
+ CIA
+ DCA TEM1
+ERS1, CDF 10
+ TAD I X1 /MOVE SYMBOL CHAR. PAIR TO TABLE
+ CDF 00
+ DCA I X2
+ ISZ TEM1 /CK. CTR.
+ JMP ERS1 /NOT DONE
+ DCA I X2 /CLR VALUE WORD
+ TAD STT /SAVE PTR TO NEW ENTRY
+ DCA SYMBOL
+ TAD X2 /RESET PTR. TO SYM. TAB. TOP
+ IAC
+ DCA STT
+ CDF 10
+ JMP SRS4
+
+/
+/OBTAIN GIVEN SYMBOL'S VITAL INFO FROM MST
+/CALL SEQ: JMS OBNSYM
+/ ADDRESS OF SYMBOL ID
+/ RET.
+/OBNSYM LEAVES SYMBOL ID IN "SYMBOL",
+/ SYMBOL CODE WORD IN USE,
+/ SYMBOL VALUE IN VAL.
+/OBNSYM CALLS RUSVL BEFORE ACTION
+/FOR SAME REASON AS SRSYM DOES.
+/
+OBNSYM, 0
+ JMS RUSVL
+ TAD I OBNSYM /ADDRESS OF SYMBOL
+ DCA TEM1
+ TAD I TEM1 /ACTUAL SYMBOL
+ DCA SYMBOL
+ ISZ OBNSYM /INDEX FOR EXIT
+ JMS SUSVL /SET UP USE AND VALUE WORDS
+ JMP I OBNSYM /RETURN WHEN FOUND
+/
+/ ROUTINE TO SET UP USE AND VALUE WORDS
+/
+SUSVL, 0
+ CDF 00 /OFF TO BANK 1
+ TAD I SYMBOL /MST USE WORD FROM BANK 1
+ DCA USE /TO BANK 0 USE LOCATION
+ TAD USE
+ AND K3
+ IAC
+ TAD SYMBOL
+ DCA VALPTR
+ TAD I VALPTR /MST VALUE WORD FROM BANK 1
+ DCA VAL /TO BANK 0 VALUE LOCATION
+ CDF 10 /RESTORE DATA FIELD
+ JMP I SUSVL /RETURN
+
+RUSVL, 0
+ CDF 00
+ TAD USE
+ DCA I SYMBOL
+ TAD VAL
+ DCA I VALPTR
+ CDF 10
+ JMP I RUSVL
+
+VALPTR, 0 /PTR TO CURRENT VAL WORD IN MST
+/
+/READ A CHARACTER
+/ IGNORES LF, FF, RO, LEADER
+/ ALSO CHECKS CHAR AS TO TYPE
+/CALLING SEQ: JMS RCH
+/ RETURN IF CHAR IS A DIGIT
+/ RETURN IF CHAR IS ALPHABETIC
+/ RETURN FOR ALL OTHER (PUNCT,ETC)
+/LEAVES AC==0
+/ CHR=ASCII VALUE OF INPUT CHARACTER
+/CALLS SRT
+
+RCH, 0
+ JMS I GETCHR /GET 1 CHAR
+ SNA
+ JMP RCH3 /0=END OF LINE
+ TAD M260
+ SPA
+ JMP RCH3 /TAKE PUNCT.EXIT (200-257)
+ TAD M12
+ SPA
+ JMP RCH4 /TAKE DIGIT EXIT (260-271)
+ TAD M7
+ SPA
+ JMP RCH3 /TAKE PUNCT, EXIT (272-300)
+ TAD M37A
+
+ SMA
+
+RCH3, ISZ RCH /PUNCT, EXIT (337-376)
+ ISZ RCH /ALPHA EXIT (301-336)
+
+RCH4, CLA /DIGIT EXIT
+ JMP I RCH
+M260, -260
+M12, -12
+M37A, -36
+
+
+/FORCE BUFFER FILL ON FIRST READ
+
+INITR, 0
+ TAD MBE
+ DCA X3
+ JMP I INITR
+
+MBE=LINAX /=LAST WORD OF DATA BUFFER
+\f*4600
+
+/SUBR TO READ 1 LINE INTO LINE BUFFER
+
+RLN, 0
+ DCA LFLG /CLR NON-NULL LINE FLAG
+ TAD SCOLON /IF LAST LINE ENDED WITH ;
+ SZA /NO NEED TO READ ANOTHER
+ JMP RLN4
+ TAD LINAX /INIT STORAGE AUTO-INDEX
+ DCA X2
+RLN2, JMS FETCH /GET A CHARACTER
+ JMS I TEST /IS IT A CR,TAB,SP,FF,LF?
+ SL7-1 /IF SO GO TO RLN15,3,3,2,2
+ BL6-SL7
+ ISZ LFLG /OTHERWISE A NON-NULL LINE
+RLN3, JMS I STOREP /OTHERWISE PUT IT IN THE BUFFER
+ TAD X2 /IS BUFFER FULL?
+ TAD LINEND
+ SZA CLA
+ JMP RLN2 /NO
+ CMA
+ TAD X2
+ DCA X2 /IF SO MOVE BACK PTR
+ JMP RLN2
+RLN15, DCA CHR /TERMINATE LINE WITH 0
+ JMS I STOREP
+ DCA AFLG
+ DCA EFLG
+ DCA VFLG
+ DCA CODE
+ TAD LINAX /INIT LINE INDEX
+RLN4, DCA X0
+ DCA SCOLON /CLR
+ JMP I RLN
+
+
+STOREP, STORE
+LINEND, -LINBUF-107
+
+/SUBROUTINE TO READ 1 CHARACTER VIA INPUT DEVICE
+/IGNORES 200'S & 377'S
+
+FETCH, 0
+ JMS R
+ AND K177
+ TAD K200 /FORCE FULL 8BIT ASCII
+ DCA CHR
+ TAD CHR
+ TAD M200
+ SZA
+ TAD M177
+ SNA CLA
+ JMP FETCH+1
+ JMP I FETCH
+M177, -177
+
+/SUBR TO GET NEXT CHAR FROM HSR BUFFER
+/REFILL BUFFER WHEN X3 REACHES END OF BUFFER
+
+R, 0
+ CDF 00
+ TAD X3
+ TAD BUFEND /CK FOR END OF BUFFER
+ SNA CLA
+ JMP RG /REFILL
+R1, TAD I X3 /GET NEXT CHAR
+ CDF 10
+ JMP I R
+RG, TAD BUF /INDEX THE BUFFER
+ DCA X3
+RG1, JMS I INDEV
+ DCA I X3
+ TAD X3 /CK FOR FULL
+ TAD BUFEND
+ SZA CLA
+ JMP RG1 /NOT FULL
+RG3, TAD BUF /RESET PTR
+ DCA X3
+ JMP R1
+
+INDEV, HSR
+BUF, DATA-1
+
+BUFEND, 1-LINBUF
+
+/GET 1 CHAR FROM LINE BUFFER
+
+L65, 0
+ CDF 00
+ TAD I X0
+ CDF 10
+ DCA CHR
+ TAD CHR
+ JMP I L65
+
+/
+/ ROUTINE TO PUNCH LEADER TRAILER CODE
+/
+LEADER, 0
+ TAD K7600
+ DCA TEM1
+ TAD K200
+ JMS I PUNCH
+ ISZ TEM1
+ JMP .-3
+ JMP I LEADER
+
+/
+/ ROUTINE TO TYPE RETURN-LINE FEED
+/
+ 0215
+ 0212
+L73, 0
+ CLA
+ TAD L73-2
+ JMS I TYPE
+ TAD L73-1
+ JMS I TYPE
+ JMP I L73
+
+
+/DECIM & OCTAL PSUEDO-OPS
+
+PDEC, JMS I SKIPL
+ IAC /SET ARITHMETIC CONVERSION TO DECIMAL
+ SKP
+POCT, JMS I SKIPL
+ DCA DSW /SET ARITHMETIC CONVERSION TO OCTAL
+ JMP I NULLP /GO GET NEXT INPUT LINE
+
+
+
+/
+/ROUTINE TO STOP NEXT LINE FROM BEING LISTED
+/THO IT IS ALREADY IN THE BUFR.
+/E.G., STOP LISTING OF PUSHED DOWN LINE
+/WHILE ASSEMBLING LIT. POOL
+/
+SAVLIN, 0
+ CDF 00
+ TAD I LINEB2 /SAVE 1ST CHAR OF LINE
+ SNA /IF ANY
+ JMP .+3 /THERE ISNT ANY
+
+ DCA SAVEIT
+ DCA I LINEB2 /CLR TO PREVENT TYPEOUT
+ CDF 10
+ JMP I SAVLIN
+
+
+/
+/REENABLE LISTING OF LINE WHICH SAVLIN
+/PREVENTED
+/
+
+RELINE, 0
+ CDF 00
+ TAD SAVEIT /RESTORE 1ST CHAR OF LINE
+ DCA I LINEB2
+ CDF 10
+ JMP I RELINE
+
+SAVEIT, 0
+LINEB2, LINBUF
+
+
+/ROUTINE TO LIST NULL, COMMENT OR PSUEDO-OP LINE
+
+NULL, DCA VALUE /IF ANY GIVEN
+ TAD VALUE /SET TYPEOUT FLAG IF NON-0
+ DCA VFLG
+ JMS I WLIF /LIST IF PASS 2
+ JMP I DCIL1 /GO BACK TO RDL1 FOR NEXT LINE
+WLIF, WLNIF1
+
+/
+/ TYPE ROUTINE
+/
+L64, 0
+ TLS /SELECT IT
+ TSF /WAIT FOR TTY
+ JMP .-1
+ CLA /EXIT WITH CLEAR AC
+ JMP I L64
+\f*5000
+/
+/ ROUTINE TO SET THE CORRECT COUNTERS FOR THE CURRENT
+/ OP CODE AND ADDRESS FIELD SYMBOL
+/
+/THIS IS A MAJOR ROUTINE. IT IS CALLED ONCE
+/FOR EVERY NORMAL (MRI,OPR,IOT) INSTR. COLLECTED.
+/IT IS ALSO CALLED DURING PAGE
+/RECOUNTING, ONCE FOR EVERY ITEM ON THE
+/PAGE TABLE.
+/CALLING SEQ: AC=0,JMS,RET WITH AC=0
+/FUNCTION: DETERMINE THE TYPE OF LINE BEING
+/READ AND SET THE VARIOUS PAGE COUNTERS
+/AND FLAGS ACCORDINGLY.
+/A FLOW CHART OF TYPES & FLAG SETTINGS IS GIVEN BELOW.
+/CONSIDERABLE OVERLAPPING IS USED TO ACHIEVE
+/THE MIN. CORE USAGE. THIS IS SOMETIMES AT THE
+/EXPENSE OF LOGICAL CLARITY.
+/ALL POSSIBLE CONDITIONS EXIT VIA SETC00
+/SETC00:(1) IF LAST INSTR. WAS A SKIP & LAST BANK
+/ IS NOT= CUR.BANK, BANK=-1.
+/ (2) IF CUR. INSTR. IS A SKIP, PGEESC=4
+/ OTHERWISE PGEESC=2.
+/ (3) LASTSKIP CONDITION= CUR. SKIP CONDITION
+/ (4) LAST BANK= CUR. BANK
+/
+/FLOW OF INSTR. TYPES
+/SETCT: IF (PARAMETER OR MICRO-INSTR.) SETC00
+/ IF (LITERAL AFS) SETC02
+/ IF(CONSTANT AFS) SETC01
+/ CALL OBNSYM(AFS)
+/ IF (INSTR. IS INDIRECT) SETC07
+/ IF (AFS IS IN COMMON) SETCO4
+/ IF (ABSOLUTE AFS) SETC05
+/ CALL SPSTB (AFS) /SEARCH PST FOR AFS
+/ CALL SETSUB
+/ IF (AFS NOT BEFORE ON PST) SETC06
+/ IF (AFS WAS IN PST BUT NOT DEF. ON PAGE)SETC12
+/ IF (OP CODE=JMS) BANK=1
+/ GO TO SETC00 /ON PAGE MR1
+/SETC01:IF (CONST.AFS ON PG.0)J2
+/ IF (INSTR. IS INDIRECT) ERROR
+/ CALL SLTAB(CONST. AFS) /PUT CONST. IN LIT.TAB.
+/J1: IF (BANK NOT=1) SETC13
+/ GO TO SETC00
+/ J2* IF( INSTR.INDIR.) J1 /PG.0 INDIRECT
+/ GO TO SETC00 /PG.0 DIRECT
+/SETC04:IF(BANK NOT 0) CALL INCOBA /INC OBACTR
+/ CALL NUMSGN
+/ S0=RESULT+COMMON ADDR.
+/SETC02:CALL SLTAB(S0) /LIT.OR. COMMN. ADDR. TO LIT. TAB.
+/ GO TO SETC00
+/ IF (AFS NOT PREV. ON PST) SETC11
+/ IF (AFS WAS ON PST BUT NOT DEF. ON PAGE) SETC11
+/ GO TO J3
+/SETC10:CALL NUMSGN
+/ IF (ABS.AFS ON PAGE 0) J3
+/SETC11:AC=1 /FORCE BANK=1
+/SETC09:AC=AC+1 /FORCE BANK=0
+/SETC08:AC=AC-2 /FORCE BANK=-1
+/ CALL INCOBA /INC OBACTR
+/ AC=BANK /(BANK OFFSET BY -1)
+/ GO TO SETC13 /(TAKEN CARE OF AT SETC13)
+/SETC12:IF (NEW PST CODE BITS 10-11=OLD SAME (IN TEM 3)) J3
+/SETC06:INC OPSCTR /OFF PAGE SYMBOL
+/J3: IF (BANK=1) SETC00
+/ INC AC
+/ CALL INCOBA
+/J4: IF (THERE HAS NOT BEEN A PST SEARCH) SETC00
+/ ADD CHANGE IN OBACTR (OBACTR-OLDOBA) TO PST CODE BITS 3-9
+/ GO TO SETC00
+/
+/NOTE: CONDITION AT J4 IS TESTED BY SETSUB HEADER
+/WORD (OBFLG). THIS IS ALWAYS CLEARED
+/WHEN SETCT STARTS AND WILL NOT CHANGE
+/UNLESS THERE IS A CALL TO SPSTB BECAUSE
+/A CALL TO SETSUB ALWAYS FOLLOWS CALL TO
+/SPSTB IN SETCT.
+
+
+/
+\fSETCT, 0
+ JMS I ICPLFS /CHECK FOR AND PROCESS ANY LFS
+ DCA OBFLG /CLR
+/NEXT 2 LINES MOVED TO
+/SETCAL (AS OF V15) TO MAKE ROOM FOR FOLLOWING INSTR. & PTR
+/ TAD EXP /IS IT PAR OR A MICRO INST?
+/ TAD UMIC
+ JMS I SETCAP
+ SZA CLA
+ JMP I SET00I /YES
+ CLA CLL CMA RAL
+ TAD AFS
+ SNA /IS AFS A CONSTANT
+ JMP SETC01 /YES
+ IAC
+ SNA CLA /IS AFS A LITERAL
+ JMP I SET02I /YES
+ JMS I OBSYM /NO ... GET POINTERS TO AFS
+ AFS
+ TAD IB /INDIRECT BIT
+ SZA CLA /IS IT SET
+ JMP SETC07 /YES
+ JMS USETST /TEST FOR OFF BANK OR ABSOLUTE
+ SETC04 /OFF BANK
+ SETC05 /ABSOLUTE
+ JMS I SPSTAB /IS AFS ON PST
+ CMA /NOT FOUND
+ JMS SETSUB
+ JMP I SET06I /NO ... MUST BE OFF PAGE
+ TAD I PSTCPR /YES ... PST CODE WORD
+ SMA CLA /IS AFS ON PAGE
+ JMP I SET12I /NO
+ JMP I SET00I
+/
+/ INDIRECT MEMORY REFERANCE INSTRUCTION
+
+SETC07, TAD USE /AFS MST USE WORD
+ AND K20 /IS AFS DUMMY
+ SZA CLA
+ JMP I SET08I /YES
+ JMS USETST /TEST OFF BANK OR ABSOLUTE
+ SETC09 /OFF BANK
+ SETC10 /ABSOLUTE
+ JMS I SPSTAB /IS AFS ON PST
+ CMA /NOT FOUND
+ JMS SETSUB
+ JMP I SET11I /NO
+ TAD I PSTCPR /YES ... PST CODE WORD
+ SMA CLA /IS AFS ON PAGE
+ JMP I SET11I /NO
+ JMP I SET6P1 /YES
+/
+/ CONSTANT FOR AN ADDRESS FIELD SYMBOL
+/
+SETC01, TAD S0 /ACTUAL BINARY CONSTANT
+ AND K7600 /IS CONSTANT ON PAGE ZERO
+ SNA CLA
+ JMP SET01A /YES
+ TAD IB /NO ... IS IT INDIRECT
+ SZA CLA
+ IERROR /YES ... ERROR
+ JMS I SLITAB /IS CONSTANT ON LITERAL TABLE
+ /IF NOT SUBROUTINE PUTS IT THERE
+ TAD OP
+ SPA CLA /IF OPCODE IS JMS OR JMP THEN BANK IS IRRELEVANT
+ JMP I SET00I
+SET01B, CLA CMA
+ TAD BANK /BANK SETTING
+ SNA CLA /IS IT SET TO THE CURRENT BANK
+ JMP I SET00I /YES ... NO PROBLEMS
+ JMP I SET00J /EXIT TO; COMMON AREA
+/
+SET01A, TAD IB /IS INDIRECT BIT SET
+ SZA CLA
+ JMP SET01B /YES
+ JMP I SET00I /NO
+SET00I, SETC00
+SET02I, SETC02
+SET00J, SETC13
+SET00B, JMP I SETCT /OFF PAGE RETURN
+SET06I, SETC06
+SET08I, SETC08
+SET11I, SETC11
+SET12I, SETC12
+SET6P1, SETC6A
+SETCAP, SETCAL
+
+
+/ROUTINE TO TEST MST USE WORD TO DETERMINE WHETHER A SYMBOL IS
+/OFF-BANK OR ABSOLUTE
+
+USETST, 0
+ TAD USE
+ AND K40
+ SZA CLA /IS IT OFF BANK?
+ JMP USESUC /YES- RETURN INDIRECT THROUGH FIRST ARG
+ TAD USE
+ AND K3000
+ ISZ USETST
+ SNA CLA /IS IT ABSOLUTE?
+ JMP USESUC /YES- RETURN INDIRECT THROUGH SECOND ARG
+ ISZ USETST
+ JMP I USETST /NEITHER - RETURN TO CALL+3
+USESUC, TAD I USETST
+ DCA USETST
+ JMP I USETST /TAKE PROPER BRANCH
+
+/
+/SETSUB IS A UTILITY USED BY SETCT ONLY.
+/USED ONLY IMMEDIATELY AFTER A PST SEARCH.
+/CALLING SEQUENCE: JMS SPSTB
+/ CMA /SPSTB MAY SKIP
+/ JMS SETSUB
+/ RETURN IF SPSTB SKIPPED OVER CMA
+/ RETURN IF SPSTB DID NOT SKIP
+/HAS SEVERAL FUNCTIONS:
+/(1) SAVE COPY OF OLD VALUE OF OBACTR BEFORE
+/CHANGING STARTS- SO IT MAY BE USED AT SETC13.
+/(2) IF INSTR IS INDIRECT, THAT'S IT- EXIT
+/(3) OTHERWISE SAVE OLD VALUE OF PST CODE BITS 10-11
+/FOR LATER USE AT SETC12. WARNING: THIS
+/IS SAVED IN TEM3, SO TEM3 IS NOT
+/TEMPORARY FOR A FEW MINUTES.
+/(4) SET PST CODE BIT 10 IF THIS IS A #REF,
+/OR BIT 11 IF IT IS A NORMAL REF.
+/ALGORITHM IS A.OR.B=(.NOT.A.AND.B)+A
+/
+
+SETSUB, 0
+ DCA TEM1 /0=FOUND, -1=NOT
+ TAD OBACTR /SAVE FOR SETC11,12,6,13
+ DCA I OLDOBP
+ TAD IB /OMIT CHANGING PST BITS IF INDIRECT
+ SZA CLA
+ JMP SETSX
+ TAD I PSTCPR /SAVE OLD CODE
+ AND K3
+ DCA TEM3
+ TAD NSGN
+ SZA CLA
+ IAC /#
+ IAC
+ DCA TEM2
+ TAD TEM2 /OR INTO CODE
+ CMA
+ AND I PSTCPR
+ TAD TEM2
+ DCA I PSTCPR
+SETSX, ISZ TEM1 /FOUND?
+ ISZ SETSUB /YES
+ JMP I SETSUB
+
+OLDOBP, OLDOBA
+OBFLG=SETSUB
+
+
+
+/SUBR TO STORE CHARACTER IN LINE BUFFER
+/ASSUMES X1 SET
+/CHAR MAY BE IN AC OR IN CHR
+
+STORE, 0
+ SNA
+ TAD CHR
+ CDF 00
+ DCA I X2
+ CDF 10
+ JMP I STORE
+
+
+/
+/ROUTINE TO CHECK NSGN FOR SETCT
+/USED ONLY BY SETCT ROUTINE.
+/CALLING SEQUENCE: AC=0
+/ JMS NUMSGN
+/ RETURN WITH AC=0 IF
+/ NSGN=0,AC=1 IF NSGN
+/ NOT=0.
+/NOTE:NSGN MAY BE NON-0 AND NOT=1. THIS
+/IS THE REASON FOR NUMSGN.
+/
+
+NUMSGN, 0
+ TAD NSGN
+ SZA CLA
+ IAC
+ JMP I NUMSGN
+\f*5200
+/
+/ AFS ABSOLUTE
+/
+SETC05, JMS I NUMSGP
+ TAD VAL /ABSOLUTE SYMBOL VALUE
+ AND K7600 /MASK OUT PAGE BITS
+ SNA CLA /IS ABSOLUTE SYMBOL ON PAGE ZERO
+ JMP SETC00 /YES ... EXIT
+ JMS I NUMSGP
+ TAD VAL /NO ... ABSOLUTE SYMBOL VALUE
+ DCA S0 /TO LITERAL TABLE SEARCH LOCATION
+ JMS I SLITAB /SEARCH LITERAL TABLE FOR VALUE
+ /IF NOT THERE ROUTINE PLACES IT THERE
+ JMP SETC06+1 /EXIT
+/
+/ INDIRECT ABSOLUTE
+/
+SETC10, JMS I NUMSGP
+ TAD VAL /ACTUAL AFS VALUE
+ AND K7600
+ SNA CLA /IS ADDRESS FIELD SYMBOL ON PAGE ZERO
+ JMP SETC6A /YES
+/
+/ INDIRECT DUMMY ADDRESS FIELD SYMBOL
+/
+SETC08, TAD M2 /SET BANK UNKNOWN
+/
+/ OFF PAGE INDIRECT
+/
+SETC11, IAC /SET BANK TO CURRENT
+/
+/ OFF BANK INDIRECT - SET BANK TO 0
+/
+SETC09,
+ JMS INCOBA /SET BANK & INCR. OBACTR
+ TAD BANK
+ JMP SETC13+1 /EXIT TO COMMON AREA
+/
+
+
+/ ADDRESS FIELD SYMBOL NOT ON PAGE SYMBOL TABLE.
+/
+SETC12, TAD I PSTCPR /HAS NEW TYPE REF BEEN ADDED?
+ AND K3
+ CIA
+ TAD TEM3
+ SZA CLA /YES
+SETC06, ISZ OPSCTR /INCREMENT OFF PAGE SYMBOL COUNTER
+ TAD OP
+ SPA CLA /DON'T WORRY ABOUT BANK FOR JMS'S AND JMP'S
+ JMP SETC00 /WHICH ARE NOT EXPLICITLY INDIRECT
+SETC6A, TAD BANK
+ SMA SZA CLA
+ JMP SETC00 /YES ... EXIT TO COMMON AREA
+SETC13, IAC
+ JMS INCOBA /SET BANK TO CUR. & INC OBACTR
+ TAD I OBFLGP /WAS THERE A PST SEARCH?
+ SNA CLA
+ JMP SETC00 /NO
+ TAD OLDOBA /YES GET CHANGE IN OBACTR
+ CIA
+ TAD OBACTR
+ CLL RTL /IN BITS 1-9
+ TAD I PSTCPR /ADD TO PST CODE
+ DCA I PSTCPR
+/
+/ COMMON AREA
+/
+SETC00, JMS CMNSET /SET BANK=1 AFTER JMS
+ JMS I SETCMN /UPDATE BANK AND LSTSKP
+ SZA CLA /IS CURRENT INSTRUCTION A SKIP?
+ TAD K2 /YES ... PAGE ESCAPE = 4
+ TAD K2 /NO ... PAGE ESCAPE = 2
+ DCA PGEESC
+ JMP I .+1 /RETURN
+ SET00B
+SETCMN, ASMCMN
+
+/ROUTINE TO SET BANK TO CURRENT AFTER A JMS
+CMNSET, 0
+ TAD OP
+ TAD K4000
+ SZA CLA /WAS OP A JMS?
+ JMP I CMNSET /NO
+ IAC
+ DCA BANK
+ JMP I CMNSET
+
+OLDOBA, 0
+OBFLGP, OBFLG
+/
+/ DIRECT OFF BANK REFERANCE
+/
+SETC04, TAD BANK /BANK INDICATOR
+ SZA CLA /IS BANK SET TO OFF
+ JMS INCOBA /NO, SET BANK TO COMMN & INC OBACTR
+ JMS I NUMSGP
+ TAD VAL /YES ... ACTUAL BANK 0 ADDRESS
+ DCA S0 /TO CONSTANT - LITERAL LOCATION
+/
+/ LITERAL FOR AN AFS
+/
+SETC02, JMS I SLITAB /PLACE LITERAL ON LITERAL TABLE
+ JMP I SET1AP
+/
+/ COLLECTION ROUTINE TO CHECK FOR AND PROCESS AN LFS
+/
+/CALLING SEQUENCE: AC=0
+/ JMS CPLFS
+/ RETURN WITH AC=0
+/FUNCTION: USED DURING COLLECTION PHASE
+/ EXCEPT WHEN RECOUNTING A PAGE.
+/ IF TAG OCCURS ON CURRENT LINE, CPLFS
+/ LOCATES (OR ENTERS) IT IN PAGE SYM.TAB.
+/ AND SETS THE DEFINED-ON-PAGE BIT IN
+/ THE PST CODE WORD.
+/ ALSO SETS BANK CONDITION TO UNKNOWN
+/ SINCE USER CODE CAN JUMP TO TAG
+/ FROM ANYWHERE. ALSO SAVE
+/ TAG IN LLFS & RESET LINE COUNT
+/ IN CASE WE GET A MULT.DEF. ERROR
+/ IN PASS1 WE MUST ALSO DO THE
+/ FOLLOWING IF THE SYMBOL IS ALREADY
+/ IN THE PST WHEN WE GO LOOK FOR
+/ IT: (1) REDUCE THE OFF-PAGE SYM.
+/ CTR. BECAUSE OFF-PAGE POINTER (FOR
+/ EITHER NORMAL OR # REFERENCES) ARE
+/ NO LONGER NEEDED. (2) REDUCE
+/ OBACTR BY THE NO. OF EXTRA WORDS
+/ OF CODE DUE TO THIS SYMBOL.
+/SUBRS. CALLED: OBNSYM(LFS),SPSTB,PSTDEF
+/
+CPLFS, 0
+ TAD I RECTI /ARE WE RECOUNTING?
+ SZA CLA
+ JMP I CPLFS /YES ... RETURN
+ TAD LFS
+ SNA
+ JMP I CPLFS /NONE THERE
+ CDF 00
+ DCA I LFSPTR /PLACE ON LFS TABLE
+ ISZ LFSPTR /INCREMENT LFS TABLE POINTER
+ CDF 10
+ ISZ I PTCPR /SET LFS BIT ON PAGE TABLE
+ JMS I OBSYM
+ LFS
+ JMS I SPSTAB /IS IT ON THE PAGE SYMBOL TABLE
+ JMP CPLFS3 /NO ... SKIP DECREMENTING
+ DCA TEM1 /CLR
+ TAD PASS /SKIP DECREMENTING IF PASS 2
+ SNA CLA
+ TAD I PSTCPR /CK USE
+ AND K3
+ CLL RAR
+ SZL
+ ISZ TEM1 /NORMAL
+ SZA CLA
+ ISZ TEM1 /#
+ TAD TEM1 /SUBTRACT
+ CIA
+ TAD OPSCTR
+ DCA OPSCTR
+ TAD I PSTCPR /EXTRACT SHARE OF OBACTR DUE
+ AND C3774 /TO THIS SYMBOL
+ CLL RTR /MOVE TO LOW ORDER
+ CIA /SUB. FROM OBACTR
+ TAD OBACTR
+ DCA OBACTR
+CPLFS3, JMS I PSTDEP
+ CLA CMA CLL /SET BANK UNKNOWN (THE CLL IS USED ELSEWHERE)
+ DCA BANK
+ TAD LFS /SAVE IN CASE OF ERROR
+ DCA LLFS
+ DCA LINE /ZERO LINE COUNT FROM LAST LFS
+ JMP I CPLFS
+C3774, 3774
+NUMSGP, NUMSGN
+PSTDEP, PSTDEF
+LLFS, 0
+
+
+/
+/UTILITY FOR SETC04,SETC08,SETC13
+/NOT USED ELSEWHERE
+/CALLING SEQUENCE: DESIRED BANK SETTING IN AC
+/ JMS INCOBA
+/ RETURN WITH AC=0
+/FUNCTION:(1) SET BANK AS SPECIFIED
+/ (2) INCREMENT OFF-BANK ADDITION CTR
+/ BY 1 OR 2: 2 IF PREVIOUS INSTR.
+/ WAS A SKIP-TYPE, 1 OTHERWISE.
+/
+INCOBA, 0
+ DCA BANK
+ TAD LSTSKP /LAST INSTRUCTION SKIP INDICATOR
+ SZA CLA /WAS LAST INSTRUCTION A SKIP INSTRUCTION
+ ISZ OBACTR /+ OLD VALUE OF OFF BANK ADDITION COUNTER
+ ISZ OBACTR /FOR NEW VALUE OF OFF BANK ADDITION COUNTER
+ JMP I INCOBA
+SET1AP, SET01A
+\f*5400
+/
+/ ROUTINE TO ASSEMBLE THE PAGE HELD IN THE CURRENT SET OF TABLES
+
+/THIS IS THE MAIN PASS1 ASSEMBLY ROUTINE
+/(NOT USED BY PASS2)
+/ASMBL GOES THRU ENTIRE PAGE TABLE
+/FLOW: (1) CALL A1 TO INIT. PAGE ASSEMBLY
+/ (2) GET ITEM OFF P.T.
+/ (3) CALL ASM02 TO ASSEMBLE ITEM
+/ (4) LOOP BACK TO (2) TIL DONE WITH PAGE
+/ (5) CALL A2 TO ASM. LITERALS
+/ASMBL IS CALLED TWICE BY L55 FOR
+/EACH PAGE OF CODE.
+/
+ASMBL, 0
+ JMS A1
+ JMS I ILC4PT /OUTPUT PAGE ORIGIN
+ JMS I INIS /DO INITS.
+ TAD PTSZE /PLACE - SIZE OF PAGE TABLE
+ CIA
+ DCA INDX1 /IN AN INDEX LOCATION
+ TAD LFSBSE /SET UP LFS TABLE POINTER
+ DCA LFSPTR
+ CLA CMA
+ DCA PHASE /SET PHASE SWITCH TO ASSEMBLY
+ JMS I ASM02I /SKIP INCREMENTING POINTERS THE FIRST TIME
+ JMS I ISSI /INCREMENT PAGE TABLE POINTERS
+ ISZ INDX1 /OVER YET
+ JMP .-3
+ JMS A2
+ JMP I ASMBL
+ISSI, ISZPT
+
+
+/
+/ASSEMBLY ROUTINE TO FINISH OFF A PAGE
+/(1) PUTS OUT PAGE ESCAPE
+/(2) LITERAL POOL (BY CALLING OAPLT)
+/(3) GET READY FOR NEXT PAGE
+/
+A2, 0
+ JMS I SAVLNP /STOP NEXT LINE LISTING
+ TAD APMSW /ARE WE IN AUTOMATIC PAGING MODE
+ SZA CLA
+ JMP A2NONA /NO ... DONT SEND PAGE ESCAPE
+ TAD PGEESC /SIZE OF PAGE ESCAPE REQUIRED
+ RTR /2 BIT TO LINK
+ SZL CLA
+ JMP ASM01A /2 INSTRUCTION PAGE ESCAPE
+ /4 INSTRUCTION PAGE ESCAPE
+ JMS I WRITEP
+ JMS I OUTBIN /JMP NEXT TO LAST LOC ON THIS PAGE
+ K5376
+ 0
+ ISZ ILC /FOR BENEFIT OF "WRITE"
+ CLA CMA
+ JMS A2SUBR /OUTPUT JMP AND LITERAL TABLE
+ JMS I OUTSKP /OUTPUT 2 SKIP INSTRUCTIONS
+ JMS I OUTSKP
+ JMP ASM01B /RETURN
+/
+ASM01A, JMS A2SUBR /OUTPUT JMP AND LITERAL TABLE
+ JMS I WRITEP
+ JMS I OUTBIN /PLACE A NOP IN THE LAST LOCATION
+ K7000
+ 0
+ASM01B, JMS I RELNP /RESTORE NEXT LINE FOR LISTING
+ TAD ACTR /REMAINS 1 DURING PASS 2
+ SZA CLA
+ JMP I A2 /EXIT IF LISTING OR 2ND ASSEMBLY
+ TAD PUPGE /SAVE ESCAPE ON PUSH DOWN LIST
+ CDF 00
+ DCA I PEPTR
+ CDF 10
+ ISZ PEPTR /MOVE STACK PTR
+ JMP I A2 /RETURN
+
+A2NONA, JMS I OUAPLT
+ DCA PUPGE /CLR
+ JMP ASM01B
+
+/SUBROUTINE TO ELIMINATE SOME COMMON CODE
+/
+A2SUBR, 0
+ TAD K177
+ TAD PAG
+ DCA A2TEMP /SET ILC IN CASE NO LITERALS
+ JMS I WRITEP
+ JMS I OUTBIN
+ K5377
+ 0
+ JMS I OUAPLT /OUTPUT LITERAL TABLE
+ TAD A2TEMP
+ DCA ILC /SET ILC TO 176 OR 177 IN PAGE
+ JMS I ILC4PT
+ JMP I A2SUBR /RETURN
+A2TEMP, 0
+
+
+ILC4PT, ILC4
+ASM02I, ASM02
+INDX1, 0
+INIS, INISUB
+OUAPLT, OAPLT
+SAVLNP, SAVLIN
+RELNP, RELINE
+PEPTR, PEBSE
+REDUCE, 0
+CDFSKP, JMS CDFSK
+
+
+/
+/INITIALIZE A PAGE ASSEMBLY
+/
+A1, 0
+ TAD PAG /MOVE PAGE TO ILC
+ DCA ILC
+ DCA LITSIZ /ZERO LITERAL TABLE SIZE
+ TAD PASS
+ SNA CLA
+ JMP I A1 /EXIT IF PASS 1
+ CDF 00
+ TAD I PEPTR /GET NEXT PAGE ESC FROM STACK
+ CDF 10
+ ISZ PEPTR /MOVE PTR
+ DCA REDUCE
+ JMP I A1
+/
+/ DUMMY PSEUDO OP
+/
+PDUMMY, JMS I GETSYM /GET NEXT INPUT ITEM
+ SKP /NOTHING THERE
+ JMP .+3 /SYMTOL
+ NOP /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ TAD USE /MST USE WORD
+ AND K3403 /SAVE SYMBOL LENGTH, TYPE BITS, AND DEF BIT
+ TAD K20 /ADD CORRECT MST BIT FOR DUMMY
+ DCA USE /FOR CORRECT CODE WORD
+ JMP I NULLP /EXIT TO GET NEXT LINE
+K3403, 3403
+
+
+/
+/COMPUTE CURRENT PAGE SIZE
+/ENTER WITH AC=0
+/EXIT WITH PAGE SIZE IN AC
+/
+CPGES, 0
+ TAD APMSW /OMIT PGEESC IF NON-AUTO PAGING
+ SNA CLA
+ TAD PGEESC /+SIZE OF ESCAPE REQUIRED
+ TAD PTSZE /SIZE OF PAGE TABLE
+ TAD LTSZE /+SIZE OF LITERAL TABLE
+ TAD OPSCTR /+OFF PAGE SYMBOL COUNTER
+ TAD OBACTR /+OFF BANK ADDITION COUNTER
+ DCA PSTDEF /STORE IN TEM.
+ TAD PSTDEF /GET IT BACK
+ TAD PAG /AND CHECK FOR 7600 PAGE OVERFLOW
+ AND K7600
+ TAD K200
+ SNA CLA
+ SERROR /OVERFLOW-ERROR S
+ TAD PSTDEF /O.K. GET PAGE SIZE, WHICH
+ JMP I CPGES /IS DESIRED RESULT
+
+
+/ROUTINE TO SET DEFINED BIT ON PST
+/USED BY CPLFS & ANUMCK
+
+PSTDEF, 0
+ TAD I PSTCPR /PROTECT CODES
+ SMA
+ TAD K4000 /SET DEFINED BIT ON PST
+ DCA I PSTCPR
+ JMP I PSTDEF
+\f*5600
+/
+/ CONSTANT FOR AN ADDRESS FIELD SYMBOL
+/
+ASM05, TAD I PTSPR /ACTUAL BINARY CONSTANT
+ AND K7600 /IS IT ON PAGE ZERO
+ SZA CLA
+ JMP I ASM5CI /NO
+ TAD I PTSPR /ADD IN PAGE ZERO ADDRESS
+ DCA TEMP6
+ TAD I PTCPR /YES ... IS IT INDIRECT
+ AND K400
+ SNA CLA
+ JMP ASM00 /EXIT TO COMMON AREA
+ TAD TEMP6
+ JMP I ASM5AI
+ASM5AI, ASM12E
+ASM5CI, ASM05C
+/
+/ OFF BANK DIRECT (COMMON DIRECT)
+/
+ASM08, JMS I NSCHKP
+ TAD VAL /ACTUAL ADDRESS IN BANK ZERO
+ DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+ CLA IAC
+ DCA S0 /ABSOLUTE SEARCH
+ JMS I SERALP /GET A PAGE ADDRESS
+ TAD K400 /ADD INDIRECT BIT
+ DCA TEMP6
+ TAD BANK /BANK INDICATOR
+ SNA CLA /IS IT SET
+ JMP ASM00
+ DCA I ASMX5I
+ TAD KCDF1A
+ DCA I ASMX4I
+ TAD CDZSKI
+ DCA I ASMX6I
+ DCA TEM7
+ JMP I ASME7I
+ASMX5I, ASMX5
+ASMX4I, ASMX4
+KCDF1A, KCDF10
+ASMX6I, ASMX6
+ASME7I, ASME7
+CDZSKI, CDZSKP
+SERALP, SRALT
+NSCHKP, NSCHK
+
+/
+/ASM02 IS THE HEART OF ASSEMBLY
+/IT IS CALLED ONCE FOR EACH ITEM ON
+/THE PAGE TABLE.
+/IT CONSISTS OF MANY PARTS, ONE FOR
+/EACH BASIC TYPE OF INSTR. TO BE
+/ASSEMBLED PLUS VARIOUS COMMON EXITS
+/
+ASM02, 0
+ DCA LFS /ZERO LFS INDICATOR
+ TAD PASS
+ SZA CLA
+ JMS I GETBAP /RESTORE BANK & LSTSKP IF PASS2
+ JMS I LFSCHK /PROCESS LFS IF ANY
+ JMS I ANCHK /PROCESS BSS 0 IF ANY
+KCDF00, CDF 00
+ TAD I PTOPR
+KCDF10, CDF 10
+ DCA OP
+ TAD I PTCPR
+ AND K40 /IS IT A SKIP INSTRUCTION
+ DCA CURSKP /YES ... SET SKIP INDICATOR
+ TAD I PTCPR
+ AND K10 /IS IT A PSEUDO OP (PAR)
+ SZA CLA
+ JMP I ASM03I /YES ... EXIT
+ TAD I PTCPR
+ AND K4 /IS IT A MEMORY REFERANCE INSTRUCTION
+ SZA CLA
+ JMP ASME1 /NO
+ TAD I PTCPR /PT CODE WORD
+ AND K20 /IS AFS A CONSTANT
+ SZA CLA
+ JMP ASM05 /YES
+ TAD I PTCPR /PT CODE WORD
+ AND K2 /IS AFS A LITERAL
+ SZA CLA
+ JMP I ASM06I /YES
+ TAD I PTSPR /AFS ID WORD FOR SYMBOL TABLE
+ DCA AFS /TO DIRECTLY ADDRESSABLE LOCATION
+ JMS I OBSYM /GET ITS POINTERS TO MST
+ AFS
+ TAD I PTCPR /PT CODE WORD
+ AND K400 /IS OP INDIRECT
+ SZA CLA
+ JMP I ASM2AI /YES
+ JMS I UZTST /TEST FOR OFF BANK OR ABSOLUTE
+ ASM08 /OFF BANK
+ ASM09 /ABSOLUTE
+ JMP I ASM07I /NO
+ASM2AI, ASM02A
+ASM03I, PPAR1
+ASM06I, ASM06
+ASM07I, ASM07
+ANCHK, ANUMCK
+UZTST, USETST
+/
+/ END OF LINE NECESSITIES
+/
+ASM00, TAD TEMP6
+ASME1, TAD OP
+ASME2, DCA TEM1
+ JMS I WRITEP
+ JMS I OUTBIN
+ TEM1
+ASME1X, 0
+ASM01, JMS I CMNASM /SET BANK=1 AFTER A JMS
+ JMS ASMCMN /SET BANK AND LSTSKP
+ DCA SKPSAV /SAVE CURSKP IN SKPSAV
+ TAD BANK /SAVE FOR PROTECTION DURING LISTING
+ DCA BNKSAV
+ ISZ ILC /INCREMENT ILC
+ASM02R, JMP I ASM02 /USED AS OFF-PAGE RETURN
+ SERROR /ILC OVERFLOWED 7777 - PROGRAM TOO BIG
+CMNASM, CMNSET
+GETBAP, GETBAS
+BNKSAV, 0
+SKPSAV, 0
+OPISUB, JMS OPIS
+OBISUB, JMS OBIS
+
+/SUBROUTINE TO UPDATE BANK,LSTSKP,LSTBNK
+/
+ASMCMN, 0
+ TAD LSTSKP /IS LAST INSTRUCTION A SKIP INSTRUCTION
+ SNA CLA
+ JMP .+10 /NO
+ TAD LSTBNK /YES ... LAST BANK
+ CIA
+ TAD BANK /+CURRENT BANK
+ SNA CLA /ARE THEY THE SAME
+ JMP .+3 /YES
+ CLA CMA /NO ... SET BANK UNKNOWN
+ DCA BANK
+ TAD CURSKP /PLACE CUR SKIP INDICATOR
+ DCA LSTSKP /AS LAST SKIP INDICATOR
+ TAD BANK /PLACE CURRENT BANK
+ DCA LSTBNK /IN LAST BANK INDICATOR
+ TAD LSTSKP
+ JMP I ASMCMN
+\f*6000
+/
+/
+/ INDIRECT DUMMY ARGUMENT
+/
+ DUMSUB
+ASM10, TAD I .-1
+ DCA TEMP6
+ CLA CMA /SET BANK UNKNOWN
+ JMP ASME3 /EXIT FOR SKIP CHECK
+/
+/ OFF BANK INDIRECT (INDIRECT COMMON)
+/
+ OBISUB
+ASM11, TAD I .-1
+ DCA TEMP6
+/
+
+TEMP6=EXP
+ASME3, DCA BANK /SET C(AC) IN BANK
+ TAD LSTSKP /WAS LAST A SKIP?
+ SNA CLA
+ JMP ASME4 /NO
+//FOLLOWING 6 LINES HAVE BEEN
+//MOVED TO 6600 TO MAKE ROOM FOR V03
+ JMP I .+1
+ ASMEXT
+// JMS I OUTSKP /YES, OUTPUT SKP
+// TAD ILC /GET PG.LOC.PTR.
+// TAD K4 /+4
+// AND K177
+// TAD K5200A /OUTPUT JMP .+4
+// DCA TEM1
+REEASM, JMS I WRITEP
+ JMS I OUTBIN
+ TEM1
+ 0
+ ISZ ILC /INCREMENT PG.LOC.PTR.
+ASME4, JMS I WRITEP
+ JMS I OUTBIN /OUTPUT JMS TO
+ TEMP6 /OBISUB,OPISUB, OR DUMSUB
+ 0
+ ISZ ILC
+ JMS I ASM10B /PPAR3S
+ ISZ ILC
+ TAD OP
+ TAD K407
+ JMP I ASME2P
+ASME2P, ASME2
+ASM02A, TAD USE /AFS MST USE WORD
+ AND K20 /IS AFS A DUMMY ARGUMENT
+ SZA CLA
+ JMP ASM10 /YES
+ JMS I UZETST /TEST FOR OFF-BANK OR ABSOLUTE
+ ASM11 /OFF-BANK
+ ASM12 /ABSOLUTE
+ JMP I ASM13I /NO
+ASM10B, PPAR3S
+ASM13I, ASM13
+K407, 0407
+ASME5A, TAD OP
+ SPA CLA /BANK NEED NOT BE CURRENT FOR A JMP OR JMS
+ JMP ASME6+2 /WHICH IS NOT EXPLICITLY INDIRECT
+ASME5, TAD BANK
+ SMA SZA CLA
+ JMP ASME6+2
+ASME7, TAD LSTSKP
+ SZA CLA
+ JMP .+7
+ JMS I WRITEP
+ JMS I OUTBIN
+ASMX4, KCDF00
+ASMX5, 5
+ ISZ ILC
+ JMP ASME6
+ JMS I WRITEP
+ JMS I OUTBIN
+ASMX6, CDFSKP
+ 0
+ ISZ ILC
+ JMS I OUTSKP
+ASME6, TAD TEM7
+ DCA BANK
+ TAD K5
+ DCA ASMX5
+ TAD KCDFA
+ DCA ASMX4
+ TAD CDFSKI
+ DCA ASMX6
+ IAC
+ DCA TEM7
+ JMP I .+1
+ ASM00
+CDFSKI, CDFSKP
+ASME1I, ASME1
+KCDFA, KCDF00
+UZETST, USETST
+
+/
+/ SYMBOL TABLE TYPEOUT FLAG TYPEOUT ROUTINE
+
+/CALL SEQ.: TAD USE /GET TYPE BITS
+/ RTL
+/ RTL
+/ JMS STFT
+/ RETURN
+/USED ONLY BY PRSYM
+/
+STFT, 0
+ AND K3 /MASK OUT TYPE BITS
+ SNA
+ JMP STFT3 /ABSOLUTE SYM.
+ TAD M3 /CK FOR NEW OPDEF
+ SNA
+ JMP STFT2 /YES
+ IAC
+ SNA
+ JMP STFT5 /EXTERNAL
+ SZL CLA
+ JMP STFT1 /DEFINED
+ TAD K2516 /"UN"
+ JMS I CTYPE
+ TAD K0406 /"DF"
+STFT0, JMS I CTYPE /TYPE FLAG
+STFT1, CLA /WE MUST HAVE A CLEAR AC
+ JMP I STFT /RETURN
+K2560, 2560
+K1720, 1720
+
+STFT2, TAD K1720 /TYPE "OP"
+ JMP STFT0
+STFT3, TAD USE
+ AND K40
+ SZA CLA
+ JMP STFT4 /COMMON
+ TAD K0102 /"AB"
+ JMS I CTYPE
+ TAD K2300 /"S "
+ JMP STFT0
+STFT4, TAD K0317 /"CO"
+ JMS I CTYPE
+ TAD K1500 /"M "
+ JMP STFT0
+
+K0102, 102
+K0317, 317
+K2300, 2300
+K1500, 1500
+K2516, 2516
+K0406, 406
+K0530, 530
+K2400=SLITAB
+
+STFT5, TAD K0530 /"EX"
+ JMS I CTYPE
+ TAD K2400
+ JMP STFT0
+\f*6200
+/
+/ LOCAL DIRECT REFERANCE
+/
+ASM07, JMS I SPSTAB /IS AFS ON PST
+ JMP ASM07A /NO ... ROUTINE PLACES IT THERE
+ TAD I PSTCPR /PST CODE WORD
+ SMA CLA /IS SYMBOL ON PAGE
+ JMP ASM07A /NO
+ JMS NSCHK
+ TAD VAL /AFS MST VALUE
+ AND K177 /SAVE PAGE ADDRESS
+ TAD K200 /ADD PAGE BIT
+ JMP I AS00I4 /
+ASM07A, TAD I PTSPR /ACTUAL SYMBOL
+ DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+ JMS NSCHK
+ CLL RTL
+ TAD K2 /RELOCATABLE SEARCH
+ JMP ASM05C+3
+ASM09B, JMS NSCHK
+ TAD VAL /DIRECT NON-PAGE 0 ABSOLUTE
+ SKP
+/
+/
+/ NON PAGE ZERO CONSTANT ADDRESS
+/
+ASM05C, TAD I PTSPR /ACTUAL BINARY CONSTANT
+ DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+ CLA IAC
+ DCA S0 /ABSOLUTE SEARCH
+ JMS I SERALT /GET A PAGE ADDRESS
+ TAD K400 /ADD INDIRECT BIT
+ DCA TEMP6
+ JMP I .+1
+ ASME5A /EXIT FOR SKIP CHECK IF OP IS NOT JMP OR JMS
+/
+/ DIRECT ABSOLUTE OR EXTERNAL
+/
+ASM09, JMS NSCHK
+ TAD VAL /ABSOLUTE SYMBOL VALUE
+ AND K7600 /IS SYMBOL ON PAGE ZERO
+ SZA CLA
+ JMP ASM09B /NO
+ JMS NSCHK
+ TAD VAL /ADD IN PAGE ZERO ADDRESS
+ JMP I AS00I4 /
+AS00II, ASME5
+/
+/ LITERAL FOR AN ADDRESS FIELD SYMBOL
+/
+ASM06, TAD I PTSPR /ACTUAL LITERAL
+ DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+ CLA IAC
+ DCA S0 /ABSOLUTE SEARCH
+ JMS I SERALT /GET A PAGE ADDRESS
+ JMP I AS00I4 /EXIT FOR SKIP CHECK
+AS00I4, ASM05+5
+OUTSK, 0
+ JMS I WRITEP
+ JMS I OUTBIN
+ K7410
+ 0
+ ISZ ILC
+ JMP I OUTSK
+SERALT, SRALT
+/
+/ INDIRECT ABSOLUTE
+/
+ASM12, TAD VAL /AFS MST USE WORD
+ AND K7600 /IS IT ON PAGE ZERO
+ SZA CLA
+ JMP ASM12F /NO
+/
+/ INDIRECT PAGE ZERO ABSOLUTE SYMBOL
+/
+ JMS NSCHK
+ TAD VAL /SAVE PAGE ZERO ADDRESS
+ASM12E, TAD K400 /ADD INDIRECT BIT
+ DCA TEMP6
+ JMP I AS00II
+/
+/ INDIRECT NON PAGE ZERO ABSOLUTE SYMBOL
+/
+ OPISUB
+ASM12F, TAD I .-1
+ DCA TEMP6
+ TAD BANK
+ JMP I AS00I3 /EXIT FOR SKIP CHECK
+AS00I3, ASME3
+K5377, 5377
+/
+/ LOCAL INDIRECT REFERANCE
+/
+ASM13, JMS I SPSTAB /IS AFS ON PST
+ JMP ASM14 /NO ... MUST BE OFF PAGE
+ TAD I PSTCPR /YES ... PST CODE WORD
+ SMA CLA /IS AFS ON PAGE
+ JMP ASM14 /NO
+ JMS NSCHK
+ TAD VAL /AFS VALUE FROM MST
+ AND K177 /SAVE PAGE DISPLACEMENT
+ TAD K600 /ADD PAGE AND INDIRECT BIT
+ DCA TEMP6 /SAVE
+ JMP I AS00II /GO OUTPUT INSTRUCTION
+/
+/ OFF PAGE INDIRECT
+/
+ OPISUB
+ASM14, TAD I .-1
+ DCA TEMP6
+ CLA IAC /SET BANK TO CURRENT
+ JMP I AS00I3 /EXIT FOR SKIP CHECK
+NSCHK, 0
+ TAD I PTCPR
+ AND K2000
+ SZA CLA
+ IAC /ITS A #
+ JMP I NSCHK
+
+
+/"IF" - CONDITIONAL ASSEMBLY PSUEDO-OP
+
+PIF, JMS I GETSYM
+ JMP PIFERR /NOTHING THERE
+ JMP .+3 /SYM
+ NOP /CON
+ JMP PIFERR /LIT
+ TAD CHR /CK FOR COMMA
+ TAD M254
+ SZA CLA
+ IERROR /NOT A COMMA
+ ISZ X0 /PREVENT FLAGGING COMMA
+ JMS I GETSYM /YES, SET CTR TO SKIP N LINES
+ NOP
+ SKP
+ SKP /I WANT A NUMBER
+PIFERR, IERROR
+ TAD USE /IS SYMBOL DEFINED?
+ AND K400
+ SZA CLA
+ DCA S0 /YES, CONTINUE NORMAL ASSMBLY
+ JMS I SKIPL
+ TAD S0 /GET THE NUM.
+ CIA
+ DCA IFCTR
+ JMP I NULLP
+
+IFCTR, 0
+
+ILC4, 0
+ JMS I OUTBIN
+ ILC
+ 4
+ JMP I ILC4
+
+
+/LAP & EAP PSUEDO-OPS
+
+*6372 /MUST BE AT 6372 OR AT PAGE BOUND. +172 FOR K5376 TO WORK AS SKIP
+PLAP, JMS I SKIPL
+ IAC /LEAVE AUTO-PAGING MODE
+K5376, 5376 /THIS REPLACES A SKIP.*******DO NOT MOVE********
+PEAP, JMS I SKIPL
+ DCA APMSW /ENTER AUTO-PAGING MODE
+ JMP I NULLP
+
+\f *6400
+LISTON, 1411
+ 2324
+ 1116
+ 0700
+ 1716
+ 0000
+HISP, 1011
+ 0710
+ 0023
+ 2005
+ 0504
+ 0020
+ 2516
+ 0310
+ 7700
+RDER, 0022
+ 0501
+ 0405
+ 2277
+ 0000
+ / PART OF MAIN PROGRAM
+ / RECOUNT ROUTINE
+ /FOLLOWING CODE CLEANS UP PST CODES BEFORE RECOUNTING
+CLNPST, CIA
+ DCA IOINIT /SET COUNTER
+ TAD PSTBSE
+ IAC
+ DCA PSTCPR /CODE POINTER
+ TAD I PSTCPR /LOOP
+ AND K4003K /KILL OBAC DUE TO THIS SYM.
+ DCA I PSTCPR
+ ISZ PSTCPR /MOVE PTR
+ ISZ PSTCPR
+ ISZ IOINIT
+ JMP .-6 /NOT DONE
+ JMP I .+1
+ RECRET
+ K4003K, 4003
+/
+/
+/COMMON EXIT FOR DATA-GENERATING PSUEDO-OPS
+/
+POPEX, DCA BSSSW
+ TAD LFS /CK FOR TAG
+ SNA CLA
+ JMP I DCIL1 /NO TAG
+ CMA /DECREMENT PTSZE
+ TAD PTSZE
+ DCA PTSZE
+ JMS I RECTI /YES RECOUNT THE PAGE
+ ISZ PTSZE /RESTORE PTSZE
+ JMS I ISZPTX /RESTORE PT PTRS
+ JMP I DCIL1 /RETURN FOR NEXT LINE
+ISZPTX, ISZPT
+
+
+
+/ROUTINE T0 INITIALIZE I/O DEVICES
+
+C2=JMS I CTYPE
+
+IOINIT, 0
+ CDF 10
+ TAD JL64
+ DCA TYPE
+VN, JMP I VERSI
+IOI, JMS I CRLF
+ TAD JHISP
+ DCA X1
+ TAD M5
+ JMS QUERY
+ JMP RGO
+ TAD JRDER
+ DCA X1
+ TAD M5
+ JMS QUERY
+ JMP RGO
+RGO, JMS KSR
+ TAD JHSR
+ TAD JASR
+ DCA I INDEVP
+ JMS I CRLF
+ TAD JHISP
+ DCA X1
+ TAD M11
+ JMS QUERY
+ NOP
+ JMS KSR
+ JMP .+4
+ TAD TYPE
+ DCA PUNCH
+ JMP IOX
+ TAD JL63
+ DCA PUNCH
+ JMS I CRLF
+ TAD JLIST
+ DCA X1
+ TAD M17
+ JMS QUERY
+ NOP
+ JMS KSR
+ IAC /1 = PUNCH, 0 = TYPE
+IOX, DCA LSTDEV
+ JMP I IOINIT
+
+
+
+QUERY, 0
+ DCA JCOUNT
+ TAD I X1
+ C2
+ KSF
+ SKP
+ JMP I QUERY
+ ISZ JCOUNT
+ JMP .-6
+ ISZ QUERY
+ JMP I QUERY
+KSR, 0
+ KSF
+ JMP .-1
+ KRB
+ DCA TEM1
+ TAD TEM1
+ JMS I TYPE
+ TAD TEM1
+ TAD M331
+ SZA CLA /0="YES"
+ ISZ KSR /NOT "YES"
+ JMP I KSR
+LSTDEV=QUERY
+M331, -331
+JHSR, HSR-ASR
+JASR, ASR
+INDEVP, INDEV
+JL63, L63
+JL64, L64
+JCOUNT=TEM3
+JHISP, HISP-1
+JLIST, LISTON-1
+JRDER, RDER-1
+VERSI, VERNUM
+M5, -5
+M11, -11
+M17, -17
+
+\f*6600
+//
+//PART OF MAIN PROGRAM MOVED FOR V03
+//
+/ROUTINE TO RESTORE BANK AND LSTSKP FOR PASS2
+/WILL NOT FIT INTO ASM02 WHERE IT BELONGS
+
+GETBAS, 0
+ TAD I BNKSAP
+ DCA BANK
+ TAD I SKPSAP
+ DCA LSTSKP
+ JMP I GETBAS
+
+BNKSAP, BNKSAV
+SKPSAP, SKPSAV
+
+/INPUT ROUTINES
+
+HSR, 0
+ DCA TEM10 /CLR TIMER
+ RFC
+HSR1, RSF
+ JMP HSR2
+ RRB
+ JMP I HSR
+HSR2, DCA ASR /WASTE SOME TIME
+ ISZ TEM10 /CK TIMER
+ JMP HSR1 /KEEP TRYING
+REXIT, TAD X3 /CK FOR EMPTY BUFFER
+ TAD BUFBEG
+ SZA CLA
+ JMP .+4 /NO, WE HAVE A PARTIAL BUFFER
+ CDF 10
+ JMP I .+1 /YES TAPE HAS ENDED WITH NO END STATMT
+ ERRE
+ DCA I X3 /FILL END OF BUFFER WITH 0'S
+ TAD X3
+ TAD BUFEN
+ SZA CLA
+ JMP .-4
+ JMP I RG3P /NOW RET. FOR PROCESSING
+
+ASR, 0
+ TAD M50
+ DCA TEM11
+ DCA TEM10
+ASR1, KSF
+ JMP ASR2
+ KRB
+ JMP I ASR
+ASR2, ISZ TEM10
+ JMP ASR1
+ ISZ TEM11
+ JMP ASR1-1
+ JMP REXIT
+
+
+M50, -50
+TEM10, 0
+TEM11, 0
+BUFBEG, 1-DATA
+RG3P, RG3
+BUFEN, 1-LINBUF
+/
+/ ENTRY PSEUDO OPERATION
+/
+PENTRY, JMS I GETSYM /GET NEXT INPUT ITEM
+ SKP /NOTHING THERE
+ JMP .+3 /SYMBOL
+ NOP /CONSTANT
+ IERROR /LITERAL
+ JMS I SKIPL
+ JMS I SREST /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
+ CLA
+ TAD USE /AFS MST USE WORD
+ AND K403 /SAVE SYMBOL LENGTH (& DEF. BIT FOR PASS 2)
+ TAD K2220 /ADD IN PROPER BITS
+ DCA USE /FOR NEW MST USE WORD
+ JMP I NULLP /EXIT FOR NEXT LINE
+K2220, 2220
+K403, 403
+/
+/
+/
+/INCREMENT PAGE TABLE POINTERS
+/
+ISZPT, 0
+ ISZ PTCPR /INCREMENT PAGE TABLE CODE POINTER BY 2
+ ISZ PTCPR
+ ISZ PTSPR /INCREMENT PAGE TABLE SYMBOL POINTER BY 2
+ ISZ PTSPR
+ ISZ PTOPR /INCREMENT PT OP CODE POINTER
+ JMP I ISZPT
+/
+/CK CONSTANT FOR BLOCK PSEUDO-OP
+/
+PBSS4, TAD APMSW /AUTOMATIC PAGING?
+ SNA CLA
+ TAD K2 /YES, 176 IS MAXIMUM
+ TAD M200 /NO, 200 IS MAX
+ TAD S0 /CHECK CONSTANT
+ SMA SZA CLA
+ IERROR /TOO BIG
+ TAD S0 /IS CONSTANT 0?
+ SNA
+ JMP I PBSS2J /YES, EQUIVALENCE TAG
+ JMP I PBSS5I /NO, CREATE BLOCK OF THIS SIZE
+PBSS2J, PBSS2
+PBSS5I, PBSS5
+
+/
+/PATCH TO DELETE DEFINED BIT IN PST FOR A TAG
+/EQUIVALENCED TO A LINE THAT OVERFLOWED THE PAGE
+/
+EQVFIX, TAD EQVBIT /WAS THERE SUCH A TAG?
+ SNA CLA
+ JMP I L55CP /NO
+ TAD I EQVBIT /YES, GET PST CODE FOR THIS TAG
+ TAD K4000 /CANCEL DEFINED BIT
+ DCA I EQVBIT
+ TAD K200 /SET EQUIVALENCE BIT FOR NEXT LINE
+ DCA EQVBIT /WHEN NEXT PAGE GETS GOING
+ JMP I L55CP /RETURN TO ASSEMBLE THE PAGE WE HAVE
+L55CP, L55C
+
+
+/
+/CK FOR TYPE OF SYMBOL
+/CALL SEQ: JMS WHATYP
+/ RET. IF USER SYMBOL
+/ RET. IF OP SYMBOL
+/
+WHATYP, 0
+ TAD USE
+ AND K3000
+ TAD M3000
+ SNA CLA
+ ISZ WHATYP
+ JMP I WHATYP
+
+
+/
+/EXECUTE ISZ GTSYM (MOVE RETURN POINTER) ONLY IF IFCTR .GE. 0
+/OTHERWISE MOVE LINE PTR TO NEXT SLASH, SEMI-COLON OR CAR.RET.
+/& ISZ IFCTR & TREAT AS A NULL LINE.
+/
+CKIF, 0
+ TAD I IFCT /IS CONDITIONAL NON-ASM IN EFFECT?
+ SPA CLA
+ JMP .+3 /YES: DO NOT ASMBL LINE
+ ISZ I GETSYM /NO, MOVE RETRN PTR & CONT. AS USUAL
+ JMP I CKIF
+ ISZ I IFCT /COUNT IGNORED LINE
+ NOP
+ TAD CHR /MOVE LINE PTR TO END OF LINE
+CKIF2, SNA
+ JMP CKIF3 /FOUND A CR
+ TAD M257
+ SNA
+ JMP CKIF3 /SLASH
+ TAD M14
+ SNA CLA
+ JMP CKIF3 /SEMI-COLON
+ JMS I GETCHR /TRY NEXT
+ JMP CKIF2
+CKIF3, JMP I .+1
+ ITM15
+M257, -257
+M14, -14
+IFCT, IFCTR
+\f*6776
+
+/PAGE SYMBOL TABLE (200 WORDS)
+/DOUBLE WORD ENTRIES
+/REBUILT FOR EACH CORE PAGE OF CODE
+/EVERY SYMBOL DEFINED OR REFERENCED ON
+/GIVEN PAGE IS ENTERED
+/TYPICAL ENTRY*: WD1=SYMBOL ID
+/ WD2=CODE BITS
+/SYMBOL ID=ADDRESS OF SYMBOL ENTRY IN MAIN SYM. TAB
+/CODE: BIT0=1 IF SYM. DEF. ON CUR. PAGE
+/ BIT11=1 IF SYM REFERENCED NORMALLY BY A MR1 ON THE PG.
+/ BIT10=1 IF SYM. REF'D. WITH A #
+/ BITS 1-9 USED FOR COUNTING AMOUNT OF OBACTR
+/ WHICH IS DUE TO THIS SYMBOL
+/SYMBOLS ARE ENTERED ON PST IN ORDER OF APPEARENCE
+/IN SOURCE
+/NO MORE THAN 64 (DEC) SYMBOLS MAY BE REF'D.
+/ON ANY PAGE.
+/NOTE: THE SIZE OF THIS TABLE SHOULD NOT BE
+/INCREASED UNLESS LFS TABLE IS ALSO INCREASED.
+
+
+*7176
+
+/PAGE TABLE (402 WORDS)
+/DOUBLE WORD ENTRIES
+/ONE ENTRY FOR EACH INSTRUCTION TO BE ASSEMBLED
+/ROOM FOR 1 EXTRA ENTRY TO COVER PAGE OVERFLOW
+/A NEW TABLE FOR EACH PAGE OF CODE
+/TYPICAL ENTRY: WD1=CODE BITS
+/ WD2=SYMBOL WORD
+/CODE: BIT1=1 IF # REF
+/ BIT2=1 IF CDF TO CUR BANK
+/ BIT3=1 IF INDIRECT
+/ BIT4=1 IF BLOCK 0 (FOR EQUIVALENCED TAGS)
+/ BIT5=1 IF SPECIAL CALL CONST
+/ BIT6=1 IF SKIP INST.
+/ BIT7=1 IF AFS IS CONST
+/ BIT8=1 IF PARAMETER
+/ BIT9=1 IF OPR OR IOT INST.
+/ BIT10=1 IF AFS IS LITERAL
+/ BIT11=1 IF LFS OCCURS
+/ BIT0 UNUSED
+/THE SYMBOL WORD=0 IF CODE BIT9=1
+/ =THE ACTUAL CONST OR LITERAL IF BITS2,5,7 OR 10=1
+/ =THE SYMBOL ID (MST ENTRY ADDR.) FOR AN ADDR. PARAMETER
+/ OR FOR THE AFS OF AN MRI
+
+
+/
+/TYPE VERSION NUMBER
+/(THIS IS ONCE ONLY CODE)
+/(OVERWRITTEN BY P.S.T.)
+/
+*7000
+/
+VERNUM, JMS I CRLF
+ TAD JVERS
+ DCA X1
+ TAD M26
+ JMS I MTYPE
+ NOP
+ TAD K7000X
+ DCA I VNOP
+ JMP I .+1
+ IOI
+JVERS, VERSN-1
+MTYPE, QUERY
+M26, -15
+VNOP, VN
+K7000X, NOP
+VERSN, 2004 /PDP-8 SABR DEC-08-A2C2-V#
+ 2055
+ 7040
+ 2301
+ 0222
+ 4004
+ 0503
+ 5560
+ 7055
+ 0162
+ 0462
+ 5561 /- VERSION # (1ST DIGIT)
+ 7001 /2ND DIGIT AND PATCH LEVEL
+
+
+\f
+/SABR BANK 1 SECTION
+
+/TABLES
+
+FIELD 0
+
+
+
+*0
+EQUTB, 0 /EQUIVALENCE TABLE
+ /100 WORDS
+ /TABLE IS REINITIALIZED BEFORE EACH PAGE BEGINS
+ /COLLECTION, IF NO EQUIV. IS LEFT FROM PREVIOUS PAGE
+ /MULTIPLE WORD ENTRIES
+ /ONE ENTRY IS MADE FOR
+ /EACH LOC. TAG WHICH HAS
+ /EQUIVALENTS
+ /1ST WORD OF EACH ENTRY
+ /CONTAINS NO. OF OTHER WORDS
+ /IN THE ENTRY
+ /OTHER WORDS ARE SYMBOL ID'S
+ /(MST ADDRESSES) OF SYMBOLS
+ /EQUIVALENT TO THE PARTICULAR
+ /LOCATION TAG
+
+
+*100
+
+/BSEEST, 0 /EXTERNAL SYMBOL TABLE
+ /100 WORDS
+ /SINGLE WORD ENTRIES
+ /CONSISTING OF THE SYMBOL ID (MST ADDRESS)
+ /EACH EXT. SYM. IS ENTRED IN
+ /THE TABLE WHEN IT FIRST
+ /OCCURS IN THE SOURCE AND
+ /ASSIGNED A LOCAL EXT. NUMBER
+ /ACCORDING TO ITS PLACE IN THE
+ /TABLE.
+
+
+*200
+
+/PTOPTB, 0 /PAGE OP CODE TABLE
+ /200 WORDS
+ /SINGLE WORD ENTRIES
+ /ONE FOR EACH ENTRY IN PAGE TABLE
+ /ENTRY=ACTUAL OP CODE FOR
+ /ALL MRI, OPR OR IOT'S
+ /OR 0 FOR ALL PARAMETERS
+ /NEW TABLE FOR EACH PAGE OF CODE
+ /NOTE: THIS TABLE MAY OVERFLOW BY 1 WORD DURING COLLECTION
+ /OVERFLOW CAUSED BY PUTTING INFO ON TABLE BEFORE CK FOR OVERFLOW
+ /NO HARM IF ASSEM. PHASE LIT. TAB FOLLOWS
+
+ CDF CIF 10 /CODE FOR START AT 200
+ JMP I .+1
+ START
+
+*400
+
+/LITBSE, 0 /ASSEMBLY PHASE LITERAL TABLE
+ /200 WORDS
+ /DOUBLE WORD ENTRIES
+ /MUST BE SEPARATE FROM COLL.
+ /PHASE LIT. TAB. BECAUSE BOTH
+ /GOING AT ONCE IN PASS 2.
+ /THIS TABLE CONTAINS NOT
+ /ONLY LITERALS BUT ALSO
+ /OFF PAGE POINTERS
+ /1ST WORD OF ENTRY = 1 OR 2 OR 6
+ /1 MEANS LITERAL &
+ /2ND WORD CONTAINS ACTUAL VALUE
+ /2 MEANS OFF PAGE SYMBOL PTR
+ /& 2ND WORD CONTAINS SYMBOL ID.
+ /6 MEANS OFF PAGE SYM. PTR
+ /WHERE SYMBOL REFERENCED BY A #
+ /2ND WORD AS FOR 2
+ /TABLE BUILT ANEW FOR EACH
+ /PAGE OF CODE.
+
+
+*600
+
+/LFSBSE, 0 /LOC FIELD SYMBOL TABLE
+ /100 WORDS
+ /SINGLE WORD ENTRIES
+ /EACH=SYMBOL ID (MST ADDRESS)
+ /OF THE GIVEN LFS
+ /LFS'S ARE ENTERED IN ORDER
+ /OF THEIR APPEARENCE IN SOURCE
+ /TABLE REBUILT FOR EACH PAGE OF CODE
+ /NOTE: THIS TABLE MUST BE AT LEAST AS LONG
+ /AS THE PST TO PREVENT LFS OVERFLOW
+
+
+
+*700
+
+PEBSE, 0 /PAGE ESCAPE PUSH DOWN LIST
+ /40 WORDS
+ /SINGLE WORD ENTRIES
+ /EACH ENTRY IS 0,2, OR 4
+ /BEING THE VALUE OF THE
+ /PAGE ESCAPE (0,2,OR 4 WORDS)
+ /OF EACH PAGE ASSEMBLED
+ /THESE NOS. ARE SAVED DURING
+ /PASS 1 & USED DURING
+ /PASS 2
+\f*740
+/SORT LISTS
+
+/SORT LIST FOR INITIAL CHAR. OF LITERAL
+SL3, 242 /QUOTE
+ 255 /MINUS
+ 304 /D
+ 313 /K
+ -1 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+
+
+
+/BRANCH LISTS
+BL6, RLN15
+ RLN2
+ RLN2
+ RLN3
+ RLN3
+
+/SORT LIST FOR BEGINNING OF INPUT ITEM
+SL2, 255 /MINUS
+ 250 /LEFT PARIN
+ 242 /QUOTE
+SL6, 273 /SEMI-COLON
+ 257 /SLASH
+SL1, 240 /SPACE
+ 211 /TAB
+ 000 /CR
+ -1 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+/BRANCH LIST FOR BEGINNING OF INPUT ITEM
+BL2, ITM4 /NEGATIVE
+ ITM8 /LITERAL
+ ITM7 /ALPHA CONSTANT
+ ITM15 /NULL ITEM
+ ITM15 /NULL ITEM
+ ITM2 /IGNORE SPACE
+ ITM2 /IGNORE TAB
+ ITM15 /NULL ITEM
+/BRANCH LIST FOR INITIAL CHAR. OF LITERL
+BL3, ITM7 /GET ASCII VALUE FOR LITERAL
+ ITM10 /SET NEG. SW.
+ ITM11 /SET MODE TO DECIMAL
+ ITM12 /SET MODE TO OCTAL
+
+
+
+
+
+
+*1000
+
+/LTBSE, 0 /COLLECTION PHASE LITERAL TABLE
+ /100 WORDS
+ /SINGLE WORD ENTRIES
+ /CONTAINING ACTUAL VALUES
+ /TABLE CONTAINS NOT ONLY
+ /LITERALS BUT ALSO
+ /POINTERS TO CONSTANT
+ /AND ABSOLUTE ADDRESSES.
+ /TABLE BUILT ANEW FOR
+ /EACH PAGE OF CODE.
+
+/INPUT DATA BUFFER
+/546 (OCTAL) WORDS
+/ALL DATA CHARACTERS READ DIRECTLY INTO THIS BUFFER
+/1 CHAR. PER WORD
+/THE ACTUAL SIZE OF THE BUFFER IS ARBITRARY.
+
+*1100
+
+DATA, 0
+
+
+
+/LINE BUFFER (73 WORDS)
+/CONTAINS ASCII CHARACTERS, 1 PER WORD
+/NULLS & RUBOUTS DONT MAKE IT
+/END OF LINE MARKED BY A 0000
+/CR,LF,FF DON'T GO INTO THE BUFFER
+
+/BUFFER IS LAID OUT AS FOLLOWS:
+
+*1646
+LINBUF, 0 /110(OCTAL) WORDS FOR LINE CHARACTERS
+
+*1756
+/LINEND, 0 /1 EXTRA WORD TO PREVENT OVERFLOW
+ /(GETS THE 0 WHEN LINE IS TOO LONG)
+*1757
+SL7, 215
+ 214
+ 212
+ 240
+ 211 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+ -1
+BL1, PTEXT /SPACE
+ PTEXT /TAB
+ TEXERR /000
+BL7, L72S
+ L72X
+ L72+2
+ L72+2
+ L72X
+
+\f
+
+/MAIN SYMBOL TABLE
+
+*2000
+
+
+/ENTRIES ARE COMPOSED OF THE FOLLOWING:
+/ FIRST A 1 WORD HEADER CODE
+/ THEN THE SYMBOL ITSELF IN PACKED 6BIT ASCII (1-3 WORDS)
+/ FINALLY THE 1 WORD BINARY VALUE OF THE SYMBOL
+
+/THE HEADER CODE IS LAID OUT AS FOLLOWS:
+/(A) FOR OP CODE SYMBOLS:
+/ BIT0=1 AFTER THE SYMBOL HAS BEEN PRINTED BY PRSYM
+/ BITS1&2=3 (THESE ARE THE SYMBOL TYPE BITS)
+/ BIT3=1 FOR MEMORY REFERENCE INSTRUCTIONS
+/ BITS4&5=THE MICRO-GROUP FOR OPR INSTRUCTIONS (0 FOR MRI AND IOT INSTS.)
+/ (NOTE: MICRO-GROUP IS SET TO 0 FOR CLA)
+/ BIT6=1 IF THE SYMBOL IS A PSUEDO-OP
+/ BIT7=1 IF THE INST. IS A SKIP TYPE INST.
+/ BIT8=1
+/ BIT9=0
+/ BITS10&11=THE NUMBER OF PACKED ASCII SYMBOL WORDS IN THE ENTRY
+
+/(B) FOR OTHER SYMBOL TYPES:
+/ BIT0 AS ABOVE
+/ BITS1&2=0 FOR ABSOLUTE AND COMMON SYMBOLS
+/ =1 FOR RELOCATABLE SYMBOLS
+/ =2 FOR EXTERNAL SYMBOLS
+/ BIT3=1 AFTER THE SYMBOL HAS BEEN DEFINED
+/ BIT4=1 FOR ENTRY SYMBOLS
+/ BIT5=1 IF THE SYMBOL IS EVER REFERENCED BY A #
+/ BIT6=1 IF THE SYMBOL IS IN COMMON
+/ BIT7=1 IF THE SYMBOL IS A DUMMY SYMBOL
+/ BITS8-11 AS ABOVE
+/MST=.
+ 3053 /ABSYM
+ 0102
+ 2331
+ 1500
+ PABSYM
+ 3052 /ARG
+ 0122
+ 0700
+ PARG
+ 3412 /AND
+ 0116
+ 0400
+ AND 0
+ 3053 /BLOCK
+ 0214
+ 1703
+ 1300
+ PBSS
+ 3052 /CALL
+ 0301
+ 1414
+ PCALL
+ 3053 /COMMN
+ 0317
+ 1515
+ 1600
+ PCOMMN
+ 3112 /CIA
+ 0311
+ 0100
+ CIA
+ 3012 /CLA
+ 0314
+ 0100
+ CLA
+ 3112 /CLL
+ 0314
+ 1400
+ CLL
+ 3112 /CMA
+ 0315
+ 0100
+ CMA
+ 3112 /CML
+ 0315
+ 1400
+ CML
+ 3053 /DECIM
+ 0405
+ 0311
+ 1500
+ PDEC
+ 3053 /DUMMY
+ 0425
+ 1515
+ 3100
+ PDUMMY
+ 3412 /DCA
+ 0403
+ 0100
+ DCA 0
+ 3052 /EAP
+ 0501
+ 2000
+ PEAP
+ 3052 /END
+ 0516
+ 0400
+ PEND
+ 3053 /ENTRY
+ 0516
+ 2422
+ 3100
+ PENTRY
+ 3053 /FORTR
+ 0617
+ 2224
+ 2200
+ PFORT
+ 3212 /HLT
+ 1014
+ 2400
+ HLT
+ 3051 /IF
+ 1106
+ PIF
+ 3053 /CPAGE
+ 0320
+ 0107
+ 0500
+ PIFF
+ 3432 /ISZ
+ 1123
+ 3200
+ ISZ 0
+ 3412 /INC (NON-SKIP ISZ)
+ 1116
+ 0300
+ ISZ 0
+ 3112 /IAC
+ 1101
+ 0300
+ IAC
+ 3012 /IOF
+ 1117
+ 0600
+ IOF
+ 3012 /ION
+ 1117
+ 1600
+ ION
+ 3412 /JMP
+ 1215
+ 2000
+ JMP 0
+ 3412 /JMS
+ 1215
+ 2300
+ JMS 0
+ 3012 /KRB
+ 1322
+ 0200
+ KRB
+ 3032 /KSF
+ 1323
+ 0600
+ KSF
+ 3052 /LAP
+ 1401
+ 2000
+ PLAP
+ 3112 /NOP
+ 1617
+ 2000
+ NOP
+ 3053 /OCTAL
+ 1703
+ 2401
+ 1400
+ POCT
+ 3053 /OPDEF
+ 1720
+ 0405
+ 0600
+ OPDEX
+ 3212 /OSR
+ 1723
+ 2200
+ OSR
+ 3052 /PAGE
+ 2001
+ 0705
+ PPAGE
+ 3053 /PAUSE
+ 2001
+ 2523
+ 0500
+ PPAUSE
+ 3012 /PLS
+ 2014
+ 2300
+ PLS
+ 3032 /PSF
+ 2023
+ 0600
+ PSF
+ 3053 /REORG
+ 2205
+ 1722
+ 0700
+ PRORG
+ 3053 /RETRN
+ 2205
+ 2422
+ 1600
+ PRTN
+ 3112 /RAL
+ 2201
+ 1400
+ RAL
+ 3112 /RAR
+ 2201
+ 2200
+ RAR
+ 3012 /RFC
+ 2206
+ 0300
+ RFC
+ 3012 /RRB
+ 2222
+ 0200
+ RRB
+ 3032 /RSF
+ 2223
+ 0600
+ RSF
+ 3112 /RTL
+ 2224
+ 1400
+ RTL
+ 3112 /RTR
+ 2224
+ 2200
+ RTR
+ 3232 /SKP
+ 2313
+ 2000
+ SKP
+ 3053 /SKPDF
+ 2313
+ 2004
+ 0600
+ SKPDEX
+ 3232 /SMA
+ 2315
+ 0100
+ SMA
+ 3232 /SNA
+ 2316
+ 0100
+ SNA
+ 3232 /SNL
+ 2316
+ 1400
+ SNL
+ 3232 /SPA
+ 2320
+ 0100
+ SPA
+ 3112 /STA
+ 2324
+ 0100
+ STA
+ 3112 /STL
+ 2324
+ 1400
+ STL
+ 3232 /SZA
+ 2332
+ 0100
+ SZA
+ 3232 /SZL
+ 2332
+ 1400
+ SZL
+ 3232 /SPC=SPA+CLA (USED BY COMPILER)
+ 2320
+ 0300
+ SPA CLA
+ 3412 /TAD
+ 2401
+ 0400
+ TAD 0
+ 3052 /TEXT
+ 2405
+ 3024
+ PTEXT
+ 3012 /TLS
+ 2414
+ 2300
+ TLS
+ 3032 /TSF
+ 2423
+ 0600
+ TSF
+
+
+ACH=20
+ACM=21
+ACL=22
+
+ 0452 /ACH
+ 0103
+ 1000
+ ACH
+ 0452 /ACM
+ 0103
+ 1500
+ ACM
+ 0452 /ACL
+ 0103
+ 1400
+ ACL
+
+II, 0451 /I
+ 1100
+ 0400
+
+STTP=.
+\fCORE1=7600
+*CORE1-1
+
+/THE OCCURRENCE TABLE EXTENDS DOWNWARD FROM HERE
+/TOWARD THE MAIN SYMBOL TABLE
+/& SHARING THE SAME SPACE WITH IT.
+/THIS TABLE IS VARIABLE, BEING COLLAPSED
+/AS MUCH AS POSIBLE DURING USE. THE ONLY
+/THING LEFT ON IT AT THE END ARE UNDEFINED
+/SYMBOLS.
+/THE OCC. TAB. CONTAINS AN ENTRY FOR EVERY
+/REF. TO AN AS YET UNDF. SYMBOL. EACH
+/TIME A SYMBOL IS DEFINED THE TABLE IS SEARCHED
+/TO SEE IF FORWARD REFERENCES TO IT EXIST.
+/IF SO THEY ARE OUTPUT & THE TABLE
+/CONDENSED.
+/ENTRIES CONSIST OF 2 OR 3 WORDS
+/STRUCTURED AS BELOW:
+/HIGH WORD: LOCATION OF REFERENCE
+/LOW WORD: SYMBOL I.D.
+/OPTIONAL WORD: # FLAG
+/THE LOC. WORD CONTAINS THE PROG. ADDR. WHERE
+/THE VALUE OF THE SYM. MUST BE ASSEMBLED
+/THE # FLAG=1 IF IT EXISTS. IT WILL
+/EXIST ONLY FOR THOSE ENTRIES WHERE THE
+/SYM. WAS REF'D. BY A #.
+/THE TABLE IS ALWAYS SEARCHED IN REVERSE
+/FROM LOW CORE UPWARD
+/THE O.T. PTR (OTP) ALWAYS PTS. TO THE NEXT FREE
+/LOCATION BELOW THE TABLE
+/THE TABLE HAS NO IMPORTANCE DURING PASS 2.
+
+
+ /MEMORY IS NOT USED
+
+
+$
+\f
--- /dev/null
+/OS8 SABR ASSEMBLER OVERLAY ***SPATCH.07***
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/FIXES TO SPATCH FOR V18 J.K. 1975
+/
+/ .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
+/ BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
+/ TO FROM FORT
+/ .ALLOW TWO PAGE OUTPUT HANDLER
+/
+/
+/SABR ASSEMBLER, LIKE 8K FORTRAN UNDER OS/8, RUNS
+/IN FIELD 1 WITH ITS TABLES IN FIELD 0.
+/ OCTOBER 26,1971
+/
+/MODIFIED SO THAT SABR WILL, AT RUN TIME, DETERMINE IF THE USER
+/SPECIFIED I/O DEVICES REQUIRE TWO PAGE HANDLERS, AND IF SO
+/SABR WILL ALLOCATE SPACE FOR THEM. ALSO IF ALL I/O IS DONE VIA THE
+/SYSTEM DEVICE, SABR WILL NOT RESERVE ANY SPACE FOR I/O HANDLERS
+/SPACE FOR TWO PAGE HANDLERS IS MADE BY SHRINKING THE INPUT
+/BUFFERS-CURRENTLY 4 PAGES-TO 2 PAGES. B.CLOGHER 10/71
+/
+
+ FIELD 0
+ SDVHND=772
+ MPARAM=7643
+ DVHNDL=7647
+ JSBITS=7746
+ MOFILE=7600
+ CORE1=6200 /UPPER CORE LIMIT OF OCCURRENCE TABLE(VARIES WITH I/O HANDLERS NEEDED!!)
+ SABR=201 /SABR V17 FIRST LOC AFTER "JMS I IOINIT"
+ PASS=110 /SABR V17
+ SERROR=JMS I 177/SABR V17
+ ERRE=2701 /SABR V17
+ PRSYMP=41 /SABR V17
+ TEM1=123 /SABR V17
+ TEM2=124 /"
+ M4=3704 /"
+ CLOC1=6 /"
+ CLOC2=3162 /"
+ CLOC3=4356 /"
+ CTYPE=23 /"
+ CRLF=24
+ CHR=61 /"
+ SYMBOL=3 /"
+ LLFS=5364 /"
+ LINE=67 /"
+ L64=4772 /"
+ TYPE=54 /"
+ PUNCH=42 /"
+ INBUF=6200 /6200-7177 OR 6600-7177
+ PRJ5=4051
+ PRNOP=4136
+ PRJ2=4170
+ PRS2=4025
+ PRS5=4101
+\f *30 /CCL PATCH; GOES HERE AS A HACK
+CCLKLG, TAD [SKP
+ DCA I [CCLSKP
+ CDF 10
+ TAD I [7645
+ SMA CLA
+ JMP I [NOTFRT
+ TAD I [7645
+ AND P3777
+ DCA I [7645
+ CDF
+ JMP I [SETCOR
+P3777, 3777
+
+ *200 /INITIALIZATION - GETS DESTROYED DURING SABR EXECUTION
+
+START, ISZ I [FSWITC /SKIPS SINCE FSWITC=-1. ENTRY FROM "R SABR"
+FSTART, JMP CCLKLG /ENTRY FROM 8K FORTRAN VIA "RUN SABR" MONITOR CALL
+ CLA CMA /USED AS TEM. BY SUBR. DNUM
+ DCA I [FSWITC /USED AS TEM. BY SUBR. DNUM
+PTEM1, CIF 10
+ JMS I [7700 /CALL I/O MONITOR
+ 10 /AND ASK IT TO STICK AROUND
+ CIF 10
+ JMS I [200
+ 5 /COMMAND DECODE
+ 2302 /.SB ASSUMED EXTENSION
+NOTFRT, CDF 10
+ TAD I [MPARAM
+ AND [100
+ CDF 0
+ SNA CLA /IS /F SWITCH ON?
+ DCA I [FSWITC /NO - ZERO OUT FSWITC
+ TAD I [JSBITS
+ TAD [1000
+ DCA I [JSBITS
+CCLSKP, JMP .+5
+SETCOR, ISZ I [FDSW /SET DELETE SWITCH
+ CIF 10
+ JMS I [7700 /CALL I/O MONITOR--LOCK IT IN
+ 10
+ CDF 10
+ TAD I [MOFILE /CHECK FIRST TWO OUT DEV. SPECS.--NEED 2 PAGE HNDLR?
+OUTL, JMS DNUM
+ JMP OSYS /NO OUTPUT OR SYS DEV.
+ JMP TWOPAG /NEED TWO-PAGE HANDLER
+DONE, TAD I [MOFILE+5 /1 PAGE HNDLR-LOOK AT 2ND OUT DEV.
+ ISZ CNT /DONE BOTH?
+ JMP OUTL /NO-GO ON
+ CLA /YES-
+ TAD PTEM2 /ARE BOTH OUT DEVS. SYS: OR NOT THERE?
+ SZA CLA /IF SO-ALLOT 0 PAGES FOR OUTPUT HANDLER
+ TAD [-200 /NO-ALLOT 1 PAGE FOR HANDLER
+DONE1, DCA OPGES /-SIZE OF OUT HANDLER NEEDED
+INLP, TAD I TEM /NOW LOOP THRU 9 POSSIBLE INPUT SPECS.
+ JMS DNUM
+ JMP ISYS /INPUT NOT THERE OR SYS DEV.
+ JMP TWOPG /TWO PAGE HANDLER NEEDED
+ILP1, ISZ TEM /ONE-MOVE PTR TO NEXT
+ ISZ TEM
+ ISZ CNT1 /DONE ALL 9?
+ JMP INLP /NO
+ TAD TEM3 /YES-ARE ALL INPUTS FROM SYS OR NOT THERE?
+ SZA CLA /IF SO-DON'T SAVE ROOM FOR INPUT HANDLER
+ TAD [-200 /NO-NEED ONE PAGE FOR HANDLER
+IDONE, DCA IPGES /STORE AS SIZE OF INPUT HANDLER
+ TAD IPGES
+ TAD OPGES
+ TAD [400 /NEED MORE THAN A TOTAL OF 2 PAGES FOR HANDLERS?
+ CDF 00 /BACK TO DF 0
+ SMA CLA
+ JMP NOTWO /NO-GO ON
+ DCA I [INREC1 /YES-ADJUST INPUT ROUTINE FOR ONLY 2 PAGE BUFFERS
+ TAD [200
+ DCA I [INBFPT-1
+ DCA I [INRD1
+ DCA I [INRD1+1
+ TAD [6600 /RESET ADDRESS OF INPUT BUFFER
+ DCA I [INBFPT
+ TAD [400
+NOTWO, TAD [6200 /RESET UPPER CORE LIM. OF OCCURRANCE TABLE
+ TAD IPGES
+ TAD OPGES
+ DCA [CORE1
+ TAD OPGES
+ TAD [200
+ SPA CLA /MORE THAN ONE PAGE OUT HNDLR NEEDED?
+ IAC /YES
+ TAD OPGES
+ TAD I [INBFPT /ADJUST HANDLER FETCH FOR TWO PAGE HANDLER
+ CDF 10 /BACK TO DATA FIELD 1
+ DCA I [OUHND
+ CMA /PROPAGATE CHANGES INTO MAIN PART OF SABR
+ TAD [CORE1
+ DCA I [CLOC1
+ TAD I [CLOC1
+ DCA I [CLOC3
+ TAD [CORE1
+ DCA I [CLOC2
+ TAD IPGES
+ TAD [200
+ SPA CLA /MORE THAN ONE PAGE FOR INPUT HNDLR?
+ IAC /YES-ADJUST IN HNDLR FETCH ROUTINE
+ TAD I [CLOC2 /(CONTAINS START ADDRESS OF CORE FOR IN HNDLR.)
+ CDF 00
+ DCA I [ADEVN /STORE FOR HNDLR FETCH ROUTINE
+ CDF 10
+ JMP I [LCHK
+ISYS, ISZ TEM3
+IPGES, 0
+ JMP ILP1 /INPUT SPEC. NOT THERE OR SYS DEV.
+TWOPG, TAD [-200 /INPUT SPEC-NEEDS TWO PAGES
+ JMP IDONE-1
+TWOPAG, TAD [-200 /OUT HNDLR NEEDS TWO PAGES
+ JMP DONE1-1
+OSYS, ISZ PTEM2 /OUT HNDLR NOT NEEDED OR SYS. DEVICE
+OPGES, 0
+ JMP DONE
+/
+/ROUTINE TO CHECK DEVICE SPECS. LEFT BY COMMAND DECODER AND SEE
+/IF WE NEED ANY TWO PAGE HANDLERS. ALSO CHECK IF ALL I/O IS FROM
+/SYS DEVICE IN WHICH WE DON'T HAVE TO SAVE ROOM FOR ANY HANDLERS
+/RETN. TO CALL + 1 IF DON'T NEED ROOM FOR ANY HANDLER
+/RETN. TO CALL + 2 IF NEED 2 PAGES FOR HANDLER
+/RETN. TO CALL + 3 IF NEED 1 PAGE FOR HANDLER
+/
+DNUM, 0
+ AND [17 /MASK DEV. #
+ DCA FSTART+1 /STORE
+ TAD FSTART+1
+ CLL
+ SNA /ANYTHING THERE?
+ JMP I DNUM /NO-TREAT LIKE SYS. DEV
+ TAD [DVHNDL-1 /CHECK IF THIS HANDLER CO-RESIDENT WITH SYS.(TD8/E--UNIT 1)
+ DCA FSTART+2
+ TAD I FSTART+2
+ TAD [200
+ SZL CLA /IS ENTRY PT. ABOVE 7600??
+ JMP I DNUM /YES-JUST LIKE SYS DEV.
+ TAD FSTART+1
+ TAD [SDVHND-1 /NO-PICK UP TABLE WD WHICH TELLS IF 2 PAGE HNDLR.
+ DCA FSTART+2
+ TAD I FSTART+2
+ ISZ DNUM /BUMP RETN.
+ SMA CLA /BIT 0=1? I.E. DOES IT NEED TWO PAGES?
+ ISZ DNUM /NO-NORMAL RETN. TO CALL+3--NEED 1 PAGE
+\f JMP I DNUM /YES-RETN. TO CALL+2--NEED 2 PAGES
+TEM3, -11
+CNT, -2
+CNT1, -11
+PTEM2, -2
+TEM, MOFILE+17
+\f*400
+LCHK, TAD I [MPARAM+1
+ AND (4
+ SNA CLA
+ ISZ STSABR
+ TAD I [MPARAM+1
+ AND [40
+ SNA CLA /IF /S IS ON
+ TAD I [MOFILE+5
+ SZA CLA /OR IF THERE IS NO LISTING OUTPUT FILE
+ JMP NSPEED
+ TAD [PRS5&177+5200 /SPEED UP SYMBOL TABLE SORT
+ DCA I [PRJ5
+ DCA I [PRNOP
+ DCA I [SYMXX /AND PRINT "U" MESSAGE FOR UNDEFINEDS
+ TAD [PRS2-1&177+5200
+ DCA I [PRJ2
+NSPEED, CDF 10
+ TAD I [MOFILE+4 /GET EXTENSION OF BINARY OUTPUT
+ SNA /IS IT THERE?
+ TAD [2214 /NO - SET TO .RL
+ DCA I [MOFILE+4
+ TAD I [MOFILE+11
+ SNA
+ TAD [1423 /SIMILIARLY SET LISTING EXTENSION TO .LS
+ DCA I [MOFILE+11
+ DCA I [OUTINH
+ TAD I [MOFILE
+ SNA CLA /BINARY OUTPUT?
+ JMP NOBNOT /NO
+ CDF CIF 10
+ JMS I [TSTNTR /YES - OPEN IT
+ CDF 10
+ JMP YESBOT
+NOBNOT, TAD [MOFILE+1
+ DCA I [PFILE
+ ISZ I [OUTINH /INHIBIT OUTPUT
+YESBOT, TAD I [MOFILE+5
+ CDF 0
+ SZA CLA
+ DCA I [LSTFLG
+ CDF 10
+ TAD I [MPARAM
+ AND [41 /"L" OR "G" FLAGS ON?
+ CDF 0
+ SNA CLA
+ JMP NOLOAD
+ JMS I [MINCOR
+ CLA IAC /DEVICE "SYS"
+ CIF 10
+ JMS I [200
+ 2 /LOOKUP
+ALOAD, LOADER
+ 0 /LENGTH GOES HERE AND IS IGNORED
+ JMP NOLODR /COULDN'T FIND IT
+ TAD ALOAD
+ DCA I [LDRBLK
+ CDF 10
+ TAD I [OUTREC
+ CDF 0
+ DCA I [REMEMB
+NOLOAD, JMS I [OPENFL /OPEN FIRST INPUT FILE WHILE MONITOR STILL IN CORE
+ CDF CIF 10
+ JMP I .+1
+STSABR, SABR /FIRST LOC IN SABR AFTER "INITIAL DIALOGUE"
+NOLODR, TAD [1200
+ JMP I [ERROR
+LOADER, TEXT /LOADERSV/
+\f *1100 /FILE OPENER - RESIDES IN PART OF THE OLD SABR INPUT BUFFER
+O7760, 7760
+OPENFL, 0
+ CDF 10
+ TAD I FILPTR
+ SNA /IS THERE ANOTHER INPUT FILE?
+ JMP I (ERROR+1 /ERROR - NO END STATEMENT IN PROGRAM
+ DCA OTEMP
+ TAD OTEMP
+ AND (17 /EXTRACT DEVICE NUMBER
+ TAD (DVHNDL-1
+ DCA OTEMP2
+ TAD I OTEMP2
+ DCA OTEMP2
+ ISZ FILPTR
+ TAD I FILPTR /GET STARTING BLOCK #
+ CDF 0
+ DCA I (INREC /STORE IT AWAY
+ ISZ FILPTR
+ TAD OTEMP
+ AND (7760 /EXTRACT LENGTH
+ SZA /LENGTH OF 256 IMPLIES MAY BE LARGER
+ TAD (17
+ CLL CML RTR
+ RTR /GET LENGTH AS A NORMAL NEGATIVE NUMBER
+ DCA I (INCNT /STORE THAT AWAY TOO
+ TAD OTEMP2
+ SZA
+ JMP GOTIT
+ JMS I (MINCOR /GET MONITOR
+ TAD ADEVN /THIS LOC. SET UP BY INITIALIZATION ROUTINE
+ DCA ADEVNO
+ TAD OTEMP
+ CIF 10
+ JMS I O200
+ 1 /ASSIGN
+ADEVNO, 5600 /FORCE HANDLER INTO PAGE 5600
+ JMP I (DELERR /GIVE S ERROR
+ TAD ADEVNO
+GOTIT, DCA I (INDEV
+ JMS I (MOUCOR /GET MONITOR OUT
+ CLA CMA
+ DCA I (INCHCT /FORCE BUFFER LOAD ON FIRST READ
+ JMP I OPENFL
+OTEMP, 0
+OTEMP2, 0
+FILPTR, 7617
+O200, 200
+ADEVN, 0 /SET UP BY INIT. ROUTINE-PAGE ADDR. OF IN HNDLR
+\f *1600
+MINCOR, 0
+ RDF
+ TAD MINCIF
+ DCA MINXIT
+MINCIF, CDF CIF 0
+ CIF 10
+ JMS I SYSTEM
+ 10 /ESCAPE
+ TAD MIN200
+ DCA SYSTEM
+MINXIT, 0 /RESTORE CALLING FIELDS
+ JMP I MINCOR
+MOUCOR, 0
+ CDF 0
+ TAD SYSTEM
+E7500, SMA
+ CIF 10
+MN7700, SMA CLA
+ JMS I SYSTEM
+ 11 /GET OUT
+ TAD MN7700
+ DCA SYSTEM
+ JMP I MOUCOR
+SYSTEM, 200
+MIN200, 200
+ERROR, TAD E7500 /MAKE SABR ERROR "B"
+ DCA MINCOR
+ JMS MOUCOR /KICK MONITOR OUT
+ CDF CIF 10
+ DCA I EPASS /SET PASS=0 SO ERROR WILL PRINT
+ TAD EL64
+ DCA I ETYPE
+ TAD MINCOR
+ JMP I .+1
+ ERRE
+EPASS, PASS
+EL64, L64
+ETYPE, TYPE
+\f *7200
+SPAUSE, 0 /"PAUSE" STATEMENT PATCH
+ TAD FSWITC
+ CLL RAL
+ TAD I (FILPTR
+ DCA I (FILPTR /RESET FILE POINTER IF CALLED FROM FORTRAN
+ JMS I (OPENFL /OPEN NEXT FILE
+ CDF CIF 10
+ JMP I SPAUSE
+FSWITC, -1 /AS ADVERTISED
+
+DELETE, TAD I (MPARAM
+ RTR /PUT "K" SWITCH IN LINK
+D7600, 7600
+ CDF 0
+ TAD I (JSBITS
+ RAR
+ CLL CML RAL
+ DCA I (JSBITS /MARK "DON'T CARE IF MONITOR AREA DESTROYED" BITS
+ TAD FDSW
+ SZL SNA CLA /DELETE ONLY IF CALLED FROM FORTRAN WITH
+ JMP NODLET /"K" SWITCH(IN LINK) ZERO
+ JMS I (MINCOR
+ CLA IAC /DEVICE "SYS"
+ CIF 10
+ JMS I (200
+ 4 /CLOSE - USED AS DELETE
+ NAME /NAME FOR CLOSE PROCESSOR
+ 0 /NO BLOCKS - WILL BE DELETED
+ JMP DELERR /ERROR
+NODLET, TAD LDRBLK
+ SNA CLA /WAS A LOADER BLOCK STORED
+ JMP GETOUT
+ CDF 10
+ TAD I (L64
+ CDF 0
+ SZA CLA /IF WE USED THE TELETYPE ROUTINE,
+ JMP GETOUT /THEN THERE WAS AN ERROR
+ TAD REMEMB
+ CDF 10
+ DCA I (MOFILE+1
+ CLL CML CLA RAR
+ TAD I (MPARAM+2
+ DCA I (MPARAM+2
+ CDF 0
+ JMS I (MINCOR
+ CIF 10
+ JMS I (200
+ 6 /RUN
+LDRBLK, 0
+REMEMB, 0
+FDSW, 0
+GETOUT, TAD I (SYSTEM
+ CDF 10
+D7700, SMA CLA
+ CMA
+ DCA I D7700
+ CDF 0
+ JMP I .+1
+ 7605
+DELERR, TAD (1700 /GIVE A "S" ERROR
+DELER2, TAD (200
+ CDF CIF 0
+ JMP I (ERROR
+NAME, 0617;2224;2216;2415
+
+INREAD, 0
+ AND D7700
+ SNA CLA
+ JMS I POPNFL
+ JMS I INDEV
+ 400 /OR 200 IF NEED TWO PAGE HANDLERS-REDUCE BUFFER SIZE TO MAKE ROOM
+INBFPT, INBUF
+INREC, 0
+ JMP INERR
+ ISZ INREAD
+ ISZ INREC
+INREC1, ISZ INREC /OR 0000 IF TWO PAGE HANDLERS-SINCE IN BUFFER IS 1/2 SIZE
+ JMP I INREAD
+INDEV, 0
+INERR, SPA CLA
+ JMP DELER2
+ JMP INREC+3
+POPNFL, OPENFL
+
+CLSMBE, 0 /SUBR TO CLOSE OUTPUT FILE IF ONE EXISTS
+ CDF CIF 10
+ TAD I (OUTINH
+ SNA CLA
+ JMS I (OUCLOS
+ CIF 0 /IN CASE WE DIDN'T CLOSE IT
+ JMP I CLSMBE
+\f *7400 /END OF PASS CRAP AND INPUT ROUTINE
+P40, 40
+PASEND, ISZ I (PASS /BUMP PASS COUNTER
+LSTFLG, JMP SBSYMT /ZERO IF LISTING FILE EXISTS
+ JMS I (CLSMBE /CLOSE BINARY FILE
+ CDF CIF 10
+ JMS I (TSTNTR /ENTER LISTING FILE
+ TAD I (FSWITC
+ SZA CLA
+ JMP .+4
+ TAD (7617
+ DCA I (FILPTR /RESET FILE POINTER TO BEGINNING
+ JMS I (OPENFL /AND OPEN FIRST FILE
+ /IF CALLED FROM FORTRAN WE DONT HAVE TO DO THIS
+ /BECAUSE OF THE PECULIAR NATURE OF FORTRAN OUTPUT
+ JMS I (MOUCOR /KICK MONITOR OUT
+ CDF CIF 10
+ TAD I (MPARAM+1
+P200, AND P40 /MASK OUT "S" SWITCH
+ DCA I (OUTINH /INTO "OUTPUT INHIBIT" FLAG
+ JMS I (SYMPRT /PRINT SYMBOL TABLE UNDER CONTROL OF /S
+ DCA I (OUTINH /ZERO FLAG FOR LISTING
+ TAD I (MPARAM+1 /SYMPRT RETURNS WITH DATA FIELD=10
+ RTL
+ CIF 10
+ SNL CLA /"N" FLAG IS IN THE LINK
+ JMP I (ENDRSM /HE WANTS A LISTING - GO GET IT
+SBREND, CIF 0
+ JMS I (CLSMBE /CLOSE OUTPUT FILE
+ JMP I (DELETE /DELETE FORTRN.TM AND CHAIN OR RETURN
+
+SBSYMT, TAD (TDUMMY
+ CDF CIF 10
+ DCA I (PUNCH /INHIBIT ALL FUTURE OUTPUT
+ JMS I (SYMPRT /CHECK SYMTAB FOR UNDEFINEDS
+ CDF 0
+ ISZ I (JSBITS /SET "DON'T CARE ABOUT USR CORE" FLAG
+ JMP SBREND /NOW GO CLOSE BINARY OUTPUT FILE AND RETURN
+
+INCHAR, 0
+ ISZ INJMP
+ KSF
+ JMP .+5
+ KRS
+ TAD (-203
+ SNA CLA
+ JMP I (7600 /EXIT TO MONITOR IF ^C TYPED
+ ISZ INCHCT
+INJMPP, INJMPE
+ TAD INCNT
+INRD, JMS I (INREAD
+ DCA INCNT /RETURN HERE ON EOF
+INRD1, ISZ INCNT /SET TO 0000 IF 2 PAGE HANDLERS FORCE INPT. BUFF. TO 1/2 SIZE
+ SKP / " " "
+ TAD (600
+ ISZ INCNT
+IN7400, 7400
+ TAD (-1401
+ DCA INCHCT
+ TAD INJMPP
+ DCA INJMP
+ TAD I (INBFPT
+ DCA INPTR
+ JMP INCHAR+1
+ INJMPE=JMP .
+INJMP, INJMPE
+ JMP INCHA1
+ JMP INCHA2
+INCHA3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND IN7400
+ CLL RTR
+ RTR
+ TAD INTEMP
+ RTR
+ RTR
+ ISZ INPTR
+ JMP INCOM
+INCHA2, TAD I INPTR
+ AND IN7400
+ DCA INTEMP
+ ISZ INPTR
+INCHA1, TAD I INPTR
+INCOM, AND (177
+ SZA
+ TAD (-177
+ SNA
+ JMP INCHAR+1
+ TAD (145 /CHECK FOR ^Z
+ SNA
+ JMP INRD /^Z ON INPUT MEANS GO TO NEXT FILE
+ TAD (232
+ CDF CIF 10
+ DCA I (CHR
+ JMP I INCHAR
+INPTR, 0
+INCHCT, 0
+INTEMP, 0
+INCNT, 0
+ FIELD 1
+\f *6400 /OUTPUT ROUTINE INTERFACE - CANT GO PAST 6423
+OUCHAR, 0
+ DCA I POUTEM
+ TAD OUTINH
+ SZA CLA
+OUCRET, JMP I OUCHAR /DOUBLES AS OFF-PAGE RETURN
+ ISZ I POUJMP
+ ISZ OUCHCT
+ JMP I POUJMX
+ JMS OUTDMP
+ JMP OUCHAR+2
+POUJMP, OUJMP
+POUJMX, OUJMX
+POUTEM, OUTEMP
+OUTINH, 0
+F3ERR, TAD O2100
+F2ERR, TAD O2100
+F1ERR, CDF CIF 0
+ JMP I .+1
+ ERROR
+O2100, 2100
+ *6457 /LOADS OVER OLD SABR INITIALIZATION ROUTINE
+TSTNTR, 0 /CALLED FROM FIELD 0
+ TAD PFILE
+ TAD C4
+ DCA PFILE
+ TAD I PFILE
+ ISZ PFILE
+ DCA ODEVNO
+ TAD OUHND /THIS LOC. IS SET UP AT INIT. TIME
+ DCA OUHNDL
+ CIF 0
+ JMS I (MINCOR
+ JMS I (200
+ 13 /RESET OUTPUT DEVICE
+ TAD ODEVNO /LOAD OUTPUT DEVICE
+ JMS I (200
+ 1
+OUHNDL, 7400
+ JMP F2ERR
+ TAD PFILE
+ DCA ENAME /POINTS TO FILE NAME
+ DCA OULNGT /ZERO CLOSING LENGTH
+ TAD ODEVNO /LOAD DEVICE NUMBER AND REQUESTED LENGTH
+ JMS I (200
+ 3 /ENTER
+ENAME, 0 /POINTER INTO COMMAND DECODER AREA GOES HERE
+ OUCHCT=ENAME
+ELENGT, 0 /"0 LENGTH" MEANS AS LARGE A SPACE AS POSSIBLE
+ JMP F2ERR /COULDN'T ENTER FILE - MAYBE BAD DIRECTORY
+ TAD ENAME /GET STARTING BLOCK #
+ DCA OUTREC /STORE IT AWAY
+ JMS OUSPTR /INITIALIZE OUTPUT ROUTINE
+ENTRTN, CDF CIF 0
+ JMP I TSTNTR
+OUSPTR, 0
+ TAD POUBUF
+ DCA I (OUPTR
+ TAD (-601
+ DCA OUCHCT
+ TAD (OUJMPE
+ DCA I POUJMP
+ JMP I OUSPTR
+OUTDMP, 0
+ CIF 0
+ JMS I OUHNDL
+ 4200
+POUBUF, 1200 /REMAINDER OF OLD SABR INPUT BUFFER
+OUTREC, 0
+ JMP F3ERR
+ ISZ OUTREC
+ JMS OUSPTR
+ ISZ OULNGT
+ ISZ ELENGT
+ JMP I OUTDMP
+ JMP F2ERR
+OUCLOS, 0
+ TAD OUT232 /PUT A ^Z IN THE OUTPUT FILE
+ JMS OUCHAR
+ TAD OUCHCT
+ CMA
+ SZA CLA
+ JMP .-4 /FILL REMAINDER OF BUFFER WITH ZEROS
+ JMS OUTDMP
+ CIF 0
+ JMS I (MINCOR
+ TAD ODEVNO
+ JMS I (200
+C4, 4 /CLOSE
+PFILE, 7574
+OULNGT, 0
+ JMP F2ERR /ERROR ON CLOSE
+ DCA OULNGT
+ CIF 0
+ JMP I OUCLOS
+OUT232, 232
+ODEVNO, 0
+OUHND, 0 /SET UP AT INIT. TIME TO ALLOW 2 PAGE HNDLR
+ /IF NEEDED
+ *6610 /OUTPUT ROUTINE - CANT GO PAST 6661
+OUJMX, CDF 0
+ OUJMPE=JMP .
+OUJMP, OUJMPE
+ JMP OUCHA1
+ JMP OUCHA2
+OUCHA3, TAD OUTEMP
+ RTL
+ RTL
+ DCA OUTEMP
+ TAD OUJMPP
+ DCA OUJMP
+ TAD OUTEMP
+ AND OU7400
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD OUTEMP
+ RTL
+ RTL
+ AND OU7400
+ TAD I OUPTR
+ DCA I OUPTR
+ ISZ OUPTR
+ JMP OUCOM
+OUCHA2, TAD OUPTR
+ DCA OUPOLD
+ ISZ OUPTR
+OUCHA1, TAD OUTEMP
+ AND OU377
+ DCA I OUPTR
+OUCOM, CDF 10
+ JMP I .+1
+ OUCRET
+OUPTR, 0
+OUJMPP, OUJMPE
+OUPOLD, 0
+OUTEMP, 0
+OU7400, 7400
+OU377, 377
+\f /PATCHES TO SABR TO HOOK INTO THESE WONDERFUL ROUTINES
+ *4574 /OLD "INITR" ROUTINE AREA - 4 LOCATIONS LONG
+SYMPRT, 0 /INTERMEDIATE ROUTINE TO PRINT SYMBOL TABLE
+ JMS I PRSYMP /CALL SABR'S ROUTINE
+ CIF 0
+ JMP I SYMPRT /BUT RETURN TO FIELD 0
+
+ *4641 /CODE IN THIS SECTION CAN'T GO PAST 4704
+FETCH, 0 /REPLACES ROUTINE IN SABR OF SAME NAME
+ CDF CIF 0
+ JMS I .+2
+ JMP I FETCH
+ INCHAR
+
+LDRCT, 7700 /FOR LEADER-TRAILER ROUTINE ON SAME PAGE
+
+USYMFG, 0 /ROUTINE TO GIVE UNDEFINED SYMBOL MESSAGES WHEN
+ JMS I CTYPE /NO SYMBOL TABLE IS REQUESTED
+SYMXX, JMP I USYMFG /ZEROED IF CHECKING FOR UNDEFINEDS
+ TAD SYMBOL
+ DCA I PLLFS /SET UP SABR CELLS SO THAT ERROR ROUTINE WILL
+ DCA LINE /PRINT THE NAME OF THE UNDEFINED SYMBOL
+ TAD U2300 /FUDGE FOR "U" ERROR MESSAGE - UNFORTUNATELY,
+ JMP I .+1 /THIS MESSAGE IS INSTANTLY FATAL - SERVES HIM RIGHT
+ F1ERR
+PLLFS, LLFS /RANDOM LOCATION IN SABR
+U2300, 2300
+
+TDUMMY, 0 /DUMMY OUTPUT ROUTINE
+ CLA
+ JMP I TDUMMY /AS DUMMY AS YOU CAN GET
+
+ *6133 /PATCH TO SYMBOL TABLE PRINTER TO USE ABOVE
+ JMS I 6177 /THIS REPLACES A "JMS I CTYPE"
+ *6177
+ USYMFG /LUCKILY THERE WAS A LOCATION FREE
+
+ *3665 /REWRITE OF OCTAL TYPEOUT ROUTINE TO
+ DCA TEM1 /NOT KEEP INFORMATION IN THE LINK ACROSS
+ TAD M4 /A CALL TO THE OUTPUT ROUTINE
+ DCA TEM2
+L62A, TAD TEM1
+ RTL
+ RAL
+ DCA TEM1
+ TAD TEM1
+ RAL
+ *3702
+ JMP L62A
+
+ *4317 /"PAUSE" PROCESSOR
+ CLA /REPLACES CLA HLT
+ CDF CIF 0
+
+ *4332 /PATCHES TO INITIALIZATION ROUTINE
+ NOP /DON'T GIVE
+ NOP /TWO USELESS CARRIAGE RETURN - LINE FEED PAIRS
+
+ *4341
+ NOP /DON'T JMS I 4372 'CAUSE WE HAVE CHANGED 4372!
+
+ *4372 /MORE "PAUSE" FUDGE
+ SPAUSE
+
+ *4715 /ALTER COUNT ON LEADER-TRAILER
+ TAD LDRCT
+
+ *561 /"END" STMT PROCESSOR
+ CIF 0
+ JMP I PEND /END OF PASS 1
+ ENDRSM=.
+
+ *565 /MORE ON "END"
+ NOP /ELIMINATE HALT AT END OF PASS 1
+
+ *570 /STILL MORE ON "END"
+ CDF CIF 0
+ JMP I SEND /END OF PASS 2
+
+ *576 /THERE ARE (WERE) TWO WHOLE FREE LOCATIONS IN THIS PAGE!
+SEND, SBREND
+PEND, PASEND
+
+ *2761 /FATAL ERROR HALT IN ERROR ROUTINE
+ CDF CIF 0
+ JMP I 166 /166 = LITERAL 7600
+
+ *4003 /LISTING ROUTINE
+ SKP CLA /ALWAYS PUT LISTING ON "PUNCH"
+
+ *PUNCH /POINTER TO PUNCH ROUTINE
+ OUCHAR /POINTER TO MY PUNCH ROUTINE
+/
+ *200
+ VERNUM
+ JMS I .-1
+/
+ *7000
+VERNUM, 0
+ JMS I CRLF
+ TAD I POINT
+ JMS I CTYPE
+ ISZ POINT
+ ISZ COUNT
+ JMP .-4
+ JMS I CRLF
+ DCA I TYPE
+ JMP I VERNUM
+/
+POINT, TITLE
+COUNT, -5
+TITLE, TEXT /SABR V18A /
+ $
+\f
+\r\f
--- /dev/null
+/ARCTANGENT ROUTINE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 11A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+ ENTRY ATAN
+
+ATAN, BLOCK 1
+ 11
+ TAD ATAN
+ DCA L4
+ TAD ATAN#
+ DCA L4#
+ INC ATAN#
+ INC ATAN#
+ CALL 1,IFAD
+L4, ARG 0
+ CLL
+ TAD ACH
+ SNA
+ JMP EXIT
+ SPA
+ TAD (4000
+ DCA ACH /TAKE ABSVAL OF ARGUMENT
+ RAR
+ DCA SIGN /AND REMEMBER SIGN
+ TAD ACH
+ TAD (-2014
+ SPA CLA
+ JMP LSTN45 /IF ARG>1,
+ JMS INVRS /INVERT ARG - SUBTRACT RESULT FROM PI/2
+ CLA CMA
+LSTN45, DCA L4# /L4# IS THE "PI/2-RESULT" SWITCH
+ TAD ACH
+ TAD (-1774 /THIS IS AN APPROXIMATE TEST TO SEE
+ SPA CLA /IF THE NEW ARG IS <2-SQRT(3)
+ JMP LSTN15 /IF IT IS,
+ CALL 1,FAD /PERFORM A "DIFFERENCE OF TANGENTS"
+ ARG SQRT3 /TRANSFORMATION TO SUBTRACT PI/6
+ TAD (20
+ JMS INVRS /FROM THE RESULT. THE ARG IS TRANSFORMED
+ CALL 0,CHS /INTO SQRT(3)-4/(ARG+SQRT(3))
+ CALL 1,FAD
+SQT3, ARG SQRT3
+ CLA CMA
+LSTN15, DCA INVRS /USE INVRS AS A SWITCH TO INDICATE THIS
+ CALL 1,STO /TRANSFORMATION OCCURRED
+ ARG T
+ TAD (-4
+ DCA L4
+ TAD SQT3#
+ DCA L3#
+ATLOOP, INC L3# /NOW PERFORM A STANDARD TAYLOR SERIES
+ INC L3# /EXPANSION (WITH TRUNCATED COEFFICIENTS)
+ INC L3#
+ CALL 1,FAD /CONVERGENCE WILL BE GOOD SINCE WE
+L3, ARG SQRT3 /HAVE MADE THE ARGUMENT BE <.3
+ JMS FMPT
+ JMS FMPT
+ ISZ L4
+ JMP ATLOOP
+ JMS FMPT
+ CALL 1,FAD
+ ARG T /FINISH UP THE SERIES
+ ISZ INVRS
+ JMP NOPI6
+ CALL 1,FAD /ADD PI/6 IF NECESSARY
+ ARG PIOVR6
+NOPI6, ISZ L4#
+ JMP NOPI2
+ CALL 0,CHS /SUBTRACT FROM PI/2 IF NECESSARY
+ CALL 1,FAD
+ ARG PIOVR2
+NOPI2, TAD SIGN
+ TAD ACH /SET SIGN OF RESULT = SIGN OF ARGUMENT
+ DCA ACH
+EXIT, RETRN ATAN
+
+INVRS, 0 /INVERSION SUBROUTINE
+ TAD (2014 /ENTERED WITH AC=0 OR 20
+ DCA L4 /AC=0 MEANS 1/FAC, AC=20 MEANS 4/FAC
+ CALL 1,STO
+ ARG T
+ TAD L4
+ DCA ACH /ACM AND ACL WERE CLEARED BY STORE
+ CALL 1,FDV
+ ARG T
+ JMP I INVRS
+
+FMPT, 0 /SUBROUTINE TO MULTIPLY BY T
+ CALL 1,FMP /SAVES A FEW MEASLY LOCATIONS
+ ARG T
+ JMP I FMPT
+
+SIGN, 0 /CELL FOR HOLDING SIGN OF ARG
+T, BLOCK 3 /FLOATING TEMPORARY
+
+ PAGE
+
+PIOVR6, 2004;1405;2216 /PI/6
+PIOVR2, 2016;2207;7325
+SQRT3, 2016;7331;7272 /SQRT(3)
+/THE NEXT 4 NUMBERS MUST IMMEDIATELY FOLLOW SQRT3
+ 1756;0462;4562 /APPROXIMATELY 1/9
+ 5764;4221;3403 /APPROXIMATELY -1/7
+ 1766;3141;6672 /APPROXIMATELY 1/5
+ 5775;2525;2337 /APPROXIMATELY -1/3
+
+ END
+\f
--- /dev/null
+/1.1 OS8 BINARY MAP (BITMAP) V4
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/NO CHANGES MADE FOR OS/8 V3C
+
+ VERSION= 4
+ SUBVER= 01 /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+
+XR= 10
+LOADXR= 11
+XFIELD= 20 /HOLDS FIELD WE ARE "STORING" INTO
+ORIGIN= 21 /HOLDS CURRENT ORIGIN
+OUT= 22
+B1= 23
+B3= 24
+C1= 25
+COLCTR= 27
+WD= 30
+WD1= 31
+WD2= 32
+FILPTR= 33
+FLDNO= 35
+
+/OS/8 EQUIVALENCES
+
+MPARAM= 7643
+JSBITS= 7746
+MIFILE= 7617
+PTP= 20
+DCB= 7760
+
+/BUFFER AND DEVICE HANDLER ASSIGNMENTS
+
+OUCTL= 4200
+OUBUF= 6000
+OUDEVH= 6400
+\f FIELD 1
+ *2000
+
+BITMAP, JMP CALLCD
+ JMP NOCD /CHAINED ENTRY POINT
+NEXTCD, TAD I (MPARAM-1
+ SPA CLA
+ JMP I (BUILD /ALTMODE TERMINATES INPUT, STARTS OUTPUT
+CALLCD, JMS I (200
+ 5 /COMMAND DECODE
+ 0216 /DEFAULT EXTENSION IS .BN
+NOCD, TAD (LDRPCH
+ DCA OUT
+ ISZ ONCE
+ JMP CDCOOL
+ CLA CLL CMA RTL
+ CDF 0
+ AND I (JSBITS /REMOVE "DON'T CARE ABOUT CD AREA" BIT
+ DCA I (JSBITS
+ CDF 10
+ JMS I (CTINIT
+CDCOOL, TAD I (MPARAM+1
+ AND (100
+ SZA CLA /IS /R SWITCH ON?
+ JMS I (CTINIT /YES - RE-INITIALIZE LOADER TABLES
+LD7400, 7400
+ TAD (MIFILE
+ DCA FILPTR
+ JMP I (NEWFIL
+ONCE, -1
+\f/SUBROUTINE TO "LOAD" A WORD.
+/INCREMENTS TWO-BIT QUANTITY CORRESPONDING TO THE WORD.
+/FIELD 0 IS MAPPED INTO WORDS 00000-01377,FIELD 1 INTO 01400-02777
+/FIELDS 4-7 ARE MAPPED INTO 20000-25777
+
+LOADWD, 0 /ENTER WITH LOW 4 BITS OF ORIGIN IN AC
+ CLL RAL
+ TAD (BITTBL-1
+ DCA LOADXR
+ TAD I LOADXR /GET WORD IN THE 3-WORD SET
+ DCA LDOFST /(WHICH MAPS 16 WORDS)
+ TAD I LOADXR /GET THE LOW ORDER BIT OF THE PAIR
+ DCA LDBIT /WHICH MAPS THIS WORD
+ TAD ORIGIN /NOW FIND OUT WHICH TRIPLEWORD TO USE
+ RTL
+ RTL
+ AND (7407
+ TAD XFIELD
+ RTL
+ RTL
+ CDF 0
+ RTL
+ RAL
+ SZL
+CDF20Y, CDF 20 /NOP'ED IF NO FIELD 2 IN MACHINE
+ CLL RTR /FIELDS 4-7 MAPPED IN FIELD 2
+ DCA LTEMP
+ TAD LTEMP
+ CLL RAL
+ TAD LTEMP
+ TAD LDOFST
+ DCA LTEMP
+ TAD LDBIT
+ CLL RAL
+ TAD LDBIT
+ AND I LTEMP
+ SNA CLA /IF COUNT IS AT 3 (MAX),
+ JMP I LOADWD /DON'T INCREMENT IT
+ TAD LDBIT
+ CIA
+ TAD I LTEMP
+ DCA I LTEMP
+ RDF
+ CDF 10
+ SZA CLA
+ DCA I (F4FLAG /SEARCH FIELD 2 IF WE STORED THERE
+ JMP I LOADWD
+LDOFST, 0
+LDBIT, 0
+LTEMP, 0
+\f/BIT TABLE FOR MAPPING
+
+BITTBL, 0;2000;0;400;0;100;0;20;0;4;0;1
+ 1;2000;1;400;1;100;1;20;1;4;1;1
+ 2;2000;2;400;2;100;2;20;2;4;2;1
+ PAGE
+\fNEWFIL, TAD (7001
+ DCA HANDLR
+ TAD I FILPTR
+ AND (7760
+ SZA /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
+ TAD (17
+ CLL CML RTR
+ RTR
+ DCA RCDCNT
+ TAD I FILPTR
+ ISZ FILPTR
+ SNA
+ JMP I (NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES
+ JMS I (200
+ 1 /ASSIGN
+HANDLR, 7001 /LOAD INTO 7000 IF NOT ALREADY LOADED
+ JMP I (IOERR
+ TAD I FILPTR
+ DCA RECNO
+ ISZ FILPTR
+ CLA CMA
+ DCA CHCNT
+ DCA REOF
+ TAD I (MPARAM /TEST FOR /I
+ AND (10
+ SNA CLA
+ JMP I (LOADER /I IS NOT ON
+ JMP I (OERR /NO!
+\fGETCH, 0 /GET-NEXT-INPUT-CHARACTER ROUTINE
+ JMS I (CTCTST
+ ISZ JMPGET
+ ISZ CHCNT
+JMPX, JMP JMPGET
+ TAD REOF
+ SZA CLA
+ JMP I GETCH /EOF REACHED BEFORE LOGICAL END - ERROR
+ CLL
+ TAD RCDCNT
+ TAD (6
+ SNL
+ DCA RCDCNT
+ SZL
+ ISZ REOF
+ CLL CMA CML RTR
+ RTR
+ RTR
+ TAD (1411
+ DCA RCTL
+ CIF 0
+ JMS I HANDLR
+RCTL, 0 /READ RECORDS INTO FIELD 1
+PBUFFR, BUFFER
+RECNO, 0
+ JMP RERROR
+ TAD RECNO
+ TAD (6
+ DCA RECNO
+ TAD (-4401
+ DCA CHCNT
+ TAD PBUFFR
+ DCA CHPTR
+ TAD JMPX
+ DCA JMPGET
+ JMP GETCH+1
+\fJMPGET, JMP .
+ JMP CHAR1
+ JMP CHAR2
+ TAD JMPX
+ DCA JMPGET
+ TAD I CHPTR
+ AND (7400
+ CLL RTR
+ RTR
+ TAD CHTMP
+ RTR
+ RTR
+ ISZ CHPTR
+ JMP GCHCOM
+CHAR2, TAD I CHPTR
+ AND (7400
+ DCA CHTMP
+ ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM, AND (377
+ ISZ GETCH
+ JMP I GETCH
+RERROR, SPA CLA
+ JMP I (IOERR /AN ACTUAL READ ERROR - AMAZING!
+ ISZ REOF
+ JMP RECNO+2
+REOF, 0
+CHCNT, 0
+CHPTR, 0
+CHTMP, 0
+RCDCNT, 0
+\fZTST, 0 /TEST A BLOCK OF THE BITMAP FOR ALL ONES
+ DCA B3 /LENGTH OF THE BLOCK IN AC
+ TAD LOADXR
+ DCA XR
+ STA
+ JMS I (XCDF
+ AND I XR
+ ISZ B3
+ JMP .-2
+ CDF 10
+ CMA
+ SZA
+ JMP I ZTST
+ TAD XR
+ DCA LOADXR /UPDATE LOADXR IF ALL ZEROES
+ JMP I ZTST
+ PAGE
+\fITSOVR, JMS ASSEMB /GET THE CHECKSUM
+ CIA
+ TAD LCKSUM
+ SZA CLA /IS IT GOOD?
+ JMP I (BADCKS /NO
+ TAD I (MPARAM+1
+ AND L40
+ SNA CLA /IF /S IS NOT SET,
+ JMP I (NEWFIL /ONLY ONE PROGRAM PER FILE.
+LOADER, DCA LCKSUM
+ JMS GETFLD
+ DCA XFIELD
+ TAD (200
+ DCA ORIGIN /INITIALIZE FOR PROGRAM
+ JMS I (GETCH
+ JMP I (NEWFIL
+ SNA
+ JMP .-3
+ TAD (-200 /FIND SOME LEADER
+ SZA CLA
+ JMP LOADER+1
+LEADER, JMS I (GETCH
+ JMP I (NEWFIL
+ SNA
+ JMP LOADER+1
+ TAD (-200 /FIND END OF LEADER
+ SNA
+ JMP LEADER
+NEWWD, SMA /FIELD SETTING?
+ JMP FIELDW /YES
+ TAD (200
+ DCA WD1 /STORE 1ST CHAR
+ JMS I (GETCH
+ JMP I (BADINP
+ DCA WD2 /2D CHAR
+ JMS I (GETCH
+ JMP I (BADINP
+ TAD (-200 /IF THIS IS LEADER, WE HAVE THE CHECKSUM
+ SNA
+ JMP ITSOVR
+ DCA WD
+ JMS ASSEMB
+ SNL /ORIGIN OR DATA?
+ JMP DATAWD /DATA
+ DCA ORIGIN
+ JMP GETNXT
+\fDATAWD, CLA
+ TAD ORIGIN
+ AND (17
+ JMS I (LOADWD /GO SET THE CORRECT BIT(S)
+ CDF 10
+ ISZ ORIGIN
+L40, 40
+GETNXT, TAD WD1
+ TAD WD2
+ TAD LCKSUM
+ DCA LCKSUM
+ TAD WD
+ JMP NEWWD
+
+ASSEMB, 0
+ TAD WD1
+ CLL RTL
+ RTL
+ RTL
+ TAD WD2
+ JMP I ASSEMB
+
+FIELDW, TAD (-32
+ SNA
+ JMP CTLZ
+ TAD (-46
+ SPA
+ JMP NOTXP
+ DCA WD1
+ TAD WD1
+ AND (7
+ SZA CLA
+ JMP NOTXP
+ TAD WD1
+ AND (70
+ DCA XFIELD
+ JMS I (GETCH
+ JMP I (BADINP
+ TAD (-200
+ SZA
+ JMP NEWWD
+NOTXP, CLA
+ TAD LCKSUM
+ SNA CLA
+ JMP LOADER
+ JMP I (BADINP
+LCKSUM, 0
+
+CTLZ, TAD LCKSUM
+ SZA CLA
+ JMP I (BADINP
+ JMP I (NEWFIL
+\fGETFLD, 0 /ROUTINE TO CHECK FOR OPTION 0-7
+ DCA C1 /AND RETURN LOWEST-NUMBERED VALUE
+ TAD I (MPARAM+2
+ AND (1774
+ SNA
+ JMP I GETFLD
+ RTL
+ RAL
+ ISZ C1
+ SNL
+ JMP .-3
+ CLA CMA
+ TAD C1
+ CLL RTL
+ RAL
+ JMP I GETFLD
+ PAGE
+\fERPCH, 0
+ AND (77 /GET LOW ORDER 6 BITS
+ SZA
+ JMP NZCHAR
+ JMS ERR
+FILMSG, TEXT /, FILE 0/
+ JMP I (BITMAP
+NZCHAR, TAD (240
+ AND (77
+ TAD (240
+ JMS I OUT /PRINT
+ JMP I ERPCH /AND RETURN
+
+LDRPCH, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I LDRPCH
+
+ERR, 0
+ CLA
+ CDF 10
+ TAD I (FILPTR /ZERO CHAR GETS REPLACED BY "FILE #"
+ TAD (322 /MAGIC NUMBER
+ CLL CML RAR /AC NOW CONTAINS " #"
+ DCA FILMSG+3
+ERRLUP, TAD I ERR
+ SNA
+ JMP EOMESG /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
+ RTR
+ RTR
+ RTR
+ JMS ERPCH
+ TAD I ERR
+ JMS ERPCH
+ ISZ ERR
+ JMP ERRLUP
+EOMESG, JMS I (ECRLF
+ JMP I ERR /RETURN
+\fIOERR, JMS ERR
+ TEXT %I/O ERROR%
+ JMP I (BITMAP
+BADINP, JMS ERR
+ TEXT /BAD INPUT/
+ JMP I (BITMAP
+BADCKS, JMS ERR
+ TEXT / BAD CHECKSUM/
+ JMP I (BITMAP
+NULERR, JMS ERR
+ TEXT /NO INPUT/
+ JMP I (BITMAP
+OUTERR, TAD (LDRPCH
+ DCA OUT
+ JMS ERR
+ TEXT /ERROR ON OUTPUT DEVICE/
+ JMP I (CALLCD
+OERR, JMS ERR
+ TEXT %NO /I!%
+ JMP I (BITMAP
+\fCTINIT, 0
+ CLA CLL CML RTR
+ DCA C1
+ DCA B1
+ DCA 0 /STRAIGHT-8 CROCK
+CTINLP, CDF 0
+ CLA CMA
+ DCA I B1
+CDF20X, CDF 20
+ STA
+ DCA I B1
+ JMP CTFLD2 /*** THIS INSTR SKIPPED IF 8K PDP-8!!!
+ DCA CDF20X /DUE TO BUG IN EXTENDED MEMORY CONTROLLER
+ TAD ERR+1 /A CLA
+ CDF 10
+ DCA I (CDF20Y
+CTFLD2, ISZ B1
+ ISZ C1
+ JMP CTINLP
+ CDF 10
+ JMP I CTINIT
+ PAGE
+\f/GENERAL OUTPUT ROUTINES
+
+ /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE
+ /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
+
+ /JMS I (OCHAR OUTPUTS A CHARACTER
+ /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT
+
+ /JMS I (OCLOSE CLOSES THE OUTPUT FILE
+ /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
+
+ /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC
+
+
+
+ /PARAMETERS NEEDED:
+
+ /OUBUF= ADDRESS OF OUTPUT BUFFER
+ /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
+ /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER
+
+ /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
+ /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
+
+OUFLD= OUCTL&70
+\fOOPEN, 0
+OU7600, 7600
+ TAD OU7601
+ DCA OUBLK
+ TAD (OUDEVH+1
+ DCA OUHNDL
+ CDF 10
+ TAD I (7604
+ SNA /IF OUTPUT HAS NO EXTENSION,
+ TAD (1520 /GIVE IT THE EXTENSION .MP
+ DCA I (7604
+OUASGN, TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+ AND (17 /STRIP OFF ANY LENGTH INFO
+ SNA /IS THERE AN OUTPUT DEVICE?
+ JMP USETTY /NO - INHIBIT OUTPUT
+ JMS I (200
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ HLT /HUH?
+OUENTR, TAD I OU7600
+ JMS I (200
+ 3 /ENTER OUTPUT FILE
+OUBLK, 7601 /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
+ DCA OUCCNT
+ JMS I (OUSETP
+ CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OOPEN
+OEFAIL, TAD I OU7600
+ AND (7760 /GET REQUESTED LENGTH
+ SNA CLA /WAS IT AN INDEFINITE REQUEST
+ JMP I (OUTERR /YES - CANNOT ENTER THE FILE
+ TAD I OU7600
+ AND (17 /MAKE THE REQUESTED LENGTH ZERO
+ DCA I OU7600
+ JMP OUENTR /TRY, TRY AGAIN
+USETTY, DCA TTYNO
+ JMS I (200
+ 12
+ 5524
+TTYNO, 0
+ 0
+ HLT /NO TELETYPE!
+ TAD TTYNO
+ DCA I OU7600
+ JMP OUASGN
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ CDF 10
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
+ JMP I (OUTERR /YES - SIGNAL OUTPUT ERROR
+ CIF 0
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMP I (OUTERR
+ JMP I OUTDMP
+\fOCLOSE, 0
+ CDF 10
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
+ SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
+ TAD (232 /OUTPUT A ^Z
+ JMS I (OCHAR
+ JMS I (OCHAR
+FILLLP, JMS I (OCHAR
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+ TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
+ TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
+ JMS OUTDMP
+NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER
+ JMS I (200
+ 4 /CLOSE THE OUTPUT FILE
+OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
+OUCCNT, 0
+ JMP I (OUTERR
+ CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OCLOSE
+ PAGE
+\fOUCTMP= OUCTL&3700
+OUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
+ TAD (-OUCTMP /GET SIZE OF BUFFER IN DOUBLEWORDS
+ DCA OUDWCT
+ TAD (OUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
+ JMP I OUSETP
+
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ RDF
+ TAD CDIF0
+ DCA OUCRET
+ CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ TAD OUTEMP /ORDER 4 BITS OF THIRD CHAR
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
+ JMP OUCRET
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCRET
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+\fOTYPE, 0
+ RDF
+ TAD CDIF0
+ DCA OTRTN
+ CDF 10
+ TAD I (7600
+ AND (17
+ TAD (DCB-1
+ DCA OUTEMP
+ TAD I OUTEMP
+OTRTN, HLT
+ JMP I OTYPE
+
+DOBITS, 0
+ DCA B3
+ JMS I (XCDF
+ TAD I LOADXR
+ CDF 10
+ DCA B1
+BITLP, TAD B1
+ CLL RTL
+ DCA B1
+ TAD B1
+ CMA CML RAL
+ AND (3
+ TAD (260
+ JMS I OUT
+ ISZ COLCTR
+ TAD COLCTR
+ AND (7
+ SZA CLA
+ JMP BITISZ
+ TAD I (TTOFLG
+ SNA CLA /IF OUTPUT IS NOT TO TTY,
+ TAD (240 /PUT A SPACE AFTER EVERY GROUP OF 8
+ SZA
+ JMS I OUT
+BITISZ, ISZ B3
+ JMP BITLP
+ JMP I DOBITS
+\fCTCTST, 0
+ TAD (200
+ KRS
+ TAD (-203
+ SNA CLA /IS THE TELETYPE BUFFER A ^C
+ KSF /WITH THE TELETYPE FLAG ON?
+ JMP I CTCTST /NO
+CDIF0, CDF CIF 0 /YES - GO TO MONITOR
+ JMP I (7605 /THROUGH THE "DON'T SAVE CORE" RETURN
+
+ PAGE
+\fBUILD, STA
+ DCA SOMTHN
+ TAD (-10
+ DCA FLDNO
+ TAD MAPSKP
+ DCA F4SKP /INITIALIZE ONCE-ONLY SKIP
+FLDLP, TAD FLDNO
+ AND (4
+ CLL RTL
+ TAD (CDF
+ DCA CDFX /STORE A CDF 0 OR CDF 20
+ TAD FLDNO
+ RTR
+ SZL SPA CLA /IF FLDNO IS 0 OR 4,
+ JMP NOT04 /INITIALIZE LOADXR TO 0
+F4SKP, SKP
+F4FLAG, JMP MAPOVR /ZEROED IF INFO IN FIELD 2
+ DCA F4SKP
+ STA
+ DCA LOADXR
+NOT04, TAD (-1400
+ JMS I (ZTST
+ SZA CLA /FIELD EMPTY?
+ JMP NONEMP /NO
+FLDISZ, ISZ FLDNO
+ JMP FLDLP
+MAPOVR, ISZ SOMTHN /WAS THERE ANY INPUT?
+MAPSKP, SKP
+ JMP I (NULERR
+ JMS I (ECRLF
+ JMS I (ECRLF
+ JMS I (OCLOSE
+ CDF CIF 0
+ JMP I (7605
+
+NONEMP, ISZ SOMTHN /HAVE WE OUTPUT ANYTHING YET?
+ JMP NOTFST
+ JMS I (OOPEN /NO - OPEN OUTPUT FILE NOW
+ JMS I (OTYPE
+ SNA CLA /SET MODE OF OUTPUT - /T INVERTS
+ TAD (20 /NORMAL TTY/NO TYY DISTINCTION
+ TAD I (MPARAM+1
+ AND (20
+ DCA I (TTOFLG
+ TAD (OCHAR
+ DCA OUT
+NOTFST, JMS I (EJECT1 /PAGE HEADING
+ TAD (-100
+ DCA PAGECT
+PAGELP, TAD FLDNO
+ TAD (270
+ JMS I OUT
+ TAD PAGECT
+ AND (70
+ CLL RTR
+ RAR
+ TAD (260 /OUTPUT LOC (HIGH 3 DIGITS) AT LEFT MARGIN
+ JMS I OUT
+ TAD PAGECT
+ AND (7
+ TAD (260
+ JMS I OUT
+ TAD (260
+ JMS I OUT
+ TAD (260
+ JMS I OUT
+ TAD (240
+ JMS I OUT
+ DCA COLCTR
+ TAD (-14
+ JMS I (ZTST /IF ALL 64 WORDS ARE ZERO,
+ SNA CLA
+ JMP NO1ND0 /DON'T PRINT LINE
+ TAD (-4
+ DCA SOMTHN
+DOBTLP, TAD (-6
+ JMS I (DOBITS /OUTPUT 4 TRIPLEWORDS FOR 64 LOCATIONS
+ TAD (-6
+ JMS I (DOBITS
+ TAD (-4
+ JMS I (DOBITS
+ ISZ SOMTHN
+ JMP DOBTLP
+NO1ND0, JMS I (ECRLF
+ CLA IAC
+ AND PAGECT
+ SZA CLA
+ JMS I (ECRLF /SKIP A LINE EVERY PDP-8 PAGE
+ TAD PAGECT
+ TAD (41
+ SNA CLA
+ JMS I (EJECT1 /NEW PAGE AT LOCATION 4000
+ ISZ PAGECT
+ JMP PAGELP
+ JMP FLDISZ
+PAGECT, 0
+SOMTHN, 0
+
+XCDF, 0
+CDFX, HLT
+ JMP I XCDF
+ PAGE
+\fEJECT1, 0
+ TAD FLDNO
+ TAD (4070
+ DCA FLDNUM
+ TAD TTOFLG
+ SZA CLA /TELETYPE STYLE OUTPUT?
+ JMP EJKTTY /YES
+ TAD (214 /NO - FORM FEED
+ JMS I OUT
+PRTFLD, JMS I (ERR
+ TEXT / BITMAP V/
+ *.-1
+VERLOC, 60+VERSION^100+SUBVER /V5A, ETC...
+ TEXT / FIELD/
+ *.-1
+FLDNUM, TEXT / 0/
+ JMS ECRLF
+ TAD TTOFLG
+ SNA CLA /IF NOT TTY OUTPUT,
+ JMP EJKLPT /DON'T PRINT HORIZONTAL GUIDE
+
+ JMS I (ERR
+ TEXT / 0000000011111111222222223333333344444444555555556666666677777777/
+ JMS I (ERR
+ TEXT / 0123456701234567012345670123456701234567012345670123456701234567/
+EJKLPT, JMS ECRLF
+ JMP I EJECT1
+\fEJKTTY, TAD (-13
+ DCA EJKTMP
+ JMS ECRLF
+ ISZ EJKTMP
+ JMP ECRLFX
+ JMS I (ERR
+ TEXT /----/
+ JMS ECRLF
+ JMP PRTFLD
+EJKTMP, 0
+
+ECRLF, 0
+ TAD (215
+ JMS I OUT
+ECRLFX, TAD (212
+ JMS I OUT
+ JMP I ECRLF
+
+TTOFLG, 0 /20 IF TTY-STYLE OUTPUT
+ PAGE
+\f BUFFER=.
+ $-$-$
+\f
--- /dev/null
+/2 OS/8 TERTIARY CASSETTE BOOTSTRAP V5
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1973,1974 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f VERSON= 5
+ SUBVER= 01 /SUBVERSION A = 01, ETC
+
+ BINARY=6200
+
+ FIELD 1
+
+ *5200
+
+ CIF CDF 0 /THE SECONDARY BOOTSTRAP BRANCHES HERE OF ALL PLACES
+ JMP I .+1
+ C3STRT /WE WANT TO BE HERE
+
+
+
+/EXPLANATION:
+
+/THE PRIMARY (KEY-IN) BOOTSTRAP CONSISTS OF 32 WORDS
+/AND IS AWFUL PRIMITIVE. IT BARELY MANAGES TO READ IN THE
+/SECONDARY BOOTSTRAP.
+/THE SECONDARY BOOTSTRAP CONTAINS A FULL-FLEDGED BINARY LOADER
+/AND IS USED TO READ IN THE NEXT FILE INTO CORE
+/(BUT NOT OVER ITSELF (LOCS 3600-4040)) AND DOES LITTLE IF ANY
+/I/O ERROR CHECKING. THIS NEXT FILE IS IN FACT THE TERTIARY BOOTSTRAP.
+/THE SECONDARY BOOTSTRAP STARTS UP THE TERTIARY BOOTSTRAP AT
+/LOCATION 15200 WHICH THEN CONTAINS ANOTHER FULL-FLEDGED BINARY LOADER
+/AND IN ADDITION A COMPLETE TWO-PAGE CASSETTE HANDLER.
+/THIS TERTIARY BOOTSTRAP RESIDES IN BUFFER SPACE OF BUILD AND
+/READS IN BUILD WITH FULL I/O ERROR CHECKING.
+/WHEN IT IS THROUGH, IT BRANCHES TO BUILD AT LOCATION 02000.
+
+/RECORD SIZES:
+
+/C2BOOT MUST BE 200 BYTES/RECORD
+/C3BOOT MUST BE 200 BYTES/RECORD
+/BUILD MUST BE 300 BYTES/RECORD
+/OS8 MUST BE 300 BYTES/RECORD
+/CD MUST BE 300 BYTES/RECORD
+/MCPIP MUST BE 300 BYTES/RECORD
+/OTHER CUSPS CAN BE ANY RECORD SIZE.
+
+/C2BOOT AND C3BOOT MUST BE 200 BYTES/RECORD BECAUSE THAT'S WHAT THE PRIMARY BOOT READS.
+/THE ONES WHICH MUST BE 300 BYTES/RECORD ARE SUCH BECAUSE
+/THEY ARE USING THE OS/8 CASSETTE HANDLER TO READ IN.
+/OTHERS ARE READ IN BY MCPIP AND CAN BE ANY RECORD SIZE.
+\f FIELD 0
+
+ *5400
+
+C3STRT, CLA
+ JMS I (CSA0
+ 3 /SKIP FILE
+L7400, 7400
+L200, 200
+M200, -200
+ JMS I (CSA0
+ 100 /SKIP HEADER BY READING PAST IT
+
+ BINARY
+M301, -301
+ SKP CLA /ERROR IS OK
+ HLT /GOOD READ IS BAD
+LDABS2, DCA CKSUM
+ JMS GCHAR
+ SNA
+ JMP .-2 /IGNORE BLANKS
+ TAD M200
+ SZA CLA /IS IT LEADER?
+ HLT /NOT BINARY
+LEADER, JMS GCHAR
+ TAD M200 /STILL LEADER?
+ SNA
+ JMP LEADER /YES
+NEWWD, SMA /IS IT LESS THAN 200?
+ JMP FIELDW /NO, IT'S A FIELD SETTING
+ TAD L200 /RESTORE CHAR
+ DCA WD1
+ JMS GCHAR
+ DCA WD2
+ JMS GCHAR
+ TAD M200
+ SNA
+ JMP OVER /200 FINISHES US UP
+ DCA WD /SAVE NEXT WORD FOR LATER
+ JMS ASSEMB /ASSEMBLE PREVIOUS WORD
+ SZL /IS IT AN ORIGIN?
+ JMP ORG /YES
+XFIELD, CDF 0 /ASSUMES BUILD STARTS IN FIELD 0
+ DCA I ORIGIN
+CDF0, CDF 0
+ TAD ORIGIN
+ IAC
+ORG, DCA ORIGIN
+NEXT, TAD WD1
+ TAD WD2 /MAKE UP CHECKSUM
+ TAD CKSUM
+ DCA CKSUM
+ TAD WD
+ JMP NEWWD
+L70, 70
+\fFIELDW, AND L70 /EXTRACT FIELD SETTING
+ TAD CDF0
+ DCA XFIELD
+ JMS GCHAR
+ TAD M200
+ SZA
+ JMP NEWWD
+OVER, JMS ASSEMB
+ CIA
+ TAD CKSUM
+ SZA CLA
+ HLT /BAD CHECKSUM
+ JMP I L200 /START BUILD
+
+ASSEMB, 0
+ TAD WD1
+ CLL RTL
+ RTL
+ RTL
+ TAD WD2
+ JMP I ASSEMB
+
+ORIGIN, 0
+WD1, 0
+WD2, 0
+WD, 0
+CKSUM, 0
+\fCHCNT, -1
+CHPTR, BINBUF
+
+GCHAR, 0
+ ISZ JMPGET /POINT TO CORRECT ROUTINE
+ ISZ CHCNT /NEED WE READ?
+JMPX, JMP JMPGET /NOT YET
+ JMS I (CSA0 /CALL HANDLER
+ 100 /READ ONE PAGE
+BINBUF, BINARY
+L377, 377 /DUMMY BLOCK NO.
+ HLT /I/O ERROR
+ TAD M301
+ DCA CHCNT /NEW CHAR COUNT
+ TAD BINBUF
+ DCA CHPTR
+ TAD JMPX
+ DCA JMPGET
+ JMP GCHAR+1
+JMPGET, JMP .
+ JMP CHAR1
+ JMP CHAR2
+TAD JMPX
+ DCA JMPGET
+ TAD I CHPTR
+ AND L7400
+ CLL RTR
+ RTR
+ TAD CHTMP
+ RTR
+ RTR
+ ISZ CHPTR
+ JMP GCHCOM
+
+CHTMP, 0
+
+CHAR2, TAD I CHPTR
+ AND L7400
+ DCA CHTMP
+ ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM, AND L377
+ JMP I GCHAR
+ PAGE
+\f CODE=0
+
+ KCLR=CODE^10+6700 /CLEAR ALL
+ KSDR=CODE^10+6701 /SKIP ON DATA FLAG
+ KSEN=CODE^10+6702 /SKIP ON ERROR
+ KSBF=CODE^10+6703 /SKIP ON READY FLAG
+ KLSA=CODE^10+6704 /LOAD STATUS A
+ KSAF=CODE^10+6705 /SKIP ON ANY FLAG OR ERROR
+ KGOA=CODE^10+6706 /ASSERT CONTENTS OF STATUS A AND XFER
+ KRSB=CODE^10+6707 /READ STATUS B
+
+ BSW=7002 /BYTE SWAP [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/ 0 WRITE EOF
+/ 1 REWIND
+/ 3 SKIPFILE/BACKFILE
+/ 2 BACKBLOCK
+
+/ 4-7 UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+ VERSION="B&77 /MODIFIED
+\fK3700, 3700 /MUST BE FIRST LOCATION ON PAGE
+UNIT,
+CSA1, VERSION /ENTRY POINT FOR CSA1
+ CLA /PROTECT CODE AGAINST IGNORANT USERS
+ TAD CSA1 /PICK UP ARGUMENTS
+ DCA CSA0 /VIA CSA0
+ STL IAC RAL /TAD (3 [8/I,L,E,F]
+ JMP .+3 /JOIN PROCESSING WITH UNIT 1
+CSA0, VERSION /ENTRY POINT FOR CSA0
+ STL CLA RTL /TAD (2
+ BSW / [8/E,F]
+ DCA UNIT /SAVE UNIT (0 IS 200, 1 IS 300)
+CS, JMS T /INITIALIZATION; REPLACED BY RDF
+ TAD KCIF /FORM RETURN FIELD INSTRUCTION
+ DCA RETCIF /STORE IN RETURN CODE
+ TAD I CSA0 /GET FUNCTION CONTROL WORD
+ DCA FUN /SAVE IT
+ TAD FUN /GET IT BACK AGAIN
+ AND K70 /ISOLATE FIELD OF BUFFER
+ TAD KCDF /FORM CDF TO FIELD OF BUFFER
+ DCA BUFCDF /STORE IN APPROPRIATE SPOT
+ ISZ CSA0 /POINT TO ARGUMENT 2
+ TAD I CSA0 /GET BUFFER ADDRESS
+ DCA BUFFER /SAVE IT
+ ISZ CSA0 /POINT TO ARGUMENT 3
+ TAD I CSA0 /GET BLOCK NUMBER
+ ISZ CSA0 /POINT TO ERROR RETURN
+KCIF, CIF CDF 0 /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
+ SZA CLA
+ JMP NOT1ST /NOT BLOCK 0
+ STL CLA RAR /TAD (4000
+ AND FUN /ISOLATE READ/WRITE BIT
+ TAD UNIT /INSERT UNIT
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ REWIND-. /TO PERFORM A REWIND/INITIALIZATION
+NOT1ST, TAD FUN
+K200, AND K3700 /ISOLATE NUMBER OF BLOCKS TO XFER
+ SNA
+ JMP SPCASE /0 BLOCKS MEANS SPECIAL THING (EOF)
+RECLP, DCA BLKNT /SET COUNT OF NUMBER OF BLOCKS
+ STL CLA RAR /TAD (4000
+ AND FUN /ISOLATE READ/WRITE BIT
+ TAD UNIT /INSERT UNIT
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ RW-. /TO INITIATE READ OR WRITE
+RETRY, SZA /NON-ZERO AC MEANS ERROR
+ JMP RETCIF /TOUGH LUCK BOOBIE - ERROR
+ TAD K7700 /GET READY TO XFER 100 DOUBLE WORDS
+ DCA DBWDCT /SET DOUBLE WORD COUNTER
+ TAD BUFFER /GET START OF BUFFER SEGMENT
+ DCA BPTR /SET 'BPTR'
+BUFCDF, HLT /CHANGE TO DATA FIELD OF USER'S BUFFER
+ TAD FUN
+K7700, SMA CLA /WHICH DIRECTION IS TRANSFER?
+ JMP READ /WANT TO READ
+\fWRITE, TAD I BPTR /WANT TO WRITE, SO GET WORD FROM BUFFER
+ JMS I QGPCH /WRITE
+ TAD I BPTR /GET FIRST WORD AGAIN
+ AND P7400 /ISOLATE FIRST HALF OF BYTE 3
+ DCA T /SAVE FOR FUTURE REFERENCE
+ ISZ BPTR /POINT TO NEXT LOCATION IN BUFFER
+ TAD I BPTR /GET SECOND WORD OF BUFFER PAIR
+ JMS I QGPCH /WRITE BYTE #2
+ TAD I BPTR /RETRIEVE WORD 2
+ AND P7400 /ISOLATE 2ND HALF OF BYTE #3
+ CLL RTR /CREATE MYSTIC HIDDEN BYTE 3
+ RTR
+ TAD T /GOOD THING I STILL HAVE THIS
+ CLL RTR
+ RTR
+ JMS I QGPCH /WRITE BYTE #3
+ JMP COM
+\fREAD, JMS I QGPCH /READ BYTE #1 OF TRIPLE
+ DCA I BPTR /STORE IN WORD 1 OF BUFFER PAIR
+ JMS I QGPCH /READ BYTE #2 OF TRIPLE
+ DCA T /SAVE IT FOR POSTERITY
+ JMS I QGPCH /READ BYTE #3 OF TRIPLE
+ RTL
+ RTL /MYSTIC ROTATES
+ DCA T2
+ TAD T2
+ AND P7400 /AND MYSTIC CONSTANTS
+ TAD I BPTR /FIX UP BUFFER WORD 1 OF PAIR
+ DCA I BPTR
+ TAD T2
+ RTL
+ RTL /MORE ROTATION
+ AND P7400 /AND MORE
+ TAD T
+ ISZ BPTR /POINT TO SECOND WORD OF BUFFER PAIR
+ DCA I BPTR /STORE SECOND WORD
+COM, ISZ BPTR /POINT TO BEGIN OF NEXT BUFFER PAIR
+P7400, 7400 /PROTECTION AGAINST CORE WRAP AROUND
+ ISZ DBWDCT /BUMP DOUBLE WORD COUNT
+ JMP BUFCDF /REITERATE
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ CRC-. /TO CHECK CRC
+ TAD BUFFER /GET BUFFER SEGMENT ADDRESS
+ TAD K200 /ADD 200 TO GET TO NEXT SEGMENT
+ DCA BUFFER /REPLACE
+ TAD BLKNT /GET BLOCK COUNT
+ TAD K7700 /SUBTRAT 100
+ SZA /ARE WE DONE?
+ JMP RECLP /NO, REITERATE
+ ISZ CSA0 /POINT TO NORMAL GOOD RETURN
+RETCIF, HLT /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
+ JMP I CSA0 /RETURN
+\f/ INTIALIZATION ROUTINE - ONCE ONLY CODE
+/ OVERLAID BY TEMPORARIES
+
+T, 0 /ENTRY POINT TO INITIALIZATION
+T2, TAD KRDF /REPLACE CALL BY RDF
+FUN, DCA CS /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
+BUFFER, TAD T /CORRECT ADDRESS OF GPCH
+DBWDCT, TAD KQX1 /BY ADDING IN CS+1
+QGPCH, DCA . /STORE IT HERE
+BLKNT, STL CLA RTL /CORRECT ADDRESS OF CAS IS 2 MORE
+ TAD QGPCH
+QCAS, DCA . /THAN GPCH. STORE IT HERE.
+BPTR, JMP CS /RETURN TO MAIN PROGRAM
+KRDF, RDF
+KQX1, GPCH-CS-1
+
+SPCASE, TAD FUN
+ AND L4003 /ISOLATE R/W BIT + SPECIAL CODE
+ TAD UNIT
+ JMS I QCAS
+ SPCODE-.
+ JMP RETCIF-1 /LEAVE GRACEFULLY
+K70, 70
+KCDF, CDF 0
+L4003, 4003
+ PAGE
+\fGPCH, 0 /READ OR WRITE A BYTE
+ JMP AROUND /GO TO REAL LOCATION OF THIS SUBROUTINE
+CAS, 0 /MUST BE AT GPCH+2; DO CASSETTE STUFF
+ DCA TEMP /SAVE ARGUMENT IN AC
+ CDF 0
+ TAD I CAS /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
+ TAD CAS /RELOCATE IT
+ ISZ CAS /POINT TO NORMAL RETURN LOCATION
+ DCA GPCH /SAVE ENTRY POINT IN TEMPORARY
+ JMP I GPCH /GO TO CORRECT ENTRY POINT
+
+RW, TAD CAS
+ DCA RTRY /SAVE RETRY ADDRESS
+ TAD TEMP /GET ARGUMENT PASSED VIA AC
+ DCA FNUNIT /SAVE
+ CLL STA RTL /TAD (7775
+ DCA ERKNT /SET ERROR COUNT TO -3
+ERETRY, TAD FNUNIT
+ SPA
+ TAD (20 /READ CODE IS 0; WRITE IS 20
+ KLSA /LOAD STATUS A
+ TAD FNUNIT /***KLSA CLEARS BIT 0
+ SMA CLA /READS HAVE TO BE INITIATED
+ JMS CWAIT /READ
+ JMP I RTRY /RETURN
+
+AROUND, DCA TEMP
+ TAD FNUNIT
+ SMA CLA
+ JMP RDCHAR /READ
+ TAD TEMP /WRITE
+ JMS CWAIT
+ JMP I GPCH /RETURN
+
+RDCHAR, JMS CWAIT
+ TAD TEMP /GET CHAR JUST READ
+ JMP I GPCH /RETURN WITH IT IN AC
+\fCRC, TAD FNUNIT
+ TAD (60
+ KLSA /INITIATE READ/WRITE CRC
+ TAD FNUNIT /***KLSA CLEARS BIT 0
+ SMA CLA
+ JMS CWAIT /HAVE TO READ TWICE
+ JMS CWAIT /WRITE CRC WRITES BOTH
+ KCLR /WHY NOT?
+ JMP I CAS /RETURN
+
+REWIND, TAD (10
+ JMS UTIL
+ TAD TEMP
+ SMA CLA
+ JMP I CAS /MERELY REWIND IF READING
+ JMP EOF
+SKIPF, TAD (20
+BACKBL, TAD (10
+EOF, TAD (10
+BACKF, TAD (30
+ JMS UTIL
+ JMP I CAS /RETURN
+
+UTIL, 0
+ TAD TEMP
+ KLSA
+TRYAGN, KGOA
+ KSBF /WAIT FOR READY
+ JMP .-1
+ KRSB
+ AND (10
+ SZA CLA
+ JMP TRYAGN /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
+ JMP I UTIL
+
+TEMP, 0
+ERKNT, 0
+FNUNIT, 0
+RTRY, 0
+
+SPCODE, TAD TEMP
+ AND (3
+ TAD (JMP TABLE
+ DCA J
+ TAD TEMP
+ AND (4300
+ DCA TEMP
+J, HLT
+TABLE, JMP EOF /0 WRITE EOF
+ JMP REWIND /1 REWIND AND WRITE EOF IF BIT 0=1
+ JMP BACKBL /2 BACK BLOCK
+ TAD TEMP /3 SKIP/BACK FILE DEPENDING ON BIT 0
+ SMA CLA
+ JMP SKIPF /FORWARD FILE
+ JMP BACKF /BACK FILE
+\fCWAIT, 0
+ KGOA /ASSERT CONTENTS OF STATUS A
+ DCA TEMP /SAVE ANYTHING READ
+ KSAF
+ JMP .-1 /WAIT FOR SOMETHING TO HAPPEN
+ KSEN /WAS IT AN ERROR?
+ JMP I CWAIT /NO, SO RETURN
+ERR, DCA TEMP /YES ... ERROR
+ KRSB
+ AND (30
+ SNA
+ JMP .+3
+ AND (20
+ JMP I RTRY /END OF FILE IS SOFT ERROR
+ ISZ ERKNT /SHALL WE TRY AGAIN?
+ JMP .+3 /YES
+ STL CLA RAR /TAD (4000
+ JMP I RTRY /RETURN WITH NON-ZERO AC
+ TAD FNUNIT /RETRY
+ TAD (50 /BUT FIRST DO BACKSPACE BLOCK GAP
+ JMS UTIL
+ JMP ERETRY
+
+L7600, 7600
+ $
+\f
--- /dev/null
+/8 COMMAND DECODER FOR OS/8 MONITOR
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975, 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/APRIL 1977 RL/EF/HJ/SR
+
+/ABSTRACT--
+/COMMAND DECODER (CD) ACCEPTS TTY INPUT AND INTERPRETS
+/THAT INPUT AS A LIST OF OPTIONS AND FILE SPECIFICATIONS
+/FOR OS/8 CUSPS. TABLES ARE SETUP INDICATING THE SPECIFIED
+/FILES AND OPTIONS.
+/THIS VERSION OF CD IS CAPABLE OF RUNNING OS/8 BATCH.
+/MODIFICATIONS TO INITIALIZATION CODE HAVE BEEN MADE TO
+/ALLOW THIS.
+
+
+ DCB=7760
+ SHNDLR=7607
+ USERFG=40 /LOCATION IN MAIN OS/8 ASSEMBLY - VOLATILE
+ T1=41 /DITTO
+ MCDREC=51 /ALSO PRETTY VOLATILE
+ MOFILE=7600
+ MIFILE=7617
+ MPARAM=7643
+ FIELD 0 /JUSTINCASE
+
+ CDVERSION=6501 /5A
+ ODTVERSION=6401 /4A
+\f/V3 CHANGES TO CD:
+
+/1. FIXED LOTS OF BUGS
+/ A:B:C IS ILLEGAL
+/ 15-BIT = OPTION DOESN'T DESTROY ALTMODE BIT
+/2. ADDED ? SUPPORT IN SPECIAL MODE
+/3. ALLOWED SPECIAL MODE UNDER BATCH
+/4. REMOVED DCC CODE
+/5. ^U, RO TO BOL, AND LF ALL REPRINT *
+/6. VERSION # AT LOC ZERO
+/7. DON'T LOAD HANDLERS FOR OUTPUT DEVICE
+/8. CHANGED _ TO < STANDARD
+
+/V3 CHANGES TO ODT
+
+/1. REMOVED DCC CODE
+/2. FIXED CORE SIZE ROUTINE
+/3. ALLOWED SOFTWARE CORE SIZE
+/4. MODIFIED 'GO' COMMAND SO THAT IT DOESN'T RESTORE TRAP
+/ LOCATION TO UNMODIFIED VALUE
+/5. FIXED BUG RE: JMS'S OUT OF FIELD WITH MAGIC LOCATION SET
+/6. TURN OFF INTERRUPTS ON BREAKPOINT
+
+/CHANGES AFTER FIELD TEST RELEASE:
+
+/1. FIXED BUG RE FILE LENGTHS GT 2047 BLOCKS
+
+/MAINTENANCE RELEASE:
+
+/ NO CHANGES
+
+/V3D CHANGES:
+
+/CHANGED FORMAT OF VERSION NUMBERS
+\f *200
+CD, JMP I NUMBER /EXECUTED IN SYSGEN
+NUM, JMP I T
+ANALYZ, TAD [BEGLN-1
+ DCA XR
+ TAD I XR
+ SNA
+ JMP NOBKAR
+ TAD [-"<
+ SZA CLA
+ JMP .-5
+ CLA CMA
+NOBKAR, DCA OUTSW
+ TAD [BEGLN-1
+ DCA LXR
+BEGGRP, TAD OUTSW
+ SNA CLA
+ TAD BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS
+ TAD [MOFILE-1
+ DCA CLXR
+ STA
+ DCA DVFLAG
+ DCA DEV1
+FILLP1, DCA DEV2
+FILLP, JMS I [GNAME
+ TAD ["A-": /AC CONTAINED DELIM - "A
+ SNA CLA
+ JMP DEVNAM
+ JMS I [ASSIGN
+ TAD OUTSW
+ SNA CLA
+ TAD LIMDIF /DIFF BETWWEN END OF OUTPUT & INPUT AREAS
+ TAD OUTLIM /END OF OUTPUT AREA
+ TAD CLXR
+ SMA CLA
+ JMP CDER1
+ TAD OUTSW
+ SNA CLA
+LKUPSW, JMP INFILE /ZEROED IF IN "SPECIAL DECODE" MODE
+ CDF 10
+ TAD DVICE
+ DCA I CLXR
+ TAD NAME1
+ DCA I CLXR
+ TAD NAME2
+ DCA I CLXR
+ TAD NAME3
+ DCA I CLXR
+ TAD NAME4
+CDSKP, SKP
+INFILE, JMS I [LOOKUP
+ DCA I CLXR
+DLOOK, CDF 0
+ STA
+ DCA DVFLAG
+ TAD DELIM
+ SNA
+ JMP CDOVER
+ TAD [-"[
+ SNA
+ JMP I [OLENGT
+ TAD ["[-",
+ SNA
+ JMP FILLP
+ TAD [",-"<
+ SNA
+ JMP BKAROW
+ TAD ["<-"=
+ SZA CLA
+ JMP I [CDER2
+EQUAL, DCA NUMFUJ
+ JMS NUMBER
+ DCA I [MPARAM+3
+ CLA CLL CML RAR
+ AND I [MPARAM-1 /PRESERVE ALTMODE
+ TAD HIORD
+ DCA I [MPARAM-1
+ JMP DLOOK
+\fBKAROW, ISZ OUTSW
+ JMP I [CDER2
+ JMP BEGGRP
+DEVNAM, TAD NAME1
+ DCA DEV1
+ ISZ DVFLAG
+ JMP I [CDER2 /CATCHES A:B:
+ TAD NAME2
+ JMP FILLP1
+CDOVER, TSF
+ JMP .-1 /LET PRINTER QUIET DOWN
+ TCF /AND CLEAR FLAG
+ CDF CIF 10
+ TAD TMONIT
+ DCA I [200 /RESTORE "MONITO"
+ TAD TUSRFG
+ DCA I [USERFG /RESTORE "USER FLAG"
+ TAD TFPUTX /LOAD "USER CALLING FIELD" INTO AC
+ JMP I CD /RETURN - MONITOR RESTORES CORE IF NECESSARY
+NUMBER, 4000 /USED BY SYSGEN
+ TAD CDSKP
+ DCA NUMADD /SET NUMADD TO EITHER "SKP" OR "TAD NUM"
+ DCA HIORD
+NUMLP, DCA NUM
+ JMS NUMTST /INTO PAGE 0 FOR RANGE TEST
+ SNL
+ JMP EONUM
+ DCA T
+ CLA CLL CMA RTL
+ DCA DELIM
+ TAD NUM
+ROTLP, CLL RAL
+ DCA NUMX
+ TAD HIORD
+ RAL
+ SPA
+ JMP I [CDER2
+ DCA HIORD
+ TAD NUMX
+ ISZ DELIM
+ JMP ROTLP
+NUMADD, TAD NUM /SKP IF OCTAL
+ TAD NUM
+ TAD T
+ JMP NUMLP
+EONUM, TAD ["0
+ DCA DELIM
+ TAD NUM
+ CDF 10
+ JMP I NUMBER
+\fCDER1, JMS I [PRMESG
+ TEXT /TOO MANY FILES/
+\f IFZERO .&400 <*400>
+ASSIGN, 0
+ TAD CLXR
+ AND DVFLAG
+ TAD OUTLIM
+ SMA SZA CLA /CHECK FOR OUTPUT OR FIRST INPUT
+ JMP ASNORM /IF DEVICE WAS SPECIFIC, OR IF WE ARE ON THE INPUT SIDE,
+ /PROCEED NORMALLY
+ TAD NAME1
+ SNA CLA
+ JMP ASGNST
+ TAD DFLTNM+1
+ DCA DEV2
+ TAD DFLTNM
+ DCA DEV1
+ASNORM, TAD DEV1
+ DCA AS+1
+ TAD DEV2
+ DCA AS+2
+ TAD OUTSW
+ SNA CLA /DON'T LOAD HANDLER IF WE ARE ON OUTPUT SIDE OF "_"
+ TAD NAME1
+SPKLG1, SNA CLA /OR IF THERE IS NO FILE NAME TO LOOK UP
+ TAD GETHND /GETHND=11 NORMALLY, 0 IF IN "SPECIAL DECODE" MODE
+ IAC
+ DCA AS
+ TAD [1401 /ALLOW TWO PAGE HANDLERS
+ DCA ASADR
+ CIF 10
+ JMS I [200
+AS, 0
+ 0
+ 0
+ASADR, 1401
+ JMP I [CDER0
+ TAD AS+2
+ASGNST, DCA DVICE
+ JMP I ASSIGN
+GNAME, 0
+ DCA NAME1
+ DCA NAME2
+ DCA NAME3
+ DCA NAME4
+ TAD [NAME1
+ DCA NMBASE
+ CLA CMA
+ DCA PERDSW
+ DCA NAMECT
+GTNMLP, JMS I [GCH
+ DCA DELIM
+ TAD DELIM
+ TAD [-"?
+ SZA
+ TAD ["?-"*
+ SNA
+STARSW, JMP I [CDER2 /"JMP STARNM" IF "SPECIAL DECODE" MODE
+ TAD ["*-".
+ SNA CLA
+ JMP PERIOD
+ JMS I [DECODE
+ JMP I GNAME
+\fSTARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY
+ TAD DELIM
+ AND [77
+ DCA DELIM
+ TAD NAMECT
+ TAD [-6
+ SMA CLA
+ JMP GTNMLP
+ TAD NAMECT
+ CLL RAR
+ TAD NMBASE
+ DCA TT
+ TAD DELIM
+ SZL
+ JMP .+4
+ RTL
+ RTL
+ RTL
+ TAD I TT
+ DCA I TT
+ ISZ NAMECT
+ JMP GTNMLP
+PERIOD, TAD NAME1
+ SZA CLA
+ ISZ PERDSW
+ JMP I [CDER2
+ ISZ NMBASE
+ TAD [4
+ JMP GTNMLP-1
+LOOKUP, 0
+ DCA LNAME
+ TAD NAME1
+ SNA CLA
+ JMP LKUPST
+ JMP EXT1
+LKUPLP, DCA LNAME
+ TAD AS+2
+ CIF 10
+ JMS I [200
+ 2
+LNAME, 0 /NAME1
+LENGTH, 0
+ JMP LFAILD
+ TAD LENGTH
+ CLL
+ TAD [400
+ SNL
+ CLA
+ CLL RTL
+ RTL
+ AND [7760
+LKUPST, CDF 10
+ TAD DVICE
+ DCA I CLXR
+ TAD LNAME
+ JMP I LOOKUP
+\fLFAILD, TAD NAMECT
+ SNA CLA /WAS THERE AN EXPLICIT EXTENSION?
+ TAD DEFALT /NO - WAS THERE A DEFAULT EXTENSION?
+ SNA CLA
+ JMP I [CDER3 /YES OR NO - FILE NOT FOUND
+ ISZ NAMECT /NO AND YES - SET FLAG TO FAIL NEXT TIME
+ JMP EXT2 /ZERO OUT THE EXTENSION AND TRY AGAIN
+CDER3, JMS I [PRNAME
+ JMS I [PRMESG
+ TEXT / NOT FOUND/
+\f IFZERO .+200&1000 <*600>
+ 0 /V3 [FREE LOC]
+SLSHCH, 0
+/V3 SNA
+/V3 JMP I [CDER2
+ DCA DELIM
+ TAD [MPARAM-1
+ DCA T
+ JMS I [DECODE
+ JMP I [CDER2
+ SZL
+ TAD [32
+ CMA STL /THE FOLLOWING TURNS ON THE CORRECT OPTION BIT
+ DCA TT
+SLSHLP, SZL
+ ISZ T
+ RAR
+ SNL
+ ISZ TT
+ JMP SLSHLP
+ DCA TT
+ CDF 10
+ TAD TT
+ CMA
+ AND I T
+ TAD TT
+ DCA I T
+ CDF 0
+ JMP I SLSHCH
+DECODE, 0
+ TAD DELIM
+ TAD [-"9-1
+ CLL
+ TAD ["9+1-"0
+ SZL
+ JMP DCDYES
+ TAD ["0-"Z-1
+ CLL CML
+ TAD ["Z-"A+1
+ SNL
+DCDYES, ISZ DECODE
+ JMP I DECODE
+CDER0, TAD DEV1
+ JMS I [PRWD
+ TAD DEV2
+ JMS I [PRWD
+ JMS I [PRMESG
+ TEXT / DOES NOT EXIST/
+\f
+RESTRT, JMS I [CRLF
+ CDF 10
+ TAD [MOFILE-1
+ DCA XR
+ TAD [-47
+ DCA T
+ DCA I XR /ZERO OUT THE COMMAND DECODER OUTPUT AREA
+ ISZ T
+ JMP .-2
+ CDF 0
+ JMP I [GLINE
+GCH, 0
+ TAD I LXR
+ TAD [-240
+ SNA
+ JMP GCH+1
+ TAD [240-"/
+ SNA
+ JMP SLASH
+ TAD ["/-"(
+ SNA
+ JMP OPENP
+ TAD ["(
+ JMP I GCH
+SLASH, TAD I LXR
+ JMS I [SLSHCH
+ JMP GCH+1
+OPENP, TAD I LXR
+ TAD [-")
+ SNA
+ JMP GCH+1
+ TAD [")
+ JMS I [SLSHCH
+ JMP OPENP
+OLENGT, TAD OUTSW
+ AND NAME1 /[N] IS ONLY LEGAL ON THE OUTPUT SIDE OF THE "_"
+ SNA CLA /AND ONLY AFTER A FILE NAME
+ JMP I [CDER2
+ TAD [-4
+ TAD CLXR
+ DCA NMBASE
+ CLA CLL CML RTL
+ DCA NUMFUJ /SET "NUMBER" TO ACCEPT DIGITS 8 AND 9
+ TAD OLFUDJ /LOAD FUDGE SO THAT "NUMBER" WILL BE DECIMAL
+ JMS I [NUMBER
+ CLL RTL
+ RTL
+ AND [7760
+ TAD I NMBASE
+ DCA I NMBASE
+ CDF 0
+ TAD DELIM
+ TAD [-"] /IS THERE A CLOSING BRACKET?
+ SNA /IF NOT, "DLOOK" ROUTINE WILL DETECT IT
+ JMS I [GCH
+ DCA DELIM
+ JMP I [DLOOK
+OLFUDJ, NUM&177+1570
+
+CDER2, CLA
+ JMS I [PRMESG
+ TEXT /ILLEGAL SYNTAX/
+\f IFZERO .&1000 <*1000>
+ /TELETYPE INPUT ROUTINE FOR COMMAND DECODER
+GLINE, TAD (252 /SETS 1177=252 FOR * IN MESSAGE
+ JMS I PRINT
+ DCA RBFLAG
+ TAD [BEGLN-1
+ DCA LXR
+CHLOOP, 6031 /KSF
+ JMP CHLOOP
+ TAD [200
+ 6034 /KRS
+ DCA NAME1
+ 6032 /KCC
+ TAD [SPADR-1
+ DCA XR
+DSPCHL, TAD I XR
+ SZA
+ TAD NAME1
+ SNA CLA
+ JMP I XR
+ JMP DSPCHL
+SPADR, -225;JMP CTRLU
+ -215;JMP CARRET
+ -377;JMP RUBOUT
+ -375;JMP ALTMOD /V3D MODIFIED BY SET
+ -376;JMP ALTMOD /V3D MODIFIED BY SET
+ -233;JMP ALTMOD
+ -200;JMP CHLOOP
+ -217;JMP CHLOOP /^O
+ -"_;JMP LESSTN
+ -212;JMP LFEED
+ -203;JMP CTRLC /MUST BE LAST - SEE CLRLIN CODE
+ 0
+ JMS PRNT
+CINSRT, TAD NAME1
+ DCA I LXR
+ TAD LXR
+ TAD [-EOBUFR+2
+ SPA CLA
+ JMP CHLOOP
+ JMS CRLF
+ JMP I [CDER2
+\fCARRET, JMS CRLF
+CLFINI, DCA I LXR
+ JMP I [ANALYZ
+LESSTN, JMS PRNT
+ TAD ["<
+ JMP CINSRT+1
+CTRLC,
+CTRLU, TAD [336
+ JMS I PRINT
+ TAD NAME1
+ TAD [100
+CLRLIN, JMS I PRINT
+ JMS CRLF
+ TAD I XR
+ SZA CLA
+ JMP GLINE
+ CDF 10
+ CLA CMA
+ DCA I [7700
+ TSF
+ JMP .-1
+ JMP I [7605 /7605=CDF CIF 10
+CRLF, 0
+ TAD [215
+ DCA NAME1
+ JMS PRNT
+ TAD [212
+ JMS I PRINT
+ JMP I CRLF
+ALTMOD, TAD [244
+ DCA NAME1
+ CLA CLL CML RAR
+ CDF 10
+ DCA I [MPARAM-1
+ CDF 0
+ JMS PRNT
+ JMP CLFINI
+\f/*** LOCATIONS ON THIS PAGE ARE MODIFIED BY SET
+/SEE SET FOR DETAILS. DO NOT CHANGE.
+
+RUBOUT, TAD LXR
+ TAD [1-BEGLN
+ SNA CLA
+ JMP RBSPCL
+ TAD [334
+ ISZ RBFLAG
+ JMS I PRINT
+ CLA CMA
+ DCA RBFLAG
+ TAD LXR
+ DCA T
+ TAD I T
+ JMS I PRINT
+LBCKUP, CLA CMA
+ TAD LXR
+ JMP CHLOOP-1
+RBSPCL, ISZ RBFLAG
+ JMP CLRLIN+1
+ TAD [334
+ JMP CLRLIN
+PRNT, 0
+ ISZ RBFLAG
+ JMP .+3
+ TAD [334
+ JMS I PRINT
+ DCA RBFLAG
+ TAD NAME1
+ JMS I PRINT
+ JMP I PRNT
+LFEED, JMS CRLF
+ DCA I LXR
+ TAD [BEGLN-2
+ DCA XR
+ TAD I XR
+ SNA
+ JMP LBCKUP
+ JMS I PRINT
+ JMP .-4
+
+ IFNZRO RUBOUT-1131 <_ERROR_>
+\f *1200 /INITIALIZATION - STORED OVER BY LINE BUFFER
+ BEGLN=. /LINE BUFFER
+CDINIT, DCA TFPUTX
+ CDF 10
+ CLA IAC
+ TAD I [200
+ DCA TMONIT /SAVE AWAY MONITOR CALL ADDRESS SINCE WE CALL
+ TAD I [USERFG /THE MONITOR RECURSIVELY, LIKEWISE SAVE
+ DCA TUSRFG /THE "USER FLAG" AND THE FIELD WE WERE CALLED FROM
+ TAD I [T1 /FETCH THE USERS ARGUMENT
+ DCA DEFALT /STORE IN THE DEFAULT EXTENSION WORD
+ DCA I [7 /ZERO "DIRECTORY SEGMENT IN CORE" KEY
+ CDF 0
+ CIF 10
+ JMS I [200
+ 13 /RESET ALL HANDLERS
+ 0 /BUT NOT OUTPUT FILES
+ TAD DEFALT
+ TAD M5200
+ SZA CLA /IS THIS A REQUEST FOR A "SPECIAL DECODE"?
+ JMP CDCONT /NO
+ TAD ALTLIM
+ DCA OUTLIM /YES - SET UP ALL THE PROPER LOCATIONS
+ TAD ALTDF1
+ DCA LIMDIF /TO YIELD 1 OUTPUT FILE AND 5 INPUT FILES
+ TAD ALTDF2
+ DCA BEGDIF /ALL OF WHICH ARE 5-WORD <DEVICE,NAME> ENTRIES
+ DCA I PLKUPS
+ TAD STARJM
+ DCA I PSTARS /AND ALLOW * AS A FILE OR EXTENSION NAME
+ DCA DEFALT /NO DEFAULT EXTENSION IN "SPECIAL" MODE
+ TAD CCLA /STOPS FETCHES IN SPECIAL MODE
+ DCA I PSPKG1 /NO HANDLER FETCHES NECESSARY EITHER SINCE NO LOOKUPS
+CDCONT, TAD I PRWD /SEE IF BATCH FLAG IS UP
+ RAL
+ SPA CLA /IF YES, GO TO PAGE0 CODE
+ JMP TT /TT ETC. IS ONCE-ONLY CODE
+ JMP I CDRST
+\fCDRST, RESTRT+1
+ /CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
+M5200, -5200
+ALTLIM, 1-MOFILE-5
+ALTDF1, MOFILE+5-MPARAM+5
+ALTDF2, 5
+PLKUPS, LKUPSW
+STARJM, STARNM&177+5200 /"JMP STARNM"
+PSTARS, STARSW
+CCLA, CLA
+PSPKG1, SPKLG1
+\f *1314
+ EOBUFR=.
+PRMESG, 0
+ TAD I PRMESG
+ JMS PRWD
+ TAD I PRMESG
+ ISZ PRMESG
+ AND [77
+ SZA CLA
+ JMP PRMESG+1
+ JMP I [RESTRT
+PRWD, 7777
+ DCA T
+ TAD T
+ RTR
+ RTR
+ RTR
+ JMS PCHAR
+ TAD T
+ JMS PCHAR
+ JMP I PRWD
+PCHAR, 0
+ AND [77
+ SNA
+ JMP I PCHAR /IGNORE NULLS
+ TAD [240
+ AND [77
+ TAD [240
+ JMS TYPE
+ JMP I PCHAR
+PRNAME, 0
+ TAD NAME1
+/ SNA /WOULD LIKE TO FIND ROOM FOR THESE 2 LOCS
+/ JMP I [CDER2
+ JMS PRWD
+ TAD NAME2
+ JMS PRWD
+ TAD NAME3
+ JMS PRWD
+ TAD NAME4
+ SNA CLA
+ JMP I PRNAME
+ TAD [256
+ JMS PCHAR
+ TAD NAME4
+ JMS PRWD
+ JMP I PRNAME
+TYPE, 0
+ JMP .+3
+ TSF
+ JMP .-1
+ TLS
+ CLA
+ TAD [7000
+ DCA TYPE+1
+TYPRET, JMP I TYPE
+ IFNZRO TYPRET-1377 <BATCHX,ZQWE>
+\f *4001 /PROG TO WRITE CD AND ODT ONTO NEW SYSTEM DEVICE
+ /4000=JMS SYSSWP TO SWAP PGS 6600 AND 7600
+ TAD I (7777 /SET TO PROPER RECORD FOR FIELD 1 STUFF
+ DCA F1STUF
+ JMS I SYSHND
+ 4600
+ 0
+ MCDREC
+ JMP CERR
+ JMS I SYSHND
+ 5011
+ 0
+ ODTREC
+ JMP CERR
+ JMS I SYSHND
+ 0110 /READ IN UPPER PG 7600
+ 7600
+F1STUF, 0
+ JMP CERR
+ JMP I .+1
+ 7605 /START HER UP
+CERR, TAD .+3
+ DCA 4001
+ JMP 4000 /RESWAP AND HALT
+ HLT
+SYSHND, 7607
+ PAGE
+\f *0
+ CDVERSION
+ HLT /POWER FAIL RESTART PROTECTION
+NUMTST, 7777
+ JMS I [GCH
+ CMA
+ TAD NUMFUJ
+ TAD ["8 /TEST INPUT CHARACTER FOR RANGE
+ CLL CMA /0-7 IF NUMFUJ=0
+ TAD [10 /0-9 IF NUMFUJ=2
+ TAD NUMFUJ
+ JMP I NUMTST
+ *15
+LXR, 0
+XR, 0
+CLXR, 0
+T, CDINIT
+TT, CDF 0 /***GETS SET TO CDF BATCH
+HIORD, TAD I DVICE /CHECK TO SEE IF BOS IS REALLY THERE
+NUMX, TAD OUTSW /IF NOT, SIGNAL ERROR
+RBFLAG, SNA CLA
+NAME1, JMP NAMECT /IT'S O.K.....PROBABLY!
+NAME2, CDF 0 /BAD. SIGNAL ERROR TO MONITOR
+NAME3, ISZ I NUMTST
+NAME4, JMP I [7605 /AND RESTART BATCH MONITOR
+NAMECT, CIF CDF 0 /*****GETS ALTERED******
+NMBASE, JMP I .+1 /START UP IN CD AREA OF BATCH
+DEV1, RESTRT+1 /***GETS ADDRESS OF CD AREA
+DEV2, 0
+PERDSW, 0
+NUMFUJ, 0
+DVFLAG, 0
+DELIM, 0
+OUTSW, 0
+DEFALT, 0
+DVICE, 0
+DFLTNM, 0423;1300 /DSK
+BEGDIF, MIFILE-MOFILE
+LIMDIF, MIFILE-MPARAM+2
+OUTLIM, 1-MIFILE
+GETHND, 11
+TMONIT, 0
+TUSRFG, 0
+TFPUTX, 0
+EXT1, TAD NAME4
+ DCA NAMECT /REMEMBER TYPED EXTENSION
+ TAD NAMECT
+ SNA
+ TAD DEFALT /SUBSTITUTE DEFAULT IF ZERO
+EXT2, DCA NAME4
+ TAD [NAME1
+ JMP I .+1
+ LKUPLP
+PRINT, TYPE
+\f FIELD 1
+ EJECT INVISIBLE ODT
+ /INVISIBLE ODT FOR OS/8 MONITOR
+ /LOADS INTO FIELD 1 NOW, BUT LOADS & EXECUTES IN FIELD 0
+ /DEFINITIONS OF MONITOR SYMBOLS - VOLATILE!
+ ODTREC=60
+ UDNAME=7741
+ MREAD=7757
+ MGET=7667
+ KMREC=7
+ MTEMP=27
+ MARG1=7740
+ JSBITS=7746
+ *200
+READ, JMS I [OCRLF
+READ5, DCA WORD
+ DCA WORD+1
+ TAD [-6
+ DCA TOTE
+REA, KSF
+ JMP .-1
+ JMS I [CTCTST
+ JMP CTRC
+ TAD [203
+ DCA TEMP
+ KCC
+ TAD TEMP
+ JMS I [TYPN
+ TAD [TABL1-1
+ DCA 10
+CHFLP, TAD I 10
+ SPA
+ JMP SEX
+ CIA
+ TAD TEMP
+ SZA CLA
+ JMP CHFLP
+ TAD 10
+ TAD [TABL2-TABL1
+ DCA TEMP
+ TAD I TEMP
+ DCA TEMP
+ CLL
+ JMP FLDTST /SEE IF FIELD SETTING IS LEGAL
+CTRC, JMS I [DUMP
+ JMP I [7605
+\fTABL1=.
+ 240
+ 212
+ 215
+ 257
+ 302
+ 307
+ 273
+ 303
+ 327
+ 336
+ 315
+ 301
+ 314
+ 304
+ 337
+ 306
+ 377
+ 253
+ 255
+ -270 /USED - SEE "SEX"
+\fEXAM, JMS TOTTST
+ JMP EX2
+ TAD WORD
+ DCA CAD
+ TAD WORD+1
+ DCA CAD+1
+EX2, JMS I [LOAD
+ CAD
+ JMS I [PNUM
+ DCA SHUT
+ JMP READ5
+SEX, TAD TEMP
+ CLL
+ TAD [10
+ SNL
+ JMP NO
+ DCA TEMP
+ CLA CLL CMA RTL
+ DCA CRL
+SROT, TAD WORD+1
+ CLL RAL
+ DCA WORD+1
+ RTL
+ RAL
+ TAD WORD
+ RAL
+ DCA WORD
+ ISZ CRL
+ JMP SROT
+ TAD WORD+1
+ TAD TEMP
+ DCA WORD+1
+ ISZ TOTE
+ JMP REA
+NO, CLA
+ TAD [277
+ JMS I [TYPN
+ JMP READ
+\fCRL, 0
+ JMS TOTTST
+ JMP I CRL
+ TAD WORD+1
+ ISZ SHUT
+ JMS I [STORE
+ CAD
+ CLA
+ JMP I CRL
+CRL1, JMS CRL
+ JMP READ
+CRL2, TAD [215
+ JMS I [TYPN
+ JMS CRL
+ JMS I [TYPN
+ ISZ CAD+1
+ NOP
+UPAR3, JMS I [TYPD
+ CAD
+ TAD [257
+ JMS I [TYPN
+ JMP EX2
+OPIN, JMS CRL
+ JMS I [LOAD
+ CAD
+ DCA CAD+1
+ TAD INDFLD
+ DCA CAD
+UPAR2, JMS I [OCRLF
+ JMP UPAR3
+SEMI, JMS CRL
+ ISZ CAD+1
+ NOP
+ JMP READ5
+\f *400
+/NOTE THAT LOCATIONS BURP,BURP+1 GET ALTERED AFTER BRKTST
+/IS EXECUTED. THEY BECOME: CDF 10; TAD I [MARG1
+BURP, JMP I .+1 /GO REDETERMINE CORE SIZE
+ BRKTST /TO MAKE ILLEGAL FIELD GIVE ?
+ DCA SAC
+ IOF
+ TAD I [MTRAD
+ DCA TRAD
+ TAD I [MTRAD1
+ DCA TRAD+1
+ TAD I [MKEEP
+ DCA KEEP
+ TAD I [MPUNN
+ DCA PUNN
+ CLA IAC
+ AND I [7700
+ DCA LINK
+ TAD I [7700
+ CDF 0
+ AND [70
+ DCA DATFLD
+ TAD DATFLD
+ DCA INDFLD
+ TAD [KMREC
+ CDF 10
+ DCA I [MGET+4
+ CLA CLL CMA RAL
+ AND I [MGET+2
+ DCA I [MGET+2 /REMOVE LOW-ORDER BIT FROM CONTROL WORD
+ CDF 0
+ TAD KEEP
+ JMS I [STORE
+ TRAD
+ TAD TRAD+1
+ IAC
+ DCA GAME+1
+ TAD TRAD
+ DCA GAME
+ TAD KEEP
+ DCA INST
+ JMS I [IOTTST
+ SKP
+ JMP JMPLIP
+ TAD TRAD
+ DCA CAD
+ TAD TRAD+1
+ DCA CAD+1
+ JMS I [EFFADR
+ TAD CAD
+ DCA FROG
+ TAD CAD+1
+ DCA FROG+1
+JMPLIP, JMS I [CTCTST
+ JMP I [7605
+ CLA
+ JMP I [LIP
+\fCTCTST, 0
+ TAD [200
+ KSF
+ STA
+ KRS
+ TAD [-203
+ SZA
+ ISZ CTCTST
+ JMP I CTCTST
+
+OCRLF, 0
+ TAD [215
+ JMS I [TYPN
+ TAD [212
+ JMS I [TYPN
+ CLA CMA
+ DCA SHUT
+ JMP I OCRLF
+TRAP, JMS TOTTST
+ TAD [SHNDLR
+ TAD WORD+1
+ DCA TRAD+1
+ TAD WORD
+ DCA TRAD
+ TAD [7000
+ DCA I [SHNDLR
+ TAD [4
+ DCA WORD+1
+ TAD [UDNAME-MPUNN-1
+ DCA TEMP
+ TAD [BRKCOD-1
+ DCA 10
+ TAD [UDNAME-1
+ DCA 11
+ TAD I 10
+ CDF 10
+ DCA I 11
+ CDF 0
+ ISZ TEMP
+ JMP .-5
+ TAD I [JSBITS
+ RTR
+ SZL CLA
+ TAD [5
+ CDF 10
+ TAD I [J7600
+ DCA I [J7600 /CHANGE JMP 7600 TO JMP 7605 IF ODT AREA NOT USED
+ CDF 0
+ TAD I [JSBITS
+ DCA JSTEMP /SAVE JSBITS BEFORE SETTING BRKPT
+ TAD [CIF 10
+ JMS I [STORE
+ WORD
+ ISZ WORD+1
+ TAD [JMP I 6
+ JMS I [STORE
+ WORD
+ ISZ WORD+1
+ TAD [UDNAME
+ JMS I [STORE
+ WORD
+ TAD JSTEMP
+ DCA I [JSBITS /RESTORE JSBITS
+ JMP I [READ
+SUBT, CML
+ADD, TAD WORD+1 /MODIFY CURRENT LOCATION POINTER
+ SNA
+ IAC /1 IS DEFAULT VALUE
+ SZL /+ OR -?
+ CIA /-
+ TAD CAD+1
+ DCA CAD+1
+ JMP I [UPAR2 /AND DISPLAY LOC AND CONTENTS
+\f *600 /MONITOR ENTERS ODT HERE
+LIP, HLT /ERROR. AT INIT, THE CODE AT 600
+ JMP I .+1 /IS CHANGED TO: ISZ PUNN;
+TTYTST, INIT /JMP XCONT; TSF
+ JMP TTYOFF
+LIPTYP, JMS I [TYPD
+ TRAD
+ TAD P250
+ JMS I [TYPN
+ TAD LINK
+ TAD [260
+ JMS I [TYPN
+ TAD [273
+ JMS I [TYPN
+ TAD SAC
+ JMS I [PNUM
+ JMP I [READ
+JUMP, JMS TOTTST /TEST FOR 'G' WITH NO ADDRESS
+ JMP I PNO
+ TAD WORD
+ DCA GAME
+ TAD WORD+1
+ DCA GAME+1
+ TAD WORD
+ DCA DATFLD
+ TAD [7000
+ DCA INST
+ DCA SAC
+ DCA LINK
+ JMP CONTX
+CONTIN, TAD WORD+1
+ CIA
+ SNA
+CONTX, CMA
+ DCA PUNN
+ DCA I [7607 /IN CASE THERE WAS NO BREAKPOINT
+ JMS I [LOAD /V3
+ TRAD /V3
+ DCA KEEP /V3
+ JMS I [OCRLF
+XCONT, TAD [JMP 4
+ JMS I [STORE
+ TRAD
+ CDF 10
+ TAD TRAD
+ DCA I [MTRAD
+ TAD TRAD+1
+ DCA I [MTRAD1
+ TAD KEEP
+ DCA I [MKEEP
+ TAD PUNN
+ DCA I [MPUNN
+ CDF 0
+ JMS I [SIM /SIMULATE THE BRKPOINTED INST HERE
+ TAD LINK
+ DCA I [MLINK
+ TAD SAC
+ DCA I [MAC
+ TAD GAME
+ TAD [CIF 0
+ DCA I [MSTCDF
+ TAD DATFLD
+ AND [70
+ TAD [CDF 0
+ DCA I [MCDF
+ TAD GAME+1
+ DCA I [MSTADR
+ JMS I [DUMP
+ TAD I [JSBITS
+ RTR
+ SZL CLA
+ JMP I [MSWITC
+ JMP I [MREAD
+\fUPAR1, JMS I [CRL
+ JMS I [EFFADR
+ JMP I [UPAR2
+EFFADR, 0
+ JMS I [LOAD
+ CAD
+ AND [177
+ DCA TEMP
+ JMS I [LOAD
+ CAD
+ AND [200
+P250, SNA CLA
+ JMP .+3
+ TAD CAD+1
+ AND [7600
+ TAD TEMP
+ DCA TEMP
+ JMS I [LOAD
+ CAD
+ AND [400
+ SNA CLA
+ JMP NOIND
+ TAD TEMP
+ DCA CAD+1
+ JMS I [LOAD
+ CAD
+ DCA TEMP
+ TAD CAD+1
+ AND P7770
+ TAD P7770
+ SZA CLA
+ JMP NOAUTO
+ ISZ TEMP
+P7770, 7770 /SPA SNA SZL CLA - NEVER SKIPS - USED TO PROTECT ISZ
+ TAD TEMP
+ JMS I [STORE
+ CAD
+NOAUTO, TAD INDFLD
+ AND [70
+ DCA CAD
+NOIND, TAD TEMP
+ DCA CAD+1
+ JMP I EFFADR
+TTYOFF, AND I 0 /WASTE SOME TIME
+ JMS I [IOTTST
+ AND I 0
+ ISZ NOUGHT
+ JMP TTYTST
+ JMP LIPTYP /IF THE TTY FLAG ISN'T UP NOW, IT'LL NEVER GO UP
+NOUGHT, 0
+\fTABL2=.
+ REA /IGNORE BLANKS
+ CRL2
+ CRL1
+ EXAM
+ TRAP
+ JUMP
+ SEMI
+ CONTIN
+ WSER
+ UPAR1
+ MASKX
+ ACX
+ LINKX
+ DATF
+ OPIN
+ INDF
+ RBOUT
+ ADD
+ SUBT
+\f IFZERO 1000&. <*1000>
+PNUM, 0
+ DCA PUNN
+ TAD [-4
+ DCA TEMP
+PN2, TAD PUNN
+ RTL
+ RAL
+ DCA PUNN
+ TAD PUNN
+ RAL
+ AND [7
+ TAD [260
+ JMS I [TYPN
+ ISZ TEMP
+ JMP PN2
+ TAD [240
+ JMS I [TYPN
+ JMP I PNUM
+TYPD, 0
+ TAD I TYPD
+ DCA TEMP
+ TAD I TEMP
+ CLL RTR
+ RAR
+ TAD [260
+ JMS I [TYPN
+ ISZ TEMP
+ TAD I TEMP
+ JMS I [PNUM
+ ISZ TYPD
+ JMP I TYPD
+TYPN, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMS I [CTCTST
+ JMP I [CTRC
+ TAD [-14 /^O?
+ SZA CLA
+ JMP I TYPN /NO
+ KCC /YES
+ JMP I [READ
+\fWSER, JMS I [OCRLF
+ TAD LIMLO
+ DCA CKT+1
+ TAD INDFLD
+ AND [70
+ DCA CKT
+WSER1, JMS I [LOAD
+ CKT
+ AND MASK
+ CIA
+ TAD WORD+1
+ SZA CLA
+ JMP WSER2
+ JMS I [TYPD
+ CKT
+ TAD [257
+ JMS I [TYPN
+ JMS I [LOAD
+ CKT
+ JMS I [PNUM
+ JMS I [OCRLF
+WSER2, TAD CKT+1
+ ISZ CKT+1
+ NOP
+ CIA
+ TAD LIMHI
+ SZA CLA
+ JMP WSER1
+ JMP I [READ
+
+ACX, TAD [SAC-LINK
+LINKX, TAD [LINK-MASK
+MASKX, TAD [MASK-DATFLD
+DATF, TAD [DATFLD-INDFLD
+INDF, TAD [INDFLD
+ DCA WORD+1
+ CLA CMA
+ DCA WORD
+ DCA TOTE
+ TAD [257
+ JMS I [TYPN
+ JMP I [EXAM
+\fBRKCOD=.
+ NOPUNC
+ *UDNAME
+ ENPUNC
+
+ DCA MARG1
+ RAL
+ RDF
+ DCA 7700
+ TAD PODT
+ DCA MGET+4
+ ISZ MGET+2 /DON'T REVERSE TAPE MOTION TO PICK UP ODT
+ CDF CIF 0
+J7600, JMP 7600
+PODT, ODTREC
+P7603, 7603
+MTRAD, 0
+MTRAD1, 0
+MKEEP, 0
+MPUNN, 0
+
+ NOPUNC
+ *BRKCOD+MPUNN-UDNAME+1
+ ENPUNC
+
+DUMP, 0
+ TAD STOFLG
+ SNA CLA
+ JMP I DUMP
+ JMS I [SHNDLR
+ 4200
+ 1400
+GREC, 0
+ HLT
+ DCA STOFLG
+ JMP I DUMP
+
+RBOUT, TAD [277
+ JMS I [TYPN
+ TAD [240
+ JMS I [TYPN
+ JMP I [READ5
+\f IFNZRO .-1200&4000 <*1200>
+SIM, 0
+ JMS IOTTST
+ JMS I [LOAD
+ FROG
+ DCA TEMP
+ TAD TEMP
+ DCA 0
+ JMS IOTTST
+ TAD [777
+ CMA
+ AND INST
+ RAL
+ CML
+ SNL SMA
+ JMP JMSJMP
+ CML RAR
+ DCA SOPR
+ TAD DATFLD
+ AND [70
+ TAD [CDF 0
+ DCA .+1
+ HLT
+ TAD LINK
+ CLL RAR
+ TAD SAC
+SOPR, HLT
+ SKP
+ ISZ GAME+1
+ DCA SAC
+ RAL
+ DCA LINK
+ RDF
+ DCA DATFLD
+ CDF CIF 0
+EOSIM, TAD 0
+ CIA
+ TAD TEMP
+EOTST, SNA CLA
+ JMP .+3
+ TAD 0
+ JMS I [STORE
+ FROG
+ JMP I SIM
+
+IOTTST, 0
+ CLA CLL CML RTR
+ TAD INST
+ SZL CLA
+ ISZ IOTTST
+ JMP I IOTTST
+\fJMSJMP, RTL
+ SZL CLA
+ JMP JMPX
+ TAD TRAD
+ DCA FROG
+ TAD GAME+1
+ DCA 0
+ CLA IAC CLL
+JMPX, TAD FROG+1
+ DCA GAME+1
+ CML RAL /PUT -LINK IN AC (0 IF JMP, 1 IF JMS)
+ JMP EOTST
+
+LOAD, 0
+ TAD I LOAD
+ JMS I [GETADR
+ NOP
+ TAD I ADR
+ CDF 0
+ ISZ LOAD
+ JMP I LOAD
+
+STORE, 0
+ DCA LOAD
+ TAD I STORE
+ JMS I [GETADR
+ ISZ STOFLG /INDICATE THAT WE'RE CHANGING THIS RECORD
+ TAD LOAD
+ DCA I ADR
+ CDF 0
+ ISZ STORE
+ JMP I STORE
+\fGETADR, 0
+ DCA ADR
+ TAD I ADR
+ DCA FADR
+ ISZ ADR
+ TAD I ADR
+ DCA ADR
+ TAD FADR
+ SNA
+ JMP CKADR
+ SPA
+ CLA
+ TAD [CDF 0
+ DCA .+1
+FADR, 0
+ ISZ GETADR
+ JMP I GETADR
+CKADR, TAD ADR
+ RAL
+ SZL SPA CLA
+ JMP FADR+1
+ CLA CLL CMA RTL
+ AND I [JSBITS
+ DCA I [JSBITS /MODIFY THE JSW TO INDICATE ODT AREA VIOLATION
+ TAD ADR
+ CLL RTL
+ RTL
+ RAL
+ AND [7
+ TAD [MTEMP+4
+ DCA GIREC
+ TAD I [GREC
+ CIA
+ TAD GIREC
+ SNA CLA
+ JMP NOREAD
+ JMS I [DUMP
+ JMS I [SHNDLR
+ 0200
+G1400, 1400
+GIREC, 0
+ HLT
+ TAD GIREC
+ DCA I [GREC
+NOREAD, TAD ADR
+ AND [377
+ TAD G1400
+ DCA ADR
+ JMP I GETADR
+\f *1400
+ /INITIALIZATION CODE TO SET UP THE "MREAD" AREA IN FIELD 0
+ /WITH THE ODT CODE TO START UP A PROGRAM
+
+INIT, TAD [MREAD-MSTADR-2
+ DCA TEMP
+ TAD [RSTCOD-1
+ DCA 10
+ TAD [MREAD-2
+ DCA 11
+ TAD I 10
+ DCA I 11
+ ISZ TEMP
+ JMP .-3
+ JMS CORE /DETERMINE CORE FIELD SIZE
+ TSF
+ JMP .-1
+ JMP I [READ
+
+BRKTST, JMS CORE /GET CORE SIZE NOW THAT WE WERE
+ TAD KLIP
+ DCA I PLIP /SETUP LOCATIONS AT 600
+ TAD KLIP+1
+ DCA I PLIP+1
+ TAD KLIP+2
+ DCA I PLIP+2
+ TAD KCDF10 /JUST BREAKPOINTED IN. THEN RESTORE
+ DCA I BURPO /LOCS AT BURP SO WE NEVER COME BACK
+ TAD KCDF10+1 /HERE AGAIN UNTIL WE'RE SWAPPED
+ DCA I BURP2
+ JMP I BURPO
+KCDF10, CDF 10
+ TAD I [MARG1 /SIMULATE LOCS AT BURP
+BURPO, BURP
+BURP2, BURP+1
+\fRSTCOD=.
+ NOPUNC
+ *MREAD-1
+ ENPUNC
+
+ SHNDLR
+ JMS I .-1
+ 1000
+ 0
+ MTEMP+4
+ HLT
+MSWITC, TAD MLINK
+ CLL RAR
+ TAD MAC
+MCDF, CDF 0
+ JMP MSTCDF
+MAC, 0
+MLINK, 0
+MSTCDF, CIF 0
+ JMP I .+1
+MSTADR, 0
+
+ NOPUNC
+ *RSTCOD+MSTADR-MREAD+2
+ ENPUNC
+\fCORE, 0
+ CDF 0
+ TAD I M1
+ AND COR70
+ SZA
+ JMP USERC
+COR0, CDF 0
+ TAD CORSIZ
+ RTL
+ RAL
+ AND COR70
+ TAD COREX
+ DCA .+1
+COR1, CDF
+ TAD I CORLOC
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC
+CORX, 7400
+ TAD CORX
+ TAD CORV
+ SZA CLA
+ JMP COREX
+ TAD COR1
+ DCA I CORLOC
+ ISZ CORSIZ
+ JMP COR0
+
+COREX, CDF 0
+ TAD CORSIZ
+ CLL RAL
+ RTL
+USERCR, CIA
+ DCA ZERO /STORE AWAY NEG OF FIRST NON-EXISTENT FIELD
+ /AT ODT'S LOCATION 0
+ JMP I CORE
+
+CORLOC, CORX
+CORV, 1400
+M1, -1
+\fCORSIZ, 1
+USERC, TAD L10
+ JMP USERCR
+L10, 10
+
+KLIP, ISZ PUNN /THESE INSTRUCTIONS GO INTO 600
+ XCONT&177+5200 /JMP XCONT
+ TSF
+PLIP, LIP
+ LIP+1
+ LIP+2
+\f *0
+ZERO, ODTVERSION
+ HLT /IN CASE BKPT WITH INTER ON
+STOFLG, 0
+PUNN, 0
+ *4 /PAGE 0 LITERALS AND CELLS
+ CIF 10 /PROTOTYPE BREAKPOINT
+ JMP I 6 /USED BY PROGRAMS WITH JSBITS(10)=1
+ UDNAME /WHEN ODT IS RELOADED ON A BREAKPOINT
+
+ *12
+TOTE, 0
+KEEP, 0
+INST, 0
+SHUT, -1
+TRAD, 0;SHNDLR
+WORD, 0;0
+LINK, 0
+SAC, 0
+CAD, 0;0
+CKT, 0;0
+GAME, 0;0
+FROG, 0;0
+TEMP, 0
+JSTEMP, 0
+DATFLD, 0
+INDFLD, 0
+MASK, 7777
+LIMLO, 0
+LIMHI, 7577
+ADR, 0
+FLDTST, TAD ZERO /LOC. 0 HAS FIRST IMAGINARY CORE FIELD
+ TAD WORD /IF USER TRIES TO ADDRESS NON-
+ SNL CLA /EXISTENT CORE, A ? RETURNS
+ JMP I TEMP /HE'S OK.
+ JMP I PNO
+PNO, NO
+TOTTST, 0
+ TAD TOTE
+ TAD [6
+ SZA CLA
+ ISZ TOTTST
+ JMP I TOTTST
+ $
+\f
--- /dev/null
+/3 CARD READER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f *0
+ -1
+DEVICE CR8E;DEVICE CDR;2030;4000;ZBLOCK 2
+
+ CDRVERSION="C&77
+
+/V3 CHANGES:
+
+/1. VERSION # IS NOW 1
+/2. FIXED BUG FOR CARDS WITH ODD NUMBER OF COLUMNS
+/3. CARD DONE FLAG IS CLEARED AT END
+
+ *200
+
+RCSF=6631
+RCRA=6632
+RCSP=6671
+RCSE=6672
+RCRD=6674
+
+CDR, CDRVERSION /ENTRY POINT RELATIVE ZERO
+CDR770, 7700 /"SMA CLA" CLEARS THE AC
+CDRTMP, 0 /LESS THAN 400 - PROTECTS THE "SMA CLA"
+ JMP CDRSET /INITIALIZATION - BECOMES "RDF"
+ TAD CDRCIF /FORM "CIF CDF N" TO CALLING FIELDS
+ DCA CDRXIT /SAVE CALLING FIELDS
+ TAD CDRCCF-1
+ DCA CDRXIT-1 /RESTORE THE "ISZ CDR"
+ TAD I CDR /GET FUNCTION WORD
+ AND CDR070 /GET BUFFER FIELD BITS
+ TAD CDRCCF /MAKE A "CDF N"
+ DCA CDBCDF /SAVE IT IN THE GET CHAR LOOP
+ TAD I CDR /GET FUNCTION WORD AGAIN
+ ISZ CDR
+ SPA /IS IT A WRITE FUNCTION?
+ JMP CDRERR /YES - HARD ERROR
+ AND CDR770 /GET COUNT BITS
+ CIA
+ DCA CDRWC /SAVE WORD COUNT (DIVIDED BY 2)
+ TAD I CDR /GET BUFFER ADDRESS
+ DCA CDRCA /AND SAVE IT
+ ISZ CDR /THE BLOCK NUMBER IS IGNORED
+CDRCCF, CDF /WE ARE IN FIELD 0
+ DCA I CDRIN2 /RESET ^Z FLAG TO ZERO
+CDRLP, JMS I CDRIN4 /GET A CHARACTER
+ DCA CDRTM1 /DATA FIELD STILL ZERO ON RETURN!
+ JMS I CDRIN4 /GET NEXT CHARACTER
+ DCA CDRTMP /AND SAVE IT
+ JMS I CDRIN4 /GET NEXT CHARACTER
+ RTL
+ RTL /GET THE FIRST FOUR BITS OF IT
+ DCA CDRTM2 /SAVE THE REST FOR LATER
+ TAD CDRTM2
+ AND CDR740 /ONLY 4 BITS
+ TAD CDRTM1 /ADD THOSE BITS TO THE 1ST CHAR
+CDBCDF, HLT /CDF TO BUFFER FIELD
+ DCA I CDRCA /STORE 1ST CHARACTER
+ ISZ CDRCA /BUMP POINTER TO BUFFER
+CDR740, 7400 /PROTECT THE ISZ AGAINST SKIPS
+ TAD CDRTM2
+ RTL
+ RTL /NOW GET LOW ORDER 4 BITS
+ AND CDR7400 /AND ONLY 4 BITS
+ TAD CDRTMP /ADD IN THE 2ND CHARACTER
+ DCA I CDRCA /AND STORE THE WORD
+ ISZ CDRCA /BUMP POINTER AGAIN
+CDR070, 70 /PROTECT THE ISZ
+ CDF 0 /CDRGCH NEEDS 0 DF ON ENTRY!
+ ISZ CDRWC /DONE?
+ JMP CDRLP /NO - LOOP
+CDRERR, ISZ CDR /HERE WITH NEGATIVE AC ON WRITE - FATAL ERROR
+ ISZ CDR /IF ^Z THIS IS ZEROED
+CDRXIT, HLT /RESTORE CALLING FIELDS
+ JMP I CDR /EXIT
+
+CDRCA, 0 /BUFFER POINTER
+CDRWC, 0 /WORD COUNT DIVIDED BY 2
+CDRTM1, 0
+CDRTM2, 0 /SPLIT WORD TEMPORARY
+CDRCIF, CIF CDF 0 /TO FORM EXIT WORD
+
+CDRIN2, CDRJMP-CDRLOC /CORRECTED AT INITIALIZATION TIME
+CDRIN4, CDRGCH-CDRLOC
+
+ 0 /** FREE LOCATIONS - COME AND GET 'EM !
+ 0
+ IFNZRO .-277 <RESORC,_ERROR_> /BUT THERE'S A CATCH
+CDRTBL, 0021;2223;2425;2627;3031;3203;4007;3502
+ 2017;6364;6566;6770;7172;7514;0577;3637
+ 1552;5354;5556;5760;6162;0104;1211;3374
+ 0641;4243;4445;4647;5051;7316;3410;1376
+
+/DO NOT INSERT ANYTHING BETWEEN "CDRTBL" AND "CDRBUF"!!
+
+CDRBUF=. /CARD BUFFER
+
+CDRSET, RDF /INITIALIZATION CODE
+ TAD CDRCCF
+ DCA CDRSE1 /SAVE CALLING FIELDS
+ CDF /WE ARE IN FIELD 0
+ JMS . /FIND OUT OUR LOCATION
+CDRLOC, TAD CDRSE2 /ADDRESS TO MODIFY
+ TAD CDRLOC-1 /CORRECT IT
+ DCA CDRSE3 /SAVE IT
+ TAD I CDRSE3 /GET DATA TO MODIFY
+ TAD CDRLOC-1 /CORRECT IT
+ DCA I CDRSE3 /AND RESTORE IT
+ ISZ CDRLOC /NEXT ADDRESS
+ ISZ CDRSE4 /MORE?
+ JMP CDRLOC /YES - LOOP
+ TAD CDRSET
+ DCA CDR+3 /SET THE "RDF"
+CDRSE1, HLT /RESTORE CALLING FIELDS
+ JMP CDR+3 /AND BACK TO NORMAL
+
+CDRSE3, 0 /MODIFY POINTER
+CDRSE4, -5 /FIVE LOCATIONS TO MODIFY
+
+CDRSE2, CDRIN2-CDRLOC /LOCATIONS TO MODIFY
+ CDRIN4-CDRLOC
+ CDRIN5-CDRLOC
+ CDRABF-CDRLOC
+ CDRTAD-CDRLOC
+\f*CDRBUF+50 /END OF THE BUFFER
+
+CDRGCH, 0 /GET A CHARACTER ROUTINE - ENTER WITH DF=0
+CDRJMP, 0 /THIS IS "JMP I CDRGCH" AFTER A ^Z
+ ISZ CDRCNT /MORE CHARACTERS IN THE INTERNAL BUFFER?
+ JMP CDRGET /YES - GET ONE
+CDRGE4, ISZ CDRCT2 /GIVE A 215, 212 FOR EVERY CARD
+ JMP CDRCLF /215, 212 ROUTINE
+ CLL CLA CMA RTL
+ DCA CDRCT2 /RESET COUNT TO -3
+CDRGNC, TAD CDRABF
+ DCA CDRPT /SET POINTER TO INTERNAL BUFFER
+CDRGE0, KSF /KEYBORAD FLAG UP?
+ JMP CDRGE7 /NO - TRY TO READ A CARD
+ TAD CDR760 /FORCE THE PARITY BIT ON
+ KRS /READ STATIC FROM KEYBOARD
+ TAD CDR175 /IS IT ^C?
+ SNA
+ JMP I CDR760 /YES - TO MONITOR VIA 07600
+ TAD CDRM27 /IS IT ^Z?
+ SZA CLA
+ JMP CDRGE7 /NO - GET A CARD
+ KCC /KILL FLAG
+CDRGEZ, CLA CMA
+ DCA CDRCNT /RESET COUNTS TO SKIP
+ CLA CMA
+ DCA CDRCT2
+ TAD CDRMOD
+ DCA CDRJMP /SET TO GIVE 0'S
+ DCA I CDRIN5 /AND A SOFT ERROR
+ TAD CDR232 /^Z
+ JMP I CDRGCH /EXIT
+
+CDRGE7, RCSE /SELECT A CARD
+ JMP CDRGE0 /NO GO - TRY AGAIN
+ DCA CDRSW /SET PACKING SWITCH
+CDRGCL, DCA CDRTIM /INITIALIZE TIMEOUT COUNTER
+CDRGE1, RCSP /CARD DONE?
+ JMP CDRGE2 /NO - TRY FOR DATA READY
+ RCRD /CLEAR CARD DONE FLAG
+CDRGE3, TAD I CDRPT /GET LAST TWO CHARACTERS
+ SZA /BOTH SPACES?
+ JMP CDRGE5 /NO
+ CLA CMA
+ TAD CDRPT
+ DCA CDRPT /BACK UP POINTER ONE
+ ISZ CDRCNT
+ ISZ CDRCNT /AND TAKE COUNT DOWN BY 2
+ JMP CDRGE3 /TEST AGAIN OR...
+ JMP CDRGE4 /IF COUNT IS ZERO THE A BLANK CARD
+
+CDRGE5, AND CDR077 /IS RIGHT HAND CHARACTER A SPACE?
+ SNA CLA
+ ISZ CDRCNT /YES A SPACE - REDUCE COUNT
+ TAD I CDRPT /GET LAST NON-SPACE
+ TAD CDR077 /THIS FORMS 7777 IFF WORD CONTAINS "_"
+ AND CDRCNT /THIS MAINTAINS 7777 IFF CDRCNT IS -1
+ CMA
+ SNA CLA /ARE BOTH CONDITIONS TRUE?
+ JMP CDRGEZ /YES - MUST BE END OF FILE
+CDRGE6, TAD CDR077
+ DCA CDRSW /SET OFFSET FROM "CDRTBL"
+CDRGET, ISZ CDRSW /BUMP OFFSET
+ TAD CDRSW /OFFSET INTO AC
+ JMS CDRGE8 /GET A CHARACTER
+ TAD CDR240 /MAKE IT ASCII
+CDRMOD, JMP I CDRGCH
+
+CDRGE8, 0 /GET FROM BUFFER ROUTINE
+ CLL RAR /DIVIDE BY 2 - AND INTO LINK IS INDICATOR
+ TAD CDRTAD /ADDRESS OF "CDRTBL"
+ DCA CDRTM3 /SET POINTER
+ TAD I CDRTM3 /GET WORD
+ SZL /SHIFT?
+ JMP .+4 /NO
+ RTR /YES
+ RTR
+ RTR
+ AND CDR077 /GET 6 BITS
+ JMP I CDRGE8
+
+CDRGE2, RCSF /DATA READY?
+ JMP CDRGEX /NO - TRY FOR TIME OUT
+ RCRA /READ ALPHA
+ JMS CDRGE8 /GET TABLE ENTRY
+ ISZ CDRSW /WHICH SIDE?
+ JMP CDRGE9 /LEFT SIDE
+ TAD I CDRPT
+ DCA I CDRPT /FORM RIGHT SIDE
+ JMP CDRGCL /CONTINUE
+
+CDRGE9, CLL RTL /SHIFT LEFT
+ RTL
+ RTL
+ ISZ CDRPT /BUMP POINTER
+ DCA I CDRPT /STORE LEFT SIDE
+ CLA CLL CMA RAL /-2 V3 FROM SIS BULLETING JAN 73
+ TAD CDRCNT
+ DCA CDRCNT /COUNT THE CHARACTERS
+ CLA CMA
+ JMP CDRGCL-1 /CONTINUE - SET SWITCH
+\fCDRCLF, CLA CMA
+ DCA CDRCNT /SET MAIN COUNT TO SKIP
+ TAD CDRCT2
+ CLL CMA RTL /ALL THIS DOES IS...
+ TAD CDRCT2 /MAKE A 2 OR -1
+ TAD CDR213 /SO THIS MAKES A 215 OR 212
+ JMP I CDRGCH
+
+CDRGEX, /TEST TIME OUT - FIRST DELAY USING CONSTANTS
+CDR760, 7600 /MONITOR ADDRESS
+CDR077, 77 /SIX BIT MASK
+CDRM77, -7700 /-"_ "
+CDR175, 175
+CDR240, 240 /ASCII SPACE
+CDR213, 213 /215, 212 CORRECTION FACTOR
+CDR232, 232 /ASCII ^Z
+ ISZ CDRTIM /THIS LOOP TAKES AT LEAST 100MS ON AN 8/E
+ JMP CDRGE1
+ DCA CDRCNT /CLEAR COUNT IN CASE PARTIAL CARD READ (E.G. JAM)
+ JMP CDRGNC /TIMED OUT - RESTART CARD
+
+CDRTM3,
+CDRTIM, 0 /TIMEOUT COUNTER
+CDRM27, -27 /-27-3=-32 ^Z TEST
+CDRCNT, -1 /MAIN COUNT
+CDRCT2, -1 /215, 212 COUNT
+CDRPT, 0 /BUFFER POINTER
+CDRSW, 0 /SWITCH
+
+CDRABF, CDRBUF-1-CDRLOC /MODIFIED LOCATIONS
+CDRTAD, CDRTBL-CDRLOC
+CDRIN5, CDRXIT-1-CDRLOC
+ $
+\f
--- /dev/null
+/4 OS/8 CASSETTE HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/ DEC-S8-UCASA-A-LA
+
+/ COPYRIGHT 1972
+
+/ DIGITAL EQUIPMENT CORPORATION
+
+/ MAYNARD MASSACHUSETTS 01754
+
+/ MOUTH/DORP
+
+ IFNDEF CODE <CODE=0>
+
+ KCLR=CODE^10+6700 /CLEAR ALL
+ KSDR=CODE^10+6701 /SKIP ON DATA FLAG
+ KSEN=CODE^10+6702 /SKIP ON ERROR
+ KSBF=CODE^10+6703 /SKIP ON READY FLAG
+ KLSA=CODE^10+6704 /LOAD STATUS A
+ KSAF=CODE^10+6705 /SKIP ON ANY FLAG OR ERROR
+ KGOA=CODE^10+6706 /ASSERT CONTENTS OF STATUS A AND XFER
+ KRSB=CODE^10+6707 /READ STATUS B
+
+ BSW=7002 /BYTE SWAP [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/ 0 WRITE EOF
+/ 1 REWIND
+/ 2 BACKBLOCK
+/ 3 SKIPFILE/BACKFILE
+
+/ 4-7 UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+ VERSION="C&77
+\f *0
+
+ -2 /THERE ARE TWO HANDLERS
+
+ 2401
+ 7001+CODE
+ 0323
+ 0160+CODE+CODE /CSA0
+ 270 /DEVICE CONTROL BLOCK (TYPE 27)
+ 4000+7 /ENTRY POINT FOR CSA0
+ ZBLOCK 2
+
+ 2401
+ 7001+CODE
+ 0323
+ 0161+CODE+CODE /CSA1
+ 270
+ 4000+1 /ENTRY POINT FOR CSA1
+ ZBLOCK 2
+\f *200
+
+K3700, 3700 /MUST BE FIRST LOCATION ON PAGE
+UNIT,
+CSA1, VERSION /ENTRY POINT FOR CSA1
+ CLA /PROTECT CODE AGAINST IGNORANT USERS
+ TAD CSA1 /PICK UP ARGUMENTS
+ DCA CSA0 /VIA CSA0
+ STL IAC RAL /TAD (3 [8/I,L,E,F]
+ JMP .+3 /JOIN PROCESSING WITH UNIT 1
+CSA0, VERSION /ENTRY POINT FOR CSA0
+ STL CLA RTL /TAD (2
+ BSW / [8/E,F]
+ DCA UNIT /SAVE UNIT (0 IS 200, 1 IS 300)
+CS, JMS T /INITIALIZATION; REPLACED BY RDF
+ TAD KCIF /FORM RETURN FIELD INSTRUCTION
+ DCA RETCIF /STORE IN RETURN CODE
+ TAD I CSA0 /GET FUNCTION CONTROL WORD
+ DCA FUN /SAVE IT
+ TAD FUN /GET IT BACK AGAIN
+ AND K70 /ISOLATE FIELD OF BUFFER
+ TAD KCDF /FORM CDF TO FIELD OF BUFFER
+ DCA BUFCDF /STORE IN APPROPRIATE SPOT
+ ISZ CSA0 /POINT TO ARGUMENT 2
+ TAD I CSA0 /GET BUFFER ADDRESS
+ DCA BUFFER /SAVE IT
+ ISZ CSA0 /POINT TO ARGUMENT 3
+ TAD I CSA0 /GET BLOCK NUMBER
+ ISZ CSA0 /POINT TO ERROR RETURN
+KCIF, CIF CDF 0 /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
+ SZA CLA
+ JMP NOT1ST /NOT BLOCK 0
+ STL CLA RAR /TAD (4000
+ AND FUN /ISOLATE READ/WRITE BIT
+ TAD UNIT /INSERT UNIT
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ REWIND-. /TO PERFORM A REWIND/INITIALIZATION
+NOT1ST, TAD FUN
+K200, AND K3700 /ISOLATE NUMBER OF BLOCKS TO XFER
+ SNA
+ JMP SPCASE /0 BLOCKS MEANS SPECIAL THING (EOF)
+RECLP, DCA BLKNT /SET COUNT OF NUMBER OF BLOCKS
+ STL CLA RAR /TAD (4000
+ AND FUN /ISOLATE READ/WRITE BIT
+ TAD UNIT /INSERT UNIT
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ RW-. /TO INITIATE READ OR WRITE
+RETRY, SZA /NON-ZERO AC MEANS ERROR
+ JMP RETCIF /TOUGH LUCK BOOBIE - ERROR
+ TAD K7700 /GET READY TO XFER 100 DOUBLE WORDS
+ DCA DBWDCT /SET DOUBLE WORD COUNTER
+ TAD BUFFER /GET START OF BUFFER SEGMENT
+ DCA BPTR /SET 'BPTR'
+BUFCDF, HLT /CHANGE TO DATA FIELD OF USER'S BUFFER
+ TAD FUN
+K7700, SMA CLA /WHICH DIRECTION IS TRANSFER?
+ JMP READ /WANT TO READ
+\fWRITE, TAD I BPTR /WANT TO WRITE, SO GET WORD FROM BUFFER
+ JMS I QGPCH /WRITE
+ TAD I BPTR /GET FIRST WORD AGAIN
+ AND P7400 /ISOLATE FIRST HALF OF BYTE 3
+ DCA T /SAVE FOR FUTURE REFERENCE
+ ISZ BPTR /POINT TO NEXT LOCATION IN BUFFER
+ TAD I BPTR /GET SECOND WORD OF BUFFER PAIR
+ JMS I QGPCH /WRITE BYTE #2
+ TAD I BPTR /RETRIEVE WORD 2
+ AND P7400 /ISOLATE 2ND HALF OF BYTE #3
+ CLL RTR /CREATE MYSTIC HIDDEN BYTE 3
+ RTR
+ TAD T /GOOD THING I STILL HAVE THIS
+ CLL RTR
+ RTR
+ JMS I QGPCH /WRITE BYTE #3
+ JMP COM
+\fREAD, JMS I QGPCH /READ BYTE #1 OF TRIPLE
+ DCA I BPTR /STORE IN WORD 1 OF BUFFER PAIR
+ JMS I QGPCH /READ BYTE #2 OF TRIPLE
+ DCA T /SAVE IT FOR POSTERITY
+ JMS I QGPCH /READ BYTE #3 OF TRIPLE
+ RTL
+ RTL /MYSTIC ROTATES
+ DCA T2
+ TAD T2
+ AND P7400 /AND MYSTIC CONSTANTS
+ TAD I BPTR /FIX UP BUFFER WORD 1 OF PAIR
+ DCA I BPTR
+ TAD T2
+ RTL
+ RTL /MORE ROTATION
+ AND P7400 /AND MORE
+ TAD T
+ ISZ BPTR /POINT TO SECOND WORD OF BUFFER PAIR
+ DCA I BPTR /STORE SECOND WORD
+COM, ISZ BPTR /POINT TO BEGIN OF NEXT BUFFER PAIR
+P7400, 7400 /PROTECTION AGAINST CORE WRAP AROUND
+ ISZ DBWDCT /BUMP DOUBLE WORD COUNT
+ JMP BUFCDF /REITERATE
+ JMS I QCAS /CALL CASSETTE ROUTINE
+ CRC-. /TO CHECK CRC
+ TAD BUFFER /GET BUFFER SEGMENT ADDRESS
+ TAD K200 /ADD 200 TO GET TO NEXT SEGMENT
+ DCA BUFFER /REPLACE
+ TAD BLKNT /GET BLOCK COUNT
+ TAD K7700 /SUBTRAT 100
+ SZA /ARE WE DONE?
+ JMP RECLP /NO, REITERATE
+ ISZ CSA0 /POINT TO NORMAL GOOD RETURN
+RETCIF, HLT /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
+ JMP I CSA0 /RETURN
+\f/ INTIALIZATION ROUTINE - ONCE ONLY CODE
+/ OVERLAID BY TEMPORARIES
+
+T, 0 /ENTRY POINT TO INITIALIZATION
+T2, TAD KRDF /REPLACE CALL BY RDF
+FUN, DCA CS /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
+BUFFER, TAD T /CORRECT ADDRESS OF GPCH
+DBWDCT, TAD KQX1 /BY ADDING IN CS+1
+QGPCH, DCA . /STORE IT HERE
+BLKNT, STL CLA RTL /CORRECT ADDRESS OF CAS IS 2 MORE
+ TAD QGPCH
+QCAS, DCA . /THAN GPCH. STORE IT HERE.
+BPTR, JMP CS /RETURN TO MAIN PROGRAM
+KRDF, RDF
+KQX1, GPCH-CS-1
+
+SPCASE, TAD FUN
+ AND L4003 /ISOLATE R/W BIT + SPECIAL CODE
+ TAD UNIT
+ JMS I QCAS
+ SPCODE-.
+ JMP RETCIF-1 /LEAVE GRACEFULLY
+K70, 70
+KCDF, CDF 0
+L4003, 4003
+ PAGE
+\fGPCH, 0 /READ OR WRITE A BYTE
+ JMP AROUND /GO TO REAL LOCATION OF THIS SUBROUTINE
+CAS, 0 /MUST BE AT GPCH+2; DO CASSETTE STUFF
+ DCA TEMP /SAVE ARGUMENT IN AC
+ CDF 0
+ TAD I CAS /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
+ TAD CAS /RELOCATE IT
+ ISZ CAS /POINT TO NORMAL RETURN LOCATION
+ DCA GPCH /SAVE ENTRY POINT IN TEMPORARY
+ JMP I GPCH /GO TO CORRECT ENTRY POINT
+
+RW, TAD CAS
+ DCA RTRY /SAVE RETRY ADDRESS
+ TAD TEMP /GET ARGUMENT PASSED VIA AC
+ DCA FNUNIT /SAVE
+ CLL STA RTL /TAD (7775
+ DCA ERKNT /SET ERROR COUNT TO -3
+ERETRY, TAD FNUNIT
+ SPA
+ TAD (20 /READ CODE IS 0; WRITE IS 20
+ KLSA /LOAD STATUS A
+ TAD FNUNIT /***KLSA CLEARS BIT 0
+ SMA CLA /READS HAVE TO BE INITIATED
+ JMS CWAIT /READ
+ JMP I RTRY /RETURN
+
+AROUND, DCA TEMP
+ TAD FNUNIT
+ SMA CLA
+ JMP RDCHAR /READ
+ TAD TEMP /WRITE
+ JMS CWAIT
+ JMP I GPCH /RETURN
+
+RDCHAR, JMS CWAIT
+ TAD TEMP /GET CHAR JUST READ
+ JMP I GPCH /RETURN WITH IT IN AC
+\fCRC, TAD FNUNIT
+ TAD (60
+ KLSA /INITIATE READ/WRITE CRC
+ TAD FNUNIT /***KLSA CLEARS BIT 0
+ SMA CLA
+ JMS CWAIT /HAVE TO READ TWICE
+ JMS CWAIT /WRITE CRC WRITES BOTH
+ KCLR /WHY NOT?
+ JMP I CAS /RETURN
+
+REWIND, TAD (10
+ JMS UTIL
+ TAD TEMP
+ SMA CLA
+ JMP I CAS /MERELY REWIND IF READING
+ JMP EOF
+SKIPF, TAD (20
+BACKBL, TAD (10
+EOF, TAD (10
+BACKF, TAD (30
+ JMS UTIL
+ JMP I CAS /RETURN
+
+UTIL, 0
+ TAD TEMP
+ KLSA
+TRYAGN, KGOA
+ JMS CTCTST
+ KSBF /WAIT FOR READY
+ JMP .-2
+ KRSB
+ AND (10
+ SZA CLA
+ JMP TRYAGN /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
+ JMP I UTIL
+
+TEMP, 0
+ERKNT, 0
+FNUNIT, 0
+RTRY, 0
+
+SPCODE, TAD TEMP
+ AND (3
+ TAD (JMP TABLE
+ DCA J
+ TAD TEMP
+ AND (4300
+ DCA TEMP
+J, HLT
+TABLE, JMP EOF /0 WRITE EOF
+ JMP REWIND /1 REWIND AND WRITE EOF IF BIT 0=1
+ JMP BACKBL /2 BACK BLOCK
+ TAD TEMP /3 SKIP/BACK FILE DEPENDING ON BIT 0
+ SMA CLA
+ JMP SKIPF /FORWARD FILE
+ JMP BACKF /BACK FILE
+\fCWAIT, 0
+ KGOA /ASSERT CONTENTS OF STATUS A
+ DCA TEMP /SAVE ANYTHING READ
+ JMS CTCTST
+ KSAF
+ JMP .-2 /WAIT FOR SOMETHING TO HAPPEN
+ KSEN /WAS IT AN ERROR?
+ JMP I CWAIT /NO, SO RETURN
+ERR, DCA TEMP /YES ... ERROR
+ KRSB
+ AND (30
+ SNA
+ JMP .+3
+ AND (20
+ JMP I RTRY /END OF FILE IS SOFT ERROR
+ ISZ ERKNT /SHALL WE TRY AGAIN?
+ JMP .+3 /YES
+ STL CLA RAR /TAD (4000
+ JMP I RTRY /RETURN WITH NON-ZERO AC
+ TAD FNUNIT /RETRY
+ TAD (50 /BUT FIRST DO BACKSPACE BLOCK GAP
+ JMS UTIL
+ JMP ERETRY
+
+CTCTST, 0 /TEST FOR CONTROL/C
+L7600, 7600
+ TAD L7600
+ KRS
+ TAD (-7603
+ SNA CLA
+ KSF
+ JMP I CTCTST
+ CIF CDF 0
+ JMP I L7600 /RETURN TO OS/8
+ $
+\f
--- /dev/null
+/8 DUMP LPT HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/ DEC-S8-UCASA-A-LA
+
+/ COPYRIGHT 1972
+
+/ DIGITAL EQUIPMENT CORPORATION
+
+/ MAYNARD MASSACHUSETTS 01754
+
+/ MOUTH/DORP
+
+ IFNDEF CODE <CODE=0>
+
+ KCLR=CODE^10+6700 /CLEAR ALL
+ KSDR=CODE^10+6701 /SKIP ON DATA FLAG
+ KSEN=CODE^10+6702 /SKIP ON ERROR
+ KSBF=CODE^10+6703 /SKIP ON READY FLAG
+ KLSA=CODE^10+6704 /LOAD STATUS A
+ KSAF=CODE^10+6705 /SKIP ON ANY FLAG OR ERROR
+ KGOA=CODE^10+6706 /ASSERT CONTENTS OF STATUS A AND XFER
+ KRSB=CODE^10+6707 /READ STATUS B
+
+ BSW=7002 /BYTE SWAP [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/ 0 WRITE EOF
+/ 1 REWIND
+/ 2 BACKBLOCK
+/ 3 SKIPFILE/BACKFILE
+
+/ 4-7 UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+\f/ EDIT HISTORY:
+
+/ 1976 S.R. ORIGINALLY WRITTEN
+/ 19-MAR-77 S.R. FIXED BUG WITH BUFFER ENDING AT 7777
+
+ *0
+
+ -1
+ DEVICE DUMP;DEVICE DUMP;1360;DUMP&177+4000;ZBLOCK 2
+
+ DMPVER="C&77
+\f *200
+
+LINK, 0 /POINTS TO 'LINC' ON NEXT PAGE
+ TAD I DUMP /GET FUNCTION CONTROL WORD
+ DCA FNWD
+ ISZ DUMP /POINT TO BUFFER STARTING ADDRESS
+ TAD I DUMP /GET BUFFER STARTING ADDRESS
+ DCA BUFFER
+ ISZ DUMP /POINT TO STARTING BLOCK #
+ TAD I DUMP /GET STARTING BLOCK NUMBER
+ DCA BLOCK /SAVE IT IN 'BLOCK'
+ ISZ DUMP /POINT TO USER'S ERROR RETURN
+ RDF
+ TAD KCIDF /FOR 'CIF CDF' TO USER'S FIELD
+ DCA DMPRET /NEED IT TO RETURN TO HIM LATER
+ TAD FNWD /LOOK AT FUNCTION WORD
+ SMA /BIT 0 IS READ/WRITE BIT
+ JMP ERRET /TAKE FATAL ERROR IF GUY TRIED TO
+ /READ FROM 'DUMP'
+ AND L3700
+ CLL RTR
+ SNA
+ JMP CLOSE /0 PAGES MEANS PERFORM CLOSE
+ /OPERATION, GO AWAY
+ CIA /STORE AWAY NEGATIVE OF
+ /NUMBER OF LINES TO DUMP
+ DCA KNT
+ TAD FNWD /LOOK SOME MORE AT ALL-IMPORTANT
+ /FUNCTION WORD
+L374, AND L70 /ISOLATE FIELD OF BUFFER
+ TAD KCDF /FORM 'CDF' TO FLD OF BUFFER
+ DCA .+1 /STORE IT IN NEXT LOCATION
+FNWD,
+BPTR, HLT /CHANGE DATA FIELD TO FLD OF BUFFER
+B, TAD M40
+ DCA RKNT
+ JMS I LINK
+ TAD LOW-200
+ CIA CLL
+ TAD BLOCK
+ SZL CLA
+ TAD KLLS
+ JMS I LINK
+ DCA LPUT+1-200
+ TAD BLOCK
+ JMS I LINK
+ JMP BLK-200
+ JMS I LINK
+ JMP CRLF-200
+A, JMS INIT
+ TAD RKNT
+ TAD L40 /MUST BE REAL 40
+ JMS I LINK
+ JMS PRINT-200
+ TAD KSLASH
+ JMS I LINK
+ JMP SPACE-200
+C, TAD I BPTR /GET WORD FROM BUFFER
+ JMS I LINK
+ JMS PRINT-200 /PRINT IT IN OCTAL ON LIST DEVICE
+ ISZ BPTR /POINT TO NEXT WORD IN BUFFER
+ NOP /V3D
+ ISZ CKNT /DONE WITH THIS ROW?
+ JMP C /NO, GO PRINT NEXT WORD
+ JMS I LINK
+ JMP SPACE-200
+ JMS INIT
+D, TAD I BPTR
+ RTR
+ RTR
+ RTR
+ JMS I LINK
+ JMP PUT6-200
+ TAD I BPTR
+ JMS I LINK
+ JMP PUT6-200
+ ISZ BPTR /POINT TO NEXT WORD IN BUFFER
+ NOP /V3D
+ ISZ CKNT /DONE WITH THIS ROW?
+ JMP D /NO, GO ON TO NEXT WORD
+ JMS I LINK
+ JMP SPACE-200
+ JMS INIT
+E, TAD I BUFFER /GET WORD 1 OF PAIR
+ JMS I LINK
+ JMP PUTSAV-200 /PUT OUT THE CHAR AND SAVE THE WORD
+ ISZ BUFFER /POINT TO WORD 2 OF PAIR
+ TAD I BUFFER /GET WORD 2 OF PAIR
+ JMS I LINK
+ JMP PUTSAV-200
+ ISZ BUFFER /POINT TO BEGIN OF NEXT PAIR
+ JMS I LINK
+ JMP THIRD-200 /PRINT THIRD CHAR FROM
+ /REMEMBRANCES OF LAST TWO
+ ISZ CKNT
+ ISZ CKNT /DONE WITH THIS ROW?
+ JMP E /NO, GO ON TO NEXT PAIR
+ JMS I LINK /YES
+ JMP CRLF-200 /PRINT CARRIAGE RETURN/LINE FEED
+ ISZ KNT /DONE WITH BUFFER YET?
+ SKP /NO
+ JMP OKRET /YES
+ ISZ RKNT /DONE WITH LAST ROW OF PAGE?
+ JMP A /NO, GO ON TO NEXT ROW IN SAME PAGE
+ ISZ BLOCK /BUMP BLOCK NUMBER BY 1
+ JMP B /GO DUMP THE NEXT PAGE
+\fCLOSE, STA /-1 CHANGES CR TO FORM FEED
+ JMS I LINK
+ JMP CRLF-200
+OKRET, ISZ DUMP /POINT TO NORMAL RETURN
+M40, SMA SZA CLA /AC 0 SO ALWAYS SKIPS
+ERRET, STL CLA RAR /FATAL ERROR HAS AC NEGATIVE
+DMPRET, HLT /PERFORM 'CIF CDF' TO USER'S FIELD
+ JMP I DUMP /RETURN
+
+INIT, 0
+ TAD M10
+ DCA CKNT
+ TAD BUFFER
+ DCA BPTR
+ JMP I INIT
+
+KSLASH, 57-40
+KCIDF, CIF CDF 0
+KCDF, CDF 0
+M10, -10
+L40, 40 /MUST BE REAL 40
+L3700, 3700
+BUFFER, 0
+RKNT, 0 /ROW COUNT
+CKNT, 0 /COLUMN COUNT
+BLOCK, 0 /CURRENT BLOCK NUMBER
+KLLS, LLS
+ IFZERO .-375&4000 <ERROR>
+ *374
+L70, 70 /MUST BE AT REL LOC 174
+KNT, 0 /- NUMBER OF PAGES LEFT TO DUMP
+ IFNZRO L70-374 <ERROR>
+DUMP, DMPVER
+ JMS LINK /GET ADDRESS OF NEXT PAGE INTO LINK
+ IFNZRO .-400 <ERROR>
+ PAGE
+\f LSF=6661 /SLIP ON LPT FLAG
+ LLS=6666 /LOAD LPT BUFFER
+
+ IFDEF DMPTTY <
+ LSF=TSF
+ LLS=TLS
+ >
+
+LINC, 0
+ DCA ARG
+ RDF
+ TAD HCDF
+TTY12, DCA TEMP
+HCDF, CDF 0
+ TAD I LINC
+ DCA DOIT
+ ISZ LINC
+L77, 77
+TEMP, 0
+ TAD ARG
+CNT,
+DOIT, HLT
+POP, JMP I LINC /RETURN
+L177, 177
+ IFNZRO POP&177-15 <ERROR> /MUST BE AT 15 IN PG
+ IFNZRO DOIT&177-14 <ERROR>
+ IFNZRO TEMP&177-12 <ERROR>
+
+THIRD, TAD SAVE
+ DCA ARG
+ TAD ARG
+PUTSAV, AND L7600
+ CLL RAL
+ TAD SAVE
+ RTL
+ RTL
+ AND L177
+ DCA SAVE
+ TAD ARG
+ AND L177 /FORCE 7-BIT
+ TAD M140 /DO RANGE CHECK
+ CLL
+ TAD (100 /FOR BETWEEN 40 AND 137
+ SNL /SKIP ON SUCCESS
+TTY40,
+M140, SZA CLA /NEVER SKIPS
+PUTSPC, TAD TTY40 /RESTORE CHAR OR BLANK
+PUTPOP, JMS LPUT
+TTY215, JMP POP
+\fLPUT, 0
+ NOP /THIS MAY BE AN 'LLS' OR 0
+L7600, 7600 /CLA
+KBD, KSF
+ JMP CHECKL
+ TAD L7600
+ KRS
+ TAD (-7603
+ SNA CLA
+ JMP CTRLC
+ KRB
+ TLS
+ AND L177
+ TAD (-15
+ SNA
+ JMP CR
+ TAD (15-70
+ CLL
+ TAD (10
+ DCA TEMP
+ SNL
+ JMP NOT /NOT A DIGIT
+ TAD NUM
+ CLL RAL
+ CLL RAL
+ CLL RAL
+ TAD TEMP
+ DCA NUM
+ JMP CHECKL
+CTRLC, CIF CDF 0
+ JMP I L7600
+CR, TAD NUM
+ DCA LOW
+ TAD (12-77
+NOT, TAD L77
+ TSF
+ JMP .-1
+XTRA, TLS
+ CLA
+ DCA NUM
+CHECKL, LSF
+ JMP KBD
+ JMP I LPUT /YES, RETURN
+NUM, 0
+LOW, 0
+\fPUT6, TAD TTY40
+ AND L77
+ JMP PUTSPC
+
+PRINT, 0
+ DCA ARG
+ TAD TTY40
+ JMS LPUT
+ TAD (-4
+ DCA CNT
+PRLUP, TAD ARG
+ AND L7600
+ CLL RTL
+ TAD L214 /14 SHIFTS TO 60
+ /AND L214 HAS AC0 = 0
+ RTL
+ JMS LPUT
+ TAD ARG
+ RTL
+ RAL
+ DCA ARG
+ ISZ CNT /BUG IF TRY TO USE AS L214
+ JMP PRLUP
+ JMP I PRINT
+L214, 214 /COULD BE 'AND CNT'
+
+SAVE, 0 /MUST BE DEDICATED. USED AS SHIFT
+ /REG AND MUST BE ALMOST 0 ON ENTRY
+\fARG, 0
+
+SPACE, TAD TTY40
+ JMS LPUT
+ JMP PUTSPC
+
+BLK, SNA CLA
+ DCA LOW /BLOCK 0 INITIALIZATION
+ TAD L214 /FORM FEED
+ JMS LPUT
+ TAD ARG
+ JMS PRINT
+/ TAD (-10
+/ DCA TEMP
+/ TAD TTY3
+/ JMS SPACE
+/LUP, TAD TEMP
+/ TAD (10 /MUST BE REAL 10
+/ JMS PRINT
+/ ISZ TEMP
+/ JMP LUP
+CRLF, TAD TTY215
+ JMS LPUT
+ TAD TTY12
+ JMP PUTPOP
+ PAGE
+\f
--- /dev/null
+/INTEGER MATH PACKAGE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 5A
+/ APRIL 28, 1977
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+/
+ ENTRY IREM
+ ENTRY IABS
+ ENTRY DIV
+ ENTRY MPY
+ ENTRY IRDSW
+ ENTRY CLEAR
+ ENTRY SUBSC
+
+/THE FOLLOWING DEFINITIONS ARE TO ENABLE LIBRARY
+/OPTIMIZATIONS WHERE CRITICAL TIMING CONSIDERATIONS
+/EXIST. THEY SHOULD BE USED WITH EXTREME CAUTION,
+/AND MUST REFERENCE CURRENT PAGE AND PAGE ZERO SYMBOLS
+/ONLY.
+
+ OPDEF TADI 1400
+ OPDEF DCAI 3400
+ OPDEF JMSI 4400
+ OPDEF JMPI 5400
+
+ LAP /LV AUTO PAGING FOR PAL-III LIKE CODE
+
+AC, 0 /LOCATIONS USED BY MPY & DIV
+MQ, 0
+SIGN, 0
+CTR, 0
+LOC, 0
+SAV, 0
+
+MPY, BLOCK 1
+ 5 /INTEGER MULTIPLY SUBROUTINE
+ DCA MQ / CALL 1,MPY
+ TAD MPY / ARG <NUMBER>
+ DCA MPY1
+MPY1, NOP /REPLACED BY CDF
+ TADI MPY#
+ INC MPY#
+ DCA MPY2
+ TADI MPY#
+ INC MPY#
+ DCA DIV
+MPY2, NOP /REPLACED BY CDF
+ TADI DIV
+ JMS MPYSB
+ RETRN MPY
+
+MPYSB, 0 /INTERNAL MULTIPLICATION SUBR
+ DCA DIV
+ TAD (-14
+ DCA CTR
+BACK, CLL RAL
+ DCA AC
+ TAD MQ
+ CLL RAL
+ DCA MQ
+ SZL
+ TAD DIV
+ TAD AC
+ ISZ CTR
+ JMP BACK
+ JMPI MPYSB
+/
+ CPAGE 4
+DIVZA, DIVZ
+DVERR, 4411 /"DIVZ" ERROR
+ 2632
+DIV, BLOCK 1
+ 5 /INTEGER DIVIDE SUBROUTINE
+ SMA / CALL 1,DIV
+ JMP AD1 / ARG <DIVISOR>
+ INC SIGN
+ CIA
+AD1, DCA MQ
+ DCA CTR
+ TAD DIV
+ DCA DIV1
+DIV1, NOP /REPLACED BY CDF
+ TADI DIV#
+ INC DIV#
+ DCA DIV2
+ TADI DIV#
+ INC DIV#
+ DCA MPY
+DIV2, NOP
+ TADI MPY
+ SNA
+ JMPI DIVZA /ATTEMPTING TO DIVIDE BY ZERO
+ SMA
+ JMP LOOP1
+ INC SIGN
+ CIA
+LOOP1, CLL RAL
+ INC CTR
+ SMA
+ JMP LOOP1
+ CLL RAR
+ DCA LOC
+ TAD LOC
+ CIA
+ DCA MPY
+ TAD CTR
+ CMA
+ DCA CTR
+ TAD CTR
+ DCA SAV
+ DCA AC
+ TAD MQ
+LOOP2, TAD MPY
+LOOP3, ISZ CTR
+ SKP
+ JMP DONE
+ STL
+ SPA
+ CLL
+ DCA MQ
+ TAD AC
+ RAL
+ DCA AC
+ TAD MQ
+ CLL RAL
+ SNL
+ JMP LOOP2
+ TAD LOC
+ JMP LOOP3
+DONE, CLA
+ TAD SIGN
+ RAR
+ CLA
+ DCA SIGN
+ TAD AC
+ SZL
+ CIA
+ RETRN DIV
+
+IREM, BLOCK 1
+ 5 /INTEGER REMAINDER SUBROUTINE
+ CLA / CALL 1,IREM
+ INC IREM# / ARG <UNUSED VARIABLE>
+ INC IREM#
+ INC SAV /IREM MUST HAVE AN ARGUMENT
+ TAD MQ /BECAUSE IT IS A FUNCTION.
+ SPA /IREM CAN BE CALLED ONLY ONCE
+ TAD LOC /AFTER EACH DIVISION ...
+ SKP /SUBSEQUENT CALLS WILL RETURN ZERO.
+LOP, CLL RAR
+ ISZ SAV
+ JMP LOP
+ RETRN IREM
+/
+ PAGE
+\f
+IABS, BLOCK 1
+ 5 /INTEGER ABS VALUE FUNCTION
+ TAD IABS / CALL 1,IABS
+ DCA IAB1 / ARG <INTEGER VARIABLE>
+IAB1, NOP
+ TADI IABS#
+ INC IABS#
+ DCA IAB2
+ TADI IABS#
+ INC IABS#
+ DCA IRDSW
+IAB2, NOP /CDF TO ARGUMENT FIELD
+ TADI IRDSW
+ SPA
+ CIA
+ RETRN IABS
+
+IRDSW, BLOCK 1
+ 5 /READ SWITCH REGISTER FUNCTION
+ CLA OSR
+ INC IRDSW#
+ INC IRDSW#
+ RETRN IRDSW
+
+DIVZ, CALL 1,ERROR /ZERO DIVIDE ERROR
+ ARG DVERR
+ CLA CLL CMA RAR
+ RETRN DIV
+
+/THE FLOATING POINT CLEAR ROUTINE WAS ADDED TO "INTEGR"
+/SO THAT PROGRAMS WHICH DO NOT USE FLOATING POINT MATH
+/CAN RUN WITHOUT LOADING THE F.P. MATH PACKAGE.
+
+CLEAR, BLOCK 1
+ 5 /FLOATING POINT CLEAR FUNCTION
+ DCA IRDSW
+ DCA ACH
+ DCA ACM
+ DCA ACL
+ TAD IRDSW
+ RETRN CLEAR
+
+\f
+/ THE FOLLOWING CAN BE USED FOR DOUBLY OR SINGLY
+/ SUBSCRIPTED ARRAYS. ON ENTRY THE AC SHOULD BE
+/ NEGATIVE FOR FLOATING POINT VARIABLES. THIS MAY
+/ BE ANY NEGATIVE NUMBER FOR SINGLY SUBSCRIPTED
+/ VARIABLES, AND MUST BE THE FIRST DIMENSION FOR
+/ DOUBLY SUBSCRIPTED VARIABLES. SOME EXAMPLES
+/ FOLLOW: (TO LOAD THE I,JTH ELEMENT OF AN FP ARRAY)
+
+/ TAD (-M /DIMENSIONS ARE M BY N
+/ CALL 3,SUBSC
+/ ARG J
+/ ARG I
+/ ARG ARRAY
+/ LOC /MUST BE A DUMMY VARIABLE
+/ CALL 1,IFAD
+/ ARG LOC
+
+/ TO LOAD THE JTH ELEMENT OF AN INTEGER ARRAY:
+
+/ CALL 2,SUBSC
+/ ARG J
+/ ARG INTARR
+/ LOC /STILL A DUMMY VARIABLE
+/ TAD I LOC
+
+
+S1, BLOCK 1 /ADDR OF 1ST SUBSC
+S2, BLOCK 1 /ADDR OF 2ND SUBSC
+A, BLOCK 2 /ADDR OF ARRAY
+R, BLOCK 1 /ADDR FOR RESULT
+TM, 0
+FL, 0 /DOUBLE SUBSC FLAG
+N, 0 /DIMENSION -- NEGATIVE IF FLOATING
+MQA, MQ /FOR INDIRECT DCA
+
+SUBSC, BLOCK 1
+ 5 /FORTRAN SUBSCRIPTING ROUTINE
+ DCA N /SAVE THE DIMENSION
+ TAD N
+ SPA /... ALSO ABS VALUE
+ CMA
+ DCAI MQA /WARNING **THIS ASSUMES DF=CURR FIELD**
+ CLA CLL CMA RAL /HOW MANY ARGS?
+ TAD SUBSC#
+ DCA 10
+ TAD SUBSC
+ DCA SUB1
+SUB1, NOP /REPLACED BY CDF
+ TADI 10
+ AND (100
+ SNA CLA /DOUBLE SUBSCRIPTS?
+ JMP SB0
+ TADI 10 /YES, PICK UP ARGS...
+ DCA SB2
+ TADI 10
+ DCA S2
+ CMA
+SB0, DCA FL /SET DBL SUBSC FLAG
+ TADI 10
+ DCA SB1
+ TADI 10
+ DCA S1
+ TADI 10
+ DCA A
+ TADI 10
+ DCA A#
+ TAD SUBSC
+ DCA SUB2
+ TADI 10
+ DCA R
+ TAD 10
+ IAC
+ DCA SUBSC#
+ ISZ FL /DBL SUBSCRIPTING?
+ JMP SB1
+ CLA CMA /GET THE 2ND SUBSC
+SB2, NOP /CDF TO FIELD OF 2ND SUBSCRIPT
+ TADI S2
+ SZA /IS IT A 1?
+ JMSI MPYSBA /NO, MULTIPLY BY DIMENSION
+SB1, NOP /CDF TO FIELD OF 1ST SUBSCRIPT
+ TADI S1
+ TAD (-1 /MINUS ONE
+ DCA TM
+SUB2, NOP /REPLACED BY CDF
+ TAD A
+ DCAI R
+ INC R
+ TAD N
+ SPA CLA /FIXED OR FLOATING
+ TAD TM
+ CLL RAL
+ TAD TM
+ TAD A#
+ DCAI R
+ STL CLA RTL /FAST 'RETRN SUBSC'
+ TAD SUBSC
+ DCA SUB3
+SUB3, NOP /REPLACED BY 'CDF CIF'
+ JMPI SUBSC#
+
+MPYSBA, MPYSB
+
+ END
+\f
--- /dev/null
+/IOH SUBROUTINE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 10A
+/ APRIL 28,1977
+/ INPUT OUTPUT CONVERSION SUBROUTINE
+/ FOR 8K ALICS-FORTRAN SYSTEM
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+ ABSYM SACH 23 /SAVE FPAC FOR MANIPULATION OF AC
+ ABSYM SACM 24
+ ABSYM SACL 25
+ ABSYM N2 175 /LAST ACCUMULATED NUMBER
+ ABSYM ARGUMT 176
+ DUMMY ARGUMT
+ DUMMY FPNT
+ ENTRY READ
+ ENTRY WRITE
+ ENTRY IOH
+/
+/ THE FOLLOWING IS NECESSARY BECAUSE CERTAIN SUBROUTINES SKIP
+/
+ OPDEF TADI 1400
+ OPDEF DCAI 3400
+ OPDEF ANDI 0400
+ OPDEF JMPI 5400
+ OPDEF JMSI 4400
+ OPDEF ISZI 2400
+ SKPDF JMSKP 4000
+ LAP
+
+/
+A2, BLOCK 14
+/
+/ IOH ERROR ROUTINES
+/
+ERRNO, BLOCK 1
+ERR2, ISZ WHI /SEE IF THIS WAS I FORMAT OR THE EXPONENT
+ERR3, ISZ ERRNO /IN E FORMAT
+ ISZ ERRNO
+ SKP
+ERR1, ISZ DV /ERR1 IS ALWAYS FATAL
+ CLA
+ TAD DV
+ SNA CLA /WAS THIS AN INPUT ERROR FROM THE TELETYPE?
+ CLA CLL CML RAR /YES - NON-FATAL
+ TAD (615
+ DCA IO
+ TAD ERRNO /IOH ERROR NUMBER
+ TAD (2461 /MAKE INTO BCD
+ DCA SW /TO ERROR COMMENT
+ CALL 1,ERROR
+ ARG IO
+
+ JMP RETRY /DO ENTIRE READ STATEMENT OVER
+DV, 0 /SAVE DEVICE CODE
+CS, A2 /INITIAL PUSH POINTER
+PARN, 0
+ NOP /CDF N
+ TADI WRITE#
+ INC WRITE#
+ JMP I PARN
+CH, 0
+TW, 12
+READ, BLOCK 1
+ 10 /ENTRY POINT FOR READ
+RETRY, TAD READ /SNEAK IN
+ DCA WRITE
+ TAD READ#
+ DCA WRITE# /SAVE SECOND RETURN WORD
+ JMP ET
+ CPAGE 4
+IO, 0
+SW, 0 /LEFT OR RIGHT HALF OF FORMAT
+WRITE, BLOCK 1
+ 10 /ENTRY POINT
+ CLA IAC /INITIALIZE SWITCH
+ET, DCA IO
+ DCA CH /CLEAR CHARACTER
+ DCA ERRNO /ZERO ERROR NUMBER IN CASE ERROR RESTART
+ TAD WRITE
+ DCA PARN#
+ JMS PARN
+ DCA DEVNO1
+ JMS PARN
+ DCA 7
+DEVNO1, NOP /CDF N
+ CLA CMA
+ TADI 7 /PICK UP DEVICE NUMBER
+ CLL RTR /ROTATE IT INTO BITS 0-3
+ RTR
+ RAR
+ DCA DV
+ TAD CS /INITIALIZE PUSH STACK
+ DCA PUSH /-
+ JMS PARN
+ DCA FPNT01
+ JMS PARN
+ DCA FPNT
+ CLA IAC /SET UP "SW" TO START FORMAT
+ DCA SW /FROM SECOND CHARACTER (FIRST IS LPAREN)
+ DCA BA /ZAP END-OF-LINE SWITCH
+ TAD PENTER /FAKE RE-ENTRY TO SET UP FIRST LPAREN
+ DCA GLST /ON PUSHDOWN STACK
+ RETRN WRITE
+PENTER, FENTER
+
+FPNT, 0
+GFRM, 0
+ TAD SW
+ INC SW
+ CLL RAR
+ TAD FPNT /FORM ADDRESS IN AC AND LEFT/RIGHT
+ DCA 7 /SWITCH IN LINK
+FPNT01, NOP /CDF N
+ TADI 7
+ SZL /LEFT OR RIGHT?
+ JMP HR
+ RTR
+ RTR
+ RTR
+HR, AND (77
+ JMP I GFRM
+ CPAGE 5
+ 0 /I1000
+ 0 /I100
+ 0 /I10
+I1, 0 /I1
+ 4000
+SV, BLOCK 3 /FLOATING POINT TEMPORARY
+ CPAGE 3
+TN, 2045 /10.0
+ 0
+ 0
+\f PAGE /EXPERIMENTAL
+RETN, DCA SACH /SET SACH TO 0
+RTUR, JMS GFRM /GET NEXT CHAR IN FORMAT
+ CPAGE 24
+ JMS CHTYPE /CLASSIFY FORMAT CHARACTER
+ DG /DIGIT EXIT
+ -57; SL
+ -56; PER
+ -54; CM
+ -51; RPAR
+ -50; LP
+ -47; QT
+ -40; RTUR
+ 0; SVCHR
+SVCHR, DCA CH
+ JMS NU /GET THE ACCUMULATED NUMBER
+ CMA /KRONK IT
+ DCA N1 /AND SAVE COUNT FOR ALL CONVERSIONS
+ TAD CH
+ AND (7757
+ TAD (7770 /THIS TESTS IF CH IS AN ,X, OR ,H,
+ SNA CLA
+CM, JMS PR /IT WAS , PROCESS IT
+ JMP RETN /NOT X OR H, KILL NUMBER AND TRY AGAIN
+N1, 0
+
+SL, JMS PR /GO PROCESS THE PREVIOUS ITEM (IF ANY)
+ JMS EJ
+ JMP RETN
+QT, JMS PR /PROCESS PREVIOUS ITEM, IF ANY
+QT1, JMS GFRM
+ TAD (-47
+ SNA /ANOTHER QUOTE?
+ JMP RETN
+ TAD (47
+ JMS PRINT /PRINT CHAR
+ JMP QT1
+DG, JMS DGT /ACCUMULATE DIGIT INTO SACH
+ JMP RTUR /TRY ANOTHER CHARACTER
+LP, ISZ PUSH /LEFT PAREN
+ CLA CMA /COUNT NESTING DEPTH, NEGATIVE
+ TAD NPAR
+ DCA NPAR
+ TAD SW /PICK UP THE FORMAT POINTER
+ DCA I PUSH /CRAM IT INTO THE LIST
+ ISZ PUSH /KICK AGAIN
+ JMS NU /THERE MAY BE AN ACCUMULATED NUMBER
+ CIA /SAVE NUMBER
+ DCA I PUSH /*
+ CLA CLL CML RTL /HERE WE SEE IF THIS IS A POSSIBLE
+ TAD NPAR /RESTART POINT
+ SPA CLA /IF FIRST SAVE SW IN S1
+ JMP RETN /NOPE- FORGET IT
+ TAD SW /YES--FIRST CRAM FORMAT---
+ DCA S1 /---INTO SAVE1
+ TAD I PUSH /AND THAT STUFF IN THE LIST---
+ DCA S2 /---GOES INTO SAVE 2
+ JMP RETN /READY FOR ANYTHING, HERE WE GO
+PUSH, 0 /PARENTHESIS PUSHDOWN LIST POINTER
+
+RPAR, JMS PR /PROCESS PREVIOUS ITEM, IF ANY
+ ISZ I PUSH
+ JMP TR
+ CLA CLL CMA RAL /-2
+ TAD PUSH /DELETE THIS ITEM FORM THE LIST
+ DCA PUSH /PUSH = PUSH-2
+ ISZ NPAR /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT
+ JMP RETN
+ JMS WH /THIS PAREN WAS THE BALANCING PAREN
+ TAD S1 /GET THE FORMAT POINTER OF THE--
+ DCA SW /RESTART POINT AND CRAM IT
+ TAD S2 /GET SWITCH AND THE COUNT
+ CIA
+FENTER, DCA SACH
+ CLA CMA
+ TAD SW /TEST TO SEE IF SW IS ORIGINAL POINTER
+ SNA CLA
+ JMP L2 /YES - FAKE A RESTART
+ ISZ PUSH /NO - PUSH ORIGINAL POINTER
+ CLA IAC /SINCE WE ARE RETURNING TO DEPTH 2
+ DCA I PUSH
+ ISZ PUSH
+ CLA CMA /SET COUNT = 1, SWITCH = 1
+ DCA I PUSH
+ CMA
+L2, DCA NPAR /PARNRN = -1
+ JMP LP
+
+TR, CLA CMA /GET OUT THE FORMAT POINTER--
+ TAD PUSH /*
+ DCA N3
+ TAD I N3
+ DCA SW /HAA-- IT IS NOW RESTORED
+ JMP RETN /AWAY WE GO
+N3, 0 /W FOR E AND F CONVER
+PER, JMS NU /GOT A PERIOD, MUST BE OR F TYPE
+ DCA N3
+ JMP RETN
+S1, 0
+S2, 0 /SAVE THE COUNT AND SWITCH
+NPAR, 0
+\f PAGE /EXPERIMENTAL
+
+EX, JMS GLST /THIS IS E FORMAT CONVERSION
+EE, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+ TAD C
+ DCA GLST /STORE C AWAY IN A SAFE PLACE
+ DCA C
+ CLA CMA
+ DCA EFLG /SET "E FORMAT FAKEOUT" FLAG
+ TAD (-5
+ JMP FFAKE /FAKE OUT "F" FORMAT TO PRINT DIGITS
+PRNTE, TAD (5 /PUT OUT THE E
+ JMS PRINT
+
+
+/ NOW PRINT 'C' DIGITS UNDER I3 FORMAT
+ TAD GLST
+ SPA SNA CLA
+ CLA CLL CMA RAL
+ TAD (55
+ JMS PRINT /PRINT A MINUS OR PLUS
+ TAD GLST
+ SPA
+ CIA
+ CALL 1,DIV
+ ARG TW
+ TAD (60
+ JMS PRINT /PRINT
+ CPAGE 4
+ CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE
+EFLG, 0
+CRX, 0
+ TAD (60
+ JMS PRINT /PRINT SECOND DIGIT
+ JMP EX /DONE, DO NEXT
+
+FX, CLA
+ JMS GLST /THIS IS F FORMAT CONVERSION
+FF, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+ DCA EFLG
+ TAD C /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER
+ SMA
+ CLA CMA /0 MULTS NEEDED OR ALREADY THERE
+FFAKE, TAD N3 /NUM3 IS THE FIELD WIDTH
+ CIA /MINUS SPACE FOR DADP+DP
+ TAD N2
+ JMS SA /PUT OUT REQUIRED BLANKS + SIGN
+ TAD C
+ SMA
+ JMP PRZRO /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS
+ CIA
+ JMS DT
+PRDCPT, TAD (56
+ JMS PRINT
+ TAD C /GET MULTIPLY COUNT
+ SPA SNA
+ JMP PAS2
+ CMA /THEY WERE MULTIPLIES, 0 TO N OF THEM
+ DCA CRX
+ TAD N2 /DIGITS AFTER DEC POINT, DADP
+ CMA
+ DCA NR
+ JMP PASA /TEST FOR 0 MULTIPLIES
+RETR, TAD (60 /PUT OUT A ZERO
+ JMS PRINT /ALL MULTIPLIES REPRESENTED
+PASA, ISZ CRX /NO, TRY RUN OFF FIELD
+ SKP
+ JMP PASS /YES
+ ISZ NR /ALL WIDTH ACCOUNTED FOR%
+ JMP RETR /NO, TRY NEXT POSITION
+
+
+PASS, TAD C /YES, GET MULT COUNT
+ CIA /-MULT COUNT
+ SKP
+PAS2, CLA
+ TAD N2 /N2-MULT COUNT
+ SMA SZA /IS MULT COUNT .GE. N2?
+ JMS DT /NO - PRINT REMAINING DIGITS
+ ISZ EFLG /WERE WE FAKED OUT BY "E" FORMAT?
+ JMP FX /NO
+ JMP PRNTE /YES - GO PRINT EXPONENT
+PRZRO, CLA
+ TAD (60
+ JMS PRINT
+ JMP PRDCPT /GO BACK TO PRINT THE DECIMAL POINT
+
+SA, 0
+ TAD SN
+ SMA /THIS IS -(NUM OF BLANKS)
+ JMP AS3 /POSITIVE, NUMBER TOO BIG FOR FIELD
+ DCA CRX
+ SKP CLA
+RETC, JMS PRINT /HERE WE PUT OUT THAT MANY BLANKS
+ TAD (40
+ ISZ CRX
+ JMP RETC /YES
+ CLA
+ TAD SN
+ SNA CLA /IS SIGN MINUS?
+ JMP I SA /EVIDENTLY NOT
+ TAD (55
+ JMS PRINT /PUT OUT A MINUS SIGN
+ JMP I SA
+
+\f PAGE /EXPERIMENTAL
+FN, TAD N3 /GET WIDTH, INPUT FOR E OR F FORMAT
+ CMA /1'S COMPLEMENT
+ DCA CR /TO COUNTER
+ DCA D1 /0 TO D1
+ CALL 0,CLEAR
+ CMA
+ DCA D2 /-1 TO DECIMAL POINT SWITCH
+ CMA /-0 TO SGN FLAG
+RRTSGN, DCA SN
+RRT, CLA
+ ISZ CR /INDEX TO SEE IF WIDTH EXCEEDED
+ SKP
+ JMP FP /GET AN INPUT CHARACTER AND TEST IT
+ JMS GCHR
+ CPAGE 20
+ JMS CHTYPE /CLASSIFY INPUT CHAR
+ FDIGIT /DIGIT
+ -56; PUNT
+ -40; RRT
+ -53; RRT
+ -55; RRTSGN
+ -5; EPRO
+ 0
+PERR3, ERR3
+FDIGIT, DCA IS
+ CALL 1,FMP
+ ARG TN
+ CALL 1,STO /SAVE FLOATING POINT ACCUMULATOR
+ ARG SV
+ TAD IS
+ CALL 0,FLOT /FLOAT NEW DIGIT
+ CALL 1,FAD
+ ARG SV
+ INC D1 /COUNT OF DIGITS
+ JMP RRT
+PUNT, ISZ D2 /TST DP SWITCH
+ JMPI PERR3 /***** TWO DECIMAL POINTS *****
+ DCA D1
+ JMP RRT
+EPRO, CLA CMA /AN E
+FP, DCA IS /-1 TO IS IF E, 0 TO IS IF END OF FIELD
+ ISZ D2 /TEST DP SWITCH
+ JMP FA /ONE HAS OCCURRED
+ TAD N2 /ONE HAS NOT OCCURRED, GET NDP
+ SKP
+FA, TAD D1 /COUNT OF DIGITS AFTER EXPLICIT DP
+ CMA /-COUNT
+ JMS DH /DIVIDE FPAC BY TEN COUNT TIMES
+ TAD ACH /IF ACH=0,DON'T CHK. SIGN
+ SNA
+ JMP ZR /ZERO-DON'T CHECK
+ ISZ SN /TEST SIGN
+ TAD (4000 /SET SIGN BIT
+ DCA ACH
+ZR, ISZ IS /DID WE GET AN "E"?
+ JMP VZA /NO - STORE RESULT AND GET OUT
+ JMP VQ /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT
+D1, 0
+D2, 0
+IS, 0
+CR, 0
+
+PRO2, CMA /GOT EXPONENT - MAKE IT NEGATIVE
+ ISZ SN /WHAT WAS ITS ORIGINAL SIGN?
+ JMP VZB /NEGATIVE - DIVIDE BY 10^EXP
+ DCA D1 /SAVE COUNT
+ JMP VZD
+VZC, CALL 1,FMP
+ ARG TN
+VZD, ISZ D1 /INDEX COUNT
+ JMP VZC
+ JMP VZA
+VZB, JMS DH
+VZA, CALL 1,ISTO /STORE IN PLACE
+ ARG ARGUMT
+ JMP FX
+\f PAGE /EXPERIMENTAL
+XX, JMS MR /TEST FOR MORE
+ TAD IO /TEST FOR INPUT-OUTPUT
+ SNA CLA
+ JMP XX1 /INPUT, PSEUDO-JUMP
+ TAD (40 /OUTPUT A BLANK
+ JMS PRINT
+ JMP XX /CYCLE
+XX1, JMS GCHR /IGNORE SPACES ON INPUT
+ CLA
+ JMP XX
+
+HH, JMS MR /THE H FIELD PROCESSOR
+ JMS GFRM /SAME AS XXX, BUT PRINT NEXT
+ JMS PRINT /----- FORMAT CHARACTER
+ JMP HH /OUTPUT ONLY
+
+PRINT, 0
+ TAD (-40
+ SPA
+ TAD (100 /CONVERT 6-BIT TO 8-BIT
+ TAD (240
+ TAD DV /ADD ON DEVICE NUMBER IN BITS 0-3
+ CALL 0,GENIO
+ JMP I PRINT
+
+WH, 0
+ JMS EJ /END THE RECORD
+ TAD ARGUMT#
+ SNA CLA /TEST PARAMETER FOR 0
+ JMS GLST /RETURN TO MAIN PROGRAM ON 0 PAR
+ JMP I WH /MORE AGRUMENTS RETURN
+
+EJ, 0 /ROUTINE TO END RECORD
+ TAD IO
+ SZA CLA /INPUT OR OUTPUT?
+ JMP E1 /OUTPUT
+E2, CLA
+ TAD BA
+ SZA CLA
+ JMP BG /CARRIAGE RETURN SEEN - GOODBYE
+ JMS GCHR /GET A CHARACTER
+ JMP E2 /KEEP LOOKING FOR CR
+BG, DCA BA
+ JMP I EJ
+E1, TAD (7715 /7715 TRANSLATES TO 215
+ JMS PRINT
+ TAD (7712
+ JMS PRINT /PRINT CR-LF
+ JMP I EJ
+
+BA, 0 /THIS IS THE END OF LINE SWITCH
+BH, ISZ BA /ENTRY TO LOOK FOR AN END OF LINE
+BL, TAD (40
+ AND (77 /KEEP THIS - BL IS REFERENCED BY GCHR
+ JMP I GCHR
+
+GCHR, 0 /GET AN INPUT STRING CHARACTER
+JD, CLA
+ TAD BA /GET EOR SWITCH
+ SZA CLA
+ JMP BL /IS EOR, RETURN BLANK
+ CLA CLL CML RTR /****** IF # OF DEVICES IS CHANGED,
+ TAD DV /THIS SHOULD BE CHANGED TOO *****
+ CALL 0,GENIO /CALL GENIO WITH OFFSET DEVICE NUMBER
+ AND (177 /STRIP PARITY
+ TAD (7763
+ SNA /CARRIAGE RETURN?
+ JMP BH
+ TAD (7655
+ CLL
+ TAD (100 /IS CHAR IN RANGE 237<CHAR<340?
+ SNL
+ JMP JD /NO - IGNORE
+ JMP BL /CONVERT TO SIXBIT AND RETURN
+\f PAGE /EXPERIMENTAL
+/ GET F.P. NUMBER INTO THE RANGE .1 .LE. N .L. 1.0
+NR, 0
+ JMSKP BB /CHECK DIRECTION OF I/O
+ JMP FN /INPUT
+ CALL 1,IFAD /OUTPUT - LOAD NUMBER INTO FLOATING AC
+ ARG ARGUMT
+ DCA SN /CLEAR THESE LOCS
+ DCA C
+ TAD ACH
+ SNA
+ JMP NREX /NUMBER IS ZERO
+ SMA /IS IT A MINUS F P NUMBER
+ JMP RETM
+ TAD (4000 /YES-- MAKE IT POSITIVE
+ ISZ SN /SET SIGN
+ DCA ACH
+RETM, CLA /MULTIPLY BY 10 UNTIL NR .GT. (1.0)
+ TAD ACH
+ TAD (5764
+ SMA CLA
+ JMP TB /GOT IT IT IS .GE.1
+ CALL 1,FMP
+ ARG TN
+ ISZ C /AND COUNT
+ JMP RETM /GO TRY TO DO IT AGAIN
+TB, JMS SE /NOTE SE ' XR-1
+ CALL 1,STO
+ ARG SV
+ TAD (2004
+ DCA ACH /200400000000=.50000 IN AC
+ TAD CH /TEST FORMAT
+ TAD (7772
+ SNA CLA /IS IT E FORMAT?
+ TAD C /NO - COUNT # OF MULTS NEEDED
+ CIA
+ TAD N2 /< DADP
+ SMA
+ CMA /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND
+ JMS DH /DO THE DIVIDES
+ CALL 1,FAD
+ ARG SV
+ JMS SE /REDUCE TO NORMAL RANGE AGAIN
+
+
+GD, TAD ACH
+ RAL
+ SPA CLA
+ JMP ZP /NUMBER IS ? 1/2
+ TAD ACH
+ CLL RAR /WE ARE GETTING EXP TO 200
+ DCA ACH
+ TAD ACM
+ RAR
+ DCA ACM
+ TAD ACL
+ RAR
+ DCA ACL
+ TAD ACH
+ AND (7774
+ TAD ACH
+ TAD (10
+ DCA ACH
+ JMP GD
+ZP, TAD ACH
+ AND (7
+ DCA ACH
+NREX, JMP I NR
+SN, 0
+
+C, 0 /COUNTER FOR DEC. EXP.
+SE, 0 /DIVIDE BY 10 UNTIL N < 1.0
+XR, TAD ACH /TEST NUMBER FOR .GE. 1
+ TAD (5764
+ SPA CLA
+ JMP I SE /NUMBER IS IN RANGE, RETURN
+ CLA CLL CMA RAL
+ JMS DH
+ CLA CMA /REDUCE COUNT
+ TAD C
+ DCA C
+ JMP XR
+\f PAGE /EXPERIMENTAL
+GLST, 0 /GET NEXT ARGUMENT ROUTINE
+ CALL 0,CLEAR /CLEAR FLOATING AC
+ ISZ IOHCNT /ARE WE IN AN ARRAY I/O LOOP?
+ JMP ARMORE /YES - GET NEXT ELEMENT
+ INC IOH#
+ RETRN IOH /RETURN TO USERS PROGRAM FOR MORE DATA
+ARMORE, TAD ARGUMT#
+ TAD IOHINC /BUMP ARGUMENT POINTER BY ELEMENT LENGTH
+ JMP IOHBAK /RESUME I/O CONVERSIONS WITH UPDATED ARGUMT
+
+ CPAGE 33
+IOH, BLOCK 1
+ 10
+ SZA CLA /IS THIS A SCALAR OR AN ARRAY CALL?
+ JMP IOHAR /AN ARRAY CALL
+ CLA CMA
+IOGTAR, DCA IOHCNT /SET UP ARGUMENT COUNT FOR THIS CALL
+ TAD IOH
+ DCA IOH1
+IOH1, NOP /SET DATA FIELD TO ARGUMENT LIST
+ TADI IOH#
+ DCA ARGUMT
+ INC IOH#
+ TADI IOH#
+IOHBAK, DCA ARGUMT#
+ JMP I GLST /RETURN TO I/O CONVERSION
+IOHAR, INC IOH#
+ CLA CLL CML RAR
+ AND I IOH /GET TYPE OF ARRAY
+ CLL RTL
+ CML RAL /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE
+ DCA IOHINC
+ CLA CLL CMA RAR
+ ANDI 7 /GET THE ELEMENT COUNT
+ CIA
+ INC IOH#
+ JMP IOGTAR /SAVE IT AND GET ARRAY POINTER
+IOHINC, 0
+IOHCNT, 0
+
+CHTYPE, 0 /SUBROUTINE TO CLASSIFY CHARACTERS
+ DCA CHCH
+ TAD CHCH
+ TAD (7706
+ CLL
+ TAD (12
+ SZL /IS THE CHARACTER NUMERIC?
+ JMP JMPOUT /YES - TAKE FIRST EXIT
+ INC CHTYPE
+CHLOOP, CLA
+ TAD I CHTYPE
+ INC CHTYPE
+ SNA /CHARACTER LIST EXHAUSTED?
+ JMP JMPOTX /YES - TAKE LAST EXIT WITH CHAR IN AC
+ TAD CHCH
+ SNA CLA /MATCH?
+ JMP JMPOUT /YES - TAKE EXIT WITH AC=0
+ INC CHTYPE
+ JMP CHLOOP /NO MATCH - GO ON TO NEXT CHAR
+JMPOUT, DCA CHCH
+JMPOTX, TAD I CHTYPE
+ DCA CHTYPE
+ TAD CHCH
+ JMP I CHTYPE
+CHCH, 0
+
+DT, 0
+ CIA
+ DCA CHCH /STORE COUNT
+RETT, JMS LS /LEFT SHIFT 1
+ TAD ACL /SAVE THE FPAC
+ DCA SACL
+ TAD ACM
+ DCA SACM
+ TAD ACH
+ AND (17
+ DCA SACH
+ TAD SACH
+ DCA ACH /TRIM AC TO 28 BITS
+ JMS LS /LEFT SHIFT 2
+ JMS LS
+ TAD ACL /ADD THE DSAVE TO THE ACC
+ TAD SACL
+ DCA ACL
+ RAL /*
+ TAD ACM
+ TAD SACM
+ DCA ACM
+ RAL /*
+ TAD ACH
+ TAD SACH
+ DCA ACH
+ TAD ACH
+ CLL RAR /ROTATE 3 RIGHT
+ RTR
+ AND (17
+ TAD (60 /MAKE DIGIT
+ JMS PRINT /DUMP IT AND SEE IF ANY MORE
+ ISZ CHCH /LOOP ON COUNT
+ JMP RETT /*
+ JMP I DT
+
+LS, 0 /LEFT SHIFT THE FPAC 1
+ TAD ACL
+ CLL RAL
+ DCA ACL
+ TAD ACM
+ RAL
+ DCA ACM
+ TAD ACH
+ RAL
+ DCA ACH
+ JMP I LS /DONE
+\f PAGE /EXPERIMENTAL
+PR, 0
+ TAD SACH /GET THE LAST NUMBER ACCUMULATED
+ DCA N2 /SAVE IT
+PR2, TAD CH
+ SNA
+ JMP I PR /NOTHING TO DO
+ CPAGE 22
+ JMS CHTYPE /CLASSIFY CH
+ ERR1 /DIGIT IS ILLEGAL
+ -30;XX
+ -11;II
+ -10;HH
+ -6;FF
+ -5;EE
+ -1;AA
+ 0;ERR1
+
+MR, 0 /MORE?
+ ISZ N1 /SEE IF IT GOES TO ZERO
+ JMP I MR
+ DCA CH /NO MORE FIELDS, FIRST WIPE CHAR
+ JMP I PR /GO BACK TO FORMAT SCANNER
+NU, 0 /ROUTINE TO FETCH THE ACCUM NUMB
+ TAD SACH
+ SNA /IF IT IS ZERO, SET IT TO 1
+ CLA IAC /IT IS AND WE DO
+ JMP I NU /GO HOME
+BB, 0
+ JMS MR /MORE?
+ TAD ARGUMT#
+ SNA CLA /IF ARG=0,
+ JMS WH /END RECORD AND RETURN TO USERS PROGRAM
+ TAD IO /TEST IN OUT SWITCH
+ SZA CLA /OUTPUT
+ INC BB /INPUT
+ JMP I BB
+AX, JMS GLST
+AA, TAD N2
+ CIA
+ DCA CX
+ JMSKP BB
+ JMP AR
+AS, JMS GADR /GET CHARACTER ADDRESS
+ TADI 7
+ SZL
+ JMP ASNORT
+ RTR
+ RTR
+ RTR
+ASNORT, AND (77 /MASK 6 BITS
+ JMS PRINT
+ ISZ CX
+ JMP AS /LOOP FOR CHARACTER COUNT
+ JMP AX /GET NEXT ARGUMENT(IF ANY)
+
+AR, JMS GCHR
+ DCA DH /GET AND SAVE INPUT CHAR
+ JMS GADR /GET CHARACTER POINTER
+ TAD DH
+ SZL /WHICH HALF?
+ JMP ARNORT /RIGHT HALF
+ IAC
+ RTL
+ RTL
+ RTL
+ SKP
+ARNORT, TADI 7
+ TAD (7740 /CANCEL BLANK CHAR
+ARCOMN, DCAI 7
+ ISZ CX
+ JMP AR
+ JMP AX
+
+GADR, 0 /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT
+ TAD ARGUMT
+ DCA AS1
+ TAD N2
+ TAD CX
+ CLL RAR
+ TAD ARGUMT# /AC=WORD POINTER, LINK=LEFT/RIGHT FLAG
+ DCA 7
+AS1, NOP /SET UP DATA FIELD OF ARGUMENT
+ JMPI GADR
+CX, 0
+
+DH, 0
+ DCA CX /DIVIDE FPAC BY TEN CX TIMES
+ JMP DTA
+DTB, CALL 1,FDV
+ ARG TN
+DTA, ISZ CX
+ JMP DTB
+ JMP I DH
+AS3, CLA /PRINT ASTERISKS FOR WHOLE FIELD SIZE
+ TAD N3 /GET FIELD SIZE, E OR F
+ CMA
+ DCA CX /-COUNT
+ JMP QQ
+QQA, TAD (52 /PRINT CX ASTERISKS
+ JMS PRINT
+QQ, ISZ CX /INDEX COUNT
+ JMP QQA
+ JMS GLST /TEST FOR MORE
+ JMP PR2 /RETURN TO FORMAT PROCESSOR, SAME TYPE
+\f PAGE /EXPERIMENTAL
+IN, TAD N2 /INTEGER INPUT, GET WIDTH OF FIELD
+ CMA /1,S COMP TO COUNTER, CR
+ DCA CR
+ CMA
+VQ, DCA WHI /-1 TO NUMBER ACCUMULATED
+ CMA /-1 TO SIGN
+RRSIGN, DCA SN
+ DCA SACH
+RRS, ISZ CR /HAS WHOLE NUMBER BEEN ACCUMULATED
+ SKP
+ JMP PRO
+ JMS GCHR
+ CPAGE 14
+ JMS CHTYPE /CLASSIFY CHARACTER
+ DIGIT /ITS A DIGIT
+ -40; RRS
+ -53; RRS
+ -55; RRSIGN
+ 0; ERR2
+DIGIT, JMS DGT /ACCUMULATE DIGIT INTO SACH
+ JMP RRS /GET NEXT DIGIT
+PRO, TAD SACH /WE HAVE AN INTEGER ...
+ ISZ WHI /WHAT KIND?
+ JMP PRO2
+ ISZ SN / 'I' FORMAT
+ CIA
+ DCA I ARGUMT
+
+IX, CLA
+ JMS GLST /INTEGER CONVERSION
+II, JMSKP BB /TEST MORE AND NON ZERO CURRENT LIST ITEM
+ JMP IN /INPUT
+ TAD AB
+ DCA SACL /OUTPUT
+ TAD (-4
+ DCA WHI /-4
+ DCA SN /0
+ TAD I ARGUMT
+ SMA /SET SN 0 FOR PLUS, 1 FOR MINUS
+ JMP XZ /PLACE MAGNITUDE IN 20
+ CIA
+ ISZ SN
+XZ, CALL 1,DIV
+ ARG TW
+ DCA SACH
+ CPAGE 4
+ CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE
+AB, I1
+WHI, 0
+
+
+ DCA I SACL /SAVE REMAINDER
+ CMA
+ TAD SACL /SACL=SACL-1
+ DCA SACL
+ ISZ WHI /INDEX COUNT
+ TAD SACH /AND CHECK NUM FOR 0
+ SZA
+ JMP XZ /CYCLE
+IB, TAD N2
+ DCA N3 /IN CASE OF OVERFLOW
+ TAD N2
+ CMA
+ TAD WHI
+ TAD (4 /COMPUTE NUMBER OF LEADING BLANKS
+ JMS SA /PRINT LEADING BLANKS AND SIGN
+ID, INC SACL /POINT TO DIGIT TO PRINT NEXT
+ TAD I SACL /GET IT
+ SPA /TERMINATOR?
+ JMP IX /YUP
+ TAD (60
+ JMS PRINT /NOPE - PRINT THE DIGIT
+ JMP ID /GET NEXT
+
+DGT, 0
+ DCA SACM
+ TAD SACH
+ CLL RTL
+ TAD SACH
+ RAL
+ TAD SACM
+ DCA SACH
+ JMP I DGT
+
+ END
+\f
--- /dev/null
+/IOPEN SUBROUTINE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 21A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/ SUBROUTINES TO MANIPULATE OS/8 FILES
+/
+
+ ENTRY IOPEN /OPEN AN INPUT FILE
+ ENTRY OOPEN /OPEN AN OUTPUT FILE
+ ENTRY OCLOS /CLOSE AN OUTPUT FILE
+ ENTRY CHAIN /CHAIN TO A PROGRAM
+
+ OPDEF TADI 1400
+ OPDEF ISZI 2400
+ OPDEF DCAI 3400
+ OPDEF JMPI 5400
+
+ LAP /LEAVE AUTOMATIC PAGING - WE NEED THE 2 LOCATIONS
+
+IOER, 1117;0522 /"IOER" ERROR MESSAGE
+IOPEN, BLOCK 1
+ 21
+ TAD ASDVM1
+ JMS SETUP /PUT 2 WORDS OF FIRST ARGUMENT INTO "ASDEV"
+ TADI INHNDL /DATA FIELD IS 0 HERE - GET INPUT HANDLER PAGE
+ SNA
+ JMP IOERR /NO /I GIVEN - ERROR
+ DCAI 10 /STORE IN "ASPAGE"
+ JMS GFILNM /MOVE FILE NAME INTO LOCS 00000-00003
+ TAD FLUKUP /LOAD POINTER TO "FLUKUP" IN RUN-TIME ROUTINES
+CALASN, 6202 /CIF 0
+ JMS I FASIGN /SET DF=CURRENT AND GO LOOKUP FILE
+ RETRN IOPEN /** FASIGN SKIPS BUT SECOND WORD IS SMALL **
+IOERR, CALL 1,ERROR /I-O ERROR - GIVE MESSAGE AND QUIT
+ ARG IOER
+
+OOPEN, BLOCK 1
+ 21
+ JMS OOCOMN
+ TAD FENTER
+ JMP CALASN /SEE "IOPEN" FOR COMMENTS
+
+OOCOMN, 0 /COMMON SUBR BETWEEN "OOPEN" AND "OCLOS"
+ TAD OOPEN
+ DCA IOPEN
+ TAD OOPEN#
+ DCA IOPEN# /MOVE CALLING ADDRESS TO IOPEN
+ TAD ASDVM1
+ JMS SETUP /SET UP DEVICE NAME IN FIELD 0
+ TADI OUHNDL
+ SNA
+ JMP IOERR /NO /O GIVEN - ERROR
+ DCAI 10 /STORE IN "ASPAGE"
+ JMS GFILNM /PUT FILE NAME INTO 00000-3
+ JMPI OOCOMN
+
+OCLOS, BLOCK 1
+ 21
+ JMS OOCOMN /SET UP DEVICE AND FILE NAME
+ TAD OCLOS
+ DCA IOPEN
+ TAD OCLOS#
+ DCA IOPEN# /SET UP IOPEN FOR RETURN
+ TAD CHAIN /=7177
+ DCA OOCOMN
+OCLOOP, TAD CHAIN# /=1632 =^Z ON DEVICE 4 OUTPUT
+ CALL 0,GENIO
+ ISZ OOCOMN
+ JMP OCLOOP /FORCE OUT THE LAST BUFFER
+ TAD FCLOSE
+ JMP CALASN /DO WORK AND LEAVE
+
+SETUP, 0
+ DCA 10
+ TAD IOPEN
+ DCA SETDF
+SETDF, 0 /SET CALLING DATA FIELD
+ TADI IOPEN#
+ DCA GETWD# /SAVE FIELD OF ARGUMENT
+ INC IOPEN#
+ TADI IOPEN#
+ DCA SETDF /SAVE ADDRESS OF ARGUMENT
+ INC IOPEN#
+ JMS GETWD /TRANSFER TWO WORDS FROM THE
+ JMS GETWD /ARGUMENT LIST TO WHERE XR 10 POINTS
+ JMPI SETUP /RETURN WITH DATA FIELD =0
+
+GETWD, 0
+ NOP /SET ARGUMENT FIELD
+ TADI SETDF
+ INC SETDF
+ 6201 /CDF 00
+ DCAI 10
+ JMPI GETWD /DO NOT RESTORE DATA FIELD
+
+GFILNM, 0
+ CLA CMA
+ JMS SETUP /MOVE TWO WORDS TO 00000 AND 00001
+ JMS GETWD /MOVE THE THIRD WORD
+ TAD DA
+ DCAI 10 /SUPPLY AN EXTENSION
+ JMPI GFILNM
+
+DA, 0401 /.DA EXTENSION
+INHNDL, 74
+OUHNDL, 75
+FASIGN, 541 /*****************
+ASDVM1, 552 / CAUTION!
+FLUKUP, 567 /ALL THESE LOCATIONS ARE VERY VOLATILE!!
+FENTER, 741 /WATCH OUT IF YOU REASSEMBLE THE LOADER!
+FCLOSE, 757 /*****************
+
+CHAIN, 7177 /USE "CHAIN" TO STORE CONSTANTS
+ 1632 /SINCE IT IS ONLY CALLED TERMINALLY
+ TAD CHAIN
+ DCA IOPEN
+ CALL 0,CKIO /WAIT FOR DEVICE
+ TAD CHAIN#
+ DCA IOPEN#
+ JMS GFILNM /GET FILE NAME INTO 00000-00003
+ ISZI INHNDL /FORCE INHNDL NONZERO SO IOPEN WONT FAIL
+ TAD SV /CHANGE ASSUMED EXTENSION
+ DCA DA /FROM .DA TO .SV
+ TAD (0310
+ DCA IOER /IF IOPEN FAILS GIVE "CHER" MESSAGE
+CALOPN, CALL 1,IOPEN
+ ARG SYS /CHAIN WORKS FROM THE SYSTEMS DEVICE ONLY
+ 6201
+ 0 /"ARG 0" POINTING TO 00000!
+ TAD (6
+ 6201 /SET DF TO 0
+ DCAI K2 /MODIFY "LOOKUP" INTO "CHAIN"
+ DCAI ZRONAM /ALSO KILL LOC WHICH ZEROS FILE NAME PTR
+ JMP CALOPN /GO BACK - THIS TIME IOPEN WILL CHAIN.
+
+SYS, 2303 /***** 2303+2326 =4631 = "SYS"! WATCH IT!
+SV, 2326
+K2, 571 /**** SUPER VOLATILE LOCATION ****
+ZRONAM, 557 /**** DITTO ****
+
+ END
+\f
--- /dev/null
+/INTEGER POWERS OF NUMBERS ...INTEGER AND FLOATING POINT
+/
+/OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 2A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+
+ ENTRY IIPOW
+ ENTRY FIPOW
+ OPDEF TADI 1400
+
+ LAP
+
+FIPOW, BLOCK 1
+ 2
+ TAD FIPOW
+ DCA IIPOW
+ TAD FIPOW#
+ DCA IIPOW#
+ CALL 1,STO
+ ARG X /SAVE BASE
+ JMP FIFI
+
+X, BLOCK 3
+RSLT, BLOCK 3
+N, 0
+FISW, 0
+IIPOW, BLOCK 1
+ 2
+ DCA X /SAVE BASE
+ IAC
+FIFI, DCA FISW
+ TAD IIPOW
+ DCA II
+II, NOP
+ TADI IIPOW#
+ DCA NCDF
+ INC IIPOW#
+ TADI IIPOW#
+ DCA N
+ INC IIPOW#
+NCDF, NOP /GET FIELD OF EXPONENT
+ TADI N /GET EXPONENT
+ CLL
+ SPA
+ CIA CML
+ DCA N /SAVE ABS VALUE
+ TAD X
+/********* THE FOLLOWING CODE MAY BE REPLACED BY JUST "SNA CLA"
+/********* IF THE RULES ARE THAT 0**ANYTHING=0 FOR FLOATING
+/********* POINT TOO. (REMEMBER 0**0 AND 0**-1!)
+ SNA CLA
+ TAD FISW
+ SZA CLA
+/*********
+ JMP IPRTRN /BASE=0 MEANS RESULT=0
+ TAD FISW
+ SZA
+ JMP DCARSL
+ACHONE, TAD (2014
+ DCA ACH /INITIALIZE FPAC TO 1.0
+DCARSL, DCA RSLT /INITIALIZE RSLT TO FISW
+ SNL /THE LINK SHOULD CONTAIN THE EXPONENT SIGN
+ JMP BACK /POSITIVE - ALLS WELL
+ TAD FISW
+ SZA CLA
+ JMP IPRTRN /I**-N = 0
+ CALL 1,FDV
+ ARG X /THERE'S A 1.0 IN THE AC, REMEMBER?
+ CALL 1,STO
+ ARG X
+ CLL /FAKE A POSITIVE SIGN
+ JMP ACHONE /GO BACK AND RESTORE FPAC TO 1.0
+
+BACK, TAD N /USE STANDARD POWER-OF-2 ALGORITHM FOR POWERS
+ SNA
+ JMP DONE
+ CLL RAR
+ DCA N
+ SNL
+ JMP LOOP
+ TAD RSLT
+ SNA
+ JMP FPMULT /RSLT=0 MEANS FLOATING POINT
+ CALL 1,MPY
+ ARG X
+STRSLT, DCA RSLT
+LOOP, TAD N
+ SNA CLA
+ JMP DONE
+ TAD FISW
+ SNA CLA
+ JMP FPSQR
+ TAD X
+ CALL 1,MPY
+ ARG X
+ DCA X
+ JMP BACK
+
+FPMULT, CALL 1,FMP /DO THE SAME STUFF IN FLOATING POINT
+ ARG X /THAT WE DID ABOVE IN INTEGERS
+ JMP STRSLT
+
+FPSQR, CALL 1,STO
+ ARG RSLT /SAVE FLTG AC
+ CALL 1,FAD
+ ARG X
+ CALL 1,FMP
+ ARG X
+ CALL 1,STO
+ ARG X /SQUARE X
+ CALL 1,FAD
+ ARG RSLT
+ DCA RSLT /KEEP RSLT ZERO!
+ JMP BACK
+
+DONE, TAD RSLT
+IPRTRN, RETRN IIPOW
+
+
+ END
+\f
--- /dev/null
+/1 ANALEX LINE PRINTER HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -1
+DEVICE L645;DEVICE LPT;1040;0;ZBLOCK 2
+
+/V3 FIXES:
+
+/1. ADDED VERSION NUMBER
+/2. ADDED PARITY ^C
+/3. ALLOWED ^C TO WORK EVEN IF LPT OFF
+/ S.R.
+
+ LPTVERSION="A&77
+
+ *200
+ /LINE PRINTER HANDLER FOR "OLD STYLE" LINE PRINTER
+ /RECOGNIZES TAB,LINE FEED,VERTICAL TAB AND FORM FEED
+ /IGNORES CARRIAGE RETURNS, TREATS ^N AS "CARRIAGE RETURN
+ / WITHOUT LINE FEED" CONTROL CHARACTER.
+ LSE=6651
+ LCF=6652
+ LLB=6654
+ LSD=6661
+ LCB=6662
+ LPR=6664
+LPT, LPTVERSION
+LP7700, 7700
+LPT11, 11 /FALLS THROUGH HARMLESSLY, CLEARING THE AC
+LPT214, RDF
+ TAD LPTCIF
+ DCA LPTXIT
+ TAD I LPT
+ AND LPT70
+ TAD LP6201
+ DCA LPTCDF
+ CLA CLL CML RAR
+ TAD I LPT /LINK IS NOW 1 IF COMMAND WAS A "WRITE"
+ AND LP7700
+ CMA
+ DCA LPTWC /LPTWC=WORD COUNT/2
+ ISZ LPT
+ TAD I LPT
+ DCA LPTCA
+ ISZ LPT
+ TAD I LPT
+ ISZ LPT
+ SNL
+ JMP LPTERR
+ SZA CLA
+ JMP LPTCDF
+ LCB
+ JMS LPWAIT
+ TAD LPT214
+ JMS LPTPCH /FORM FEED, INITIALIZES COUNT
+LPTCDF, HLT
+ JMP LPT7
+LPTLP, TAD I LPTCA
+ JMS LPTPCH
+ TAD I LPTCA
+ AND LP7400
+ DCA LPTTMP
+ ISZ LPTCA
+LP7400, 7400
+ TAD I LPTCA
+ JMS LPTPCH
+ TAD I LPTCA
+ AND LP7400
+ CLL RTR
+ RTR
+ TAD LPTTMP
+ RTR
+ RTR
+ JMS LPTPCH
+ ISZ LPTCA
+LPT7, 7
+ ISZ LPTWC
+ JMP LPTLP
+LPTRTN, ISZ LPT
+LPTXIT, HLT
+ JMP I LPT
+LPTWC, 0
+LPTCA, 0
+LPTPCH, 0
+ AND LPT177
+ SZA
+ TAD LPM140
+ SMA
+ JMP I LPTPCH
+ TAD LPT106
+ SNA
+ JMP LPTCTZ
+ TAD LPT13
+ CLL
+ TAD LPT6
+ SZL SNA
+ JMP LPTCTL
+ TAD LPT11
+ LLB
+ JMP LPTKSF
+LPWAIT, -1
+WEIGHT, LSD
+ JMP NOTDON
+ LCF
+ ISZ LPLPTR
+ JMP I LPWAIT
+ CLA IAC
+LPTCTL, SNA
+ JMP LPTTAB
+ TAD LPTTAD
+ DCA LPTXXX
+ TAD LP7607
+ DCA LPLPTR
+LPTXXX, HLT
+ SNA
+ JMP .+3
+ LPR
+LPTKSF, JMS LPWAIT
+ JMP I LPTPCH
+NOTDON, KRS
+ AND LPT177
+ TAD LPM3
+ SNA CLA
+ KSF
+ JMP WEIGHT
+LPTCIF, CDF CIF 0
+ JMP I .+1
+ 7600
+LPTCTZ, TAD LPT214
+ JMS LPTPCH
+ JMP LPTRTN
+LPT6, 6
+LPTTAB, TAD LPT40
+ LLB
+ JMS LPWAIT
+ TAD LPLPTR
+ AND LPT7
+LPM140, SZA CLA
+ JMP LPTTAB
+ JMP I LPTPCH
+LPTERR, CLA CLL CML RAR
+ JMP LPTXIT
+LPTTAD, TAD .
+LPT70, 70 /LF
+LPT13, 13 /VT
+LPT177, 177 /FF
+ 0 /CR
+LPT40, 40 /CR, NO LF
+LPM3, -3
+LPT106, 106
+LP7607, 7607
+LP6201, CDF 0
+LPTTMP, 0
+LPLPTR, 0
+ $
+\f
--- /dev/null
+/1 LINCTAPE HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -10
+DEVICE LNC;DEVICE LTA0;4170;10;ZBLOCK 2
+DEVICE LNC;DEVICE LTA1;4170;11;ZBLOCK 2
+DEVICE LNC;DEVICE LTA2;4170;12;ZBLOCK 2
+DEVICE LNC;DEVICE LTA3;4170;13;ZBLOCK 2
+DEVICE LNC;DEVICE LTA4;4170;14;ZBLOCK 2
+DEVICE LNC;DEVICE LTA5;4170;15;ZBLOCK 2
+DEVICE LNC;DEVICE LTA6;4170;16;ZBLOCK 2
+DEVICE LNC;DEVICE LTA7;4170;17;ZBLOCK 2
+
+ LINCVERSION="A&77
+
+ *200
+ /LINCTAPE HANDLER FOR PS/8 - CRUDE VERSION (WRITE OPERATION CHECKS
+ /AFTER EACH BLOCK)
+ /ALL 8 HANDLERS ARE IN THIS PAGE - SEE DECTAPE HANDLER FOR
+ /DUMB COMMENT
+
+ /PDP-12 OPCODES NEEDED
+ LINC= 6141
+ PDP= 0002
+ CLR= 0011
+ AXO= 0001
+ TMA= 0023
+ TAC= 0003
+ STDI= 0436
+ COM= 0017
+ ROLI1= 0261
+ ESF= 0004
+
+LTM203, -203
+LTA, 0
+LTA7, 7
+LTA30, 30
+LTA70, 70
+LTA702, 702
+LT3700, 3700
+LTATMP, LINCVERSION
+DTA0, ISZ LTANO
+DTA1, ISZ LTANO
+DTA2, ISZ LTANO
+DTA3, ISZ LTANO
+DTA4, ISZ LTANO
+DTA5, ISZ LTANO
+DTA6, ISZ LTANO
+DTA7, ISZ LTANO
+LTA200, 200
+ TAD LTANO
+ CMA
+ TAD LTATAD
+ DCA LTANO
+ CLA CLL CML RTR
+ TAD LTANO
+ DCA LTADCA
+ RDF
+ TAD LCDIF0
+ DCA LTAXIT
+LTANO, 0
+ DCA LTA
+ TAD LTAISZ
+LTADCA, 0
+ TAD I LTA
+ DCA LTARG1
+ ISZ LTA
+ TAD I LTA
+ DCA LTARG2
+ ISZ LTA
+ TAD I LTA
+ CLL RAL /MOVE ARGUMENTS TO WORK AREA
+ DCA LTARG3
+ ISZ LTA
+ ISZ LTA
+ TAD LTARG1 /GET CORE FIELD
+ AND LTA70
+ TAD LTCDF
+ DCA LTSET
+ TAD LTSET
+ AND LTA70
+ CLL RTL
+ RTL /MOVE TO BITS 0-2. CONTROLLER
+ RTL /WANTS THEM THERE
+SLTARG3,DCA LTATMP
+ TAD LTANO /GET UNIT NO.
+ AND LTA7
+ CLL RAR
+ TAD LTATMP
+ TAD LTA30 /SET BIT 7 ON. EXTENDED ADD. MODE
+ LINC
+ AXO /SEND DATA TO CONTROLLER
+ PDP
+LT7600, 7600
+ DCA LTANO /RESET UNIT NO.
+ TAD LTARG1
+ RTL
+ AND LTA3
+ CLL RTL
+ TAD LTA702 /ADD TAPE INST; STORE IT
+ DCA LTINST
+LTALP, TAD LTARG2 /CORE ADDRESS TO CONTROLLER
+LTATAD, TAD LTA200 /SAVE 129 TH WORD
+ DCA LTATMP
+LTSET, 0
+ TAD I LTATMP
+ DCA LTASVC /SAVE LOC.
+ TAD LTARG2
+ LINC
+ TMA
+LTINST, 0 /TAPE INSTRUCTION HERE
+LTARG3, 0 /BLOCK NO. HERE
+LTAWLP, PDP
+ CLA
+ TAD LTASVC /RESTORE 129TH WORD
+ DCA I LTATMP
+ TAD LTA200 /ADD 200 FOR PARITY TTY
+ KRS
+ TAD LTM203 /TEST FOR ^C
+ SNA CLA
+ KSF /IS FLAG UP?
+ JMP NOTFUG /EITHER NOT ^C OR NO FLAG
+ TAD LTA30
+ LINC
+ ESF
+ PDP
+LT7700, 7700
+ TAD LTASVC
+ DCA I LTATMP
+LCDIF0, CDF CIF 0
+ JMP I LT7600
+NOTFUG, LINC
+ STDI
+ COM
+ ROLI1
+LTA3, TAC
+ PDP
+ SNL
+ JMP LTAWLP
+LTADUN, CLL IAC
+ CLA IAC RTL
+ AND LTINST
+ SNA CLA
+ JMP LTALP
+LTNERR, TAD LTARG1
+ AND LT3700
+ TAD LT7700
+ SNA /ALL DONE?
+ JMP LTAXIT
+ DCA LTARG1 /NO.. SAVE COUNT
+ TAD LTATMP
+ DCA LTARG2
+ ISZ LTARG3
+ JMP LTALP
+LTAXIT, HLT
+ JMP I LTA
+LTAISZ, ISZ LTANO
+LTARG1, 0
+LTARG2, 0
+LTCDF, CDF 0
+LTASVC=LTADCA
+$$$$$$$$
+\f
--- /dev/null
+/2 LINCTAPE SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ SOFSET=7747
+ SBLOCK=7776
+ LINC=6141
+ AXO=1
+ PDP=2
+ TMA=23
+ *0
+
+ VERSION="B&77
+
+ -2
+ DEVICE LINC;DEVICE SYS;4171;2007;0;1341
+ DEVICE LINC;DEVICE LTA0;4171;1007;0;1341
+
+/V3D: REMOVED 'SOFSET'
+\f STARTB-ENDB-1
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+STARTB, ZBLOCK 16
+B4047, 4047
+B7647, 7647
+ 1020;20;4 /IO PRESET
+ 1020;20;AXO /LOAD SOME LINCTAPE FLAGS
+ 1020;7600;TMA /LOAD MEMORY ADDRESS
+ 720;1 /READ RECORD 1
+ PDP /BACK TO PDP-8 MODE
+ CLA
+ TAD I B4047
+ CDF 10
+ DCA I B7647
+ CDF 00
+ ISZ B4047
+ ISZ B7647
+ JMP .-6
+ JMP I .+1
+ENDB, 7605
+
+
+
+ /THE BOOTSTRAP FOR A LINCTAPE SYSTEM IS AS FOLLOWS:
+
+ /LEFT SWITCHES=700,RIGHT SWITCHES=0
+ /I-O PRESET IN LINC MODE AND PRESS "D0". TAPE WILL MOVE
+ /WHEN TAPE STOPS PRESS "START 20".
+\f *200
+
+ NOPUNCH;*7600;ENPUNCH
+
+ ZBLOCK 7
+SHNDLR, VERSION
+S7600, 7600
+ RDF
+ TAD SCIF
+ DCA SXIT
+ TAD I SHNDLR
+ DCA SFUN /FUNCTION
+ ISZ SHNDLR
+ TAD I SHNDLR
+ DCA SADR /BUFFER ADDRESS
+ ISZ SHNDLR
+ TAD I SHNDLR
+/V3D TAD SOFSET /SOFSET=0
+ NOP /SAVE ROOM
+ CLL RAL
+ DCA SBLOK /BLOCK NO.
+ ISZ SHNDLR
+ CLL CML RAR
+ AND SFUN
+ RTL
+ RTL
+ TAD S702 /GET FUNCTION;CREATE READ OR WRITE
+ DCA SINST /READ OR WRITE INSTRUCTION.
+ TAD SFUN
+ AND S70 /FIELD BITS TO AC 0-2
+ TAD SADCDF
+ DCA SADSET
+ TAD SADSET
+ AND S70
+ RTL
+ IAC RTL /SET EXTENDED ADDRESS
+ RTL
+ LINC
+ AXO
+ PDP
+ CLA
+ TAD SFUN
+ RAL
+ AND S7600
+ DCA SFUN
+SADSET, 0
+SLOOP, CLA CLL CMA RTL
+ DCA SERRCT /NO. ERROR TRIES
+STRY, TAD SADR
+ TAD S200
+ DCA SADNXT
+ TAD I SADNXT
+ DCA SADSVC
+ TAD SADR
+ LINC
+ TMA /CORE ADDRESS TO CONTROL
+SINST, 0 /READ OR WRITE
+SBLOK, 0 /BLOCK NO. HERE
+ PDP
+ CMA /CHECKSUM HERE. 7777=GOOD
+ DCA SADSET
+ TAD SADSVC
+ DCA I SADNXT
+ IFNZRO .-7700 <NZERR>
+ SKP
+ HLT
+ TAD SADSET
+ SZA CLA
+ JMP SERR
+SOK, ISZ SBLOK
+ TAD SADNXT
+ DCA SADR
+ TAD SFUN
+ TAD S7600
+ SNA /ALL DONE?
+ JMP SDONE /YES
+ DCA SFUN
+ JMP SLOOP
+SERR, TAD SINST
+ RTR;RTR
+ SPA CLA /WAS IT READ?
+ JMP SOK /NO..WRITE. CONTINUE
+ ISZ SERRCT /READ..RETRY IT?
+ JMP STRY
+ CLA CLL CML RAR /DON'T BOTHER
+ SKP
+SDONE, ISZ SHNDLR
+SXIT, 0
+ JMP I SHNDLR
+SFUN, 0
+SADR, 0
+SERRCT, 0
+S702, 702
+S200, 200
+S70, 70
+SCIF, CDF CIF 0
+SADCDF, CDF 0
+SADNXT, 0
+SADSVC, 0
+ $
+\f
--- /dev/null
+/5 LP08/LS8E/LA180/LV8E HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f LPVERSION="C&77
+
+ *0
+
+ -1
+ DEVICE LPSV;DEVICE LPT;1040;LPT&177;ZBLOCK 2
+
+/LPT HANDLER FOR EITHER LP08 OR LS8E LINE PRINTER.
+/HANDLES TABS, PASSES EVERYTHING ELSE ON TO THE HARDWARE.
+
+ LSF=6661 /SKIP ON FLAG
+ LSR=6663 /SKIP ON ERROR
+ LLS=6666 /LOAD LPT BUFFER
+
+ DBST= 6570 /SKIP IF DEMAND SET AND CLEAR IT
+ DBTD= 6574 /LOAD COMPLEMENT OF AC0-11 TO TRANSMIT BUFFER
+ DBSE= 6575 /SET INTERRUPT ENABLE
+ DBCE= 6575 /CLEAR INTERRUPT ENABLE
+
+ LA180=0 /SET TO 1 TO USE LA180
+
+/V3D CHANGES:
+
+/ADDED IN LA180 SUPPORT
+\f *200
+
+LPWDTH, -205 /-(WIDTH+1) [USE -121 FOR 80 COLUMNS]
+LTERMC, 14 /4 FOR LV8
+LVCCNV, -40 /0 IF PRINTER PRINTS LC
+LP7770, 7770
+LP0007, 0007
+LPT, LPVERSION /NORMAL ENTRY POINT
+ CLA STL RAR
+ TAD I LPT / R/W BIT TO LINK L
+ AND LP7700 / I
+ CMA /TREAT 0 PG CNT AS 0 WD CNT N
+ DCA LPTWC /SAVE -(DBLWD COUNT+1) K
+LPT214, RDF /
+ TAD LPTCIF / M
+ DCA LPTXIT /SAVE CIF CDF RETRN FIELD U
+ TAD I LPT / S
+ AND (70 / T
+ TAD (CDF 0 /
+ DCA LPTCDF / N
+ ISZ LPT /PT TO BUFFER O
+ TAD I LPT /GET BUFFER ADDRESS T
+ DCA LPTCA /SAVE BUFFER PTR
+ ISZ LPT /PT TO BLOCK # C
+ TAD I LPT /GET IT H
+ ISZ LPT /POINT TO ERROR RETURN G
+LPTCDF, HLT / !
+ SNL
+ JMP LPTERR /CAN'T READ FROM LPT
+ SNA CLA
+ TAD LPT214 /OUTPUT FORM FEED IF BLOCK 0
+LPTELP, JMS LPTPCH /PRINT 3RD CHAR OF DOUBLEWORD
+ ISZ LPTWC
+ JMP LPTLP /GET 3 MORE CHARS
+ SKP
+LPTCTZ, TAD LTERMC
+ JMS LPTPCH /OUTPUT FORM FEED IF ^Z SEEN (EOT OF LV8)
+ ISZ LPT /BUMP TO NORMAL RETURN
+LPTXIT, HLT /RESTORE FIELDS
+ JMP I LPT /EXIT
+\f/UNPACKING LOOP - USES A SHIFT REGISTER METHOD TO GET THE
+/THIRD CHARACTER IN EACH DOUBLEWORD.
+
+LPTLP, STL /GUARD BIT OF SHIFT REGISTER
+LPROTL, RTL
+ RTL
+ SPA /DO WE HAVE 8 BITS SHIFTED IN?
+ JMP LPTELP
+ DCA LPTCDF /SAVE SHIFT REGISTER
+ TAD I LPTCA
+ JMS LPTPCH /PRINT A CHAR
+ TAD I LPTCA
+ ISZ LPTCA /BUMP INPUT POINTER
+LP7400, 7400 /PROTECT ISZ
+ AND LP7400
+ CLL RAL
+ TAD LPTCDF /SHIFT HIGH 4 BITS INTO
+ JMP LPROTL /SHIFT REGISTER
+
+LPTERR, STL CLA RAR /PUT 4000 IN AC
+ JMP LPTXIT /AND TAKE ERROR RETURN
+
+LPTWC, 0
+LPTCA, 0
+\f/CHAR PRINT ROUTINE
+
+LPTPCH, 0
+ AND (177
+ TAD (-175
+ SMA
+ JMP LPFLSH /FLUSH CODES 175-177
+ TAD (175-140
+ SMA
+ TAD LVCCNV /CONVERT LC TO UC IF DESIRED
+ TAD (140-33
+ SNA
+ TAD (11 /CHANGE ALTMODE TO $
+ IAC
+ SNA
+ JMP LPTCTZ /^Z - END OF FILE
+ TAD (32-11
+ SNA
+ JMP LPTTAB /TABS MUST BE SIMULATED
+LPLFHK, TAD (11 /RESTORE CHAR
+ SZA /FLUSH NULLS
+ JMS LPCHAR /
+ TAD LPLPTR /IF COL. CTR GT 0
+ SMA /WE HIT A CONTROL CHAR
+ TAD LPWDTH /OR EOL- SET TO FULL
+ DCA LPLPTR /WIDTH (NOTE LPLPTR=1 !)
+LP7700,
+LPFLSH, SMA CLA /NEVER SKIPS
+ JMP I LPTPCH /RETURN
+
+LPCHAR, 0 /LOW LEVEL PRINT ROUTINE
+ IFZERO LA180 <
+ NOP /NOP'S NEEDED FOR SET
+ LLS /PUT CHAR IN LPT BUFFER
+ NOP
+ >
+ IFNZRO LA180 <
+ CMA
+ DBTD /PUT CHAR IN LP BUFFER
+ CMA
+ >
+ AND LP7770 /KLUDGE - CLEARS COLUMN CTR
+ TAD LP7770 /ON CR, LF, VT, FF BUT ALSO
+ SNA CLA /ON ^H,^N, AND ^O. BIG DEAL
+ DCA LPLPTR /?SR RICHIE SAID 'LPCRFG'
+LP7600, 7600 /CLEAR AC
+LPCTCL, TAD LP7600
+ KRS
+ TAD (-7603 /CHECK FOR ^C FROM CONSOLE
+ SNA CLA
+ KSF /WITH FLAG UP
+ JMP .+3
+LPTCIF, CDF CIF 0 /YES, RETURN TO OS/8
+ JMP I LP7600
+ IFNZRO LA180 <DBST> /NO MUST BE HERE
+ IFZERO LA180 <LSF> /NO FOR SET
+ JMP LPCTCL /WAIT FOR FLAG
+ ISZ LPLPTR /CHECK LINE OVERFLOW
+ JMP I LPCHAR
+ TAD (15
+ JMS LPCHAR
+ CLA IAC
+ JMP LPLFHK
+\fLPTTAB, TAD LPBLNK /GET PSEUDO BLANK
+ JMS LPCHAR /PRINT IT
+ TAD LPWDTH
+ CMA
+ TAD LPLPTR /GET # CHARS IN LINE
+ AND LP0007
+LPBLNK, SZA CLA /LOOP 'TILL MULTIPLE OF 8
+ JMP LPTTAB
+ JMP I LPTPCH
+
+LPLPTR, 0
+ $
+\f
--- /dev/null
+/1 PTR/PTP HANDLER FOR LOW SPEED
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+ *0
+ -2
+DEVICE KS33;DEVICE PTP;1020;0;ZBLOCK 2
+DEVICE KS33;DEVICE PTR;2010;110;ZBLOCK 2
+
+ VERSION="A&77
+
+ *200
+PTP, VERSION
+ CLA CLL CML /SET LINK ON TO INDICATE PUNCH
+ JMS PSETUP /DO COMMON CRAP
+PTPLP, KSF
+ JMP PTPCNT /KEYBOARD FLAG OFF - DON'T WORRY ABOUT ^C
+ KRS
+ AND PTP177
+ TAD PTPM3
+ SZA CLA /IS THERE A ^C IN THE TTY BUFFER?
+ JMP PTPCNT /NO
+PTPCIF, CDF CIF 0
+ JMP I PT7600
+PTPCNT, TAD I PTPCA
+ JMS PTPPCH /FIRST CHAR IN LOW ORDER 8 BITS OF WORD 1
+ DCA PTR
+ ISZ PTPCA
+PT7700, 7700
+ TAD I PTPCA
+ JMS PTPPCH /SECOND CHAR IN LOW ORDER 8 BITS OF WORD 2
+ CLL RTR
+ RTR
+ TAD PTR
+ RTR
+ RTR /THIRD CHARACTER NOW IN AC
+ JMS PTPPCH
+PTPEND, ISZ PTPCA
+PT70, 70 /JUST IN CASE WERE PUNCHING PG 7600 KEEP THIS LITERAL HERE
+ JMP PTPISZ
+PSETUP, 0
+ RDF /GET FIELD OF CALLING PROGRAM
+ TAD PTPCIF
+ DCA PTPXIT /SET UP RETURN SEQUENCE
+ TAD I PTP
+ AND PT70
+ TAD PCDF
+ DCA PTPCDF
+ RAR /GET LINK(1=PTP,0=PTR)
+ TAD I PTP /GET FUNCTION WORD
+ ISZ PTP
+ SPA /CHECK CORRECT MODE
+ JMP PTPERR /SIGNAL "UNRECOVERABLE DEVICE ERROR"
+ AND PT7700
+ CMA /SET UP -(WORD COUNT)/2-1
+ DCA PTPWC
+ TAD I PTP /SET UP STARTING ADDRESS
+ ISZ PTP
+ DCA PTPCA
+ TAD I PTP
+PTPCDF, 0 /SET DATA FIELD TO ACCESS BUFFER
+ PTPEOF=PTPCDF
+ SNA CLA
+ SZL
+ JMP PTPISZ
+ TAD PTP336 /INPUT INITIALIZATION - TYPE "^" AND WAIT
+ TLS
+ KSF
+ JMP .-1
+PT7600, 7600
+PTPISZ, ISZ PTPWC
+ JMP I PSETUP /LOOP FOR BUFFER SIZE (128 WORDS)
+PTPRTN, TAD PTPEOF
+ SZA CLA /DID WE RUN OUT OF TAPE?
+ ISZ PTP
+ ISZ PTP
+PTPXIT, HLT /EXIT CDF GOES HERE
+ JMP I PTP
+PTPPCH, 0
+ TLS
+ TSF /NOTICE THE GLORIOUS LACK OF OVERLAP
+ JMP .-1
+ AND PT7400
+ JMP I PTPPCH
+PTPCA, 0
+PTR, VERSION /*** CORRECT ENTRY IN MAIN ASSEMBLY IF THIS IS MOVED!
+ CLA CLL
+ TAD PTR
+ DCA PTP
+ JMS PSETUP /SET UP ADDRESS, COUNT, FIELDS
+PTRLP, JMS PTRGCH /READ FIRST CHARACTER OF 3
+ DCA I PTPCA
+ JMS PTRGCH
+ DCA PTPPCH
+ JMS PTRGCH
+ RTL
+ RTL
+ DCA PTR
+ TAD PTR
+ AND PT7400
+ TAD I PTPCA
+ DCA I PTPCA /HIGH ORDER 4 BITS INTO WORD 1
+ TAD PTR /GET THE CHAR FROM THE PTR BUFFER
+ RTL
+ RTL
+ AND PT7400
+ TAD PTPPCH
+ ISZ PTPCA
+PT7400, 7400
+ DCA I PTPCA /LOW ORDER 4 BITS INTO WORD 2
+ JMP PTPEND
+PTRGCH, 0
+ TAD PTPEOF
+ SNA CLA
+ JMP I PTRGCH
+ CLA CLL CMA RTL /-3
+ DCA PTPEOF
+ DCA PTR
+PTTIME, ISZ PTR /TIMEOUT LOOP FOR LOW SPEED READER
+ JMP PTP232
+ ISZ PTPEOF /TIMES OUT IN 132 MS(PDP 8/E) OR 205 MS(PDP 8)
+ JMP PTP232
+ TAD PTP232
+ JMP I PTRGCH /OVERFLOWED - PTPEOF IS NOW 0, RETURN ^Z
+PTP232, 232 /WASTE SOME TIME
+PTP177, 177
+ KSF
+ JMP PTTIME /READER NOT READY - CONTINUE TIMEOUT
+ KRB
+ JMP I PTRGCH /RETURN WITH CHARACTER
+PTPERR, CLA CLL CML RAR /SIGNAL A "PERMANENT I/O ERROR" ON THE DEVICE
+ JMP PTPXIT-2
+PCDF, CDF 0
+PTP336, 336
+PTPWC, 0
+PTPM3, -3
+$$$$$$$
+\f
--- /dev/null
+/POWERS SUBROUTINE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 5A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+ ENTRY IFPOW / INTEGER TO FLOATING POWER
+ ENTRY FFPOW / FLOATING TO FLOATING POWER
+ ENTRY EXP / E TO A POWER
+ ENTRY ALOG / NATURAL LOGARITHM
+/
+/
+ DUMMY LXP
+ OPDEF JMSKP 4000
+/
+/ INTERNAL SUBROUTINE POL
+/
+/ COMPUTES N TERMS OF POLYNOMIAL (NO CONSTANT TERM)
+/ N IN AC ... X IN FLOATING AC
+/ COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL
+/
+POL2, BLOCK 1
+POL, BLOCK 1
+ CIA
+ DCA POL2
+ CALL 1,STO
+ ARG X
+ TAD I POL
+ INC POL
+/ DCA ARG1# /THIS CODE PROBABLY EXTRANEOUS
+/ SKP
+ARG2, DCA ARG1#
+ CALL 1,FAD
+ARG1, ARG EXS / ADDRESS STORED HERE
+ CALL 1,FMP
+ ARG X
+ ISZ POL2
+ JMP POL1
+ JMP I POL
+POL1, TAD ARG1#
+ TAD (3
+ JMP ARG2
+
+ CPAGE 17 / CANT BREAK UP THIS TABLE
+EXS, 1464 /7.9608942E-9 CONSTANTS FOR EXP
+ 2142
+ 1421
+ 1545 /6.3578287E-7
+ 2525
+ 2525
+ 1625 /4.0690103E-5
+ 2525
+ 2525
+ 1704 /1.9531250E-3
+ 0000
+ 0000
+ 1754 /6.25E-2
+ 0000
+ 0000
+ CPAGE 3
+ONE, 2014
+ 0000
+ 0000
+ CPAGE 30
+COF, 5716 /-6.4535442E-3 CONSTANTS FOR LOGS
+ 4674
+ 1006
+ 1744 /3.6088494E-2
+ 4750
+ 6073
+ 5756 /-9.5329390E-2
+ 0636
+ 0162
+ 1765 /1.6765407E-1
+ 2726
+ 6023
+ 5767 /-2.4073380E-1
+ 5501
+ 3543
+ 1775 /3.3179902E-1
+ 2360
+ 6176
+ 5777 /-4.9987412E-1
+ 7767
+ 6001
+ 2007 /9.9999643E-1
+ 7777
+ 7041
+ CPAGE 3
+ER16, 2014 /1.0644944
+ 2040
+ 5326
+ CPAGE 3
+LN2, 1755 /8.6643397E-2
+ 4271
+ 0300
+
+X, BLOCK 3
+Y, BLOCK 3
+\f
+/
+/ ALOG - NATURAL LOGARITHM
+/
+/ ALOG(X)=N*ALOG(2)+ALOG(M) WHERE 1/2 OR EQUAL TO M
+/ ALOG(M)=ALTERNATING SERIES (K**I)/I WHERE K=2M-1 AND M AS ABOVE
+/
+ CPAGE 4
+LGER, 0114 / "ALOG" ERROR AT LOC XXXXX
+ 1707
+ALOG, BLOCK 1
+ 5 / ENTRY POINT
+ TAD ALOG
+ DCA TEM
+ TAD ALOG#
+ DCA TEM#
+ CALL 1,IFAD
+TEM, ARG 0
+ INC ALOG#
+ INC ALOG#
+ TAD ACH / GET EXPONENT
+ SPA SNA
+ JMP LGERR /LOG OF X<=0 - ERROR
+ AND (3770
+ TAD (5770 / -2000
+ DCA TEM / N INTO TEM
+ TAD ACH / GET M WITHOUT SIGN
+ AND (7
+ TAD (2010 / 2M
+ DCA ACH
+ CALL 1,FSB / 2M-1
+ ARG ONE
+ TAD (D8 / 8 TERMS OF SERIES
+ JMS POL
+ COF
+ CALL 1,STO / ALOG(M) INTO Y
+ ARG Y
+ TAD TEM / GET N
+ CALL 0,FLOT / FLOAT IT
+ CALL 1,FMP / N *ALOG(2)
+ ARG LN2
+ CALL 1,FAD / N *ALOG(2) ALOG(M)(ALOG(X)
+ ARG Y
+ RETRN ALOG / EXIT
+LGERR, CALL 1,ERROR
+ ARG LGER
+\f
+/
+/ EXP - E TO A POWER
+/
+/ E**X=SERIES (X**I)/(I!)
+/ IF B=E**(1/16) AND X IS BETWEEN -1 AND 1 THEN
+/ B**X=1 SUMA(I)*(X**I) FOR I FROM I=1 TO I=5
+/ WHERE A(I)(1/((I!)*16**2))
+/
+ CPAGE 4
+EXPER, 4530
+ 2040
+EXP, BLOCK 1
+ 5 / ENTRY POINT
+ TAD EXP
+ DCA XT
+ TAD EXP#
+ DCA XT#
+ INC EXP#
+ INC EXP#
+ CALL 1,IFAD
+XT, ARG 0
+ CLA CLL CMA RAR
+ AND ACH
+ TAD (-2075
+ SMA CLA
+ TAD ACM
+ CLL
+ TAD (-4271 /TEST FOR FLTG. AC <88.2
+ SZL CLA
+ JMP EXPERR
+ TAD ACH
+ SZA
+ TAD (40 / X*16
+ DCA ACH
+ CALL 1,STO / Y=16X
+ ARG Y
+ CALL 1,FAD / EXPRESS Y AS INTEGER N AND FRACTION F
+ ARG Y
+ CALL 0,FIX / GET N
+ SMA
+ IAC
+ DCA ALOG / ALOG=N
+ TAD ALOG / GET F
+ CIA
+ CALL 0,FLOT
+ CALL 1,FAD
+ ARG Y
+ TAD (5 / 5 TERMS OF SERIES
+ JMS POL
+ EXS
+ CALL 1,FAD / PLUS 1
+ ARG ONE
+ CALL 1,STO / GIVES B**F
+ ARG Y
+ CALL 1,FAD / GET B
+ ARG ER16
+ CALL 1,FIPOW
+ ARG ALOG
+ CALL 1,FMP / B**(N+F)=(B**16X)(E**X)
+ ARG Y
+ RETRN EXP / EXIT
+EXPERR, CALL 1,ERROR
+ ARG EXPER
+ TAD ACH
+ SMA CLA
+ CLL CMA RAR
+ DCA ACH
+ DCA ACM
+ DCA ACL
+ RETRN EXP
+\f
+/
+/ IFPOW - INTEGER TO FLOATING POWER
+/
+/ JUST FLOAT BASE AND GO TO FFPOW
+/
+IFPOW, BLOCK 1
+ 5 / ENTRY POINT
+ CALL 0,FLOT
+ TAD IFPOW / FROM BANK
+ DCA FFPOW / TO PROPER LOCATION
+ TAD IFPOW# // FROM ADDRESS
+ DCA FFPOW# /TO PROPER LOC
+ JMP ML / SNEAK INTO ROUTINE
+
+/
+/ FFPOW- FLOATING TO FLOATING POWER
+/
+/ IDENTITY USED ... X**Y=EXP(Y*ALOG(X))
+/
+ CPAGE 4
+FFPER, 4614
+ 2027
+FFPOW, BLOCK 1
+ 5 / ENTRY POINT
+ML, TAD I FFPOW / GET CDF TO EXPONENT
+ DCA LXP
+ INC FFPOW# / INCREMENT TO EXPONENT ADDRESS
+ TAD I FFPOW / GET EXPONENT ADDRESS
+ DCA LXP#
+ INC FFPOW# / INCREMENT FOR EXIT
+ TAD I LXP / HIGH ORDER WORD OF EXPONENT
+ SNA CLA / IS IT ZERO
+ JMP FFP5 / YES ... RESULT=1
+ TAD ACH / BASE IS IN FLOATING POINT AC
+ SPA
+ JMP FFPERR
+ SZA CLA / IF BASE EQUALS ZERO ... RESULT EQUALS ZERO
+ JMP FFP1
+ RETRN FFPOW / ZERO RESULT EXIT
+FFP1, CALL 1,STO / SAVE BASE
+FFP2, ARG X
+ CALL 1,ALOG
+ ARG X
+ CALL 1,FMP / Y*LOG(X)
+LXP, ARG 0 / ADDRESS STORED HERE
+ CALL 1,STO
+ ARG X
+ CALL 1,EXP
+ ARG X
+FFP6, RETRN FFPOW
+FFP5, CALL 0,CLEAR / ANYTHING TO ZERO POWER IS 1
+ TAD (2014
+ DCA ACH
+ JMP FFP6
+FFPERR, TAD (4000
+ DCA ACH
+ CALL 1,ERROR
+ ARG FFPER
+ JMP FFP1
+ END
+\f
--- /dev/null
+/1 HI SPEED READER/PUNCH HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1 HI SPEED READER/PUNCH HANDLER
+ *0
+ -2
+DEVICE PT8E;DEVICE PTP;1020;0;ZBLOCK 2
+DEVICE PT8E;DEVICE PTR;2010;112;ZBLOCK 2
+
+ PTVERSION="A&77
+
+ *200
+ /THIS IS THE REAL HIGH SPEED HANDLER.
+ /HIGH SPEED PAPER TAPE HANDLER FOR BLEEP MONITOR
+ /PACKS 3 CHARACTERS IN 2 WORDS ON INPUT, UNPACKS ON OUTPUT
+ /PAGE RELOCATABLE
+PTP, PTVERSION
+ CLA CLL CML /SET LINK ON TO INDICATE PUNCH
+ JMS PSETUP /DO COMMON CRAP
+PTPLP, TAD I PTPCA
+ JMS PTPPCH /FIRST CHAR IN LOW ORDER 8 BITS OF WORD 1
+ DCA PTR
+ ISZ PTPCA
+PT7700, 7700
+ TAD I PTPCA
+ JMS PTPPCH /SECOND CHAR IN LOW ORDER 8 BITS OF WORD 2
+ CLL RTR
+ RTR
+ TAD PTR
+ RTR
+ RTR /THIRD CHARACTER NOW IN AC
+ JMS PTPPCH
+PTPEND, ISZ PTPCA
+PT70, 70 /JUST IN CASE WERE PUNCHING PG 7600 KEEP THIS LITERAL HERE
+ KSF
+ JMP PTPISZ /KEYBOARD FLAG OFF - DON'T WORRY ABOUT ^C
+PTPKRS, KRS
+ AND PTP177
+ TAD PTPM3
+ SZA CLA /IS THERE A ^C IN THE TTY BUFFER?
+ JMP PTPISZ /NO
+PTPCIF, CDF CIF 0
+ JMP I .+1
+ 7600
+PSETUP, 0
+ RDF /GET FIELD OF CALLING PROGRAM
+ TAD PTPCIF
+ DCA PTPXIT /SET UP RETURN SEQUENCE
+ TAD I PTP
+ AND PT70
+ TAD PCDF
+ DCA PTPCDF
+ RAR /GET LINK(1=PTP,0=PTR)
+ TAD I PTP /GET FUNCTION WORD
+ ISZ PTP
+ SPA /CHECK CORRECT MODE
+ JMP PTPERR /SIGNAL "UNRECOVERABLE DEVICE ERROR"
+ AND PT7700
+ CMA /SET UP -(WORD COUNT)/2-1
+ DCA PTPWC
+ TAD I PTP /SET UP STARTING ADDRESS
+ ISZ PTP
+ DCA PTPCA
+ TAD I PTP
+PTPCDF, 0 /SET DATA FIELD TO ACCESS BUFFER
+ PTPEOF=PTPCDF
+ SNA CLA
+ SZL
+ JMP PTPKRS
+ TAD PTP336 /INPUT INITIALIZATION - TYPE "^" AND WAIT
+ TLS
+ KSF
+ JMP .-1
+ JMS PTRGCH /INITIALIZE THE PTR BUFFER CHAR
+ 6032 /CLEAR AC AND KEYBOARD FLAG
+ JMP PTPKRS /CHECK FOR ^C
+PTPISZ, ISZ PTPWC
+ JMP I PSETUP /LOOP FOR BUFFER SIZE (128 WORDS)
+PTPRTN, TAD PTPEOF
+ SZA CLA /DID WE RUN OUT OF TAPE?
+ ISZ PTP
+ ISZ PTP
+PTPXIT, HLT /EXIT CDF GOES HERE
+ JMP I PTP
+PTPPCH, 0
+ PLS /NOTICE THE GLORIOUS LACK OF OVERLAP
+ PSF
+ JMP .-1
+ AND PT7400
+ JMP I PTPPCH
+PTPCA, 0
+PTR, PTVERSION /*** CORRECT ENTRY IN MAIN ASSEMBLY IF THIS IS MOVED!
+ CLA CLL
+ TAD PTR
+ DCA PTP
+ JMS PSETUP /SET UP ADDRESS, COUNT, FIELDS
+PTRLP, JMS PTRGCH /READ FIRST CHARACTER OF 3
+ DCA I PTPCA
+ JMS PTRGCH
+ DCA PTPPCH
+ JMS PTRGCH
+ RTL
+ RTL
+ AND PT7400
+ TAD I PTPCA
+ DCA I PTPCA /HIGH ORDER 4 BITS INTO WORD 1
+ TAD PTR /GET THE CHAR FROM THE PTR BUFFER
+ RTR
+ RTR
+ RAR /PUT THE LOW ORDER BITS INTO AC 0-3
+ AND PT7400
+ TAD PTPPCH
+ ISZ PTPCA
+PT7400, 7400
+ DCA I PTPCA /LOW ORDER 4 BITS INTO WORD 2
+ JMP PTPEND
+PTRGCH, 0
+ TAD PTPEOF
+ SNA CLA
+ JMP PT0BFR /MAKE SURE BUFFER IS ZEROED
+ RFC
+ DCA PTPEOF
+PTTIME, ISZ PTPEOF /THIS LOOP OVERFLOWS IN APPROX. 100 MS ON A PDP-8,
+ JMP PGCHLP /72 MS ON A PDP-8/E
+ TAD PTP232 /SEND ^Z TO BUFFER
+PT0BFR, DCA PTR
+ JMP PTRXX /AND 0 GARBAGE CHARACTER
+PGCHLP, TAD PTPTMP
+ DCA PTR
+PTP232, 232
+PTP336, 336 /FALL THROUGH CONSTANTS TO STALL FOR TIME
+PTP177, 177
+ RSF
+ JMP PTTIME /READER NOT READY - CHECK TIMING
+ RRB /READER READY - READ CHAR
+PTRXX, DCA PTPTMP /BUFFER READER BY ONE CHARACTER TO ELIMINATE
+ TAD PTR /GARBAGE CHARACTER AT END OF TAPE
+ JMP I PTRGCH /AND RETURN
+PTPERR, CLA CLL CML RAR /SIGNAL A "PERMANENT I/O ERROR" ON THE DEVICE
+ JMP PTPXIT-2
+PCDF, CDF 0
+PTPTMP, 0
+PTPWC, 0
+PTPM3, -3
+$$$$$$$$
+\f
--- /dev/null
+This area contains the files contained on system release DECtape #3.
+
+Directory of OS/8 V3D DECtape 3 labeled: AL-4693C-SA 2/26/78
+ OS/8 OPRG SYS SRC TAPE 3 OF 7
+
+
+CR8E .PA 21 01-AUG-77 UTILTY.SB 20 01-AUG-77
+TC08SY.PA 13 01-AUG-77 CD .PA 65 01-AUG-77
+TC08NS.PA 14 01-AUG-77 POWERS.SB 15 01-AUG-77
+INTEGR.SB 16 01-AUG-77 RX01SY.PA 21 01-AUG-77
+L645 .PA 8 01-AUG-77 SQRT .SB 6 01-AUG-77
+IPOWRS.SB 8 01-AUG-77 DUMP .PA 19 01-AUG-77
+LINCNS.PA 10 01-AUG-77 VT50 .PA 11 01-AUG-77
+LPSV .PA 12 01-AUG-77 LINCSY.PA 9 01-AUG-77
+TD8ESY.PA 20 01-AUG-77 BITMAP.PA 42 01-AUG-77
+ROMMSY.PA 9 01-AUG-77 TDINIT.PA 51 01-AUG-77
+RF08NS.PA 10 01-AUG-77 C3BOOT.PA 30 01-AUG-77
+PT8E .PA 11 01-AUG-77 IOH .SB 49 01-AUG-77
+CS .PA 23 01-AUG-77 TRIG .SB 13 01-AUG-77
+RK8ENS.PA 17 01-AUG-77 ATAN .SB 9 01-AUG-77
+LSPT .PA 10 01-AUG-77 RWTAPE.SB 10 01-AUG-77
+TM8E .PA 28 01-AUG-77 IOPEN .SB 12 01-AUG-77
+VR12 .PA 20 01-AUG-77 TDCOPY.PA 79 01-AUG-77
+
+ 34 files in 711 blocks - 19 free blocks
+
+
--- /dev/null
+/3 RF08 NON SYSTEM HANDLER / NULL:
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ SR
+
+ RF08=1 /CHANGE TO 0 FOR DF32 HANDLER
+
+ *0
+
+ -2
+ IFNZRO RF08 <
+ DEVICE RF;DEVICE RF;4064;RF&177;ZBLOCK 2
+ >
+ IFZERO RF08 <
+ DEVICE DF;DEVICE DF;4124;DF&177;ZBLOCK 2
+ >
+ DEVICE RF;DEVICE NULL;0240;NULL&177;ZBLOCK 2
+
+ SCA=7751
+ SWC=7750
+
+ RFVERSION="A&77
+ NULLVERSION="A&77
+\f *200
+
+INITLC, 0 /PATCH TO 232 TO HAVE NULL STORE ^Z IN BUFFER
+SYSER, CLA CLL CML RAR /4000
+ ISZ SYSCNT /TRY AGAIN?
+ SKP CLA
+ JMP SFIELD /WHY BOTHER
+ CLA CLL CMA RTL
+ TAD RF
+ DCA RF /RESET PARAMETERS AND TRY AGAIN
+ JMP RETRY
+T1, 0
+T2, 0
+
+CTLC, 0
+ KRS
+ AND (177
+ TAD (-3
+ SNA CLA
+ KSF
+ JMP I CTLC
+CIFCDF, CIF CDF 0 /RETURN TO OS/8 IF USER TYPED ^C
+ JMP I S7600
+ ZBLOCK 224-.
+ IFNZRO .-224 <ADRERR,QQQQ> /ENTRY PT MUST BE RELATIVE 24
+\fDF,
+RF, RFVERSION
+ CLA CLL CMA RTL /-3
+ DCA SYSCNT /# TRYS ON ERROR
+RETRY, TAD I RF /HANDLER RUNS IN USER'S DATA FIELD
+ RAL
+ CLA RTL
+ TAD S6603
+ DCA SFUN /EITHER A READ OR WRITE
+ TAD I RF
+ AND S70
+ DCA SFIELD /GET FIELD OF BUFFER
+ TAD I RF
+ RAL
+ AND S7600
+ CIA
+ DCA T1 /SET UP WORD COUNT
+ CLA CMA
+ ISZ RF
+ TAD I RF
+ DCA T2 /BUFFER ADDRESS-1
+ ISZ RF
+ RDF
+ TAD SCDF
+ DCA RESRDF
+SCDF, CDF 0
+ TAD T1
+ DCA I (SWC
+ TAD T2
+ DCA I (SCA
+RESRDF, HLT /RESTORE USER'S DATA FIELD
+ IFZERO RF08 <
+ TAD I RF
+ RTL
+ AND S3700
+ >
+ TAD SFIELD
+ 6615 /LOAD DISK EXTENDED MEMORY
+S7600, 7600
+ IFNZRO RF08 <
+ TAD I RF
+ RTR
+ RTR
+ AND S377
+ 6643 /LOAD HIGH ORDER
+ >
+ TAD I RF
+ RTR
+ RTR
+ RAR
+ AND S7400
+SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE)
+ RDF
+ TAD CIFCDF
+ DCA SFIELD
+ IFZERO RF08 <6622>
+ IFNZRO RF08 <6623>
+ JMP .-1
+ JMS CTLC
+ ISZ RF
+ 6621 /SKIP ON ERROR
+ IFNZRO RF08 <SKP /SENSE OF SKIP IS REVERSED>
+ JMP SYSER
+ ISZ RF
+SFIELD, HLT /RETURN TO PROPER FIELD
+ 6601 /CLEAR TROUBLESOME FLAG
+ JMP I RF
+
+ IFZERO RF08 <S3700, 3700>
+ IFNZRO RF08 <S377, 0377>
+\fNULL, NULLVERSION
+ CLA
+ RDF
+ TAD CIFCDF
+ DCA NULRET
+ JMS CTLC
+ TAD I NULL /GET FN WORD
+ DCA SFUN
+ ISZ NULL /POINT TO CORE LOC
+ TAD I NULL /GET START OF BUFFER
+ DCA T1
+ ISZ NULL /POINT TO BLOCK NUMBER
+ ISZ NULL /POINT TO ERROR RETURN
+ TAD SFUN
+ SPA CLA
+ JMP BYE /LEAVE BUFFER ALONE ON A WRITE
+ TAD SFUN
+ AND S70 /ISOLATE FIELD OF BUFFER
+ TAD SCDF
+ DCA NFIELD
+ TAD SFUN
+ CLL RAL
+ AND S7600 /GET NO. OF WDS IN BUFFER
+ CIA
+ DCA T2
+ TAD INITLC
+NFIELD, HLT /GO TO FIELD OF BUFFER
+ DCA I T1 /ZERO BUFFER
+ ISZ T1
+ ISZ T2
+ JMP .-3
+BYE, TAD SFUN
+ RAL /PUT R/W BIT IN LINK
+ CLA CML RAL /AC=1 IF READING
+ SNA
+ ISZ NULL /POINT TO GOOD RETURN IF WRITE
+NULRET, HLT /BACK TO USER'S DATA FIELD, INST FIELD
+ JMP I NULL /RETURN
+
+SYSCNT, 0
+S6603, 6603
+S70, 70
+S7400, 7400
+ $
+\f
--- /dev/null
+/1 RK8E NON-SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/DEC-S8-URK8B-A-LA HJ
+
+/COPYRIGHT 1973
+
+/DIGITAL EQUIPMENT CORPORATION
+
+/MAYNARD, MASSACHUSETTS 01754
+
+/JANUARY 22, 1973
+\f
+/ONE RK8E IS TREATED AS TWO LOGICAL DISKS
+/EACH OF 3248 OS/8 BLOCKS.
+
+/THIS HANDLER CONTAINS ENTRY POINTS FOR THE 8 LOGICAL UNITS.
+/(RKA0,RKB0,RKA1,RKB1,RKA2,RKB2,RKA3,RKB3)
+
+
+ DCLR=6742
+ DLAG=6743
+ DLDC=6746
+ DRST=6745
+ DSKP=6741
+ DLCA=6744
+ *0
+ -10
+DEVICE RK05;DEVICE RKA0;4230;20;ZBLOCK 2
+DEVICE RK05;DEVICE RKB0;4230;21;ZBLOCK 2
+DEVICE RK05;DEVICE RKA1;4230;22;ZBLOCK 2
+DEVICE RK05;DEVICE RKB1;4230;23;ZBLOCK 2
+DEVICE RK05;DEVICE RKA2;4230;24;ZBLOCK 2
+DEVICE RK05;DEVICE RKB2;4230;25;ZBLOCK 2
+DEVICE RK05;DEVICE RKA3;4230;26;ZBLOCK 2
+DEVICE RK05;DEVICE RKB3;4230;27;ZBLOCK 2
+\f VERSION="A&77
+
+ *200
+
+/THE FOLLOWING MUST REMAIN HERE BECAUSE OF THE R200 REF.
+R37, 37 /USED TO CHECK FOR CYLINDER CHANGE
+RKEBLK, 0 /12 BITS OF BLOCK NUMBER
+CHKHED, 0 /CHECK HEADER FLAG
+RKEARG, 0 /HOLDS RETURN ADDRESS
+RKENO, 0 /HOLDS ENTRY POINT COUNT
+PAGCNT, 0 /HOLDS REMAINING PAGE COUNT
+RKEISZ, ISZ RKENO /TO PUT BACK OVER THE EP ADDR
+
+CTRLC, TAD R200 /TO IGNORE PARITY
+ KRS /READ THE KEYBOARD
+ TAD R7575 /SUBTRACT ^C
+ SNA CLA
+ KSF /IS KEYBOARD FLAG UP?
+ JMP RWAIT /NO
+RCIF, CDF CIF 0
+ JMP I R7600 /BOOTSTRAP
+
+
+
+
+
+
+/NOTE: A LOCATION CAN BE EEKED OUT BY USING RKA0 BETTER
+RERRCT, 0 /HOLDS RETRY COUNT
+\f ZBLOCK 220-. /PAD ENTRY POINTS TO 220
+
+RKA0, VERSION
+RKB0, ISZ RKENO /THE ISZ'S SET UP A COUNT OF
+RKA1, ISZ RKENO /OF WHICH ENTRY POINT WE CAME IN
+RKB1, ISZ RKENO
+RKA2, ISZ RKENO
+RKB2, ISZ RKENO
+RKA3, ISZ RKENO
+RKB3, ISZ RKENO
+R400, 400 /AN INNOCUOUS AND INSTRUCTION WHICH
+ /IS REFERENCED BY A TAD.
+ CLA CLL CMA RTL /AC=-3
+ DCA RERRCT /RETRY 3 TIMES
+ TAD RKENO /7-EP NUMBER
+ CMA /EP-8
+ TAD RKETAD /ADD ON INSTRUCTION
+ /WHICH REFERENCES THE 400 TO GENERATE A
+ /TAD CORRECT ENTRY POINT INSTRUCTION.
+ DCA GETENT /WE EXECUTE TO GET USERS ADDRESS
+ CLA CLL CML RTR /AC=2000
+ TAD GETENT /GENERATE A DCA INTO ENTRY POINT INSTRUCTION
+ DCA RKECMD /THIS IS EXECUTED TO REPLACE ISZ RKENO
+ RDF /GET USERS DATA FIELD
+ TAD RCIF /BUILD A CIF FOR RETURNING
+ DCA REXIT /STORE IT INTO THE EXIT CODE
+GETENT, HLT /WILL BE A TAD "ENTRY POINT"
+ /WILL SAVE UNIT INFO HERE FOR ERRORS
+ DCA RKEARG /SAVE USERS ADDR IN COMMON LOCATION
+ DCA RKENO /ZERO COUNT FOR NEXT TIME
+ TAD RKEISZ /GET THE ISZ RKENO
+RKECMD, HLT /THE DCA ENTRY POINT IS PUT HERE
+ /AND THIS LOCATION IS USED FOR THE RK8E COMMAND
+\f
+
+RETRY, TAD RKEARG /AC=-2 IF ERROR RETRY
+ DCA RKEARG
+ TAD GETENT
+ AND R6 /GET THE UNIT NUMBER
+ DCA RKECMD /SET UP UNIT FOR COMMAND
+ TAD GETENT
+ RAR /PUT HI/LOW LOGICAL DISK BIT IN LINK
+ SZL CLA
+ TAD R6260 /DISPLACEMENT TO 2ND HALF OF DISK
+ DCA RKA0 /NICE PLACE FOR A CONSTANT
+ TAD I RKEARG /GET ARG1
+ AND R4070 /GET R/W AND DF BITS
+ TAD RKECMD /GET UNIT NUMBER
+ DCA RKECMD /BASE COMMAND TO RK8E(DLDC)
+ TAD I RKEARG /GET ARG1 AGAIN
+ TAD I RKEARG /GET ARG1 AGAIN
+ ISZ RKEARG /POINT TO ARG2
+ AND R7600
+ CIA /TO MAKE 0 LOOK LIKE 40 PAGES
+ DCA PAGCNT /SAVE PAGE COUNT
+ TAD I RKEARG /GET ARG2
+ ISZ RKEARG /POINT TO ARG3
+ DLCA /LOAD CURRENT ADDRESS REGISTER
+\f
+ TAD I RKEARG /GET ARG3
+ CLL
+ TAD RKA0 /SYS OR RKB0 DISPLACMENT
+ DCA RKEBLK /LOW PART OF RK8E BLOCK NUMBER
+ SZL /STILL OFF IF BELOW BLOCK 10000
+OVRFLO, ISZ RKECMD /TURN ON EXTENDED BIT IF OVERFLOWED
+RELOOP, DCA CHKHED /SET CHECK HEADER FLAG TO EITHER
+ /0 OR 4000(WHICH GETS RTR'D BEFORE USED)
+ /AND CAUSES EITHER A "DATA" OR "ALL"
+ /TRANSFER
+ DCLR /CLEAR STATUS REGISTER
+ TAD PAGCNT /TEST TO SEE IF ONLY 1 PAGE WANTED
+ TAD R200
+ SNA CLA
+RKETAD, TAD R400 /7600 WAS IN PAGCNT
+ TAD CHKHED /ADD IN CHECK HEADER FLAG
+ CLL RTR /SHIFT TO CORRECT BITS
+ TAD RKECMD /ADD IN BASE COMMAND
+ DLDC /LOAD COMMAND REGISTER
+ TAD RKEBLK
+ DLAG /LOAD BLOCK REGISTER AND GO
+RWAIT, DSKP /WAIT ON FLAG
+ JMP CTRLC /CHECK FOR CONTROL C WHILE WAITING
+ DRST /READ COMPLETION REGISTER
+ CLL RAL /GET RID OF SUCCESS BIT
+ SZA /AND SEE IF ANYTHING LEFT
+ JMP RERROR /AN ERROR
+
+/IF THERE WAS NO ERROR L=1 BECAUSE DONE FLAG
+ TAD PAGCNT /CHECK TO SEE IF DONE
+ TAD R400 /ADD 2 PAGES ONTO TOTAL
+ SNL
+ JMP RKDONE /NO MORE TO DO
+ DCA PAGCNT /SAVE FOR NEXT TIME
+ TAD RKEBLK
+ CMA
+
+/THE R37 MUST REMAIN AT 200 SO THE FOLLOWING IS A 200
+R200, AND R37 /IF BLOCK IS AT A 37 MAKE
+ /NEXT OPERATION DO A CHECK HEADER
+ SZA CLA
+ STL RAR /SET AC TO "ALL" FLAG
+ ISZ RKEBLK /BUMP BLOCK NUMBER
+ JMP RELOOP /TRANSFER SOME MORE
+ JMP OVRFLO /PAST BLOCK 7777-SET EXTENDED BIT
+\f
+RERROR, AND R1002 /AC WAS RAL'D AND WE WANT TO SEE IF
+ /DRIVE SEEK FAILED OR CYLINDER ADDR ERROR
+ SNA CLA
+ JMP RKTST3 /WE TRY 3 TIMES
+/WE HAVE TO RECALIBRATE DRIVE
+ DCLR /CLEAR STAUS REGISTER
+ STL RTL /AC=2
+ DCLR /RECALIBRATE DRIVE
+ DSKP /WAIT ON FLAG
+ JMP .-1
+ DCLR /CLEAR STATUS REGISTER
+ DRST /WAIT FOR STATUS TO CLEAR
+ SZA CLA
+ JMP .-2 /STILL DOING RECALIBRATE
+RKTST3, CLA CLL CMA RAL /AC=-2
+ ISZ RERRCT /SKIP IF WE TRIED 3 TIMES
+ JMP RETRY /TRY AGAIN
+ JMP .+3 /ERROR EXIT
+RKDONE, ISZ RKEARG /NORMAL RETURN
+R7600, 7600 /GROUP 2 CLA
+ ISZ RKEARG /IF JUMPED TO HERE- ERROR RETURN
+REXIT, HLT /RESET USERS INST FIELD- WE NEVER TOUCHED DF
+ JMP I RKEARG /EXIT
+
+R6260, 6260 /SIZE OF ONE LOGICAL DISK
+R4070, 4070 /USED TO GET READ/WRITE AND DF BITS
+R1002, 1002 / " TO CHECK FOR RECALIBRATE ERRORS
+R6, 6 /TO PEEL OUT UNIT NUMBER
+R7575, 7575 /- ^C CONSTANT
+
+
+ $$$$
+\f
--- /dev/null
+/2 ROM-TD8E HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f ROMFLD=70
+ VERSION="A&77
+/THESE ARE ASSEMBLY REFERENCES TO LOCATIONS IN THE ROM:
+
+ RGO=7405
+ F2SET=7552
+/ TD8E MNEMONICS:
+ SDSS=6771
+ SDST=6772
+ SDSQ=6773
+ SDLC=6774
+ SDLD=6775
+ SDRC=6776
+ SDRD=6777
+ *0
+
+ -3
+ DEVICE ROM;DEVICE SYS;4211;2007;0;1341
+ DEVICE ROM;DEVICE DTA0;4211;1007;0;1341
+ DEVICE ROM;DEVICE DTA1;4211;SDTA1&177+1000;0;1341
+\f STARTB-ROMCT-1
+
+ NOPUNCH
+ *7360 /ROOM FOR DECTAPE HEADER WORDS
+ ENPUNCH
+
+STARTB, ZBLOCK 20
+ CDF 0 /BOOTSTRAP TO MOVE FIELD 1
+ TAD I ROM1 /CODE UP TO FIELD 1
+ CDF 10
+ DCA I ROM2
+ ISZ ROM1
+ NOP
+ ISZ ROM2
+ NOP
+ ISZ ROMCT
+ JMP 7400
+ CIF CDF 0 /DONE
+ SDLC /STOP THE TAPE
+ JMP I .+1
+ 7605 /START HER UP
+ROM1, 7427 /FIELD 1 CODE GETS LOADED HERE
+ROM2, 7647 /AND GOES UP HERE
+ROMCT, -130
+\f *200
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+ ZBLOCK 7
+SHNDLR, VERSION /UNIT 0 ENTRY
+ CLA CLL
+ JMP SHND2
+S70, 70
+S6201, 6201
+SDTA1, VERSION /UNIT 1 ENTRY POINT
+ CLA CLL CML
+ TAD SDTA1 /GET ARGS AT SHNDLR
+ DCA SHNDLR
+SHND2, RAR /UNIT BIT IS IN LINC
+ DCA SUNIT
+ RDF
+ TAD S6203 /SETUP RETURN FIELD
+ DCA EFLD
+ TAD I SHNDLR
+ SDLD /STORE FUNCTION WORD IN DATA REG.
+ AND S70 /SDLD DOESN'T CLEAR AC
+ TAD S6201 /ISOLATE FIELD OF XFER
+ DCA TFLD
+ TAD TFLD
+ DCA TFLD2
+ ISZ SHNDLR
+ TAD I SHNDLR /BUFFER ADDRESS
+ DCA BPTR
+ ISZ SHNDLR
+ TAD I SHNDLR /PS/8 RECORD #
+ CLL RAL /TIMES 2 FOR ABSOLUTE BLOCK
+ DCA BLOCK
+ ISZ SHNDLR
+ CDF 0
+ CIF ROMFLD /ROM IS IN FIELD 7
+ JMP I XF2SET /INITIALIZE.
+\fGET, 0
+TFLD, HLT /ROUTINE TO LOAD DATA FROM BUFFER
+ TAD I XPTR
+ CIF ROMFLD
+ JMP I GET
+
+PUT, 0 /PUT DATA INTO BUFFER
+TFLD2, HLT
+ DCA I XPTR
+ CIF ROMFLD
+ JMP I PUT
+
+ERROR, CLA CLL /FORCE TURNAROUND AT RGO
+ CIF ROMFLD
+ ISZ TRYCNT /TRIED 3 TIMES?
+ JMP I XRGO
+S6203, CIF CDF 0
+ JMP SEREX /YES..FATAL EXIT
+
+XRGO, RGO
+XF2SET, F2SET
+\f/EQUIVALENCES FOR HANDLER
+
+ EQUTMP=7750
+ BPTR=7751
+ XPGCT=7752
+ XPTR=7753
+ XWCNT=7754
+ WRQ=7724
+WRQUAD, 0 /WRITE A 12 BIT TAPE WORD
+ CIF ROMFLD
+ JMP WRQ
+CIFR, CIF ROMFLD
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT DATA WORD
+ SDSQ
+ JMP .-1
+ SDRD
+ CIF ROMFLD
+ JMP I RDQUAD
+
+EQUFUN, 0 /EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP
+ TAD EQUTMP
+ AND SCKSUM
+ CIA
+ CLL RAL
+ TAD EQUTMP
+ TAD SCKSUM
+ DCA SCKSUM
+ TAD EQUTMP
+ CLL CMA
+ CIF ROMFLD
+ JMP I EQUFUN
+
+SEXIT, ISZ SHNDLR /NORMAL EXIT
+SEREX, TAD SUNIT /STOP THE DRIVE
+ SDLC
+ CLA CML RAR /EXIT CONDITION IN BIT 0
+EFLD, HLT
+ JMP I SHNDLR
+
+TRYCNT, 0
+SXUNIT, 0
+SXFUN, 0
+SCKSUM, 0
+BLOCK, 0
+SUNIT, 0
+ $
+\f
--- /dev/null
+/DECTAPE I-O ROUTINES OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 2A
+/
+/ CALL 4, RTAPE(WTAPE)
+/ ARG UNIT
+/ ARG +-BLOCK (-MEANS START SEARCH FORWARD)
+/ ARG WORD COUNT
+/ ARG CORE ADDRESS
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+ ENTRY RTAPE
+ ENTRY WTAPE
+ DUMMY WCT
+ DUMMY CAD
+ OPDEF TADI 1400
+ OPDEF DCAI 3400
+
+ LAP /ENABLE FIT INTO 1 PAGE
+/
+/DATA
+/
+DFUNC, 0
+DBLK, 0
+DWCT, 0
+DFIELD, 0
+WCT, 7754
+CAD, 7755
+DCORE,
+/
+/ARG PICKUP ROUTINE
+/
+GETARG, 0
+ TAD I RTAPE
+ DCA AA
+ INC RTAPE#
+ TADI RTAPE#
+ DCA WTAPE#
+ INC RTAPE#
+AA, NOP /SET DATA FIELD
+ TADI WTAPE#
+ JMP I GETARG
+/
+/ERROR
+/
+DTERR, CALL 1,ERROR /CK FOR ERROR
+ ARG TAPERR
+/
+/DATA
+/
+/
+/START
+/
+WTAPE, BLOCK 1
+ 2
+ TAD WTAPE /MOVE ARG ADDR TO RTAPE
+ DCA RTAPE
+ TAD WTAPE#
+ DCA RTAPE#
+ IAC /WRITE FUNCTION
+ JMP TARGS
+TAPERR, 2401 /TA
+ 2005 /PE
+RTAPE, BLOCK 1
+ 2
+TARGS, DCA DFUNC /READ=0, WRITE=1
+ JMS GETARG /GET UNIT #
+ CLL RTR /TO BITS 0-2
+ RTR
+ TAD DFUNC /COMBINE WITH R-W BIT
+ DCA DFUNC
+ JMS GETARG /GET BLK #
+ SMA
+ JMP RT2 /REV. SRCH.
+ CIA /FORWARD SRCH.
+ DCA DBLK
+ JMP RT3
+RT2, DCA DBLK
+ TAD (400 /REV. SRCH. BIT
+ TAD DFUNC
+ DCA DFUNC
+RT3, JMS GETARG /GET W.C.
+ CIA
+ DCA DWCT
+ JMS GETARG /GET CORE ADDR
+ CLA CMA
+ TAD WTAPE#
+ DCA DCORE
+ TAD AA /GET CORE FIELD
+ DCA DFIELD
+/
+/DEFINITIONS
+/
+OPDEF DTCA 6762
+OPDEF DTXA 6764
+OPDEF DTLB 6774
+OPDEF DTRB 6772
+SKPDF DTSF 6771
+OPDEF DTRA 6761
+/
+/START OF DECTAPE I-O
+/
+ TAD DFUNC /UNIT & DIRECTION
+ AND (7400
+ TAD (10 /+ SRCH MODE
+ DTCA DTXA /SET STATUS & CLR FLGS
+ DTLB /CLR FIELD BITS
+ TAD WCT /USE 7754 AS ADDR TO
+ 6201 /SET FIELD 0
+ DCAI CAD /STORE BLK FOUND
+DTSERR, RTL /REENTRY FOR SRCH ERROR
+ RAL /ENDZONE FLAG TO LINK
+ CLA CML /CHANGE DIRECTION
+ TAD (200 /DTA GO FLAG
+DTCONT, SNL /CK DIR.
+DTREV, TAD (400 /CHANGE DIR.
+DTSRCH, DTXA /GO INTO SEARCH
+ DTSF DTRB /READ CONDITION
+ JMP DTSRCH#
+ SPA
+ JMP DTSERR /ERROR
+ DTRA /GET CUR. DIR.
+ RTL /TO LINK
+ RTL
+ SZL CLA
+ TAD (3 /FOR REV GET BLK-3
+ 6201
+ TADI WCT /# OF LAST BLK SEEN
+ CMA /CIA MIGHT BLOW THE LINK
+ TAD DBLK
+ CMA
+ SZA CLA
+ JMP DTCONT /CONT. SRCH
+ SZL /FOUND, CK DIR.
+ JMP DTREV /IF REV, SNEAK BACK UP
+ TAD DWCT /SET WORD COUNT
+ DCAI WCT
+ TAD DCORE
+ DCAI CAD
+LABEL, TAD DFIELD /LOAD FIELD BITS
+ DTLB
+ IAC /GET R-W FUNCTION
+ AND DFUNC
+ CLL RTL
+ RTL
+ TAD (130 /SET UP FUNCTION FOR
+ /THE XOR TO GIVE SRCH
+ /MODE CLEARED & SET CONTINUOUS MODE
+ /READ=3, WRITE=5
+ DTXA /BEGIN TRANSFER
+DTWAIT, DTSF /WAIT FOR W.C. OVERFLOW
+ JMP DTWAIT
+ DTRA
+ AND (200 /STOP-GO BIT
+ TAD (2 /SAVE DTA & ERROR FLAGS
+ DTXA /STOP TAPE
+ DTRB /READ ERROR FLAGS
+ SPA CLA /CK FOR ERROR
+ JMP DTERR /YES
+ RETRN RTAPE
+ END
+\f
--- /dev/null
+/FLOPPY DISK (RX01,RX71) SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK HANDLER SYSTEM
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXSVER= "E&77
+
+DEVCOD= 750 /DEVICECODE
+
+LCD= 6001+DEVCOD /LOAD COMMAND REGISTER
+XDR= 6002+DEVCOD /TRANSFER DATA REGISTER
+STR= 6003+DEVCOD /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER= 6004+DEVCOD /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN= 6005+DEVCOD /SKIP ON DONE FLAG, CLEAR FLAG
+INTR= 6006+DEVCOD /INTERRUPT ENABLE/DISABLE
+INIT= 6007+DEVCOD /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/ 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+/MAIN CHANGE FROM RX01SY IS THAT THE NEXT DISK ADDRESS IS
+/CALCULATED DURING THE DATA TARNSFER TO/FROM THE DISK TO ITS
+/SECTOR BUFFER. THIS IS NEEDED FOR SLOW 8S !.
+\f *0 /ORIGIN FOR BUILD
+
+ -1 /ONE ENTRY POINT
+ DEVICE RX8E /"RX8E" IS THE GROUP NAME
+ DEVICE SYS /"SYS" IS THE ENTRY POINT NAME
+ 4250 /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+ 2007 /2000 MEANS SYS HANDLER,7 IS ENTRY POINT OFFSET
+ 0 /THIS WORD ALWAYS SEEMS TO BE 0
+ DECIMAL
+ 76^26%4 /THE NUMBER OF OS8 BLOCKS ON THE DEVICE
+ OCTAL
+
+ BOOTST-BOOTND /LENGTH OF THE BOOTSTRAP
+\f
+ RELOC 2
+BOOTST,
+X7577, 7577
+SECT, 1
+FAKRET, JMS GET1
+ DCA CDF10
+ CDF 0
+ TAD X7577
+ DCA XR
+ JMS GET1
+ JMS GET1
+ TAD UNIT
+ DCA I PUNIT
+ INIT
+ JMS I X7577
+XR, 7600+BOOTND-BOOTST-1 /LOC 17
+PUNIT, S4UNIT
+
+GET1, FAKRET
+ STL RTL
+ TAD UNIT
+ LCD
+ CLA STL RTL
+ TAD SECT
+ JMS LOAD
+ DCA SECT
+ CLA IAC
+ JMS LOAD
+HANGGG, SDN
+ JMP LOAD+1
+ SER
+ SKP
+ HLT
+ SNA
+ JMP I GET1
+ CLA STL RTL
+ LCD
+CDF10, CDF 10
+ JMS LOAD
+ DCA I XR
+LP, JMP CDF10
+BOOTND,
+ RELOC
+
+\f
+ NOPUNCH
+ *24
+BOOT, STL RTL
+ TAD UNIT
+ LCD
+ CLA IAC
+ JMS LOAD
+ JMS LOAD
+ CLL RAL
+
+START,
+HANGGG, SDN
+ JMP LOAD+1
+ SER
+ SNA
+ SKP CLA
+ JMP GOODRD
+ TAD UNIT
+ CIA
+ TAD X6030
+ DCA UNIT
+ JMP BOOT
+GOODRD, LCD
+LP, JMS LOAD
+ DCA BOOTST
+ ISZ .-1
+ JMP LP
+
+LOAD, 0
+ STR
+ JMP HANGGG
+ XDR
+ JMP I LOAD
+UNIT, 7024
+X6030, 6030
+
+ ENPUNCH
+\f *200
+ RELOC 7600
+
+ ZBLOCK 7 /SYSTEM SPACE
+
+/ OVERALL COMMENTS:
+/
+/ LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/ EXCEPT AS MANIPULATED BY DIVSUB
+/
+/ OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/ BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/ BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/ THE I/O OPERATION.
+/ A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/ A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/ THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/ AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/ DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/ TIMING CONSIDERATIONS OF THE VT78.
+/
+/ THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+SYS, RXSVER
+ CLL CML CLA RAR /SET LINK=0, AC=4000
+ TAD I SYS /TO PUT READ-WRITE BIT TO LINK
+S33, AND S70 /KEEP BITS FOR CDF
+ TAD SCDF0 /ADDING IN CDF LITERAL
+ DCA BUFCDF /CDF INSTRUCTION TO USER'S BUFFER
+ CML RTL /FUNCTION CODE, 0=WRITE, 2=READ
+ DCA FN
+ RDF /FETCH CALLER'S FIELD
+ TAD SCDIF0 /MAKE CDF CIF TO HIS FIELD
+ DCA SRET /FOR RETURN
+ TAD I SYS /MAKE CONTROL COUNT
+S4UNIT, RAL /7004 (7024 FOR UNIT #1) DOUBLES AS
+ /LITERAL FOR READ-WRITE COMMAND
+ AND S7600 /MAKE CONTROL COUNT FOR TOTAL
+ CIA /NUMBER OF WORDS
+ DCA BC
+ ISZ SYS
+ TAD I SYS /FETCH BUFFER ADDRESS
+ DCA BUF
+ ISZ SYS
+S70, 70 /THIS LITERAL MUST BE AT LOCATION 33!
+ IFNZRO S70&177-33 <.ERROR.>
+ TAD I SYS /OS8 BLOCK #
+ CLL RTL /TIMES 4 TO BE FLOPPY SECTOR #
+ DCA REC
+ ISZ SYS /ERROR EXIT FROM I/O CALL
+ JMS DIVSUB /COMPUTE TRACK/SECTOR FOR FIRST I/O
+ TAD FN /READ OR WRITE START DIFFERENTLY
+ SZA CLA /SKIP ON WRITE
+ JMP STREAD /GO TO READ
+/
+/ WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO, TAD FN /SET SILO TO LOAD-UNLOAD DEPENDING
+ JMS LDCMD
+ TAD S7700 /SILO CONTROL COUNT 100 OCTAL
+ DCA FLPWC
+BUFCDF, HLT /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP, TAD I BUF /FETCH A WORD IN CASE WRITE
+ STR /WAIT
+ JMP .-1
+ XDR /AC TO SILO; OR; SILO TO AC
+ DCA I BUF /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+ ISZ BUF /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77, 77 /LITERAL 77, EXECUTES AS A NOP
+ ISZ FLPWC /DONE WITH 100 OCTAL SILO OPERATION
+ JMP TRLOOP /NO
+ TAD BC /INCREMENT BC BY 77 HERE, AND 1 LATER
+ TAD S77
+MAGIC, SNA /SKIP UNLESS READ DONE;NO-OP FOR LDCMD!
+ JMP OKEX /READ EXIT.
+ DCA BC /
+/
+/ MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD, TAD FN /READ STARTS HERE
+ TAD S4UNIT /SET UP DO DO READ OR WRITE I/O
+ JMS LDCMD
+ TAD MQ /LOAD PRECOMPUTED SECTOR INFO
+ STR
+ JMP .-1 /IN CASE NOT READY
+ XDR
+S7700, 7700 /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+ TAD QUO /TRACK
+ STR /ILLEGAL 7700 ENTRY WILL HANG; THE FUNCTION
+ JMP .-1 /IS NOT SET UP (LDCMD)
+ XDR
+S7600, 7600
+ ISZ REC /MOVE TO NEXT FLOPPY SECTOR
+ JMS DIVSUB /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+ TAD MAGIC /WAIT FOR I/O TO COMPLETE
+ JMS LDCMD
+ ISZ BC /CHECK FOR WRITE EXIT
+ JMP SETSLO /NO, BACK TO TOP
+OKEX, ISZ SYS /BUMP TO REGULAR EXIT
+SRET, HLT /CDF CIF FOR USER'S CALLING FIELD
+ JMP I SYS /GONE
+/
+\f/
+/
+/ LITERALS
+/
+SM15, -15
+SCDF0, CDF 0
+SCDIF0, CDF CIF 0
+/
+/ DIVSUB
+/
+/ MUST ENTER WITH LINK AND AC 0
+/ COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/ REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/ QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/ REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/ LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB, 0
+ DCA QUO /INIT QUOTIENT FOR DIVIDE
+ TAD REC /RECORD # MASSAGED IN AC
+DIVLP, SNL /LINK USAGE REVERSED FROM RICHIE'S CODE
+ ISZ QUO /ISZ EVERY OTHER TIME, ==DIVIDE BY 26
+ TAD SM15 /THE -13 DECIMAL
+ SMA /SKIP ON DONE
+ JMP DIVLP /MORE
+ RAL /LINK USAGE REVERSED; INTERLEAVE!!
+ TAD S33 /ADD 233 (200 IRREL) MAKING SECTOR
+ DCA MQ
+ JMP I DIVSUB /LEAVING LINK AND AC 0
+/
+/ LDCMD
+/
+FLPWC=. /COUNTER IN ENTRY POINT FOR SILO LOOP ONLY
+LDCMD, 0
+ SDN /WAIT
+ JMP .-1
+ LCD /COMMAND FROM AC, WHICH IS CLEARED
+ SER /SKIP IF ERROR (I/O ONLY)
+ JMP I LDCMD /OK, RETURN
+ CLL CML CLA RAR /CONVENTIONAL ERROR RETURN 4000 IN AC
+ JMP SRET /SET CDF AND EXIT
+/
+/ USE DATA BREAK LOCATIONS FOR TERMPORARIES
+/
+MQ=7750
+BC=7751
+FN=7752
+QUO=7753
+REC=7754
+BUF=7755
+
+ RELOC
+
+\f
--- /dev/null
+/SQUARE ROOT SUBROUTINE OS8 FORTRAN II LIBRARY LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 4A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+ ENTRY SQRT
+/
+/ SQUARE ROOT ROUTINE
+/ IF X0 IS AN APPROXIMATION FOR Y**(1/2)
+/ THEN (X0+(Y/X0))/2 IS A BETTER APPROXIMATION
+/
+X0, BLOCK 3
+Y, BLOCK 3
+CNT, BLOCK 1
+/
+/
+ CPAGE 4
+SQER, 6321 /"SQRT" ERROR FROM LOC XXXXX
+ 2224
+SQRT, BLOCK 1
+ 4 /ENTRY POINT
+ TAD I SQRT
+ DCA IN
+ INC SQRT#
+ TAD I SQRT
+ DCA IN#
+ ISZ SQRT#
+ CALL 1,FAD
+IN, ARG 0
+ CALL 1,STO /Y=ARGUMENT
+ ARG Y
+ CALL 1,FAD
+ ARG Y
+ TAD ACH /IF Y NEGATIVE THEN ERROR
+ SMA
+ JMP POS
+ CALL 1,ERROR
+ ARG SQER
+ CLA CLL CMA RAR
+ AND ACH
+POS, SZA /IF Y=0 THEN ROOT=0
+ JMP NONZ
+ RETRN SQRT
+NONZ, RAR CLL /FORM INITIAL APPROXIMATION
+ TAD (1004
+ DCA ACH
+ TAD ACM
+ RAR
+ DCA ACM
+ TAD ACL
+ RAR
+ DCA ACL
+ TAD ACH
+ AND (4
+ SNA CLA
+ TAD (2
+ TAD ACH
+ DCA ACH
+ TAD (-3 /DO 3 ITERATIONS
+ DCA CNT
+INIT, CALL 1,STO
+ ARG X0
+ CALL 1,FAD
+ ARG Y
+ CALL 1,FDV /Y/X0
+ ARG X0
+ CALL 1,FAD /(Y/X0)+X0
+ ARG X0
+ TAD ACH /((Y/X0)+X0)/2
+ TAD (7770
+ DCA ACH
+ ISZ CNT
+ JMP INIT
+ RETRN SQRT
+ END
+\f
--- /dev/null
+/2 TC08 HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1 TC08 HANDLER FOR BUILD
+ *0
+ -10
+DEVICE TC;DEVICE DTA0;4160;10;ZBLOCK 2
+DEVICE TC;DEVICE DTA1;4160;11;ZBLOCK 2
+DEVICE TC;DEVICE DTA2;4160;12;ZBLOCK 2
+DEVICE TC;DEVICE DTA3;4160;13;ZBLOCK 2
+DEVICE TC;DEVICE DTA4;4160;14;ZBLOCK 2
+DEVICE TC;DEVICE DTA5;4160;15;ZBLOCK 2
+DEVICE TC;DEVICE DTA6;4160;16;ZBLOCK 2
+DEVICE TC;DEVICE DTA7;4160;17;ZBLOCK 2
+ DTRB=6772
+ DTLB=6774
+ DTXA=6764
+ DTCA=6762
+ DTRA=6761
+ DTSF=6771
+
+ TCVERSION="A&77
+
+ *200
+ /DECTAPE HANDLERS(PAGE RELOCATABLE) FOR PS/8 MONITOR
+DFUN, 0
+DM203, -203
+DBLOCK, 0
+DBLKCT, 0
+D3, 3
+WC, 7754
+CA, 7755
+DERRCT, TCVERSION
+DTA0, ISZ DTANO
+DTA1, ISZ DTANO
+DTA2, ISZ DTANO
+DTA3, ISZ DTANO
+DTA4, ISZ DTANO
+DTA5, ISZ DTANO
+DTA6, ISZ DTANO
+DTA7, ISZ DTANO
+D400, 400
+ CLA CLL CMA RTL
+ DCA DERRCT /SET TO REPEAT THREE TIMES IN CASE OF ERROR
+ TAD DTANO
+ CMA
+ TAD DTATAD /GENERATE "TAD DTAN" WHERE DTAN IS THE ONE THAT
+ DCA DTANO /WAS CALLED.
+ CLA CLL CML RTR
+ TAD DTANO /ALSO GENERATE "DCA DTAN" SO WE CAN RESTORE IT
+ DCA DTADCA
+ RDF
+ TAD DCDIF0
+ DCA DSTOP /STORE CALLING FIELD FOR RETURNING
+DTANO, 0 /GET CALLING ADDRESS
+ DCA DTA /SAVE IT
+ TAD DTAISZ
+DTADCA, 0 /RESTORE ENTRY POINT
+ DLOC=DTADCA
+DTAISZ, ISZ DTANO /BUMP DTANO FOR VARIOUS GROOVY REASONS
+ /WHICH WILL BE APPARENT LATER
+ TAD I DTA
+ DCA DFUN /STORE AWAY FUNCTION WORD FOR FUTURE USE
+ ISZ DTA
+DT7140, CLL CMA /THE "CLL" IS ONLY NECESSARY TO FORM THE 7140
+ TAD I DTA
+ DCA DLOC /BUFFER ADDRESS -1
+ ISZ DTA
+ TAD I DTA
+ CLL RAL /MULTIPLY BY 2 FOR 256-WORD SIMULATED RECORDS
+ DCA DBLOCK /DECTAPE BLOCK #
+ ISZ DTA
+DTATRY, TAD WC
+DCDIF0, CDF CIF 0
+ DCA I CA
+ TAD DFUN
+ RAR
+ CLA CML /COMPLEMENT OF BIT 11 OF DFUN NOW IN THE LINK
+ TAD DTANO /DTANO = "TAD DTAN+1"
+ RTR
+ RTR /THESE TWO ROTATES FORM THE FLLOWING NUMBER
+ /IN THE AC: YYYF00101000, WHERE YYY =DTAN+1
+ /AND F IS THE COMPLEMENT OF DFUN(11)
+ TAD DT7140 /THE MAGIC STEP - THIS SIMULTANEOUSLY BUMPS DOWN
+ /THE RECORD NUMBER IN AC(0-2) AND TRANSFORMS
+ /THE REST OF THE AC TO F10001000 WHICH IS A
+ /SEARCH IN DIRECTION F(F=1 MEANS BACKWARDS) WITH
+ /THE MOTION BIT ON.
+ DTCA DTXA
+ DTLB /SET DECTAPE FIELD TO 0 FOR SEARCHING
+ JMP DC+3 /JUMP INTO THE BLOCK SEARCH ROUTINE
+DERR, RTL /DECTAPE STATUS REGISTER B IS USUALLY IN THE AC HERE
+ RAL
+D7600, 7600 /GET THE "END OF TAPE" FLAG INTO THE LINK AND CLEAR THE AC
+ TAD D200 /GET MOTION BIT
+DC, SZL /AND, IF LINK IS ON
+DTATAD, TAD D400 /REVERSE DIRECTION OF MOTION
+ DTXA
+ TAD D200
+ KRS
+ TAD DM203
+ SNA CLA
+ KSF /CHECK FOR ^C TYPED
+ JMP DTAWT
+ TAD D7600 /**PROBLEM: LINK IS RANDOM YET MUST BE 0
+ DCA DTA /FAKE DTA SO WE GO TO LOC 7600 IN FIELD 0
+ JMP DSTOP1 /AFTER STOPPING THE TAPE
+DTAWT, DTSF DTRB
+ JMP .-1 /WAIT FOR SEARCH TO COMPLETE
+ SPA /HAS AN ERROR OCCURED?
+ JMP DERR /DO SOMETHING APPROPRIATE
+ DTRA
+ RTL
+ CMA RTL
+ SNL CLA /WAS MOTIOZ OF TAPE FORWARDS?
+ TAD D3 /NO, SO ONLY SUCCEED IF WE ARE 3 BLOCKS IN FRONT
+ /OF TARGET BLOCK
+ TAD I WC
+ CMA
+ TAD DBLOCK
+ CMA /AFTER THIS OPERATION WE HAVE THE FOLLOWING 4 POSSIBILITIES
+ /1)AC=0, L=1 /SEARCH COMPLETE
+ /2)AC=0, L=0 /RIGHT PLACE ON TAPE,WRONG DIRECTION
+ /3)AC .GT. 0, L=0 /WEVE PASSED THE CORRECT BLOCK
+ /4)AC .GT. 0, L=1 /WE HAVENT REACHED THE CORRECT BLOCK YET
+ SZA CLA
+ JMP DC
+ SNL
+ JMP DTATAD /DC+1
+ TAD DLOC
+ DCA I CA /SET THE CURRENT ADDRESS REGISTER TO THE BUFFER -1
+ TAD DFUN
+ DTLB /SET FIELD TO BUFFER FIELD
+ TAD D7700
+D200, AND DFUN
+ CLL RAL
+ DCA DBLKCT /GET UNCOMPLEMENTED WORD COUNT INTO DBLKCT
+ RAL
+ IAC
+ CLL CML RTL
+ RTL /FORM A 50 IF L=1, A 30 IF L=0
+DL, DTXA /XOR IN 50(WRITE) OR 30(READ) OR 0(CONTINUE PREVIOUS OP)
+ TAD D7600
+ DCA I WC /READ/WRITE 128 WORDS FROM/INTO EACH BLOCK
+ DTSF DTRB
+ JMP .-1
+ CLL CML /SET ERROR FLAG ON INITIALLY
+D7700, SMA CLA
+ JMP DJ
+ ISZ DERRCT /ERROR-IS IT THE THIRD?
+\f JMP DTATRY /NO-TRY AGAIN
+ JMP DSTOP /3 ERRORS-STOP TAPE!
+DJ, TAD DBLKCT
+ TAD D7600
+ SNA /BUMP WORD COUNT BY -128 AND SEE IF 0
+\f /ALSO REVERSE LINK.
+ JMP DOVER /YES - DONE
+ DCA DBLKCT /RESTORE BUMPED WORD COUNT
+ JMP DL /AND LOOP
+DOVER, ISZ DTA /SKIP ERROR RETURN
+DSTOP, HLT /RESTORE CALLING FIELD
+DSTOP1, TAD D200 /STOP THE TAPE
+ DTXA
+ DCA DTANO /INITIALIZE DTANO FOR THE NEXT CALL
+ RAR /GET ERROR CODE FROM LINK INTO AC0
+ JMP I DTA /AND EXIT
+DTA, 0
+ $
+\f
--- /dev/null
+/2 TC08 SYSTEM HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f VERSION="B&77
+ *0
+ -2
+ DEVICE TC08;DEVICE SYS;4161;2007;0;1341
+ DEVICE TC08;DEVICE DTA0;4161;1007;0;1341
+\f STARTB-ENDB-1 /NEGATIVE OF LENGTH OF BOOTSTRAP
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+STARTB, TAD B600 /THIS CODE ONLY EXECUTED ON DMS-TYPE BOOTSTRAP
+ DTCA DTXA /ALL IT DOES IS SIMULATE THE OTHER TYPE OF BOOTSTRAP
+ DTSF /MORAL: DISK MONITOR SYSTEM SUCKS
+ JMP .-1
+ DCA BOOTX
+ DCA BOOTX+1 /FUDGE TO MAKE USE OF SOME COMMON CODE
+ TAD B620
+ JMP BOOT3 /START READING OVER OURSELVES WITH RECORD 0 AGAIN
+ ZBLOCK 7611-.
+BM7642, -7641 /MUST BE BEFORE 7617
+BOOT1, TAD 7755
+ TAD BM7642
+ SNA CLA /WATCH THE PROGRESS OF THE READ
+ JMP BOOT2 /WHEN IT GETS PAST 7643, SWITCH TO FIELD 1
+ NOP /LOADS OVER DTSF IN 7616
+ JMP BOOT1 /LOADS OVER JMP .-1 IN 7617 - STARTS BOOTSTRAP
+BOOT2, TAD B10
+ DTLB /ZAP A 10 INTO STATUS REG B TO LOAD INTO FIELD 1
+ DTSF /FROM HERE ON - LOAD THE FIELD 1 RESIDENT INTO FIELD 1
+ JMP .-1
+BOOT3, DTXA /CONTINUE READING NEXT RECORD(ALSO SEE CODE AT 7600)
+ DTLB /INTO FIELD 0
+ TAD B7577
+ DCA 7755 /PAGE 7600
+ DCA 7754
+BOOTX, CDF CIF 10
+ JMP 7642 /JUMP INTO WAIT LOOP IN FIELD 1
+ JMP BOOT1 /DISK MONITOR FUDGE - JUMP INTO WAITING LOOP
+B7577, 7577
+B10, 10
+B600, 600
+B620, 620
+ ZBLOCK 7642-.
+ DCA 7744
+ DTSF /THIS IS LOADED INTO FIELD 1 WITH MONITOR RESIDENT
+ JMP .-1 /IT IS IN THE CD OUTPUT AREA AND SO WILL BE ZAPPED
+ CDF CIF 0 /BY THE KEYBOARD MONITOR
+ENDB, JMP 7605 /OK, FIELD 0 RESIDENT READ IN, START UP MONITOR
+
+ /BOOTSTRAP FOR DECTAPE MONITOR IS THE SAME AS FOR THE
+ /DEC LIBRARY SYSTEM, RL MONITOR AND POLY BASIC - OR JUST
+ /READ RECORD 0 INTO 7600 AND TRANSFER TO 7600 A LA DISK
+ /MONITOR SYSTEM ON DECTAPE
+\f DTRB=6772
+ DTLB=6774
+ DTXA=6764
+ DTCA=6762
+ DTRA=6761
+ DTSF=6771
+
+ *200
+
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+ SBLOCK=7776 /RELIC FROM OS/8 ASSEMBLY
+ ZBLOCK 7
+SHNDLR, VERSION
+ CLA CLL CMA RTL
+ DCA SYSCNT /3 TRIES ON ERROR
+ RDF
+ TAD SCIF
+ DCA SFIELD /RETURN FIELD SETUP
+ TAD I SHNDLR
+ DCA SFUN
+ ISZ SHNDLR
+ CLA CMA
+ TAD I SHNDLR
+ DCA SLOC /BUFFER ADDRESS-1
+ ISZ SHNDLR
+STRY, TAD S410 /SETUP DTA0 TO DO SEARCH REVERSE
+ DTCA DTXA /BUT MOTION BIT IS NOT ON
+ DTLB
+ CLA CMA CLL RAL
+ DCA SCA /7776=SBLOCK FROM OS/8 ASSEMBLY
+ TAD SFUN
+ RTR
+ RTR
+SERR, RTL
+ RAL /LAST 4 INST. PUT MOTION BIT IN LINK
+ /IF THIS BIT WAS SET IN THE CALLING
+ /SEQUENCE, SEARCH STARTS FORWARD.
+S7600, 7600
+ TAD S200
+SC, SZL
+ TAD S400
+ DTXA /ZAP MOTION BIT ON
+ DTSF DTRB
+ JMP .-1
+ SPA /CHECK FOR ANY ERRORS
+ JMP SERR
+ DTRA /NO ERRORS
+ RTL
+ CMA RTL /COMPLEMENT OF DIRECTION TO LINK
+ /IF LINK ON, SEARCHING FORWARD.
+ SNL CLA
+ CML RTL
+ TAD SBLOCK /SEARCH FOR ONE RECORD BEFORE THE
+ /REQUIRED ONE. THEN REVERSE DIRECTION
+ CMA
+ TAD I SHNDLR
+ TAD I SHNDLR /X+X=2*X; RECORDS TO BLOCKS
+ NOP
+ NOP
+ CMA
+ SZA CLA /IS IT PROPER RECORD?
+ JMP SC
+ SNL /YES..IF LINK IS ON,WAS FWD SRCH
+ JMP SC+1 /REVERSE..REVERSE TAPE MOTION
+ /AND SEARCH FORWARD
+ TAD SLOC
+ DCA SCA
+ TAD SFUN
+ DTLB /SET UP FIELD
+ TAD SFUN
+ CLL RAL
+ AND S7600
+ DCA SBLKCT /BLOCK COUNT
+ RAL /FUNCTION TO BIT 11
+ IFNZRO .-7700 <NZERR>
+ SKP
+ HLT /TO PROTECT AGAINST BAD PROGRAMMERS
+ IAC
+ CLL CML RTL
+ RTL /FORMS EITHER READ OR WRITE
+SL, DTXA
+ TAD S7600
+ DCA SWC /TRANSFER 200 (8)
+ DTSF DTRB
+ JMP .-1
+ CLL CML /IN CASE OF FATAL ERROR
+ SPA CLA
+ JMP SERR2
+ TAD SBLKCT
+ TAD S7600
+ SNA /ALL DONE?
+ JMP SOVER /YES
+ DCA SBLKCT
+ JMP SL
+SERR2, ISZ SYSCNT /TRY AGAIN?
+ JMP STRY
+ SKP /DON'T BOTHER
+SOVER, ISZ SHNDLR
+ ISZ SHNDLR
+ TAD S200 /STOP THE TAPE
+ DTXA
+ RAR /GIVE FATAL RETURN
+SFIELD, HLT
+ JMP I SHNDLR
+\fSCIF, CIF 0
+S400, 400
+S200, 200
+S410, 410
+ SBLKCT=7753
+ SYSCNT=7750
+ SFUN=7751
+ SLOC=7752
+ SWC=7754
+ SCA=7755
+ $
+\f
--- /dev/null
+/3 TD8E SYSTEM RESIDENT (12K)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f *0
+
+ -3
+ DEVICE TD8E;DEVICE SYS;4211;6007;0;1341
+ DEVICE TD8E;DEVICE DTA0;4211;5007;0;1341
+ DEVICE TD8E;DEVICE DTA1;4211;SDTA1&177+5000;0;1341
+\f TDBEGN-TD77-1
+
+ RELOC 7360
+
+/THE BINARY GETS LOADED INTO 27220 INITIALY, AND
+/WRITTEN OUT AS PART OF RECORD 0. WHEN THE 30 WORD
+/BOOTSTRAP IS USED, THIS CODE GETS READ INTO 7400.
+
+
+
+ SDSS=6771
+ SDST=6772
+ SDSQ=6773
+ SDLC=6774
+ SDLD=6775
+ SDRC=6776
+ SDRD=6777
+
+TDBEGN, ZBLOCK 20
+TDBOOT, TAD K7600 /128 WORDS PER PAGE
+ DCA TDWCT
+ SDSS /WAIT FOR A BLOCK MARK (TAPE IS
+ JMP .-1 /STILL MOVING)
+ SDRC
+ AND TD77
+ TAD KM26 /IS IT A BLOCK MARK?
+ SZA CLA
+ JMP TDBOOT+2 /NO..WAIT A WHILE LONGER
+ SDRD /GET THE BLOCK NO.
+TDBKNO, TAD TDM14 /NEED DECTAPE BLOCKS 154 & 155 (REC. 66)
+ SZA CLA
+ JMP TDBOOT+2 /NOT YET, BUSTER
+TDRGRD, SDSS
+ JMP .-1 /NOW LET'S LOOK FOR A REVERSE GUARD WORD
+ SDRC
+ AND TD77
+ TAD KM32
+ SZA CLA
+ JMP TDRGRD /KEEP LOOKING FOR IT
+ JMS TDRQD
+ JMS TDRQD
+ JMS TDRQD /SKIP CONTROL WORDS
+ CDF 10 /LOAD UP FIELD 1
+TDREAD, JMS TDRQD /GET A DATA WORD
+ DCA I TDPTR
+ ISZ TDPTR /ARE WE DONE?
+ JMP TDREAD /NOT YET
+ ISZ TDBKNO /YES..LOOK AT BLOCK 15
+ TAD KCDF20
+ DCA TDREAD-1 /LOAD UP FIELD 2
+ ISZ M2 /DONE THIS JUNK?
+ JMP TDBOOT /GO DO FIELD 2
+ SDLC /STOP THE TAPE
+ CIF CDF 0
+ JMP I K7605
+\fTDM14, -154
+ -155 /USE RECORD 66
+TDPTR,
+TDWCT, 7600
+TDRQD, 0
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I TDRQD
+
+K7600, 7600
+KM26, -26
+KM32, -32
+KCDF20, CDF 20
+M2, -2
+K7605, 7605
+TD77, 77
+
+/ THIS BOOTSTRAP RESIDES IN BLOCK 0
+/ BLOCK 1/2 CONTAINS THE USUAL IMAGE OF 07600
+/ BLOCK 66 CONTAINS THE IMAGE OF 17600
+/ BLOCK 66 1/2 CONTAINS THE IMAGE OF 27600
+ RELOC
+\f *200
+
+/TD8E DECTAPE SYSTEM HANDLER
+/THIS HANDLER CAN DRIVE UNITS 0&1, AND IS PERMANENTLY
+/RESIDENT IN FIELDS 0&2.
+
+ RELOC 7600
+
+ VERSION="B&77
+
+ ZBLOCK 7
+SHNDLR, VERSION /UNIT 0 ENTRY POINT
+ CLA CLL
+ JMP SHND2
+C3, 3 /MUST BE HERE FOR BUILD
+S70, 70
+SDTA1, VERSION /UNIT 1 ENTRY
+ CLA CLL CML
+SC1000, TAD SDTA1 /DOUBLES AS CONSTANT 1000
+ DCA SHNDLR /GET ARGS AT SHNDLR
+SHND2, RAR /UNIT #
+ DCA SUNIT
+ RDF /SETUP FOR EXIT
+ TAD S6203
+ DCA EFLD
+ TAD I SHNDLR /FUNCTION WORD
+ SDLD /PUT IT IN DATA EGISTER
+ AND S70 /SDLD DOES NOT 0 AC..GET FIELD
+ TAD S6203 /CIF CDF N FOR TRANSFER FIELD
+ DCA TFLD
+ ISZ SHNDLR
+ TAD I SHNDLR /BUFFER ADDRESS
+ DCA BPTR
+ ISZ SHNDLR
+ TAD I SHNDLR /BLOCK #. TIMES 2 FOR REAL #
+ CLL RAL
+ DCA BLOCK
+ ISZ SHNDLR /POINT TO ERROR EXIT
+ CIF CDF 20 /PUT UNIT # INTO FIELD 2
+ TAD SUNIT
+ DCA I SUNIT2
+ JMP F2SET /TO FIELD 2 FOR INIT.
+
+F1GO, SDRD /INITIAL DIRECTION TO LINK
+ RAR
+ JMP RGO
+\fRENTER, TAD BPTR /DONE THIS BLOCK..NEXT ADDRESS
+ TAD SC200
+ DCA BPTR
+ ISZ BLOCK /NEXT TAPE BLOCK..CAN'T SKIP
+ CLL CML /FORCE FORWARD MOTION
+RGO, CLA CML RTR /LINK TO MOTION BIT
+ TAD SC1000
+ TAD SUNIT
+ SDLC /MOVE THE TAPE
+ SDSQ
+ JMP .-1
+ SDRD /KNOCK DOWN QUAD FLAG
+ SDSQ
+ JMP .-1
+ SDRD /THIS IS NEEDED, ELSE TIME ERROR!!!
+\f
+SRCH, SDSS /WAIT FOR A BLOCK MARK
+ JMP .-1
+ SDRC /GET MARK TRACK BITS
+ CLL RTL /DIRECTION TO LINK
+ AND SC374
+ TAD SM110 /IS IT A N END ZONE?
+ SNA
+ JMP SENDZ /YES
+ TAD SM20 /MAYBE A BLOCK MARK?
+ SZA CLA
+ JMP SRCH /NEITHER..KEEP GOING
+ SDRD /READ THE BLOCK #
+ SZL /IF REVERSE, LOOK 3 AHEAD OF TARGET
+ TAD C3
+ CMA
+ TAD BLOCK
+ CMA
+ SNA /IS IT THE RIGHT ONE?
+ JMP FOUND /YES
+SM110, CLA SNA SZL /SNA SUPERFLUOUS..ONLY SZL VALID
+ JMP SRCH /HEADED FOR IT..KEEP GOING
+SENDZ, SDRC
+ CLL RTL
+ SZL CLA /IF IN END ZONE FORWARD, GIVE ERROR
+ JMP RGO
+ CIF 20 /IF IT IS REALL END ZONE, AN ERROR
+ JMP ERROR
+
+FOUND, SZL CLA /RIGHT BLOCK..HOW ABOUT DIRECTION?
+ JMP RGO /WRONG..EXECUTE TURNAROUND
+ TAD BPTR
+TFLD, HLT /GETS CIF CDF N
+ CIF 20
+ JMP RDWT /LET'S TRANSFER DATA
+
+SEXIT, ISZ SHNDLR /NORMAL RETURN
+SEREX, TAD SUNIT /STOP THE TAPE
+ SDLC
+ CML CLA RAR /EITHER 0 OR 4000 IN AC ON RETURN
+EFLD, HLT
+ JMP I SHNDLR
+
+ BPTR=7755
+ BLOCK=7754
+ SUNIT=SDTA1
+
+S6203, 6203
+SC200, 200
+SC374, 374
+SM20, -20
+SUNIT2, SXUNIT
+ RELOC
+\f *400
+
+ RELOC 7600 /RUNS IN 27600
+
+XPTR, 0 /BUFFER POINTER
+F2SET, CLA CLL CMA RTL /3 ERROR TRIES
+ DCA TRYCNT
+ TAD SXUNIT /MAKE SURE TAPE IS STOPPED
+ SDLC
+F26203, CIF CDF 0
+ SDRD /FUNCTION WORD
+ CLL RAL
+ AND CX7600 /PAGE COUNT
+ DCA XPGCT
+ SDRD
+ DCA SXFUN /SAVE THE FUNCTION WORD
+ JMP F1GO
+
+RDWT, DCA XPTR /SAVE NEW BUFFER ADDRESS
+ TAD CX7600
+ DCA XWCNT /128 WORDS PER BLOCK
+REVGRD, SDSS /WAIT FOR REVERSE GUARD WORD
+ JMP .-1
+ SDRC
+ AND X77
+ TAD XM32 /IS IT REVERSE GUARD?
+ SZA CLA
+ JMP REVGRD /NO
+ TAD SXFUN
+SK7700, SMA CLA /READ OR WRITE?
+ JMP READ /READ
+ SDRC
+ AND C300 /ERRORS ON WRITE LOCKOUT AND TIME
+ SZA CLA
+ JMP ERROR
+ JMS RDQUAD /SKIP A WORD
+CX7600, 7600
+ TAD WRLP
+ TAD SXUNIT
+ SDLC /TURN ON THE WRITE
+ CLA CMA
+ JMS WRQUAD /WRITE 7777 IN REV. CHECKSUM
+ CLA CMA
+ DCA SCKSUM /AND ALSO IN COMPUTE CHECKSUM
+WRLP, TAD I XPTR
+ JMS WRQUAD /WRITE THE DATA
+ ISZ XPTR
+X77, 77 /JUST IN CASE
+ ISZ XWCNT /DONE 128?
+ JMP WRLP
+ JMS WRQUAD /WRITE AND CHECKSUM A WORD OF 0
+ JMS GETCHK /GET CHECKSUM
+ JMS WRQUAD
+ JMS WRQUAD /LET CHECKSUM GET WRITTEN
+\f
+RWCOM, SDST /CHECK FOR TIME AND CHECKSUM ERRORS
+ SZA CLA
+ JMP ERROR /NOTE THAT LINK IS OFF AT RWCOM
+ CIF CDF 0
+ TAD XPGCT /FINISHED TRANSFER?
+ TAD CX7600 /LINK GOES ON HERE
+ SNA
+ JMP SEXIT /YES..GETOUT
+ DCA XPGCT
+ JMP RENTER
+
+READ, JMS RDQUAD /SKIP CONTROL WORDS
+ JMS RDQUAD
+ JMS RDQUAD /GET CHECKSUM
+ AND X77
+ TAD SK7700
+ DCA SCKSUM
+SRDLP, JMS RDQUAD
+ DCA I XPTR
+ TAD I XPTR
+ JMS EQUFUN
+ ISZ XPTR
+C300, 300
+ ISZ XWCNT /DONE ALL?
+ JMP SRDLP /NO
+ JMS RDQUAD /READ AND CHECKSUM LAST WORD
+ JMS EQUFUN
+ JMS RDQUAD /GET CHECKSUM
+ AND SK7700
+ JMS EQUFUN
+ JMS GETCHK
+ JMP RWCOM
+
+ERROR, CLA CLL /THIS CAUSES SEARCH REVERSE AT RGO
+ CIF CDF 0
+ ISZ TRYCNT /EXHAUSTED ERROR TRIES?
+ JMP RGO
+ JMP SEREX /YES..FATAL EXIT
+
+WRQUAD, 0 /WRITE A 12 BIT WORD
+ SDSQ
+ JMP .-1
+ SDLD
+ JMS EQUFUN /SDLD LEAVES AC ALONE
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT WORD
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I RDQUAD
+\fEQUFUN, 0 /EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP
+ TAD EQUTMP
+ AND SCKSUM
+ CIA
+ CLL RAL
+ TAD EQUTMP
+ TAD SCKSUM
+ DCA SCKSUM
+ JMP I EQUFUN
+
+GETCHK, 0
+ TAD SCKSUM
+ CLL CMA RTL
+ RTL
+ RTL
+ JMS EQUFUN
+ TAD SCKSUM
+ AND SK7700
+ JMP I GETCHK
+
+SXUNIT, 0
+XPGCT, 0
+SXFUN, 0
+TRYCNT, 0
+XWCNT, 0
+XM32, -32
+SCKSUM, 0
+EQUTMP, 0
+
+/THE LAST 4 LOCS. ARE FREE FOR USE BY BATCH
+ ZBLOCK 4
+ RELOC
+ $
+\f
--- /dev/null
+/TD8E DECTAPE COPY, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1972, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f
+
+
+/DEFINITIONS FOR PAL8 AND PAL10
+
+BSW=7002
+MQL=7421
+MQA=7501
+CAM=7621
+SWP=7521
+ACL=7701
+CAF=6007
+CDI=6203
+KCF=6030
+SDSS=6771
+SDST=6772
+SDSQ=6773
+SDLC=6774
+SDLD=6775
+SDRC=6776
+SDRD=6777
+FIXTAB
+
+
+HALT=HLT
+
+
+/UNIT NUMBER DEFINITIONS FOR TD8E IOT'S
+
+UNIT01=0770
+UNIT23=0760
+UNIT45=0750
+UNIT67=0740
+
+\f
+
+LIMIT=7600
+
+*11
+
+X11, 0
+X12, 0
+
+/PAGE 0 CONSTANTS AND VARIABLES
+
+*20
+INPUT, 0 /INPUT UNIT CONSTANT
+OUTPUT, 0 /OUTPUT UNIT CONSTANTS
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+OCOUNT, 0 /NUMBER OF OUTPUT UNITS SPECIFIED
+OPOINT, 0
+LIST, OUTPUT-1
+OUTNUM, 0
+IBLOCK, 0 /STARTING INPUT BLOCK
+OBLOCK, 0 /STARTING OUTPUT BLOCK
+NUMBER, 0 /NUMBER OF BLOCKS TO TRANSFER
+FIELDS, 0 /-(HIGHEST FIELD AVAILABLE)
+COUNT, 0 /TEMPORARY COUNTERS
+COUNT1, 0 / "
+COUNT2, 0 / "
+COUNT3, 0 / "
+COUNT4, 0 / "
+UNIT, 0 /UNIT CONSTANT--THIS TRANSFER
+VERF, 0 /VERIFY SWITCH (1=YES,0=NO)
+WDCNT, 0 /-(NUMBER OF WORDS PER BLOCK)
+RW, 0 /READ/WRITE BIT--THIS TRANSFER
+FLD0, 0 /# OF BLOCKS IN FIELD 0 BUFFER
+FLDN, 0 /# OF BLOCKS IN FIELD N BUFFER
+BUF0, 0 /START OF FIELD 0 BUFFER
+BUFN, 0 /START OF FIELD N BUFFER
+XNUMB, 0 /# OF BLOCKS LEFT TO TRANSFER
+BLOCKN, 0 /STARTING BLOCK NUMBER--THIS TRANSFER
+NUMB1, 0
+NUMB2, 0
+VB, 0
+END0, 0 /BEGINNING OF FIELD 0 VERIFY BUFFER
+ENTRY, 0 /ENTRY TO TD8E HANDLER
+INB, 0
+OUTB, 0
+OHOLD, 0
+\f
+MESSG1, TEXT @TD8E COPY V4A@
+MESSG3, TEXT @ 12-BIT WORDS PER BLOCK@
+\f
+*200
+
+START, TLS
+ JMS CRLF
+ JMS I [MESSGE
+ MESSG1 /@TD8E COPY@
+ JMS CRLF
+ DCA COUNT
+ JMP I [END /ONCE ONLY CODE FOR MULTIPLE FIELD TEST
+START1, JMS QUEST
+ MESSG4 /@FROM UNIT:@
+ SWP
+ JMS UNITNO /MAKE UNIT NUMBER CONSTANT
+ DCA INPUT
+ TAD LIST
+ DCA OPOINT
+ SKP
+AGAIN, JMS ERR4 /*ILLEGAL RESPONSE*
+ DCA OCOUNT
+ DCA COUNT
+ JMS I [MESSGE
+ MESSG5 /@TO UNITS:@
+MORE2, JMS I [ANSWER
+ JMP AGAIN
+ ACL
+ JMS UNITNO /MAKE UNIT NUMBER CONSTANT
+ MQL /STORE IN MQ
+ MQA /RESTORE TO AC
+ CIA
+ TAD INPUT
+ SNA CLA /IS OUTPUT UNIT = INPUT UNIT ?
+ JMP MORE2+1 /YES--ERROR
+ ISZ OPOINT
+ ISZ OCOUNT /COUNT ONE MORE OUTPUT UNIT
+ TAD OCOUNT
+ TAD [-10
+ SPA CLA /WERE MORE THAN 7 UNITS SPECIFIED?
+ JMP .+3
+ JMS CRLF /YES--CARRIAGE RETURN
+ JMP OALL /IGNORE EXTRA ONE
+ SWP /NO--
+ DCA I OPOINT /STORE UNIT CONSTANT IN LIST
+ TAD COUNT
+ CIA
+ TAD OCOUNT
+ SPA SNA CLA /ALL UNITS IN?
+ JMP MORE2 /YES
+\f
+OALL, DCA COUNT
+ JMS I [MESSGE
+ MESSG6 /@FIRST INPUT BLOCK:@
+ JMS I [ANSWER
+ JMP WHOLE /COPY WHOLE TAPE
+ TAD COUNT
+ SNA CLA /WERE TOO MANY SPECIFIED?
+ JMP .+5
+ JMS I [MESSGE /YES
+ ERROR4 /@ILLEGAL RESPONSE@
+ JMS CRLF
+ JMP OALL /REPEAT THE QUESTION
+ ACL /NO
+ DCA IBLOCK /STORE
+ JMS QUEST
+ MESSG7 /@FIRST OUTPUT BLOCK:@
+ ACL
+ DCA OBLOCK
+ JMS QUEST
+ MESSG8 /@NUMBER OF BLOCKS TO COPY:@
+ ACL
+ SNA /WERE 0 BLOCKS SPECIFIED?
+ JMP QUEST1 /YES--REPEAT QUESTION
+ DCA NUMBER
+ JMP .+4
+WHOLE, DCA IBLOCK
+ DCA OBLOCK
+ DCA NUMBER /0 MEANS WHOLE TAPE
+ JMS QUEST
+ MESSG9 /@VERIFY OUTPUT (YES=1,NO=0):@
+ ACL
+ AND [7
+ DCA VERF
+ JMP I (SETUP
+\f
+/OUTPUT CARRIAGE RETURN/LINE FEED
+
+CRLF, 0
+ TAD (215
+ JMS I [TYPE
+ TAD [212
+ JMS I [TYPE
+ JMP I CRLF /--RETURN--
+
+ERR4, 0
+ JMS I [MESSGE
+ ERROR4 /@ILLEGAL RESPONSE@
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ TAD [-4
+ TAD ERR4
+ DCA ERR4
+ DCA COUNT
+ JMP I ERR4 /--RETURN--
+
+\f
+QUEST, 0
+ TAD I QUEST
+ DCA MNUM
+ ISZ QUEST
+ JMS I [MESSGE
+MNUM, 0
+ JMS I [ANSWER
+QUEST1, JMS ERR4
+ TAD COUNT
+ SZA CLA
+ JMP QUEST1
+ JMP I QUEST /--RETURN--
+
+
+/CONVERT UNIT NUMBER TO A WORD OF THE FORM
+/000 XXX XXX 000 OR
+/100 XXX XXX 000
+/WHERE XY0 IS THE THIRD DIGIT OF THE IOT
+/AND 0 OR 1 REFLECTS THE TD8E UNIT NUMBER
+/ENTER WITH THE UNIT NUMBER IN THE AC
+/EXIT WITH SPECIAL CODE IN AC
+
+UNITNO, 0
+ AND [7 /MASK OUT ALL EXTRANEOUS BITS
+ CLL RAR /SAVE 0/1 BIT IN LINK
+ MQL /STORE ROTATED WORD, CLEAR AC
+ RAR
+ SWP /PRESERVE 0/1 BIT IN MQ
+ TAD TABX /GET DEVICE NUMBER CORRECTLY
+ DCA CRLF
+ TAD I CRLF
+ MQA /OR IN 0/1 BIT
+ JMP I UNITNO /--RETURN--
+
+TABX, UNITS
+
+/SKIP 4 LINES AND FETCH MARK TRACK
+
+SKIPQ, 0
+IOTR5, SDSQ
+ JMP .-1
+IOTR6, SDRC
+ JMP I SKIPQ /--RETURN--
+\f
+*400
+
+/USER RESPONSE HANDLER
+/USES MQ FOR TEMPORARY STORAGE
+/EXIT WITH RESPONSE IN MQ
+/EXIT TO CALL+1 IF JUST CARRIAGE RETURN
+/OR ILLEGAL CHARACTER, CARRIAGE RETURN
+/OR ;,CARRIAGE RETURN
+/EXIT TO CALL+2 IF GOOD DATA, CARRIAGE RETURN
+/INCREMENT COUNT AND EXIT TO CALL+2 IF GOOD DATA;
+/ILLEGAL CHARACTERS CAUSE WHOLE ANSWER TO BE IGNORED
+/AND EXIT TO CALL+1
+
+ANSWER, 0
+ CAM /CLEAR AC AND MQ
+ TAD CLEAR
+ DCA SWITCH
+MORE, JMS LISTEN /FETCH A CHARACTER
+ TAD (-215
+ SZA /IS IT A CARRIAGE RETURN?
+ JMP .+5 /NO
+ TAD [212 /YES--OUTPUT LINE FEED
+ JMS TYPE
+SWITCH, NOP /SET UP EXIT ADDRESS
+ JMP I ANSWER /--RETURN--
+ TAD (215-260
+ SPA /IS CHARACTER LESS THAN 260?
+ JMP BAD /YES--ILLEGAL CHARACTER
+ TAD [260-270 /NO
+ SMA /IS IT MORE THAN 269?
+ JMP SEMI /YES--CHECK FOR SEMICOLON
+ TAD (270 /RESTORE CHARACTER
+ AND [7 /MASK OUT EXTRANEOUS BITS
+ CLL
+ SWP
+ AND (777 /MASK OUT FIRST DIGIT IF THERE ARE 4
+ RAL /ROTATE 3 LEFT
+ RTL
+ MQA /FETCH NEW CHARACTER
+ MQL /STORE RESULT IN MQ
+ TAD SKIP /SET UP TO SKIP ON RETURN
+ DCA SWITCH
+ JMP MORE /FETCH ANOTHER
+
+\f
+CLEAR, NOP
+SKIP, ISZ ANSWER
+
+BAD, CLA /ILLEGAL CHARACTER
+ JMS I [CRLF
+ JMP I ANSWER /--RETURN--
+
+
+/TEST FOR SEMICOLON
+
+SEMI, TAD (270-273
+ SZA CLA /IS CHARACTER A SEMICOLON?
+ JMP BAD /NO--ILLEGAL CHARACTER
+ ISZ COUNT /YES--INCREMENT COUNTER
+ JMP SWITCH /EXIT FROM ANSWER ROUTINE
+
+
+/TELETYPE INPUT AND ECHO HANDLER
+
+LISTEN, 0
+ KSF
+ JMP .-1
+ JMS I [PARITY
+ TLS /ECHO CHARACTER
+ JMS CHECK /CHECK FOR CTRL/C AND CTRL/S
+ JMP I LISTEN /--RETURN--
+
+/CHECK FOR CTRL/C AND CTRL/S
+/ENTER WITH INPUT CHARACTER IN AC
+/EXIT TO HANDLER OR WITH CHARACTER IN AC
+
+CHECK, 0
+ TAD (-203
+ SNA /IS IT CTRL/C?
+ JMP I CTRLC /YES--HANDLE IT
+ TAD (203-223
+ SNA /IS IT CTRL/S?
+ JMP I [REPEAT /YES--HANDLE IT
+ TAD (223 /RESTORE CHARACTER
+ JMP I CHECK /--RETURN--
+
+CTRLC, LIMIT
+\f
+/MESSAGE OUTPUT HANDLER
+
+/EXPECTS MESSAGE ADDRESS TO BE IN LOCATION AFTER CALL
+/EXITS TO CALL+2
+
+MESSGE, 0
+ TAD I MESSGE
+ DCA FINDER /SET UP POINTER
+ ISZ MESSGE
+ DCA LOC /SET L/R SWITCH TO L (EVEN)
+LNEXT, TAD I FINDER /GET WORD
+ BSW
+RHALF, AND [77
+ SNA /IS CHARACTER 0 (TERMINATOR)?
+ JMP I MESSGE /YES--RETURN--
+ DCA CHAR
+ TAD CHAR
+ AND (40
+ SNA CLA /IS IT A LETTER?
+ TAD [100 /YES--301-337
+ TAD [200 /NO--240-277
+ TAD CHAR /RESTORE CHARACTER
+ JMS TYPE /OUTPUT IT
+ ISZ LOC
+ TAD LOC
+ RAR
+ SZL CLA /WHICH HALF WAS THAT?
+ JMP .+3
+ ISZ FINDER /RIGHT
+ JMP LNEXT
+ TAD I FINDER /LEFT
+ JMP RHALF
+FINDER, 0
+LOC, 0
+CHAR, 0
+
+
+/TELETYPE OUTPUT ROUTINE
+
+
+TYPE, 0
+ TSF
+ JMP .-1
+ TLS
+ CLA
+ JMP I TYPE /--RETURN--
+
+\f
+/INSERT IOT'S ACCORDING TO TABLES
+/UNIT CONTAINS APPROPRIATE UNIT CODE
+/COUNT CONTAINS -(NUMBER OF IOT'S TO TRANSFER)
+/COUNT1 CONTAINS ADDRESS OF ADDRESS TABLE
+/UNIT CONTAINS UNIT CODE OF CURRENT UNIT
+
+INSERT, 0
+ TAD I COUNT1
+ DCA COUNT3
+ TAD UNIT
+ MQL
+ TAD I COUNT3 /MAKE NEW IOT
+ AND (7007
+ MQA
+ CIA
+ TAD I COUNT3 /COMPARE WITH IOT FROM PROGRAM
+ SNA CLA /ARE THE IOT'S THE SAME AS THE LAST UNIT?
+ JMP I INSERT /YES--RETURN--
+INS1, TAD I COUNT1
+ DCA COUNT3
+ TAD I COUNT3 /GET IOT FROM PROGRAM
+ AND (7007 /RETAIN ONLY SIGNIFICANT BITS
+ MQA /OR IN UNIT NUMBER
+ DCA I COUNT3 /PUT IT IN PROGRAM
+ ISZ COUNT1 /BUMP COUNTERS
+ ISZ COUNT /DONE YET?
+ JMP INS1 /NO
+ JMP I INSERT /YES--RETURN--
+
+
+PAGE
+\f
+/COUNT THE NUMBER OF WORDS PER BLOCK
+/PLACE IT IN MWORDS
+/BE SURE ALL TAPES MATCH INPUT FORMAT
+
+SETUP, TAD LIST
+ DCA OPOINT /SET POINTER TO I/O LIST
+ DCA COUNT2 /CLEAR COUNTER
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM /SET # OF UNITS
+SET4, TAD (TABLE1-END1-1 /SET UP COUNTERS FOR IOT FIX
+ DCA COUNT
+ TAD (TABLE1
+ DCA COUNT1
+ TAD I OPOINT
+ DCA UNIT
+ JMS I [INSERT /PUT THE PROPER IOT'S IN THE FOLLOWING ROUTINE
+ DCA WDCNT /CLEAR WORD COUNT
+ TAD UNIT
+ AND [4000
+ TAD (2000
+IOTX7, SDLC
+ CLA
+IOTX8, SDRC
+ RTL
+ SZL /DOES UNIT EXIST?
+ JMP .+3 /YES
+SELERR, JMS I [ERR3 /@SELECT ERROR UNIT N@
+ JMP SETUP
+ AND (400
+ SZA CLA /TURNED ON?
+ JMP SELERR /NO
+ TAD UNIT /GET 0 OR 1 UNIT BIT (0 OR 4000)
+ AND [4000
+ TAD [1000 /GET GO BIT
+IOTX1, SDLC /START READING FORWARD
+ JMS SKIP4 /SKIP 8 LINES TO AVOID GARBAGE
+ JMS SKIP4
+IOTX3, SDSS /LOOK FOR FORWARD BLOCK NUMBER (26)
+ JMP .-1
+IOTX4, SDRC
+ AND [77
+ TAD (-26
+ SZA CLA /FOUND YET?
+ JMP IOTX3 /NO--KEEP LOOKING
+\f
+SET2, JMS SKIP4 /YES--START COUNTING LINES BY FOURS
+ ISZ WDCNT
+ NOP
+ AND [77
+ TAD (-51
+ SZA CLA /FOUND GUARD YET?
+ JMP SET2 /NO
+ TAD UNIT /YES
+ AND [4000
+IOTX2, SDLC /STOP UNIT
+ CLA
+ TAD COUNT2
+ SZA /IS THIS THE INPUT UNIT?
+ JMP SET5 /NO
+ TAD (-11 /YES--SAVE THE COUNT
+ TAD WDCNT
+ CIA
+ DCA COUNT2
+ JMP SET3 /FIRST OUTPUT UNIT
+SET5, TAD (-11 /NOT INPUT UNIT
+ TAD WDCNT
+ SZA CLA /SAME NUMBER OF WORDS AS INPUT UNIT?
+ JMP ERR5 /NO*ILLEGAL FORMAT*
+SET3, ISZ OPOINT /NEXT UNIT
+ ISZ OUTNUM /DONE YET?
+ JMP SET4 /NO
+ TAD COUNT2 /YES--PRINT MESSAGE
+ DCA I [MWORDS /SET UP NUMBER OF WORDS PER BLOCK
+ TAD I [MWORDS
+ CIA
+ JMS I [PRINT /PRINT 4 DIGIT NUMBER OF BLOCKS
+ JMS I [MESSGE /YES--PRINT REST OF MESSAGE
+ MESSG3
+ JMS I [CRLF
+\f
+/IF WHOLE TAPE IS TO BE COPIED, IT IS NECESSARY TO
+/COMPUTE THE NUMBER OF BLOCKS ON THE TAPE (NB)
+/USING THE NUMBER OF WORDS PER BLOCK (WB)
+/AND THE FORMULA:
+/OCTAL: NB=[63 6160/(WB+17)]+2
+/DECIMAL: NB=[212,080/(WB+15)]+2
+
+ TAD NUMBER
+ SZA CLA /COPY WHOLE TAPE?
+ JMP VERFQ /NO--
+ DCA COUNT /YES--COMPUTE NUMBER OF BLOCKS ON TAPE
+ TAD I [MWORDS
+ CIA
+ TAD (17
+ DCA COUNT1 /GET NUMBER OF WORDS PER BLOCK+17
+ TAD (-64
+ DCA COUNT2
+ TAD (-6160
+SUB, CLL
+ TAD COUNT1
+ ISZ COUNT /COUNT A BLOCK--TOO MANY?
+ SKP /NO
+ JMP ERR5 /YES--ERROR
+ SZL
+ ISZ COUNT2
+ JMP SUB
+ CLA CLL
+ TAD COUNT /COUNT IS [63 6160/WB+17]+1
+ IAC /ADD 1 MORE
+ DCA NUMBER /STORE AS # OF BLOCKS TO TRANSFER
+ JMP I .+1
+ VERFQ
+
+ERR5, CLA
+ JMS I [MESSGE
+ ERROR5 /*ILLEGAL FORMAT UNIT*
+ JMS I [DECODE /PRINT UNIT NUMBER
+ JMS I [CTRLR /WAIT FOR CTRL/R
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ JMP SETUP /TRY AGAIN
+
+
+
+
+/READ FOUR LINES AND FETCH MARK TRACK
+
+SKIP4, 0
+IOTX5, SDSQ
+ JMP .-1
+IOTX6, SDRC
+ JMP I SKIP4 /--RETURN--
+
+
+
+\f
+PAGE
+
+/IS TAPE TO BE VERIFIED?
+/SET UP DEPENDING ON RESPONSE
+VERFQ, TAD VERF
+ SZA CLA /VERIFY?
+ JMP YES /YES--
+ TAD (NOP /NO--
+ DCA I VERF1A
+ TAD (OUTN
+ DCA I VERF2A
+ JMP CONT
+YES, TAD (RAR
+ DCA I VERF1A
+ TAD (VERIFY
+ DCA I VERF2A
+CONT, JMP I .+1
+ DOIT
+
+VERF1A, VERF1
+VERF2A, VERF2
+
+/WAIT FOR CTRL/R
+
+CTRLR, 0
+ JMS I [LISTEN /FETCH CHARACTER
+ TAD [-222
+ SZA CLA /IT IT CTRL/R?
+ JMP .-3 /NO--WAIT FOR ONE
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ JMP I CTRLR /--RETURN--
+
+
+REPEAT, DCA COUNT
+ JMS I [CRLF
+ JMS I [QUEST /@REPEAT (YES=1;NO=0):@
+ MESS11
+ ACL
+ AND [7
+ SZA CLA
+ JMP I [CLEAN /YES
+ JMP I [START+4 /NO--RESTART
+\f
+MESSG6, TEXT @FIRST INPUT BLOCK:@
+MESSG7, TEXT @FIRST OUTPUT BLOCK:@
+MESSG8, TEXT @NUMBER OF BLOCKS TO COPY:@
+MESSG9, TEXT @VERIFY OUTPUT (YES=1,NO=0):@
+MESS10, TEXT @DONE@
+MESS11, TEXT @REPEAT (YES=1,NO=0):@
+ERROR1, TEXT @VERIFY ERROR BLOCK @
+ERROR2, TEXT @TAPE ERROR BLOCK @
+ERROR3, TEXT @SELECT ERROR UNIT @
+\f
+PAGE
+
+/SETUP FOR ACTUAL READ/WRITE/VERIFY OPERATION
+DOIT, TAD [LIMIT-END /SET UP NUMBER OF BLOCKS
+ JMS DIV1 /IN FIELD 0 BUFFER
+ DCA FLD0
+ TAD M200
+ JMS DIV1 /AND IN FIELD N BUFFERS
+ DCA FLDN
+ TAD IBLOCK /SET UP RUNNING COUNTERS AND POINTERS
+ DCA INB /FOR NEXT INPUT BLOCK
+ TAD OBLOCK
+ DCA OUTB /FOR NEXT OUTPUT BLOCK
+ TAD NUMBER
+ DCA NUMB1 /FOR NUMBER OF BLOCKS LEFT TO TRANSFER
+ JMP .+4
+ALLDUN, TAD XNUMB
+ SNA CLA /DONE WITH ALL BLOCKS YET?
+ JMP REWIND /YES
+/READ---
+READX, TAD LIST /NO--SET UP POINTER TO OUTPUT UNITS
+ DCA OPOINT
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM
+ TAD INB
+ DCA BLOCKN
+ TAD NUMB1 /SET POINTERS FOR TRANSFER
+ DCA XNUMB
+ TAD NUMB1
+ DCA NUMB2 /SAVE COUNTER FOR WRITE
+ TAD INPUT /SELECT INPUT UNIT
+ DCA UNIT
+ DCA RW /SET R/W BIT TO READ
+\f
+ TAD [END /SET START OF BUFFERS IN CASE
+ DCA BUF0 /THEY WERE CHANGED BY VERIFY
+ DCA BUFN
+ JMS I [READY /FILL THE BUFFERS
+ TAD XNUMB /SAVE THE POINTERS
+ DCA NUMB1
+ TAD BLOCKN
+ DCA INB
+
+OUTN, ISZ OPOINT
+ ISZ OUTNUM /DONE WITH ALL UNITS YET?
+ JMP .+4 /NO--CONTINUE WRITING
+ TAD OHOLD /YES
+ DCA OUTB
+ JMP ALLDUN /READ ANOTHER BUFFER LOAD
+WRITEX, TAD OUTB
+ DCA OHOLD
+ TAD OHOLD /WRITE
+ DCA BLOCKN /RESET POINTERS
+ TAD OUTB
+ DCA VB /SAVE COUNTER FOR VERIFY
+ TAD NUMB2
+ DCA XNUMB
+ TAD I OPOINT /SELECT OUTPUT UNIT
+ DCA UNIT
+ CLA CLL CML RAR /AC=4000
+ DCA RW /SET R/W BIT TO WRITE
+ JMS I [READY
+ TAD BLOCKN
+ DCA OHOLD
+ JMP I .+1
+VERF2, VERIFY
+
+
+\f
+/SEE HOW MANY BLOCKS WILL FIT INTO BUFFER
+/ENTER WITH BUFFER SIZE IN AC
+/EXIT WITH # OF BLOCKS IN AC
+
+DIV1, 0
+ DCA COUNT1
+ DCA COUNT
+ TAD COUNT1 /TOTAL WORDS
+DIV2, CLL
+ TAD I [MWORDS /-NUMBER OF WORDS PER BLOCK
+ SNL /RUN OUT OF ROOM?
+ JMP .+3 /YES--
+ ISZ COUNT /NO--COUNT A BLOCK
+ JMP DIV2
+ CLA CLL /IGNORE LESS THAN A BLOCK LEFT
+ TAD COUNT
+VERF1, RAR /DIVIDE BY 2 IF VERIFY (NOP IF NO VERIFY)
+ JMP I DIV1 /--RETURN--
+
+/END OF OPERATION
+/REWIND TAPES TO INITIAL END ZONE
+
+REWIND, TAD OCOUNT
+ CMA
+ DCA COUNT2 /SET NUMBER OF TAPES STILL SPINNING
+RLIST, CLA CMA
+ TAD LIST
+ DCA OPOINT /SET POINTER TO UNIT LIST
+ TAD OCOUNT
+ IAC
+ CMA
+ DCA OUTNUM /SET NUMBER OF UNITS IN LIST
+RUNIT, JMS I [PARITY
+ JMS I [CHECK /CHECK TTY FOR CTRL/S OR CTRL/C
+ ISZ OUTNUM /DONE WITH WHOLE LIST YET?
+ SKP CLA /NO
+ JMP RLIST /YES--START THROUGH LIST AGAIN
+ ISZ OPOINT
+ TAD I OPOINT /GET UNIT CODE
+ RTL
+ SZL CLA /STILL SPINNING?
+ JMP RUNIT /NO--TRY NEXT TAPE
+ TAD I OPOINT /YES
+ DCA UNIT
+\f
+
+ TAD [-6
+ DCA COUNT
+ TAD [RTAB
+ DCA COUNT1
+ JMS I [INSERT /PUT PROPER IOT'S IN THIS ROUTINE
+ TAD I OPOINT
+ AND [4000 /UNIT/READ
+ TAD [3000 /REVERSE/GO
+IOTR1, SDLC
+ JMS I [SKIPQ
+ JMS I [SKIPQ /WAIT FOR DRIVE TO GET UP TO SPEED
+IOTR2, SDSS
+ JMP .-1
+IOTR3, SDRC /GET MARK TRACK BITS
+ AND [77
+ TAD [-22
+ SZA CLA /END ZONE?
+ JMP RUNIT /NO--NEXT UNIT
+ CLA CLL CML RTR /AC=2000
+ MQA /UNIT CODE STILL IN MQ FROM INSERT
+ DCA I OPOINT /SET STOPPED BIT
+ TAD I OPOINT
+ AND [6000
+IOTR4, SDLC /STOP UNIT
+M200, 7600 /CLA
+ ISZ COUNT2 /ALL TAPES STOPPED?
+ JMP RUNIT /NO--NEXT UNIT
+ JMS I [MESSGE /YES
+ MESS10 /@DONE@
+ JMP I [REPEAT
+
+\f
+
+PAGE
+
+/VERIFICATION ROUTINES
+
+VERIFY, TAD VB /SET POINTERS AND COUNTERS FOR TRANSFER
+ DCA BLOCKN
+ TAD NUMB2
+ DCA XNUMB
+ DCA RW
+ TAD END0 /SET BEGINNINGS OF VERIFY BUFFERS
+ DCA BUF0
+ TAD (3700
+ DCA BUFN
+ TAD CDF0
+ DCA COMP2
+ JMS I [READY /READ VERIFY BUFFERS FULL
+ TAD COUNT1 /GET # OF BLOCKS IN LAST BUFFER FILLED
+ DCA COUNT3
+ CMA /SET AUTOINDEX POINTERS TO BUFFERS
+ TAD [END
+ DCA X11
+ CMA CLL
+ TAD END0
+ DCA X12
+ TAD COUNT
+ CMA
+ TAD FIELDS
+ DCA COUNT /SET NUMBER OF FIELDS WHICH WERE FILLED
+ JMS COMP4 /GET NUMBER OF BLOCKS
+ TAD FLD0
+ CIA
+ DCA COUNT4 /SET COUNTER
+ JMS COMP /COMPARE THE BUFFERS
+\f
+COMP3, TAD COUNT
+ SNA CLA
+ JMP I [OUTN
+ JMS COMP4 /GET NUMBER OF BLOCKS
+ TAD FLDN
+ CIA
+ DCA COUNT4
+ TAD COMP2 /EACH FIELD------
+ TAD (10
+ DCA COMP2 /SET CDF INSTRUCTION PROPERLY
+ CMA CLL /SET AUTOINDEX POINTERS TO BUFFERS
+ DCA X11
+ TAD (3677
+ DCA X12
+ JMS COMP
+ JMP COMP3 /DO THE NEXT FIELD
+
+
+/ENTER WITH AC CLEAR
+/EXIT TO CALL+1 WITH AC CLEAR IF
+/NORMAL BUFFER FILL
+/EXIT TO CALL+2 WITH # OF BLOCKS IN AC IF
+/LAST BUFFER
+
+COMP4, 0
+ ISZ COUNT /LAST FIELD FILLED?
+ JMP I COMP4 /NO--RETURN--
+ TAD XNUMB /YES--OUT OF BLOCKS?
+ SZA CLA
+ JMP I COMP4 /NO--RETURN--
+ TAD COUNT3 /YES--GET ACTUAL # OF BLOCKS
+ ISZ COMP4 /INCREMENT RETURN ADDRESS
+ JMP I COMP4 /--RETURN--
+
+\f
+/COMPARE PORTION OF VERIFY ROUTINE
+
+COMP, 0
+ TAD I [MWORDS /SET NUMBER OF WORDS PER BLOCK COUNTER
+ DCA COUNT2
+COMP2, HALT /SHOULD CONTAIN CDF N
+ TAD I X11 /GET CORRESPONDING WORDS FROM EACH BUFFER
+ CIA
+ TAD I X12
+CDF0, CDF 0
+ SZA CLA /DO WORDS MATCH?
+ JMP ERR1 /NO--VERIFY ERROR
+TRY, ISZ COUNT2 /DONE WITH BLOCK?
+ JMP COMP2 /NO--CONTINUE
+ ISZ COUNT4 /DONE WITH ALL BLOCKS?
+ JMP COMP+1 /NO
+ JMP I COMP /YES--RETURN--
+
+ERR1, JMS I [MESSGE
+ ERROR1 /*VERIFY ERROR BLOCK *
+ TAD COUNT4 /GET CURRENT BLOCK NUMBER
+ CIA
+ TAD I (BLOCKS /FROM BLOCK THIS OPERATION STARTED WITH
+ JMS PRINT /PRINT 4 DIGIT BLOCK NUMBER
+ JMS I [MESSGE
+ ERROR6 /*UNIT *
+ JMS I [DECODE /PRINT UNIT NUMBER
+WAIT, JMS I [LISTEN /WAIT FOR RESPONSE
+ DCA PRINT
+ JMS I [CRLF
+ TAD PRINT
+ TAD [-224
+ SNA /WAS IT CTRL/T?
+ JMP I [WRITEX /YES--TRY AGAIN
+ TAD [2
+ SZA CLA /WAS IT CTRL/R?
+ JMP WAIT /NO--WAIT FOR A GOOD RESPONSE
+ JMP TRY /YES--IGNORE AND CONTINUE
+
+\f
+
+
+/PRINT A 4 DIGIT OCTAL NUMBER
+/ENTER WITH NUMBER IN AC
+
+PRINT, 0
+ DCA I [MESSGE /TEMPORARY STORAGE
+ TAD [-4
+ DCA I [ANSWER /SET DIGIT COUNTER
+ TAD I [MESSGE
+ RAL
+ DCA I [CRLF
+FOUR, TAD I [CRLF
+ RAL
+ RTL
+ DCA I [CRLF
+ TAD I [CRLF
+ AND [7
+ TAD [260
+ JMS I [TYPE /PRINT ONE DIGIT
+ ISZ I [ANSWER /DONE YET?
+ JMP FOUR /NO
+ JMP I PRINT /YES--RETURN--
+
+
+/CLEAN UP UNIT TABLES AFTER REWIND
+
+CLEAN, TAD LIST
+ DCA OPOINT
+ TAD OCOUNT
+ CMA
+ DCA OUTNUM /SET POINTER AND COUNTER
+CLEAN1, TAD I OPOINT /GET UNIT CODE
+ AND (4770 /MASK OUT EXTRANEOUS BITS
+ DCA I OPOINT /REPLACE IT
+ ISZ OPOINT
+ ISZ OUTNUM /DONE YET?
+ JMP CLEAN1 /NO
+ JMP I [DOIT /YES--NEXT OPERATION
+
+
+
+\f
+PAGE
+
+/FILL ALL N FIELDS ONCE
+/ENTER WITH AC CLEAR
+/# OF BLOCKS FOR FIELD 0 IN FLD0
+/# OF BLOCKS FOR OTHERS IN FLDN
+/ADDRESSES OF BUFFERS IN BUF0, BUFN
+/R/W BIT (0 OR 4000) IN RW
+
+
+
+READY, 0
+ TAD [IOTLOC-TABEND-1
+ DCA COUNT
+ TAD [IOTLOC
+ DCA COUNT1
+ JMS I [INSERT /PUT PROPER IOT'S IN HANDLER
+ TAD UNIT
+ SPA CLA /EVEN OR ODD UNIT NUMBER?
+ CLL IAC RTL /ODD
+ TAD [ORIGIN /EVEN
+ DCA ENTRY /SET UP ENTRY TO HANDLER
+ TAD RW
+ MQL /STORE UNIT BIT FOR LATER
+ CMA
+ TAD FIELDS /SET COUNTER FOR # OF FIELDS
+ DCA COUNT
+ CLL
+ TAD FLD0 /ADJUST NUMBER OF BLOCKS TO
+ JMS SUB1 /TRANSFER DEPENDING ON NUMBER
+ TAD FLD0 /LEFT TO BE TRANSFERRED
+ JMS SUB2 /RESET FUNCTION WORD
+ TAD BUF0 /SET UP BUFFER POINTERS
+ JMS SUB3
+ JMS TRANS /TRANSFER DATA--FIELD 0
+ZOOM, ISZ COUNT /BEGINNING OF LOOP FOR EACH FIELD ABOVE 0
+ SKP /DONE YET?
+ JMP I READY /YES--RETURN--
+\f
+ TAD FIELDS
+ CIA CLL
+ TAD COUNT
+ IAC
+ RAL
+ RTL /GET FIELD SETTING READY
+ MQL /STORE IN MQ
+ TAD FUNCTN /GET PREVIOUS FUNCTION WORD
+ AND [4000 /GET R/W BIT
+ MQA /OR IN FIELD SETTING
+ MQL /STORE
+ CLL
+ TAD FLDN /ADJUST NUMBER OF BLOCKS TO TRANSFER
+ JMS SUB1
+ TAD FLDN
+ JMS SUB2 /AND RESET FUNCTION WORD
+ TAD BUFN
+ JMS SUB3 /SET UP BUFFER POINTERS
+ JMS TRANS /TRANSFER DATA--FIELDS 1-N
+ JMP ZOOM /FILL ANOTHER FIELD
+
+SUB1, 0
+ CIA
+ TAD XNUMB
+ CLL CML /SET LINK=1
+ SMA /ARE THERE LESS BLOCKS LEFT THAN A FIELD FULL?
+ DCA XNUMB /NO--REDUCE COUNT OF BLOCKS LEFT
+ JMP I SUB1 /YES-TRANSFER BLOCKS LEFT--RETURN--
+
+SUB2, 0
+ DCA COUNT1 /LINK=1 IF BLOCKS LEFT, 0 IF NONE
+ SNL /DONE WITH ALL BLOCKS YET?
+ DCA XNUMB /YES--BUMP SWITCH
+ TAD COUNT1 /NO
+ BSW
+ MQA /PUT # OF BLOCKS INTO FUNCTION WORD
+ DCA FUNCTN /START REVERSE
+ JMP I SUB2 /--RETURN--
+
+\f
+SUB3, 0
+ DCA BUFADD
+ TAD BLOCKN /SET STARTING BLOCK NUMBER
+ DCA BLOCKS
+ TAD COUNT1
+ TAD BLOCKN
+ DCA BLOCKN /RESET STARTING BLOCK FOR NEXT TIME
+ JMP I SUB3 /--RETURN--
+
+
+/CALL TO THE HANDLER
+
+TRANS, 0
+ JMS I [PARITY /CHECK TELETYPE
+ JMS I [CHECK /WAS ^C OR ^S TYPED?
+ JMS I ENTRY
+FUNCTN, 0 /FUNCTION WORD
+BUFADD, 0 /BUFFER ADDRESS
+BLOCKS, 0 /STARTING BLOCK NUMBER
+ JMP ERR /ERROR RETURN
+ JMS I [PARITY /CHECK TELETYPE
+ JMS I [CHECK /WAS ^C OR ^S TYPED?
+ CLA
+ TAD XNUMB
+ SZA CLA /DONE YET?
+ JMP I TRANS /NO--RETURN--
+ ISZ COUNT
+ JMP I READY /--RETURN--
+ JMP I READY /--RETURN--
+
+/TRANSFER ERROR HANDLER
+
+ERR, SNA CLA /FATAL ERROR?
+ JMP SELECT /NO
+ JMS I [MESSGE /YES
+ ERROR2 /*TAPE ERROR BLOCK *
+ TAD I (BLOCK
+ JMS I [PRINT /PRINT BLOCK NUMBER
+ JMS I [MESSGE
+ ERROR6 /*UNIT *
+ JMS DECODE /PRINT UNIT NUMBER
+ JMS I [CRLF
+ JMP I [REWIND
+SELECT, JMS ERR3
+ ISZ FUNCTN /TURN AROUND AND TRY AGAIN
+ JMP FUNCTN-1
+
+\f
+ERR3, 0
+ JMS I [MESSGE
+ ERROR3 /*SELECT ERROR UNIT *
+ JMS DECODE /PRINT UNIT NUMBER
+ JMS CTRLR /WAIT FOR CTRL/R
+ JMP I ERR3 /--RETURN--
+
+
+/DECODE UNIT NUMBER FOR PRINTING
+/PRINT UNIT NUMBER BEFORE RETURNING
+
+DECODE, 0
+ CLL
+ TAD UNIT
+ RAL
+ MQL /SAVE ROTATED CODE IN MQ
+ RAL
+ SWP /SAVE EVEN/ODD BIT IN MQ
+ RAR /WORK ON IOT CODE
+ RTR
+ IAC
+ CMA
+ AND [7
+ MQA /INCLUDE EVEN/ODD BIT
+ TAD [260 /MAKE ASCII DIGIT
+ JMS I [TYPE
+ JMP I DECODE /--RETURN--
+
+
+PAGE
+
+\f
+/TD8E DECTAPE HANDLER
+
+/SLIGHTLY MODIFIED VERSION OF DEC-E8-UZTA-D
+/COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASSACHUSETTS 01754
+
+/THE CALLING SEQUENCE IS:
+/ JMS ENTRY
+/ FUNCTION WORD
+/ BUFFER ADDRESS
+/ STARTING BLOCK
+/ ERROR RETURN
+/ NORMAL RETURN (AC CLEAR)
+
+/FUNCTION WORD:
+/ BIT 0: 0=READ, 1=WRITE
+/ BITS 1-5: # OF BLOCKS TO BE TRANSFERRED
+/ BITS 6-8: FIELD OF BUFFER AREA
+/ BITS 9-10: UNUSED
+/ BIT 11: 1=START FORWARD, 0=START REVERSE
+
+/ERRORS:
+/THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/FATAL ERRORS:
+/ PARITY ERROR
+/ TIMING ERROR
+/ TOO GREAT A BLOCK NUMBER
+/FATAL ERRORS TAKE ERROR RETURN WITH AC=4000
+/NON-FATAL ERROR:
+/ SELECT ERROR (IMPROPER UNIT NUMBER OR NO UNIT NUMBER)
+/NON-FATAL ERROR TAKES ERROR RETURN WITH AC=0
+\fPAGE
+
+MFIELD=0
+ORIGIN=.
+
+DTA0, 0 /ENTRY POINT FROM UNIT 0
+ CLA CLL /0 TO LINK
+ JMP DTA1X
+C1000, 1000
+DTA1, 0 /UNIT 2 ENTRY
+ CLA CLL CML /1 TO LINK
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA YUNIT /LINK TO UNIT POSITION
+ RDF
+ TAD C6203 /GET DATA FIELD AND SETUP RETURN
+ DCA LEAVE
+ TAD YUNIT /GET FUNCTION WORD
+IOT4, SDLC /PUT FUNCTION INTO DATA REGISTER
+ TAD I DTA0
+IOT1, SDLD
+ CLA
+ TAD MWORDS
+ DCA WCOUNT /STORE MASTER WORD COUNT
+ ISZ DTA0 /TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /TO BLOCK NUMBER
+ TAD I DTA0
+ DCA BLOCK
+ ISZ DTA0 /POINT TO ERROR EXIT
+ CIF CDF MFIELD /TO ROUTINES DATA FIELD
+IOT2, SDRD /GET FUNCTION INTO AC
+ CLL RAL
+ AND CM200 /GET # PAGES TO XFER
+ DCA PGCT
+IOT3, SDRD
+C374, AND C70 /GET FIELD FOR XFER
+ TAD C6201 /FORM CDF N
+ DCA XFIELD /IF=0 AND DF=N AT XFER.
+ CLA CLL CMA RTL
+ DCA TRYCNT /3 ERROR TRIES
+IOT5, SDRC
+ AND C100
+ SZA CLA
+ JMP FATAL-1
+\f
+IOT6, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
+ DCA I CXFUN
+ TAD WCOUNT
+ DCA I CXWCT
+IOT7, SDRD /GET MOTION BIT TO LINK
+ CLL RAR
+ JMP GO /AND START THE MOTION.
+RWCOM, SDST /ANY CHECKSUM ERRORS?
+ SZA CLA /OR CHECKSUM ERRORS?
+ JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
+ /SET AT RWCOM. GETCHK SETS IT.
+ TAD PGCT /NO ERROR..FINISHED XFER?
+ TAD CM200
+ SNA
+ JMP EXIT /ALL DONE. GET OUT
+ DCA PGCT /NEW PAGE COUNT
+ ISZ BLOCK /NEXT BLOCK TO XFER
+ TAD WCOUNT /FORM NEXT BUFFER ADDRESS
+ CIA
+ TAD BUFF
+ DCA BUFF
+ CLL CML /FORCES MOTION FORWARD
+GO, CLA CML RTR /LINK BECOMES MOTION BIT
+ TAD C1000
+ TAD YUNIT /PUT IN 'GO' AND UNIT #
+IOT8, SDLC /LOOK FOR BLOCK NO.
+ JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
+ JMS I CRDQUD
+CM200, 7600 /COULD HAVE SAVED A LOC. HERE
+SRCH, SDSS
+ JMP .-1 /WAIT FOR SINGLE LINE FLAG
+IOT9, SDRC
+ CLL RTL /DIRECTION TO LINK. INFO BITS
+ /ARE SHIFTED.
+ AND C374 /ISOLATE MARK TRACK BITS
+ TAD M110 /IS IT END ZONE?
+ SNA /THE LINK STAYS SAME THRU THIS
+ JMP ENDZ
+ TAD M20 /CHECK FOR BLOCK MARK
+ SZA CLA
+ JMP SRCH
+IOT10, SDRD /GET THE BLOCK NUMBER
+ SZL /IF WE ARE IN REVERSE, LOOK FOR 3
+ /BLOCKS BEFORE TARGET BLOCK. THIS
+ /ALLOWS TURNAROUND AND UP TO SPEED.
+ TAD C3 /REVERSE
+ CMA
+ TAD BLOCK
+ CMA /IS IT RIGHT BLOCK?
+ SNA
+ JMP FOUND /YES..HOORAY!
+M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
+ /ABOVE SNA IS SUPERFLUOUS.
+ JMP SRCH /YES
+ENDZ, SDRC /WE ARE IN THE END ZONE
+ CLL RTL /DIRECTION TO LINK
+ CLA /ARE WE IN REVERSE?
+ JMP GO /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3, CLL CLA
+ ISZ TRYCNT
+ JMP GO /TRY 3 TIMES
+ CLL CLA
+ JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
+EXIT, ISZ DTA0
+ CLL CML /AC=0 ON NORMAL RETURN
+FATAL, TAD YUNIT
+ SDLC /STOP THE UNIT
+ CLA CML RAR
+LEAVE, HLT
+ JMP I DTA0 /--RETURN--
+
+\f
+C6201, 6201
+C6203, 6203
+CRDQUD, RDQUAD
+WCOUNT, 0
+BUFF, 0
+MWORDS, 0
+YUNIT, 0
+CXFUN, XFUNCT
+M20, -20
+PGCT, 0
+CXWCT, XWCT
+C100, 100
+TRYCNT, -3
+BLOCK=DTA1
+
+
+ *ORIGIN+170
+FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
+ JMP GO /WRONG..TURN AROUND
+ TAD YUNIT /PUT UNIT INTO LINK
+ CLL RAL /AC IS NOW 0
+C70, 70 /********DON'T MOVE THIS!!!!******
+C3, 3
+ TAD BUFF /GET BUFFER ADDRESS
+XFIELD, HLT /INTO NEXT PAGE
+
+ *ORIGIN+200
+ XUNIT=EQUFUN
+
+ DCA XBUFF
+IOT16, SDRC
+IOT17, SDLC
+ RAR /NOW GET UNIT #
+ DCA XUNIT
+REVGRD, SDSS
+ JMP REVGRD /LOOK FOR REVERSE GUARD
+IOT11, SDRC
+ AND K77
+ TAD CM32 /IS IT REVERSE GUARD?
+ SZA CLA
+ JMP REVGRD /NO.KEEP LOOKING
+ TAD XWCT
+ DCA WORDS /WORD COUNTER
+ TAD XFUNCT /GET FUNCTION READ OR WRITE
+K7700, SMA CLA
+ JMP READ /NEG. IS WRITE
+WRITE, SDRC
+ AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
+ CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
+ SZA CLA
+ JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
+ JMS RDQUAD /NO ONE EVER USES THIS WORD!
+C7600, 7600
+ TAD C1400
+ TAD XUNIT /INITIATE WRITE MODE
+IOT12, SDLC
+ CLA CMA
+ JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
+ CLA CMA
+ DCA CHKSUM
+WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
+ JMS WRQUAD
+ ISZ XBUFF /BUMP CORE POINTER
+K77, 77 /ABOVE MAY SKIP
+ ISZ WORDS /DONE THIS BLOCK?
+ JMP WRLP /NOT YET..LOOP A WHILE
+ TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
+ CLL RTR /IF NO, WRITE A 0 WORD
+ SZL CLA
+\f
+ JMS WRQUAD /WRITE A WORD OF 0
+ JMS GETCHK /DO THE CHECK SUM
+ JMS WRQUAD /WRITE FORWARD CHECKSUM
+ JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
+ JMP I CRWCOM
+
+
+READ, JMS RDQUAD
+ JMS RDQUAD
+ JMS RDQUAD /SKIP CONTROL WORDS
+ AND K77
+ TAD K7700 /TACK 7700 ONTO CHECKSUM.
+ DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP, JMS RDQUAD
+ JMS EQUFUN /COMPUT CHECKSUM AS WE GO
+ DCA I XBUFF /IT GETS CONDENSED LATER
+ ISZ XBUFF
+C300, 300 /PROTECTION
+ ISZ WORDS /DONE THIS OP?
+ JMP RDLP /NO SUCH LUCK
+ TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
+ CLL RTR /CHECKSUM THE LAST TAPE WORD
+ SNL CLA
+ JMP RDLP2
+ JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
+ JMS EQUFUN /CHECKSUM IT
+RDLP2, JMS RDQUAD /READ CHECKSUM
+ AND K7700
+ JMS EQUFUN
+ JMS GETCHK /GET SIX BIT CHECKSUM
+ JMP I CRWCOM
+
+WRQUAD, 0 /WRITE OUT A 12 BIT WORD
+ JMS EQUFUN /ADD THIS TO CHECKSUM
+IOT13, SDSQ /SKIP ON QUADLINE FLAG
+ JMP .-1
+IOT14, SDLD /LOAD DATA ONTO BUS
+ CLA /SDLD DOESN'T CLEAR AC
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT WORD
+ SDSQ
+ JMP .-1
+IOT15, SDRD /READ DATA
+ JMP I RDQUAD
+
+\f
+EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
+ AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE, WE CAN DO IT 12
+ CLL RAL /BITS AT A TIME AND CONDENSE LATER.
+ TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
+ TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EQUFUN
+
+GETCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CHKSUM
+ CMA
+ CLL RTL
+ RTL
+ RTL
+ JMS EQUFUN
+ CLA CLL CML /FORCES LINK ON AT RWCOM
+ TAD CHKSUM
+ AND K7700
+ JMP I GETCHK
+
+CFATAL, FATAL
+CRWCOM, RWCOM
+XFUNCT, 0
+CM32, -32
+C1400, 1400
+CHKSUM, 0
+WORDS, 0
+XBUFF, 0
+XWCT, 0
+EQUTMP, 0
+
+\fPAGE
+/
+/
+PARITY, 0
+ KRB
+ AND [177
+ TAD [200
+ JMP I PARITY
+
+/IOT TABLES FOR TD8E SUBROUTINE
+
+IOTLOC, IOT1
+ IOT2
+ IOT3
+ IOT4
+ IOT5
+ IOT6
+ IOT7
+ RWCOM
+ IOT8
+ SRCH
+ IOT9
+ IOT10
+ ENDZ
+ FATAL+1
+ REVGRD
+ IOT11
+ WRITE
+ IOT12
+ IOT13
+ IOT14
+ RDQUAD+1
+ IOT15
+ IOT16
+TABEND, IOT17
+
+UNITS=.
+ UNIT01
+ UNIT23
+ UNIT45
+ UNIT67
+
+RTAB, IOTR1
+ IOTR2
+ IOTR3
+ IOTR4
+ IOTR5
+ IOTR6
+
+
+/IOT TABLES FOR WORDS PER BLOCK ROUTINE
+
+TABLE1, IOTX1
+ IOTX2
+ IOTX3
+ IOTX4
+ IOTX5
+ IOTX6
+ IOTX7
+END1, IOTX8
+
+\fMESSG4, TEXT @FROM UNIT:@
+MESSG5, TEXT @TO UNITS:@
+ERROR5, TEXT @ILLEGAL FORMAT UNIT @
+ERROR6, TEXT @ UNIT @
+ERROR4, TEXT @ILLEGAL RESPONSE@
+
+\f
+PAGE
+/ONCE ONLY CODE
+
+END, JMS I (QUEST
+ MESSG2 /@HIGHEST FIELD AVAILABLE:@
+ ACL
+ AND [7
+ CIA
+ DCA FIELDS
+ TAD (CDF
+ DCA CDF00
+ TAD FIELDS
+ SNA /MORE THAN 1 FIELD??
+ JMP LIM /NO--NO PROBLEM
+ DCA COUNT1 /YES--ARE THEY ALL PRESENT?
+NEXT, TAD CDF00
+ TAD (10
+ DCA CDF00 /SET FOR DATA FIELD CHANGE
+ TAD (HLT
+CDF00, CDF
+ DCA I (10 /TRY LOCATION 10
+ TAD I (10
+ CDF 0
+ CIA
+ TAD (HLT
+ SNA CLA /IS FIELD THERE?
+ JMP NEXT1 /YES--TRY NEXT ONE
+ JMS I [MESSGE /NO
+ ERROR4 /ILLEGAL RESPONSE
+ JMS I [CRLF /CARRIAGE RETURN/LINE FEED
+ DCA COUNT /CLEAR COUNT
+ JMP END /TRY AGAIN
+NEXT1, ISZ COUNT1 /DONE YET?
+ JMP NEXT /NO
+
+LIM, TAD (LIMIT-END /SET BEGINNING OF VERIFY BUFFER
+ CLL RAR
+ TAD [END
+ DCA END0
+ TAD (NOP
+ DCA I (START1-1
+ JMP I (START1
+MESSG2, TEXT @HIGHEST FIELD AVAILABLE:@
+
+FIELD 0
+*200
+
+$
+\f\f
--- /dev/null
+/2 TD8E INITIALIZER PROGRAM, V7A
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1975, 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f
+/DECEMBER 21, 1973 GB/RL/EF/SR
+
+/ABSTRACT--
+/ THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH OS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+
+/ EXPLANATION:
+
+/THIS IS A SAVE FILE, WHICH MUST BE PLACED AS FILE # 1
+/ON THE OS/8 BINARIES TAPE. (I.E. BLOCK 7)
+/FOLLOWING IT MUST BE THE FOLLOWING FILES, EACH 50 (DEC) BLKS LONG:
+/TDROM.SY
+/TD12K.SY
+/
+/TO CREATE SPECIAL BLOCK 0 FOR THAT TAPE, START THIS PROGRAM AT
+/LOCATION 200 AND FOLLOW INSTRUCTIONS.
+
+/TO THEN PERFORM THE INITIALIZATION FROM THE LIBRARY TAPES,
+/MERELY PLACE THE BINARY TAPE ON UNIT 0 AND BOOTSTRAP INTO IT.
+/THEN FOLLOW INSTRUCTIONS.
+
+/FILES TDROM.SY AND TD12K.SY ARE MERELY SYSTEM HEADS OF THE
+/APPROPRIATE SYSTEMS, THEY MAY CONTAIN ANY HANDLERS.
+
+/THE BLOCK 0 SPECIAL SECONDARY BOOTSTRAP READS IN THE FIRST
+/3 PAGES OF TDINIT (WORDS 200-777) AND BRANCHES TO 'STARTUP'.
+/THIS THEN READS IN THE REMAINDER OF TDINIT WITH ERROR CHECKING.
+
+/CODE LOC BLOCK ON BINARY TAPE
+
+/CCB 16,17 (THESE ARE DECTAPE BLOCK NUMBERS, NOT OS/8 RECORDS)
+/0 20 SKIPPED BY BLOCK 0
+/200 21
+/400 22
+/600 23
+/1000 24
+/1200 25
+/1400 26
+/1600 27
+/2000 30
+/2200 31 TDINIT MUST HAVE USEFUL PART END AT OS/8 RECORD 75
+/7400 32,33 RECORD 15 CONTAINS IMAGE OF BLOCK 0
+
+/FIXES SINCE FIELD-TEST RELEASE:
+
+/1. FIXED BUG RE CLA ON RETRY AFTER ERROR
+/2. ALLOWED FINAL BOOTSTRAP TO BE INTO A WRITE-LOCKED DEVICE
+
+/OS/8 V3D CHANGES:
+
+/3. FIXED BUG RE TD8E BUILD (V6B PATCH)
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+ DRIVE=10 /UNITS 0 AND 1 SELECTED
+ ORIGIN=400 /ENTER AT ORIGIN, ORIGIN+4
+ AFIELD=0 /INITIAL FIELD SETTING
+ MFIELD=00 /AFIELD*10=MFIELD
+ WDSBLK=201 /129 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/ DRIVE=10 IMPLIES UNITS 0 &1
+/ DRIVE=20 IMPLIES UNITS 2&3
+/ DRIVE=30 IMPLIES UNITS 4&5
+/ DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/ MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/ LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/ THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/ THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE
+/ IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/ 128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/ BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/ FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/ FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/ DRIVE=20
+/ ORIGIN=3000
+/ AFIELD=2
+/ MFIELD=20
+/ WDSBLK=400
+\f/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR OS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/ CDF CURRENT
+/ CIF MFIELD /MFIELD=FIELD ASSEMBLED IN
+/ JMS ENTRY /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+ /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/ ARG1
+/ ARG2
+/ ARG3
+/ ERROR RETURN
+/ NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD BIT0: 0=READ, 1=WRITE
+/ BITS 1-5: # BLOCKS IN OPERATION
+/ BITS 6-8: FIELD OF BUFFER AREA
+/ BIT 9: UNUSED
+/ BIT 10: # OF WORDS/BLOCK.
+/ 0= WDSBLK, 1=WDSBLK-1
+/ BIT 11: 1=START FORWARD, 0=REVERSE
+
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/ TOO GREAT A BLOCK NUMBER
+/ FATAL ERRORS TAKE ERROR RETURN WITH THE
+/ AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/ IF NO PROPER UNIT IS SELECTED, THE ERROR
+/ RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+
+/THE TD8E IOT'S ARE:
+ SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+ SDST=7002-DRIVE /SKIP ON TIMING ERROR
+ SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+ SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+ SDLD=7005-DRIVE /LOAD DATA REGISTER
+ SDRC=7006-DRIVE /READ COMMAND REGISTER
+ SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+\f INITLN=7 /LENGTH OF TDINIT INCLUDING BLOCK 0 IMAGE (IN BLOCKS)
+ CTRLO=20
+ INCHAR=21
+ TEMPA=22
+
+ST, CLA /IN CASE CHAINED TO
+ JMP I (CREATE /CREATE BLOCK 0 -IN HOUSE ONLY -
+STARTUP,JMS I (DTA0 /TD8E S.R. IS IN 200 NOW
+ 603 /READ 3 BLOCKS INTO 1000-2377
+ 1000
+ 24 /GET REST OF INIT
+ JMP FERR /REALLY BAD!
+ TAD (SKP CLA
+ DCA ST /ALLOWS HIM TO RESTART AT 200
+RE, JMS MSG
+ VNO
+ JMS I (CHKCOR /USE ROM OR 12K SYSTEM
+ JMS MSG
+ INIT
+ JMS I (MOVSYS
+ JMS MSG
+ SWTCH
+ JMS TTY /PAUSE
+ TAD INCHAR
+ TAD (-32
+ SNA CLA
+ JMP I (ZERO /HE TYPED ^Z
+CPY, JMS MSG
+ COPY
+ TAD (160
+ DCA B1
+ TAD (160
+ DCA B2
+RD, JMS I (DTA0
+ 3612
+ 0
+B1, 0
+ JMS I (ER1
+ JMS I (DTA1
+ 7612
+ 0
+B2, 0
+ JMS I (ER1
+ TAD B1
+ TAD (36
+ DCA B1
+ TAD B1
+ DCA B2
+ TAD B1 /COPY OVER ABOVE 2700
+ TAD (-2600 /***
+ SPA CLA
+ JMP RD /KEEP GOING
+ JMS I (DTA0 /COPY DIRECTORY
+ 1412
+ 0
+ 2
+ JMS I (ER1
+ JMS I (DTA1
+ 5412
+ 0
+ 2
+ JMS I (ER1
+RESTRT, JMS MSG
+ DISMNT /SETUP TAPES FOR INIT
+ JMS TTY
+ JMP I (BOOT
+\fTTY, 0
+ JMS MSG
+ STRIKE
+ KCC
+ KSF
+ JMP .-1
+ KRB
+ AND (177
+ DCA INCHAR
+ JMP I TTY
+
+MSG, 0 /MESSAGE TYPER
+ DCA CTRLO
+ JMS I (CRLF
+ TAD I MSG
+ DCA TEMPA
+ ISZ MSG
+WTMSG, TAD I TEMPA
+ CLL RTR;RTR;RTR
+ JMS PNCH
+ TAD I TEMPA
+ JMS PNCH
+ ISZ TEMPA
+ JMP WTMSG
+
+PNCH, 0
+ AND (77
+ SNA /IGNORE NULL. _ MEANS CR/LF
+ JMP I PNCH /? MEANS TERMINATE
+ TAD (-37 /IS IT _?
+ SNA
+ JMS I (CRLF /YES
+ TAD (-40 /MAYBE ?
+ SNA
+ JMP I MSG
+ TAD (40
+ SPA
+ TAD (100
+ TAD (237
+ JMS I (TTYOUT
+ JMP I PNCH
+\fFERR, HLT
+ CLA
+ JMP STARTUP
+ PAGE
+\f/ THIS HANDLER USES DECTAPE BLOCKS NOT OS/8 BLOCKS !
+
+ *ORIGIN
+
+DTA0, 0 /ENTRY POINT FROM UNIT 0
+ CLA CLL /0 TO LINK
+ JMP DTA1X
+C1000, 1000
+BLOCK,
+DTA1, 0 /UNIT 2 ENTRY
+ CLA CLL CML /1 TO LINK
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /LINK TO UNIT POSITION
+ RDF
+ TAD C6203 /GET DATA FIELD AND SETUP RETURN
+ DCA LEAVE
+ TAD I DTA0 /GET FUNCTION WORD
+ SDLD /PUT FUNCTION INTO DATA REGISTER
+ CLL RTR /AC STILL HAS FUNCTION. PUT # WORDS PER
+ /BLOCK INTO LINK
+ SZL CLA /KNOCK ONE OFF WDSBLK?
+ IAC /YES
+ TAD MWORDS
+ DCA WCOUNT /STORE MASTER WORD COUNT
+ ISZ DTA0 /TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /TO BLOCK NUMBER
+ TAD I DTA0
+ DCA BLOCK
+ ISZ DTA0 /POINT TO ERROR EXIT
+ CIF CDF MFIELD /TO ROUTINES DATA FIELD
+ SDRD /GET FUNCTION INTO AC
+ CLL RAL
+ AND CM200 /GET # PAGES TO XFER
+ DCA PGCT
+ SDRD
+C374, AND C70 /GET FIELD FOR XFER
+ TAD C6203 /FORM CDF N
+ DCA XFIELD /IF=0 AND DF=N AT XFER.
+ CLA CLL CMA RTL
+ DCA TRYCNT /3 ERROR TRIES
+ TAD UNIT /TEST FOR SELECT ERROR
+ SDLC
+ SDRC
+ AND C100
+ SZA CLA
+ JMP FATAL-1
+ SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
+ DCA I CXFUN
+ TAD WCOUNT
+ DCA I CXWCT
+ SDRD /GET MOTION BIT TO LINK
+ CLL RAR
+ JMP GO /AND START THE MOTION.
+RWCOM, SDST /ANY CHECKSUM ERRORS?
+ SZA CLA /OR CHECKSUM ERRORS?
+ JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
+ /SET AT RWCOM. GETCHK SETS IT.
+ TAD PGCT /NO ERROR..FINISHED XFER?
+ TAD CM200
+ SNA
+ JMP EXIT /ALL DONE. GET OUT
+ DCA PGCT /NEW PAGE COUNT
+ ISZ BLOCK /NEXT BLOCK TO XFER
+ TAD WCOUNT /FORM NEXT BUFFER ADDRESS
+ CIA
+ TAD BUFF
+ DCA BUFF
+ CLL CML /FORCES MOTION FORWARD
+GO, CLA CML RTR /LINK BECOMES MOTION BIT
+ TAD C1000
+ TAD UNIT /PUT IN 'GO' AND UNIT #
+ SDLC /LOOK FOR BLOCK NO.
+ JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
+ JMS I CRDQUD
+CM200, 7600 /COULD HAVE SAVED A LOC. HERE
+SRCH, SDSS
+ JMP .-1 /WAIT FOR SINGLE LINE FLAG
+ SDRC
+ CLL RTL /DIRECTION TO LINK. INFO BITS
+ /ARE SHIFTED.
+ AND C374 /ISOLATE MARK TRACK BITS
+ TAD M110 /IS IT END ZONE?
+ SNA /THE LINK STAYS SAME THRU THIS
+ JMP ENDZ
+ TAD M20 /CHECK FOR BLOCK MARK
+ SZA CLA
+ JMP SRCH
+ SDRD /GET THE BLOCK NUMBER
+ SZL /IF WE ARE IN REVERSE, LOOK FOR 3
+ /BLOCKS BEFORE TARGET BLOCK. THIS
+ /ALLOWS TURNAROUND AND UP TO SPEED.
+ TAD C3 /REVERSE
+ CMA
+ TAD BLOCK
+ CMA /IS IT RIGHT BLOCK?
+ SNA
+ JMP FOUND /YES..HOORAY!
+M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
+ /ABOVE SNA IS SUPERFLUOUS.
+ JMP SRCH /YES
+ENDZ, SDRC /WE ARE IN THE END ZONE
+ CLL RTL /DIRECTION TO LINK
+ CLA /ARE WE IN REVERSE?
+ JMP GO /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3, CLA
+ ISZ TRYCNT
+ JMP GO /TRY 3 TIMES
+ JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
+EXIT, ISZ DTA0
+ CLL CML /AC=0 ON NORMAL RETURN
+FATAL, TAD UNIT
+ SDLC /STOP THE UNIT
+ CLA CML RAR
+LEAVE, HLT
+ JMP I DTA0
+
+\fC6203, 6203
+CRDQUD, RDQUAD
+WCOUNT, 0
+BUFF, 0
+MWORDS, -WDSBLK
+UNIT, 0
+CXFUN, XFUNCT
+M20, -20
+PGCT, 0
+CXWCT, XWCT
+C100, 100
+TRYCNT, -3
+
+
+ *ORIGIN+170
+FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
+ JMP GO /WRONG..TURN AROUND
+ TAD UNIT /PUT UNIT INTO LINK
+ CLL RAL /AC IS NOW 0
+C70, 70 /********DON'T MOVE THIS!!!!******
+C3, 3
+ TAD BUFF /GET BUFFER ADDRESS
+XFIELD, HLT /INTO NEXT PAGE
+\f *ORIGIN+200
+ CIF MFIELD
+ DCA XBUFF /SAVE ADDRESS
+ RAR /NOW GET UNIT #
+ DCA XUNIT
+ SDRC
+ SDLC
+REVGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD
+ SDRC
+ AND K77
+ TAD CM32 /IS IT REVERSE GUARD?
+ SZA CLA
+ JMP REVGRD /NO.KEEP LOOKING
+ TAD XWCT
+ DCA WORDS /WORD COUNTER
+ TAD XFUNCT /GET FUNCTION READ OR WRITE
+K7700, SMA CLA
+ JMP READ /NEG. IS WRITE
+WRITE, SDRC
+ AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
+ CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
+ SZA CLA
+ JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
+ JMS RDQUAD /NO ONE EVER USES THIS WORD!
+C7600, 7600
+ TAD C1400
+ TAD XUNIT /INITIATE WRITE MODE
+ SDLC
+ CLA CMA
+ JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
+ CLA CMA
+ DCA CHKSUM
+WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
+ JMS WRQUAD
+ ISZ XBUFF /BUMP CORE POINTER
+K77, 77 /ABOVE MAY SKIP
+ ISZ WORDS /DONE THIS BLOCK?
+ JMP WRLP /NOT YET..LOOP A WHILE
+ TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
+ CLL RTR /IF NO, WRITE A 0 WORD
+ SZL CLA
+ JMS WRQUAD /WRITE A WORD OF 0
+ JMS GETCHK /DO THE CHECK SUM
+ JMS WRQUAD /WRITE FORWARD CHECKSUM
+ JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
+ JMP I CRWCOM
+\fREAD, JMS RDQUAD
+ JMS RDQUAD
+ JMS RDQUAD /SKIP CONTROL WORDS
+ AND K77
+ TAD K7700 /TACK 7700 ONTO CHECKSUM.
+ DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP, JMS RDQUAD
+ JMS EQUFUN /COMPUT CHECKSUM AS WE GO
+ DCA I XBUFF /IT GETS CONDENSED LATER
+ ISZ XBUFF
+C300, 300 /PROTECTION
+ ISZ WORDS /DONE THIS OP?
+ JMP RDLP /NO SUCH LUCK
+ TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
+ CLL RTR /CHECKSUM THE LAST TAPE WORD
+ SNL CLA
+ JMP RDLP2
+ JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
+ JMS EQUFUN /CHECKSUM IT
+RDLP2, JMS RDQUAD /READ CHECKSUM
+ AND K7700
+ JMS EQUFUN
+ JMS GETCHK /GET SIX BIT CHECKSUM
+ JMP I CRWCOM
+
+WRQUAD, 0 /WRITE OUT A 12 BIT WORD
+ JMS EQUFUN /ADD THIS TO CHECKSUM
+ SDSQ /SKIP ON QUADLINE FLAG
+ JMP .-1
+ SDLD /LOAD DATA ONTO BUS
+ CLA /SDLD DOESN'T CLEAR AC
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT WORD
+ SDSQ
+ JMP .-1
+ SDRD /READ DATA
+ JMP I RDQUAD
+
+\fXUNIT,
+EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
+ AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE, WE CAN DO IT 12
+ CLL RAL /BITS AT A TIME AND CONDENSE LATER.
+ TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
+ TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EQUFUN
+
+GETCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CHKSUM
+ CMA
+ CLL RTL
+ RTL
+ RTL
+ JMS EQUFUN
+ CLA CLL CML /FORCES LINK ON AT RWCOM
+ TAD CHKSUM
+ AND K7700
+ JMP I GETCHK
+
+CFATAL, FATAL
+CRWCOM, RWCOM
+XFUNCT, 0
+CM32, -32
+C1400, 1400
+CHKSUM, 0
+WORDS, 0
+XBUFF, 0
+XWCT, 0
+EQUTMP, 0
+\fTBL, CPY
+ ZER
+ LVAL
+ PAGE
+\fCREATE, JMS I (MSG
+ WRITOUT
+ JMS I (TTY
+ JMS I (DTA1
+ 4202
+ 7400
+ 0
+ JMS ER1
+ JMS I (MSG
+ OK
+ HLT
+ JMP I (7605
+ ROMSW=17
+
+/THIS ROUTINE COPIES THE SYSTEM ONTO UNIT 1.
+/IT COPIES FROM A SYSTEM HEAD FILE ON TAPE ON UNIT 0.
+/UNIT 0 MUST BE THE OS/8 BINARIES TAPE
+/1ST FILE: TDINIT.PA
+/2ND FILE: TDROM.SY
+/3RD FILE: TD12K.SY
+
+MOVSYS, 0
+ JMS I (TTY
+ TAD ROMSW /GET ADDRESS OF START OF SYSTEM HEAD
+ SNA CLA
+ TAD (62^2 /12 K
+ TAD (7+INITLN^2 /ROM
+ DCA HEAD
+ JMS I (DTA0 /READ PAGE 0
+ 212
+ 0
+HEAD, HLT
+ JMS ER1
+ CDF 10
+ TAD I (200
+ CDF 0
+ TAD (-4207 /CHECK FOR GOOD SYSTEM HEAD
+ SZA CLA
+ JMP WRGSYS
+ JMS I (DTA1
+ 4212
+ 0
+ 0
+ JMS ER1
+ STL CLA RTL /2
+ TAD HEAD
+ DCA KBM
+ JMS I (DTA0
+ 0012 /READ 40 SYSTEM BLOCKS 7-26 (PAGES 16-55)
+ 0
+KBM, HLT
+ JMS ER1
+ JMS I (DTA1
+ 4012
+ 0
+ 7^2 /WRITE KBM ETC
+ JMS ER1
+ TAD HEAD
+ TAD (43^2
+ DCA CD
+ JMS I (DTA0
+ 3613 /READ 51-67 (PAGES 122-157)
+ 0
+CD, HLT
+ JMS ER1
+ JMS I (DTA1
+ 7613
+ 0
+ 43+6^2
+ JMS ER1
+ JMP I MOVSYS
+\fWRGSYS, JMS I (MSG
+ WRONG
+ JMS I (TTY
+ JMP I (CPY
+
+ER1, 0
+ CLA
+ JMS I (MSG
+ IOERR
+ JMS I (TTY
+ TAD I (INCHAR
+ TAD (-101
+ SNA CLA /A?
+ JMP I (RE /YES, ABORT
+ TAD ER1
+ TAD (-5
+ DCA ER1 /BACK UP, POINT TO CALL
+ JMP I ER1 /RETRY
+
+CRLF, 0
+ TAD (215
+ JMS TTYOUT
+ TAD (212
+ JMS TTYOUT
+ JMP I CRLF
+
+TTYOUT, 0
+ DCA TM
+ JMS I (TSTKBD
+ TAD CTRLO
+ SZA CLA
+ JMP I TTYOUT
+ TAD TM
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYOUT
+\fTM, 0
+ PAGE
+\fCHKCOR, 0 /DETERMINE CONFIGURATION
+ CDF 70 /CHECK FOR ROM
+ TAD I (7503
+ TAD (-SDSS
+ SZA CLA
+ JMP TRY12K
+ CDF 0
+ JMS I (MSG
+ ROM8K
+ CLA IAC
+ENTR12, DCA ROMSW /SET INDICATOR
+ CDF 0
+ JMP I CHKCOR
+TRY12K, CDF 20
+ TAD ENTR12
+ DCA I (7600
+ TAD I (7600
+ CIA
+ TAD ENTR12
+ CDF 0
+ SNA CLA
+ JMP OK12
+ JMS I (MSG
+ HRDWR /NO HARDWARE AROUND!
+ HLT
+ JMP .-1
+OK12, JMS I (MSG
+ TD8E12
+ JMP ENTR12
+\fIN, 0
+
+ZERO, JMS I (MSG
+ SPECIAL
+ JMS I (TTY
+ TAD INCHAR
+ TAD (-62
+ DCA IN
+ TAD IN
+ SPA
+ CIA
+ CLL RAR /ALLOW ONLY -1, 0, 1
+ SZA CLA
+ JMP ZERO+1
+ TAD IN
+ TAD (TBL+1
+ DCA IN
+ TAD I IN
+ DCA IN
+ JMP I IN /JUMP TO APPROPRIATE ROUTINE
+
+ZER, JMS I (MSG
+ ZERY
+ JMS I (DTA1
+ 4202
+ MTDIR
+ 2
+ JMS I (ER1
+ JMP I (RESTRT
+
+LVAL, JMS I (MSG
+ PRES
+ JMP I (RESTRT
+\fMTDIR, -1
+ 70 /SYSTEM TAPE
+ 0
+ 0
+ -1 /1 EMPTY FILE
+ 0
+ 6437+70 /-LENGTH OF DECTAPE
+
+BOOT, TAD ROMSW
+ SNA CLA
+ JMP TDBOOT
+ JMS I (DTA0 /ROM BOOT
+ 202
+ 7400
+ 0 /READ IN BLOCK 0
+ JMS I (ER1
+ TAD (CDF 10
+ JMS MOVE
+ 7400
+ JMP I (7605
+
+TDBOOT, JMS I (DTA0
+ 202
+ 7400
+ 0
+ JMS I (ER1
+ JMS I (DTA0
+ 202
+ 7000
+ 66^2
+ JMS I (ER1
+ TAD (CDF 10
+ JMS MOVE
+ 7000
+ TAD (CDF 20
+ JMS MOVE
+ 7200
+ JMP I (7605
+\f XRIN=11
+ XROUT=12
+
+MOVE, 0
+ DCA MOVCDF
+ STA
+ TAD I MOVE
+ DCA XRIN
+ TAD (-200 /MOVE 200 WORDS TO LOCATION 7600
+ DCA MVCNT
+ ISZ MOVE
+ TAD (7577
+ DCA XROUT
+MOVLUP, TAD I XRIN
+MOVCDF, HLT
+ DCA I XROUT
+ CDF 0
+ ISZ MVCNT
+ JMP MOVLUP
+ JMP I MOVE
+
+MVCNT, -200
+ PAGE
+\fVNO, TEXT /TD8E INITIALIZER PROGRAM VERSION 7A ?/
+INIT, TEXT /MOUNT A CERTIFIED DECTAPE ON UNIT 1 WRITE-ENABLED_/
+ TEXT /ALWAYS KEEP ORIGINAL SYSTEM DECTAPES WRITE-LOCKED?/
+STRIKE, TEXT /STRIKE A CHARACTER TO CONTINUE?/
+DISMNT, TEXT /REMOVE AND SAVE TAPE ON UNIT 0_/
+ TEXT /TAKE NEW TAPE (ON UNIT 1) WHICH WAS JUST CREATED_/
+ TEXT /AND PLACE IT ON UNIT 0_/
+ TEXT \IT IS YOUR NEW OS/8 SYSTEM TAPE?\
+SWTCH, TEXT /DISMOUNT SYSTEM TAPE #2 FROM UNIT 0 AND SAVE IT_/
+ TEXT /MOUNT ORIGINAL SYSTEM TAPE #1 ON UNIT 0_/
+ TEXT /PREPARE TO COPY FILES OVER?/
+OK, TEXT /OK?/
+WRITOUT,TEXT /READY TO CREATE BLOCK 0 OF UNIT 1?/
+COPY, TEXT /COPYING FILES FROM UNIT 0 TO UNIT 1?/
+ZERY, TEXT /ZEROING DIRECTORY ON TAPE UNIT 1?/
+PRES, TEXT /DIRECTORY ON UNIT 1 PRESERVED?/
+WRONG, TEXT /NOT ORIGINAL OS8 SYSTEM TAPE #2_/
+ TEXT /MOUNT CORRECT TAPE ON UNIT 0?/
+ROM8K, TEXT /8K ROM SYSTEM?/
+TD8E12, TEXT /12K SYSTEM?/
+HRDWR, TEXT /NEED ROM OR 12K?/
+IOERR, TEXT /FATAL IO ERR_/
+ TEXT /TYPE A TO ABORT AND START OVER AGAIN_/
+ TEXT \TYPE ANY OTHER CHARACTER TO RETRY THIS I/O OPERATION?\
+SPECIAL,TEXT /TYPE 1 TO COPY FILES FROM UNIT 0 TO UNIT 1_/
+ TEXT /TYPE 2 TO ZERO THE DIRECTORY OF UNIT 1_/
+ TEXT /TYPE 3 TO LEAVE THE DIRECTORY OF UNIT 1 ALONE?/
+\fTSTKBD, 0
+ KSF
+ JMP I TSTKBD
+ KRS
+ AND (177
+ TAD (-3
+ SNA
+ JMP I (RE /^C
+ TAD (3-17
+ SZA CLA
+ JMP NO
+ CLA IAC
+ DCA CTRLO
+NO, KCC
+ JMP I TSTKBD
+ PAGE
+\f/TD8E SYSTEM INITIALIZER
+/THIS CODE IS PLACED ON THE BINARY TAPE
+/IN RECORD 0. WHEN THE 7470 OR STANDARD TD8E BOOTSTRAP
+/IS EXECUTED, THIS PROGRAM READS THE REST OF THE INIT
+/SYSTEM FROM THE FIRST FILE ON THE TAPE, AND
+/STARTR EXECUTION OF IT. A SHORT PROGRAM IS HERE
+/INCLUDED TO WRITE RECORD 0 ON THE TAPE. THE START ADDRESS
+/OF THAT CODE IS 200.
+
+SDSS=6771
+SDST=6772
+SDSQ=6773
+SDLC=6774
+SDLD=6775
+SDRC=6776
+SDRD=6777
+ *7420
+ NOPUNCH
+ *7400
+ ENPUNCH
+ TAD K177 /INIT FOR TAPE READ
+ DCA 10
+NUBLK, TAD KM200 /SET BLOCK WORD COUNT
+ DCA WCNT
+NOT, JMS GET /GET BLOCK # FORWARD
+ -26
+ SDRD /THE RIGHT ONE?
+ AND KK77
+ TAD BLOCKK
+ SZA CLA
+ JMP NOT /I GUESS NOT
+ JMS GET /RIGHT. NOW GET REV. GUARD
+ -32
+ JMS RQD
+ JMS RQD
+ JMS RQD
+LP, JMS RQD
+ DCA I 10 /READ THE INIT PROGRAM
+ ISZ WCNT
+ JMP LP
+ ISZ BCNT /DONE ALL BLOCKS?
+ JMP CONT
+ SDLC
+ JMP I .+1
+ STARTUP
+CONT, CLA CMA /SET FOR NEXT BLOCK
+ TAD BLOCKK
+ DCA BLOCKK
+ JMP NUBLK
+
+RQD, 0
+ SDSQ
+ JMP .-1
+ SDRD
+ JMP I RQD
+\fGET, 0 /PICK UP A SPECIFIED TAPE FRAME
+ TAD I GET /HOLDS 6 BIT MARK TRACK I.D.
+ DCA RQD
+GTIT, SDSS
+ JMP .-1
+ SDRC /FLAG IS UP. READ MARK TRACK
+ AND KK77
+ TAD RQD /A MATCH?
+ SZA CLA
+ JMP GTIT
+ ISZ GET
+ JMP I GET
+
+KK77, 77
+KM200, -200
+BLOCKK, -21 /SKIP CORE CONTROL BLOCK AND PAGE 0
+WCNT, -200
+K177, 177
+BCNT, -3
+ *200
+ $
--- /dev/null
+/16 TM8-E MAGTAPE HANDLER FOR OS/8
+
+
+
+
+
+
+
+
+
+
+/
+/
+/COPYRIGHT (C) 1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+\f LWCR=6701 /LOAD WORD COUNT REGISTER AND CLEAR AC
+ LCAR=6703 /LOAD CURRENT ADDRESS REGISTER AND CLEAR AC
+ LCMR=6705 /LOAD COMMAND REGISTER AND CLEAR AC
+ LFGR=6706 /LOAD FUNCTION REGISTER AND CLEAR AC
+ CLT=6712 /CLEAR TRANSPORT
+ RMSR=6714 /CLEAR AC AND READ MAIN STATUS REGISTER
+ RFSR=6716 /CLEAR AC AND READ STUFF
+ SKEF=6721 /SKIP IF ERROR FLAG IS SET
+ SKJD=6723 /SKIP IF THE JOB IS DONE (MTTF IS SET)
+ SKTR=6724 /SKIP IF TAPE UNIT READY (TUR TRUE)
+
+ MTAVERSION="F&77
+
+/SPECIAL CODES USED WHEN PAGE COUNT=0 (CODES IN BITS 9-11 OF FN WORD)
+
+/0 (CLOSE) WRITE 2 EOF'S
+/1 REWIND
+/2 SPACE FORWARD/REVERSE RECORDS
+/ IF BIT 0 OF THE FUNCTION WORD IS A 0,
+/ THIS CODE ADVANCES RECORDS.
+/ THE NEGATIVE OF THE NUMBER OF RECODRDS IS SPECIFIED IN ARG 3
+/ IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/ THIS CODE BACKSPACES RECORDS.
+/ THE NEGATIVE OF THE NUMBER OF RECORDS IS SPECIFIED AS ARG 3.
+/ UNDER NO CIRCUMSTANCES DOES THIS COMMAND CONTINUE PAST A FILE MARK.
+/3 SPACE FORWARD/REVERSE FILES
+/ IF BIT 0 OF THE FUNCTION WORD IS A 0
+/ THEN THIS FUNCTION ADVANCE FILE MARKS
+/ THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG3
+/ THE TAPE IS LEFT POSITIONED AFTER THIS FILE MARK
+/ BUT UNDER NO CIRCUMSTANCES DOES THE TAPE ADVANCE PAST
+/ THE SECOND MARK OF TWO CONSECUTIVE FILE MARKS
+/ IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/ THIS CODE BACKSPACES PAST FILE MARKS.
+/ THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG 3.
+/ THE TAPE IS LEFT POSITIONED BEFORE THE LAST FILE MARK,
+/ SO THE USER PROBABLY WANTS TO DO A FORWARD RECORD NEXT.
+/4 REWIND AND PUT OFF-LINE
+/5 WRITE EOF
+/6 PERFORM OPERATION WITH SPECIFIED BLOCKSIZE
+/ THE NEGATIVE OF THE DESIRED BLOCKSIZE IS SPECIFIED AS ARG 3.
+/7 CURRENTLY UNUSED
+
+/NOTE: SKIP TO EOD CAN BE PERFORMED BY SKIPPING 4096 FILES
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. MAJOR CODE OVERHAUL
+/2. SKIP RECORDS RETURNS NON-FATAL ERROR IF IT DETECTS FILE MARK
+/3. SKIP FORWARD FILES NEVER EVER PASSES EOD
+/4. SKIP FORWARD FILES RETURNS ERROR IF IT STARTS IMMEDIATELY
+/ BEFORE A FILE MARK (UNLESS IT'S AT BOT)
+/ IT THEN REMAINS BEFORE THE FILE MARK
+/5. FIXED TIMING PROBLEM FOR TS03
+/6. CHANGED ORDER OF TEST FOR DATA DURING SKIP FORWARD FILES
+/7. MADE UNUSED FUNCTION CODE 7 ACT SAME AS 0
+\f
+/BUILD DESCRIPTOR BLOCK
+
+ *0
+
+ -10 /8 ENTRY POINTS
+
+DEVICE TM8E;DEVICE MTA0;200;MTA0&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA1;200;MTA1&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA2;200;MTA2&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA3;200;MTA3&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA4;200;MTA4&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA5;200;MTA5&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA6;200;MTA6&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA7;200;MTA7&177+4000;ZBLOCK 2
+\f *200
+
+PARITY, 402 /CHANGE TO 2 TO HAVE EVEN PARITY
+BLOCK0, 0 /SET TO 1 TO INHIBIT REWIND ON BLOCK 0
+MTATAD, TAD MTA0 /USED TO MAKE HANDLER SERIALLY REUSABLE
+ /CONTENTS MUST BE 13XX [V3C]
+MTISZ, ISZ MTANO /DITTO
+STOP, ISZ MTHX
+MTEXIT, HLT /CIF CDF TO USER'S FIELD
+ JMP I MTHX
+
+PNEXT, 0
+/V3C CLA
+ TAD MTANO /GET UNIT #
+ CIA
+ TAD MTATAD /FIND WHICH ENTRY POINT
+ DCA MTFUN /MAKE A 'TAD MTAN' AND EXECUTE IT
+MTFUN, HLT
+ DCA MTHX /COLLECT ARGUMENTS VIA 'MTHX'
+ CLA STL RTR /2000
+ TAD MTFUN /MAKE A 'DCA MTAN' AND EXECUTE IT
+ DCA NBLOK
+ TAD MTISZ /RESTORE DESTROYED ISZ
+NBLOK, HLT
+ TAD I MTHX /GET FUNCTION WORD
+ DCA MTFUN /SAVE IT IN 'MTFUN'
+ ISZ MTHX /POINT TO BUFFER ADDRESS
+ STA /GET ONE LESS THAN
+ TAD I MTHX /BUFFER ADDRESS
+ DCA NBUFF /AND STORE AWAY
+ ISZ MTHX /POINT TO BLOCK NUMBER
+ TAD I MTHX /GET BLOCK NUMBER
+ DCA NBLOK /STORE AWAY
+ ISZ MTHX /POINT TO ERROR RETURN
+ RDF /GET CALLING FIELD
+ TAD MTCDIF /CREATE CIF CDF TO USER'S FIELD
+ DCA MTEXIT /STORE AWAY WHERE WILL BE USEFUL LATER
+MTCDIF, CIF CDF 0 /GO TO FIELD 0
+ TAD MTANO /GET UNIT NUMBER
+ CLL RTR
+ RTR
+ DCA MTANO /PUT IN BITS 0-2 OF 'MTANO'
+ TAD MTFUN /RETRIEVE FUNCTION WORD
+ AND L70 /ISOLATE FIELD OF BUFFER
+ TAD PARITY /SET ODD PARITY BITS, AND DENSITY 8 (800 BPI, 7-CHANNEL)
+ TAD MTANO /COMBINE WITH UNIT NUMBER
+ DCA MTAWD /TO GET A USEFUL MTA COMMAND
+ TAD MTFUN /ZERO BUFFER FOR PIP ON EOF
+ AND L70 /FIELD OF ORIGIN
+ TAD MTCDF
+ DCA USRCDF
+USRCDF,
+MTANO, 0
+ DCA MTANO /RESET 'MTANO' FOR NEXT CALL
+ TAD MTFUN
+ RAL
+ AND P7600 /GET # OF WORDS IN BUFFER
+ SNA SZL /ZERO BUFFER IF READING
+ JMP P7600
+ CIA
+ DCA MTH
+ TAD NBUFF
+ DCA ERROR
+MCLRLP, ISZ ERROR
+L100, 100
+ DCA I ERROR
+ ISZ MTH
+ JMP MCLRLP
+P7600, 7600
+MTCDF, CDF 0
+ TAD BLOCK0
+ SNA /OPERATE IN MULTIPLE-FILE MODE?
+ TAD NBLOK /RETRIEVE BLOCK
+ SZA CLA /IS IT BLOCK 0?
+ JMP BIGBLK /NO
+ TAD MTATAD /YES, REWIND [CAN BE 13XX]
+ JMS MTH /CALL MAGTAPE ROUTINE
+MTAWD, 1000 /CA IMMATERIAL
+M7603, -7603 /WC IMMATERIAL
+L70, 70 /NO REWIND ERRORS (THESE CAN'T OCCUR)
+BIGBLK, TAD MTFUN
+ JMS I PNEXT /GO READ OR WRITE NEXT PAGE
+NBUFF, 0 /ONE LESS THAN ADDRESS OF BUFFER
+ /MUST BE AT LOC AFTER CALL TO NEXT
+\f/ MTH
+
+/SET UP WC AND CA REGISTERS, LOAD FUNCTION AND GO
+
+/CALLING SEQUENCE:
+
+/ TAD (FNWORD
+/ JMS MTH
+/ BUFFER ADDRESS-1
+/ -WORD COUNT
+/ MASK FOR UNACCEPTABLE ERROR CONDITIONS
+/ <NORMAL RETURN>
+
+/ TAKES HANDLER ERROR RETURN ON ERRORS.
+/ IF ERROR, AC HAS ERROR CODE FROM MAIN STATUS REGISTER
+/ AC IS POSITIVE IF E.O.F. READ
+
+MTH, 0 /MUST BE AT 2ND LOC AFTER CALL TO NEXT
+ DCA ERROR /SAVE FUNCTION TEMPORARILY
+ SKTR /V3C
+ JMP .-1 /FIX TIMING BUG
+ CLT /CLEAR THE WORLD
+ TAD MTAWD
+ LCMR /LOAD COMMAND REGISTER
+ TAD I MTH /GET CURRENT ADDRESS
+ LCAR /LOAD IT
+ ISZ MTH /POINT TO WORD COUNT
+ TAD I MTH /GET WORD COUNT (TWO'S COMPLEMENT THEREOF)
+ LWCR /LOAD IT
+ ISZ MTH /POINT TO ERROR MASK
+ TAD ERROR /GET FUNCTION BACK
+ LFGR /GO BABY GO
+ JMS ERROR /CHECK FOR ERROR
+ SKJD /THROUGH?
+ JMP .-2 /NO
+ JMS ERROR /YES, ANY ERRORS?
+E1, ISZ MTH /AMAZING WE MADE IT (NO ERRORS)
+ JMP I MTH /NORMAL RETURN
+
+ IFNZRO MTH-NBUFF-1 <MTHERR,XXX>
+\fERROR, 0
+ TAD P7600 /YES
+ KRS /IS IT CTRL/C?
+ TAD M7603 /ALLOW PARITY TELETYPES
+ SNA CLA
+ KSF
+ JMP SIFE
+ CLT /ABORT I/O
+ JMP I P7600 /RETURN TO OS/8 KEYBOARD MONITOR
+SIFE, SKEF /SKIP ON ERROR
+ JMP I ERROR /RETURN, NO ERRORS
+ RMSR /WHAT'S CAUSING THE ERROR?
+ AND I MTH /IS IT A GOOD ONE? (USE ERROR MASK)
+ SNA CLA /IS ERROR ACCEPTABLE?
+ JMP E1 /YES
+ RMSR /NOT ACCEPTABLE
+ AND L100 /IS IT AN E.O.F.?
+ SNA /IF SO, LEAVE BIT 0 CLEAR
+ RMSR
+ JMP MTEXIT /AND LEAVE WITH STATUS IN AC
+
+ IFZERO .-367&4000 <PERR,ZZXX>
+\f *366
+MTHX, MTAVERSION
+MTA7, ISZ MTANO
+MTA6, ISZ MTANO
+MTA5, ISZ MTANO
+MTA4, ISZ MTANO
+MTA3, ISZ MTANO
+MTA2, ISZ MTANO
+MTA1, ISZ MTANO
+MTA0, ISZ MTANO
+ JMS PNEXT /GET ADDRESS OF FIRST LOCATION ON NEXT PAGE
+ PAGE
+
+ IFNZRO PARITY-200 <PARERR,ZZZ>
+\f *400
+
+NEXT, 0
+ DCA RECNO /READ OR WRITE AND HOW MANY
+ TAD NEXT
+ TAD KSTOP
+ DCA NSTOP /ADDRESS OF RETURN ROUTINES
+ TAD NEXT
+ TAD KBLOK
+ DCA WC
+ TAD I WC
+ DCA WC
+ TAD I NEXT
+ DCA BUFFER /GET BUFFER ADDRESS - 1
+ ISZ NEXT /POINT TO MTH
+ TAD (3677 /V3C
+ DCA ERFLAG /DEFAULT IS REPORT ALL ERRORS EXCEPT EOF
+ TAD RECNO
+ CLL RAL /LINK SPECIFIES READ OR WRITE
+ AND L7600 /-(# OF BLOCKS)^200
+ SNA
+ JMP ZERO /0 PAGE COUNT!
+ DCA RECNO
+ SZL /READ OR WRITE?
+ STL CLA RTR /WRITE. +2000 TO CONVERT READ CODE TO WRITE CODE
+ TAD L2100 /READ (OR WRITE) & GO
+ DCA TEMP /SAVE THIS COMMAND
+ TAD L7600
+ DCA WC /OS/8 USES 128 WORD BLOCKS
+ STA /V3C
+ DCA ERFLAG /NOW DEFAULT IS REPORT ALL ERRORS
+RL1, TAD TEMP
+ JMS GO
+ TAD BUFFER /NEXT 200 WORDS
+ TAD L200
+ DCA BUFFER
+ TAD RECNO /ANY MORE?
+ TAD L7600
+ SNA
+ JMP I NSTOP /NO, FINISH
+ DCA RECNO /YES, LOOP
+ JMP RL1 /REJOIN PROCESSING
+
+KSTOP, STOP-NBUFF /USED TO RELOCATE 'STOP'
+
+KBLOK, NBLOK-NBUFF
+\fFLAG, 0
+
+COUNT,
+TEMP, 0
+
+EFL2, TAD L5100
+ JMS GO /ALL THIS CODE IS NEW FOR V3C
+EFL1, TAD L5100
+ JMP GOO /V3C
+
+GO, 0
+ JMS I NEXT /CALL MTH
+BUFFER, HLT
+WC, 0
+ERFLAG, -1
+ JMP I GO
+
+L5100, 5100
+RECNO, 0
+NSTOP, 0
+L7, 7
+L2100, 2100
+\fZERO, TAD RECNO /RETRIEVE FN WORD (MUST PRESERVE LINK)
+ AND L7 /ISOLATE SPECIAL CODE
+ TAD PJUMP
+ DCA .+1
+FN, HLT /BRANCH THROUGH JUMP TABLE
+
+TABLE, JMP EFL2 /0 CLOSE. WRITE TWO EOF'S
+ JMP REW /1 REWIND
+ JMP SPACE /2 SPACE FORWARD/REVERSE RECORDS
+ JMP SEOF /3 SPACE FORWARD/REVERSE FILES
+ JMP UNLOAD /4 REWIND AND OFF-LINE
+ JMP EFL1 /5 WRITE EOF
+ JMP SPEC /6 READ OR WRITE WITH SPECIAL BLOCKSIZE
+PJUMP, JMP TABLE /7 UNUSED SAME AS 0
+
+SEOF, RAR /LINK ON MEANS REVERSE
+ RTR
+ DCA FN
+ TAD WC
+ DCA COUNT
+ STA
+ DCA WC
+ RMSR
+ AND (3000 /CHECK BOT BIT
+ SZA CLA /SIMULATE DATA IF AT BOT (OR REWINDING)
+FILE, CLA IAC
+FILE2, DCA FLAG
+ TAD FN
+ TAD L6100 /V3C FORWARD [OR BACKSPACE] A RECORD
+ JMS GO
+ RMSR
+ AND P100
+ SNA CLA /SKIP IF FILE MARK FOUND
+ JMP FILE
+ TAD FN
+ TAD FLAG
+ SZA CLA /WAS THERE ANY DATA?
+ JMP CONT /V3C YES, CONTINUE
+ /EITHER SAW DATA OR WAS GOING IN REVERSE
+ STL /NO, BACKSPACE ONE RECORD
+SPACE, CLA CMA /V3C DON'T TOUCH LINK
+ DCA ERFLAG /ALL ERRORS ARE FATAL
+ RAR /LINK ON MEANS REVERSE (READ BIT)
+ STL RAR
+ STL RAR
+UNLOAD, TAD P100 /ADD IN 'GO' BIT
+GOO, JMS GO
+ JMP I NSTOP
+
+CONT, ISZ COUNT /V3C
+ JMP FILE2 /CONTINUE?
+ JMP I NSTOP /CHECK FOR EOD BEFORE COUNT
+
+/FLAG .NE. 0 MEANS SAW DATA
+\fL6100, 6100
+P100, 100
+L7600, 7600
+
+SPEC, CLA CMA /V3C DON'T TOUCH LINK
+ DCA ERFLAG /ALL ERRORS ARE NOW FATAL
+ SZL /LINK STILL CONTAINS READ/WRITE BIT
+ STL CLA RTR
+ TAD L2100 /V3C
+ JMP GOO /V3C
+
+REW, DCA ERFLAG /NO REWIND ERRORS
+ TAD (1000 /V3C
+ JMP UNLOAD /V3C
+L200, 200
+ PAGE
+ $
+\f\v
--- /dev/null
+/TRIGONOMETRY ROUTINES OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/ VERSION 5 HAS PATCH FOR IMPROVED ACCURACY AT LARGE ARGS
+/ INSERTED NOP INSTRUCTIONS AT PATCH1 AND PATCH2/C. STOLZ
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ VERSION 6A
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+ ENTRY SIN
+ ENTRY COS
+ ENTRY TAN
+
+QUAD, 0 /CONTAINS ONE LESS THAN THE QUADRANT OF THE ARGUMENT
+Y, BLOCK 3 /TEMPORARY STORAGE FOR ARG
+ CPAGE 22
+COEF, 5476 /-2.39E-8 CONSTANTS FOR SIN
+ 3246
+ 2500 /2.7526E-6
+ 1565
+ 6134
+ 5170 /-1.98409E-4
+ 5646
+ 4006
+ 0026 /8.3333315E-3
+ 1724
+ 2104
+ 2065 /-1.6666667E-1
+ 5765
+ 2525
+ 2525 /1.0
+ 2014
+ 0000
+ 0000
+ CPAGE 3
+HALFPI, 2016 /1.5707963
+ 2207
+ 7324
+ CPAGE 3
+QTRPI, 2006 /7.8539815E-1
+ 2207
+ 7324
+ CPAGE 25
+TOEF, 1724 /9.5168091E-3
+ 6766
+ 1440 /2.9005250E-3
+ 1705
+ 7413
+ 2741 /2.4565090E-2
+ 1736
+ 2236
+ 2720 /5.3374060E-2
+ 1746
+ 6517
+ 3023 /1.3339240E-1
+ 1764
+ 2114
+ 0042 /3.3333140E-1
+ 1775
+ 2525
+ 1517 /1.0
+ 2014
+ 0000
+ 0000
+TAN, BLOCK 1
+ 6
+ DCA QUAD /SET QUADRANT OFFSET SWITCH
+ TAD I TAN /PICK-UP CDF
+ DCA TARG
+ INC TAN# /POINT TO NEXT WORD
+ TAD I TAN /PICK-UP ADDRESS
+ DCA TARG#
+ INC TAN# /POINT TO RETURN
+ CALL 1,FAD /GET ARG IN FP-ACC
+TARG, ARG 0
+BAC, TAD ACH /LOOK AT HIGH ORDER WORD
+ SPA CLA /IF NEGATIVE
+ JMP OVT /GO OM
+ CALL 1,FSB /OTHERWISE SUBTRACT
+ ARG QTRPI /PI/2
+ ISZ QUAD /AND INCREMENT QUADRANT COUNTER
+PATCH1, NOP /ALLOW FOR SKIP
+ JMP BAC /UNTIL ARG IS NEGATIVE
+OVT, CALL 1,FAD /ADD PI/2 TO ARG UNTIL IT IS IN
+ ARG QTRPI /THE FIRST QUADRANT
+ CLA CMA
+ TAD QUAD /BUT KEEP TRACK OF WHICH QUADRANT IT WAS IN
+ DCA QUAD
+ TAD ACH /GET HI ORDER WORD
+ SPA CLA
+ JMP OVT /IF NEGATIVE REPEAT
+ TAD QUAD /FIND OUT WHAT QUAD IT WAS IN
+ RTR
+ SMA CLA
+ JMP OM
+ CALL 0,CHS /SUBTRACT FROM PI/2 IF QUAD 2 OR 4
+ CALL 1,FAD
+ ARG QTRPI
+OM, TAD (7 /USE A 7 TERM SERIES
+ CPAGE 3
+ JMS POL
+ TOEF /ADRESS OF COEFICIENTS FOR THE SERIES
+ CLA CMA
+ TAD QUAD
+ RTR
+ SZL CLA
+ JMP OM3
+ CALL 1,STO
+ ARG Y
+ TAD (2014
+ DCA ACH
+ CALL 1,FDV
+ ARG Y
+OM3, RETRN TAN
+/ INTERNAL SUBROUTINE POL
+/
+/ COMPUTES N TERMS OF POLYNOMIAL
+/ N IN AC ... X IN FLOATING AC
+/ COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL
+/
+POL2, BLOCK 1
+POL, BLOCK 1
+ CIA
+ DCA POL2
+ CALL 1,STO /STORE ADJUSTED ARGUMENT
+ ARG Y /IN A TEMPORARY
+ CALL 1,FAD
+ ARG Y /RESTORE FP AC
+ CALL 1,FMP
+ ARG Y /SQUARE IT
+ CALL 1,STO
+ ARG X
+ TAD I POL
+ INC POL
+ARG2, DCA ARG1#
+ CALL 1,FAD
+ARG1, ARG COEF / ADDRESS STORED HERE
+ ISZ POL2
+ JMP POL1
+ CALL 1,FMP /MULTIPLY AGAIN TO COMPLETE SERIES
+ ARG Y
+ TAD QUAD
+ RTR
+ SNL CLA /FIND OUT WHICH QUADRANT
+ JMP POLEX
+ CALL 0,CHS /IF IN QUADRANT 3 OR 4 SET NEGATIVE
+POLEX, JMP I POL
+POL1, CALL 1,FMP
+ ARG X
+ TAD ARG1#
+ TAD (3
+ JMP ARG2
+/
+X, BLOCK 3 /TEMPORARY FOR POL
+/
+/
+/ 8K FORTRAN TRIGNOMETRY ROUTINES
+/
+/
+COS, BLOCK 1
+ 6
+ TAD COS
+ DCA SIN
+ TAD COS#
+ DCA SIN# /IT NOW APPEARS THAT SIN WAS CALLED
+ CLA IAC /WITH QUADRANT OFFSET BY ONE
+ JMP COSE
+SIN, BLOCK 1
+ 6
+COSE, DCA QUAD /SET QUADRANT OFFSET SWITCH
+ TAD I SIN /PICK-UP CDF
+ DCA SARG
+ INC SIN# /POINT TO NEXT WORD
+ TAD I SIN /PICK-UP ADDRESS
+ DCA SARG#
+ INC SIN# /POINT TO RETURN
+ CALL 1,FAD /GET ARG IN FP-ACC
+SARG, ARG 0
+BACK, TAD ACH /LOOK AT HIGH ORDER WORD
+ SPA CLA /IF NEGATIVE
+ JMP OVR /GO ON
+ CALL 1,FSB /OTHERWISE SUBTRACT
+ ARG HALFPI /PI/2
+ ISZ QUAD /AND INCREMENT QUADRANT COUNTER
+PATCH2, NOP /ALLOW FOR SKIP
+ JMP BACK /UNTIL ARG IS NEGATIVE
+OVR, CALL 1,FAD /ADD PI/2 TO ARG UNTIL IT IS IN
+ ARG HALFPI /THE FIRST QUADRANT
+ CLA CMA
+ TAD QUAD /BUT KEEP TRACK OF WHICH QUADRANT IT WAS IN
+ DCA QUAD
+ TAD ACH /GET HI ORDER WORD
+ SPA CLA
+ JMP OVR /IF NEGATIVE REPEAT
+ TAD QUAD /FIND OUT WHAT QUAD IT WAS IN
+ RTR
+ SMA CLA
+ JMP ON
+ CALL 0,CHS /SUBTRACT FROM PI/2 IF QUAD 2 OR 4
+ CALL 1,FAD
+ ARG HALFPI
+ON, TAD (6 /USE A 6 TERM SERIES
+ CPAGE 3
+ JMS POL
+ COEF /ADRESS OF COEFICIENTS FOR THE SERIES
+ RETRN SIN
+ END
+\f
--- /dev/null
+/UTILITY SUBROUTINE PACKAGE OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/UTILITY SUBROUTINE PACKAGE OS8 FORTRAN II LIBRARY
+\f/ VERSION 10A (APRIL 28, 1977)
+/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+ ENTRY OPEN /INITIALIZING AND FLAG SETTING ROUTINE
+ ENTRY GENIO
+ ENTRY EXIT /EXIT TO DISK MONITOR SYSTEM
+ ENTRY ERROR
+ ENTRY CKIO /USELESS ROUTINE
+ OPDEF KRS 6034
+ OPDEF KCC 6032
+ OPDEF TADI 1400
+ OPDEF DCAI 3400
+ OPDEF JMSI 4400
+ OPDEF JMPI 5400
+/ CARD READER IOT'S
+ OPDEF RCSE 6672
+ OPDEF RCSP 6671
+ OPDEF RCSF 6631
+ OPDEF RCRA 6632
+/LINE PRINTER IOT'S
+ OPDEF LLB 6666
+ OPDEF LSF 6661
+
+ LAP
+
+U17, 17 /*** MUST BE FIRST LOC IN PAGE ***
+
+IOER, 1117
+ 0522 /"IOER" ERROR
+GENIO, BLOCK 1
+ 10 /GENERAL INPUT/OUTPUT ROUTINE
+ DCA 7 /SAVE ENTRY AC
+GENLP, TAD 7
+ RTL
+ RTL
+ RAL
+U200, AND U17
+ TAD JMPITB
+ DCA DSPACH /INDEX JUMP TABLE BY DEVICE NUMBER
+ TAD U200
+ KRS
+ TAD UM203
+ SNA CLA
+ KSF /CHECK FOR ^C ON TELETYPE
+DSPACH, NOP /NO ^C - DISPATCH TO I/O ROUTINE
+ CALL 0,EXIT
+
+JMPITB, JMPI DEVTAB
+DEVTAB, TTYOUT
+ HSPOUT
+ LPTOUT
+ GENOUT
+ TTYIN
+ HSRIN
+ CDRIN
+ GENIN
+ TTYFUJ /FUDGE - SEE TELETYPE INPUT ROUTINE
+ IOERR
+ IOERR
+ IOERR
+ IOERR
+ IOERR
+ IOERR
+ IOERR
+
+HSPOUT, PSF
+ JMP GENLP
+ TAD 7
+ PLS
+GENRTN, CLA
+ RETRN GENIO
+
+TTYIN, KSF
+ JMP GENLP
+ CLA CLL CML RTR /****DEPENDS ON NUMBER OF DEVICES ****
+ JMP GENLP /TEST FOR ^C ONE LAST TIME
+
+HSRIN, ISZ T1
+ JMP HSRSF
+ TAD U336 /TIME OUT-PRINT '^'
+ TLS
+HLP, KSF
+ JMP HLP
+ AND U200 /GET 200 INTO AC
+ KRS /READ THE CHAR.
+ TAD UM203
+ SZA CLA /IS IT CONTROL C?
+ KCC /NO-CLEAR FLAG
+ RFC /USER TYPED-TICKLE RDR-FALL THRU RFC
+HSRSF, RSF
+ JMP GENLP
+ DCA T1
+ RRB RFC
+ JMP GENRTN#
+U336, 336
+T1, 0
+
+UM203, -203
+PCDRGC, CDRGCH /USED TO FORCE DF=CURRENT WHEN NECESSARY
+CDR215, 215
+CDR100, 100
+CDR240, 240
+PCDRTB, CDRTBL /CONVERSION FROM CARD CODE TO ASCII-240
+CDRCT, 0
+CDRLEN, 0
+CDRIN, TAD CDRCT
+ SNA CLA
+ JMP CDRNXT /NEW CARD NECESSARY
+ ISZ CDRCT /ADVANCE TO NEXT COLUMN
+ JMP CDRGET
+ TAD CDR215 /NO MORE - SEND A CARRIAGE RETURN
+ JMP GENRTN#
+
+CDREST, KSF
+ JMP CDRTST
+ KCC
+CDRNXT, RCSE
+ JMP GENLP /CHECK FOR ^C WHILE WAITING FOR NEXT CARD
+CDRTST, RCSP
+ JMP CDRCOL /NOT END OF CARD YET
+ TAD CDRCT /END OF CARD - SET UP FOR EXTRACTION OF CHARS
+ CIA
+ DCA CDRLEN
+CDRGET, TAD CDRCT
+ TAD CDRLEN /FORM CHAR POINTER INTO TABLE AT 10100
+ CLL RAR
+ TAD CDR100
+ 6211
+ JMSI PCDRGCH /INDEX TABLE AND PULL OUT CHAR (DF=10)
+ TAD CDR240 /CHANGE TO ASCII
+ JMP GENRTN# /RETURN
+CDRCOL, RCSF /ANYTHING YET?
+ JMP CDREST /KEEP LOOKING
+ RCRA /READ IT
+ CLL RAR
+ TAD PCDRTB
+ JMS I PCDRGC /GET TABLE ENTRY, FORCING DATA FIELD CURRENT
+ DCA CDRLEN /SAVE IT TEMPORARILY
+ TAD CDRCT
+ CIA
+ CLL RAR
+ TAD CDR100 /INDEX TABLE AT LOC 10100
+ DCA DSPACH
+ 6211 /CDF 10
+ TAD CDRLEN
+ SZL /WHICH HALF?
+ JMP CDNORT /RIGHT HALF
+ RTL
+ RTL
+ RTL
+ SKP
+CDNORT, TADI DSPACH /ADD EXISTING LEFT HALF
+ DCAI DSPACH /SAVE UPDATED ENTRY
+ CLA CMA
+ TAD CDRCT
+ DCA CDRCT /UPDATE COLUMN POINTER
+ JMP CDRCOL
+
+
+ PAGE
+\fU377, 377 /MUST BE FIRST LOC IN THIS PAGE
+GENIN, 6201
+ TADI IHNDLR
+ SNA CLA /OPEN INPUT FILE?
+ JMP IOERR /NO
+ 6202
+ JMS I FICHAR /GET A CHAR
+ JMP IOERR /INPUT ERROR
+UU200, AND U377
+GRTN2, RETRN GENIO
+
+GENOUT, 6201
+ TADI OHNDLR
+ SNA CLA /OPEN OUTPUT FILE?
+ JMP IOERR /NO
+ 6202
+ TAD 7 /GET CHAR TO BE OUTPUT
+ AND U377
+ JMS I FOCHAR /PUT A CHARACTER
+ JMP IOERR /OUTPUT ERROR
+ JMP GRTN2
+
+IHNDLR, 122 /***ALL THESE LOCATIONS ARE VERY VOLATILE!! ***
+FICHAR, 606 /*******
+OHNDLR, 121 /*******
+FOCHAR, 651 /******************
+
+/
+/ INITIALIZING SUBROUTINE CALLED BY FORTRAN
+/ CLEARS FLOATING AC AND SETS FLAGS
+/
+OPEN, BLOCK 1
+ 10
+ TAD (212
+ TLS /PUT LINE-FEED ON TTY
+ LLB /INITIALIZE LPT
+ KCC /CLEAR KEYBOARD FLAG (AND AC)
+ PLS
+ RFC
+ CALL 0,CLEAR
+ 6201
+ DCAI IHNDLR
+ DCAI OHNDLR /ZERO DEVICE-INDEPENDENT IO FLAGS
+ RETRN OPEN
+
+
+LPTOUT, LSF
+ JMP GENLP
+ TAD 7
+ ISZ PFSTCH
+ JMP NOFST
+ TAD (-1262 /LOOK FOR CONTROL CHARS IN PRINT POSITION 1
+ CLL IAC
+ IAC
+ SNL
+ JMP DCACH
+ CLL RAL
+ TAD (212
+NOFST, LLB
+ TAD (-1212
+DCACH, SNA CLA /IF LINE FEED
+ CMA /SET "FIRST CHAR" SWITCH ON
+ DCA PFSTCH
+ JMP GRTN2
+PFSTCH, -1
+
+TTYFUJ, TAD UU200
+ KRS
+ DCA 7 /SAVE KEYBOARD CHAR
+ KCC /CLEAR FLAG
+ TAD 7
+ TAD (-212
+ SZA CLA
+ JMS TYPE
+ TAD 7
+ TAD (-215
+ SZA CLA
+ JMP TYRTN
+ CLA CLL CMA RTL
+ JMS TYPE
+TYRTN, TAD 7
+ JMP GRTN2 /RETURN WITH CHAR IN AC
+
+TYPE, 0
+ TAD 7
+TYPELP, TSF
+ JMP TYPELP
+ TLS
+ CLA
+ JMPI TYPE
+
+TTYOUT, JMS TYPE
+ JMP GRTN2
+
+IOERR, CALL 1,ERROR
+ ARG IOER
+
+CDRTBL, 0021;2223;2425;2627
+ 3031;3203;4007;3502
+ 2017;6364;6566;6770
+ 7172;7514;0577;3637
+ 1552;5354;5556;5760
+ 6162;0104;1211;3374
+ 0641;4243;4445;4647
+ 5051;7316;3410;1376
+
+ PAGE
+\f
+PMESG, MESG
+MESG, 7777
+ 7777
+ 4005
+ 2222
+ 1722
+ 4001
+ 2440
+ 1417
+ 0340
+LIT7, 0007
+
+ERROR, BLOCK 1
+ 10 /ERROR PROCESSOR
+U7600, 7600
+ TAD ERROR
+ DCA TEM1
+TEM1, NOP /SET DATA FIELD OF "CALL ERROR"
+ TADI ERROR#
+ DCA TEM3
+ INC ERROR#
+E60, CLA CMA CML /CML IS WINDOW DRESSING
+ TADI ERROR#
+ DCA 10
+ INC ERROR#
+TEM3, NOP /DATA FIELD OF MESSAGE&ENTRY POINT
+ DCA CKIO /ZERO "FATAL ERROR" FLAG
+ TADI 10
+ RAL
+ SZL /NON-FATAL BIT ON?
+ ISZ CKIO /YES - SET "FATAL FLAG" TO NON-FATAL
+ CLL RAR /STRIP NON-FATAL BIT FROM MESSAGE
+ DCA MESG
+ TADI 10 /SECOND WORD OF MESSAGE
+ DCA MESG#
+ TADI 10
+ DCA TEM1
+ TADI 10
+ DCA TEM3 /CALLING ADDRESS
+ TAD PMESG
+ DCA TEM2
+
+ERLP, TAD I TEM2
+ RTR
+ RTR
+ RTR
+ JMS PR6BIT
+ TAD I TEM2
+ JMS PR6BIT
+ INC TEM2
+ JMP ERLP
+
+PRLOC, TAD TEM1
+ RTR
+ RTR
+ JMS ERTTY /PRINT CALLING FIELD
+ TAD (-4
+ DCA TEM2
+NUMLP, TAD TEM3
+ RTL
+ RAL
+ DCA TEM3
+ TAD TEM3
+ JMS ERTTY
+ ISZ TEM2
+ JMP NUMLP
+ TAD (215
+ DCA 7
+ JMS TYPE
+ CLA CLL CMA RTL
+ JMS TYPE
+ TAD CKIO /GET THE FATAL ERROR FLAG
+ SNA CLA /WHADDOWEDO??
+ JMP EXITX
+ RETRN ERROR /HE SAYS ITS NON-FATAL - LET HIM HANDLE IT
+
+ERTTY, 0 /DIGIT PRINTING ROUTINE
+ RAL
+ AND LIT7
+ TAD E60
+ JMS PR6BIT
+ JMP I ERTTY
+
+PR6BIT, 0 /6BIT TO 8BIT CONVERTOR
+ AND (77
+ SNA
+ JMP PRLOC /MESSAGE OVER
+ TAD (7740
+ SPA
+ TAD (100
+ TAD (240
+ CALL 0,GENIO /LOOK FOR ^C WHILE TYPING
+ JMP I PR6BIT
+
+/
+/EXIT TO DISK MONITOR SYSTEM
+/
+EXIT, BLOCK 1
+ 10
+EXITX, CALL 0,CKIO
+ 6203
+ JMPI U7600 /RETURN TO MONITOR
+
+CKIO, 0
+TEM2, 10 /DUMMY SUBROUTINE TO WAIT FOR I/O COMPLETE
+CKWAIT, 6041
+ JMP CKWAIT
+ RETRN CKIO
+
+CDRGCH, 0 /GET A CHAR FROM A PACKED TABLE
+ DCA TEM2 /WORD PTR IN AC, LEFT/RIGHT SW IN LINK
+ TADI TEM2 /PRESERVE ENTRY FIELD
+ SZL
+ JMP CDRAND /RIGHT HALF
+ RTR
+ RTR
+ RTR
+CDRAND, AND CDR77
+ JMP I CDRGCH /RESTORE CURRENT FIELD AND GET OUT
+CDR77, 77
+
+ END
+\f
--- /dev/null
+/25 OS/12 SCOPE HANDLER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/ NOVEMBER, 1972
+
+/ MARIO DENOBILI, P?S
+
+/ THIS ROUTINE WAS WRITTEN VERY HASTILY.
+
+/ THE FOLLOWING FEATURES SHOULD BE PUT
+/ IN, BUT I WAS TOO LAZY TO DO SO.
+/ WITH A FEW HOURS WORK, A COMPETENT
+/ PROGRAMMER SHOULD BE ABLE TO COMPACT
+/ MY HASTY CODE AND EASILY ADD AT LEAST
+/ A FEW OF THE FOLLOWING FEATURES:
+
+/1. TABS SHOULD BE HANDLED CORRECTLY.
+
+/2. FORM FEEDS SHOULD SIGNAL A NEW
+/ SCOPE PAGE. [BRANCH TO LOCATION 'FULL']
+
+/3. VERTICAL TABS SHOULD BE TREATED AS
+/ 7 LINE FEEDS.
+
+/4. THE HANDLER SHOULD RETURN AN ERROR ON READ.
+
+/5. IF THE BUFFER OVERLAPS THE BETA REGISTER,
+/ OR WRAPS AROUND 7777.
+/ THIS SHOULD NOT CAUSE A CRAPPY
+/ CHARACTER TO BE DISPLAYED.
+
+/6. CTRL/Z SHOULD BE CHECKED FOR AND SIGNIFY
+/ END OF BUFFER. [BRANCH TO 'FULL' WITH
+/ LINK 0]
+
+/7. THE DISPLAY ALGORITHM SHOULD BE IMPROVED
+/ SO THAT THERE IS LESS FLICKER.
+\f/MORE FEATURES TO BE ADDED
+
+/8. THE RESTRICTION THAT THE USER'S BUFFER
+/ START AT AN EVEN ADDRESS IS USELESS
+/ AND SHOULD BE REMOVED.
+
+/9. THE STATUS OF THE SPECIAL FUNCTIONS
+/ REGISTER SHOULD BE SAVED AND RESTORED
+/ BEFORE EXITING.
+
+/10. WHEN ANOTHER LOCATION IS FOUND, THE HANDLER
+/ SHOULD BE ABLE TO DETECT PARITY ^C
+
+/11. SENSE SWITCH 0 SHOULD BE USED TO
+/ SPECIFY SMALL OR LARGE SIZE CHARACTERS.
+
+/12. OVERFLOW LINES SHOULD BE INDENTED SOME SMALL
+/ AMOUNT TO SHOW THAT THEY ARE A CONTINUATION
+/ OF THE PREVIOUS LINE
+\f/ OS/8 BUILD HEADER BLOCK
+
+ FIELD 0
+ *0
+
+ -1
+ DEVICE VR12 /DEVICE NAME
+ DEVICE TV /HANDLER NAME
+ 1300 /DCB WORD
+ 4000+SCOPE-200 /2-PAGE FLAG AND RELATIVE ENTRY PT
+ ZBLOCK 2
+
+/ TWO PAGE SCOPE DEVICE HANDLER
+/ PAGE INDEPENDENT AND REUSABLE
+
+ LINC=6141
+ PDP=2
+ ESF=4
+ CLR=11
+
+ *200
+
+L26, 26
+SAVE, 0 /BETA REG SAVE LOC - MAY BE BETA REG
+LINKNT, TAD SAVE /COUNT OF # OF LINES
+YCOORD, AND SCDF /DISPLAY ORDIANTE
+BETA, DCA . /8-MODE ADDRESS OF BETA REGISTER 1
+CBASE, TAD SAVE /POINTS TO CHARACTER DISPLAY TABLE
+BUFEND, TAD XCIF /END OF BUFFER
+BPTR, DCA CBASE /POINTS INTO BUFFER
+BUFFER, TAD X /BEGINNING OF BUFFER
+T1, DCA BEGIN /TEMPORARY
+L7410, SKP
+
+ TVERSION="A&77
+\fSCOPE, TVERSION
+BEGIN, JMS SAVE /ADDRESS MUST BE EVEN
+ AND L70 /GET DATA FIELD OF BUFFER
+ TAD KCDF
+ DCA SCDF
+ KCC
+ RDF /GET DATA FIELD
+ TAD FULL
+ DCA XCIF
+X, TAD I SCOPE /GET FUNCTION WORD
+ CLL RAL
+ AND L7700 /GET # OF PAGES
+ ISZ SCOPE
+ SNA
+ JMP OVERX
+ TAD I SCOPE /ADD IN BUFFER START
+ DCA BUFEND /TO GET END OF BUFFER
+ TAD I SCOPE /GET BUFFER START
+ DCA BUFFER /[RESTRICTION: IT MUST BE EVEN]
+ CDF 0
+ TAD I BETA
+ DCA SAVE /SAVE CONTENTS OF BETA REGISTER
+\f/MAIN LOOP - GET CHARACTERS AND CALL DISPLAY ROUTINE
+
+NEW, LAS /LINE COUNT FROM SWITCH REGISTER
+ DCA LINKNT
+ DCA I BETA /GO TO LEFT MARGIN
+ TAD BUFFER
+ DCA BPTR /POINT TO BEGIN OF BUFFER
+ TAD YINIT
+ DCA YCOORD /GO TO TOP OF SCREEN
+ENTRY, JMS DISP /DISPLAY 3D CHAR ( ALSO SETS DF)
+ TAD BPTR
+ CMA CLL
+ TAD BUFEND /COMPARE BUFFER PTR WITH BUFFER END
+ SNL CLA /AT END OF BUFFER?
+ JMP FULL /YES - LINK OFF AT FULL MEANS EXIT
+ROTT1, RTL /NOTE LINK=1 IF WE FELL INTO HERE!
+ RTL /ROTATE HI ORDER BITS INTO SHIFT REG
+ SPA /TEST FOR SHIFT REGISTER FULL
+ JMP ENTRY /YES - GO DIAPLAY IT
+ DCA T1 /RESAVE SHIFT REGISTER
+ TAD I BPTR /GET NEXT BUFFER WORD
+ JMS DISP /DISPLAY LOW-ORDER
+ TAD I BPTR
+ ISZ BPTR /BUMP PTR
+/ NOP
+ AND L7410 /GET HIGH ORDER - THE 10 IS HARMLESS
+ CLL RAL
+ TAD T1 /ADD HIGH ORDER TO SHIFT REGISTER.
+ JMP ROTT1 /INVOLUTED CODE.
+\f/DISPLAY SUBROUTINE - DISPLAYS A CHARACTER
+
+DISP, 0
+KCDF, CDF 0
+YINIT, AND L177
+ SNA
+ JMP SCDF /IGNORE NULLS
+ TAD L7640
+ CLL CML
+ TAD L100 /CHECK WHETHER THE CHARACTER
+ SZL /IS OUTSIDE OF THE RANGE [40,137]
+ JMP UGH /YES - SUBSTITUTE SPACE OR L.F.
+ CLL RAL
+MAGIC, TAD CBASE /ADD IN BASE ADDR
+ DCA RIGHT /GET DISPLAY BIT PATTERN PTR
+ TAD I RIGHT
+ DCA LEFT /GET LEFT HALF OF DISPLAY BITS
+ ISZ RIGHT
+ TAD I RIGHT
+ DCA RIGHT /GET RIGHT HALF
+ TAD YCOORD /PUT ORDINATE IN AC
+ LINC
+YINC, 1760 /DSC I
+LEFT, 0 /DISPLAY LEFT HALF
+ 1760 /DSC I
+RIGHT, 0 /DISPLAY RIGHT HALF
+ CLR
+ ESF /SMALL CHARACTERS!
+ PDP
+ ISZ I BETA /LEAVE A BISSEL SPACE
+ TAD I BETA /GET ABSCISSA
+ TAD LINEND /COMPARE WITH RIGHT MARGIN
+L7700, SMA CLA /AT RIGHT EDGE OF SCREEN?
+ JMP NEWLIN /YES, GO TO NEXT LINE
+SCDF, 6001 /NO, SET PROPER DF
+ JMP I DISP /RETURN
+\f/DISPLAY ROUTINE CONTINUED
+
+UGH, TAD L26 /CHECK FOR LINE FEED
+LINEND, RTR /OR FORM FEED (LINK=0!)
+L7640, SZA CLA
+ JMP MAGIC /OTHER CONTROL CHARS PRINT BLNK
+NEWLIN, DCA I BETA /BACK TO LEFT MARGIN
+ TAD YCOORD
+ TAD YINC
+ DCA YCOORD /MOVE DOWN TO NEXT LINE
+ ISZ LINKNT /AT BOTTOM OF SCREEN?
+ JMP SCDF /NO
+ CLL CLA CMA RAL /TAKE QUOT ON DIV BY 2
+ AND BPTR /AND LEAVE IN AC
+FULL, CIF CDF 0 /YES
+ KSF /GO TO NEXT SCOPE PAGE?
+ JMP NEW /NO, REFRESH
+ DCA BUFFER /GET NEW BUFFER 'START'
+ SZL /END OF BUFFER ?
+ JMP NOW /NO, REFRESH
+ TAD SAVE
+ DCA I BETA /RESTORE BETA REGISTER
+OVERX, CLA STL RAL IAC /ADD 3
+ TAD SCOPE /TO RET ADDRESS
+ DCA SCOPE
+XCIF, CHRTBL-BEGIN-1 /RESTORE INST FIELD & DATA FIELD
+ JMP I SCOPE /LEAVE
+L177, 177
+L100, 100
+NOW, KRB
+/ AND L177
+ TAD M3
+ SZA CLA
+ JMP NEW
+ JMP I .+1
+ 7605
+L70, 70
+M3, -203 /** TEMP
+/BETTER STUFF, PRINTS ^C
+/NOW, TAD L7600
+/ KRS
+/ TAD M7603
+/ SZA CLA
+/ JMP NEW
+/ JMP I L7600
+/L7600, 7600
+/M7603, -7603
+ PAGE
+\f/THE TABLE OF PATTERN WORDS BEGINS HERE
+
+CHRTBL, 0000; 0000 /SPACE
+ 7500; 0000 /!
+ 7000; 0070 /"
+ 7714; 1477 /#
+ 5721; 4671 /$
+ 6661; 4333 /%
+ 5166; 0526 /&
+ 0000; 0070 /'
+ 3600; 0041 /(
+ 4100; 0036 /)
+ 2050; 0050 /*
+ 0404; 0437 /+
+ 0500; 0006 /,
+ 0404; 0404 /-
+ 0001; 0000 /.
+ 0601; 4030 //
+ 4536; 3651 /0
+ 2101; 0177 /1
+ 4523; 2151 /2
+ 4122; 2651 /3
+ 2414; 0477 /4
+ 5172; 0651 /5
+ 1506; 4225 /6
+ 4443; 6050 /7
+ 5126; 2651 /8
+ 5122; 3651 /9
+ 2200; 0000 /:
+ 4601; 0000 /;
+ 2410; 0042 /<
+ 1212; 1212 /=
+ 4200; 1024 />
+ 4020; 2055 /?
+ 4136; 3656 /@
+ 4477; 7744 /A
+ 5177; 2651 /B
+ 4136; 2241 /C
+ 4177; 3641 /D
+ 4577; 4145 /E
+ 4477; 4044 /F
+ 4136; 2645 /G
+ 1077; 7710 /H
+ 7741; 0041 /I
+ 4142; 4076 /J
+ 1077; 4324 /K
+ 0177; 0301 /L
+ 3077; 7730 /M
+ 3077; 7706 /N
+ 4177; 7741 /O
+ 4477; 3044 /P
+ 4276; 0376 /Q
+ 4477; 3146 /R
+ 5121; 4651 /S
+ 4040; 4077 /T
+ 0177; 7701 /U
+ 0176; 7402 /V
+ 0677; 7701 /W
+ 1463; 6314 /X
+ 0770; 7007 /Y
+ 4543; 6151 /Z
+ 4177; 0000 /[
+ 3040; 0106 /\
+ 0000; 7741 /]
+ 2000; 2076 /^
+ 1604; 0404 /_
+
+ $
+\f
--- /dev/null
+/33 OS/8 V3D BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ABSTRACT--
+/BUILD IS THE SYSTEM CONFIGURATOR FOR THE OS/8 PROGRAMMING
+/SYSTEM. WITH BUILD, THE DEVICES WITHIN A PARTICULAR
+/SYSTEM CAN BE RAPIDLY AND EASILY CHANGED. BUILD ALSO
+/PROVIDES THE FACILITY FOR CREATING AN INITIAL OS/8 SYSTEM
+/FROM BINARY PAPER TAPES OR CASSETTES.
+
+/V3 CHANGES
+
+/0. MADE BUILD SUPPORTABLE
+/1. ADDED VE COMMAND (CURRENT VERSION # IS 3X WHERE X IS PATCH LEVEL)
+/2. FIXED PROBLEM WITH Z'S AND 9'S IN FILENAMES
+/3. CHANGED LENGTH OF DF32
+/4. FIXED PROBLEM WITH RK8 BOOTSTRAP RECORD.
+/5. ON LOAD, NULL EXTENSION FIRST SEARCHES FOR .BN
+/6. CR TO $ DOESN'T GIVE ERROR
+/7. FIXED BUG WITH BUILDING ROM SYS
+/8. RUBOUTS TO BOL GIVE $
+/9. ^U RETYPES $
+/10. ASSUME DSK: IF NO DEV GIVEN WITH LOAD
+/11. NO DOT IS PRINTED IF NO EXTENSION
+/12. ^O STUFF NEW
+/13. ALLOW PARITY ^C
+/14. ADDED EXAMINE COMMAND
+/15. FIXED BUG RE ACCESSING USR TABLE VIA POINTER
+/16. CLEANED UP MOVE ROUTINE
+/17. CLEANED UP NUMBER TOO BIG CHECKER
+/18. OVERFLOW ERROR MESSAGE CHANGED TO 'BAD ORIGIN'
+/19. DON'T ALLOW NAMES OVER 6 CHARS TO SPILL INTO EXTENSION;
+/ DON'T ALLOW MULTIPLE EXTENSIONS
+/20. INCREASED NUMBER OF ALLOWABLE ENTRY PTS/HANDLER TO 16 (DEC)
+/21. CLEANED UP SYMBOL PRINT ROUTINE
+/22. GOT NAMES IN TABLE TO LINE UP.
+/23. INSERT GRPNAME <CR> INSERTS FIRST HANDLER
+/24. INSERT GRP,DEV1,DEV2,DEV3,...
+/25. INSERT GRP,DEV1-5,...
+/26. SAME FOR DELETE AND REPLACE
+/27. COUNT DEVICES AND SLOTS ONLY ON BOOT
+/28. FIXED BUG RE SYS RF08=4023
+/29. GENERAL SUPPORT OF 2-PAGE SYS HANDLERS
+/30. ADDED QL COMMAND
+/31. SETS SA=00200, JSW=0
+/32. UNLOAD UNLOADS AND DELETES
+/33. ADDED DSK COMMAND
+/34. BUILD COMMAND
+/35. PRINT TELLS YOU ABOUT DSK
+/36. TOOK OUT LOC DEPENDENT CHECK FOR SYSTEM HANDLERS
+/37. INSERT ALLOWS SETTING # OF PLATTERS
+/38. HANDLER HEADER LOADS DIRECTLY INTO DESCRIPTOR TABLE
+/39. USES EXTRA CORE IF AVAILABLE (ALSO CHECKS SOFTWARE CORE SIZE)
+/40. STOPS ECHOING ON INPUT LINE OVERFLOW
+/41. *'S SYSTEM DEVICE
+/42. REMEMBERS SYS ACROSS A BOOT
+/43. 'Y' INSTEAD OF 'YE'
+/44. BO CHECKS DCB IN CORE TO SEE IF NEED REWRITE MONITOR
+/45. ALLOW UNLOADING ENTRY POINT NAMES
+/46. CTL COMMAND
+/47. EACH COMMAND HAS ITS OWN MAXIMUM INPUT LINE SIZE
+/48. ADDED CORE COMMAND
+/49. FIXED ^U TO WRITE ZERO DIRECT MSG BUG
+/50. HIT CONTINUE AFTER 'SYS ERR' TO RETRY
+/51. PRESERVED DATE ACROSS BOOT
+/52. MULTIPLE LOADS AND UNLOADS
+/53. LOAD FROM SCRATCH USES INTERNAL ACTIVE HANDLERS
+/54. CASSETTE SUPPORT
+/55. SETS CORE CONTROL BLOCK
+
+/CHANGES SINCE FIELD RELEASE
+
+/A 'NO ROOM' DOESN'T PRINT 'BAD LOAD'
+/B NO. OF ENTRY POINTS NOW CORRECTLY CHECKED FOR
+/C FIXED BUG RE BUILDING TD8E FROM TD8E
+/D BOOT CMD DISABLES BUILD CMD
+/E JSW SET TO 1 BEFORE CHAINING TO ABSLDR
+/F P CMD BUG FIXED
+/G ALTER BUG FIXED
+/H LENGTH OF INPUT LINE SYMBOLIC
+/I SOFCOR STUFF OPTIMIZED
+/J QL DOESN'T PRINT SPACE BETWEEN SYS'S GRP:NAME
+/K FIXED BUG IN 32K
+/L PAPER TAPE PUTS HLT IN 7600
+
+/THINGS TO DO:
+
+/? DIES IF DATA OCCURS BEFORE *0
+/? BOOT.ZE, .NZ CMD?
+/? GET 2-PAGE BIT OF CURRENT SYSTEM
+
+/CHANGES FOR MAINTENANCE RELEASE V3C:
+
+/ 7-AUG-75
+
+/1. CHANGED VERSION NUMBER TO V5
+/2. INCORPORATED PATCH SEQ #1 (DSN APRIL 1975)
+/ ZERO LOCATION SOFSET WHILE BUILDING
+/3. INCORPORATED PATCH SEQ #2 (DSN NOV. 1974)
+/ DISMISS USR AFTER ?NAME ERROR
+/4. INCORPORATED PATCH SEQ #3 (DSN MARCH 1975)
+/ DECREASE SYSTEM SIZE BY 5 (FOR ABSLDR) WHEN BUILDING FROM PAPER TAPE
+/5. INCORPORATED PATCH SEQ #4 (DSN APRIL 1975)
+/ ADDED 'SIZE' COMMAND TO BUILD
+/6. FIXED BUG WHICH CAUSES SYSXY.RS NOT FOUND TO BE PRINTED
+/ ON BOOTXY.RS COMMAND
+
+/CHANGES FOR V3D:
+
+/ 1-MAY-77
+
+/1. FIXED PROBLEM WITH CASSETTE BUILD (JSW WAS SET WRONG)
+/2. ALLOWED SAVING OF HIGH-ORDER DATE BITS
+\f/BUILD PAGE 0
+ *1
+ HLT /SAFETY HALT AND PATCH SPACE
+SAV1, 0
+SAV2, 0 /SAVES GROUP NAME
+ *10 /AUTO INDEX REGISTERS
+XR1, 0 /GENERAL PURPOSE REGISTERS
+XR2, 0
+XR3, 0
+XR4, 0 /USED TO BUILD IMAGE TABLES
+XR5, 0
+LXR, 0
+GNMXR, 0
+L600, 600
+
+ *20
+COUNT, 0 /GENERAL COUNTER LOCATION
+CHAR, 0 /CHARACTER BUFFER
+TEMP, 0 /TEMPORARIES
+TMP1, 0
+
+
+ BUFFER=5400
+ BINARY=6000
+ DEVBUF=0400 /FIRST HANDLER AT 10400
+ /FOR REASONS TOO LONG TO GO INTO HERE,
+ /BUT WHICH HAVE TO DO WITH CURIOUS
+ /PROPERTIES OF THE NUMBER 0,
+ /HANDLERS CAN'T START AT 0.
+ /THEY COULD HAVE STARTED AT 200.
+ SOFSET=7747 /SYSTEM OFFSET. (CURRENTLY =0)
+ PG7600=BUFFER /RECORD 0 (IMAGES OF BOTH 7600'S)
+
+ LDRCTL=4113 /CHECK OS/8 ASSEMBLY
+NAME1, 0 /NAME1-4 HOLDS FILE AND DEVICE NAMES
+NAME2, 0
+NAME3, 0
+NAME4, 0
+TABLMT, DSCTAB /HIGH CORE END OF DESCRIPTORS
+ /FIRST FREE LOCATION
+SIZE, 0
+HNDPTR, DEVBUF /POINTS TO FIRST FREE LOCATION IN HANDLER TABLE
+
+ BLDSAV=75 /**** WILL DESTROY PREVIOUS FILES
+ /START OF 40 BLOCK TO SAVE BUILD IN
+ HDRSIZ=10 /NUMBER OF ITEMS IN A DESCRIPTOR
+DSCPTR, DSCTAB /ALWAYS POINTS TO BEGIN OF CURRENT DESCRIPTOR
+\fSLOT, 0
+DSKG1, 0 /NAME OF 'DSK'
+DSKG2, 0
+DSKP1, 0
+DSKP2, 0
+NEWPAG, 0
+OLDPAG, 0
+NEWCOR, 0 /NEW CORE MAX
+SAVDAT, 0 /REMEMBERS DATE ACROSS A BOOT
+ DATEWD=7666
+FLAG2, 1 /0 IF PREVIOUS SYSTEM HAD A 2-PAGE HANDLER
+/SAMSYS, 1 /0 IF DIDN'T SPECIFY NEW SYS
+ BLOK66=0
+SYSDCB, 0
+ SA=7744
+ JSW=7746
+/BOOTDV, 0 /HANDLER ADDRESS OF DEVICE WE'RE BOOTSTRAPPING TO
+SAVHID, 0 /HIGH-ORDER DATE (BITS 3-4)
+\f/BEGLIN: 72 CHAR LINE BUFFER
+
+/NEW BUILD CORE ALLOCATION:
+
+/0000-5177 BUILD (ABSLD MUST BE ABOVE 4177)
+/5400-5777 DEVICE HANDLER FOR LOAD
+/5200-5377 PAPER TAPE/INIT/LINE BUFFER
+/6000-6377 INPUT BUFFER FOR LOAD (TEMP LOC OF USR)
+/6400-7577 DESCRIPTOR TABLE (DSCTAB)
+
+/BINARY MUST FOLLOW BUFFER
+/FIELD 1: HANDLERS (0400-7577)
+/10000-10377 BLOK66 BUFFER
+\f *200
+
+ SKP CLA /ENTRY FROM 'R BUILD'
+ HLT /CHAIN ENTRY ADDRESS
+ TAD I [7600 /SEE IF SYSTEM ALREADY EXISTS
+ CIA
+ TAD [4207
+ SZA CLA /IF NOT, BUILD SYSTEM FROM PAPER TAPE
+ CLA IAC /NOTE FACT THAT OS/8 AINT AROUND
+ DCA I [RETSW
+ JMS CORE
+ DCA I (AMTCOR /FIGURE OUT HOW MUCH CORE WE HAVE
+ JMS I (GOOD /DO SOME INITIALIZATION; IT'LL DO YA GOOD
+CONFIG, CDF 0
+ DCA I (ECHOFLG /ALLOW TYPING
+ JMS I [CRLF
+DOLR, TAD ["$ /OUTPUT A $ BECAUSE I'M JEWISH
+ JMS I [TTYOUT
+ DCA I [SWAPER /USE CURRENT HANDLER, NO SWAP ON ^C.
+ TAD [-LNLNGT
+ JMS I [GTEXT /READ TTY LINE
+ JMP DOLR
+ JMS I [GNAME /INTERPRET THE COMMAND
+ TAD NAME1
+ SNA
+ JMP CONFIG
+ DCA CHAR /ENABLE TEST TO WORK
+\f JMS I [TEST /LOOK FOR THE COMMAND IN LIST
+ -1417;LOAD /LOAD DEVICE HANDLER BINARY
+ -2205;REPLACE /REPLACE IN SYSTEM
+ -1601;NAME /ALTER PERMANENT NAME
+ -0114;ALTER /CHANGE DEVICE HANDLER LOCATION
+ -2022;PRINT /SYSTEM STATUS
+ -2331;SYSTEM /SPECIFY SYSTEM DEVICE
+ -0217;BOOT /BOOTSTRAP THE NEW SYSTEM
+ -2516;UNLOAD /DELETE INACTIVE HANDLER
+ -0405;DELETE /DELETE ACTIVE HANDLER
+ -1116;INSERT /INSERT HANDLER IN SYSTEM
+ -2605;VERS /TYPE VERSION #
+ -0530;EXAMINE /EXAMINE LOCATION
+ -2114;QLIST /QUICK LIST
+ -0423;DSK /DSK
+ -0317;KORE /CORE
+ -0403;DCBCM /DCB
+ -0324;CTLCM /CTL
+ -2311;SIZCM /SIZE
+BD, -0225;BUILD /BUILD
+ 0 /MUST TERMINATE LIST WITH 0
+ JMP I [WHAT /DIDN'T FIND COMMAND
+
+/NEW HEADER BLOCK:
+
+/ DEVICE GROUPNAME
+/ DEVICE PERMANENT NAME
+/ DCB (R/W,TYPE,MAX # OF PLATTERS)
+/ 1/2 PAGE, SYSTEM BIT, CORES BIT, REL ENTRY PT
+/ MUST BE 0
+/ SIZE OF 1 PLATTER
+\fCORSIZ,
+GETCHA, 0
+ TAD DSCPTR
+ TAD I GETCHA
+ ISZ GETCHA
+ DCA GETEM
+ TAD I GETEM
+ JMP I GETCHA
+
+GOTCHA, 0
+ DCA GOTEM
+ TAD I GOTCHA
+ TAD DSCPTR
+ ISZ GOTCHA
+ DCA GETEM
+ TAD GOTEM
+ DCA I GETEM
+ JMP I GOTCHA
+
+ PUT=JMS I [GOTCHA
+ GET=JMS I [GETCHA
+\fGOTEM,
+CORE, 0
+ TAD I [7777
+ AND [70
+ CLL RTR
+ RAR
+ SNA
+ JMS RELCOR
+ JMP I CORE
+
+GETEM, /POINTS INTO DSCTAB
+RELCOR, 0
+ CLA IAC
+ DCA CORSIZ /MAKE RE-USABLE
+ TAD [7400
+ DCA CORX /MAKE ROUTINE REUSABLE ON 32K MACHINE
+COR0, CDF 0
+ TAD CORSIZ
+ RTL
+ RAL
+ AND COR70
+ TAD COREX
+ DCA .+1
+COR1, CDF /N
+ TAD I CORLOC
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC
+CORX, 7400
+ TAD CORX
+ TAD CORV
+ SZA CLA
+ JMP COREX
+ TAD COR1
+ DCA I CORLOC
+ ISZ CORSIZ
+ JMP COR0
+COREX, CDF 0
+ STA
+ TAD CORSIZ
+ JMP I RELCOR /LEAVE WITH HIGHEST EXISTENT BANK
+
+CORLOC, CORX
+CORV, 1400
+ PAGE
+\f/GET GETS DESCRIPTOR ITEM FROM CURRENT DESCRIPTOR
+/OP
+
+/PUT PUTS DESCRIPTOR ITEM IN AC BACK IN SPECIFIED ITEM
+/OP IN CURRENT DESCRIPTOR
+
+/ITEMS:
+
+/ACTIVE BIT 0=1 MEANS ENTRY POINT HAS BEEN INSERTED (IS ACTIVE)
+/PERM1 PERMANENT NAME (FIRST 2 CHARS)
+/PERM2 2ND 2 CHARS
+/TWOPAG BIT 0=1 MEANS 2-PAGE HANDLER, BIT 4 IGNORED, BITS 5-11 RELATIVE ENTRY POINT
+/PAGRES BITS 7-11 GIVE PAGE OF START OF HANDLER WHEN ROTATED 6 RT
+/GRPNM1 GROUP NAME (DEVICE NAME) FIRST 2 CHARS
+/GRPNM2 2ND 2 CHARS
+/DEVSIZ GIVES SIZE OF 1 PLATTER
+/PLATNUM # OF PLATTERS IN BITS 2-4
+/DSKBIT BIT 1 IS FLAG FOR 'DSK' (USED TEMPORARILY BY BUILD)
+/MAXPLT MAXIMUM NUMBER OF PLATTERS ALLOWED (IN BITS 9-11)
+/DCB D.C.B. BIT 0: FILESTRUCTURED, BITS 3-8 DEVICE TYPE
+/ BITS 9-11 MAX NO. OF PLATTERS
+/CORES BIT 2 MEANS ENTRY PT IS CORESIDENT WITH SYS HANDLER
+/SYSBIT BIT 1 IS A 1 IF THE DEVICE HAS NAME 'SYS' AND IS A SYS DEVICE
+
+/IF FIRST ENTRY OF A DESCRIPTOR IS GE 7600, THEN THIS
+/ENTRY IS A BOOTSTRAP ENTRY.
+/IT STARTS WITH THE NEGATIVE OF THE NUMBER OF WORDS IN THE
+/BOOTSTRAP (FOR THE PRECEDING DEVICE), FOLLOWED BY THAT MANY WORDS
+\f GRPNM1=0
+ GRPNM2=1
+ PRMNM1=2
+ PRMNM2=3
+ DCB=4
+ MAXPLT=4
+ DVTYPE=4
+ TWOPAG=5 /BIT 0
+ SYSBIT=5 /BIT 1
+ ACTIVE=6
+ ENTPT=5
+ PAGRES=6
+ PLATNUM=6
+ DEVSIZ=7
+ DSKBIT=6 /BIT 1
+ CORES=5 /BIT 2
+\f/READ A LINE OF TEXT RETURN 1 IS ^U RETURN
+GTEXT, 0 /ROUTINE TO COLLECT TTY INPUT
+ TAD (-BEGLIN /AC IS NON-ZERO
+ DCA ENDLIN
+ DCA I (RUBFLG /INITIALIZE RUBOUT TO \
+ TAD (BEGLIN-1
+RDTX, DCA LXR /BUFFER ADD. TO INDEX
+RDTXT, JMS I [TTYIN /READ BLOODY TELETYPE
+ TAD CHAR
+ DCA NAME1 /SETUP FOR TEST AGAIN
+ JMS I [TEST
+ -377;RBOUT /RUBOUT
+ -212;LFEED /LINE FEED..ECHO CURRENT COMMAND
+ -215;CARRET /LINE TERMINATOR
+ -233;ALTMOD /ALT MODE IN SEVERAL FLAVORS
+ -375;ALTMOD
+ -376;ALTMOD
+ -200;RDTXT /IGNORE BLANKS
+ -217;RDTXT /AS WELL AS ^O
+ -203;CTRLC /BACK TO CURRENT SYSTEM
+ -225;CTRLU /CTRLU
+ 0 /IF NOT ONE OF THESE, PUT IN BUFFER
+ TAD LXR
+ TAD ENDLIN
+ SNA CLA
+ JMP RDTXT /LINE OVERFLOW, STOP ECHOING
+ JMS I [PRNT /PRINT THE CHARACTER
+ TAD CHAR
+ DCA I LXR /AND PUT IN LINE BUFFER
+ JMP RDTXT /NO PROBLEMS YET
+\fRBOUT, TAD LXR /IS THERE TEXT TO RUB OUT?
+ TAD [1-BEGLIN
+ SNA CLA
+ JMP RBCR /NO..SO DON'T DO ANYTHING
+ TAD ["\ /YES..ECHO BACKSLASH?
+ ISZ I (RUBFLG /IF = -1, NO
+ JMS I [TTYOUT
+ CLA CMA /IGNORE CONSECUTIVE RUBOUTS
+ DCA I (RUBFLG
+ TAD LXR
+ DCA TMP1
+ TAD I TMP1
+ JMS I [TTYOUT /ECHO LAST CHAR
+XRBACK, CLA CMA
+ TAD LXR /MOVE INDEX BACK ONE
+ JMP RDTX
+CARRET, JMS I [CRLF /GENERATE 215,212
+CAR1, DCA I LXR
+ DCA I LXR /GUARD AGAINS CMD <CR>
+ TAD [BEGLIN-1
+ DCA GNMXR /SETUP FOR GNAME ROUTINE
+ ISZ GTEXT /TAKE NORMAL RETURN
+ JMP I GTEXT
+
+LFEED, DCA I LXR /A 0 TO MARK END
+ TAD [BEGLIN-1
+ DCA LXR
+ JMS I [CRLF
+ TAD ["$
+ JMS I [TTYOUT
+ECHO, TAD I LXR
+ SNA /DONE ECHOING?
+ JMP XRBACK /YES..REPOSITION LXR
+ JMS I [TTYOUT
+ JMP ECHO
+
+ALTMOD, TAD ["$ /ALT MODE ECHOES AS $
+ JMS I [TTYOUT
+ JMP CAR1
+
+CTRLU, TAD ["^
+ JMS I [TTYOUT /GENERATE ^U
+ TAD NAME1
+ TAD [100
+ JMS I [TTYOUT
+RBCR, JMS I [CRLF
+ JMP I GTEXT /TAKE ERROR RETURN
+\f GETCHR=JMS I [GETC
+ BAKCHR=JMS I [BAKC
+
+ENDLIN,
+GETNUM, 0 /PICKS UP NUMBER FROM LINE BUFF
+ /DELIM CHAR PUT IN 'CHAR'
+ /PRINTS ERROR MESSAGE IF GT 4095
+ /IF NO NUMBER, TAKES RETURN 1
+ /IF NUMBER, TAKES RET 2 WITH # IN 'SIZE'
+ DCA SIZE
+ DCA GOTSW /HAVEN'T FOUND ANY DIGITS YET
+ JMP NCHAR
+ROT, DCA TMP1
+ ISZ GOTSW /FOUND A DIGIT
+ TAD SIZE
+ AND [7000
+ SZA CLA
+ JMP I [BADARG /NUMBER .GT. 4095
+ TAD SIZE
+ CLL RTL
+ RAL /BUILD UP THE DIGIT
+ TAD TMP1
+ DCA SIZE
+NCHAR, GETCHR
+ SNA /0 ENDS THE LINE
+ JMP NUMOUT
+ TAD [-240 /IGNORE SPACES
+ SNA
+ JMP NCHAR
+ TAD (-30 /TEST LIMITS
+ CLL
+ TAD [10 /MUST BE BETWEEN 0 AND 7
+ SZL
+ JMP ROT
+ TAD (260 /RESTORE CHAR
+NUMOUT, DCA CHAR /SAVE AWAY THIS DELIMETER
+ TAD GOTSW /DID WE GET ANY DIGITS?
+ SZA CLA /?
+ ISZ GETNUM /YES
+ JMP I GETNUM /NO, RETURN
+\fGETC, 0 /GET THE NEXT CHARACTER, ADVANCE SCAN PAST IT
+ TAD I GNMXR
+ JMP I GETC
+
+GOTSW, /1 MEANS GOT A DIGIT
+BAKC, 0 /BACK UP SCAN TO THE CHARACTER JUST LOOKED AT
+ STA
+ TAD GNMXR
+ DCA GNMXR
+ JMP I BAKC
+ PAGE
+\f INIT=JMS I [INI
+ ADVDSC=JMS I [DSCADV
+ ADVBOT=JMS I [BOTADV
+
+/ JMS PRMNAM /SEARCH TABLE FOR A PERMANENT NAME
+ /GIVEN IN NAME1-NAME2
+ /POINT TO DESCRIPTOR FOR THIS NAME
+/ JMS ACTNAM /SAME BUT PERMANENT NAME MUST BE ACTIVE
+/ JMS BIGNAM /SEARCHES FOR PERM & GRP NAME (GRP NAME IN SAV1,SAV2)
+/ JMS GRPNAM /SAME BUT SEARCH FOR GROUP NAME
+
+CHKNAM, 0
+ INIT
+CHKLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
+ ADVBOT /ADVANCE OVER ANY BOOTSTRAP
+ JMP NFOUND /NO MORE- ERROR
+ GET
+NM1, GRPNM1 /GET GROUP OR PERMANENT NAME
+ CIA
+ TAD NAME1
+ SZA CLA /DO FIRST WORDS MATCH?
+ JMP CHKLUP /NO, TRY AGAIN
+ GET
+NM2, GRPNM2 /GET 2ND WORD
+ CIA
+ TAD NAME2
+ SZA CLA /2ND WORD MATCH?
+ JMP CHKLUP /NO
+ TAD BIGFLG
+ SNA CLA /WANT BOTH GROUP AND PERM NAME?
+ JMP NOBIG /NO
+ GET /YES
+ GRPNM1
+ CIA
+ TAD SAV1
+ SZA CLA
+ JMP CHKLUP
+ GET
+ GRPNM2
+ CIA
+ TAD SAV2
+ SZA CLA
+ JMP CHKLUP
+NOBIG, TAD ACTSW /FOUND MATCH
+ SNA CLA /MUST HANDLER BE ACTIVE?
+ JMP I CHKNAM /NO, RETURN
+ GET /YES
+ ACTIVE
+ SMA CLA /IS IT ACTIVE?
+ JMP CHKLUP /NO, TRY AGAIN
+ JMP I CHKNAM /YES, RETURN
+\fGRPNAM, 0
+ TAD (GRPNM1 /WANT TO SEARCH FOR GROUP NAME
+ DCA NM1
+ TAD (GRPNM2
+ DCA NM2
+ DCA ACTSW /NEED NOT BE ACTIVE
+ DCA BIGFLG
+ JMS CHKNAM /GO SEARCH
+ JMP I GRPNAM
+
+ACTSW, 0 /1 MEANS HANDLER MUST BE ACTIVE
+
+PRMNAM, 0
+ DCA ACTSW /AC MAY BE NON ZERO (TO MEAN ACTIVE ONLY)
+ TAD (PRMNM1 /WANT TO SEARCH FOR PERMANENT NAME
+ DCA NM1
+ TAD (PRMNM2
+ DCA NM2
+ DCA BIGFLG
+ JMS CHKNAM /GO SEARCH
+ JMP I PRMNAM
+
+ACTNAM, 0
+ CLA IAC /THEY MUST BE ACTIVE
+ JMS PRMNAM
+ JMP I ACTNAM
+
+BIGNAM, 0
+ DCA ACTSW
+ TAD (PRMNM1
+ DCA NM1
+ TAD (PRMNM2
+ DCA NM2
+ CLA IAC
+ DCA BIGFLG
+ JMS CHKNAM
+ JMP I BIGNAM
+
+/SOMETIMES CHKNAM CAME FROM DSKASK INSTEAD OF GETSYS ****
+
+BIGFLG, 0 /SET TO 1 TO CHECK GROUP & PERMANENT NAME
+\fNFOUND, JMS I [PRNAME
+ JMS I [PRWD
+ TEXT / NOT FOUND/
+ JMP I [CONFIG
+
+NOROOM, JMS I [PRWD
+ TEXT /?NO ROOM/
+ DCA I TABLMT /RESTORE SENTINEL 0
+ JMP I [CONFIG
+
+VERS, JMS I [PRWD
+ TEXT /BUILD V6A/
+ JMP I [CONFIG
+
+/BUILD CORE CONTROL BLOCK
+
+BLDCCB, -2 /2 SEGMENTS
+ 6203 /FIELD 0
+ 0200 /200 IS S.A.
+ 0000 /JSW
+ 0000 /0-7577
+ 3710
+ 0000 /10000-17577
+ 3700
+/GOES INTO WORDS 200-377 OF BLOCK 37
+\fOK, STA /NOW USE ORIGIN TO TELL US HOW BIG A
+ TAD I (ORIGIN /HANDLER WAS LOADED
+ AND [7600
+ TAD [200 /REMEMBER THAT ORIGIN IS ONE GREATER
+ DCA HNDPTR /THAN ACTUAL LAST LOCATION.
+ /BETTER TO USE 2-PAGE BIT
+ TAD I (NEWLIM
+ DCA TABLMT /SET NEW TABLE TOP
+ DCA I TABLMT /NEED 0 AT END
+ JMS I [COMMA
+ JMP I (LOAD
+ PAGE
+\f/LOAD A 1- OR 2-PAGE HANDLER INTO BUFFER
+/USE IT TO ABSLD
+
+SETUP, 0
+ TAD [NAME1
+ DCA FILPTR /POINT TO FILENAME AREA
+ TAD (BUFFER+1 /LOAD 2 PAGE HANDLER INTO 'BUFFER'
+ DCA DRIVER /SET UP ASSIGN DEVICE HANDLER
+ JMS I [GNAME /GET DEVICE NAME
+ TAD NAME1
+ SNA CLA
+ JMP I SETUP /NO ARG
+ ISZ SETUP
+ TAD I (RETSW
+ SZA CLA
+ JMP I (BLDLOD /WHEN LOADING STANDALONE, USE INTERNAL HANDLERS
+ TAD CHAR
+ TAD [-":
+ SZA CLA
+ JMP I (SETDSK /USE 'DSK ' IF NO DEVICE GIVEN
+ TAD NAME1
+ DCA DVNM1
+ TAD NAME2
+ DCA DVNM1+1 /LOOKUP DEVICE NAME
+GETU, JMS I (GETUSR
+ CIF 10
+ JMS I [200 /FETCH HANDLER
+ 1
+SUBLUP,
+DVNM1, 0
+LODTMP,
+DVNUM, 0 /NAME GOES IN HERE
+DRIVER, 0
+ JMP I (KICKM /NO DEVICE. RELEASE MONITOR
+ TAD CHAR
+ SZA CLA
+ JMS I [GNAME /PICK UP FILE NAME
+ TAD DVNM1+1 /DEVICE NUMBER
+ JMS I (DTYPE /SEE IF FILE STRUCTURED
+ TAD NAME1 /IF FILE STRUCTURED WITH NO NAME
+ SNA CLA /IT IS AN ERROR
+ JMP NMER /V3C
+ TAD NAME4 /SAVE ORIGINAL EXTENSION
+ DCA TEMP
+ TAD NAME4
+ SNA /IF NULL
+ TAD (0216 /TRY .BN FIRST
+TRYAGN, DCA NAME4
+ TAD DVNUM /GET DEVICE NUMBER
+ CIF 10
+ JMS I [200 /DO LOOKUP OF FILENAME
+ 2
+FILPTR, NAME1
+ 0
+ JMP LDEXT /DIDN'T FIND FILE. DO SOMETHING
+ CIF 10
+ JMS I [200 /KICK OUT MONITOR
+ 11
+ TAD DRIVER
+LOADIN, DCA I [DVICE /ENTRY POINT OF HANDLER
+ JMS I (IOPEN /IF HERE, IT WILL FIT
+ JMP I SETUP
+\fLOAD, JMS SETUP /SET UP FOR INPUT
+ JMP I [NODEV /NO LOAD DEVICE
+ STA CLL RAL /-2 DO A HANDLER LOAD
+ JMS I (LDABS
+ JMP I [BADLOD /BAD
+ TAD I TABLMT /SEE IF HEADER INFORMATION IS OK
+ SMA
+ JMP I [BADLOD
+ TAD (20 /ALLOW 16 HANDLERS/BINARY
+ SPA CLA
+ JMP I [BADINP /TOO MANY
+ TAD I TABLMT
+ DCA LODTMP /# OF LOOPS TO EXECUTE
+ TAD TABLMT
+ TAD [PAGRES+1 /POINT TO FIRST 'PAGRES' WORD
+ DCA HDPTR /GO THERE FOR DESCRIPTORS
+ TAD HNDPTR
+ JMS I [ROTL
+ DCA TEMP /PAGE OF RESIDENCE
+PGLUP, TAD TEMP
+ DCA I HDPTR /INSERT PAGE OF RESIDENCE
+ TAD HDPTR
+ TAD [HDRSIZ
+ DCA HDPTR
+ ISZ LODTMP
+ JMP PGLUP
+ TAD [2-HDRSIZ
+ TAD HDPTR
+ DCA HDPTR /POINT TO AFTER DESCRIPTORS
+ TAD HDPTR
+ CIA
+ TAD I (NEWLIM
+ SNA CLA /AT END?
+ JMP I (OK /YES
+ TAD I HDPTR /NO, MAYBE A BOOTSTRAP RECORD
+ CLL
+ TAD [200
+ SNL CLA
+ JMP I [BADLOD /NO
+ TAD I HDPTR /MAYBE
+ CIA
+ IAC /OVER COUNT
+ TAD HDPTR
+ CIA
+ TAD I (NEWLIM
+ SZA CLA
+ JMP I [BADLOD /NO
+ JMP I (OK
+\fHDPTR, 0 /POINTS INTO NEW HEADER
+
+/DESCRIPTOR TABLE DESCRIPTION:
+
+/'TABLMT' ALWAYS POINTS TO FIRST FREE LOCATION
+/'DSCPTR' ALWAYS POINTS TO BEGIN OF CURRENT HEADER BLOCK
+/ITEMS ARE OF 3 FORMS:
+/(A) GROUP COUNT: IN RANGE -1 TO -20 (IGNORED AND HAS NO MEANING)
+/ IT IS THERE FOR COMPATIBILITY WITH OLD BUILD
+/(B) HEADER BLOCK STARTS WITH NUMBER IN RANGE 0-7577
+/ CONSISTS OF 'HDRSIZ' CONSECUTIVE WORDS
+/ DESCRIBED ELSEWHERE
+/(C) BOOTSTRAP BLOCK: STARTS WITH NUMBER IN RANGE 7600-7757
+/ THIS IS THE NEGATIVE OF THE NUMBER OF WORDS TO FOLLOW
+\f/NON-SYSTEM HEADER INFO:
+
+/ - NUMBER OF ENTRY POINTS
+
+/FOR EACH ENTRY POINT:
+
+/0,1 GROUP NAME
+/2,3 ENTRY POINT NAME (PERMANENT NAME)
+/4 R/W FILE-STR, DEVICE TYPE, MAX # OF PLATTERS
+/5 1/2 PAGE, REL ENTRY PT, SYSBIT, CORES
+/6* PAGE OF HANDLER, ACTIVE BIT, # OF PLATS, DSKBIT
+/7 SIZE OF DEVICE
+
+/* SUPPLIED BY BUILD
+
+LDEXT, TAD TEMP /DIDN'T FIND FILE
+ SZA CLA
+ JMP I (KICKM /NO RESORT
+ ISZ TEMP
+ JMP TRYAGN /TRY NULL EXTENSION
+
+NMER, CIF 10 /V3C
+ JMS I [200 /DISMISS USR FROM CORE
+ 11
+ JMP I [NAMERR
+ PAGE
+\fREPLACE,JMS I (DEL /DELETE PERMANENT NAME SPECIFIED NEXT
+ TAD CHAR
+ TAD MEQ
+ SZA CLA /AFTER ALL DELETIONS, MUST FIND A "="
+ JMP I [SYNTAX /IF NOT, WARN THE GUY
+ JMS INS /IF FOUND IT, NOW PERFORM INSERTIONS
+ JMP I [CONFIG /THE GUY HAS BEEN HUMORED
+
+INSERT, JMS INS
+TSTEOL, TAD CHAR /THERE SHOULDN'T BE ANYTHING AFTER EOC
+ SNA CLA
+ JMP I [CONFIG /THERE WASN'T
+ JMP I [SYNTAX /WARN BLOKE ABOUT EXTRA STUFF
+
+DELETE, JMS I (DEL /DELETE PERMANENT NAMES SPECIFIED
+ JMP TSTEOL
+
+SYSTEM, JMS INS /SYS IS SAME AS INSERT
+ GET
+ SYSBIT
+ RTL
+ SPA SZL CLA /BUT SYSBIT OR CORES SHOULD BE ON
+ JMP TSTEOL /JUST TO HUMOR IT'S NAME
+TWOSYS, JMS I [PRWD /AND FOR COMPATIBILITY REASONS
+ TEXT /?SYS/
+ JMP I [CONFIG
+\fINS, 0
+ TAD (STL RAR
+ DCA I (ACTION /SET 'ACTION' FOR INSERTIONS
+ JMS I [TSTNAM /LOOK FOR A NAME
+ JMS I [GRPNAM /GET GROUP NAME
+ JMS SAVNAM
+ JMS I [TEST
+MEQ, -"=;ACT
+ -",;INSNAM
+ -":;INSNAM
+ 4000;ACT
+ 0
+INSNAM, JMS I [TSTNAM /GRAB A NAME
+INSGN, JMS I [BIGNAM /GET PERMANENT NAME WITH SPECIFIED GROUP NAME
+ GET
+ GRPNM1
+ CIA
+ TAD SAV1
+ SZA CLA
+ JMP I [NFOUND /MAKE SURE PERMANENT NAME FOUND
+ GET /HAS GROUP NAME PREVIOUSLY SPECIFIED
+ GRPNM2
+ CIA
+ TAD SAV2
+ SZA CLA
+ JMP I [NFOUND
+ACT, JMS I (SETACT /SET ACTIVE BIT
+COM, JMS I [TEST
+ -"-;HYPH
+ -",;INSNAM
+ -"=;INPLAT
+ 0
+ JMP I INS
+\fINPLAT, JMS I [GETNUM /AN "="
+ JMP I [SYNTAX
+ TAD SIZE
+ SNA CLA
+ JMP I [BADARG /=0 ILLEGAL
+ GET
+ MAXPLT
+ AND [7 /GET MAXIMUM # OF PLATTERS ALLOWED
+ SNA
+ IAC /0 MEANT 1
+ CMA CLL
+ TAD SIZE /COMPARE WITH USER'S REQUEST
+ SZL CLA /IS HIS REQUEST OKAY?
+ JMP BADPLT /REQUEST-SHMEST. TOO MANY PLATTERS
+ TAD SIZE
+ JMS I [ROTR
+ DCA SIZE
+ GET
+ PLATNUM
+ AND (6177
+ TAD SIZE /STORE AWAY HIS STATED NUMBER OF PLATTERS
+ PUT /FOR FUTURE USE BY 'BOOT'
+ PLATNUM
+ JMP COM /REJOIN PROCESSING
+
+BADPLT, JMS I [PRWD
+ TEXT /?PLAT/
+ JMP I [CONFIG
+\fSAVNAM, 0
+ TAD NAME1
+ DCA SAV1 /SAVE GROUP NAME
+ TAD NAME2
+ DCA SAV2
+ JMP I SAVNAM
+
+HYPH, TAD NAME2
+ AND [77
+ CIA
+ DCA DETEM
+ GETCHR
+ AND [77
+ TAD DETEM /GET CHAR AFTER HYPEN
+ SNA CLA /REACHED IT YET?
+ JMP IGET /YES, WELL TRY FOR MORE STUFF
+ BAKCHR /NO, PUT IT BACK FOR FUTURE USE
+ ISZ NAME2 /FORM NEXT SEQUENTIAL NAME
+ JMP INSGN /GO INSERT IT
+/DO WE REALLY HAVE TO START SEARCH AT CURRENT DESCR?
+
+DETEM, 0
+
+IGET, GETCHR
+ DCA CHAR
+ JMP COM
+
+NODEV, JMS I [PRWD
+ TEXT /?DEVICE/
+ JMP I [CONFIG
+ PAGE
+\fINTEM,
+SETACT, 0
+ GET
+ ACTIVE /GET ACTIVATION BIT
+ RAL
+ACTION, STL RAR /ACTIVATE IT (SET TO 'CLL RAR' TO DEACT)
+ PUT
+ ACTIVE /RESTORE
+ JMP I SETACT
+
+DEL, 0
+ TAD (CLL RAR
+ DCA ACTION
+DELNAM, JMS I [TSTNAM /PARSE OFF A NAME
+DELGN, JMS I [ACTNAM /FIND IT AS AN ACTIVE PERMANENT NAME
+ JMS SETACT /DEACTIVATE IT
+ GET
+ PLATNUM
+ AND [6177 /SET # OF PLATTERS TO 0
+ PUT
+ PLATNUM
+DCOM, JMS I [TEST
+ -"-;DHYPH
+ -",;DELNAM
+ 0
+ JMP I DEL
+
+DHYPH, TAD NAME2
+ AND [77
+ CIA
+ DCA INTEM
+ GETCHR
+ AND [77
+ TAD INTEM
+ SNA CLA /REACHED FINAL NAME?
+ JMP DGET /YES
+ BAKCHR /NO, PUT FINAL LETTER BACK
+ ISZ NAME2 /YES, BUMP TO NEXT NAME
+L0423, 423
+ JMP DELGN /DELETE NEXT ONE IN SUCCESSION
+\fDGET, GETCHR
+ DCA CHAR
+ JMP DCOM
+
+TTYIN, 0 /TTY INPUT ROUTINE
+ KSF
+ JMP .-1
+ KRB
+ SNA /LOW LEVEL BLANK IGNORE
+ JMP TTYIN+1
+ AND [177 /HANDLE PARITY
+ TAD [200
+ DCA CHAR
+ JMP I TTYIN
+\f/DSK=ACTIVE PERMANENT NAME
+/DSK=GROUPNAME:PERMANENT NAME
+/DSK=<CR> MEANS NO DSK SPECIFIED, USE 'SYS'
+
+/JUST REMEMBERS NAME (NOTHING ELSE)
+
+DSK, JMS I [GNAME /GET A NAME
+ TAD NAME1
+ SNA CLA
+ JMP NODSK
+ TAD CHAR
+ SNA
+ JMP NOCOL
+ TAD [-":
+ SZA CLA /IS IT FOLLOWED BY A ":"?
+ JMP I [SYNTAX /NO, ASSUME HE'S GIVING AN ACTIVE PERMANENT NAME
+ /THIS IS FOR COMPATIBILITY WITH OLD BUILD
+/ JMS I [GRPNAM /YES, ITS A GROUP NAME
+ TAD NAME1 /SAVE IT
+ DCA DSKG1
+ TAD NAME2
+ DCA DSKG2
+ JMS I [TSTNAM /GET PERMANENT NAME
+PN, TAD NAME1
+ DCA DSKP1 /DON'T WORRY NOW IF IT'S AROUND
+ TAD NAME2
+ DCA DSKP2
+ TAD CHAR
+ SZA CLA
+ JMP I [SYNTAX
+ JMP I [CONFIG
+
+NODSK, DCA DSKG1 /FIRST WORD 0 MEANS NONE SPECIFIED
+ JMP I [CONFIG
+
+NOCOL, JMS I [ACTNAM /IT MUST BE AN ACTIVE HANDLER
+ GET
+ GRPNM1
+ DCA DSKG1
+ GET
+ GRPNM2
+ DCA DSKG2
+ JMP PN
+\fSETDSK, TAD L0423 /DS
+ DCA I (DVNM1
+ TAD (1300 /K
+ DCA I (DVNM1+1
+ JMP I (GETU
+
+KICKM, CIF 10 /RELEASE MONITOR AND RELOAD
+ JMS I [200 /OUR DEVICES
+ 11
+ JMP I [NFOUND
+
+GETUSR, 0
+ CIF 10
+ JMS I [7700 /LOCK IN MONITOR
+ 10
+ CIF 10 /RESET RESIDENT HANDLER TABLE
+ JMS I [200
+ 13
+ JMP I GETUSR
+\f/ CODE FOR USING INTERNAL HANDLERS ON STANDALONE LOAD:
+
+BLDLOD, DCA I (FILPTR /LOAD DEV
+ JMS I [ACTNAM /MUST BE ACTIVE
+ JMS I [GETPG
+ DCA HNDLOK /LOCATION OF HANDLER
+ TAD [-400
+ JMS I [MOVE
+ CDF 10
+HNDLOK, HLT
+ CDF 0
+PBUFFER,BUFFER
+ GET
+ DCB
+ DCA BLDCB
+ GET
+ ENTPT
+ AND [177
+ TAD PBUFFER /GET ENTRY POINT OF HANDLER
+ JMP I (LOADIN
+
+BLDCB, 0 /CONTAINS DCB OF CURRENT LOAD HANDLER
+ PAGE
+\fGETPG, 0
+ GET
+ PAGRES
+ JMS I [ROTR
+ AND [7600
+ JMP I GETPG
+
+/FORMAT: NAME OLDNAME=NEWNAME
+
+NAME, JMS TSTNAM /SEE IF ARGUMENT SUPPLIED
+ /SEARCH PERMANENT TABLES
+ JMS I [ACTNAM /GET ACTIVE PERMANENT NAME DESCRIPTOR
+ TAD CHAR
+ TAD MEQL /CHECK FOR =
+ SZA CLA
+ JMP I [BADARG
+ JMS TSTNAM /GET NEW DEVICE NAME
+ TAD NAME1 /REPLACE THE NAME
+ PUT
+ PRMNM1
+ TAD NAME2
+ PUT
+ PRMNM2
+ JMP I [CONFIG
+\fEXAMINE,CLA IAC
+ALTER, DCA XSWTCH
+ JMS I [TSTNAM /ALTER ALLOWS MODS TO A PARTICULAR
+ JMS I [GRPNAM /HANDLER'S ACTUAL CODE.
+ /LOOK AT DEVICE TYPE ENTRY
+ JMS GETPG /GET PAGE OF RESIDENCE
+ DCA PAGAD /SAVE IT.
+ JMS I [GETNUM /GET RELATIVE LOC TO ALTER
+ JMP I [SYNTAX /NO NUMBER
+ GET
+P2PAG, TWOPAG /IS THIS A 2-PAGE HANDLER?
+ SPA CLA
+ TAD [7600
+ TAD [7600 /ALLOW 200 OR 400 MAXIMUM
+ CLL
+ TAD SIZE /IS THE # TO ALTER TOO LARGE?
+ SZL CLA
+ JMP I [BADARG /I GUESS IT IS
+ TAD SIZE
+ TAD PAGAD /GET ABSOLUTE LOCATION
+ DCA PAGAD
+ TAD XSWTCH
+ SZA CLA /EXAMINE OR ALTER?
+ JMP EXAM /EXAMINE
+ TAD CHAR /ALTER
+ SZA CLA /CR?
+ JMP GETVAL /NO
+ JMS EXAMSB /YES, GIVE GUY OLD VALUE FIRST
+ODTL, TAD ["/ /ODT LIKE
+ JMS I [TTYOUT
+ TAD [-100
+ JMS I [GTEXT
+ JMP ODTL
+GETVAL, JMS I [GETNUM /GET NEW CONTENTS
+ JMP I (TSTEOL /NO NUMBER
+ TAD SIZE
+ CDF 10
+ DCA I PAGAD /REPLACE THAT LOC.
+ JMP I [CONFIG /AND GET OUT
+PAGAD, 0
+
+/ALTER GROUPNAME,LOC=NEWVALUE
+/ALTER GROUPNAME,LOC
+/EXAMINE GROUPNAME,LOC
+\f/SIZE ACTNAM
+/SIZE ACTNAM=VALUE
+/DCB ACTNAM
+/DCB ACTNAM=VALUE
+/CTL ACTNAM
+/CTL ACTNAM=VALUE
+
+SIZCM, TAD (3 /SIZE COMMAND V3C
+DCBCM, TAD [-1 /EXAMINE DCB WORD
+CTLCM, TAD P2PAG /EXAMINE CONTROL WORD
+ DCA PUTAT
+ TAD PUTAT
+ DCA LOOKAT
+ JMS I [TSTNAM /GET A NAME
+ JMS I [ACTNAM /IT MUST BE ACTIVE
+ JMS I [TEST
+MEQL, -"=;INPDCB
+ 4000;EXAMDCB
+ 0
+ JMP I [SYNTAX
+INPDCB, JMS I [GETNUM
+ JMP I [CONFIG /IGNORE = NOTHING
+ TAD SIZE
+ PUT
+XSWTCH, /0 MEANS ALTER, 1 MEANS EXAMINE
+PUTAT, DCB
+ JMP I [CONFIG /THE USER LIVES DANGEROUSLY
+
+EXAMDCB,GET
+LOOKAT, DCB
+ JMS PUTNUM
+ TAD ["/
+ JMS I [TTYOUT
+ TAD [-100
+ JMS I [GTEXT
+ JMP EXAMDCB
+ JMP INPDCB /NOW PARSE OFF THE REPLY
+\fEXAM, JMS EXAMSB
+ JMP I [CONFIG
+
+EXAMSB, 0
+ CDF 10
+ TAD I PAGAD /GET CURRENT CONTENTS
+ CDF 0
+ JMS PUTNUM /PRINT IT
+ JMP I EXAMSB
+
+PUTNUM, 0 /PRINT AN OCTAL NUMBER
+ DCA PTM
+ TAD [-4 /4 DIGITS
+ DCA PKNT
+PLOOP, TAD PTM
+ RTL
+ RTL
+ AND [7
+ TAD (60
+ JMS I [TTYOUT
+ TAD PTM
+ RTL
+ RAL
+ DCA PTM
+ ISZ PKNT
+ JMP PLOOP
+ JMP I PUTNUM
+PTM, 0
+
+PKNT,
+TSTNAM, 0
+ JMS I [GNAME /COLLECT NAME
+ TAD NAME1 /IF NO NAME FOUND, GIVE ERROR
+ SZA CLA
+ JMP I TSTNAM
+NAMERR, JMS I [PRWD
+ TEXT /?NAME/
+ JMP I [CONFIG
+ PAGE
+\f/PRINT FUNCTION TYPES OUT THE STATUS OF BUILD ON COMMAND
+/AN * BESIDE A DEVICE INDICATES THAT IT IS CURRENTLY MARKED
+/FOR INSERTION IN THE SYSTEM BEING BUILT.
+
+TTY240,
+PRINT, STA
+ DCA OLDPAG /SET ILLEGAL OLD PAGE
+ INIT
+ ISZ I (LINEUP /MAKE THINGS LINE UP
+PRLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
+ ADVBOT /ADVANCE PAST A BOOTSTRAP (IF ANY)
+ JMP DONE /ALL DONE
+ JMS I [GETPG /GET PAGE OF NEW HANDLER
+ DCA NEWPAG
+ TAD NEWPAG
+ CIA
+ TAD OLDPAG /COMPARE WITH LAST HANDLER'S PAGE
+ SNA CLA /SAME?
+ JMP PRTPER /YES
+ JMS I [CRLF /NO, GO TO NEXT LINE
+ TAD NEWPAG
+ DCA OLDPAG
+ JMS PGNAME
+ TAD TTY240
+ JMS I [TTYOUT
+PRTPER, GET /GET ACTIVE BIT
+ ACTIVE
+ SPA CLA /IS IT ACTIVE?
+ TAD ("*-STA /YES, PRINT *
+ TAD TTY240 /NO, PRINT SPACE
+ JMS I [TTYOUT
+ JMS PNAME /PRINT PERMANENT NAME
+ JMP PRLUP
+
+PGNAME, 0
+ GET
+ GRPNM1
+ JMS I (PRINTE /PRINT GROUP NAME
+ GET
+ GRPNM2
+ JMS I (PRINTE
+ TAD (":
+ JMS I [TTYOUT
+ JMP I PGNAME
+\fDONE, DCA I (LINEUP /NO MORE LINE-UP
+ TAD DSKG1
+ SNA CLA
+ JMP TELCOR
+ JMS I [CRLF /TELL GUY ABOUT 'DSK'
+ JMS I [CRLF
+ JMS I [PRWD
+ TEXT /DSK=/
+ TAD DSKG1
+ JMS I (PRINTE
+ TAD DSKG2
+ JMS I (PRINTE
+ TAD (":
+ JMS I [TTYOUT
+ TAD DSKP1
+ JMS I (PRINTE
+ TAD DSKP2
+ JMS I (PRINTE
+TELCOR, TAD NEWCOR
+ SNA
+ JMP I [CONFIG /NO SPECIFIED CORE LIMIT
+ JMS I [ROTL
+ TAD (6000
+ DCA CORMSG+3
+ JMS I [CRLF
+ JMS I [PRWD
+CORMSG, TEXT /CORE= /
+ JMP I [CONFIG
+\f/QUICK PRINT
+
+QLIST, INIT
+QLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
+ ADVBOT /ADVANCE OVER ANY BOOTSTRAP IF NECESSARY
+ JMP DONE /GO AWAY WHEN NO MORE
+ GET
+ ACTIVE /GET ACTIVE BIT
+ SMA CLA /IS IT ACTIVE?
+ JMP QLUP /NO, IGNORE IT
+ GET /YES
+ SYSBIT
+ RAL
+ SPA CLA /IS IT 'SYS'?
+ JMS PGNAME /YES, PRINT GROUP NAME TOO
+ JMS PNAME /NO, PRINT PERMANENT NAME ONLY
+ JMP QLUP
+
+DT,
+PNAME, 0
+ GET
+ PRMNM1
+ JMS I (PRINTE
+ GET
+ PRMNM2
+ JMS I (PRINTE
+ TAD TTY240
+ JMS I [TTYOUT
+ JMP I PNAME
+\f DCBTBL=7760
+
+WHAT, JMS I [PRNAME
+ JMS I [PRWD
+ TEXT /?/ /FOR WHEN A COMMAND ERROR OCCURS
+ JMP I [CONFIG
+
+
+DTYPE, 0 /RETURNS TYPE OF OUTPUT
+ TAD (DCBTBL-1
+ DCA DT /ENTRY AC HAD DEVICE #
+ CDF 10
+ TAD I DT /IF FILE DEVICE, LINK=0
+ CDF 0
+ CMA RAL /ALSO, IF FILE AC=0 ON EXIT
+ CLA RAL
+ JMP I DTYPE
+\fWRITCC, 0
+ TAD [-6 /PUT IN DATA BREAK FILLERS
+ JMS I [MOVE
+ CDF 0
+ K7750
+ CDF 0
+ PG7600+200+150
+ TAD (4200
+ JMS I [SYS /WRITE NEW CCB
+ BLDCCB-200
+ 37
+ JMP I WRITCC
+ PAGE
+\fTOOMANY,JMS I [PRWD
+ TEXT /?HANDLERS/
+ JMP I [CONFIG
+
+BADLOD, JMS I [CRLF
+ JMS I [PRWD
+ TEXT /?BAD LOAD/
+ DCA I TABLMT /RESTORE SENTINEL 0
+ JMP I [CONFIG
+\fTEST, 0 /TEST CHAR AGAINST ARGUMENTS
+ TAD I TEST /PICK UP ARGUMENT FROM LIST
+ SNA /0 TERMINATES
+ JMP I TEST
+ TAD CHAR /SEE IF THEY COMPARE =
+ AND (3777 /COMPARE ONLY LOW ORDER, THUS ALLOWING '4000' TO MEAN '0'
+ SNA CLA
+ JMP TSTOVR /THEY DO..DISPATCH TO TABLE
+ ISZ TEST
+ ISZ TEST
+ JMP TEST+1 /THEY DON'T. KEEP GOING
+TSTOVR, ISZ TEST
+ TAD I TEST
+ DCA TEMP
+ JMP I TEMP
+
+K7750, 7750 /DATA BREAK FILLERS
+ 7751
+ 7752
+ 7753
+ 7754
+ 7755
+
+SYS, 0 /SAVES A FEW WORDS IN SYSTEM CALLS
+ DCA SYCTL /SAVE FUNCTION WORD
+ TAD I SYS
+ DCA SYBUF /BUFFER BEING USED
+ ISZ SYS
+ TAD I SYS
+ DCA SYREC /RECORD #
+ ISZ SYS /THERE IS NO ERROR RETURN
+/IF SWAPER SET AND BOOTDV SET, USE SPECIAL BOOT HANDLER HERE
+GO, JMS I SYSENT
+SYCTL, 0
+SYBUF, 0
+SYREC, 0
+ SKP CLA
+ JMP I SYS
+ JMS I [PRWD
+ TEXT /SYS ERR/
+ HLT /IF USER IS DARING, HIT CONTINUE TO RETRY
+ JMP GO
+
+SYSENT, 7607
+\f/*****************
+/
+/ SYS HANDLER IS 2-PAGES LONG IF LOCATION 7612 IS A 3
+/
+/******************
+
+CLRTBL, 0
+ TAD [BEGLIN
+ DCA XR1
+ TAD [-200 /ZERO OUT 5200-5377
+ DCA TMP1
+ DCA I XR1
+ ISZ TMP1
+ JMP .-2
+ JMP I CLRTBL
+
+/FOR HANDLER ONLY
+ORGLIM, 0 /THIS ROUTINE MAKES CERTAIN THAT
+ DCA CLRTBL /THE ORIGIN FOR LDABS IS WITHIN
+ TAD CLRTBL /THE BOUNDS SPECIFIED BY SIZE
+ TAD [7600 /AND THE CONTENTS OF HNDPTR
+ SPA
+ JMP BADORG /ORIGIN BELOW 200
+ CIA
+ TAD [400 /IS ORIGIN WITHIN UPPER BOUND?
+ SPA CLA
+ JMP BADORG
+ TAD CLRTBL
+ TAD [7600 /NOW GIVE BACK RELATIVE BUFFER
+ TAD HNDPTR /ADDRESS IN FIELD 1
+ DCA CLRTBL
+ TAD CLRTBL
+ AND [7600
+ TAD [200
+ SNA CLA
+ JMP I (NOROOM /CAN'T 'ORIGIN' INTO PAGE 7600
+ TAD CLRTBL
+ JMP I ORGLIM
+
+BADORG, JMS I [PRWD
+ TEXT /?ORIGIN/
+ JMP I (OVROUT
+
+/SOMEWHERE TEST IF HE GAVE US A 2-PAGE BUT REQ A 1-PAGE
+\f/ PG7600_0
+/ BLOK66_66
+/ IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
+
+RECZRO, 0 /READS FIELD 1 CODE, EVEN FOR 12K TD8E
+ TAD [200
+ JMS I [SYS /READ RECORD 0
+ PG7600
+ 0 /THAT NORMALLY CONTAINS FIELD 1
+ TAD (210
+ JMS I [SYS /READ RECORD 66
+ BLOK66
+ 66
+ TAD FLAG2 /DID PREVIOUS SYSTEM HAVE A 2-PAGE HANDLER?
+ SZA CLA
+ TAD [-200 /NO
+ JMS I [MOVE /YES
+ CDF 0
+ PG7600
+ CDF 10
+ BLOK66
+ JMP I RECZRO
+
+NOTNUF, JMS I [PRWD
+ TEXT /?CORE/
+ JMP I [CONFIG
+ PAGE
+\fUNLOAD, JMS I [TSTNAM /PULL OFF A NAME
+ JMS I [GRPNAM /IT HAD BETTER BE A GROUP NAME
+ JMS I [TEST
+ -":;UNLPRM
+ 4000;UNLGRP
+ 0
+ JMP I [SYNTAX
+
+UNLPRM, JMS I (SAVNAM /UNLOAD PARTICULAR HANDLER
+UNLNAM, JMS I [TSTNAM
+ JMS I [BIGNAM
+ TAD DSCPTR /DELETE A SINGLE DESCRIPTOR
+ DCA SAVPTR /DON(T DELETE HANDLER
+ TAD DSCPTR /OR BOOTSTRAP
+ TAD [HDRSIZ /NO RELOCATION NECESSARY
+ DCA LSTPTR
+ TAD TABLMT
+ JMP NOMOR
+\fUNLGRP, JMS I [GETPG /GET PAGE OF RESIDENCE
+ DCA TOMOV /START OF HANDLER
+ GET
+ TWOPAG /IS IT A 1- OR 2- PAGE HANDLER?
+ SPA CLA
+ TAD [200 /2 PAGE
+ TAD [200 /1 PAGE
+ DCA UNSIZE
+ TAD TOMOV /DELETE HANDLER AND MOVE ALL FOLLOWING DOWN
+ TAD UNSIZE
+ DCA FROMOV /GET FIRST LOCATION AFTER HANDLER
+ TAD HNDPTR /GET NEXT FREE LOCATION FOR HANDLER
+ CIA
+ TAD FROMOV /GET NUMBER OF LOCS TO MOVE
+ JMS I [MOVE
+ CDF 10
+FROMOV, 0
+ CDF 10
+TOMOV, 0 /UPDATE POINTERS; SEARCH DESCRIPTORS
+ TAD UNSIZE /FOR REFS TO MOVED HANDLERS AND DECREASE
+ CIA /THOSE REFS BY -UNSIZE
+ TAD HNDPTR
+ DCA HNDPTR /FREES SOME BUFFER SPACE
+ TAD TABLMT
+ DCA OLDTOP /REMEMBER ORIGINAL TOP OF STACK
+ STA /BACK UP OVER GROUP COUNT
+ TAD DSCPTR
+ DCA SAVPTR /REMEMBER THIS LOCATION
+ TAD UNSIZE
+ JMS I [ROTL
+ CIA
+ DCA UNSIZE
+ TAD DSCPTR
+ TAD [HDRSIZ
+ DCA LSTPTR /'LSTPTR' POINTS TO FIRST DESCRIPTOR BEING MOVED
+\f/COMPRESS THE DESCRIPTORS ABOVE THIS ONE
+
+ADV, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
+ JMP BADV /ENCOUNTERED A BOOTSTRAP RECORD
+ JMP NOMORE /NO MORE, THROUGH
+GT, JMS I [GETPG /GET PAGE OF THIS DESCRIPTOR
+ CLL CIA
+ TAD TOMOV /COMPARE WITH PAGE OF DELETED HANDLER
+ SNA CLA
+ JMP SAMPAG /THEY'RE THE SAME
+ SZL /THEY'RE NOT THE SAME. WHICH IS HIGHER?
+ JMP ADV /IT WAS BELOW HANDLER. NO SWEAT.
+ GET /IT WAS ABOVE HANDLER, HAVE TO ACCOUNT FOR THIS
+ PAGRES /POINT TO NEW HANDLER LOCATION
+ TAD UNSIZE
+ PUT
+ PAGRES
+ JMP ADV /CONTINUE
+SAMPAG, TAD [HDRSIZ
+ TAD DSCPTR
+ DCA LSTPTR /NOTE LOCATION OF NEXT DESCRIPTOR
+ JMP ADV
+/ADVANCE PAST BOOTSTRAP OR DELETE IT AS NECESSARY
+BADV, TAD DSCPTR
+ CIA
+ TAD LSTPTR
+ SZA CLA /IS THIS BOOT PART OF GROUP BEING UNLOADED?
+ JMP BDV /NO
+ TAD I DSCPTR /YES
+ CIA
+ IAC
+ TAD DSCPTR
+ DCA LSTPTR /SET 'LSTPTR' TO BEGIN OF NEXT DESCRIPTOR
+BDV, ADVBOT /ADVANCE OVER BOOTSTRAP
+ JMP NOMORE /DONE
+ JMP GT /GO ON TO NEXT DESCRIPTOR
+\f/ALL DESCRIPTORS FOR THE SAME HANDLER ARE CONSECUTIVE
+/MOVE DOWN DESCRIPTORS
+
+NOMORE, TAD OLDTOP
+NOMOR, CIA
+ TAD LSTPTR /MINUS # OF WORDS TO MOVE
+ JMS I [MOVE
+ CDF 0
+LSTPTR, 0 /FIRST DESCRIPTOR NOT CONSIDERED
+ CDF 0
+SAVPTR, 0 /POINTS TO INITIAL DESCRIPTOR BEING DELETED
+ TAD LSTPTR
+ CIA
+ TAD SAVPTR /GET NUMBER OF WORDS DELETED
+ TAD TABLMT
+ DCA TABLMT /UPDATE TABLMT
+ DCA I TABLMT /MUST HAVE 0 AT TABLE END SO DON'T THINK IT'S A BOOTSTRAP
+ JMS I [COMMA
+ JMP UNLNAM
+
+OLDTOP, /ORIGINAL TOP OF DESCRIPTORS
+INI, 0
+ TAD (DSCTAB-HDRSIZ
+ DCA DSCPTR
+ JMP I INI
+
+ INIT=JMS I [INI
+
+/RETURN TO CONFIG IF EOL, OR BACK IN-LINE IF COMMA
+
+UNSIZE,
+COMMA, 0
+ TAD CHAR
+ SNA
+ JMP I [CONFIG
+ TAD (-",
+ SNA CLA
+ JMP I COMMA
+ JMP I [SYNTAX
+\fBOOTQ, SZA CLA /MAY BE OVERLAID
+ JMP SAMEE
+ DCA I (DRECT /DON'T TOUCH DIRECTORY IF DIDN'T COPY SYS
+SAMF, JMS I [SYSWP
+ JMP I (BOOT4
+SAMEE, JMS I (SYSCPY /OR IF OLD DEV=NEW DEV
+ JMP SAMF
+ PAGE
+\fLOCSYS, 0
+ TAD (2331 /"SY"
+ DCA NAME1
+ TAD (2300 /"S "
+ DCA NAME2
+ DCA NAME3 /V3C
+ DCA NAME4
+ JMS I [ACTNAM /LOOK UP 'SYS'
+ JMP I LOCSYS
+
+NOSLOT, JMS I [PRWD
+ TEXT /?SLOTS/
+ JMP I [CONFIG
+
+GOOD, 0
+ TAD [4207 /RESTORE 7600 TO NORMAL
+ DCA I [7600
+ TAD [5000
+ DCA I [7601
+ TAD (CDF CIF
+ DCA I [SA /SET SA=00200
+ TAD [200
+ DCA I (SA+1
+ DCA I (JSW /SET JOB STATUS WORD=0
+ STA
+ DCA I (DRECT
+ CLL STA RTL /-3
+ TAD I [7612 /FUDGE FOR 12K TD8E
+ DCA FLAG2 /SET FLAG2=0 IF PREV SYSTEM WAS 2 PAGE
+ JMP I GOOD
+\fPACK, ISZ PROTECT /OK TO PACK IT?
+ JMP PACKOK /YES
+ STA
+ DCA PROTECT /INHIBIT OTHER PACKS ALSO
+ JMP GNAME2
+PACKOK, ISZ SWIT /PACK LEFT OR RIGHT
+ JMP RIGHT
+ TAD CHAR
+ AND [77
+ JMS I [ROTL /ROTATE 6 LEFT
+ DCA I TEMP /STORE THE CHARACTER
+ JMP GNAME2
+RIGHT, CLA CMA /RESET FLIP FLOP
+ DCA SWIT
+ TAD CHAR
+ AND [77
+ TAD I TEMP
+ DCA I TEMP
+ ISZ TEMP /POINT TO NEXT WORD
+ JMP GNAME2
+PROTECT,0 /-1 MEANS DON'T ACCEPT CHAR, IGNORE IT
+SWIT, 0
+\fDOT, CLA CMA
+ DCA SWIT
+ TAD (-3 /NOW ALLOW ONLY A 2-CHAR EXTENSION
+ DCA PROTECT
+ TAD (NAME4
+ DCA TEMP
+ ISZ DOTCNT /HAD WE SEEN A DOT BEFORE?
+ JMP SYNTAX /YES
+ JMP GNAME2 /NO
+
+DOTCNT, -1 /-1 MEANS HAVEN'T SEEN A DOT
+
+EOL, DCA CHAR
+ JMP I GNAME
+
+GNAME, 0 /COLLECT A WORD IN NAME1-NAME4
+ /LEAVE DELIMITING CHAR IN 'CHAR'
+ CDF 0
+ TAD [-7 /MAX 6 CHARACTERS
+ DCA PROTECT
+ DCA NAME1 /FIRST CLEAR OUT COLLECTION AREA
+ DCA NAME2
+ DCA NAME3
+ DCA NAME4
+ CLA CMA
+ DCA SWIT /L-R PACKING SWITCH
+ STA
+ DCA DOTCNT /ALLOW ONLY ONE DOT PER NAME
+ TAD (NAME1
+ DCA TEMP
+GNAME2, GETCHR
+ SNA /A 0 ENDS THE SEARCH
+ JMP EOL
+ DCA CHAR
+ TAD CHAR
+ TAD (-"A /GET ONLY A-Z OR 0-9
+ CLL
+ TAD ("A-"Z-1
+ SNL CLA /IS IT A-Z?
+ JMP PACK /YES..PACK IT AWAY
+ TAD CHAR
+ TAD (-"0
+ CLL
+ TAD ("0-"9-1
+ SNL CLA
+ JMP PACK /FOUND 0-9
+ JMS I [TEST /TEST FOR DELIMITING CHARS
+ -".;DOT /ADVANCE POINTERS
+ 0
+ JMP I GNAME
+\fSYNTAX, JMS I [PRWD
+ TEXT /?SYNTAX/
+ JMP I [CONFIG
+
+DSKBAD, JMS I [PRWD
+ TEXT /?DSK/
+ JMP I [CONFIG
+\f SRES=BEGLIN+60 /RESIDENCY TABLE
+ SDCB=BEGLIN+100 /DCB
+ SHND=BEGLIN+120 /SLOT ASSSIGNED?
+ SNAME=BEGLIN+140/NAME
+ SBUFF=BEGLIN+160/ADDRESS OF HANDLER
+
+
+/ SYSTEM TABLES:
+
+/THOSE IN USR:
+
+/PDNT PERMANENT DEVICE NAME TABLE (SNAME)
+/ POINTED TO BY LOCATION 10036 IN USR
+/ CONTAIN HASH CODE OF DEVICE NAME
+/ ADD TWO WORDS OF NAME TOGETHER AND TURN ON BIT 0
+/ IF SECOND WORD WAS NON-ZERO
+/ AN ENTRY OF 0 MEANS THERE IS NO DEVICE FOR THAT ENTRY
+
+/DHIT DEVICE HANDLER INFORMATION TABLE (SHND)
+/ POINTED TO BY LOCATION 10037 IN USR
+/ BIT 0 =1 IF THIS IS A TWO-PAGE HANDLER
+/ BITS 1-4 RELATIVE BLOCK LOCATION OF HANDLER ON SYSTEM DEVICE
+/ (BLOCK SLOT). ADD 15 TO GET ACTUAL BLOCK #.
+/ BITS 5-11 RELATIVE ENTRY POINT OF HANDLER
+
+
+/DHRT DEVICE HANDLER RESIDENCY TABLE (SRES)
+/ IN LOCATIONS 17647-17665
+/ ACTUAL ENTRY POINT OF HANDLER
+/ WE ONLY CARE ABOUT IT IF THE HANDLER IS RESIDENT.
+/ OTHERWISE IT'S ZERO.
+/ THE SYSTEM HANDLER AND ALL HANDLERS CORESIDENT WITH
+/ IT ARE ALWAYS RESIDENT IN CORE AND HAVE THIS ENTRY NON-0.
+
+
+/DCWT DEVICE CONTROL WORD TABLE (SDCB)
+/ RESIDES IN LOCATIONS 17760-17776
+/ BIT 0 1 IF DEVICE IS FILE STRUCTURED
+/ BIT 1 1 IF THE DEVICE IS READ ONLY
+/ BIT 2 1 IF THE DEVICE IS WRITE-ONLY
+/ BITS 3-8 PHYSICAL DEVICE TYPE
+/ BITS 9-11 DIRECTORY BLOCK # (WE SET TO 0)
+\f/PRE-ASSIGNED DEVICE TYPES
+
+/0 TELETYPE
+/1 HIGH SPEED PAPER TAPE READER
+/2 HIGH SPEED PAPER TAPE PUNCH
+/3 CARD READER
+/4 LINE PRINTER (ANY TYPE)
+/5 RK8 DISK
+/6 RF08 (1 PLATTER)
+/7 RF08 (2 PLATTERS)
+/10 RF08 (3 PLATTERS)
+/11 RF08 (4 PLATTERS)
+/12 DF32 (1 PLATTER)
+/13 DF32 (2 PLATTERS)
+/14 DF32 (3 PLATTERS)
+/15 DF32 (4 PLATTERS)
+/16 TC08 DECTAPE
+/17 LINCTAPE
+/20 TM8E MAGTAPE
+/21 TD8E DECTAPE (12K OR ROM)
+/22 BAT:
+/23 RK8E DISK
+/27 TU60 CASSETTES
+/30 VR12 (PDP-12 SCOPE)
+ PAGE
+\fBOOT2A, TAD (15
+ DCA SLOT /START ASSIGNING AT BLOCK SLOT 16 (16-25)
+ TAD (-17 /ALLOW 16 ACTIVE HANDLERS NOT COUNTING DSK
+ DCA COUNT
+ JMS I (CLRTBL /CLEAR OUT IN-CORE TABLES
+ TAD (SHND+1 /ASSIGN SLOTS, COUNT ACTIVE HANDLERS
+ DCA XR1 /XR1 POINTS TO SLOT TABLE (DHIT)
+ TAD (SDCB+1
+ DCA XR2 /XR2 POINTS TO DCB TABLE
+ TAD (SNAME+1
+ DCA XR3 /XR3 POINTS TO PERMANENT DEVICE NAME TABLE
+ TAD (SBUFF+1
+ DCA XR4 /XR4 POINTS TO HANDLER BUFFER ADDRESSES
+ TAD (SRES+1
+ DCA XR5 /XR5 POINTS TO RESIDENCY TABLE
+ CLA IAC /??
+ DCA OLDPAG /SET 'OLDPAG' TO A RIDICULOUS VALUE
+ INIT
+SLTLUP, ADVDSC /GO TO NEXT DESCRIPTOR
+ ADVBOT /ADVANCING OVER ANY BOOTSTRAPS
+ JMP BOOT2X /ALL DONE CREATING INTERNAL COPIES OF TABLES
+ GET
+ ACTIVE
+ SMA CLA /IS IT ACTIVE?
+ JMP INACT /NO
+ ISZ COUNT /YES, UPDATE COUNT
+ JMP ACTIV
+ JMP I (TOOMANY /TOO MANY ACTIVE HANDLERS
+
+BOOT2X,/ TAD I (SNAME /SEE IF SYS WAS SPECIFIED
+/ DCA SAMSYS /0 IF DIDN'T SPECIFY NEW SYS
+/ TAD SAMSYS
+/ SZA CLA
+/ JMP CHKDSK
+/ CDF 10
+/ TAD I (7760 /DIDN'T SPECIFY SYS SO USE CURRENT SYS
+/ CDF 0
+/ DCA I (SDCB
+/ TAD (7607
+/ DCA I (SRES
+/CHKDSK, TAD DSKG1 /WAS DSK SPECIFIED?
+/ SZA CLA
+/ JMP I (BOOT3 /YES, ALREADY SET UP
+/ TAD I (SDCB
+/ DCA I (SDCB+1
+/ TAD (7607
+/ DCA I (SRES+1
+/ DCA I (SBUFF+1
+ JMP I (BOOT3
+\fCHKRES, 0
+ JMS I [GETPG /GET PAGE OF RESIDENCE
+ DCA NEWPAG
+ TAD NEWPAG
+ TAD OLDPAG
+ SNA CLA /SAME OR PREVIOUS PAGE?
+ JMP I CHKRES /YES, SAME PAGE
+ ISZ CHKRES
+ GET /NO, A NEW PAGE, NEEDS NEW SLOT, ETC.
+ CORES
+ RTL /GET CORES BIT
+ SPA CLA /IS THIS ALLOWED TO START A NEW GROUP?
+ JMP I (TWOSYS /NO, IT MAY ONLY BE CORESIDENT WITH SOMETHING EARLIER
+ TAD NEWPAG /YES
+ CIA
+ DCA OLDPAG /GOT NEW 'OLDPAG'
+ JMP I CHKRES
+\fACTIV, JMS CHKRES
+ JMP SAMPG
+ GET
+ SYSBIT
+ RAL
+ SPA CLA /IS IT A 'SYS' HANDLER?
+ JMP I (SETSY /YES
+ JMS I (GETSLOT /NO
+ JMS I (SETSLT /SET BLOCK SLOT
+ DCA I XR1
+ TAD NEWPAG
+HNDLOC, DCA I XR4 /STORE AWAY ADDRESS OF HANDLER (OR 0 IF PREVIOUSLY USED)
+ JMS I (GETDCB
+ DCA I XR2 /SET DCB
+ GET /HASH CODE NAME
+ PRMNM2
+ DCA TEMP /SAVE 2ND WORD
+ GET
+ PRMNM1
+ TAD TEMP /ADD 2 WORDS
+ DCA TMP1 /SAVE SUM
+ TAD TEMP
+ SNA CLA /WAS 2ND WORD 0?
+ JMP NO4C /YES
+ TAD TMP1 /NO, FORCE BIT 0 ON
+ RAL
+ STL RAR
+ DCA TMP1
+NO4C, TAD TMP1 /TAKE CODED NAME
+ DCA I XR3 /SET PERMANENT NAME TABLE
+ GET
+ CORES
+ RTL /GET CORESIDENT BIT
+ SMA CLA /IS IT RESIDENT?
+ JMP NORE /NO
+ GET /YES
+ ENTPT /GET RELATIVE ENTRY POINT
+ AND [177
+ TAD [7600 /CORESIDENT ENTRY POINTS TO SYS MUST BE ON PAGE 7600
+NORE, DCA I XR5 /SET RESIDENCY TABLE
+INACT, GET /BUT MAYBE IT'S 'DSK'
+ DSKBIT
+ RTL
+ SNL CLA /IS IT DSK?
+ JMP SLTLUP /NO, IT'S TO BE IGNORED
+ JMS I (SLOTDSK /YES ASSIGN 'DSK''S LOCATION SLOT
+ GET /GET RID OF DSK BIT
+ DSKBIT
+ RTL
+ CLL RTR
+ PUT
+ DSKBIT
+ JMP SLTLUP /REITERATE
+\fSAMPG, TAD SLOT /ALREADY HAVE SLOT
+ JMS I (SETSLT
+ DCA I XR1
+ JMP HNDLOC
+
+BADARG, JMS I [PRWD
+ TEXT /?ARG/
+ JMP I [CONFIG
+ PAGE
+\f/ STEPS IN BOOTSTRAPPING:
+
+/1. ASSIGN DSK, IF SPECIFIED, MAKE SURE NFS [BOOT2]
+/2. ASSIGN SLOTS [BOOT2A]
+/3. GIVE ERROR IF TOO MANY ACTIVE OR TOO MANY SLOTS [BOOT2A]
+/4. BUILD INTERNAL COPIES OF DCB, SLOT, NAME, RES [BOOT2A]
+/5. ALSO BUILD HANDLER ADDRESS TABLE, CONTAINS [BOOT2A]
+/ HANDLER ADDRESS IF NOT PREVIOUSLY WRITTEN OUT
+/6. COMPARE DCB'S OF NEW AND OLD SYSTEM, IF DIFF, [BOOT3]
+/ COPY SYSTEM OVER. LEAVE NEW SYSTEM HANDLER
+/ IN CORE
+/7. ASK GUY ABOUT NEW DIRECTORY [BOOT4]
+/8. READ IN USR, UPDATE ITS TABLES, WRITE OUT USR [BOOTC]
+/ NAME TABLE, DHIT (SLOT, 2-PAGE,ENTPT)
+/9. READ IN CURRENT PAGE 7600 IMAGES [BOOT5]
+/ SET UP AS FOLLOWS:
+/ PG7600/L: BOOT
+/ PG7600/H: 07600 IMAGE
+/ BLOK66/L: 17600 IMAGE
+/ BLOK66/U: 27600 IMAGE
+/ THIS IS ACCOMPLISHED VIA:
+/ PG7600_0
+/ BLOK66_66
+/ IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
+/10. MOVE DCB AND RESIDENCY TABLES INTO 17600 IMAGE [BOOT6]
+/11. MOVE BOOTSTRAP INTO PAGE 7600 IMAGES (2 PLACES) [BOOT7]
+/12. WRITE OUT HANDLERS [BOOT8]
+/13. ZERO DIRECTORY IF REQUESTED [BOOTD]
+/14. PUT SYS, DATA BREAK, CORE LIM IN 07600 IMAGE [BOOTE]
+/15. WRITE 7600 IMAGES BACK OUT ONTO TAPE [BOOTF]
+/ IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
+/ 0_PG7600
+/ 66_BLOK66
+/16. READ BACK PAGE 7600 IMAGES. MOVE IN FIELD 1 STUFF
+/ EXCEPT FOR CD AREA, RESTORE TODAY'S DATE,
+/ BRANCH TO 7600
+\fGETSLOT,0
+ ISZ SLOT /USE NEXT SLOT
+ TAD SLOT
+ TAD (-26
+ SNA CLA
+ JMP I (NOSLOT
+ TAD SLOT
+ JMP I GETSLOT
+
+BOOT, ISZ I (RETSW /***?
+ CLA IAC
+ DCA I (BD /DISABLE 'BUILD' CMD
+/SEE IF ARGUMENT WAS GIVEN; TREAT IT AS BOOT DEVICE,
+/SAVE HANDLER ADDRESS (MUST BE AN ACTIVE HANDLER)
+ JMS I (LOCSYS /IN CASE DSK=SYS
+/ JMS I [GETNUM
+/ NOP
+/ TAD SIZE
+/ DCA BOOTDV /CHECK THAT # IS GT 7600
+BOOT2, TAD DSKG1 /FIND OUT ABOUT 'DSK'
+ SNA
+ JMP GOTD /DSK=SYS
+ DCA SAV1
+ TAD DSKG2
+ DCA SAV2
+ TAD DSKP1
+ DCA NAME1
+ TAD DSKP2
+ DCA NAME2
+ JMS I [BIGNAM /FIND IT IN TABLES
+GOTD, GET
+ DCB
+ SMA CLA /IS IT FILE-STRUCTURED?
+ JMP I (DSKBAD /NO
+ GET /YES
+ DSKBIT
+ RTL
+ STL RTR /TURN ON BIT 1
+ PUT
+ DSKBIT
+ JMP I (BOOT2A
+\fGETDCB, 0
+ GET
+ PLATNUM
+ JMS I [ROTL
+ AND [7 /GET # OF PLATTERS
+ SNA
+ IAC /0 MEANS 1
+ TAD [-1 /SUBTRACT 1
+ CLL RTL
+ RAL /TIMES 10
+ DCA TMP1
+ GET
+ DCB
+ AND [7770 /MASK OFF USEFUL INFO
+ TAD TMP1
+ JMP I GETDCB
+\fSLOTDSK,0
+ JMS I (CHKRES
+ JMP SMPG
+ TAD NEWPAG
+ DCA I (SBUFF+1
+ JMS GETSLOT
+ JMS SETSLT
+B, DCA I (SHND+1
+ JMS GETDCB
+ DCA I (SDCB+1
+ TAD (5723 /'DSK' HASHED
+ DCA I (SNAME+1
+ GET
+ SYSBIT
+ RTL /SYSBIT TO L, CORES BIT TO AC0
+ SNL SMA CLA /IS IT EITHER SYS OR CORESIDENT WITH SYS?
+ JMP NORE2 /NO, SO IT'S NOT CORE-RESIDENT
+ GET /YES, RESIDENT AT ALL TIMES IN 07600
+ ENTPT
+ AND [177
+ TAD [7600
+NORE2, DCA I (SRES+1
+ JMP I SLOTDSK
+
+SETSY, TAD NEWPAG
+ DCA I (SBUFF
+/ JMS SETSLT /NO BLOCK SLOT
+ DCA I (SHND
+ JMS GETDCB
+ DCA I (SDCB /SET DCB
+ TAD I (SNAME
+ SZA CLA
+ JMP I (TWOSYS
+ TAD (4631 /HASH CODING FOR 'SYS'
+ DCA I (SNAME
+/CHECK THAT NAME IS 'SYS'
+ TAD [7607
+ DCA I (SRES
+/CHECK REL ENTRY PT IS 7
+ JMP I (INACT
+
+SMPG, TAD SLOT
+ JMS SETSLT
+ JMP B
+\fSETSLT, 0
+ SNA
+ JMP .+3
+ TAD [-15
+ JMS I [ROTR
+ DCA TMP1
+ GET /
+ CORES /
+ RTL /
+ SPA SZL CLA /
+ JMP I SETSLT /SYS &CORES HANDLERS GET 0 ENTRY (UNFORTUNATELY)
+ GET
+ ENTPT
+ AND (4177
+ TAD TMP1
+ JMP I SETSLT
+ PAGE
+\f USRBLK=13 /BLOCK OF USR ON SYSTEM DEVICE
+ USRNPT=36 /POINTS TO USR PTR TO PERMANENT DEVICE NAME TABLE
+ USRHPT=37 /POINTS TO USR PTR TO DEVICE HANDLER INFORMATION TABLE
+
+BOOTC, TAD [200 /READ FIRST BLOCK OF USR
+ JMS I [SYS
+ BUFFER /INTO BUFFER
+ USRBLK
+ TAD I [BUFFER+USRNPT /GET POINTER TO NAME TABLE
+ TAD [BUFFER-400 /ADD IN OFFSET FOR RELOCATION
+ DCA T1AD /ASSUME BOTH TABLES OCCUR IN THE SECOND
+ TAD I [BUFFER+USRHPT /BLOCK OF THE USR
+ TAD [BUFFER-400
+ DCA T2AD /GET POINTER TO DHIT
+ TAD [400 /READ BLOCKS 2 AND 3 OF USR
+ JMS I [SYS /INTO BUFFER,BINARY
+ BUFFER
+ USRBLK+1
+ TAD [-17
+ JMS I [MOVE /MOVE IN PERMANENT DEVICE NAME TABLE
+ CDF 0
+ SNAME
+ CDF 0
+T1AD, HLT
+/ TAD SAMSYS /WAS SYS SPECIFIED?
+/ SZA CLA
+/ JMP CHKD2 /YES
+/ TAD I T2AD /NO, USE CURRENT SYS INFO
+/ DCA I (SHND
+/CHKD2, TAD DSKG1
+/ SZA CLA /WAS DSK SPECIFIED?
+/ JMP MVSHND /YES
+/ TAD I T2AD /MAKE SAME AS SYS
+/ DCA I (SHND+1
+MVSHND, TAD [-17 /NOW PUT IN SLOT WORDS (DHIT)
+ JMS I [MOVE
+ CDF 0
+ SHND
+ CDF 0
+TMP2,
+T2AD, HLT
+ TAD [4400 /RE-WRITE USR
+ JMS I [SYS
+L5400, BUFFER
+ USRBLK+1
+ JMP I [BOOT5
+ IFNZRO BUFFER-5400 <ERRRR,XX>
+\fBOOTD, TAD DRECT /WANT NEW DIRECTORY?
+SNACLA, SNA CLA
+ JMP BOOTE
+ TAD L5400 /YEP. WRITE ONE
+ JMS I [SYS
+ DPROPR
+ 1
+BOOTE, TAD NEWCOR
+ CLL RAL
+ RTL
+ TAD SAVHID /V3D SET NEW H.O. DATE WORD
+ DCA I [7777 /SET UP NEW CORE LIMIT
+ TAD SYSLOC /MOVE IN FRESH COPY OF SYS HANDLER
+ TAD [7
+ DCA SYSL2
+ TAD [7607-7743-1
+ JMS I [MOVE
+ CDF 10
+SYSL2, HLT
+ CDF 0
+ 7607
+ TAD [-200 /PUT SYS HANDLER INTO REC 0 BUFF. ???
+ JMS I [MOVE
+ CDF 0
+ 7600
+ CDF 0
+ PG7600+200 /RESIDENT F0 CODE
+ JMS I (WRITCC /WRITE CCB AND DATA BREAK FILLERS
+ TAD [200
+ TAD SYSLOC /MOVE IN COPY OF 27600 AGAIN
+ DCA SYSL3
+ TAD [-200
+ JMS I [MOVE
+ CDF 10
+SYSL3, HLT
+ CDF 10
+ BLOK66+200
+ JMP I (BOOTF
+
+DRECT, -1 /1 MEANS WRITE A ZERO DIRECTORY
+ /0 MEANS DON'T TOUCH DIRECTORY
+ /-1 MEANS ASK GUY FOR OPTION
+\f/SEE IF NEW SYSTEM HAS SAME DCB AS CURRENT SYSTEM
+/THIS MAY WELL CAUSE EXTRA I/O WHEN GOING FROM RF08=K TO RF08=M
+
+BOOT3, CDF 10
+ TAD I (DATEWD
+ DCA SAVDAT /SAVE TODAY'S DATE FOR FUTURE REFERENCE
+ TAD I (DCBTBL /GET DCB OF CURRENT SYSTEM
+ CDF 0
+ AND [7770
+ DCA TMP2
+ JMS I (PATCH /V3D
+ TAD SAVLOC /DON'T COPY IF DID 'BUILD'
+ SNA CLA /WAS THE 'BU' COMMAND USED?
+ TAD [-10 /NO, USE 'SZA CLA'
+ TAD SNACLA /YES, USE 'SNA CLA'
+ DCA I (BOOTQ
+ JMS SETUPSYS
+ TAD SYSDCB
+ CIA
+ TAD TMP2
+ JMP I (BOOTQ
+
+/NOTE: THIS PROCEDURE DOESN'T COPY BOOTSTRAP IF NEW DEV=OLD DEV.
+/ THEREFORE YOU CAN'T CHANGE BOOTSTRAPS
+/ CHECK ON AFFECT FOR TD8E/ROM INTERACTION
+\fSETUPSYS,0
+ DCA SAVLOC
+ TAD SAVLOC
+ DCA I (SAVLC
+ JMS I (LOCSYS
+ JMS I [GETPG /GET PAGE OF SYS HANDLER
+ DCA SYSLOC /PAGE OF START OF NEW SYSTEM HANDLER
+ JMS I (GETDCB
+ DCA SYSDCB
+ JMS I (GETLEN
+ GET
+ TWOPAG
+ DCA I (SYSSIZ
+ TAD I (SYSSIZ
+ SMA CLA /IS IT 1- OR 2-PAGES?
+ JMP ONEPG /GUESS WHAT THIS MEANS [HINT LOOK AT LABEL]
+ STA
+ TAD I (AMTCOR
+ SNA CLA
+ JMP I (NOTNUF /WE CAN'T RUN IN 8 K
+ONEPG, TAD [-400
+ JMS I [MOVE
+ CDF 10
+SYSLOC, HLT /MOVE SYSTEM HANDLER
+ CDF 10
+SAVLOC, 0 /TO 10000-10377
+ JMP I SETUPSYS
+ PAGE
+\f/ASSUMES NEW PROPOSED SYSTEM HANDLER IS IN 10000-10377
+
+/CAN'T DESTROY OS/8, IE. CAN'T USE PG 0 TEMPS
+
+SYSWP, 0 /ROUTINE TO MOVE SYS HANDLER AROUND
+ ISZ SWAPER /DIDDLE SWAP INDICATOR
+ CLA CMA /-1 MEANS NEW HANDLER IS IN
+ DCA SWAPER
+ STA
+ TAD AMTCOR
+ SNA CLA /DO WE HAVE 8K?
+ JMP SWAPLW /YES, DON'T SWAP WITH FIELD 2
+ TAD L7600 /NO, CAN'T HURT TO SWAP FIELD 2
+ DCA OUT
+ TAD SAVLC
+ TAD P200
+ DCA IN
+ TAD (4-200
+ DCA STEMP /SWAP ENTIRE PAGE (EXCEPT LAST 4 LOCATIONS)
+SWAP3, CDF 10 /SWAP 27600 & 2ND PAGE OF HANDLER
+ TAD I IN
+ DCA SYSQ
+ CDF 20
+ TAD I OUT
+ CDF 10
+ DCA I IN
+ TAD SYSQ
+ CDF 20
+ DCA I OUT
+ ISZ IN
+L7400, 7400 /NOP
+ ISZ OUT
+L7600, 7600
+ ISZ STEMP
+ JMP SWAP3
+SWAPLW, CDF 0
+ TAD (7607
+ DCA OUT /7607 ALWAYS TARGET DESTINATION
+ TAD SAVLC
+ TAD (7
+ DCA IN
+ TAD (7607-7743-1/ONLY 7607-7743 GETS MOVED
+ DCA STEMP
+SWAP2, CDF 10
+ TAD I IN
+ DCA SYSQ /TEMP STORE
+ CDF 0
+ TAD I OUT
+ CDF 10
+ DCA I IN
+ TAD SYSQ
+ CDF 0
+ DCA I OUT
+ ISZ IN
+ ISZ OUT
+ ISZ STEMP
+ JMP SWAP2
+ DCA I (SOFSET /V3C
+ JMP I SYSWP
+
+AMTCOR, 1 /HIGHEST CORE BANK
+SAVLC, 0 /MUST BE ABOVE 3577
+\fCHTMP,
+IN, 0 /POINTS TO HANDLER AREA AT ONE NAMED SYS
+OUT, 0 /POINTS TO 7607 HANDLER
+SWAPER, 0 /-1 MEANS NEW HANDLER IN
+\f/MUST BE ABOVE OS/8, NO PAGE 0 LITERALS
+
+STEMP,
+ICHAR, 0
+ JMS I (CTCTST
+ ISZ JMPGET /POINT TO CORRECT CHAR
+ ISZ CHCNT /NEED WE READ?
+JMPX, JMP JMPGET /NOT YET
+ TAD REOF /YES. DID LAST YIELD EOF?
+ SZA CLA
+ JMP I (BADINP /SOMETHING IS WRONG.
+RDIN, JMS I DVICE
+P200, 0200 /READ INTO FIELD 0
+BINBUF, BINARY
+RECNO, 0
+ JMP RERROR /READ ERROR
+RECNO2, ISZ RECNO /POINT TO NEXT RECORD
+ TAD (-601
+ DCA CHCNT /NEW CHARACTER COUNT
+ TAD BINBUF
+ DCA CHPTR
+ TAD JMPX
+ DCA JMPGET /RESET JUMP SWITCH
+ JMP ICHAR+1
+SYSQ,
+JMPGET, JMP . /IF WE GET CAUGHT HERE, WE KNOW IT
+ JMP CHAR1 /ASSEMBLE FIRST CHAR
+ JMP CHAR2 /SECOND CHAR
+ TAD JMPX /THIRD CHAR HERE
+ DCA JMPGET /RESET SWITCH
+ TAD I CHPTR
+ AND L7400
+ CLL RTR
+ RTR
+ TAD CHTMP /ADD IN THE LAST TEMP STORE
+ RTR
+ RTR
+ ISZ CHPTR /TO NEXT CHAR
+ JMP GCHCOM
+\fCHAR2, TAD I CHPTR
+ AND L7400
+ DCA CHTMP /SAVE FOR THIRD CHAR
+ ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM, AND (377
+ ISZ ICHAR /PASS UP ERROR RET
+ JMP I ICHAR
+RERROR, SPA CLA /FATAL, OR EOF?
+ JMP IOERR /FATAL
+ ISZ REOF /END OF FILE
+ JMP RECNO2 /BACK TO MAINSTREAM
+IOERR, JMS I (PRWD
+ TEXT \?I/O\
+ JMP I ICHAR
+REOF, 0
+CHCNT, 0
+CHPTR, 0
+DVICE, 0
+ PAGE
+\f/BLOCK 0 OF DEVICE CONTAINS INITIAL IMAGE
+/OF 17600 FOLLOWED BY 07600
+
+/17600-17646 CD AREA INITIALLY CONTAINS BOOTSTRAP
+/17647-17665 RESIDENCY TABLE
+/17666 DATE
+/17667-17677 PART OF OS/8 KBM
+/17700-17740 PART OF OS/8 USR
+/17741-17757 USER DEVICE NAME TABLE/ODT
+/17760-17776 CONTROL WORD TABLE (DCB)
+/17777 UNUSED
+
+/07600-07606 PART OF OS/8 CODE
+/07607-07743 SYSTEM HANDLER
+/07744-07745 STARTING ADDRESS
+/07746 JOB STATUS WORD (JSW)
+/07747 MUST BE 0 (SOFSET)
+/07750-07755 DATA BREAK LOCATIONS RESERVED FOR HARDWARE
+/07756-07775 KBM AND ODT
+/07776 MUST BE 0 (SBLOCK)
+/07777 SOFTWARE CORE SIZE, BATCH FLAGS
+
+/IF SYSTEM HANDLER IS TWO PAGES LONG, THEN WE HAVE INSTEAD:
+
+/BLOCK 66 (LOWER) CONTAINS 17600 IMAGE
+/BLOCK 66 (UPPER) CONTAINS 27600 IMAGE (MUST END WITH 4 ZERO'S)
+/BLOCK 0 (LOWER) CONTAINS BOOTSTRAP
+/BLOCK 0 (UPPER) CONTAINS 07600 IMAGE
+\fDSCADV, 0 /ADVANCE TO NEXT DESCRIPTOR
+ /RETURN 2 MEANS NO MORE
+ /RETURN 1 MEANS NOW AT BOOTSTRAP BLOCK
+ /RETURN 3 OTHERWISE
+ TAD DSCPTR
+ TAD [HDRSIZ
+ DCA DSCPTR
+ JMS I (SKPCRD /SKIP A POSSIBLE GROUP COUNT
+ TAD I DSCPTR
+ CLL
+ TAD [200
+ SZL CLA
+ JMP I DSCADV /TAKE RETURN1 UPON REACHING BOOTSTRAP RECORD
+ ISZ DSCADV
+ TAD I DSCPTR
+ SZA CLA
+ ISZ DSCADV /TAKE RETURN 2 IF ADVANCED TO END
+ JMP I DSCADV
+
+/RETURN 1 MEANS NO MORE DESCRIPTORS
+BOTADV, 0
+ TAD I DSCPTR
+ CIA
+ IAC /COUNT IS ONE MORE
+ TAD DSCPTR
+ DCA DSCPTR /POINT TO BEGIN OF NEXT DESCRIPTOR
+ JMS I (SKPCRD
+ TAD I DSCPTR
+ CLL
+ TAD [200
+ SZL CLA
+ JMP BOTADV+1 /WIERD CASE OF CONSECUTIVE BOOTSTRAPS
+ TAD I DSCPTR
+ SZA CLA
+ ISZ BOTADV /TAKE RETURN1 IF ADVANCED TO END
+ JMP I BOTADV
+
+/WIERD CASES CAN OCCUR IF GUY DELETES ALL ENTRY POINTS IN A GROUP SEPARATELY
+
+/DESCRIPTOR ENTRIES:
+
+/FIRST WORD:
+/ 0 MEANS END OF TABLE
+/ -1 TO -20 MEANS GROUP COUNT (NOT NECESSARILY ACCURATE)
+/ -21 TO -400 APPROX MEANS BOOTSTRAP RECORD COUNT
+/ OTHER MEANS DESCRIPTOR
+\fSYSCPY, 0 /COPY OS/8 SYSTEM
+ STA
+ TAD I (AMTCOR
+ SZA CLA
+ TAD [10 /GT 8K
+ DCA CORBIT
+ TAD CORBIT
+ SZA CLA
+ JMP COP2
+ JMS I [SYSWP /SWAP IN NEW SYS HANDLER
+ TAD (7410
+ JMS I [SYS /SAVE PART OF BUILD TO MAKE A BIG BUFFER
+ 400 /SAVE 400-
+ 27 /SAVE IN BLOCK 27
+ JMS I [SYSWP /GET BACK ORIGINAL HANDLER
+COP2, TAD [4210
+ JMS COPY /COPY BLOCK 0
+ 0
+ TAD (5610
+ JMS COPY /COPY 7-15
+ 7
+ TAD [4210
+ JMS COPY /COPY 26
+ 26
+ TAD (7410
+ JMS COPY /COPY 51-66
+ 51
+ TAD [4210
+ JMS COPY /COPY 67
+ 67
+ TAD CORBIT
+ SZA CLA
+ JMP COP3
+ JMS I [SYSWP /GET BACK NEW HANDLER FOR A MOMENT
+ TAD (3410 /RESTORE CORE WE SAVED
+ JMS I [SYS
+ 400
+ 27
+ JMS I [SYSWP /RESTORE ORIGINAL SYS HANDLER
+COP3, JMP I SYSCPY
+\fCOPY, 0
+ TAD CORBIT
+ DCA TMP1
+ TAD I COPY
+ DCA COPREC /ARG 1 CONTAINS FIRST BLOCK TO COPY
+ TAD COPREC
+ DCA CPREC2 /MAKE TWO COPIES
+ STL RAR /CONVERT 'WRITE' TO READ
+ TAD TMP1
+ JMS I [SYS /READ FROM ORIGINAL DEVICE
+ 400
+COPREC, HLT
+ JMS I [SYSWP
+ TAD TMP1
+ JMS I [SYS /WRITE ON NEW DEVICE
+ 400
+CPREC2, HLT
+ JMS I [SYSWP /LEAVE WITH ORIGINAL SYSTEM HANDLER STILL IN SYSTEM
+ JMP I COPY /FALL THROUGH RECORD NUMBER
+\fCORBIT,
+GETLEN, 0
+ GET /GET LENGTH OF DEVICE
+ PLATNUM
+ JMS I [ROTL /GET NUMBER OF PLATTERS
+ AND [7
+ SNA
+ IAC /0 MEANS 1
+ CIA
+ DCA COUNT
+ GET
+ DEVSIZ
+ DCA TMP1
+SIZLUP, TAD TMP1
+ SNA
+ STA /4096 BECOMES 4095
+ ISZ COUNT
+ JMP SIZLUP
+ CIA
+ TAD [70 /LEAVE ROOM FOR OS/8
+ DCA DLENGTH
+ JMP I GETLEN
+
+DPROPR, -1 /INITIAL EMPTY DIRECTORY
+ MFREE
+ 0
+ 0
+ -1
+ 0 /1 EMPTY FILE
+DLENGT, 0
+ PAGE
+\f/WANT TO COPY
+
+/SYS 0
+/KBM 7-12
+/USR 13-15
+/ENTER 26
+/CD 51-53
+/SAVE,DATE 54-55
+/ERR 56
+/CHAIN 57
+/ODT 60-63
+/CCL 64,65,67
+/SYS 66
+
+/EXTRA (DON'T WANT TO COPY):
+
+/HANDLERS 16-25
+/SCRATCH 27-50
+
+/NEW ALGORITHM:
+
+/SET FIELD 2 IF 12K OR MORE AND SKIP *'ED ITEMS
+
+/1. MOVE NEW SYS HANDLER TO 0,200
+/2.* SAVE 34 PAGES STARTING AT 10400 IN BLOCK 27 OF NEW DEVICE
+/3. COPY BLOCKS 7-15
+/4. COPY BLOCK 26
+/5. COPY BLOCKS 51-66
+/6. COPY BLOCK 67
+/7.* RESTORE 34 PAGES
+\f/THE FOLLOWING ROUTINES AND VARIABLES MUST BE ABOVE THE LOCATIONS
+/IN WHICH OS/8 AND CD LOAD INTO, BECAUSE THEY ARE CALLED BY LDABS.
+/FURTHERMORE, NONE OF THESE ROUTINES MAY USE PAGE 0 LITERALS
+/OR MAY USE ANY PAGE 0 TEMPORARIES, EXCEPT THAT SOME MAY USE
+/PAGE ZERO TEMPORARIES IF THE STORE INTO THEM FIRST
+/(EXCEPT THOSE COMMENTED OTHERWISE, WHICH MUST PRESERVE
+/THE NEW PAGE 0 AT ALL COSTS, UNTIL IT IS WRITTEN OUT
+
+/LDABS
+/ICHAR
+/BADINP
+/OVER
+/ASSEMB
+/CTCTST
+/PRWD
+/CTRLC
+/OVROUT
+/ROTL
+/PRINTE
+/TTYOUT
+/ROTR
+/PWORD
+/ECHOFL
+/LINEUP
+/CRLF
+/PRNT
+/RUBFLG
+/MOVE
+/SYSWP
+/AMTCOR
+\f SYDCB=7760 /LOCATION OF SYS,DSK DCB WORDS
+
+BOOT5, JMS I (RECZRO
+BOOT6, TAD [-17
+ JMS I [MOVE /PUT RESIDENT FIELD 1 TABLES INTO
+ CDF 0
+ SDCB /FIXED SPOTS
+ CDF 10
+ BLOK66+160
+ TAD [-17
+ JMS I [MOVE
+ CDF 0
+ SRES
+ CDF 10
+ BLOK66+47 /COULD SET USER DEVICE NAMES HERE IF DESIRED
+BOOT7, JMS I (LOCSYS
+/ TAD SAMSYS
+/ SZA CLA /SAME SYSTEM?
+/ JMP BOOT8 /YES
+BLOOK, ADVDSC /SEARCH FOR BOOTSTRAP
+ JMP FNDBOT /FOUND BOOTSTRAP RECORD AMONGST DESCRIPTORS
+ HLT /IT WASN'T THERE!
+ JMP BLOOK /KEEP LOOKING
+
+FNDBOT, TAD DSCPTR
+ IAC /POINT TO BOOTSTRAP
+ DCA FROMBO
+ TAD I DSCPTR /LENGTH OF BOOTSTRAP
+/CHECK THAT'S IT'S LE 47 LOCS IF 1-PAGE SYSTEM
+ JMS I [MOVE
+ CDF 0
+FROMBO, HLT
+ CDF 0
+ PG7600
+ TAD [-47 /MOVE FIRST 47 LOCS INTO CD AREA IN 17600 IMAGE
+ JMS I [MOVE
+ CDF 0
+ PG7600
+ CDF 10
+ BLOK66
+BOOT8, TAD (-16
+ DCA COUNT
+ TAD (SBUFF
+ DCA XR1
+ TAD (SHND
+ DCA XR2
+DVLOOP, TAD I XR1
+ SNA
+ JMP NOHN
+ DCA DVBUF /LOCATION OF HANDLER
+ TAD I XR2
+ JMS I [ROTL
+ AND [17
+ SNA
+ JMP CN /NO BLOCK SLOT
+ TAD L15 /CONVERT TO ACTUAL BLOCK #
+ DCA DVREC
+ TAD [4210
+ JMS I [SYS
+DVBUF, HLT
+DVREC, HLT
+CN, ISZ COUNT
+ JMP DVLOOP
+ JMP I (BOOTD
+NOHN, ISZ XR2
+ JMP CN
+
+SYSSIZ, 0 /MINUS MEANS 2-PAGE SYS HANDLER
+\fCTRLC, KCC /CLEAR ^C FLAG
+ TAD I (SWAPER /DO WE HAVE TO SWITCH?
+ SZA CLA
+ JMS I (SYSWP /YES. INSERT OLD HANDLER
+ JMP I (7600
+
+KORE, JMS I [GETNUM
+L15, 15 /NOTHING MEANS 0
+ TAD SIZE
+ AND [7770
+ SZA CLA
+ JMP I [BADARG /MUST BE BETWEEN 0 AND 7
+ JMS I (RELCOR /FIND REAL AMOUNT OF CORE
+ CMA
+ TAD SIZE
+ SMA CLA
+ JMP I (NOTNUF /MUST BE .LE. REAL AMT OF CORE
+ TAD CHAR
+ SZA CLA
+ JMP I [SYNTAX
+ TAD SIZE
+ DCA NEWCOR
+ JMP I [CONFIG
+\f/ IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
+/ 0_PG7600
+/ 66_BLOK66
+
+BOOTF, TAD SYSSIZ
+ SMA CLA /IS NEW SYS TWO PAGES?
+ TAD [-200 /NO
+ JMS I [MOVE /YES, NULL MOVE
+ CDF 10
+ BLOK66
+ CDF 0
+ PG7600
+ TAD [4200
+ JMS I [SYS
+ PG7600
+ 0
+ TAD [4210
+ JMS I [SYS
+ BLOK66
+ 66
+BOOTG, NOP
+/ JMS I (RECZRO /SIMULATE BOOTSTRAP
+ TAD [-131 /MOVE UP FIELD 1 CODE
+ JMS I [MOVE
+ CDF 10
+ BLOK66+47
+ CDF 10
+ 7600+47
+ TAD SAVDAT
+ CDF 10
+ DCA I (DATEWD
+ CDF 0
+ JMS I [PRWD
+ TEXT /SYS BUILT/
+ JMP I [7600
+ PAGE
+\f/MOVE MOVES CORE AROUND (CALLABLE FROM ANY FIELD)
+
+/ TAD (-# OF LOCS TO MOVE
+/ JMS MOVE
+/ CDF FROM FIELD
+/ FROM BUFFER LOCATION START
+/ CDF 'TO' FILED
+/ TO BUFFER
+
+/MUSTN'T DESTROY OS/8 LOCS, NO PAGE 0 TEMPS!
+
+MOVE, 0
+ DCA MVCT
+ RDF
+ TAD (CIF CDF
+ DCA MOVRET
+ TAD I MOVE /GET CDF FROM-FLD
+ DCA MVCDF2
+ ISZ MOVE /POINT TO FROM-BUF
+ TAD I MOVE /GET LOC TO MOVE
+ DCA MVTM1
+ ISZ MOVE /POINT TO TO-CDF
+ TAD I MOVE
+ DCA MVDF /GET CDF TO FIELD OF DESTINATION
+ ISZ MOVE /POINT TO TARGET AREA
+ TAD I MOVE
+ DCA MVTM2
+ ISZ MOVE /POINT TO RETURN
+ TAD MVCT
+ SNA CLA
+ JMP MOVRET /NOTHING TO MOVE
+MVCDF2, CDF 0 /GETS ALTERED TO PICK UP F1
+ TAD I MVTM1
+MVDF, HLT
+ DCA I MVTM2
+ ISZ MVTM1 /BUMP POINTERS TO AREAS
+ ISZ MVTM2
+MV20, 20
+ ISZ MVCT
+ JMP MVCDF2
+MOVRET, HLT /RETURN TO CALLING FIELD
+ JMP I MOVE
+
+CTCTST, 0
+ TAD MV7600 /ALLOW FOR PARITY
+ KRS
+ TAD (-7603
+ SNA CLA
+ KSF
+ JMP I CTCTST
+ JMP I (CTRLC
+\fMVCT,
+IOPEN, 0 /PREPARE TO READ INPUT
+ CLA CMA
+ DCA I (CHCNT
+ TAD I (JMPX /RESTORE SWITCH
+ DCA I (JMPGET
+ TAD I (FILPTR /RESULTS OF LOOKUP
+ DCA I (RECNO
+ DCA I (REOF
+ TAD (CDF 0
+ DCA I (XFIELD /SETUP LDABS FOR FIELD 0
+ JMP I IOPEN
+\fBOOT4, TAD I (DRECT
+ SMA CLA
+ JMP I (BOOTC /HE'S SPECIFIED ABOUT DIRECTORY ZERO
+ JMS I [PRWD /YES, NO NEED TO COPY SYSTEM
+ TEXT /WRITE ZERO DIRECT?/
+ TAD [-10 /DON'T WANT TO DESTROY PRECIOUS TABLES
+ JMS I [GTEXT /GET REPLY
+ JMP BOOT4
+ JMS I [GNAME
+ TAD NAME1
+ AND [7700
+ TAD (-3100
+ SNA CLA
+ CLA IAC /Y
+ DCA I (DRECT /NO; COULD HAVE SAVED LOCATION BUT I FEEL SAFER THIS WAY
+ JMP I (BOOTC
+
+MVTM1,
+ROTL, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I ROTL
+
+MVTM2,
+ROTR, 0
+ CLL RTR
+ RTR
+ RTR
+ JMP I ROTR
+\fTTYOUT, 0 /YOU GUESSED IT
+ DCA TM
+ TAD ECHOFL
+ SZA CLA /ARE WE ECHOING?
+ JMP I TTYOUT /NO
+ TAD TM /YES
+ TLS
+ TSF
+ JMP .-1
+MV7600, 7600 /CLA
+ JMS I (CTCTST /TEST FOR ^C.
+ JMP I TTYOUT
+
+TM,
+SKPCRD, 0
+ TAD I DSCPTR
+ CLL
+ TAD MV20 /A GROUP COUNT MUST BE IN THE RANGE -1 TO -20
+ SNL CLA
+ JMP I SKPCRD
+ ISZ DSCPTR /IT'S A DARN GROUP COUNT, GO PAST IT
+ JMP SKPCRD+1 /WIERD CASE OF CONSECUTIVE GROUP COUNTS
+
+ECHOFL, 0 /1 MEANS NOT ECHOING, SAW ^O
+\fPATCH, 0
+ TAD I [7777 /V3D
+ AND L600
+ DCA SAVHID /SAVE HIGH ORDER DATE BITS
+ JMP I PATCH
+ PAGE
+\fPRNAME, 0 /ROUTINE TO PRINT NAME1-NAME4
+ TAD (NAME1
+ DCA TEMP
+ CLL STA RTL /-3
+ DCA COUNT
+PRNM2, TAD I TEMP
+ JMS PRINTE /TYPE OUT CHARS
+ ISZ TEMP
+ ISZ COUNT /EXHAUSTED ALL?
+ JMP PRNM2
+ TAD I TEMP
+ SNA CLA
+ JMP I PRNAME /NO . IF NO EXTENSION
+ TAD (". /PRINT '.'
+ JMS I (TTYOUT
+ TAD I TEMP
+ JMS PRINTE
+ JMP I PRNAME
+
+PRINTE, 0
+ DCA CHTMP2
+ TAD CHTMP2 /EXTRACT LEFT HAND SIDE
+ JMS I (ROTR
+ JMS PWORD
+ TAD CHTMP2
+ JMS PWORD
+ JMP I PRINTE
+\fPWORD, 0
+ AND (77
+ SNA /IF NULL, GET OUT
+ JMP NULL
+ DCA PRTM
+ TAD (200
+ KRS
+ TAD (-217 /^O
+ SNA CLA /STOP ECHOING?
+ KSF /MAYBE
+ SKP /NO
+ JMP CTO /YES
+ TAD PRTM
+ TAD (240
+ AND (77
+PRSPAC, TAD (240
+ JMS I (TTYOUT
+ JMP I PWORD
+NULL, TAD LINEUP
+ SNA CLA /PRINT SPACE?
+ JMP I PRINTE /NO
+ JMP PRSPAC /YES
+
+PRWD, 0
+ CLA
+PRWD2, TAD I PRWD
+ JMS PRINTE
+ TAD I PRWD
+ ISZ PRWD
+ AND (77
+ SZA CLA
+ JMP PRWD2
+ JMP I PRWD /LEAVE IF LAST WORD ENDED WITH 00
+
+CHTMP2, 0
+
+CTO, KCC
+ TAD ("^
+ JMS I (TTYOUT
+ TAD ("O
+ JMS I (TTYOUT
+ JMS CRLF
+ CLA IAC
+ DCA I (ECHOFL
+ JMP I PWORD
+
+LINEUP, 0 /NON-ZERO MEANS PRINT NULLS AS SPACES
+\fOVER, JMS ASSEMB /EXTENSION OF LDABS.
+ CIA
+ TAD I LCKSUM /CHECKSUM OK?
+ SZA CLA
+ JMP BADINP /SOORY ABOUT THAT
+ CLA IAC
+ JMP OVROUT /SKIP ERROR EXIT
+BADINP, JMS PRWD
+ TEXT /?BAD INPUT/
+ JMS CRLF
+OVROUT, TAD I (LDABS
+ DCA OTEMP
+ JMP I OTEMP
+OTEMP,
+ASSEMB, 0 /ASSEMBLE TWO 6 BIT WORDS
+ TAD I LWD1
+ JMS I PROTL /INTO A SINGLE 12 BIT WORD
+ TAD I LWD2
+ JMP I ASSEMB
+
+LCKSUM, CKSUM
+LWD1, WD1
+LWD2, WD2
+PROTL, ROTL
+PRTM, 0
+\fCRLF, 0
+ TAD (215
+ DCA NAME1
+ JMS PRNT
+ TAD (212
+ JMS I (TTYOUT
+ JMP I CRLF
+
+PRNT, 0 /CHARACTER PRINT ROUTINE
+ TAD ("\ /IF NOT RUBOUT, AND IF RUBOUT WAS
+ ISZ RUBFLG /LAST, ECHO \.
+ SKP CLA
+ JMS I (TTYOUT
+ TAD NAME1
+ JMS I (TTYOUT
+ JMP I PRNT
+RUBFLG, 0 /RUBOUT FLAG
+ PAGE
+\f/LDABS DOES A REAL LIVE ABSLOAD IF AC=0
+/IF AC=-2 THEN IT IS LOADING A HANDLER, THIS IS DONE AS FOLLOWS:
+/SEARCH FOR *0
+/THEN LOAD CONSEC WORDS INTO DESCRIPTOR TABLE
+/AT NEXT ORIGIN, LOAD WORDS INTO HANDLER AREA (ALLOW ORIGINS)
+
+/CAN'T USE PAGE 0 LITERALS IN CASE LOADING OS/8
+
+LDABS, 0
+ DCA LODTST /-2 IF HANDLER, 0 IF OS8
+LDABS2, TAD JMPNXT
+ DCA TSTO0
+ DCA CKSUM /CLEAR CHECKSUM
+ JMS I (ICHAR /GET A BUFFER CHAR
+ JMP I LDABS /NO INPUT FOUND
+ SNA
+ JMP .-3 /IGNORE BLANKS
+ TAD (-200
+ SZA CLA /IS IT LEADER?
+ JMP I (BADINP /WASN'T 200..PROBABLY NOT BINARY
+LEADER, JMS I (ICHAR
+ JMP I LDABS /STRANGE....ALL LEADER!!!
+ SNA
+ JMP LDABS2 /START OVER.BLANKS AFTER LEADER
+ TAD (-200 /IS IT STILL LEADER?
+ SNA
+ JMP LEADER /YES
+NEWWD, SMA /IS IT < 200?
+ JMP FIELDW /NO.TEST FOR FIELD SEETING
+ TAD (200 /RESTORE CHARACTER
+ DCA WD1
+ JMS I (ICHAR
+ JMP I (BADINP /EOF BETWEEN WORDS. HOW NICE!
+ DCA WD2
+ JMS I (ICHAR
+ JMP I (BADINP
+ TAD (-200 /200 FINISHES US UP
+ SNA
+ JMP I (OVER
+ DCA WD
+ JMS I (ASSEMB /ASSEMBLE LAST WORD READ
+ SZL /IS IT AN ORIGIN?
+ JMP ORGTST /YES
+XFIELD, HLT /GETS CDF N
+ DCA I ORIGIN /STORE THIS WORD
+CDF0, CDF 0
+ ISZ ORIGIN /SHOULD NEVER SKIP, BUT...
+LD7, 7
+ TAD ORIGIN
+ TAD (200 /GIVE ERROR IF ORIGIN ADVANCES TO 7600
+ SNA CLA
+ JMP I (NOROOM
+NEXT, TAD WD1
+ TAD WD2 /MAKE UP CHECKSUM
+ TAD CKSUM
+ DCA CKSUM
+ TAD WD
+ JMP NEWWD
+\fORGTST, DCA ORGX /TEST FOR ORIGIN
+ TAD LODTST /GET POINTER TO PROPER ORIGIN
+ SZA CLA
+ JMP HND
+ TAD ORGX /OS/8 - USE REAL ORIGIN
+ORI, DCA ORIGIN /BUFFER AREA
+ TAD LODTST /HANDLER LOAD?
+ SNA CLA
+ JMP NEXT /NOPE
+ TAD ORGX /DON'T START LOAD UNTIL *0 IS FOUND
+ SZA CLA
+TSTO0, JMP NEXT
+ DCA .-1 /FOUND *0..DO THE LOAD
+ ISZ LODTST /YES. BUMP LODTST TO LOAD HANDLER NEXT
+ JMP NEXT
+ TAD XFIELD
+ TAD (-CDF 0
+ SNA CLA
+ JMS FIRST /FIRST TIME THROUGH
+/DO THIS BETTER; ALSO MAKE SURE HANDLER DOESN(T HAVE A FILED PSEUDO
+ TAD (CDF 10
+ DCA XFIELD /AT THIS POINT, WE START
+ CLA CMA /LOADING THE HANDLER INTO THE
+ DCA LODTST /AREA SPECIFIED BY HNDORG+1
+/CHECK 'ORIGIN' TO SEE IF HEADER WAS RIGHT SIZE
+/ALSO ELSEWHERE, CAN CHECK ORIGIN WHEN BUMPING TO SEE
+/IF WE HIT ANY MAGIC LOCATIONS
+ TAD ORGX /SEE IF LEGAL RE ORIGIN
+ JMS I (ORGLIM
+ DCA ORIGIN /ACTUAL FIELD 1 ORIGIN
+/ TAD SNACLA /LOADING FIELD 1..TEST ORIGINS
+/ DCA JMPRE
+JMPNXT, JMP NEXT
+FIELDW, TAD (-100 /LESS THAN 300 FAILS
+ SPA
+ JMP I (BADINP
+ DCA WD1
+ TAD WD1
+ AND LD7
+ SZA CLA
+ JMP I (BADINP /DISECT WORD TO CATCH GARBAGE
+ TAD LODTST /IF LOADING HANDLER, IGNORE FIELD
+ SZA CLA
+ JMP FIELD2
+ TAD WD1
+ AND (70 /EXTRACT FIELD SETTING
+ TAD CDF0
+ DCA XFIELD
+FIELD2, JMS I (ICHAR
+ JMP I (BADINP
+ TAD (7600
+ SZA
+ JMP NEWWD
+ JMP I (OVER
+\fORGX, 0
+ORIGIN, 0
+WD1, 0
+WD2, 0
+WD, 0
+CKSUM, 0
+LODTST, 0
+
+/0: LOADING OS/8
+/-2: LOADING HEADER OF HANDLER
+/-1: LOADING HANDLER
+
+HND, TAD ORIGIN
+ DCA KLUD
+ TAD TABLMT
+ JMP ORI /HANDLER - USE HANDLER SPACE
+
+KLUD, 0
+
+FIRST, 0
+ TAD KLUD
+ DCA NEWLIM
+ JMP I FIRST
+
+NEWLIM, 0 /NEW END OF DESCRIPTORS
+RETSW, 0 /0 MEANS RAN FROM OS/8, 1 MEANS RAN STANDALONE
+ PAGE
+\f LNLNGT=103
+BEGLIN, ZBLOCK LNLNGT
+
+ SBLOCK=7776 /??
+/CTCFAK, .+1 /^C MUST NOT RETURN TO ANY SYSTEM.
+/ JMP I CTCFAK /CTCFAK MARKS OUR PLACE DURING
+/ /SYSGEN, AND ^C WILL RETURN TO THAT PLACE.
+/*** THIS STUFF GOES AWAY ON A BOOT
+
+BUILD, CDF 10
+ TAD I [7200 /HAS SPECIAL CODE BEEN OVERLAID BY HANDLERS?
+ CDF 0
+ TAD [-1234
+ SZA CLA
+ JMP I (NOROOM /YES, TOO BAD
+/ TAD (5601
+/ DCA I [7600
+/ TAD (CTCFAK+1
+/ DCA I (7601
+ TAD [6600 /SAVE OLD SYSTEM HANDLER IN 16600
+ JMS I (SETUPSYS
+/ JMS CTCFAK
+RDOS8, JMS I [PRWD
+ TEXT \LOAD OS/8: \
+ JMS RD
+ JMP RDOS8
+ CIF CDF 10
+ JMS I (WROS8
+ JMS I (SYSWP
+/ JMS CTCFAK
+RDCD, JMS I [CRLF
+ JMS I [PRWD
+ TEXT /LOAD CD: /
+ DCA DVER
+ JMS RD
+ JMP RDCD
+ CIF CDF 10
+ JMS I (WRCD
+ TAD I (RETSW
+ SNA CLA /NOT IF FROM SCRATCH
+ JMS I (SYSWP /GET OLD HANDLER IF ANY BACK IN
+ JMP I [CONFIG
+\fRD, 0
+ TAD [-40
+ JMS I [GTEXT
+ JMP I RD
+ JMS I (SETUP
+DVER, JMP I (NODEV
+ JMS I (SYSWP /PUT IN NEW HANDLER
+ CIF CDF 10
+ JMS I (SAVE
+ JMS I (SYSWP
+ JMS I (LDABS /PAST HERE PAGE 0 IS GONE
+ JMP I RD
+ JMS I (SYSWP
+ ISZ RD
+ JMP I RD
+ PAGE
+\f *6400
+
+DSCTAB, ZBLOCK 1200
+\f/RELIC:
+
+ *7600
+ 0 /ONLY LOADED FROM PAPER TAPE.
+
+ *7777
+ 0 /SET SOFTWARE CORE SIZE TO 'UNKNOWN'
+ FIELD 1
+ *0
+ 0 /FORCE ABSLDR TO LOAD THIS PAGE
+ *400
+/ ZBLOCK 5400
+ 0
+\f *6600
+
+ RELOC BINARY
+
+BINPUN, CDF 10
+ CLA
+ TAD (-400
+ CIF 0
+ JMS I (MOVE
+ CDF 10
+ 6600
+ CDF 0
+ BINARY /MOVE ONESELF DOWN
+ CIF CDF 0
+ JMP I (LDR /EXECUTE IN FIELD 0
+LDR, JMS LEDER /PUNCH 72 FRAMES OF 200
+ DCA CHECK /0 CHECKSUM
+ TAD (102
+ JMS CKSUMM
+ JMS PNCH
+STARTB, JMS I (CRLF
+ TAD ("*
+ JMS I (TTYOUT
+ TAD (-100
+ JMS I (GTEXT
+ JMP STARTB
+ JMS I (GETNUM
+ JMP I (OVERB
+ TAD SIZE
+ AND (7770
+ SZA CLA
+ JMP STARTB
+ TAD SIZE
+ CLL RTL
+ RAL
+ DCA FLD
+ JMS I (GETNUM /GET LOWER LIMIT
+ JMP STARTB
+ TAD SIZE
+ DCA LIM1
+ JMS I (GETNUM /GET UPPER LIMIT
+ JMP STARTB
+ TAD SIZE
+ DCA LIM2
+ TAD LIM2
+ CMA
+ TAD LIM1
+ DCA COUNT2
+ TAD FLD
+ TAD (300
+ JMS PNCH
+ TAD FLD
+ TAD (CDF 0
+ DCA BUFLD
+ TAD LIM1
+ JMS I (ROTR
+ AND (77
+ TAD (100
+ JMS CKSUMM
+ TAD LIM1
+ AND (77
+ JMS CKSUMM
+BUFLD, HLT
+ TAD I LIM1
+ JMS I (ROTR
+ AND (77
+ JMS CKSUMM
+ TAD I LIM1
+ AND (77
+ JMS CKSUMM
+ ISZ LIM1
+ ISZ COUNT2
+ JMP BUFLD
+ CIF CDF 0
+ JMP STARTB
+\fLEDER, 0 /PUNCH LEADER/TRAILER
+ TAD (-200
+ DCA COUNT2
+ TAD (200
+ JMS PNCH
+ ISZ COUNT2
+ JMP .-3
+ JMP I LEDER
+
+PNCH, 0
+ PLS
+ PSF
+ JMP .-1
+ CLA
+ JMP I PNCH
+
+FLD, 0
+LIM1, 0
+LIM2, 0
+COUNT2, 0
+CHECK, 0
+
+CKSUMM, 0
+ DCA CK1
+ TAD CK1
+ TAD CHECK
+ DCA CHECK
+ TAD CK1
+ JMS PNCH
+ JMP I CKSUMM
+
+CK1, 0
+ PAGE
+\fOVERB, TAD (300
+ JMS I (PNCH /FIELD 0
+ TAD (176
+ JMS I (CKSUMM
+ JMS I (CKSUMM /*7600
+ TAD (74
+ JMS I (CKSUMM
+ STL CLA RTL
+ JMS I (CKSUMM /HLT
+ TAD (177
+ JMS I (CKSUMM
+ TAD (77
+ JMS I (CKSUMM /*7777
+ JMS I (CKSUMM
+ JMS I (CKSUMM /0000
+ TAD (102
+ JMS I (CKSUMM
+ JMS I (CKSUMM /*200
+ TAD I (CHECK
+ JMS I (ROTR
+ AND (77
+ JMS I (PNCH
+ TAD I (CHECK
+ AND (77
+ JMS I (PNCH
+ JMS I (LEDER
+ HLT
+ JMP .-1 /ALL DONE
+ PAGE
+ RELOC
+\f *7200
+
+ DIRLOC=1400 /FROM OS/8 ASSEMBLY
+
+ READ=JMS I (7607
+ WRITE=READ
+ MFREE=70
+ ERR=JMS I (WRERR
+
+ 1234 /MAGIC NUMBER WHICH IF NOT HERE, MEANS HANDLERS OVERLAID
+
+WROS8, 0
+ CIF 0
+ TAD Z7600
+ JMS I (MOVE /SAVE CURRENT 7600
+ CDF 0
+ 7600
+ CDF 0
+ 7000 /IN 07000
+ TAD (-7 /MOVE 6600 TO 7600
+ CIF 0
+ JMS I (MOVE
+ CDF 0
+ 6600
+ CDF 0
+ 7600
+ TAD (-34 /FINISH MOVING FIELD 0
+ CIF 0
+ JMS I (MOVE
+ CDF 0
+ 6744
+ CDF 0
+ 7744
+ CDF 0
+ TAD (5 /V3C SUBTRACT OFF LENGTH OF ABSLDR
+ TAD I (DLENGTH /FILL IN INITIAL LENGTH
+ CDF 10
+ DCA I (DIRLOC+14 /OS8 HAS INITIAL DIRECTORY
+\f CIF 0;WRITE;4200;7400;0;ERR /INITIAL REC.0
+ CIF 0;WRITE;4200;7400;66;ERR /ALSO WRITE RECORD 66
+ CIF 0;WRITE;4210;DIRLOC;1;ERR /INITIAL DIRECTORY
+ CIF 0;WRITE;5000;0;7;ERR /KBM
+ CIF 0;WRITE;4610;0;13;ERR /USR
+ CIF 0;WRITE;4111;3400;26;ERR /ENTER OVERLAY
+ CIF 0;WRITE;4701;2000;54;ERR /SAVE, DATE, MON ERROR, CHAIN OVERLAYS
+ CIF 0;WRITE;4101;LDRCTL;70;ERR /ABSLDR CORE CONTROL BLOCK
+ CIF 0;WRITE;5010;2000;71;ERR /ABSLDR
+ CDF 0
+ TAD I (RETSW
+ CDF 10
+ SNA CLA /SCRATCH BUILD?
+ JMP I (RES76 /NO
+ TAD Z7600 /YES /MOVE 17600 UP THERE
+ CIF 0
+ JMS I (MOVE
+ CDF 0
+ 7400
+ CDF 10
+Z7600, 7600
+ JMS I (RESTORE
+ CIF CDF 0
+ JMP I WROS8
+
+/RELATIONSHIP BEWTWEEN OS/8 CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
+
+/ITEM CORE LOC BLOCKS
+
+/KBM 0000-1777 7-12
+/OVERLAYS 2000-3577 54-57
+/INIT DIR DIRLOC- 1
+/ABSLDR CCB LDRCTL- 70
+/INIT BLOCK 0 7400-7777 0
+/USR 10000-11377 13-15
+/ABSLDR 12000-13777 71-74
+/ENTER 13400-13577 26
+/SYS 06600-06606 PART OF 07600
+/SYS 06744-06777 "
+\fWRCD, 0
+ CIF 0;WRITE;4600;0;51;ERR /CD
+ CIF 0;WRITE;5011;0;60;ERR /ODT
+ JMS I (RESTORE
+ JMS I (CASIT
+ CIF CDF 0
+ JMP I WRCD
+ PAGE
+\f READ=JMS I (7607
+ ERR=JMS WRERR
+
+/SPECIAL CODE TO CHAIN TO ABSLDR, TO READ IN MCPIP
+
+ JMS I (7700
+ 10 /LOCK USR IN CORE
+ TAD R7600 /ZERO CD AREA
+ DCA CDPTR
+ TAD (-47
+ DCA CDKNT
+ DCA I CDPTR
+ ISZ CDPTR
+ ISZ CDKNT
+ JMP .-3
+ STL CLA RAR /ALTMODE
+ DCA I (7642
+ JMS I (200
+ 12 /INQUIRE
+ 4503 /ENCODE CSA0
+CDN, 0
+ 0
+ HLT
+ TAD CDN /TAKE DEVICE NUMBER
+ DCA I (7617 /STORE DEVICE NUMBER OF CASSETTE
+ ISZ I (7620 /V3C FORCE BLOCK 1
+ CLA IAC
+ CDF 0 /V3D
+ DCA I (7746 /SET JSW SO CHAIN DOESN'T DO USROUT
+ CDF 10
+ JMS I (200 /CHAIN TO ABSLDR
+ 6
+ 70
+\fRESTORE,0
+ CIF 0;READ;3701;0;BLDSAV;ERR
+ CIF 0;READ;3510;0;BLDSAV+20;ERR /RESTORE BUILD
+ JMP I RESTORE
+\f WRITE=JMS I (7607
+ ERR=JMS WRERR
+
+SAVE, 0
+ CDF 0
+ DCA I (SOFSET
+ DCA I (SBLOCK
+ DCA I (DRECT /HAVE TO KEEP DIRECTORY LATER
+ CDF 10
+ CIF 0;WRITE;7701;0;BLDSAV;ERR
+ CIF 0;WRITE;7510;0;BLDSAV+20;ERR
+ JMS CASIT
+ CIF CDF 0
+ JMP I SAVE
+
+RES76, TAD I (Z7600
+ CIF 0
+ JMS I (MOVE
+ CDF 0
+ 7000 /RESTORE OLD PAGE 7600
+ CDF 0
+ 7600
+ JMP I (Z7600
+\fWRERR, 0 /WRITE ERROR
+ HLT CLA /HIT CONTINUE TO RETRY
+ TAD WRERR
+ TAD (-6
+ DCA WRERR /POINT BACK TO CIF OF CALL
+ JMP I WRERR /RETRY
+
+/RELATIONSHIP BETWEEN CD CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
+
+/ITEM CORE LOC BLOCKS
+/CD 00000-01377 51-63
+/ODT 10000-11777 60-63
+
+CSA, 0 /CASSETTE HANDLER ENTRY PT
+CDPTR, 0
+
+CDKNT,
+CASIT, 0
+ CDF 0
+ TAD I (RECNO
+ SNA
+ CLA IAC /IF BLOCK 0, CHANGE TO 1
+ DCA I (RECNO
+ TAD I PRETSW
+ SNA CLA /BUILDING FROM SCRATCH?
+ JMP I CASIT /NO
+ TAD I (BLDCB /YES, GET DCB OF LOAD HANDLER
+ AND L770
+ TAD M270 /CASSETTE DEVICE CODE=27
+ SZA CLA
+ JMP I CASIT /NOT A CASSETTE
+ TAD I (DVICE
+ DCA CSA /GET HANDLER ENTRY POINT
+ CDF 10
+ CIF 0
+ JMS I CSA
+ 3 /SKIP TO NEXT FILE
+L770, 770
+M270, -270
+R7600, 7600 /IGNORE ERRORS
+ CIF 0
+ JMS I CSA
+ 100 /DUMMY READ A PAGE
+ BINARY /TO SKIP HEADER
+PRETSW, RETSW
+ SKP CLA /WANT AN ERROR
+ HLT /A GOOD READ IS BAD!
+ JMP I CASIT
+\f FIELD 0
+ *200
+ $
+\f
--- /dev/null
+/TC08 DECTAPE FORMATTER, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/COPYRIGHT 1970 DIGITAL EQUIPMENT CORP.
+/MAYNARD, MASS.
+/REVISED APRIL 1970
+
+/ TOG-8 TO MARK AND CHECK PDP-8 DECTAPE
+/THIS PROGRAM WRITES TIMING AND MARK TRACKS ON
+/DECTAPE MOUNTED ON THE TCO1-TU55 TAPE CONTROL UNIT.
+
+
+
+
+
+ X1=10
+ X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+ DTRA=6761
+ DTCA=6762
+ DTXA=6764
+ DTSF=6771
+ DTRB=6772
+ DTLB=6774
+ DTCX=6766
+
+/SET 0 FOR THE LOGIN FEATURE
+
+ *0
+ 0
+ JMP I .+1
+ CONC /CONTROL "C" AND LOGIN
+
+/WORKING LOCATIONS
+
+ *20
+
+W1, 0000
+W2, 0000
+W3, 0000
+W4, 0000
+W5, 0000
+W6, 0000
+BLOCKS, 0000
+BLOCKA, 0000
+DTA, 0000
+ERX, 0000
+PHASE, 0000
+TOTAL, 0000
+VAR1, 0000
+VAR2, 0000
+\f/CONSTANTS
+
+C1, 0001
+C2, 0002
+C3, 0003
+C4, 0004
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0030, 0030
+C0400, 0400
+C0700, 0700
+C203, 0203
+C201, 0201
+C210, 0210
+C260, 0260
+C261, 0261
+C267, 0267
+C270, 0270
+C271, 0271
+C277, 0277
+C1000, 1000
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+C7772, 7772
+C7775, 7775
+CRCOD, 0215
+LETK, 0313
+LFCOD, 0212
+M2, -2
+M3, -3
+M4, -4
+M6, -6
+M7, -7
+M14, -14
+M144, -144
+M300, -300
+SPCOD, 0240
+\f/INTERPAGE LINKS
+
+ADW2, W2-1
+ADW3, W3-1
+BADD, BUFFER-1
+BFR, BUFFER
+CA, 7755
+COMPAR, COMPRE
+FCON, 0000
+IT, INIT1
+FORMA, FORM-1
+FORMB, FORM
+QU1, Q1
+QU2, Q2
+QU3, Q3
+QU4, Q4
+MESS, MES
+STX, START
+TURN, TRN
+TYOCT, TYCT
+TYPE, MESAGE
+TYPIN, TYPN
+WAIT, STALL
+WC, 7754
+DBUFPT, 0 /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+\f
+
+
+/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER
+
+RSEND, 0000
+ TLS /LOAD AND PRINT, CLEAR FLAG
+ TSF /WAIT FOR CONFIRMATION
+ JMP .-1 /ENDLESSLY
+ TCF /CLEAR THE FLAG ANYWAY
+ JMP I RSEND
+
+
+/PRINT A "?" ON THE KEYBOARD TYPER
+
+QU, .+1
+ IOF /KILL LOG AND CONTROL C FCTN
+ CLA CLL /C(AC)+C(L)=0
+ TAD C277 /"?"
+ JMS RSEND /TYPE THE CHARACTER
+ JMP I .+1 /RESTART
+ INIT
+
+/DECTAPE CONTROL WORDS
+
+DT0030, 0030
+DT0060, 0060
+DT0070, 0070
+DT0100, 0100
+DT0130, 0130
+DT0140, 0140
+DT0200, 0200
+DT0210, 0210
+DT0360, 0360
+DT0510, 0510
+DT0600, 0600
+DT0610, 0610
+
+/SOME SPECIAL LINKS
+
+ADBA, 2475
+ADWA, 2476
+ADWAB, 2477
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+
+BINCON, .+1
+ 0001
+ 0012
+ 0144
+ 1750
+\f *200 /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+
+MESAGE, 0
+ IOF /KILL LOG AND CONTROL FUNCTION
+ CLA CMA /SET C(AC)=-1
+ TAD MESAGE /ADD LOCATION
+ DCA 10 /AUTO INDEX REGISTER
+ TAD I 10 /FETCH FIRST WORD
+ DCA MSRGHT /SAVE IT
+ TAD MSRGHT
+ RTR
+ RTR /ROTATE 6 BITS TO THE RIGHT
+ RTR
+ JMS TYPECH /TYPE IT
+ TAD MSRGHT /GET DATA AGAIN
+ JMS TYPECH /TYPE RIGHT HALF
+ JMP MESAGE+5 /CONTINUE
+MSRGHT, 0 /TEMPORARY STORAGE
+TYPECH, 0 /TYPE CHARACTER IN C(AC)6-11
+ AND C0077
+ SNA /IS IT END OF MESSAGE?
+ JMP I 10 /YES: EXIT
+ TAD M40 /SUBTRACT 40
+ SMA /<40?
+ JMP .+3 /NO
+ TAD C340 /YES: ADD 300
+ JMP MTP /TO CODES <40
+ TAD M3 /SUBTRACT 3
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C212 /YES: CODE 43 IS
+ JMP MTP /LINE-FEED (212)
+ TAD M2 /SUBTRACT 2
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C215 /YES: CODE 45 IS
+ JMP MTP /CARRIAGE RETURN (215)
+ TAD C245 /ADD 200 TO OTHERS >40
+MTP, TLS /TRANSMIT CHARACTER
+ TSF /WAIT FOR THE FLAG
+ JMP .-1 /NOT SET YET
+ CLA /SET: CLEAR C(AC)
+ JMP I TYPECH /RETURN
+
+/CONSTANTS
+
+M40, -40
+C340, 340
+C212, 212
+C215, 215
+C245, 245
+\f/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN, 0
+ IOF /KILL THE LOG AND CONTROL C FUNCTION
+ KCC /CLEAR AC, KEYBOARD FLAG
+ TAD BADD /GET BUFFER ADDRESS
+ DCA W1 /STORE FOR THE CHARACTER STRING
+
+/READ AND RESPOND WITH THE CHARACTER
+
+NTYRTN, ISZ W1 /NORMAL RETURN. INCREMENT BUFFER
+ KSF /WAIT FOR KEYBOARD
+ JMP .-1 /FLAG TO RAISE
+ KRB /GOT FLAG, RESET IT, GET CHARACTER
+ JMS RSEND /SEND CHARACTER BACK
+ AND (177 /TAKE CARE OF PARITY
+ TAD (200
+ DCA I W1 /LOAD CHARACTER INTO BUFFER AREA
+ TAD I W1 /CHECK FOR CTRL C
+ CIA
+ TAD C203
+ SZA CLA
+ JMP CHKSP /NO- CHECK FOR SPACE
+ 6007 /CTRL C -CLEAR ALL FLAGS
+ NOP /FOR OLD MACHINES
+ CLA /JUST IN CASE
+ DTLB /CLEAR STATUS REGISTER B
+ JMP I (7605
+
+/IF CHARACTER IS A SPACE, IGNORE IT
+
+CHKSP, TAD I W1 /CHARACTER INTO THE AC
+ CIA /SUBTRACT FROM SPACE CODE (240)
+ TAD SPCOD /COMPLETE COMPARISON
+ SNA CLA /WAS IT A SPACE?
+ JMP NTYRTN+1 /YES: DO NOT INCREMENT BUFFER
+
+/IF CHARACTER IS A CR, EXIT FROM ROUTINE
+
+ TAD I W1 /CHARACTER TO AC
+ CIA /SET AC TO SUBTRACT CR (215)
+ TAD CRCOD /COMPLETE COMPARISON
+ SZA CLA /WAS IT CR?
+ JMP NTYRTN /NO: INCREMENT BUFFER + WAIT
+
+/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE
+
+ TAD LFCOD /GIVE KEYBOARD LINE FEED
+ JMS RSEND /EXECUTE LINE FEED
+ CLA CLL /EXIT WITH C(ACC) + AND C(L)=0
+ ION /RESET LOG AND CONTROL C FUNCTION
+ JMP I TYPN /RETURN TO CALL
+\f/COMPARE A STRING OF CHARACTERS IN "BUFFER"
+/TO A CHARACTER STRING AFTER A JMS IN ASCII
+
+COMPRE, 0
+ CLA CMA /C(AC)=7777
+ TAD COMPRE /SUBTRACT 1 FOR INDEX REG 1
+ DCA 10 /AUTO INDEX 1 SET TO CHA STRING
+ TAD BADD /AUTO INDEX 2 SET TO BUFFER-1
+ DCA 11 /LOAD X2
+
+/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
+/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
+/ZERO, IF BAD ONE PLUS
+
+ TAD I X1 /CHARACTER FROM PROGRAM
+ CIA /TO SUBTRACT FROM
+ TAD I X2 /CHARACTER IN BUFFER
+ SZA CLA /COMPARE?
+ JMP CERR /NO:RESYNC FOR NON COMPARE EXIT
+ TAD I X1 /YES: CHECK FOR GOOD EXIT
+ SZA /IF 0, EXIT GOOD
+ JMP .-6 /NO: TEST NEXT CHAACTER
+ ISZ X1 /+1 TO X1(TOTAL 2 FROM THE 0)
+ JMP I X1 /+1 TO X1, EXIT
+
+/ERROR FOUND. RESYNC AND EXIT NO COMPARE
+
+CERR, TAD I X1 /CHARACTER FROM PROGRAM
+ SZA CLA /IS THIS EXIT KEY? (0000)
+ JMP .-2 /NO: GET NEXT
+ JMP I X1 /YES: EXIT, NOT COMPARE
+\f\f *400
+/VARIOUS ERROR MESSAGES
+/"NOT DECIMAL"
+
+Q1, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0405 /DE
+ 0311 /CI
+ 1501 /MA
+ 1400 /L
+ JMP QUX
+
+/"TO MANY WORDS"
+
+Q2, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 0000 /00
+ JMP QUX
+
+/"TO MANY BLOCKS"
+
+Q3, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2300 /S0
+ JMP QUX
+
+/"NOT DIVISIBLE BY 3"
+Q4, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0411 /DI
+ 2611 /VI
+ 2311 /SI
+ 0214 /BL
+ 0540 /E
+ 0231 /BY
+ 4063 / 3
+ 0000 /00
+QUX, JMS I TYPE
+ 4345 /CR+LF
+ 0000 /END
+ JMP I .+1
+ INIT
+\f/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES, 0
+ DCA W4 /BLOCK NUMBER GIVEN IN AC
+ TAD W4 /RESTORE TO AC AGAIN
+ CMA /COMPLEMENTED
+ RTL
+ RAL /LEFT 3
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ AND C7000 /ISOLATE HIGH CHA
+ DCA V2 /FORWARD BLOCK NUMBER
+ TAD W5 /SHIFTED VALUE
+ AND C0070 /ISOLATE 6,7,8
+ DCA V1 /FORWARD BLOCK NUMBER
+ TAD W4 /ORIGIONAL SET
+ CMA /UPSIDE DOWN
+ RTR
+ RAR /RIGHT 3
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ AND C0700 /ISOLATE 3,4,5
+ TAD V2 /COMBINE FORWARD BLOCK NUMBER
+ TAD C0077
+ DCA V2 /1/2 COMPLETE
+ TAD W5 /SHIFTED VALUE
+ AND C0007 /ISOLATE 9, 10,11
+ TAD V1 /COMBINE WITH BN
+ DCA V1 /FORWARD BLOCK NUMBER COMPLETE
+
+/CONVERT REVERSE BLOCK NUMBER
+
+ CMA /-1 TO GIVEN BLOCK #
+ TAD W4 /ORIGIONAL BLOCK #
+ DCA W5 /TEMP SAVE
+ TAD W5 /TO AC AGAIN
+ RTR
+ RTR /6 RIGHT
+ RTR
+ AND C0077 /ISOLATE LOW
+ DCA V3 /HIGH REVERSE
+ TAD W5 /COMPLEMENT ORIGIONAL -1
+ RTL
+ RTL /6 LEFT
+ RTL
+ AND C7700 /ISOLATE HIGH
+ DCA V4 /REVERSE COMPLETED
+ JMP I MES
+\f/FORM USED TO WRITE 12 DATA WORDS FOR BLOCK NUMBERING
+
+FORM, 0000
+ 0000
+ 0000
+ 0000
+V1, 0000
+V2, 0000
+ 7777
+ 7700
+ 0000
+V3, 0000
+V4, 0000
+ 0000
+\f//THIS ROUTINE ALLOWS KEYBOARD INTERRUPTION
+/FOR LOGGING ON THE KEYBOARD, OR FOR A MAJOR
+/CLEAR IN THE PROGRAM. BY HITTING "CONTROL C"
+/A SYSTEM RESTART WILL OCCUR.
+
+CONC, TSF /IS THE PRINTER FLAG ON?
+ JMP .+5 /NO, CHECK READER
+ TCF /YES: RESET IT
+ KSF /IS THE READER FLAG ON?
+ JMP RTNS /NO: RETURN TO SEQUENCE
+ JMP .+3
+ KSF
+ HLT
+
+/OK. CHECK FOR EITHER LOG OR CONTROL C.
+
+ DCA MES /SAVE C(AC)
+ RAL /SAVE THE LINK
+ DCA RSYC+6 /FOR LOGGING
+ KRB /GET CHARACTER FROM KEYBOARD
+ TLS /RETURN CHARACTER
+ CIA /TO SEE IF
+ TAD C203 /"CONTROL C"
+ SNA CLA /IS IT?
+ JMP RSYC /YES: RESYNC THE PROGRAM
+ TAD RSYC+6 /RESTORE THE LINK
+ RAR /FOR EXIT.
+ TAD MES /THE AC TOO
+RTNS, ION /INTERRUPT ON
+ JMP I 0 /RETURN
+\f
+*600
+/RESYNC THE SYSTEM TO START
+
+RSYC, TSF /WAIT FOR FLAG
+ JMP .-1 /ON LAST SENDOFF
+ JMS I TYPE
+ 2205 /RE
+ 2331 /SY
+ 1603 /NC
+ 0000 /END
+ TAD DTA /TO KILL EXISTING TAPE MOTION
+ DTCX /NOW
+ JMP I STX /RETURN TO START
+\f/WAIT FOR THE DECTAPE FLAG TO RISE
+
+STALL, 0
+ CLA
+ DTRB /READ TCU "B" REGISTER
+ SPA /ERROR?
+ JMP ERROR /YES, DECIDE WHAT TO DO
+ RAR /DECTAPE FLAG TO LINK
+ SNL CLA /FLAG?
+ JMP .-5 /NO: CONTINUE WATCH
+RERR, DTXA /RESET THE DECTAPE FLAG
+ DCA ERX /CLEAR THE END TAPE FLAG
+ JMP I STALL /GOT FLAG, EXIT
+
+/DRIVE TAPE INTO THE END ZONE, AND TURN IT
+/AROUND.
+/IF C(AC)=0400, TAPE INTO REVERSE END ZONE
+/IF C(AC)=0000, TAPE INTO FORWARD END ZONE
+
+TRN, 0
+ ISZ ERX /END ZONE IS LEGAL
+ DCA W4 /SAVE DIRECTION
+ TAD DT0200 /MOVE FUNCTION,GO
+ TAD W4 /DIRECTION TO MOVE
+ TAD DTA /DRIVE TO MOVE
+ DTCX /CLEAR AND RESET "A"
+ JMS I WAIT /FOR END ZONE FLAG
+ TAD DT0610 /SEARCH, GO
+ TAD W4 /DIRECTION TO SEARCH
+ AND C0777 /DELETE OVERFLOW BIT
+ TAD DTA /SET THE DECTAPE
+ DTCX /RESET STATUS "A"
+ DCA ERX /END ZONE NOT LEGAL NOW
+ JMP I TRN /RETURN TO SEQUENCE
+C0777, 0777
+
+\f/AN ERROR FLAG HAS BEEN SET. IN SOME CASES
+/END ZONE IS LEGAL, OTHERWISE, A RESTART ATTEMPT
+/MAY BE INITIATED.
+
+/DETERMINE WHICH FLAG SET THE DECTAPE FLAG
+
+ERROR, DCA W5 /SAVE "B" REGISTER
+ TAD DTA /GOING TO KILL
+ DTCX /TAPE MOTION
+ TAD W5 /RESTORE "B" REGISTER
+ RTL /POSITION BITS 1+2
+ SPA /END OF TAPE FLAG?
+ JMP ZEOT /YES: GO TO ROUTINE
+ SZL /MARK TRACK ERROR?
+ JMP ZMKTK /YES: GO TO ROUTINE
+ RTL /POSITION BITS 2+3
+ SPA /PARITY ERROR?
+ JMP ZPAR /YES: GO TO PARITY ERROR ROUTINE
+ SZL CLA /SELECT ERROR?
+ JMP ZSEL /YES: GO TO ROUTINE
+ JMP ZTIM /MUST BE TIMING ERROR
+
+/END OF TAPE FLAG FOUND, SEE IF IT'S LEGAL
+
+ZEOT, CLA CLL /CLEAR REMAINS
+ TAD ERX /SWITCH
+ SZA CLA /ERROR?
+ JMP RERR /OK, IT'S LEGAL
+
+/NOT LEGAL END ZONE FLAG
+
+ JMS I TYPE
+ 0516 /EN
+ 0440 /D
+ 2401 /TA
+ 2005 /PE
+ 4000 / 0
+ JMP ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, JMS I TYPE
+ 1501 /MA
+ 2213 /RK
+ 4024 / T
+ 2201 /RA
+ 0313 /CK
+ 4000 / 0
+ JMP ZCOM
+\f/PARITY ERROR
+
+ZPAR, JMS I TYPE
+ 2001 /PA
+ 2211 /RI
+ 2431 /TY
+ 4000 / 0
+ JMP ZCOM
+
+/SELECT ERROR
+
+ZSEL, JMS I TYPE
+ 2305 /SE
+ 1405 /LE
+ 0324 /CT
+ 4000 / 0
+ JMP ZCOM
+
+/TIMING ERROR
+
+ZTIM, JMS I TYPE
+ 2411 /TI
+ 1511 /MI
+ 1607 /NG
+ 4000 / 0
+
+/TYPE "ERROR PHASE X"
+
+ZCOM, TAD PHASE /WHAT PHASE OF OPERATION
+ TAD PFORM /WAS THE MACHINE IN
+ DCA TFORM /WHEN ERROR OCCURED
+ JMS I TYPE
+ 0522 /ER
+ 2217 /RO
+ 2240 /R
+ 2010 /PH
+ 0123 /AS
+ 0540 /E
+TFORM, 4060 / X
+ 4345 /CR+LF
+ 0000 /END
+ JMS I TYPIN
+
+/HE CAN RESTART IF HE TYPES "RETRY"
+
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0324 /T
+ 0322 /R
+ 0331 /Y
+ 0000 /0
+ JMP I IT /GUESS HE DOESN'T WISH TO TRY AGAIN
+\f/ATTEMPT RESTART. NOTE, "ATTEMPT"
+
+ TAD PHASE /RESTART ACCORDING TO
+ TAD ZFORM /WHICH PHASE WAS HE IN
+ DCA .+3
+ JMP I .+2
+ZFORM, .+2
+ 0000
+ JMP I .+5 /PHASE 0
+ JMP I .+5 /PHASE 1
+ JMP I .+5 /PHASE 2
+ JMP I .+5 /PHASE 3
+ JMP I .+5 /PHASE 4
+ START
+ PSER
+ DOBLK
+ DBN
+ NOP
+PFORM, 4060
+\f
+
+
+/HERE STARTS THIS PROGRAM. IT WILL ASK THE
+/OPERATOR FOR DRIVE NUMBERS, THEN ASK HIM FOR
+/A DIRECTION ON WHAT TO DO WITH THE DRIVES.
+
+/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:
+
+
+/DTA? (3 OR 1 2 3 OR 2 4 7)
+/DIRECT? (MARK 1215)
+/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
+/(YES)
+
+
+/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
+/(HE DOESN'T TYPE THE PARENTHESIS)
+/IF HE HAD ANSWERED NO, "DIRECT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "DIRECT?" THE
+/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
+/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
+/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
+/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
+/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
+/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT
+
+
+
+
+
+\f *1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+
+START0, JMS I TYPE /PRINT TITLE
+ 4543
+ 4300
+ JMS I TYPE
+ TEXT /DTFRMT V4A/
+
+
+START, JMS I TYPE /SET UP TYPER
+ 4543 /CR+LF
+ 4300 /LF+END
+TYQU, JMS I TYPE /"DTA?"
+ 0424 /DT
+ 0177 /A?
+ 4000 / END
+
+/WAIT FOR A REPLY
+
+ JMS I TYPIN /GET NUMBERS
+ TAD BADD /INITIALIZE POINTER (BFR)
+ IAC /(BADD=BUFFER-1, SO BUMP THE AC)
+ DCA BFR /TO START OF INPUT BUFFER
+ DCA DCTR /INITIALIZE DTA COUNTER TO 0
+ DCA CRFLAG /CLEAR FLAG SO CR NOT ACCEPTIBLE
+CRCHK, TAD CRCOD /GET CODE FOR CAR. RETN
+ CIA /NEGATE IT
+ TAD I BFR /SEE IF NEXT CHAR. IN
+ SNA /BUFFER IS CAR. RETN.
+ JMP OKCR /YES: SEE IF C.R. LEGAL HERE
+ DCA CRFLAG /NO: SO C.R. IS LEGAL NOW
+VALCHK, TAD C261 /SEE IF # IS LESS THAN
+ CIA /ASCII 1 (261)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SPA CLA /IS IT LESS THAN ASII 0?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD C270 /NO: SEE IF GREATER THAN
+ CMA /ASC II 8 (270)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SMA CLA /GREATER THAN ASCII 7?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD I BFR /NO: ACCEPT BUFFER
+ RTR
+ RTR /4 BITS RIGHT
+ AND C7000 /ISOLATE DTA
+ JMS REPEAT /GO CHECK FOR REPEATED DTA AND STORE #
+ ISZ BFR /INCREMENT INPUT BUF. PTR.
+ JMP CRCHK /GO LOOK AT NEXT CHAR.
+
+/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
+/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
+OKCR, CLA /CLEAR AC
+ TAD CRFLAG /LOAD CR FLAG; 0 MEANS NO GOOD
+ SNA CLA
+ JMP START /0: NO VALID INPUT; RESTART
+ TAD DCTR /NOT 0: SO HAVE VALID INPUT
+ TAD DBUFAD /CALCULATE END OF DTA LIST +1
+ DCA DBUFPT /STORE IT IN BUFFER POINTER, THEN
+ CMA /COMPLEMENT THE AC AND
+ DCA I DBUFPT /TERMINATE DTA LIST WITH 7777
+INIT1, CLA /CLEAR AC IF COME THRU LOC IT
+ TAD DBUFAD /AND RESET LIST POINTER
+ DCA DBUFPT /TO START OF LIST
+ JMS I GETDTA /GO GET A DTA NUMBER
+
+/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
+/TYPE "DIRECT" AND WAIT FOR THE REPLY
+
+INIT, JMS I TYPE /MESSAGE OUT
+ 0411 /DI
+ 2205 /RE
+ 0324 /CT
+ 7740 /?
+ 0000 /END
+ JMS I TYPIN /WAIT FOR A REPLY
+ JMS I COMPAR /DID HE TYPE "MARK"?
+ 0315 /M
+ 0301 /A
+ 0322 /R
+ 0313 /K
+ 0000 /END
+ JMP .+3
+ JMP I .+1
+ MARK /TO MARK A TAPE
+\f/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS IN REVERSE).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0322 /R
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDR /TYPE BLOCKS
+
+/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS FORWARD).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0306 /F
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDFA /TYPE BLOCKS
+
+/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
+/USING THE SAME CONSTANTS AS BEFORE).
+
+ JMS I COMPAR
+ 0323 /S
+ 0301 /A
+ 0315 /M
+ 0305 /E
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RSTSM /TO MARK AS BEFORE
+
+/SEE IF HE TYPED "RESTART"
+
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0323 /S
+ 0324 /T
+ 0301 /A
+ 0322 /R
+ 0324 /T
+ 0000 /0
+ JMS QU /MUST BE NONSENSE
+ JMP START /START ALL OVER
+GETDTA, NUDTA /POINTER TO ROUTINE TO SWITCH UNITS
+CRFLAG, 0 /=0, CR NO GOOD; NOT 0, CR IS OK
+\f/
+\f *1200
+/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
+/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
+/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)
+
+MARK, TAD BINCON /ADDRESS OF FIRST BINARY
+ DCA W5 /CONSTANT FOR DEC TO BIN
+ DCA TOTAL /WILL BE BINARY EQUIVILANT
+
+/SAVE C(X1) FOR DECREMENT THROUGH BUFFER
+
+DNC, CLA CMA /DECREMENT BUFFER ADDRESS
+ TAD W1 /ADDRESS BY 1
+ DCA W1 /W1=SWEEP ADDRESS
+
+/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER
+
+ TAD LETK /LETTER ASCII "K"
+ CIA /SUBTRACT FROM CHARACTER
+ TAD I W1 /IN BUFFER
+ SNA CLA /EQUAL?
+ JMP DIV3 /YES: SEE IF DIVISIBLE BY 3
+
+/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN
+
+ TAD C260 /ASCII FOR 0
+ CIA /TO SEE IF CHARACTER
+ TAD I W1 /IS LESS THAN 260
+ SPA CLA /IS IT?
+ JMP I QU1 /YES: NOT DECIMAL CHARACTER
+ TAD C271 /ASCII FOR 9
+ CMA /TO SEE IF GREATER THAN
+ TAD I W1 /9
+ SMA CLA /IS IT?
+ JMP I QU1 /NOT A DECIMAL CHARACTER
+\f/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
+/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
+/10,100,1000.
+
+ TAD I W1 /ISOLATE THE NUMBER
+ AND C0017 /FOR PROPER CONVERSION
+ SNA /IF 0, NO BINARY CONVERSION NEEDED
+ JMP IBS /YES: 0: INCREMENT BINARY CONVERSION
+
+/NOT 0, SET UP CONVERSION LOOP
+
+ CLL CIA /NUMBER OF ADDITIONS
+ DCA W4 /TO NEGATIVE FOR ISZ
+ TAD I W5 /BINARY POSITION TO C(ACC)
+ TAD TOTAL /ADD TO PRESENT TOTAL
+ SZL /CHECK ON TO MANY WORDS
+ JMP I QU2 /TO MANY WORDS CALLED FOR
+ DCA TOTAL /KEEP RUNNING SUM
+ ISZ W4 /LAST ADDITION?
+ JMP .-6 /NO: ADD AGAIN
+
+/FINAL ADDITION FOR THIS POSITION COMPLETED
+
+IBS, ISZ W5 /NEXT POSITION
+ JMP DNC /DO NEXT CHARACTER
+
+/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
+/IF NOT A NORMAL INPUT
+
+DIV3, TAD TOTAL /GET TOTAL WORDS
+ SNA /IF TOTAL 0, NORMAL INPUT
+ TAD C201 /129 OCT. THIS TEST REDUNDANT
+ TAD C0017 /ADD CONSTANT 15 TO TOTAL
+ DCA TOTAL /FOR FUTURE CONSIDERATIONS
+ DCA VAR1 /# OF WORDS/3 FOR MARK TRACK WRITING
+ TAD TOTAL /RESTORE IN THE ACC
+ CLL /TO DIVIDE BY 3, LINK KEEPS OVERFLOW
+ TAD M3 /SUBTRACT 3
+ ISZ VAR1 /ON EACH DIVISION, KEEP RUNNING SUM
+ SZA /IF AC = 0,NO REMAINDER
+ SNL /WHEN LINC GOES TO 0, DIVISION ENDED
+ SKP /NOW SEE IF IT DIVIDED EVENLY
+ JMP .-6 /SUBTRACT 3 MORE
+ SZA CLA /IF 0,OK. OTHERWISE ERROR
+ JMP I QU4 /NOT DIVISIBLE BY 3
+
+/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
+/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
+/CONFIGURATION TO BE WRITTEN.
+
+ TAD M7 /SUBTRACT 7 FROM PHONY SETUP
+ TAD VAR1 /GIVING THE NUMBER OF TIMES
+ CIA /TO BE USED LATER IN A ISZ
+ DCA VAR1 /DATA MARK WILL BE WRITTEN
+\f
+/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
+/RECORD SIZE + 15 INTO 636160 OCT.
+
+ TAD C7714 /EXTENDED 64 VALUE. SETS AC#2
+ DCA W1 /SET FOR 640000
+ JMS I FORM10 /PATCH TO CHECK FOR STD.10 FORMAT
+ TAD C1620 /VERNIER ADJUSTMENT FOR FORMULA
+ CLL /ACC#2 CARRY FUNCTION
+ TAD TOTAL /WORD COUNT
+ ISZ BLOCKS /+1 TO BLOCK COUNT
+ SKP
+ JMP I QU3 /TO MANY BLOCKS CALLED FOR
+ SNL /CARRY INTO ACC#2?
+ JMP .-5 /NO: CONTINUE COUNT
+ ISZ W1 /YES: FULLY DIVIDED?
+ JMP .-10 /NO: CONTINUE PROCESS
+ CLA CLL /C(ACC)+ C(L)=0
+F10RTN, TAD BLOCKS /FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
+ CMA /WRITING
+ DCA VAR2 /SEE MARK WRITE
+
+/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
+/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.
+
+ TAD TOTAL /SUBTRACT 15 FROM TOTAL
+ TAD C7761 /WORDS FOOLING OPERATOR
+ DCA TOTAL /CORRECTED FOR TAPE WRITING
+ TAD TOTAL /FOR OCTAL TYPEOUT
+ JMS I TYOCT /TYPE OCTAL WORDS
+ JMS I TYPE /TYPE MESSAGE
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 5400 /, END
+ TAD BLOCKS /TYPE OUT BLOCK #S
+ IAC /TO FOOL THE OPERATOR
+ JMS I TYOCT /IN OCTAL
+ JMS I TYPE /TYPE MESSAGES
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2356 /S.
+ 1713 /OK
+ 7733 /?(
+ 3105 /YE
+ 2340 /S
+ 1722 /OR
+ 4016 / N
+ 1735 /O)
+ 4543 /CR+LF
+ 0000 /END
+ JMS I TYPIN /WAIT FOR REPLY
+\f/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+ JMS I COMPAR
+ 0331 /Y
+ 0305 /E
+ 0323 /S
+ 0000 /END
+ JMP I IT
+
+/SEE IF THE DRIVE IS OK
+
+RSTSM, TAD DT0060 /GIVE WRTM, NO GO
+ TAD DTA /AND DTA #
+ DTCX /ORDER EXECUTE
+ DCA W1 /STALL FUNCTION
+CDTRD, DTRB /READ STATUS "B"
+ SMA CLA /ERROR?
+ JMP CIZ /NO: TIME OUT STALL
+ JMS I TYPE /YES: INCORRECT SETUP
+ 2305 /SE
+ 2425 /TU
+ 2077 /P
+ 0000 /END
+ JMP I .+1
+ START
+
+/STALL FOR A WHILE FOR THE INTERRUPT
+
+CIZ, ISZ W1 /ONE ROUND'S WORTH
+ JMP CDTRD /OF ISZ
+ JMP I .+1
+ STMK /OK, GO DO THE MARK TRACK
+FORM10, F10PAT
+
+\f *1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE
+/SET. FROM THIS POINT ON, CONTROL IS EXECUTED
+/VIA THE WCO INTERRUPT
+
+/CLEAR OUT STATUS "A" AND RELOAD IT WITH CONTINUOUS
+/WRITE TIMING AND MARK TRACK COMMAND
+
+STMK, TAD DT0360 /FWD, CONT, T+M,GO,INT
+ TAD DTA /ADD IN THE DTA
+ DTCX /CLEAR FLAGS START MOTION
+ DCA PHASE /FOR ERROR ROUTINE
+ TAD VAR2 /TO MAKE A RESTART FOR THE "SAME"
+ DCA W6 /OPTION POSSIBLE
+
+/WRITE END ZONE. WRITE ABOUT 10' OF THIS
+/CONFIGURATION. 4044
+/ 0440 ON TAPE AS
+/ 4404 (5555) OCTAL.
+
+ DCA W1 /CLEAR COUNTER, 7777= ABOUT 10'
+CEZ, TAD REZ /LOAD ADDRESS OF DATA
+ DCA I CA /TO BE WRITTEN INTO THE CA
+ TAD M3 /LOAD # WORDS TO BE WRITTEN INTO
+ DCA I WC /WC LOCATION
+
+/WAIT FOR INTERRUPT, TEST FOR END OF
+/END ZONE WRITING.
+
+ JMS I WAIT /FOR INTERRUPT
+ ISZ W1 /END OF FOOTAGE?
+ JMP CEZ /NOT END FOOTAGE, CONTINUE
+ /OK, WRITE INTERBLOCK SYNC
+
+/WRITE INTERBLOCK SYNC. SINCE THIS CONFIGURATION
+/ACT AS A NOP TO THE TCU, AT THE BEGINING OF
+/TAPE, MORE LENGTH OF THIS IS NEEDED FOR TURN AROUND
+/TIME TO GUARANTEE BLOCK 0000 TO THE LIBRARY SYSTEM
+/THEREFORE AT THE BEGINING OF TAPE ONLY, WRITE SEVERAL
+/INTERBLOCK ZONES
+
+ TAD M144 /NUMBER OF TIMES TO
+ DCA W1 /WRITE INTERBLOCK SYNC
+ JMS INBLSY /WRITE 1 INTERBLOCK SYNC
+ ISZ W1 /CONFIGURATION, TEST END
+ JMP .-2 /NOT TOTAL FOOTAGE. WRITE AGAIN
+ JMP WDZ /COMPLETED, GO ON
+\f/AT NORMAL RETURN, WRITE ONLY ONE INTERBLOCK SYNC
+/CONFIGURATION. APPEARS AS 0404
+/ 0404 ON TAPE AS
+/ 0404 2525 OCTAL
+
+INBLSY, 0
+ TAD IBZ /COUNTER AND WORD
+ DCA I CA /COUNT WITH KEYS
+ TAD M3 /FOR CONTROL
+ DCA I WC
+ TAD VAR1 /RESET THE WORDS
+ DCA W5 /PER BLOCK COUNTER
+
+/WAIT FOR INTERRUPT, RETURN TO SEQUENCE
+
+ JMS I WAIT /FOR INTERRUPT
+ JMP I INBLSY
+
+
+/WRITE FORWARD BLOCK MARK AND REVERSE GUARD
+/THREE WORDS 0404
+/ 4004 ON TAPE AS
+/ 4040 2632 OCTAL
+
+WDZ, TAD FBM /ADDRESS OF PATTERN
+ DCA I CA /TO CURRENT ADDRESS
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNTER
+ JMS I WAIT /DROP THROUGH AFTER WRITE
+
+
+/WRITE LOCK MARK, REVERSE CKSUM, REVERSE FINAL,REV PREFINAL
+/SIX WORDS 1. 0040 4. 0040
+/ 2. 0000 5. 0000 ON TAPE OCTAL
+/ 3. 4000 6. 4000 10101010
+
+ TAD WLMRF /ADDRESS OF PATTERN
+ DCA I CA /TO CURRENT ADDRESS
+ TAD M6 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNTER
+ JMS I WAIT /DROP THROUGH AFTER WRITE
+
+
+/ WRITE THE DATA TRACK. SINCE THE LENGTH OF EACH
+/RECORD IS A VARIABLE, "VAR1" KEEPS TRACK OF THE
+/NUMBER OF TIMES THIS CONFIGURATION WILL BE WRITTEN
+/"VAR1" WAS DECIDED FROM ABOVE IN THE FORMULA
+/TRANSLATION SECTION
+/THREE WORDS 4440
+/ 0044 ON TAPE AS
+/ 4000 7070 OCTAL
+DTRK, TAD DZ /LOAD ADDRESS OF THE DATA
+ DCA I CA /CONFIGURATION INTO CA
+ TAD M3 /LOAD # WORDS
+ DCA I WC /INTO WORD COUNT
+\f/WRITE ONE SET TEST "VAR1" FOR LAST SET
+
+ JMS I WAIT /ONE CONFIGURATION
+ ISZ W5 /LAST?
+ JMP DTRK /NOW WRITE DATA MARK TRACK AGAIN
+
+/ MARK TRACK CODE FOR DATA IS COMPLETE. NOW WRITE
+/PREFINAL, FINAL, CHECKSUM AND REVERSE CHECKSUM.
+/SIX WORDS 1 4440 4 4440
+/ 2 4444 5 4444 ON TAPE AS
+/ 3 4044 6 4044 73737373 OCTAL
+
+ TAD FEZ /LOAD ADDRESS OF
+ DCA I CA /DATA CONFIGURATION INTO CA
+ TAD M6 /LOAD # WORDS
+ DCA I WC /INTO WORD COUNT
+ JMS I WAIT /TILL COMPLETED WRITE
+
+
+
+/WRITE GUARD, REVERSE BLOCK
+/THREE WORDS 4040
+/ 0440 ON TAPE AS
+/ 0404 5145 OCTAL
+
+ TAD GRZ /DATA ADDRESS TO
+ DCA I CA /THE CA
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /TO WORD COUNT
+ JMS I WAIT /TILL COMPLETE
+
+
+
+/THIS COMPLETE SET OF DATA TRANSFERES
+/COMPLETES ONE BLOCK ON TAPE. SINCE THE
+/NUMBER OF BLOCKS IS VARIABLE, "VAR2" IS
+/USED TO RECYCLE. "VAR2" WAS SET UP ABOVE IN
+/THE FORMULA TRANSLATION SECTION
+
+ JMS INBLSY /WRITE INTERBLOCK SYNC
+ ISZ W6 /TOTAL NUMBER OF BLOCKS
+ JMP WDZ /WRITTEN? NO:
+
+
+\f/ALL DATA BLOCKS HAVE BEEN WRITTEN.
+/NOW PROVIDE A BUFFER ZONE OF INTERBLOCK SYNC AT THE END
+/OF TAPE AS AT THE START OF TAPE
+
+ TAD M144 /ABOUT TWO BLOCKS(STANDARD) WORTH
+ DCA W1 /ABOUT 100 TIMES
+ JMS INBLSY /WRITE ONE PATTERN
+ ISZ W1 /AT END YET?
+ JMP .-2 /NO CONTINUE WRITING INTERBLOCK SYNC
+
+/COMPLETED BLOCK WRITING
+/WRITE ANOTHER 10' OF END ZONE (FORWARD)
+/BEFORE LOADING BLOCK NUMBERS.
+/THREE WORDS 0400
+/ 4004 ON TAPE AS
+/ 0040 2222 OCTAL
+
+ DCA W1 /ISZ=10 FEET
+WEZF, TAD EZM /LOAD ADDRESS OF DATA
+ DCA I CA /INTO CA
+ TAD M3 /NUMBER OF WORDS
+ DCA I WC /WORD COUNT
+
+/WRITE 1 SET, CHECK END OF 10'.
+
+ JMS I WAIT /TILL COMPLETE
+ ISZ W1 /END OF FOOTAGE?
+ JMP WEZF /NO, CONTINUE WITH END ZONE
+ JMP I .+1 /GO AND START BLOCK NUMBER
+ MWTM /SEQUENCING
+\f/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK
+
+
+/REVERSE END ZONE
+
+REZ, .
+ 4044 /ON TAPE AS 5555 (OCT)
+ 0440
+ 4404
+
+/INTERBLOCK SYNC
+
+IBZ, .
+ 0404 /ON TAPE AS 2525 (OCT)
+ 0404
+ 0404
+
+/FORWARD BLOCK MARK AND REVERSE GUARD
+
+FBM, .
+ 0404 /ON TAPE AS 2632 (OCT)
+ 4004
+ 4040
+
+/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
+/AND REVERSE PREFINAL
+
+WLMRF, .
+ 0040 /ON TAPE AS 10101010 (OCT)
+ 0000
+ 4000
+ 0040
+ 0000
+ 4000
+
+/DATA MARK
+
+DZ, .
+ 4440 /ON TAPE AS 7070 (OCT)
+ 0044
+ 4000
+
+/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK
+
+FEZ, .
+ 4440 /ON TAPE AS 73737373 (OCT)
+ 4444
+ 4044
+ 4440
+ 4444
+ 4044
+\f/FORWARD GUARD AND REVERSE BLOCK NUMBER
+
+GRZ, .
+ 4040 /ON TAPE AS 5145 (OCT)
+ 0440
+ 0404
+
+/FORWARD END ZONE
+
+EZM, .
+ 0400 /ON TAPE AS 2222 (OCT)
+ 4004
+ 0040
+/SUBROUTINE TO SEE IF USER TYPED MARK 384
+/TO SPECIFY STANDARD PDP-10 FORMAT
+F10PAT, 0
+ DCA BLOCKS /CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
+ TAD TOTAL /AND GET NUMBER TYPED BY USER
+ TAD M617 /WAS IT 384?
+ SZA CLA
+ JMP I F10PAT /NO-RETURN
+ DCA W1 /YES-CLEAR W1 FOR WAIT LOOP
+ TAD C1101 /AND ADJUST BLOCK TOTAL FOR
+ DCA BLOCKS /1102(OCTAL) BLOCKS.
+ JMP I .+1
+F10BAK, F10RTN
+M617, -617
+C1101, 1101
+\f
+ *1600
+/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
+/MOVING FORWARD IN THE FORWARD END ZONE. STOP
+/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
+/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
+/"NORMAL/WRTM/RDTM" SWITCH TO "NORMAL"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+/KILL WRITE, STOP TAPE
+
+MWTM, TAD DT0070 /STOP TAPE WITH SELECT ERROR
+ TAD DTA /LOAD DTA INTO ORDER
+ DTCX /EXECUTE THE ABOVE
+ JMS NUDTA /ANY MORE DTAS TO MARK?
+ JMP I DOMARK /YES: GO MARK THEM
+
+/MESSAGE TO OPERATOR
+
+ JMS I TYPE /NO: BACK TO FIRST DTA AND CONTINUE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 / T
+ 1740 /O
+ 1617 /NO
+ 2215 /RM
+ 0114 /AL
+ 0000 /END
+ JMS I TYPIN /WAIT FOR CR
+
+/REVERSE TAPE FOR A FEW SECONDS TO GUARANTEE
+/BLOCK MARK SECT WILL BE UNDER THE HEAD
+
+PSER, TAD DT0600 /REVERSE, MOVE, GO
+ TAD DTA /ADD DTA TO ORDER
+ DTCX /CLEAR TCU,GET MOVING IN REVERSE
+
+/STALL A FEW SECONDS
+
+ TAD M300 /AROUND 2 SECONDS
+ DCA W2 /MAJOR STALL
+MSTALL, ISZ W1 /MINOR STALL
+ JMP .-1 /LOOP MINOR
+ DTSF
+ SKP
+ JMP PSER
+ ISZ W2 /MAJOR STALL
+ JMP MSTALL /LOOP MAJOR
+\f/TAPE OUT ON MARK TRACK NOW, TURN AND GET IT
+/MOVING FORWARD. AT THIS POINT, THE LAST REVERSE
+/BLOCK NUMBER WILL BE WRITTEN UNTILL END ZONE IS
+/REACHED. THEREFORE, WHEN THE BOUNCE OUT OF THE END
+/ZONE TAKES PLACE, THE SYSTEM WILL BE ABLE TO SYNC ON
+/THE REVERSE BLOCK NUMBER TO WRITE THE REST OF
+/THE BLOCK NUMBERS AND KNOWN GOOD DATA IN REVERSE.
+/THIS PROCESS WILL ELIMINATE A NEEDLESS REWIND AND
+/KEEP THE ENTIRE PROCESS TO TWO COMPLETE PASSES
+
+/WRITE LAST REVERSE BLOCK NUMBER GOING FORWARD
+
+ TAD RZ
+ DCA I CA
+ TAD DT0210 /FORWARD, SEARCH, GO
+ TAD DTA /ADD IN THE DTA
+ DTCX /CLEAR STATUS "A" AND RELOAD IT
+ TAD C1 /PHASE 1 ERROR
+ DCA PHASE /FOR ERROR ROUTINE
+
+/WAIT HERE FOR DECTAPE FLAG. CHECK ALSO FOR ERRORS
+/SET BLOCK NUMBER (REVERSE) INTO FORM
+
+ TAD BLOCKS /INTO AC WITH LAST BLOCK NUMBER
+ JMS I MESS /CONVERT BLOCK NUMBER FOR TAPE
+
+/INTERRUPTED? ERROR?
+
+ DTRB /READ STATUS "B"
+ RAR /DECTAPE FLAG TO LINK
+ SNL CLA /FLAG SET?
+ JMP .-3 /NO: CONTINUE WAIT
+
+/BLOCK FOUND. SWITCH TO READ DATA WITH WC ONE LESS THAN
+/NUMBER OF WORDS TO BE READ. READ TILL WC=0
+
+ TAD DT0130 /TO SET STATUS "A" INTO
+RCYBR, DTXA /THE READ DATA MODE
+ CLA CMA /SUBTRACT 1 FROM TOTAL
+ TAD TOTAL /GIVING TOTAL-1 (HO HO)
+ CMA /INVERT FOR ISZ
+ DCA I WC /SET WC
+ TAD C4 /NOP
+ DCA I CA /JIMMIED TO DO NOTHING
+ DTRB /READ "B" REGISTER
+ AND C1000 /ISOLATE END ZONE BIT
+ SZA CLA /END ZONE?
+ JMP I GDBLK /YES: GO AND WRITE THE BLOCK NUMBERS
+ TAD I WC /WAIT TILL WORD COUNT ZERO
+ SZA CLA /EQUAL TO ZERO?
+ JMP .-10 /NO: LOOP AGAIN
+\f/END OF BLOCK FOUND. WRITE JUNK AND REVERSE BLOCK NUMBER
+
+ TAD M14 /12 WORDS TO BE WRITTEN
+ DCA I WC /TO WORD COUNT REG.
+ TAD FORMB /FORM TO CA
+ DCA I CA /OF NUMBERING FORM
+ TAD DT0070 /SWITCH TO WRITE ALL
+ DTXA /MODE.
+
+/LOOK FOR THE DECTAPE FLAG INDICATING ANOTHER RECYCLE
+
+ DTRB /NO: GET "B" AGAIN
+ RAR /FLAG TO LINK
+ SNL CLA /FLAG SET?
+ JMP .-3 /NO: BE PATIENT. HAST NOT.
+ TAD DT0070 /TO SWITCH TO READ DATA
+ JMP RCYBR
+GDBLK, DOBLK
+DOMARK, STMK /POINTER TO START OF MARK ROUTINE
+
+/SUBROUTINE TO GET NEXT DTA UNIT # FROM INPUT LIST OR
+/RECYCLE TO FIRST UNIT IF ALL HAVE BEEN PROCESSED UP TO
+/THIS POINT--CALL SEQUENCE
+/ JMS NUDTA /CALL THE ROUTINE
+/ (RETN1) /RETURNS HERE IF MORE DTAS TO PROCESS
+/ (RETN2) /RETURNS HERE IF END OF LIST
+/END OF LIST MEANS RESET TO FIRST AND RETURN TO (RETN2)
+/RETURN IS WITH DTA SET TO NEW VALUE AND AC=0
+
+NUDTA, 0
+ TAD I LSTPT /GET CURRENT VALUE OF DTA LIST PTR
+ DCA TBUFPT /STORE IT AS TEM. BUF. PTR.
+ TAD I TBUFPT /GET A DTA # FROM THE LIST
+ AND C0007 /ISOLATE LOW ORDER DIGIT
+ SZA CLA /IS IT 7777?
+ JMP LSTEND /YES: END OF LIST
+ TAD I TBUFPT /NO: GET IT BACK
+ DCA DTA /AND STORE AS NEW DTA #
+ ISZ I LSTPT /INCREMENT LIST POINTER
+ JMP I NUDTA /RETURN
+/COMES HERE AT END OF LIST TO RESET PTRS AND RETN TO CALL+2
+LSTEND, ISZ NUDTA /INCREMENT RETURN POINTER
+ TAD I STRTPT /GET ADR. OF START OF LIST
+ DCA I LSTPT /STORE TO RE-INITIALIZE LIST PTR.
+ JMP NUDTA+1 /GO GET FIRST DTA # AND RETURN
+
+STRTPT, DBUFAD /POINTER TO START OF DTA LIST
+TBUFPT, 0 /TEM. STORAGE FOR BUF. PTR.
+LSTPT, DBUFPT /POINTER TO CURRENT VALUE OF DTA LIST PTR
+DTABUF, 0 /START OF DTA # LIST - MAX. 9 WORDS
+RZ, .+1
+ 0
+/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
+/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
+/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
+/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
+REPEAT, 0
+ DCA DNUM /TEM STORAGE FOR NEW DTA #
+ TAD DBUFAD /INITIALIZE POINTER (DBUFPT)
+ DCA DBUFPT /TO START OF DTA LIST
+ TAD DCTR /LOAD NUM. OF DTAS STORED
+ CMA /COMPLEMENT IT
+ DCA COMCTR /STORE IN COMPARE COUNTER
+COMCHK, ISZ COMCTR /DONE WITH ALL COMPARES?
+ JMP DOCOMP /NO: GO DO COMPARE
+ TAD DNUM /YES: STORE NEW DTA#
+ DCA I DBUFPT /AT END OF LIST
+ ISZ DCTR /INCR. # OF DTAS STORED
+ JMP I REPEAT /RETURN
+
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP, TAD I DBUFPT /GET NEXT DTA NUMBER FROM LIST
+ CIA /NEGATE IT
+ TAD DNUM /ADD IN DTA NUMBER PASSED
+ SNA CLA /ARE THEY THE SAME?
+ JMP I REPEAT /YES: RETURN
+ ISZ DBUFPT /NO: INCREMENT LIST POINTER
+ JMP COMCHK /SEE IF DONE ALL COMPARES
+/
+/
+COMCTR, 0 /COUNTER FOR # OF LIST COMPARISONS TO BE DONE
+DCTR, 0 /COUNTER FOR # OF DTAS IN LIST
+DBUFAD, DTABUF /START OF DTA NUM. LIST
+DNUM, 0 /TEM STORAGE FOR DTA #
+/
+\f *2000
+/GO INTO SEARCH IN REVERSE MODE LOOKING FOR
+/THE LAST BLOCK NUMBER. WHEN FOUND, SYNC THE SYSTEM
+/AND WRITE ALL DATA AND BLOCK NUMBERS
+
+DOBLK, JMS I TURN /INTO REVERSE AND SEARCH MODE
+ TAD BLOCKS /TO SET UP
+ DCA BLOCKA /FOR BLOCK DECREMENTING
+ TAD C2 /PHASE 2 ERROR
+ DCA PHASE /FOR ERROR ROUTINE
+
+/LOOK FOR INTERRUPT INDICATING BLOCK NUMBER
+
+ JMS I WAIT /FOR DECTAPE FLAG
+
+/SWITCH TO WRITE ALL. SYSTEM NOW IN SYNC
+
+ TAD DT0140 /SWITCH TO WRITE ALL
+ DTXA /EXECUTE ORDER
+NEXTBN, TAD ADF3 /ADDRESS OF FIRST 3 WORDS INCLUDING
+ DCA I CA /THE FORWARD CHECKSUM TO BE WRITTEN
+ TAD M3 /NUMBER OF WORDS TO BE WRITTEN
+ DCA I WC /TO WORD COUNT
+ JMS CEZN /CHECK FOR END ZONE
+ TAD I WC /CHECK FOR WC=0
+ SZA CLA /=0?
+ JMP .-3 /NOPE: TRY AGAIN
+ DTXA /YUP: CLEAR THE FLAG
+
+/WRITE DATA TRACK. REMEMBER CORRECT DATA IS BEING WRITTEN
+
+ TAD TOTAL /ONE FROM TOTAL NUMBER
+ CIA /OF WORDS FOR COUNTING
+ DCA I WC /DATA WORDS WRITTEN
+ TAD AD7777 /ADDRESS OF SEVENS
+ DCA I CA /DATA TO BE WRITTEN
+
+/MONITOR WORD COUNT FOR A ZERO READING
+/SOME OF THIS TIME IS USED TO SET THE NEXT
+/BLOCK NUMBER INTO THE FORM.
+
+ TAD BLOCKA /CURRENT BLOCK NUMBER
+ JMS I MESS /CONVERT INTO FORM
+ CLA CMA /TO DECREMENT
+ TAD BLOCKA /THE BLOCK COUNT
+ DCA BLOCKA /DOWN TO ZERO
+ JMP CEZB /BYPASS FOLLOWING ROUTINE
+
+/CHECK FOR END ZONE
+CEZN, 0
+ DTRB /READ STATUS "B"
+ AND C1000 /ISOLATE END ZONE
+ SNA CLA /HAVE IT?
+ JMP I CEZN /NOT EZ, RETURN
+ JMP I GDBN /COMPLETED
+\f/CHECK HERE ALSO TO SEE IF END ZONE, INDICATING
+/THAT THE LAST BLOCK HAS BEEN WRITTEN
+
+CEZB, JMS CEZN /END ZONE?
+
+/LOOK FOR WORD COUNT AS BEING EQUAL TO ZERO
+
+ TAD I WC /WC TO C(AC)
+ SNA CLA /END OF DATA WRITE?
+ JMP WBN /YES: GO TO WRITE BLOCK NUMBER
+ TAD AD7777 /RESET CURRENT ADDRESS COUNT
+ DCA I CA /DON'T LET THE CA ADVANCE TO
+ JMP CEZB /MUCH
+
+/DATA HAS BEEN WRITTEN. NOW WRITE REVERSE
+/BLOCK NUMBER, FORWARD BLOCK NUMBER, AND REVERSE
+/CHECKSUM. (12 WORDS)
+
+WBN, DTXA /CLEAR OUT DECTAPE FLAG
+ TAD M14 /WILL WRITE 12 WORDS
+ DCA I WC /FOR THIS BIT
+ TAD FORMA /FROM A FORM CONTAINING
+ DCA I CA /BLOCK NUMBERS
+
+/WAIT FOR END
+
+ JMS CEZN /END ZONE?
+ TAD I WC /NO: SEE IF DONE THE WRITE
+ SZA CLA /DONE YET ?
+ JMP .-3 /NO: PATIENCE IS A VIRTUE????
+ DTXA /RESET THE CURRENT FLAG
+ JMP NEXTBN /YES: GO RECYCLE COMPLETLY
+GDBN, DBN
+
+/ FIRST 3 WORDS TO BE WRITTEN
+
+ADF3, .
+ 0000
+ 0000
+ 0077
+
+/DATA TO BE WRITTEN ON TAPE (REVERSE)
+
+AD7777, .
+ 7777
+ 7777
+ 7777
+ 7777
+/CHECK IF ALL DTAS ARE DONE BEFORE RESTARTING
+
+SETDTA, JMS I GDTA /ALL DTAS DONE?
+ JMP I CONTNU /NO: BACK TO WRITE BLOCK #S ON NEXT
+ JMP I IT /YES: GO ASK "DIRECT?"
+GDTA, NUDTA /POINTER TO SUBR FOR GETTING NEXT UNIT #
+CONTNU, PSER /POINTER TO START OF BLOCK # WRITE ROUTINE
+\f
+
+/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE
+/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT
+
+TYCT, 0
+ DCA TW1 /STORE WORD GIVEN
+ TAD TW1 /TO C(ACC) AGAIN
+ RTR
+ RTR /6 BITS GIGHT
+ RTR
+ DCA TYCT1+2 /SAVE ROTATED VALUE, 1ST TWO
+ TAD TYCT1+2 /TO C(ACC) AGAIN
+ AND C0007 /ISOLATE SECOND CHARACTER
+ TAD C6060 /CONVERT TO ASCII
+ DCA TYCT1+1 /STORE AS FIRST PARTIAL 2
+ TAD TYCT1+2 /ROTATED VALUE STORED ABOVE
+ RTL
+ RAL /3 BITS LEFT
+ AND C0700 /ISOLATE FIRST CHARACTER
+ TAD TYCT1+1 /CONVERT 1ST TO ASCII
+ DCA TYCT1+1 /1ST AND 2ND CHARACTERS READY
+ TAD TW1 /ORIGIONAL WORD
+ AND C0007 /ISOLATE 4TH CHARACTER
+ TAD C6060 /CONVERT 4 TH TO ASCII
+ DCA TYCT1+2 /STORE 4TH FOR A MOMENT
+ TAD TW1 /ORIGIONAL WORD
+ RTL
+ RAL /POSITION IT 3RD CHARACTER
+ AND C0700 /ISOLATE 3RD CHARACTER
+ TAD TYCT1+2 /CONVERT TO ASCII
+ DCA TYCT1+2 /CONVERSION COMPLETE
+TYCT1, JMS I TYPE /TYPE THE FOUR CHARACTERS
+ 0 /FIRST 2
+ 0 /SECOND 2
+ 0 /KILL KEY
+ JMP I TYCT /EXIT FROM ROUTINE
+
+/SOME CONSTANTS FOR THE ROUTINE
+
+TW1, 0000
+C6060, 6060
+\f *2200
+/VERIFY THE TAPE AS BEING WRITTEN CORRECTLY
+/WITH DATA AND BLOCK NUMBERS. THE INFORMATION WRITTEN
+/WAS WRITTEN IN SUCH A WAY AS TO BE CORRECT
+/UPON READING IT BACK
+
+
+/TURN TAPE AND HAVE IT GOING FORWARD
+
+DBN, TAD ISZV /RESET INCREMENT
+ DCA VISZ /BLOCK NUMBERS FORWARD
+ DCA FCON /WILL BE ZEROS FORWARD
+ DCA W1 /FIRST BLOCK NUMBER FORWARD
+ TAD C0400 /TURN TO GO FORWARD
+DBNAUX, JMS I TURN
+ TAD C3 /ERROR IN PHASE 3
+ DCA PHASE /FOR ERROR ROUTINE
+
+/SET SOME OF THE CONTROL REGS
+
+DAB, DCA I WC /WORD COUNT DON'T CARE
+ TAD ADBA /SOME WHERE UP ABOVE
+ DCA I CA /TO GET BLOCK NUMBERS
+
+/WAIT FOR INTERRUPT
+
+ JMS I WAIT /INTERRUPT
+ TAD W1 /FIRST OR NEXT BLOCK NUMBER
+ CIA /TO COMPARE
+ TAD I ADBA /GET THE BLOCK NUMBER
+ SZA CLA /COMPARE OK?
+ JMP BLKERZ /BLOCK ERROR FOUND
+
+/BLOCK COMPARES, NOW CHECK DATA
+
+ TAD DT0030 /TO SWITCH INTO READ
+ DTXA /DATA MODE
+ DCA I WC /DON'T CARE ABOUT THE WC
+CTST, TAD ADWA /FOR COMPARING
+ DCA I CA /FROM TAPE
+
+/EVERY TIME THE WORD COUNT MOVES
+/A DATA TRANSFERE HAS BEEN COMPLETED.
+/MAKE SURE THAT THE INFORMATION IS OK
+
+ TAD I WC /GET WORD COUNT
+ SNA CLA /STILL AT ZERO?
+ JMP CEFR /YES: SEE IF AT END
+ TAD FCON /NO: SEE IF DATA
+ CIA /IS SAME AS WRITTEN
+ TAD I ADWAB /RECEIVED DATA
+ SZA CLA /SAME?
+ JMP DTAR /DATA ERROR FOUND
+ DCA I WC /YES: RESET WORD COUNT
+\f/CHECK FOR DECTAPE FLAG INDICATING END OF
+/BLOCK OR ERROR
+
+CEFR, DTRB /READ "B" REGISTER
+ SPA /ERROR?
+ JMP PARIR /PARITY ERROR, I GUESS
+
+/NO ERROR, END OF BLOCK?
+
+ RAR /FLAG TO THE LINK
+ SNL CLA /END?
+ JMP CTST /NO: CONTINUE CHECKING
+ TAD DT0030 /CLEAR DECTAPE FLAG
+ DTXA /AND RETURN TO SEARCH
+
+/END OF BLOCK. SEE IF END OF TAPE
+
+ TAD W1 /BLOCK NUMBER JUST TESTED
+VISZ, ISZ W1 /+1 OR -1 TO BLOCK COUNT
+ SKP
+ HLT /ABSOLUTE PANIC
+ CIA /TO BE COMPARED WITH
+ TAD BLOCKS /TOTAL BLOCKS
+ SZA CLA /LAST?
+ JMP DAB /NO, DO ANOTHER BLOCK
+
+
+/HERE PUT IN THE REVERSE CHECK
+
+DDSF, DTSF /WAIT FOR ANY FLAG TO APPEAR
+ JMP .-1 /NOT YET
+ CLA CLL /RID AC OF GARBAGE
+ DTRB /READ THE "B" REGISTER
+ AND C1000 /BETTER BE END ZONE
+ SNA CLA /IS IT?
+ JMP LNE /LAST INTERRUPT NOT END ZONE
+ DTCX /YUP: A OK
+\f/BLOCK NUMBERS AND DATA HAVE BEEN CHECKED FORWARD
+/AND ARE OK. USING THE ABOVE ROUTINE FOR CHECKING
+/RESET A FEW THINGS AND CHECK IN REVERSE
+
+/WAS COMPLETION FOUND FORWARD? IF SO GO CHECK
+/IN REVERSE; IF NOT GO SEE IF ALL TAPES HAVE BEEN CHECKED.
+
+
+ TAD FCON /IF 0'S, IT WAS FWD
+ SZA CLA /FWD?
+ JMP I FINCHK /N0: REVERSE-SEE IF ALL DTAS DONE
+
+/RESET THE ABOVE ROUTINE TO READ IN REVERSE
+
+ CMA /DATA WILL BE AS WRITTEN
+ DCA FCON /I.E., 7777'S
+ TAD SJMP /INSTEAD OF INCREMENTING
+ DCA VISZ /WE WILL DECREMENT BLOCK NUMBERS
+ TAD BLOCKS /STARTING WITH THE HIGHEST
+ DCA W1 /AND WILL WORK TO ZERO
+ JMP DBNAUX /ALL SET, TRAVEL ONWARD
+
+/RETURN HERE AFTER EACH BLOCK FOR CHECKING WHEN LAST BLOCK
+/HAS BEN PROCESSED????????????
+
+SJMP, JMP .+1
+ SNA /IF AC = 0, WE ARE DONE
+ JMP DDSF /AND NEXT FLAG SHOULD BE END ZONE
+ CIA /OTHERWISE, SUBTRACT ONE FROM
+ CMA /BLOCKS GIVING BLOCKS-1......?
+ DCA W1 /NOT DONE
+ JMP DAB /GO DO ANOTHER BLOCK
+
+ISZV, ISZ W1 /VARIABLE TAG
+FINCHK, SETDTA
+\f/BLOCK ERROR FOUND
+
+BLKERZ, TAD DTA /TO RESET TAPE
+ DTCX /MOTION
+ TAD I ADBA /GET BAD BLOCK NUMBER
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS TYSB /TYPE "SHOULD BE"
+ TAD W1 /GOOD BLOCK NUMBER
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE
+ 4002 / B
+ 1413 /LK
+ 4005 / E
+ 2243 /R CR
+ 4500 /LF+END
+DBERZ, JMP I .+1
+ ZCOM
+
+/COMMON ROUTINE
+
+TYSB, 0
+ JMS I TYPE
+ 4023 / S
+ 1017 /HO
+ 2514 /UL
+ 0440 /D
+ 0205 /BE
+ 4000 / 0
+ JMP I TYSB
+
+/DATA ERROR
+
+DTAR, TAD DTA /TO STOP TAPE
+ DTCX /MOTION
+ TAD I ADWA /GET THE BAD WORD
+ JMS I TYOCT
+ JMS TYSB /TYPE "SHOULD BE"
+ TAD FCON /GOOD WORD
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE
+ 4004 /D
+ 0124 /AT
+ 0140 /A
+ 0522 /ER
+ 4543 /CR+LF
+ 0000 /END
+ JMP DBERZ
+\f/PARITY ERROR FOUND
+
+PARIR, JMP I .+1
+ ERROR /MAIN ERROR ROUTINE
+
+/LAST INTERRUPT WAS NOT END ZONE
+
+LNE, JMS I TYPE
+ 1401 /LA
+ 2324 /ST
+ 4011 / I
+ 1624 /NT
+ 4016 / N
+ 1724 /OT
+ 4005 / E
+ 1724 /OT
+ 4345 /LF+CR
+ 0000 /END
+ JMP DBERZ
+\f *2400
+/ TYPE OUT THE DTA UNIT NUMBER AND THE FIRST 12 BLOCK
+/NUMBERS IN EITHER DIRECTION. IF RDR, IN REVERSE
+/IF RDF, TYPE THEM OUT GOING IN THE FORWARD
+/DIRECTION FROM THE BEGINING OF TAPE
+
+RDFA, TAD C0400 /DIRECTION FOR TURNING
+ DCA SAVEIT /STORE DIRECTION FOR NEXT DTA UNIT
+ TAD SAVEIT /GET DIRECTION FOR TURNING
+ JMS I TURN /AROUND
+ TAD M14 /READ 12 BLOCK
+ DCA W3 /COUNTER
+ TAD BADD /ADDRESS OF BUFFER
+ DCA X2 /TO AUTO INDEX 2
+ TAD ADW3 /ADDRESS OF W2
+ DCA I CA /FOR DATA XFER
+ JMS I WAIT /FOR BLOCK INTERRUPT
+ TAD W2 /BLOCK NUMBER
+ DCA I X2 /STORE BLOCK NUMBER
+ ISZ W3 /TOTAL = 12?
+ JMP .-4 /NO: GRAB NEXT
+ TAD DTA /KILL TAPE MOTION
+ DTCX /HERE
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT #
+
+ JMS I TYPE /TYPE "DTA"
+ 0424 /DT
+ 0140 /A
+ 0000 /END
+ TAD DTA /GET UNIT #
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS I TYPE
+ 4345 /CR&LF
+ 0000 /END
+ TAD M14 /WILL TYPE ALL
+ DCA W1 /TWELVE WORDS
+ TAD BADD /ADDRESS OF BLOCK
+ DCA X2 /NUMBERS TO INDEX 2
+ TAD I X2 /FIRST OR NEXT BLOCK
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE /CR AND LINE FEED
+ 4345 /CR+LF
+ 0000
+ ISZ W1 /COMPLETE?
+ JMP .-6 /NO
+ JMS I NEWDTA /YES: ANY MORE DTAS?
+ JMP RDFA+2 /YES: GO GET BLOCK #S
+ JMP I IT /NO: GO ASK FOR "DIRECT?"
+RDR, JMP RDFA+1 /OTHER DIRECTION
+
+SAVEIT, 0 /TEM. STORAGE FOR DIRECTION
+NEWDTA, NUDTA /POINTER TO SUBR. TO GET A NEW DTA UNIT #
+\f
+/INPUT BUFFER FOR THE TELETYPE.
+/NOTE ,,,,,,,THIS MUST BE AT THE END OF THE PROGRAM
+
+BUFFER, 0000
+
+$
+\f
--- /dev/null
+/17 SUPER TTY HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/S.W.,S.R.,H.J.,R.L.,S.R.
+
+ *0
+
+ -1
+ DEVICE KL8E;DEVICE TTY;0;TTY&177+4000;ZBLOCK 2
+
+/TWO-PAGE TELETYPE HANDLER FOR OS/8 V3.
+/ON INPUT, RECOGNIZES ^Z, ^C, ^U, RUBOUT
+/^Z MEANS END OF INPUT, INSERT ^Z IN BUFFER,
+/ PAD WITH ZEROES, AND ECHO "^Z"
+/^C MEANS ABORT JOB, RETURN TO OS/8 VIA LOC 7600 TO SAVE CORE AND PRINT "^C"
+/^U MEANS DELETE THE LAST LINE, ALLOW OPERATOR TO RETYPE
+/ (LINE STARTS AT BEGIN OF BUFFER AND IS TERMINATED BY A CR)
+/ A CR GETS ENTERED INTO BUFFER, CAUSES A LF TO ALSO ECHO
+/ AND GET ENTERED INTO BUFFER, BUFFER IS THEN PADDED WITH NULLS.
+/ CONVERTS LC TO UC
+
+/ON OUTPUT RECOGNIZES ^C, ^O, ^S, ^Q FROM KEYBOARD
+/^C CAUSES JOB TO ABORT, RETURN TO OS/8 VIA LOCATION 7600
+/ TO SAVE CORE AND PRINT "^C"
+/^O CAUSES ECHOING BY THE HANDLER TO CEASE
+/ TYPING ANY OTHER CHARACTER RESUMES ECHOING.
+/^S CAUSES THE HANDLER TO STOP SENDING TO TERMINAL
+/^Q RESUMES HANDLER SENDING
+/ ^S AND ^Q ARE IGNORED IN OTHER CASES
+
+/WHENEVER PRINTING CHARACTERS (EITHER ON OUTPUT OR WHEN ECHOING),
+/ IGNORES NULLS
+/ FLAGS LC WITH AN APOSTROPHE
+/ HANDLES TABS CORRECTLY (SEVERAL WAYS)
+/ PRINTS ESCAPE AS $
+/ DELAYS 16 MS AFTER LINEFEEDS
+/ PRINTS CONTROL CHARACTERS AS "^K"
+
+/DOES AUTOMATIC CR/LF AT END OF LINE WIDTH.
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. ADDED KCC FOR NON-CONSOLE TELETYPES
+
+/V3D CHANGES: (VERSION E)
+
+/1. ADDED DELAY OPTION FOR VT78
+/2. ADDED SCOPE RUBOUTS
+/3. CHANGED VT78 DEFAULTS
+/4. REARRANGED CODE FOR SET TTY ESC AND ARROW
+\f INDVC=03
+ OUTDVC=04
+
+ KSF=10^INDVC+6001
+ KCC=10^INDVC+6002
+ KRS=10^INDVC+6004
+ KRB=KCC KRS
+ TSF=10^OUTDVC+6001
+ TCF=10^OUTDVC+6002
+ TPC=10^OUTDVC+6004
+ TLS=TCF TPC
+
+ TTYVERSION="E&77
+\f/BUILD YOUR OWN TELETYPE HANDLER:
+
+/THIS SOURCE HAS MUMBLE LOCATIONS LEFT.
+
+/THE FOLLOWING CONDITIONALS ALLOW YOU TO INCLUDE OPTIONAL FEATURES.
+/YOU MAY INCLUDE AS MANY OR AS FEW AS YOU DESIRE PROVIDED THERE
+/IS ROOM LEFT.
+
+/CONDITIONAL LOCATIONS LOCATIONS INCLUDED
+/VARIABLE PAGE 1 PAGE 2 FEATURES
+
+/ DELAY 0 7 DELAY AFTER GIVEN CHAR
+/ CTRL 0 3 PRINT CONTROL CHARS AS ^K
+/ RUB 0 0 PRINT CHAR RUBBED OUT ON RUBOUTS
+/ SIMTAB 0 10 SIMULATE TABS AS SPACES
+/ SLOTAB 0 6 PUT OUT 2 RUBOUTS AFTER A TAB
+/ ESC 0 10 PRINT ESCAPE AS $
+/ FLAGLC 0 12 FLAG LOWER CASE CHARS ON OUTPUT
+/ CNVLC 0 7 CONVERT LOWER CASE ON INPUT TO UPPER CASE
+/ ALTMOD 0 11 CONVERT ALTMODES (175,176) TO ESCAPE (33)
+/ PAUS 0 20 PAUSE BETWEEN PAGES
+/ FREE LOCS: 2 33
+
+ VT78=1 /SET TO 0 TO ALLOW OTHER PARAMETERS
+ /SET TO 1 TO FORCE OTHER PARAMETERS TO VT78 COMPATIBLE
+
+ DELAY=0 /SET NON-ZERO TO ALLOW DELAY AFTER ANY CHAR (12=CR)
+ /TYPICALLY AFTER LF FOR HIGH SPEED VT05
+ /SET VALUE OF DELAY = 7-BIT CHAR TO DELAY AFTER
+
+ CTRL=1 /SET TO 1 TO ECHO CONTROL CHARS AS ^K
+ /SET TO 0 TO ACCEPT CONTROL CHARACTERS AND PUT
+ /IN BUFFER, BUT NOT ECHO THEM (EXCEPT THE USUAL)
+ RUB=1 /SET TO 0 TO ECHO EACH RUBOUT BY TYPING A BACK SLASH
+ /SET TO 1 TO ECHO CHARS RUBBED OUT UPON RUB-OUT
+ /SET TO 4000 TO PERFORM SCOPE TYPE RUBOUTS
+ SIMTAB=1 /SET TO 1 TO SIMULATE TABS AS THE CORRECT NUMBER OF SPACES
+ /SET TO 0 TO TYPE TABS AS TABS
+ SLOTAB=0 /SET TO 1 TO TYPE 2 RUBOUTS AFTER A TAB
+ /ONLY IS APPLICABLE IF SIMTAB=0
+ ALTMOD=0 /SET TO 1 TO CONVERT 175,176 TO 33
+ /(UPPER CASE TERMINALS ONLY)
+ ESC=1 /SET TO 1 TO ECHO ESCAPE AS $
+ /SET TO 0 TO ECHO ESCAPE AS A CONTROL CHAR (^[)
+ FLAGLC=1 /SET TO 1 TO FLAG LOWER CASE CHARS ON OUTPUT
+ /THIS IS FOR PEOPLE NOT PRIVELIDGED ENOUGH TO
+ /OWN A LOWER CASE TERMINAL
+ /SET TO 0 TO PRINT LOWER CASE CHARS AS IS
+ CNVLC=0 /SET TO 1 TO CONVERT LOWER CASE CHARS ON INPUT TO UPPER CASE
+ /SET TO 0 TO ACCEPT INPUTTED LOWER CASE CHARS AS IS
+ /THIS IS FOR PEOPLE WHO ARE HANDICAPPED BY A LOWER CASE
+ /TERMINAL AND ONLY WANT UPPER CASE
+ PAUS=200 /NON-0 PAUSES BETWEEN SCOPE PAGES
+ HEIGHT=30 /NUMBER OF LINES PER SCREEN
+
+/SOME OF THE ABOVE OPTIONS SHOULD ACTUALLY BE IMPLEMENTED
+/IN SUCH A MANNER THAT THE USER CAN CHANGE THEM VIA AN ALTER
+/RATHER THAN HAVE TO REASSEMBLE.
+
+ IFNZRO VT78 <
+ DELAY=0
+ CTRL=1
+ RUB=4000
+ SIMTAB=0
+ SLOTAB=0
+ ALTMOD=0
+ ESC=1
+ FLAGLC=0
+ CNVLC=0
+ IFNZRO INDVC-3 <CTRL=0>
+ >
+\f/CROSS PAGE LINKAGE:
+
+/THIS CODE MUST BE ABLE TO LOAD INTO ANY TWO PAGES OF CORE
+/THE ENTRY POINT IS AT THE NEXT LOCATION TO THE END OF THE FIRST PAGE
+/AT THE END OF THE FIRST PAGE WE JMS TO PLINK,
+/THIS LEAVES THE ADDRESS OF THE FIRST LOCATION OF THE NEXT PAGE
+/IN LOCATION 'PLINK' . THIS JUST HAPPENS TO BE THE ADDRESS
+/OF BOTH TTYPCH AND TTYGCH.
+
+/TTYPCH AND TTYGCH SHARE THE SAME ENTRY POINT.
+/IF IT IS CALLED WITH A 0 AC, IT IS A CALL TO TTYGCH,
+/IF IT IS CALLED WITH A NON-ZERO AC, IT IS A CALL TO TTYPCH.
+
+/RETURN 1 MEANS GOT RUBOUT
+/TTYGCH TAKES RETURN 2 IF IT GOT A ^Z.
+/OTHERWISE IT TAKES RETURN 3 WITH CHARACTER GOTTEN IN AC.
+
+/TTYPCH TAKES RETURN 1 IF IT WANTS THE HANDLER TO GO AWAY,
+/I.E IF IT SAW A ^Z.
+/AC IS NORMALLY NON-ZERO UPON RETURN
+/AC IS POSITIVE MEANS DO A CRLF
+
+/WHEN ECHOING WE WANT TO CALL TTYPRT
+/BUT OTHERWISE WE WANT TO CALL TTYPCH (WHICH DOES ADDITIONAL
+/STUFF LIKE CHECK ^O, ^Q, ETC.
+/WE TELL BY WHETHER OR NOT TTYGCH HAD BEEN PREVIOUSLY CALLED.
+\f *200
+
+PLINK, 0 /GETS ADDRESS OF TTYPCH AND TTYGCH (START OF NEXT PAGE)
+ STL CLA RAR /4000
+ TAD I TTY /RETRIEVE FUNCTION WORD, BUT PUT R/W BIT IN LINK
+ AND L3700 /EXTRACT NUMBER OF DOUBLE-WORDS TO TRANSFER
+ CMA /GET COUNT+1
+ DCA BUFSIZ /STORE AWAY
+ RDF /FIND OUT THE USER'S DATA FIELD
+ TAD CIFCDF /FORM OUR EXIT CIF CDF
+ DCA TTYXIT /STORE AWAY FOR EXIT ROUTINE
+ TAD TTY70 /GET FUNCTION WORD
+L776, AND I TTY /ISOLATE FIELD OF BUFFER
+ TAD TTYCDF /FORM CDF TO FIELD OF BUFFER
+ DCA TTCDBF /STORE WHERE IT WILL BE USEFUL
+ /AT SAME TIME, INITIALIZE TTYEOF
+ ISZ TTY /POINT TO BUFFER ADDRESS
+ TAD I TTY /AND GET IT
+ DCA BUFSTRT /AND SAVE IT
+ ISZ TTY /POINT TO BLOCK #
+TTY376, ISZ TTY /POINT TO ERROR RETURN
+SHIFT, /OUTPUT SHIFT REGISTER
+TTYEOF, /0 IF SAW CR OR ^Z AND WISH TO PAD BUFFER WITH 0'S
+TTCDBF, HLT /CDF BUFFER FIELD
+ JMP TTYKLG
+TTYLP, SNL CLA /LINK=1 MEANS OUTPUT
+ JMP TTYGET /INPUT IS FROM TTY:
+\f/LINK MUST BE SET FIRST TIME THROUGH HERE.
+/IT ACTS AS A GUARD BIT IN THE SHIFT REGISTER
+ROTL, RTL
+ RTL
+ SPA /DO WE HAVE 8 BITS SHIFTED IN?
+ JMP TELP
+ DCA SHIFT /SAVE SHIFT REGISTER
+ TAD I BUFSTRT
+ SZA
+ JMS PUNCH /PRINT A CHARACTER
+ TAD I BUFSTRT
+ ISZ BUFSTRT /BUMP INPUT POINTER
+TT7400, 7400 /PROTECT ISZ
+ AND TT7400
+ CLL RAL
+ TAD SHIFT /SHIFT HIGH ORDER 4 BITS INTO
+ JMP ROTL /SHIFT REGISTER
+TELP, JMS PUNCH /PRINT 3RD CHARACTER OF DOUBLE-WORD
+ STL /***KLUDGE
+TTYKLG, ISZ BUFSIZ /DONE?
+ JMP TTYLP /NOT YET
+TTYX, TAD TTYEOF /IF INPUT AND WE WERE PADDING WITH 0'S
+ SZA CLA /TAKE SOFT ERROR EXIT
+TTYRTN, ISZ TTY /POINT TO NORMAL RETURN
+ /CAN'T GET ERROR OR END-OF-FILE ON OUTPUT
+TTYXIT, HLT /RETURN TO USER'S FIELD
+ JMP I TTY /RETURN TO USER
+TTYCA, 0
+TTYWC, 0
+BUFSIZ, 0
+BUFSTRT,0
+TTY70, 70
+
+PUNCH, 0 /NEVER CALL TTYPCH WITH ZERO AC
+ JMS I PLINK /CALL TTYPCH
+ JMP TTYRTN /GO AWAY, WE SAW A ^Z
+L7700, SMA CLA /DID WE REACH END OF TTY LINE?
+ JMS CRLF /YES, PERFORM CR/LF
+ JMP I PUNCH /RETURN
+
+TMP,
+CRLF, 0
+ TAD L215
+ JMS I PLINK /CALL TTYPCH TO PRINT CR
+L215, 215 /CAN'T RETURN HERE
+ CLA /****
+ TAD L212
+ JMS I PLINK /CALL TTYPCH TO PRINT LF
+L212, 212 /CAN'T RETURN HERE
+ CLA /****
+ JMP I CRLF /RETURN
+\fCTRLU, JMS CRLF /PERFORM A CR/LF
+TTYGET, TAD BUFSTRT
+ DCA TTYCA /POINT TO START OF BUFFER
+ TAD BUFSIZ
+ CLL RAL /CONVERT DOUBLE-WORDS TO WORDS
+DCAWC, DCA TTYWC /SET SIZE OF BUFFER
+TSTEND, TAD TTYEOF
+ SNA CLA
+ JMP ZERO
+ JMS I PLINK /CALL TTYGCH TO GET A CHARACTER
+ JMP RUBOUT /RETURN 1 MEANS SAW RUBOUT
+ZERO, DCA I TTYCA /RETURN 2 MEANS GOT CHARACTER
+ /STORE AWAY TEMPORARILY
+ /USING USER'S BUFFER AS A TEMP LOCATION
+ TAD I TTYCA /GET BACK CHARACTER
+ IFNZRO .-320 <_ERROR>
+ SZA
+ JMS PUNCH /ECHO IT
+ TAD I TTYCA /GET IT AGAIN
+ TAD M32 /-^Z
+ SNA
+ JMP CTRLZ
+ TAD L5 /^Z-^U
+ SNA /IS IT ^U?
+ JMP CTRLU /YES
+ TAD L7
+GRUDGE, DCA TMP
+ ISZ TTYCA /NO
+L7, 7
+ ISZ TTYWC /IS BUFFER FULL?
+TT10, SKP
+ JMP TTYX
+ ISZ TMP /WAS LAST CHAR A CR?
+ JMP TSTEND /NO
+ DCA TTYEOF /YES, SET "PAD WITH 0'S" FLAG
+ ISZ TTY /POINT TO NORMAL RETURN
+ /CR IS NOT AN ERROR OR END-OF-FILE
+ TAD L212 /IF LAST CHAR INPUT WAS CR, NOW PRETEND LF WAS INPUT
+ JMP ZERO /REJOIN PROCESSING
+
+CTRLZ, DCA TTYEOF
+ JMS CRLF
+ JMP GRUDGE
+
+M32, -32
+L5, 5
+L3700, 3700
+CIFCDF, CIF CDF 0
+TTYCDF, CDF 0
+
+/TTYEOF IS ZERO MEANS PAD BUFFER WITH ZEROES
+\f/DON'T DO YET:
+/RUBOUT, AND TTYWC /177 IN AC
+/ SNA CLA
+/ JMP CTRLU
+
+RUBOUT, KCC /TTYGCH DOESN'T CLEAR RO FROM BUFFER
+ TAD TTYCA
+ CIA
+ TAD BUFSTRT
+ SNA CLA /ARE WE AT BEGIN OF BUFFER?
+ JMP CTRLU /YES
+ STA
+ TAD TTYCA
+ DCA TTYCA
+ IFZERO RUB <
+LSLASH, "\
+ TAD LSLASH /PRINT A BACK SLASH FOR EACH RUBBED OUT CHAR
+ >
+ IFNZRO RUB&4000+RUB <TAD I TTYCA> /PRINT CHAR JUST DELETED
+ IFNZRO RUB&4000 <TAD TT10> /BACKSPACE-SPACE-BACKSPACE
+ JMS PUNCH
+ STA
+ TAD TTYWC
+ JMP DCAWC /BUMP BACK WC AND GET ANOTHER CHAR
+
+ ZBLOCK 376-.
+TTY, TTYVERSION /ENTRY POINT TO HANDLER
+ JMS PLINK /SET UP CROSS PAGE LINKAGE
+ IFNZRO TTY-376 <ENTERR,QQQQ>
+ PAGE
+\f/INTERLUDE:
+
+/USA STANDARD CODE FOR INFORMATION INTERCHANGE:
+
+/ 000 001 010 011 100 101 110 111
+/
+/ 0000 NUL DLE SP 0 @ P ' 'P
+/
+/ 0001 SOH DC1 ! 1 A Q 'A 'Q
+/
+/ 0010 STX DC2 " 2 B R 'B 'R
+/
+/ 0011 ETX DC3 # 3 C S 'C 'S
+/
+/ 0100 EOT DC4 $ 4 D T 'D 'T
+/
+/ 0101 ENQ NAK % 5 E U 'E 'U
+/
+/ 0110 ACK SYN & 6 F V 'F 'V
+/
+/ 0111 BEL ETB ' 7 G W 'G 'W
+/
+/ 1000 BS CAN ( 8 H X 'H 'X
+/
+/ 1001 HT EM ) 9 I Y 'I 'Y
+/
+/ 1010 LF SUB * : J Z 'J 'Z
+/
+/ 1011 VT ESC + ; K [ 'K '[
+/
+/ 1100 FF FS , < L \ 'L '\
+/
+/ 1101 CR GS - = M ] 'M ']
+/
+/ 1110 SO RS . > N ^ 'N '^
+/
+/ 1111 SI US / ? O _ 'O '_
+/
+\f/TTYGCH: GETS A CHAR FROM KBD
+/ IF GOT ^Z, IT SETS TTYEOF FLAG
+/ LEAVES IT IN AC IN 7-BIT
+
+/TTYPRT: PRINTS CHAR IN AC ON TTY
+/ IGNORES NULLS
+/ PRINTS ^X ON CONTROL CHARS (EXCEPT CR, LF, FF, VT, TAB)
+/ PRINTS 'X ON LOWER CASE
+
+/HANDLES TABS CORRECTLY
+/ AND AUTOMATICALLY PRINTS CR/LF AT EOL
+/ PRINTS ESCAPE AS $
+
+/TTYTLS: USED TO ACTUALLY PRINT CHAR
+/ IT HANDLES TABS AUTOMATICALLY
+/ AND CR/LF'S AT END OF LINE
+
+/TTYPCH: IT USES TTYPRT TO PRINT CHAR BUT ALSO RESPONDS TO
+/ ^C, ^O, ^S, ^Q.
+/ IF ^Z IS BEING PRINTED, IT THEN STOPS FURTHER PRINTING
+\f/MUST BE AT TOP OF PAGE
+TTYPCH, /ENTRY POINT TO TTY PUNCH ROUTINE
+ /OR TTY PRINT ROUTINE
+TTYGCH, 0 /ENTRY POINT TO TTY GET CHAR ROUTINE
+ SNA
+ JMS TGCH /ZERO AC-MEANT CALL TO TTYGCH
+PCH, AND (177 /FORCE TO 7-BIT
+ DCA TCHAR
+ TAD TGCH
+M140, SZA CLA /ARE WE ECHOING?
+ JMP ECHO /YES, IGNORE ^S AND STUFF
+K5, 5 /MUST BE AT REL 10
+ TAD TCHAR
+ TAD (-32
+ IFZERO PAUS <
+ SNA CLA
+ JMP I TTYPCH
+ >
+ IFNZRO PAUS <
+ SNA
+ JMP I TTYPCH
+ TAD L15 /32-15
+ SNA CLA /LOOK FOR CR
+ ISZ LINCNT /AT END OF PAGE?
+ JMP NOPAUS /NOT AT CR, OR AT CR BUT NOT AT END OF PAGE
+L15, 15 /MUST BE HERE FOR SET
+ TAD PAUSN
+ DCA TTYTLS /SET COUNT FOR OUTER LOOP
+ ISZ LINCNT
+ JMP .-1
+ ISZ TTYTLS
+ JMP .-3
+ TAD LINSYZ
+ DCA LINCNT
+ >
+NOPAUS, JMS TTYTST
+ TAD (203-217 /NO
+ SNA /^O?
+ DCA TCHAR /YES, SET TO NULL SO IT WILL BE IGNORED
+ TAD (217-223 /NO
+ SZA CLA /^S?
+ JMP ECHO /NO, IGNORE CHAR
+TTCTLQ, JMS TTYTST
+ TAD (203-221 /NO, NOTHING ELSE MATTERS UNTIL ^Q
+ SZA CLA /^Q?
+ JMP TTCTLQ /NO, SUSPEND OUTPUTTING
+TTY32, KCC /YES, REMOVE ^Q FROM BUFFER
+/HAD NO ROOM FOR:
+/ TAD LINSYZ
+/ DCA LINCNT
+ECHO, DCA TGCH
+ ISZ TTYPCH
+ IFNZRO ESC <
+ TAD TCHAR
+ TAD (-33
+ SZA CLA
+ JMP .+3
+ TAD L44
+ DCA TCHAR
+L44, 44
+ >
+ TAD TCHAR
+ SNA
+ JMP TTYCTO /IGNORE NULLS
+ IFNZRO RUB&4000 <
+ TAD (-10
+ SNA
+ JMP RUBO
+ TAD (10-16
+ >
+ IFZERO RUB&4000 <
+ TAD (-16
+ >
+TTY100, CLL
+TTY10, TAD K5
+TTY240, SZA /TAB?
+ JMP NOTAB
+ IFNZRO SIMTAB <
+TTYTAB, TAD TTY240
+ JMS TTYTLS
+TTY7, 7 /HERE FOR NO SPECIAL REASON
+ TAD TABCTR
+ AND TTY7
+ SZA CLA
+ JMP TTYTAB
+ JMP TTYCTO
+ >
+ IFNZRO SLOTAB <
+ TAD TCHAR
+ JMS TTYTLS
+ TAD (177
+ JMS TTYTLS
+ TAD (177
+ JMP PRIN+1
+ >
+ IFZERO SIMTAB+SLOTAB <JMP PRIN>
+
+/BUG: IF HARDWARE TABS, DON'T COUNT COLUMNS CORRECTLY
+
+ IFNZRO RUB&4000 <
+RUBO, TAD TTY10 /OUTPUT BACKSPACE-RUBOUT-BACKSPACE
+ JMS TTYTLS
+ TAD TTY240
+ JMS TTYTLS
+ TAD (-4
+ TAD TABCTR
+ JMP PREPRN
+ >
+\fNOTAB, SZL CLA
+ JMP SPCHR /DON'T UPARROW CHARS LF,CR,TAB,VT,FF
+ IFNZRO FLAGLC <
+ TAD TCHAR
+ AND TTY140
+ TAD M140
+ SZA CLA /IS IT LC?
+ JMP NOLC /NO
+TTYQUO, "'
+ TAD TTYQUO /YES
+ JMS TTYTLS /PRINT QUOTE
+ TAD M40
+ JMP PRIN /PRINT UPPER CASE OF CHAR
+ >
+NOLC, TAD TCHAR /NO, GET BACK CHAR
+ AND TTY140 /HIGH ORDER BITS IRRELEVANT
+ IFNZRO CTRL <
+M40, SMA SZA CLA /CAN'T BE NEGATIVE
+ JMP PRIN /NOT A CONTROL CHARACTER
+ TAD TTYUPA /ECHO 201-237 AS ^X (EXCEPT 211-215)
+ JMS TTYTLS
+ TAD TTY100 /ADD X100 TO ^K TO GET K
+ >
+ IFZERO CTRL <
+ SNA CLA /IS CHAR A CONTROL CHAR?
+ JMP TTYCTO /YES, DON'T ECHO CONTROL CHARACTERS EXCEPT FOR 211-215
+ >
+PRIN, TAD TCHAR
+ JMS TTYTLS
+TTYCTO, TAD TABCTR /RETURN TABCNT IN AC
+ JMP I TTYPCH
+
+ IFZERO CTRL <
+M40, -40
+ >
+
+TTY140,
+SPCHR, STA CLL
+ TAD LINSIZ
+PREPRN, DCA TABCTR /THESE CHARS RESET COLUMN COUNTER
+ JMP PRIN
+\fTGCH, 0 /NON-ZERO MEANS TTYGCH WAS CALLED
+ KSF
+ JMP .-1 /WAIT FOR CHAR TO BE TYPED
+ JMS TTYTST
+/WILD: (DON'T PUT IN) SZA CLA /FALL THRU AND RETURN R.O.
+/ ISZ TTYGCH
+ TAD (203-377
+ SNA CLA /TAKE RETURN 1 ON RUB OUT
+ JMP I TTYGCH /"CLUMSY" - R.L. (9/18/73)
+ ISZ TTYGCH
+ KRB /GET CHARACTER
+TTYAND, AND (177 /MUST RETURN CHAR IN 7-BIT
+ IFNZRO CNVLC <
+ DCA TCHAR
+ TAD TCHAR
+ AND TTY140
+ TAD M140
+ SNA CLA /IS IT LC?
+ TAD M40 /YES
+ TAD TCHAR /NO
+ >
+ IFNZRO ALTMOD <
+ TAD (-175 /IS IT 175 OR 176?
+ SMA
+ JMP CONV /YES, CONVERT ALTMODE TO ESCAPE
+ TAD (175 /NO, RESTORE CHAR
+ >
+ JMP I TTYGCH /TAKE RETURN 3
+
+/SHOULDN'T TABCTR BE INITIALIZED TO C(LINSIZ) UPON ENTRY?
+
+TABCTR, -110
+
+TTYTLS, 0
+ TLS
+ IFNZRO DELAY <
+ TAD (-DELAY
+ SZA CLA
+ STA
+ >
+TTYTSF, TSF
+ JMP .-1
+ IFNZRO DELAY <
+ IAC
+ SZA /19.66 MS IS G.T. 1/60 SEC
+ JMP TTYTSF
+ >
+ ISZ TABCTR
+TTYUPA, "^
+TT7600, 7600
+ JMP I TTYTLS
+LINSIZ, -110
+
+ IFNZRO PAUS <
+LINSYZ, -HEIGHT
+LINCNT, -HEIGHT
+PAUSN, -PAUS
+ >
+
+ IFNZRO ALTMOD <
+ IFNZRO KCC-6032 <
+CONV, CLA
+ TAD (33
+ JMP I TTYGCH
+ >
+ IFZERO KCC-6032 <
+CONV, CLA IAC
+ TAD TTY32 /DEVICE DEPENDENT
+ JMP TTYAND
+ >
+ >
+\fTCHAR, 0
+
+/TTYTST: READS KEYBOARD STATICALLY AND RESPONDS TO ^C
+/ OTHERWISE RETURNS CHAR (8-BIT) MINUS 203 IN AC.
+/ IF FLAG IS NOT UP, IT RETURNS A 1.
+
+TTYTST, 0
+ TAD TT7600 /OR CHAR IN
+ KRS
+ TAD (-7603 /-7603=175
+ KSF
+ CLA IAC /STUFF IN BUFFER IS UNRELIABLE IF FLAG ISN'T UP
+ SZA
+ JMP I TTYTST
+ IFNZRO INDVC-3 <KCC>
+ CIF CDF 0 /BRANCH TO OS/8 MONITOR AT 07600
+ JMP I TT7600 /IT WILL PRINT "^C" FOR CHAR IN BUFFER
+ PAGE
+\f/ DYNAMICALLY MODIFYING THE KL8E HANDLER
+
+/ *** I M P O R T A N T ***
+
+/ THIS HANDLER CAN BE DYNAMICALLY CHANGED VIA SET COMMANDS.
+/ CONSEQUENTLY, IT IS EXTREMELY IMPORTANT THAT PEOPLE
+/ WHO MODIFY THIS SOURCE DO NOT AFFECT THE ALGORITHMS
+/ NECESSARY TO PERFORM SUCH MODIFICATIONS.
+
+/ THIS ALGORITHM IS EXPLAINED BELOW.
+
+/ SET TTY WIDTH=N
+
+/ SEARCH LOCATIONS 200-377 FOR A 7600. CALL ITS ADDRESS X.
+/ LET Y BE THE INSTRUCTION AT LOCATION X+1.
+/ FORM THE (RELATIVE) ADDRESS T=Y&177+200-1.
+/ THEN LOCATIONS T AND X+2 CONTAIN MINUS THE TTY WIDTH.
+/ THE WIDTH MUST BE A MULTIPLE OF 10 AND MUST NOT BE 200.
+/ (BECAUSE -200 IS THE MAGIC 7600)
+
+/ SET TTY CODE XX
+
+/ SEARCH ENTIRE HANDLER FOR INSTRUCTIONS OF THE FORM 6XXY
+/ WHERE XX IS NOT 20 OR 21,
+/ AND FURTHERMORE DON'T INCLUDE A 6031 IF 2 LOCATIONS
+/ FOLLOWING IS A 7650
+/ AND DON'T INCLUDE A 6034 IF 4 LOCATIONS FOLLOWING IS A 7650.
+
+
+/ SET TTY [NO] ECHO
+
+/ THE WORD INVOLVED IS AT (RELATIVE) LOCATION 120.
+/ SET TO 7440 TO ECHO.
+/ SET TO 7610 TO SUPPRESS ECHOING.
+
+
+/ SET TTY LC
+
+/ SEARCH LOCATIONS 200-377 FOR A 377. CALL ITS ADDRESS X.
+/ LOOK AT LOCATION X+5.
+/ IF THIS LOCATION IS NOT A 7650, THEN LC TO UC CONVERSION
+/ WAS NOT ENABLED AT ASSEMBLY TIME.
+/ IF THE FEATURE IS ENABLED, CHANGE LOCATION X+5 TO A 7610
+/ TO PREVENT THE CONVERSION. TO ALLOW CONVERSION, SET
+/ LOCATION X+5 BACK TO 7650.
+
+/ SET TTY PAGE
+
+/ SEARCH LOCATIONS 215-300 FOR A 7450. CALL ITS ADDRESS X.
+/ SET X+3 TO 7640 TO ENABLE ^S, ^Q.
+/ SET X+3 TO 7200 TO DISABLE ^S, ^Q.
+\f/ SET TTY TAB
+
+/ SEARCH LOCATIONS 200-300 FOR A 7.
+/ IF NOT FOUND, SIMULATED TABS WAS NOT ENABLED AT ASSEMBLY TIME.
+/ IF FOUND, CALL ITS ADDRESS X.
+/ TO PATCH OUT SIMULATED TABS:
+/ MOVE C(X-12) TO LOCATION X-2
+/ CHANGE LOCATION X+3 TO A 7610
+/ TO RESTORE SIMULATED TABS:
+/ SET LOCATION X-2 TO X-4&77+1200
+/ CHANGE LOCATION X+3 TO A 7640
+
+/ SET TTY FILL
+
+/ THE LITERAL 177 MUST REMAIN AT THE END OF PAGE 2
+/ SEARCH LOCATIONS 200-300 FOR A 1377.
+/ IF NOT FOUND, THEN FILL CHARACTERS WERE NOT ENABLED AT ASSEMBLY
+/ TIME. IF FOUND, CALL ITS ADDRESS X.
+/ TO PATCH OUT FILL CHARACTERS, MOVE C(X+3) TO LOCATION X-1.
+/ TO RESTORE FILL CHARACTERS, MOVE C(X+1) TO LOCATION X-1.
+
+/ SET TTY FLAGLC
+
+/ SEARCH LOCATIONS 200-377 FOR A 247.
+/ IF NOT FOUND, LOWER CASE FLAGGING WAS NOT ENABLED AT ASSEMBLY TIME.
+/ IF FOUND, CALL ITS ADDRESS X.
+/ TO DISABLE FLAGGING, SET LOCATION X-2 TO A 7200.
+/ TO RE-ENABLE FLAGGING, SET LOCATION X-2 TO A 7640.
+
+/ SET TTY PAUSE [N]
+
+/ SEARCH LOCATIONS 200-300 FOR A 15.
+/ IF NOT FOUND, PAUSING WAS NOT ENABLED AT ASSEMBLY TIME.
+/ IF FOUND, CALL ITS ADDRESS X.
+/ TO DISABLE PAUSING AFTER A FULL SCREEN,
+/ SET LOCATION X-3 TO A 7610.
+/ TO RE-ENABLE PAUSING, SET LOCATION X-3 TO A 7650.
+/ TO SET PAUSE DURATION, SEARCH LOCATIONS 300-377 FOR A 7600,
+/ CALLING ITS ADDRESS X. THEN (MINUS THE) PAUSE DURATION IS AT
+/ LOCATION X+5.
+
+/ SET TTY HEIGHT
+
+/ THIS IS ONLY APPLICABLE IF SET TTY PAUSE HAS BEEN ASSEMBLED IN
+/ (A 15 CAN BE FOUND ON SECOND PAGE).
+/ NEGATIVE OF HEIGHT MUST BE SET IN BOTH LOCATIONS X+3 AND X+4
+/ WHERE X IS THE ADDRESS OF A 7600 AS IN ABOVE.
+\f/ SET TTY ESCAPE
+
+/ SEARCH LOCATIONS 200-377 FOR A 44.
+/ IF NOT FOUND, THEN $ WAS NOT ASSEMBLED INTO TTY HANDLER.
+/ IF FOUND, CALL ITS ADDRESS X.
+/ TO DISABLE PRINTING ESCAPE AS $, SET LOCATION X-4 TO A 'CLA'.
+/ TO CAUSE ESCAPE TO PRINT AS AN ESCAPE, SET LOCATION X-4 TO SZA CLA.
+
+/ SET TTY ARROW
+
+/ SEARCH LOCATIONS 200-377 FOR 7740.
+
+/ IF NOT FOUND, USING OLD HANDLER.
+/ CALL ITS ADDRESS X.
+/ IF LOCATION X+1 IS MORE THAN 7000,
+/ THEN UPARROW MODE WAS NOT ASSEMBLED INTO KL8E.
+/ OTHERWISE, TO ALLOW ARROWS, SET LOCATION X+3 TO THE
+/ CONTENTS OF LOCATION X+6.
+/ TO CAUSE CONTROL CHARACTERS TO ECHO AS IS, SET
+/ LOCATION X+3 TO 'SKP CLA'.
+/ NOTE THAT THIS IS A DIFFERENT OPTION THAN ASSEMBLING CTRL=0.
+\f IFDEF TEST <
+ *600
+
+/TEST ROUTINE FOR KL8E HANDLER
+
+GO, JMS I (TTY /CALL HANDLER
+ 0600 /READ SIX PAGES
+ 1000 /BUFFER AT 01000
+ 0001 /BLOCK 1
+ HLT /ERROR RETURN
+ JMS I (TTY /CALL HANDLER AGAIN
+ 4600 /OUTPUT SIX PAGES
+ 1000
+ 0001
+ HLT
+ CLA
+ JMP GO
+ >
+ $
+\f
--- /dev/null
+/ LQP HANDLER FOR OS/8
+/
+/
+/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/ AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/ CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/ FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/ THE SOFTWARE DESCRIBED HEREIN IS FURNISHED TO THE PURCHASER
+/ UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/ (WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/ SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/ DIGITAL EQUIPMENT ASSUMES NO RESPONSIBILITY FOR THE USE
+/ OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED
+/ BY DIGITAL.
+/
+/ COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+
+PDMP=6502
+PDMC=6503
+PDPC=6504
+PDRS=6505
+PDWS=6506
+PDRE=6507
+
+LPVERSION="A&77 /VERSION A (MH)
+
+*0 /ORIGIN FOR BUILD INFO
+
+-1 /ONE ENTRY POINT
+DEVICE LQP /GROUP NAME
+DEVICE LPT /DEVICE NAME
+1040 /DEVICE TYPE
+LQP&177+4000 /ENTRY POINT + TWO-PAGE FLAG
+0 /REQUIRED ZEROES
+0
+
+PAGE
+
+LQPORG=.
+LQPCSV, 0
+LQPBUF, 0
+LQPDWC, 0
+LQPDCY, 0
+
+LQP, LPVERSION /ENTRY POINT (MH)
+ CLA STL RTL /RAISE RIBBON
+ PDWS
+
+ PDRE /INIT PRINTER
+ DCA .-1 /---FIRST TIME ONLY---
+
+ JMS LQPDCZ /INIT SECOND PAGE LINK
+
+ RDF /GET RETURN CIF
+ TAD (CIF CDF)
+ DCA LQPRDF
+
+ TAD I LQP /GET FUNCTION WORD
+ AND (70)
+ TAD (CDF)
+ DCA LQPBDF /SET BUFFER CDF
+
+ TAD I LQP
+ AND (3700)
+ CMA
+ DCA LQPDWC /SET DOUBLE-WORD COUNT +1
+
+ ISZ LQP
+ TAD I LQP
+ DCA LQPBUF /SET BUFFER PTR
+
+ ISZ LQP
+ TAD I LQP
+LQPBDF, 0 /CDF TO BUFFER
+ SZA CLA
+ JMP LQPGO
+ TAD (15);JMS LQPDOC /NEW PAGE ON BLOCK 0
+ TAD (14);JMS LQPDOC
+LQPGO, ISZ LQPDWC
+ JMP LQPGO1 /LOOP IF MORE TO DO
+LQPCZ,
+ TAD (13);JMS LQPDOC /CLEAR SPACE ACCUMULATORS
+LQPRDF, 0 /THEN RETURN TO CALLER
+ ISZ LQP
+ ISZ LQP
+ JMP I LQP
+
+LQPGO1,
+ TAD I LQPBUF /GET NEXT WORD
+ AND (7400)
+ CLL RTR
+ DCA LQPCSV /SAVE PART OF THIRD CHAR
+
+ TAD I LQPBUF
+ JMS LQPDOC /OUTPUT FIRST CHAR
+
+ ISZ LQPBUF
+ TAD I LQPBUF
+ JMS LQPDOC /OUTPUT SECOND CHAR
+
+ TAD I LQPBUF
+ AND (7400) /PUT THIRD CHAR TOGETHER
+ BSW
+ TAD LQPCSV
+ CLL RTR
+ JMS LQPDOC /OUTPUT THIRD CHAR
+
+ ISZ LQPBUF
+ JMP LQPGO /LOOP FOR DONE TEST
+
+LQPDCZ, 0
+ TAD LQPDCZ
+ AND (7600)
+ TAD (LQPDCX-LQPORG)
+ DCA LQPDCY
+ JMP I LQPDCZ
+
+LQPDOC, 0
+ JMS I LQPDCY
+ JMP LQPCZ
+
+ KRS /CHECK FOR CONTROL C AT CONSOLE
+ AND (177)
+ TAD (-3)
+ SZA CLA /SKIP IF SO
+ JMP I LQPDOC
+
+ CIF CDF 0 /RETURN TO OS8
+ JMP I (7600)
+
+PAGE
+\fLQPTCH, 24 /2*NUMBER OF INCRS PER CHAR
+LQLINE, 20 /2*NUMBER OF INCRS PER LINE
+LQPAGE, -102 /-NUMBER OF LINES PER PAGE
+
+LQPDCX, 0 /OUTPUT ONE CHAR
+ AND (177)
+ TAD (-40) /TEST FOR SPECIAL OR BLANK
+ SPA
+ JMP LQPSPC /JUMP IF SPECIAL
+ SNA
+ JMP LQPIDX /JUMP IF BLANK
+
+ TAD (40)
+LQPDC1, DCA LQPCTM /SAVE CHAR CODE
+
+LQPWLP, PDRS /LOOP TIL DEVICE READY
+ BSW
+ SMA CLA
+ JMP .+5 /JUMP IF NO CHECK FLAG
+ PDRE /ELSE RESET DEVICE
+ DCA LQPX /AND HORIZONTAL POSITIONS
+ DCA LQPDX
+ ISZ LQPDY /ADVANCE A LINE, FOR CLARITY
+
+ PDRS
+ STL
+ TAD (400)
+ SZL CLA
+ JMP LQPWLP /LOOP IF NOT READY
+
+ TAD LQPDY /DO Y MOTION, IF NEEDED
+ SNA
+ JMP LQPNDY /JUMP IF NONE
+ CIA
+ DCA LQPMTM /SAVE -NUMBER LINES TO DO
+
+ TAD LQLINE /SUM TOTAL INCRS TO DO
+ ISZ LQPMTM
+ JMP .-2
+
+ PDMP /MOVE PAPER
+
+ TAD LQPY /COMPUTE NEW POSITION
+ TAD LQPDY
+ TAD LQPAGE /ON PAGE, PLEASE!!
+ SMA
+ JMP .-2
+ CIA
+ TAD LQPAGE
+ CIA
+ DCA LQPY
+ DCA LQPDY
+
+LQPNDY, TAD LQPDX /DO X MOTION, IF NEEDED
+ SNA
+ JMP LQPNDX /JUMP IF NONE
+
+ STL
+ SMA
+ CLL CIA /ADJUST FOR -X MOTION
+ DCA LQPMTM
+
+ TAD LQPTCH /SUM TOTAL INCRS TO DO
+ ISZ LQPMTM
+ JMP .-2
+
+ RAR /GET DIRECTION INDICATOR BACK
+ PDMC /MOVE CARRIAGE
+
+ TAD LQPX /COMPUTE NEW POSITION
+ TAD LQPDX
+ DCA LQPX
+ DCA LQPDX
+
+LQPNDX, TAD LQPCTM /RETRIEVE SAVED CHAR
+ SNA
+ JMP LQPDCR /JUMP IF NONE
+ CLL RAL /ADJUST FOR OFFSET
+ PDPC /PRINT CHAR
+
+LQPIDX, ISZ LQPDX /BUMP SPACE COUNTER
+ JMP LQPDCR /RETURN TO CALLER
+ JMP LQPDCR /...IN CASE ISZ SKIPPED...
+
+LQPSPC, /SPECIAL CHARACTER CHECKING
+ TAD (40-32) /CONTROL Z?
+ SNA
+ JMP I LQPDCX /TAKE EOF RETURN IF SO
+
+ TAD (32-15) /CARRIAGE RETURN?
+ SNA
+ JMP LQPCR /JUMP IF SO
+
+ IAC /FORM FEED?
+ SNA
+ JMP LQPFF /JUMP IF SO
+
+ IAC /VERTICAL TAB?
+ SNA
+ JMP LQPDC1 /CLEAR ACCUMULATORS, IF SO
+
+ IAC /LINE FEED?
+ SNA
+ JMP LQPLF /BUMP LINE COUNTER IF SO
+
+ IAC /TAB?
+ SNA CLA
+ JMP LQPDCR /RETURN IF NOT RECOGNIZED
+
+LQPTB, TAD LQPX /DO TAB
+ TAD LQPDX
+ TAD (10)
+ AND (7770)
+ CIA
+
+LQPCR, TAD LQPX
+ CIA
+ DCA LQPDX /SAVE CR OR TAB MOTION
+
+LQPDCR, ISZ LQPDCX /BUMP TO OK RETURN
+ JMP I LQPDCX /AND TAKE IT
+
+LQPLF, ISZ LQPDY /BUMP LINE COUNTER
+ TAD LQPY /CHECK FOR NEXT PAGE
+ TAD LQPDY
+ TAD LQPAGE
+ SMA CLA
+ JMP LQPDC1 /JUMP IF SO
+
+ JMP LQPDCR /ELSE, JUST RETURN
+
+LQPFF, TAD LQPY /DO FORM FEED
+ TAD LQPAGE
+ CIA
+ DCA LQPDY
+ JMP LQPDC1 /DO PAGE EJECT NOW
+
+LQPX, 0
+LQPDX, 0
+LQPY, 0
+LQPDY, 0
+LQPMTM, 0
+LQPCTM, 0
+
+PAGE
--- /dev/null
+/3 PIP FOR OS/8 MONITOR
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977
+/BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ 4-MAY-1977 FILE: PIP.PA OS/8 VERSION 12A
+/RL/EF/ET.AL./S.R./E.S.
+
+
+
+/ABSTRACT----
+/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
+/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
+/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
+/CONFIGURATION.
+
+
+/VERSION 3 MODS:
+
+/FIXED PROBLEM WITH ONE-PAGE WRITE
+/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
+/ WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
+/DATES STILL DON'T LINE UP
+/'0 FREE BLOCKS'
+/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
+/ALLOW 7-BIT ^C
+/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
+/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
+/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
+/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
+/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE
+
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. FIXED LENGTH OF ALL VARIETIES OF RF08
+/2. ADDED RX01 TO INTERNAL LENGTH TABLES
+/3. CHANGED VERSION NUMBER TO V10
+/4. ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER
+
+/E.S. DISABLED /E,/F,/L
+/E.S. FIXED /Y OPTION PER SPR
+
+\f/DETAILS OF PIP:
+
+/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
+/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
+/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
+/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.
+
+/CORE USED:
+/FIELD 0
+
+/00000-02777- OUTPUT BUFFER
+/03000-06377- INPUT BUFFER
+/06400-06577- USED FOR /Y COMMAND ONLY
+/06600-07177- INPUT HANDLER
+/07200-07577- OUTPUT HANDLER
+
+/FIELD 1
+
+/10000-11777- OS/8 I/O MONITOR
+/12000-16577- EXECUTABLE CODE
+/16600-17177- HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
+/17200-17577- HOLDS OLD DIRECTORY SEGMENT IN /S OPTION
+
+
+/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
+/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
+/NOT AS THEY ARE LOGICALLY CONNECTED.
+
+/ICHAR- GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
+/ DEVICE HANDLERS AS NEEDED.
+
+/OOPEN- ENTERS A FILE ON A SPECIFIED DEVICE.
+
+/OUTDMP- WRITES OUTPUT BUFFER TO OUTPUT DEVICE.
+
+/OCLOSE- CLOSES FILE CREATED BY OOPEN
+
+/OCHAR- CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
+/ TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.
+
+/OTYPE- USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
+/ INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
+/ GIVES A CODE FOR THE TYPE OF DEVICE.
+
+/SLASHG- HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
+/ ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
+/ SPECIAL RETURN IS TAKEN.
+
+/IMAGE- IMAGE MODE PROCESSOR FOR PIP.
+
+/SQTRA- MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.
+
+/PIP, PIP+1- MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
+/ INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
+/ ROUTINES.
+
+/ASCII- THE DEFAULT TRANSFER MODE IN PIP IS ASCII.
+
+/DELETE- DELETES FILES ON OUTPUT SIDE OF CD LIST.
+
+/DZERO- ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.
+
+/PIPERR- ERROR ROUTINR FOR PIP.
+
+/DIRPRE- DIRECTORY PRINTING ROUTINE.
+
+/BINARY- BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
+/ RELOCATABLE BINARY FILES.
+
+/ERPRNT- ERROR PRINTOUT.
+
+/SQUISH- FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
+/ IN DIRECTORY OF INPUT DEVICE.
+
+/SYSCOP- SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
+/ OS/8 SYSTEM AREA.
+\f/OPTIONS AVAILABLE IN PIP:
+
+/A- ASCII TRANSFER; DEFAULT MODE
+/B- BINARY MODE TANSFER
+/C- DELETE TRAILING BLANKS. (ASCII MODE)
+/D- DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
+/E- LIST INPUT DIRECTORY INCLUDING EMPTY FILES
+/F- LIST INPUT DIRECTORY; ONLY FILE NAMES
+/G- IGNORE ERRORS WHILE TRANSFERING
+/I- IMAGE MODE TRANSFER
+/L- LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
+/O- OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
+/S- COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
+/ 'HOLES' ON INPUT DEVICE.
+/T- PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
+/Y- COPY OS/8 SYSTEM AREA
+/Z- ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
+/=N- LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
+/ ONLY WITH /S OR /Z.
+/=N- WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
+/V PRINTS VERSION # (FIRST TIME ONLY)
+
+/COMMENTS ON THE PROGRAM:
+
+ /SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
+ /CAN BE USED. THE LOCATIONS CURRENTLY USED IN
+ /FIELD 1 ON PAGE ZERO ARE:
+
+ OUTXR=10
+ INXR=11
+ TEMP1=12
+ IHNDLR=24 /HOLDS INPUT HANDLER ADDRESS
+ OHNDLR=25 /OUTPUT HANDLER ADDRESS
+ SQFLAG=26 /'SQUISH INDICATOR
+ OUWAST=27 /# WASTE WORDS ON OUTPUT
+ OUTBLK=30
+ OUDLEN=31
+ SAME=32
+ INBLK=33
+ RECCNT=34
+
+/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:
+
+ FLENGT=24
+ BLOKNO=25
+ DTYPE=27
+ DCOUNT=30
+ DLINK=31
+ WASTE=32
+ DDATE=33
+ ECOUNT=35
+\f /PIP FOR OS/8 MONITOR
+ /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES
+
+ OUBUF=0 /MUST BE LOWER THAN INBUF
+ OUCTL=5400 /OUTPUT BUFFER OF 3000 WORDS
+ OUDEVH=7200 /PROVIDE ROOM FOR TWO-PAGE HANDLERS
+ INBUF=3000
+ INCTL=1600 /INPUT BUFFER OF 3400 WORDS
+ INRECS=7
+ INDEVH=6600
+
+ /PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND
+
+ /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
+ DCB=7760
+ MPARAM=7643 /CD PARAMETER AREA
+ OLDDIR=7 /POINTER TO MONITOR VARIABLE "OLDT9"
+ MTEMP=27 /MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
+ PTP=20 /INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
+ XR=10
+ TEMP=20
+ CHAR=21
+ INFPTR=22
+ INEOF=23
+
+ ABUF=6601 /LINE BUFFER - 150 CHARACTERS LONG
+ SQBUF1=6600 /DIRECTORY BUFFER FOR "SQUISH" OPTION
+ SQBUF2=7200 /""
+
+ FIELD 1
+
+/TO ENABLE /E,/F,/L SET
+/OS78=0
+
+/TO DISABLE /E,/F,/L
+IFNDEF OS78 <OS78=1>
+
+\f /GENERAL CHARACTER I/O ROUTINES FOR BLEEP
+ /CALLED AS FOLLOWS:
+
+ /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE
+
+ /JMS I (ICHAR READS A CHARACTER
+ /ERROR RETURN /AC>0 IF END OF FILE, AC<0 IF READ ERROR
+
+ /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE
+ /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
+
+ /JMS I (OCHAR OUTPUTS A CHARACTER
+ /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT
+
+ /JMS I (OCLOSE CLOSES THE OUTPUT FILE
+ /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
+
+ /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC
+
+
+
+ /PARAMETERS NEEDED:
+
+ /INBUF= ADDRESS OF INPUT BUFFER
+ /INCTL= INPUT BUFFER CONTROL WORD
+ /OUBUF= ADDRESS OF OUTPUT BUFFER
+ /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
+ /INRECS= [INCTL/256]
+ /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER
+ /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER
+
+ /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
+ /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
+\f INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
+
+ *2000
+
+IN7400, 7400
+IOPEN, 0
+ CLA CMA
+ DCA INCHCT /SET INCHCT TO FORCE A READ
+ ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+ TAD (7617
+ DCA INFPTR /RESET FILE POINTER
+ RDF
+ TAD INCDIF
+ DCA .+1
+INPTR, HLT /RESTORE CALLING FIELDS
+ JMP I IOPEN
+
+ICHAR, 0
+IN7600, 7600
+ RDF
+ TAD INCDIF
+ DCA INRTRN /SAVE CALLING FIELDS
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SNA CLA /DID LAST READ YIELD END-OF-FILE?
+ JMP INGBUF /NO - DO ANOTHER
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ JMP EOFERR /NO FILE TO OPEN
+INGBUF, TAD INCTR
+ CLL
+ TAD (INRECS
+ SNL
+ DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ /NOT END-OF-FILE IF INPUT DEVICE
+ /IS NON-FILE STRUCTURED!
+ CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CONTROL WORD
+ TAD (INCTL+1
+ DCA INCTLW
+INCDIF, CDF CIF 0
+ CDF 10
+ JMS I INHNDL /CALL THE DEVICE HANDLER
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMS I (SLASHG /A HANDLER ERROR - SHOULD WE IGNORE?
+ INERRX-. /ADDRESS IF NOT
+INBREC, TAD INREC
+ TAD (INRECS
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
+ SMA CLA /WHICH TYPE WAS IT?
+ JMP INBREC /END OF FILE - RESUME THY PROCESSING
+INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
+EOFERR, JMP INRTRN
+INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+IN200, AND IN7400
+ CLL RTR
+ RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND (377
+ TAD (-232
+INCTZF, SNA /IS THE CHARACTER A ^Z?
+ JMP GETNEW /YES - GET A NEW FILE
+ TAD (232 /RESTORE THE CHARACTER
+ ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
+INRTRN, 0 /RESTORE CALLING FIELDS
+ JMP I ICHAR /AND RETURN
+ /IOPEN IS UNNECESSARY.
+\fINNEWF, -1 /ROUTINE TO OPEN NEW INPUT FILE
+ INCHCT=INNEWF
+ CDF 10
+ TAD (INDEVH+1
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
+ SNA /ANY MORE?
+ JMP I INNEWF /NO - OUT OF INPUT
+ JMS I IN200
+ 1 /ASSIGN, FETCH HANDLER
+INHNDL, 0
+ HLT /HUH?
+ TAD I INFPTR
+ AND (7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH >=256
+ TAD (17 /ADD HIGH-ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR
+ DCA INREC /STORE STARTING RECORD NUMBER OF FILE
+ ISZ INFPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+ ISZ INNEWF
+ JMP I INNEWF
+ INCTR=IOPEN
+ PAGE
+\fOOPEN, 0 /OPEN OUTPUT FILE
+OU7600, 7600
+/ RDF
+/ TAD OUCDIF
+/ DCA OORETN
+ TAD OU7601
+ DCA OUBLK
+ TAD (OUDEVH+1
+ DCA OUHNDL
+ CDF 10
+ TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+ AND (17 /STRIP OFF ANY LENGTH INFO
+ SNA /IS THERE AN OUTPUT DEVICE?
+ JMP ONOFIL /NO - INHIBIT OUTPUT
+ JMS I (200
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ HLT /HUH?
+OUENTR, TAD I OU7600
+ JMS I (200
+ 3 /ENTER OUTPUT FILE
+OUBLK, 7601 /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
+ DCA OUCCNT
+ DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
+ JMS I (OUSETP
+ ISZ OOPEN
+OORETN, CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OOPEN
+OEFAIL, TAD I OU7600
+ AND (7760 /GET REQUESTED LENGTH
+ SNA CLA /WAS IT AN INDEFINITE REQUEST
+ JMP ONTERR /YES - CANNOT ENTER THE FILE
+ TAD I OU7600
+ AND (17 /MAKE THE REQUESTED LENGTH ZERO
+ DCA I OU7600
+ JMP OUENTR /TRY, TRY AGAIN
+ONTERR, CLA CLL CML RAR
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
+ONOFIL, ISZ I (OUTINH
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ CDF 10
+ TAD I (OUTINH
+ SZA CLA
+ JMP OUNOWR
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
+ JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR
+OUCDIF, CDF CIF 0
+ CDF 10
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMS I (SLASHG
+ .+2-.
+OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
+ JMP I OUTDMP
+\fOCLOSE, 0
+ CDF 10
+ TAD I (OUTINH
+ SZA CLA /IS OUTPUT INHIBITED?
+ JMP OCISZ /YES - CLOSE IS A NOP
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
+ SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
+ TAD (232 /OUTPUT A ^Z
+ JMS I (OCHAR
+ JMP OCRET
+ JMS I (OCHAR
+ JMP OCRET
+FILLLP, JMS I (OCHAR
+ JMP OCRET
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+ TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
+ TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
+ JMS OUTDMP
+ JMP OCRET /AN ERROR OCCURRED WHILE DUMPING THE BUFFER
+NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER
+ JMS I (200
+ 4 /CLOSE THE OUTPUT FILE
+OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
+OUCCNT, 0
+ SKP /ERROR WHILE CLOSING THE FILE - BAD!
+OCISZ, ISZ OCLOSE
+OCRET, CDF CIF 10 /RESTORE CALLING FIELDS
+ JMP I OCLOSE
+ PAGE
+\fOUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
+ TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
+ CIA /PAL10 IS DEFINITELY NOT NICE
+ DCA OUDWCT
+/ TAD (OUBUF
+ IFNZRO OUBUF <ERROR!> /V3
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
+ JMP I OUSETP
+
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ RDF
+ TAD (CDF CIF 0
+ DCA OUCRET
+ TAD OUTINH
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP OUCOMN /NO - EXIT
+OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, ISZ OCHAR
+OUCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+\fOTYPE, 0
+ RDF
+ TAD (CDF CIF 0
+ DCA OTRTN
+ CDF 10
+ TAD I (7600
+ AND (17
+ TAD (DCB-1
+ DCA OUTEMP
+ TAD I OUTEMP
+OTRTN, HLT
+ JMP I OTYPE
+CTCTST, 0
+ TAD (200 /V3
+ KRS
+ TAD (-203
+ SNA CLA /IS THE TELETYPE BUFFER A ^C
+ KSF /WITH THE TELETYPE FLAG ON?
+ JMP I CTCTST /NO
+LEAVE, CDF CIF 0 /YES - GO TO MONITOR
+ JMP I (7600 /THROUGH THE "SAVE CORE" RETURN
+
+SLASHG, 0
+ DCA CTCTST
+ TAD SQFLAG
+ SZA CLA /ARE WE SQUISHING?
+ JMP I (SQIOER /YES
+ TAD CTCTST
+ SPA CLA /ONLY IGNORE HARD ERRORS
+ TAD I (MPARAM
+ AND (40
+ SZA CLA / "G" SWITCH
+SLGRET, JMP I SLASHG /IGNORED!
+ TAD I SLASHG
+ TAD SLASHG
+ DCA SLASHG /SET UP NON-IGNORE ADDRESS
+ TAD CTCTST
+ JMP I SLASHG /RETURN WITH AC RESTORED
+
+\f
+ IFZERO OS78 <
+DIR, DCA DTYPE /SAVE TYPE OF REQUEST
+ TAD I (7600
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I (DIRPRE /YES
+ DCA TTYDEV+1
+ JMS I (200
+ 12 /ASSIGN WITHOUT FETCH
+TTYDEV, 5524 /COMPRESSED CODE FOR "TTY"
+ 0
+ 0
+ JMP I (PIP /V3 WHAT - NO TELETYPE!
+ TAD TTYDEV+1
+ DCA I (7600
+ JMP I (DIRPRE
+ >
+
+ IFNZRO OS78 <
+DIR, JMS I (PIPERR /TYPE OUT MESSAGE
+ 14
+DIRMSG, TEXT "USE DIRECT"
+ >
+
+ PAGE
+\f /PIP PROPER BEGINS HERE
+ /**********************
+
+ /IMAGE MODE PROCESSOR FOR PIP
+
+IMAGE, JMS I (FIXLEN
+ JMS I (OUTOPN
+ JMS IMTRA
+IMCLOS, TAD I (OUTINH
+ SZA CLA /WAS THERE AN OUTPUT FILE?
+ JMP I (PIPCLR /NO - DON'T CLOSE IT
+ JMS I (OUK /GET THE LENGTH OF THE OUTPUT FILE
+ DCA IMCCNT
+ TAD I IM7600
+ JMS I (200
+ 4 /CLOSE
+ 7601 /FILE NAME
+IMCCNT, 0
+ JMP I (AOUERR
+ JMP I (PIPCLR
+
+ENDFUJ, 0 /PART OF DIRECTORY PRINTING ROUTINE
+ JMS I (PRNUM
+ TAD (-6
+ JMS I (PRWD /PRINT SIX WORDS
+ 0006 / F
+ 2205 /RE
+ 0500 /E
+ 0214 /BL
+ 1703 /OC
+ 1323 /KS
+ JMS I (PCRLF
+ JMS I (PCRLF /LEAVE A SPACE BETWEEN DIRECTORIES
+ ISZ INEOF /SIMULATE "END OF FILE" FOR INPUT ROUTINE
+ CLA CMA
+ DCA I (INCHCT /AS WELL AS "END OF BUFFER"
+ JMP I ENDFUJ
+\fIMHNDL, /V3
+SQTRA, 0
+ TAD SQTRA
+ DCA IMTRA /FAKE A CALL TO "IMTRA"
+ TAD RECCNT /SETTING UP THE ARGS TO DO THE SQUISHING FOR US
+ DCA I (INCTR
+ TAD IHNDLR
+ DCA IMHNDL
+ TAD INBLK
+ DCA IMREC
+ TAD OUTBLK
+ DCA I (OUCCNT
+ DCA INEOF
+ JMP IMRCLP
+
+IMTRA, 0
+ JMS I (IOPEN /INITIALIZE INPUT ROUTINE
+AGAIN, TAD INEOF /IOPEN ALWAYS SETS INEOF
+ SNA CLA /KEEP READING?
+ JMP IMRCLP /YES
+ /NO, OPEN NEXT FILE
+IMFILP, JMS I (INNEWF /SET UP PARAMS FOR NEXT FILE
+ JMP I IMTRA /NO NEXT FILE
+ TAD I (INHNDL
+ DCA IMHNDL /GET DEVICE HANDLER ENTRY
+ TAD I (INREC
+ DCA IMREC /AND STARTING BLOCK NUMBER
+IMRCLP, TAD I (INCTR
+ CLL
+ TAD (15
+ SNL /IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
+ DCA I (INCTR
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR
+ RTR
+ RTR
+ TAD (3201 /FORM A FULL OR PARTIAL READ CONTROL WORD
+ DCA IMCTLW
+ JMS I (CTCTST /CHECK FOR ^C
+ CIF 0
+ JMS I IMHNDL
+IMCTLW, 0
+ OUBUF
+IMREC, 0
+ JMS I (SLASHG
+ IMERRX-.
+ TAD IMREC
+ TAD (15
+ DCA IMREC /UPDATE BLOCK NUMBER
+ CLA CLL CML RAR
+ TAD IMCTLW
+IMOUT, JMS I (OUTDMP /WRITE OUT WHAT WE JUST READ IN
+ JMP I (AOUERR /WRITE ERROR - BAD!
+ JMP AGAIN /V3
+\fIMERRX, ISZ INEOF /SIGNAL EOF OR WORSE
+ SPA CLA /WHICH ONE IS IT?
+ JMP IM7600
+ TAD (6377 /MARCH DOWN THROUGH CORE
+IMEFLP, DCA CHAR /LOOKING FOR THE FIRST NON-ZERO WORD
+ CDF 0
+ TAD I CHAR
+ SZA CLA
+ JMP IMNZRO
+ CLA CMA CLL
+ TAD CHAR
+ SZL /IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
+ JMP IMEFLP
+IM7600, 7600
+ JMS I (PIPERR /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
+ 4 /A ^Z AT LEAST)
+IMNZRO, CDF 10
+ TAD CHAR
+ CLL CML RAR
+ AND IM7600
+ TAD (200 /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
+ JMP IMOUT /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
+ PAGE
+\f/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **
+
+PIPSA, JMP PIPCD /NORMAL ENTRY/RE-ENTRY - CALL CD
+ JMP NOPCD /ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
+ /PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE
+
+LFEED, TAD CHAR
+ DCA I XR /PUT THE LINE FEED IN THE LINE BUFFER
+EOL, DCA I XR /MARK THE END OF USEFUL INFO
+ JMS I (CTCTST
+ TAD (ABUF-1
+ DCA XR /RESET BUFFER POINTER
+EOLLP, TAD I XR /GET A CHARACTER FROM THE LINE BUFFER
+PIPSNA, SNA /ZERO MEANS NO MORE CHARS
+ JMP EOFTST
+ JMS I (OCHAR /OUTPUT THE CHARACTER
+ JMP I (AOUERR
+ JMP EOLLP
+EOFTST, TAD AEOFFG
+ SNA CLA /END OF INPUT ENCOUNTERED?
+ JMP I (ASCIGO /NO - GET NEXT LINE
+ACLOSE, JMS I (OCLOSE /YES - CLOSE THE OUTPUT FILE
+ JMP I (AOUERR /ERROR ON CLOSE
+PIP, TAD I (MPARAM-1 /V3
+ SMA CLA /ALTMODE TERMINATE LAST COMMAND STRING?
+ JMP PIPCD /NO
+ CDF CIF 0 /YES
+ JMP I (7605 /EXIT TO OS/8 WITHOUT SAVING CORE
+PIPCD, JMS I (200 /OF COURSE THE MONITOR IS IN CORE!
+ 5 /COMMAND DECODE
+ 0 /NO ASSUMED EXTENSIONS ON INPUT
+L20, /V3
+NOPCD, JMS I (ONCE /REPLACED BY '20' BY ONCE-ONLY CODE
+ JMS I (SRSTOR /CLEAR /S OR /Y;READ MONITOR
+ DCA SQFLAG /CLEAR /S INDICATOR
+ TAD PIPSNA
+ DCA I (INCTZF /RESET INPUT SWITCH TO DETECT "^Z"'S
+ TAD I (MPARAM+1
+ AND (40 /"S" SWITCH
+ SZA CLA
+ JMP I (SQUISH /IT WAS ON - COMPRESS THE INDICATED DEVICES
+ TAD I (MPARAM+2
+ RTL
+ SZL CLA /"Z" SWITCH IN THE LINK
+ JMS I (DZERO /ZERO DIRECTORY BEFORE PROCEEDING
+ TAD I (MPARAM
+ AND (400 /"D" SWITCH
+ SZA CLA
+ JMS I (DELETE /DELETE OUTPUT FILE
+ TAD I (MPARAM+2 /IS /Y ON?
+ SPA CLA
+ JMP I (SYSCOP /YEP..TRANSFER SYSTEM HEAD
+ TAD I (MPARAM
+ AND (301 /"E","F" AND "L" SWITCHES
+ SZA /ANY ONE OF THEM ON?
+ JMP I (DIR /YES - LIST A DIRECTORY
+ TAD I (MPARAM
+ RTL
+ AND (40 /"I" SWITCH ROTATED TWO LEFT
+ SZA CLA
+ JMP I (IMAGE /IMAGE MODE TRANSFER
+ TAD I (7617 /MUST PRESERVE THE LINK
+ SNA CLA /V3 IMAGE MODE ALLOWS NO INPUT FILE
+ JMP PIP /TERMINATE HERE IF NO INPUT SIDE
+ SZL CLA /"B" SWITCH IN LINK
+ JMP I (BINARY /BINARY MODE TRANSFER
+
+ /DEFAULT MODE OF TRANSFER IS ASCII
+
+ASCII, TAD I (MPARAM+1
+ AND L20
+ DCA COPTSW
+ TAD COPTSW
+ JMS I (ASCI2 /TEST FOR OUTPUT DEVICE
+ JMS I (OUTOPN
+ JMS I (IOPEN /OPEN THE INPUT FILES
+ DCA AEOFFG /ZERO THE END-OF-FILE FLAG
+ JMS I (LEADER
+ JMP I (ASCIGO
+
+ /ENTRY ON END OF INPUT
+ASCEOF, SPA CLA /WAS IT END OF INPUT OR AN INPUT ERROR?
+PER4, JMS I (PIPERR
+ 4
+ ISZ AEOFFG /SET END-OF-INPUT FLAG
+ JMP EOL /PROCESS LAST LINE (IF ANY)
+AEOFFG, 0
+\f /SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
+RUBOUT, 0 /UNLESS OUTPUT IS TO A DIRECTORY DEVICE
+ DCA TEMP /STORE COUNT
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ JMP I RUBOUT /DIRECTORY DEVICE - DON'T BOTHER
+RBTLP, TAD CHAR
+ TAD (-214
+ SNA CLA /IS THE FORM CONTROL CHAR A FORM-FEED?
+ IAC /YES - OUTPUT BLANK TAPE INSTEAD
+ TAD (377
+ DCA I XR /PUT IN BUFFER
+ ISZ TEMP
+ JMP RBTLP /LOOP FOR THE REQUISITE COUNT
+ JMP I RUBOUT
+COPTSW, 0
+
+DEND, SPA CLA
+ JMP PER4
+ JMP ACLOSE
+ PAGE
+\f *3200
+ /ASCII PROCESSOR CONTINUED
+
+ASCIGO, TAD (ABUF-2
+ DCA XR
+ DCA I XR /PROTECT AGAINST NULL LINE WITH "T" OPTION
+ DCA COLCT /ZERO COLUMN COUNTER FOR TAB CONVERSION
+ACHLP, JMS I (ICHAR /GET A CHARACTER
+ JMP I (ASCEOF /END OF INPUT OR WORSE
+ AND (177 /MASK OUT PARITY BIT
+ SZA /IGNORE BLANK TAPE AND LEADER/TRAILER
+ TAD (-177
+ SNA
+ JMP ACHLP /DITTO RUBOUTS
+ TAD (177-32 /V3C
+ SNA
+ JMP I (ASCPTCH /7-BIT ^Z CHECK
+ TAD (232 /FORCE COLUMN 8 ON
+ DCA CHAR
+ TAD CHAR
+ TAD (-216
+ CLL
+ TAD ASCI5
+ SNL /IS THE CHARACTER A FORM CONTROL CHARACTER?
+ JMP CINSRT /NO
+ TAD ASCJMP /YES - GO TO APPROPRIATE ROUTINE
+ DCA .+1
+ HLT
+ASCJMP, JMP I .+1
+ TAB
+ LFEED
+ VTAB
+ FFEED
+ CARRET
+CINSRT, 7600 /GRP 2 CLA
+ TAD CHAR
+ADCAXR, DCA I XR /STORE THE CHARACTER IN THE LINE BUFFER
+ ISZ COLCT /ALWAYS BUMP THE COLUMN POINTER
+TESTXR, TAD XR
+ TAD (-ABUF-226
+ SPA CLA /HAS THE BUFFER OVERFLOWED?
+ JMP ACHLP /NO - GET NEXT CHARACTER
+ JMS I (PIPERR
+ 1
+\fTAB, TAD I (COPTSW
+ SNA CLA /DO WE WANT TO CONVERT?
+ JMP TABRBT /NO
+TABLP, TAD (240
+ DCA I XR /OUTPUT A SPACE
+ ISZ COLCT
+ TAD COLCT
+ AND (7
+ SZA CLA /IS THE COLUMN COUNTER A MULTIPLE OF 8?
+ JMP TABLP /NOT YET
+ JMP TESTXR /YES - CHECK BUFFER OVERFLOW
+TABRBT, TAD CHAR
+ DCA I XR
+ CLA CMA
+ JMS I (RUBOUT /TWO RUBOUTS FOLLOW A TAB
+ JMP TESTXR /CHECK FOR BUFFER OVERFLOW
+VTAB, TAD I (COPTSW
+ SZA CLA /SHOULD WE CONVERT?
+ JMP VTLF /YES
+ TAD CHAR
+ DCA I XR
+ TAD (-4
+ JMS I (RUBOUT /FOUR RUBOUTS AFTER A VERTICAL TAB
+ JMP I (EOL
+FFLF, TAD (-4 /NINE LINE FEED SIMULATE A FORM FEED
+VTLF, TAD (-5 /FIVE LINE FEEDS SIMULATE A VERTICAL TAB
+ DCA TEMP
+ TAD (212
+ DCA I XR
+ ISZ TEMP
+ JMP .-3
+ JMP I (EOL /FORM FEED AND VERTICAL TAB ARE LINE ENDERS
+\fFFEED, TAD I (COPTSW
+ SZA CLA /SHOULD WE CONVERT?
+ JMP FFLF /YES
+ TAD CHAR
+ DCA I XR
+ TAD (-11 /NINE RUBOUTS AFTER A FORM FEED
+ JMS I (RUBOUT
+ JMP I (EOL
+CARRET, TAD I (MPARAM
+ RTL
+ SMA CLA /"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
+ JMP NOTOPT /IT WASN'T ON
+TOPT, TAD XR
+ DCA TEMP
+ TAD I TEMP
+ TAD (-240
+ SZA CLA /WAS THE LAST CHAR ON THE LINE A SPACE?
+ JMP NOTOPT /NO
+ CLA CMA
+ TAD XR /YES - BACK UP THE LINE POINTER
+ DCA XR
+ JMP TOPT
+NOTOPT, TAD CHAR
+ DCA I XR /STORE THE CARRIAGE RETURN IN THE BUFFER
+ JMP TESTXR /CARRIAGE RETURN IS NOT A LINE TERMINATOR
+COLCT, 0
+
+OUTOPN, 0
+ JMS I (OOPEN
+ SMA CLA
+ JMP I OUTOPN
+ JMS I (PIPERR
+ASCI5, 5
+ PAGE
+\f /SUBROUTINES CALLED BY THE REST OF PIP
+
+K770, 770 /** DON'T MOVE THIS CONSTANT
+DELETE, 0
+ TAD P7600
+ DCA DPFILE
+ CLA CLL CMA RTL
+ DCA CHAR /MAXIMUM OF THREE OUTPUT FILES
+DELOOP, TAD (7201
+ DCA DLHNDL
+ TAD I DPFILE
+ SNA /DOES THIS FILE EXIST?
+ JMP I DELETE /THAT'S ALL
+ JMS I C200
+ 1 /ASSIGN HANDLER FOR THE DELETION
+DLHNDL, 0
+ HLT
+ TAD I DPFILE /RELOAD DEVICE NUMBER FOR DELETE
+ ISZ DPFILE /BUMP DPFILE TO POINT TO THE FILE NAME
+ JMS I C200 /DEVICE NUMBER IN AC
+DP4, 4 /CLOSE - USED AS DELETE IN THIS CASE
+DPFILE, 0 /POINTER TO FILE NAME
+ 0 /ZERO LENGTH FOR DELETE
+ JMS I (PIPERR /FILE WASN'T THERE TO BE DELETED
+ 3
+ TAD DPFILE
+ TAD DP4
+ DCA DPFILE
+ ISZ CHAR
+ JMP DELOOP /DELETE AS MANY FILES AS HE LISTED(UP TO 3)
+ JMP I DELETE
+\fDZERO, 0 /SUBROUTINE TO ZERO THE DIRECTORY OF THE
+ /FIRST OUTPUT DEVICE
+ JMS I (OTYPE
+ CLL RTL
+ SZL /IS DEVICE READ-ONLY?
+ JMP OZERR /YES - ERROR
+ RTR
+ AND K770 /MASK OUT DEVICE TYPE
+ CLL RTR
+ RAR
+ TAD (DEVLEN /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
+ DCA PIPERR
+ TAD I PIPERR
+ SNA
+ JMP I DZERO /DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
+ DCA PIPERR /STORE LENGTH
+ TAD (OUDEVH+1
+ DCA OZHNDL
+ TAD I P7600
+ JMS I C200
+ 1 /ASSIGN DEVICE, FETCH HANDLER
+OZHNDL, 0
+ HLT
+ TAD I (MPARAM+2 /IF /Y ON, DO SYSTEM ZERO
+ SPA CLA
+ JMP ZRO70
+ TAD OZHNDL /BUT IF NOT, CHECK FOR SYSTEM ZERO
+ TAD (-7607
+ SZA CLA
+ JMP ZRO70+1 /NOT SYSTEM FILES BEGIN AT 7
+ JMS I (CONFRM /ASK IF HE'S SURE
+ SYSZRO /V3
+ZRO70, TAD (61
+ TAD (7
+ DCA I (DFORG
+ DCA I (SQFLAG /AND CLEAR OUT SQUISHES
+ TAD PIPERR
+ TAD I (DFORG
+ DCA I (DLENGT
+ JMS I (GETEQ
+ DCA I (DWASTE /DEFINE # OF WASTE WORDS
+ DCA I (MPARAM+3 /KILL = OPTION FOR FUTURE /I TRANSFERS
+ CIF 0
+ JMS I OZHNDL
+ 5410 /V3 OUTPUT 6 BLOCKS FROM FIELD 1
+ DIRECT
+ 1 /ALL DIRECTORIES ARE IN RECORD 1
+OZERR, JMS I (PIPERR /ERROR WHILE ZEROING DIRECTORY
+ 2
+ DCA OLDDIR /ZERO DIRECTORY POINTER TO FORCE A NEW READ
+ JMP I DZERO
+\fPIPERR, 0
+P7600, 7600 /V3 CLA
+ JMS I (SRSTOR /RESET 07600!
+ CDF 10 /JUST IN CASE
+ TAD I PIPERR /GET ARG
+ TAD (ERRTBL
+ DCA TEMP
+ TAD I TEMP
+ JMS I (ERPRNT
+ JMP I (PIP /RESTART PIP
+
+LEADER, 0
+ JMS I (OTYPE
+C200, AND K770 /GET THE TYPE OF THE OUTPUT DEVICE
+ TAD (-PTP /IS IT A PAPER TAPE PUNCH?
+ SZA CLA
+ JMP I LEADER /NO
+ TAD P7600
+ DCA TEMP
+ JMS I (OCHAR /PUT OUT SOME LEADER
+ JMP I (AOUERR
+ ISZ TEMP
+ JMP .-3
+ JMP I LEADER
+ PAGE
+\f /TABLE OF DEVICE LENGTHS FOR /Z OPTION
+
+DEVLEN, 0;0;0;0;0;1520 /RK08 (1520= - DECIMAL 3248)
+ 6001;4001;2001;0001 /RF08 IN VARIOUS SIZES
+ /(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
+ 7601;7401;7201;7001 /DF32 IN VARIOUS SIZES
+ /(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
+ 6437;6437 /DECTAPE AND LINCTAPE
+ ZBLOCK 1 /20 MAGTAPE
+ 6437 /21 TD8E
+ 0
+ 1520 / 1/2 OF AN RK8E IS 23
+ 0 /24
+ 7022 /25 RX01 FLOPPY DISK
+ ZBLOCK 52 /ALL THE REST
+
+
+FIXLEN, 0 /ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
+ TAD I (7600
+ AND (7760
+ SZA CLA /DID THE USER PROVIDE AN ESTIMATE?
+ JMP I FIXLEN /YES - USE IT
+ DCA CHAR
+ TAD (7617
+ DCA TEMP
+FIXLP, TAD I TEMP /GET NEXT INPUT FILE
+ SNA
+ JMP FIXOVR /NO MORE INPUT FILES
+ AND (7760
+ CIA CLL /GET LENGTH AS A POSITIVE NUMBER
+ /(LENGTH OF ZERO TURNS LINK ON)
+ TAD CHAR
+ DCA CHAR /UPDATE CUMULATIVE LENGTH
+ SZL CLA /DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
+ JMP I FIXLEN /YES - CAN'T ESTIMATE IT
+ ISZ TEMP
+ ISZ TEMP
+ JMP FIXLP
+FIXOVR, TAD CHAR
+ TAD I (7600
+ DCA I (7600 /STICK LENGTH IN OUTPUT FILE DESCRIPTOR
+ JMP I FIXLEN
+\fNOYES, TEXT /NO/
+ TEXT /YES/
+
+CONFRM, 0
+ TAD I (MPARAM+1
+ RTL /'O' BIT TO SIGN
+ SPA CLA
+ JMP GOTCON /V3 'O' MEANS OK, ASSUME 'YES'
+ TAD I CONFRM /V3
+ JMS I (ERPRNT
+ KSF
+ JMP .-1
+ JMS I (CTCTST
+ KRB /LOOK AT HIS REPLY
+ AND (177 /IGNORE PARITY TTY
+ TAD (-"Y!7600 /V3
+ SNA CLA /IS IT YES?
+ ISZ SQFLAG /SET SQFLAG TO 1 (NEEDED 1 LATER)
+ TAD SQFLAG /USE SQFLAG AS INDEX FOR MESSAGE
+ CLL RAL
+ TAD (NOYES
+ JMS I (ERPRNT
+ TAD SQFLAG
+ SNA CLA
+ JMP I (PIP
+CNFMXT, ISZ CONFRM
+ JMP I CONFRM
+
+GOTCON, ISZ SQFLAG /SET SQFLAG
+ JMP CNFMXT /AND TAKE SKIP EXIT
+ PAGE
+\f /DIRECTORY PRINTER FOR PIP
+ MDATE=7666
+
+DIRPRE, JMS I (OUTOPN /OPEN THE OUTPUT FILE
+ TAD (ABUF
+ DCA CHAR /ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
+ TAD (7617
+ DCA TEMP
+ TAD I (7617
+ SNA
+ JMS I (DSKNUM
+ DCA I (7617 /DEFAULT DIRECTORY IS DSK:
+DFUJLP, TAD I TEMP
+ SNA /ARE WE THROUGH WITH THE INPUT DEVICES?
+ JMP GETDIR /YES
+ AND (17
+ DCA I TEMP /ONLY THE DEVICE NUMBER IS IMPORTANT
+ TAD I TEMP
+ TAD (DCB-1
+ DCA PRWD
+ CLA CLL CML RTL
+ TAD TEMP
+ DCA INFPTR /THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
+ TAD I PRWD
+ SMA CLA /IS THE DEVICE A DIRECTORY DEVICE?
+ JMS I (PIPERR /NO
+ 6
+ ISZ TEMP
+ TAD I TEMP
+ DCA I CHAR /SAVE THE STARTING BLOCK NUMBER
+ CLA IAC
+ DCA I TEMP /READ FROM THE DIRECTORY
+ ISZ TEMP
+ ISZ CHAR
+ JMP DFUJLP
+GETDIR, TAD (ABUF
+ DCA CHAR
+ JMS PCRLF
+ TAD I (MDATE
+ JMS I (PDATE
+ JMS PCRLF
+ JMS I (IOPEN /RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
+ /ROUTINES
+ JMP I (NXTDIR
+\fPRWD, 0 /ROUTINE TO PRINT SIXBIT TEXT
+ SNA /IS COUNT ZERO?
+ CMA /MAKE IT ONE
+ DCA PRCT /STORE COUNT
+PRWDLP, TAD I PRWD
+PR212, RTR
+ RTR
+ RTR
+ JMS PR6BIT
+ TAD I PRWD
+ JMS PR6BIT
+ ISZ PRWD
+ ISZ PRCT
+ JMP PRWDLP
+ JMP I PRWD
+PRCT, 0
+PR6BIT, 0
+ AND (77
+ SZA
+ TAD (240 /V3
+ AND (77 /V3
+ TAD (240 /V3
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMP I PR6BIT
+\fPRNUM, 0
+ DCA PRWD
+ DCA TEMP
+ TAD (PWRTEN
+ DCA PCRLF
+PRNMLP, DCA PR6BIT
+ TAD I PCRLF
+ SNA
+ JMP PRLAST /V3
+ CLL
+ TAD PRWD
+ SNL
+ JMP .+4
+ DCA PRWD
+ ISZ PR6BIT
+ JMP PRNMLP+1
+ CLA
+ TAD PR6BIT
+ TAD TEMP
+ SNA
+PBLJMP, JMP PRBLNK /INCREMENTED BY PDATE TO KILL LEADING BLANKS
+ TAD (260
+ JMS PR6BIT
+ CLA CLL CML RAR
+ DCA TEMP
+ ISZ PCRLF
+ JMP PRNMLP
+PRBLNK, JMS PR6BIT
+ JMP .-3
+PRLAST, TAD PRWD /V3
+ TAD (260 /V3
+ JMS PR6BIT /V3
+ JMP I PRNUM /V3
+\fPCRLF, 0
+ TAD (215
+ JMS I (OCHAR
+ JMP I (AOUERR
+ TAD PR212
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMP I PCRLF
+
+PWRTEN, -1750;-144;-12;0 /V3
+ PAGE
+\f /MAIN DIRECTORY PRINTING LOOP
+
+NXTDIR, JMS I (ICHAR /FAKE, FAKE
+ JMP I (DEND
+ CLA /WE DON'T WANT THE CHARACTER
+ DCA ECOUNT
+ TAD (INBUF-1 /WE WANT THE BUFFER!
+NEWSEG, DCA XR
+ CDF 0
+ TAD I XR
+ DCA DCOUNT /NUMBER OF ENTRIES
+ TAD DCOUNT
+ CLL
+ TAD (100
+ SNL CLA
+ JMS I (PIPERR
+ 11
+ TAD I XR
+ DCA BLOKNO /FIRST BLOCK OF FILE STORAGE
+ TAD I XR
+ DCA DLINK /LINK TO NEXT SEGMENT
+ ISZ XR /BUMP XR PAST FLAG WORD
+ TAD I XR
+ DCA WASTE
+NAMELP, CDF 0
+ TAD I XR
+ SNA /WHAT TYPE OF ENTRY IS IT?
+ JMP DEMPTY /A FREE FILE
+ DCA NAME1 /A PERMENANT OR TENTATIVE FILE
+ TAD I XR
+ DCA NAME2
+ TAD I XR
+ DCA NAME3
+ TAD I XR
+ DCA NAME4
+ TAD I XR
+ DCA DDATE
+ TAD WASTE /COMPENSATE FOR THE DATE INCREMENT
+ CMA /AND THE WASTE WORDS
+ TAD XR
+ DCA XR
+ TAD I XR
+ SNA /IS IT A TENTATIVE FILE?
+ JMP ADDLEN+1 /YES - TENTATIVE FILES ARE ALWAYS IGNORED
+ CIA
+ DCA FLENGT /NO - STORE THE LENGTH
+ CDF 10
+ TAD I CHAR /GET THE STARTING FILE FOR THIS LISTING
+ CIA CLL
+ TAD BLOKNO
+ SNL CLA /ARE WE THERE YET?
+ JMP ADDLEN /NO - KEEP GOING
+ CLA CLL CMA RTL
+ JMS I (PRWD /PRINT THREE WORDS
+NAME1, 0
+NAME2, 0
+NAME3, 0
+ TAD NAME4
+ SNA CLA /IS THERE AN EXTENSION?
+ TAD (-16 /NO - PRINT A BLANK
+ TAD (56 /YES - PRINT A PERIOD
+ JMS I (PR6BIT
+ JMS I (PRWD
+NAME4, 0 /ZERO PRINTS AS TWO MORE BLANKS
+PRLNGT, TAD DTYPE
+ AND (100
+ SZA CLA /WAS THE LISTING SWITCH /F?
+ JMP PRTCRL /YES - DON'T PRINT LENGTH
+ TAD FLENGT
+ JMS I (PRNUM
+ TAD WASTE
+ SZA CLA
+ TAD DDATE
+ JMS I (PDATE /PRINT THE CREATION DATE OF THE FILE
+PRTCRL, JMS I (PCRLF
+ADDLEN, TAD FLENGT
+ TAD BLOKNO
+ DCA BLOKNO /UPDATE BLOCK NUMBER
+ ISZ DCOUNT
+ JMP NAMELP /LOOP UNTIL ALL FILES ARE PROCESSED
+ TAD DLINK
+ SNA CLA /MULTI-SEGMENT DIRECTORY?
+ JMP ENDDIR /NO - FINISH UP
+ TAD XR
+ AND (7400
+ TAD (377 /BUMP XR TO NEXT BLOCK
+ JMP NEWSEG /PROCESS NEXT LINK
+\fDEMPTY, TAD I XR
+ CIA
+ DCA FLENGT /STORE LENGTH OF FREE ENTRY
+ CDF 10
+ TAD FLENGT
+ TAD ECOUNT
+ DCA ECOUNT /BUMP COUNT OF FREE BLOCKS
+ TAD DTYPE
+ AND (200
+ SNA CLA /IS THE /E SWITCH ON?
+ JMP ADDLEN /NO - DON'T LIST FREE FILES
+ TAD (-4
+ JMS I (PRWD
+ TEXT /<EMPTY>/
+ JMS I (PR6BIT
+ TAD FLENGT
+ JMS I (PRNUM
+ JMP PRTCRL
+ENDDIR, ISZ CHAR /BUMP TEMP ARRAY TO NEXT ENTRY
+ TAD ECOUNT
+ JMS I (ENDFUJ
+ JMP NXTDIR
+ PAGE
+\f/BINARY MODE PROCESSOR FOR PIP
+
+BIN360, 360
+BINARY, JMS I (FIXLEN
+ JMS I (OUTOPN
+ JMS I (IOPEN
+ JMS I (LEADER /PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
+ JMS LTCODE
+NEWTAP, JMS I (ICHAR
+ JMP BEOF /END OF FILE ON INPUT
+ SNA
+ JMP NEWTAP /BLANK TAPE - KEEP GOING
+ TAD BN7600
+ SZA CLA
+ JMP NEWTAP
+ JMS I (ICHAR
+ JMP BEOF
+ TAD BN7600
+ SNA
+ JMP .-4
+ TAD BIN200
+ DCA CHAR
+ TAD CHAR
+BIN200, AND BIN360
+ TAD (-240 /CHECK TYPE OF TAPE
+ SNA /IS IT RELOCATABLE?
+ JMP RELBIN /YES
+ TAD (-40 /IF A FIELD SETTING, IT'S ABSOLUTE
+ AND (7700
+ SNA
+ JMP ABSLUT
+ TAD BIN200 /CHECK FOR ORIGIN ALSO
+ SZA CLA
+ JMP NEWTAP /NOTHING..NEXT FRAME
+ABSLUT, CLA CMA
+ JMS LTCODE
+ABSBIN, JMS RCOPY1 /COPY THIS FRAME AND READ NEXT
+ TAD BN7600
+BNM140, SZA CLA /IS IT TRAILER?
+ JMP ABSBIN /NO - KEEP GOING
+BEOT, CLA CMA /END OF TAPE
+ JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
+ JMP NEWTAP /GET NEXT TAPE
+\fLTCODE, 0 /SUBROUTINE TO PUNCH 200 CODE
+ SMA /SHORT LEADER/TRAILER?
+ JMS I (OTYPE
+ SPA CLA /DIRECTORY DEVICE?
+ TAD (70 /YES
+ TAD (-100
+ DCA TEMP
+LTLOOP, TAD BIN200
+ JMS I (OCHAR /OUTPUT 64 OR 8 FRAMES OF L/T CODE
+ JMP I (AOUERR
+ ISZ TEMP
+ JMP LTLOOP
+ JMP I LTCODE
+
+RELBIN, TAD (SKP
+ DCA I (INCTZF /DISABLE CONTROL-Z CHECKING ON INPUT
+ CLA CMA
+ JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
+RELLP, TAD CHAR
+ RTR
+ RTR
+ AND (17
+ TAD (RELTBL
+ DCA TEMP
+ TAD I TEMP /GET DATA WORD FOR THIS FRAME
+ SMA SZA /POSITIVE MEANS SPECIAL OR ERROR
+ JMP RELERR
+RELSNA, SNA
+ JMP RELEND /ZERO MEANS CHECKSUM FRAME
+ DCA TEMP /NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
+ JMS RCOPY1
+BN7600, 7600
+ ISZ TEMP
+ JMP .-3 /COPY THIS FRAME AND ALL SLAVE FRAMES
+ JMP RELLP /GET NEXT CONTROL FRAME
+RELEND, JMS RCOPY1 /COPY THE FIRST FRAME OF THE CHECKSUM
+ JMS I (OCHAR
+ JMP I (AOUERR /OUTPUT THE SECOND FRAME
+ JMP BEOT /END TAPE - START NEXT ONE
+BEOF, JMS LTCODE
+ JMS I (OCLOSE
+ JMP I (AOUERR
+ JMP I (PIP
+\fRCOPY1, 0 /ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
+ TAD CHAR
+ JMS I (OCHAR
+ JMP I (AOUERR
+ JMS I (ICHAR
+ JMP INEFER
+ DCA CHAR
+ TAD CHAR
+ JMP I RCOPY1
+INEFER, SMA CLA /DETECT FATALITIES
+ JMS I (PIPERR
+ 7
+ JMS I (PIPERR /A REAL BAD READ
+ 4
+
+RELERR, CLL RAR
+ SZA CLA /CODE OF 1 MEANS SPECIAL
+ JMS I (PIPERR /ILLEGAL RELOCATABLE INPUT
+ 10
+ JMS RCOPY1
+ CLL CML CMA RTL /MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
+ TAD CHAR
+ CLL CML RAL /(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
+ JMP RELSNA
+ PAGE
+\fERPRNT, 0 /ERROR MESSAGE PRINTOUT ROUTINE
+ DCA TEMP
+ERLP, TAD I TEMP
+ RTR
+ RTR
+ RTR
+ JMS ERPCH /PRINT HIGH-ORDER CHARACTER
+ TAD I TEMP
+ JMS ERPCH /PRINT LOW-ORDER CHARACTER
+ ISZ TEMP
+ JMP ERLP
+
+ERPCH, 0
+ AND (77
+ SNA
+ JMP ERCRLF /0 CHARACTER TERMINATES
+ JMS CHPRNT
+ JMP I ERPCH
+FILENR, TAD ("#
+ JMS I (TTYOUT
+ TAD INFPTR /GET PTR TO CURRENT INPUT FILE
+ TAD (321 /MAGIC NUMBER
+ CLL RAR
+ JMP FILENR-2
+
+CHPRNT, 0
+ TAD (-37 /IS IT A _?
+ SNA
+ JMP FILENR /YES..PRINT FILE NUMBER
+ IAC
+ SNA /MAYBE ^?
+ JMP I (SQFILE /YEP..PRINT FILE NAME
+ SPA
+ TAD (100
+ TAD (236
+ JMS I (TTYOUT
+ JMP I CHPRNT
+
+ERCRLF, TAD (215
+ JMS I (TTYOUT
+ TAD (212
+ JMS I (TTYOUT
+ JMP I ERPRNT
+\fPDATE, 0 /PRINTS THE DATE
+ SNA
+ JMP I PDATE /NO DATE TO PRINT
+ DCA ERPRNT
+ ISZ I (PBLJMP
+ JMS I (PR6BIT
+ TAD ERPRNT
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ JMS I (PRNUM
+ TAD (57
+ JMS I (PR6BIT
+ TAD ERPRNT
+ RTR
+ RAR
+ AND (37
+ JMS I (PRNUM
+ TAD (57
+ JMS I (PR6BIT
+ TAD ERPRNT
+ AND (7
+ TAD (106
+ JMS I (PRNUM
+ CLA CMA
+ TAD I (PBLJMP
+ DCA I (PBLJMP /RESET PRNUM TO PRINT LEADING SPACES
+ JMP I PDATE
+
+DSKNUM, 0
+ DCA DSKNAM+1
+ JMS I (200
+ 12
+DSKNAM, 5723
+ 0
+ 0
+ HLT
+ TAD DSKNAM+1
+ JMP I DSKNUM
+\fRELTBL, -2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1
+
+ERRTBL, ERR0
+ ERR1
+ ERR2
+ ERR3
+ ERR4
+ ERR5
+ ERR6
+ ERR7
+ ERR8
+ ERR9
+ ERR10
+ ERR11
+ IFNZRO OS78 <DIRMSG>
+
+ PAGE
+\f/ERROR MESSAGE TEXT GOES HERE
+
+
+ERR0, TEXT /NO ROOM FOR OUTPUT FILE/
+ERR1, TEXT /LINE TOO LONG IN FILE_/
+ERR3, TEXT /ERROR DELETING FILE/
+ERR4, TEXT /INPUT ERROR, FILE_/
+ERR5, TEXT /CAN'T OPEN OUTPUT FILE/
+ERR6, TEXT /DEVICE_ NOT A DIRECTORY DEVICE/
+ERR7, TEXT /PREMATURE END OF FILE, FILE_/
+ERR8, TEXT /ILLEGAL BINARY INPUT, FILE_/
+ERR9, TEXT /BAD DIRECTORY ON DEVICE_/
+ERR10, TEXT /DIRECTORY ERROR/
+
+
+TTYOUT, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TTYOUT
+ PAGE
+\f/SQUISH PROCESSOR
+
+SQUISH, JMS I (CONFRM
+ SURE /V3
+SQUISX, DCA I (OUELEN /INITIALIZE PARAMS TO FAKE OUT "IMTRA"
+ DCA I (OUBLK
+ DCA I (7621 /ZERO SECOND FILE FOR "INNEWF"
+ DCA I (CTCFLG
+ JMS I (IOPEN
+ JMS I (INNEWF
+ JMP I (PIP /NO INPUT
+ TAD (OUDEVH+1
+ DCA SOHND
+ TAD I SQ7600
+ SNA
+ JMP I (PIP /NO OUTPUTEE, NO SQUISHEE
+ JMS I (200
+ 1
+SOHND, 0
+ HLT
+ JMS INTEST
+ JMS I (OTYPE
+ CLL RTR
+ RAR
+ AND (77
+ TAD (DEVLEN
+ DCA TEMP
+ TAD I TEMP /GET ENTRY FROM DEVICE LENGTH TABLE
+ DCA OUDLEN /SAVE OUTPUT DEVICE LENGTH
+ JMS GETEQ
+ DCA OUWAST
+ TAD SOHND
+ DCA OHNDLR
+ TAD OHNDLR
+ DCA I (OUHNDL
+ TAD I (INHNDL
+ DCA IHNDLR
+ JMS SETCTC
+ JMS I (CTCFLG
+ CIF 0
+ JMS I IHNDLR
+ 1400
+ 0
+ 1
+ JMP I (SQIDER+1
+ CIF 0
+ JMS I (7607
+ 5400
+ 0
+ MTEMP /MOVE THE INPUT DIRECTORY TO SYS:
+ JMP I (SQIDER+1
+ CLA IAC
+ DCA I (SQBUF2+2
+ DCA I (CTCFLG
+ TAD SOHND /SETUP DIRECTORY START
+ JMS I (SQDTST
+ JMS I (SETSAM /IF IHNDLR=OHNDLR, SAME=1
+ CLA CMA
+ DCA I (SQBUF2
+ DCA I (OUTSEG
+ JMP I (NEWOUT
+
+GETEQ, 0 /V3
+ TAD I (MPARAM+3
+ SNA
+ IAC
+ AND (77 /CONVERT 0 TO 1 AND 100 TO 0
+ CIA
+ JMP I GETEQ
+
+INTEST, 0 /TEST IF INPUT IS DIRECTORY
+ TAD I (7617
+ AND (17
+ TAD (DCB-1
+ DCA TEMP
+ TAD I TEMP
+ SMA CLA
+ JMS I (PIPERR
+ 6
+ JMP I INTEST
+
+SETCTC, 0 /MODIFY 07600 TO RETURN TO SQCTLC
+ TAD CDIF10
+ CDF 0
+ DCA I SQ7600
+ TAD (5602 /JMP I .+1
+ DCA I (7601
+ TAD (SQCTLC
+ DCA I (7602
+CDIF10, CIF CDF 10
+ JMP I SETCTC
+\fOUK, 0 /V3 ON IMAGE MODE TRANSFER
+ /CLOSE OUT FILE WITH = OPTION
+ /IF NOT TOO SMALL
+ TAD I (OUCCNT
+ CLL CIA
+ TAD I (MPARAM+3
+ SNL /IS = OPTION LARGER?
+SQ7600, 7600 /RETURN OUCCNT IF IT'S LARGER
+ TAD I (OUCCNT /RETURN LOW ORDER = OPTION IF IT'S LARGER
+ JMP I OUK
+ PAGE
+\fNEWIN, TAD (MTEMP-1
+ DCA INSEG
+ JMS I (CTCFLG
+ CIF 0
+ JMS I (7607
+ 0210
+S7200, SQBUF2
+INSEG, 0
+ JMP I (SQIDER
+ DCA I (CTCFLG
+ TAD I (SQBUF2+1
+ DCA INBLK
+ TAD (SQBUF2+4
+ DCA INXR
+SGETIN, TAD I INXR
+ SNA
+ JMP SEMPTY
+ DCA I OUTXR
+ TAD OUTXR
+ DCA OUSAVE
+ JMS I (CYWAST /COPY WASTE WORDS
+ TAD I INXR
+ DCA RECCNT
+ TAD RECCNT
+ SNA
+ JMP SNULL
+ CMA CLL /V3
+ TAD OUTBLK
+ TAD OUDLEN
+ SZL CLA
+ JMP SNULER
+ TAD RECCNT
+ DCA I OUTXR
+ CLA CMA
+ TAD I (SQBUF1
+ DCA I (SQBUF1
+ TAD INBLK
+ CIA
+ TAD OUTBLK
+ SNA CLA
+ TAD SAME
+ SNA CLA
+MOVFIL, JMS I (SQTRA /MOVE THE FILE DOWN
+ TAD RECCNT
+ CIA
+ TAD OUTBLK
+ DCA OUTBLK
+ TAD RECCNT
+DMTX, CIA
+ TAD INBLK
+ DCA INBLK
+ TAD OUTXR
+ CIA
+ TAD OUWAST
+ TAD OUWAST
+ TAD (SQBUF1+365
+ SMA CLA /DO WE HAVE ROOM FOR TWO MORE ENTRIES?
+ JMP NEXTIN
+
+ /DIRECTORY SEGMENT OVERFLOW ON OUTPUT...
+
+ ISZ I (OUTSEG
+ TAD I (OUTSEG
+ IAC
+ DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT
+ TAD I (SQBUF1+2
+ TAD (-7
+ SMA CLA
+ JMP I (SQIDER-1 /TOO MANY SEGMENTS
+ JMS I (OUTDIR /OUTPUT THIS SEGMENT
+NEWOUT, TAD (SQBUF1-1
+ DCA OUTXR /INITIALIZE XR FOR NEXT OUTPUT SEGMENT
+ DCA I (OUTINH /ZAP ANY OLD OUTPUT INHIBIT FLAG
+ DCA I OUTXR
+ TAD OUTBLK
+ DCA I OUTXR
+ DCA I OUTXR
+ DCA I OUTXR
+ TAD OUWAST
+ DCA I OUTXR
+NEXTIN, ISZ I S7200
+ JMP SGETIN
+ TAD I (SQBUF2+2
+ SNA /ANY MORE INPUT SEGMENTS?
+ JMP I (SQOVER
+ JMP NEWIN
+SNULER, TAD (NOROOM
+ JMS I (ERPRNT
+SNULL, CLA CMA
+ TAD OUSAVE
+ DCA OUTXR
+ JMP DMTX-1
+SEMPTY, TAD I INXR
+ JMP DMTX
+OUSAVE, 0
+\fSURE, TEXT /ARE YOU SURE?/
+
+SETSAM, 0
+ TAD IHNDLR
+ CIA
+ TAD OHNDLR
+ SNA CLA
+ IAC
+ DCA SAME
+ JMP I SETSAM
+ PAGE
+\fSQOVER, DCA I OUTXR
+ TAD OUDLEN
+ TAD OUTBLK
+ SNA
+ JMP CKZERO
+ DCA I OUTXR
+ CLA CMA
+ TAD I (SQBUF1
+ DCA I (SQBUF1
+CKZERO, TAD I (SQBUF1
+ SZA CLA
+ JMP ZEROK
+ CLA CLL CML RAR
+ JMS OUTDIR /READ IN LAST DIRECTORY
+ DCA I (SQBUF1+2 /ZERO OUT LINK WORD
+ SKP
+ZEROK, ISZ OUTSEG
+ JMS OUTDIR
+ZEROKS, JMS SRSTOR
+ JMP I (PIP
+
+ DCA I (SQBUF1+2
+SQIDER, JMS OUTDIR
+ JMS SRSTOR
+ JMS I (PIPERR
+ 12
+OUTDIR, 0
+ TAD (4210
+ DCA .+4
+ JMS CTCFLG
+ CIF 0
+ JMS I OHNDLR
+ 0
+ SQBUF1
+OUTSEG, 0
+ JMP SQIDER+1
+ DCA CTCFLG
+ JMP I OUTDIR
+
+SQIOER, TAD (IOMSG
+ JMS I (ERPRNT
+ JMP I (SLGRET
+\fSQCTLC, KCC /JUMPED TO BY CODE AT 07600
+ JMS I (TSTSAM /TEST IF OPERATION IS TO ITSELF
+ TAD (CTCMSG
+ JMS I (ERPRNT
+ TAD CTCFLG
+ SZA CLA
+ JMP I CTCFLG
+ TAD I (MPARAM+1 /IS IT /S?
+ AND (40
+ SNA CLA
+ JMP I (SYSCPY /NO../Y
+ JMP I (MOVFIL
+
+SRSTOR, 0
+ JMS I (7700 /MAKE SURE MONITOR IS IN CORE
+ 10
+ DCA .-2 /AND WIPE THE CALL AWAY
+ TAD (4207
+ CDF 0
+ DCA I (7600
+ TAD (5000
+ DCA I (7601
+ DCA I (7602
+ CDF 10
+ JMP I SRSTOR
+
+CTCFLG, 0
+ JMP I CTCFLG
+\fCTCMSG, TEXT /SORRY - NO INTERRUPTIONS/
+IOMSG, TEXT /I-O ERROR IN ^ - CONTINUING/
+NOROOM, TEXT /NO ROOM IN ^ - CONTINUING/
+ PAGE
+\fK7760, 7760
+SYSCOP, TAD K7622 /SET INFPTR IN CASE OF /Y ERROR
+ DCA INFPTR /WILL FILE #1
+ JMS I (SETCTC /KLUDGE UP 07600
+SYSCPY, TAD (INDEVH+1
+ DCA YIHAND /SET TO ASSIGN INPUT HANDLER
+ TAD (OUDEVH+1
+ DCA YOHAND
+ TAD (2000
+ DCA K2000 /THIS MAY GET CLOBBERED READING IN DIRECT.
+ TAD (10
+ DCA OFSET
+ TAD I K7617
+ SNA CLA /IS THERE AN INPUT DEVICE?
+ ISZ I K7617 /MAKE INPUT =SYS
+ JMS I (INTEST /SEE IF OPERATIONS ARE TO SAME DEVICE
+ TAD I K7617
+ JMS I K200 /ASSIGN HANDLER
+ 1
+YIHAND, 0
+K7622, 7622 /THINLY DISGUISED HALT
+ TAD I K7617
+K200, AND K7760 /CHECK INPUT FILE LENGTH
+ SNA /IF BLANK,INPUT SYSTEM HEAD
+ JMP YSOUT
+ TAD (-6340 /CHECK FOR PROPER LENGTH
+ SZA CLA
+ JMP PER13 /ERROR..NOT SYSTEM HEAD
+ TAD I (7601 /IS THERE OUTPUT DEVICE?
+ SZA CLA /IF YES..WE CAN DO IMAGE XFER
+ JMP I (IMGTST
+ TAD I (7620
+YOUSYS, DCA YINREC /PICK UP STARTING RECORD
+ CIF 0
+ JMS I YIHAND /READ IN FIRST INPUT RECORDS
+K2000, 2000 /(0-15 IF SYSTEM HEAD,0-7 IF FILE)
+ OUBUF
+YINREC, 0
+ JMP I (PER4 /INPUT ERROR
+ TAD I (7620 /IF INPUT FROM A FILE, OPEN
+ SZA CLA /A HOLE FOR OUTPUT DIRECTORY
+ JMS I (MOVE /DO A CORE MOVE
+ JMS I (TSTHED /TEST FOR VALID SYSTEM HEAD
+ TAD YINREC
+ TAD OFSET /BUMP TO NEXT RECORD
+ DCA NXTRD
+ TAD I (7600 /IF NO OUTPUT, FORGET IT
+ SNA
+ JMP PIPCLR /RESET AND GO TO PIP
+ JMS I K200
+ 1
+YOHAND, 0
+ HLT /V3
+ JMS I (FAKE
+ JMS I (SETSAM
+\f JMS I (TSTIO /TEST OUTPUT. SEE IF DIRECT. DEV.
+ CIF 0
+ JMS I YOHAND /READ OUTPUT DIRECTORY INTO PLACE
+ 1400
+ 400
+ 1
+ JMP I (PER4
+ CDF 0
+ TAD I (401 /NOW TEST FOR VALID OUTPUT DEVICE
+ CDF 10
+ TAD (-10 /IF LESS THAN 10, DON'T XFER
+ SPA CLA
+ JMS I (PIPERR
+ 11
+ TAD (-4
+ DCA YINREC /XFER COUNTER
+
+ JMP YDUMP
+YLOOP, CIF 0
+ JMS I YIHAND /READ NEXT
+K3400, 3400 /16 BLOCKS
+ OUBUF
+NXTRD, 0
+ JMP I (PER4
+ TAD NXTRD
+ TAD (16
+ DCA NXTRD
+YDUMP, TAD (7400
+ JMS I (OUTDMP /WRITE BUFFER
+ JMP I (AOUERR
+ ISZ YINREC /DONE YET?
+ JMP YLOOP /NOT YET..LOOP
+PIPCLR, JMS I (SRSTOR /CLEAR OUT 07600
+ JMP I (PIP
+\fYSOUT, TAD I (7601 /HERE IF INPUT FROM SYSTEM HEAD
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I (YTSOUT /YES, SET UP FOR IMAGE MODE
+YNOOUT, TAD K3400 /SET TO READ IN DIRECTORY
+ DCA K2000 /PLUS FIRST 7 RECORDS
+ TAD (16 /AND RESTART READ AT RECORD 16
+ DCA OFSET
+ JMP YOUSYS
+OFSET, 0
+
+PER13, JMS I (PIPERR
+ 13
+K7617, 7617 /V3
+ PAGE
+\fDIRECT, -1
+DFORG, 0 /FILE STORAGE
+ 0
+ 0
+DWASTE, 0 /#WASTE WORDS
+ 0
+DLENGT, 0
+
+MOVE, 0
+ TAD (4400 /MOVES CORE TO OPEN DIRECTORY HOLE
+ DCA TEMP
+ TAD (3777
+ DCA MWAST
+ TAD (6777
+MOVE1, DCA TSTSAM
+ CDF 0
+ TAD I MWAST
+ DCA I TSTSAM
+ CMA
+ TAD MWAST
+ DCA MWAST
+ CMA
+ TAD TSTSAM
+ ISZ TEMP
+ JMP MOVE1
+ CLA
+ CDF 10
+ JMP I MOVE
+
+ERR11, TEXT /BAD SYSTEM HEAD/
+
+YTSOUT, TAD I (7617 /O.K. SETUP CD AREA FOR IMAGE XFER
+ TAD (7760 /FROM SYSTEM AREA OF INPUT DEVICE
+ DCA I (7617
+ TAD I (7617
+ AND (17
+ TAD (6360
+ DCA I (7621
+ TAD K7
+ DCA I (7622
+IMGTST, DCA SAME /ALLOW ^C IF TO OUTPUT FILE
+ TAD I (YIHAND /TEST FOT VALID SYSTEM
+ DCA IHNDLR
+ CIF 0
+ JMS I IHNDLR
+ 0200
+ 3400
+K7, 7
+ JMP I (PER4
+ JMS I (TSTHED
+ JMP I (IMAGE
+\fTSTSAM, 0
+ TAD SAME /IF /Y IS TO SAME DEVICE AS INPUT (SYS)
+ SNA CLA /^C GIVES MESSAGE AND RETRIES OPERATION
+ JMP I (ZEROKS
+ JMP I TSTSAM
+
+ERR2, TEXT /OUTPUT ERROR/
+
+SQFILE, DCA MWAST
+ TAD I (OUSAVE
+ DCA TSTSAM /IF ERROR DURING /S
+ DCA DWASTE
+ CLA CLL CMA RTL
+ DCA MOVE /-3 FOR FILE NAME
+SQFIL3, TAD I TSTSAM /FIRST 2 CHARS. IN NAME
+ CLL RTR
+ RTR
+ RTR
+SQFIL5, AND (77
+ SZA /IF ZERO, DON'T BOTHER
+ JMS I (CHPRNT
+ ISZ DWASTE /RIGHT HALF OR NEW WORD?
+ JMP SQFIL4 /RIGHT HALF
+ ISZ TSTSAM
+ ISZ MOVE /EXHAUSTED ALL?
+ JMP SQFIL3 /NOPE
+ TAD MWAST /DONE WITH IT YET?
+ SZA CLA
+ JMP I (FILENR-1 /YES
+ TAD I TSTSAM /IS THERE AN EXTENSION?
+ SNA CLA
+ JMP I (FILENR-1 /NO..CONTINUE ORIGINAL MSG
+ TAD (256
+ JMS I (TTYOUT
+ ISZ MWAST /SIGNAL END
+ CLA CMA
+ JMP SQFIL3-1
+SQFIL4, CLA CMA
+ DCA DWASTE
+ TAD I TSTSAM /GET RIGHT HALF
+ JMP SQFIL5
+\fMWAST, 0
+ DCA TEMP
+ TAD I INXR
+ DCA I OUTXR /ROUTINE TO COPY WASTE WORDS
+ ISZ TEMP
+ JMP .-3
+ JMP I MWAST
+ PAGE
+\fFAKE, 0
+ TAD I (YIHAND
+ DCA IHNDLR
+ TAD I (YOHAND
+ DCA OHNDLR
+ DCA I (OUCCNT
+ DCA I (OUBLK
+ DCA I (OUELEN
+ TAD I (YOHAND
+ DCA I (OUHNDL
+ JMP I FAKE
+
+CYWAST, 0 /ROUTINE TO COPY WASTE WORDS
+ CLA CLL CMA RTL /THREE MORE FOR FILE NAME
+ JMS I (MWAST /COPY THEM
+ TAD I (SQBUF2+4 /NOW ADJUST I/O WASTE WORDS
+ CIA
+ TAD OUWAST /DIFF. BETWEEN OUT AND IN WORDS
+ SMA /IF <0, MORE OUT THAN IN
+ JMP CGEWST /POS. MORE IN THAN OUT (OR SAME)
+ DCA TEMP1
+ TAD I (SQBUF2+4
+ SZA
+ JMS I (MWAST /COPY ALL INPUT WORDS
+ DCA I OUTXR /AND 0 ALL EXTRA OUTPUT WORDS
+ ISZ TEMP1
+ JMP .-2
+ JMP I CYWAST
+CGEWST, DCA TEMP1
+ TAD OUWAST /XFER ONLY ENOUGH OUTPUT WDS.
+ SZA
+ JMS I (MWAST
+ TAD INXR
+ TAD TEMP1 /POINT INPUT TO NEXT FILE
+ DCA INXR
+ JMP I CYWAST
+
+TSTHED, 0 /TESTS FOR KEYBOARD MONITOR
+ CDF 0
+ TAD I (3401
+ CDF 10
+ TAD (-7200
+ SZA CLA
+ JMP I (PER13 /IF NOT CLA, NOT VALID
+ JMP I TSTHED
+\fTSTIO, 0 /SEE IF OUTPUT IS DIRECTORY DEVICE
+ JMS I (OTYPE /GET DCB WORD FOR OUTPUT
+ SMA CLA /IF NOT NEG., NOT DIRECT DEVICE
+ JMS I (PIPERR
+ 5
+ TAD OHNDLR /IF OUTPUT=SYS, SET NO INTERRUPT
+ TAD (171
+ SNA CLA
+ ISZ SAME
+ JMP I TSTIO
+
+ASCI2, 0 /SEE IF VALID ASCII OUTPUT
+ DCA TSTIO
+ TAD I (7600
+ SNA CLA
+ JMP I (PIP /NO..BACK TO PIP
+ TAD TSTIO /SEE IF /C IS ON
+ SNA CLA
+ JMS I (FIXLEN /NO..TRY TO ESTIMATE OUTPUT
+ JMP I ASCI2
+
+SQDTST, 0 /ROUTINE TO CHECK /S DIRECTORIES
+ DCA NOHND /PRESERVE POSSIBLE SYS ON OUTPUT
+ TAD (7 /DEFAULT TO BLOCK 7
+ DCA OUTBLK /INITIAL GUESS
+ CDF 10 /NOW TRY TO READ DIRECTORY OF OUTPUT
+ JMS I (OTYPE /IF NON-FILE, DON'T READ IT
+ SMA CLA
+ JMP P1A
+ CIF 0 /COULD BE NON-FILE, HOWEVER.
+ JMS I NOHND
+ 0210
+ 1400
+P1, 1
+ JMP I (SQIDER+1 /ERROR IN READ
+P1A, DCA OLDDIR /WIPES ANY DIRECT. SEGMENT
+ TAD I (1401
+ TAD (-70 /IS OUTPUT A SYS DEVICE?
+ SNA CLA
+ JMP SYSDIR /YES.
+ TAD NOHND /IS OUTPUT THE SYSTEM DEVICE?
+ TAD (171
+ SZA CLA
+ JMP .+3
+SYSDIR, TAD (70
+ DCA OUTBLK
+ JMP I SQDTST
+
+NOHND=FAKE
+
+SYSZRO, TEXT /ZERO SYS?/
+\fAOUERR, SMA CLA /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
+ JMP BOUERR /OUT OF SPACE
+PER2, JMS I (PIPERR
+ 2
+BOUERR, JMS I (PIPERR
+ 0
+
+ASCPTCH,TAD (ACHLP+1 /V3C FAKE OUT ICHAR
+ DCA I (ICHAR /SIMULATE CALL TO ICHAR FROM 'ACHLP'
+ JMP I (GETNEW /V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
+ PAGE
+\f/THIS IS ONCE-ONLY CODE
+
+ONCE, 0
+ STA
+ TAD ONCE
+ DCA ONCENF
+ TAD (20
+ DCA I ONCENF /RESTORE L20, DON'T ALLOW REENTRY
+ TAD I (MPARAM+1
+ AND (7
+ SNA CLA /IS /V SET?
+ JMP I ONCE /NO, RETURN
+ TAD (VER /YES
+ JMS I (ERPRNT /PRINT VERSION NUMBER
+ JMP I ONCE /RETURN
+
+VER, TEXT \OS/8 PIP V11A\
+ONCENF, 0
+ PAGE
+ $
+\f
--- /dev/null
+This area contains the files contained on system release DECtape #4.
+
+Directory of OS/8 V3D DECtape 4 labeled: AL-4694C-SA 2/15/78
+ OS/8 V3D SRC DT 4 OF 7
+ (replaces DEC-S8-OSYSB-B-UA4)
+
+
+DTFRMT.PA 111 01-AUG-77 LQP .PA 14 01-AUG-77
+TDFRMT.PA 101 01-AUG-77 RX78B .PA 21 01-AUG-77
+KL8E .PA 52 01-AUG-77 PIP .PA 126 01-AUG-77
+BUILD .PA 187 01-AUG-77 RXCOPY.PA 52 01-AUG-77
+RX01NS.PA 21 01-AUG-77
+
+ 9 files in 685 blocks - 45 free blocks
+
+
--- /dev/null
+/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXVER= "E&77
+
+DEVCOD= 750 /DEVICECODE
+
+LCD= 6001+DEVCOD /LOAD COMMAND REGISTER
+XDR= 6002+DEVCOD /TRANSFER DATA REGISTER
+STR= 6003+DEVCOD /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER= 6004+DEVCOD /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN= 6005+DEVCOD /SKIP ON DONE FLAG, CLEAR FLAG
+INTR= 6006+DEVCOD /INTERRUPT ENABLE/DISABLE
+INIT= 6007+DEVCOD /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/ 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+
+/MODIFIED TO ALLOW ADDRESS CALCULATION DURING SECTOR BUFFER
+/LOAD-UNLOAD.
+\f *0 /ORIGIN FOR BUILD
+
+ -2 /TWO ENTRY POINTS
+ DEVICE RX01 /"RX01" IS THE GROUP NAME
+ DEVICE RXA0 /"RXA0" IS THE ENTRY POINT NAME
+ 4250 /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+ RXA0&177 /ENTRY POINT OFFSET
+ 0 /THIS WORD ALWAYS SEEMS TO BE 0
+ 0 /UNUSED FOR NONSYSTEM DEVICE
+
+ DEVICE RX01 /"RX01" IS THE GROUP NAME
+ DEVICE RXA1 /"RXA1" IS THE ENTRY POINT NAME
+ 4250 /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+ RXA1&177 /ENTRY POINT OFFSET
+ 0 /THIS WORD ALWAYS SEEMS TO BE 0
+ 0 /UNUSED FOR NONSYSTEM DEVICE
+\f *200 /HANDLER CODE
+
+BUF, 0 /USER BUFFER POINTER
+REC, 0 /RX01 RECORD NUMBER BEFORE INTERLEAVING
+BC, 0 /BLOCK COUNT OF TRANSFER
+FN, 0 /FUNCTION, 0=WRITE, 2=READ
+TRANS, 0 /TRANSFER COMMAND
+
+FLPWC=. /100 COUNTER FOR SILO OK IN LDCMD ENTRY
+LDCMD, 0 /WAIT FOR DONE FLAG AND LOAD CMD REG
+ DCA TRANS /SAVE THE NEW COMMAND REG VALUE
+DONELP, TAD S7600 /SEE IF THE KEYBOARD BUFFER
+ KRS /CONTAINS A CONTROL/C CHARACTER
+ TAD (-7603 /(WITH OR WITHOUT PARITY)
+ CLL /KEEP LINK CLEAAR
+ SNA CLA
+ KSF /WITH THE FLAG UP.
+ JMP NOTCTC /IF NOT, CONTINUE
+SCDIF0, CDF CIF 0 /IF SO, RETURN TO OS/8
+ JMP I S7600
+
+NOTCTC, SDN /WAIT FOR THE DONE FLAG TO COME UP
+ JMP DONELP /BEFORE YOU LOAD THE COMMAND REGISTER
+ TAD TRANS /NOW GET THE NEW COMMAND REGISTER CONTENTS
+ LCD /AND LOAD IT.
+ SER /SKIP IF I/O ERROR
+ JMP I LDCMD /AND RETURN
+ CLA CLL CML RAR /SET AC TO 4000
+ JMP SRET /TAKE ERROR RETURN
+
+
+RXA0, RXVER /ENTRY POINT FOR UNIT 0
+ CLA /BE PROTECTIVE
+ JMP RXCOMN /GO TO COMMON CODE
+S70, 70 /** MUST BE AT 33 ON THIS PAGE**
+
+ IFNZRO S70&177-33 <.ERROR>
+
+MQ, /DIVIDE TEMPORARY
+RXA1, RXVER /ENTRY POINT FOR UNIT 1
+ CLA /CAREFUL, CAREFUL!
+ TAD RXA1
+ DCA RXA0 /PUT CALLING ADDR IN KNOWN PLACE
+ TAD DIVLP /GET "20"
+RXCOMN, TAD DIVRAL /SET AC TO 20*UNIT+4
+ DCA UNIT /SAVE UNIT NUMBER
+ RDF
+ TAD SCDIF0 /REMEMBER CALLING FIELD FOR RETURN
+ DCA SRET
+\f
+/ OVERALL COMMENTS:
+/
+/ LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/ EXCEPT AS MANIPULATED BY DIVSUB
+/
+/ OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/ BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/ BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/ THE I/O OPERATION.
+/ A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/ A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/ THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/ AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/ DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/ TIMING CONSIDERATIONS OF THE VT78.
+/
+/ THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+ CLL CML CLA RAR /SET LINK=0, AC=4000
+ TAD I SYS /TO PUT READ-WRITE BIT TO LINK
+S33, AND S70 /KEEP BITS FOR CDF
+ TAD SCDF0 /ADDING IN CDF LITERAL
+ DCA BUFCDF /CDF INSTRUCTION TO USER'S BUFFER
+ CML RTL /FUNCTION CODE, 0=WRITE, 2=READ
+ DCA FN
+ TAD I SYS /MAKE CONTROL COUNT
+ RAL
+ AND S7600 /MAKE CONTROL COUNT FOR TOTAL
+ CIA /NUMBER OF WORDS
+ DCA BC
+ ISZ SYS
+ TAD I SYS /FETCH BUFFER ADDRESS
+ DCA BUF
+ ISZ SYS
+ TAD I SYS /OS8 BLOCK #
+ CLL RTL /TIMES 4 TO BE FLOPPY SECTOR #
+ DCA REC
+ ISZ SYS /ERROR EXIT FROM I/O CALL
+ JMS DIVSUB /COMPUTE TRACK/SECTOR FOR FIRST I/O
+ TAD FN /READ OR WRITE START DIFFERENTLY
+ SZA CLA /SKIP ON WRITE
+ JMP STREAD /GO TO READ
+/
+/ WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO, TAD FN /SET SILO TO LOAD-UNLOAD DEPENDING
+ JMS LDCMD
+ TAD S7700 /SILO CONTROL COUNT 100 OCTAL
+ DCA FLPWC
+BUFCDF, HLT /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP, TAD I BUF /FETCH A WORD IN CASE WRITE
+ STR /WAIT
+ JMP .-1
+ XDR /AC TO SILO; OR; SILO TO AC
+ DCA I BUF /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+ ISZ BUF /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77, 77 /LITERAL 77, EXECUTES AS A NOP
+ ISZ FLPWC /DONE WITH 100 OCTAL SILO OPERATION
+ JMP TRLOOP /NO
+ TAD BC /INCREMENT BC BY 77 HERE, 1 LATER
+ TAD S77 /CHECKING FOR A READ EXIT
+MAGIC, SNA /IF BC HAS GONE TO ZERO, NO-OP FOR LDCMD
+ JMP OKEX /READ EXIT.
+ DCA BC /REPLACING BC FOR WRITE EXIT CHECK AT LOOP END
+/
+/ MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD, TAD FN /READ STARTS HERE
+ TAD UNIT /SET UP DO DO READ OR WRITE I/O
+ JMS LDCMD
+ TAD MQ /LOAD PRECOMPUTED SECTOR INFO
+ STR
+ JMP .-1 /IN CASE NOT READY
+ XDR
+S7700, 7700 /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+ TAD QUO /TRACK
+ STR /ILLEGAL 7700 ENTRY WILL HANG; THE FUNCTION
+ JMP .-1 /IS NOT SET UP (LDCMD)
+ XDR
+S7600, 7600
+ ISZ REC /MOVE TO NEXT FLOPPY SECTOR
+ JMS DIVSUB /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+ TAD MAGIC /WAIT FOR I/O TO COMPLETE
+ JMS LDCMD
+ ISZ BC /CHECK FOR WRITE EXIT
+ JMP SETSLO /NO, BACK TO TOP
+OKEX, ISZ SYS /BUMP TO REGULAR EXIT
+SRET, HLT /CDF CIF FOR USER'S CALLING FIELD
+ JMP I SYS /GONE
+/
+UNIT, 0 /UNIT
+SYS=RXA0
+/
+\f/
+/
+/ LITERALS
+/
+SM15, -15
+SCDF0, CDF 0
+/
+/ DIVSUB
+/
+/ MUST ENTER WITH LINK AND AC 0
+/ COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/ REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/ QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/ REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/ LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB, 0
+ DCA QUO /INIT QUOTIENT FOR DIVIDE
+ TAD REC /RECORD # MASSAGED IN AC
+DIVLP, SNL /LINK USAGE REVERSED FROM RICHIE'S CODE
+ ISZ QUO /ISZ EVERY OTHER TIME, <=DIVIDE BY 26
+ TAD SM15 /THE -13 DECIMAL
+ SMA /SKIP ON DONE
+ JMP DIVLP /MORE
+DIVRAL, RAL /LINK USAGE REVERSED; INTERLEAVE!!
+ TAD S33 /ADD 233 (200 IRREL) MAKING SECTOR
+ DCA MQ
+ JMP I DIVSUB /LEAVING LINK AND AC 0
+QUO, 0 /DIVIDE TEMP
+/
+
+ $
+
+\f
--- /dev/null
+/RX78B
+/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+/FOR RXA2 AND RXA3
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXVER= "F&77
+
+DEVCOD= 750 /DEVICECODE
+
+LCD= 6001+DEVCOD /LOAD COMMAND REGISTER
+XDR= 6002+DEVCOD /TRANSFER DATA REGISTER
+STR= 6003+DEVCOD /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER= 6004+DEVCOD /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN= 6005+DEVCOD /SKIP ON DONE FLAG, CLEAR FLAG
+INTR= 6006+DEVCOD /INTERRUPT ENABLE/DISABLE
+INIT= 6007+DEVCOD /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/ 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+
+/MODIFIED TO ALLOW ADDRESS CALCULATION DURING SECTOR BUFFER
+/LOAD-UNLOAD.
+\f *0 /ORIGIN FOR BUILD
+
+ -2 /TWO ENTRY POINTS
+ DEVICE RX01 /"RX01" IS THE GROUP NAME
+ DEVICE RXA2 /"RXA2" IS THE ENTRY POINT NAME
+ 4250 /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+ RXA2&177 /ENTRY POINT OFFSET
+ 0 /THIS WORD ALWAYS SEEMS TO BE 0
+ 0 /UNUSED FOR NONSYSTEM DEVICE
+
+ DEVICE RX01 /"RX01" IS THE GROUP NAME
+ DEVICE RXA3 /"RXA3" IS THE ENTRY POINT NAME
+ 4250 /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+ RXA3&177 /ENTRY POINT OFFSET
+ 0 /THIS WORD ALWAYS SEEMS TO BE 0
+ 0 /UNUSED FOR NONSYSTEM DEVICE
+\f *200 /HANDLER CODE
+
+BUF, 0 /USER BUFFER POINTER
+REC, 0 /RX01 RECORD NUMBER BEFORE INTERLEAVING
+BC, 0 /BLOCK COUNT OF TRANSFER
+FN, 0 /FUNCTION, 0=WRITE, 2=READ
+
+FLPWC=. /100 COUNTER FOR SILO OK IN LDCMD ENTRY
+LDCMD, 0 /WAIT FOR DONE FLAG AND LOAD CMD REG
+ DCA TRANS /SAVE THE NEW COMMAND REG VALUE
+ SDN /WAIT FOR THE DONE FLAG TO COME UP
+ JMP .-1 /BEFORE YOU LOAD THE COMMAND REGISTER
+DONELP, TAD S7600 /SEE IF THE KEYBOARD BUFFER
+ KRS /CONTAINS A CONTROL/C CHARACTER
+ TAD (-7603 /(WITH OR WITHOUT PARITY)
+ CLL /KEEP LINK CLEAAR
+ SNA CLA
+ KSF /WITH THE FLAG UP.
+ JMP NOTCTC /IF NOT, CONTINUE
+ JMS SELECT /YES, SELECT "A" DRIVES
+SCDIF0, CDF CIF 0 / RETURN TO OS/8
+ JMP I S7600
+
+NOTCTC, TAD TRANS /NOW GET THE NEW COMMAND REGISTER CONTENTS
+ LCD /AND LOAD IT.
+ SER /SKIP IF I/O ERROR
+ JMP I LDCMD /AND RETURN
+ JMS SELECT /SELECT "A" DRIVES
+ CLA CLL CML RAR /SET AC TO 4000
+ JMP SRET /TAKE ERROR RETURN
+
+
+RXA2, RXVER /ENTRY POINT FOR UNIT 2
+ CLA /BE PROTECTIVE
+S70, 70 /** MUST BE AT 33 ON THIS PAGE**
+ JMP RXCOMN /GO TO COMMON CODE
+
+ IFNZRO S70&177-33 <.ERROR>
+
+MQ, /DIVIDE TEMPORARY
+RXA3, RXVER /ENTRY POINT FOR UNIT 3
+ CLA /CAREFUL, CAREFUL!
+ TAD RXA3
+ DCA RXA2 /PUT CALLING ADDR IN KNOWN PLACE
+ TAD DIVLP /GET "20"
+RXCOMN, TAD DIVRAL /SET AC TO 20*UNIT+4
+ DCA UNIT /SAVE UNIT NUMBER
+ RDF
+ TAD SCDIF0 /REMEMBER CALLING FIELD FOR RETURN
+ DCA SRET
+ IAC
+ JMS SELECT /SELECT "B" DRIVES
+\f
+/ OVERALL COMMENTS:
+/
+/ LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/ EXCEPT AS MANIPULATED BY DIVSUB
+/
+/ OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/ BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/ BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/ THE I/O OPERATION.
+/ A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/ A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/ THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/ AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/ DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/ TIMING CONSIDERATIONS OF THE VT78.
+/
+/ THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+ CLL CML CLA RAR /SET LINK=0, AC=4000
+ TAD I SYS /TO PUT READ-WRITE BIT TO LINK
+S33, AND S70 /KEEP BITS FOR CDF
+ TAD SCDF0 /ADDING IN CDF LITERAL
+ DCA BUFCDF /CDF INSTRUCTION TO USER'S BUFFER
+ CML RTL /FUNCTION CODE, 0=WRITE, 2=READ
+ DCA FN
+ TAD I SYS /MAKE CONTROL COUNT
+ RAL
+ AND S7600 /MAKE CONTROL COUNT FOR TOTAL
+ CIA /NUMBER OF WORDS
+ DCA BC
+ ISZ SYS
+ TAD I SYS /FETCH BUFFER ADDRESS
+ DCA BUF
+ ISZ SYS
+ TAD I SYS /OS8 BLOCK #
+ CLL RTL /TIMES 4 TO BE FLOPPY SECTOR #
+ DCA REC
+ ISZ SYS /ERROR EXIT FROM I/O CALL
+ JMS DIVSUB /COMPUTE TRACK/SECTOR FOR FIRST I/O
+ TAD FN /READ OR WRITE START DIFFERENTLY
+ SZA CLA /SKIP ON WRITE
+ JMP STREAD /GO TO READ
+/
+/ WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO, TAD FN /SET SILO TO LOAD-UNLOAD DEPENDING
+ JMS LDCMD
+ TAD S7700 /SILO CONTROL COUNT 100 OCTAL
+ DCA FLPWC
+BUFCDF, HLT /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP, TAD I BUF /FETCH A WORD IN CASE WRITE
+ STR /WAIT
+ JMP .-1
+ XDR /AC TO SILO; OR; SILO TO AC
+ DCA I BUF /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+ ISZ BUF /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77, 77 /LITERAL 77, EXECUTES AS A NOP
+ ISZ FLPWC /DONE WITH 100 OCTAL SILO OPERATION
+ JMP TRLOOP /NO
+ TAD BC /INCREMENT BC BY 77 HERE, 1 LATER
+ TAD S77 /CHECKING FOR A READ EXIT
+MAGIC, SNA /IF BC HAS GONE TO ZERO, NO-OP FOR LDCMD
+ JMP OKEX /READ EXIT.
+ DCA BC /REPLACING BC FOR WRITE EXIT CHECK AT LOOP END
+/
+/ MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD, TAD FN /READ STARTS HERE
+ TAD UNIT /SET UP DO DO READ OR WRITE I/O
+ JMS LDCMD
+ TAD MQ /LOAD PRECOMPUTED SECTOR INFO
+ STR
+ JMP .-1 /IN CASE NOT READY
+ XDR
+S7700, 7700 /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+ TAD QUO /TRACK
+ STR
+ JMP .-1
+ XDR
+S7600, 7600
+ ISZ REC /MOVE TO NEXT FLOPPY SECTOR
+ JMS DIVSUB /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+ TAD MAGIC /WAIT FOR I/O TO COMPLETE
+ JMS LDCMD
+ ISZ BC /CHECK FOR WRITE EXIT
+ JMP SETSLO /NO, BACK TO TOP
+OKEX, ISZ SYS /BUMP TO REGULAR EXIT
+ JMS SELECT /SELECT "A" DRIVES
+SRET, HLT /CDF CIF FOR USER'S CALLING FIELD
+ JMP I SYS /GONE
+/
+UNIT, 0 /UNIT
+SYS=RXA2
+/
+\f/
+/
+/ LITERALS
+/
+SM15, -15
+SCDF0, CDF 0
+/
+/ DIVSUB
+/
+/ MUST ENTER WITH LINK AND AC 0
+/ COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/ REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/ QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/ REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/ LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB, 0
+ DCA QUO /INIT QUOTIENT FOR DIVIDE
+ TAD REC /RECORD # MASSAGED IN AC
+DIVLP, SNL /LINK USAGE REVERSED FROM RICHIE'S CODE
+ ISZ QUO /ISZ EVERY OTHER TIME, <=DIVIDE BY 26
+ TAD SM15 /THE -13 DECIMAL
+ SMA /SKIP ON DONE
+ JMP DIVLP /MORE
+DIVRAL, RAL /LINK USAGE REVERSED; INTERLEAVE!!
+ TAD S33 /ADD 233 (200 IRREL) MAKING SECTOR
+ DCA MQ
+ JMP I DIVSUB /LEAVING LINK AND AC 0
+QUO, 0 /DIVIDE TEMP
+/
+SELECT=.-1 /ENTRY POINT FOR DRIVES SELECT
+ 6750 /SELECT APPROPRIATE DRIVES
+ TAD MAGIC
+ LCD /INITIALIZE THEM
+ JMP I SELECT /DONE
+/
+TRANS=DIVSUB /TRANSFER COMMAND
+/
+ $
+
+\f
--- /dev/null
+/ RXCOPY FOR OS/8 V3D AND OS/78 V1A
+/
+/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/ SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
+/ OF THE ABOVE SOPYRIGHT NOTICE. THIS SOFTWARE, OR ANY THEREOF,
+/ MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER
+/ PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
+/ THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
+/ SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/ THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/ NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/ EQUIPMENT CORPORATION.
+/
+/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/ SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+\f
+/
+/ VERSION V4A M.H. MAY 20, 1977
+/ S.R. MAY 20, 1977
+/
+/ START ADDRESS 16000; JSW 7403
+/
+/ THIS PROGRAM PERFORMS COPY, READ, AND COMPARE OPERATIONS ON
+/ RX FLOPPY DISKS ON A TRACK BY TRACK BASIS. THE COMMAND FORMAT
+/ IS: DEV:<DEV:/OPTION WHERE OPTIONS ARE P, N, M, R, OR V.
+/P PAUSE BEFORE AND AFTER ACCESSING DISK
+/M MATCH WITH NO IMPLIED COPY
+/N COPY WITH NO IMPLIED MATCH
+/R READ OUTPUT DEVICE WITH NO IMPLIED MATCH OR COPY
+/V PRINT VERSION NUMBER
+/C (NOT DOCUMENTED) COPY
+/ IF NO OPTIONS ARE EXPLICITYLY DECLARED, COPY AND MATCH ARE ASSUMED.
+/ IF THE R OPTION IS THE ONLY DISK ACCESSING OPTION SELECTED, THE
+/ FOLLOWING FORMATS WORK: DEV:/R DEV:</R <DEV:/R.
+/
+\f
+MAGIC=7623 /LOCATION IN RX SYSTEM HANDLER WITH A 7004 IF
+ /UNIT 0 OR A 7024 IF UNIT 1. THIS IS ONLY
+ /ACCESSED IF THE USER USES SYS: IN THE COMMAND
+ /STRING AND SYS: IS KNOWN TO BE AN RX!!
+OPT1=7643 /1ST COMMAND DECODER OPTION WORD
+OPT2=7644 /2ND COMMAND DECODER OPTION WORD
+BUFF=2000 /INPUT BUFFER FOR TTY MSGS
+DEVTYP=25 /DEVICE CODE FOR FLOPPY DISKS
+BSIZE=6400 /BUFFER SIZE IN OCTAL WORDS
+BSTART=20 /BUFFER START
+BHALF=BSIZE%2 /HALF OF BSIZE
+USR=200 /ENTRY POINT OF USR
+NOMAT=2000 /NO MATCH OPTION MASK
+COPY=1000 /COPY OPTION MASK
+MMATCH=3777 /CMA OF MATCH OPTION MASK
+MCOPY=6777 /CMA OF COPY OPTION MASK
+MATCH=4000 /MATCH OPTION MASK
+READ=0100 /READ OPTION MASK
+VERSION=0004 /VERSION OPTION MASK
+PAUS=0400 /PAUSE OPTION MASK
+\f
+/ RXCOPY READ-WRITE SUBROUTINE
+/
+ *6420
+/
+/ READ-WRITE SUBROUTINE TO HANDLE FLOPPY DISK IN 8-BIT MODE
+/ ROUTINE LIVES IN FIELD 0 TO BE CALLED FROM FIELD 10
+/
+/ CALLING SEQUENCE
+/
+/ CIF 0 /ASSUMED CDF 10, CALLED FROM FIELD 10
+/ TAD TRACK /TRACK # INTO AC
+/ JMS I (RW
+/ BITS /4000 IF FIELD 10 BUFFER, 2 IF READ, 20 IF UNIT 1
+/ OK RETURN /CDF AND CIF TO 10
+/ ERROR /SECTOR # IN AC
+/
+/ READS OR WRITES A TRACK AT A TIME. TWO BUFFERS LIVE IN 20-6417
+/ EACH OF FIELD 0 AND 10
+/
+/ USES AUTO-INCREMENT REGISTER 10 OF FIELD 0
+X10=10
+/
+/ AN ALTERNATE ENTRY OF CONTIN (JMP NOT JMS) CAUSES THE
+/ SUBROUTINE TO CONTINUE WORKING ON THE SAME TRACK ON WHICH THE
+/ ERROR OCCURRED.
+/
+/ THREE RETRIES ARE DONE ON A SECTOR BEFORE AN ERROR IS DECLARED.
+/
+SDN=6755
+LCD=6751
+STR=6753
+XDR=6752
+SER=6754
+FLINIT=6757
+/
+/
+/ USE PART OF PAGE AT 6400 TO SPREAD OUT WRITE LOOP
+/ FOR A LITTLE EXTRA SAFETY ON MAKING INTERLEAVE TIMING
+/
+WRIT1, TAD (-10 /8 TIMES THRU 16 BYTE > 128
+ DCA WRTCNT
+ST4, TAD I X10 /FETCH A BYTE
+ STR /SKIP IF READY TO TRANSFER
+ JMP .-1 /NO (SHOULDN'T HIT THIS ON VT78)
+ XDR /MOVE BYTE TO SILO
+ CLA /CLEAR THE MUMBLE AC
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD I X10
+ STR
+ JMP .-1
+ XDR
+ CLA
+ ISZ WRTCNT /THRU WITH SILO?
+ JMP ST4 /NO
+ JMP WRIT2 /REST OF LOOP ON OTHER PAGE
+/
+WRTCNT, 0 /CONTROL COUNT FOR FILL SILO LOOP
+/
+ PAGE
+/
+\f/
+/ READ-WRITE ENTRY POINT
+/
+/
+RW, 0
+ DCA TRCKNO /ARRIVES WITH TRACK # IN AC
+ TAD I RW /DATA FIELD 10, FETCH CONTROL BITS
+ TAD L7100 /FLOPPY CONTROLLER IGNORES TOP 4 BITS; 100
+/ /BIT IS 8 BIT MODE; CONTROL FOR UNIT, R/W, IN PLACE
+ DCA FN /BUFFER BIT (COMPLEMENTED) ALSO STORED IN FN
+ TAD (17 /SET UP AUTO-INCR REG.
+ DCA X10
+ TAD (-32 /26 DECIMAL SECTORS PER TRACK
+ DCA SECTOR
+ ISZ RW /POINT TO OK EXIT
+ TAD FN /IF FIELD ZERO BUFFER, NEED TO CDF
+ SPA /SKIP ON FIELD 10 BUFFER, ALREADY SET!
+ CDF 0
+ RTR /READ/WRITE BIT TO LINK
+ SZL CLA /SKIP IF WRITE
+ JMP READLP /GO TO READ
+/
+/ WRITE LOOP
+/
+WRITLP, CLL CLA CMA RTL /LITERAL -3 FOR RETRY COUNT
+ DCA RETRY
+WRTRY, TAD FN /RETRY ERROR HERE THREE TIMES
+ JMS LDCMD
+ JMP WRIT1 /OTHER PAGE TO MOVE DATA TO SILO
+WRIT2, JMS DOIO /RETURN FROM OTHER PAGE TO ACCESS I/O
+ ISZ SECTOR
+ JMP WRITLP
+XT1, CDF CIF 10
+ JMP I RW
+/
+/ READ LOOP
+/
+READLP, CLL CLA CMA RTL /LITERAL -3 FOR RETRY COUNT
+ DCA RETRY
+RDTRY, JMS DOIO /COME HERE TO RETRY I/O
+ TAD FN
+ JMS LDCMD
+ TAD (-40 /32 PASSES THRU 4 BYTES MOVED
+ DCA FLEA
+ST5, STR
+ JMP .-1
+ XDR
+ DCA I X10
+ STR
+ JMP .-1
+ XDR
+ DCA I X10
+ STR
+ JMP .-1
+ XDR
+ DCA I X10
+ STR
+ JMP .-1
+ XDR
+ DCA I X10
+ ISZ FLEA
+ JMP ST5
+ ISZ SECTOR
+ JMP READLP
+ JMP XT1
+/
+/ DO READ OR WRITE I/O FUNCTION
+/
+DOIO, 0
+ TAD FN /SILO FUNCTION, CONVERTED TO READ-WRITE
+ TAD L7004 /BY LITERAL 4 (TOP FOUR BITS IRREL)
+ JMS LDCMD
+ JMS GETSEC /FETCH SECTOR TO AC
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD TRCKNO
+ STR
+ JMP .-1
+ XDR
+ CLA
+ TAD L7530 /UNIT 1, 8-BIT NO-OP (TOP 4 BITS IGNORED)
+ JMS LDCMD
+ JMP I DOIO
+/
+/ LOAD COMMAND REGISTER
+/
+FLEA=.
+LDCMD, 0
+ SDN /SKIP ON DONE
+ JMP .-1
+ LCD /LOAD COMMAND
+ SER /SKIP ON ERROR
+ JMP I LDCMD
+ ISZ RETRY /TRIED THREE TIMES YET
+ JMP KEEPON /NO, KEEP ON TRYING
+ JMS GETSEC /RETURN SECTOR IN AC
+ ISZ RW /ON ERROR, RETURN ONE FURTHER DOWN
+ JMP XT1 /EXIT TO CALLER WITH SECTOR # IN AC
+/
+/ ENTRY TO CONTINUE AFTER ERROR
+/
+CONTIN, STA /BACK UP EXIT TO GOOD EXIT
+ TAD RW
+ DCA RW
+ TAD FN /SET DATA FIELD TO 0 IF NECESSARY
+ SPA CLA /ALREADY CDF TO 10, SKIP IF OK
+ CDF 0 /NO, SO SET TO 0
+ JMP I LDCMD /PRETEND OPERATION OK, SO RETURN THRU LDCMD!
+/
+KEEPON, FLINIT /DO A RECAL TO SHAKE IT UP
+ TAD FN /RETRYING READ OR WRITE
+ RTR /R/W BIT TO LINK
+ SZL CLA /SKIP ON WRITE
+ JMP RDTRY /RETRY A READ
+ TAD (-200 /BACK UP AUTO INCR TO REFILL SILO FOR WRITE
+ TAD X10 /SINCE THE FLINIT CLEARED SILO
+ DCA X10
+ JMP WRTRY /SO GO RETRY WRITE
+/
+/ CONVERT COUNT TO SECTOR
+/
+GETSEC, 0
+ TAD SECTOR /CONVERT -32 TO -1 TO INTERLEAVED SECTOR
+ TAD (15
+L7100, CLL /100 BIT SETS 8-BIT MODE, AS LITERAL
+L7530, SPA SZL /SZL JUST TO MAKE CORRECT LITERAL, NO-OP WAIT
+ TAD (15
+ CML RAL
+ IAC
+ JMP I GETSEC
+L7004, 7004
+/
+/
+/
+TRCKNO, 0 /TRACK NUMBER, INVARIANT THRU CALL
+SECTOR, 0 /COUNTS -32 UP TO 0; 26 DECIMAL SECTORS PER TRACK
+FN, 0 /FUNCTION BITS: ALWAYS 100 FOR 8BIT MODE
+/ /20 IF UNIT 1
+/ /2 IF READ OPERATION (2 IS SILO FETCH; 0 SILO FILL)
+/ /MINUS WORD IF BUFFER IN FIELD 0, PLUS IF FIELD 10
+/ /CONTROLLER IGNORES TOP 4 BITS OF WORD
+RETRY, 0 /RETRY COUNTER -3 TO 0
+\f FIELD 1
+ *6000
+/
+/ ***** BEGIN ONCE ONLY CODE *****
+/
+/
+/ ENTER HERE AND GET USER INPUTS
+/
+START, CLA!SKP /NORMAL ENTRY (MUST CALL DECODER)
+CHAIN, JMP NODEC /CHAIN ENTRY
+ JMS I (USR /CALL IT
+ 5
+ 5200 /DEFAULT INPUT EXT.(SPECIAL MODE)
+ 0 /PRESERVE TENTATIVE FILES
+/
+/ LOAD CONSOLE TTY HANDLER
+/
+NODEC, JMS I (USR /LOAD THE KL8E HANDLER
+ 1
+ DEVICE TTY
+TTYEP, 7201
+ JMP ERRUSR /PRINT USER ERROR
+ TAD TTYEP /MOVE ENTRY POINT FROM THIS PAGE
+ DCA TTYENT
+/
+/ LOAD OUTPUT DEVICE IF SPECIFIED
+/
+ JMS CTRLC /CHECK FOR CONTROL C TYPE-IN
+ TAD I (7600 /GET OUTPUT DEV
+ AND (17
+ DCA OUTDEV
+ TAD I (7605 /GET INPUT DEVICE
+ AND (17
+ DCA INDEV
+ TAD OUTDEV /IF NO OUTPUT DEVICE
+ SZA /IS NAMED MOVE INPUT
+ JMP LOC10 /TO OUTPUT DEVICE
+ TAD INDEV /MOVE IT!
+ DCA OUTDEV
+ DCA INDEV /ZERO INPUT DEVICE
+/
+/ VALIDATE OUTPUT DEVICES AND FILES
+/
+LOC10, JMS CTRLC /CHECK FOR CONTROL C
+ TAD (7601 /MAKE SURE THAT THERE ARE NO OUTPUT FILES
+ DCA TMP1 /OR OTHER OUTPUT DEVICES
+ TAD (-4
+ DCA TMP2
+LOC1, TAD I TMP1 /GET DECODER ENTRY
+ SZA!CLA /IS IT ZERO?
+ JMP ERR2 /NO -- ERROR
+ ISZ TMP1 /INCREMENT POINTER
+ ISZ TMP2 /YES -- DONE WITH OUTPUT ENTRIES?
+ JMP LOC1 /NO -- PROCEED
+ /YES --
+/
+ JMS CTRLC /CHECK FOR CONTROL C
+ TAD I (7605 /WAS THERE ANY INPUT SPECIFICATION?
+ SNA
+ JMP LOC3A /NO
+ TAD (7606 /YES -- MAKE SURE THAT THERE ARE NO INPUT FILES
+ DCA TMP1 /OR OTHER INPUT DEVICES
+ TAD (-5
+ DCA TMP2
+LOC2, TAD I TMP1 /GET DECODER ENTRY
+ SZA!CLA /IS IT ZERO?
+ JMP ERR2 /NO -- ERROR
+ ISZ TMP1 /INCREMENT POINTER
+ ISZ TMP2 /YES -- DONE WITH INPUT ENTRIES?
+ JMP LOC2 /NO -- PROCEED
+ /YES --
+/
+LOC3A, JMS I (USR /LOAD RXA0 AND RXA1 SO UNIT NUMBERS CAN
+ 1 /BE FOUND.
+ DEVICE RXA0
+RX0EP, 200
+ NOP
+ JMS I (USR
+ 1
+ DEVICE RXA1
+RX1EP, 200
+ NOP
+ JMP LOC3 /GO TO NEXT PAGE
+/
+OUTDEV, 0 /OUTPUT DEVICE NUMBER
+INDEV, 0 /INPUT DEVICE NUMBER
+TMP1, 0 /TEMP STORE
+TMP2, 0 /TEMP STORE
+/
+ERR2, TAD (MSG2 /ILLEGAL SPECIFICATION
+PERR, JMS TYPE /PRINT ERROR MESSAGE
+ JMP EXIT /LEAVE
+/
+ERRUSR, JMS I (USR /PRINT USER ERROR
+ 7
+ 2
+ JMP EXIT
+/
+/ SUBROUTINE UNIT -- FIND OUT WHAT THE UNIT NUMBER IS
+/ ON ENTRY AC HAS DEVICE NUMBER
+/ ON EXIT AC HAS 0 IFF UNIT 0 OR 0020 IFF UNIT 1
+/
+UNIT, 0
+ DCA TMP1 /SAVE DEVICE NUMBER
+ CLA!CMA
+ TAD TMP1 /IS DEVICE SYS:?(I.E. IS DEV NUM=1?)
+ SZA!CLA
+ JMP UNITNS /NO
+UNITSY, CDF 0 /YES -- FIND OUT WHICH UNIT IS SYS:
+ TAD I (MAGIC /GUT HOOK RX SYSTEM HANDLER********
+ CDF 10
+ AND (0020 /IF AC IS 0 ITS UNIT 0
+ JMP I UNIT
+UNITNS, TAD TMP1 /GET INFO ON DEVICE NUMBER
+ JMS I (USR
+ 12
+UNITIN, 0
+ JMP ERR3 /SAY DEVICE IS NOT RX IF ERROR HERE
+ TAD UNITIN /IS DEV SYS: IN DISGUISE?
+ RAL
+ SZL!CLA
+ JMP UNITSY /YES -- GO DIG OUT THE UNIT NUM.
+ TAD UNITIN /NO -- DOES EP MATCH RXA0'S
+ CMA!IAC
+ TAD RX0EP
+ SNA!CLA
+ JMP I UNIT /YES
+ TAD UNITIN /NO -- CHECK RXA1
+ CMA!IAC
+ TAD RX1EP
+ SZA!CLA
+ JMP ERR3 /NO -- ERROR
+ TAD (20 /YES
+ JMP I UNIT
+\f
+/
+ PAGE
+/
+\f
+/
+/ CHECK THAT REQ'D DEVICES WERE SPECIFIED FOR OPTIONS SELECTED
+/
+LOC3, JMS OUTD /CHECK THAT OUTPUT DEVICE WAS GIVEN
+ TAD I (OPT2 /IF COPY OR MATCH, CHECK FOR INPUT DEV
+ AND (NOMAT!MATCH
+ SZA!CLA
+ JMS IND
+ TAD I (OPT2 /IF NOT READ OPTION, CHECK FOR INPUT DEV
+ AND (READ
+ SNA!CLA
+ JMS IND
+/
+/ PRINT VERSION IF SELECTED
+/
+VERS, JMS CTRLC /CHECK FOR CONTROL C
+ TAD I (OPT2 /SHOULD VERSION NUMBER BE PRINTED?
+ AND (VERSION
+ SNA!CLA
+ JMP TRANS /NO -- GO CHECK THAT DEVS ARE RXS
+ TAD (VERBUF /YES -- PRINT MESSAGE
+ JMS TYPE
+/
+/ PREPARE FOR DATA TRANSFER
+/
+TRANS, TAD I (OPT2 /SET C SWITCH IF COPY REQ'D
+ AND (MATCH!READ
+ SNA!CLA
+ JMP TRANSB
+ TAD I (OPT2
+ AND (NOMAT
+ SNA!CLA
+ JMP TRANSA /DON'T SET C SWITCH
+TRANSB, TAD I (OPT1 /SET IT
+ AND (MCOPY
+ TAD (COPY
+ DCA I (OPT1
+TRANSA, TAD I (OPT2 /SET M SWITCH IF MATCH REQ'D
+ AND (NOMAT!READ
+ SZA!CLA
+ JMP TRANS1
+ TAD I (OPT2
+ AND (MMATCH
+ TAD (MATCH
+ DCA I (OPT2
+TRANS1, TAD OUTDEV /NO -- CHECK THAT OUTPUT DEV IS RX
+ TAD (7757 /PREPARE TO GET DEV TYPE FROM TABLE
+ DCA TMP3
+ TAD I TMP3
+ AND (0770
+ RTR!CLL
+ RAR
+ TAD (-DEVTYP /WAS DEVICE AN RX?
+ SZA!CLA /DOES IT MATCH?
+ JMP ERR3 /NO -- OUTDEV IS NOT AN RX!!
+ TAD OUTDEV /SETUP UNIT NUMBERS
+ JMS UNIT /FOR OUPUT DEVICE
+ DCA WO1
+ TAD WO1
+ TAD (4002
+ DCA RO1
+/
+OUTOK, TAD I (OPT1 /IF MATCH OR COPY GET INFO ON INDEV
+ AND (COPY
+ SZA!CLA
+ JMP OUTOK1
+ TAD I (OPT2
+ AND (MATCH
+ SNA!CLA /WAS MATCH OR COPY SELECTED?
+ JMP DORDY /NO -- OK
+OUTOK1, TAD INDEV /MAKE SURE INPUT DEVICE IS AN RX
+ TAD (7757 /PREPARE TO ACCESS TABLE
+ DCA TMP3
+ TAD I TMP3
+ AND (0770
+ RTR!CLL
+ RAR
+ TAD (-DEVTYP
+ SZA!CLA /DOES IT MATCH?
+ JMP ERR3 /NO -- ERROR
+ TAD INDEV /SETUP UNIT NUMBERS
+ JMS UNIT /FOR INPUT DEVICE
+ TAD (2
+ DCA RI1
+DORDY, JMS QUEST /PAUSE IF SPECIFIED
+ MSG12
+ JMP DO /PROCESS DISKS
+\f
+/
+/ SUBROUTINE IND -- RETURN IF INPUT DEVICE NUMBER IS NON-ZERO
+/
+IND, 0
+ TAD INDEV /IF INPUT DEV WAS SPEC'D RETURN
+ SNA!CLA /IF NOT DECLARE ERROR
+ JMP ERR5
+ JMP I IND
+/
+/ SUBROUTINE OUTD -- RETURN IF OUTPUT DEVICE NUMBER IS NON-ZERO
+/
+OUTD, 0
+ CLA
+ TAD OUTDEV /IF OUTPUT DEV WAS SPEC'D RETURN
+ SNA!CLA /IF NOT DECLARE ERROR
+ JMP ERR6
+ JMP I OUTD
+/
+TMP3, 0 /TEMP STORE
+TMP4, 0 /TEMP STORE
+/
+ERR3, TAD (MSG3
+ JMP PERR
+ERR5, TAD (MSG5
+ JMP PERR
+ERR6, TAD (MSG6
+ JMP PERR
+\f
+/
+ PAGE
+/
+\f
+DO, JMS I (USR /UNLOCK USR FROM CORE
+ 11
+ TAD (-115 /INIT COUNTER TO -77 DECIMAL
+ DCA CNT
+ DCA TRACK /INIT TRACK NUMBER TO 0
+ JMP DO1
+/
+/ ****** END OF ONCE ONLY CODE ******
+/
+ *6420
+/
+/ WAS COPY SELECTED?
+/
+DO1, TAD I (OPT1 /SHOULD WE COPY?
+ AND (COPY
+ SNA!CLA
+ JMP DO2 /NO
+ JMS RI /YES -- READ INPUT DEVICE INTO FIELD 0
+ JMS WO /WRITE OUTPUT DEVICE FROM FIELD 0
+/
+/ WAS READ SELECTED?
+/
+DO2, TAD I (OPT2 /SHOULD WE READ?
+ AND (READ
+ SNA!CLA
+ JMP DO3 /NO -- CHECK MATCH
+ IAC /YES -- READ OUTPUT DEVICE INTO FIELD 1
+ JMS RO
+/
+/ WAS MATCH SELECTED?
+/
+DO3, TAD I (OPT2 /SHOULD WE MATCH?
+ AND (MATCH
+ SNA!CLA
+ JMP DO5 /NO
+ TAD I (OPT1 /YES -- WAS THERE A COPY?
+ AND (COPY
+ SNA!CLA
+ JMS RI /NO -- READ INPUT DEVICE INTO FILED 0
+ TAD I (OPT2 /YES -- WAS THERE A READ?
+ AND (READ
+ SZA!CLA
+ JMP DO4 /YES
+ IAC /NO -- READ OUTDEV TO FIELD 1
+ JMS RO
+/
+/ COMPARE BUFFERS
+/
+DO4, TAD (BSTART
+ DCA PTR /INIT BUFFER POINTER
+ TAD (-BSIZE /SETUP WD IN BUFFER COUNTER
+ DCA WDCNT
+DO4A, TAD I PTR /GET A WD FROM FIELD 1
+ DCA TMP5 /SAVE
+ CDF 0 /GET A WD FROM FIELD 0
+ TAD I PTR
+ CDF 10
+ CMA!IAC /NEGATE
+ TAD TMP5 /DID WDS MATCH?
+ SZA!CLA /SKIP IF SO
+ JMS ERR7 /NO -- ERROR (BUT NOT FATAL)
+ ISZ PTR /YES -- INCREMENT POINTER
+ ISZ WDCNT /DONE WITH BUFFER?
+ JMP DO4A /NO -- PROCEED
+ /YES --
+/
+/ TEST FOR END OF DISK
+/
+DO5, ISZ TRACK /INCREMENT TRACK
+ ISZ CNT /DONE?
+ JMP DO1 /NO
+ JMP EXITOK /YES
+TMP5, 0 /TEMP STORE
+CNT, 0 /ISZ COUNTER OF TRACKS
+TRACK, 0 /TRACK NUMBER
+PTR, 0 /WORD IN BUFFER POINTER
+WDCNT, 0 /BUFFER WORD COUNTER
+/
+/ SUBROUTINE QUEST -- PRINT MSG AND ASK QUESTION
+/ ASK IT ONLY IF /P WAS SPECIFIED
+/ JMS+1 HAS MSG TO ASK
+/ RETURN ONLY WHEN ANSWER IS YES
+/
+QUEST, 0
+ TAD I (OPT2 /WAS /P SPECIFIED?
+ AND (PAUS
+ SNA!CLA
+ JMP Q2 /NO -- RETURN
+Q1, TAD I QUEST /YES -- GET MESG ADDR
+ JMS TYPE /PRINT IT
+ TAD (BUFF /SELECT INPUT BUFFER
+ JMS RDANS /READ ANSWER
+ TAD I (BUFF /WAS IT "Y"?
+ AND (77
+ TAD (-31
+ SZA!CLA
+ JMP Q1 /NO -- ASK AGAIN
+Q2, ISZ QUEST /YES -- RETURN AT JMS+2
+ JMP I QUEST
+/
+/ SUBROUTINE CTRLC -- CHECK FOR CONTROL C
+/
+CTRLC, 0
+ KRS
+ AND (177
+ TAD (-3
+ SNA!CLA
+ KSF
+ JMP I CTRLC
+ JMP EXIT
+/
+/ EXIT PROGRAM
+/
+EXITOK, JMS QUEST
+ MSG11
+EXIT, CIF!CDF 0
+ JMP I (7605
+\f
+/
+ PAGE
+/
+\f
+/
+/ SUBROUTINE RI -- READ FROM INPUT DEVICE
+/
+RI, 0 /READ FROM INPUT DEVICE
+ JMS CTRLC /CHECK FOR CONTROL C
+ TAD TRACK /GET TRACK NUMBER INTO AC
+ CIF 0 /PREPARE TO ENTRY DRIVER
+ JMS I (RW /CALL DRIVER
+RI1, 0 /FUNCTION WORD
+ JMP I RI /EXIT -- SUCCESSFUL
+ JMS ERR8 /ERROR
+ JMS CTRLC /CHECK FOR CONTROL C
+ CIF 0
+ JMP I (CONTIN /PROCEED
+/
+/ SUBROUTINE RO -- READ FROM OUTPUT DEVICE
+/
+RO, 0 /READ FROM OUTDEV
+ JMS CTRLC /CHECK FOR CONTROL C
+ TAD TRACK
+ CIF 0
+ JMS I (RW
+RO1, 0
+ JMP I RO
+ JMS ERR9
+ JMS CTRLC
+ CIF 0
+ JMP I (CONTIN
+\f
+/
+/ SUBROUTINE WO -- WRITE OUTPUT DEVICE
+/
+WO, 0 /WRITE TO OUTPUT DEVICE
+ JMS CTRLC
+ TAD TRACK
+ CIF 0
+ JMS I (RW
+WO1, 0
+ JMP I WO
+ JMS ERR10
+ JMS CTRLC
+ CIF 0
+ JMP I (CONTIN
+\f/
+/ MISC ERROR ROUTINES
+/
+ERR7, 0
+ TAD (-BSTART /SUBTRACK BUFFER START
+ TAD PTR /FROM WORD IN BUFFER POINTER
+ TAD (-BHALF /THEN SUBTRACT 1/2 OF BUFFER SIZE
+ SPA /SKIP IF PTR IN 2ND HALF
+ JMP ERR7A /PTR IN 1ST HALF
+ AND (7600 /DIVIDE BY 64 DECIMAL AND ADD 2
+ CLL!RTR
+ RTR
+ RTR
+ IAC
+ JMP ERR7W
+ERR7A, TAD (BHALF /MAKE POSITIVE
+ AND (7600 /DIVIDE BY 64 AND ADD 1
+ CLL!RTR
+ RTR
+ RTR
+ERR7W, IAC
+ DCA ERRTMP /SAVE SECTOR NUMBER
+ TAD TRACK /WAS THERE ANOTHER MISMATCH ON THIS SECTOR?
+ TAD ERR7TR
+ SZA!CLA
+ JMP ERR7P /NO
+ TAD ERRTMP /MAYBE
+ TAD ERR7SC
+ SNA!CLA
+ JMP I ERR7 /YES
+ERR7P, TAD (MSG7
+ JMS TYPE
+ TAD ERRTMP
+ JMS ADPRNT
+ TAD TRACK /SAVE TRACK AND SECTOR
+ CMA!IAC /AS 2'S COMP FOR FUTURE COMPARISION
+ DCA ERR7TR
+ TAD ERRTMP
+ CMA!IAC
+ DCA ERR7SC
+ JMP I ERR7
+ERR7TR, 400
+ERR7SC, 400
+ERR8, 0
+ DCA ERRTMP
+ TAD (MSG8
+ JMS TYPE
+ TAD ERRTMP
+ JMS ADPRNT
+ JMP I ERR8
+ERR9, 0
+ DCA ERRTMP
+ TAD (MSG9
+ JMS TYPE
+ TAD ERRTMP
+ JMS ADPRNT
+ JMP I ERR9
+ERR10, 0
+ DCA ERRTMP
+ TAD (MSG10
+ JMS TYPE
+ TAD ERRTMP
+ JMS ADPRNT
+ JMP I ERR10
+/
+ERRTMP, 0
+/
+\f
+/
+/ SUBROUTINE TYPE -- PRINT MESSAGE
+/ ON ENTRY AC HAS MESSAGE ADDRESS
+/
+TYPE, 0
+ DCA TYPAD /SAVE ADDR
+ CIF 0
+ JMS I TTYENT
+ 4110
+TYPAD, 0
+ 0
+ NOP
+ JMP I TYPE
+/
+/ SUBROUTINE RDANS -- READ ANSWER FROM TTY
+/ ON ENTRY AC HAS BUFFER ADDR
+/
+RDANS, 0
+ DCA RDAD /SAVE ADDR
+ CIF 0
+ JMS I TTYENT
+ 0110
+RDAD, 0
+ 0
+ NOP
+ JMP I RDANS
+/
+TTYENT, 0 /ENTRY POINT TO TTY HANDLER
+/
+\f
+/
+ PAGE
+/
+\f/
+/ SUBROUTINE APRNT -- PRINT TRACK AND SECTOR
+/ ENTER WITH SECTOR IN AC
+/
+ADPRNT, 0
+ JMS SETIN
+ MSG13B-1
+ TAD I TRACKN
+ JMS SETIN
+ MSG13A-1
+ TAD MSG
+ JMS I TYPEIT
+ JMP I ADPRNT
+TYPEIT, TYPE
+TRACKN, TRACK
+MSG, MSG13
+\f
+/
+/ SUBROUTINE SETIN -- ENTER NUMBER INTO A MESSAGE
+/
+/ ON ENTRY AC HAS NUMBER AND JMS+1 HAS POINTER TO MESSAGE
+/ HOLE MINUS 1. (2 DECIMAL DIGIT NUMBERS ARE ASSUMED)
+/
+SETIN, 0
+ DCA SETIN1 /SAVE NUMBER
+ DCA SETCNT /ZERO 10'S COUNTER
+ TAD I SETIN /GET MSG ADDR
+ DCA 10 /ENTER INTO AUTOINC POINTER
+ ISZ SETIN /BUMP RETURN ADDR
+SETINB, TAD SETIN1 /GET NUMBER
+ TAD M12 /SUBTRACT 10 DECIMAL
+ SMA /DONE DIVIDING?
+ JMP SETINA /NO
+ CLA /YES
+ TAD SETCNT /GET 10'S
+ TAD P260 /MAKE IT ASCII
+ DCA I 10 /STORE IN MESSAGE
+ TAD SETIN1 /GET REMAINDER
+ TAD P260 /MAKE IT ASCII
+ DCA I 10 /STORE IN MESSAGE
+ JMP I SETIN
+SETINA, DCA SETIN1 /SAVE RESULT
+ ISZ SETCNT /INCREMENT 10'S COUNT
+ JMP SETINB /CONTINUE
+/
+SETIN1, 0 /NUMBER STORAGE
+SETCNT, 0 /10'S COUNTER
+M12, -12 /MINUS 10 DECIMAL
+P7, 7 /LITERAL
+P260, 260 /LITERAL
+\f
+/
+/ ERROR MESSAGES
+/
+VERBUF, "R; "X; "C; "O; "P; "Y; 240; "V; "4; "A; 240; 215; 212; 232
+MSG2, "I; "L; "L; "E; "G; "A; "L; 240; "S; "P; "E; "C; "I; "F; "I
+ "C; "A; "T; "I; "O; "N; 215; 212; 232
+MSG3, "D; "E; "V; "I; "C; "E; 240; "I; "S; 240; "N; "O; "T; 240
+ "R; "X; 215; 212; 232
+MSG5, "N; "O; 240; "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C;
+ "E; 215; 212; 232
+MSG6, "N; "O; 240; "O; "U; "T; "P; "U; "T; 240
+ "D; "E; "V; "I; "C; "E; 215; 212; 232
+MSG7, "C; "O; "M; "P; "A; "R; "E; 240
+ "E; "R; "R; "O; "R; 232
+MSG8, "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+ "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
+MSG9, "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+ "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
+MSG10, "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+ "W; "R; "I; "T; "E; 240; "E; "R; "R; "O; "R; 232
+MSG11, "I; "S; 240; "M; "O; "N; "I; "T; "O; "R; 240
+ "R; "E; "M; "O; "U; "N; "T; "E; "D
+ "?; 232
+MSG12, "R; "E; "A; "D; "Y; "?; 232
+MSG13, 240; "T; "R; "A; "C; "K; 240
+MSG13A, 0
+ 0
+ ",; "S; "E; "C; "T; "O; "R; 240
+MSG13B, 0
+ 0
+ 215; 212; 232
+$
--- /dev/null
+/TD8E FORMATTER V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f
+
+/TD8E DECTAPE FORMATTER COPYRIGHT 1971
+/DIGITAL EQUIPMENT CORP.
+/MAYNARD , MASS
+
+
+
+
+
+ X1=10
+ X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+ SDSS=6771
+ SDST=6772
+ SDSQ=6773
+ SDLC=6774
+ SDLD=6775
+ SDRC=6776
+ SDRD=6777
+
+
+ *0
+ 0
+ JMP 1 /HLT PROGRAM GOT INTERRUPTED SOMEHOW
+ 2
+ 3
+ 0
+ 0
+
+/WORKING LOCATIONS
+
+ *20
+
+W1, 0000
+W2, 0000
+W3, 0000
+W4, 0000
+W5, 0000
+W6, 0000
+BLOCKS, 0000
+DTA, 0000
+PHASE, 0000
+TOTAL, 0000
+VAR1, 0000
+VAR2, 0000
+/CONSTANTS
+
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0700, 0700
+C203, 0203
+C201, 0201
+C260, 0260
+C261, 0261
+C270, 0270
+C271, 0271
+C277, 0277
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+CRCOD, 0215
+LETK, 0313
+LFCOD, 0212
+M2, -2
+M3, -3
+M6, -6
+M7, -7
+M14, -14
+M144, -144
+SPCOD, 0240
+
+BADD, BUFFER-1
+BFR, BUFFER
+COMPAR, COMPRE
+IT, INIT1
+QU1, Q1
+QU2, Q2
+QU3, Q3
+QU4, Q4
+MESS, MES
+STX, START
+TYOCT, TYCT
+TYPE, MESAGE
+TYPIN, TYPN
+WAIT, STALL
+WC, 0
+MTR, 0
+SLRDRC, SRDRC
+DATRD, 0
+M55, -55
+M25, -25
+M26, -26
+M32, -32
+M10, -10
+M70, -70
+M73, -73
+M51, -51
+M45, -45
+M22, -22
+M143, -143
+M52, -52
+M31, -31
+M306, -306
+CNT, 0
+M4, -4
+M307, -307
+SSDSQT, SDSQT
+SA3LNS, A3LNS
+SCEXPC, CEXPC
+MSK77, 0077
+NUD, NUDTA
+BLK, 0
+REVBLK, 0
+BCXOR, SBCXOR
+CHKSUM, 0
+SBWORD, 0
+
+
+
+/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER
+
+RSEND, 0000
+ TLS /LOAD AND PRINT, CLEAR FLAG
+ TSF /WAIT FOR CONFIRMATION
+ JMP .-1 /ENDLESSLY
+ TCF /CLEAR THE FLAG ANYWAY
+ JMP I RSEND
+
+
+/PRINT A "?" ON THE KEYBOARD TYPER
+
+QU, .+1
+ IOF
+ CLA CLL /C(AC)+C(L)=0
+ TAD C277 /"?"
+ JMS RSEND /TYPE THE CHARACTER
+ JMP I .+1 /RESTART
+ INIT
+
+/DECTAPE CONTROL WORDS
+
+DT1400, 1400
+DT0400, 0400
+DT2000, 2000
+DT3000, 3000
+DT1000, 1000
+
+BINCO, BINCON
+SELTIM, ZTIM
+MARKER, ZMKTK
+BLKERR, ZBLK
+DATERR, ZDATA
+CHKERR, ZPAR
+DOMARK, STMK
+DBUFPT, 0 /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+
+*200 /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+ JMP I .+1
+ PATCH
+
+MESAGE, 0
+ IOF
+ CLA CMA /SET C(AC)=-1
+ TAD MESAGE /ADD LOCATION
+ DCA 10 /AUTO INDEX REGISTER
+ TAD I 10 /FETCH FIRST WORD
+ DCA MSRGHT /SAVE IT
+ TAD MSRGHT
+ RTR
+ RTR /ROTATE 6 BITS TO THE RIGHT
+ RTR
+ JMS TYPECH /TYPE IT
+ TAD MSRGHT /GET DATA AGAIN
+ JMS TYPECH /TYPE RIGHT HALF
+ JMP MESAGE+5 /CONTINUE
+MSRGHT, 0 /TEMPORARY STORAGE
+TYPECH, 0 /TYPE CHARACTER IN C(AC)6-11
+ AND C0077
+ SNA /IS IT END OF MESSAGE?
+ JMP I 10 /YES: EXIT
+ TAD M40 /SUBTRACT 40
+ SMA /<40?
+ JMP .+3 /NO
+ TAD C340 /YES: ADD 300
+ JMP MTP /TO CODES <40
+ TAD M3 /SUBTRACT 3
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C212 /YES: CODE 43 IS
+ JMP MTP /LINE-FEED (212)
+ TAD M2 /SUBTRACT 2
+ SZA /IS IT ZERO?
+ JMP .+3 /NO
+ TAD C215 /YES: CODE 45 IS
+ JMP MTP /CARRIAGE RETURN (215)
+ TAD C245 /ADD 200 TO OTHERS >40
+MTP, TLS /TRANSMIT CHARACTER
+ TSF /WAIT FOR THE FLAG
+ JMP .-1 /NOT SET YET
+ CLA /SET: CLEAR C(AC)
+ JMP I TYPECH /RETURN
+
+/CONSTANTS
+
+M40, -40
+C340, 340
+C212, 212
+C215, 215
+C245, 245
+/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN, 0
+ IOF
+ KCC /CLEAR AC, KEYBOARD FLAG
+ TAD BADD /GET BUFFER ADDRESS
+ DCA W1 /STORE FOR THE CHARACTER STRING
+
+/READ AND RESPOND WITH THE CHARACTER
+
+NTYRTN, ISZ W1 /NORMAL RETURN. INCREMENT BUFFER
+ KSF /WAIT FOR KEYBOARD
+ JMP .-1 /FLAG TO RAISE
+ KRB /GOT FLAG, RESET IT, GET CHARACTER
+ JMS RSEND /SEND CHARACTER BACK
+ AND (177 /TAKE CARE OF PARITY
+ TAD (200
+ DCA I W1 /LOAD CHARACTER INTO BUFFER AREA
+ TAD I W1 /CHECK FOR CTRL C
+ CIA
+ TAD C203
+ SZA CLA
+ JMP CHKSP /NO- CHECK FOR SPACE
+ 6007 /CAF- CLEAR ALL FLAGS
+ NOP /JUST IN CASE
+ CLA
+ JMP 7605
+
+/IF CHARACTER IS A SPACE, IGNORE IT
+
+CHKSP, TAD I W1 /CHARACTER INTO THE AC
+ CIA /SUBTRACT FROM SPACE CODE (240)
+ TAD SPCOD /COMPLETE COMPARISON
+ SNA CLA /WAS IT A SPACE?
+ JMP NTYRTN+1 /YES: DO NOT INCREMENT BUFFER
+
+/IF CHARACTER IS A CR, EXIT FROM ROUTINE
+
+ TAD I W1 /CHARACTER TO AC
+ CIA /SET AC TO SUBTRACT CR (215)
+ TAD CRCOD /COMPLETE COMPARISON
+ SZA CLA /WAS IT CR?
+ JMP NTYRTN /NO: INCREMENT BUFFER + WAIT
+
+/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE
+
+ TAD LFCOD /GIVE KEYBOARD LINE FEED
+ JMS RSEND /EXECUTE LINE FEED
+ CLA CLL /EXIT WITH C(ACC) + AND C(L)=0
+ IOF
+ JMP I TYPN /RETURN TO CALL
+\f
+/COMPARE A STRING OF CHARACTERS IN "BUFFER"
+/TO A CHARACTER STRING AFTER A JMS IN ASCII
+
+COMPRE, 0
+ CLA CMA /C(AC)=7777
+ TAD COMPRE /SUBTRACT 1 FOR INDEX REG 1
+ DCA 10 /AUTO INDEX 1 SET TO CHA STRING
+ TAD BADD /AUTO INDEX 2 SET TO BUFFER-1
+ DCA 11 /LOAD X2
+
+/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
+/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
+/ZERO, IF BAD ONE PLUS
+
+ TAD I X1 /CHARACTER FROM PROGRAM
+ CIA /TO SUBTRACT FROM
+ TAD I X2 /CHARACTER IN BUFFER
+ SZA CLA /COMPARE?
+ JMP CERR /NO:RESYNC FOR NON COMPARE EXIT
+ TAD I X1 /YES: CHECK FOR GOOD EXIT
+ SZA /IF 0, EXIT GOOD
+ JMP .-6 /NO: TEST NEXT CHAACTER
+ ISZ X1 /+1 TO X1(TOTAL 2 FROM THE 0)
+ JMP I X1 /+1 TO X1, EXIT
+
+/ERROR FOUND. RESYNC AND EXIT NO COMPARE
+
+CERR, TAD I X1 /CHARACTER FROM PROGRAM
+ SZA CLA /IS THIS EXIT KEY? (0000)
+ JMP .-2 /NO: GET NEXT
+ JMP I X1 /YES: EXIT, NOT COMPARE
+\f
+*400
+/VARIOUS ERROR MESSAGES
+/"NOT DECIMAL"
+
+Q1, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0405 /DE
+ 0311 /CI
+ 1501 /MA
+ 1400 /L
+ JMP QUX
+
+/"TO MANY WORDS"
+
+Q2, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 0000 /00
+ JMP QUX
+
+/"TO MANY BLOCKS"
+
+Q3, JMS I TYPE
+ 2417 /TO
+ 1740 /O
+ 1501 /MA
+ 1631 /NY
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2300 /S0
+ JMP QUX
+
+/"NOT DIVISIBLE BY 3"
+Q4, JMS I TYPE
+ 1617 /NO
+ 2440 /T
+ 0411 /DI
+ 2611 /VI
+ 2311 /SI
+ 0214 /BL
+ 0540 /E
+ 0231 /BY
+ 4063 / 3
+ 0000 /00
+QUX, JMS I TYPE
+ 4345 /CR+LF
+ 0000 /END
+ JMP I .+1
+ INIT
+/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES, 0
+ DCA W4 /SAVE WORD
+ CLL
+ TAD W4
+ CMA RTR
+ RTR
+ AND C7000
+ DCA V1
+ TAD W4
+ CMA RTL
+ RAL
+ AND C0700
+ DCA V2
+ TAD W4
+ CMA RTR
+ RAR
+ AND C0070
+ DCA V3
+ TAD W4
+ CMA RTL
+ RTL
+ AND C0007
+ TAD V1
+ TAD V2
+ TAD V3
+ JMP I MES
+
+V1, 0000
+V2, 0000
+ 7777
+ 7700
+ 0000
+V3, 0000
+ 0000
+
+PATCH, CLA
+ TAD .+4
+ DCA 1
+ JMP I .+1
+ START
+ HLT
+/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE
+/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT
+
+TYCT, 0
+ DCA TW1 /STORE WORD GIVEN
+ TAD TW1 /TO C(ACC) AGAIN
+ RTR
+ RTR /6 BITS RIGHT
+ RTR
+ DCA TYCT1+2 /SAVE ROTATED VALUE, 1ST TWO
+ TAD TYCT1+2 /TO C(ACC) AGAIN
+ AND C0007 /ISOLATE SECOND CHARACTER
+ TAD C6060 /CONVERT TO ASCII
+ DCA TYCT1+1 /STORE AS FIRST PARTIAL 2
+ TAD TYCT1+2 /ROTATED VALUE STORED ABOVE
+ RTL
+ RAL /3 BITS LEFT
+ AND C0700 /ISOLATE FIRST CHARACTER
+ TAD TYCT1+1 /CONVERT 1ST TO ASCII
+ DCA TYCT1+1 /1ST AND 2ND CHARACTERS READY
+ TAD TW1 /ORIGIONAL WORD
+ AND C0007 /ISOLATE 4TH CHARACTER
+ TAD C6060 /CONVERT 4 TH TO ASCII
+ DCA TYCT1+2 /STORE 4TH FOR A MOMENT
+ TAD TW1 /ORIGIONAL WORD
+ RTL
+ RAL /POSITION IT 3RD CHARACTER
+ AND C0700 /ISOLATE 3RD CHARACTER
+ TAD TYCT1+2 /CONVERT TO ASCII
+ DCA TYCT1+2 /CONVERSION COMPLETE
+TYCT1, JMS I TYPE /TYPE THE FOUR CHARACTERS
+ 0 /FIRST 2
+ 0 /SECOND 2
+ 0 /KILL KEY
+ JMP I TYCT /EXIT FROM ROUTINE
+
+/SOME CONSTANTS FOR THE ROUTINE
+
+TW1, 0000
+C6060, 6060
+\f
+*600
+
+STALL, 0
+ CLA
+ TAD I 12 /WORD TO BE WRITTEN
+ SDSQ /WAIT FOR QUADLINE FLAG
+ JMP .-1
+ SDLD /LOAD DATA REGISTERS
+ SDST /CHECK FOR TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ CLA
+ JMP I STALL /GO GET NEXT WORD
+
+
+
+/WAIT TILL WORD COUNT REGISTER GOES TO ZERO
+
+/BLOCK NUMBER ERROR
+ZBLK, 0
+ CLA
+ TAD DTA
+ SDLC /STOP MOVEMENT OF TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZBLK
+ JMS I TYOCT
+ JMS I TYPE
+ 4040 /DOUBLE SPACE
+ 0214 /BL
+ 1703 /OC
+ 1340 /K
+ 1625 /NU
+ 1502 /MB
+ 0522 /ER
+ 4000 /END
+ JMP ZCOM
+
+ /DATA ERRORS
+ZDATA, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003
+ 4000
+ CLA CMA
+ TAD ZDATA
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 0401 /DA
+ 2401 /TA
+ 4000 /END
+ JMP ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZMKTK
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 1501 /MA
+ 2213 /RK
+ 4024 / T
+ 2201 /RA
+ 0313 /CK
+ 4000 / 0
+ JMP ZCOM
+/PARITY ERROR
+
+ZPAR, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD ZPAR
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 0310 /CH
+ 0503 /EC
+ 1323 /KS
+ 2515 /UM
+ 4000 /0
+ JMP ZCOM
+
+
+/TIMING ERROR
+
+ZTIM, 0
+ CLA
+ TAD DTA
+ SDLC /STOP THE TAPE
+ JMS I TYPE
+ 2003
+ 4000
+ CLA CMA
+ TAD ZTIM
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 2411 /TI
+ 1511 /MI
+ 1607 /NG
+ 4000 / 0
+
+/TYPE "ERROR PHASE X"
+
+ZCOM, TAD PHASE /WHAT PHASE OF OPERATION
+ TAD PFORM /WAS THE MACHINE IN
+ DCA TFORM /WHEN ERROR OCCURED
+ JMS I TYPE
+ 0522 /ER
+ 2217 /RO
+ 2240 /R
+ 2010 /PH
+ 0123 /AS
+ 0540 /E
+TFORM, 4060 / X
+ 4543 /CR+LF
+ 0000 /END
+ JMP I .+1
+ RETRY
+PFORM, 4060
+
+
+\f
+/HERE STARTS THIS PROGRAM. IT WILL ASK THE
+/OPERATOR FOR DRIVE NUMBERS, THEN ASK HIM FOR
+/A DIRECTION ON WHAT TO DO WITH THE DRIVES.
+
+/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:
+
+
+/UNIT? (0 OR 1 OR 0 1)
+/FORMAT? (MARK 1215)
+/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
+/(YES)
+
+
+/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
+/(HE DOESN'T TYPE THE PARENTHESIS)
+/IF HE HAD ANSWERED NO, "FORMAT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "FORMAT?" THE
+/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
+/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
+/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
+/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
+/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
+/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT
+
+
+
+
+
+*1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+STAR0, JMS I TYPE /TYPE VERSION NUMBER
+ 4543 /CR+LF
+ 4300 /LF+0
+ JMS I TYPE
+ TEXT /TDFMT V4A/
+START, JMS I TYPE /SET UP TYPER
+ 4543 /CR+LF
+ 4300 /LF+END
+
+TYQU, JMS I TYPE /"UNIT?"
+ 2516 /UN
+ 1124 /IT
+ 7740 /?
+ 0000 /END
+
+/WAIT FOR A REPLY
+
+ JMS I TYPIN /GET NUMBERS
+ TAD BADD /INITIALIZE POINTER (BFR)
+ IAC /(BADD=BUFFER-1, SO BUMP THE AC)
+ DCA BFR /TO START OF INPUT BUFFER
+ DCA DCTR /INITIALIZE DTA COUNTER TO 0
+ DCA CRFLAG /CLEAR FLAG SO CR NOT ACCEPTIBLE
+CRCHK, TAD CRCOD /GET CODE FOR CAR. RETN
+ CIA /NEGATE IT
+ TAD I BFR /SEE IF NEXT CHAR. IN
+ SNA /BUFFER IS CAR. RETN.
+ JMP OKCR /YES: SEE IF C.R. LEGAL HERE
+ DCA CRFLAG /NO: SO C.R. IS LEGAL NOW
+VALCHK, TAD C260 /SEE IF # IS LESS THAN
+ CIA /ASCII 0 (260)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SPA CLA /IS IT LESS THAN ASII 0?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD C261 /NO: SEE IF GREATER THAN
+ CMA /ASC II 1 (261)
+ TAD I BFR /SUBTRACT BUFFER DATA
+ SMA CLA /GREATER THAN ASCII 7?
+ JMP TYQU /YES: TELL OUTSIDE WORLD
+ TAD I BFR /NO: ACCEPT BUFFER
+ RTR
+ AND C7000 /ISOLATE DTA
+ JMS REPEAT /GO CHECK FOR REPEATED DTA AND STORE #
+ ISZ BFR /INCREMENT INPUT BUF. PTR.
+ JMP CRCHK /GO LOOK AT NEXT CHAR.
+
+/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
+/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
+OKCR, CLA /CLEAR AC
+ TAD CRFLAG /LOAD CR FLAG; 0 MEANS NO GOOD
+ SNA CLA
+ JMP START /0: NO VALID INPUT; RESTART
+ TAD DCTR /NOT 0: SO HAVE VALID INPUT
+ TAD DBUFAD /CALCULATE END OF DTA LIST +1
+ DCA DBUFPT /STORE IT IN BUFFER POINTER, THEN
+ CMA /COMPLEMENT THE AC AND
+ DCA I DBUFPT /TERMINATE DTA LIST WITH 7777
+INIT1, CLA /CLEAR AC IF COME THRU LOC IT
+ TAD DBUFAD /AND RESET LIST POINTER
+ DCA DBUFPT /TO START OF LIST
+ JMS I GETDTA /GO GET A DTA NUMBER
+
+/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
+/TYPE "FORMAT" AND WAIT FOR THE REPLY
+
+INIT, JMS I TYPE /MESSAGE OUT
+ 0617 /FO
+ 2215 /RM
+ 0124 /AT
+ 7740 /?
+ 0000 /END
+ JMS I TYPIN /WAIT FOR A REPLY
+ JMS I COMPAR /DID HE TYPE "MARK"?
+ 0315 /M
+ 0301 /A
+ 0322 /R
+ 0313 /K
+ 0000 /END
+ JMP .+3
+ JMP I .+1
+ MARK /TO MARK A TAPE
+/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS IN REVERSE).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0322 /R
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDR /TYPE BLOCKS
+
+/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS FORWARD).
+
+ JMS I COMPAR
+ 0322 /R
+ 0304 /D
+ 0306 /F
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ RDFA /TYPE BLOCKS
+
+/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
+/USING THE SAME CONSTANTS AS BEFORE).
+
+ JMS I COMPAR
+ 0323 /S
+ 0301 /A
+ 0315 /M
+ 0305 /E
+ 0000 /0
+ JMP .+3
+ JMP I .+1
+ SWCHK /TO MARK AS BEFORE
+
+/SEE IF HE TYPED "RESTART"
+
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0323 /S
+ 0324 /T
+ 0301 /A
+ 0322 /R
+ 0324 /T
+ 0000 /0
+ JMS QU /MUST BE NONSENSE
+ JMP START /START ALL OVER
+GETDTA, NUDTA /POINTER TO ROUTINE TO SWITCH UNITS
+CRFLAG, 0 /=0, CR NO GOOD; NOT 0, CR IS OK
+\f\f
+ *1200
+/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
+/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
+/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)
+
+MARK, TAD I BINCO /ADDRESS OF FIRST BINARY
+ DCA W5 /CONSTANT FOR DEC TO BIN
+ DCA TOTAL /WILL BE BINARY EQUIVILANT
+
+/SAVE C(X1) FOR DECREMENT THROUGH BUFFER
+
+DNC, CLA CMA /DECREMENT BUFFER ADDRESS
+ TAD W1 /ADDRESS BY 1
+ DCA W1 /W1=SWEEP ADDRESS
+
+/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER
+
+ TAD LETK /LETTER ASCII "K"
+ CIA /SUBTRACT FROM CHARACTER
+ TAD I W1 /IN BUFFER
+ SNA CLA /EQUAL?
+ JMP DIV3 /YES: SEE IF DIVISIBLE BY 3
+
+/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN
+
+ TAD C260 /ASCII FOR 0
+ CIA /TO SEE IF CHARACTER
+ TAD I W1 /IS LESS THAN 260
+ SPA CLA /IS IT?
+ JMP I QU1 /YES: NOT DECIMAL CHARACTER
+ TAD C271 /ASCII FOR 9
+ CMA /TO SEE IF GREATER THAN
+ TAD I W1 /9
+ SMA CLA /IS IT?
+ JMP I QU1 /NOT A DECIMAL CHARACTER
+/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
+/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
+/10,100,1000.
+
+ TAD I W1 /ISOLATE THE NUMBER
+ AND C0017 /FOR PROPER CONVERSION
+ SNA /IF 0, NO BINARY CONVERSION NEEDED
+ JMP IBS /YES: 0: INCREMENT BINARY CONVERSION
+
+/NOT 0, SET UP CONVERSION LOOP
+
+ CLL CIA /NUMBER OF ADDITIONS
+ DCA W4 /TO NEGATIVE FOR ISZ
+ TAD I W5 /BINARY POSITION TO C(ACC)
+ TAD TOTAL /ADD TO PRESENT TOTAL
+ SZL /CHECK ON TO MANY WORDS
+ JMP I QU2 /TO MANY WORDS CALLED FOR
+ DCA TOTAL /KEEP RUNNING SUM
+ ISZ W4 /LAST ADDITION?
+ JMP .-6 /NO: ADD AGAIN
+
+/FINAL ADDITION FOR THIS POSITION COMPLETED
+
+IBS, ISZ W5 /NEXT POSITION
+ JMP DNC /DO NEXT CHARACTER
+
+/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
+/IF NOT A NORMAL INPUT
+
+DIV3, TAD TOTAL /GET TOTAL WORDS
+ SNA /IF TOTAL 0, NORMAL INPUT
+ TAD C201 /129 OCT. THIS TEST REDUNDANT
+ TAD C0017 /ADD CONSTANT 15 TO TOTAL
+ DCA TOTAL /FOR FUTURE CONSIDERATIONS
+ DCA VAR1 /# OF WORDS/3 FOR MARK TRACK WRITING
+ TAD TOTAL /RESTORE IN THE ACC
+ CLL /TO DIVIDE BY 3, LINK KEEPS OVERFLOW
+ TAD M3 /SUBTRACT 3
+ ISZ VAR1 /ON EACH DIVISION, KEEP RUNNING SUM
+ SZA /IF AC = 0,NO REMAINDER
+ SNL /WHEN LINC GOES TO 0, DIVISION ENDED
+ SKP /NOW SEE IF IT DIVIDED EVENLY
+ JMP .-6 /SUBTRACT 3 MORE
+ SZA CLA /IF 0,OK. OTHERWISE ERROR
+ JMP I QU4 /NOT DIVISIBLE BY 3
+
+/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
+/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
+/CONFIGURATION TO BE WRITTEN.
+
+ TAD M7 /SUBTRACT 7 FROM PHONY SETUP
+ TAD VAR1 /GIVING THE NUMBER OF TIMES
+ CIA /TO BE USED LATER IN A ISZ
+ DCA VAR1 /DATA MARK WILL BE WRITTEN
+/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
+/RECORD SIZE + 15 INTO 636160 OCT.
+
+ TAD C7714 /EXTENDED 64 VALUE. SETS AC#2
+ DCA W1 /SET FOR 640000
+ JMS I FORM10 /PATCH TO CHECK FOR STD.10 FORMAT
+ TAD C1620 /VERNIER ADJUSTMENT FOR FORMULA
+ CLL /ACC#2 CARRY FUNCTION
+ TAD TOTAL /WORD COUNT
+ ISZ BLOCKS /+1 TO BLOCK COUNT
+ SKP
+ JMP I QU3 /TO MANY BLOCKS CALLED FOR
+ SNL /CARRY INTO ACC#2?
+ JMP .-5 /NO: CONTINUE COUNT
+ ISZ W1 /YES: FULLY DIVIDED?
+ JMP .-10 /NO: CONTINUE PROCESS
+ CLA CLL /C(ACC)+ C(L)=0
+F10RTN, TAD BLOCKS /FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
+ CMA /WRITING
+ DCA VAR2 /SEE MARK WRITE
+
+/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
+/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.
+
+ TAD TOTAL /SUBTRACT 15 FROM TOTAL
+ TAD C7761 /WORDS FOOLING OPERATOR
+ DCA TOTAL /CORRECTED FOR TAPE WRITING
+ TAD TOTAL /FOR OCTAL TYPEOUT
+ JMS I TYOCT /TYPE OCTAL WORDS
+ JMS I TYPE /TYPE MESSAGE
+ 4027 / W
+ 1722 /OR
+ 0423 /DS
+ 5400 /, END
+ TAD BLOCKS /TYPE OUT BLOCK #S
+ IAC /TO FOOL THE OPERATOR
+ JMS I TYOCT /IN OCTAL
+ JMS I TYPE /TYPE MESSAGES
+ 4002 / B
+ 1417 /LO
+ 0313 /CK
+ 2356 /S.
+ 1713 /OK
+ 7733 /?(
+ 3105 /YE
+ 2340 /S
+ 1722 /OR
+ 4016 / N
+ 1735 /O)
+ 4543 /CR+LF
+ 0000 /END
+ JMS I TYPIN /WAIT FOR REPLY
+/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+ JMS I COMPAR
+ 0331 /Y
+ 0305 /E
+ 0323 /S
+ 0000 /END
+ JMP I IT
+
+ JMP I .+1
+ SWCHK
+FORM10, F10PAT
+
+
+\f
+*1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE SET.
+
+/WRITE TIMING AND MARK TRACK
+
+STMK, CLA
+ DCA PHASE
+ TAD DT1400 /FWD, WRITE, GO
+ TAD DTA /GET UNIT NUMBER
+ SDLC /LOAD COMMAND REGISTER
+ TAD VAR2 /TO MAKE A RESTART FOR THE SAME
+ DCA W6 /OPTION POSSIBLE
+
+/WRITE ABOUT 10 FEET OF END ZONE
+ DCA W1
+CEZ, TAD REZ /ADDRESS OF DATA
+ JMS SETUP
+ ISZ W1
+ JMP CEZ /NOT END FOOTAGE
+ TAD M144 /OK WRITE INTERBLOCK SYNC
+ DCA W1
+ JMS INBLSY
+ ISZ W1
+ JMP .-2
+ JMP WDZ
+
+ /WRITE INTERBLOCK SYNC
+INBLSY, 0
+ TAD VAR1 /RESET THE WORDS
+ DCA W5
+ TAD IBZ /ADDRESS OF DATA
+ JMS SETUP /GO OUT AND WRITE 1
+ JMP I INBLSY /GO DO AGAIN
+
+ /WRITE FORWARD BLOCKMARK AND REVERSE GUARD
+WDZ, TAD FBM /ADDRESS OF PATTERN
+ JMS SETUP
+
+ /WRITE LOCKMARK, REVERSE CHECKSUM, REV FINAL, REV PREFINAL
+LRCFP, TAD WLMRF
+ JMS SETUP1
+
+ /WRITE THE DATA TRACK
+DTRK, TAD DZ /ADDRESS OF PATTERN
+ JMS SETUP
+ ISZ W5
+ JMP DTRK /NOW WRITE DATA MARK TRACK AGAIN
+ /WRITE PREFINAL, FINAL, CHECKSUM, AND REVERSE LOCK
+PFCRC, TAD FEZ /ADDRESS OF DATA
+ JMS SETUP1
+
+ /WRITE GUARD REVERSE BLOCK
+GRB, TAD GRZ
+ JMS SETUP
+
+ /THIS COMPLETES 1 BLOCK, GO BACK AND WRITE THE REST
+ JMS INBLSY /WRITE INTERBLOCK SYNC
+ ISZ W6 /TOTAL NUMBER OF BLOCKS
+ JMP WDZ /WRITTEN? NO:
+
+ /ALL DATA BLOCKS WRITTEN NOW WRITE BUFFER ZONE OF INTERBLOCK SYNC
+ TAD M143 /198 EXPAND CODES AT END OF BLOCKS
+ DCA W1
+ JMS INBLSY
+ ISZ W1
+ JMP .-2
+
+ /FINISHED BLOCK WRITTING, WRITE ANOTHER 10(1) OF END ZONES
+ DCA W1
+WEZF, TAD EZM
+ JMS SETUP
+ ISZ W1
+ JMP WEZF
+ SDST
+ SKP CLA
+ JMS I SELTIM /TIMING ERROR
+ TAD C1
+ DCA PHASE
+ JMP I .+1
+ MWTM
+
+SETUP, 0
+ DCA 12 /WORD TO BE WRITTEN ON MARK TRACK
+ TAD M3
+ DCA WC
+ JMS I WAIT
+ ISZ WC
+ JMP .-2
+ JMP I SETUP
+
+SETUP1, 0
+ DCA 12
+ TAD M6
+ DCA WC
+ JMS I WAIT
+ ISZ WC
+ JMP .-2
+ JMP I SETUP1
+/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK
+
+
+/REVERSE END ZONE
+
+REZ, .
+ 4044 /ON TAPE AS 5555 (OCT)
+ 0440
+ 4404
+
+/INTERBLOCK SYNC
+
+IBZ, .
+ 0404 /ON TAPE AS 2525 (OCT)
+ 0404
+ 0404
+
+/FORWARD BLOCK MARK AND REVERSE GUARD
+
+FBM, .
+ 0404 /ON TAPE AS 2632 (OCT)
+ 4004
+ 4040
+
+/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
+/AND REVERSE PREFINAL
+
+WLMRF, .
+ 0040 /ON TAPE AS 10101010 (OCT)
+ 0000
+ 4000
+ 0040
+ 0000
+ 4000
+
+/DATA MARK
+
+DZ, .
+ 4440 /ON TAPE AS 7070 (OCT)
+ 0044
+ 4000
+
+/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK
+
+FEZ, .
+ 4440 /ON TAPE AS 73737373 (OCT)
+ 4444
+ 4044
+ 4440
+ 4444
+ 4044
+/FORWARD GUARD AND REVERSE BLOCK NUMBER
+
+GRZ, .
+ 4040 /ON TAPE AS 5145 (OCT)
+ 0440
+ 0404
+
+/FORWARD END ZONE
+
+EZM, .
+ 0400 /ON TAPE AS 2222 (OCT)
+ 4004
+ 0040
+/SUBROUTINE TO SEE IF USER TYPED MARK 384
+/TO SPECIFY STANDARD PDP-10 FORMAT
+F10PAT, 0
+ DCA BLOCKS /CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
+ TAD TOTAL /AND GET NUMBER TYPED BY USER
+ TAD M617 /WAS IT 384?
+ SZA CLA
+ JMP I F10PAT /NO-RETURN
+ DCA W1 /YES-CLEAR W1 FOR WAIT LOOP
+ TAD C1101 /AND ADJUST BLOCK TOTAL FOR
+ DCA BLOCKS /1102(OCTAL) BLOCKS.
+ JMP I .+1
+F10BAK, F10RTN
+M617, -617
+C1101, 1101
+C1, 0001
+\f
+ *1600
+/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
+/MOVING FORWARD IN THE FORWARD END ZONE. STOP
+/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
+/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
+/"OFF/WTM" SWITCH TO "OFF"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+
+ /KILL WRITE,STOP TAPE
+
+MWTM, CLA
+ TAD DTA /UNIT
+ SDLC
+ JMS NUDTA
+ JMP I DOMARK
+
+ /MESSAGE TO THE OPERATOR
+OFF, JMS I TYPE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 /T
+ 1740 /O
+ 1706 /OF
+ 0600 /F
+ JMS I TYPIN /WAIT FOR CR
+ JMP I .+1
+ SWOFF /CHECK TO MAKE SURE THAT SWITCH IS OFF
+ /REVERSE TAPE AND READ MARK TRACK
+PSER, TAD DT3000 /REVERSE GO
+ TAD DTA /UNIT
+ SDLC /LOAD COMMAND REGISTER
+ DCA W1 /STALL ROUTINE TO GET UP TO SPEED
+ SDSQ
+ JMP .-1
+ SDRC
+ ISZ W1
+ JMP .-4
+ SDSQ /SKIP ON QUAD LINE IF SET AFTER WAIT ROUTINE
+ SKP
+ JMP .+3 /FLAG WAS SET
+ SDSS /READ IN A LINE OF TAPE
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77 /CHECK TO SEE IF TAPE IS STILL IN END ZONE
+ TAD M55
+ SZA CLA
+ JMP .-11 /NOT A 55 YET
+ JMS I SSDSQT /YES,READ IN SOME MORE
+ TAD M55 /IS IT END ZONE
+ SNA CLA
+ JMP .-3 /STILL IN END ZONE
+ TAD MTR /GET THE MARK TRACK
+ TAD M25 /IS IT EXPAND CODE
+ SZA CLA
+ JMS I SCEXPC /NOT YET,CHECK FOR A 52,AND ADVANCE 3 LINES
+ CLA /YES IT IS EXPAND CODE
+ TAD M306 /SET UP FOR 198 EXPAND CODES
+ DCA CNT
+ JMS I SSDSQT /THE TAPE SHOULD BE IN SYNC NOW
+ TAD M25 /READ THE REST OF EXPAND CODE
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT /INCREMENT COUNTER
+ JMP .-5
+ TAD VAR2 /NUMBER OF BLOCKS
+ DCA W6
+RSTBLK, JMS I SSDSQT /START OF A STANDARD BLOCK
+ TAD M25 /FIRST EXPAND CODE AT BEGINNING
+ SZA CLA /OF BLOCK
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ MARK BLOCK NUMBER
+ TAD M26
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ MARK GUARD
+ TAD M32
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ TAD M4
+ DCA CNT
+ JMS I SSDSQT /READ L,CK,F,PF
+ TAD M10
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ CLA CLL
+ TAD VAR1
+ RAL
+ DCA W5 /NUMBER OF DATA MARKS
+ JMS I SSDSQT /READ DATA MARKS
+ TAD M70
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ W5 /COUNT FOR NUMBER OF BLOCKS
+ JMP .-5
+ TAD M4
+ DCA CNT
+ JMS I SSDSQT /READ PF,F,CK,L
+ TAD M73
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ JMS I SSDSQT /READ REVERSE GUARD
+ TAD M51
+ SZA CLA
+ JMS I MARKER
+
+ JMS I SSDSQT /READ BLOCK NUMBER
+ TAD M45
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS I SSDSQT /READ EXPAND CODE
+ TAD M25
+ SZA CLA
+ JMS I MARKER /END OF ONE BLOCK,MARK TRACK ERROR
+
+ ISZ W6 /FINISHED ALL BLOCKS
+ JMP RSTBLK /NO:DO OTHER BLOCKS
+ TAD M307 /SET UP FOR INTERBLOCK SYNC AT END OF TAPE
+ DCA CNT
+ JMS I SSDSQT /CHECK FOR 199 EXPAND CODES
+ TAD M25
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ ISZ CNT
+ JMP .-5
+ JMS I SSDSQT
+ TAD M22
+ SZA CLA
+ JMS I MARKER
+ TAD DTA
+ SDLC
+ JMP I .+1
+WDBLKN, DBLKN /GO OUT TO WRITE DATA AND BLOCK NUMBERS FORWARD
+
+
+\f
+*2000
+DBLKN, TAD C2
+ DCA PHASE
+ TAD VAR2 /NUMBER OF BLOCKS
+
+ DCA W6
+ DCA BLK /INITIAL BLOCK IS 0
+ TAD BLK
+ JMS I MESS /COMPUTE THE COMP OBVERSE OF REV BLK
+ DCA REVBLK
+ SDLD
+ TAD DT1400 /FORWARD,WRITE,GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDRC /CHECK TO MAKE SURE WRITE IS SET
+ RTL
+ RAL
+ SMA CLA
+ JMS WLO /WRITE FAILED TO SET
+ TAD M6
+ DCA CNT
+ SDSQ /ROUTINE TO GET UP TO SPEED
+ JMP .-1
+ SDLD
+ ISZ CNT
+ JMP .-4
+ SDLD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+LINE, SDSS /WRITE ALL ZEROES TO THE FIRST BLOCK
+ JMP .-1
+ SDLD /LOAD THE DATA BUFFER
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ DCA MTR
+ TAD MTR
+ TAD M26
+ SZA CLA
+ JMP LINE
+ SDLD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMP WDOBLK /GO AND WRITE REVERSE GUARD
+WDBLK, CLA CLL /BEGINNING OF BLOCK,WRITE DATA AND BLOCK NUMBER
+ JMS W4L /WRITE EIGHT LINES
+ JMS W4L /END OF EXPAND CODE,BEGINNING OF BLK NUMBER
+ TAD BLK /GET FORWARD BLOCK NUMBER
+ JMS W4L /WRITE IT
+ CLA
+ JMS W4L /WRITE FIRST WORD OF REV GUARD
+WDOBLK, CLA
+ JMS W4L /SECOND WORD OF REVERSE GUARD
+ JMS W4L
+ JMS W4L /FIRST WORD OF REVERSE CHECKSUM
+WDATA, TAD TOTAL /NUMBER OF DATA WORDS TO BE WRITTEN
+ CIA
+ DCA W5 /SET UP COUNTER
+ JMS W4L
+ ISZ W5 /INCREMENT COUNTER
+ JMP .-2
+ CLA CLL
+ TAD MSK77 /COME BACK TO WRITE LAST WORD AND CHECKSUM
+ JMS W4L
+ CLA
+ JMS W4L /FINISH CHECKSUM
+ JMS W4L /FIRST WORD OF REVERSE LOCK
+ JMS W4L /LAST WORD OF RL. AND HALF OF GUARD
+ JMS W4L /REST OF GUARD
+ TAD REVBLK /GET REVERSE BLOCK NUMBER
+ JMS W4L
+ CLA CMA
+ JMS W4L /END OF BLOCK NUMBER AND HALF OF EXPAND CODE
+ JMS W4L /END OF EXPAND CODE
+ ISZ BLK
+ CLA
+ TAD BLK
+ JMS I MESS /COMPUTE NEW BLK NUMBER
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W6 /IS IT DONE WRITING BLK AND DATA
+ JMP WDBLK /NO
+ SDSQ
+ JMP .-1
+ SDRD
+ CLA
+ TAD DT1000 /SEARCH FOR END ZONE
+ TAD DTA /GET UNIT
+ SDLC /LOAD THE COMMAND REG
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ JMP I .+1
+ DBLOCK
+
+W4L, 0
+ SDSQ
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDLD /LOAD THE DATA BUFFER
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMP I W4L
+
+C2, 0002
+
+WLO, 0
+ TAD DTA /STOP THE TAPE
+ SDLC /LOAD THE COMMAND REGISTER
+ JMS I TYPE
+ 2003 /PC
+ 4000 /END
+ CLA CMA
+ TAD WLO
+ JMS I TYOCT
+ JMS I TYPE
+ 4040
+ 2722 /WR
+ 1124 /IT
+ 0540 /E
+ 0000 /END
+ JMP I .+1
+ ZCOM
+
+
+
+\f
+*2200
+BLCSD, TAD C4
+ DCA PHASE
+ CLA CLL
+ TAD VAR2
+ DCA W6 /SET UP FOR THE NUMBER OF BLOCKS
+ DCA BLK /SET BLK TO 0
+ TAD DT1000 /FORWARD READ
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REG
+ TAD BLK
+ JMS I MESS /CALCULATE THE COMPLEMENT OBVERSE
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD M6 /WAIT TO GET UP TO SPEED
+ DCA CNT /SET UP COUNTER
+ SDSQ /SKIP ON A QUAD LINE FLAG
+ JMP .-1
+ SDRD /READ THE DATA BUFFER TO CLEAR FLAG
+ ISZ CNT
+ JMP .-4
+ CLA
+BLCSDA, DCA CHKSUM
+ JMS I SLRDRC /READ A SINGLE LINE AT A TIME
+ TAD M26
+ SZA CLA /IS IT BLOCK MARK
+ JMP SRDRC+4 /NO,GO BACK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD DATRD
+ CIA
+ TAD BLK
+ SZA CLA
+ JMS I BLKERR /BLK NUMBER ERROR
+ JMS I SSDSQT /READ GUARD
+ JMS I SSDSQT /READ REVERSE LOCK
+ JMS I SSDSQT /READ CHECKSUM
+ SDRD /READ THE DATA BUFFER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ JMS I BCXOR /GO OUT TO CHECKSUM ROUTINE
+RDATA, TAD TOTAL /NUMBER OF WORDS PER BLOCK
+ CIA
+ DCA W5 /SET UP COUNTER
+ SDSQ
+ JMP .-1
+ SDRD /READ THE DATA BUFFER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ DCA DATRD
+ TAD DATRD /SAVE THE DATA WORD
+ SZA CLA
+ JMS I DATERR /DATA ERROR
+ TAD DATRD
+ JMS I BCXOR
+ SDST /CHECK FOR A TIMING ERROR
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W5
+ JMP RDATA+3
+ SDSQ /READ REVERSE CHECKSUM
+ JMP .-1
+ SDRD /READ IT IN
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND C7700
+ JMS I BCXOR /CHECK CHECK SUM
+ TAD CHKSUM
+ AND MSK77
+ IAC
+ TAD C7700
+ SZA CLA
+ JMS I CHKERR /CHECKSUM ERROR
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ JMS I SLRDRC /ADVANCE A SINGLE LINE FLAG
+ TAD M31 /LOOK FOR REV BLK NUMBER
+ SZA CLA
+ JMP SRDRC+4
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ TAD DATRD
+ CIA
+ TAD REVBLK /COMPARE BLOCK READ WITH ONE COMPUTED
+ SZA CLA
+ JMS I BLKERR /BLOCK NUMBER ERROR
+ SDSQ
+ JMP .-1
+ SDRD
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ CLA CLL
+ ISZ BLK
+ TAD BLK
+ JMS I MESS
+ DCA REVBLK
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ ISZ W6
+ JMP BLCSDA
+ TAD DT1000
+ TAD DTA
+ SDLC
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ JMP I .+1
+ RDBLKS
+
+C4, 0004
+
+\f
+*2400
+DBLOCK, TAD C3
+ DCA PHASE
+ CLA CLL
+ DCA DISBLK
+ TAD DT3000 /REVERSE,GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ CLA CLL
+DISLUP, SDSS
+ JMP .-1
+ CLA CLL
+ SDRD
+ DCA DISDAT /SAVE THE DATA BUFFER
+ SDRC
+ AND MSK77 /MASK OUT THE MARK TRACK
+ TAD M26 /CHECK FOR BLOCK NUMBER
+ SZA
+ JMP DISEND /NOT BLK MARK,CHECK FOR END ZONE
+ TAD DISDAT /DISPLAY THE NUMBER IN THE AC
+ ISZ DISBLK
+ JMP .-1
+ JMP DISLUP /GO SEARCH FOR THE NEXT BLOCK
+DISEND, TAD FOUR /IS IT END ZONE
+ SZA CLA
+ JMP DISLUP /NO,GO GET NEXT LINE
+ TAD DTA /STOP GET READY TO READ
+ SDLC /LOAD THE COMMAND REGISTER
+ JMP I .+1
+ BLCSD
+DISBLK, 0
+DISDAT, 0
+FOUR, 4
+C3, 0003
+C5, 0005
+
+RDBLKS, TAD C5
+ DCA PHASE
+ TAD VAR2
+ DCA W5 /SET UP FOR NUMBER OF BLOCKS
+ IAC
+ TAD VAR2
+ DCA W6 /SET UP TO CHECK BLK REVERSE
+ TAD DT3000 /READ REVERSE GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+RDBLK, SDSS
+ JMP .-1
+ SDRD /READ THE DATA BUFFER AND STORE IT AWAY
+ DCA CNT
+ SDRC
+ AND MSK77
+ TAD M26
+ SZA CLA /IS IT BLOCK NUMBER
+ JMP RDBLK
+ TAD CNT
+ TAD W6
+ SZA CLA
+ JMS I BLKERR /BLOCK NUMBER ERROR
+ IAC
+ TAD W6 /INCREMENT A NUMBER FOR COMPARE COUNTER
+ DCA W6
+ ISZ W5 /INCREMENT BLK COUNTER
+ JMP RDBLK
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ TAD DTA
+ SDLC /LOAD THE COMMAND REGISTER WITH UNIT STOP
+ IAC
+ DCA PHASE
+ JMS NUDTA
+ JMP PSER
+ JMP I .+1
+ INIT /END GO BACK TO DIRECT
+/
+/
+/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
+/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
+/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
+/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
+REPEAT, 0
+ DCA DNUM /TEM STORAGE FOR NEW DTA #
+ TAD DBUFAD /INITIALIZE POINTER (DBUFPT)
+ DCA DBUFPT /TO START OF DTA LIST
+ TAD DCTR /LOAD NUM. OF DTAS STORED
+ CMA /COMPLEMENT IT
+ DCA COMCTR /STORE IN COMPARE COUNTER
+COMCHK, ISZ COMCTR /DONE WITH ALL COMPARES?
+ JMP DOCOMP /NO: GO DO COMPARE
+ TAD DNUM /YES: STORE NEW DTA#
+ DCA I DBUFPT /AT END OF LIST
+ ISZ DCTR /INCR. # OF DTAS STORED
+ JMP I REPEAT /RETURN
+
+COMCTR, 0 /COUNTER FOR # OF LIST COMPARISONS TO BE DONE
+DCTR, 0 /COUNTER FOR # OF DTAS IN LIST
+DBUFAD, DTABUF /START OF DTA NUM. LIST
+DNUM, 0 /TEM STORAGE FOR DTA #
+/
+/
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP, TAD I DBUFPT /GET NXT DTA NUMBER PASSED
+ CIA /NEGATE IT
+ TAD DNUM /ADD IN DTA NUMBER PASSED
+ SNA CLA /ARE THEY THE SAME
+ JMP I REPEAT /YES: RETURN
+ ISZ DBUFPT /NO: INCREMENT LIST POINTER
+ JMP COMCHK /SEE IF DONE ALL COMPARES
+/
+/
+
+\f
+*2600
+
+RDFA, CLA CLL
+ TAD DT3000 /REVERSE READ GO
+ TAD DTA /GET UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDSS /SKIP ON A SINGLE LINE FLAG
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M22 /IS IT END ZONE
+ SZA CLA /YES
+ JMP .-6 /NO GO BACK AND LOOK AGAIN
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+RDFA1, TAD M26
+ DCA W3 /SET UP COUNTER TO READ 22 BLOCKS
+ TAD BADD /SET UP BUFFER ADDRESS
+ DCA X2
+ SDSS /GO SINGLE LINE FLAGS
+ JMP .-1
+ SDRD /READ THE DATA BUFFER
+ DCA CNT
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M26 /SEARCH FOR BLOCK NUMBER
+ SZA CLA
+ JMP RDFA1+4 /NOT BLOCK NUMBER YET GO BACK AGAIN
+ TAD CNT /OK BLK NUMBER STORE IT AWAY
+ DCA I X2
+ ISZ W3 /INCREMENT COUNTER
+ JMP RDFA1+4 /NOT 22 BLOCKS YET
+ TAD DTA
+ SDLC /STOP THE DTA
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT#
+
+ JMS I TYPE
+ 0424 /DT
+ 0140 /A
+ 0000 /END
+ TAD DTA /GET UNIT NUMBER
+ RTL
+ JMS I TYOCT /AND TYPE IT OUT
+ JMS I TYPE
+ 4345 /CR&LF
+ 0000 /END
+ TAD M26 /WILL TYPE ALL
+ DCA W1 /22 WORDS
+ TAD BADD /ADDRESS OF BLOCK
+ DCA X2 /NUMBERS TO INDEX
+ TAD I X2 /FIRST OR NEXT BLOCK
+ JMS I TYOCT /TYPE IT OUT
+ JMS I TYPE /CR&LF
+ 4345 /CR&LF
+ 0000 /END
+ ISZ W1 /COMPLETE
+ JMP .-6
+ JMP I IT /GO ASK FOR FORMAT
+
+RDR, CLA CLL
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ SDSS /SKIP ON A SINGLE LINE FLAG
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ AND MSK77
+ TAD M22 /CHECK FOR END ZONE
+ SZA CLA
+ JMP .-6 /NOT YET GO BACK
+ TAD DT3000 /REVERSE READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT
+ SDSS
+ JMP .-1
+ SDRC
+ CLA
+ ISZ CNT
+ JMP .-5
+ JMP RDFA1 /STORE NUMBERS IN REVERSE
+
+RETRY, JMS I TYPIN
+ JMS I COMPAR
+ 0322 /R
+ 0305 /E
+ 0324 /T
+ 0322 /R
+ 0331 /Y
+ 0000 /END
+ JMP I IT /GUESS HE DOESN'T WANT TO TRY AGAIN
+ CLA
+ TAD DT1000 /FORWARD READ GO
+ TAD DTA /UNIT
+ SDLC /LOAD THE COMMAND REGISTER
+ TAD M6
+ DCA CNT /WAIT 6 LINES
+ SDSS
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ ISZ CNT
+ JMP .-4
+ SDSS
+ JMP .-1
+ SDRC
+ AND MSK77
+ TAD M22
+ SZA CLA
+ JMP .-6
+ TAD DT3000
+ TAD DTA
+ SDLC
+ CLA IAC
+ DCA PHASE
+ JMP I .+1
+ PSER+11
+
+
+\f
+*3000
+
+
+SDSQT, 0
+ SDSQ /ADVANCE SIX LINES
+ JMP .-1 /SKIP ON QUAD LINE FLAG
+ SDRC /READ COMMAND REGISTER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1 /SKIP ON SINGLE LINE FLAG
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC /READ THE COMMAND REGISTER
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77 /SAVE THE MARK TRACK LAST 6 BITS
+ DCA MTR
+ TAD MTR
+ JMP I SDSQT
+
+A3LNS, 0 /ADVANCE THREE LINES
+ SDSS
+ JMP .-1 /SKIP ON SINGLE LINE FLAG
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ SDSS
+ JMP .-1
+ SDRC
+ SDST
+ SKP
+ JMS I SELTIM /TIMING ERROR
+ AND MSK77
+ DCA MTR
+ TAD MTR
+ JMP I A3LNS
+
+CEXPC, 0
+ TAD MTR
+ TAD M52
+ SZA CLA
+ JMS I MARKER /MARK TRACK ERROR
+ JMS A3LNS /READ THREE MORE LINES
+ TAD M25 /IS IT 25 NOW
+ SZA CLA
+ JMS I MARKER /NO ,MARK TRACK ERROR
+ JMP I CEXPC /YES:IT IS EXPAND CODE NUMBER 1
+
+ /SIXBIT COMPLEMENT XOR SUBROUTINE
+ /SUBROUTINE IS ENTERED WITH DATA WORD TO BE XORED IN AC
+ /TWO SIX-BIT COMPLEMENT XORS WILL TAKE PLACE TO LOC CHKSUM
+ /WITH THE RESULT IN CHKSUM
+
+SBCXOR, 0
+ CMA /COMPLEMENT WORD
+ DCA SBWORD /AND SAV
+ TAD SBWORD
+ AND CHKSUM
+ CIA
+ CLL RAL
+ TAD SBWORD
+ TAD CHKSUM
+ DCA CHKSUM
+ TAD SBWORD
+ RTR CLL;RTR;RTR
+ DCA SBWORD
+ TAD SBWORD
+ AND CHKSUM
+ CIA
+ CLL RAL
+ TAD SBWORD
+ TAD CHKSUM
+ AND MSK77
+ DCA CHKSUM
+ JMP I SBCXOR
+
+SRDRC, 0
+ SDSQ
+ SKP
+ JMP .+3
+ SDSS
+ JMP .-1
+ SDRD
+ DCA DATRD
+ SDRC
+ AND MSK77
+ JMP I SRDRC
+
+NUDTA, 0
+ TAD I LSTPT /GET CURRENT VALUE OF DATA LIST PTR
+ DCA TBUFPT /STORE IT AS TEM,BUF,PTR
+ TAD I TBUFPT /GET A DTA # FROM THE LIST
+ AND C0007
+ SZA CLA /IS IT A 7777
+ JMP LSTEND /YES END OF LIST
+ TAD I TBUFPT /NO;GET IT BACK
+ DCA DTA
+ ISZ I LSTPT /INCREMENT LIST POINTER
+ JMP I NUDTA /RETURN
+/COME HERE AT END OF LIST TO RESET POINTERS AND RETURN TO CALL+2
+LSTEND, ISZ NUDTA /INCREMENT RETURN POINTER
+ TAD I STRTPT /GET ADR OF START OF LIST
+ DCA I LSTPT
+ JMP NUDTA+1 /GO GET FIRST DTA# AND RETURN
+STRTPT, DBUFAD /POINTER TO START OF DATA LIST
+TBUFPT, 0 /TEM STORAGE FOR BOT PTR
+LSTPT, DBUFPT /POINTER TO CURRENT VALUE OF DTA LIST PTR
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+BINCON, .+1
+ 0001
+ 0012
+ 0144
+ 1750
+DTABUF, 0
+
+
+
+
+\f
+*3200
+ /CHECK SWITCH TO SEE IF SET TO WTM POSITION
+SWCHK, JMS I TYPE /TYPE OUT MESSAGE
+ 2305 /SE
+ 2440 /T
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4024 /T
+ 1740 /O
+ 2724 /WT
+ 1500 /M
+ JMS I TYPIN /WAIT FOR CR
+ CLA
+ DCA CNTERL
+ SDLD /CLEAR SINGLE AND QUAD FLAGS
+ SDSS
+ SKP
+ JMP .+4
+ ISZ CNTERL
+ JMP .-4
+ JMP SWCHER /ERROR,TYPE ERROR MESSAGE AND GO TO SWCHK
+ /SEE IF THE DRIVE IS OK
+RSTSM, SDLC /LOAD CR TO CLEAR TIMEING ERROR
+ SDLD /LOAD DATA BUFFER TO CLEAR S Q FLAGS
+ TAD DT0400 /SET WRITE
+ TAD DTA /GET UNIT
+ DCA SAV /STORE IT AWAY
+ TAD SAV
+ SDSS
+ JMP .-1
+ SDLC
+ TAD SAV
+ SDLC /LOAD THE TRANSPORT
+ SDRC /READ THE COMMAND REGISTER AND CHECK IT
+ RTL
+ RAL
+ SMA /CHECK WRITE TO BE SET
+ JMP ERCHK /WRITE IS NOT SET
+ RAL /CHECK WLO
+ SPA
+ JMP ERCHK /WLO
+ RAL /CHECK SELECT AND TIMING ERROR
+ SPA CLA
+ JMP ERCHK /SELECT OR TIMING ERROR
+ JMS NUDTA /CHECK OTHER DRIVE IF ANY
+ JMP RSTSM-11 /CHECK OTHER DRIVE
+ JMP I .+1
+ STMK
+CNTERL, 0
+SAV, 0
+
+ERCHK, JMS I TYPE /INCORRECT SETUP
+ 2305 /SE
+ 2425 /TU
+ 2077 /P
+ 0000 /END
+ JMP I .+1
+ START
+
+SWCHER, JMS I TYPE
+ 2327 /SW
+ 1124 /IT
+ 0310 /CH
+ 4016 /N
+ 1724 /OT
+ 4023 /S
+ 0524 /ET
+ 4024 /T
+ 1740 /O
+ 2724 /WT
+ 1540 /M
+ 1722 /OR
+ 4023 /S
+ 1116 /IN
+ 0714 /GL
+ 0540 /E
+ 1411 /LI
+ 1605 /NE
+ 4006 /F
+ 1401 /LA
+ 0740 /G
+ 0601 /FA
+ 1114 /IL
+ 0504 /ED
+ 4024 /T
+ 1740 /O
+ 2305 /SE
+ 2440 /T
+ 4543 /CR LF
+ 0000 /END
+ JMP SWCHK
+
+SWOFF, CLA
+ DCA CNTERL
+ SDLD /CLEAR ANY FLAGS THAT ARE SET
+ SDSS
+ SKP
+ JMP OFF /FLAG SHOULDN'T BE SET
+ ISZ CNTERL
+ JMP .-4
+ CLA
+ JMP I .+1
+ PSER
+
+
+*3400
+/INPUT BUFFER FOR TELETYPE THIS MUST BE AT THE END OF PROGRAM
+
+BUFFER, 0
+
+$
--- /dev/null
+/56 CCL FOR OS/8 V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1976,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f MOFILE=7600
+ MIFILE=7617
+ MPARAM=7643
+
+ XR2=15
+ XR=16
+ TXR=17
+ AMFLAG=17
+ T=20
+ TT=21
+ DEF=22
+ NAME1=23
+ NAME2=24
+ NAME3=25
+ NAME4=26
+ NMBASE=27
+ DEV1=30
+ DEV2=31
+ DELIM=32
+ DEFALT=33 /POINTS TO DEFAULT EXTENSION LIST
+ LXR=34
+ CLXR=35
+ PTR=36
+ DATWD=7666
+ BATERR=7000 /JMP HERE TO ABORT BATCH
+ BATOUT=7400 /JMS HERE TO PRINT ON BATCH LOG
+ BATSPL=7200 /JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC
+ OS78BIT=7771
+
+ BEGLN=1000
+
+/CCL STARTING ADDRESS: 12000
+/STARTING ADDRESS: 12001
+/CHAIN STARTING ADDRESS:12002
+
+/ JOB STATUS WORD = 2003
+
+/**************************************************
+/
+/ SAVING CCL
+/
+/ .LOAD CCL
+/ .SAVE SYS CCL;12001=2103
+/ .R CCL
+/
+/**************************************************
+
+ CCLSW=435
+ DEASADR=427
+ PRQMRK=1357
+ GETCCL=1362
+ OV=1375
+ MSOVL2=55
+
+ CCLBLK=67 /BLOCK ON SYS: USED BY CCL
+ CCLTAB="G /MUST BE UPDATED IF TABLES CHANGE
+ CCLNUM="1
+ CCLVER="F /CCL VERSION #
+
+/*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY.
+/USE OF SEMICOLONS WITH CCL VERSION I OR LATER
+/REQUIRES BATCH VERSION 7 OR LATER.
+/USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER
+
+ HNDLR=4400
+ BFR=5000
+
+/MEMORY ALLOCATION:
+
+/0 4400-4777 INPUT HANDLER FOR CD
+/ ALSO, SEMICOLON BUFFER
+/0 5000-5177 PRE-EXTENSION @ BUFFER
+/0 5200-5577 @ BUFFER
+/0 1000-1777 /COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK]
+/0 2000-2777 /LINE BUFFER EXTENSION
+\f/ CHANGES SINCE FIELD RELEASE VERSION:
+
+/1. RECURSIVE 'U' BUG FIXED
+/2. INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED
+/3. BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED
+/4. .SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE
+/5. COMPARE PASSES ALTMODE
+/6. TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP
+/7. BUG RE PASSING DEFAULT * FIXED
+/8. .LS FORM OF .CREF COMMAND REMOVED
+/9. BUG CONCERNING PROCESSOR SWITCHES FIXED
+/10. CCL SWITCH ALLOWED AFTER =N OPTION
+/11. BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED
+/12. EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT
+/13. 'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY
+/14. 'BAD CCL SWITCH' MESSAGE ADDED
+/15. CCL EDIT # CHANGED TO CCL VERSION #
+/16. .EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES
+/17. MUNG PTR: NOW WORKS
+/18. FIXED BUG RE MUNG <CR>
+/19. FIXED BUG RE CD FOR FILE > 2047 BLKS
+/20. FIXED BUG RE MAKE PTR:
+
+/VERSION B FIXES:
+
+/21. ALLOWED 'EDIT' TO COPY FILE EXTENSION
+/22. FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE
+/23. FIXED DATE PROBLEM
+/24. ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED
+
+/VERSION C FIXES:
+
+/25. FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT
+/26. ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE
+/ AS IN DEVICE (IF NONE SPECIFIED)
+/27. ADDED MORE SYNTAX CHECKING TO ZERO COMMAND
+
+/VERSION D CHANGES:
+
+/28. ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' .
+
+/VERSION E CHANGES: (IN-HOUSE ONLY VERSION)
+
+/29. WARNING MSG IF SQUISH SYS: UNDER BATCH
+/30. ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS <
+/31. ADDED HOOKS FOR ; TO BE READY FOR V4
+/32. FIX BUG RE CMD STARTING WITH SPACES
+
+/CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C):
+
+/33. FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC
+/34. INCORPORATED ALL PREVIOUS EDITS
+/35. ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED)
+/36. FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1:
+/37. CORRECTED SPELLING OF SUPERSEDING
+/38. ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS]
+
+/VERSION G CHANGES:
+
+/39. FIXED BUG WITH HELP COMMAND
+/40. FIXED BUG CONCERNING EDIT DEV:_FILE
+
+/VERSION H CHANGES:
+
+/41. ADDED MAC AND LINK COMMANDS
+/42. ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS
+/43. ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS
+/44. ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING
+/45. ALLOWED @ AT BEGINNING OF LINE
+/46. MOVED MOST OF 'DETCOR' TO FIELD 0
+/47. WAIT ROUTINE NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC
+/48. ALLOWED EXEC .BI TO USE BATCH
+/49. TENTATIVELY ADDED SEMICOLON STUFF
+/50. PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH
+
+/VERSION I CHANGES:
+
+/51. FIRMED UP SEMICOLON STUFF
+
+/VERSION J CHANGES:
+
+/52. DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS:
+/53. -L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME
+
+/VERSION K CHANGES:
+
+/54. DATE NOW HANDLES DATE/78 ALGORITHM
+/55. TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG
+
+/VERSION 1A CHANGES:
+
+/56. FIXED BUG RE NULL INDIRECT CMD FILE
+/57. FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM
+/58. PRINT "OS78" FOR VERSION NAME IF APPLICABLE
+/59. ADDED -N AND -D AND REWROTE LOGIC A BIT
+/60. HELP COMMAND NOW USES HELP.SV
+/61. SET COMMAND NOW USES SET.SV
+/62. 'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD
+/63. ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH)
+/64. ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE)
+/65. ADDED DUPLICATE COMMAND (USES RXCOPY)
+
+/V1B CHANGES:
+
+/66. MODIFIED FORMAT OF MAIN TABLE
+/67. GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT
+/ FILE (EVEN IF NON-FS)
+/68. PRINT KBM VERSION #
+/69. ADDED TERMINATE COMMAND
+
+/V1F CHANGE:
+
+/70. DUPL CALLS RXCOPY IN SPECIAL MODE
+\f/ FORMAT OF CCL TABLE
+
+/ENTRY PURPOSE
+
+/ TABLE WIDTH=7 (BUT VARIES)
+
+/0 FLAG WORD
+
+ /BIT MEANING IF ON
+
+ /0 PERFORM CD (IF 0, OMIT ENTRIES 1-6)
+ /1 DON'T PERMIT SPOOLING
+ /2 ALLOW .LS, .NB, .MP SWITCHES
+ /3 ADD _ TO END OF COMMAND STRING
+ /4 SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON)
+ /6-8 SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1)
+ / 0 MEANS NONE. 7 RESERVED FOR SPECIAL USE.
+ /10 CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME
+ /11 WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1)
+
+/1 PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES.
+/ IF PTS TO 0, NONE. IF PTS TO 5200, USE SPECIAL MODE.
+
+/2-4 DEFAULT SWITCHES TO BE OR'ED INTO THOSE
+/ EXPLICITLY GIVEN.
+
+/5 ADDRESS OF SUBROUTINE TO BE CALLED
+/ AFTER C.D. HAS BEEN DONE. 0 IF NONE.
+
+/6 PTR TO FILENAME OF PROGRAM
+/ TO BE CHAINED TO. 0 IF NONE.
+
+/ FIELD 0
+
+/1000-1777 LINE BUFFER
+/2000-2777 LINE BUFFER EXTENSION
+/4000-4377 REM-LINES
+/4400-4777 HANDLER
+/5000-5577 BUFFER
+/6000-7577 MORE CCL (7 PAGES)
+
+ REST=6000
+\f FIELD 1
+
+ *2000
+
+ FAKBM=404 /PLACE TO FAKE OUT KBM
+
+START, JMP .+3 /START FROM MONITOR
+ JMP (CCLBLC /START FROM .RUN COMMAND
+ /THIS LITERAL IS AT END OF PAGE
+ JMP MONCHN /START WHEN CHAINED TO
+ CLA
+ CDF 0 /READ IN REST OF CCL
+ TAD I (CCLBLC /GET BLOCK OF START
+ CDF 10
+ TAD CCLREM
+ DCA CCLREM /GET BLOCK OF REST
+ CIF 0
+ JMS I (7607
+ 700 /READ 7 MORE PAGES
+ REST
+CCLREM, 1+14+1 /SKIP CCB AND *400 STUFF
+ JMP ERR2
+ JMS TWAIT
+ CDF 0
+ TAD I LVNO
+ CDF 10
+ TAD (-CCLTAB /DO VERSION #'S AGREE?
+ SZA CLA
+ JMP BADVNO
+PREGO, JMS I (AT
+ STA
+ DCA I (REMD /ALLOW RECURSIVE U'S
+ CDF 0
+ TAD I KENTRY /GET ENTRY #
+KCIDF, CIF CDF 10
+ TAD (PTBL /GET ADDRESS OF PTR TO START OF ENTRY
+ DCA PTR
+ TAD I PTR /GET PTR TO START OF ENTRY
+ DCA PTR
+ JMP I (GOO
+MONCHN,
+KCIF, CIF 0
+ JMS I (7607 /READ IN KBM
+ 1000 /4 BLOCKS
+ 0 /0-1777
+ 7 /BLOCK 7 ON SYS:
+ HLT /NO WAY TO RECOVER (EVEN 7605 DOES THIS)
+ TAD (-44
+ JMS I (MOVE /ASSUME COMMAND LINE IS IN
+ CDF 10 /17600-17643
+ 7600
+ CDF 0
+ 1000 /MOVE TO OS/8 LINE BUFFER
+ CIF CDF 0
+YAT, JMP I KFAKBM /@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO')
+ TAD I (ASSIGN /'YAT' IS JMS'ED TO
+ SNA CLA /BY INITIAL @ COMMAND
+ JMP I (LEAVE /DO NOTHING IF NO @ GOT EXPANDED (NULL LINE)
+REGO, CIF 0
+ JMS I (7607
+ 200 /READ ONE BLOCK
+ 400 /400-777
+ 10 /RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY
+ HLT
+ JMP I (FAKE
+
+/REGO, TAD KCIDF
+/ CDF 0
+/ DCA I (RETCIF /ALLOW 'FINDIT' TO RETURN TO FIELD 1
+/ CIF CDF 0
+/ STA
+/ DCA I (HALF
+/ DCA I (ENTRY
+/ TAD (KEYWRD
+/ DCA I (KPTR
+/ JMS I (FINDIT /LOOK UP KEYWORD
+/ SMA CLA
+/ JMP PREGO /FOUND IT
+/CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD
+/ ERRCMD
+\fERR2, CIF CDF 0
+ JMP I (NOCCL
+
+BADVNO, JMS I (PRINT
+ BADVMS
+ JMS I (VERTN
+ JMP I (LEAVE /GO AWAY
+\f/TEST END OF TABLE
+
+USRSUB, 0
+ TAD I (REMD
+ SMA CLA
+ JMP REGO /REMEMBERED A NEW LINE
+ TAD I (FLAG /WANT TO
+ AND (70
+ CLL RTR
+ RAR
+ TAD (-1 /IN THIS REM-LINE
+ DCA UREM
+ JMS I (FOREVER /NO DATE
+ JMS I (REMEM
+UREM, 0
+ JMP I USRSUB
+\fTWAIT, 0
+ DCA WFL
+ JMS BATCH
+ JMP TW /BATCH NOT RUNNING
+ CLA /WE'RE RUNNING UNDER BATCH
+ JMP I TWAIT
+TW, TSF
+ SKP /WAIT FOR THINGS TO QUIET DOWN
+ JMP I TWAIT
+LVNO, AND I 0 /WASTE SOME TIME
+KFAKBM, AND I 4
+KENTRY, 600
+ ISZ WFL
+ JMP TW
+ JMP I TWAIT /CAN'T WAIT TOO LONG
+WFL, 0
+
+/SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC
+
+BATCH, 0
+ CDF 0
+ TAD I (7777
+ CDF 10
+ DCA BWORD
+ TAD BWORD
+ RTL
+ SNL CLA /IS BATCH RUNNING?
+ JMP I BATCH /NO
+ TAD BWORD /YES
+ AND (70 /ISOLATE FIELD OF BATCH
+ TAD KCIF /FORM CIF TO THE HIGHEST FIELD
+ ISZ BATCH /AND TAKE SKIP RETURN WITH IT IN AC
+ JMP I BATCH
+\fBWORD, 0
+ PAGE
+\f/WE FALL INTO THIS FROM LITERAL ON PREVIOUS PAGE
+MONFIX, JMS I (RDMON
+ CDF 0
+ TAD I ZERO
+ TAD (-7607
+ SNA CLA
+ JMP I PCCER3 /ALWAYS WRITE OUT CCL BLOCK
+ CDF 10
+ CIF 0
+ JMS I L7607
+ 4200 /WRITE 1 RECORD FROM FIELD 0
+ 400 /LOCATIONS 400-777
+ CCLBLK /INTO THE SYSTEM'S CCL BLOCK
+ JMP I (IOERR
+ CDF 0
+ TAD I (2000+CCLSW
+ TAD (-PRQMRK
+ SNA
+ JMP MONOK
+ TAD (PRQMRK-GETCCL
+ SZA CLA
+ JMP I PCCER3
+/ CIF CDF 0
+/ JMP I L7605
+MONOK, TAD (GETCCL
+ DCA I (2000+CCLSW
+ STA
+ DCA I (2000+DEASADR /DELETE DEASSIGN
+ JMS WRMON
+ JMS I (LOOK
+ YFORT /LOOK FOR FORT.SV
+ TAD (YF4-YFORT /NOT FOUND, USE F4
+ TAD (YFORT /FOUND USE IT
+ DCA I (FORTE
+ TAD I (FORTE
+ TAD (-YFORT
+ SZA CLA
+ TAD (YLOAD-YLOADER /F4
+ TAD (YLOADER
+ DCA I (LOADE
+ JMP I (WRITFT /UNKLUTZ
+\fL200,
+WRMON, 200
+ CDF 10
+ CIF 0
+ JMS I L7607
+ 4200
+L2400, 2400
+ 10
+ JMP I (IOERR
+ JMP I WRMON
+\fMONRES, 0
+ JMS I (RDMON
+ CDF 0
+ TAD (PRQMRK
+ DCA I (2000+CCLSW
+ TAD (-405
+ DCA I (2000+DEASADR
+ JMS WRMON
+ JMP I MONRES
+
+L7605,
+SETLPT, 7605 /COULD BE ONCE ONLY
+ TAD KLPTDEV
+ JMS SETDEV
+ JMP I SETLPT
+
+L7607, 7607
+
+M7607,
+SETTTY, -7607
+ TAD KTTYDEV
+ JMS SETDEV
+ JMP I SETTTY
+
+PCCER3,
+SETPTP, CCER3
+ TAD (PTPDEV
+ JMS SETDEV
+ JMP I SETPTP
+
+ZERO, /STAYS 0 FOR A WHILE
+SETDEV, 0 /V1A ARG NOW IN AC
+ DCA DEVPTR
+ CLL STA RAL /-2
+ JMS I (MOVE
+ CDF 0
+DEVPTR, LOC78
+ CDF 10
+ DVNM1
+ JMS I (SETOUT
+ JMP I SETDEV
+
+P4, SETDEV
+KLPTDEV,LPTDEV
+
+P5, SETDEV
+KTTYDEV,TTYDEV
+\fFAKE, CIF CDF 0
+ TAD (MSOVL2
+ DCA I (OV /RESTORE LOC SO DATE CMD W ARGS WILL WORK
+ JMP I (FAKBM
+
+PTCH, CDF 0
+ DCA I (VLOC
+ TAD I (OS78BIT
+ AND (200 / 78
+ SZA CLA / OR
+ TAD (1000 / /8
+ TAD (5770
+ DCA I DEVPTR
+ CDF 10
+ JMS I (PRMESG
+ VMES
+ PAGE
+\f COLWRD /NEEDED BY SET
+GO, JMS I (SCAN /ADVANCE SCAN UNTIL AFTER SPACES
+GO2, TAD I PTR /GET FLAG
+ DCA FLAG /SAVE IT
+ TAD DELIM
+ SNA CLA /IS TYPED LINE EMPTY AFTER KEYWORD?
+ TAD FLAG /AND IS SPECIAL REMEMBERING BITS ON?
+ CLL RTR
+ RAR /AND HAS GOD WILLED US TO REMEMBER?
+ AND (7 /AND ARE THE ZODIAK SIGNS FAVORABLE?
+ SNA
+ JMP NORM /NO
+ TAD REMD /YES, GET REM-LINE (SUBTRACT 1)
+ DCA REMD
+ CDF 0
+ TAD I (BEGLN
+ CDF 10
+ DCA NMPTR
+ JMS I (RECALL /RECALL LINE
+REMD, -1 /-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE
+ DCA DEPN /SAVE DEPENDENT INFO
+ TAD NMPTR
+ SZA CLA /EG COMMAND?
+ JMP NORM /NO
+ ISZ DELIM /YES
+ TAD DEPN
+ DCA PTR /RESET PTR FROM CMD DEPENDENT WORD
+ JMP GO2
+\fNORM, TAD FLAG
+L7700, SMA CLA
+ JMP CHAINN /SKIP ENTRIES IF NO CD
+ ISZ PTR /POINT TO DEFAULT INPUT EXTENSION
+ TAD I PTR /GET DEFAULT INPUT EXTENSION PTR
+ DCA DEFALT /SAVE IT
+ TAD (7641
+ DCA XR
+ TAD FLAG
+ JMS I (GAMFLG
+ DCA I XR /STORE AWAY IN C.D. OPTION TABLE
+ DCA I XR /V3D ZERO OPTION WORDS
+ DCA I XR
+ DCA I XR
+ DCA I XR /ZERO L.O. =
+STOLUP, ISZ PTR
+ TAD I PTR
+ SNA
+ JMP STODON
+ DCA NTEMP
+ ISZ PTR
+ TAD I PTR /GET VALUE
+ DCA I NTEMP /STORE IN SPECIFIED LOCATION
+ JMP STOLUP
+STODON, TAD FLAG
+ AND (400
+ SZA CLA
+ JMS I (INSARR /INSERT BACK ARROW IF FLAG BIT SET
+ JMS I (CD /PERFORM COMMAND DECODE IF FLAG BIT
+ /0 SET
+CHAI, TAD FLAG
+ RAL
+ SMA CLA /IS SPOOLING PROHIBITED?
+ JMS I (SPOOLIT /NO
+CHAINN, ISZ PTR /POINT TO AFTER CD SUBR
+ TAD I PTR /GET SUBR ADDRESS
+ JMS I (JMSUB
+ TAD I (DEFILE
+ SZA /IS THERE A FILENAME SET TO CHAIN TO?
+ JMP ZOW /YES
+ ISZ PTR /NO, POINT TO FILENAME
+ TAD I PTR
+ SNA
+ JMP I (LEAVE /NO FILE TO CHAIN TO
+ZOW, DCA NMPTR
+ JMS LOOK /LOOKUP FILE
+NMPTR, 0
+ JMP I (CCER1 /NOT FOUND
+CHAIN, JMS I (200 /CHAIN TO IT
+ 6 /CHAIN
+DEPN, /REM LINE DEPENDENT INFO
+BLK, 0
+/ -----
+\f/LOOK, LOOKS UP FILE ON DEVICE . POINTER IS IN ARG1
+/ ARG2 IS ERROR RETURN IF NOT FOUND
+/DEVICE NUMBER IS IN AC. IF 0, USE SYS:
+
+LOOK, 0
+ SNA
+ IAC
+ DCA DEV
+ TAD I LOOK /GET PTR TO FILE NAME IN FIELD 0
+ DCA HISFIL
+ TAD HISFIL
+ AND L7700
+ SNA CLA
+ JMP FLD1 /PTR LT 100 MEANS IN FIELD 1
+ TAD (-3
+ JMS I (MOVE /MOVE IT UP
+ CDF 0
+HISFIL, 0
+ CDF 10
+PFILDMY,FILDMY
+ TAD PFILDMY
+SETN, DCA NAMPTR /STORE AWAY PTR TO FILENAME
+ ISZ LOOK /POINT TO ERROR RETURN
+ TAD DEV /GET DEVICE NUMBER
+ JMS I (200
+ 2 /LOOKUP
+NTEMP,
+NAMPTR, 0
+ 0
+ JMP I LOOK /TAKE ERROR RETURN IF NOT FOUND
+ TAD NAMPTR /STORE STARTING BLOCK # IN 'BLK'
+ DCA BLK
+ ISZ LOOK /POINT TO NORMAL RETURN
+ JMP I LOOK /RETURN
+\fFLAG, 0
+DEV, 0
+
+FLD1, TAD HISFIL
+ JMP SETN
+ PAGE
+\fXEXE, 5033; EXTEXE; 7643;40;0; EXSUB; YPAL8 /EXECUTE MUST BE FIRST FOR TECO EG
+XBAC, 0; TRMSUB; YCAMP /BACKSPACE (OR TERMINATE)
+ /MUST BE 2ND FOR OS78
+XBAS, 0; BASUB; YBASIC /BASIC
+XDUPL, 4001; STAR; 0; 0; YRXCOP /DUPLIC
+XBOO, 0; 0; YBOOT /BOOT
+XCCL, 0; MONRES; 0 /CCL
+XCOMPA, 4001; EXTNUL; 0; SETTTY; YSRCCOM /COMPARE
+XCOMPI, 5033; EXTCOM; 0; EXSUB; YPAL8 /COM
+XCOP, 4001; STAR; 7643;1;0; MOVRT; YFOTP /COPY
+XCOR, 0; DETCOR; 0 /MEMORY
+XCREA, 4400; EXTNUL; 0; CRSUB; YEDIT /CREATE
+XCREF, 4002; EXTCF; 7643;1000;0; 0; YPAL8 /CREF
+XDAT, 0; DATE; 0 /DATE
+XDEL, 4001; STAR; 7643;401;0; KILRT; YFOTP /DELETE
+XDEA, 0; DEASSIG;0 /DEASSIGN
+XDIR, 4001; STAR; 7646;COLWRD,0;0;SETTTY; YDIRECT /DIRECT
+XEDI, 5220; EXTNUL; 0; EDSUB; YEDIT /EDIT
+XEOF, 0; 0; YCAMP /EOF
+XHEL, 4001; STAR; 7644;20;0; SETTTY; YHELP /HELP
+XLINK, 5033; EXTLI; 0; EXSUB; YLINK /LINK
+XMAC, 5033; EXTMA; 0; EXSUB; YMACREL /MAC
+XLIS, 4001; STAR; 7644;10;0; SETLPT; YFOTP /LIST
+XLOA, 5031; EXTLO; 0; EXSUB; YABSLDR /LOAD
+XMAK, 0; MAKSUB; YTECO /MAKE
+XMAP, 4001; EXTBN; 0; SETTTY; YBITMAP /MAP
+XMUN, 0; MNGSUB; YTECO /MUNG
+XPAL, 5033; EXTPA; 0; EXSUB; YPAL8 /PAL
+XPRI, 4000; STAR; 0; SETLPT; YLPTSPL /PRINT
+XPUN, 4001; EXTNUL; 0; SETPTP; YPIP /PUNCH
+XREN, 4001; STAR; 7643;1;7644;100;0;RENRT;YFOTP /RENAME
+XRES, 4001; EXTSY; 0; SETTTY; YRESORC /RESOURCES
+XREW, 0; 0; YCAMP /REWIND
+XSET, 0; 0; YSET /SET
+XSKI, 0; 0; YCAMP /SKIP
+XSQU, 4001; EXTNUL; 7644;40;0; SQSUB; YPIP /SQUISH
+XSUB, 4000; EXTBI; 0; 0; YBATCH /SUBMIT
+XTEC, 10; TECSUB; YTECO /TECO
+XTYP, 4001; STAR; 7644;10;0; SETTTY; YFOTP /TYPE
+XUNL, 0; 0; YCAMP /UNLOAD
+XUA, 40; USRSUB; 0 /UA
+XUB, 50; USRSUB; 0 /UB
+XUC, 60; USRSUB; 0 /UC
+XVER, 0; VERTN; 0 /VERSION
+XZER, 4401; EXTNUL; 7645;2000;0; ZERSUB; YPIP /ZERO
+XAT, 0; YAT; 0 /@
+ ZBLOCK 13
+
+GAMFLG, 0
+ CDF 0
+ TAD I PAMFLAG /COMBINE ALTMODE BITS
+ CDF 10
+ RAR /IN POSITION 11
+ CLA RAR /PUT NEW ALTMODE BIT ALONE IN BIT 0
+ JMP I GAMFLG
+PAMFLAG,AMFLAG
+\fTRMSUB, 0
+ CDF 0
+ TAD I POS78
+ CDF 10
+ AND R200
+ SNA CLA
+ JMP I TRMSUB /BACKSPACE, NOT TERMINATE
+ 6073
+ 6002
+ CLA /JUST IN CASE WE'RE NOT ON A VT-78
+ JMS I PPRM
+ BADEV
+POS78, OS78BIT
+R200, 200
+PPRM, PRMESG
+\fPTBL, XEXE
+ XBAC
+ XBAS
+ XDUPL
+ XBOO
+ XCCL
+ XCOMPA
+ XCOMPI
+ XCOP
+ XCOR
+ XCREA
+ XCREF
+ XDAT
+ XDEL
+ XDEA
+ XDIR
+ XEDI
+ XEOF
+ XHEL
+ XLINK
+ XMAC
+ XLIS
+ XLOA
+ XMAK
+ XMAP
+ XMUN
+ XPAL
+ XPRI
+ XPUN
+ XREN
+ XRES
+ XREW
+ XSET
+ XSKI
+ XSQU
+ XSUB
+ XTEC
+ XTYP
+ XUNL
+ XUA
+ XUB
+ XUC
+ XVER
+ XZER
+ XAT
+ ZBLOCK 4
+\fSTAR, 5200; 0
+ 0; 0
+
+
+EXTSY, 2331; 0
+ 0; 0
+EXTBI, 0211; 0
+ 0; 0
+EXTCF, 2001; COMPA
+/EXTLS, 1423; COMLS
+ 0; COMPA
+EXTMA, 1501; COMMA
+ 0; COMMA
+EXTPA, 2001; COMPA
+ 0; COMPA
+EXTBN, 0216; 0
+ 0; COMBN
+/EXTHL, 1014; 0
+/ 0; 0
+EXTNUL, 0; 0
+EXTLO, 0216; COMBN /BN
+ 2214; COMRL /RL
+EXTLI, 2202; COMRB /RB
+ 0; 0
+EXTCM, 0315; 0
+ 0; 0
+\fEXTEXE, 2001; COMPA /PA
+ 0624; COMFT /FT
+ 0201; COMBA /BA
+ 1501; COMMA /MA
+ 0216; COMBN /BN
+ 2214; COMRL /RL
+ 2201; COMRA /RA
+ 2302; COMSB /SB
+ 2202; COMRB /RB
+ 1404; COMLD /LD V3C
+ 0211; COMBI /BI
+ 0; 0
+ ZBLOCK 4
+EXTCOM, 2001; COMPA /PA
+ 0624; COMFT /FT
+ 1501; COMMA /MA
+ 0201; COMBA /BA
+ 2201; COMRA /RA
+ 2302; COMSB /SB
+ 0; 0
+ ZBLOCK 4
+ IFZERO .&7600-3200 <PAGE>
+\fCOMBN, 0
+ JMS USUAL
+ 0216
+ YABSLDR
+ JMP I COMBN
+
+COMRL, 0
+ JMS USUAL
+ 2214
+LOADE, YLOAD /MAY BECOME YLOADER
+ JMP I COMRL
+
+COMPA, 0
+ JMS USUAL
+ 2001
+ YPAL8
+ JMP I COMPA
+
+COMFT, 0
+ JMS USUAL
+ 0624
+FORTE, YF4 /COULD BE CHANGED TO YFORT BY .R CCL
+ JMP I COMFT
+
+COMBA, 0
+ JMS USUAL
+ 0201
+ YBCOMP
+ JMP I COMBA
+
+COMRA, 0
+ JMS USUAL
+ 2201
+ YRALF
+ JMP I COMRA
+\fCOMSB, 0
+ JMS USUAL
+ 2302
+ YSABR
+ JMP I COMSB
+
+COMRB, 0
+ JMS USUAL
+ 2202
+ YLINK
+ JMP I COMRB
+
+COMMA, 0
+ JMS USUAL
+ 1501
+ YMACREL
+ JMP I COMMA
+
+COMBI, 0
+ JMS USUAL
+ 0211
+ YBATCH
+ JMP I COMBI
+
+COMLD, 0
+ JMS USUAL
+ 1404
+ YFRTS
+ JMP I COMLD
+\fDEFILE, 0 /PTR TO FILENAME TO CHAIN TO
+
+/COMLS, 0
+/ TAD I (EXTLS
+/ DCA SETEXT
+/ TAD (YCREF
+/ DCA DEFILE
+/ ISZ I (DONB /CREF FOO.LS MAKES NO BINARY
+/ JMP I COMLS
+
+RDMON, 0
+ CDF 10
+ CIF 0
+ CLA
+ JMS I (7607
+ 0400 /READ 2 RECORD
+ 2000 /LOCATION 2000 FIELD 0
+ 7 /BLOCK 7,10
+ JMP I (IOERR
+ JMP I RDMON
+
+USUAL, 0
+ TAD I USUAL
+ DCA SETEXT
+ ISZ USUAL
+ TAD I USUAL
+ DCA DEFILE
+ ISZ USUAL
+ JMP I USUAL
+\fUNKN, 0
+ TAD SETEXT
+ SZA
+ TAD T /NEG OF SWITCH REQUEST
+ SZA CLA
+ JMP I (CCERA /CAN'T HAVE 2ND DEFAULT EXTENSION
+ TAD T
+ CIA
+ DCA SETEXT /SET DEFAULT EXTENSION
+ TAD DEFALT /SEE IF IT'S IN COMMAND'S SEARCH LIST
+ DCA DEF
+ TAD SETEXT
+ JMS I (EXTLUK
+ SNA CLA /DID WE FIND IT?
+ JMP I (CDER4 /NO
+ ISZ DEF /YES
+/ TAD I (JMSUB /ALLOW RECURSIVE CALL
+/ DCA HOLD
+ TAD I DEF
+ JMS I (JMSUB /CALL ITS SUBR
+/ TAD HOLD
+/V1A RECURSIVE CALL NO LONGER THREATENS
+/ DCA I (JMSUB
+ JMP I UNKN
+
+SETEXT, 0 /EXT WHICH HAS BEEN SET BY A CCL SWITCH
+
+SEMERR, TAD (SEMSG-1
+ DCA UNKN
+ TAD I UNKN
+ DCA .+2
+ JMS I (PRMESG
+ SEMSG1
+\fWRITFT, JMS I (LOOK
+ YCCL
+ JMP I (IOERR /CCL.SV NOT FOUND
+ TAD I (BLK
+ TAD (4 /*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB
+ DCA FBLK
+ CDF 10
+ CIF 0
+ JMS I (7607
+ 4210 /WRITE 1 RECORD FROM FIELD 1
+ 3400 /LOCS 3400-3777
+FBLK, 0
+ JMP I (IOERR
+ CIF CDF 0
+ JMP I (7605
+ PAGE
+\fCD, 0
+ JMS I (200
+ 13 /RESET ALL HANDLERS
+ JMS I (CDINIT
+BEGGRP, TAD OUTSW
+ SNA CLA
+ TAD I (BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS
+ TAD (MOFILE-1
+ DCA CLXR
+ JMS I (GETSPC
+ JMS I (ASSIGN
+ TAD OUTSW
+ SNA CLA
+ TAD I (LIMDIF /DIFF BETWWEN END OF OUTPUT & INPUT AREAS
+ TAD I (OUTLIM /END OF OUTPUT AREA
+ TAD CLXR
+ SMA CLA
+ JMP I (CDER1
+ JMS I (CCLSWT
+ TAD OUTSW
+ SNA CLA
+LKUPSW, JMP INFILE /ZEROED IF IN "SPECIAL DECODE" MODE
+ TAD I (DVICE
+ JMS PCLXR
+ TAD NAME1
+ JMS PCLXR
+ TAD NAME2
+ JMS PCLXR
+ TAD NAME3
+ JMS PCLXR
+ TAD NAME4
+ JMP LSTPUT
+INFILE, JMS I (LOOKUP
+ JMS PCLXR /STORE LENGTH AND DEV NUMBER
+ TAD I (LNAME /GET BLOCK
+LSTPUT, JMS PCLXR
+ TAD OUTSW
+ SNA CLA
+ TAD I (FLAG
+ CLL RTL
+ SPA CLA /FEATURE ENABLED?
+ TAD LKUPSW
+ SNA CLA
+ JMP DLOOK /IN SPECIAL MODE OR ON OUTPUT SIDE
+ TAD DONB
+ SZA CLA
+ JMP NBS
+ TAD (7600 /V1A NOW TAKES ARG IN AC
+ JMS I (NMOVE /MOVE NAME TO OUTPUT FILE NAMES
+ JMP DLOOK
+\fNBS, DCA DONB /ZERO 1ST OUTPUT FILE
+ TAD (7577
+ DCA XR2
+ DCA I XR2
+ DCA I XR2
+ DCA I XR2
+ DCA I XR2
+ DCA I XR2
+DLOOK, STA
+ DCA I (DVFLAG
+ TAD DELIM
+ SNA
+ JMP I CD
+ TAD (-"[
+ SNA
+ JMP I (OLENGT
+ TAD ("[-",
+ SNA
+ JMP I (FILLP /**** JUMPING INTO ROUTINE (IS THIS A BUG?)
+ TAD (",-"<
+ SNA
+ JMP BKAROW
+ TAD ("<-"=
+ SZA CLA
+ JMP I (CDER2 /BAD CHAR
+/ THIS STUFF WOULD ALLOW = AS WELL AS < AND _
+/*** HAVE TO FIX 'BKA' ROUTINE
+/ JMS I (GLXR
+/ JMS I (DECODE
+/ STL
+/ STA /LINK=0 MEANS LETTER
+/ TAD LXR /NOW LINK=1 MEANS LETTER
+/ DCA LXR
+/ SZL
+/ JMP BKAROW
+ DCA I (NUMFUJ
+ JMS I (NUMBER
+ DCA I (MPARAM+3
+ CLA CLL CML RAR
+ AND I (MPARAM-1 /PRESERVE ALTMODE
+ TAD I (HIORD
+ DCA I (MPARAM-1
+ JMS I (CCLSWT
+ JMP DLOOK
+BKAROW, ISZ OUTSW
+ JMP I (CDER2 /TWO BACK-ARROWS
+ TAD LXR /GET PTR TO ARROW
+ DCA I (ARLOC /SAVE IT ('EDIT' MIGHT NEED IT)
+ JMP BEGGRP
+
+PCLXR, 0
+ ISZ CLXR
+ DCA I CLXR
+ JMP I PCLXR
+\fDONB, 0 /ENTRY PT USED AS FLAG
+ JMP I DONB
+
+OUTSW, -1 /-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE
+
+P6, SETDEV
+ TVDEV
+ PAGE
+\fNUMBER, 0
+ SZA CLA
+ TAD (NUM&177+1200-SKP
+ TAD (SKP
+ DCA NUMADD/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
+ DCA HIORD
+NUMLP, DCA NUM
+ JMS I (GCH
+ ISZ NUMKNT
+ SKP
+ JMP EONUM2
+ CMA
+ TAD NUMFUJ
+ TAD ("8 /TEST INPUT CHARACTER FOR RANGE
+ CLL CMA /0-7 IF NUMFUJ=0
+ TAD (10 /0-9 IF NUMFUJ=2
+ TAD NUMFUJ
+ SNL
+ JMP EONUM
+ DCA T
+ CLA CLL CMA RTL
+ DCA DELIM
+ TAD NUM
+ROTLP, CLL RAL
+ DCA NUMX
+ TAD HIORD
+ RAL
+NUMSKP, SPA /MODIFIED BY #
+ JMP I (CDER5
+ DCA HIORD
+ TAD NUMX
+ ISZ DELIM
+ JMP ROTLP
+NUMADD, TAD NUM /SKP IF OCTAL
+ TAD NUM
+ TAD T
+ JMP NUMLP
+EONUM, TAD ("0
+EONUM2, DCA DELIM
+ TAD NUMKNT
+ SPA CLA
+ JMP I (CDER5 /FEWER THAN CORRECT NUMBER OF DIGITS
+ TAD NUM
+ JMP I NUMBER
+
+NUM, 0
+NUMFUJ, 0
+NUMKNT, 0 /SET TO -N-1 TO FORCE N DIGITS
+HIORD, 0
+\fASSIGN, 0
+ TAD CLXR
+ AND I (DVFLAG
+ TAD I (OUTLIM
+ SMA SZA CLA /CHECK FOR OUTPUT OR FIRST INPUT
+ JMP ASNORM /IF DEVICE WAS SPECIFIC,
+ /OR IF WE ARE ON THE INPUT SIDE,
+ /PROCEED NORMALLY
+ TAD NAME1
+ SNA CLA
+ JMP ASGNST
+ TAD DFLTNM+1
+ DCA DEV2
+ TAD DFLTNM
+ DCA DEV1
+ASNORM, TAD DEV1
+ DCA AS+1
+ TAD DEV2
+ DCA AS+2
+ TAD I (OUTSW
+ SNA CLA /DON'T LOAD HANDLER
+ /IF WE ARE ON OUTPUT SIDE OF "_"
+ TAD NAME1
+SPKLG1, SNA CLA /OR THERE IS NO FILE NAME TO LOOK UP
+ TAD GETHND /GETHND=11 NORMALLY,
+ /0 IF IN "SPECIAL DECODE" MODE
+ IAC
+ DCA AS
+ TAD (HNDLR+1 /ALLOW TWO PAGE HANDLERS
+ DCA ASADR
+ CIF 10
+ JMS I (200
+NUMX,
+AS, 0
+ 0
+ 0
+ASADR, HNDLR+1
+ JMP I (CDER0
+ TAD AS+2
+ASGNST, DCA I (DVICE
+ JMP I ASSIGN
+\fDFLTNM, DEVICE DSK
+GETHND, 11 /1+11=12 (1=FETCH, 12=INQUIRE)
+
+LOVE, 0
+ TAD NAME1
+ TAD (-1417
+ SZA CLA
+ JMP I LOVE
+ TAD NAME2
+ TAD (-2605
+ SZA CLA
+ JMP I LOVE
+ TAD NAME3
+ TAD NAME4
+ SZA CLA
+ JMP I LOVE
+ JMS I (PRINT
+ LOVMES
+ JMP I LOVE
+
+FILDMY, FILENAME DUMMY.SV
+
+SEMSG, SEMSG1
+ SEMSG2
+ SEMSG3
+ SEMSG4
+ PAGE
+\f/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
+/RETURNS WITH DELIMETER IN AC
+/GIVES ERROR MESSAGE IF NAME IS BAD
+
+TN, /DON'T CALL CCLSWT FROM GNAME UNLESS THIS IS MOVED
+GNAME, 0
+ DCA NAME1
+ DCA NAME2
+ DCA NAME3
+ DCA NAME4
+ TAD (NAME1
+ DCA NMBASE
+ CLA CMA
+ DCA PERDSW
+ DCA NAMECT
+ JMS I (GCH
+ TAD (-"#
+ SNA
+ JMP NUMCON
+ TAD ("#
+ SKP
+GTNMLP, JMS I (GCH
+ DCA DELIM
+ TAD DELIM
+ TAD (-"?
+ SZA
+ TAD ("?-"*
+ SNA
+STARSW, JMP I (CDER6 /"JMP STARNM"
+ /IF "SPECIAL DECODE" MODE
+ TAD ("*-".
+ SNA CLA
+ JMP PERIOD
+ TAD DELIM
+ JMS I (DECODE
+ JMP LV
+STARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY
+ TAD DELIM
+ AND (77
+ DCA DELIM
+ TAD NAMECT
+ TAD (-6
+ SMA CLA
+ JMP GTNMLP
+ TAD NAMECT
+ CLL RAR
+ TAD NMBASE
+ DCA TT
+ TAD DELIM
+ SNL
+ JMS I (ROTL
+ TAD I TT
+ DCA I TT
+ ISZ NAMECT
+ JMP GTNMLP
+PERIOD, TAD NAME1
+ SZA CLA
+ ISZ PERDSW
+ JMP I (CDER7 /NULL NAME OR DOUBLE EXTENSION
+ ISZ NMBASE
+ TAD (4
+ DCA NAMECT
+ JMP GTNMLP
+\fCCLSWT, 0
+ TAD DELIM
+ TAD (-"-
+ SZA CLA
+ JMP I CCLSWT
+ TAD I (OUTSW
+ SZA CLA
+ JMP I (CDER4 /CCL EXT ON OUTPUT FILE
+ TAD (SWTCHS
+ DCA DEF
+ JMS GETL
+ JMP I (CDER44 /NON-ALPHANUMERIC CCL SWITCH
+ JMS I (ROTL
+ DCA TN
+ JMS GETL
+ JMP XLK2 /ONE CHAR CCL SWITCH
+ TAD TN
+ DCA TN
+ JMS GETL
+XLK2, SKP CLA /2 CHAR CCL SWITCH
+ JMP I (CDER44 /3 CHAR CCL-SWITCH
+ TAD TN
+ JMS I (EXTLUK
+ CLA
+ ISZ DEF
+ TAD I DEF
+ DCA GETL /GET PTR TO ARGUMENT PAIR
+ TAD I GETL /GET SUBROUTINE
+ DCA PERDSW
+ ISZ GETL
+ TAD I GETL /GET ARGUMENT
+ JMS I PERDSW /CALL SUBR, ARG IN AC
+ JMP CCLSWT+1
+\fGETL, 0
+ JMS I (GCH
+ DCA DELIM
+ TAD DELIM
+ JMS I (DECODE
+ JMP I GETL /NON-ALPHANUM IN CCL SWITCH
+ CLA
+ TAD DELIM
+ AND (77
+ ISZ GETL
+ JMP I GETL
+
+NUMCON, JMS I (NUMC
+LV, CLA
+ TAD DELIM
+ JMP I GNAME
+
+PERDSW, 0
+NAMECT, 0
+ PAGE
+\fLOOKUP, 0
+ DCA LNAME
+ TAD NAME1
+ SNA CLA
+ JMP LKUPST
+ TAD I (PERDSW
+ TAD NAME4
+ SNA CLA
+ CLA IAC /FORCE NAMERM NON-0 IF . AND NO EXT
+ TAD NAME4
+ DCA NAMERM /REMEMBER TYPED EXTENSION
+ TAD DEFALT
+ DCA DEF
+ TAD I (SETEXT
+ SNA /HAS AN EXTENSION BEEN SET?
+ TAD NAMERM /NO
+ SNA /DOES FILE HAVE EXTENSION?
+ JMP EXT2 /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
+ JMS EXTLUK /LOOK FOR EXTENSION
+ SNA CLA /DID WE FIND IT?
+ JMP EXT3 /NO, FORCE NULL EXTENSION TO MATCH
+EXT2, TAD I DEF
+ IAC
+ SNA CLA
+ JMP NEXTEXT /IGNORE -1'S
+ TAD NAMERM
+ SZA CLA
+ JMP EXT3
+ TAD I DEF
+ DCA NAME4 /SET NEW EXTENSION
+EXT3, TAD (NAME1
+ DCA LNAME
+ TAD I (AS+2
+ JMS I (200
+ 2
+LNAME, 0 /NAME1
+LENGTH, 0
+ JMP LFAILD
+ ISZ DEF /POINT TO FOLLOW-UP SUBROUTINE
+ TAD I DEF
+ JMS JMSUB /CALL IT
+ TAD LENGTH
+ CLL
+ TAD (400
+ SNL
+CLACON, 7600 /CLA
+ CLL RTL
+ RTL
+ AND (7760
+LKUPST, TAD DVICE
+ JMP I LOOKUP
+\fLFAILD, TAD NAMERM
+ SNA CLA /WAS THERE AN EXPLICIT EXTENSION?
+ TAD I DEF /NO - WAS THERE A DEFAULT EXTENSION?
+ SNA CLA
+ JMP I (CDER3 /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
+NEXTEXT,ISZ DEF /NO EXPLICIT EXT AND YES DEFAULT EXT
+ ISZ DEF /POINT TO NEXT POSSIBLE DEFAULT EXTENSION
+ JMP EXT2 /AND TRY FOR IT
+
+NAMERM, 0
+DVICE, 0
+
+EXTLUK, 0
+ CIA
+ DCA T
+XLUK, TAD I DEF
+ SNA /AT NULL?
+ JMP I EXTLUK /YES
+ TAD T /NO
+ SNA CLA /MATCH?
+ JMP MAT /YES
+ ISZ DEF /NO
+ ISZ DEF /POINT TO NEXT ENTRY
+ JMP XLUK /TRY AGAIN
+MAT, TAD I DEF /RETURN WITH IT IN AC
+ JMP I EXTLUK
+
+TS,
+ZERSUB, 0
+ TAD I (7601
+ SNA CLA /WAS FILENAME SPECIFIED ON ZERO CMD?
+ TAD I CLACON /OR WAS NO OUT DEVICE SPECIFIED?
+ SNA CLA
+ JMP I (CDER2 /YES... ERROR
+ JMP I ZERSUB /NO, OKAY.
+\fIOERR, JMS I (PRMESG
+ SYSER
+
+EXSUB, 0
+ TAD BASPTR /PUSH PTR BACK TO BEGIN OF ENTRIES
+ JMS I (REMEM /REMEMBER THIS IN DEPENDENT WORD
+ 2
+ JMP I EXSUB
+
+JMSUB, 0
+ SNA
+ JMP I JMSUB
+ DCA TS
+ JMS I TS
+ JMP I JMSUB
+\fSPOOLIT,0
+ JMS I (BATCH /IS BATCH RUNNING?
+ JMP I SPOOLIT /NO
+ DCA CB /YES
+ TAD I DEFALT
+ TAD (-5200
+ SNA CLA
+ TAD I DEFALT /LEAVE 5200 IN AC IF SPECIAL MODE
+CB, HLT /CIF TO FIELD OF BATCH
+ JMS I (BATSPL /ALLOW BATCH TO SPOOL STUFF
+ JMP I SPOOLIT
+
+GOO, TAD PTR
+BASPTR, DCA BASPTR
+ JMP I (GO
+ PAGE
+\fSLSHCH, 0
+ DCA DELIM
+ TAD (MPARAM-1
+ DCA T
+ TAD DELIM
+ JMS DECODE
+ JMP CDER8
+ SZL
+ TAD (32
+ CMA STL /THE FOLLOWING TURNS
+ /ON THE CORRECT OPTION BIT
+ DCA TT
+SLSHLP, SZL
+ ISZ T
+ RAR
+ SNL
+ ISZ TT
+ JMP SLSHLP
+ DCA TT
+ TAD TT
+ CMA
+ AND I T
+ TAD TT
+ DCA I T
+ JMP I SLSHCH
+
+/THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT
+/IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0
+/IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1
+/IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC.
+DECODE, 0
+ TAD (-"9-1 /MIGHT BE CALLED WITH ANY DF
+ CLL
+ TAD ("9+1-"0
+ SZL
+ JMP DCDYES
+ TAD ("0-"Z-1
+ CLL CML
+ TAD ("Z-"A+1
+ SNL
+DCDYES, ISZ DECODE
+ JMP I DECODE
+
+CDER8, CLA
+ JMS I (PRMESG
+ BADOPT
+\fZEROCD, 0
+ TAD (-42 /AC MAY BE NON-0
+ DCA T
+ TAD (MOFILE-1
+ DCA XR
+ DCA I XR /ZERO THE COMMAND DECODER OUTPUT AREA
+ ISZ T
+ JMP .-2
+ JMP I ZEROCD
+
+GCH, 0
+ JMS GLXR
+ TAD (-240
+ SNA
+ JMP GCH+1
+ TAD (240-"/
+ SNA
+ JMP SLASH
+ TAD ("/-"(
+ SNA
+ JMP OPENP
+ TAD ("(
+ JMP I GCH
+SLASH, JMS GLXR
+ JMS SLSHCH
+/*** CAN'T PUT /A:VAL HERE BECAUSE GCH AINT RECURSIVE
+ JMP GCH+1
+OPENP, JMS GLXR
+ TAD (-")
+ SNA
+ JMP GCH+1
+ TAD (")
+ JMS SLSHCH
+ JMP OPENP
+
+GLXR, 0
+ CDF 0
+ ISZ LXR
+ TAD I LXR
+ CDF 10
+ JMP I GLXR
+\fOLENGT, TAD I (OUTSW
+ AND NAME1 /[N] IS ONLY LEGAL
+ /ON THE OUTPUT SIDE OF THE "_"
+ SNA CLA /AND ONLY AFTER A FILE NAME
+ JMP I (CDER2
+ TAD (-4
+ TAD CLXR
+ DCA NMBASE
+ CLA CLL CML RTL
+ DCA I (NUMFUJ /SET "NUMBER" TO ACCEPT
+ /DIGITS 8 AND 9
+ STA /ALLOW DECIMAL
+ JMS I (NUMBER
+ CLL RTL
+ RTL
+ AND (7760
+ TAD I NMBASE
+ DCA I NMBASE
+ CDF 0
+ TAD DELIM
+ TAD (-"] /IS THERE A CLOSING BRACKET?
+ SNA /IF NOT,
+ /"DLOOK" ROUTINE WILL DETECT IT
+ JMS GCH
+ DCA DELIM
+ JMP I (DLOOK
+\fBASUB, 0
+ TAD (200 /SET /Q SWITCH
+ DCA I (MPARAM+1
+ JMP I BASUB
+ PAGE
+\fPRMESG, 0
+ CLA
+ TAD I PRMESG
+ DCA .+2
+ JMS PRINT
+ HLT
+LEAVE, JMS I (TWAIT
+/V3D TCF
+ CIF CDF 0
+ TAD FATALFLG
+ SNA CLA
+ JMP I (7605
+FATALFLG,0 /CIF CDF BATCH FIELD IF WANT TO ABORT
+ JMP I (BATERR
+
+PRWD, 0
+ DCA T
+ TAD T
+TTY212, RTR
+ RTR
+ RTR
+ JMS PCHAR
+ TAD T
+ JMS PCHAR
+ JMP I PRWD
+
+PCHAR, 0
+ AND (77
+ SNA
+ JMP I PCHAR /IGNORE NULLS
+ TAD (240
+ AND (77
+ TAD (240 /CAN'T USE 'TTY240'
+ JMS TYPE
+ JMP I PCHAR
+
+PRNAME, 0
+ TAD NAME1
+ JMS PRWD
+ TAD NAME2
+ JMS PRWD
+ TAD NAME3
+ JMS PRWD
+ TAD NAME4
+ SNA CLA
+ JMP I PRNAME
+ TAD (256
+ JMS PCHAR
+ TAD NAME4
+ JMS PRWD
+ JMP I PRNAME
+\fTYPE, 0
+ DCA TE2
+ JMS I (BATCH
+ JMP TTYOUT
+ DCA CIFB
+CIFB, HLT /REPLACED BY CIF BATCH FIELD
+ TAD TE2
+ JMS I (BATOUT
+ TAD TE2
+ TAD (-"#
+TTY240, SZA CLA
+ JMP I TYPE
+ TAD CIFB
+ IAC /CONVERT CIF TO CIF CDF
+ DCA FATALFLG
+ JMP I TYPE
+
+TTYOUT, TAD TE2
+ TAD (-"# /DON'T TYPE #'S
+ SNA CLA
+ JMP I TYPE
+ TAD T7600
+ KRS
+ TAD (-7603
+ SNA
+ JMP LEAVE
+ TAD (203-217
+ SNA CLA
+ JMP I TYPE
+ TAD TE2
+TJUMP, JMP .+3
+ TSF
+ JMP .-1
+ TLS
+T7600, 7600
+ TAD (7000
+ DCA TJUMP
+ JMP I TYPE
+\fPRINT, 0
+ DCA CRLF /AC NON-0 MEANS DON'T CRLF
+ TAD I PRINT
+ ISZ PRINT
+ DCA TE
+PRINTP, CDF 0
+ TAD I TE
+ CDF 10
+ JMS PRWD
+ CDF 0
+ TAD I TE
+ CDF 10
+ ISZ TE
+ AND (77
+ SZA CLA
+ JMP PRINTP
+ TAD CRLF
+ SNA CLA
+ JMS CRLF
+ JMP I PRINT
+TE, 0
+TE2, 0
+\fCRLF, 0
+ TAD (215
+ JMS TYPE
+ TAD TTY212
+ JMS TYPE
+ JMP I CRLF
+
+CDER2, JMS PRMESG
+ BADSYN
+
+P1, NMOVE
+ 7605
+ PAGE
+\fCCERB, JMS I (PRMESG
+ BADSW
+CDER1, JMS I (PRMESG
+ TOOMAN
+CDER5, JMS I (PRMESG
+ BADNUM
+CCER1, TAD I (NAMPTR
+ DCA NMX
+ TAD (-4
+ JMS I (MOVE
+ CDF 10
+NMX, 0
+ CDF 10
+ NAME1
+CDER3, TAD (4300
+ JMS I (PRWD /#
+ JMS I (PRNAME
+ JMS I (PRMESG
+ NF
+
+CCER2, TAD I (DVNM1
+ DCA DEV1
+ TAD I (DVNM2
+ DCA DEV2
+CDER0, TAD DEV1
+ SNA CLA
+ JMP I (CDER2 /B DOES NOT EXIST
+ TAD (4300 /#
+ JMS I (PRWD
+ TAD DEV1
+ JMS I (PRWD
+ TAD DEV2
+ JMS I (PRWD
+ JMS I (PRMESG
+ DNE
+\fKILRT, 0
+ JMS I (PRINT
+ KILMES
+ JMP I KILRT
+
+RENRT, 0
+ JMS I (PRINT
+ RENMES
+ JMP I RENRT
+
+MOVRT, 0
+ JMS I (PRINT
+ MOVMES
+ JMP I MOVRT
+
+SWTCHS, 1423; P1 /LS
+ 1602; P2 /NB
+ 1520; P3 /MP
+ 1400; P4 /L
+ 2400; P5 /T
+ 2300; P6 /S
+ 2000; P7 /P
+ 0400; P8 /D
+ 1600; P9 /N
+ 0000; P10 /UNKNOWN
+ ZBLOCK 2 /PATCH ROOM FOR USER
+
+P2, DONB
+ 0
+
+P3, NMOVE
+ 7612
+
+P7, SETDEV
+ PTPDEV
+
+P9, SETDEV
+ NULDEV
+
+P10, UNKN
+ 0
+\fSCAN, 0
+ TAD (BEGLN
+ DCA T
+ CDF 0
+ JMS BLSCAN /IGNORE INITIAL SPACES
+ JMP CHK
+NOBLUP, CLA
+ ISZ T
+ TAD I T
+CHK, SNA
+ JMP ENDOFB
+ JMS I (DECODE
+ SKP CLA
+ JMP NOBLUP
+ JMS BLSCAN
+ENDOFB, DCA DELIM
+ STA
+ TAD T
+ CDF 10
+ DCA I (LBEGIN
+ JMP I SCAN
+
+BLSCAN, 0
+ TAD I T
+ TAD (-240
+ SZA
+ JMP BL2
+ ISZ T
+ JMP BLSCAN+1
+BL2, TAD (240
+ JMP I BLSCAN /LEAVE CHAR IN AC
+ PAGE
+\f ALTMODE=233
+
+SETPA, 0
+ JMS I (SETX
+ "P;"A /KEEP HERE TO MAKE EASY TO PATCH
+ JMP I SETPA
+
+MAKSUB, 0
+ TAD DELIM
+ SNA CLA
+ JMP CMDERR /DON'T ALLOW MAKE <CR>
+ JMS SETLXR
+ JMS I (GETSPC
+ JMS I (LOVE
+ JMS TECPUT
+ "E;"W;0
+ JMS TECMOV
+ JMS SETPA
+ JMS TECPUT
+ ALTMODE;0
+ JMS I (CHKSUP
+ JMS I (REMEM
+ 0
+ JMP I MAKSUB
+
+SETLXR, 0
+ TAD I (LBEGIN
+ DCA LXR
+ TAD (MOFILE-1
+ DCA I (TYR
+ TAD (-5 /ZERO OPTION TABLE TOO
+ JMS I (ZEROCD
+ TAD LXR
+ DCA SAVLXR
+ JMP I SETLXR
+
+/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR
+
+TECPUT, 0
+/ TAD NAME1
+/ SNA CLA
+/ JMP I (CDER2
+ TAD I TECPUT
+ ISZ TECPUT
+ SNA
+ JMP I TECPUT
+ JMS I (TPUT
+ JMP TECPUT+1
+\f/MOVE CHARS FROM FIELD 0 LINE BUFFER
+/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
+/INTO TECO LINE BUFFER AT 17600
+
+TECMOV, 0
+ TAD SAVLXR
+ DCA XR2
+ TAD SAVLXR
+ CMA
+ TAD LXR
+ SNA CLA
+ JMP I (CDER2 /NO FILE SPEC
+TECL, CDF 0
+ TAD I XR2
+ CDF 10
+ JMS I (TPUT
+ TAD XR2
+ CMA
+ TAD LXR
+ SNA CLA
+ JMP I TECMOV
+ JMP TECL
+\fTECSUB, 0
+ JMS SETLXR
+ JMS I (GETSPC
+ TAD DELIM
+ SNA
+ JMP TECNORM
+ TAD (-"< /ALLOW "_" AS WELL AS "<"
+ SNA
+ JMP EXTEN
+ TAD ("<-"_
+ SZA CLA
+ JMP I (CDER2
+EXTEN, CDF 0
+ DCA I LXR /CHANGE < TO 0
+ CDF 10
+ JMS TECPUT
+ "E;"W;0
+ JMS TECMOV
+ JMS SETPA
+ TAD LXR
+ DCA SAVLXR
+ JMS I (CHKSUP
+ JMS I (GETSPC
+ JMS TECPUT
+ ALTMODE;"E;"R;0
+ JMS TECMOV
+ JMS SETPA
+ JMS TECPUT
+ ALTMODE;"Y;0
+ JMP TECLV
+\fTECNORM,JMS TECPUT
+ "E;"B;0
+ JMS TECMOV
+ JMS SETPA
+ JMS TECPUT
+ ALTMODE;"Y;0
+TECLV, JMS I (REMEM
+ 0
+ JMP I TECSUB
+SAVLXR, 0
+
+CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD
+ ERRCMD
+ PAGE
+\fTPUT, 0
+ AND (177 /TECO LIKES 7-BIT
+ ISZ TYR
+ DCA I TYR
+ TAD TYR
+ TAD (-7646 /CHECK FOR OVERFLOW OF CD AREA
+ SZA CLA
+ JMP I TPUT
+CDER9, JMS I (PRMESG
+ TOOLNG
+
+MNGSUB, 0
+ JMS I (SETLXR
+ JMS I (GETSPC
+ JMS I (TECPUT
+ "E;"R;0
+ JMS I (TECMOV
+ JMS SETX
+ "T;"E
+EXTOK, JMS I (TECPUT
+ ALTMODE;"Y;"H;"X;"Y;"H;"K;"I;0
+ TAD DELIM
+ SNA
+ JMP IFIN
+ TAD (-",
+ SZA CLA
+ JMP I (CDER2
+G, STL CLA RAR /PREVENT 'GCH' FROM HANDLING SPACE AND /
+ JMS I (GCH
+ AND (177 /GET RID OF HIGH ORDER BIT
+ SNA
+ JMP IFIN
+ JMS TPUT
+ JMP G
+IFIN, JMS I (TECPUT
+ ALTMODE;"M;"Y;0 /MACRO GETS CALLED WITH POINTER PAST CHARS
+ JMP I MNGSUB
+TYR, 0
+\f/SET DEFAULT EXTENSION
+
+SETX, 0
+ TAD I SETX
+ DCA C1
+ ISZ SETX
+ TAD I SETX
+ DCA C2 /FALL THRU 2ND EXT
+ TAD NAME4
+ SNA CLA
+ TAD NAME1
+ SNA CLA
+ JMP I SETX
+ TAD I TYR /GET LAST CHAR (NO EXT)
+ TAD (-56 /WAS IT A DOT?
+ SNA CLA
+ JMP I SETX /YES
+ JMS I (TECPUT /NO, USE DEFAULT EXTENSION
+ ".
+C1, 0
+C2, 0
+ 0
+ TAD C1
+ AND (77
+ JMS I (ROTL
+ DCA C1
+ TAD C2
+ AND (77
+ TAD C1
+ DCA NAME4
+ JMP I SETX
+
+CCERA, JMS I (PRMESG
+ CONTRA
+\fCRSUB, 0
+ TAD I (7617
+ SNA CLA /BETTER BE NO INPUT
+ TAD I (7600 /ANYTHING THERE?
+ SNA CLA
+ JMP I (CDER2 /NO OUTPUT OR YES INPUT
+ JMS EDSUB /REMOVE BACK-ARROW AND REMEMBER CREATE LINE
+ JMP I CRSUB
+
+EDSUB, 0
+ CDF 0
+ DCA I ARLOC /REPLACE ARROW BY NULL
+ CDF 10
+ JMS I (REMEM /REMEMBER NEW COMMAND LINE
+ 1
+ JMP I EDSUB
+
+ARLOC, . /LOCATION OF BACK-ARROW IN COMMAND LINE
+ /'.' IS HARMLESS PTR IN CASE NO ARROW
+
+CCER3, CDF 10
+ JMS I (PRMESG
+ BADMON
+
+CDER4, CLA
+ JMS I (PRMESG
+ BADSW
+CDER44, CLA
+ JMS I (PRMESG
+ BADSW2
+CDER7, JMS I (PRMESG
+ BADX
+CDER6, JMS I (PRMESG
+ BADSTR
+ PAGE
+\fINSARR, 0
+ TAD (BEGLN
+ DCA XR
+ CDF 0
+ TAD I XR
+ SZA CLA
+ JMP .-2
+ STA
+ TAD XR
+ DCA XR
+ TAD ("<
+ DCA I XR
+ DCA I XR
+ CDF 10
+ STA
+ TAD XR
+ DCA I (ARLOC /REMEMBER WHERE WE INSERTED A "_"
+ JMP I INSARR
+
+BKA, 0
+ TAD I (LBEGIN
+ DCA CLXR
+GG, CDF 0
+ ISZ CLXR
+ TAD I CLXR
+ CDF 10
+ SNA
+ JMP NOBKAR
+ TAD (-"<
+ SNA
+ JMP I BKA
+ TAD ("<-"_
+ SZA CLA
+ JMP GG
+ TAD ("<
+ CDF 0
+ DCA I CLXR
+ CDF 10
+ JMP I BKA
+NOBKAR, ISZ BKA
+ JMP I BKA
+\fAT, 0
+ CIF CDF 0
+ JMS I (SEMI
+ATMORE, TAD (BEGLN-1
+ DCA LXR
+ATLOOP, JMS I (GLXR
+ SNA
+ JMP I AT
+ TAD (-300
+ SZA CLA
+ JMP ATLOOP
+ TAD LXR
+ DCA I (SAVL
+ JMS I (FUDG
+ JMS I (GETSPC
+ JMS I (ASSIGN
+ DCA I (SETEXT
+ TAD (EXTCM
+ DCA DEFALT
+ JMS I (LOOKUP
+ SZA CLA /V3C
+ TAD I (ASADR
+ SNA
+ JMP I (ATERR /IF NO FILESPEC AFTER @, ERROR
+ DCA T
+ TAD I (LNAME /GET BLOCK NUMBER
+ DCA BLN
+ CIF 0
+ JMS I T
+ 200 /READ 2 PAGES
+NWB, BFR+200 /INTO BUFFER
+COUNT,
+BLN, 0 /FROM THIS BLOCK
+ JMP I (ATERR / I/O ERROR
+ TAD (-200
+ DCA COUNT
+ TAD (BFR-1
+ DCA XR
+ TAD NWB
+ DCA T
+ CDF 0
+ALP, TAD I T
+ JMS I (P
+ CLL RTR
+ RTR
+ DCA BKA
+ ISZ T
+ TAD I T
+ JMS I (P
+ CLL RTL
+ RTL
+ RAL
+ TAD BKA
+ JMS I (P
+ CLA
+ ISZ T
+ ISZ COUNT
+ JMP ALP
+ JMP I (ATOVER
+
+/ATFIN, TAD LXR
+/ TAD (-BEGLN
+/ SZA CLA
+/ JMP I AT /LEAVE
+/ JMP I (LEAVE /LEAVE BECAUSE LINE NOW EMPTY
+ PAGE
+\fP, 0
+ AND (177
+ SNA
+ JMP CTZ /END AT 0 OR ^Z
+ TAD (-32
+ SNA
+ JMP CTZ
+ TAD (32-16 /IGNORE CR,LF,FF,VT
+ CLL
+ TAD (16-12
+ SZL
+ JMP POGO
+ TAD (212 /FORCE 8-BIT
+ DCA I XR
+POGO, CLA
+ TAD I T
+ AND (7400
+ JMP I P
+\fCTZ, CDF 10
+ TAD LXR
+ DCA ATEND
+ STA
+ TAD LXR
+ DCA LXR /INCASE @ GOES TO EOL
+ JMS I (GLXR /SEARCH FOR EOL
+ SZA CLA
+ JMP .-2
+ TAD LXR
+ CMA
+ TAD ATEND
+ DCA ENDLEN
+ TAD XR
+ CMA
+ TAD (BFR /GET LENGTH OF INSERTED STUFF
+ DCA NEWLEN
+ CDF 0
+ TAD I ATEND /GET NEXT CHAR AFTER FILESPEC
+ CDF 10 /V3C
+ TAD (-"'
+ SZA CLA /IS IT AN APOSTROPHE?
+ JMP .+3 /NO
+ ISZ ENDLEN /YES
+ ISZ ATEND /MAKE IT GO AWAY
+ TAD ENDLEN
+ JMS I (MOVE /MOVE REST OF LINE UP
+ CDF 0
+ATEND, 0 /FIRST CHAR POSITION AFTER @ SPEC
+ CDF 0
+ BEGLN+1000
+ TAD NEWLEN /IF 0, 'MOVE' WILL IGNORE IT
+ JMS I (MOVE /MOVE IN NEW STUFF
+ CDF 0
+ BFR
+ CDF 0
+SAVL, 0 /POINTS TO @
+ TAD NEWLEN
+ CIA
+ TAD SAVL
+ DCA NEWEND
+ CLL
+ TAD NEWEND
+ TAD (-BEGLN-1000
+ SZL CLA
+ JMP ATOVER
+ TAD ENDLEN
+ JMS I (MOVE /MOVE BACK END
+ CDF 0
+ BEGLN+1000
+ CDF 0
+NEWEND, 0 /FIRST POSITION AFTER NEW STUFF
+ JMP I (ATMORE /LOOK FOR MORE
+\fATOVER, JMS I (PRMESG
+ OVFLOW
+GETMP,
+ENDLEN, 0 /- NO. OF CHARS AT END INCLUDING 0
+
+NUMC, 0
+ TAD (SKP
+ DCA I (NUMSKP
+ TAD (-11
+ DCA I (NUMKNT
+ JMS I (NUMBER
+ DCA NAME2
+ TAD I (HIORD
+ DCA NAME1
+ STA
+ TAD LXR
+ DCA LXR
+ TAD (-11
+ DCA I (NUMKNT
+ JMS I (NUMBER
+ DCA NAME4
+ TAD I (HIORD
+ DCA NAME3
+ TAD (SPA
+ DCA I (NUMSKP
+ JMP I NUMC
+\fNEWLEN, /- NO. OF CHARS BEING INSERTED
+GETYR, 0
+ AND (7
+ DCA GETMP
+ CDF 0
+ TAD I (7777
+ CDF 10
+ CLL RTR
+ RTR
+ AND (30
+ TAD GETMP
+ JMP I GETYR
+ PAGE
+\f/ TAD (-# OF LOCS TO MOVE
+/ JMS MOVE
+/ FROM CDF
+/ FROM LOC
+/ TO CDF
+/ TO LOC
+
+MOVE, 0
+ DCA T
+ TAD I MOVE /GET FROM CDF
+ DCA FRCDF
+ ISZ MOVE
+ STA
+ TAD I MOVE /GET FROM LOC-1
+ DCA XR
+ ISZ MOVE
+ TAD I MOVE /GET TO CDF
+ DCA TOCDF
+ ISZ MOVE
+ STA
+ TAD I MOVE /GET TO LOC-1
+ DCA XR2
+ ISZ MOVE /POINT TO RETURN
+ TAD T
+ SNA CLA
+ JMP I MOVE /V1A IGNORE 0 MOVE
+FRCDF, HLT
+ TAD I XR
+TMP1,
+TOCDF, HLT
+ DCA I XR2
+ ISZ T
+ JMP FRCDF
+ CDF 10
+ JMP I MOVE
+\fDETCOR, 0
+ CIF 0
+ JMP I (CORE
+ JMP I DETCOR
+
+BADCOR, JMS I (PRINT
+ NOCORE
+GOEQ, CIF CDF 0
+ JMP I (COREQ
+
+ABSCOR, JMS I (PRINT
+ CORMES
+ JMP I DETCOR
+
+WRSCOR, JMS I (PRINT
+ BATCOR
+ JMP GOEQ
+
+SCRM, JMS I (PRINT
+ SCRMES
+ JMP I DETCOR
+\fSQSUB, 0
+ TAD I K7600
+ SZA CLA
+ JMP I SQSUB
+ TAD I (7617
+ DCA I K7600
+ JMS I (BATCH /IS BATCH RUNNING?
+ JMP I SQSUB /NO
+K7600, 7600 /YES (CLEAR AC)
+ TAD I K7600
+ TAD (7647-1 /POINT INTO DEVICE HANDLER RESIDENCY TABLE
+ DCA TMP1
+ TAD I TMP1 /GET HANDLER STARTING ADDRESS
+ TAD (-7607
+ SZA CLA /IS SQUISHED DEVICE SYS:?
+ JMP I SQSUB /NO
+ JMS I (PRINT
+ SQWARN /YES, WARN USER
+ JMP I SQSUB
+\fSETOUT, 0
+ TAD I (FLAG
+ RTR
+ SZL CLA
+ TAD (5
+ TAD K7600
+ DCA OLOC
+ TAD I OLOC
+ SZA CLA
+ JMP I SETOUT /HE'S SPECIFIED SOMETHING
+ JMS I (200
+ 12 /INQUIRE
+DVNM1, 0
+DVNM2, 0
+ 0
+ JMP I (CCER2 /NO SUCH DEVICE
+ TAD DVNM2
+ DCA I OLOC
+ TAD OLOC
+ AND (5
+ SNA CLA /USING 2ND OUT DEV?
+ JMP I SETOUT /NO
+ ISZ OLOC /YES
+ TAD (-4
+ JMS MOVE
+ CDF 10
+ NAME1
+ CDF 10
+OLOC, 7600 /INITIALLY 7600 OR 7605
+ JMP I SETOUT
+\fENGOA, TAD (-5
+ JMS I (ZEROCD
+ CDF 0
+ TAD I (BLKNO
+ CDF 10
+ DCA I (7620
+ CLA IAC
+ DCA I (7617 /'CCBTCH' IS ON SYS:
+ TAD (20 / /T OPTION
+ DCA I (7644
+ TAD (20 / ALSO /H (HUSH) OPTION
+ DCA I (7643
+ TAD (YBATCH
+ JMP I (ZOW /CHAIN TO BATCH
+ PAGE
+\fDATE, 0
+ TAD I (DATWD
+ SNA
+ JMP NODATE
+ DCA DATEM
+ TAD DATEM
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ DCA TM1
+ TAD TM1
+ TAD (MONLST-1
+ DCA TM2
+ CDF 0
+ TAD I TM2
+ CDF 10
+ DCA MONP
+ TAD DATEM
+ JMS I (GETYR /V3D DATE/78 ALGORITHM
+ DCA TM2
+ TAD TM2
+ TAD (106 /70.
+ CIF CDF 0
+ JMS I (OTODY
+ DCA YEAR
+ TAD DATEM
+ CLL RTR
+ RAR
+ AND (37
+ DCA DATEM
+ TAD DATEM
+ CIF CDF 0
+ JMS I (OTODY
+ DCA DAY
+ CDF 0
+ STL CLA RTL /2
+ TAD TM2
+ CLL RTR
+ SNL SMA
+ JMP LEAP
+ ISZ I (JAN
+ ISZ I (FEB
+LEAP, AND (37
+ TAD TM2
+ TAD (3
+ TAD DATEM
+ DCA DATEM
+ TAD TM1
+ TAD (JAN-1
+ DCA TM1
+ TAD I TM1
+ CDF 10
+ TAD DATEM
+DIV7, CLL
+ TAD (-7
+ SZL
+ JMP DIV7
+ TAD (7
+ TAD (WEEKLST
+ DCA TM2
+ CDF 0
+ TAD I TM2
+ CDF 10
+ DCA WKP
+ STA /DON'T CRLF
+ JMS I (PRINT
+WKP, 0
+ STA
+ JMS I (PRINT
+ DAYDAY
+ STA
+ JMS I (PRINT
+MONP, 0
+ STL CLA RAR
+ JMS I (PRWD /SPACE
+ TAD DAY
+ JMS I (PRWD
+ STA
+ JMS I (PRINT
+ COM19
+ TAD YEAR
+ JMS I (PRWD
+ JMS I (CRLF
+ JMS I (LOOK /LOOKUP SYS:DATE.SV
+ YDATE
+ JMP I DATE /DO NOTHING IF IT'S NOT THERE
+ JMP I (CHAIN /CHAIN TO IT, IF IT'S THERE
+\fNODATE, JMS I (PRMESG
+ NONE
+DT, 0
+TM2, 0
+DATEM, 0
+DAY, 0
+YEAR, 0
+\fSETDSK, 0
+ TAD DSKDEV
+ SZA
+ JMP I SETDSK
+ JMS I (200
+ 12 /INQUIRE
+ 5723 /PACKED ENCODING FOR 'DSK:'
+DSKDEV, 0 /SET TO DEVICE NUMBER
+ 0
+TM1, HLT /NO 'DSK' !
+ TAD DSKDEV
+ JMP I SETDSK
+ PAGE
+\f/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL
+/SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE.
+/THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT:
+
+/4000-4037 REM-LINE 0
+/4040-4177 REM-LINE 1
+/4100-4137 REM-LINE 2
+/4140-4177 REM-LINE 3
+/4200-4237 REM-LINE 4
+/4240-4277 REM-LINE 5
+/4300-4337 REM-LINE 6
+/4340-4377 REM-LINE 7
+
+/EACH REM-LINE HAS THE FOLLOWING FORMAT:
+
+/WORD 0: IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE
+/WORD 1: DATE LINE WAS REMEMBERED
+/WORD 2: COMMAND DEPENDENT INFORMATION
+/WORD 3: RESERVED FOR FUTURE EXPANSION
+/WORDS 4-37 COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES
+/ PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0.
+
+/ROUTINES:
+
+/ TAD (DEP
+/ JMS REMEM
+/ N
+
+/REMEMBERS CURRENT LINE IN REM-LINE N. AC IS LINE DEPENDENT INFORMATION.
+/IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK.
+
+/ JMS RECALL
+/ N
+
+/RECALLS REM-LINE N INTO BUFFER
+/IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8.
+/UPON RETURN, LINE-DEPENDENT INFO IS IN AC.
+/IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1
+
+/0 USED BY TECO, MAKE COMMANDS
+/1 USED BY EDIT, CREATE COMMANDS
+/2 USED BY COMPILE, EXECUTE COMMANDS & PAL.
+/ DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE
+
+/3 USED BY 'UA' COMMAND
+/4 USED BY UB
+/5 USED BY UC
+
+/ JMS FOREVER
+
+/CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
+\f REMSPACE=4000
+ REMBLOCK=65
+
+REMEM, 0
+ DCA DEP
+ TAD I (REMD
+ SMA CLA
+ JMP I REMEM /DON'T REMEMBER IF JUST RECALLED
+ JMS I (RDREM
+ JMP I (MEMBIG
+ TAD I REMEM
+ ISZ REMEM
+ CLL RTL
+ RTL
+ RAL /MULTIPLY BY 40
+ TAD (REMSPACE
+ DCA LPTR
+ TAD (1234
+ CDF 0
+ DCA I LPTR
+ CDF 10
+ ISZ LPTR
+FORVR, TAD I (DATWD /REPLACED BY CMA IF WANT NO DATE
+ JMS LPUT /STORE DATE
+ TAD DEP
+ JMS LPUT /STORE DEPENDENT INFO
+ JMS LPUT /RESERVED
+ JMS I (SCAN /GO PAST KEYWORD AND BLANKS
+ TAD I (LBEGIN
+ DCA XR
+RELUP, JMS I (GETF
+ JMP LZER
+ JMS I (ROTL
+ DCA TML
+ JMS I (GETF
+ JMP RZER
+ TAD TML
+ JMS LPUT
+ JMP RELUP
+RZER, TAD TML
+LZER, JMS LPUT
+ JMS I (WRREM
+ JMP I (MEMBIG
+REMGO, JMP I REMEM
+\fDEP, 0
+LPTR, 0 /PTS TO REM-LINE
+TML, 0 /TEMP
+
+/PUT INTO REM-LINE
+
+LPUT, 0
+ DCA TML
+ TAD LPTR
+ AND (37
+ SNA CLA
+ JMP I (MEMBIG
+ TAD TML
+ CDF 0
+ DCA I LPTR
+ CDF 10
+ ISZ LPTR
+ JMP I LPUT
+
+FOREVER,0
+ TAD LCMA
+ DCA FORVR
+ JMP I FOREVER /NON-ZERO MEANS SET DATE TO -1
+\fRECALL, 0
+ JMS I (RDREM
+ JMP I (REMERR
+ TAD I RECALL
+ ISZ RECALL
+ JMS I (ROTL
+ RAR
+ TAD (REMSPACE
+ DCA LPTR
+ JMS LGET
+ TAD (-1234
+ SZA CLA
+ JMP I (REMER2
+ JMS LGET
+ SNA
+ JMP I (REMER2
+LCMA, CMA
+ SNA
+ JMP FOREV
+ IAC
+ TAD I (DATWD /SAME DAY?
+ SZA CLA
+ JMP I (REMER2
+FOREV, JMS LGET
+ DCA DEP
+ JMS LGET /IGNORE RESERVED WORD
+ CLA
+ TAD (BEGLN-1
+ DCA XR
+ TAD (BEGLN-1
+ DCA I (LBEGIN
+RECLUP, JMS LGET
+ DCA TML
+ TAD TML
+ JMS I (ROTL
+ RAL
+ JMS I (PUTF
+ JMP RECLV
+ TAD TML
+ JMS I (PUTF
+ JMP RECLV
+ JMP RECLUP
+
+RECLV, TAD DEP
+ JMP I RECALL
+\fLGET, 0
+ CDF 0
+ TAD I LPTR
+ CDF 10
+ ISZ LPTR
+ JMP I LGET
+ PAGE
+\fPUTF, 0
+ AND (77
+ SNA
+ JMP PUTZ
+ ISZ PUTF
+ TAD (240
+ AND (77
+ TAD (240
+PUTZ, CDF 0
+ DCA I XR
+ CDF 10
+ JMP I PUTF
+
+CHKSUP, 0
+ JMS FUDG
+ JMS I (ASSIGN
+ TAD NAME1
+ SNA CLA
+ JMP I CHKSUP /CAN'T SUP IF NO FILENAME
+ TAD I (DVICE
+ JMS I (LOOK /LOOK UP FILE
+ NAME1
+ JMP I CHKSUP /NOT FOUND (GOOD)
+ JMS I (PRINT
+ SUP
+ JMP I CHKSUP
+
+REMERR, JMS I (PRMESG
+ REMBAD
+REMER2, JMS I (PRMESG
+ BADREM
+\fMEMBIG, CLA
+ JMS I (PRINT
+ MEMWARN
+ JMP I (REMGO
+
+RDREM, 0
+ CIF 0
+ JMS I (7607
+ 200 /READ 2 PAGES INTO FIELD 0
+ 4000 /LOCATION 4000
+ REMBLOCK
+ SKP CLA
+ ISZ RDREM
+ JMP I RDREM
+
+WRREM, 0
+ CIF 0
+ JMS I (7607
+ 4200 /WRITE 2 PAGES FROM FIELD 0
+ 4000 /LOCATION 4000
+ REMBLOCK
+ SKP CLA
+ ISZ WRREM
+ JMP I WRREM
+
+FUDG, 0
+ DCA I (OUTSW /LOAD HANDLER
+ TAD I (OUTLIM
+ CIA
+ DCA CLXR
+ JMP I FUDG
+\fK8, 0
+ TAD (1716
+ JMS I (PRWD
+ TAD (1431
+ JMS I (PRWD
+ CIF CDF 0
+ JMP I K8
+
+ROTL, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I ROTL
+
+/GET FROM INPUT LINE VIA XR
+
+GETF, 0
+ CDF 0
+ TAD I XR
+ CDF 10
+ SZA
+ ISZ GETF
+ AND (77
+ JMP I GETF
+\f/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
+/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
+/IT GIVES A FATAL ERRORR MESSAGE IF BAD.
+GETSPC, 0
+ STA
+ DCA DVFLAG
+ DCA DEV1
+FILLP1, DCA DEV2
+FILLP, JMS I (GNAME
+ TAD (-": /AC CONTAINED DELIM
+ SNA CLA
+ JMP DEVNAM
+ DCA I (NUMC
+ JMP I GETSPC
+DEVNAM, CLA IAC
+ TAD I (PERDSW
+ TAD I (NUMC
+ SZA CLA
+ JMP CDERA /. OR # IN DEVICE NAME
+ TAD NAME1
+ DCA DEV1
+ ISZ DVFLAG
+ JMP CDERA /CATCHES A:B:
+ TAD NAME2
+ JMP FILLP1
+
+DVFLAG, 0
+\fCDERA, JMS I (PRMESG
+ BADEV
+
+ATERR, CDF 10
+ CLA
+ JMS I (PRMESG
+ ATIO
+ PAGE
+\fCDINIT, 0
+ TAD I DEFALT
+ TAD (-5200
+ SZA CLA /IS THIS A REQUEST FOR A
+ /"SPECIAL DECODE"?
+ JMP CDCONT /NO
+ TAD ALTLIM
+ DCA OUTLIM /YES, SET UP THE PROPER LOCATIONS
+ TAD ALTDF1
+ DCA LIMDIF /TO GET 1 OUTPUT AND 5 INPUT FILES
+ TAD ALTDF2
+ DCA BEGDIF /ALL OF WHICH ARE
+ /5-WORD <DEVICE,NAME> ENTRIES
+ DCA I PLKUPS
+ TAD STARJM
+ DCA I PSTARS /AND ALLOW *
+ /AS A FILE OR EXTENSION NAME
+ TAD CCLA /STOPS FETCHES IN SPECIAL MODE
+ DCA I PSPKG1 /NO HANDLER FETCHES NECESSARY EITHER
+ /SINCE NO LOOKUPS
+CDCONT, JMS I (BKA
+ STA
+ DCA I (OUTSW
+ JMS I (ZEROCD
+ TAD LBEGIN
+ DCA LXR
+ JMP I CDINIT
+/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
+ALTLIM, 1-MOFILE-5
+ALTDF1, MOFILE+5-MPARAM+5
+ALTDF2, 5
+PLKUPS, LKUPSW
+PSTARS, STARSW
+PSPKG1, SPKLG1
+
+BEGDIF, MIFILE-MOFILE
+LIMDIF, MIFILE-MPARAM+2
+OUTLIM, 1-MIFILE
+LBEGIN, 0 /PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT
+\fNMOVE, 0
+ DCA PT1 /V1A ARG IN AC
+ TAD I (FLAG
+ RTL
+ SMA CLA /FEATURE ENABLED?
+ JMP I (CCERB /NO
+ TAD I (OUTSW
+ SZA CLA
+ JMP I (CCERB /ON OUTPUT SIDE
+ TAD I CCLA /V3C
+ SNA CLA /DON'T CHANGE OUT DEV IF SPECIFIED
+ TAD I (FLAG /LOOK AT 'COPY EXT' BIT
+ AND (200
+ SNA CLA
+ JMP NMXXX /IT WASN'T SET
+ TAD I (7617 /GET FIRST INPUT DEVICE
+ AND (17 /ISOLATE DEVICE BITS
+ DCA I CCLA /FORCE THIS TO BE FIRST OUTPUT DEVICE
+NMXXX, TAD I PT1
+ SNA
+ JMS I (SETDSK /CHANGE TO 'IAC' TO ALWAYS USE SYS:
+ DCA I PT1 /SET DEVICE TO SYS IF NONE
+ ISZ PT1
+ TAD I PT1 /WAS THERE A SPECIFICATION THERE?
+ SZA CLA
+ JMP I NMOVE /YES, DO NOTHING
+ TAD I (FLAG
+ AND (200 /GET 'COPY EXTENSION' BIT
+L7740, SMA SZA CLA /'SMA' IS UNNECESSARY
+ STA /COPY 4 WORDS IF BIT 4 WAS ON
+ TAD (-3 /OTHERWISE ONLY COPY 3 WORDS
+ JMS I (MOVE
+ CDF 10
+ NAME1
+ CDF 10
+TEM,
+PT1, 0
+ JMP I NMOVE
+
+P8, SETDEV
+ DMPDEV
+\fVERTN, 0
+ JMS I (RDMON /READ MONITOR
+ CDF 0
+ TAD I (2031 /GET PATCH LEVEL
+ SNA
+ TAD ("!
+ AND (77
+ DCA TEM
+ TAD I (2000 /GET VERSION #
+ CDF 10
+ SPA
+CCLA, 7600 /"0" MEANS OLD
+ TAD (60
+ JMS I (ROTL
+ TAD TEM
+ JMP I (PTCH
+\f/ALLOW DEASSIGN FOO ?
+
+DEASSIGN,0
+ TAD L7740
+ DCA XR
+ TAD (-17
+ DCA T
+ DCA I XR
+ ISZ T
+ JMP .-2
+ CDF 0
+ TAD I (7746
+ AND (6777
+ TAD (1000
+ DCA I (7746
+ CDF 10
+ JMP I DEASSIGN
+\fSTARJM, RELOC STARNM /DUMP LITERALS AT LAST POSSIBLE MOMENT
+ JMP STARNM
+ RELOC
+ PAGE
+ ZBLOCK 7600-.
+\f/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD
+/CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT.
+/FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE
+/OS/8 CORE-IMAGE FORMAT.
+/FOR VERSION OF THE MONITOR BEFORE LEVEL A,
+/THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS
+/OR IT READS OVER 7600.
+/BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF
+/INTO FIELD 0. 400-777 IS IGNORED BY SKIPPING A BLOCK,
+/THEN THER REST OF CCL (7 PAGES) IS READ IN.
+
+ FIELD 0
+
+ *400
+
+/IT LOADS OVER THE SAVE, DATE OVERLAY
+/AND STARTS AT LOCATION 600
+
+/KEYWORD TABLE IN 400-
+
+/CONSISTS OF COMMANDS 2 CHARS PER LOCATION
+/IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL)
+/SEPARATED FROM EACH OTHER BY 6-BIT 00'S.
+/EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU
+/NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX
+/BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED
+/BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
+\fVNO, CCLTAB
+KEYWRD,
+0530 /EX ECUT
+4543
+6564
+0002 /BA CKSP OR TER MIN
+0143
+5363
+6000
+0201 /BAS IC
+2351
+4300
+0425 /DU PLICATE
+6054
+5143
+4164
+4500
+0217 /BO OT
+5764
+0003 /CCL
+0314
+0003 /COMPA R
+1715
+2001
+6200
+0317 /COM PIL
+1560
+5154
+0003 /COP Y
+1720
+7100
+1505 /MEM ORY
+1557
+6271
+0003 /CREA TE
+2205
+0164
+4500
+0322 /CREF
+0506
+0004 /DA TE
+0164
+4500
+0405 /DEL ETE
+1445
+6445
+0004 /DE A
+0541
+0004 /DIR ECT
+1122
+4543
+6400
+0504 /ED IT
+5164
+0005 /EO F
+1746
+0010 /HE LP
+0554
+6000
+1411 /LIN K
+1653
+0015 /MAC R
+0103
+6200
+1411 /LI ST
+6364
+0014 /LO AD
+1741
+4400
+1501 /MAK E
+1345
+0015 /MAP
+0120
+0015 /MUNG
+2516
+0700
+2001 /PAL
+1400
+2022 /PRI NT
+1156
+6400
+2025 /PU NCH
+5643
+5000
+2205 /REN AME
+1641
+5545
+0022 /RES
+0523
+0022 /REW IND
+0527
+5156
+4400
+2305 /SET
+2400
+2313 /SK IP
+5160
+0023 /SQ UISH
+2165
+5163
+5000
+2325 /SU BMIT
+4255
+5164
+0024 /TE CO
+0543
+5700
+2431 /TY PE
+6045
+0025 /UN LOAD
+1654
+5741
+4400
+2501 /UA
+0025 /UB
+0200
+2503 /UC
+0026 /VE R
+0562
+0032 /ZERO
+0522
+1700
+4000 /@
+ ZBLOCK 600-.
+\f IFDEF XYZMCR <
+
+THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE:
+
+
+HKGYJ2S\ 1\eR0,.KHXAHKMA
+\ 1TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM
+OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL.
+** NO EDITING **
+\ 1HKHXYHXN0UO0UB0UN
+!CHLP!^TUL\eQL-32"EOBLANK\e'QL-13"EOCR\e'QL-26"EOEND\e'
+!CHLP0!QL&63+QBUT\e QT/8UX\eQX+48I\eQT-(8*QX)+48I\e
+QL"NZJ.UZGNQLI\eQZJXNK%N\e'
+%O&1"NOCHLP\e' QN-3"LZUH'I
+\eOCHLP\e
+!BLANK! 32UBZJ.UZGNQLI\eQZJXNK%N\eOCHLP\e
+!CR! \ 1
+\ 1QHJ /\eGNZJXN0UN0UB0ULOCHLP0\e
+!END!I00
+\e
+
+
+ >
+\f *600
+
+ JSBITS=7746
+ SYSTEM=22
+ PRMES=330
+ ERRET=33 /THESE ARE LOCATIONS FROM OS/8 MONITOR
+
+/RUNS IN FIELD 0 ONLY.
+
+ENTRY, 0 /INITIALLY 0 MEANS 'EX' COMMAND
+LINPTR, JMP ENTREE /OS/8 JUMPS HERE (ACTUALLY TO 600)
+TEMM,
+TEKLDG, ISZ CCLNHR /TECO 'EG' JUMPS HERE
+ DCA I (BEGLN /ZERO COMMAND LINE
+ JMP TEGO /FIRST WE DISABLE CALLS TO MONITOR
+ENTREE, TAD (7605
+ DCA ERRET
+ TAD SYSTEM
+ DCA MYSYS
+ JMS FINDIT
+ SPA CLA /WAS IT A LEGAL COMMAND?
+ JMP I (PRQMRK /NO
+TEGO, TAD (6003 /YES
+ DCA I (JSBITS
+ CIF 10
+ JMS I MYSYS /CALL USR AND LOCK IN CORE
+ 10
+ CLA IAC
+ CIF 10
+ JMS I (200
+ 2
+CCLBLC, CCLSV
+CCLEN, 0
+CCLNHR, JMP NOCCL /ISZ'ED IF KBM NOT IN MEMORY
+ CLA IAC
+ TAD CCLBLC
+ DCA CCLRDB
+ JMS I (7607
+CCLCCW, 2711 /READ 27 PAGES OF CCL.SV
+CCLSTR, 2000
+MYSYS,
+CCLRDB, 7700 /INITIALLY POINTS TO USR
+ JMP NOCCL
+ CIF CDF 10
+ JMP I CCLSTR
+\fCCLSV, FILENAME CCL.SV
+
+NOCCL, CLA SKP
+ JMP I (7605 /GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND
+ JMS I (PRMES /PRINT ERROR MESSAGE OTHERWISE
+ TEXT /NO CCL!/
+ 0
+\f/FINDS IF INPUT LINE STARTS WITH A COMMAND
+/LEAVES ENTRY # IN AC, -1 IF NOT FOUND
+/ENTRIES START AT ENTRY 0.
+/CALLABLE FROM ANY FIELD
+
+FINDIT, 0
+MORE, TAD (BEGLN-1
+ DCA LINPTR
+ ISZ LINPTR
+ TAD I LINPTR
+ TAD (-240
+ SNA CLA
+ JMP .-4
+ JMS GETKAR
+ JMP ENDOFT /NO MATCH
+ JMP INTO
+FNLUP, TAD I LINPTR
+ TAD (-301
+ STL
+ TAD (-32
+ SNL CLA
+ JMP NOLET /NOT A LETTER
+ JMS GETKAR
+ JMP MATCH
+INTO, CIA
+ TAD I LINPTR
+ AND (37 /5-BIT ASCII
+ ISZ LINPTR
+ SNA CLA /DO THEY MATCH?
+ JMP FNLUP /YES
+NOMT, JMS GETKAR
+ SKP
+ JMP .-2 /SCAN TO NEXT ENTRY
+ ISZ ENTRY
+ JMP MORE
+
+NOLET, JMS GETKAR
+ JMP MATCH
+ CLA
+ ISZ SIGNIF
+ JMP NOMT
+MATCH, TAD ENTRY
+ SKP
+ENDOFT, STA
+RETCIF, CDF 0 /RETURN TO CALLING FIELD (MAY BE OVERLAID)
+ JMP I FINDIT
+KPTR, KEYWRD
+\fHALF, -1 /0 MEANS LEFT HALF
+SIGNIF, 0 /1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT
+
+/GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC
+/SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT
+/TAKES RETURN 1 IF CHAR IS 0
+/TAKES RETURN 2 OTHERWISE
+
+GETKAR, 0
+ ISZ HALF
+ JMP RTHALF
+ TAD I KPTR
+ RTR
+ RTR
+ RTR
+ JMP INSIDE
+RTHALF, STA
+ DCA HALF
+ TAD I KPTR
+ ISZ KPTR
+INSIDE, AND (77
+ DCA TEMM
+ TAD TEMM
+ AND X40
+X40, SZA CLA
+ STA
+ DCA SIGNIF
+ TAD TEMM
+ SZA
+ ISZ GETKAR
+ AND (37
+ JMP I GETKAR
+ PAGE
+\f *REST
+CORLOC, CORX
+CORV, 1400
+CORSIZ, 1
+
+CORE, CDF 0
+ TAD CORSIZ
+ CLL RTL
+ RAL
+ AND COR70
+ TAD COREX
+ DCA .+1
+COR1, CDF
+ TAD I CORLOC
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC
+CORX, 7400
+ TAD CORX
+ TAD CORV
+ SZA CLA
+ JMP COREX
+ TAD COR1
+ DCA I CORLOC
+ ISZ CORSIZ
+ JMP CORE
+COREX, CDF 0
+ TAD CORSIZ
+ CLL RTL
+ TAD (-10
+ JMP I (DETC2 /GO TO NEXT PAGE
+\fMONLST, MON1
+ MON2
+ MON3
+ MON4
+ MON5
+ MON6
+ MON7
+ MON8
+ MON9
+ MON10
+ MON11
+ MON12
+\fMON1, TEXT /JANUARY/
+MON2, TEXT /FEBRUARY/
+MON3, TEXT /MARCH/
+MON4, TEXT /APRIL/
+MON5, TEXT /MAY/
+MON6, TEXT /JUNE/
+MON7, TEXT /JULY/
+MON8, TEXT /AUGUST/
+MON9, TEXT /SEPTEMBER/
+MON10, TEXT /OCTOBER/
+MON11, TEXT /NOVEMBER/
+MON12, TEXT /DECEMBER/
+\fCOM19, TEXT /, 19/
+
+WEEKLST,DAY1
+ DAY2
+ DAY3
+ DAY4
+ DAY5
+ DAY6
+ DAY7
+
+DAY1, TEXT /SATUR/
+DAY2, TEXT /SUN/
+DAY3, TEXT /MON/
+DAY4, TEXT /TUES/
+DAY5, TEXT /WEDNES/
+DAY6, TEXT /THURS/
+DAY7, TEXT /FRI/
+BADMON, TEXT /#BAD MONITOR/
+ PAGE
+\fHISIZ, 0 /HIGHEST MEMORY BANK
+NEWCOR, 0 /PROPOSED NEW MEMORY BANK
+
+DETC2, SNA
+ JMS KEIGHT
+ TAD (-30
+ SNA
+ JMS K32
+ TAD (40
+ JMS OTOD
+ DCA I (CORMES
+ CDF 10
+ TAD I (LBEGIN
+ DCA XRL
+ CDF 0
+ STA
+ TAD I (CORSIZ
+ DCA HISIZ
+ ISZ XRL
+ TAD I XRL /GET NEXT CHAR
+ SNA
+ JMP COREQ /NOT SETTING CORE SIZE
+ TAD (-260
+ DCA NEWCOR
+ TAD NEWCOR
+ AND (7770
+ SZA CLA
+ JMP DETER /TRIED TO SET CORE SIZE GT 7
+ TAD NEWCOR
+ CIA
+ TAD HISIZ
+ SPA CLA
+ JMP BADKOR /TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE
+ TAD I (7777
+ RTL /BATCH BIT TO LINK
+ SZL CLA
+ JMP WRSKOR /CAN'T CHANGE CORE SIZE UNDER BATCH
+ TAD NEWCOR
+ CLL RTL
+ RAL
+ DCA NEWCOR
+ TAD I (7777
+ AND (7707
+ TAD NEWCOR
+ DCA I (7777
+COREQ, TAD I (7777
+ AND (70
+ SNA
+ JMP ABSKOR
+ TAD (10
+ CLL RAR
+ JMS OTOD
+ DCA I (SCRMES
+ TAD I (SCRMES
+ CIA
+ TAD I (CORMES
+ABSKOR, CIF CDF 10
+ SNA CLA
+ JMP I (ABSCOR /DON'T PRINT SOFT IF = REAL
+ JMP I (SCRM
+
+BADKOR, CIF CDF 10
+ JMP I (BADCOR
+WRSKOR, CIF CDF 10
+ JMP I (WRSCOR
+
+DETER, CIF CDF 10
+ JMP I (CMDERR
+
+KEIGHT, 0
+ CIF CDF 10
+ JMS I (K8
+ JMP I KEIGHT
+
+XRL, 0
+\fOTOD, 0
+ DCA TTX
+ DCA TX
+ TAD TTX
+ TAD (-12
+ ISZ TX
+ SMA
+ JMP .-3
+ TAD (72
+ DCA CORETM
+ STA
+ TAD TX
+ SNA
+ TAD (40-60
+ TAD (60
+ CLL RTL
+ RTL
+ RTL
+ TAD CORETM
+ JMP I OTOD
+
+TX, 0
+TTX, 0
+CORETM,
+K32, 0
+ TAD (4100
+ DCA I (CORMES+5
+ JMP I K32
+\fOTODY, 0
+ JMS OTOD
+ CIF CDF 10
+ JMP I OTODY
+ PAGE
+\fERRCMD, TEXT /#ERROR IN COMMAND/
+BADVMS, TEXT /#CCL 3X OVERLAY AND MONITOR INCOMPATIBLE/
+ AAAA=.
+ *BADVMS+3
+ CCLTAB&77^100+40
+ *AAAA
+\fLOVMES, TEXT /NOT WAR?/
+KILMES, TEXT /FILES DELETED:/
+RENMES, TEXT /FILES RENAMED:/
+MOVMES, TEXT /FILES COPIED:/
+SCRMES, TEXT \00K/\
+ *.-1
+CORMES, TEXT /00K MEMORY/
+DAYDAY, TEXT /DAY /
+\fNOCORE, TEXT /# NOT ENOUGH MEMORY/
+BATCOR, TEXT /#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/
+JAN, 0
+FEB, 3
+ 4;0;2;5;0;3;6;1;4;6
+\fSUP, TEXT /%SUPERSEDING/
+MEMWARN,TEXT /%CAN'T REMEMBER/
+SQWARN, TEXT /%BATCH SQUISHING SYS:!/
+SYSER, TEXT \#I/O ERROR ON SYS:\
+BADSYN, TEXT /#ILLEGAL SYNTAX/
+TOOMAN, TEXT /#TOO MANY FILES/
+NF, TEXT / NOT FOUND/
+DNE, TEXT / DOES NOT EXIST/
+SEMSG1, TEXT /? ENTER ERROR/
+SEMSG2, TEXT \?I/O ERROR\
+SEMSG3, TEXT /?DEVICE FULL/
+SEMSG4, TEXT /?CLOSE ERROR/
+\fATIO, TEXT /#BAD FILENAME OR ERROR READING INDIRECT FILE/
+OVFLOW, TEXT /#COMMAND LINE OVERFLOW/
+BADNUM, TEXT /#BAD NUMBER/
+BADSTR, TEXT /#ILLEGAL * OR ?/
+\fBADX, TEXT /#BAD EXTENSION/
+BADOPT, TEXT /#BAD SWITCH OPTION/
+TOOLNG, TEXT /#COMMAND TOO LONG/
+REMBAD, TEXT \#I/O ERROR TRYING TO RECALL\
+\fBADSW, TEXT /#SWITCH NOT ALLOWED HERE/
+BADSW2, TEXT /#BAD CCL SWITCH/
+NONE, TEXT /NONE/
+BADREM, TEXT /#BAD RECOLLECTION/
+BADEV, TEXT /#BAD DEVICE/
+CONTRA, TEXT /#CONTRADICTORY SWITCHES/
+\fVMES, TEXT \OS/8 - KBM V3A - CCL V1A\
+ LOC78=VMES+1
+ VLOC=VMES+6
+ *.-2
+ CV=CCLVER&77
+ CCLNUM&77^100+CV
+ *.+1
+\fYEDIT, FILENAME EDIT.SV
+ *.-1
+YBOOT, FILENAME BOOT.SV
+ *.-1
+YFORT, FILENAME FORT.SV
+ *.-1
+YF4, FILENAME F4.SV
+ *.-1
+YBITMAP,FILENAME BITMAP.SV
+ *.-1
+YSRCCOM,FILENAME SRCCOM.SV
+ *.-1
+YBCOMP, FILENAME BCOMP.SV
+ *.-1
+YPAL8, FILENAME PAL8.SV
+ *.-1
+YFOTP, FILENAME FOTP.SV
+ *.-1
+/YCREF, FILENAME CREF.SV
+/ *.-1
+YDIRECT,FILENAME DIRECT.SV
+ *.-1
+\fYPIP, FILENAME PIP.SV
+ *.-1
+YABSLDR,FILENAME ABSLDR.SV
+ *.-1
+YLOADER,FILENAME LOADER.SV
+ *.-1
+YLOAD, FILENAME LOAD.SV
+ *.-1
+YTECO, FILENAME TECO.SV
+ *.-1
+YLPTSPL,FILENAME LPTSPL.SV
+ *.-1
+YCAMP, FILENAME CAMP.SV
+ *.-1
+YSET, FILENAME SET.SV
+ *.-1
+YBASIC, FILENAME BASIC.SV
+ *.-1
+YRXCOP, FILENAME RXCOPY.SV
+ *.-1
+YRESORC,FILENAME RESORC.SV
+ *.-1
+YBATCH, FILENAME BATCH.SV
+ *.-1
+YRALF, FILENAME RALF.SV
+ *.-1
+YSABR, FILENAME SABR.SV
+ *.-1
+YFRTS, FILENAME FRTS.SV
+ *.-1
+YDATE, FILENAME DATE.SV
+ *.-1
+YCCL, FILENAME CCL.SV
+ *.-1
+YHELP, FILENAME HELP.SV
+ *.-1
+YMACREL,FILENAME MACREL.SV
+ *.-1
+YLINK, FILENAME LINK.SV
+ *.-1
+\fBATHED, "$;"J;"O;"B;215;212;".;0
+BATAIL, ".;"R;240;"F;"O;"T;"P;215;212
+ "*;"S;"Y;"S;":;"C;"C;"B;"T;"C;"H;".;"T;"M;"/;"D;"$;215;212
+ "$;"E;"N;"D;215;212;32;0
+TEMNAM, FILENAME CCBTCH.TM
+\fLPTDEV, DEVICE LPT
+TVDEV, DEVICE TV
+TTYDEV, DEVICE TTY
+PTPDEV, DEVICE PTP
+DMPDEV, DEVICE DUMP
+NULDEV, DEVICE NULL
+\f BATBUF=4400 /LOCATION OF ONE BLOCK BATCH TEMP BUFFER
+ USR=200
+ GLINE=1200 /LOCATION FROM KBM
+ CTRLCK=1241 /LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C
+BATPTR, BATBUF-1
+LCHAR, 0
+
+SEMGO, CIF CDF 10
+ JMP I SEMI
+
+SEMI, 0
+ TAD (BEGLN-1
+ DCA XR
+SEMLUP, TAD I XR
+ SNA
+ JMP SEMGO /NO SEMICOLONS
+ TAD (-";
+ SZA CLA
+ JMP SEMLUP
+ CIF 10
+ CLA IAC /SYS
+ JMS I (USR
+ 3 /ENTER
+BLKNO, TEMNAM
+BLKLEN, 0 /NEG OF LENGTH
+ JMP SEMER1 /ENTER ERROR
+ TAD BLKNO
+ DCA BATBLK
+ TAD (BEGLN-1
+ DCA XR
+ TAD (7600
+ DCA I (CTRLCK /FORCE ^C TO GLINE TO GO TO 7600
+ JMS BATLST
+ BATHED
+S2, TAD I XR
+ SNA
+ JMP LINEND
+ DCA LCHAR /SAVE CHAR
+ TAD LCHAR
+ TAD (-";
+ SNA CLA
+ JMP GOTSEM
+ TAD LCHAR
+S3, JMS BATPUT
+ JMP S2
+\fLINEND, TAD LCHAR
+ TAD (-"; /LOOK AT LAST CHAR
+ SZA CLA /WAS IT SEMICOLON?
+ JMP BATEND /NO, END OF TEMP BATCH STREAM
+ JMS I (GLINE /YES, READ NEW LINE FROM KEYBOARD
+/**** WHAT IF WE'RE RUNNING UNDER BATCH ****
+ TAD (BEGLN-1
+ DCA XR
+ JMP S2
+
+GOTSEM, JMS KRLF
+ TAD (".
+ JMP S3
+
+KRLF, 0
+ TAD (215
+ JMS BATPUT
+ TAD (212
+ JMS BATPUT
+ JMP I KRLF
+
+BATPUT, 0
+ ISZ BATPTR
+ DCA I BATPTR
+ TAD BATPTR
+ TAD (-BATBUF-377
+ SNA CLA
+ JMS BATWRIT /WRITE OUT BUFFER IF FULL
+ JMP I BATPUT
+\fBATWRIT,0
+ JMS I (7607
+ 4200 /WRITE 1 BLOCK
+ BATBUF
+BATBLK, 0
+ JMP SEMER2 / I/O ERROR
+ ISZ BATBLK /POINT TO NEXT BLOCK
+ ISZ BATLEN /BUMP LENGTH
+ ISZ BLKLEN
+ SKP
+ JMP SEMER3 /DEVICE FULL
+ TAD (BATBUF-1
+ DCA BATPTR
+ JMP I BATWRIT
+
+BATEND, JMS KRLF
+ JMS BATLST
+ BATAIL
+ JMS BATWRIT
+ CIF 10
+ CLA IAC /SYS
+ JMS I (USR
+ 4 /CLOSE
+ TEMNAM
+BATLEN, 0 /LENGTH OF TEMPORARY FILE
+ JMP SEMER4 /CLOSE ERROR
+ CIF CDF 10
+ JMP I (ENGOA
+\fBATLST, 0
+ TAD I BATLST
+ DCA BTPT
+ ISZ BATLST
+BTLP, TAD I BTPT
+ SNA
+ JMP I BATLST
+ JMS BATPUT
+ ISZ BTPT
+ JMP BTLP
+
+BTPT, 0
+
+SEMER4, IAC /CLOSE ERROR
+SEMER3, IAC /DEVICE FULL
+SEMER2, IAC / I/O ERROR
+SEMER1, IAC /ENTER ERROR
+ CIF CDF 10
+ JMP I (SEMERR
+ PAGE
+\f FIELD 1
+ *2001
+ $
+\f
--- /dev/null
+/DECTAPE COPY, V10
+
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1966, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/DECTAPE COPY
+/VERSION .B07
+/
+/
+/COPYRIGHT 1968 DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASS. OCTOBER,1968
+
+
+\f
+/ THIS PROGRAM COPIES A DECTAPE FROM ONE
+/ SPECIFIED UNIT TO ANOTHER. ALL DECTAPE
+/ ROUTINES ARE INTERNALLY GENERATED SO THAT
+/ IT MAY BE RUN WITHOUT THE MONITOR SYSTEM.
+/
+/ STARTING ADDRESS IS 200
+/
+ DTRA=6761
+ DTCA=6762
+ DTXA=6764
+ DTSF=6771
+ DTRB=6772
+ DTLB=6774
+
+ WC=7754
+ CA=7755
+/ THESE AREAS ARE USED BY DATA BREAK
+BUFIOT=1547 /INPUT OUTPUT BUFFER
+BUFCHK=4563 /RE-READ BUFFER
+/
+*20
+/ PAGE ZERO WORKING STORAGE
+BADTRY, -3 /COUNT OF READ ERRORS
+CURBLK, 0 /CURRENT BLOCK NUMBER
+TRASH1, 0 /WORKING STORAGE
+TRASH2, 0 /WORKING STORAGE
+TRASH3, 0 /WORKING STORAGE
+BLKCNT, 0 /NUMBEROF BLOCKS TO READ
+ /OR MINUS THAT NUMBER
+SORBLK, 0 /STORAGE FOR CURBLK
+WORDS, 0 /NUMBER OF WORDS PER BLOCK
+INUNIT, 0 /INPUT UNIT IN LH OCT CHAR
+OUTUNI, 0 /OUTPUT UNIT IN LH OCT CHAR
+RESTOR, 0 /NUMBER OF WORDS TO COPY
+RESAVE, 0 /NEGATIVE OF BLKCNT
+SMICAR, 0 /CHARACTER STORAGE
+SMISUM, 0 /RUNNING SUM
+SPELIN, 0 /POINTER
+SEAZIK, 0 /INPUT AREA
+SEAZOK, 0 /TEMP STORAGE
+DECTWC, 0 /FLAG TO DETERMINE IF VALIDATION WILL OCCUR
+DECTCA, 0 /CURRENT ADDRESS STORE
+FIRST, 0 /STARTING BLOCK NUMBER
+LAST, 0 /LAST BLOCK NUMBER
+LENGTH, 0 /NUMBER OF WORDS TO COPY
+PARITY, 0 /PARITY ERROR FLAG (COUNT)
+MSKIN, 0 /NEGATIVE OF INUNIT
+PARDEL, PSTACK /POINTER TO PARITY TABLE
+/
+/ PAGE ZERO SUBROUTINES
+DIREC, 0
+ CLA
+ DTRA /FIND DIRECTION
+ AND [400
+ SZA CLA /BRANCH BACK
+ ISZ DIREC /REVERSE DIRECTION EXIT
+ JMP I DIREC /FORWARD DIRECTION EXIT
+/
+/
+BACKUP, 0 /SUBROUTINE REWINDS TAPE
+ CLA
+ DTRA
+ AND (670 /CLEAR DIRECTION AND MOVEMENT
+ DTXA
+ TAD (600 /GO IN REVERSE
+ DTXA
+ DTSF
+ JMP .-1 /WAIT UNTILL DONE
+ JMS I [ERROR /BUSYWORK FOR ERRORS
+ JMP I BACKUP /EXIT ON ENDZONE ERROR
+ JMP BACKUP+1
+\f
+*200
+BEGIN, CLA CLL /INITIALIZE
+ DTLB
+ TLS /TELETYPE OUTPUT
+ JMS I [SPEAK
+ MESS0
+ JMS I [SPEAK
+ MESS1 /INPUT UNIT NUMBER
+ JMS GETNUM /CHECK INPUT UNIT NUMBER
+ DCA INUNIT
+ TAD INUNIT
+ CIA /SET UP INPUT UNIT MASK
+ DCA MSKIN
+ JMS I [SPEAK
+ MESS2 /OUTPUT UNIT NUMBER
+ JMS GETNUM
+ TAD MSKIN /MAKE SURE UNITS ARE DIFFERENT
+ SNA
+ JMP BEGIN /INPUT ERROR
+ TAD INUNIT
+ DCA OUTUNI
+ JMS I [SPEAK /GET FIRST BLOCK NUMBER
+ MESSA
+ JMS I [SMIGIT
+ NOP
+ DCA CURBLK
+ TAD CURBLK
+ CIA /STORE BEGINNING MARKER
+ DCA FIRST
+ JMS I [SPEAK /GET LAST BLOCK NUMBER
+ MESSB
+ JMS I [SMIGIT
+ CLA CMA /KLUDGE IF NO INPUT
+ DCA LAST
+ TAD FIRST
+ CLL
+ SZA
+ TAD LAST /MAKE SURE VALID
+ SZA SNL CLA
+ JMP BEGIN
+ DTLB
+ TAD INUNIT /INIT INPUT UNIT
+ JMS I [FIXTAP
+ DCA WORDS /SET UP BLOCK LENGTH
+ TAD OUTUNI /INIT OUTPUT UNIT
+ JMS I [FIXTAP
+ CIA /MAKE SURE BLOCK LENGTH
+ TAD WORDS /SAME ON INPUT AND OUTPUT
+ SZA CLA
+ JMP BADLEN /BLOCK LENGTH ERROR
+ JMS I [SPEAK /TYPE OUT BLOCK LENGTH
+ MESS3
+ TAD WORDS
+ JMS I [TYPNUM
+ JMS I [SPEAK /SEND <RETURN><LINE FEED>
+ MESS0+11
+ TAD WORDS
+ CIA /COMPUTE NUMBER OF BLOCKS
+ DCA LENGTH /TO READ AND WRITE
+ DCA BLKCNT /CLEAR BLOCK COUNTER
+ TAD [3014 /LOAD BUFFER SIZE
+ TAD LENGTH
+ SPA
+ JMP BADLEN /TOO MANY WORDS PER BLOCK
+ ISZ BLKCNT /TALLY
+ TAD LENGTH
+ SMA
+ JMP .-3 /CONTINUE COUNTING
+ TAD WORDS /GET NUMBER OF
+ TAD [-3014 /WORDS TO READ
+ CIA /AND TO WRITE
+ DCA RESTOR /PRESERVE IN RESTOR
+ TAD RESTOR
+ DCA LENGTH
+ TAD BLKCNT /SAVE NEGATIVE OF BLKCNT
+ CIA
+ DCA RESAVE
+ JMS I [SPEAK
+ MESSC
+ JMS I [SMIGIT
+ NOP
+ DCA DECTWC /SET UP VERIFY FLAG
+/
+/ MAIN LOOP FOR COPY
+LETS, TAD CURBLK /CHECK FOR PARTIAL BLOCK TO COPY
+ TAD BLKCNT
+ CLL CMA IAC
+ TAD LAST
+ SZL
+ JMP LETT /COPY FULL LENGTH
+ DCA LENGTH /ADJUST WORDS TO COPY
+ TAD RESTOR
+ CIA
+ TAD WORDS
+ ISZ LENGTH
+ JMP .-2 /COMPUTE PROPER LENGTH
+ CIA
+ TAD WORDS
+ DCA LENGTH
+ TAD [REVERS /KLUDGE COPY EXIT
+ DCA I [COPY
+ JMP I [COPY+1 /PERFORM THIS COPY
+LETT, JMS I [COPY /COPY THIS BLOCKS
+ TAD BLKCNT
+ TAD BLKCNT /ADVANCE CURRENT BLOCK
+ TAD CURBLK
+ DCA CURBLK
+ JMS DIREC
+ JMP LETU /FORWARD EXCEEDED CHECK
+LETR, TAD CURBLK /REVERSE CHECK
+ TAD FIRST
+ CMA
+ SZA CLA /CHECK FOR MINUS 1
+ JMP LETT /CONTINUE COPY
+ JMP I [DONE /FINISHED JOB
+LETU, TAD CURBLK
+ CLL CMA IAC
+ TAD LAST
+ SZL CLA /CHECK FOR END OF TAPE
+ JMP LETS
+ JMP I [REVERV
+
+
+
+
+/ THIS SUBROUTINE GETS INPUT
+/ AND OUTPUT UNIT NUMBERS FROM
+/ THE TELETYPE AND VALIDATES THEM.
+/
+GETNUM, 0
+ JMS I [SMIGIT
+ NOP
+ AND [7
+ CLL RTR /MOVE TO LH THREE BITS
+ RTR
+ JMP I GETNUM
+/
+/
+
+BADLEN, JMS I [SPEAK /BLOCK LENGTH ERROR
+ MESS3A
+ JMP BEGIN
+/
+/
+/
+PAGE
+\f
+/
+/ THIS TURN AROUND IS ENTERRED
+/ WHEN THE LAST COPY MOVED INTO
+/ THE FINAL DATA AREA
+REVERV, TAD LAST
+ DCA CURBLK /START OF COPY BACK
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ TAD INUNIT
+ DTCA DTXA
+ JMS I [RESET /REPOSITION TAPE
+ TAD OUTUNI
+ DTCA DTXA
+ JMS I [RESET /REPOSITION TAPE
+REBACK, TAD CURBLK
+ CMA /COMPUTE NEW COPY LENGTH
+ TAD SORBLK
+ TAD BLKCNT
+ SNA
+ JMP REVERS /KLUDGE IF NOTHING TO DO
+ DCA SORBLK /MINUS # OF BLOCKS
+ TAD SORBLK
+ DCA BLKCNT /SAVE THIS NUMBER
+ TAD WORDS
+ ISZ SORBLK
+ JMP .-2
+ DCA LENGTH /LENGTH FOR COPY
+ JMS I [COPY /PERFORM IT
+ TAD CURBLK
+ TAD BLKCNT
+ TAD RESAVE /ADVANCE CURBLK
+ DCA CURBLK
+ TAD RESAVE
+ DCA BLKCNT
+ TAD RESTOR
+ DCA LENGTH
+ JMP I [LETR /CONTINUE COPY
+/
+/
+/ THIS TURN AROUND IS ENTERRED
+/ WHEN THE LAST SEARCH FOR
+/ CURRENT BLOCK CAUSED AN END
+/ OF TAPE ERROR
+/
+REVERT, JMS DIREC
+ SKP
+ JMP I [DONE /FINISHED IF DIRECTION REVERSE
+ TAD SORBLK
+ DCA CURBLK /RESTORE CURBLK
+ TAD OUTUNI /RESET LOCATION OF
+ DTCA DTXA /OUTPUT DECTAPE AND
+ JMS I [RESET /FIND LAST BLOCK
+ TAD [4000 /BY LOOKING FOR IMAGINARY
+ JMS I [SEARCH /BLOCK NUMBER (KLUDGING SEARCH)
+ NOP
+ JMP .-3 /TRY AGAIN ON ERRORS
+ TAD SEAZIK /MUST BE LAST BLOCK NUMBER
+ DCA CURBLK
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ JMP REBACK
+/
+/
+/ THIS TURN AROUND IS ENTERRED WHEN THE
+/ END BLOCK FOR COPY WAS REACHED BY A
+/ PARTIAL BUFFER COPY.
+/
+REVERS, CLA CMA /ADJUST CURBLK POINTER
+ TAD SORBLK
+ DCA CURBLK
+ TAD RESAVE
+ DCA BLKCNT /MAKE BLKCNT NEGATIVE
+ TAD RESTOR
+ DCA LENGTH /RESTORE COPY LENGTH
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ JMP I [LETR
+/
+REVALT, 0
+ TAD OUTUNI
+ TAD [400
+ DCA OUTUNI /REVERSE DIRECTION
+ TAD INUNIT
+ TAD [400
+ DCA INUNIT /REVERSE DIRECTION
+ JMP I REVALT
+/
+\f
+/THIS SUBROUTINE PERFORMS THE OPERATION
+/OF COPYING N BLOCKS AND VALIDATING
+/THE OUTPUT.
+/WHEN END OF TAPE IS REACHED THE ROUTINE
+/BRANCHES TO "REVERS", OR TO REVERT
+/AS APPROPRIATE.
+/
+COPY, 0
+ KSF /CHECK FOR <^C>
+ JMP .+5
+ KRB
+ TAD [-203
+ SNA
+ JMP I [7600
+ CLA
+ TAD INUNIT /LOAD STAT REG A
+ DTCA DTXA
+ TAD [-3
+ DCA BADTRY /RESTORE ERROR COUNTER
+ JMS I [DECTAP
+COPO, BUFIOT /INPUT AREA
+ 30 /READ CODE
+ NOP /NORMAL RETURN
+ TAD PARITY /CHECK PARITY FLAG
+ SZA
+ JMP I [ERRPAR /FIX MESSAGE FOR PARITY ERRORS
+COPZ, TAD OUTUNI /(IGNORE END ZONE)
+ DTCA DTXA /OUTPUT UNIT & DIRECTION
+COPYB, JMS I [DECTAP /WRITE OUTPUT TAPE
+ BUFIOT /OUTPUT BUFFER
+ 50 /WRITE CODE
+ JMP COPCPR /NORMAL RETURN
+ TAD [REVERS /END ZONE RETURN
+ DCA COPY /FIX UP EXIT
+COPCPR, TAD CURBLK
+ DCA SORBLK /STORE CURRENT BLOCK NUMBER
+ TAD DECTWC
+ SZA CLA
+ JMP I COPY /NO VERIFICATION
+ JMS I [RESET /RETURN TO FRONT END
+ JMS I [DECTAP /READ DATA
+COPR, BUFCHK /INPUT AREA
+ 30 /READ CODE
+ JMP .+2 /NORMAL RETURN BRANCH
+ TAD I [WC /END ZONE RETURN
+ TAD LENGTH
+ CIA
+ DCA TRASH3 /COUNTER
+ TAD COPO
+ DCA 17 /FORWARDS POINTER
+ TAD COPR /REREAD BUFFER
+ DCA 16 /SET UP POINTER
+COPCML, TAD I 16
+ CIA
+ TAD I 17
+ SZA
+ JMP COPERR /MISMATCH ON READ
+ ISZ TRASH3 /ANY MORE WORDS
+ JMP COPCML /LOOP
+ JMP I COPY /MADE IT! EXIT
+COPERR, ISZ BADTRY /HOW MANY ATTEMPTS
+ JMP COPERS /TRY AGAIN
+ JMS I [SPEAK
+ MESS5 /RE-READ ERRORS
+ JMS I [TUNIT /TYPE UNIT NUMBER AND WAIT
+ TAD [-3
+ DCA BADTRY /RESTORE ERROR COUNTER
+COPERS, CLA
+ JMS I [RESET
+ JMP COPYB /WRITE OUT BLOCK AGAIN
+/
+PAGE
+\f
+/ THIS SUBROUTINE MOVES THE DECTAPE
+/ BACK IN PREPARATION FOR ANOTHER
+/ READ OR WRITE.
+/
+RESET, 0
+ CLA CLL /CLEAR AC AND LINK
+ TAD [400 /CHANGE DIRECTION
+ DTXA
+ JMS DIREC /FIND DIRECTION
+ TAD [6 /FORWARD MAKE +3
+ TAD [-3 /REVERSE MAKE -3
+ TAD CURBLK
+ SPA /MAKE SURE VALUE IS PLUS
+ JMP RESEV
+ JMS I [SEARCH /FIND THIS BLOCK
+ SKP CLA /FOUND IT
+ JMP RESET+4
+REEXT, DTRA
+ AND [200 /CLEAR STOP-GO FLAG
+ TAD [400 /AND REVERSE DIRECTION
+ DTXA
+ JMP I RESET
+RESEV, JMS BACKUP /REWIND THIS TAPE
+ JMP REEXT
+/
+/
+/ THIS BRANCH IS TKEN WHEN
+/ ALL COPYING IS COMPLETED
+DONE, JMS I [SPEAK
+ MESS4
+ JMS I [SMIGIT
+ JMP I [BEGIN
+
+ JMP I [BEGIN
+\f
+/THIS SUBROUTINE READS NUMBERS,
+/NOT EXCEEDING 4098, FROM A TELETYPE
+/AND RETURNS THE OCTAL VALUE OF INPUT.
+/THE FOLLOWING SPECIAL CHARACTERS
+/ARE USD...<RETURN> MARKS END OF INPUT, CAUSES A <CR><LF>
+/IF THE <RETURN> IS THE FIRST CHARACTER THEN
+/DIRECT RETURN IS TAKEN, ELSE RETURN IS TO ENTRY+2
+/ <^C> CAUSES A BRANCH TO 7600
+/
+SMIGIT, 0
+ KCC /INITIALIZE TTY INPUT
+ DCA SMISUM /CLEAR TEMP STORAGE
+ JMS TTYIN /GET CHAR
+ AND [177
+ TAD [200
+ TAD [-215 /CHECK FOR <RETURN>
+ SNA
+ JMP SMIXIT /EXIT ON FIRST <RETURN>
+ ISZ SMIGIT /ADVANCE EXIT POINTER
+SMIGOP, TAD [12 /CHECK FOR ^C
+ SNA
+ JMP I [7600 /BRANCH TO MONITOR
+ TAD [-65 /CHECK FOR DIGITS
+ CLL
+ TAD [10
+ SNL
+ JMP SMILOP /INVALID CHARACTER
+ DCA SMICAR /TEMP STOR
+ TAD SMISUM /GET CHARACTER STRING
+ CLL RAL
+ CLL RAL
+ CLL RAL /ROTATE TO LH POSITION
+ TAD SMICAR /APPEND CURRENT DIGIT
+ DCA SMISUM
+ TAD SMICAR
+ TAD [260 /MAKE ASCII
+ JMS TYPE /ECHO CHARACTER
+SMILOP, JMS TTYIN /GET NEXT CHARACTER
+ TAD [-215 /CHECK FOR <RETURN>
+ SZA
+ JMP SMIGOP /CONTINUE LOOP
+SMIXIT, JMS I [SPEAK /SEND A <RETURN><LINE FEED>
+ MESS0+11
+ TAD SMISUM /GET INPUT STRING
+ JMP I SMIGIT /EXIT
+
+
+/THIS SUBROUTINE READS A CHARACTER FROM THE TTY
+TTYIN, 0
+ KSF /WAIT UNTIL READY
+ JMP .-1
+ KRB /READ TTY BUFFER
+ JMP I TTYIN
+\f
+/THIS SUBROUTINE TYPES OUT A
+/DIGIT STRING FROM THE AC
+/AS FOUR OCTAL CHARACTERS
+TYPNUM, 0
+ DCA SMICAR /PRESERVE STRING VALUE
+ TAD [-4
+ DCA SMISUM /INITIALIZE COUNTER
+TYPXL, TAD SMICAR
+ RTL
+ RAL /GET NEXT PRINT DIGIT
+ DCA SMICAR /RETURN TO STRING
+ TAD [3
+ AND SMICAR
+ RAL /ENTER CURRENT DIGIT
+ TAD [260 /MAKE ASCII
+ JMS TYPE /TYPE DIGIT
+ ISZ SMISUM /COUNT DIGITS
+ JMP TYPXL /COUNTINUE LOOP
+ JMP I TYPNUM /EXIT
+
+\f
+/THIS SUBROUTINE TYPES OUT A
+/MESSAGE IN "TEXT" FORMAT TWO
+/ASCII CHARACTERS PER WORD.
+/SPECIAL CHARACTERS ARE NOT
+/PERMITTED. A CARRIGE RETURN
+/AND LINE FEED PRECEED THE
+/MESSAGE.
+/ JMS I [SPEAK <BRANCH TO SUBROUTINE>
+/ MESSAGE <POINTER TO MESSAGE BUFFER>
+/A ZERO WORD MARKS THE
+/END OF THE MESSAGE.
+/
+SPEAK, 0
+ CLA CLL
+ TAD [215
+ JMS I [TYPE /CARRIGE RETURN
+ TAD I SPEAK /GET ADDRESS OF OUTPUT
+ DCA SPELIN
+ ISZ SPEAK
+ TAD [212
+ JMS I [TYPE /LINE FEED
+SPEELH, TAD I SPELIN /GET NEXT WORD
+ SNA /CHECK FOR ZERO
+ JMP I SPEAK /EXIT IF ZERO
+ AND [7700 /GET LH CHARACTER
+ CLL RTR /MOVE TO
+ RTR /RIGHT HAND
+ RTR /SIX BITS
+ JMS SPEOUT /TRANSLATE AND OUTPUT
+ TAD I SPELIN
+ ISZ SPELIN /ADVANCE POINTER
+ AND [77 /GET RH CHARACTER
+ JMS SPEOUT /TRANSLATE AND OUTPUT
+ JMP SPEELH
+SPEOUT, 0
+ TAD [-40 /CHECK FORMAT
+ SMA
+ TAD [-100 /KLUDGE DIGITS FORMAT<200+XX>
+ TAD [340 /ALPHA FORMAT <300+XX>
+ JMS I [TYPE /OUTPUT IT
+ JMP I SPEOUT /RETURN
+
+/
+/THIS SUBROUTINE TYPES OUT
+/THE ASCII CHARACTER IN THE AC.
+/
+TYPE, 0
+ TSF /WAIT UNTIL READY
+ JMP .-1
+ TLS /TYPE CHARACTER
+ CLA
+ JMP I TYPE
+/
+/THIS SUBROUTINE TYPES OUT THE
+/CURRENT UNIT NUMBER
+TUNIT, 0
+ CLA
+ DTRA
+ AND [7000 /GET CURRENT UNIT NUMBER
+ CLL RTL /MOVE OVER
+ RTL
+ TAD [260 /MAKE ASCII CODE
+ JMS I [TYPE /TYPE IT
+ JMS I [SMIGIT /WAIT
+ JMP I TUNIT /EXIT
+ JMP I TUNIT
+/
+/
+PAGE
+\f
+/THIS SUBROUTINE SEARCHES DECTAPE
+/IN A FORWARD OR REVERSE DIRECTION.
+/STATUS REGISTER A SHOULD CONTAIN
+/UNIT SELECT NUMBER (0-2), FORWARD
+/OR REVERSE, AND A5=1.
+/THE BLOCK NUMBER FOR WHICH THE PROGRAM IS
+/SEARCHING MUST BE IN THE AC.
+/ON ERROR RETURN THE COMAND
+/FOLLOWING THE "JMS" IS SKIPPED,
+/AN END OF TAPE ERROR WILL CAUSE
+/THREE MOVES INTO ENDZONE AND TWO COMMANDS FOLLOWING
+/THE "JMS" ARE SKIPPED
+SEARCH, 0
+ CIA /FORM TWO'S COMPLEMENT
+ DCA SEAZOK /STORE - BLOCK NUMBER
+ DCA SEAZIK /CLEAR INPUT WORD
+ DTRA
+ AND [274
+ DTXA /CLEAR OUT A REGISTER
+ TAD [210 /START DEVICE
+ DTXA
+ JMS DIREC /DETERMINE DIRECTION
+ TAD [NOP-CIA /FORWARD...FIX TO "NOP"
+ TAD [CIA /REVERSE...FIX TO "CIA"
+ DCA SEATIX /FIX UP COMMAND
+ TAD [SEAZIK /BLOCK NUMBER INPUT
+ DCA I [CA /PUT IN CURRENT ADDRESS
+ CLA CMA /NUMBER OF BLOCKS=1
+ JMS SEARUN /FIND FIRST BLOCK MARK
+ TAD [100 /SET CONTINUOUS MODE FLAG
+ DTXA
+ TAD SEAZIK /BLOCK NUMBER HERE
+ TAD SEAZOK /MINUS BLOCK NUMBER THERE
+SEATIX, NOP /IFSEARCHING IN REVERSE DIRECTION
+*.-1
+ CIA /IF SEARCHING IN FORWARD DIRECTION
+ SPA /SKIP IF DONE
+ JMS SEARUN /FIND "N" BLOCK MARKS
+ DTRA
+ AND [100 /CLEAR CONTINUOUS MODE FLAG
+ DTXA
+ JMP I SEARCH /NORMAL EXIT
+SEARUN, 0
+ DCA I [WC /NUMBER OF BLOCKS TO READ
+ DTXA
+ DTSF /CHECK FOR DONE
+ JMP .-1
+ DTRB /READ STATUS REGISTER B
+ SMA CLA
+ JMP I SEARUN /DT FLAG...NORMAL EXIT
+ JMS I [ERROR /HANDLE ALL ERRORS
+ ISZ SEARCH /END OF TAPE ERROR
+ ISZ SEARCH /ALL OTHER ERRORS
+ JMP SEARUN-4 /EXIT
+
+\f
+/THIS SUBROUTINE READS OR WRITES
+/<N> WORDS, IN CONTROL MODE, ON
+/A BLOCK(S) ASSUMING THAT
+/THE DECTAPE IS PROPERLY
+/POSITIONED. IN LINE CODE:
+/ JMS I [DECTAP
+/ <BUFFER> ADDRESS TO READ INTO (OR WRITE FROM) -1
+/ <3> IF READ, <5> IF WRITE
+/<<NORMAL RETURN>>
+/<<END OF TAPE ERROR>>
+/AN END OF TAPE ERROR WHILE SEARCHING
+/CAUSES A BRANCH TO "REVERT".
+/STATUS REGISTER A SHOULD CONTAIN:
+/AO-2 UNIT NUMBER
+/A3 FORWARD=0, REVERSE=1
+/A4 UNIMPORTANT, SHOULD BE ZERO
+/A5 1
+/A6-8,89 UNIMPORTANT
+/BLOCK NUMBER IN PAGE ZERO "CURBLK"
+/NUMBER OF WORDS TO READ OR
+/WRITE IS IN PAGE ZERO "LENGTH"
+/
+DECTAP, 0
+ TAD I DECTAP /GET INPUT BUFFER
+ DCA DECTCA /STORE
+ ISZ DECTAP
+DECAGN, TAD CURBLK /SEARCH FOR BLOCK
+ JMS I [SEARCH
+ JMP DECRUN /FOUND IT
+ JMP DECAGN
+ JMP I [REVERT /END ZONE ERROR
+DECRUN, TAD SEAZIK
+ TAD SEAZOK /CHECK TO SEE IF FOUND BLOCK
+ SZA
+ JMP DECEXT-3
+ TAD LENGTH /SET UP WORD COUNT
+ CIA
+ DCA I [WC
+ TAD DECTCA /AND INPUT OUTPUT BUFFER
+ DCA I [CA
+ TAD I DECTAP /GET READ OR WRITE
+DECLOP, DTXA /START GOING
+ DTSF
+ JMP .-1
+ DTRB /GET FLAGS
+ SMA
+ JMP DECEXI
+ JMS I [ERROR
+ JMP DECEXT-1 /ENDZONE ERROR
+ JMS I [RESET /RESTORE POINTERS
+ JMP DECAGN
+ ISZ DECTAP /END OF TAPE EXIT
+DECEXT, ISZ DECTAP
+ CLA
+ JMP I DECTAP /FINISHED
+DECEXI, CLA
+ TAD I [WC /HAVE WE FINISHED?
+ SZA CLA
+ JMP DECLOP /NO-:CONTINUE READ-WRITE
+ DTRA /YES--CLEAR STATUS
+ AND [274
+ DTXA
+ JMP DECEXT
+\f
+/THIS SUBROUTINE CHECKS THE CONTENTS
+/OF STATUS REGISTER B.
+/ <BRANCH> JMS I [ERROR
+/ <+1 END OF TAPE ERROR>
+/ <+2 ALL OTHER ERRORS>
+/IN ADDITION: 1--A SELECT ERROR WILL
+/CAUSE A TYPEOUT AND HALT. 2--A PARITY
+/ERROR ON OUTPUT TAPE CAUSES A
+/BRANCH TO "COPERS"; ON INPUT TAPE
+/"PARITY ERROR" IS TYPED OUT. 3--GO FLIP-FLOP
+/AND STATUS REGISTER A6-8 WILL BE CLEARED.
+/
+ERROR, 0
+ CLA CLL
+ DTRB /GET ERROR FLAGS
+ AND [200 /PARITY ERROR FLAG
+ SNA CLA
+ JMP ERNOT /HANDLE OTHER ERRORS
+ DTXA /CLEAR FLAGS, CONTINUE READ MODE
+ DTRA /GET UNIT NUMBER
+ AND [7000
+ TAD MSKIN /CHECK FOR INPUT UNIT
+ SZA
+ JMP I [COPERR /ERROR ON OUTPUT UNIT
+ TAD I [WC /PUT WORD COUNT IN PUSH
+ CIA
+ DCA I PARDEL /DOWN STACK
+ ISZ PARDEL /ADVANCE POINTER
+ ISZ PARITY /SET FLAG
+ JMP I [DECEXI /RETURN TO READ
+ERNOT, DTRA /GET STATUS REGISTER A
+ AND [274
+ TAD [2 /DO NOT DISTURB ERROR FLAGS
+ DTXA /CLEAR A4 AND A6-8
+ DTRB /GET ERROR FLAGS
+ RTL
+ SMA /SKIP IF END OF TAPE ERROR
+ JMP ERROTH
+ CLA
+ TAD [-3 /LOAD -3
+ DCA ERRSOR /STORE IN COUNT
+ TAD [200 /GO FLIP-FLOP
+ DTXA /SET
+ DTSF
+ JMP .-1
+ ISZ ERRSOR /HAVE WE DONE THREE TIMES
+ JMP .-5
+ JMP I ERROR /EXIT
+ERRSOR, 0
+ERROTH, ISZ ERROR /CHANGE ERROR BRANCH
+ SZL
+ CLA CLL /MARK TRACK ERROR
+ RTL
+ SNL CLA
+ JMP I ERROR /TIMING ERROR BRANCH
+ JMS I [SPEAK /SELECT ERROR MESSAGE
+ ERRSEL
+ERRUNT, JMS I [TUNIT
+ JMP I ERROR
+/
+PAGE
+\f
+/ VARIOUS MESSAGES
+MESS0, TEXT %DECTAPE COPY V10A %
+MESSA, TEXT %FIRST BLOCK TO COPY (OCTAL) %
+MESSB, TEXT %FINAL BLOCK TO COPY (OCTAL) %
+ERRSEL, TEXT %SELECT ERROR ON UNIT #%
+PMESS, TEXT %PARITY ERROR ON BLOCK %
+MESSC, TEXT %VERIFY OUTPUT? (0=YES, 1=NO): %
+MESS1, TEXT %FROM UNIT %
+MESS2, TEXT %TO UNIT %
+MESS3, TEXT %PDP-8 WORDS PER BLOCK %
+MESS4, TEXT %DONE%
+MESS5, TEXT %WRITE ERRORS ON UNIT #%
+MESS3A, TEXT %BLOCK LENGTH ERROR%
+/
+/
+PAGE
+/
+/
+\f
+/THIS ROUTINE TYPES OUT PARITY ERROR MESSAGES
+/AND RESTORES POINTERS TO THE PUSH DOWN STACK.
+ERRPAR, CIA
+ DCA PARITY /SET UP STACK COUNTER
+ CLA CMA
+ TAD PARDEL /MOVE POINTER BACK
+ DCA PARDEL
+ JMS I [SPEAK /TYPE OUT MESSAGE
+ PMESS
+ TAD CURBLK
+EPLOOP, DCA EPJK
+ TAD I PARDEL /CHECK FOR CORRECT BLOCK NUMBER
+ TAD WORDS /ADVANCE BLOCK WORDS COUNT
+ DCA I PARDEL
+ TAD I PARDEL
+ CIA /REACHED ORIGINAL VALUE?
+ TAD LENGTH
+ SNA CLA
+ JMP EPTYP /TYPE BLOCK AT ERROR
+ JMS DIREC
+ CLL CMA RAL /ADD ONE IF FORWARD
+ CMA /SUBTRACT ONE IF NEGATIVE
+ TAD EPJK /NEXT BLOCK NUMBER
+ JMP EPLOOP /CONTINUE LOOP
+EPTYP, TAD EPJK
+ JMS I [TYPNUM /TYPE BLOCK NUMBER
+ ISZ PARITY /ADVANCE COUNTER
+ JMP ERRPAR+2 /CONTINUE LOOP
+ JMP I EPPEXT /RETURN TO COPY
+EPPEXT, COPZ /REENTRY TO COPY
+EPJK, 0 /WORKING STORAGE
+\f
+/THIS SUBROUTINE READS A RANDOM
+/BLOCK ON DECTAPE TO DETERMINE THE BLOCK LENGTH
+FIXTAP, 0
+ TAD [610 /FIX A REG. WORD
+ DTCA DTXA /LOAD A STAT. REG.
+ CLA CMA
+ DCA I [WC /SEARCH FOR 1 BLOCK
+ TAD [BUFIOT /FIX CURRENT ADDRESS
+ DCA I [CA /TO READ INTO BUFFER
+ DTSF /WAIT AROUND
+ JMP .-1
+ DTRB
+ SPA CLA
+ JMP FIXERR /HANDLE ERROR CONDITIONS
+ TAD [30 /CHANGE TO READ MODE
+ DTXA
+ DTSF /WAIT TILL READ DONE
+ JMP .-1
+ TAD [200 /STOP TAPE
+ DTXA
+ TAD I [WC /GET BLOCK LENGTH
+ JMP I FIXTAP /EXIT
+FIXERR, JMS I [ERROR
+ TAD [400 /END OF TAPE...REVERSE DIRECTION
+ TAD [210 /START TAPE MOVING
+ DTXA /AND CLEAR FLAGS
+ JMP FIXTAP+3 /TRY AGAIN
+\f
+/PARITY ERROR WORD COUNT STACK
+PSTACK, 0
+
+
+/
+
+/END OF PROGRAM
+$
--- /dev/null
+/ OS/8 HELP PROGRAM
+/
+/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/ AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/ CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/ FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/ THE SOFTWARE DESCRIBED HEREIN IS FURNISHED TO THE PURCHASER
+/ UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/ (WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/ SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/ DIGITAL EQUIPMENT ASSUMES NO RESPONSIBILITY FOR THE USE
+/ OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED
+/ BY DIGITAL.
+/
+/ COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+\f
+/
+/ VERSION #1 B. M. 1/1/77
+/ VERSION #2A M. H. 4/22/77
+/ (CHANGE TAG VERS WHEN CHANGING VERSION NUMBERS)
+/
+/ THIS PROGRAM CAN BE CALLED DIRECTLY OR CHAINED TO BY CCL TO
+/ PRINT INFORMATION ON RANDOM SUBJECTS THE USER ASKS ABOUT.
+/
+/ START ADDRESS:200 JSW:3401
+/ CORE LIMITS:200-7377
+/
+/ THIS PROGRAM REQUIRES AN INPUT FILE TO RUN. FOR OS/8 THE FILE
+/ SHOULD BE NAMED "HELP8.HL" FOR OS/78 THE NAME SHOULD BE "HELP78.HL".
+/
+/ THE FORMAT OF THE FILE IS:
+/ <SP><CR><LF>
+/ &COMMAND NAME
+/ &ADDITIONAL COMMAND NAMES(IF ANY)
+/ TEXT OF HELP INFO
+/ &NEXT COMMAND NAME
+/ TEXT OF NEXT HELP INFO
+/ ETC.
+/
+/ NOTE: TOO SPEED UP PROCESSING A HASHING ALGORITHM IS USED
+/ WHICH REQUIRES THAT WHEN MULTIPLE COMMANDS REFERENCE A
+/ SINGLE SUBFILE, THE SUBFILE MUST APPEAR IN THE HELP FILE
+/ ALPHABETICALLY ACCORDING TO THE 1ST COMMAND STRING LETTER
+/ CLOSEST TO Z.
+/ THAT IS, SUBFILES MUST BE ARRANGED ALPHABETICALLY ACCORDING TO
+/ THE HIGHEST LETTERED 1ST CHARACTER OF THE COMMAND.
+/
+\f
+USR= 200 /ADDRESS OF USR
+OS78= 7771 /ADDRESS OF WD WITH OS/78 FLAG BIT(4) (MH)
+FETCH= 1 /FETCH A HANDLER
+LOOKUP= 2 /LOOKUP A FILE NAME
+ENTER= 3 /ENTER A FILE
+CLOSE= 4 /CLOSE A FILE
+DECODE= 5 /CALL THE COMMAND DECODER
+HASH= 3 /HASH CODE SUBTRACTION FACTOR(MH)
+
+*10
+NAMPTR, 0 /POINTER TO CMD DECODER INPUT NAMES
+XR1, 0 /RANDOM INDEX REGISTER
+XR2, 0 /ANOTHER RANDOM INDEX REGISTER
+
+*30
+COUNT, 0 /RANDOM WORD COUNT FOR ANYTHING
+CHAR, 0 /TEMPORARY PLACE TO PUT A CHARACTER
+WILD, 0 /IF NONZERO, NAME HAS '*' OR '?' IN IT
+WASHLP, 0 /NONZERO IF HELP WAS FOUND ON THIS WORD
+NAME, ZBLOCK 6 /NAME HELP WAS REQUESTED ON
+TXTNAM, ZBLOCK 10 /CURRENT SCRIPT FILE NAME BEING LOOKED AT
+NAMCNT, 0 /NUMBER OF NAMES IN THE COMMAND DECODER AREA
+BLKCNT, 0 /NUMBER OF AVAILABLE BLOCKS ON OUTPUT
+OUTADR, 0 /ADDRESS OF OUTPUT HANDLER
+LINCNT, 0 /COUNT OF NUMBER OF NAMES ON '*' OR 'HELP' LINE
+LINMAX, -5 /MAXIMUN NUMBER OF NAMES/LINE ON '*' OR 'HELP' LINE
+FILNAM, ZBLOCK 4 /OUTPUT FILE NAME
+WDCTR, 0 /WORD COUNTER IN INPUT BLOCK
+CHTEM, 0 /TEMPORARY SPOT FOR CHARACTER IN 2/3 UNPACK
+DEVHND, 0 /OUTPUT DEVICE HANDLER ADDRESS
+CHPTR, 0 /BUFFER POINTER FOR READING CHARACTERS
+TEMP, 0 /TEMP STORE
+\f
+/ MAIN LOOP OF PROGRAM
+STADR=200
+*STADR
+START, SKP CLA /NORMAL ENTRY POINT
+ JMP START1 /CHAINED ENTRY (CMD DECODE DONE BY CCL)
+ CIF 10 /SEE WHAT TO DO
+ JMS I (USR
+ DECODE
+ 5200
+ 0
+START1, JMS I (INIT /DO ALL INITIALIZATION AND SETUP
+MAINLP, JMS I (NXTNAM /GET NEXT NAME FROM COMMAND DECODER AREA
+ JMP I (EXIT /NO NAMES LEFT
+ JMS I (RESET /RESET THE INPUT FILE POINTERS TO THE BEGINNING
+ TAD NAME /CHECK FOR '*' OR 'HELP" NAME INDICATING LIST OF HELPS
+ TAD (-"*
+ SNA!CLA
+ JMP HELPLS /NAME BEGAN WITH '*'
+ TAD NAME /NOT '*' LOOK FOR HELP (MH)
+ TAD (-"H
+ SZA!CLA
+ JMP MAIN1 /NO 'HELP'
+ TAD NAME+1
+ TAD (-"E
+ SZA!CLA
+ JMP MAIN1
+ TAD NAME+2
+ TAD (-"L
+ SZA!CLA
+ JMP MAIN1
+ TAD NAME+3
+ TAD (-"P
+ SNA!CLA
+ JMP HELPLS /WAS 'HELP" GO PRINT LIST (MH)
+ TAD NAME /IS 1ST CHAR A "?"?(MH)
+ TAD (-"? /(MH)
+ SNA!CLA /(MH)
+ JMP MAIN1 /YES -- DON'T TRY TO HASH FILE (MH)
+ TAD NAME /NO -- HASH START BLK OF FILE BY (MH)
+ AND (77 /MAKING 1ST CHAR OF NAME SIXBIT (MH)
+ DCA TEMP /MULTIPLY BY 1.5 (MH)
+ TAD NAME /THEN SUBTRACT "HASH"(3) (MH)
+ AND (77 /(MH)
+ CLL!RAR /(MH)
+ TAD TEMP /(MH)
+ TAD (-HASH /(MH)
+ SPA /(MH)
+ CLA /IF RESULT IF MINUS, SET TO ZERO (MH)
+ TAD I (BLK /ADD REAL START BLK OF FILE (MH)
+ DCA I (BLK /REPLACE NEW BLOCK(MH)
+MAIN1, JMS I (FINDNM /GET A NAME FROM THE SCRIPT FILE
+ JMP NOHELP /HIT THE END OF THE FILE INSTEAD OF NAME
+ JMS I (COMPAR /COMPARE THIS NAME WITH THE ONE HE HAD
+ JMP MAIN1 /NOT A MATCH, TRY NEXT ONE
+ JMS I (PRINT /PRINT THE HELP INFORMATION FOR THAT NAME
+ TAD WILD /IF A WILD CARD TYPE NAME (I.E. '?') THEN
+ SZA CLA / THEN KEEP SEARCHING PAST 1ST MATCH SINCE THERE
+ JMP MAIN1 / MAY BE MORE.
+ JMP MAINLP /NOT A WILD CARD, GET NEXT CMD DECODER NAME
+
+/ HIT THE END OF THE SCRIPT FILE
+/ IF DOING A WILD CARD NAME, SOME HJELP MAY HAVE ALREADY BEEN PRINTED. IF
+/ NOT, PRINT AN ERROR MESSAGE ON THE TELETYPE (OR WHATEVER)
+NOHELP, TAD WASHLP /SEE IF HELP WAS ADMINISTERED
+ SZA CLA
+ JMP MAINLP /YES IT WAS, TRY NEXT NAME ON LIST
+ JMS I (TYPE /TYPE THE ERROR MESSAGE ON THE TTY
+ SORRY-1
+ DCA TXTNAM /PUT ON ZERO TERMINATER
+ JMS I (TYPE
+ NAME-1 /TYPE WHAT HELP MISSED
+ JMS I (TYPE
+ CRLF-1 /TYPE CARR RETURN, LINE FEED
+ JMP MAINLP /NOW CONTINUE ON WITH IT
+
+
+/ IF A '*' OR 'HELP' WAS TYPED AS HELP NAME, THEN PRINT A LISTING
+/ OF ALL THE INFO IN THE HELP FILE FOR THE USER TO PICK FROM.
+HELPLS, JMS I [OUTSTR /PRINT THE HEADING MESSAGE
+ AVAIL-1
+ TAD LINMAX /MAX NO. NAMES PER LINE
+ DCA LINCNT /INITIAL COUNT OF NAMES PER LINE
+HELP1, JMS I (FINDNM /GET NEXT NAME
+ JMP HELP2 /AT END OF FILE
+ JMS I (NAMLST /PRINT THE NAME
+ JMP HELP1
+HELP2, TAD LINCNT /CHECK IF LAST CHAR WAS CRLF
+ SNA!CLA
+ JMP MAINLP /IT WAS, DON'T DO ANOTHER
+ JMS I [OUTSTR
+ CRLF-1
+ JMP MAINLP
+\f PAGE
+
+/ CLOSE ALL FILES AND RETURN TO MONITOR
+/
+EXIT, TAD (32 /WRITE AN AND OF FILE TO THE OUTPUT
+ JMS I [PCH
+ TAD (-600 /CLOSE FILE BY WRITING 600(8) NULLS
+ DCA COUNT
+ JMS I [PCH /WRITE IT
+ ISZ COUNT
+ JMP .-2
+ TAD I [BLKSRT /COMPUTE ACTUAL FILE LENGTH FOR CLOSE
+ CIA
+ TAD I [OUTBLK /CURRENT BLOCK NUMBER
+ IAC
+ DCA OLEN
+ CIF CDF 10
+ TAD I [7600
+ CDF 0
+ JMS I (USR /CLOSE THE FILE
+ CLOSE
+ FILNAM
+OLEN, 0 /THE LENGTH
+ NOP /ERROR ON CLOSE... CAN'T HAPPEN(MH)
+ JMP I (7605 /RETURN TO OS/8
+\f
+/ SEARCH FOR A <LF>& IN THE FILE
+/ THIS IS THE START OF SOME HELP INFO FOR A SUBJECT WHICH IS NAMED AFTER
+/ THE &. COPY THE NAME INTO 'TXTNAM' SO COMPARES CAN BE DONE LATER.
+/ SKIP IF THE END OF FILE ISN'T FOUND ON THE WAY.
+FINDNM, 0
+ DCA TXTNAM /CLEAR THE NAME OUT
+ DCA TXTNAM+1
+ DCA TXTNAM+2
+ DCA TXTNAM+3
+ DCA TXTNAM+4
+ DCA TXTNAM+5
+ DCA TXTNAM+6
+FIND1, JMS I [GCH /LOOK FOR A <LF>& IN THE FILE
+ TAD (-232 /CHECK FOR END OF FILE
+ SNA
+ JMP I FINDNM /RETURN IF FOUND
+ TAD (232-212 /CHECK FOR LINE FEED
+ SZA CLA
+ JMP FIND1 /NOT IT
+FIND5, JMS I [GCH /TRY FOR THE & NOW
+ TAD (-"&
+ SNA CLA
+ JMP FIND2 /FOUND A LF,&
+ TAD ("&-232 /MAKE SURE THIS ISNT THE END OF FILE
+ SNA CLA
+ JMP I FINDNM /END OF FILE FOUND, RETURN
+ JMP FIND1 /KEEP LOOKING FOR NAME
+FIND2, TAD (TXTNAM-1 /MOVE THE NAME INTO 'TXTNAM'
+ DCA XR1
+ TAD (-7 /MAX OF 7 CHARACTERS
+ DCA COUNT
+FIND3, JMS I [GCH /GET A NAME CHARACTER
+ TAD (-215 /CHECK IF THE END OF LINE <CR>
+ SNA CLA
+ JMP FIND4 /END OF LINE, THATS IT
+ TAD CHAR
+ DCA I XR1 /SAVE CHARACTER IN TXTNAM
+ ISZ COUNT
+ JMP FIND3 /IF MORE CHARACTERS LEFT
+FIND4, ISZ FINDNM /BUMP RETURN ADDRESS FOR FOUND RETURN
+ JMP I FINDNM
+ PAGE
+\f
+/ COMPARE TWO STRINGS, ONE IN NAME AND ONE IN TXTNAM. CHECK FOR WILD
+/ CARD STUFF LATER WHEN THIS PART IS WORKING.
+/ SKIP IF NAMES ARE EQUAL
+COMPAR, 0
+ TAD [NAME-1 /SET UP REGISTERS FOR COMPARE
+ DCA XR1
+ TAD (TXTNAM-1
+ DCA XR2
+ TAD (-6
+ DCA COUNT
+COMP1, TAD I XR1 /GET A CHARACTER AND COMPARE WITH ONE FROM
+ DCA CHAR
+ TAD CHAR
+ TAD (-"? /WILDCARD
+ SZA CLA
+ JMP COMP3 /NO WILDCARD
+ ISZ XR2
+ ISZ WILD
+ JMP COMP2
+COMP3, TAD CHAR
+ CIA / THE OTHER STRING
+ TAD I XR2
+ SZA CLA
+ JMP I COMPAR /NO MATCH, NORMAL RETURN
+COMP2, ISZ COUNT
+ JMP COMP1
+ ISZ COMPAR /EQUAL RETURN IS RETRN ADDR+1
+ JMP I COMPAR
+\f
+/ GET THE NEXT NAME FROM THE COMMAND DECODER AREA
+/ STOP ON EITHER A ZERO OR THE NAME GOING TO ZERO
+NXTNAM, 0
+ ISZ NAMCNT /COUNT NAMES, ONLY 5 IN THE AREA
+ SKP
+ JMP I NXTNAM /RETURN, NO MORE NAMES
+ CLA CLL CMA RTL /NUMBER OF WORDS OF NAME(-3)
+ DCA COUNT
+ TAD [NAME-1
+ DCA XR1
+ CDF 10
+ TAD I NAMPTR /GET 1ST CHARACTER OF NAME
+ CDF 0
+ SNA
+ JMP NXTN3 /MAYBE OUT OF NAMES(MH)
+NXTN1, DCA CHAR /SAVE THE WORD
+ TAD CHAR
+ RTR
+ RTR
+ RTR /ISOLATE HIGH 6 BITS
+ JMS SIXTO8
+ DCA I XR1 /PUT IN NAME BUFFER
+ TAD CHAR /NOW DO OTHER HALF
+ JMS SIXTO8
+ DCA I XR1 /2ND CHARACTER OF WORD
+ ISZ COUNT
+ SKP
+ JMP NXTN2 /NO MORE CHARACTERS IN NAME
+ CDF 10
+ TAD I NAMPTR /LOOP IS STRANGE (SHOULD USE DEVICE WORD FOR CHECK)
+ CDF 0
+ JMP NXTN1
+NXTN2, ISZ NAMPTR /BUMP POINTER TO NEXT NAME IN AREA
+ ISZ NAMPTR
+ ISZ NXTNAM /BUMP RETURN ADDRESS FOR FOUND NAME
+ JMP I NXTNAM
+NXTN3, TAD NAMCNT /CHECK FOR "HELP<CR>" OR "TTY:<<CR>"(MH)
+ TAD (4 /IF 1ST TRY AT A NAME THEN NULL COMMAND WAS INPUT(MH)
+ SZA!CLA
+ JMP I NXTNAM /WASN'T NULL -- RETURN, END OF NAMES
+ DCA NAME /WAS NULL -- CLEAR OUT NAME BUFFER
+ DCA NAME+1
+ DCA NAME+2
+ DCA NAME+3
+ DCA NAME+4
+ DCA NAME+5
+ JMP NXTN2 /PREPARE TO RETURN(MH)
+
+SIXTO8, 0 /CONVERT 6BIT TO 8BIT
+ AND (77
+ SNA /SNA IF NOT A NULL
+ JMP I SIXTO8 /ELSE RETURN 8BIT NULL
+ TAD (240
+ AND (77
+ TAD (240
+ JMP I SIXTO8
+\f
+/ PRINT ALL THE STUFF BETWEEN LINES OF THE OUTPUT DEVICE
+/ THIS CONTINUES UNTIL A <LF>& IS SEEN OR AND OF FILE IS READ
+PRINT, 0
+ ISZ WASHLP /SET FLAG SAYING HE WAS HELPED
+PRINT3, JMS I [GCH /FIND 1ST LF WITHOUT FOLLOWING &, THEN PRINT(MH)
+ TAD (-212 /WAS CHAR LF?(MH)
+ SZA!CLA /(MH)
+ JMP PRINT3 /NO -- READ NEXT CHAR(MH)
+ JMS I [GCH /YES -- LOOK FOR &(MH)
+ TAD (-"& /(MH)
+ SNA!CLA /(MH)
+ JMP PRINT3 /IT WAS & SO CONTINUE(MH)
+ JMS I (OUTSTR /IT WASN'T & SO BEGIN PRINTING(MH)
+ CRLF-1
+ TAD CHAR /(MH)
+ SKP /(MH)
+PRINT1, JMS I [GCH /GET A CHARACTER
+ JMS I [PCH /PRINT THE CHARACTER
+ TAD CHAR /CHECK FOR <LF>
+ TAD (-212
+ SZA CLA
+ JMP PRINT1
+ JMS I [GCH /TRY FOR EITHER & OR END OF FILE OR FF
+ TAD (-"& /CHECK FOR A &
+ SNA
+ JMP I PRINT /STOP ON <LF> & FOUND
+ TAD (+32 /CHECK FOR <FF> ("&-"<FF> (MH)
+ SNA /(MH)
+ JMP I PRINT /(MH)
+ TAD (-16 /-<EOT>+<FF> (MH)
+ SNA
+ JMP I PRINT /RETURN IF END OF FILE
+ TAD (232-"@
+ SNA CLA
+ JMP PRINT1 /SKIP "@" IF 1ST CHAR ON LINE
+ TAD CHAR /GET THE CHARACTER BACK TO PRINT
+ JMS I [PCH /PRINT IT
+ JMP PRINT1
+ PAGE
+\f/ TYPE A MESSAGE ON THE TELETYPE
+/ THE MESSAGE IS ONE CHARACTER PER WORD, TERMINATED WITH A ZERO
+TYPE, 0
+ TAD I TYPE /GET THE MESSAGE ADDRESS
+ ISZ TYPE /BUMP RETURN ADDRESS
+ DCA XR1
+TYPE1, TAD I XR1 /GET A CHARACTER
+ SNA
+ JMP I TYPE /END OF THE MESSAGE
+ TLS /PRINT THE CHARACTER
+TYPE2, TSF
+ JMP TYPE2
+ CLA
+ JMP TYPE1 /LOOP
+
+
+/PRINT THE NEXT NAME ON THE OUTPUT DEVICE AND CHECK TO SEE IF
+/ A CRLF IS NEEDED. EACH NAME IS TERMINATED WITH A TAB CHAR
+NAMLST, 0
+ TAD TXTNAM /CHECK FOR NULL NAME (MH)
+ SZA!CLA /(MH)
+ JMP NAMLS1 /NOT NULL NAME (MH)
+ JMS OUTSTR /WAS NULL -- PRINT "<NONE>" (MH)
+ NULNAM-1 /(MH)
+ JMP NAMLS2 /PROCEED (MH)
+NAMLS1, JMS OUTSTR /PRINT THE NAME ON THE DEVICE
+ TXTNAM-1
+NAMLS2, JMS OUTSTR /PRINT A TAB AFTER NAME
+ TAB-1
+ ISZ LINCNT /BUMP NUMBER PRINTED SO FAR
+ JMP I NAMLST /NO YET, JUST RETURN
+ TAD LINMAX /RESET TO MAX NUMBER OF NAMES PER LINE
+ DCA LINCNT
+ JMS OUTSTR /TYPE CRLF
+ CRLF-1
+ JMP I NAMLST /NOW RETURN
+
+
+/ PRINT A STRING ON THE OUTPUT DEVICE BY STUFFING THE CHARACTERS
+/ IN THE OUTPUT FILE. THE ADDRESS-1 IS FOLLOWING THE JMS
+OUTSTR, 0
+ TAD I OUTSTR /GET THE ADDRESS
+ ISZ OUTSTR
+ DCA XR1 /POINTER TO NAME
+OUTS1, TAD I XR1 /GET A CHARACTER
+ SNA
+ JMP I OUTSTR /RETURN IF DONE
+ JMS I [PCH /PRINT THE CHARACTER
+ JMP OUTS1
+
+ PAGE
+\f/ GET A CHARACTER FROM THE INPUT FILE
+GCH, 0
+ TAD CHAR /RETURN A EOF IF THE LAST WAS EOF
+ TAD (-232
+ SZA CLA
+ JMP I GIVCH /NOT EOF, GET NEXT CHARACTER
+ TAD (232 /GET END OF FILE
+ JMP I GCH
+
+GIVCH, INITBF /INITIALLY SET UP BUFFERS
+ AND (377 /MASK THE CHARACTER
+ DCA CHAR /SAVE CHARACTER
+ TAD CHAR
+ JMP I GCH /RETURN
+
+INITBF, TAD (-2000 /SET WORD COUNT FOR BLOCK(MH)
+ DCA WDCTR
+ TAD BUFAD
+ DCA CHPTR /CHARACTER POINTER FOR BUFFER
+ TAD I (BLKBGN /FIND OUT IF DATA TRANSFER WILL(MH)
+ CMA!IAC /PASS END OF FILE, IF SO REDUCE(MH)
+ TAD I (FSIZE /SIZE OF TRANSFER.(MH)
+ DCA TEMP /SAVE -ST. BLK.-FILE SIZE(MH)
+ TAD RDFCT /GET TRANSFER LENGTH IN BLKS(MH)
+ CLL!RTL /(MH)
+ RTL /(MH)
+ RTL /(MH)
+ TAD BLK /ADD CURRENT BLK(MH)
+ TAD TEMP /SUBTRACT (ST. BLK OF FILE + SIZE)(MH)
+ SPA!SNA /(MH)
+ JMP INITOK /PROCEED -- DON"T CHG. TRANSFER LEN(MH)
+ CLL!RTR /CHANGE TRANSFER LENGTH SO IT WON'T(MH)
+ RTR /PASS END OF FILE(MH)
+ RTR /(MH)
+ CMA!IAC /(MH)
+ TAD RDFCT /(MH)
+ DCA RDFCT /ENTER THIS INTO FUNCTION WD.(MH)
+INITOK, JMS I DEVHND /CALL THE HANDLER TO READ A BLOCK
+RDFCT, 2000 /8 BLOCKS(MH)
+BUFAD, BUFFER
+BLK, 0 /BLOCK NUMBER
+ JMP RDERR /ERROR RETURN(MH)
+NXTCH, TAD I CHPTR
+ JMS GIVCH
+ TAD (7400
+ AND I CHPTR /GET THE HIGH ORDER PART
+ DCA CHTEM
+ ISZ CHPTR
+ TAD I CHPTR
+ JMS GIVCH
+ TAD I CHPTR
+ AND (7400
+ CLL RTR
+ RTR
+ TAD CHTEM /GET OTHER HALF
+ RTR
+ RTR
+ JMS GIVCH /GIVE THIRD CHARACTER OF GROUP
+ ISZ CHPTR
+ ISZ WDCTR /BUMP WORD COUNTER
+ JMP NXTCH /LOOP
+ TAD RDFCT /INCREMENT BLOCK NUMBER(MH)
+ CLL!RTL /(MH)
+ RTL /(MH)
+ RTL /(MH)
+ TAD BLK /(MH)
+ DCA BLK /ENTER INTO FUNCTION WD(MH)
+ JMP INITBF /READ IT IN
+
+ PAGE
+\f/ ROUTINE TO INITIALIZE ALL OF THIS STUFF
+/ POINTERS GET SET AND THE FILES OPENED.
+INIT, 0
+ TAD (OUTHSP+1
+ DCA OUTHND
+ TAD (OUTHSP+1 /HANDLER ADDRESS
+ DCA OUTHN1
+ CDF 10
+ TAD I [7600 /GET OUTPUT DEVICE
+ SNA
+ JMP TTYDFL
+ CIF 10
+ CDF 0
+ JMS I (USR /FETCH THE HANDLER
+ FETCH
+OUTHN1, OUTHSP+1
+ JMP FETERR /ERROR RETURN(MH)
+ TAD OUTHN1 /GET HANDLER ADDRESS
+ JMP COMMON /COMMON CODE FOR BOTH FETCHES
+
+/ DEFAULT TO THE TTY WHEN NO OUTPUT DEVICE IS SPECIFIED
+TTYDFL, TAD TTYNM /SET UP THE DEVICE NAME
+ DCA TTY
+ TAD TTYNM+1
+ DCA TTY+1
+ CIF 10 /FETCH THE OUTPUT HANDLERS
+ CDF 0
+ JMS I (USR
+ FETCH
+TTY, DEVICE TTY /DEFAULT TO THE TTY
+OUTHND, OUTHSP+1 /PLACE TO PUT THE HANDLER
+ JMP NOTTY /IF TELETYPE HANDLER DOESNT EXIST
+ TAD TTY+1 /SET UP DEVICE NUMBER FOR COMMON CODE
+ CDF 10
+ DCA I [7600
+ CDF 0
+ TAD OUTHND /GET HANDLER ENTRY POINT
+COMMON, DCA OUTADR
+ TAD (OUTBUF
+ DCA I (OCPTR
+ TAD (-200 /OUTPUT BUFFER COUNT
+ DCA I (OUWDCT
+ TAD (7600
+ DCA XR1 /COPY NAME FROM FIELD 1 CMD DEC AREA
+ CDF 10
+ TAD I XR1
+ SNA
+ TAD (1014 /HL.LS IS DEFAULT NAME IF NONE THERE
+ DCA FILNAM
+ TAD I XR1
+ DCA FILNAM+1
+ TAD I XR1
+ DCA FILNAM+2
+ TAD I XR1 /COPY EXTENSION
+ SNA
+ TAD (1423 /USE .LS AS DEFAULT EXTENSION
+ DCA FILNAM+3
+ CDF 0
+ TAD (FILNAM /INITIALIZE THE ENTER
+ DCA BLKSRT
+ CDF CIF 10
+ TAD I (7600
+ CDF 0
+ JMS I (USR /DO ENTER WITH DEVICE NO IN AC
+ ENTER
+BLKSRT, 0 /STARTING BLOCK
+FILLNG, 0 /LENGTH OF FILE
+ JMP NOROOM /DEVICE FULL
+ TAD BLKSRT
+ DCA I [OUTBLK /INITIAL OUTPUT BLOCK
+ TAD FILLNG
+ DCA BLKCNT /NEGATIVE FILE LENGTH IN BLOCKS
+\f
+ TAD (7605 /SET NXTNAM POINTER TO THE NEXT NAME
+ DCA NAMPTR
+ TAD (-5
+ DCA NAMCNT /NUMBER OF CHARACTERS IN NAME
+ CIF 10
+ JMS I (USR /FETCH THE SYSTEM DEVICE HANDLER
+ FETCH / TO GET THE DEVICE NUMBER TO LOOKUP HELP FILE
+DEVNAM, DEVICE SYS /(MH)
+DEVH, 0 /HANDLER ADDRESS FOR READING
+ JMP FETERR /FETCH ERROR(MH)
+ TAD DEVNAM+1 /GET THE SYS DEVICE NUMBER
+ CIF 10 /LOOKUP HELP FILE WITH IT
+ JMS I (USR
+ LOOKUP
+BLKBGN, HELP8 /STARTING BLOCK OF THE FILE(MH)
+FSIZE, 0 /-NUMBER OF BLOCKS(MH)
+ JMP NOSCRP /THE SCRIPT FILE (HELP FILE) ISNT THERE
+ TAD DEVH
+ DCA DEVHND /COPY TO PG 0 FOR ADDRESSABILITY
+ JMP I INIT /THATS IT
+
+NOSCRP, JMS I (TYPE /TYPE MESSAGE SAYING HELP FILE NOT THERE
+ NOSC-1
+ JMP I (7605 /RETURN TO NONITOR
+NOTTY, JMS I (TYPE
+ TTYMIS-1
+ JMP I (7605
+TTYNM, DEVICE TTY
+NOROOM, JMS I [TYPE /DEVICE FILL
+ DEVFUL-1
+ JMP I (7605 /RETURN TO MONITOR
+ PAGE
+\f
+/ RESET THE INPUT FILE TO THE FIRST BLOCK AND RESET ALL THE CHARACTER
+/ UNPACKING STUFF TO THE 1ST CHARACTER OF THE FILE
+RESET, 0
+ TAD I (BUFFER /RESET BUFFER POINTER TO START
+ DCA CHPTR
+ DCA WASHLP /SET NOT YET HELPED
+ DCA CHAR /SET TO STOP EOF STUFF
+ TAD (-2000 /RESET WORD COUNT FOR 8 BLOCKS(MH)
+ DCA WDCTR
+ TAD I (BLKBGN /RESET STARTING BLOCK OF FILE
+ DCA I (BLK
+ TAD (2000 /RESET TRANSFER LEN FOR 8 BLOCKS(MH)
+ DCA I (RDFCT /(MH)
+ TAD (INITBF /SET UP TO REREAD BLOCK 0 OF FILE
+ DCA I (GIVCH
+ JMP I RESET
+\f
+/ PUT A CHARACTER OUT TO THE OUTPUT DEVICE
+/ THIS IS A COOROUTINE TYPE GUY JUST LIKE THE INPUT HANDLER
+
+PCH, 0
+ JMP I RPOS /DISPATCH
+
+RPOS1, DCA I OCPTR /PUT 1ST CHARACTER IN BUFFER
+ JMS RPOS
+
+RPOS2, DCA HOLD /SAVE THE 2ND CHARACTER
+ JMS RPOS
+
+RPOS3, RTL /PACK THE CHARACTERS
+ RTL
+ DCA HOLD2
+ TAD HOLD2
+ AND (7400
+ TAD I OCPTR
+ DCA I OCPTR /PART WAY DONE
+ ISZ OCPTR
+ TAD HOLD2
+ RTL
+ RTL
+ AND (7400 /NOW THE 2ND WORD
+ TAD HOLD
+ DCA I OCPTR
+ ISZ OCPTR /BUMP POINTER AGAIN
+ ISZ OUWDCT
+ SKP
+ JMS DUMP /IF AT THE END OF THE BUFFER
+RPOS4, JMS RPOS
+ JMP RPOS1
+RPOS, RPOS1 /INITIALLY SET TO THE 1ST CHARACTER
+ JMP I PCH /RETURN TO THE USER
+
+OUWDCT, 0 /OUTPUT BUFFER WORD COUNTER
+OCPTR, 0 /OUTPUT CHARACTER BUFFER POINTER
+HOLD, 0 /TEMPORARY PLACE TO PUT A CHARACACTER
+HOLD2, 0 /SAME AS ABOVE
+\f
+/ DUMP THE OUTPUT BUFFER TO THE OUTPUT FILE
+
+DUMP, 0
+ ISZ BLKCNT /SEE IF ANY ROOM LEFT TO DUMP TO
+ SKP
+ JMP DUMPER /IF OUT OF ROOM
+ JMS I OUTADR /CALL THE HANDLER
+ 4200
+OUTBFA, OUTBUF /OUTPUT BUFFER ADDRESS
+OUTBLK, 0 /OUTPUT BUFFER BLOCK NUMBER
+ JMP WRERR /WRITE ERROR(MH)
+ TAD OUTBFA /RESET INPUT POINTER
+ DCA OCPTR
+ TAD (-200 /RESET THE WORD COUNT
+ DCA OUWDCT
+ ISZ OUTBLK /BUMP OUTPUT BLOCK NUMBER
+ JMP I DUMP /RETURN
+DUMPER, JMS I (TYPE /TYPE ERROR MESSAGE
+ DEVFUL-1 /FILE FULL ERROR
+ JMP I (7605
+WRERR, JMS I (TYPE /WRITE ERROR (MH)
+ MWRERR-1 /(MH)
+ JMP I (7605 /(MH)
+FETERR, JMS I (TYPE /FETCH ERROR (MH)
+ MFEERR-1 /(MH)
+ JMP I (7605 /(MH)
+RDERR, JMS I (TYPE /(READ ERROR (MH)
+ MRDERR-1 /(MH)
+ JMP I (7605 /(MH)
+MWRERR, "W; "R; "I; "T; "E; 240; "E; "R; "R; 215; 212; 0
+MFEERR, "F; "E; "T; "C; "H; 240; "E; "R; "R; 215; 212; 0
+MRDERR, "R; "E; "A; "D; 240; "E; "R; "R; 215; 212; 0
+ PAGE
+\f
+TTYMIS, "N;"O;" ;"T;"T;"Y;" ;"H;"A;"N;"D;215;212;0
+NOSC, "N;"O;" ;"H;"E;"L;"P; 240; "F; "I; "L; "E; 215;212;0
+NULNAM, 242; "N; "O; "N; "E; 242; 0
+AVAIL, " ; "H; "E; "L; "P; ".; "S; "V; 215; 212
+ 240; 215; 212
+ "C; "A; "L; "L; "I; "N; "G; 240; "C; "O; "M; "M; "A; "N; "D; "S; ":
+ 215; 212; ".; "H; "E; "L; "P; 240; "P; "A; "R; "A; "M; "E; "T; "E; "R
+ 215; 212
+ 240; 215; 212
+ "P; "A; "R; "A; "M; "E; "T; "E; "R; "S; ":; 215; 212; 0
+CRLF, 215;212;0
+TAB, 211;0
+SORRY, 215;212;"N;"O;240;"H;"E;"L;"P;240;"-;240;0
+DEVFUL, "D;"E;"V;"I;"C;"E;240;"F;"U;"L;"L;215;212;0
+HELP8, FILENAME HELP.HL
+VERS, 0201 /VERSION 2A (MH)
+ PAGE
+OUTHSP, ZBLOCK 400 /OUTPUT HANDLER SPACE
+OUTBUF, ZBLOCK 400 /OUTPUT BUFFER FOR LISTING
+BUFFER=. /INPUT BUFFER FOR HELP FILE, 8 BLKS OR 4000 WDS (MH)
+$
--- /dev/null
+This area contains the files contained on system release DECtape #5.
+
+Directory of OS/8 V3D DECtape 5 labeled: AL-4695C-SA 2/27/78
+ OS/8 V3D SRC DT 5 OF 7
+ (replaces DEC-S8-OSYSB-B-UA5)
+
+
+DTCOPY.PA 50 30-OCT-75 SET .PA 91 05-JUL-77
+HELP .PA 50 23-MAY-77 CCL .PA 159 25-MAY-77
+RKLFMT.PA 129 28-APR-77
+
+ 5 files in 479 blocks - 251 free blocks
+
+
--- /dev/null
+/RK8E/RK8L DISK FORMATTER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/RK8E/RK8L DISK FORMATTER PROGRAM: MD-08-DHRKD-D
+/MAINDEC-08-DHRKD-D-D
+/
+/MODIFIED FOR OS8V3D BY ED STEINBERGER
+/
+DLSC=6740 /LOAD SECTOR COUNTER
+DSKP=6741 /SKIP ON TRANSFER DONE OR ERROR
+DCLR=6742 /CLEAR DISK CONTROL LOGIC
+DLAG=6743 /LOAD ADDRESS AND GO
+DLCA=6744 /LOAD CURRENT ADDRESS
+DRST=6745 /READ STATUS REGISTER
+DLDC=6746 /LOAD COMMAND REGISTER
+DMAN=6747 /LOAD MAINTENANCE
+/
+LDSC=JMS I XXLDSC
+IOTCHN=JMS I XCHANG
+LODTRK=JMS I XWRTRK
+REDDSK=JMS I XRDTRK
+RECAL=JMS I XRESTR
+RECEIV=JMS I XWAIT
+KILBUF=JMS I XKLBUF
+ERROR=JMS I XERRO
+RDSTAT=JMS I XRDST
+LDADD=JMS I XLDAD
+DSKSKP=JMS I XSDKP
+LDCMD=JMS I XLDCM
+LDCUR=JMS I XLDCA
+CLRALL=JMS I XCLDR
+PRNTER=JMS I XPRN
+OCTEL=JMS I XFROCT
+TWOCT=JMS I XTOCT
+TYPE=JMS I XPRINT
+CRLF=JMS I XCRLF
+APT8A=JMS I XAPT8
+TIME=JMS I XTIME
+TICK=JMS I XTICK
+KAERRO=JMS I XAERRO
+/
+*0
+/
+ 304 /REV D
+ 5001
+ 0002
+ 0003
+/
+*10
+/
+AUTO10, 0
+/
+AUTO11, 0
+/
+*20
+/
+ 0000 /PSEUDO SWITCH REGISTER
+ 0 /CONTROL WORD 1 - USE PSUEDO SWITCHES **ES**
+ 400 /CONTROL WORD 2 - SET CONSOLE PACKAGE ACTIVE **ES**
+ 0000 /RESERVED
+XAPT8, APT8
+XTIME, KTIME
+XAERRO, AERRO
+XTICK, KTICK
+XCHANG, CHANG
+XWRTRK, WRTTRK
+XRDTRK, REDTRK
+XRESTR, RESTOR
+XWAIT, WAIT
+XKLBUF, KLBUF
+XPRINT, PRINT
+XERRO, ERRO
+XRDST, RDST
+XSDKP, SDKP
+XLDCM, LDCM
+XLDCA, LDCA
+XLDAD, LDAD
+XCLDR, CLDR
+XXLDSC, XLDSC
+XPRN, PRN
+XFROCT, FROCT
+XTOCT, TOCT
+XCRLF, UPONE
+XLOTRK, LOTRK
+XHITRK, HITRK
+BGNBUF, WRKBUF
+AMOUNT, 0
+SWITCH, 0
+K0003, 0003
+K4, 4
+K0007, 0007
+K0040, 0040
+M313, -313
+K0277, 0277
+K0200, 0200
+K0260, 0260
+K4000, 4000
+K7735, 7735
+K7760, 7760
+K0400, 400
+K0037, 0037
+KCDF, CDF
+M4, -4
+M10, -10
+DRIVNO, 0
+CHAR, 0
+LOWAD, 0
+HIGHAD, 0
+TRKCNT, 0
+DSKCNT, 0
+SBCNT1, 0
+STCNT1, 0
+STCNT2, 0
+STCNT3, 0
+TCNTR1, 0
+TCNTR2, 0
+TCNTR3, 0
+TCNTR4, 0
+TCNTR5, 0
+/
+GDREG2, 0
+EXBIT, 0
+CMREG, 0
+STREG, 0
+DAREG, 0
+CAREG, 0
+ADREG, 0
+DTREG, 0
+BGNTST, FRMDSK
+HOMEMA, 0
+DATCNT, 0
+CLKCNT, -2
+/
+XMOVE, MOVE
+LOC8ED, 0
+XEND, ENDTST
+SOFT, 0
+ADPOT1, DSK0A
+DSK0A, 0
+DSK1A, 0
+DSK2A, 0
+DSK3A, 0
+DSK4A, 0
+DSK5A, 0
+DSK6A, 0
+DSK7A, 0
+ADPOT2, DSK0B
+DSK0B, 0
+DSK1B, 0
+DSK2B, 0
+DSK3B, 0
+DSK4B, 0
+DSK5B, 0
+DSK6B, 0
+DSK7B, 0
+PCOUNT, 0 /USED ONLY IF ON APT
+/
+*200
+/
+BGN, RIF
+ DCA HOMEMA
+ TAD HOMEMA
+ TAD KCDF /MAKE HOMEDF
+ DCA .+1
+ HLT /MAKE DF=IF
+/NOW TEST FOR APT SYSTEM
+/IF ON APT TERMINAL MESSAGES ARE SKIP
+/TO AVOID TIMING PROBLEMS WITH THE SYSTEM
+ APT8A /TEST FOR APT SYSTEM
+ JMS XC8PSW /GET SR=.
+ *.-1 /**ES**
+ NOP /**ES**
+ IOTCHN /CHANGE DEVICE TO SWR3-8
+ CRLF
+ CRLF
+ PRNTER /PRINT "RK8E/RK8L DISK FORMATTER PROGRAM"
+ MES1 /MESSAGE 1 POINTER
+ CRLF
+ PRNTER /PRINT "FOR ALL QUESTIONS"
+ MES2 /MESSAGE POINTER 2
+ALLAGN, TAD M10
+ DCA STCNT1 /COUNTER FOR AMOUNT OF DISKS
+ DCA LOC8ED
+ DCA STCNT2
+SAMAGN, CRLF
+ PRNTER /PRINT "FORMAT DISK ? "
+ MES3 /MESSAGE POINTER 3
+ TAD STCNT2
+ TAD K0260
+ TYPE /TYPE DISK NUMBER
+QUES1, TAD K0277
+ TYPE /TYPE ?
+ TAD ADPOT1
+ TAD STCNT2
+ DCA STCNT3
+ RECEIV /WAIT FOR CHARACTER
+ JMP NOTDSK /NO NOT THIS DISK
+ JMP QUES1 /NEITHER YES OR NO
+WASDSK, ISZ LOC8ED
+ CLA CLL CMA
+NOTDSK, DCA I STCNT3 /YES, WAS CLEAR DISK POINTER
+ ISZ STCNT2 /UPDATE POINTER
+ ISZ STCNT1 /COUNT DISKS
+ JMP SAMAGN /ASK ABOUT NEXT
+/
+DONE, CRLF
+ PRNTER /PRINT "ARE YOU SURE ?"
+ MES4 /MESSAGE POINTER 4
+ RECEIV /WAIT FOR CHARACTER
+ JMP ALLAGN /NO, START ALL OVER
+ JMP DONE /NEITHER TYPE ?
+ TAD LOC8ED
+ CIA
+ SNA /ANY DISKS
+ JMP BGN /NO, OPERATOR ERROR
+ DCA LOC8ED /YES, AMOUNT LOCATED
+/
+/FIRST RECALIBRATE AND FORMAT IN WRITE ALL MODE
+/ALL DISK DRIVES SELECTED BY OPERATOR,. MAKE THE FIRST
+/TWO WORDS OF EVERY DISK SECTOR EQUAL TO THE
+/ABSOLUTE DISK ADDRESS.
+/
+FRMDSK, JMS I XMOVE /MOVE DISK POINTERS
+ TAD LOC8ED
+ DCA AMOUNT
+ TAD AMOUNT
+ DCA DSKCNT /COUNTER FOR AMOUNT OF DISKS
+ DCA TCNTR4
+ TAD ADPOT2
+ DCA TCNTR5 /A FEW COUNTERS
+ TAD I TCNTR5
+ SZA CLA /FORMAT THIS DISK
+ JMP FORMAT /YES, GO
+NEXFRM, ISZ TCNTR5 /NO, TRY NEXT
+ ISZ TCNTR4
+ JMP .-5
+ HLT /WHAT HAPPENED????
+/
+FORMAT, TAD TCNTR4
+ AND K0003 /MASK OUT
+ CLL RAL /MAKE DISK NUMBER
+ DCA DRIVNO
+ TAD TCNTR4
+ AND K4
+ SZA CLA
+ TAD K0200
+ DCA EXBIT /SET EXTENDED DRIVE BIT
+ RECAL /RECALIBRATE THIS DRIVE
+ JMP RENEX1 /RECALIBRATE NEXT EXISTING
+ DCA LOWAD /SETUP ADDRESS POINTER
+ DCA HIGHAD /SETUP ADDRESS POINTER
+ TAD M313
+ DCA TRKCNT /COUNTER FOR AMOUNT OF TRACKS
+/
+/
+WRTDSK, TICK /TIMING FOR APT IF NEEDED.
+ -4 /OTHERWISE BOTH ARE SKIPPED
+ LODTRK /FORMAT A TRACK
+ JMP RENEX1 /TO NEXT DISK
+ CLA CLL
+ TAD LOWAD
+ TAD K0040
+ DCA LOWAD /UPDATE TO NEXT TRACK
+ SZL CLA /SET EXTENDED BIT
+ ISZ HIGHAD /YES
+ ISZ TRKCNT /UPDATE TRACK COUNTER
+ JMP WRTDSK /DO NEXT TRACK
+RENEX1, ISZ DSKCNT /UPDATE DISK COUNTER
+\f JMP NEXFRM /DO NEXT DISK
+/
+/ROUTINE TO CHECK ADDRESSING INFORMATION ON THE DISK.
+\f/THE FIRST TWO WORDS OF EVERY SECTOR SHOULD EQUAL
+/THE ABSOLUTE DISK ADDRESS. ALL OTHER DATA IS
+/NOT CHECKED.
+/
+CHKDSK, TAD AMOUNT
+ DCA DSKCNT /AMOUNT OF DISKS
+ DCA TCNTR4
+ TAD ADPOT2
+ DCA TCNTR5
+ TAD I TCNTR5 /SOFTWARE INFORMATION
+ SZA CLA /CHECK THIS DISK
+ JMP CHKDAT /CHECK THIS ONE
+NEXCHK, ISZ TCNTR5 /UPDATE FOR NEXT DISK
+ ISZ TCNTR4
+ JMP .-5
+ HLT /WHAT HAPPENED?????
+/
+CHKDAT, TAD TCNTR4
+ AND K0003 /MASK OUT
+ CLL RAL /MAKE DRIVE NUMBER
+ DCA DRIVNO
+ TAD TCNTR4
+ AND K4
+ SZA CLA
+ TAD K0200
+ DCA EXBIT /SET EXTENDED DRIVE BIT
+ RECAL /RECALIBRATE
+ JMP RENEX2 /TRY NEXT DRIVE
+ DCA LOWAD
+ DCA HIGHAD /SETUP STARTING DISK ADDRESS
+ TAD M313
+ DCA TRKCNT /AMOUNT OF TRACKS TO DO
+ JMP CHECK
+/
+PAGE
+/
+CHECK, TICK /TIMING FOR APT IF NEEDED.
+ -4 /SKIPPED IF NOT REQUIRED.
+ REDDSK /READ AND CHECK ONE CYLINDER
+ JMP RENEX2 /TO NEXT DISK
+ CLA CLL
+ TAD LOWAD
+ TAD K0040
+ DCA LOWAD /UPDATE TO NEXT CYLINDER
+ SZL CLA /TIME TO SET EXTENDED BIT
+ ISZ HIGHAD /YES, SET IT
+ ISZ TRKCNT /UPDATE CYLINDER COUNTER
+ JMP CHECK /CHECK NEXT ONE
+RENEX2, ISZ DSKCNT /UPDATE DISK COUNTER
+ JMP NEXCHK /CHECK NEXT
+/
+/
+ TAD 22
+ AND K4000 /TEST FOR APT
+ SNA CLA /ARE WE?
+ JMP ENDTST /NO. NORMAL RUN
+ ISZ PCOUNT /INCREMENT PASS COUNT
+ JMP FRMDSK /LOOP PROGRAM
+ENDTST, CRLF
+ PRNTER /PRINT "PASS COMPLETE"
+ TEXEND
+ CRLF
+ PRNTER /PRINT "TRY SAME SEQUENCE"
+ MES5
+ RECEIV /WAIT FOR INPUT FROM OPERATOR
+ JMP ALLAGN /NO, ASK AGAIN
+ JMP .-5
+ JMP FRMDSK /TRY SAME SEQUENCE
+/
+/
+/SUBROUTINE FOR "ERRORS," SCOPE LOOPS, AND
+/ERROR TYPEOUTS.
+/
+ERRO, 0
+ CLA CLL IAC
+ TAD ERRO /GET PC STORED
+ DCA RETRN1 /STORE FOR RETURN
+ KAERRO /NOTIFY APT OF ERROR IS NEED BE
+ CRLF
+ CRLF
+ TAD I ERRO /GET TEXT POINTER
+ AND K0007 /MASK 9-11
+ TAD HEDTAD /MAKE ERROR HEADER TAD
+ DCA .+1
+ HLT /MODIFIED HEADER TAD
+ DCA .+2
+ PRNTER /MODIFIED HEADER POINTER
+ HLT
+ CRLF
+ PRNTER /PRINT PC:
+ TEXPC
+ TAD ERRO /GET PC POINTER
+ OCTEL /PRINT PC STORED
+ TAD I ERRO /GET TEXT POINTER
+ CLL RAL
+ SNL
+ JMP NTGD /NOT GD: REGISTER
+ DCA ERRO
+ PRNTER /PRINT GD:
+ TEXGD
+ TAD GDREG2
+ OCTEL /PRINT FOUR OCTAL
+ SKP CLA
+NTGD, DCA ERRO
+ PRNTER
+ TEXEX
+ TAD EXBIT
+ SZA CLA
+ IAC
+ OCTEL
+ TAD XTEXT
+ DCA PCNTR2
+ TAD XREG
+ DCA AUTO10
+ TAD K7771
+ DCA PCNTR1 /COUNTER FOR # OF HEADS
+ CLA CLL CMA RAL
+ DCA PCNTR3
+STRAUT, TAD ERRO /GET TEXT POINTER
+ SMA
+ JMP NOTEX /NOT THIS ONE
+ CLL RAL
+ DCA ERRO
+ TAD PCNTR2 /GET TEXT MESSAGE POINTER
+ ISZ PCNTR2
+ ISZ PCNTR2
+ DCA .+2 /STORE FOR PRNTER
+ PRNTER /PRINT XX:
+ HLT /MODIFIED TEXT POINTER
+ TAD I AUTO10
+ OCTEL /PRINT FOUR OCTAL
+ ISZ PCNTR3
+ SKP CLA
+ CRLF
+AGAIN, ISZ PCNTR1
+ JMP STRAUT /CHECK FOR NEXT XX:
+ JMP I RETRN1 /RETURN TO QUESTION
+NOTEX, CLL RAL
+ DCA ERRO
+ ISZ PCNTR2
+ ISZ PCNTR2
+ ISZ AUTO10
+ JMP AGAIN
+/
+RETRN1, 0
+XTEXT, TEXCM
+XREG, EXBIT
+PCNTR1, 0
+PCNTR2, 0
+PCNTR3, 0
+HEDTAD, TAD HEDLST
+HEDLST, ERTX1
+ ERTX2
+ ERTX3
+ ERTX4
+K7771, 7771
+/
+PAGE
+/
+/ROUTINE TO FORMAT CYLINDER
+/MAKE FIRST TWO WORDS OF EVERY SECTOR
+/EQUAL TO DISK ADDRESS.
+/
+WRTTRK, 0
+ CLA CLL CML RAR
+ DCA GDREG2 /SETUP COMPARE REGISTER
+ KILBUF /CLEAR BUFFER
+ TAD K7735 /AMOUNT OF SECTORS TO DO
+ DCA TCNTR1 /SETUP COUNTER
+ DCA TCNTR2 /STARTING WITH 0
+ TAD K7760 /STOPPER
+ DCA TCNTR3 /SECTOR COUNTER POINTER STOP
+LODR1, TAD TCNTR2
+ AND K0037 /MASK SECTOR BITS
+ TAD LOWAD /ADD IN CYLINDER
+ DCA I XLOTRK /SETUP TRACK WORD IN BUFFER
+ TAD EXBIT /ADD IN EXTENDED BIT
+ TAD HIGHAD
+ TAD DRIVNO /ADD IN DRIVE NUMBER
+ DCA I XHITRK /SETUP TRACK WORD IN BUFFER
+ TAD I XHITRK
+ AND K7577
+ TAD HOMEMA /CURRENT FIELD
+ TAD K5000 /FUNCTION WRITE ALL
+ LDCMD /LOAD COMMAND
+ TAD EXBIT
+ LDSC /LOAD EXTENDED DRIVE BIT
+ CLA /CLEAR EXTENDED DRIVE BIT
+ TAD BGNBUF
+ LDCUR /LOAD CURRENT ADDRESS
+ TAD I XLOTRK
+ LDADD /LOAD TRACK AND GO
+ DSKSKP /SKIP ON FLAG
+ JMP .-1 /WAIT FOR FLAG
+ RDSTAT /READ STATUS
+ TAD K4000
+ SZA CLA /WAS STATUS 0?
+ JMP LODER /ERROR, STATUS ON WRITE ALL
+ ISZ TCNTR2
+ ISZ TCNTR3 /COUNT FIRST REVOLUTION
+ SKP CLA /STILL IN FIRST REV.
+ DCA TCNTR2 /SETUP FOR SECTOR "1"
+ ISZ TCNTR2
+ ISZ TCNTR1 /UPDATE SECTOR COUNTER
+\f JMP LODR1 /TRY NEXT SECTOR
+ ISZ WRTTRK
+ JMP I WRTTRK /THIS CYLINDER DONE
+LODER, ERROR /ERROR, STATUS
+ 3602 /TEXT POINTER
+/
+ RECAL /CLEAR CONTROL AND DRIVE
+ JMP I WRTTRK /TO NEXT DISK
+ CRLF
+ PRNTER /PRINT "TRY SAME AGAIN"
+ ERMES1
+ RECEIV /WAIT FOR YES OR NO
+ JMP LODER-2 /WAS A NO TRY SAME CYLINDER
+ JMP .-5 /WAS NEITHER ASK AGAIN
+ JMP WRTTRK+1 /YES, TRY NEXT
+K5000, 5000
+K7577, 7577
+/
+/
+/SUBROUTINE TO READ STATUS REGISTER
+/
+RDST, 0
+IOT5, DRST /READ STATUS IOT
+ SKP
+ERHLT5, JMS XC8ERR /SKIP TRAP ERROR.
+ DCA STREG /SAVE RESULTS
+ TAD STREG
+ JMP I RDST /EXIT
+/
+/SUBROUTINE TO LOAD CURRENT ADDRESS REGISTER
+/
+LDCA, 0
+ DCA ADREG /SAVE IN ADDRESS
+ TAD ADREG
+ DCA CAREG /SETUP INITIAL CURRENT ADDRESS
+ TAD ADREG
+IOT4, DLCA /LOAD CURRENT ADDRESS IOT
+ JMP I LDCA /EXIT
+ERHLT4, JMS XC8ERR /SKIP TRAP ERROR.
+ JMP .-1
+/
+/
+/SUBROUTINE TO LOAD TRACK ADDRESS REGISTER
+/
+LDAD, 0
+ DCA DAREG /SAVE OUTBOUND DATA
+ TAD DAREG
+IOT3, DLAG /LOAD DISK ADDRESS REGISTER
+ JMP I LDAD /EXIT
+ERHLT3, JMS XC8ERR /SKIP TRAP ERROR.
+ JMP .-1
+/
+/
+/SUBROUTINE TO LOAD COMMAND REGISTER
+/
+LDCM, 0
+ DCA CMREG /SAVE OUTBOUND DATA
+ DCA INMODE
+ JMS XC8CKP /CHECK FOR CONTROL CHARACTERS.
+ CLA
+ CLA
+ TAD CMREG
+IOT6, DLDC /LOAD COMMAND REGISTER
+ JMP I LDCM /EXIT
+ERHLT6, JMS XC8ERR /SKIP TRAP ERROR.
+ JMP .-1
+/
+/
+/SUBROUTINE ISSUE "DLSC"
+XLDSC, 0
+IOT0, DLSC
+ JMP I XLDSC
+ERHLT0, JMS XC8ERR
+ JMP .-1
+
+/SUBROUTINE TO ISSUE "DSKP" DISK SKIP IOT
+/
+SDKP, 0
+IOT1, DSKP /DISK SKIP IOT
+ SKP /DID NOT SKIP
+ ISZ SDKP
+ JMP I SDKP /EXIT
+/
+/SUBROUTINE TO ISSUE "DCLR" CLEAR IOT
+/
+CLDR, 0
+IOT2, DCLR /DCLR "CLEAR IOT"
+ JMP I CLDR /EXIT
+ERHLT2, JMS XC8ERR /SKIP TRAP ERROR.
+ JMP .-1
+/
+/ROUTINE TO ZERO WORK BUFFER
+/
+KLBUF, 0
+ CLA CLL CMA
+ TAD BGNBUF /START OF BUFFER -1
+ DCA AUTO10 /SETUP AUTO INDEX
+ TAD K7400
+ DCA DATCNT /SETUP COUNTER
+ DCA I AUTO10 /CLEAR BUFFER
+ ISZ DATCNT /UPDATE COUNTER
+ JMP .-2 /NOT ALL CLEARED YET
+ JMP I KLBUF /BUFFER CLEARED
+K7400, 7400
+/
+PAGE
+/
+/
+/ROUTINE TO READ AND CHECK A CYLINDER
+/
+REDTRK, 0
+ TAD K7735
+ DCA TCNTR1 /AMOUNT OF SECTORS TO DO
+ DCA TCNTR2 /STARTING WITH 0
+ TAD K7760
+ DCA TCNTR3
+ KILBUF /CLEAR BUFFER
+CHKR1, CLA CLL CMA
+ DCA SOFT /SETUP SOFT ERROR FLAG
+ TAD BGNBUF
+ LDCUR /LOAD CURRENT ADDRESS
+ TAD HIGHAD /EXTENDED CYLINDER BIT
+ TAD DRIVNO /CURRENT DRIVE
+ TAD HOMEMA /CURRENT FIELD
+ LDCMD /LOAD COMMAND
+ TAD EXBIT /LOAD EXTENDED DRIVE BIT
+ LDSC
+ CLA /CLEAR EXTENDED DRIVE BIT
+ TAD TCNTR2
+ AND K0037 /MASK SECTOR BITS OFF
+ TAD LOWAD /ADD IN OTHER DISK ADDRESS
+ LDADD /LOAD AND GO
+ DSKSKP /DISK SKIP IOT
+ JMP .-1 /WAIT FOR FLAG
+ RDSTAT /READ STATUS
+ TAD K4000 /ADD IN FUDGE FACTOR
+ SNA CLA /SKIP IF ERROR
+ JMP STAOK /STATUS O.K.
+ TAD STREG /GET STATUS READ
+ AND K0010
+ SNA CLA /WAS IT A CRC
+ JMP STAER /NO, JUST A HARD ERROR
+ DCA SOFT /CLEAR SOFT ERROR FLAG
+STAOK, TAD CMREG /GET LAST COMMAND
+ AND K0007
+ TAD EXBIT /ADD EXTENDED DRIVE BIT
+ CIA
+ TAD I XHITRK /GET WORD READ FROM DISK
+ SNA CLA /SKIP IF ERROR
+ JMP FRSTOK /FIRST WORD O.K.
+ TAD I XHITRK /GET WORD
+ DCA DTREG /SETUP ERROR PRINTER
+ TAD CMREG
+ AND K0007
+ DCA GDREG2 /SETUP GOOD FOR PRINTER
+ JMP DATER /NO, DATA ERROR
+FRSTOK, TAD I XLOTRK /GET WORD READ
+ CIA
+ TAD DAREG /COMPARE TO GOOD
+ SNA CLA /SKIP IF ERROR
+ JMP DATOK /WORD O.K.
+ ISZ ADREG /SETUP ERROR PRINTER
+ TAD DAREG
+ DCA GDREG2 /SETUP GOOD WORD FOR PRINTER
+ TAD I XLOTRK /GET WORD READ
+ DCA DTREG /SETUP FOR PRINTER
+ JMP DATER /DATA ERROR
+DATOK, TAD SOFT /GET SOFT ERROR FLAG
+ SNA CLA /WAS IT CLEAR
+ JMP STAER /YES, STATUS ERROR
+ TAD TCNTR2
+ TAD K0003 /ADVANCE 3 SECTORS
+ DCA TCNTR2
+ ISZ TCNTR3
+ JMP CHKR1 /MORE TO FORMAT
+ ISZ REDTRK
+ JMP I REDTRK /EXIT, O.K.
+DATER, TAD K7741
+ DCA TCHKT /SETUP TEXT POINTER
+ JMP CHKER /ERROR
+STAER, TAD K3600
+ DCA TCHKT /SETUP TEXT POINTER
+ CLA CLL CML RAR
+ DCA GDREG2 /SETUP GOOD STATUS PRINTER
+CHKER, ERROR /ERROR, READ DATA
+TCHKT, 0 /MODIFIED TEXT POINTER
+ RECAL /CLEAR CONTROL AND DRIVE
+ JMP I REDTRK /TO NEXT DISK
+ CRLF
+ PRNTER /PRINT "TRY SAME AGAIN"
+ ERMES3
+ RECEIV
+ JMP DATER-2 /CHECK NEXT
+ JMP .-5 /RE-PRINT
+ JMP REDTRK+1 /TRY SAME AGAIN
+/
+/THIS ROUTINE WILL TEST FOR APT AND NOP CONSOLE
+/PACKAGE IF NEED BE
+/
+APT8, 0
+ TAD 22
+ SMA CLA
+ JMP I APT8
+ TAD 22
+ AND K7377 /ON APT. NOP CONSOLE PACKAGE
+\f DCA 22
+ TAD 22
+ AND K0007 /ISOLATE DRIVE NUMBER OR
+ /NUMBER OF DRIVES TO BE DONE
+ DCA STCNT1
+ TAD 22
+ AND K0100
+ SNA CLA /SINGLE DRIVE TESTING
+ JMP MULDSK /NO.SEVERAL TO DO
+ TAD ADPOT1 /GET DISK POINTER
+ TAD STCNT1 /ESTABLISH DRIVE TO DO
+ DCA STCNT1
+ CLL CLA CMA /-1
+ DCA I STCNT1
+ CLL CLA CMA /ONE DISK TO DO
+ DCA LOC8ED
+ JMP I BGNTST
+MULDSK, TAD STCNT1 /DRIVE TO BE DONE
+ CMA
+ DCA STCNT1
+ TAD ADPOT1 /GET DISK POINTER
+ TAD STCNT2 /ESTABLISH DRIVE TO BE DONE
+ DCA STCNT3
+ ISZ LOC8ED
+ CLL CLA CMA
+ DCA I STCNT3 /DO THIS DRIVE
+ ISZ STCNT2
+ ISZ STCNT1
+ JMP MULDSK+3 /MORE TO DO
+ TAD LOC8ED
+ CIA
+ DCA LOC8ED /NUMBER TO BE DONE
+ JMP I BGNTST
+K7377, 7377
+PAGE
+/
+/SUBROUTINE TO PRINT TWO OCTAL
+/
+TOCT, 0
+ DCA SBCNT1 /SAVE AC
+ TAD SBCNT1
+ RAR
+ RTR
+ AND K0007
+ TAD K0260
+ TYPE /PRINT FIRST BYTE
+ TAD SBCNT1
+ AND K0007
+ TAD K0260
+ TYPE /PRINT SECOND BIT
+ JMP I TOCT /EXIT
+/
+/
+/
+/ROUTINE TO DO CRLF
+/
+UPONE, 0
+ CLA CLL
+ TAD K0215
+ TYPE
+ TAD K0212
+ TYPE
+ TYPE /TYPE ONE NULL
+ JMP I UPONE
+/
+K0215, 0215
+K0212, 0212
+/
+/ROUTINE TO PRINT FOUR OCTAL
+/
+FROCT, 0
+ RTL
+ RTL
+ DCA UPONE
+ TAD M4
+ DCA TOCT
+ TAD UPONE
+ AND K0007
+ TAD K0260
+ TYPE
+ TAD UPONE
+ RTL
+ RAL
+ DCA UPONE
+ ISZ TOCT
+ JMP .-11
+ TAD K0240
+ TYPE
+ JMP I FROCT
+/
+/SUBROUTINE TO PRINT TEXT
+/
+PRN, 0
+ CLA CLL
+ TAD I PRN /GET POINTER
+ ISZ PRN
+ DCA FROCT
+ TAD I FROCT
+ AND K7700
+ SNA
+ JMP EXIT
+ SMA
+ CML
+ IAC
+ RTR
+ RTR
+ RTR
+ TYPE
+ TAD I FROCT
+ AND K0077
+ SNA
+ JMP EXIT
+ TAD K3740
+ SMA
+ TAD K4100
+ TAD K0240
+ TYPE
+ ISZ FROCT
+ CLA CLL
+ JMP PRN+5
+EXIT, CLA CLL
+ JMP I PRN
+
+/
+K4100, 4100
+K3740, 3740
+/
+/ROUTINE TO TYPE
+/
+PRINT, 0
+ TLS
+ TSF
+ JMP .-1
+ TCF
+ CLA
+ JMP I PRINT
+K0240, 0240
+K7700, 7700
+K0077, 0077
+K0010, 10
+K7741, 7741
+K3600, 3600
+/ROUTINE TO WAIT FOR KEY FROM OPERATOR
+/
+WAIT, 0
+ CLA CLL
+ KCC
+ KSF
+ JMP .-1
+ KRB
+ TLS
+ TSF
+ JMP .-1
+ AND K0177
+ TAD K0200
+ DCA CHAR
+ TAD CHAR
+ DCA C8CHAR
+ ISZ INMODE
+ JMS XC8CNT /CHECK FOR CONTROL CHARACTERS.
+ CLA
+ CLA
+ DCA INMODE
+ KCC
+ TCF
+ TAD CHAR
+ CIA
+ TAD K0316
+ SNA CLA /WAS IT A NO
+ JMP I WAIT /YES
+ ISZ WAIT /UPDATE RETURN POINTER
+ TAD CHAR
+ CIA
+ TAD K0331
+ SNA CLA /WAS IT A YES
+ ISZ WAIT /WAS A YES
+ JMP I WAIT /WAS NEITHER
+K0177, 0177
+K0316, 0316
+K0331, 0331
+/
+PAGE
+/
+/
+/ROUTINE TO RECALIBRATE SELECTED DRIVE
+/
+RESTOR, 0
+ CLA CLL IAC /ENABLE CLEAR CONTROL
+ CLRALL /CLEAR CONTROL
+ TAD DRIVNO /CURRENT DRIVE
+ TAD HOMEMA /CURRENT FIELD
+ LDCMD /LOAD COMMAND
+ TAD EXBIT
+ LDSC /LOAD EXTENDED DRIVE BIT
+ CLA CLL CML RAR /MAYBE EXPECTED STATUS
+ DCA GDREG2 /SETUP COMPARE REGISTER
+ CLA CLL CML RTL /ENABLE RECALIBRATE BIT
+ CLRALL /"RECALIBRATE"
+ DSKSKP /DISK SKIP IOT
+ JMP .-1 /WAIT FOR FIRST DONE FLAG
+ RDSTAT /READ STATUS
+ TAD K2000
+ SNA /WAS IT BUSY AND DONE
+ JMP RESTA /YES, THEN ITS O.K.
+ TAD K2000 /NO, THEN IT MUST BE JUST DONE
+ SZA CLA /WAS IT JUST DONE
+ JMP RESTER /NO, ERROR
+RESTA, CLRALL /CLEAR STATUS
+ TAD K0200 /ENABLE SET SECOND DONE FLAG
+ TAD CMREG /ORIGINAL COMMAND
+ LDCMD /LOAD COMMAND
+ DSKSKP /DISK SKIP IOT
+ JMP .-1 /WAIT FOR SECOND DONE
+ RDSTAT /READ STATUS
+ TAD K4000
+ SZA CLA /WAS IT ONLY DONE FLAG
+ JMP RESTER /NO, ERROR STATUS
+ CLA CLL IAC /ENABLE CLEAR CONTROL
+ CLRALL /CLEAR CONTROL
+ ISZ RESTOR /UPDATE FOR GOOD RECALIBRATE
+ JMP I RESTOR /RETURN
+RESTER, ERROR /ERROR, STATUS
+ 3603 /TEXT POINTER
+/
+ CRLF
+ PRNTER /PRINT "TRY RECALIBRATE"
+ ERMES2
+ RECEIV /WAIT FOR INPUT
+ JMP .+3 /TRY NEXT EXISTING DISK
+ JMP .-5
+ JMP RESTOR+1 /TRY AGAIN
+ CLA CLL IAC
+ TAD AMOUNT /GET AMOUNT ON SYSTEM
+ SNA /WAS THERE ONLY 1 LEFT
+ JMP I XEND /LAST DISK
+ DCA AMOUNT /MORE TO GO BUT CLEAR THIS ONE
+ DCA I TCNTR5 /CLEAR DISK POINTER
+ JMP I RESTOR /TRY NEXT ONE
+/
+/
+/ROUTINE TO CHANGE DEVICE CODES
+/
+CHANG, 0
+ JMS XC8SW /GET SWITCH REGISTER BITS.
+ RAR
+ SNL CLA /CHANGE DEVICE CODES?
+ JMP I CHANG /NO.
+ JMS XC8SW /GET SWITCHES.
+ AND A0770
+ DCA CSAVE1 /SAVE DESIRED
+ TAD CCNTR1
+ DCA CSAVE2
+\f TAD CHNPOT
+ DCA RESTOR
+CHANGR, TAD I RESTOR /GET ADDRESS POINTER
+ DCA KWAIT
+ TAD I KWAIT /GET OLD CODE
+ AND A7007 /MASK
+ TAD CSAVE1 /ADD IN DESIRED
+ DCA I KWAIT /STORE DESIRED DEVICE CODE
+ ISZ RESTOR /UPDATE POINTER
+ ISZ CSAVE2 /UPDATE CHANGE COUNTER
+ JMP CHANGR
+ JMP I CHANG /EXIT TO PROGRAM.
+/
+KWAIT, 0
+A7007, 7007
+A0770, 0770
+CSAVE1, 0
+CSAVE2, 0
+CCNTR1, 7771
+CHNPOT, CHNPOT+1
+ IOT0
+ IOT1
+ IOT2
+ IOT3
+ IOT4
+ IOT5
+ IOT6
+K2000, 2000
+/
+/THIS ROUTINE WILL GENERATE TIMING IF NEEDED BY THE APT SYSTEM
+/
+KTICK, 0
+ CLL CLA
+ TAD 22 /GET HARDWARE CONFIGURATION
+ AND K4000
+ SNA CLA /ON APT?
+ JMP EXTICK /NO
+ TAD I KTICK /GET TIMING VALUE
+ DCA COUNT /ESATABLISH TIME
+ ISZ CLKCNT
+ JMP EXTICK /RETURN
+ TAD COUNT /GET VALUE OF COUNTER
+ DCA CLKCNT /STORE IT
+ ISZ CNT /TIMING NEED BE DONE?
+ JMP EXTICK
+ TIME
+ TAD KCNT /TIMING VALUE
+ DCA CNT /INIT SECOND COUNTER
+EXTICK, ISZ KTICK /MOVE BEYOND TIMING VALUE
+ JMP I KTICK
+
+COUNT, 0
+CNT, -2
+KCNT, -2
+K0100, 0100
+/
+/
+/ROUTINE TO NOTIFY APT OF USE IF REQUIRED
+/
+KTIME, 0
+ IOF /DISABLE INTERUPTS
+ RDF /GET PRESENT DATA FIELD
+ TAD KCDF
+ DCA .+1 /ESTABLISHES CURRENT DATA FIELD
+ HLT
+ CIF 70 /FIELD 7. LOCATION OF UV PROM
+ JMS I K6500
+ CLL CLA
+ JMP I KTIME
+/
+K6500, 6500
+/
+PAGE
+/
+/
+/THIS ROUTINE WILL NOTIFY APT OF AN ERROR AND SEND PC TO
+/APT SYSTEM. ALL ERRORS WILL RESULT IN PROGRAM HLT AND A TIME OUT ON
+/APT. APT WILL TAKE OVER FROM THERE.
+
+/
+AERRO, 0
+ IOF /DISABLE INTERUPTS
+ CLA
+ TAD 22 /CHECK FOR APT SYSTEM
+ SMA CLA
+ JMP I AERRO /RETURN NOT ON APT
+ TAD I KERRO /GET PC
+ DCA SAVPC
+ RDF /GET CURRENT DATA FIELD
+ TAD KCDF
+ DCA .+2
+ TAD SAVPC
+ HLT /REPLACED WILL CURRENT DATA FIELD
+ CIF 70 /CHANGE IF FOR APT RETURN TO FIELD 7
+ JMP I K6520 /NOTIFIES APT OF ERROR
+ HLT
+/
+K6520, 6520
+KERRO, ERRO
+SAVPC, 0
+/
+/
+/ROUTINE TO MOVE DISK POINTERS
+/
+MOVE, 0
+ TAD ADPT1
+ DCA AUTO10
+
+ TAD ADPT2
+ DCA AUTO11
+ TAD M10
+ DCA MCNTR1
+ TAD I AUTO10 /FROM HERE
+ DCA I AUTO11 /TO THERE
+ ISZ MCNTR1 /4 POINTERS
+ JMP .-3
+ JMP I MOVE
+/
+ADPT1, DSK0A-1
+ADPT2, DSK0B-1
+MCNTR1, 0
+/
+/
+TEXPC, TEXT "PC:"
+TEXGD, TEXT "GD:"
+TEXEX, TEXT "EX:"
+TEXCM, TEXT "CM:"
+TEXST, TEXT "ST:"
+TEXDA, TEXT "DA:"
+TEXCA, TEXT "CA:"
+TEXAD, TEXT "AD:"
+TEXDT, TEXT "DT:"
+/
+ERTX1, TEXT "READ STATUS ERROR"
+ERTX2, TEXT "DISK DATA ERROR"
+ERTX3, TEXT "WRITE STATUS ERROR"
+ERTX4, TEXT "RECALIBRATE STATUS ERROR"
+/
+ERMES1, TEXT "TRY TO FORMAT SAME CYLINDER AGAIN?"
+ERMES2, TEXT "TRY TO RECALIBRATE SAME DISK AGAIN?"
+ERMES3, TEXT "TRY TO CHECK SAME CYLINDER AGAIN?"
+/
+TEXEND, TEXT "RK8E/RK8L DISK FORMATTER PASS COMPLETE"
+MES1, TEXT "RK8E/RK8L DISK FORMATTER PROGRAM"
+MES2, TEXT "FOR ALL QUESTIONS, ANSWER Y FOR YES OR N FOR NO."
+MES3, TEXT "FORMAT DISK "
+MES4, TEXT "ARE YOU SURE?"
+MES5, TEXT "FORMAT SAME DISK(S) AGAIN?"
+/
+PAGE
+/
+WRKBUF=.
+/
+HITRK=.
+LOTRK=.+1
+/
+ENDBUF=.+377
+/
+
+
+/CONSOL SRC -V2-R0- CONSOLE PACKAGE
+
+
+/LAS= CALL C8CKSW OR JMS XC8SW
+/THIS WILL READ THE SWITCH REGISTER FROM THE PLACE SPECIFIED
+/BY LOCATION 20 BIT 0.
+
+
+/THE PROGRAN SHOULD CHECK FOR A CONTROL CHARACTER FRON THE TERMINAL
+/EVERY FIVE(5) SECONDS OR SOONER.
+
+/LOCATIONS THAT NEED TO BE SET UP FOR USING THE CONSOLE PACKAGE.
+
+/CNTVAL IN XC8PASS THIS LOCATION DETERMINDS THE NUMBER OF
+/PROGRAM COMPLETIONS THAT ARE NEEDED BEFORE THE PASS MESSAGE IS TYPED
+/THE VALUE SHOULD PUT THE PASS MESSAGE OUT IN THE RANGE OF 1 TO 5 MINUTES.
+/THIS SHOULD BE A POSITIVE NUNBER.
+
+/C8STRT THIS IS FOUND IN CNTRL ROUTINE CONTROL R PART
+/IT IS THE RETURN WHEN CONTROL R IS ENTERED (RESTART PROGRAM)
+/THE RETURN JUMPS TO XDOSW WHICH CONTAINS C8STRT SO PUT THE LABEL C8STRT
+/WHERE YOU WANT TO RESTART THE PROGRAM.
+
+
+/SETUP1 IN XC8ERR THIS IS THE MASK BIT FOR HALT ON ERROR
+/PLACE THE CORRECT BIT IN THIS LOCATION FOR HALTING ON ERRORS.
+
+/SETUP2 IN XC8PASS THIS IS THE MASK FOR HALT A END OF PASS.
+
+/THE CALL TABLE IS A CONDITIONAL ASSEMBLY.
+/TO ASSEMBLE THE CALL REMOVE THE / BEFORE CONSOL=0.
+/IN COMBINING THE CONSOL PACKAGE TO A DIAGNOSTIC.
+/THE CALL TABLE IS TO BE AT THE BEGINNING OF A PROGRAM.
+
+
+/CONSOL=0
+ PSKF= 6661
+ PCLF= 6662
+ PSKE= 6663
+ PSTB= 6664
+ PSIE= 6665
+ GTF= 6004
+ ACL= 7701
+ CAF= 6007
+ MQL= 7421
+ MQA= 7501
+/
+*3000
+/
+/*********************************************************************
+/C8PASS
+/THIS IS CALLED AT THE END OF EACH PROGRAM COMPLETION
+/THE VALUE OF** CNTVAL** WILL BE DETERMINED BY THE TIME IT TAKES
+/THE PROGRAM TO COMPLETE THIS MANY C8PASS TO BE IN THE 1 TO 4 MINUTE
+/RANGE
+/ C8PASS=JMS XC8PAS
+/EX. OF CALL C8PASS
+ / HLT /HALT IF NON CONSOL PACKAGE
+/ JMP START1 /CONTINUE RUNNING THIS PROGRAM
+
+
+/RETURN TO LOCATION CALL PLUS ONE WITH THE AC=0 IF NON CONSOL PACKAGE AND HLT
+/IF CONTINUE TO RUN THEN RETURN TO CALL PLUS2 AC=0
+/THE LOCATION SETUP2 IS THE MASK BIT FOR THE HALT AT END OF PASS
+/CHECK THAT IT IS CORRECT FOR THE CURRENT PROGRAM
+
+/CALLS USED BY XC8PAS ARE CHKCLA-XC8CRLF-XC8OCTA-XC8SW-XC8PNT-XC8INQ-
+
+
+XC8PAS, 0
+ CLA
+\f JMS CHKCLA /IS WORD 22 BIT 3 ACTIVE CONSOLE?
+ JMP DOPACK /IS CLASSIC
+ JMS C8GET /GET THE REGISTERS.
+ JMS XC8SW /DEACTIVE CONSOL CHECK SR SETTING
+ AND (400 /FOR HALT ON END OF C8PASS
+ SZA CLA /1= HALT 0 CONTINUE
+ JMP I XC8PAS /GO TO HALT
+ JMP C8BY1 /CONTINUE ON RUNNING PROGRAM
+DOPACK, JMS CKCOUT /CLASS CHECK C8PASS COUNT
+ JMP C8BY1 /C8PASS COUNT NOT DONE REDO PROGRAM
+ ISZ PASCNT /C8PASS COUNT DONE SET C8PASS COUNT
+ JMS XC8CRLF
+ JMS XC8PNT /C8PRNT BUFFER
+ MESPAS /
+ TAD PASCNT /GET NUMBER
+ JMS XC8OCTA /CONVERT IT TO ASCII
+ JMS XC8CRLF /DO A CARRIAGE RETURN
+ JMS C8GET /GET THE REGISTERS.
+ JMS XC8SW /CHECK A HALT AT END OF C8PASS
+SETUP2, AND (400 /MASK BIT
+ SZA CLA /HALT =1 NO SKIP CONTINUE =0
+ JMS XC8INQ /STOP PROGRAM EXECUTION-LOOK FOR INPUT
+C8BY1, ISZ XC8PAS /BUMP RETURN
+ JMP I XC8PAS
+CKCOUT, 0
+ TAD DOSET /CHECK IF SET UP NEEDED
+ SZA CLA /0=SET UP C8PASS COUNT VALUE
+ /1=C8PASS COUNT VALUE OK
+ JMP NOSET /C8PASS COUNT VALUE ON
+ TAD CNTVAL /GET COUNT VALUE FOR THIS PROG
+ CMA /SET TO NEGATIVE
+ DCA DOCNT /STORE IN HERE
+ ISZ DOSET /INDICATE VALUE SET UP
+NOSET, ISZ DOCNT /COUNT THE NUMBER OF PASSES
+ JMP C8BY1 /EXIT FOR ANOTHER PASS
+ DCA DOSET /SET TO C8PRNT C8PASS
+ ISZ CKCOUT /BUMP RETURN FOR
+ JMP I CKCOUT /C8PASS C8TYPE OUT
+DOCNT, 0
+PASCNT, 0 /
+DOSET, 0
+CNTVAL, 0
+MESPAS, TEXT "DHRKDD PASS "
+
+
+
+/*********************************************************************
+
+/C8CKSW
+
+/THIS ROUTINE CAN BE USED INPLACE OF A READ THE SWITCHES LAS.
+/ROUTINE THAT WILL CHECK WHERE TO READ THE
+/C8 SWITCHES FROM IE. FROM PANEL OR PSEUDO SWITCH REGISTER
+/THE SELECTION IS DETERMINED BY THE STATE OF BIT 0 IN LOCATION 21.
+
+ /C8CKSW= JMS XC8SW
+ /EX. JMS XC8SW /READ THE C8SWIT REGISTER
+ /RETURN WITH THE CONTENTS OF SWITCH REGISTER
+
+/RETURN TO NEXT LOCATION FOLLOWING CALL WITH THE AC= TO VALUE OF C8SWIT SETTING
+
+/CALLS USED ARE-XC8CKPA-
+
+
+
+XC8SW, 0
+ JMS XC8CKPA /GO CHECK THE IF ANY CONTRL
+ NOP
+ TAD 21 /GET WD FOR INDICATOR
+ SPA CLA /CHECK IF FROM PANEL 4000
+ 7614 /DO LAS AND SKIP GET FROM PANEL WITH LAS
+ TAD 20 /PSEUDO SWITCH
+ JMP I XC8SW /EXIT WITH STATUS BIT IN AC.
+
+
+/*********************************************************************
+
+/C8TTYI
+/THIS ROUTINE WILL LOOK FOR A INPUT FROM THE TERMINAL
+/AND REMOVE ANY PARITY BITS, THEN MAKE IT 8 BIT ASCI.
+/ C8TTYI= JMS XC8TTY
+/EX. JMS XC8TTYI /READ CHAR FROM THE CONSOL DEVICE
+ / /RETURN TO CALL PLUS ONE AC CONTAINS THE CHAR
+
+
+/CALLS USED -NONE- BUT C8CHAR IS OFF PAGE AND IN ROUTINE CALLED XC8ECHO
+
+/
+/
+XC8TTY, 0
+ KSF /LOOK FOR KEYBOARD FLAG
+ JMP .-1
+ KRB /GET CHAR
+ AND (177 /MASK FOR 7 BITS
+ TAD (200 /ADD THE EIGTH BIT
+ DCA C8CHAR /STORE IT
+ TAD C8CHAR
+ JMP I XC8TTY /EXIT
+
+
+
+/*********************************************************************
+
+/C8PRNT
+
+/THIS ROUTINE WILL TYPE THE CONTENTS OF THE C8 PRINT BUFFER. THE LOCATION
+/OF THE BUFFER WILL BE IN THE ADDRS FOLLOWING THE CALL. PRINTING OF THE BUFFER
+/WILL STOP WHEN A 00 CHAR IS DETECTED. CHARACTERS ARE PACKED 2 PER WORD.
+
+/ C8PRNT= JMS XC8PNT
+
+
+/EX. JMS XC8PNT /C8PRNT THE CONTENTS OF THE FOLLOWING BUFFER
+/ MESS77 /LOCATION OF C8PRNT BUFFER
+
+/C8PRNT WILL USE THE LOCATION FOLLOWING THE CALL AS THE POINTER FOR THE
+/C8PRNT ROUTINE.RETURN TO CALL PLUS TWO WITH AC= 0
+
+/CALLS USED ARE-XC8TYPE-XC8PNT
+
+
+
+XC8PNT, 0
+ CLA CLL
+ TAD I XC8PNT /GET C8PRNT BUFFERS STARTING LOCATION
+ DCA PTSTOR /STORE IN PTSTOR
+ ISZ XC8PNT /BUMP RETURN
+C8DO1, TAD I PTSTOR /GET DATA WORD
+ AND (7700 /MASK FOR LEFT BYTE
+ SNA /CHECK IF 00 TERMINATE
+ JMP I XC8PNT /EXIT
+ SMA /IS AC MINUS
+ CML /MAKE CHAR A 300 AFTER ROTATE
+ IAC /MAKE CHAR A 200 AFTER ROTATE
+ RTR
+ RTR
+ RTR /PUT CHAR IN BITS 4-11 MAKE IT 8 BIT ASCII
+ JMS XC8TYPE /C8PRNT IT ON CONSOLE
+ TAD I PTSTOR /GET DATA WORD
+ AND (0077 /MASK FOR RIGHT BYTE
+ SNA /CHECK IF 00 TERMINATOR
+ JMP I XC8PNT //EXIT
+ TAD (3740 /ADD FUDGE FACTOR TO DETERMINE IF 200
+ SMA /OR 300 IS TO BE ADD TO CHAR
+ TAD (100 /ADD 100
+ TAD (240 /ADD 200
+ JMS XC8TYPE /C8TYPE ONLY BITS 4-11
+ ISZ PTSTOR /BUMP POINTER FOR NEXT WORD
+ JMP C8DO1 /DO AGAIN
+PTSTOR, 0 /STOR FOR C8PRNT BUFFER
+/**************************************************************************
+
+
+/C8PAUS
+/THIS ROUTINE WILL CHECK IF THE CONSOL PACKAGE IS ACTIVE,IF ACTIVE
+/IT WILL RETURN TO CALL PLUS ONE AC= 0. AND DO THAT INSTRUCTION.
+/IF THE CONSOL PACKAGE IS NOT ACTIVE THE CALL WILL BE REPLACED
+/WITH A 7402 HALT AND THEN RETURN TO THE HALT.
+
+/ C8PAUS= JMS XC8PAU
+/
+/
+/EX. JMS XC8PAUS /CHECK IF ON ACTIVE CONSOL IF NOT HALT HERE
+/ ANYTHING /RETURN HERE IF ON ACTIVE CONSOL
+/
+/
+
+/CALLS USED ARE -CHKCLA-
+
+
+
+XC8PAU, 0
+ CLA CLL
+ JMS CHKCLA /CHECK LOC 22 BIT 3 CONSOLE BIT
+ JMP C8DO3 /GO DO CONSOL PART RETURN CALL +1
+ CMA /DEACTIVE CONSOLE PACKAGE PUT HLT IN CALL
+ TAD XC8PAU /GET CORRECT RETURN ADDRS
+ DCA XC8PAU /SET UP RETURN
+ TAD (7402 /GET CODE FOR HLT
+ DCA I XC8PAU /PUT HALT IN CALL LOCATION
+C8DO3, JMP I XC8PAU /GO TO HALT OR RETURN TO NEXT LOCATION
+
+
+PAGE
+/*********************************************************************
+\f
+
+/C8CNTR
+/THIS ROUTINE WILL CHECK FOR THE PRESENCE OF CONTROL CHARACTERS
+/IT WILL CHECK FOR THE FOLLOWING CHAR C-R-Q-L-S
+/ C8CNTR= JMS XC8CNT
+
+/EX. JMS XC8CNTR /CHECK FOR CONTROL CHARACTER
+/ JMP ANYTHING /LOC FOLLOWING CALL IS FOR CONTINUING THE PROGRAM
+/ JMP ANYTHING /LOC. IS FOR RETURN IF INMODE SET AND NOT CNTRL CHAR
+/
+
+/RETURN IS TO CALL PLUS ONE IF CONTINUE
+/RETURN IS TO CALL PLUS TWO IF INMODE SET AND NOT CONTROL CHAR
+/RETURN IS TO CALL PLUS TWO IF INMODE IS NOT SET AND NO
+/CONTROL CHAR ..THIS WILL PRINT THE CHARACTER AND A ?
+/CLEAR THE AC AND RETURN CALL+2.
+
+/CALLS USED ARE-CHKCLA-XC8TYPE-XC8CRLF-C8GET-UPAROW-XC8TYI-XC8PSW-
+/
+/
+/
+XC8CNT, 0
+ DCA ACSAVE /SAVE THE AC
+ JMS CHKCLA /CHECK LOC.22 BIT3 FOR CONSOLE BIT
+ JMP .+3 /ON ACTIVE CONSOLE
+ TAD ACSAVE /DEACTIVE CONSOLEGET AC FOR RETURN
+ JMP I XC8CNT /EXIT NOT ON ACTIVE CONSOLE
+ GTF
+ DCA FLSAVE
+ MQA
+ DCA MQSAVE /SAVE THE MQ
+ DCA INDEXA /SET DISPLACEMENT INTO TABLE B
+ TAD XTABLA /GET ADDRS OF TABLE A
+ DCA GETDAT /CONTAINS POINTER TO CONTROL CHAR
+REDOA, TAD I GETDAT /GET CONTROL CHAR FROM TABLE
+ SNA /CHECK FOR A 0 END OF TABLE
+ JMP DONEA /END OF TABLE NO CONTROL CHAR
+ TAD C8CHAR /COMPARE CHAR TO CONTROL CHAR
+ SNA CLA /0 IF MATCH
+ JMP GOITA /MATCH
+ ISZ INDEXA /NO MATCH NOT END OF TABLE REDO
+ ISZ GETDAT /BUMP INDEX FOR EXIT WHEN CONTROL FOUND
+ JMP REDOA /BUMP GETDAT FOR COMPARE OF NEXT CNTRL CHAR.
+DONEA, TAD INMODE /CHECK IF PROGRAM EXPECTS CHAR
+ SZA CLA /1=CHAR EXPECTED 0= NO CHAR EXPECTED
+ JMP EXITA /CHAR EXPECTED
+ TAD C8CHAR /GET CHAR - NOT CONTROL + NOT EXPECTED
+ JMS XC8TYPE /C8PRNT CHAR
+ TAD (277 /GET CODE FOR "?"
+ JMS XC8TYPE
+ JMS XC8CRLF
+ ISZ XC8CNT /BUMP RETURN
+ JMP I XC8CNT /EXIT CALL+2
+EXITA, ISZ XC8CNT /BUMP RETURN FOR MAIN PROGRAM CHECK OF CHAR
+ TAD C8CHAR /PUT CHAR IN AC.
+ JMP I XC8CNT /EXIT
+GOITA, TAD C8CHAR /GET THE CONTENTS OF CHAR
+ TAD (100 /ADD 100 TO FORM A GOOD ASCII CHARACTER
+ DCA C8CHAR /RESTORE COFFECT CHAR
+ TAD XTABLB /GET START OF TABLE B
+ TAD INDEXA /GET NOW FAR INTO TABLE
+ DCA GOTOA /STORE IT
+ TAD I GOTOA /GET THE ROUTINE STARTTING ADDRESS
+ DCA GOTOA /STORE IT IN HERE
+ JMP I GOTOA /GOTO CONTROL CHAR ROUTINE
+GOTOA, 0000 /ADD OF CNTRL ROUTINE TO EXECUTE
+INDEXA, 0000 /DISPLACEMENT INTO CNTRL TABLE
+GETDAT, 0000 /LOCATION OF ADDRS OF CONTROL CHAR.
+XTABLA, TABLA /ADDRS OF TABLEA
+XTABLB, TABLB /ADDRS OF TABLEB
+TABLA, 7575 /CNTRL C BACK TO MONITOR 203
+ 7564 /CNTRL L SWITCH ERROR PRINTTING DEVICE 214
+ 7557 /CNTRL Q START DISPLAYING CHAR. AGAIN 221
+ 7556 /CNTRL R BACK TO BEGINNING OF PROGRAM 222
+ 7555 /CNTRL S STOP SENDING CHAR TO DISPLAY WAIT FOR CNTRL Q 223
+ 7573 /CNTRL E CONTINUE WITH PROGRAM 205
+ 7574 /CONTROL D CHANGE SWITCH REGISTER ON FLY
+ 0000
+
+TABLB, CNTRLC
+ CNTRLL
+ CNTRLQ
+ CNTRLR
+ CNTRLS
+ CNTRLE
+ CNTRLD
+/
+/CONTROL Q
+/START SENDING CHAR. TO THE DISPLAY
+/THIS WILL RETURN CONTROL TO CALL THAT WAS SET BY
+/THE CALL FOR CONTROL S.
+/
+CNTRLQ, DCA INMODE /SET SOFT FLAG FOR UNEXPECTED CHAR
+ TAD C8SETS /CHECK IF CONTROL S TYPED IN
+ SZA CLA
+ JMP BYRETR /CONTROL S TYPED IN
+ JMS C8GET /NO CONTROL S TYPED PREVIOUSLY
+ JMP I XC8CNTR /LEAVE VIA CNTR ENTRY ADDRESS
+BYRETR, DCA C8SETS /CLEAR THE SOFT FLAG
+ JMS C8GET /RESTORE REGISTERS
+ JMP I C8RETR /EXIT TO ADDRESS SET BY CONTROL S
+/
+/
+/CONTROL R
+/GO TO THE QUESTION C8SWIT
+CNTRLR, DCA TTYLPT /CLEAR THE TYPE FLAG SET TO TTY
+ DCA C8SETS /CLEAR SOFT FLAG FOR CNTRL S
+ DCA INMODE
+ JMS UPAROW /PRINT THE ^ AND C8CHAR
+C8BY4, DCA C8SWST /CLEAR FLAG FOR CNTRL D OR R
+ JMP I XDOSW /GO TO ADDRS OF C8SWIT
+XDOSW, BGN /DOSW IS LABEL FOR C8SWIT QUESTION
+/
+/
+/CONTROL S
+/STOP SENDING CHAR. TO DISPLAY UNTIL A ^Q IS RECEIVED
+/
+/
+CNTRLS, TAD C8SETS /IF1 DO NOT STORE IN C8RETR
+ SZA CLA
+ JMP C8DO7 /DONT SET UP C8RETR
+ IAC /MAKE RETURN CALL PLUS 2
+ TAD XC8CNT /GET RETURN FOR THIS CALL
+ DCA C8RETR /STORE IT HERE FOR USE BE CNTROL Q
+C8DO7, ISZ C8SETS /SET FLAG TO SAVE CALL
+ JMS XC8TTYI /LOOK FOR THE INPUT
+ JMS C8GET /GET REGISTERS
+ JMS XC8CNTR /CHECK FOR THE CONTROL CHAR
+ CLA
+ JMP CNTRLS /IF NOT A CNTRL Q R C REASK
+C8SETS, 0
+C8RETR, 0
+/
+/SWITCH OUTPUT FROM ONE OUTPUT DEVICE TO ANOTHER - THE TWO OUTPUTS ARE THE
+/CONSOLE AND THE PRINTER WITH DEVICE CDOE 66.
+/
+/
+CNTRLL, TAD TTYLPT /GET PRESENT C8SWIT INDICATOR
+ CMA /COMPLEMENT IT
+ DCA TTYLPT /STOR NEW C8SWIT
+ JMS UPAROW /C8PRNT ^ AND CHAR ON NEW DEVICE
+ JMS C8GET /RESTORE THE REGISTERS
+ JMP I XC8CNT /EXIT
+/
+/CONTROL E
+/CONTINUE RUNNING FROM A INQUIRE OR ERROR
+/
+/
+CNTRLE, JMS UPAROW /PRINT THE CONTROL CHAR
+ JMS C8GET /GET THE REGISTERS
+ JMP I XC8CNT /RETURN TO CALL PLUS ONE
+/
+
+/CONTROL C
+/RETURN TO MONITOR CONTROL C
+CNTRLC, DCA TTYLPT /CLEAR THE LPT FLAG TO PRINT ON DISPLAY
+ JMS UPAROW /C8PRNT A^ AND LETTER IN CHAR
+ CDF CIF /GO TO 0 FLD
+ CAF /CLEAR THE WORLD
+ JMP I (7600 /GO TO DIAGNOSTIC MONITOR
+/*********************************************************************
+/
+/
+/
+PAGE
+
+/
+ /CONTROL D
+ /CHANGE THE SWITCH REGISTER ANYTIME CNTRL D AND RETURN TO
+ /THE PROGRAM RUNNING.
+
+
+CNTRLD, JMS UPAROW
+\f TAD C8SETD /CHECK IF THE RETURN ADDRS IS SAFE
+ SZA CLA
+ JMP C8DO11 /DO NOT CHANGE THE RETURN ADDRS
+ TAD XC8CNT /GET THE RETURN ADDRS AND SAVE IT
+ DCA C8RETD /SAVE THE RETURN HERE
+ ISZ C8SETD /INDICATE RETURN SAVED DONT DISTROY
+C8DO11, JMS XC8PSW /GO CHANGE THE SWITCH REGISTER
+ DCA C8SETD /CLEAR THE FLAG
+ JMS C8GET /RESTORE THE AC MQ LINK ETC
+ JMP I C8RETD /RETURN TO THE PROGRAM
+/
+C8SETD, 0
+C8RETD, 0
+
+
+
+/THIS WILL TYPE A UP ARROW AND THE CHAR IN C8CHAR.
+
+UPAROW, 0 /C8PRNT THE "^" AND THE CHAR C8TYPED IN
+ TAD (336 /CODE FOR ^
+ JMS XC8TYPE
+ TAD C8CHAR /C8TYPE THE CHAR
+ JMS XC8TYPE
+ JMS XC8CRLF
+ JMP I UPAROW /EXIT
+
+
+
+/***********************************************************************
+
+C8GET, 0
+ CLA
+ TAD MQSAVE
+ MQL /RESTORE MQ
+ TAD FLSAVE
+ RAL /RESTORE THE LINK
+ CLA
+ TAD ACSAVE /RESTORE THE AC
+ JMP I C8GET /GET THE REGISTERS
+
+
+
+/********************************************************************
+
+/C8INQU
+/C8INQU ROUTINE WILL PRINT A WAITING
+/AND THE PROGRAM IS EXPECTING A CONTROL CHAR INPUT
+/IF CONTINUE FROM CONTROL CHAR RETURN IS CALL PLUS ONE
+/IF NO CONTROL CHAR ENTERED THEN WAITING IS REPRINTED
+/AND PROGRAM WAITS FOR A CONTROL CHAR AGAIN.
+
+/ C8INQU = JMS XC8INQ
+
+/EX. JMS XC8INQ /C8 WILL PRINT A WAITINGAND WAIT FOR INPUT
+/ DO ANYTHING /RETURN IS CALL PLUS ONE AC =0 CONTINUE
+
+/CALLS USED ARE -CHKCLA-XC8PNT-XC8TYI-C8GET-XC8CNTR-
+
+
+XC8INQ, 0
+ CLA CLL
+ JMS CHKCLA /CHECK LOC 22 BIT 3 CONSOLE BIT
+ SKP /ACTIVE CONSOLE PACKAGE
+ JMP I XC8INQ /NOT CONSOLE LEAVE
+ JMS XC8PNT
+ WATMES /INQUIR WAITTING
+ JMS XC8TTYI /GET CHARACTER
+ JMS C8GET
+ JMS XC8CNTR /CHECK IF CONTROL CHARACTER
+ JMP I XC8INQ /EXIT AND CONTINUE
+ JMP XC8INQ+1 /REASK
+WATMES, TEXT "WAITING "
+
+
+/*********************************************************************
+
+/C8SWIT
+
+/ROUTINE WILL CHECK IF CONSOL IS ACTIVE IF IT IS ACTIVE DISPLAY
+/SW QUESTION . IN NOT ACTIVE IT WILL NOT PRINT THE SW QUESTION BUT
+/RETURN TO CALL PLUS ONE AC=0.
+/C8SWIT WILL SET UP THE PSEUDO SWITCH
+/REGISTER WITH THE NEW DATA ENTERED
+/
+/ C8SWIT = JMS XC8PSW
+
+/EX. JMS XC8PSW /SET UP PSEUDO C8SWIT REGISTER IF
+ /ON THE CONSOL PACKAGE. RETURN IS CALL PLUS ONE AC = 0
+
+/CALLS USED ARE -CHKCLA-XC8PSW-XC8PNT-XC8OCTA-XC8TYPE-
+
+
+XC8PSW, 0
+ JMS CHKCLA /CHECK LOC 22 BIT 3 CONSOLE BIT
+ SKP /ACTIVE CONSOLE
+ JMP I XC8PSW /DEACTIVE CONSOLE PACKAGE
+ /RETURN WITHOUT ASKING PSEUDO SWITCH
+ TAD C8SWST /IS THE SOFT FLAG SET FOR SWITCH?
+ SZA CLA /SKIP IF ONE ENTRY AT ATIME OK
+ JMP C8BY4 /SECOND ENTRY WITH OUT A EXIT GO TO SW QUESTION
+ ISZ C8SWST /FIRST ENTRY SET FLAG
+C8RDPS, JMS XC8PNT /C8PRNT SR=
+ MESA
+ TAD 20 /GET CONTENTS OF SW
+ JMS XC8OCTA /CONVERT IT TO ASCII
+ TAD (40 /GET SPACE
+ JMS XC8TYPE
+ ISZ INMODE /SET FLAG FOR CHAR EXECTED
+ JMS XC8ECHO /LOOK FOR INPUT
+ JMS TSTCHA /NOT CONTROL TEST IT IS LEGAL
+ TAD C8CHAR /STORE NEW CHAR IN SW REG
+ DCA 20
+
+ TAD (-3 /GET A MINUS 3
+ DCA TMPCNT /STORE IN TEMP COUNT
+GETCH1, JMS XC8ECHO /GET NEXT CHAR
+ JMS TSTCHA /CHECK IF CR + GOOD CHAR
+ TAD 20 /GET C8SWIT REGISTER
+ RTL CLL /ROTATE IT LEFT 3 PLACES
+ RAL
+ TAD C8CHAR /GET CHAR + ADD IT TO PREVIOUS CONTENTS
+ DCA 20 /SAVE NEW CONTENTS
+ ISZ TMPCNT /BUMP COUNT
+ JMP GETCH1 /JMP BACK + GET NEXT CHAR
+ JMP ENDIT /END 4 CHAR C8TYPED IN
+TSTCHA, 0
+ CIA /CMPL CHAR IN AC
+ TAD (215 /TEST IF IT IS A CARRIAGE RETURN
+ SNA CLA /SKIP IN NOT CR.
+ JMP ENDIT /WAS CARRIAGE RETURN
+ TAD C8CHAR /NOT CR. GET CHAR
+ TAD (-260 /CHECK IF IT IS IN RANGE
+ SPA CLA /IF NOT POSITIVE C8ERR CHAR SMALLER THEN 260
+ JMP ERR1 /C8ERR - CHAR TOO SMALL
+ TAD C8CHAR /GET CHAR
+ TAD (-270 /GET A -270 + CHECK IF IT IS LARGER THEN 7
+ SMA CLA /SKIP IF LESS THEN 7
+ JMP ERR1 /C8ERR ON CHAR NOT IN RANGE
+ TAD C8CHAR /GET CHAR
+ AND (7 /MASK FOR RIGHT BYTE
+ DCA C8CHAR /STORE IN CHAR
+ /GET CHAR IN AC
+ JMP I TSTCHA /EXIT
+ERR1, TAD (277 /C8PRNT
+ JMS XC8TYPE /?
+ JMS XC8CRLF /
+ JMP C8RDPS /EXIT + ASK AGAIN
+ENDIT, JMS XC8CRLF /DO A CR LF
+ DCA C8SWST /CLEAR THE PSW ENTRY FLAG
+ JMP I XC8PSW /EXIT ROUTINE
+C8SWST, 0
+
+TMPCNT, 0
+MESA, TEXT "SR= "
+
+
+PAGE
+
+/C8OCTA
+
+/OCTAL TO ASCII CONVERSION
+/THIS ROUTINE WILL TAKE THE OCTAL NUMBER IN THE AC AND CONVERT IT TO ASCII
+/THE RESULT WILL BE PRINTED ON THE CONSOL TERMINAL
+/ C8OCTA= JMS XC8OCT
+/
+/EX. JMS XC8OCTA /AC CONTAINS NUMBER TO BE CHANGE
+/ RETURN IS TO CALL PLUS ONE AC=0
+/
+/CALLS USED ARE -XC8TYPE-
+
+
+XC8OCT, 0
+ CLL RTL
+ RTL /POSITION THE FIRST CHAR FOR PRINTING
+ DCA C8TMP1 /SAVE CORRECT POSITIONED WORD HERE
+ TAD (-4
+ DCA C8CKP /STORE COUNTER IN HERE
+C8DO4, TAD C8TMP1 /GET FIRST NUMBER
+ AND (0007 /MASK
+ TAD (260 /ADD THE PRINT CONSTANT
+ JMS XC8TYPE /TYPE THE NUMBER
+ TAD C8TMP1 /
+ RTL
+ RAL /PUT NEXT NUMBER IN POSITION
+ DCA C8TMP1 /STORE IT
+ ISZ C8CKP /DONE YET WITH FOUR NUMBERS
+ JMP C8DO4 /NOT YET DO MORE
+ JMP I XC8OCT /DONE WITH FOUR
+ C8TMP1, 0
+ C8CKP, 0
+
+
+/*********************************************************************
+
+/C8CRLF
+/C8TYPE CR AND LF WITH FILLERS FOLLOWING EACH LF AND CR
+\f/
+/ C8CRLF= JMS XC8CRL
+/
+/EX. JMS XC8CRLF /C8PRNT A CR AND LF WITH FILL
+/ /RETURN TO CALL PLUS ONE AC =0
+/CALLS USED ARE -XC8TYPE-
+
+
+XC8CRLF,0
+ CLA CLL
+ TAD (215 /GET CODE FOR CR
+ JMS XC8TYPE
+ TAD FILLER
+ CMA
+ DCA FILCNT /STORE FILLER IN HERE
+ TAD (212 /GET CODE FOR LF
+C8DO2, JMS XC8TYPE
+ ISZ FILCNT /CHECK ON FILLER CHAR
+ JMP C8DO2 /TYPE A NON PRINTING CHAR
+ JMP I XC8CRL /EXIT
+FILLER, 0004 /FILLER SET FOR 4 CHAR
+FILCNT, 0 /COUNTER FOR FILL
+
+
+
+//*************************************************************
+/C8CKPA
+/THIS ROUTINE WILL CHECK IF A CHARACTER WAS ENTERED FROM THE
+/TERMINAL. IFTHE FLAG IS SET AND THE CONSOLE PACKAGE IS
+/ACTIVE A CHECK IS MADE TO DETERMIND IF IT IS A CONTROL CHAR.
+/IF IT WAS A CONTROL CHAR THEN ITS CONTROL FUNCTION IS PERFORMED.
+/IF NOT A CONTROL CHARACTER OR A CONTROL E-D-L-O- IT WILL DO
+/THE CONTROL FUNCTION AND RETURN TO CALL PLUS 2.
+/A NON CONTROL CHARACTER WILL BE PRINTEDAND A "?" IT WILL RETURN TO
+/CALL PLUS 2.
+/IF NO FLAG IS SET OR THE CONSOL IS NOT ACTIVE THE RETURN IS TO
+/CALL PLUS 1.
+
+
+/ C8CKPA= JMS XC8CKP
+
+
+/EX. JMS XC8CKPA /CALL TO CHECK IF CONTROL CHAR SET
+/ ANYTHING(SKIP) /RETURN IF NOT FLAG OR NOT CONSOLE ACTIVE
+/ ANYTHING(JMP EXIT SKIP CHAIN) /RETURN IF NOT CONTROL OR CONTINUE CONTROL
+
+
+/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-
+
+
+XC8CKP, 0
+ DCA ACSAVE /SAVE THE AC
+ GTF /SAVE THE FLAGS
+ DCA FLSAVE /SAVE THE FLAGS
+ MQA /PUT MQ IN AC
+ DCA MQSAVE /SACE THE MQ
+ KSF /CHECK THE KEYBOARD FLAG
+ JMP C8BY3 /EXIT TO CALL PLUS 1
+ JMS CHKCLA /CHECK LOC 22 BIT 3 CONSOLE BIT
+ SKP /ACTIVE CONSOLE PACKAGE
+ JMP C8BY3 /EXIT TO CALL PLUS 1
+ JMS XC8TTYI /GET THE CHAR
+ JMS C8GET /GET THE FLAGS
+ JMS XC8CNTR /CHECK IF CONTROL CHAR.
+ NOP /RETURN IF A CONTINUE CHAR.
+ ISZ XC8CKP /BUMP RETURN FOR CALL PLUS 2
+C8BY3, JMS C8GET /GET REGISTERS
+ JMP I XC8CKP /SAY GOOD BY
+
+//*********************************************************************
+
+/C8ECHO
+/THIS ROUTINE WILL LOOK FOR A CHAR FROM THE KEYBOARD. STORE IT IN LOCATION CHAR
+/CHECK IF IT WAS A CONTROL CHARACTER - SET INMODE - PRINT CHARACTER
+
+/ C8ECHO = JMS XC8ECH
+/EX. JMS XC8ECHO /LOOK FOR CONSOL CHAR C8PRNT IT
+ /RETURN CALL PLUS ONE AC = CHAR C8TYPED IN
+
+/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-XC8ECH-XC8TTYPE
+
+/
+XC8ECH, 0
+ JMS XC8TTYI /WAIT FOR CHAR FROM KEYBOARD
+ JMS C8GET /RESTORE THE REGISTERS
+ ISZ INMODE /SET INMODE IDENTIFING THIS AS A EXPECTED CHAR
+ JMS XC8CNTR /GO CHECK IF IT IS A CONTROL CHAR
+ JMP I XC8ECH /WAS A CONTROL CHAR - CONTINUE RUNNING
+ JMS XC8TYPE /NOT A CONTROL CHAR C8PRNT IT
+ DCA INMODE /CLEAR FLAG THAT CHAR EXPECTED
+ TAD C8CHAR /GET CHAR IN AC
+ JMP I XC8ECH /EXIT
+C8CHAR, 0
+INMODE, 0
+
+/*********************************************************************
+
+/C8TYPE
+/THIS ROUTINE WILL C8PRNT ON THE CONSOLE OR THE LPT WITH DEVICE CODE 66.
+/
+/ C8TYPE= JMS XC8TYP
+
+/EX. JMS XC8TYPE /C8PRNT THE CHAR IN THE AC.
+ / /RETURN CALL PLUS ONE AC =0000
+ /DO NOT CLEAR THE LINK IN THIS ROUTINE NEEDED BYC8OCT
+
+/CALLS USED ARE -C8HANG-XC8CNTR-XC8PNT-XC8CRLF-XC8INQU-
+
+
+XC8TYP, 0
+ DCA PNTBUF /STORE CHAR
+ TAD TTYLPT /CHECK O=TTY 7777=LPT
+ SZA CLA
+ JMP XDOLPT /DO OUT PUT ON LPT
+ TAD PNTBUF
+ TLS
+ TSF
+ JMP .-1
+ TCF
+ JMP C8BY5
+XDOLPT, TAD PNTBUF /GET CHAR
+ PSTB PCLF /C8PRNT IT
+ JMS C8HANG /CHECK KEYBOARD IF HUNG
+ PCLF /CLEAR THE FLAG
+C8BY5, 7600 /CLEAR THE AC
+ JMP I XC8TYP /EXIT
+PNTBUF, 0
+TTYLPT, 0
+
+
+C8HANG, 0
+ CLA /
+ TAD C8BY5 /GET CONSTANT 7600
+ DCA PNTBUF /PNTBUF IS NOW A COUNTER
+ PSKF /SKIP ON PRINTER DONE
+ SKP /NOT DONE YET
+ JMP I C8HANG /SAW FLAG DONE
+ ISZ C8CONT /FIRST COUNTER FAST ONE
+ JMP .-4 /CHECK IF FLAG SET YET
+ ISZ PNTBUF /MADE 4096 COUNTS ON FAST COUNTER
+ JMP .-3 /KEEP IT UP FOR 5 SEC
+ TAD XC8CNTR /GET THE RETURN ADDRESS IN CONTROL
+ DCA C8HANG /SAVE IT IN HANG
+ DCA TTYLPT /ALLOW PRINTING ON TTY
+ JMS XC8PNT
+ MESHANG /LPT ERROR
+ JMS XC8CRLF
+ JMS XC8INQU /PRINT WAITING
+ JMP I C8HANG /CONTINUE TO SAVE ADDRESS
+C8CONT, 0 /COUNTER FOR TIMER
+MESHANG,TEXT "LPT ERROR"
+
+PAGE
+/*********************************************************************
+/*******************************************************************
+
+/THIS ROUTINE WILL CHECK LOCATION 22 THE HARD WARE CONFIG WORD.
+/TO SEE IF THE CONSOLE BIT 3 )400) IS SET IF SET THEN RETURN
+/TO CALL PLUS TWO FO A ACTIVE CONSOLR PACKAGE AC=0
+/IF NOT SET THEN TO CALL PLUS ONE FOR A DEACTIVE CONSOLE PACKAGE.
+
+
+CHKCLA, 0
+ CLA
+ TAD 22 /GET THE COTENTA OF LOCATION 22
+ AND (400 /MASK FOR BIT 3 (400
+ SNA CLA /
+ ISZ CHKCLA /ACTIVE CONSOLE PACKAGE RETURN
+ /CALL PLUS ONE (1) FOR ACTIVE
+ JMP I CHKCLA /DEACTIVE CONSOLE PACKAGE RETURN
+ /CALL PLUS TWO (2)
+
+/C8ERR
+/THIS ROUTINE WILL DETERMINE WHAT TO DO WHEN A C8ERR IS ENCOUNTERED
+/WILL CHECK IF CLASSIC SYSTEM, WILL CHECK C8SWIT REGISTERS.
+/ C8ERR= JMS XC8ERR
+/EX. JMS XC8ERR /GO TO C8ERR CALL IF NOT CONSOL
+/ /RETURN IS CALL PLUS ONE AC =0000
+
+/CALLS USED ARE -CHKCLA-XC8CRLF-XC8SW-XC8INQU-XC8PNT-XC8OCTA-
+
+
+XC8ERR, 0
+ IOF
+ DCA ACSAVE /SAVE AC
+ GTF
+ DCA FLSAVE /SAVE THE FLAGS
+\f MQA
+ DCA MQSAVE /SAVE THE MQ
+ CLA CLL CMA /SUBTRACT A 1 FOR TRUE LOCATION
+ TAD XC8ERR /GET RETTURN LOCATION
+ DCA PCSAVE /SAVE ADD OF C8ERR CALL
+ JMS CHKCLA /CHECK LOC.22 BIT 3 CONSOL BIT
+ SKP /ACTIVE CONSOLE PACKAGE
+ JMP NTCLAS /NOT CLASSIC SYSTEM
+ JMS C8GET /GET THE REGISTERS.
+ JMS XC8SW /CHECK SWITCH REG FOR BIT THAT INDICATES
+ /NO ERROR MESSAGE
+SETUP1, AND (0000 /MASK FOR BIT FOR NO ERROR PRINTING
+ /IF THIS ERROR MESSAGE IS TO ALWAYS
+ /BE PRINTED LEAVE AND VALUE AT 0000
+ SZA CLA /SKIP IF BIT IS 0 PRINT ERROR MESSAGE
+ JMP C8DO10 /DO NOT PRINT
+ JMS XC8CRLF
+ JMS XC8PNT
+ ERRMES /PRINT THE ERROR MESSAGE
+ JMS XC8PNT
+ MESPC /PRINT THE PC STSTEMENT
+ TAD PCSAVE
+ JMS XC8OCTA /CONVERT 4 DIGIT PC TO ASCII
+ JMS XC8PNT
+ MESAC /PRINT THE AC MESS
+ TAD ACSAVE
+ JMS XC8OCTA
+ JMS XC8PNT
+ MESMQ /PRINT MQ
+ TAD MQSAVE
+ JMS XC8OCTA
+ JMS XC8PNT
+ MESFL /PRINT FL
+ TAD FLSAVE
+ JMS XC8OCTA
+ JMS XC8CRLF
+C8DO10, JMS C8GET /GET THE REGISTERS.
+ JMS XC8SW /CHECK SWITCH REGISTER
+ SKP CLA /SKIP IF BIT 0 SET
+ JMP C8BY2 /LEAVE
+ JMS XC8INQ /GO TO THE INQUIRE ROUTINE
+ JMP C8BY2 /LEAVE
+NTCLAS, JMS C8GET /GET THE REGISTERS.
+ JMS XC8SW /CHECK PSEUDO SWITCH REGISTER
+ /CHECK THE C8SWIT REGISTER
+ SKP CLA /SKIP IF HALT
+ JMP I XC8ERR /NO HALT CONTINUE
+ TAD (7402 /CODE FOR HLT
+ DCA I PCSAVE /PUT IT IN CALL LOC.
+ JMS C8GET
+ JMP I PCSAVE /EXIT TO CALL AND HALT
+C8BY2, JMS C8GET /GET THE REGISTERS
+ JMP I XC8ERR
+ERRMES, TEXT "DHRKDD FAILED "
+MESPC, TEXT " PC:"
+MESAC, TEXT " AC:"
+MESMQ, TEXT " MQ:"
+MESFL, TEXT " FL:"
+PCSAVE, 7777
+ACSAVE, 7777
+MQSAVE, 7777
+FLSAVE, 7777
+
+ $$$
+/#8
+/#8
--- /dev/null
+/8 OS8 SET (PAL8/MACREL VERSION)
+
+/
+/S.R.
+/
+/
+/ S E T
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/ COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION.
+/
+/
+/
+/
+\f/ EDIT HISTORY:
+
+/ 19-MAR-77 S.R. REMOVED FROM CAMP V4
+/ 19-MAR-77 S.R. FIXED BUG WITH SET MTA FILES
+/ 19-MAR-77 S.R. FIXED BUG WITH SET CDR
+/ 19-MAR-77 S.R. FIXED BUG WITH = OPTION
+/ 19-MAR-77 S.R. CONVERTED TO MACREL CODE
+/ 01-APR-77 S.R. TTY PAUSE
+/ 01-APR-77 S.R. TTY HEIGHT
+/ 01-APR-77 S.R. TTY SCOPE
+/ 17-APR-77 S.R. REWROTE TTY PAGE
+/ 17-APR-77 S.R. DEV: DVCODE
+/ 17-APR-77 S.R. FINISHED TTY SCOPE
+/ 27-APR-77 S.R. TTY COL
+/ 27-APR-77 S.R. SYS OPTIONS (INIT, OS8, OS78)
+/ 03-MAY-77 S.R. LA8A, LA78
+/ 03-MAY-77 S.R. INIT OS78 FIXES TERMINATE
+/ 03-MAY-77 S.R. BASIC FIXES
+/ 29-JUN-77 S.R. TTY ARROW (NOT FOR PS/8)
+/ 29-JUN-77 S.R. TTY ESC (NOT FOR PS/8)
+/ 29-JUN-77 S.R. DEV BLK LOC (NOT FOR PS/8)
+
+/ MUST SKIP LOCS 1000-1777
+
+ LINBUF=1000
+
+ AUXBUF=6600
+
+ IFDEF EDF <MACREL=1>
+ IFNDEF EDF <MACREL=0>
+
+ IFNZRO MACREL < .XSECT XSET
+ >
+ IFZERO MACREL < *10 >
+
+XR1, 0
+XR2, 0
+XR3, 0
+
+ IFNZRO MACREL < .ZSECT ZSET
+ >
+ IFZERO MACREL < *20 >
+TEMP, 0
+T, 0
+T2, 0
+LINPTR, 0
+T3, 0
+FLAG, 0
+SPKNT, 0
+DEVTYP, 0 /DEVICE TYPE (BITS 6-11)
+ENTRY, 0 /HANDLER ENTRY POINT
+NUM, 0
+TYP, 0 /0 MEANS 'F', 1 MEANS 'R'
+T4, 0
+DEVNUM, 0
+DCW, 0 /DEVICE CONTROL WORD
+DCWPTR, 0
+USR, 200 /POINTS TO USR ENTRY POINT
+ESCBIT, 0 /1 MEANS USER TYPED ALTMODE
+CNT, 0
+CTOFLG, 0 /-1 MEANS SAW ^O
+PTR, 0
+DHIT, 0 /DEVICE HANDLER INFO TABLE - 1
+DHI, 0 /DEVICE HANDLER INFO
+DBLK, 0 /DEVICE HANDLER BLOCK
+VNOPTR, 0 /PTS TO VERSION # IN HANDLER
+VNO, 0 /CURRENT HANDLER VERSION NUMBER
+SAVPTR, 0
+NO, 0 /1 MEANS 'NO'
+FLG, 1 /1 MEANS SAW NO DIGITS
+RR, 0
+NUCODE, 0
+SCOP, 0 /NON-0 IF TTY IS SCOPE
+NUM2, 0
+
+/0000-0777 /SET
+/1000-1377 /OS/8 LINE BUFFER
+/1400-1777 /PS/8 LINE BUFFER
+/2000-6577 /SET
+/6600-7177 /AUXILIARY I/O BUFFER
+/7000-7177 /I/O BUFFER FOR TECO CCB
+/7200-7577 /OS/8 HANDLER
+/7600-7777 /OS/8
+
+ SCPBIT=7726 /BIT 4
+\f IFNZRO MACREL < .ASECT ASET
+ >
+ *200
+
+START, SKP
+ JMP CHN
+ TAD ("#
+ JMS I [TYPE
+ JMS BIT
+ JMS I [READ /READ A LINE INTO OS/8 LINE BUFFER
+CHN, TAD [LINBUF /CHAIN ENTRY ADDRESS
+ DCA LINPTR /INITIALIZE POINTER TO LINE BUFFER
+ JMS BIT
+ STA
+ JMS I [SPACE /IGNORE LEADING SPACES
+ JMS GETTWO /GET TWO CHARS
+ DCA TEMP
+ JMS I [SCAN /SCAN PAST EXTRA LETTERS OR DIGITS
+ TAD TEMP
+ JMS I [BRANCH /GO TO APPROPRIATE ROUTINE
+ -2305;SET /SE
+ -2605;VERSION /VE
+ -1005;HELP /HE
+ 0
+ SNA CLA
+ JMP I [GOAWAY
+ JMP I [SYNTAX /NONE OF THESE
+
+BIT, 0
+ CDF 10
+ TAD I (SCPBIT
+ CDF 0
+ AND [200
+ DCA SCOP /NOTE WHETHER TTY IS SCOPE V3D
+ JMP I BIT
+\f/ GETTWO
+
+/GET TWO LETTERS OR DIGITS FROM INPUT LINE, PACK IN SIXBIT
+/ADVANCE PAST THEM. SUBSTITUTE NULL IF NOT FOUND.
+
+GETTWO, 0
+ JMS GETSIX
+ CLL RTL
+ RTL
+ RTL
+ DCA T2
+ JMS GETSIX
+ TAD T2 /COMBINE
+ JMP I GETTWO
+
+GETSIX, 0 /GET A SIXBIT LETTER OR DIGIT (OR NULL)
+ JMS ALPHA /IS IT ALPHANUMERIC?
+ JMP NOTALPH /NO
+ AND [77 /YES
+ JMP I GETSIX /TRUNCATE TO SIXBIT
+NOTALPH,CLA
+ JMS BACKC
+ JMP I GETSIX /RETURN NULL
+
+GETC, 0 /GET A CHARACTER, ADVANCE POINTER
+ TAD I LINPTR
+ AND [177 /ALWAYS RETURN 8-BIT
+ SZA
+ TAD [200 /WITH HIGH ORDER BIT ON
+ ISZ LINPTR /ADVANCE SCAN
+ JMP I GETC /RETURN
+
+BACKC, 0 /MOVE SCAN POINTER BACK ONE
+ STA
+ TAD LINPTR
+ DCA LINPTR
+ JMP I BACKC /RETURN
+\f/RETURN 1 NOT OF TYPE DESIRED
+/RETURN 2 DESIRED TYPE
+/IN BOTH CASES, CHAR IS LEFT IN AC
+
+ALPHA, 0 /LOOK FOR ALPHANUMERIC
+ JMS I [GETC
+ JMS LETTER /IS IT A LETTER?
+ JMP TRYDIG /NO, TRY DIGIT
+ JMP GOTAL /YES
+TRYDIG, JMS DIGIT /IS IT A DIGIT?
+ JMP I ALPHA /NO, AINT LETTER OR DIGIT
+GOTAL, ISZ ALPHA /YES, EITHER LETTER OR DIGIT
+ JMP I ALPHA /RETURN WITH IT IN AC
+
+LETTER, 0 /LOOK FOR LETTER
+ TAD (-"A
+ CLL
+ TAD ("A-"Z-1
+ SNL
+ ISZ LETTER
+ TAD ("Z+1 /RESTORE CHAR
+ JMP I LETTER
+
+DIGIT, 0 /LOOK FOR DIGIT
+ TAD (-"0
+ CLL
+ TAD ("0-"9-1 /(DECIMAL)
+ SNL
+ ISZ DIGIT
+ TAD ("9+1 /RESTORE DIGIT TO CHARACTER FORM
+ JMP I DIGIT /AND RETURN WITH IT IN AC
+\fHELP, JMS I [PRINT
+ TEXT /SET DEV: [NO] ATTRIB [N]/
+ JMS I [PRINT
+ TEXT /VERSION/
+ JMS I [PRINT
+ TEXT /HELP/
+ JMP I [START
+ PAGE
+\fSYNTAX, CLA
+ JMS PRINT
+ TEXT /? SYNTAX ERROR/
+GOAWAY, TAD ESCBIT
+ SZA CLA
+ JMP I [7605 /LINE ENDED WITH ESCAPE
+ TAD I [READ /WAS 'READ' EVER CALLED?
+ SZA CLA
+ JMP I [START /YES, GET A NEW LINE
+ JMP I [7605 /NO, WE MUST'VE BEEN CHAINED TO, RECALL KBM
+
+PRINT, 0
+ TAD I PRINT
+ RTR
+ RTR
+ RTR
+ JMS PRIN
+ TAD I PRINT
+ JMS PRIN
+ ISZ PRINT
+ JMP PRINT+1
+LV, JMS I [CRLF
+ ISZ PRINT
+ JMP I PRINT
+
+PRIN, 0
+ AND [77
+ SNA
+ JMP LV
+ TAD [240
+ AND [77
+ TAD [240
+ DCA T3
+ TAD [200
+ KRS
+ TAD (-203
+ SNA
+ JMP CTRLC
+ TAD (203-217 /^O
+ SNA CLA
+ JMS CTRLO
+ TAD T3
+ JMS I [TYPE
+ JMP I PRIN
+\fCTRLC, TAD ["^
+ JMS I [TYPE
+ TAD ("C
+ JMS I [TYPE /ECHO "^C"
+ JMS I [DELAYY
+ JMP I [7600 /THEN GO AWAY
+CTRLO, 0
+ KCC /CLEAR OUT ^O
+ TAD ["^
+ JMS I [TYPE
+ TAD ("O
+ JMS I [TYPE
+ JMS I [CRLF
+ STA
+ DCA CTOFLG /STOP ECHOING
+ JMP I CTRLO
+
+VERSION,JMS PRINT
+ TEXT \OS/8 SET V1B\
+ JMP I [START
+NUMBIG, JMS PRINT
+ TEXT /? NUMBER TOO BIG/
+ JMP I [GOAWAY
+\fNONEX, JMS PRINT
+ TEXT /? CAN'T - DEVICE DOESN'T EXIST/
+ JMP I [GOAWAY
+
+SYSERR, JMS PRINT
+ TEXT \? I/O ERROR ON SYS:\
+ JMP I [GOAWAY
+ PAGE
+\fSYSOS8, 0
+ TAD NO /REVERSE MEANING OF 'NO'
+ SNA CLA
+ IAC
+ DCA NO
+ JMS SYS78
+ JMP I SYSOS8
+
+SYS78, 0
+ TAD [7771
+ JMS I [SET200
+ JMS I [7607
+ 200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+ TAD (AUXBUF+371
+ JMS I [SET200
+ JMS I [7607
+ 4200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+ JMS I [7607 /THERE'S A 2ND COPY
+ 200 /IN BLOCK 11 LOCATION 56
+ AUXBUF
+ 11
+ JMP I [SYSERR
+ TAD (AUXBUF+56
+ JMS I [SET200
+ JMS I [7607
+ 4200
+ AUXBUF
+ 11
+ JMP I [SYSERR
+ JMS I (FIXCCL
+ JMP I SYS78
+\fSYSINI, 0
+ JMS I [GETC
+ SNA CLA
+ JMP DEFINI /ASSUME @INIT
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX /SET SYS NO INIT CMD
+ JMS I [BACKC
+ TAD LINPTR
+ DCA SAVLP
+ TAD (-6 /ALLOW A MAXIMUM OF 5 CHARS
+ DCA SAVKN
+SAVLUP, JMS I [GETC
+ SNA CLA
+ JMP DEFDO
+ ISZ SAVKN
+ JMP SAVLUP
+ JMS I [PRINT
+ TEXT /? INITIAL COMMAND TOO BIG/
+ JMP I [GOAWAY
+
+SAVKN, 0
+SAVLP, 0
+
+DEFINI, TAD (INIMSG
+ DCA SAVLP
+DEFDO, JMS I [7607
+ 200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+ TAD NO
+ SZA CLA
+ TAD (400-1077
+ TAD (1077
+ DCA I (AUXBUF+77
+ JMS I [7607
+ 4200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+ TAD NO
+ SZA CLA
+ JMP I SYSINI
+ JMS I [7607
+ 200
+ AUXBUF
+ 11
+ JMP I [SYSERR
+ STA
+ TAD SAVLP
+ DCA XR2
+ TAD (AUXBUF-1
+ DCA XR3
+ TAD (-5
+ DCA SAVKN
+MOVL, TAD I XR2
+ DCA I XR3
+ ISZ SAVKN
+ JMP MOVL
+ JMS I [7607
+ 4200
+ AUXBUF
+ 11
+ JMP I [SYSERR
+ JMP I SYSINI
+
+INIMSG, "@;"I;"N;"I;"T;0
+ PAGE
+\f *1400
+
+/THIS WON'T ALWAYS WORK UNDER PS/8:
+
+TTGGO, JMP I TTGAG
+TTGAG, 0
+ JMS I [TTST1
+ JMS I [PRINT
+TEXT /A FUNNY THING HAPPENED TO ME ON THE WAY TO THE COMPUTER ROOM./
+ JMS I [PRINT
+TEXT /A PANHANDLER CAME UP TO ME AND SAID,/
+ JMS I [PRINT
+TEXT /"CAN YOU SPARE ME $25,000 FOR A CUP OF COFFEE?"/
+ JMS I [PRINT
+TEXT /"WHY SO MUCH?", I ASKED IN AMAZEMENT./
+ JMS I [PRINT
+TEXT /"THINGS HAVE BECOME SO AUTOMATED", HE REPLIED,/
+ JMS I [PRINT
+TEXT /"THAT THE ONLY WAY I CAN ORDER IT/
+ JMS I [PRINT
+TEXT /IS WITH A COMPUTER ORDER FORM"./
+ JMP I (TTGGO
+\fTTESC, 0 /V3D
+ JMS I (OLDTST
+ JMS I [SRCH
+ 200;200;44
+ JMP I [REASEM
+ TAD (-4
+ DCA TEMP /SEE SOURCE OF KL8E
+ TAD NO
+ SZA CLA
+ TAD (7640-CLA /YES
+ TAD (CLA /NO
+ DCA I TEMP
+ JMP I TTESC
+
+TTAROW, 0 /V3D
+ JMS I (OLDTST
+ JMS I [SRCH
+ 200;200;7740
+ JMP I [REASEM
+ IAC
+ DCA TEMP
+ TAD I TEMP
+ RAL
+KSPA, SPA CLA
+ JMP I [REASEM
+ ISZ TEMP
+ ISZ TEMP
+ TAD TEMP
+ TAD (3
+ DCA TEMP2
+ TAD NO
+ SNA CLA
+ JMP YESARO /YES
+ TAD KSPA /NO
+NOAROW, DCA I TEMP
+ JMP I TTAROW
+YESARO, TAD I TEMP2
+ JMP NOAROW
+\fGENBLK, 0 /V3D
+ JMS I (GENCMN
+ TAD NUM2
+ DCA BLOK /GET BLOCK NUMBER
+ TAD (LOC
+ JMS I [KEYSRCH
+ JMP I [SYNTAX
+ JMS I (GENCMN /GET LOCATION
+ TAD [-400
+ CLL
+ TAD NUM2
+ SZL CLA
+ JMP I [NUMBIG
+ TAD NUM2
+ TAD PAUXBUF
+ DCA NUM2
+ JMS I ENTRY /READ BLOCK
+ 200
+PAUXBUF,AUXBUF
+BLOK, 0
+ JMP I [SYSERR
+ TAD TEMP
+ SNA CLA
+ JMS I (ODT
+ JMS I [ONUM
+ DCA NUM
+ CLA IAC
+ DCA DEVNUM /FAKE OUT - PREVENTS RE-WRITING USED HANDLER
+ TAD FLG
+ SZA CLA
+ JMP I GENBLK
+ JMS I [GETC
+ SZA CLA
+ JMP I [SYNTAX
+ TAD NUM
+ DCA I NUM2 /SET NEW VALUE
+ TAD BLOK
+ DCA BLOK2
+ JMS I ENTRY
+ 4200
+ AUXBUF
+TEMP2,
+BLOK2, 0
+ JMP I [SYSERR
+ JMP I GENBLK
+ PAGE
+\f *2000
+
+/ORIGIN PAST OS/8 LINE BUFFER AT 1000.
+/SKIP PAST PS/8 LINE BUFFER (AT 1400) JUST IN CASE
+/PS/8 USERS WISH TO PATCH THIS PROGRAM
+
+/SCAN PAST EXTRA LETTERS OR DIGITS
+
+SCAN, 0
+ JMS I [ALPHA
+ JMP NOPE
+ CLA
+ JMP SCAN+1
+NOPE, CLA
+ JMS I [BACKC
+ JMP I SCAN
+
+/SCAN PAST SPACES; GIVE ERROR IF NO SPACES FOUND UNLESS AC=-1
+
+SPACE, 0
+ DCA FLAG /SET AC=-1 TO PREVENT ERROR ON NO SPACES FOUND
+ DCA SPKNT /INITIALIZE SPACE COUNTER
+ SKP /JUMP INTO LOOP
+GOTSP, ISZ SPKNT
+ JMS I [GETC /GET NEXT CHAR
+ TAD [-240
+ SNA CLA /IS IT A SPACE?
+ JMP GOTSP /YES, COUNT IT
+ JMS I [BACKC /NO, PUT IT BACK
+ ISZ FLAG /CHECK FLAG
+ SKP /USER DIDN'T SPECIFY FLAG
+ JMP I SPACE /-0 MEANT DON'T CHECK IF FOUND SPACE
+ TAD SPKNT /HOW MANY SPACES DID WE FIND?
+ SZA CLA
+ JMP I SPACE /SOME. OK
+ JMP I [SYNTAX /NONE. TSK. TSK.
+\fBRANCH, 0
+ DCA T
+BR2, TAD I BRANCH
+ ISZ BRANCH
+ SNA
+ JMP NOTFND
+ TAD T
+ SNA CLA
+ JMP FOUND
+ ISZ BRANCH
+ JMP BR2
+
+FOUND, TAD I BRANCH
+ DCA T
+ JMP I T /FOUND ITEM IN COLUMN 1, JUMP TO ADDRESS IN COL 2
+
+NOTFND, TAD T
+ JMP I BRANCH /IF NOT FOUND IN COL 1, RETURN WITH AC INTACT
+
+BADKBM, CDF 0
+ JMS I [PRINT
+ TEXT /? OLD VERSION OF KBM/
+ JMP I [GOAWAY
+\f LLS=6666
+ DBTD=6574
+ LSF=6661
+ DBST=6570
+
+LP78, 0
+ TAD (CMA-NOP
+ JMS LP8A
+ JMP I LP78
+
+LP8A, 0
+ TAD (NOP /AC MAY BE NON-0
+ DCA LPKOD
+ JMS I (LPTST1
+ TAD VNO
+ TAD (-2
+ SNA CLA
+ JMP I (OLDERR
+ JMS I [SRCH
+ 0;200;7700
+ JMP I (OLDERR
+ TAD (3
+ DCA TEMP
+ TAD I TEMP
+ AND [7000
+ TAD [-7000
+ SZA CLA /NOP OR CMA
+ JMP I (OLDERR
+ TAD LPKOD
+ DCA I TEMP
+ ISZ TEMP
+ TAD I TEMP
+ AND [7000
+ TAD (-6000
+ SZA CLA
+ JMP I (OLDERR
+ TAD LPKOD
+ AND [70
+ SZA CLA
+ TAD (DBTD-LLS
+ TAD (LLS
+ DCA I TEMP
+ ISZ TEMP
+ TAD LPKOD
+ DCA I TEMP
+ JMS I [SRCH
+ 100;100;6203
+ JMP I (OLDERR
+ TAD (2
+ DCA TEMP
+ TAD LPKOD
+ AND [70
+ SZA CLA
+ TAD (DBST-LSF
+ TAD (LSF
+ DCA I TEMP
+ JMP I LP8A
+
+LPKOD, 0
+ PAGE
+\f/READ A LINE INTO OS/8 LINE BUFFER
+
+READ, 0
+ DCA CTOFLG /ALLOW ECHOING
+RD1, TAD [LINBUF
+ DCA LINPTR
+ DCA ESCBIT
+GT, JMS I [GET
+LOOK, JMS I [BRANCH
+ -377;RUBOUT
+ -217;GT /^O
+ -203;CTRLC /^C
+ -212;LF /LINE FEED
+ -215;CR /CARRIAGE RETURN
+ -375;ESCAPE /ALTMODE
+ -376;ESCAPE /ALTMODE (2ND FLAVOR)
+ -233;ESCAPE /ESCAPE
+ -225;CTRLU /^U
+ -200;GT /IGNORE NULLS
+ -223;GT /IGNORE ^S
+ 0
+ DCA TEMP /NONE OF THESE
+ TAD LINPTR
+ TAD (-LINBUF-377
+ SNA CLA /AT END OF LINE BUFFER?
+ JMP GT /YES, DON'T ACCEPT CHAR
+ TAD TEMP /NO, RETRIEVE CHAR
+ JMS I [TYPE /ECHO IT
+ TAD TEMP /INSERT IN BUFFER
+ DCA I LINPTR
+ ISZ LINPTR /BUMP POINTER
+ JMP GT /NEXT
+
+CTRLU, TAD ["^
+ JMS I [TYPE
+ TAD ("U
+ JMS I [TYPE /ECHO "^U" <CR><LF>
+ JMS I [CRLF
+RDA, TAD ("#
+ JMS I [TYPE
+ JMP RD1
+\f BS=10
+
+RUBOUT, TAD LINPTR
+ TAD [-LINBUF
+ SNA
+ JMP BOL /AT BEGIN OF LINE
+ TAD [LINBUF-1
+ DCA LINPTR /MOVE POINTER BACK ONE
+ TAD SCOP
+ SZA CLA
+ TAD (BS-"\
+ TAD ["\
+ JMS I [TYPE /ECHO "\"
+RUB3, TAD SCOP
+ SNA CLA
+ JMP .+3
+ TAD [40
+ SKP
+ TAD I LINPTR
+ JMS I [TYPE /ECHO RUBBED-OUT CHARACTER
+ TAD SCOP
+ SNA CLA
+ JMP GT2
+ TAD [BS
+ JMS I [TYPE
+GT2, JMS I [GET
+ JMS I [BRANCH
+ -377;RUB2
+ -216;GT2 /IGNORE ^O
+ -203;CTRLC /^C
+ 0
+ DCA TEMP /A NEW CHAR
+ TAD SCOP
+ SZA CLA
+ JMP .+3
+ TAD ["\
+ JMS I [TYPE /ENCLOSE RUBBED-OUT CHARS IN \'S
+ TAD TEMP
+ JMP LOOK
+
+RUB2, TAD LINPTR
+ TAD [-LINBUF
+ SNA
+ JMP BOL2
+ TAD [LINBUF-1
+ DCA LINPTR
+ JMP RUB3
+\fBOL2, TAD SCOP
+ SZA CLA
+ JMP BOL
+ TAD ["\
+ JMS I [TYPE
+BOL, JMS I [CRLF
+ JMP RDA
+
+ESCAPE, TAD ["$ /ECHO ESCAPE AS DOLLAR SIGN
+ JMS I [TYPE
+ ISZ ESCBIT /NOTE ESCAPE
+CR, DCA I LINPTR /INSERT 0 AT END
+ JMS I [CRLF
+ JMP I READ /RETURN, WE GOT LINE
+\fLF, DCA I LINPTR /TEMPORARILY INSERT A 0 SENTINEL
+ TAD [LINBUF-1
+ DCA XR1
+ JMS I [CRLF
+ TAD ["#
+ JMS I [TYPE
+LFLP, TAD I XR1
+ SNA
+ JMP I [GT /FINISHED, GET SOME MORE CHARS
+ JMS I [TYPE /ECHO CURRENT CHARS
+ JMP LFLP
+ PAGE
+\f/GET A DECIMAL NUMBER, RETURN IT IN AC
+
+NUMBER, 0
+ DCA NUM
+ CLA IAC
+ DCA FLG
+ JMS I [BACKC
+NM1, JMS I [GETC
+ JMS I [DIGIT
+ JMP EON
+ TAD (-"0 /CONVERT TO DIGIT
+ DCA T4
+ DCA FLG /NOTE PASSAGE OF A DIGIT
+ TAD NUM
+ AND [7000
+ SZA CLA
+ JMP I [NUMBIG
+ TAD NUM
+ CLL RTL
+ TAD NUM
+ CLL RAL
+ TAD T4
+ SZL
+ JMP I [NUMBIG
+ DCA NUM
+ JMP NM1
+
+EON, CLA
+ JMS I [BACKC
+ TAD FLG
+ SZA
+ DCA NUM /IF NO DIGITS, RETURN A 1
+ TAD NUM
+ JMP I NUMBER
+\f/ GETDEV
+
+/PARSES OFF A DEVICE NAME (1-4 CHARS)
+/DETERMINES IF IT EXISTS
+/LOADS HANDLER INTO 7200-7577 IF NOT ALREADY IN CORE
+/SETS ENTRY POINT ADDRESS AT 'ENTRY'
+/SETS DEVICE NUMBER AT 'DEVNUM'
+/SETS DEVICE CONTROL WORD AT 'DCW'
+/SETS 'DEVTYP'
+
+GETDEV, 0
+ JMS I [GETTWO
+ DCA WD1
+ JMS I [GETTWO
+ DCA WD2
+ TAD WD1
+ TAD WD2
+ DCA WD1 /COMBINE TWO WORDS INTO 1 (IN WD1)
+ TAD WD2
+ SNA CLA
+ JMP INQ
+ TAD WD1 /OS/8 KLUDGE FOR UNIQUENESS
+ CLL RAL
+ STL RAR /FORCE BIT 0 ON IF 2ND WORD WAS NON-ZERO
+ DCA WD1
+INQ, DCA WD2
+ CIF 10
+ JMS I USR
+ 12 /INQUIRE
+WD1, 0 /DEVICE NAME
+WD2, 0 /GETS DEVICE NUMBER
+WD3, 0 /GETS ENTRY POINT
+ JMP I [NONEX /DEVICE DOESN'T EXIST
+ TAD WD3
+ SZA /IS HANDLER ALREADY IN CORE?
+ JMP INCORE /YES
+ TAD WD1
+ DCA DW1
+ TAD (7201 /ALLOW TWO PAGE HANDLER IN 7200
+ DCA DW3
+ DCA DW2
+ CIF 10
+ JMS I USR
+ 1 /FETCH
+DW1, 0 /DEVICE NAME
+DW2, 0 /GETS DEVICE NUMBER
+DW3, 0 /GETS ENTRY POINT
+ JMP I [NONEX /DOESN'T EXIST
+ TAD DW2
+ DCA DEVNUM
+ TAD DW3
+ DCA ENTRY
+ JMP GETYP
+\fINCORE, DCA ENTRY
+ TAD WD2
+ DCA DEVNUM
+GETYP, TAD DEVNUM
+ TAD (7757
+ DCA DCWPTR /POINT INTO DEVICE CONTROL WGRD TABLE
+ CDF 10
+ TAD I DCWPTR /GET DCW
+ DCA DCW
+ TAD DCW
+ RTR
+ RAR
+ AND [77
+ DCA DEVTYP
+ STA
+ TAD I (37 /GET ADDRESS OF DHIT
+ DCA DHIT
+ TAD DHIT
+ TAD DEVNUM
+ DCA DHI
+ TAD I DHI
+ CDF 0
+ DCA DHI
+ TAD DHI
+ RTL
+ RTL
+ RTL
+ AND (17
+ SZA
+ TAD (15
+ DCA DBLK
+ JMP I GETDEV
+
+DELAYY, 0
+ TAD (-10
+ DCA OUTER
+ ISZ ZER
+ JMP .-1
+ ISZ OUTER
+ JMP .-3
+ JMP I DELAYY
+ZER, 0
+OUTER, -10
+ PAGE
+\fOLDTST, 0 /V3D
+ JMS I (ASRTST
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;OLDERR
+ -4;OLDERR
+ -5;TSTOK
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+TSTOK, JMP I OLDTST
+\fTTPAUS, 0
+ JMS OLDTST
+ JMS I [SRCH
+ 200;100;15
+ JMP I [REASEM
+ TAD (-3
+ DCA TEMP /SEE SOURCE OF KL8E FOR EXPLANATION
+ TAD NO
+ SNA CLA
+ TAD (7650-7610 /YES
+ TAD (7610 /NO
+ DCA I TEMP
+ DCA NUM
+ JMS I [GETC
+ SNA CLA
+ JMP NOPA /NO PAUSE VALUE
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX /SET TTY NO PAUSE N
+ JMS I [NUMBER
+ SNA
+ JMP BADPAUS
+ DCA NUM
+ TAD NUM /SCALE CORRECTLY
+ CLL RAL
+ TAD NUM
+ CLL RTL
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP BADPAUS /NO DIGITS
+ TAD NUM
+ AND [6000
+ SZA CLA
+ JMP BADPAUS
+ JMS I [SRCH
+ 300;77;7600
+ JMP I [REASEM
+ TAD (5
+ DCA TEMP
+ TAD NUM
+ CIA
+ DCA I TEMP
+NOPA, JMS I (BASLUK
+ JMP I TTPAUS
+ TAD NUM
+ CIA
+ DCA I (AUXBUF+1
+ JMS I (BASWRI
+ JMP I TTPAUS
+\fBADPAUS,JMS I [PRINT
+ TEXT /? BAD VALUE FOR PAUSE DURATION/
+ JMP I [GOAWAY
+\fONUM, 0
+ DCA NUM
+ CLA IAC
+ DCA FLG
+ONM1, JMS I [GETC
+ TAD (-"0-10 /CONVERT TO DIGIT
+ CLL
+ TAD [10
+ SNL
+ JMP OEON
+ DCA T4
+ DCA FLG
+ TAD NUM
+ AND [7000
+ SZA CLA
+ JMP I [NUMBIG
+ TAD NUM
+ CLL RTL
+ RAL
+ TAD T4
+ DCA NUM
+ JMP ONM1
+OEON, CLA
+ JMS I [BACKC
+ TAD NUM
+ JMP I ONUM
+ PAGE
+\fTTCOL, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX /SET TTY NO COL
+ JMS I [GETC
+ SNA CLA
+ JMP BADCOL /NO COL SPECIFIED
+ JMS I [NUMBER
+ SNA
+ JMP BADCOL
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I [SYNTAX
+ TAD NUM
+ AND [7770
+ SZA CLA
+ JMP BADCOL
+ TAD (CCLNAM /READ IN CCL.SV
+ JMS I [LOOKUP
+ JMP CCLNF /CCL NOT FOUND
+ TAD (2 /WANT 2ND BLOCK IN CCL
+ DCA ARG2 /CCL LOCATIONS 12400-12777
+ JMS I (7607
+ 200 /READ IN 2 PAGES
+ AUXBUF
+ARG2, 0
+ JMP I [SYSERR
+ TAD ARG2
+ DCA ARG3
+ TAD I (AUXBUF /GET PTR TO DIRECT COL WORD
+ SPA
+ JMP OLDCCL
+ TAD (AUXBUF-2400 /RELOCATE
+ DCA ARG2
+ TAD NUM
+ DCA I ARG2
+ JMS I (7607
+ 4200
+ AUXBUF
+ARG3, 0
+ JMP I [SYSERR
+ JMP I TTCOL
+\fBADCOL, JMS I [PRINT
+ TEXT /? BAD COLUMN COUNT/
+ JMP I [GOAWAY
+
+OLDCCL, CLA
+ JMS I [PRINT
+ TEXT /? WRONG VERSION OF CCL/
+ JMP I [GOAWAY
+\fTYPE, 0
+ DCA TYPEM
+ JMS I [DELAYY
+ DCA .-1 /DELAY FIRST TIME THRU TO LET THINGS QUIET DOWN
+ TAD CTOFLG
+ SZA CLA
+ JMP I TYPE /NO ECHOING
+ TAD TYPEM
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TYPE
+
+TYPEM, 0
+
+CCLNAM, FILENAME CCL.SV
+
+CCLNF, JMS I [PRINT
+ TEXT /? CCL.SV NOT FOUND/
+ JMP I [GOAWAY
+\f CCLBLK=67
+
+FIXCCL, 0
+ JMS I [7607
+ 200
+ AUXBUF
+ CCLBLK
+ JMP I [SYSERR
+ TAD I (AUXBUF
+ TAD (-"G
+ SPA CLA
+ JMP I (OLDCCL
+ TAD (CCLTBL
+ JMS I (FIXUP
+ JMS I [7607
+ 4200
+ AUXBUF
+ CCLBLK
+ JMP I [SYSERR
+ JMP I FIXCCL
+ PAGE
+\fESC, "E;"S;"C;4000+"A;4000+"P;4000+"E;0
+
+TTHGHT, 0
+ JMS I (OLDTST
+ JMS I [GETC
+ SNA CLA
+ JMP I (BADHIT /NO HEIGHT
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX /SET TTY NO HEIGHT
+ JMS I [NUMBER
+ SNA
+ JMP I (BADHIT
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I (BADHIT /NO DIGITS
+ JMS I [SRCH
+ 300;77;7600
+ JMP I [REASEM
+ TAD (3
+ DCA TEMP
+ TAD NUM
+ CIA
+ DCA I TEMP
+ TAD I TEMP
+ ISZ TEMP
+ DCA I TEMP
+ JMS I (BASLUK
+ JMP I TTHGHT
+ TAD NUM
+ CIA
+ DCA I (AUXBUF
+ JMS I (BASWRI
+ JMP I TTHGHT
+\f/ LOC YES NO
+KBMTBL, AUXBUF+313; 0210; 1070
+ AUXBUF+314; 1313; 2020
+ AUXBUF+316; 1324; 7240
+ AUXBUF+317; 4423; 3020
+ AUXBUF+322; 1313; 1440
+ AUXBUF+224; 7555; 7403
+ AUXBUF+225; 1207; 1302
+ AUXBUF+226; 7557; 7402
+ AUXBUF+227; 1207; 1302
+ 0
+
+CDTBL, AUXBUF+135; 0210; 1102
+ AUXBUF+136; 1335; 2024
+ AUXBUF+140; 1346; 7240
+ AUXBUF+141; 4466; 3024
+ AUXBUF+144; 1335; 1420
+ AUXBUF+33; 7555; 7403
+ AUXBUF+34; 5207; 5321
+ AUXBUF+35; 7557; 7402
+ AUXBUF+36; 5207; 5321
+ 0
+
+CCLTBL, AUXBUF+4; 0024; 0002
+ AUXBUF+5; 0522; 0143
+ AUXBUF+6; 5551; 5363
+ AUXBUF+7; 5600; 6000
+ 0
+
+AROW, "A;"R;"R;"O;"W;0
+ PAGE
+\f/ SCOPE BIT ON DISK:
+/ BLOCK 0 REL 126 BIT 4
+
+/ SCOPE BIT IN MEMORY:
+/ LOC 17726 BIT 4
+
+TTSCOP, 0
+/THE FOLLOWING CODE WOULD BE ADDED IF WE WANT TO
+/ALLOW CHANGING KL8E SCOPE PATTERNS
+/ JMS I (ASRTST
+/ TAD VNO
+/ JMS I [BRANCH
+/ -1;OLDERR
+/ -2;OLDERR
+/ -3;OLDERR
+/ -4;OLDERR
+/ -5;TTSCOK
+/ ZBLOCK 2
+/ 0
+/ JMP I [NEWERR
+TTSCOK, JMS I (7607
+ 200
+ AUXBUF /READ 2 PAGES INTO AUXILIARY BUFFER
+ 11
+ JMP I [SYSERR
+ TAD (KBMTBL
+ JMS FIXUP
+ JMS I (7607
+ 4200
+ AUXBUF
+ 11
+ JMP I [SYSERR
+ JMS I (7607
+ 200
+ AUXBUF /READ BLOCK 53 (CD)
+ 53
+ JMP I [SYSERR
+ TAD (CDTBL
+ JMS FIXUP
+ JMS I (7607
+ 4200
+ AUXBUF
+ 53
+ JMP I [SYSERR
+ TAD NO /SET SCOPE BIT
+ SNA CLA
+ IAC
+ DCA SCOP
+ CDF 10
+ TAD (SCPBIT
+ JMS SET200
+ CDF 0
+ JMS I (7607
+ 200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+ TAD (AUXBUF+126
+ JMS SET200
+ JMS I (7607
+ 4200
+ AUXBUF
+ 0
+ JMP I [SYSERR
+/ JMS I [SRCH
+/ 366;11;7770
+/ JMP I [REASEM
+/ CLA
+/ JMS I [SRCH
+/ 0;200;"\
+/ JMP I [OLDERR
+/ IAC
+/ DCA TEMP
+/ TAD NO
+/ SNA CLA
+/ TAD (1336-1367
+/ TAD (1367
+/ DCA I TEMP
+ JMP I TTSCOP
+\fSET200, 0 /DF IS SPECIALLY SET
+ DCA HLTPTR
+ TAD I HLTPTR
+ AND (7577
+ DCA TEMP
+ TAD TEMP
+ TAD (-HLT
+ SZA CLA
+ JMP I (BADKBM
+ TAD NO
+ SNA CLA
+ TAD [200
+ TAD TEMP
+ DCA I HLTPTR
+ JMP I SET200
+HLTPTR, 0
+
+FIXUP, 0
+ DCA FIXPTR
+FIXLUP, TAD I FIXPTR
+ SNA
+ JMP I FIXUP
+ DCA FIXLOC
+ ISZ FIXPTR
+ TAD NO
+ SZA CLA
+ ISZ FIXPTR
+ TAD I FIXPTR
+ DCA I FIXLOC
+ TAD NO
+ SNA CLA
+ ISZ FIXPTR
+ ISZ FIXPTR
+ JMP FIXLUP
+
+FIXPTR, 0
+FIXLOC, 0
+\fBASNAM, FILENAME BASIC.SV
+
+BASLUK, 0
+ TAD (BASNAM
+ JMS I (LOOKUP
+ JMP I BASLUK
+ ISZ BASLUK
+ TAD (7
+ DCA BASBLK
+ JMS I [7607
+ 200
+ AUXBUF
+BASBLK, 0
+ JMP I [SYSERR
+ TAD BASBLK
+ DCA BASB2
+ TAD I (AUXBUF+2
+ SNA CLA
+ JMP I BASLUK
+ JMP I (OLDBAS
+
+BASWRI, 0
+ JMS I [7607
+ 4200
+ AUXBUF
+BASB2, 0
+ JMP I [SYSERR
+ JMP I BASWRI
+ PAGE
+\fTTCODE, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ONUM
+ SNA
+ JMP I [SYNTAX
+ DCA NUCODE
+ TAD NUCODE
+ AND [7700
+ SZA CLA
+ JMP I [NUMBIG
+ JMS I [TTST1
+ TAD (7200
+ DCA RR
+ JMS GETIOT
+ JMP I [OLDERR
+ CIA
+ DCA T2
+TTLP, JMS GETIOT
+ JMP I [OLDERR
+ CIA
+ DCA T3
+ TAD T3
+ CIA
+ TAD T2
+ SNA
+ JMP TTLP
+ SMA CLA
+ JMP .+3
+ TAD T3
+ DCA T2 /T2 CONTAINS NEG OF SMALLER IOT
+ TAD (7200
+ DCA RR
+TTLP2, JMS GETIOT
+ JMP I TTCODE
+ TAD T2
+ SZA CLA
+ CLA IAC
+ TAD NUCODE
+ CLL RTL
+ RAL
+ DCA T3
+ TAD I RR
+ AND (7007
+ TAD T3
+ DCA I RR
+ JMP TTLP2
+\fGETIOT, 0
+ ISZ RR
+ TAD RR
+ TAD (-7600
+ SNA CLA
+ JMP I GETIOT
+ TAD I RR
+ AND [7000
+ TAD [-6000
+ SZA CLA
+ JMP GETIOT+1
+ TAD I RR
+ RTR
+ RAR
+ AND [77
+ TAD (-20
+ CLL RAR
+ SNA
+ JMP GETIOT+1
+ RAL
+ TAD (20
+ ISZ GETIOT
+ JMP I GETIOT
+\fNOTIMPL,JMS I [PRINT
+ TEXT /% OPERATION NOT YET IMPLEMENTED/
+ JMP I [GOAWAY
+\fSET, JMS I [SPACE
+ DCA VNO /V3C
+ JMS I [GETDEV
+ JMS I [GETC
+ JMS I [BRANCH
+ -":;COLN
+ -" ;COLN
+ -"-;HYPH
+ 0
+ JMP I [SYNTAX /NO : OR BLANK AFTER NAME
+
+BADHIT, JMS I [PRINT
+ TEXT /? BAD HEIGHT SPECIFIED/
+ JMP I [GOAWAY
+
+TTALT, 0
+ JMS I [TTST1
+ JMP I [NOTIMPL
+ JMP I TTALT
+ PAGE
+\fCOLN, STA
+ JMS I [SPACE /IGNORE OPTIONAL SPACES
+ JMS I [GETC
+ SNA
+ JMP I [SYNTAX
+ TAD (-"-
+ SNA CLA
+ JMP HYPH
+ JMS I [BACKC
+ STA
+ TAD DEVNUM
+ SNA CLA
+ JMP SYSDV
+COLN2, DCA NAM1
+ DCA NAM2
+ TAD (MAIN-1 /LOOK FOR DEVICE TYPE IN MAIN TABLE
+MNLUP, DCA XR1
+ TAD I XR1
+ SMA SZA
+ JMP NOTYP /NOT FOUND
+ TAD DEVTYP
+ SNA CLA
+ JMP FNDTYP
+ TAD XR1
+ TAD (3 /POINT TO NEXT ENTRY
+ JMP MNLUP
+\fFNDTYP, TAD I XR1 /GET GENERIC NAME
+ DCA NAM1
+ TAD I XR1
+ DCA NAM2
+ DCA AUXFLG
+ TAD I XR1 /GET PTR TO DEVICE TABLE
+INTO, DCA PTR
+ DCA NO
+ TAD LINPTR
+ DCA SAVPTR /SAVE SCAN POINTER
+ JMS I [GETTWO
+ TAD (-1617
+ SNA CLA /ARE NEXT TWO CHARS 'NO'?
+ JMS SAWNO /YES
+ TAD SAVPTR /NO
+ DCA LINPTR /RESTORE PTR
+SCNLUP, TAD I PTR
+ SNA /GET NEXT KEYWORD POINTER
+ JMP NOKEY
+ ISZ PTR /POINT TO PTR TO ROUTINE
+ JMS I [KEYSRCH
+ JMP NOF /NOT FOUND
+ TAD I PTR /FOUND
+ DCA PTR /GET PTR TO ROUTINE
+ STA
+ TAD DEVNUM
+ SZA CLA
+ JMS I (HREAD /READ HANDLER
+ JMS I PTR /CALL ROUTINE
+ STA
+ TAD DEVNUM
+ SZA CLA
+ JMS I (HWRITE /REWRITE HANDLER
+ JMP I [GOAWAY
+
+SYSDV, ISZ AUXFLG
+ TAD (SYSAUX
+ JMP INTO /V3D ALLOW SET SYS:
+\fHYPH, JMS I [ALPHA
+ JMP I [BADV
+ DCA VNO
+ TAD VNO
+ SNA
+ JMP I [BADV
+ AND [17
+ DCA VNO
+ JMS I [SPACE /IGNORE SPACE
+ JMP COLN2
+\fNOKEY, TAD AUXFLG
+ SNA CLA
+ JMP NOO
+ JMS I [PRINT
+ TEXT \? UNKNOWN ATTRIBUTE FOR DEVICE \
+ *.-1
+NAM1, 0
+NAM2, 0
+ 0
+ JMP I [GOAWAY
+
+SAWNO, 0
+ ISZ NO
+ STA
+ JMS I [SPACE
+ TAD LINPTR
+ DCA SAVPTR
+ JMP I SAWNO
+
+NOTYP, CLA
+ ISZ AUXFLG
+ TAD (AUX /SEARCH AUXILIARY TABLE
+ JMP INTO
+\fNOF, ISZ PTR
+ TAD SAVPTR
+ DCA LINPTR
+ JMP SCNLUP
+
+AUXFLG, 0
+
+NOO, ISZ AUXFLG
+ TAD (AUX
+ DCA PTR
+ JMP SCNLUP
+ PAGE
+\fHREAD, 0
+ TAD DBLK
+ SNA
+ JMP RESERR
+ DCA BLOCK
+ JMS I [7607
+ 200 /READ 2 PAGES
+L7200, 7200 /INTO 7200-7577
+BLOCK, 0 /FROM THIS BLOCK ON SYSTEM DEVICE
+ JMP I [SYSERR
+ TAD DHI
+ AND [177 /GET RELATIVE ENTRY PT
+ TAD L7200
+ DCA ENTRY
+ TAD VNO
+ SZA CLA /V3C
+ JMP I HREAD /VNO ALREADY SET BY - COMMAND
+ TAD ENTRY
+VLOOP, DCA VNOPTR
+ TAD I VNOPTR
+ CLL
+ TAD [-33
+ SZL CLA
+ JMP BACKV
+ TAD I VNOPTR
+ SNA
+ JMP OLDERR
+ DCA VNO
+ JMP I HREAD
+BACKV, STA
+ TAD VNOPTR
+ JMP VLOOP
+
+RESERR, JMS I [PRINT
+ TEXT /? CAN'T - DEVICE IS RESIDENT/
+ JMP I [GOAWAY
+\fOLDERR, CLA
+ JMS I [PRINT
+ TEXT /? CAN'T - OBSOLETE HANDLER/
+ JMP I [GOAWAY
+
+HWRITE, 0
+ TAD BLOCK
+ DCA BLKTWO
+ JMS I [7607
+ 4200
+ 7200
+BLKTWO, 0
+ JMP I [SYSERR
+ JMP I HWRITE
+\fNEWERR, CLA
+ JMS I [PRINT
+ TEXT /? CAN'T - UNKNOWN VERSION OF THIS HANDLER/
+ JMP I [GOAWAY
+\fMAIN, -0; DEVICE TTY; TTYTBL
+ -1; DEVICE PTR; PTRTBL
+ -2; DEVICE PTP; PTPTBL
+ -3; DEVICE CDR; CDRTBL
+ -4; DEVICE LPT; LPTTBL
+ -20; DEVICE MTA; MTATBL
+ 1
+ ZBLOCK 20
+/TABLE ENDS WITH A POSITIVE NON-ZERO NUMBER
+\fLPTTBL, WIDTH;LPWDTH
+ LC;LPLC
+ LV8E;LPLV
+ LA8A; LP8A
+ LA78; LP78
+ ZBLOCK 4
+ 0
+
+MTATBL, PARITY;MTAPAR
+ DENSITY;MTADEN
+ FILES;MTAFIL
+ ZBLOCK 4
+ 0
+\fAUX, LOC;GENLOC
+ FILES;GENFIL
+ READO;GENREA
+ VERS;GENVER
+ DVCO;GENDVC /V3D
+ BLK;GENBLK /V3D
+ ZBLOCK 6
+ 0
+\fWIDTH, "W;"I;"D;"T;"H;0
+LC, "L;"C;0
+LV8E, "L;"V;4000+"8;4000+"E;0
+CODE, "C;"O;"D;"E;0
+ALT, "A;"L;"T;4000+"M;4000+"O;4000+"D;4000+"E;0
+ECHO, "E;"C;"H;"O;0
+PAYGE, "P;"A;"G;"E;0
+TAB, "T;"A;"B;0
+LOC, "L;"O;"C;4000+"A;4000+"T;4000+"I;4000+"O;4000+"N;0
+FILES, "F;"I;"L;"E;4000+"S;0
+READO, "R;"E;"A;"D;4000+"O;4000+"N;4000+"L;4000+"Y;0
+VERS, "V;"E;"R;4000+"S;4000+"I;4000+"O;4000+"N;0
+PARITY, "P;"A;"R;4000+"I;4000+"T;4000+"Y;0
+DENSITY,"D;"E;"N;4000+"S;4000+"I;4000+"T;4000+"Y;0
+FILL, "F;"I;"L;"L;0
+FLAGG, "F;"L;"A;"G;0
+CTRL, "C;"T;"R;"L;0
+EVEN, "E;4000+"V;4000+"E;4000+"N;0
+ODD, "O;4000+"D;4000+"D;0
+DELAY, "D;"E;"L;"A;"Y;0
+GAG, "G;"A;"G;0
+PAUS, "P;"A;"U;"S;"E;0
+HGHT, "H;"E;"I;"G;"H;"T;0
+SCOPP, "S;"C;"O;"P;"E;0
+SYSAUX, INIT; SYSINI
+ OS8; SYSOS8
+ OS78; SYS78
+ ZBLOCK 10
+ 0
+DVCO, "D;"V;"C;4000+"O;4000+"D;4000+"E;0
+COL, "C;"O;"L;4000+"U;4000+"M;4000+"N;0
+LA8A, "L;"A;"8;"A;0
+LA78, "L;"A;"7;"8;0
+INIT, "I;"N;"I;"T;0
+OS8, "O;"S;"8;0
+OS78, "O;"S;"7;"8;0
+ PAGE
+\fLPWDTH, 0
+ JMS I (GETWID
+ JMS LPTST1
+ TAD NUM
+ CMA
+ DCA I (7200
+ JMP I LPWDTH
+
+LPTST1, 0
+ TAD I (7201
+ SPA CLA
+ JMP L645
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;LPTOK
+ -3;LPTOK
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+LPTOK, JMP I LPTST1
+
+L645, JMS I [PRINT
+ TEXT /? CAN'T AFFECT ANNALEX LPT/
+ JMP I [GOAWAY
+\fASRTST, 0
+ TAD DHI
+ SPA CLA
+ JMP I ASRTST
+ JMS I [PRINT
+ TEXT /? CAN'T - NOT KL8E HANDLER/
+ JMP I [GOAWAY
+\fGENVER, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ALPHA
+ JMP BADV
+ DCA NUM
+ TAD NUM
+ AND (40
+ SZA CLA
+ JMP BADV
+ TAD NUM
+ AND (37
+ DCA I VNOPTR
+ JMP I GENVER
+
+GENREA, 0
+ CDF 10
+ TAD I DCWPTR
+ CLL RTL
+ CLL RAL
+ TAD NO
+ RAR
+ CML RAR
+ RAR
+ DCA I DCWPTR
+ CDF 0
+ JMP I GENREA
+
+GENFIL, 0
+ CDF 10
+ TAD I DCWPTR
+ CLL RAL
+ CLL RAL /ZERO LINK
+ TAD NO
+ RAR
+ CML RAR
+ DCA I DCWPTR
+ CDF 0
+ JMP I GENFIL
+\fBADV, CLA
+ JMS I [PRINT
+ TEXT /? BAD VERSION LETTER/
+ JMP I [GOAWAY
+
+CRLF, 0
+ TAD [215
+ JMS I (TYPE
+ TAD [212
+ JMS I (TYPE
+ JMP I CRLF
+ PAGE
+\fLPLV, 0
+ JMS I (LPTST1
+ TAD NO
+ CLL RTL
+ RTL
+ TAD (4
+ DCA I (7201
+ JMP I LPLV
+
+LPLC, 0
+ JMS I (LPTST1
+ TAD NO
+ CLL RTL
+ RTL
+ RAL
+ CIA
+ DCA I (7202
+ JMP I LPLC
+
+TTECHO, 0
+ JMS I [TTST1
+ TAD NO
+ SZA CLA
+ TAD (SKP CLA-SZA
+ TAD (SZA
+ DCA I (7200+120
+ JMP I TTECHO
+\fTTPAGE, 0
+ JMS I (OLDTST
+ JMS I [SRCH /V3D NEW ROUTINE
+ 215;100;7450
+ JMP I [REASEM
+ TAD (3 /POINT TO 'SZA CLA'
+ DCA TEMP
+ TAD NO
+ SNA CLA
+ TAD (SZA CLA-CLA /YES
+ TAD (CLA /NO
+ DCA I TEMP
+ JMP I TTPAGE
+\fTTTAB, 0
+ JMS I [TTST1
+ JMS I [GETC
+ SNA
+ JMP TTEO
+ TAD (-"/
+ SNA CLA
+ JMS I [GETC
+ TAD (-"N
+ SZA CLA
+ JMP I [SYNTAX
+ JMP NOTEC
+TTEO, TAD NO
+ SNA CLA
+ TAD (5000
+ TAD L200
+ JMS I (TECO
+NOTEC, JMS I [SRCH
+L200, 200;100;7
+ JMP I [REASEM
+ DCA TEMP
+ STA CLL RAL /-2
+ TAD TEMP
+ DCA T2
+ TAD TEMP
+ TAD (3
+ DCA T3
+ TAD NO
+ SNA CLA
+ JMP SETAB
+ TAD TEMP
+ TAD (-4
+ DCA T4
+ TAD T4
+ AND (77
+ TAD (1200 /TAD TTY240
+ DCA I T2
+ TAD (SZA CLA
+ DCA I T3
+ JMP I TTTAB
+\fSETAB, TAD TEMP
+ TAD (-12
+ DCA T4
+ TAD I T4
+ DCA I T2
+ TAD (SKP CLA
+ DCA I T3
+ JMP I TTTAB
+
+BADWID, JMS I [PRINT
+ TEXT /? ILLEGAL WIDTH/
+ JMP I [GOAWAY
+
+BLK, "B;"L;"O;"C;"K;0
+ PAGE
+\fTTFILL, 0
+ JMS I [TTST1
+ JMS I [SRCH
+ 200;100;1377
+ JMP I [REASEM
+ TAD (-1
+ DCA TEMP
+ TAD NO
+ CLL RAL
+ TAD (2
+ TAD TEMP
+ DCA T2
+ TAD I T2
+ DCA I TEMP
+ JMP I TTFILL
+
+REASEM, JMS I [PRINT
+ TEXT /? CAN'T - MUST REASSEMBLE KL8E SOURCE/
+ JMP I [GOAWAY
+
+TTDELAY,0
+ JMS I [TTST1
+ JMP I [NOTIMPL
+ JMP I TTDELAY
+\f/ENTER WITH PTR TO POSSIBLE KEYWORD IN AC
+
+KEYSRCH,0
+ DCA KPTR
+KL, TAD I KPTR
+ ISZ KPTR
+ SNA
+ JMP GOTKEY
+ CIA
+ DCA TEMP
+ JMS I [ALPHA /IS IT ALPHANUMERIC?
+ JMP EOK /NO
+ TAD TEMP /COMPARE
+ CLL RAL /LOW ORDER 11 BITS
+ SNA CLA
+ JMP KL /MATCHED, KEEP LOOKING
+ JMP I KEYSRCH /DIDN'T MATCH
+EOK, JMS I [BACKC
+ TAD TEMP
+ CIA /INPUT STREAM RAN OUT OR HIT SPACE
+ SPA CLA
+ JMP GOTKEY /SPACE OR EOL MATCH FLAGGED CHARACTER
+ JMP I KEYSRCH
+
+KPTR, 0
+
+GOTKEY, JMS I [SCAN
+ STA /SKIP EXTRA STUFF
+ JMS I [SPACE
+ ISZ KEYSRCH /TAKE GOOD RETURN 2
+ JMP I KEYSRCH
+
+PTRTBL, ZBLOCK 4
+ 0
+
+PTPTBL, ZBLOCK 4
+ 0
+\fTTYTBL, WIDTH;TTWIDTH
+ CODE;TTCODE
+ ALT;TTALT
+ ECHO;TTECHO
+ LC;TTLC
+ PAYGE;TTPAGE
+ TAB;TTTAB
+ FILL;TTFILL
+ FLAGG;TTFLAG
+ CTRL;TTCTRL
+ GAG;TTGAG
+ DELAY;TTDELAY
+ PAUS;TTPAUS /V3D
+ HGHT;TTHGHT /V3D
+ SCOPP;TTSCOP /V3D
+ COL;TTCOL /V3D
+ ESC;TTESC /V3D
+ AROW;TTAROW /V3D
+ ZBLOCK 10
+ 0
+ PAGE
+\fTTFLAG, 0
+ JMS TTST1
+ JMS I [SRCH
+ 200;200;247
+ JMP I [REASEM
+ TAD (-2
+ DCA TEMP
+ TAD NO
+ SNA CLA
+ TAD (SZA CLA-CLA
+ TAD (CLA
+ DCA I TEMP
+ JMP I TTFLAG
+
+TTLC, 0
+ JMS TTST1
+ JMS I [SRCH
+ 200;200;377
+ JMP I [REASEM
+ TAD (5
+ DCA TEMP
+ TAD I TEMP
+ CLL
+ TAD [200
+ SNL CLA
+ JMP I [REASEM
+ TAD NO
+ SNA CLA
+ TAD [40 /SNA CLA
+ TAD (7610 /SKP CLA
+ DCA I TEMP
+ JMP I TTLC
+
+TTCTRL, 0
+ JMS TTST1
+ JMP I [NOTIMPL
+ JMP I TTCTRL
+\fTTWIDTH,0
+ JMS GETWID
+ JMS TTST1
+ TAD NUM
+ AND [7
+ SZA CLA
+ JMP I [BADWID
+ TAD NUM
+ TAD [-200
+ SNA CLA
+ JMP I [BADWID
+ JMS I [SRCH
+ 200;200;7600
+ JMP I [REASEM
+ IAC
+ DCA TEMP
+ TAD I TEMP
+ AND [177
+ TAD (177+7200
+ DCA T2
+ TAD TEMP
+ IAC
+ DCA T3
+ TAD NUM
+ CIA
+ DCA I T3
+ TAD I T3
+ DCA I T2
+ JMP I TTWIDTH
+\fGETWID, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS OPTEQ
+ JMS I [NUMBER
+ SNA
+ JMP I (BADWID
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I [SYNTAX /NO DIGITS
+ TAD NUM
+ AND [7400
+ SZA CLA
+ JMP I [NUMBIG
+ JMP I GETWID
+
+TTST1, 0
+ JMS I (ASRTST
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;TTOK
+ -4;TTOK /V3C
+ -5;TTOK /V3D
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+TTOK, JMP I TTST1
+\fOPTEQ, 0
+ JMS I [GETC
+ TAD (-"=
+ SZA CLA
+ JMP I OPTEQ
+ STA /V3D
+ JMS I [SPACE
+ JMP I OPTEQ
+ PAGE
+\fOPRIN, 0
+ DCA N3
+ TAD (-4
+ DCA OKNT
+OPLP, TAD N3
+ JMS DGP
+ TAD N3
+ RTL
+ RAL
+ DCA N3
+ ISZ OKNT
+ JMP OPLP
+ JMP I OPRIN
+
+DGP, 0
+ RTL
+ RTL
+ AND [7
+ TAD [60
+ JMS I [TYPE
+ JMP I DGP
+
+OKNT, 0
+N3, 0
+GTEM, 0
+\fSRCH, 0
+ TAD I SRCH
+ ISZ SRCH
+ TAD (7200-1
+ DCA XR1
+ TAD I SRCH
+ ISZ SRCH
+ CIA
+ DCA CNT
+ TAD I SRCH
+ CIA
+ DCA TEMP
+ ISZ SRCH
+SRLUP, TAD I XR1
+ TAD TEMP
+ SNA CLA
+ JMP SRFND
+ ISZ CNT
+ JMP SRLUP
+ JMP I SRCH
+SRFND, ISZ SRCH
+ TAD XR1
+ JMP I SRCH
+\fGENCMN, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ONUM
+ DCA NUM2
+ TAD FLG
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [GETC
+ DCA TEMP
+ TAD TEMP
+ SNA
+ JMP I GENCMN
+ TAD (-"=
+ SZA
+ TAD ("=-",
+ SZA CLA
+ JMP I [SYNTAX
+ JMP I GENCMN
+\fGENLOC, 0
+ JMS GENCMN
+ TAD DHI
+ SPA CLA
+ TAD [-200
+ TAD [-200
+ CLL
+ TAD NUM2
+ SZL CLA
+ JMP I [NUMBIG
+ TAD NUM2
+ TAD (7200 /BASE OF HANDLER
+ DCA NUM2
+ TAD TEMP
+ SNA CLA
+ JMS ODT
+GETNEW, JMS I [ONUM
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I GENLOC
+ JMS I [GETC
+ SZA CLA
+ JMP I [SYNTAX
+ TAD NUM
+ DCA I NUM2
+ JMP I GENLOC
+\fODT, 0
+ TAD I NUM2
+ JMS OPRIN
+ TAD ("/
+ JMS I [TYPE
+ TAD I [READ
+ DCA GTEM /SAVE CHAIN STATUS
+ JMS I [READ
+ TAD [LINBUF
+ DCA LINPTR
+ TAD GTEM
+ DCA I [READ
+ JMP I ODT
+
+OLDBAS, JMS I [PRINT
+ TEXT /? OLD BASIC/
+ JMP I [GOAWAY
+ PAGE
+\fMTAPAR, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS MTST1
+ TAD LINPTR
+ DCA SAVPTR
+ TAD (EVEN
+ JMS I [KEYSRCH
+ SKP
+ JMP SETE
+ TAD SAVPTR
+ DCA LINPTR
+ TAD (ODD
+ JMS I [KEYSRCH
+ JMP I [SYNTAX
+ TAD (400
+SETE, TAD (2
+ DCA I (7200
+ JMP I MTAPAR
+
+MTST1, 0
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;OLDERR
+ -4;MTOK
+ -5;MTOK
+ -6;MTOK
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+MTOK, JMP I MTST1
+
+MTADEN, 0
+ JMS MTST1
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMP I [NOTIMP
+ JMP I MTADEN
+\fMTAFIL, 0
+ JMS MTST1
+ TAD NO
+ CIA /V3D
+ IAC /V3D
+ DCA I (7201
+ JMP I MTAFIL
+
+BADCOD, JMS I [PRINT
+ TEXT /? UNKNOWN CARD CODE/
+ JMP I [GOAWAY
+
+/SUPPOSED TO WORK ON ALL VERSIONS
+
+CDCODE, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I (OPTEQ
+ JMS I [NUMBER
+ TAD (-32 /026
+ SNA
+ JMP C026
+ TAD (32-35 /029
+ SZA CLA
+ JMP BADCOD
+ JMS CHANGE
+ LIST1;LIST2
+ JMP I CDCODE
+C026, JMS CHANGE
+ LIST1;LIST3
+ JMP I CDCODE
+\fCHANGE, 0
+ TAD I CHANGE
+ DCA P1
+ ISZ CHANGE
+ TAD I CHANGE
+ DCA P2
+ ISZ CHANGE
+CHLUP, TAD I P1
+ SNA
+ JMP I CHANGE
+ TAD (7200 /BASE OF HANDLER
+ DCA P3
+ TAD I P2
+ DCA I P3
+ ISZ P1
+ ISZ P2
+ JMP CHLUP
+
+P1, 0
+P2, 0
+P3, 0
+\fGET, 0
+ KSF
+ JMP .-1
+ KRB
+ AND [177
+ TAD [200 /FORCE TO 8-BIT
+ JMP I GET
+ PAGE
+\f/FIXED FOR V3D:
+LIST1, 104;105;106
+ 114;115;116
+ 124;125;126;127
+ 134;135;136
+ 0
+
+LIST2, 3203;4007;3502
+ 7514;0577;3637
+ 0104;1211;3374;0641
+ 7316;3410;1376
+
+LIST3, 7735;4076;0774
+ 3314;1002;0305
+ 3204;1273;3606;1341
+ 3716;1175;3401
+\fTECNAM, FILENAME TECO.SV
+
+TECO, 0
+ DCA SA
+ TAD (TECNAM
+ JMS LOOKUP
+ JMP I TECO /NOT THERE
+ DCA BLKN
+ JMS I (7607
+ 100 /READ 1 PAGE FROM TECO
+ 7000 /BUFFER
+BLKN, 0
+ JMP I [SYSERR
+ TAD BLKN
+ DCA BLKN2
+ TAD SA
+ DCA I (7002 /REL LOC 2 IS S.A.
+ JMS I (7607
+ 4100
+ 7000
+BLKN2, 0
+ JMP I [SYSERR
+ JMP I TECO
+
+SA, 0
+\fLOOKUP, 0
+ DCA ARG1 /PTR TO FILENAME IN AC
+ CLA IAC /LOOKUP ON SYS
+ CIF 10
+ JMS I USR
+ 2
+ARG1, 0 /STARTING BLOCK
+ 0
+ JMP I LOOKUP /NOT FOUND
+ TAD ARG1
+ ISZ LOOKUP
+ JMP I LOOKUP /RETURN 2 WITH BLOCK # IN AC
+\fGENDVC, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ONUM
+ SNA
+ JMP I [SYNTAX
+ DCA NUCODE
+ TAD NUCODE
+ AND [7700
+ SZA CLA
+ JMP I (NUMBIG
+ TAD NUCODE
+ TAD (-30
+ SPA CLA
+ JMP I [NUMBIG
+ TAD NUCODE
+ CLL RTL
+ RAL
+ DCA NUCODE
+ TAD (7200
+ DCA RR
+DVLUP, JMS I (GETIOT
+ JMP I GENDVC
+ TAD (-30
+ SPA CLA
+ JMP DVLUP
+ TAD I RR
+ AND (7007
+ TAD NUCODE
+ DCA I RR
+ JMP DVLUP
+\fCDRTBL, CODE;CDCODE
+ ZBLOCK 4
+ 0
+ PAGE
+
+/7000-7177 BUFFER FOR TECO CCB
+/7200-7577 BUFFER FOR HANDLER
+\f FIELD 0
+ *200
+ $
--- /dev/null
+/16 BOOT - OS/8 V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f /SR
+
+/FIXES MADE FOR MAINTENANCE RELEASE:
+
+/1. ADDED RX01 (FLOPPY BOOTSTRAP)
+/2. LEFT PATCH SPACE IN NAME TABLE
+
+ PTR=14
+ OLDLOC=15
+ NEWLOC=16
+ CDOIO=27
+ SCAN=17
+
+ *1
+ HLT
+ JMP I (7600
+ *100
+
+INNER, 0
+OUTR, -20
+CODE, 0
+LENGTH, 0
+\f *200
+
+START, CLA /ALLOW BEING CHAINED TO
+ TAD I (7600
+ SPA CLA
+ JMP OS8IN
+ ISZ INNER
+ JMP .-1
+ ISZ OUTR
+ JMP .-3
+ JMS I (TESTRK
+COSIN, TAD I (7776
+COMN, CIA
+ DCA CODE
+ TAD (TABLE-1
+ DCA PTR
+LOOP, TAD I PTR
+ SNA
+ JMP OS8
+ TAD CODE
+ SZA CLA
+ JMP NXT
+ IOF
+ STA
+ TAD I PTR
+ DCA OLDLOC
+ STA
+ TAD I PTR
+ DCA NEWLOC
+ TAD I PTR
+ CIA
+ DCA LENGTH
+ TAD I OLDLOC
+ DCA I NEWLOC
+ ISZ LENGTH
+ JMP .-3
+ TAD I PTR
+ DCA TEMP
+ TAD HLTSWT
+ SNA CLA
+ HLT
+ CLL
+ JMP I TEMP
+HLTSWT, 1
+
+NXT, TAD PTR
+ TAD (4
+ DCA PTR
+ JMP LOOP
+\fOS8, TAD ("N
+ JMS I (PUT
+ TAD ("O
+ JMS I (PUT
+ CLA IAC
+ DCA HLTSWT
+RETRY, JMS I (CRLF
+ TAD ("/
+ JMS I (PUT
+ JMS I (GET
+ SKP
+ JMP RETRY
+ CLL RTL
+ RTL
+ RTL
+ DCA TEMP
+ JMS I (GET
+ SKP
+ JMP RETRY
+ TAD TEMP
+ DCA TEMP
+ JMS I (GET
+ JMP .-1
+ CLA
+ JMS I (CRLF
+ TAD TEMP
+ JMP COMN
+\fOS8IN, TAD I (7600
+ TAD (-4207
+ SZA CLA
+ JMP RETRY
+ TAD I (1000
+ TAD (777
+ SNA CLA
+ TAD (600
+ TAD (1000-1
+ DCA SCAN
+SKAN, TAD I SCAN
+ SNA
+ JMP RETRY
+ AND (177
+ TAD (-"/!7600
+ SZA CLA
+ JMP SKAN
+ TAD I SCAN
+ AND (77
+ CLL RTL
+ RTL
+ RTL
+ DCA TEMP
+ TAD I SCAN
+ AND (77
+ TAD TEMP
+ DCA TEMP
+ TAD I SCAN
+ AND (177
+ TAD (-".!7600
+ DCA HLTSWT
+ TAD TEMP
+ JMP COMN
+
+TEMP, 0
+ PAGE
+\fTABLE, 2403 /TC
+ DECTAP
+ 7554
+ 25
+ 7554
+
+ 2213 /RK
+RKADR, RK8
+ 21
+ 11
+ 21
+
+ 2404 /TD
+ TD8E
+ 7277
+ 34
+ 7277
+
+ 1424 /LT
+ LINCTP
+ 4400
+ 7
+ 4400
+
+ 2206 /RF
+ RF08
+ 7746
+ 7
+ 7746
+
+ 2024 /PT
+ BINLDR
+ 7626
+ 152
+ 7700
+
+ 3205 /ZE
+ ZERO
+ 4
+ 6
+ 4
+
+ 2431 /TY
+ TYPSET
+ 7730
+ 42
+ 7730
+
+ 0414 /DL
+ DIAL
+ 4012
+ 6
+ 4012
+
+ 0301 /CA
+ CAS
+ 4000
+ 40
+ 4000
+
+ 0415 /DM
+ DSKMON
+ 171
+ 16
+ 174
+
+ 2605 /VE
+ VERS
+ VERS
+ 1
+ VERS
+
+ 0424 /DT
+ TAPE
+ TAPE
+ 1
+ TAPE
+
+ 0413 /DK
+ DISK
+ DISK
+ 1
+ DISK
+
+ 2205 /RE
+ RK8E
+ 21
+ 11
+ 21
+
+ 2523 /US
+ 1
+ 1
+ 1
+ RETRY
+
+ 2230 /RX
+ RX01
+ RX8E
+ 36
+ RXSTRT
+
+ ZBLOCK 4^5 /PATCH SPACE
+
+ 0
+
+/FORMAT:
+
+/SIXBIT OF 2-CHARACTER NAME
+/ADDRESS OF BOOTSTRAP CODE IN BOOT
+/ADDRESS WHERE BOOTSTRAP CODE IS TO BE MOVED TO
+/LENGTH OF BOOTSTRAP IN WORDS
+/STARTING ADDRESS OF BOOTSTRAP
+\fDECTAP, 7600
+ 6774
+ 1374
+ 6766
+ 6771
+ 5360
+ 7240
+ 1354
+ 3773
+ 1354
+ 3772
+ 1375
+ 6766
+ 5376
+ 7754
+ 7755
+ 0600
+ 0220
+ 6771
+ 5376
+\fRK8, 6732
+ 6751
+ 6745
+ 5023
+ 6742
+ 6753
+ 6755
+ 6733
+ 5031
+
+RK8E, 7000
+ 7000
+ 7000
+ 7000
+ 7201
+ 6742
+ 6742
+ 6743
+ 5031
+\fTD8E, 6007
+ 1312
+ 4312
+ 4312
+ 6773
+ 5303
+ 6777
+ 3726
+ 2326
+ 5303
+ 5732
+ 2000
+ 1300
+ 6774
+ 6771
+ 5315
+ 6776
+ 0331
+ 1327
+ 7640
+ 5315
+ 2321
+ 5712
+ 7354
+ 7756
+ 7747
+ 0077
+ 7400
+\fLINCTP, 6141
+ 1020
+ 0020
+ 0004
+ 0700
+ 0000
+ 6020
+\fRF08, 6643
+ 6615
+ 7600
+ 6603
+ 6622
+ 5352
+ 5752
+\f/ 1000 IS OS/8 LINE BUUFFER
+/ 1600 IS PS/8 LINE BUFFERE
+
+ *2000
+
+BINLDR, 0000
+ 3212
+ 4260
+ 1300
+ 7750
+ 5237
+ 2212
+ 7040
+ 5227
+ 1212
+ 7640
+ 5230
+ 1214
+ 0274
+ 1341
+ 7510
+ 2226
+ 7750
+ 5626
+ 1214
+ 0256
+ 1257
+ 3213
+ 5230
+ 0070
+ 6201
+ 0000
+ 0000
+ 6031
+ 5262
+ 6036
+ 3214
+ 1214
+ 5660
+ 6011
+ 5270
+ 6016
+ 5265
+ 0300
+ 4343
+ 7041
+ 1215
+ 7402
+ 6032
+ 6014
+ 6214
+ 1257
+ 3213
+ 7604
+ 7700
+ 1353
+ 1352
+ 3261
+ 4226
+ 5313
+ 3215
+ 1213
+ 3336
+ 1214
+ 3376
+ 4260
+ 3355
+ 4226
+ 5275
+ 4343
+ 7420
+ 5336
+ 3216
+ 1376
+ 1355
+ 1215
+ 5315
+ 0000
+ 3616
+ 2216
+ 7600
+ 5332
+ 0000
+ 1376
+ 7106
+ 7006
+ 7006
+ 1355
+ 5743
+ 5262
+ 0006
+ 0000
+ 0000
+ 6014
+ 6011
+ 5357
+ 6016
+ 7106
+ 7006
+ 7510
+ 5374
+ 7006
+ 6011
+ 5367
+ 6016
+ 7420
+ 3776
+ 3376
+ 5357
+ 0000
+ 5301
+\fZERO, 1005
+ 3410
+ 5004
+ 5404
+ 0011
+ 2010
+\fDIAL, 6141
+ 1020
+ 0020
+ 0004
+ 0701
+ 7300
+\f/ 7300
+/ 6002
+/ 6042
+/ 6022
+/ 6012
+/ 6032
+/ 6601
+/ 6764
+/ 1221
+/ 3010
+/ 1622
+/ 2222
+/ 7450
+/ 5620
+/ 3410
+/ 5212
+/ 7730
+/ 7727
+/ 0223
+TYPSET, 6774
+ 1347
+ 4341
+ 7240
+ 1353
+ 3355
+ 1352
+ 4341
+ 5753
+ 7777
+ 6766
+ 3354
+ 6771
+ 5344
+ 5741
+ 4600
+ 7777
+ 7777
+ 4220
+ 7400
+ 7777
+ 7777
+ 7777
+ 6014
+ 6011
+ 5360
+ 7106
+ 6012
+ 7420
+ 5357
+ 5756
+ 4356
+ 3373
+ 4356
+\fPTCLEV, "A
+L3, "4
+LV, "V
+VERS, TAD LV
+ JMS I (PUT
+ TAD L3
+ JMS I (PUT
+ TAD PTCLEV
+ JMS I (PUT
+ JMP I PRETRY
+PRETRY, RETRY
+\fDSKMON, 7577
+ 7750
+ 7751
+ 1171
+ 3572
+ 1172
+ 3573
+ 6643
+ 6615
+ 6603
+ 6602
+ 5203
+ 5606
+ 7600
+\fCAS, 1237
+ 1206
+ 6704
+ 6706
+ 6703
+ 5204
+ 7264
+ 6702
+ 7610
+ 3211
+ 3636
+ 1205
+ 6704
+ 6706
+ 6701
+ 5216
+ 7002
+ 7430
+ 1636
+ 7022
+ 3636
+ 7420
+ 2236
+ 2235
+ 5215
+ 7346
+ 7002
+ 3235
+ 5201
+ 7737
+ 3557
+ 7730
+\f LCD=6751
+ SDN=6755
+ SER=6754
+ STR=6753
+ XDR=6752
+
+RX01, RELOC 24
+
+RX8E, STL RTL
+ TAD UNIT /GET A READ COMMAND ON THE PROPER
+ LCD /UNIT AND LOAD IT INTO THE COMMAND REGISTER
+ CLA IAC
+ JMS LOAD /READ SECTOR ONE
+ JMS LOAD /OF TRACK ONE.
+ CLL RAL /SET AC = 2 AS FLAG SAYING WE READ TRACK 1
+
+RXSTRT, /** BOOTSTRAP START ADDR **
+HANGGG, SDN /DO A FIGURE-8 SKIP -
+ JMP LOAD+1 /ONLY THE DONE FLAG WILL COME UP
+ SER /ANY ERRORS?
+ SNA /OR IS THIS THE INITIAL DUMMY WAIT?
+ SKP CLA /IF EITHER ONE, TRY OTHER DRIVE
+ JMP GOODRD /IF ALL IS WELL, GO READ THE SECTOR BUFFER
+ TAD UNIT /COME HERE ON READ ERRORS -
+ CIA /FLIP THE UNIT NUMBER
+ TAD X6030 /IN "UNIT"
+ DCA UNIT
+ JMP RX8E
+GOODRD, LCD /LOAD THE EMPTY SECTOR BUFFER COMMAND ( A CONVENIENT 2)
+LP, JMS LOAD /GET A WORD FROM THE SECTOR BUFFER
+ DCA 2 /SECONDARY BOOT LOADS INTO LOCATIONS 2-51
+ ISZ .-1 /BUMP STORE ADDRESS
+ JMP LP
+
+LOAD, 0
+ STR /DO A FIGURE-8 LOOP WAITING FOR THE TRANSFER
+ JMP HANGGG /OR DONE FLAGS TO COME UP.
+ XDR /TRANSFER FLAG CAME UP - TRANSFER A WORD
+ JMP I LOAD
+
+UNIT, 7024 /7004 = DRIVE 0, 7024 = DRIVE 1
+X6030, 6030 /CONSTANT NEEDED TO FLIP UNIT - 7004+7024.
+
+ RELOC
+ PAGE
+\fL2213, 2213
+ DIML=6615
+DISK, CLA IAC
+ DIML
+ SNA CLA
+ JMP GOTRF
+ TAD (70
+ 6732
+ SNA CLA
+ JMP GOTRK8
+ CLA IAC
+ 6744
+ SZA CLA
+ JMP I PRETR
+ STA /RE
+GOTRF, TAD L2206 /RF
+ JMP I PCOMN
+L2206, 2206
+GOTRK8, TAD L2213 /RK
+ JMP I PCOMN
+PRETR, RETRY
+\fTAPE, 6141 /LINC
+ 17 /COMPL AC
+ 2 /PDP
+ IAC
+ SNA CLA
+ JMP GOTLTA
+ TAD (70
+ 6774
+ CLA
+ 6772
+ NOP
+ TAD M70
+ SNA CLA
+ JMP GOTTC
+ STL CLA RAR
+ 6774
+ CLA
+ 6776
+ SMA CLA
+ JMP I PRETR
+GOTTD, CLA IAC
+GOTTC, TAD L2403 /TC
+ JMP I PCOMN
+GOTLTA, TAD L1424 /LT
+ JMP I PCOMN
+L1424, 1424
+L2403, 2403
+PCOMN, COMN
+M70, -70
+/ 0000
+\fCRLF, 0
+ TAD L215
+ JMS PUT
+ TAD L212
+ JMS PUT
+ JMP I CRLF
+
+L215, 215
+L212, 212
+
+PUT, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I PUT
+
+GET, 0
+ KSF
+ JMP .-1
+ KRB
+ AND (177
+ TLS
+ TSF
+ JMP .-1
+ TAD (-003
+ SNA
+ JMP I (7605
+ TAD (003-177
+ SNA
+ JMP I (RETRY
+ TAD (177-015
+ SNA
+ ISZ GET
+ TAD (015
+ AND (77
+ JMP I GET
+
+TESTRK, 0
+ TAD (70
+ 6732
+ SNA CLA
+ JMP I TESTRK
+RK05, TAD (RK8E
+ DCA I (RKADR
+ JMP I TESTRK
+
+ FIELD 0
+ *200
+ $
--- /dev/null
+/11 OS8 CAMP
+
+/
+/S.R.
+/
+/
+/CASSETTE & MAGTAPE POSITIONER (CAMP)
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE VITHOUT NOTICE
+/AND SHOULD NOT BE CONTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/ COPYRIGHT (C) 1973,1975,1977 BY DIGITAL EQUIPMENT CORPORATION.
+/
+/
+/
+/
+\f
+/ MUST SKIP LOCS 1000-1377
+
+ LINBUF=1000
+
+ XR1=11
+ XR2=12
+ XR3=13
+
+ *20
+
+TEMP, 0
+T, 0
+T2, 0
+LINPTR, 0
+T3, 0
+FLAG, 0
+SPKNT, 0
+DEVTYP, 0 /DEVICE TYPE (BITS 6-11)
+ENTRY, 0 /HANDLER ENTRY POINT
+NUM, 0
+TYP, 0 /0 MEANS 'F', 1 MEANS 'R'
+T4, 0
+DEVNUM, 0
+DCW, 0 /DEVICE CONTROL WORD
+DCWPTR, 0
+USR, 200 /POINTS TO USR ENTRY POINT
+ESCBIT, 0 /1 MEANS USER TYPED ALTMODE
+CNT, 0
+CTOFLG, 0 /-1 MEANS SAW ^O
+COUNT, 0
+PTR, 0
+DHIT, 0 /DEVICE HANDLER INFO TABLE - 1
+DHI, 0 /DEVICE HANDLER INFO
+DBLK, 0 /DEVICE HANDLER BLOCK
+VNOPTR, 0 /PTS TO VERSION # IN HANDLER
+VNO, 0 /CURRENT HANDLER VERSION NUMBER
+SAVPTR, 0
+NO, 0 /1 MEANS 'NO'
+FLG, 1 /1 MEANS SAW NO DIGITS
+P, 0
+RR, 0
+NUCODE, 0
+
+/ MAGTAPE SPECIAL CODES
+
+ REWKOD=1
+ SKFKOD=3 /SKIP FORWARD FILE
+ UNLKOD=4
+ EOFKOD=5
+ SKPKOD=2 /FORWARD RECORD
+ BAKKOD=SKPKOD+4000
+ BKFKOD=SKFKOD+4000
+
+ DTLA=6766
+
+/0000-0777 /CAMP
+/1000-1377 /OS/8 LINE BUFFER
+/1400-1777 /PS/8 LINE BUFFER
+/2000- /CAMP
+/7000-7177 /I/O BUFFER
+/7200-7577 /OS/8 HANDLER
+/7600-7777 /OS/8
+
+ DLDC=6746
+ DLAG=6743
+ PAGE
+\f *200
+
+START, SKP
+ JMP CHN
+ TAD ("#
+ JMS I [TYPE
+ JMS I [READ /READ A LINE INTO OS/8 LINE BUFFER
+CHN, TAD [LINBUF /CHAIN ENTRY ADDRESS
+ DCA LINPTR /INITIALIZE POINTER TO LINE BUFFER
+ STA
+ JMS I [SPACE /IGNORE LEADING SPACES
+ JMS GETTWO /GET TWO CHARS
+ DCA TEMP
+ JMS I [SCAN /SCAN PAST EXTRA LETTERS OR DIGITS
+ TAD TEMP
+ JMS I [BRANCH /GO TO APPROPRIATE ROUTINE
+ -2313;SKIP /SK
+ -0517;EOF /EO
+ -0201;BACK /BA
+ -2205;REWIND /RE
+ -2516;UNLOAD /UN
+ -2605;VERSION /VE
+ -1005;HELP /HE
+ -2664;V4 /V4
+ -2305;SYNTAX /SE
+ SETLOC=.-1
+ 0
+ SNA CLA
+ JMP I [GOAWAY
+ JMP I [SYNTAX /NONE OF THESE
+
+/V1 FEATURES:
+/FIXES SINCE FIELD TEST RELEASE:
+
+/1. ADDED CASSETTE SUPPORT
+/2. FIXED BUG RE IMMEDIATE ALTMOD
+/3. CHANGED SPECIAL CODES TO AGREE WITH NEW MAGTAPE HANDLER
+/4. IGNORE NULLS ON INPUT
+/5. ALLOW UNLOADING AN RK8E
+
+/CHANGES MADE TO V3:
+
+/1. SET COMMAND IMPLEMENTED
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. TOOK OUT 'SET' SINCE WE DON'T WANT TO SUPPORT IT
+/ UNTIL OS/8 V4
+/2. FIXED BUG RE AT EOF AND BOF MESSAGES
+/3. CHANGED CAMP TO USE NEW TM8E HANDLER
+/ NOTE: CAMP WILL NOT WORK PROPERLY WITH
+/ TM8E HANDLERS PRIOR TO VERSION F
+/4. PROPERLY FIND EOT EVEN IF WE'RE JUST
+/ BEFORE A FILE MARK.
+/5. GIVE AT BOT OR EOT MESSAGE IF SEE REFLECTIVE SPOT
+/6. CHANGED VERSION NUMBER TO V4
+/7. ENSURE THAT USER CAN'T PASS OVER EOD
+
+/V3D CHANGES:
+
+/1. FIXED BUG WITH UNLOADING RKS
+\f/ GETTWO
+
+/GET TWO LETTERS OR DIGITS FROM INPUT LINE, PACK IN SIXBIT
+/ADVANCE PAST THEM. SUBSTITUTE NULL IF NOT FOUND.
+
+GETTWO, 0
+ JMS GETSIX
+ CLL RTL
+ RTL
+ RTL
+ DCA T2
+ JMS GETSIX
+ TAD T2 /COMBINE
+ JMP I GETTWO
+
+GETSIX, 0 /GET A SIXBIT LETTER OR DIGIT (OR NULL)
+ JMS ALPHA /IS IT ALPHANUMERIC?
+ JMP NOTALPH /NO
+ AND [77 /YES
+ JMP I GETSIX /TRUNCATE TO SIXBIT
+NOTALPH,CLA
+ JMS BACKC
+ JMP I GETSIX /RETURN NULL
+
+GETC, 0 /GET A CHARACTER, ADVANCE POINTER
+ TAD I LINPTR
+ AND [177 /ALWAYS RETURN 8-BIT
+ SZA
+ TAD [200 /WITH HIGH ORDER BIT ON
+ ISZ LINPTR /ADVANCE SCAN
+ JMP I GETC /RETURN
+
+BACKC, 0 /MOVE SCAN POINTER BACK ONE
+ STA
+ TAD LINPTR
+ DCA LINPTR
+ JMP I BACKC /RETURN
+\f/RETURN 1 NOT OF TYPE DESIRED
+/RETURN 2 DESIRED TYPE
+/IN BOTH CASES, CHAR IS LEFT IN AC
+
+ALPHA, 0 /LOOK FOR ALPHANUMERIC
+ JMS I [GETC
+ JMS LETTER /IS IT A LETTER?
+ JMP TRYDIG /NO, TRY DIGIT
+ JMP GOTAL /YES
+TRYDIG, JMS DIGIT /IS IT A DIGIT?
+ JMP I ALPHA /NO, AINT LETTER OR DIGIT
+GOTAL, ISZ ALPHA /YES, EITHER LETTER OR DIGIT
+ JMP I ALPHA /RETURN WITH IT IN AC
+
+LETTER, 0 /LOOK FOR LETTER
+ TAD (-"A
+ CLL
+ TAD ("A-"Z-1
+ SNL
+ ISZ LETTER
+ TAD ("Z+1 /RESTORE CHAR
+ JMP I LETTER
+
+DIGIT, 0 /LOOK FOR DIGIT
+ TAD (-"0
+ CLL
+ TAD ("0-"9-1 /(DECIMAL)
+ SNL
+ ISZ DIGIT
+ TAD ("9+1 /RESTORE DIGIT TO CHARACTER FORM
+ JMP I DIGIT /AND RETURN WITH IT IN AC
+ PAGE
+\fSYNTAX, CLA
+ JMS PRINT
+ TEXT /? SYNTAX ERROR/
+GOAWAY, TAD ESCBIT
+ SZA CLA
+ JMP I [7605 /LINE ENDED WITH ESCAPE
+ TAD I [READ /WAS 'READ' EVER CALLED?
+ SZA CLA
+ JMP I [START /YES, GET A NEW LINE
+ JMP I [7605 /NO, WE MUST'VE BEEN CHAINED TO, RECALL KBM
+
+PRINT, 0
+ TAD I PRINT
+ RTR
+ RTR
+ RTR
+ JMS PRIN
+ TAD I PRINT
+ JMS PRIN
+ ISZ PRINT
+ JMP PRINT+1
+LV, JMS I [CRLF
+ ISZ PRINT
+ JMP I PRINT
+
+PRIN, 0
+ AND [77
+ SNA
+ JMP LV
+ TAD [240
+ AND [77
+ TAD [240
+ DCA T3
+ TAD [200
+ KRS
+ TAD (-203
+ SNA
+ JMP CTRLC
+ TAD (203-217 /^O
+ SNA CLA
+ JMS CTRLO
+ TAD T3
+ JMS I [TYPE
+ JMP I PRIN
+\fCTRLC, TAD ["^
+ JMS I [TYPE
+ TAD ("C
+ JMS I [TYPE /ECHO "^C"
+ JMS I [DELAYY
+ JMP I [7600 /THEN GO AWAY
+CTRLO, 0
+ KCC /CLEAR OUT ^O
+ TAD ["^
+ JMS I [TYPE
+ TAD ("O
+ JMS I [TYPE
+ JMS I [CRLF
+ STA
+ DCA CTOFLG /STOP ECHOING
+ JMP I CTRLO
+
+VERSION,JMS PRINT
+ TEXT \OS/8 CAMP V5A\
+ JMP I [START
+NUMBIG, JMS PRINT
+ TEXT /? NUMBER TOO BIG/
+ JMP I [GOAWAY
+\fNONEX, JMS PRINT
+ TEXT /? CAN'T - DEVICE DOESN'T EXIST/
+ JMP I [GOAWAY
+
+SYSERR, JMS PRINT
+ TEXT \? I/O ERROR ON SYS:\
+ JMP I [GOAWAY
+ PAGE
+\fHELP, JMS I [PRINT
+ TEXT /BACKSPACE DEV: N FILES/
+ JMS I [PRINT
+ TEXT /BACKSPACE DEV: N RECORDS/
+ JMS I [PRINT
+ TEXT /EOF DEV:/
+H2, JMP H1 / JMS I [PRINT
+ TEXT /SET DEV: [NO] ATTRIB [N]/
+H1, JMS I [PRINT
+ TEXT /SKIP DEV: N FILES/
+ JMS I [PRINT
+ TEXT /SKIP DEV: N RECORDS/
+ JMS I [PRINT
+ TEXT /SKIP DEV: EOD/
+\f JMS I [PRINT
+ TEXT /REWIND DEV:/
+ JMS I [PRINT
+ TEXT /UNLOAD DEV:/
+ JMS I [PRINT
+ TEXT /VERSION/
+ JMS I [PRINT
+ TEXT /HELP/
+ JMP I [START
+\fBADEV, CLA
+ JMS I [PRINT
+ TEXT /? CAN'T FOR THIS DEVICE/
+ JMP I [GOAWAY
+
+V4, TAD (SET
+ DCA I (SETLOC
+ TAD H1
+ DCA H2
+ JMP I [START
+ PAGE
+\f *2000
+
+/ORIGIN PAST OS/8 LINE BUFFER AT 1000.
+/SKIP PAST PS/8 LINE BUFFER (AT 1400) JUST IN CASE
+/PS/8 USERS WISH TO PATCH THIS PROGRAM
+
+/SCAN PAST EXTRA LETTERS OR DIGITS
+
+SCAN, 0
+ JMS I [ALPHA
+ JMP NOPE
+ CLA
+ JMP SCAN+1
+NOPE, CLA
+ JMS I [BACKC
+ JMP I SCAN
+
+/SCAN PAST SPACES; GIVE ERROR IF NO SPACES FOUND UNLESS AC=-1
+
+SPACE, 0
+ DCA FLAG /SET AC=-1 TO PREVENT ERROR ON NO SPACES FOUND
+ DCA SPKNT /INITIALIZE SPACE COUNTER
+ SKP /JUMP INTO LOOP
+GOTSP, ISZ SPKNT
+ JMS I [GETC /GET NEXT CHAR
+ TAD (-240
+ SNA CLA /IS IT A SPACE?
+ JMP GOTSP /YES, COUNT IT
+ JMS I [BACKC /NO, PUT IT BACK
+ ISZ FLAG /CHECK FLAG
+ SKP /USER DIDN'T SPECIFY FLAG
+ JMP I SPACE /-0 MEANT DON'T CHECK IF FOUND SPACE
+ TAD SPKNT /HOW MANY SPACES DID WE FIND?
+ SZA CLA
+ JMP I SPACE /SOME. OK
+ JMP I [SYNTAX /NONE. TSK. TSK.
+\fBRANCH, 0
+ DCA T
+BR2, TAD I BRANCH
+ ISZ BRANCH
+ SNA
+ JMP NOTFND
+ TAD T
+ SNA CLA
+ JMP FOUND
+ ISZ BRANCH
+ JMP BR2
+
+FOUND, TAD I BRANCH
+ DCA T
+ JMP I T /FOUND ITEM IN COLUMN 1, JUMP TO ADDRESS IN COL 2
+
+NOTFND, TAD T
+ JMP I BRANCH /IF NOT FOUND IN COL 1, RETURN WITH AC INTACT
+CHECKR, 0
+ TAD DCW
+ RAL
+ SMA CLA
+ JMP I CHECKR
+RONLY, JMS I [PRINT
+ TEXT /? CAN'T - DEVICE IS READ-ONLY/
+ JMP I [GOAWAY
+\fCHECKW, 0
+ TAD DCW
+ RTL
+ SMA CLA
+ JMP I CHECKW
+WONLY, JMS I [PRINT
+ TEXT /? CAN'T - DEVICE IS WRITE-ONLY/
+ JMP I [GOAWAY
+\fONUM, 0
+ DCA NUM
+ CLA IAC
+ DCA FLG
+ONM1, JMS I [GETC
+ TAD (-"0-10 /CONVERT TO DIGIT
+ CLL
+ TAD (10
+ SNL
+ JMP OEON
+ DCA T4
+ DCA FLG
+ TAD NUM
+ AND [7000
+ SZA CLA
+ JMP I [NUMBIG
+ TAD NUM
+ CLL RTL
+ RAL
+ TAD T4
+ DCA NUM
+ JMP ONM1
+OEON, CLA
+ JMS I [BACKC
+ TAD NUM
+ JMP I ONUM
+ PAGE
+\f/READ A LINE INTO OS/8 LINE BUFFER
+
+READ, 0
+ DCA CTOFLG /ALLOW ECHOING
+RD1, TAD [LINBUF
+ DCA LINPTR
+ DCA ESCBIT
+GT, JMS GET
+LOOK, JMS I [BRANCH
+ -377;RUBOUT
+ -217;GT /^O
+ -203;CTRLC /^C
+ -212;LF /LINE FEED
+ -215;CR /CARRIAGE RETURN
+ -375;ESCAPE /ALTMODE
+ -376;ESCAPE /ALTMODE (2ND FLAVOR)
+ -233;ESCAPE /ESCAPE
+ -225;CTRLU /^U
+ -200;GT /IGNORE NULLS
+ 0
+ DCA TEMP /NONE OF THESE
+ TAD LINPTR
+ TAD (-LINBUF-377
+ SNA CLA /AT END OF LINE BUFFER?
+ JMP GT /YES, DON'T ACCEPT CHAR
+ TAD TEMP /NO, RETRIEVE CHAR
+ JMS TYPE /ECHO IT
+ TAD TEMP /INSERT IN BUFFER
+ DCA I LINPTR
+ ISZ LINPTR /BUMP POINTER
+ JMP GT /NEXT
+
+CTRLU, TAD ["^
+ JMS TYPE
+ TAD ("U
+ JMS TYPE /ECHO "^U" <CR><LF>
+ JMS I [CRLF
+ JMP RD1
+\fRUBOUT, TAD LINPTR
+ TAD [-LINBUF
+ SNA
+ JMP BOL /AT BEGIN OF LINE
+ TAD [LINBUF-1
+ DCA LINPTR /MOVE POINTER BACK ONE
+ TAD ["\
+ JMS TYPE /ECHO "\"
+RUB3, TAD I LINPTR
+ JMS TYPE /ECHO RUBBED-OUT CHARACTER
+GT2, JMS GET
+ JMS I [BRANCH
+ -377;RUB2
+ -216;GT2 /IGNORE ^O
+ -203;CTRLC /^C
+ 0
+ DCA TEMP /A NEW CHAR
+ TAD ["\
+ JMS TYPE /ENCLOSE RUBBED-OUT CHARS IN \'S
+ TAD TEMP
+ JMP LOOK
+
+RUB2, TAD LINPTR
+ TAD [-LINBUF
+ SNA
+ JMP BOL2
+ TAD [LINBUF-1
+ DCA LINPTR
+ JMP RUB3
+
+BOL2, TAD ["\
+ JMS TYPE
+BOL, JMS I [CRLF
+ JMP RD1
+
+ESCAPE, TAD ("$ /ECHO ESCAPE AS DOLLAR SIGN
+ JMS TYPE
+ ISZ ESCBIT /NOTE ESCAPE
+CR, DCA I LINPTR /INSERT 0 AT END
+ JMS I [CRLF
+ JMP I READ /RETURN, WE GOT LINE
+\fGET, 0
+ KSF
+ JMP .-1
+ KRB
+ AND [177
+ TAD [200 /FORCE TO 8-BIT
+ JMP I GET
+
+TYPE, 0
+ DCA TYPEM
+ JMS I [DELAYY
+ DCA .-1 /DELAY FIRST TIME THRU TO LET THINGS QUIET DOWN
+ TAD CTOFLG
+ SZA CLA
+ JMP I TYPE /NO ECHOING
+ TAD TYPEM
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TYPE
+
+TYPEM, 0
+
+LF, DCA I LINPTR /TEMPORARILY INSERT A 0 SENTINEL
+ TAD [LINBUF-1
+ DCA XR1
+ JMS I [CRLF
+ TAD ["#
+ JMS I [TYPE
+LFLP, TAD I XR1
+ SNA
+ JMP I [GT /FINHSHED, GET SOME MORE CHARS
+ JMS I [TYPE /ECHO CURRENT CHARS
+ JMP LFLP
+ PAGE
+\fEOF, JMS I [SPACE /SPAN OVER SPACES
+ JMS I [GETDEV /GET DEVICE
+ JMS I [CHECKR
+ TAD DEVTYP
+ JMS I [BRANCH
+ -20;MAGEOF
+ -27;CASEOF
+ ZBLOCK 2
+ 0
+ JMP I [BADEV
+
+SKIP, JMS I [SPACE
+ JMS I [GETDEV
+ JMS I [CHECKW
+ JMS GETNUM
+ TAD DEVTYP
+ JMS I [BRANCH
+ -20;MAGSKP
+ -27;CASSKP
+ 0
+ JMP I [BADEV
+
+REWIND, JMS I [SPACE
+ JMS I [GETDEV
+ JMS I [CHECKW
+ TAD DEVTYP
+ JMS I [BRANCH
+ -20;MAGREW
+ -27;CASREW
+ -16;TCREW
+/ -17;LTREW
+ ZBLOCK 4 /PATCH SPACE
+ 0
+ TAD DCW
+ SMA CLA
+ JMP I [BADEV /NOT FILE STRUCTURED
+ CLA IAC /READ BLOCK 0 TO REWIND
+ DCA I [BLK
+ TAD (100
+ JMS I [GO
+ JMP I [GOAWAY
+\fUNLOAD, JMS I [SPACE
+ JMS I [GETDEV
+ JMS I [CHECKW
+ TAD DEVTYP
+ JMS I [BRANCH
+ -20;MAGUNL
+/ -27;CASUNL
+ -16;TCUNL
+ -21;TDUNL
+/ -17;LTUNL
+ -23;RKEUNL
+ ZBLOCK 2
+ 0
+ JMP I [BADEV
+
+BACK, JMS I [SPACE
+ JMS I [GETDEV
+ JMS I [CHECKW
+ JMS GETNUM
+ TAD TYP
+ SPA CLA
+ JMP I [SYNTAX /CAN'T BACKSPACE TO EOD
+ TAD DEVTYP
+ JMS I [BRANCH
+ -20;MAGBAK
+ -27;CASBAK
+ 0
+ JMP I [BADEV
+\fGETNUM, 0 /PARSE OFF :NNNN [F ! R] OR EOD
+ CLA IAC
+ DCA NUM
+ DCA TYP
+ JMS I [GETC
+ SNA
+ JMP I GETNUM /EOL
+ TAD (-":
+ SZA CLA
+ JMP I [SYNTAX
+ STA
+ JMS I [SPACE /OPTIONAL SPACES
+ TAD I LINPTR
+ SNA
+ JMP I GETNUM /EOL
+ TAD (-"E
+ SNA CLA
+ JMP EO
+ JMS I [NUMBER
+ DCA NUM
+ STA
+ JMS I [SPACE /MORE OPTIONAL SPACES
+ DCA TYP
+ JMS I [GETC
+ SNA
+ JMP I GETNUM /NO F OR R. F ASSUMED
+ TAD (-"F
+ SNA
+ JMP R /0 MEANS 'F'
+ TAD ("F-"R
+ SZA CLA
+ JMP I [SYNTAX
+ CLA IAC /1 MEANS 'R'
+R, DCA TYP
+ JMP I GETNUM
+EO, STA /-1 MEANS 'E'
+ JMP R
+ PAGE
+\f/GET A DECIMAL NUMBER, RETURN IT IN AC
+
+NUMBER, 0
+ DCA NUM
+ CLA IAC
+ DCA FLG
+NM1, JMS I [GETC
+ JMS I [DIGIT
+ JMP EON
+ TAD (-"0 /CONVERT TO DIGIT
+ DCA T4
+ DCA FLG /NOTE PASSAGE OF A DIGIT
+ TAD NUM
+ AND [7000
+ SZA CLA
+ JMP I [NUMBIG
+ TAD NUM
+ CLL RTL
+ TAD NUM
+ CLL RAL
+ TAD T4
+ SZL
+ JMP I [NUMBIG
+ DCA NUM
+ JMP NM1
+
+EON, CLA
+ JMS I [BACKC
+ TAD FLG
+ SZA
+ DCA NUM /IF NO DIGITS, RETURN A 1
+ TAD NUM
+ JMP I NUMBER
+\f/ GETDEV
+
+/PARSES OFF A DEVICE NAME (1-4 CHARS)
+/DETERMINES IF IT EXISTS
+/LOADS HANDLER INTO 7200-7577 IF NOT ALREADY IN CORE
+/SETS ENTRY POINT ADDRESS AT 'ENTRY'
+/SETS DEVICE NUMBER AT 'DEVNUM'
+/SETS DEVICE CONTROL WORD AT 'DCW'
+/SETS 'DEVTYP'
+
+GETDEV, 0
+ JMS I [GETTWO
+ DCA WD1
+ JMS I [GETTWO
+ DCA WD2
+ TAD WD1
+ TAD WD2
+ DCA WD1 /COMBINE TWO WORDS INTO 1 (IN WD1)
+ TAD WD2
+ SNA CLA
+ JMP INQ
+ TAD WD1 /OS/8 KLUDGE FOR UNIQUENESS
+ CLL RAL
+ STL RAR /FORCE BIT 0 ON IF 2ND WORD WAS NON-ZERO
+ DCA WD1
+INQ, DCA WD2
+ CIF 10
+ JMS I USR
+ 12 /INQUIRE
+WD1, 0 /DEVICE NAME
+WD2, 0 /GETS DEVICE NUMBER
+WD3, 0 /GETS ENTRY POINT
+ JMP I [NONEX /DEVICE DOESN'T EXIST
+ TAD WD3
+ SZA /IS HANDLER ALREADY IN CORE?
+ JMP INCORE /YES
+ TAD WD1
+ DCA DW1
+ TAD (7201 /ALLOW TWO PAGE HANDLER IN 7200
+ DCA DW3
+ DCA DW2
+ CIF 10
+ JMS I USR
+ 1 /FETCH
+DW1, 0 /DEVICE NAME
+DW2, 0 /GETS DEVICE NUMBER
+DW3, 0 /GETS ENTRY POINT
+ JMP I [NONEX /DOESN'T EXIST
+ TAD DW2
+ DCA DEVNUM
+ TAD DW3
+ DCA ENTRY
+ JMP GETYP
+\fINCORE, DCA ENTRY
+ TAD WD2
+ DCA DEVNUM
+GETYP, TAD DEVNUM
+ TAD (7757
+ DCA DCWPTR /POILT INTO DEVICE CONTROL WGRD TABLE
+ CDF 10
+ TAD I DCWPTR /GET DCW
+ DCA DCW
+ TAD DCW
+ RTR
+ RAR
+ AND [77
+ DCA DEVTYP
+ STA
+ TAD I (37 /GET ADDRESS OF DHIT
+ DCA DHIT
+ TAD DHIT
+ TAD DEVNUM
+ DCA DHI
+ TAD I DHI
+ CDF 0
+ DCA DHI
+ TAD DHI
+ RTL
+ RTL
+ RTL
+ AND (17
+ SZA
+ TAD (15
+ DCA DBLK
+ JMP I GETDEV
+
+DELAYY, 0
+ TAD (-10
+ DCA OUTER
+ ISZ ZER
+ JMP .-1
+ ISZ OUTER
+ JMP .-3
+ JMP I DELAYY
+ZER, 0
+OUTER, -10
+ PAGE
+\fLOADPT, TAD I (FUNCT
+ TAD (-REWKOD
+ SNA CLA
+ JMP I [GOAWAY /LOAD POINT ON A REWIND IS NOT AN ERROR
+READBT, JMS I [PRINT
+ TEXT /? CAN'T - AT BOT OR EOT/
+ JMP I [GOAWAY
+\fREADEOF,JMS I [PRINT
+ TEXT /% CAN'T - AT EOF/
+ JMP I [GOAWAY
+
+READBOF,JMS I [PRINT
+ TEXT /% CAN'T - AT BOF/
+ JMP I [GOAWAY
+
+\fCASSKP, DCA I (DIR
+ TAD TYP
+ SNA CLA
+ JMP CSKPF
+ JMP I (NOTIMPL
+
+CGO, 0
+ DCA CFUNCT
+ JMS I ENTRY
+CFUNCT, 0
+CBUFR, 7000
+CBLK, -1
+ SKP
+ JMP I CGO
+ DCA TEMP
+ TAD TEMP
+ SMA CLA
+ JMP I (END /SOFT ERROR
+ JMS I [PRINT
+ TEXT \? CAN'T - I/O ERROR\
+ JMP I [GOAWAY
+
+CASEOF, JMS CGO
+ JMP I [GOAWAY
+
+CASREW, TAD (REWKOD
+ JMS CGO
+ JMP I [GOAWAY
+\fCSKPF, TAD NUM
+ SNA
+ IAC
+ CIA
+ DCA COUNT
+ TAD (SKFKOD
+ JMS CGO
+ ISZ COUNT
+ JMP .-3
+ JMP I [GOAWAY
+
+CASBAK, CLA IAC
+ DCA I (DIR
+ TAD TYP
+ SZA CLA
+ JMP CBAKBLK
+ TAD NUM
+ CMA
+ DCA COUNT
+ TAD (BKFKOD
+ JMS CGO
+ ISZ COUNT
+ JMP .-3
+ JMP I [GOAWAY
+
+CBAKBLK,TAD NUM
+ SNA
+ IAC
+ CIA
+ DCA COUNT
+ TAD (BAKKOD
+ JMS CGO
+ ISZ COUNT
+ JMP .-3
+ JMP I [GOAWAY
+ PAGE
+\fTCREW, JMS TCR
+ JMP I [GOAWAY
+
+TCUNL, JMS TCR
+ TAD ENTRY
+ IAC
+ RTR
+ RTR
+ AND [7000
+ DTLA /SELECT ANOTHER UNIT
+ JMP I [GOAWAY
+
+TCR, 0
+ TAD ENTRY
+ TAD (-7607
+ SZA CLA /SYSTEM TC08 DECTAPE MUST BE UNIT 0
+ TAD ENTRY
+ RTR
+ RTR
+ AND [7000 /ISOLATE UNIT # IN BITS 0-2
+ TAD (600 /GO REVERSE
+ DTLA
+ JMP I TCR
+\fTDUNL, TAD (-7607
+ SZA CLA
+ TAD ENTRY
+ DCA TEMP
+ TAD TEMP
+ RTR
+ RAR
+ CLA RAR
+ DCA UNIT
+ TAD TEMP
+ AND [3
+ CIA
+ TAD [77 /GET DEV CODE
+ CLL RTL
+ RAL
+ TAD (6004 /BUILD 'SDLC'
+ DCA BSDLC
+ TAD UNIT
+ TAD (3000 /GO, REVERSE
+BSDLC, HLT
+ CLA
+ JMP I [GOAWAY
+UNIT, 0
+\fTTCODE, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ONUM
+ SNA
+ JMP I [SYNTAX
+ DCA NUCODE
+ TAD NUCODE
+ AND [7700
+ SZA CLA
+ JMP I [NUMBIG
+ JMS I [TTST1
+ TAD (7200
+ DCA RR
+ JMS GETIOT
+ JMP I [OLDERR
+ CIA
+ DCA T2
+TTLP, JMS GETIOT
+ JMP I [OLDERR
+ CIA
+ DCA T3
+ TAD T3
+ CIA
+ TAD T2
+ SNA
+ JMP TTLP
+ SMA CLA
+ JMP .+3
+ TAD T3
+ DCA T2 /T2 CONTAINS NEG OF SMALLER IOT
+ TAD (7200
+ DCA RR
+TTLP2, JMS GETIOT
+ JMP I TTCODE
+ TAD T2
+ SZA CLA
+ CLA IAC
+ TAD NUCODE
+ CLL RTL
+ RAL
+ DCA T3
+ TAD I RR
+ AND (7007
+ TAD T3
+ DCA I RR
+ JMP TTLP2
+\fGETIOT, 0
+ ISZ RR
+ TAD RR
+ TAD (-7600
+ SNA CLA
+ JMP I GETIOT
+ TAD I RR
+ AND [7000
+ TAD [-6000
+ SZA CLA
+ JMP GETIOT+1
+ TAD I RR
+ RTR
+ RAR
+ AND [77
+ TAD (-20
+ CLL RAR
+ SNA
+ JMP GETIOT+1
+ RAL
+ TAD (20
+ ISZ GETIOT
+ JMP I GETIOT
+ PAGE
+\fMAGSKP, DCA DIR
+ TAD TYP
+ SNA
+ JMP SKPF
+ SPA CLA
+ JMP SKPEOD
+ TAD NUM
+ SNA
+ CLA IAC
+ CIA
+ DCA WC
+ TAD (SKPKOD
+ JMS GO
+ JMP I [GOAWAY
+
+MAGEOF, TAD (EOFKOD
+ JMS GO
+ JMP I [GOAWAY
+
+SKPF, TAD NUM
+ SNA
+ JMP SKP0
+ CIA
+ DCA WC
+ JMS I (FUDGE /DON'T LET GUY TRICK US INTO GOING PAST EOD
+ TAD (SKFKOD
+ JMS GO
+ JMP I [GOAWAY
+
+SKPEOD, JMS I (FUDGE /DON'T LET GUY TRICK US INTO GOING PAST EOD
+ JMS I ENTRY
+ SKFKOD
+ 0
+ 0 /SKIP 4096 FILES
+ SMA
+ SKP CLA
+ JMP CHKBOT
+ JMP I [GOAWAY
+
+MAGBAK, CLA IAC
+ DCA DIR
+ TAD TYP
+ SNA CLA
+ JMP BAKF
+ TAD NUM
+ SNA
+ CLA IAC
+ CIA
+ DCA WC
+ TAD (BAKKOD
+ JMS GO
+ JMP I [GOAWAY
+\fBAKF, TAD NUM
+ CMA
+ DCA WC2
+ JMS I ENTRY
+ BKFKOD
+ 0
+WC2, -1 /
+ SMA
+ SKP CLA
+ JMP CHKBOT
+ TAD (SKPKOD /SKIP 1 RECORD FORWARD
+ JMP SKY
+
+CHKBOT, DCA TEMP
+ TAD TEMP
+ AND (1000
+ SNA CLA
+ JMP IOE
+ JMP I (READBT
+\fMAGUNL, TAD (UNLKOD
+ JMS GO
+ JMP I [GOAWAY
+
+MAGREW, TAD (REWKOD
+ JMS GO
+ JMP I [GOAWAY
+
+GO, 0
+ DCA FUNCT
+ JMS I ENTRY
+FUNCT, 0
+BUFR, 7000
+WC,
+BLK, -1
+ SKP /I/O ERROR
+ JMP I GO
+ DCA TEMP
+ TAD TEMP
+ SMA CLA
+ JMP END /SOFT ERROR
+ TAD TEMP
+ AND (1000
+ SZA CLA
+ JMP I [LOADPT
+IOE, TAD TEMP
+ JMP I [IOERR
+
+DIR, 0 /0- FORWARD ; 1- BACKWARDS
+
+END, TAD TYP
+ SNA CLA
+ JMP I (EODERR /V3C NEW HANDLER CALL
+ TAD DIR /SAW FILE MARK
+ SNA CLA /V3C
+ JMP I [READEOF /AT END OF FILE
+ JMP I [READBOF /AT BEGIN OF FILE
+\fSKP0, JMS I ENTRY
+ SKFKOD
+ 0 /IRRELEVANT
+ -1 /ADVANCE 1 FILE
+ SMA
+ SKP CLA
+ JMP I [IOERR /HARD ERROR
+ TAD (BAKKOD
+SKY, DCA SKX /V3C
+ JMS I ENTRY
+SKX, BAKKOD
+ 0 /IRREL
+ -1 /BACK OVER FILE MARK
+ SMA
+ SKP CLA
+ JMP I [IOERR
+ JMP I [GOAWAY
+ PAGE
+\fIOERR, AND (3777
+ CLL RAL
+ DCA TEMP
+ JMS I [PRINT
+ TEXT \? CAN'T - I/O ERROR\
+ TAD (-13 /11 BITS TO LOOK AT
+ DCA CNT
+ TAD (JLIST
+ DCA JM
+IOLUP, TAD TEMP
+ RAL
+ DCA TEMP
+ SZL
+ JMP I JM
+IOCONT, ISZ JM
+ ISZ CNT
+ JMP IOLUP
+ JMP I [GOAWAY
+
+JM, 0
+
+JLIST, JMP BIT1
+ JMP BIT2
+ JMP BIT3
+ JMP BIT4
+ JMP BIT5
+ JMP BIT6
+ JMP BIT7
+ JMP BIT8
+ JMP I (BIT9
+ JMP I (BIT10
+ JMP I (BIT11
+\fBIT1, JMS I [PRINT
+ TEXT /(REWINDING)/
+ JMP IOCONT
+BIT2, JMS I [PRINT
+ TEXT /(BOT)/
+ JMP IOCONT
+BIT3, JMS I [PRINT
+ TEXT /(SELECT ERROR)/
+ JMP IOCONT
+BIT4, JMS I [PRINT
+ TEXT /(PARITY ERROR)/
+ JMP IOCONT
+BIT5, JMS I [PRINT
+ TEXT /(EOF)/
+ JMP IOCONT
+\fBIT6, JMS I [PRINT
+ TEXT /(RECORD LENGTH INCORRECT)/
+ JMP IOCONT
+BIT7, JMS I [PRINT
+ TEXT /(TIMING ERROR)/
+ JMP IOCONT
+BIT8, JMS I [PRINT
+ TEXT /(EOT)/
+ JMP IOCONT
+\fRKEUNL, CLL
+ TAD ENTRY
+ TAD (200
+ SNL CLA
+ TAD ENTRY
+ AND (6 /ISOLATE UNIT
+ TAD (2000 /WRITE PROTECT DISK
+ DLDC /LOAD COMMAND REGISTER
+ DLAG
+ JMP I [GOAWAY
+ PAGE
+\fBIT9, JMS I [PRINT
+ TEXT /(WRITE LOCK-OUT)/
+ JMP I (IOCONT
+BIT10, JMS I [PRINT
+ TEXT /(READ COMPARE ERROR)/
+ JMP I (IOCONT
+BIT11, JMS I [PRINT
+ TEXT /(ILLEGAL FUNCTION)/
+ JMP I (IOCONT
+\fNOTIMPL,JMS I [PRINT
+ TEXT /% OPERATION NOT YET IMPLEMENTED/
+ JMP I [GOAWAY
+EODERR, JMS I [PRINT
+ TEXT /? CAN'T - AT EOD/
+ JMP I [GOAWAY
+\f/THIS ROUTINE PREVENTS US FROM GOING PAST EOD WHEN
+/SKIPPING FORWARD FILES.
+/IT DOES THIS BY THE FOLLOWING ALGORITHM:
+/FIRST WE BACKSPACE A RECORD.
+/IF WE SAW DATA, THEN OK, WE RETURN TO THE USER;
+/THIS WILL NOT AFFECT HIS SKIP FILE COUNT.
+/IF WE SAW A FILE MARK, THEN WE SKIP FORWARD
+/BACK OVER THAT FILE, IGNORING THE FILE MARK ERROR.
+/IF WE SAW BOT, THEN, OK NO ERROR.
+
+FUDGE, 0
+ JMS I ENTRY /V3C ALL NEW
+ BAKKOD
+TM, 0
+ -1
+ SKP
+ JMP I FUDGE
+ SPA
+ JMS BER
+ SZA CLA
+ JMS FRWD
+ JMP I FUDGE
+
+/IF ERROR WAS BOT, OK
+
+BER, 0
+ DCA TM
+ TAD TM
+ AND (1000
+ SZA CLA
+ JMP I BER /BOT OK, NO FRWD
+ TAD TM
+ JMP I [IOERR
+
+FRWD, 0
+ JMS I ENTRY
+ SKPKOD
+ 0
+ -1
+ SMA
+ SKP CLA
+ JMP I [IOERR
+ JMP I FRWD
+ PAGE
+\fSET, JMS I [SPACE
+ DCA VNO /V3C
+ JMS I [GETDEV
+ JMS I [GETC
+ JMS I [BRANCH
+ -":;COLN
+ -" ;COLN
+ -"-;HYPH
+ 0
+ JMP I [SYNTAX /NO : OR BLANK AFTER NAME
+COLN, STA
+ JMS I [SPACE /IGNORE OPTIONAL SPACES
+ JMS I [GETC
+ SNA
+ JMP I [SYNTAX
+ TAD (-"-
+ SNA CLA
+ JMP HYPH
+ JMS I [BACKC
+COLN2, DCA NAM1
+ DCA NAM2
+ TAD (MAIN-1 /LOOK FOR DEVICE TYPE IN MAIN TABLE
+MNLUP, DCA XR1
+ TAD I XR1
+ SMA SZA
+ JMP NOTYP /NOT FOUND
+ TAD DEVTYP
+ SNA CLA
+ JMP FNDTYP
+ TAD XR1
+ TAD (3 /POINT TO NEXT ENTRY
+ JMP MNLUP
+FNDTYP, TAD I XR1 /GET GENERIC NAME
+ DCA NAM1
+ TAD I XR1
+ DCA NAM2
+ DCA AUXFLG
+ TAD I XR1 /GET PTR TO DEVICE TABLE
+INTO, DCA PTR
+ DCA NO
+ TAD LINPTR
+ DCA SAVPTR /SAVE SCAN POINTER
+ JMS I [GETTWO
+ TAD (-1617
+ SNA CLA /ARE NEXT TWO CHARS 'NO'?
+ JMS SAWNO /YES
+ TAD SAVPTR /NO
+ DCA LINPTR /RESTORE PTR
+SCNLUP, TAD I PTR
+ SNA /GET NEXT KEYWORD POINTER
+ JMP NOKEY
+ ISZ PTR /POINT TO PTR TO ROUTINE
+ JMS I [KEYSRCH
+ JMP NOF /NOT FOUND
+ TAD I PTR /FOUND
+ DCA PTR /GET PTR TO ROUTINE
+ JMS I (HREAD /READ HANDLER
+ JMS I PTR /CALL ROUTINE
+ JMS I (HWRITE /REWRITE HANDLER
+ JMP I [GOAWAY
+\fHYPH, JMS I [ALPHA
+ JMP I [BADV
+ DCA VNO
+ TAD VNO
+ SNA
+ JMP I [BADV
+ AND [17
+ DCA VNO
+ JMS I [SPACE /IGNORE SPACE
+ JMP COLN2
+\fNOKEY, TAD AUXFLG
+ SNA CLA
+ JMP NOO
+ JMS I [PRINT
+ TEXT \? UNKNOWN ATTRIBUTE FOR DEVICE \
+ *.-1
+NAM1, 0
+NAM2, 0
+ 0
+ JMP I [GOAWAY
+
+SAWNO, 0
+ ISZ NO
+ STA
+ JMS I [SPACE
+ TAD LINPTR
+ DCA SAVPTR
+ JMP I SAWNO
+
+NOTYP, CLA
+ ISZ AUXFLG
+ TAD (AUX /SEARCH AUXILIARY TABLE
+ JMP INTO
+\fNOF, ISZ PTR
+ TAD SAVPTR
+ DCA LINPTR
+ JMP SCNLUP
+
+AUXFLG, 0
+
+NOO, ISZ AUXFLG
+ TAD (AUX
+ DCA PTR
+ JMP SCNLUP
+ PAGE
+\fHREAD, 0
+ TAD DBLK
+ SNA
+ JMP RESERR
+ DCA BLOCK
+ JMS I (7607
+ 200 /READ 2 PAGES
+L7200, 7200 /INTO 7200-7577
+BLOCK, 0 /FROM THIS BLOCK ON SYSTEM DEVICE
+ JMP I [SYSERR
+ TAD DHI
+ AND (177 /GET RELATIVE ENTRY PT
+ TAD L7200
+ DCA ENTRY
+ TAD VNO
+ SZA CLA /V3C
+ JMP I HREAD /VNO ALREADY SET BY - COMMAND
+ TAD ENTRY
+VLOOP, DCA VNOPTR
+ TAD I VNOPTR
+ CLL
+ TAD (-33
+ SZL CLA
+ JMP BACKV
+ TAD I VNOPTR
+ SNA
+ JMP OLDERR
+ DCA VNO
+ JMP I HREAD
+BACKV, STA
+ TAD VNOPTR
+ JMP VLOOP
+
+RESERR, JMS I [PRINT
+ TEXT /? CAN'T - DEVICE IS RESIDENT/
+ JMP I [GOAWAY
+\fOLDERR, CLA
+ JMS I [PRINT
+ TEXT /? CAN'T - OBSOLETE HANDLER/
+ JMP I [GOAWAY
+
+HWRITE, 0
+ TAD BLOCK
+ DCA BLKTWO
+ JMS I (7607
+ 4200
+ 7200
+BLKTWO, 0
+ JMP I [SYSERR
+ JMP I HWRITE
+\fNEWERR, CLA
+ JMS I [PRINT
+ TEXT /? CAN'T - UNKNOWN VERSION OF THIS HANDLER/
+ JMP I [GOAWAY
+ PAGE
+\fMAIN, -0; DEVICE TTY; TTYTBL
+ -1; DEVICE PTR; PTRTBL
+ -2; DEVICE PTP; PTPTBL
+ -3; DEVICE CDR; CDRTBL
+ -4; DEVICE LPT; LPTTBL
+ -20; DEVICE MTA; MTATBL
+ 1
+ ZBLOCK 20
+/TABLE ENDS WITH A POSITIVE NON-ZERO NUMBER
+\fCDRTBL, CODE;CDCODE
+ ZBLOCK 4
+ 0
+
+LPTTBL, WIDTH;LPWDTH
+ LC;LPLC
+ LV8E;LPLV
+ ZBLOCK 4
+ 0
+
+MTATBL, PARITY;MTAPAR
+ DENSITY;MTADEN
+ FILES;MTAFIL
+ ZBLOCK 4
+ 0
+\fTTYTBL, WIDTH;TTWIDTH
+ CODE;TTCODE
+ ALT;TTALT
+ ECHO;TTECHO
+ LC;TTLC
+ PAYGE;TTPAGE
+ TAB;TTTAB
+ FILL;TTFILL
+ FLAGG;TTFLAG
+ CTRL;TTCTRL
+ GAG;TTGAG
+ DELAY;TTDELAY
+ ZBLOCK 10
+ 0
+
+AUX, LOC;GENLOC
+ FILES;GENFIL
+ READO;GENREA
+ VERS;GENVER
+ ZBLOCK 10
+ 0
+ PAGE
+\fWIDTH, "W;"I;"D;"T;"H;0
+LC, "L;"C;0
+LV8E, "L;"V;4000+"8;4000+"E;0
+CODE, "C;"O;"D;"E;0
+ALT, "A;"L;"T;4000+"M;4000+"O;4000+"D;4000+"E;0
+ECHO, "E;"C;"H;"O;0
+PAYGE, "P;"A;"G;"E;0
+TAB, "T;"A;"B;0
+LOC, "L;"O;"C;4000+"A;4000+"T;4000+"I;4000+"O;4000+"N;0
+FILES, "F;"I;"L;"E;4000+"S;0
+READO, "R;"E;"A;"D;4000+"O;4000+"N;4000+"L;4000+"Y;0
+VERS, "V;"E;"R;4000+"S;4000+"I;4000+"O;4000+"N;0
+PARITY, "P;"A;"R;4000+"I;4000+"T;4000+"Y;0
+DENSITY,"D;"E;"N;4000+"S;4000+"I;4000+"T;4000+"Y;0
+FILL, "F;"I;"L;"L;0
+FLAGG, "F;"L;"A;"G;0
+CTRL, "C;"T;"R;"L;0
+EVEN, "E;4000+"V;4000+"E;4000+"N;0
+ODD, "O;4000+"D;4000+"D;0
+DELAY, "D;"E;"L;"A;"Y;0
+GAG, "G;"A;"G;0
+ PAGE
+\fLPWDTH, 0
+ JMS I (GETWID
+ JMS LPTST1
+ TAD NUM
+ CMA
+ DCA I (7200
+ JMP I LPWDTH
+
+LPTST1, 0
+ TAD I (7201
+ SPA CLA
+ JMP L645
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;LPTOK
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+LPTOK, JMP I LPTST1
+
+L645, JMS I [PRINT
+ TEXT /? CAN'T AFFECT ANNALEX LPT/
+ JMP I [GOAWAY
+\fASRTST, 0
+ TAD DHI
+ SPA CLA
+ JMP I ASRTST
+ JMS I [PRINT
+ TEXT /? CAN'T - NOT KL8E HANDLER/
+ JMP I [GOAWAY
+\fGENVER, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ALPHA
+ JMP BADV
+ DCA NUM
+ TAD NUM
+ AND (40
+ SZA CLA
+ JMP BADV
+ TAD NUM
+ AND (37
+ DCA I VNOPTR
+ JMP I GENVER
+
+GENREA, 0
+ CDF 10
+ TAD I DCWPTR
+ CLL RTL
+ CLL RAL
+ TAD NO
+ RAR
+ CML RAR
+ RAR
+ DCA I DCWPTR
+ CDF 0
+ JMP I GENREA
+
+GENFIL, 0
+ CDF 10
+ TAD I DCWPTR
+ CLL RAL
+ CLL RAL /ZERO LINK
+ TAD NO
+ RAR
+ CML RAR
+ DCA I DCWPTR
+ CDF 0
+ JMP I GENFIL
+\fBADV, CLA
+ JMS I [PRINT
+ TEXT /? BAD VERSION LETTER/
+ JMP I [GOAWAY
+
+CRLF, 0
+ TAD [215
+ JMS I (TYPE
+ TAD [212
+ JMS I (TYPE
+ JMP I CRLF
+ PAGE
+\fLPLV, 0
+ JMS I (LPTST1
+ TAD NO
+ CLL RTL
+ RTL
+ TAD (4
+ DCA I (7201
+ JMP I LPLV
+
+LPLC, 0
+ JMS I (LPTST1
+ TAD NO
+ CLL RTL
+ RTL
+ RAL
+ CIA
+ DCA I (7202
+ JMP I LPLC
+
+TTALT, 0
+ JMS I [TTST1
+ JMP I [NOTIMPL
+ JMP I TTALT
+
+TTECHO, 0
+ JMS I [TTST1
+ TAD NO
+ SZA CLA
+ TAD (SKP CLA-SZA
+ TAD (SZA
+ DCA I (7200+120
+ JMP I TTECHO
+
+TTPAGE, 0
+ JMS I (ASRTST
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;OLDERR
+ -4;PAGOK
+ ZBLOCK 2
+ 0
+ JMP I [NEWERR
+\fPAGOK, TAD I (7200+216
+ TAD (-SNA
+ SZA CLA
+ JMP I [REASEM
+ TAD NO
+ SNA CLA
+ TAD (SZA CLA-CLA
+ TAD (CLA
+ DCA I (7200+216
+ JMP I TTPAGE
+\fTTTAB, 0
+ JMS I [TTST1
+ JMS I [GETC
+ SNA
+ JMP TTEO
+ TAD (-"/
+ SNA CLA
+ JMS I [GETC
+ TAD (-"N
+ SZA CLA
+ JMP I [SYNTAX
+ JMP NOTEC
+TTEO, TAD NO
+ SNA CLA
+ TAD (5000
+ TAD L200
+ JMS I (TECO
+NOTEC, JMS I [SRCH
+L200, 200;100;7
+ JMP I [REASEM
+ DCA TEMP
+ STA CLL RAL /-2
+ TAD TEMP
+ DCA T2
+ TAD TEMP
+ TAD (3
+ DCA T3
+ TAD NO
+ SNA CLA
+ JMP SETAB
+ TAD TEMP
+ TAD (-4
+ DCA T4
+ TAD T4
+ AND (77
+ TAD (1200 /TAD TTY240
+ DCA I T2
+ TAD (SZA CLA
+ DCA I T3
+ JMP I TTTAB
+SETAB, TAD TEMP
+ TAD (-12
+ DCA T4
+ TAD I T4
+ DCA I T2
+ TAD (SKP CLA
+ DCA I T3
+ JMP I TTTAB
+ PAGE
+\fTTFILL, 0
+ JMS I [TTST1
+ JMS I [SRCH
+ 200;100;1377
+ JMP I [REASEM
+ TAD (-1
+ DCA TEMP
+ TAD NO
+ CLL RAL
+ TAD (2
+ TAD TEMP
+ DCA T2
+ TAD I T2
+ DCA I TEMP
+ JMP I TTFILL
+
+REASEM, JMS I [PRINT
+ TEXT /? CAN'T - MUST REASSEMBLE KL8E SOURCE/
+ JMP I [GOAWAY
+
+TTDELAY,0
+ JMS I [TTST1
+ JMP I [NOTIMPL
+ JMP I TTDELAY
+\f/ENTER WITH PTR TO POSSIBLE KEYWORD IN AC
+
+KEYSRCH,0
+ DCA KPTR
+KL, TAD I KPTR
+ ISZ KPTR
+ SNA
+ JMP GOTKEY
+ CIA
+ DCA TEMP
+ JMS I [ALPHA /IS IT ALPHANUMERIC?
+ JMP EOK /NO
+ TAD TEMP /COMPARE
+ CLL RAL /LOW ORDER 11 BITS
+ SNA CLA
+ JMP KL /MATCHED, KEEP LOOKING
+ JMP I KEYSRCH /DIDN'T MATCH
+EOK, JMS I [BACKC
+ TAD TEMP
+ CIA /INPUT STREAM RAN OUT OR HIT SPACE
+ SPA CLA
+ JMP GOTKEY /SPACE OR EOL MATCH FLAGGED CHARACTER
+ JMP I KEYSRCH
+
+KPTR, 0
+
+GOTKEY, JMS I [SCAN
+ STA /SKIP EXTRA STUFF
+ JMS I [SPACE
+ ISZ KEYSRCH /TAKE GOOD RETURN 2
+ JMP I KEYSRCH
+
+PTRTBL, ZBLOCK 4
+ 0
+
+PTPTBL, ZBLOCK 4
+ 0
+ PAGE
+\fTTGAG, 0
+ JMS TTST1
+ JMP I [NOTIMPL
+ JMP I TTGAG
+
+TTFLAG, 0
+ JMS TTST1
+ JMS I [SRCH
+ 200;200;247
+ JMP I [REASEM
+ TAD (-2
+ DCA TEMP
+ TAD NO
+ SNA CLA
+ TAD (SZA CLA-CLA
+ TAD (CLA
+ DCA I TEMP
+ JMP I TTFLAG
+
+TTLC, 0
+ JMS TTST1
+ JMS I [SRCH
+ 200;200;377
+ JMP I [REASEM
+ TAD (5
+ DCA TEMP
+ TAD I TEMP
+ CLL
+ TAD [200
+ SNL CLA
+ JMP I [REASEM
+ TAD NO
+ SNA CLA
+ TAD [40 /SNA CLA
+ TAD (7610 /SKP CLA
+ DCA I TEMP
+ JMP I TTLC
+
+TTCTRL, 0
+ JMS TTST1
+ JMP I [NOTIMPL
+ JMP I TTCTRL
+\fTTWIDTH,0
+ JMS GETWID
+ JMS TTST1
+ TAD NUM
+ AND [7
+ SZA CLA
+ JMP I [BADWID
+ TAD NUM
+ TAD [-200
+ SNA CLA
+ JMP I [BADWID
+ JMS I [SRCH
+ 200;200;7600
+ JMP I [REASEM
+ IAC
+ DCA TEMP
+ TAD I TEMP
+ AND [177
+ TAD (177+7200
+ DCA T2
+ TAD TEMP
+ IAC
+ DCA T3
+ TAD NUM
+ CIA
+ DCA I T3
+ TAD I T3
+ DCA I T2
+ JMP I TTWIDTH
+\fGETWID, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS OPTEQ
+ JMS I [NUMBER
+ SNA
+ JMP I (BADWID
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I [SYNTAX /NO DIGITS
+ TAD NUM
+ AND [7400
+ SZA CLA
+ JMP I [NUMBIG
+ JMP I GETWID
+
+TTST1, 0
+ JMS I (ASRTST
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;TTOK
+ -4;TTOK /V3C
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+TTOK, JMP I TTST1
+\fOPTEQ, 0
+ JMS I [GETC
+ TAD (-"=
+ SZA CLA
+ JMP NOE
+ JMS I [SPACE
+ JMP I OPTEQ
+NOE, JMS I [BACKC
+ JMP I OPTEQ
+ PAGE
+\fBADWID, JMS I [PRINT
+ TEXT /? ILLEGAL WIDTH/
+ JMP I [GOAWAY
+
+OPRIN, 0
+ DCA N3
+ TAD (-4
+ DCA OKNT
+OPLP, TAD N3
+ JMS DGP
+ TAD N3
+ RTL
+ RAL
+ DCA N3
+ ISZ OKNT
+ JMP OPLP
+ JMP I OPRIN
+
+DGP, 0
+ RTL
+ RTL
+ AND [7
+ TAD [60
+ JMS I [TYPE
+ JMP I DGP
+
+OKNT, 0
+N3, 0
+NUM2, 0
+GTEM, 0
+\fSRCH, 0
+ TAD I SRCH
+ ISZ SRCH
+ TAD (7200-1
+ DCA XR1
+ TAD I SRCH
+ ISZ SRCH
+ CIA
+ DCA CNT
+ TAD I SRCH
+ CIA
+ DCA TEMP
+ ISZ SRCH
+SRLUP, TAD I XR1
+ TAD TEMP
+ SNA CLA
+ JMP SRFND
+ ISZ CNT
+ JMP SRLUP
+ JMP I SRCH
+SRFND, ISZ SRCH
+ TAD XR1
+ JMP I SRCH
+\fGENLOC, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [ONUM
+ DCA NUM2
+ TAD FLG
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I [GETC
+ DCA TEMP
+ TAD TEMP
+ SNA
+ JMP ENOL
+ TAD (-"=
+ SZA CLA
+ JMP I [SYNTAX
+ENOL, TAD DHI
+ SPA CLA
+ TAD (-200
+ TAD (-200
+ CLL
+ TAD NUM2
+ SZL CLA
+ JMP I [NUMBIG
+ TAD NUM2
+ TAD (7200 /BASE OF HANDLER
+ DCA NUM2
+ TAD TEMP
+ SNA CLA
+ JMP ODT
+GETNEW, JMS I [ONUM
+ DCA NUM
+ TAD FLG
+ SZA CLA
+ JMP I GENLOC
+ JMS I [GETC
+ SZA CLA
+ JMP I [SYNTAX
+ TAD NUM
+ DCA I NUM2
+ JMP I GENLOC
+\fODT, TAD I NUM2
+ JMS OPRIN
+ TAD ("/
+ JMS I [TYPE
+ TAD I [READ
+ DCA GTEM /SAVE CHAIN STATUS
+ JMS I [READ
+ TAD [LINBUF
+ DCA LINPTR
+ TAD GTEM
+ DCA I [READ
+ JMP GETNEW
+ PAGE
+\fMTAPAR, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS MTST1
+ TAD LINPTR
+ DCA SAVPTR
+ TAD (EVEN
+ JMS I [KEYSRCH
+ SKP
+ JMP SETE
+ TAD SAVPTR
+ DCA LINPTR
+ TAD (ODD
+ JMS I [KEYSRCH
+ JMP I [SYNTAX
+ TAD (400
+SETE, TAD (2
+ DCA I (7200
+ JMP I MTAPAR
+
+MTST1, 0
+ TAD VNO
+ JMS I [BRANCH
+ -1;OLDERR
+ -2;OLDERR
+ -3;OLDERR
+ -4;MTOK
+ -5;MTOK
+ -6;MTOK
+ ZBLOCK 4
+ 0
+ JMP I [NEWERR
+MTOK, JMP I MTST1
+
+MTADEN, 0
+ JMS MTST1
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMP I [NOTIMP
+ JMP I MTADEN
+\fMTAFIL, 0
+ JMS MTST1
+ TAD NO
+ DCA I (7201
+ JMP I MTAFIL
+
+BADCOD, JMS I [PRINT
+ TEXT /? UNKNOWN CARD CODE/
+ JMP I [GOAWAY
+
+/SUPPOSED TO WORK ON ALL VERSIONS
+
+CDCODE, 0
+ TAD NO
+ SZA CLA
+ JMP I [SYNTAX
+ JMS I (OPTEQ
+ JMS I [NUMBER
+ TAD (-32 /026
+ SNA
+ JMP C026
+ TAD (32-35 /029
+ SZA CLA
+ JMP BADCOD
+ JMS CHANGE
+ LIST1;LIST2
+ JMP I CDCODE
+C026, JMS CHANGE
+ LIST1;LIST3
+ JMP I CDCODE
+\fCHANGE, 0
+ TAD I CHANGE
+ DCA P1
+ ISZ CHANGE
+ TAD I CHANGE
+ DCA P2
+ ISZ CHANGE
+CHLUP, TAD I P1
+ SNA
+ JMP I CHANGE
+ TAD (7200 /BASE OF HANDLER
+ DCA P3
+ TAD I P2
+ DCA I P3
+ ISZ P1
+ ISZ P2
+ JMP CHLUP
+
+P1, 0
+P2, 0
+P3, 0
+ PAGE
+\fLIST1, 304;305;306
+ 314;315;316
+ 324;325;326;327
+ 334;335;336
+ 0
+
+LIST2, 3203;4007;3502
+ 7514;0577;3637
+ 0104;1211;3374;0641
+ 7316;3410;1376
+
+LIST3, 7735;4076;0774
+ 3314;1002;0305
+ 3204;1273;3606;1341
+ 3716;1175;3401
+\fTECNAM, FILENAME TECO.SV
+
+TECO, 0
+ DCA SA
+ TAD (TECNAM
+ DCA ARG1
+ CLA IAC /LOOKUP ON SYS
+ CIF 10
+ JMS I USR
+ 2
+ARG1, TECNAM /STARTING BLOCK
+ 0
+ JMP I TECO /NOT FOUND
+ TAD ARG1
+ DCA BLKN
+ JMS I (7607
+ 100 /READ 1 PAGE FROM TECO
+ 7000 /BUFFER
+BLKN, 0
+ JMP I [SYSERR
+ TAD BLKN
+ DCA BLKN2
+ TAD SA
+ DCA I (7002 /REL LOC 2 IS S.A.
+ JMS I (7607
+ 4100
+ 7000
+BLKN2, 0
+ JMP I [SYSERR
+ JMP I TECO
+
+SA, 0
+ PAGE
+
+/7000-7177 BUFFER FOR TECO CCB
+/7200-7577 BUFFER FOR HANDLER
+\f FIELD 0
+ *200
+ $
--- /dev/null
+/DIRECT V3D FOR OS/78 V1A AND OS/8 V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/JANUARY 17, 1974 H.J.
+/
+/5-AUGUST-1975 MAINT. RELEASE CHANGES S.R.
+/1. UPDATED COPYRIGHT DATE
+/2. CHANGED VERSION NUMBER TO V4
+/3. INCORPORATED PATCH (SEQ #2) OF FEB 1975 DSN
+/ (FIXES BUG RE: DEFAULTING TO TTY: AND DSK:)
+/
+/ 5-APR-77 MH OS/78 FIXES (V5A)
+/ 18-MAY-77 MH SPR 2286 (V6A)
+/
+/DIRECTORY LISTING PROGRAM
+/
+/ START ADDRESS 14600; JSW 6403
+/
+
+ PTR=20
+ CNT=21
+ INFPTR=22
+ OUHAND=23
+ INHAND=24
+ EPTR=26
+ INSCNT=27
+ TEMP=30
+ OKFLAG=31
+ IFCNT=32
+ OSWTCH=33
+ INFWDS=34
+ BDPTR=35
+ GPTR1=36
+
+
+ XR=10
+ XR1=11
+ XR2=12
+
+
+ AC2=CLA CLL CML RTL
+ AC4000=CLA CLL CML RAR
+ ACM2=CLA CLL CMA RAL
+ ACM3=CLA CLL CMA RTL
+
+
+ ALTOPT=7642
+ OPT1=7643
+ OPT2=7644
+ EQLS=7646 /EQUALS OPTION
+ DATE=7666
+ BIPCCL=7777 /CONTAINS DATE EXTENSION IN BITS 3 AND 4 (MH)
+ BUF=5200 /THE FILE OUTPUT BUFFER
+ /5 BLOCKS LONG, TO 7577
+
+\f
+ FIELD 1
+ *2000
+ SKP CLA /NORMAL ENTRY
+ JMP MSTRT /CHAIN ENTRY
+CDCALL, JMS I (200 /SEE WHAT THE PERSON WANTS
+ 5
+STAR, 5200 /IN SPECIAL MODE
+
+MSTRT, TAD I (OPT2 /GET OPTION /W
+ RTR
+ SNL CLA /SKIP FOR VESION NUMBER
+ JMP EQUALT
+ JMS I (ERROR /PRINT VERSION NUMBER
+ VERNO+40
+ TAD (215
+ JMS I (TYPE
+
+/SET UP FOR MULTIPLE ENTRIES ON A LINE
+
+EQUALT, TAD I (EQLS /EQUALS OPTION WORD
+ SPA /MUST BE POSITIVE
+ CLA CLL CML RTR /SET AC LARGE POSITIVE
+ TAD (-10 /CHECK LEGALITY OF OPTION
+ SMA SZA CLA /SKIP IF GOOD
+ JMP BADEQ
+
+/SUBSTITUTE .DI IF NULL EXTENSION
+
+ TAD I (7604 /GET EXTENSION
+ SNA /SKIP IF GIVEN
+ TAD (0411 /.DI
+ DCA I (7604 /PUT EXTENSION BACK
+
+/ GET THE DATE INCREMENT BITS
+
+ CDF 0 /GET GET WORD FORM FIELD 0(MH)
+ TAD I (BIPCCL /THE BITS WITH DATE EXT. ARE 3 AND 4 (MH)
+ CDF 10 /BACK TO FIELD 1 (MH)
+ RTR /SHIFT THOSE BITS SO THEY CREATE A 0,10,20, OR 30(MH)
+ RTR /AFTER MASKING (MH)
+ AND (0030 /MASK (MH)
+ DCA DATINC /SAVE THE DATE EXTENSION (MH)
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+ TAD (-10
+ DCA CNT /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C, TAD (7605
+ JMS I (GTSXBT /GET A CHAR
+ TAD (-"?!7700 /CHECK FOR ?
+ SNA
+ JMP QINO
+ TAD ("?-"*
+ SNA CLA
+ JMP AINO
+ ISZ CNT
+ JMP S1C
+
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+ TAD (7605
+S4L, DCA PTR
+ TAD (-10
+ DCA CNT
+ACK, TAD PTR
+ JMS I (GTSXBT
+ TAD (-"*!7700
+ SZA CLA
+ JMP CNTUP
+ AC2
+ TAD CNT
+ SZA
+ TAD (6
+ SNA CLA
+ ISZ CNT
+ TAD PTR
+ JMS I (GTSXBT
+ SZA CLA
+ JMP AINO
+CNTUP, ISZ CNT
+ JMP ACK
+ TAD I PTR
+ SNA CLA
+ JMP I (NULLCK
+ TAD (5
+ TAD PTR
+ JMP S4L
+
+/THIS IS THE END OF OPERATION CODE
+/IT CLOSES THE FILE AND HANDLES RETURNS
+
+ENDCHK, ISZ I (ECHO
+ TAD (232
+OLOOP, JMS I (OUTCHR
+ TAD I (OUWDCT /GET -WORDS LEFT IN BUFFER
+ AND (177 /CHECK AGAINST NEW BUFFER #
+ SNA /SPR 2286, CHECK CAREFULLY (MH)
+ TAD RPOS /TO SEE IF ANY TRAILING (MH)
+ CIA /OR DANGLING CHARS (MH)
+ TAD (RPOS-1 /ARE LEFT OVER (MH)
+ SZA!CLA /(MH)
+ JMP OLOOP /KEEP GOING TO DUMP ONE
+ TAD I (OUWDCT
+ TAD (1200 /DONT DUMP IF AT END
+ SZA CLA
+ JMS DUMP /DUMP BUFFER
+ TAD I (7600
+ JMS I (200
+ 4
+ 7601
+CLEN, 0
+ JMP CLOERR
+ JMP ABORT /CODE MOVED TO ANOTHER PAGE (MH)
+
+ PAGE
+\f
+NULLCK, TAD (7201
+ DCA AO2
+ TAD (7201
+ DCA AO1
+ TAD I (7600
+ SNA
+ JMP TTYHND
+ JMS I (200
+ 1
+AO1, 7201
+ HLT
+ TAD AO1
+ JMP CMN
+TTYHND, TAD (2424
+ DCA TTY1
+ TAD (3100
+ DCA TTY2
+ JMS I (200
+ 1
+TTY1, 0
+TTY2, 0
+AO2, 7201
+ JMP I (IDBLVT
+ TAD TTY2
+ DCA I (7600
+ TAD AO2
+CMN, DCA OUHAND
+ TAD (7601
+ DCA BLCK
+ TAD I (7600
+ JMS I (200
+ 3
+BLCK, 7601
+LENGTH, 0
+ JMP I (NOROOM
+ TAD BLCK
+ DCA I (BLCKN
+ TAD (BUF
+ DCA I (OCPTR
+ TAD (RPOS-1 /SPR 2286 (MH)
+ DCA I (RPOS
+ TAD (-1200 /NUMBER OF WORDS IN BUFFER
+ DCA I (OUWDCT
+ DCA I (CLEN
+ TAD I (7605
+ SNA
+ JMP FINDSK /V3C IF NO DEVICE SPECIFIED, LOOKUP 'DSK'
+SETDEV, DCA I (7605
+ TAD (7605
+DOMOIN, DCA INFPTR
+ TAD (6601
+ DCA AI1
+ TAD I INFPTR
+ SNA
+ JMP I (ENDCHK
+ JMS I (200
+ 1
+AI1, 6601
+ HLT
+ TAD AI1
+ DCA INHAND
+ TAD (OUTCHR
+ DCA OSWTCH
+ JMS I (CRLF
+ TAD I (DATE
+ DCA I (DATNOW /SAVE CURRENT DATE (MH)
+ TAD I (DATE /GET DATE BACK INTO AC (MH)
+ JMS I (PDATE
+ JMS I (CRLF
+ JMS I (CRLF
+ DCA I (ECOUNT
+ CMA
+ TAD I (EQLS
+ SMA /SET UP NEGATIVE COUNT
+ CMA
+ DCA I (ALNCNT /SAVE FOR LATER
+ TAD I (ALNCNT /SAVE FOR LATER
+ DCA I (LNCNT /SAVE FOR LATER
+ JMP I (PG1
+
+AINO, JMS I (ERROR
+ ILLA+40
+ JMP EOLIN
+QINO, JMS I (ERROR
+ ILLQ+40
+EOLIN, TAD (215 /COME HERE TO ABORT DIRECTORY
+ JMS I (TYPE /AND PRINT CRLF
+ JMP I (ABORT /ABORT OPERATION AND GOTO ENDUP
+
+FINDSK, DCA XX /V3C
+ JMS I (200 /CALL USR
+ 12 /TO DO AN INQUIRE
+ 5723 /TO LOCATE 'DSK'
+XX, 0
+ 0
+ JMP I (IDBLVT /NO 'DSK' IMPOSSIBLE (SO SAY NO 'TTY')
+ TAD XX /RETURN DEVICE NUMBER OF DSK
+ JMP SETDEV
+ PAGE
+\f DIRCTY=0 /LOCATION OF INPUT DIRECTORY
+
+PG1, TAD I INFPTR
+ TAD (7757
+ DCA TEMP
+ TAD I TEMP
+ SMA CLA
+ JMP NFIN
+ CIF 0
+ JMS I INHAND
+ 1400
+ DIRCTY
+ 1
+ JMP INDERR
+ CDF 0 /CODE TO CHECK FOR
+ TAD I (DIRCTY /LEGALITY OF DIRECTORY
+ CMA CLL
+ TAD I (DIRCTY+2
+ CDF 10
+ SNL
+ TAD (7700
+ SZL CLA
+ JMP BIDIR /DIRECTORY IS BAD
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+ TAD INFPTR
+ SKP
+GETCNT, TAD PTR
+ IAC
+ DCA PTR
+ TAD I PTR
+ SZA CLA
+ JMP NOSUB
+ TAD (5200
+ DCA I PTR
+ TAD (3
+ TAD PTR
+ DCA TEMP
+ TAD (5200
+ DCA I TEMP
+NOSUB, TAD PTR
+ TAD (4
+ DCA PTR
+ ISZ CNT
+ TAD I (OPT2
+ AND (10
+ SZA CLA
+ JMP NOPTIM
+ TAD I PTR
+ CIA
+ TAD I INFPTR
+ SNA CLA
+ JMP GETCNT
+NOPTIM, TAD CNT
+ CIA
+ DCA INSCNT
+ TAD PTR
+ DCA I (MOIN
+ DCA BDPTR
+ JMP I (NBLOCK
+
+BIDIR, JMS I (ERROR
+ BADDIR+40
+ JMP I (EOLIN
+NFIN, JMS I (ERROR
+ NFLEIN+40
+ JMP I (EOLIN
+INDERR, JMS I (ERROR
+ BADIRD+40
+ JMP I (EOLIN
+
+/THIS IS THE ERROR MESSAGE PRINTER
+
+ERROR, 0
+ ISZ I (ECHO
+ CLA CLL
+ TAD (TYPE
+ DCA OSWTCH
+ TAD (-100
+ DCA CNT
+PLOOP, TAD I ERROR
+ JMS I (GTSXBT
+ DCA DFLAG
+ TAD DFLAG
+ JMS I (CONVTP
+ ISZ CNT
+ TAD DFLAG
+ SZA CLA
+ JMP PLOOP
+ ISZ ERROR
+ JMP I ERROR
+
+DFLAG, 0
+ABORT, TAD I (ALTOPT /MOVED (MH)
+ SMA CLA
+ JMP I (CDCALL
+ CIF CDF 0
+ JMP I (7605
+BADEQ, JMS I (ERROR
+ BIGEQ+40
+ JMP I (EOLIN
+
+ PAGE
+\f
+/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK, TAD BDPTR /POINTER TO START OF DIR BLOCK
+ DCA XR
+ CDF 0
+ TAD I XR /GET BLOCK NUMBER FIRST FILE
+ DCA BLOCK
+ TAD I XR /NEXT SEGMENT NUMBER
+ DCA LFLAG /IF IT 0 WE AT END
+ ISZ XR /SKIP TENTATIVE FILE WORD
+ TAD I XR /GET -NUMBER OF INFO WORDS
+ CIA /MAKE POSITVE
+ DCA INFWDS
+ TAD XR /POINT TO FIRST
+ IAC /ENTRY
+ DCA EPTR
+
+BLOOP, TAD I EPTR /GET FILENAME WORD
+ CDF 10
+ SNA CLA /SKIP IF FILE HERE
+ JMP EMPTY /NO... ITS REALLY AN EMPTY
+ TAD INSCNT /SET NUMBER OF INPUT TO LOOK
+ DCA NCNT /AT ALL AT ONCE
+ DCA MATFLG /CLEAR MATCH FLAG
+ TAD INFPTR /ADDRESS OF FIRST INPUT
+ SKP
+MN1, TAD GPTR2 /ADDRESS OF CURRENT INPUT
+ TAD (5 /GTSXBT SUBR REQUIRES US TO
+ DCA GPTR2 /POINT TO END OF FIELD
+ TAD EPTR /POINT DIRECTORY POINTER TO
+ TAD (4 /END OF ENTRY FOR SAME REASON
+ DCA GPTR1
+ TAD GPTR1 /SET EPNEXT TO POINT TO
+ TAD INFWDS /MINUS NUMBER OF BLOCKS IN
+ DCA EPNEXT /FILE WORD
+ TAD (-10 /NUMBER OF CHARS TO LOOK AT
+WILDNM, DCA CNT
+\f
+MLP, TAD GPTR2 /OK - GET A CHARACTER FROM
+ JMS I (GTSXBT /STRING
+ TAD (-"*!7700 /IS IT AN *
+ SNA /SKIP IF NOT *
+ JMP WILDA /YEP... ITS A WILD CARD
+ TAD ("*-"? /IS IT A ?
+ SNA /SKIP IF NOT
+ JMP WILD /YES... FORCE MATCH ON THIS CHAR
+ TAD ("?&77 /RESTORE VALUE
+ CIA /NEGATE
+ DCA CHAR /AND SAVE
+ TAD GPTR1 /NOW GET CHAR FROM DIRECTORY
+ CDF 0
+ JMS I (GTSXBT
+ CDF 10
+ TAD CHAR /DO CHARS MATCH
+ SZA CLA /SKIP IF THEY DO
+ JMP NM1 /NO MATCH ON THIS INPUT
+WILD, ISZ CNT /BUMP COUNT OF CHARS & POINTER
+ JMP MLP /COMPARE ALL 8
+MEXT, ISZ MATFLG /A MATCH!!!!!!!
+NM1, CLA /WILD CARD COMES HERE WITH ICHY AC
+ ISZ NCNT /HAVE WE CHECKED GROUP OF INPUTS
+ JMP MN1 /NO CHECK WHOLE GROUP
+ TAD MATFLG /HAVE THERE BEEN ANY MATCHES
+ SZA CLA /SKIP IF NOT
+ TAD (4 /WILL INVERT /V SWITCH
+ TAD I (OPT2 /ADD SWITCH
+ AND (4 /ISOLATE IT
+ CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+ SZA CLA
+ TAD I EPNEXT /GET -NUMBER OF BLOCKS
+ CDF 10
+ SZA /SKIPS IF TENTATIVE OR NOT CANDIDATE
+ JMP I (GOT1 /PROCESS FILE
+NENT, TAD EPNEXT /POINT EPTR TO BLOCK
+ DCA EPTR /COUNT OF FILE
+ JMP NEMPTY
+EMPTY, ISZ EPTR /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+ JMS I (HEMPTY /HANDLE EMPTY SLOTS
+NEMPTY, CDF 0
+ TAD I EPTR /GET BLOCK COUNT
+ CIA /MAKE POSITIVE
+ TAD BLOCK
+ DCA BLOCK /KEEP SUM
+ ISZ EPTR /POINT TO NEXT ENTRY
+ ISZ I BDPTR /POINTS TO -NUMBER OF ENTRIES
+ JMP BLOOP /NOT DONE WITH SEGMENT
+ CDF 10
+ TAD (400 /BUMP TO NEXT SEGMENT
+ TAD BDPTR
+ DCA BDPTR
+ TAD LFLAG /DID WE PROCESS LAST SEGMENT
+ SZA CLA /SKIP IF WE DID
+ JMP NBLOCK /PROCESS NEW SEGNENT
+ JMP I (SAYNON
+\f
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT /GET CURRENT CHAR POSITION
+ TAD (6 /ADD SIZE OF FILENAME
+ SPA /SKIP IF IN EXTENSION FIELD
+ JMP WILDNM /THIS BUMPS TO EXTENSION
+ JMP MEXT /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR, 0
+EPNEXT, 0
+GPTR2, 0
+LFLAG, 0
+NCNT, 0
+BLOCK, 0
+MATFLG, 0
+
+
+ PAGE
+\fGOT1, DCA IFCNT /-# OF BLOCKS IN AC
+ JMS I (DATCHK /VERIFY /C AND /O SWITCHES
+ TAD (OUTCHR
+ DCA OSWTCH
+ TAD I (OPT2
+ SPA CLA
+ JMP I (NENT
+ JMS I (ADDINF /SEE IF ADDITIONAL INFO WORDS
+ TAD I (OPT2
+ AND (100 /IS /R USED
+ SNA CLA
+ JMP NOR
+ TAD INFPTR /FILL IN *.* FOR FILENAME
+ IAC
+ DCA TEMP
+ TAD (5200 /*
+ DCA I TEMP
+ ISZ TEMP
+ ISZ TEMP
+ ISZ TEMP /POINT TO EXTENSION
+ TAD (5200 /.*
+ DCA I TEMP /SUBSTITUTE IT
+NOR, TAD GPTR1
+ CDF
+ JMS I (PNMSUB
+ TAD I (OPT1
+ RTL
+ SNL CLA
+ JMP SKPBLK
+ JMS I (CONVTP
+ TAD I (BLOCK
+ JMS BSPACE /(MH) PATCH FOR /B/E
+SKPBLK, TAD I (OPT1
+ AND (100
+ SZA CLA
+ JMP NODATE
+ TAD IFCNT
+ CIA
+ JMS I (PRNUM
+ TAD INFWDS
+ SNA CLA
+ JMP NODATE
+ CDF
+ TAD I GPTR1
+ CDF 10
+ JMS I (PDATE
+NODATE, ISZ LNCNT /IS LINE FILLED?
+ JMP MOROLN /NO
+ JMS CRLF
+ TAD ALNCNT /RESET COUNT
+ DCA LNCNT
+ JMP I (NENT
+MOROLN, TAD (5 /OUTPUT 5 BLANKS
+ JMS I (BLANK
+ JMP I (NENT
+
+/BLANKS ROUTINE
+BLANK, 0
+ CIA
+ DCA BLTMP
+ JMS I (CONVTP
+ ISZ BLTMP
+ JMP .-2
+ JMP I BLANK
+BLTMP, 0
+
+
+ALNCNT, 0
+LNCNT, 0
+
+OUTCHR, 0
+ JMP I RPOS
+RPOS1, DCA I OCPTR
+ JMS RPOS
+RPOS2, DCA HOLD
+ JMS RPOS
+RPOS3, RTL
+ RTL
+ DCA HOLD2
+ TAD HOLD2
+ AND (7400
+ TAD I OCPTR
+ DCA I OCPTR
+ ISZ OCPTR
+ TAD HOLD2
+ RTL
+ RTL
+ AND (7400
+ TAD HOLD
+ DCA I OCPTR
+ ISZ OCPTR
+ ISZ OUWDCT
+ SKP
+ JMS DUMP
+ JMS RPOS
+ JMP RPOS1
+RPOS, RPOS1
+ JMP I OUTCHR
+
+OUWDCT, 0
+OCPTR, 0
+HOLD, 0
+HOLD2, 0
+BSPACE, 0 /(MH) PATCH FOR /B/E
+ JMS I (OPRNT
+ CLA!IAC
+ JMS I (BLANK
+ JMP I BSPACE
+
+ PAGE
+\f
+GTSXBT, HLT
+ CLL RAL
+ TAD CNT
+ CML RAR
+ DCA TEMP
+ TAD I TEMP
+ SNL
+ JMS ROTR6
+ AND (77
+ JMP I GTSXBT
+
+
+ROTR6, 0
+ RTR
+ RTR
+ RTR
+ JMP I ROTR6
+
+CONVTP, HLT
+ SZA
+ TAD (240
+ AND (77
+ TAD (240
+ JMS I OSWTCH
+ JMP I CONVTP
+
+TYPE, HLT
+ DCA HOLD1
+ TAD (217
+ JMS I (CTYPE
+ SKP
+ DCA ECHO
+ TAD ECHO
+ SNA CLA
+ JMP I TYPE
+ JMS I (CINTER
+ SKP
+ JMP I (ABORT
+ TAD HOLD1
+ JMS TTY
+ JMP I TYPE
+
+HOLD1, 0
+
+TTY, 0
+ TLS
+ TSF
+ JMP .-1
+ TAD (-215
+ SZA CLA
+ JMP I TTY
+ TAD (12
+ JMP TTY+1
+
+ECHO, 1
+
+OPRNT, 0
+ DCA GTSXBT
+ TAD (-4
+ DCA CNT
+OPLP, TAD GTSXBT
+ RTL CLL
+ RAL
+ DCA GTSXBT
+ TAD GTSXBT
+ RAL
+ AND (7
+ TAD (260
+ JMS I (CONVTP
+ ISZ CNT
+ JMP OPLP
+ JMP I OPRNT
+
+
+/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK, 0
+ TAD I (OPT1 /CHECK /C
+ JMS MDATE
+ NOP /RETURN HERE WITH AC=0 IF NO /C
+ SZA CLA /RETURN HERE WITH AC=0 IF DATES MATCH
+ JMP I (NENT /DATES DONT MATCH AND /C GIVEN
+ TAD I (OPT2 /CHECK /V
+ JMS MDATE
+ CMA CLA /SET AC=-1 IF NO /V
+ SNA CLA /RETURN HERE AC=0 IF DATES SAME
+ JMP I (NENT /DATES SAME WITH /V-IGNORE FILE
+ JMP I DATCHK /CONTINUE
+
+MDATE, 0 //O AND /V ARE AC2
+ RTL /IS IT OPTION ON?
+ SMA CLA /SKIP IF IT IS
+ JMP I MDATE /NO- RETURN WITH 0 AC
+ ISZ MDATE /SKIP RETURN
+ CDF 0
+ TAD I GPTR1 /GET DATE WORD
+ CIA
+ CDF 10
+ TAD I (DATE /COMPARE WITH MONITORS, 0 IF =
+ JMP I MDATE
+
+ PAGE
+\f
+PRNUM, 0
+ DCA NUM
+ TAD (PWRTEN
+ DCA PTR
+PRNTLP, ISZ MPNTCNT
+ SKP
+ AC4000
+ DCA PNTFLG
+ DCA DIG
+DIVLPY, TAD I PTR
+ SNA
+ JMP I PRNUM
+ CLL
+ TAD NUM
+ SNL
+ JMP PRTDIG
+ DCA NUM
+ ISZ DIG
+ JMP DIVLPY
+PRTDIG, CLA
+ TAD DIG
+ TAD PNTFLG
+ SNA
+STPBLK, JMP PRBLNK
+ TAD (260
+ JMS I (CONVTP
+ CLA CLL CML RAR
+NXTPWR, ISZ PTR
+ JMP PRNTLP
+PRBLNK, JMS I (CONVTP
+ JMP NXTPWR
+
+NUM, 0
+PNTFLG, 0
+DIG, 0
+MPNTCNT,0
+
+PWRTEN, -1750;-144;-12;-1;0
+
+PDATE, 0
+ SNA
+ JMP FDATE
+ DCA DATEY
+ TAD DATNOW /WAS A DATE ENTERED AT BOOT TIME?(MH)
+ SNA /SKIP IF SO(MH)
+ JMP FDATE /NO -- DON'T PRINT DATE IF NOT ENTERED(MH)
+ AND (7 /YES -- SAVE YR NEGATED(MH)
+ CMA!IAC /(MH)
+ DCA DATTMP /SAVE THIS RESULT TEMP(MH)
+ ISZ I (STPBLK
+ JMS I (CONVTP
+ ACM3
+ DCA I (MPNTCNT
+ TAD DATEY
+ RTR
+ RAR
+ AND (37
+ JMS I (PRNUM
+ TAD ("-
+ JMS I (CONVTP
+ TAD DATEY
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ DCA PRNUM
+ TAD PRNUM
+ TAD PRNUM
+ TAD PRNUM
+ TAD (DATTAB-4
+ DCA XR
+ ACM3
+ DCA CNT
+ TAD I XR
+ JMS I OSWTCH
+ ISZ CNT
+ JMP .-3
+ TAD ("-
+ JMS I OSWTCH
+ TAD DATEY
+ AND (7
+ TAD DATTMP /ADD -ENTERED YR(MH)
+ CLL /CLEAR LINK FOR FLAG USE(MH)
+ SZA!SMA!CLA /SKIP AND CLEAR IF ENTERED YR BIGGER,SAME(MH)
+ CML /SET LINK IF DIR YR BIGGER THAN ENETERED YR (MH)
+ TAD DATEY /GET DATE BACK(MH)
+ AND (7 /GET THE YR(MH)
+ SZL /SKIP IF ENTERED YR WAS BIG OR SAME(MH)
+ TAD (-10 /SUBTRACT 10 OCTAL IF DIR YR WAS BIGGER(MH)
+ TAD DATINC /ADD DATE INCREMENT(MH)
+ TAD (106
+ JMS I (PRNUM
+ CLA CMA
+ TAD I (STPBLK
+ DCA I (STPBLK
+ JMP I PDATE
+FDATE, TAD I (LNCNT /SEE IF AT END OF LINE?
+ IAC /AC=0 NOW IF YES
+ SNA CLA /OUT PUT SPACES TO FILL DATE SLOT
+ JMP I PDATE /NO NEED FOR SPACES IF AT END OF LINE
+ TAD (12 /10 SPACES IS WHATS NEEDED
+ JMS I (BLANK
+ JMP I PDATE /LEAVE
+
+DATEY, 0
+DATNOW, 0 /CURRENT DATE IF ONE WAS ENTERED(MH)
+DATINC, 0 /DATE ENXTENSION TO 1970 (0,10,20, OR 30) (MH)
+DATTMP, 0 /TEMP STORE (MH)
+
+ PAGE
+\f
+CTYPE, 0
+ DCA T2
+ TAD (200
+ KRS
+ CIA
+ TAD T2
+ SNA CLA
+ KSF
+ JMP I CTYPE
+ KCC
+ TAD ("^
+ JMS I (TTY
+ TAD T2
+ TAD (100
+ JMS I (TTY
+ TAD (215
+ JMS I (TTY
+ ISZ CTYPE
+ JMP I CTYPE
+
+T2, 0
+
+CINTER, 0
+ TAD (203
+ JMS CTYPE
+ JMP UPPCK
+ JMP SPURGE
+UPPCK, TAD (220
+ JMS CTYPE
+ JMP I CINTER
+ SKP
+SPURGE, CMA
+ DCA I (ALTOPT
+ ISZ CINTER
+ JMP I CINTER
+
+HEMPTY, 0
+ CDF 0
+ TAD I EPTR
+ CDF 10
+ CIA
+ TAD ECOUNT
+ DCA ECOUNT
+ TAD I (OPT1
+ AND (200
+ SZA CLA
+ JMP LISTEM
+ TAD I (OPT2
+ SMA CLA
+ JMP I HEMPTY
+LISTEM, TAD I (OPT1
+ AND (10 /IS /I GIVEN
+ SNA CLA /IF YES PAD BY ADDIDTIONAL INFO WORDS
+ JMP EMSG
+ CLA CMA
+ TAD INFWDS /NUMBER OF SPACES=5*(INFWDS-1)
+ DCA DFLAG
+ TAD DFLAG
+ RTL CLL
+ TAD DFLAG
+ SZA /DONT OUTPUT 4096 BLANKS
+ JMS I (BLANK
+EMSG, TAD (EMPTYM-1
+ DCA XR1
+ TAD (-11
+ DCA CNT
+EOLP, TAD I XR1
+ JMS I (OUTCHR
+ ISZ CNT
+ JMP EOLP
+ TAD I (OPT1
+ RTL
+ SNL CLA
+ JMP SKIPES
+ JMS I (CONVTP
+ TAD I (BLOCK
+ JMS I (BSPACE /(MH) PATCH FOR /B/E
+SKIPES, CDF 0
+ TAD I EPTR
+ CDF 10
+ CIA
+ JMS I (PRNUM
+ ISZ I (LNCNT /AT END OF LINE
+ JMP WORK /NO. HAVE TO DO BLANK PADDING
+ JMS I (CRLF
+ TAD I (ALNCNT /RESET COUNT
+ DCA I (LNCNT
+ JMP I HEMPTY
+WORK, TAD (5 /FORCES 5 BLANKS
+ JMS I (BLANK
+ TAD I (OPT1
+ AND (100 /CHECK FOR /F
+ SZA CLA /ADD 10 SPACES TO COVER DATE
+ JMP I HEMPTY
+ TAD (12
+ JMS I (BLANK
+ JMP I HEMPTY
+
+ECOUNT, 0
+
+ PAGE
+\f
+PNMSUB, 0
+ DCA NMEPLC
+ RDF
+ TAD (CDF
+ DCA FLDFUD
+ TAD (-10
+ DCA CNT
+PNLOOP, TAD NMEPLC
+FLDFUD, HLT
+ JMS I (GTSXBT
+ CDF 10
+ JMS I (CONVTP
+ TAD (3
+ TAD CNT
+ SZA CLA
+ JMP .+3
+ TAD (".
+ JMS I OSWTCH
+ ISZ CNT
+ JMP PNLOOP
+ JMP I PNMSUB
+
+NMEPLC, 0
+
+WRTERR, JMS I (ERROR
+ OUERR+40
+ JMP I (EOLIN
+CLOERR, JMS I (ERROR
+ CLERR+40
+ JMP I (EOLIN
+NOROOM, JMS I (ERROR
+ SPRBLM+40
+ JMP I (EOLIN
+IDBLVT, JMS I (ERROR
+ NOTTY+40
+ JMP I (EOLIN
+
+SAYNON, TAD (OUTCHR
+ DCA OSWTCH
+ JMS I (CRLF
+ JMS I (CRLF
+ TAD (-4 /FORCE PRINTING OF ONLY 1 DIGIT
+ DCA I (MPNTCNT /FOR 0 FREE BLOCKS
+ TAD I (ECOUNT
+ JMS I (PRNUM
+ JMS I (CONVTP
+ TAD (FRBLM-1
+ DCA XR1
+ TAD (-13
+ DCA CNT
+FRBLP, TAD I XR1
+ JMS I (OUTCHR
+ ISZ CNT
+ JMP FRBLP
+ JMS I (CRLF
+ TAD (14 /FORM FEED
+ JMS I (OUTCHR
+ TAD MOIN
+ JMP I (DOMOIN
+
+MOIN, 0
+
+CRLF, 0
+ TAD (215
+ JMS OUTCHR
+ TAD (212
+ JMS OUTCHR
+ JMP I CRLF
+
+/ROUTINE TO DUMP ADDITIONAL INFO WORDS IF WANTED
+
+ADDINF, 0
+ TAD I (OPT1
+ AND (10 /CHECK /I SWITCH
+ SNA CLA
+ JMP I ADDINF
+ CLA CMA
+ TAD INFWDS /GET NUMBER
+ SPA SNA /MUST BE 2 OR MORE TO PRINT
+ JMP CLARET /RETURN
+ CIA
+ DCA CNTX
+ TAD GPTR1
+ IAC /BUMP TO FIRST ONE
+ DCA PGPTR1
+ADDLP, CDF 0
+ TAD I PGPTR1 /GET WORD
+ CDF 10
+ JMS I (OPRNT /PRINT IT IN OCTAL
+ JMS I (CONVTP /OUTPUT A BLANK
+ ISZ PGPTR1 /BUMP
+ ISZ CNTX /COUNT NUMBER
+ JMP ADDLP
+CLARET, CLA /RETRN
+ JMP I ADDINF
+
+PGPTR1, 0
+CNTX, 0
+
+ PAGE
+\f
+VERNO, TEXT /DIRECT V6A /
+BADIRD, TEXT /ERROR READING INPUT DIRECTORY/
+SPRBLM, TEXT /NO ROOM FOR OUTPUT FILE/
+OUERR, TEXT /ERROR WRITING FILE/
+CLERR, TEXT /ERROR CLOSING FILE/
+NFLEIN, TEXT /DEVICE DOES NOT HAVE DIRECTORY/
+BIGEQ, TEXT /EQUALS OPTION BAD/
+ILLQ, TEXT /ILLEGAL ?/
+ILLA, TEXT /ILLEGAL */
+BADDIR, TEXT /BAD INPUT DIRECTORY/
+NOTTY, TEXT /THERE IS NO HOPE-THERE IS NO TTY HANDLER IN YOUR SYSTEM/
+EMPTYM, "<;"E;"M;"P;"T;"Y;">;240;240
+FRBLM, "F;"R;"E;"E;240;"B;"L;"O;"C;"K;"S
+
+ "B;"A;"D /PROTECTION AGAINST BAD DATE
+DATTAB, "J;"A;"N
+ "F;"E;"B
+ "M;"A;"R
+ "A;"P;"R
+ "M;"A;"Y
+ "J;"U;"N
+ "J;"U;"L
+ "A;"U;"G
+ "S;"E;"P
+ "O;"C;"T
+ "N;"O;"V
+ "D;"E;"C
+ "B;"A;"D /PROTECTION AGAINST BAD DATE
+ "B;"A;"D /PROTECTION AGAINST BAD DATE
+ "B;"A;"D /PROTECTION AGAINST BAD DATE
+
+DUMP, 0
+ TAD I (LENGTH /GET LENGTH AVAILABLE
+ SNA /IF ZERO ITS NON FILE STRUCTURE
+ JMP NOMATR /IF ZERO DOESNT MATTER
+ CLL
+ TAD I (CLEN /ADD CURRENT SIZE
+ TAD (5 /ADD # OF BLOCKS
+ SZL CLA /WE ARE OK IF SKIPS
+ JMP I (NOROOM
+ TAD I (CLEN /UPDATE CLOSING LENGTH
+ TAD (5 /BY NUMBER OF BLOCKS
+ DCA I (CLEN /SAVE FOR CLOSE
+NOMATR, TAD OUWDCT
+ TAD (5210
+ DCA CTLWD
+ CIF 0
+ JMS I OUHAND
+CTLWD, 5210
+BUFAD, BUF
+BLCKN, 0
+ JMP WRTERR
+ TAD (5
+ TAD BLCKN /UPDATE BLOCK # BY 5
+ DCA BLCKN
+ TAD (-1200
+ DCA OUWDCT
+ TAD BUFAD
+ DCA OCPTR
+ JMP I DUMP
+/
+\f
+ *4600
+
+ JMS INIT
+ JMS INIT
+ JMP I (2000
+ JMP I (2001
+INIT, 0
+ ISZ INIT
+ CLA CLL
+ TAD (2000
+ CDF 0
+ DCA I (7745
+ TAD (6403
+ DCA I (7746
+ CDF 10
+ JMP I INIT
+ $
--- /dev/null
+/7 OS/8 MCPIP MAGTAPE AND CASSETTE PIP
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+/ S.R.
+
+/ REVISED FEB. 11, 1974
+/ SECOND REVISION: 7-AUG-75
+
+
+/1. INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
+/ (NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
+/2. BUMPED VERSION NUMBER TO V5
+/3. FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE
+
+ KCLR=6700 /CLEAR ALL
+ /CLEAR STATUS A AND B REGISTERS.
+ KSDR=6701 /SKIP ON DATA FLAG
+ KSEN=6702 /SKIP ON ERROR
+ KSBF=6703 /SKIP ON READY FLAG
+ KLSA=6704 /LOAD STATUS A FROM AC 4-11
+ /CLEAR AC, THEN
+ /LOAD 8 BIT COMPLEMENT OF STATUS A
+ /BACK INTO AC
+ KSAF=6705 /SKIP ON ANY FLAG OR ERROR
+ KGOA=6706 /ASSERT THE CONTENTS OF STATUS A,
+ /TRANSFER DATA IF READ OR WRITE
+ KRSB=6707 /READ STATUS B INTO AC 4-11
+
+
+ FIXMRI CALL=4400
+ FIXMRI EXIT=5400
+ FIXMRI INCR=2000
+
+/CORE ALLOCATION
+
+/00000-01777 COMMAND DECODER
+/02000-02377 OUTPUT HANDLER
+/02400-02777 INPUT HANDLER
+/03000-03777 CASSETTE OUTPUT BUFFER
+/04000-04777 CASSETTE INPUT BUFFER
+/05000-05577 STAND ALONE CASSETTE HANDLER
+/05600-07577 LOOKUP, ENTER, CLOSE
+/07600-07777 OS/8
+
+/10000-11777 USR
+/12000-14577 PIPC
+/14600-17577 OS/8 INPUT/OUTPUT BUFFER
+/17600-17777 OS/8
+\f/USR HAS THE FOLLOWING FREE LOCATIONS:
+/0-6
+/10-17 (BUT GET DESTROYED)
+/20-37
+
+ TEMP=20
+ TEMP1=21
+ TEMP2=22
+ TEMP3=23
+
+/ STARTING ADDRESS = 12000
+/ JOB STATUS WORD = 6003
+
+ INHAND=2400
+ OUTHAND=2000
+ COBUF=3000
+ CIBUF=4000
+
+ PIPVERSION=6
+ PATCHLEV=77&"A
+
+ SPCODE=6
+ CLCODE=0
+ REWCOD=1
+ FICODE=3
+ EOCODE=5
+ RECCOD=2
+\f/V3 CHANGES:
+
+/1. SHRUNK 0S/8 BUFFER TO 3000 WORDS
+/2. ADDED VERSION NUMBER (/V)
+/3. MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
+/4. ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
+/5. ALTMODE MEANS RETURN TO KBM
+/6. ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
+/7. FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
+/8. CR ALONE TO CD GIVES NO ERROR MESSAGE
+/9. ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
+/10. GIVE ERRORS ON ILLEGAL * OR ? IN NAME
+/11. USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
+
+/PROPOSED:
+/8. ALLOW *.* FOR CASSETTE INPUT
+/9. SUPPORT OF UNLABELED MAGTAPE STANDARD
+/10. /7 OR /9 SPECIFIES CHANNEL
+
+/FIXES SINCE FIELD TEST :
+
+/1. ^C ALWAYS BRINGS YOU BACK TO KBM
+/2. FIXED BUG RE CHECK FOR FILE FULL
+/3. MADE COMPATIBLE WITH NEW TM8E HANDLER
+/4. TIME-OUT ON CASSETTE READ
+/5. BE NICE-GUY IF OS/8 LOOKUP FAILURE
+\f/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
+/AND READY.
+/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
+/THE UNIT NUMBER IS IN BITS 8-11 OF THE AC.
+/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
+/CINUSE IS SET TO 1.
+/THE HANDLER MUST NOT ALREADY BE IN USE.
+/THE DATA FIELD IS INTERROGATED
+/AND A RETURN CIF CDF IS BUILT
+/AND STORED IN LOCATION RETCIF
+
+\f *5000
+
+FIXDVC, 0
+ DCA DVC
+ RDF
+ TAD (CIF CDF
+ CDF 0
+ DCA TMP
+ TAD I FIXDVC
+ DCA ERRET
+ ISZ FIXDVC
+ TAD TMP
+ DCA I ERRET
+ TAD DVC
+ SNA
+ JMP CHECKR
+ RAR /MOVE UNIT TO LINK; DEVICE TO AC
+ AND (3 /MASK OFF DEVICE CODE
+ DCA DVC /SAVE DEVICE CODE
+ SZL
+ TAD (100
+ DCA I (ABUNIT /SET UNIT IN BIT 5
+ TAD DVC
+ CLL RTL
+ RAL /UGLY
+ DCA DVC /MOVE TO BITS 6-8
+ TAD (IOTBL
+ DCA IOTPTR
+IOTLOOP,TAD I IOTPTR
+ SNA /END OF TABLE?
+ JMP CHECKR /YES
+ DCA TMP
+ TAD I TMP
+ AND (7707 /MASK OUT OLD DVC
+ TAD DVC /INSERT NEW ONE
+ DCA I TMP /REPLACE
+ ISZ IOTPTR /POINT TO NEXT ONE
+ JMP IOTLOOP
+
+TMP, 0
+DVC, 0 /DEVICE CODE
+IOTPTR, 0
+\fCHECKR, JMS I (CLEAR
+ TAD (200
+ JMS I (LOADA /SELECT DRIVE
+ JMS I (CHECKB
+ AND (7735 /IGNORE EOT/BOT FLAG
+ /AND WLO
+ TAD (-1
+ SZA CLA
+ JMP I ERRET /NOT READY
+ ISZ I (CINUSE
+ JMP I FIXDVC
+
+ERRET, 0 /ERROR RETURN LOCATION
+\fFIDDLE, 0
+ CIF 10
+ JMS I (FID2 /NEED ROOM
+ TAD (CIBUF+11
+ DCA 10
+ TAD FAST
+ SZA CLA
+ JMP DIREOL
+ TAD (40
+ DCA I 10
+ TAD I (CIBUF+20
+ DCA I 10
+ TAD I (CIBUF+20
+ AND (177
+ SZA
+ TAD (-40
+ SZA CLA
+ TAD ("/-40
+ TAD (40
+ DCA SLSH
+ TAD I (CIBUF+21
+ DCA I 10
+ TAD SLSH
+ DCA I 10
+ INCR 10
+ INCR 10
+ TAD SLSH
+ DCA I 10
+ TAD I (CIBUF+22
+ DCA I 10
+ TAD I (CIBUF+23
+ DCA I 10
+DIREOL, TAD (15
+ DCA I 10
+ TAD (12
+ DCA I 10
+ TAD (32
+ DCA I 10
+FIDLV, EXIT FIDDLE
+
+/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
+/F I L E N A M E S D D M M Y Y
+/F I L E N A . M E S M M / D D / Y Y CR LF ^Z
+
+FAST, 0 /0 MEANS F NOT SPECIFIED
+\fSLSH, "/
+
+IOTBL, IOT0
+ IOT1
+ IOT4
+ IOT5
+ IOT6
+ IOT6C
+ IOT7
+ 0
+ PAGE
+\fUTIL, 0
+ DCA TEMPU
+ DCA REWSW /ZERO REWIND SWITCH
+ TAD I UTIL
+ TAD (-10
+ SNA
+ ISZ REWSW
+ ISZ UTIL
+ TAD (210
+ DCA TEMPFN
+ TAD TEMPU
+ JMS I (FIXDVC /FIX DEVICE CODE
+ UTEND /UNIT NOT READY
+ TAD (UT
+ DCA CRET /SET RETURN ADDRESS
+ STA
+ DCA I (RW /NOTE FACT THAT OP AINT READ
+ TAD TEMPFN
+ JMS I (LOADA
+ JMS GO /INITIATE UTIL
+ JMP CRET+1
+ ISZ UTIL
+UTEND, HLT
+ JMP I UTIL
+UT, JMS CHECKB /LOOK AT STATUS B
+ AND (50 /CHECK FOR CL, EMPTY, OR WLO
+ /GIVE NO ERROR ON WLO ************
+ /BAD FOR WRGAP
+ SNA
+ JMP OK /NO ERRORS
+ TAD (-40
+ SZA CLA
+ JMP NOTOK /ERROR NOT CL
+ TAD REWSW
+ SNA CLA /CL OK IF DID REWIND
+NOTOK, STA
+OK, JMS CLEAR
+ TAD CINUSE
+ SMA CLA
+ JMP UTEND-1
+ TAD BSTATE /ERROR
+ JMP UTEND
+
+TEMPU, 0
+TEMPFN, 0
+REWSW, 0 /1 MEANS OPERATION IS REWIND
+\fCHECKB, 0
+IOT7, KRSB /READ STATUS B INTO AC 4-11
+ DCA BSTATE /SAVE STATUS B
+ TAD BSTATE
+ JMP I CHECKB
+
+CLEAR, 0
+ DCA CINUSE /LEAVE STATUS CONDITION IN AC; -1 MEANS ERROR
+IOT0, KCLR /CLEAR STATUS A AND B
+ JMP I CLEAR
+
+GO, 0
+IOT6, KGOA /ASSERT CONTENTS OF STATUS A
+ CLA
+ JMP I GO
+
+CHK, 0
+ JMS I (CHECKB
+ AND (374
+IOT1, KSDR
+ SKP /DATA FLAG NOT UP -
+ JMP I CHK
+ TAD (-20
+ SNA CLA /IS IT END OF FILE?
+ JMP I (ERRR /YES, ERROR - BUT DON'T RETRY
+ TAD BSTATE
+ JMP I CHK
+
+CINUSE, 0 /1 MEANS HANDLER IN USE
+BSTATE, 0 /STATUS OF REGISTER B ON ERROR
+\fDTEM, 0
+
+DOPTION,JMS I (CONVRT
+ 7601
+ DCA DTEM
+ TAD I (OUNIT
+ JMS I (LOOKUP
+ JMP I (XER4
+ JMP MBNF /NOT FOUND
+ INCR DTEM
+ JMS I (DELET
+ JMP I (XER77 /OUTPUT ERROR
+MBNF, TAD DTEM
+ SNA CLA /ANYTHING DELETED?
+ JMP I (XER24 /NO
+ JMS UTIL
+ REWIND
+ CLA
+ CIF CDF 10 /YES
+ JMP I (DECODE
+\fCRET, 0
+ CDF 0
+ TAD (-200 /COUNT OF HOW LONG TO WAIT
+ DCA I (OUTER
+IOL, JMS I (CTRLC
+ JMS I (TIMEOUT
+IOT5, KSAF
+ JMP IOL
+ EXIT CRET
+ PAGE
+\fHANDLER,0
+ DCA TUN
+ TAD I HANDLER /GET FUNCTION CONTROL WORD
+ AND L70 /ISOLATE FIELD OF BUFFER
+ TAD LCDF
+ DCA WCDF
+ TAD I HANDLER /RETRIEVE FUNCTION CONTROL WORD
+ RAL /READ/WRITE BIT TO LINK
+ CLA RAL
+ DCA RW /RW=1 IF WRITE
+ ISZ HANDLER /POINT TO BUFFER ADDRESS
+ TAD I HANDLER /GET BUFFER ADDRESS
+ DCA BUFFER /SAVE IT
+ ISZ HANDLER /POINT TO ERROR RETURN
+ TAD TUN
+ JMS I (FIXDVC
+ LV /NOT READY
+ TAD WCDF
+ DCA BFIELD
+ TAD WCDF
+ DCA BFLD
+ STA CLL RTL /TAD (-3
+ DCA ERKNT
+ JMS SETUP /SET UP READ OR WRITE
+ JMP I (CRET+1
+ ISZ HANDLER /POINT TO GOOD RETURN
+LV, HLT
+ JMP I HANDLER
+RW, 0 /1 IF WRITE (-1 IF UTIL)
+ERKNT, -3
+\fSETUP, 0
+ TAD RW
+ TAD (WRITEX
+ DCA I (CRET /SET RETURN ADDRESS
+ TAD BUFFER
+ DCA BPTR
+ TAD BSIZE
+ CMA /WANT TO READ ONE MORE
+ TAD RW
+ DCA BKNT
+ TAD RW
+ DCA OUTSW
+ TAD RW
+ CLL RTL
+ RTL /WRITE FN CODE=20
+ TAD (200 /SELECT AND INTERRUPT ENABLE
+ JMS I (LOADA
+WCDF, HLT
+ TAD RW
+ SZA CLA
+ TAD I BPTR
+LCDF, CDF 0
+ JMS I (GO
+ JMP I SETUP
+
+\fREADX, JMS I (CHK
+ AND L374
+ SZA
+ JMP ERRX
+IOT6C, KGOA /GET CHAR JUST READ
+ DCA BYTE
+ ISZ BKNT
+ SKP
+ JMP RWCRC
+BMODE, TAD BYTE
+TUN,
+BFLD, HLT
+ DCA I BPTR
+ ISZ BPTR
+L374, 374
+ JMP I (CRET+1 /CRET ALREADY SET UP
+
+BSIZE, 200
+OUTSW, 0 /1 MEANS WE BEGAN TO WRITE
+\fRWCRC, TAD (260 /ENABLE, ENABLE INTER, READ CRC
+ JMS I (LOADA
+ JMS I (GO
+ JMS I (CRET
+ JMS I (CHK
+CRCMN, JMS I (GO
+ JMS I (CRET
+ JMS I (CHECKB
+ AND (7775 /IGNORE WLO
+ TAD (-1
+ERRX, SNA CLA /ERRORS?
+ JMP ERRR+1 /NO - CLEAN BILL OF HEALTH
+ ISZ ERKNT /TRY 3 TIMES
+ JMP I (ERRCOV /RETRY
+ERRR, STA /ERROR WHILE READING CRC
+ JMS I (CLEAR
+ TAD I (CINUSE
+ SMA CLA
+ JMP LV-1
+ TAD I (BSTATE
+ JMP LV
+\fWRITEX, JMP READX
+ JMS I (CHK
+ SZA
+ JMP ERRX
+ ISZ BKNT
+ SKP
+ JMP WCRC
+BFIELD, HLT
+ ISZ BPTR
+L70, 70
+ TAD I BPTR
+ JMS I (GO
+ JMP I (CRET+1
+
+
+WCRC, TAD (260
+ JMS I (LOADA
+ JMP CRCMN
+BKNT, 0 /NUMBER OF CHARS EXPECTED
+BPTR, 0 /NEXT LOCATION IN BUFFER TO STORE INTO
+BYTE, 0 /TEMPORARILY HOLDS BYTE FOUND
+BUFFER, 0
+ PAGE
+\f/ LOOKUP, ETC.
+
+ F1=10
+ READ=0
+ WRITE=4000
+
+ REWIND=10
+ BACKFIL=30
+ WRGAP=40
+ BACKBLOCK=50
+ SKPFIL=70
+
+ HSIZE=40
+ OBUFFER=4600 /LOCATION OF OS/8 I/O BUFFER
+ BINBUF=OBUFFER
+ OBUFLEN=3000
+ HOBUFLEN=OBUFLEN%2
+ MAXBLK=OBUFLEN%400
+
+FILNUM, 0
+/ ENTER
+
+/ TAD UNIT
+/ JMS I (ENTER
+/ <ERROR RETURN>
+/ <NORMAL RETURN>
+
+/ ENTER FILENAME AS SPECIFIED IN SINCH
+/ USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
+
+ENTER, 0
+ JMS I (LOOKUP
+ JMP ERET /ERROR WHILE READING
+ JMP NTF
+ JMS I (DELET
+ JMP ERET /ERROR WHILE DELETING
+NTF, JMS BACK
+ JMP ERET /ERROR BACKING UP
+ JMS I QH1 /WRITE NEW HEADER
+ WRITE
+ SINCH
+ JMP ERET /CASSETTE NOT READY
+ TAD I (RECSIZ
+ DCA I (BSIZE
+ INCR ENTER
+ERET, EXIT ENTER
+
+RDOR, 0
+ AND (374 /CASSETTE ONLY
+ TAD (-200
+ SZA CLA /WAS ERROR JUST CRC?
+ EXIT BACK /NO
+ EXIT RDOR /YES, OK CONTINUE
+\fBACK, 0
+BK4, JMS I QU1
+BK2, BACKFIL /GO BACK TO FILE GAP
+ EXIT BACK
+BK3, JMS I QU1
+ BACKBLOCK /BACK TO LAST RECORD
+ JMP BKERR
+ TAD I (RECSIZ
+ DCA I (BSIZE
+ JMS I QH1 /READ LAST RECORD OF PREV FILE
+ READ+F1 /DON'T STORE IN BUFFER
+ BINBUF
+ JMS RDOR /^*******
+ /ERROR READING LAST BLOCK
+NEWGAP, JMS I QU1
+ WRGAP /WRITE A NEW GAP
+ EXIT BACK
+BK9, TAD (HSIZE
+ DCA I (BSIZE
+ INCR BACK
+ EXIT BACK
+
+BKERR, AND (3775 /CASSETTES ONLY
+ TAD (-41
+ SZA CLA /WAS ERROR CLEAR LEADER?
+ EXIT BACK
+ JMP NEWGAP
+
+BK1, JMP BK9
+
+/FOR MAGTAPES:
+
+/BK2_BACKBLOCK
+/BK3_BK1
+\fCLOSE, 0
+ JMS I QU1
+ WRGAP
+ JMP CLRET /ERROR WHILE WRITING GAP
+ TAD (HSIZE
+ DCA I (BSIZE
+ JMS I QH1
+ WRITE /WRITE SENTINEL
+ ZER
+ JMP CLRET
+ JMS I QU1
+ REWIND
+ JMP CLRET
+ INCR CLOSE /SKIP ERROR RETURN
+CLRET, EXIT CLOSE
+\fCRED, 0
+ TAD I (INRECSZ
+ DCA I (BSIZE
+ TAD I (IUNIT
+ JMS I QH1
+ READ
+ CIBUF
+ JMP INER
+ TAD (CIBUF
+ DCA I (CIPTR
+ TAD I (INRECSZ
+ CIA
+ DCA I (CIKNT
+/ CLA IAC
+/ DCA DATAFLG
+ EXIT CRED
+INER, AND EOFBIT
+ SZA CLA /REAL ERROR?
+ JMP I (XER4 /YES
+/ TAD DATAFLG
+/ SNA CLA /READ ANY DATA?
+/ JMP INTO /NO REWIND
+/ DCA DATAFLG /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
+INTO, CLA
+ TAD I (IUNIT
+ JMS I QU1
+ REWIND
+ CLA
+ TAD I (BIPTR
+ CIF CDF 10 /NO, MERELY END-OF-FILE
+ TAD (-OBUFFER+377
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ DCA I (INTEN /NUMBER OF BLOCKS GOT
+ JMP I (XFIN
+
+LOADA, 0
+ TAD ABUNIT
+IOT4, KLSA
+ CLA
+ JMP I LOADA
+
+EOFBIT, 254 /CHANGED TO 3673 FOR MAGTAPE
+/DATAFLG,0 /1 MEANS READ DATA
+\fQU1, UTIL
+QH1, HANDLER
+ABUNIT, 0
+ PAGE
+\f
+/ LOOKUP
+
+/ TAD UNIT
+/ JMS I (LOOKUP
+/ I/O ERROR RETURN
+/ <NOT FOUND RETURN>
+/ <FOUND RETURN>
+/ ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
+
+LOOKUP, 0
+ DCA P1
+ CDF 10
+ TAD I (7644
+ CDF 0
+ AND (10 /IS /U SPECIFIED?
+ SZA CLA
+ JMP GOODRT /YES, DO NOTHING
+ TAD P1
+ JMS I QU2
+ REWIND
+ JMP ERRIT
+ TAD (HSIZE /SET LENGTH OF RECORD HEADER
+ DCA I (BSIZE
+ DCA I (FILNUM
+FL1, JMP FL2 /ZERO THIS LOCATION FOR MAGTAPES
+FLOOP, JMS I QU2
+ SKPFIL
+ JMP ERRIT
+FL2, INCR I (FILNUM
+ JMS I QH2
+ READ
+ INCH
+ JMP ERRIT
+ TAD (INCH
+ DCA P1
+ TAD I P1
+ SNA CLA /SENTINEL FILE?
+ JMP NFNDRET /YES, NOT FOUND
+ TAD (SINCH /NO, IS THIS THE ONE WANTED?
+ DCA P2
+ TAD (-10
+ DCA SCNT
+\fSLOOP, TAD I P1
+ CIA
+ TAD I P2
+ AND (177 /ONLY LAST 7 BITS NEED MATCH
+ SZA CLA
+ JMP FLOOP /FILE KEY NOT ONE DESIRED
+ INCR P1
+ INCR P2
+ ISZ SCNT
+ JMP SLOOP
+GOODRT, INCR LOOKUP /SKIP NOT FOUND RETURN
+NFNDRET,INCR LOOKUP /SKIP ERROR RETURN
+ERRIT, CLA
+ TAD I (RECSIZ
+ DCA I (BSIZE /BE NICE TO USER
+LRET, EXIT LOOKUP /BYE-BYE
+
+ERRT, AND EOTBIT /REAL ERROR?
+ SZA CLA
+ JMP ERRIT /YES
+ JMP NFNDRET /NO, MERELY END-OF CASSETTE
+
+/END OF CASSETTD IS SIGNALLED BY
+
+/A SENTINEL FILE
+/B DOUBLE FILE GAP
+/C EOT
+
+EOTBIT, 314 /CHANGE TO 3663 FOR MAGTAPE
+\fP1, 0
+P2, 0
+SCNT, 0
+DELET, 0
+ JMS I (BACK
+ EXIT DELET
+ JMS I QH2 /WRITE EMPTY HEADER
+ WRITE+10
+ EMPTINCH
+ EXIT DELET /ERROR WHILE DELETING
+ CLL STA RAL /-2
+ TAD LOOKUP
+ DCA LOOKUP
+ JMP FLOOP /JUMP INTO LOOKUP TO CONTINUE
+ZER, 0
+
+QH2, HANDLER
+QU2, UTIL
+FL3, JMP FL2
+\fERRCOV, JMS I (CLEAR
+ JMS I (CTRLC
+ TAD (250
+ JMS I (LOADA
+ JMS I (GO /BACKSPACE BLOCK
+ JMS I (CRET /WAIT
+ JMS I (CHECKB
+ AND (374 /KILL WRITE-LOCK BIT
+ SZA CLA
+ JMP I (ERRR
+ JMS I (SETUP /RE-SET UP OPERATION
+ JMP I (CRET+1 /GO AWAY
+\fTIMEOUT,0
+ ISZ INNER
+ JMP I TIMEOUT
+ ISZ OUTER
+ JMP I TIMEOUT
+ TAD I (RW / I/O HAS TAKEN A LOT OF TIME
+ SZA CLA /IS IT A READ OP?
+ JMP I TIMEOUT /NO, RETURN
+ JMP I (ERRR /YES, ERROR
+
+INNER, 0
+OUTER, -200
+ PAGE
+\f/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
+/VIA CASSETTE OUTPUT BUFFER
+
+CWRITE, 0
+ TAD (OBUFFER
+ DCA BUPTR /PT TO BEGIN OF BUFFER
+ CDF 10
+ TAD I (INTEN /GET NO. OF BLOCKS READ
+ SNA
+ JMP CWLV
+ CDF 0
+ CLL RTR
+ RTR
+ RAR /CONVERT TO WORDS
+ IAC
+ AND (7776 /ROUND UP TO EVEN NO.
+ CLL RAR /DIVIDE BY TWO
+ CIA /USE AS COUNT OF DOUBLE-WORDS
+ DCA BUKNT /2000 TWO-WORD ENTRIES
+CWLOOP, CDF 10
+ TAD I BUPTR
+ JMS CWR /SENT TO CASSETTE OUTPUT BUFFER
+ CDF 10
+ TAD I BUPTR
+ AND (7400
+ DCA TEMP1
+ INCR BUPTR /PT TO 2ND HALF
+ TAD I BUPTR
+ JMS CWR
+ CDF 10
+ TAD I BUPTR
+ AND (7400
+ CLL RTR
+ RTR
+ TAD TEMP1
+ RTR
+ RTR
+ JMS CWR
+ INCR BUPTR /PT TO NEXT DOUBLE-WORD
+ ISZ BUKNT /AT END OF BUFFER?
+ JMP CWLOOP /NO
+CWLV, CIF CDF 10
+ EXIT CWRITE /YES, RETURN
+BUPTR, 0 /PTS INTO OBUUFER
+BUKNT, 0
+\f/INSERT CHAR IN CASSETTE OUTPUT BUFFER
+/AND OUTPUT BUFFER IF BUFFER FULL
+
+CWR, 0
+ AND (377
+ CDF 0
+ DCA CWTMP
+ TAD LDRFLG
+ SZA CLA
+ JMS I (LDRTST
+ CDF 10
+ TAD I (7643
+ RTL /PUT /B OPTION IN LINK
+ CDF 0
+ SNL CLA
+ JMP GOK
+ TAD CWTMP
+ TAD M200
+ SNA CLA
+ JMP I (PREFIN
+GOK, TAD CWTMP2
+ JMS CWR2
+ TAD CWTMP1
+ DCA CWTMP2
+ TAD CWTMP
+ DCA CWTMP1
+CWREX, EXIT CWR
+
+CWR2, 0
+ SPA
+ JMP CWRIGN /IGNORE -1
+ CDF 0
+ DCA I COPTR /INSERT CHAR IN COBUF
+ INCR COPTR
+ ISZ COKNT /COBUF FULL?
+ EXIT CWR2 /NO, SO RETURN
+ JMS CWRI
+M200,
+CWRIGN, 7600 /CLA
+ EXIT CWR2
+\fCWRI, 0
+ TAD COKNT
+ TAD RECSIZ
+ SNA CLA
+ EXIT CWRI /DO NOTHING IF BUFFER EMPTY
+ TAD RECSIZ
+ DCA I (BSIZE
+ TAD I (OUNIT
+ JMS I QH3 /YES, WRITE OUT BUFFER
+ WRITE /WRITE FROM FIELD 0
+PCOBUF, COBUF /LOCATION COBUF
+ JMP XER7 /OUTPUT ERROR
+ TAD PCOBUF
+ DCA COPTR /BUFFER IS NOW EMPTY
+ TAD RECSIZ
+ CIA
+ DCA COKNT
+ EXIT CWRI
+
+RECSIZ, 0 /RECORD SIZE ON OUTPUT
+COPTR, COBUF /PTS TO NEXT FREE LOCATION IN COBUF
+COKNT, -1000 /NUMBER OF EMPTY SLOTS LEFT IN COBUF
+
+XER7, CIF CDF 10
+ AND (40
+ SZA CLA /CLEAR LEADER?
+ JMP I (ER5 /YES, DEVICE FULL
+ JMP I (ER7 /OUTPUT ERROR
+XER4, CIF CDF 10
+ JMP I (ER4
+XER8, CIF CDF 10
+ JMP I (ER8
+
+LDRFLG, 0 /NON-ZERO IF IGNORING LEADER
+CWTMP1, -1
+CWTMP2, -1
+CWTMP, 0
+QH3, HANDLER
+ PAGE
+\fPREFIN, TAD (200
+ JMS I (CWR2 /WRITE OUT TRAILER
+ JMP CFIN2 /BUT NO CHECKSUM
+CFIN, TAD I (CWTMP2 /V3C
+ JMS I (CWR2
+ TAD I (CWTMP1 /V3C
+ JMS I (CWR2
+CFIN2, JMS I (CWRI
+ TAD I (OUNIT
+XCLOSE, JMS I (CLOSE
+ JMP I (XER8
+XLV, CIF CDF 10
+ JMP I (DECODE
+\fCTRTEM,
+CREAD, 0
+ TAD (OBUFFER
+ DCA BIPTR
+ TAD (-OBUFLEN
+ DCA BIKNT
+ZRLUP, CDF 10
+ DCA I BIPTR /ZERO BUFFER
+ CLA IAC
+ AND I (7643
+ SZA CLA
+ TAD (DCRE-CRE /GOT L OPTION
+ TAD (CRE
+ CDF 0
+ DCA XCRE /PT TO INPUT SUBR
+ INCR BIPTR
+ ISZ BIKNT
+ JMP ZRLUP
+ TAD (OBUFFER
+ DCA BIPTR
+ TAD (-HOBUFLEN
+ DCA BIKNT /# OF DOUBLE-WORDS
+CRLOOP, JMS I XCRE
+ CDF 10
+ DCA I BIPTR
+ JMS I XCRE
+ DCA TEMP2
+ JMS I XCRE
+ DCA TEMP3
+ CDF 10
+ TAD TEMP3
+ RTL
+ RTL
+ AND (7400
+ TAD I BIPTR
+ DCA I BIPTR
+ INCR BIPTR
+ TAD TEMP3
+ RTR
+ RTR
+ RAR
+ AND (7400
+ TAD TEMP2
+ DCA I BIPTR
+ INCR BIPTR
+ ISZ BIKNT
+ JMP CRLOOP /REITERATE
+ CIF CDF 10
+ TAD (MAXBLK
+ DCA I (INTEN /READ 10 BLOCKS
+ EXIT CREAD /ALL DONE
+\fBIPTR, 0 /PTS INTO OBUFFER
+BIKNT, 0
+XCRE, CRE
+
+CTRLC, 0
+ KSF
+ EXIT CTRLC
+ TAD (7600
+ KRS
+ TAD (-7603
+ SZA CLA
+ EXIT CTRLC
+ JMS I (CLEAR
+ TAD I (OUNIT
+ SPA CLA
+ JMP I (7600
+ TAD I (OUNIT
+ DCA CTRTEM
+ STA
+ DCA I (OUNIT
+ TAD CTRTEM
+ JMS I (CLOSE
+ JMP I (XER8
+ JMP I (7600
+\fLOPTION,TAD I (IUNIT
+ JMS I QU3
+ REWIND
+ JMP I (INER
+ CLA IAC
+ DCA I (CIBUF
+LM1, JMP LM2 /ZERO FOR MAGTAPE
+ JMS I QU3
+ SKPFIL
+ JMP I (INER
+LM2, CIF CDF 10
+ JMP I (CHLOOP
+LM3, JMP LM2
+QU3, UTIL
+ PAGE
+\fCIKNT, -1 /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
+CIPTR, CIBUF /PTS TO NEXT BYTE IN CIBUF TO BE READ
+
+CRE, 0
+ CDF 0
+ TAD FTFLG /FIRST TIME THROUGH?
+ SZA CLA
+ JMP FT /YES
+ TAD TLRFLG
+ SNA CLA
+ JMP EPI /TRAILER
+ ISZ CIKNT
+ SKP
+ JMS I (CRED
+ TAD I CIPTR
+ JMS CHKSUM
+ JMS CHKTLR
+ TAD I CIPTR
+ INCR CIPTR
+/ AND (377
+ EXIT CRE
+
+
+/READ DIRECTORY
+DCRE, 0
+ CDF 0
+ ISZ CIKNT
+ SKP
+ JMS DCRED
+ TAD I CIPTR
+ TAD (-32
+ SNA
+ JMP DCRE+1 /ALLOW '32' TO SHORTEN BUFFER
+ TAD (32
+ SNA
+ TAD (232
+ INCR CIPTR
+ EXIT DCRE
+\fFT, DCA FTFLG
+ TAD (200 /SEND LEADER
+ EXIT CRE
+
+CHKSUM, 0
+ DCA CHTEM
+ TAD CHTEM
+ AND (200
+ SNA CLA
+ TAD CHTEM
+ TAD CHECKSUM
+ DCA CHECKSUM
+ EXIT CHKSUM
+CHTEM, 0
+CHECKSUM,0
+FTFLG, 1 /1 IF FIRST TIME HERE
+CHKPTR, CHKTBL
+TLRFLG, 0
+
+CHKTBL, 0 /CHECKSUM LEFT PART
+ 0 /CHECKSUM RIGHT PART
+ 200 /TRAILER
+ 32 /CTRL/Z
+ -1 /TABLE END
+
+CHKTLR, 0
+ CDF 10
+ TAD I (7643
+ CDF 0
+ RTL /B SWITCH TO LINK
+ SNL CLA
+ EXIT CHKTLR
+ TAD I CIPTR
+ TAD (-200
+ SZA CLA
+ EXIT CHKTLR
+ DCA TLRFLG
+ TAD (CHKTBL
+ DCA CHKPTR
+ TAD CHECKSUM
+ RTR
+ RTR
+ RTR
+ AND (77
+ DCA CHKTBL
+ TAD CHECKSUM
+ AND (77
+ DCA CHKTBL+1
+EPI, TAD I CHKPTR
+ SPA
+ JMP I (INTO
+ INCR CHKPTR
+ EXIT CRE
+\fDCRED, 0
+ TAD (40
+ DCA I (BSIZE
+ TAD I PCIBUF
+ SNA CLA
+ JMP I (INTO
+ TAD I (IUNIT
+ JMS I QH4
+ READ
+PCIBUF, CIBUF
+ JMP I (INER
+ TAD PCIBUF
+ DCA CIPTR
+ TAD I CIPTR
+ SZA CLA
+ TAD (-23
+ TAD (-2
+ DCA CIKNT
+ JMS I (FIDDLE
+ TAD I CIPTR
+ SNA CLA
+ EXIT DCRED
+ JMS I QU4
+ SKPFIL
+ JMP I (INER
+ EXIT DCRED
+
+QH4, HANDLER
+QU4, UTIL
+/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
+/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
+/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
+/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
+ PAGE
+\f/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
+
+CONVRT, 0
+ STA
+ TAD I CONVRT
+ DCA ONPTR
+ INCR CONVRT
+ TAD (SINCH
+ DCA CNPTR
+ TAD (-4
+ DCA CKNT
+CONLUP, CDF 10
+ INCR ONPTR
+ TAD I ONPTR
+ CDF 0
+ RTR
+ RTR
+ RTR
+ JMS CNV
+ DCA I CNPTR
+ INCR CNPTR
+ CDF 10
+ TAD I ONPTR
+ CDF 0
+ JMS CNV
+ DCA I CNPTR
+ INCR CNPTR
+ ISZ CKNT
+ JMP CONLUP
+ TAD (40
+ DCA I CNPTR
+ CDF 10
+ TAD I (7643
+ CDF 0
+ RTL
+ SNL CLA
+ EXIT CONVRT / NOT /B
+ CDF 10
+ TAD I (7643
+ RAL
+ CLA
+ TAD I ONPTR
+ CDF 0
+ SZA CLA
+ EXIT CONVRT /EXTENSION SPECIFIED
+ SZL
+ EXIT CONVRT / /A
+ CLL STA RAL
+ TAD CNPTR
+ DCA CNPTR
+ TAD ("B /SET EXTENSION TO .BIN
+ DCA I CNPTR
+ INCR CNPTR
+ TAD ("I
+ DCA I CNPTR
+ INCR CNPTR
+ TAD ("N
+ DCA I CNPTR
+ EXIT CONVRT
+\fCNV, 0
+ AND (77
+ SZA /CHANGE 0 TO BLANK
+ TAD (40
+ AND (77
+ TAD (40
+ EXIT CNV
+
+ONPTR, 0
+CNPTR, 0
+CKNT, 0
+
+LOOK4ME,JMS CONVRT
+ 7606
+ TAD IUNIT
+ JMS I (LOOKUP
+ JMP I (XER4
+ JMP XER24
+ TAD I (INCH+12 /GET H.O. INPUT RECORD SIZE
+ CLL RTR
+ RTR
+ RAR
+ TAD I (INCH+13
+ DCA INRECSZ
+ TAD INRECSZ
+ SNA
+ JMP XER40 /RECORD SIZE 0
+ CLL
+ TAD (-1001
+ SZL CLA
+ JMP XER10
+ CIF CDF 10
+ JMP I (CHLOOP
+
+XER24, CIF CDF 10
+ JMP I (ER24
+XER25, CIF CDF 10
+ JMP I (ER3
+\fOUNIT, 0
+IUNIT, 0
+/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
+/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
+/OUNIT IS -1 DURING A ^C CLOSE
+/-1 MEANS DON'T CLOSE ON ERROR
+INRECSZ,200 /RECORD SIZE ON INPUT
+XER40, CIF CDF 10
+ JMP I (ER40
+XER10, CIF CDF 10
+ JMP I (ER10
+F1CTRLC,0
+ JMS I (CTRLC
+ CIF CDF 10
+ EXIT F1CTRLC
+ PAGE
+\fSINCH, ZBLOCK 16
+ 40;40;40;40;40;40
+ ZBLOCK 14
+INCH, ZBLOCK 40
+
+LDRTST, 0
+ TAD I (CWTMP
+ TAD (-200
+ SNA CLA /LEADER?
+ JMP I (CWREX /YES, EXIT CWR
+ DCA I (LDRFLG /NO
+ EXIT LDRTST
+\fENTERO, TAD (COBUF
+ DCA I (COPTR
+ JMS I (CONVRT
+ 7601
+ JMS I (MAKDAT
+ TAD I (RECSIZ
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ DCA I (SINCH+12
+ TAD I (RECSIZ
+ AND (377
+ DCA I (SINCH+13
+ CDF 10
+ TAD I (FILTYP
+ CDF 0
+ DCA I (SINCH+11
+ DCA I (SINCH+14
+ DCA I (SINCH+15
+ CDF 10
+ TAD I (VRSNO
+ CDF 0
+ DCA I (SINCH+24
+ TAD I (OUNIT
+ JMS I (ENTER
+ JMP I (XER25
+ CIF CDF 10
+ DCA I (OSWITCH
+ JMP I (CONT1
+ PAGE
+\fZOPTION,TAD I (OUNIT
+ JMS I QU5
+ REWIND
+ JMP XER77 /OUTPUT ERROR
+ CDF 10
+ TAD I (7601
+ CDF 0
+ SNA CLA
+ JMP NOFILE
+ JMS I (CONVRT
+ 7601
+ JMS I (LOOKUP
+ JMP I (XER4
+ JMP I (XER24
+ JMS I QU5
+ SKPFIL
+ JMP I (XER24
+ TAD (40
+ DCA I (BSIZE
+ JMS I QH5
+ READ
+ INCH
+ JMP XER77
+CLO3, JMS I (BACK
+ JMP XER77
+ JMS I QH5
+ WRITE
+ ZER
+ JMP XER77
+NOFILE, JMP I (XCLOSE
+\fMAKDAT, 0
+ CDF 10
+ TAD I (DATE
+ CDF 0
+ SNA
+ JMP SETOBL
+ DCA SKNT
+ TAD (SINCH+16
+ DCA SPTR
+ TAD SKNT
+ RTR
+ RAR
+ AND (37
+ JMS TWO /INSERT DAY
+ TAD SKNT
+ RTL
+ RTL
+ RAL
+ AND (17
+ JMS TWO /INSERT MONTH
+ TAD SKNT
+ AND (7
+ TAD (106
+ JMS TWO /INSERT YEAR
+ EXIT MAKDAT
+
+SETOBL, TAD (-6 /SET DATE TO BLANKS
+ DCA SKNT
+ TAD (SINCH+16
+ DCA SPTR
+SELOOP, TAD (40
+ DCA I SPTR
+ INCR SPTR
+ ISZ SKNT
+ JMP SELOOP
+ EXIT MAKDAT
+
+SPTR, 0
+SKNT, 0
+TEM2, 0
+TENS, 0
+\fTWO, 0
+ DCA TEM2
+ TAD (60
+ DCA TENS
+ TAD TEM2
+TWOLUP, TAD (-12
+ SPA
+ JMP NEG
+ INCR TENS
+ JMP TWOLUP
+NEG, TAD (72
+ DCA TEM2
+ TAD TENS
+ DCA I SPTR
+ INCR SPTR
+ TAD TEM2
+ DCA I SPTR
+ INCR SPTR
+ EXIT TWO
+
+XER77, CIF CDF 10
+ JMP I (ER7 /OUTPUT ERROR
+
+QU5, UTIL
+QH5, HANDLER
+\fMHANDLER,0 /AC CONTAINS HANDLER ENTRY ADDRESS
+ CIF 10
+ JMP I (MHAN /KLUDGEY LINK TO FIELD 1
+
+MUTIL, 0 /AC CONTAINS ETC.
+ CIF 10
+ JMP I (MUT
+ PAGE
+\f FIELD 1
+
+ XR=10
+
+ *2000
+
+START, JMP DEC2 /NORMAL STARTING ADDRESS
+CHAIN, JMP NODEC /CHAIN STARTING ADDRESS
+DECODE, STL CLA RAR
+ AND I (7642
+ SZA CLA
+ JMP KBM /RETURN TO KBM ON $
+/ WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
+DEC2, CALL (200
+ 5 /COMMAND DECODE
+ 5200 /USING SPECIAL MODE
+NODEC, TAD (OUTHAND+1
+ DCA ENTR /RESET PTR TO HANDLER LOCATION
+ STA
+ DCA I (OSWITCH
+ JMS I (CHKSW /CHECK FOR SWITCH OPTIONS
+ CDF 0
+ DCA I (OUTSW
+ STA
+ DCA I (OUNIT
+ CDF 10
+ TAD I (7666
+ DCA I (DATE
+FET, TAD I (7600 /GET DEVICE NUMBER OF OUTPUT FILE
+ SNA /WAS ONE SPECIFIED?
+ JMP NOF /NO - NO OUTPUT FILE
+ CALL (200
+ 1 /FETCH HANDLER
+ENTR, OUTHAND+1 /INTO PAGES 2400 AND 2600
+ /REPLACED BY HANDLER STARTING ADDRESS
+ JMP I (ER6 /OUTPUT DEVICE DOESN'T EXIST
+ TAD I (7644
+ AND (1000
+ SZA CLA
+ JMP I (FOXOUT /O SPECIFIED
+ STL CLA RTR
+ AND I (7645
+ TAD I (7601
+ SNA CLA
+ JMP NOCAS /NO OUTPUT NAME
+ TAD (7600
+ JMS I (CHKNAM
+ JMP I (STARER /*.*
+ TAD I (7600
+ JMS I (TCAS /CASSETTE?
+ JMP I (FIXOUT /YES
+ JMP I (FXMOUT /MAGTAPE
+NOCAS, TAD (7601 /NO
+ DCA OBLK /GET PTR TO OUTPUT FILE NAME
+ TAD ENTR
+ DCA I (OENTRY /STORE AWAY OUTPUT HANDLER ENTRY PT
+ TAD (OWRITE
+ DCA PWRITE
+ TAD (FINIO
+ DCA I (XFINIO
+ TAD I (7643
+ RTL
+ SNL CLA
+ JMP NOB
+ TAD I (7604 /GET EXT
+ SZA CLA
+ JMP NOB
+ TAD (216 /SET TO .BN
+ DCA I (7604
+NOB, TAD I (7600 /GET DEVICE NUMBER AGAIN
+ CALL (200
+ 3 /OPEN OUTPUT FILE
+OBLK, 7601 /PTS TO OUTPUT FILE NAME
+ /REPLACED BY STARTING BLOCK NUMBER
+LEN, 0 /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
+ JMP I (ER3 /FILE OPEN ERROR
+ DCA I (REALEN /ZERO REAL LENGTH
+ TAD OBLK
+ DCA I (OBLOCK /SET STARTING BLOCK NUMBER
+CONT1, JMS I (GETIN
+/ INITIALIZE INPUT STUFF
+CHLOOP, CIF CDF 0
+ JMS I (F1CTRLC
+ CALL PREAD
+ CIF CDF 0
+ JMS I (F1CTRLC
+ CALL PWRITE
+ JMP CHLOOP
+\fPREAD, OREAD
+PWRITE, OWRITE
+NOF, STL CLA RTR
+ AND I (7645
+ SNA CLA
+ JMP I (ER1
+ JMP I (FOXOUT /Z IMPLIES O
+
+KBM, CIF CDF 0
+ JMP I (7605
+ PAGE
+\fUDIG, 0
+
+GETSWDIG,0
+ DCA UDIG
+ TAD I (7645
+ AND (1774
+ SNA
+ EXIT GETSWDIG /NO UNIT
+ INCR GETSWDIG
+ RTL
+ RAL
+LUDIG, SZL
+ JMP GOTUD
+ INCR UDIG
+ RAL
+ JMP LUDIG
+G7600,
+GOTUD, 7600
+ TAD UDIG
+ TAD (60
+ EXIT GETSWDIG
+\fFOXOUT, JMS GETSWDIG
+ JMP I (ER1 /NO OUTPUT UNIT
+ JMP GOTOU
+FIXOUT, TAD I (ENTR
+ JMS I (GETDVC
+GOTOU, CDF 0
+ DCA I (OUNIT
+ CDF 10
+ JMS I (SETCAS
+YAHAOU, TAD I (7643
+ AND (400
+ SZA CLA
+ JMP DOPT
+ STL CLA RTR
+ AND I (7645
+ SZA CLA
+ JMP ZOPT
+ TAD I G7600
+ RTR
+ RTR
+ AND (377 /ISOLATE FILE TYPE
+ DCA FILTYP /SAVE IT
+ JMS I (GETLEN
+ TAD (CW
+ DCA I (PWRITE
+ TAD (CFINIO
+ DCA I (XFINIO
+ TAD I (7643
+ RTL /B TO LINK
+ SZL CLA
+ CLA IAC
+ CIF CDF 0
+ DCA I (LDRFLG
+ STA
+ DCA I (CWTMP1
+ STA
+ DCA I (CWTMP2
+ DCA I (CHECKSUM
+ JMP I (ENTERO
+/ RETURN TO CONT1
+
+FXMOUT, TAD I (ENTR
+ CDF 0
+ DCA I (OUNIT
+ CDF 10
+ JMS I (SETMAG
+ TAD I (ENTR /GET LOCATION OF MAGTAPE HANDLER
+ JMS SETDEN
+ JMP YAHAOU
+\fSETDEN, 0
+ AND G7600
+ DCA MTA
+ TAD I (7644
+ AND (10
+ SZA CLA /IS /U SPECIFIED?
+ IAC /YES, USE DENSITY 3
+ TAD (2 /NO, USE DENSITY 2
+ DCA DEN
+ CDF 0
+ TAD PARITY
+ CLL RAR /LINK ON IF PARITY SPECIFIED
+ SZL
+ TAD PAR
+ SNL
+ TAD I MTA /GET RELATIVE LOC 0
+ AND (400 /ISOLATE PARITY
+ TAD DEN /FORCE CORE DUMP MODE
+ DCA I MTA /STORE BACK DENSITY AND PARITY
+ CDF 10
+ JMP I SETDEN
+\fFILTYP, 0
+BINTYP, 0 /SET BINARY TYPE - DON'T TOUCH LINK
+ IAC
+ IAC
+ DCA FILTYP
+ EXIT BINTYP
+
+DOPT, CIF CDF 0
+ JMP I (DOPTION
+
+ZOPT, CIF CDF 0
+ JMP I (ZOPTION
+
+MTA, 0 /FIRST LOC OF MAGTAPE HANDLER
+PARITY, 0 /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
+PAR, 0 /0 OR 400 SPECIFYING PARITY
+DEN, 2 /DENSITY
+ PAGE
+\fFID2, 0
+ TAD I (CIBUF
+ AND (177 /DF=0
+ TAD (-52
+ SNA CLA
+ JMS EMPTY
+ TAD I (CIBUF+10
+ DCA I (CIBUF+11
+ TAD I (CIBUF+7
+ DCA I (CIBUF+10
+ TAD I (CIBUF+6
+ DCA I (CIBUF+7
+ TAD (".
+ DCA I (CIBUF+6
+ CIF 0
+ JMP I FID2
+
+EMPTY, 0
+ TAD I (FAST
+ SNA CLA
+ JMP I EMPTY
+ STA
+ DCA I (CIKNT
+ TAD (32
+ DCA I (CIBUF
+ CIF 0
+ JMP I (FIDLV
+\fGETLEN, 0
+ CLL STA RAR /3777
+ AND I (7642 /GET H.O. OPTION
+ DCA VRSNO
+ TAD I (7646 /GET = OPTION (L.O. 12 BITS)
+ CLL
+ TAD (-1001
+ SZL CLA /LESS THAN 1001?
+ JMP I (ER10 /NO, ERROR
+ TAD I (7646 /YES
+ SNA
+ TAD (200 /200 IS DEFAULT RECORD SIZE
+ CDF 0
+ DCA I (RECSIZ
+ TAD I (RECSIZ
+ CIA
+ DCA I (COKNT
+ CDF 10
+ EXIT GETLEN
+
+FINIO, JMS I (OWRITE
+ TAD I (7600 /GET OUTPUT DEVICE NUMBER
+ CALL (200
+ 4 /CLOSE
+ 7601 /PTR TO FILE NAME
+REALEN, 0 /LENGTH OF NEW OUTPUT FILE
+ JMP ER8 /CLOSE ERROR
+ JMP I (DECODE
+ER8, JMS I (PRINT
+ TEXT /?CLOSE ERROR/
+ER5, JMS I (PRINT
+ TEXT /?OUTPUT DEVICE FULL/
+\fER30, JMS I (PRINT
+ TEXT /?OUT=IN/
+VRSNO, 0
+
+ER6, JMS I (PRINT
+ TEXT /?FETCH ERROR/
+ER24, STA
+ DCA I (SPSWTCH /RETURN FROM PRINT
+ JMS I (PRINT
+ TEXT /?FILE NOT FOUND/
+ ISZ I (FUDSW /FIXUP CASSETTE
+ JMP I (CLO
+ PAGE
+\fOREAD, 0
+ TAD (MAXBLK
+ DCA INTEN /TRY TO READ 10 BLOCKS
+ TAD (MAXBLK^200+10
+ DCA READSZ
+ TAD I (7605
+ AND (17
+ TAD (7757
+ DCA TEMP /GET DCB ADDR
+ TAD I TEMP /GET DCB
+ AND (1000
+ SZA CLA
+ JMP ER4 /INPUT DEVICE IS WRITE-ONLY
+ TAD I TEMP
+ SMA CLA
+ JMP YES /NOT FILE-STRUCTURED
+ TAD I (INLEN
+ TAD (MAXBLK
+ SMA SZA CLA /CAN I READ IN 10 BLOCKS?
+ JMS SHORT /NO
+YES, CIF 0 /YES
+ JMS I IENTRY /CALL INPUT HANDLER
+READSZ, 2010 /READ 20 PAGES INTO FIELD 1
+ OBUFFER /LOCATION 4000
+IBLOCK, 0 /INPUT BLOCK NUMBER
+ JMP QER4 /INPUT ERROR
+ TAD IBLOCK
+ TAD INTEN
+ DCA IBLOCK /UPDATE BLOCK NUMBER
+ TAD I (INLEN
+ TAD INTEN
+ DCA I (INLEN /UPDATE LENGTH LEFT
+ TAD INTEN
+ TAD (-MAXBLK
+ SZA CLA
+ JMP XFIN
+ EXIT OREAD /RETURN
+INTEN, 10 /NUMBER OF BLOCKS JUST READ
+XFINIO, FINIO
+
+SHORT, 0
+ TAD I (INLEN /HOW MANY BLOCKS LEFT?
+ CIA /MAKE POSITIVE
+ DCA INTEN /THAT'S AS MUCH AS WE CAN READ
+ TAD INTEN
+ SNA
+XFIN, JMP I XFINIO /NO MORE
+ CLL RTR
+ RTR
+ RTR /CONVERT TO PAGES IN BITS 1-5
+ TAD (10 /ADD IN FIELD 1 BIT
+ DCA READSZ
+ EXIT SHORT /RETURN
+\fIENTRY, 0 /PTS TO INPUT HANDLER ENTRY POINT
+QER4, SMA CLA
+ JMP SFIN /NON-FATAL END-OF FILE
+ER4, JMS I (PRINT
+ TEXT /?INPUT ERROR/
+ER26, JMS I (PRINT
+ TEXT /?TOO MANY FILES/
+SFIN, TAD (7600
+ DCA TPTR
+SLUP, STA
+ TAD TPTR
+ DCA TPTR
+ TAD I TPTR
+ SNA CLA
+ JMP SLUP
+ TAD TPTR
+ TAD (-OBUFFER+1
+ SNA
+ JMP ALLZ
+ TAD (377 /CHANGED FROM PIPC'S 376
+ CLL RTL
+ RTL
+ RAL
+ AND (17
+ DCA INTEN
+ JMP XFIN
+ALLZ, CLA IAC
+ JMP .-3
+TPTR, 0
+\fER3, JMS I (PRINT
+ TEXT /?ENTER ERROR/
+ PAGE
+\fGETIN, 0 /OPEN INPUT FILE
+ DCA DATE
+ TAD I (7605 /ANY MORE FILES SPECIFIED?
+ SNA CLA
+ JMP NOIN /NO
+ TAD I (7612
+ SZA CLA
+ JMP I (ER26 /2ND INPUT FILE IS BAD
+ TAD (7605
+ JMS I (CHKNAM
+ JMP I (STARER /*.*
+ TAD (7606
+ DCA IN /SET PTR TO FILE NAME
+ TAD (INHAND+1
+ DCA IN3
+ TAD I (7605 /GET DEVICE NUMBER
+ CALL (200
+ 1 /FETCH NEW DEVICE HANDLER
+IN3, INHAND+1 /INTO PAGES 3200 AND 3400
+ /REPLACED BY ENTRY PT TO INPUT HANDLER
+ JMP I (ER6 /FETCH ERROR
+ TAD I (7643
+ AND (10
+ SZA CLA
+ JMP I (FOXIN /I SPECIFIED
+ CLA IAC /V3C
+ AND I (7643 /LOOK AT /L OPTION
+ TAD I (7606
+ SNA CLA
+ JMP NOCAS2
+/IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
+/MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
+/A NON-FILE-STRUCTURED OS/8 DRIVER.
+ TAD I (7605
+ JMS I (TCAS /CASSETTE?
+ JMP I (FIXIN /YES
+ JMP I (FIXMIN /MAGTAPE
+NOCAS2, CLA IAC
+ AND I (7643
+ SZA CLA
+ JMP ER11 /V3C /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
+ TAD (OREAD
+ DCA I (PREAD
+ TAD IN3 /GET NEW HANDLER ENTRY PT
+ DCA I (IENTRY /STORE AWAY
+ TAD I (7605 /GET DEVICE NUMBER AGAIN
+ CALL (200
+ 2 /PERFORM A LOOKUP
+IN, 0 /PTR TO FILE NAME
+ /REPLACED BY INPUT BLOCK NUMBER
+IN2, 0 /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
+ JMP LKERR /LOOKUP ERROR
+ TAD IN /GET NEW INPUT BLOCK
+ DCA I (IBLOCK /STORE AWAY
+ TAD IN2 /GET NEW INPUT FILE LENGTH
+ DCA INLEN
+ TAD I (1404 /GET # OF ADDITIONAL WORDS
+ SNA
+ JMP NONE
+ TAD 17
+ DCA POINTER
+ TAD I POINTER /GET FILE CREATION DATE
+ SNA
+ JMP NONE
+SETDAT, DCA DATE
+ EXIT GETIN
+NONE, TAD I (7666 /USE TODAY'S DATE
+ JMP SETDAT
+LKERR, CLA
+ TAD I (7611
+ SZA CLA
+ JMP I (ER24 /FILE NOT FOUND
+ TAD I (7643 /TRY .BN
+ RTL
+ SNL CLA
+ JMP I (ER24 / NOT /B
+ TAD (216
+ DCA I (7611
+ JMP GETIN+1
+
+INLEN, 0
+DATE, 0 /OS8 DATE OF INPUT FILE
+POINTER,0
+
+NOIN, CLA IAC
+ AND I (7643
+ SNA CLA
+ JMP I (ER21
+ JMP I (FOXIN / /L SPECIFIED
+\fER11, JMS I (PRINT /V3C
+ TEXT /?L OPTION OUT OF CONTEXT/
+ PAGE
+\f/ENTER WITH INTEN BLOCKS TO WRITE
+OWRITE, 0
+ TAD I (INTEN /HOW MUCH IS THERE TO WRITE?
+ SNA
+ EXIT OWRITE /NOTHING
+ DCA OUTEN /SAVE NUMBER OF BLOCKS TO WRITE
+ TAD I (7600
+ AND (17
+ TAD (7757
+ DCA TEMP
+ STL CLA RTR
+ AND I TEMP
+ SZA CLA
+ JMP I (ER7 /OUTPUT DEVICE IS READ-ONLY
+ TAD OUTEN
+ CLL RTR
+ RTR
+ RTR /CONVERT TO PAGES
+ TAD (4010 /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
+ DCA WRSIZ
+ TAD I (LEN
+ SNA CLA
+ JMP NFS /NON-FILE STRUCTURED
+ TAD I (REALEN
+ TAD OUTEN
+ STL
+ TAD I (LEN
+ SNL SZA CLA
+ JMP I (ER5
+NFS, CIF 0
+ JMS I OENTRY /CALL OUTPUT HANDLER
+WRSIZ, 6010 /WRITE 20 PAGES FROM FIELD 1
+ OBUFFER /LOCATION 4000
+OBLOCK, 0 /OUTPUT BLOCK NUMBER
+ JMP I (ER7 /OUTPUT ERROR
+ TAD OBLOCK
+ TAD OUTEN
+ DCA OBLOCK /UPDATE OUTPUT BLOCK NUMBER
+ TAD I (REALEN
+ TAD OUTEN
+ DCA I (REALEN /UPDATE LENGTH WROTE
+ EXIT OWRITE
+
+OENTRY, 0
+OUTEN, 0
+\fFOXIN, JMS I (GETSWDIG
+ JMP I (ER21
+ JMP GOTIU
+FIXIN, TAD I (IN3 /GET INPUT HANDLER ADDRESS
+ JMS I (GETDVC
+GOTIU, CDF 0
+ DCA I (IUNIT
+ CDF 10
+ JMS I (SETCAS
+YAHAIN, CDF 0
+ TAD I (OUNIT
+ CIA
+ TAD I (IUNIT
+ SNA CLA
+ JMP I (ER30
+ STA
+ DCA I (CIKNT
+ DCA I (CHECKSUM
+ CLA IAC
+ DCA I (TLRFLG
+ CDF 10
+ TAD (CR
+ DCA I (PREAD
+ TAD I (7643
+ RTL
+ CLA RAL
+ CDF 0
+ DCA I (FTFLG
+ CDF 10
+ JMS I (GETLEN
+ TAD I (7643
+ AND (100 / F OPTION?
+ CDF 0
+ DCA I (FAST
+ CDF 10
+ CLA IAC
+ AND I (7643
+ CIF CDF 0
+ SZA CLA
+ JMP I (LOPTION
+ JMP I (LOOK4ME
+/RETURN TO CHLOOP
+\fFIXMIN, TAD I (IN3
+ CDF 0
+ DCA I (IUNIT
+ CDF 10
+ JMS I (SETMAG
+ TAD I (IN3
+ JMS I (SETDEN
+ JMP YAHAIN
+ PAGE
+\fPRINT, 0
+ CLA
+ CDF 10
+ DCA CTOFLG /ALLOW ECHOING
+ JMS CRLF
+PRLUP, TAD I PRINT
+ RTR
+ RTR
+ RTR
+ JMS PRIN
+ TAD I PRINT
+ JMS PRIN
+ INCR PRINT
+ JMP PRLUP
+
+PRIN, 0
+ AND (77
+ SNA
+ JMP PRFIN
+ TAD (240
+ AND (77
+ TAD (240
+ DCA TM
+ KSF
+ JMP NOBOTH
+ TAD (200
+ KRS
+ TAD (-203
+ SNA
+ JMP KBM2
+ TAD (203-217
+ SZA CLA
+ JMP NOBOTH
+ TAD ("^
+ JMS TYPE
+ TAD ("O
+ JMS TYPE
+ JMS CRLF
+ ISZ CTOFLG
+NOBOTH, TAD TM
+ JMS TYPE
+ EXIT PRIN
+PRFIN, JMS CRLF
+ DCA FUDSW
+ TAD I (SPSWTCH
+ SNA CLA
+ JMP CLO
+ DCA I (SPSWTCH /SWITCH NON-ZERO MEANS RETURN
+ INCR PRINT /POINT TO RETURN
+ JMP I PRINT
+\f/DO A CLOSE IF OUTPUT CASSETTE OPEN
+CLO, CDF 0
+ TAD I (OUNIT
+ CDF 10
+ SPA CLA
+ JMP I (DECODE
+ TAD OSWITCH
+ SZA CLA
+ JMP I (DECODE
+ CDF 0
+ TAD I (OUTSW
+ CDF 10
+ SNA CLA /DID WE WRITE ON OUTPUT CASSETTE?
+ JMP I (DECODE /NO
+ CIF CDF 0
+ TAD I (OUNIT
+ DCA TEMP
+ STA
+ DCA I (OUNIT
+ TAD FUDSW
+ SZA CLA
+ JMP I (CLO3
+ TAD TEMP
+ JMP I (XCLOSE
+OSWITCH,-1 /0 MEANS OUTPUT CASSETTE OPEN
+
+KBM2, CIF CDF 0
+ JMP I L7600 /RETURN TO OS/8
+
+FUDSW, 0 /1 MEANS GOT OS/8 LOOKUP FAILURE
+\fTYPE, 0
+ DCA TM
+ TAD CTOFLG
+ SZA CLA
+ EXIT TYPE /NOT ECHOING
+ TAD TM
+ TLS
+ TSF
+ JMP .-1
+L7600, 7600
+ EXIT TYPE
+
+CRLF, 0
+ TAD (215
+ JMS TYPE
+ TAD (212
+ JMS TYPE
+ EXIT CRLF
+
+CTOFLG, 0 /1 MEANS DON'T ECHO
+TM, 0
+
+ER7, JMS PRINT
+ TEXT /?OUTPUT ERROR/
+
+CFINIO, CIF CDF 0
+ JMS I (CWRITE
+ CIF CDF 0
+ JMP I (CFIN /FINISH OUTPUT AND WRITE SENTINEL
+/RETURN TO DECODE
+ PAGE
+\fER10, JMS I (PRINT
+ TEXT /?RECORD SIZE TOO BIG/
+/ENTRY POINT REL 1: UNIT 1
+/ENTRY POINT REL 7: UNIT 0
+
+GETDVC, 0
+ IAC
+ DCA TEMP
+ STL CLA RTL /2
+ AND TEMP
+ RAR
+ DCA UNIT /DETERMINE IF UNIT 0 OR 1
+ TAD TEMP
+ AND (7600
+ DCA TEMP
+ CDF 0
+LOOKIO, ISZ TEMP
+ TAD I TEMP /SEARCH HANDLER FOR ANY IOT
+ AND (7700
+ TAD (-6700
+ SZA CLA
+ JMP LOOKIO
+ TAD I TEMP /GET CASSETETE IOT
+ CDF 10
+ AND (30 /V3 BUG FIX FROM V2
+ CLL RTR
+ TAD UNIT
+ TAD (60
+ EXIT GETDVC /LEAVE IT IN AC
+
+UNIT, 0
+\fCHKNAM, 0 /DON'T ALLOW *'S OR ?'S
+ DCA XR /IN OUTPUT OR INPUT NAME
+ TAD I XR
+ TAD (-5200
+ SNA
+ JMP STARNM /ENTIRE NAME IS *
+ TAD (5200
+ JMS CHKSTR
+ TAD I XR
+ JMS CHKSTR
+ TAD I XR
+ JMS CHKSTR
+ TAD I XR
+ JMS CHKSTR
+ ISZ CHKNAM
+ JMP I CHKNAM /NAME GOOD, RETURN 2
+
+CHKSTR, 0
+ DCA TEM
+ TAD TEM
+ CLL RTR
+ RTR
+ RTR
+ JMS CHC
+ TAD TEM
+ JMS CHC
+ JMP I CHKSTR
+\fCHC, 0
+ AND (77
+ TAD (-52
+ SNA
+ JMP STARER /* IN NAME
+ TAD (52-77
+ SZA CLA
+ JMP I CHC /OKAY
+STARER, JMS I (PRINT
+ TEXT /?ILLEGAL * OR ?/
+
+STARNM, ISZ XR
+ ISZ XR
+ TAD I XR
+ TAD (-5200
+ SZA CLA
+ JMP STARER /NOT *.*
+ JMP I CHKNAM /TAKE SPECIAL RETURN ON *.*
+
+TEM, 0
+\fCHKSW, 0 /CHECK SWITCHES
+ TAD I (7644
+ AND (4 /CHECK FOR /V
+ SZA CLA
+ JMS I (VERSN /PRINT MCPIP VERSION #
+ TAD I (7644
+ AND (400 /CHECK FOR /P
+ /NOTE /P = 400 SAME AS ODD PARITY CODE
+ SZA
+ JMP ODDPAR
+ TAD I (7643
+ AND (200 /CHECK FOR /E
+ SZA CLA
+ JMP EVPAR
+GOTP, NOP
+ JMP I CHKSW
+
+ODDPAR, /400 IN AC
+EVPAR, DCA I (PAR
+ CLA IAC
+ DCA I (PARITY
+ JMP GOTP
+ PAGE
+\fSPSWTCH,0 /NON-ZERO MEANS RETURN FROM PRINT
+
+/RET 1: CASSETTE
+/RET 2: MAGTAPE
+/RET 3: NEITHER
+
+TCAS, 0
+ AND (17 /ISOLATE
+ TAD (7757 /ADD IN BASE OF DCB TABLE
+ DCA TEMP /TO GET DCB ADDRESS
+ TAD I TEMP /GET DCB
+ AND (770 /ISOLATE UNIT TYPE
+ TAD (-270 /CASSETTE HANDLER TYPE IS 27
+ SNA
+ JMP ITSCAS
+ TAD (270-200
+ SZA CLA
+ INCR TCAS /NOTHING SPECIAL
+ INCR TCAS /MAGTAPE
+ITSCAS, EXIT TCAS
+\fVERSN, 0
+ STA
+ DCA SPSWTCH /RETURN FROM PRINT
+ JMS I (PRINT
+ TEXT \OS/8 MCPIP V\
+ *.-1
+ PIPVERSION+60^100+PATCHLEV
+ 0
+ JMP I VERSN
+
+ER1, TAD I (7605
+ SNA CLA
+ JMP I (DECODE /NO OUT AND NO IN
+ CLA IAC
+ AND I (7643 /WAS /L SPECIFIED?
+ SZA CLA
+ JMP SETTY /YES
+ JMS I (PRINT
+ TEXT /?NO OUTPUT FILE/
+ER40, JMS I (PRINT
+ TEXT /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
+\fSETTY, TAD (3100
+ DCA Y
+ JMS I (200
+ 12 /INQUIRE
+TT, 2424
+Y, 3100 /DEVICE TTY
+ 0
+ JMP ER99
+ TAD Y /GET DEVICE NO. OF TTY:
+ DCA I (7600
+ JMP I (FET
+
+ER99, JMS I (PRINT
+ TEXT /?TTY DOES NOT EXIST/
+ER21, JMS I (PRINT
+ TEXT /?NO INPUT FILE/
+\fCW, 0
+ CIF CDF 0
+ JMS I (CWRITE
+ EXIT CW
+
+CR, 0
+ CIF CDF 0
+ JMS I (CREAD
+ EXIT CR
+ PAGE
+\fSETCAS, 0
+ TAD (UTIL
+ JMS SETU
+ TAD (HANDLER
+ JMS SETH
+ CDF 0
+ TAD (BACKFIL
+ DCA I (BK2
+ TAD I (BK4
+ DCA I (BK3
+ TAD (254
+ DCA I (EOFBIT
+ TAD I (FL3
+ DCA I (FL1
+ TAD (314
+ DCA I (EOTBIT
+ TAD I (LM3
+ DCA I (LM1
+ CDF 10
+ JMP I SETCAS
+
+SETMAG, 0
+ TAD (MUTIL
+ JMS SETU
+ TAD (MHANDLER
+ JMS SETH
+ CDF 0
+ TAD (BACKBLOCK
+ DCA I (BK2
+ TAD I (BK1
+ DCA I (BK3
+ TAD (3673
+ DCA I (EOFBIT
+ DCA I (FL1
+ TAD (3663
+ DCA I (EOTBIT
+ DCA I (LM1
+ CDF 10
+ JMP I SETMAG
+\fSETU, 0
+ DCA SETH
+ CDF 0
+ TAD SETH
+ DCA I (QU1
+ TAD SETH
+ DCA I (QU2
+ TAD SETH
+ DCA I (QU3
+ TAD SETH
+ DCA I (QU4
+ TAD SETH
+ DCA I (QU5
+ CDF 10
+ JMP I SETU
+\fSETH, 0
+ DCA SETU
+ CDF 0
+ TAD SETU
+ DCA I (QH1
+ TAD SETU
+ DCA I (QH2
+ TAD SETU
+ DCA I (QH3
+ TAD SETU
+ DCA I (QH4
+ TAD SETU
+ DCA I (QH5
+ CDF 10
+ JMP I SETH
+ PAGE
+\fMH, 0
+
+MHAN, SZA
+ DCA MENTRY
+ TAD I (MHANDLER
+ DCA MH /PICK UP ARGS VIA MH
+ TAD I MH /GET FN WORD
+ TAD (SPCODE /ADD SPECIAL CODE
+ DCA MARG1
+ ISZ MH
+ TAD I MH /GET CORE LOC
+ DCA MARG2
+ ISZ MH /PT TO ERROR RETURN
+ TAD I (BSIZE /GET BLOCKSIZE
+ CIA
+ DCA MARG3 /STORE NEG
+ CDF 10
+ CIF 0
+ JMS I MENTRY /CALL MAGTAPE HANDLER
+MARG1, HLT
+MARG2, HLT
+MARG3, HLT
+ SKP /TAKE ERROR RETURN
+ ISZ MH /NORMAL RETURN
+ CIF CDF 0
+ JMP I MH /GO BACK TO FIELD 0
+
+MENTRY, 0
+\fMU, 0
+
+MUT, SZA
+ DCA MENTRY /DF=0
+ TAD I (MUTIL /PICK UP ARGS
+ DCA MU /VIA 'MU'
+ TAD I MU /GET UTILITY FUNCTION
+ ISZ MU
+ CDF 10
+ TAD (-REWIND
+ SNA
+ JMP REWT
+ TAD (REWIND-BACKFIL
+ SNA
+ JMP BAKFT
+ TAD (BACKFIL-WRGAP
+ SNA
+ JMP WRGT
+ TAD (WRGAP-BACKBLOCK
+ SNA
+ JMP BAKBT
+ TAD (BACKBLOCK-SKPFIL
+ SZA CLA
+ HLT /IMPOSSIBLE
+SKPFT, STL CLA RAR /4000=WRITE
+BAKFT, TAD (WRITE+FICODE-REWCOD
+REWT, TAD (REWCOD-EOCODE
+WRGT, TAD (EOCODE-RECCOD-WRITE
+BAKBT, TAD (RECCOD+WRITE
+ DCA MRG1
+ CIF 0
+ JMS I MENTRY
+MRG1, HLT
+MCA, HLT /IRRELEVANT
+MWC, -1
+ SKP /ERROR RETURN
+ ISZ MU
+ CIF CDF 0
+ JMP I MU /RETURN
+\fEMPTINCH,52;105;115;120;124;131;40;40;40;14
+ 0;0;0;0;40;40;40;40;40;40
+ ZBLOCK 14
+ PAGE
+\f *2000
+ $
--- /dev/null
+/2 PAL8 ASSEMBLER FOR OS/8 MONITOR VERSION 10
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1-OCT-75 MB/MB/SM/MB/RL/JR/SR
+
+DECIMAL
+
+VERSION= 10
+SUBVERSION= "A
+
+OCTAL
+
+/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED
+/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
+
+/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
+/THE SYMBOL TABLE.
+
+/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
+/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.
+
+/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
+/LISTING.
+
+/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
+/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.
+
+ IFNDEF HASH<HASH=1> /DEFINE FOR HASH SYMBOL TABLE
+/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
+/2. ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
+/3. PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
+/4. FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
+/5. ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
+/6. FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
+/7. FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
+/8. FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
+/9. CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
+/10. ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
+/11. CORE ALLOCATION:
+/ WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
+/ WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
+/ UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
+/12. /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
+/13. 14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE
+
+/JR 14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
+\f/COMMAND DECODER RULES:
+
+/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS
+
+/OPTIONS:
+/B BYTE SHIFT - ! IS 6 BIT SHIFT (!=^100+)
+/C CREF AFTER - "CREFLS.TM" CREATED IF NO CREF
+/D DDT TYPE SYMBOL - ONLY IF LISTING
+/E 'LG' ERROR - LINKS ARE ERRORS
+/F NO TEXT FILL - NO EXTRA 0 FILL IN 'TEXT'
+/G LOAD+GO AFTER - SAME AS /L, BUT /G PASSED TO ABSLDR
+/H NO PAGING - ONLY IF LISTING
+/J JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE
+/K CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
+/L LOAD AFTER - "PAL8BN.TM" CREATED IF NO BINARY
+/N NO LISTING - ONLY IF LISTING
+/O NO 200 ORG - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
+/S NO SYMBOL TABLE - ONLY IF LISTING
+/T CR-LF NOT FF - ONLY IF LISTING
+/W WIPE LITERALS - INHIBITS REMEMBERING OF LITERAL BOUNDS
+
+/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
+/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
+/TO REVERSE THE POLARITY OF THE "T" SWITCH.
+
+/PSEUDO-OPS:
+/DECIMAL RADIX TO BASE 10
+/DEVICE 2 WORD DEVICE CODE
+/DTORG TYPESETTING TAPE ORIGIN
+/EJECT SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
+/ THAT TEXT BECOMES THE NEW HEADER LINE
+/ENPUNCH ENABLE PUNCHING
+/EXPUNGE REMOVE ALL SYMBOLS
+/FIELD SET FIELD
+/FILENAME 4 WORD FILE CODE
+/FIXMRI DEFINE MEMORY REFERENCE INSTRUCTION
+/FIXTAB MAKE ALL SYMBOLS PERMANENT
+/IFDEF CONDITIONAL ON DEFINITION
+/IFNDEF CONDITIONAL ON UNDEFINED
+/IFNZRO CONDITIONAL ON NON-ZERO
+/IFZERO CONDITIONAL ON ZERO
+/NOPUNCH DISABLE PUNCHING
+/OCTAL RADIX TO BASE 8
+/PAGE RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
+/PAUSE ALTERNATE END-OF-FILE
+/RELOC ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
+/TEXT 6 BIT TEXT
+/XLIST LISTING INHIBIT UNLESS THE XLIST IS
+/ FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
+/ IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
+/ZBLOCK RESERVE BLOCK OF ZEROS
+\f/SYMBOL LAYOUT:
+
+/ WORD 1 BIT 0=1 PERMANENT SYMBOL
+/ BIT 1=1 "I" OR "Z"
+/ BITS 3-11 CHARS 1 AND 2
+/
+/ WORD 2 BIT 0=1 MEMORY REFERENCE INSTRUCTION
+/ BITS 2-11 CHARS 3 AND 4
+/
+/ WORD 3 BIT 0=1 PSEUDO-OP
+/ BITS 2-11 CHARS 5 AND 6
+/
+/ WORD 4 BITS 0-11 OCTAL VALUE
+/CHARS ARE STORED AS:
+/ A TO Z ARE 01 TO 32
+/ 0 TO 9 ARE 33 TO 44
+/
+/ CHAR1^45+CHAR2
+
+/OPERATORS:
+/+ TWO'S COMPLEMENT ADD
+/- TWO'S COMPLEMENT SUBTRACT
+/& BOOLEAN AND
+/! BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
+/ (SPACE) DELIMITER OR INCLUSIVE OR
+/^ MULTIPLY (REPEATED ADDITION)
+/% DIVIDE (REPEATED SUBTRACTION)
+\f/DEFINITIONS
+
+ASWAP= 40 /WATCH THIS SWAP AREA!!
+MDATE= 7666 /MONITOR DATE
+BIPCCL= 7777 /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
+MPARAM= 7643 /COMMAND DECODER OPTION LIST
+DCB= 7760 /DEVICE CONTROL BLOCK
+JSBITS= 7746 /JOB STATUS WORD
+BATOUT= 7400 /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
+LNPRPG= 70 /56 LINES PER PAGE
+HEDLEN= 50 /40 CHARACTERS IN PAGE TITLE
+ /(MUST BE A MULTIPLE OF 8)
+
+AC7776= STA CLL RAL
+AC7775= STA CLL RTL
+AC4000= STL CLA RAR
+AC3777= STA CLL RAR
+AC2000= STL CLA RTR
+AC0002= STL CLA RTL
+
+
+/TABLE OF ERROR MESSAGE DEFINITIONS
+
+
+IZ= "I-240^100+"Z-240 /ILLEGAL PAGE ZERO REFERENCE
+CF= "C-240^100+"F-240 /CREF.SV NOT FOUND
+US= "U-240^100+"S-240 /UNDEFINED SYMBOL
+IP= "I-240^100+"P-240 /ILLEGAL PSEUDO-OP USAGE
+SE= "S-240^100+"E-240 /SYMBOL TABLE EXCEEDED
+ZE= "Z-240^100+"E-240 /PAGE ZERO EXCEEDED
+PE= "P-240^100+"E-240 /CURRENT PAGE EXCEEDED
+IC= "I-240^100+"C-240 /ILLEGAL CHARACTER
+ID= "I-240^100+"D-240 /ILLEGAL DEFINITION
+BE= "B-240^100+"E-240 /PUSH-DOWN OVERFLOW
+DE= "D-240^100+"E-240 /DEVICE ERROR
+DF= "D-240^100+"F-240 /DEVICE FULL
+LD= "L-240^100+"D-240 /ABSLDR.SV NOT FOUND
+IE= "I-240^100+"E-240 /ILLEGAL EQUATE
+PH= "P-240^100+"H-240 /PHASE ERROR
+II= "I-240^100+"I-240 /ILLEGAL INDIRECT
+RD= "R-240^100+"D-240 /REDEFINITION
+UO= "U-240^100+"O-240 /UNDEFINED ORIGIN
+LG= "L-240^100+"G-240 /LINK GENERATED
+
+
+
+/ABBREVIATIONS
+/CR/LF CARRIAGE RETURN/LINE FEED (215,212)
+/F/F FORM FEED (214)
+\f/PAGE ZERO
+
+*0
+FORMF6, 0 /USED IN DECIMAL PRINT ROUTINE
+ERROR5, 0 /USED BY PACKED ASCII PRINT ROUTINE
+PTR, 0 /V3C USED BY
+KNTR, 0 /INPUT ROUTINE
+
+/AUTOINDEX REGISTERS
+/PRESET FOR ONCE ONLY CODE
+
+*10
+PDLXR, PDLST /PUSH-DOWN AUTO INDEX REGISTER
+TAGXR, SWAP1-1 /TAG AUTO INDEX REGISTER
+XREG1, DSWIT1-1 /GENERAL AUTO INDEX REGISTER
+XREG2, DSWIT2-1 /GENERAL AUTO INDEX REGISTER
+
+/NOT USED AS AUTO INDEX REGISTERS
+/EXCEPT DURING ONCE ONLY CODE
+
+LAST1, DATE-1 /LAST DEFINED SYMBOL
+LAST2, SWAP2-1
+LAST3, IFZERO HASH <SYMPRT+4-1>
+ IFNZRO HASH <SYMNWP-1>
+LAST4, IFZERO HASH <SYMPR9-2-1>
+ IFNZRO HASH <SYMDDT-1>
+
+*20
+TAG1, 0 /TAG STORAGE
+TAG2, 0
+TAG3, 0
+
+LITPTR, 200 /LITERAL POINTER
+
+RADIX, 0 /7777 IF DECIMAL MODE
+PUNCHX, 0 /NON-ZERO IF NO PUNCHING
+XLISTX, 0 /NON-ZERO IF NO LISTING
+/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
+/AND IN THIS ORDER
+
+LOC, 200 /CURRENT LOCATION
+OFFSET, 0 /LOCATION COUNTER OFFSET FROM "LOC"
+OFSBUF, 0 /LOCATION COUNTER OFFSET BUFFER
+STARSW, 0 /-1 IF NEXT ORIGIN SHOULD BE INHIBITED
+
+OP, 0 /LAST OPERATOR CODE (0-6)
+VALUE, 0 /EXPRESSION VALUE
+VALUE2, 0 /EXPRESSION OPERAND
+
+TXTSWT, 0 /SPACE SWITCH
+TXTPTR, LINBUF+120 /TEXT POINTER
+CHAR, 0 /CURRENT CHARACTER
+
+THISPG, 0 /OVERFLOW PAGE
+EDITPG, 0 /EDITOR PAGE
+\fTEMP, 0 /TEMPORARY REGISTERS
+TEMP1, 0
+TEMP2, 0
+TEMP3, 0
+
+OCHAR, OUTPUT /OUTPUT ROUTINE
+OERROR, OTYPEO /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
+PASS, -2 /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
+IOMON, 200 /USER SERVICE ROUTINES
+CONDSW, 0 /NUMBER OF NESTED CONDITIONALS
+EXPIND, 0 /0 IF MRI OK HERE
+ /NOT 0 IF MRI NOT OK HERE
+CHKSUM, 0 /BINARY CHECK SUM
+IZIND, 0 /"I" AND "Z" INDICATOR
+ /IF I, LEFT 6 BITS ARE NON-ZERO
+ /IF Z, RIGHT 6 BITS ARE NON-ZERO
+THISTG, 0 /ASSIGNED NUMBER OF CURRENT TAG
+HIGHTG, SYME-SYMS%4-1 /ASSIGNED NUMBER OF LAST TAG
+LINCNT, 0 /LINE COUNT
+ALPHAI, 0 /UNDEFINED TAG INDICATOR
+ /-1 IF UNDEFINED
+GETCI, 0 /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
+ /OTHERWISE /,;, OR CARRIAGE RETURN ENDS
+LSTCNT, 0 /TAB COUNTER
+UNDFSW, 0 /UNDEFINED SWITCH
+INCTL, 601 /CONTROL WORD - FOR OS/8 I/O
+LINKSW, 0 /OFF-PAGE LINK SWITCH
+ /0 IF NO LINK GENERATED, 0700 IF LINK
+LININD, 0 /BACK-UP FOR LINKSW
+PERROR, PERRO1 /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
+ /MESSAGES DURING PASS 1
+FLDIND, "0 /CURRENT FIELD IN ASCII DIGIT FORM
+BINSRT, 0 /BINARY OR LISTING STARTING
+ERCNT, 0 /ERROR COUNTER
+LINK, 0 /LINK COUNTER
+ IFNZRO HASH<
+TAGMAX, 0 /SET TO PRIME # EQ TO MAX # SYMS
+ >
+ PAGE
+\f/STARTING ADDRESS OF PAL8 (0200)
+/CHAINING ADDRESS (0201)
+
+NAME1, JMP I NAME3 /NAME1-NAME3 USED LATER
+NAME2, JMP I GETTA2 /TO STORE TAGS AS THEY ARE BUILT
+NAME3, BEGIN /V3C
+GETTA2, NOCD /BUILDING SWITCH AND OVERFLOW PROTECT
+
+
+/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS
+
+NOPUNX, CLA IAC /NON-ZERO FOR NO PUNCHING
+ENPUNX, DCA PUNCHX /ZERO FOR PUNCHING
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+
+/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS
+
+DECIMX, STA /7777 FOR DECIMAL RADIX
+OCTALX, DCA RADIX /ZERO FOR OCTAL RADIX
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\f/GET A TAG ROUTINE
+/PICKS UP A TAG AND SEARCHES FOR IT
+/"THISTG" HAS NUMBER OF TAG
+/"VALUE2" HAS VALUE
+/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND
+
+GETTAG, 0
+ DCA NAME1 /CLEAR BUILD AREA
+ DCA NAME2
+ DCA NAME3
+ TAD [NAME1
+ DCA GETTA4 /SET POINTER FOR BUILDING
+ DCA GETTA2 /ZERO SWITCH
+GETTG1, TAD CHAR /GET THE CHARACTER
+ AND [77 /MAKE IT 01-32 OR 60-71
+ TAD (-32 /WAS IT A TO Z?
+ SMA SZA
+ TAD (-25 /NO - MAKE 60-71 INTO 33-44
+ TAD (32 /YES - IT IS NOW 01-32 OR 33-44
+ ISZ GETTA2 /LEFT SIDE?
+ JMP GETTA3 /YES
+ TAD I GETTA4 /NO - RIGHT SIDE
+ DCA I GETTA4 /BUILD THE WORD
+ ISZ GETTA4 /BUMP TO NEXT WORD
+GETTA1, JMS I [GETC /GET NEXT CHARACTER
+ JMS I [TSTALN /IS IT ALPHANUMERIC?
+ JMP GETTG1 /YES - KEEP BUILDING
+ IFZERO HASH<
+ TAD HIGHTG /NO - GET NUMBER OF HIGHEST TAG
+ CLL RAR /DIVIDE BY 2
+ DCA TEMP2 /SAVE DIFFERENCE
+ DCA THISTG /START AT TAG ZERO
+ CLL CML /LINK MUST BE ON INITIALLY
+ DCA TEMP1
+
+
+/GETTA4 IS POINTER TO NAME1-NAME3
+/FOR DEPOSITING TAG AS IT IS BUILT
+
+/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
+/DURING BINARY SEARCHING
+\fGETTG2, SZL /IS THISTG HIGHER THAN TAG?
+ JMP GETTG3 /NO-LOWER
+GETTG4, DCA TEMP1 /CLEAR LAST TIME SWITCH
+ SNL
+ ISZ TEMP1 /SET LAST TIME SWITCH TO 1
+ TAD TEMP2 /GET # OF TAGS TO SKIP
+ SNL
+ CIA
+ TAD THISTG /INCREASE OR DECREASE TAG NUMBER
+ DCA THISTG
+ TAD TEMP2 /GET NUMBER
+ CLL RAR /DIVIDE BY 2
+ SNA /IS RESULT 0?
+ ISZ TEMP1 /YES-BUMP LAST TIME SWITCH
+ SNA
+ IAC /IF RESULT WAS 1, MAKE IT 2
+ DCA TEMP2 /SAVE IT FOR NEXT TIME
+ JMS I [FINDTG /GET THE TAG
+ TAD [1777 /MASK
+ AND TAG1 /GET WORD 1
+ CLL CIA
+ TAD NAME1 /DOES IT MATCH?
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ AC3777
+ AND TAG2 /YES - GET WORD 2
+ CLL CIA
+ TAD NAME2 /DOES IT MATCH?
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ AC3777
+ AND TAG3 /YES - DOES IT MATCH?
+ CLL CIA
+ TAD NAME3
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ JMP I GETTAG /YES--RETURN--
+\fGETTG3, AC7776
+ TAD TEMP1 /LAST TIME SWITCH = 2?
+ SZA CLA
+ JMP GETTG4 /NO-KEEP TRYING
+ ISZ THISTG /YES-QUIT SEARCHING
+ DCA VALUE2
+ DCA TAG1
+ DCA TAG2
+ DCA TAG3 /TAG NOT FOUND
+ STA /AC=7777 MEANS NOT FOUND
+ JMP I GETTAG /--RETURN--
+ >
+\f IFNZRO HASH<
+ PRIME=TAGMAX
+
+GETTGH,/JMS I [TLYREF /HACK ONLY
+ TAD NAME1 /HASH OUR NAME
+ CLL RTL
+ TAD NAME2
+ RTL
+ TAD NAME3
+ RTL
+ TAD NAME1
+ JMS PROBE /NOW PROBE THE TABLE
+ TAD NAME1 /RE HASH THE NAME FOR A STEPSIZE
+ CLL RAL
+ RTL
+ TAD NAME2
+ CLL /CALC MODULO PRIME INLINE
+ TAD MPRIME
+ SZL
+ JMP .-3
+ TAD PRIME
+ SNA
+ IAC /STEPSIZE MUST BE NON ZERO!
+ DCA CRPDEL
+PRBLUP, CLL
+ TAD THISTG /BUMP THE POINTER RANDOMLY
+ TAD CRPDEL
+ SZL /PROTECT AGAINST WRAP AROUND
+ TAD MPRIME /PROBABLY UNOPTIMAL SOLUTION
+ JMS PROBE
+ JMP PRBLUP
+
+PROBE, 0
+ CLL
+ TAD MPRIME
+ SZL
+ JMP .-3
+ TAD PRIME
+ DCA THISTG /THISTG MODULO PRIME
+/ JMS I [TLYPRB /HACK ONLY
+ JMS I [FINDTG /GO GET IT
+ TAD [1777 /MASK THE TYPE BITS OUT
+ AND TAG1 /IS THERE ONE?
+ SNA
+ JMP NOTFND /NO EXIT POINTING AT IT
+ CIA /YES, DO A COMPARE
+ TAD NAME1
+ SZA CLA
+ JMP I PROBE
+ AC3777
+ AND TAG2
+ CIA
+ TAD NAME2
+ SZA CLA
+ JMP I PROBE
+ AC3777
+ AND TAG3
+ CIA
+ TAD NAME3
+ SZA CLA
+ JMP I PROBE /FOUND EXIT WITH AC CLEAR
+ JMP I GETTAG
+NOTFND, STA /NOT FOUND EXIT WITH AC SET
+ JMP I GETTAG
+
+CRPDEL, 0
+MPRIME, 0 /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
+ >
+
+
+GETTA3, DCA GETTA2 /SAVE CHAR
+ TAD GETTA2
+ CLL RTL /*4
+ RAL /*10
+ TAD GETTA2 /*11
+ RTL /*44
+ TAD GETTA2 /*45
+ DCA I GETTA4 /SET LEFT SIDE
+ TAD GETTA4
+ TAD (-GETTA2
+ SZA CLA /IS THIS AN OVERFLOW (>6) CHAR?
+ STA /NO - SET SWITCH TO RIGHT HALF
+ DCA GETTA2 /YES - LEAVE SWITCH AT LEFT HALF
+ JMP GETTA1
+
+GETTA4, NAME1
+\f/IGNORE SPACES ROUTINE
+
+SPNOR, 0
+ TAD CHAR /GET THE CHARACTER
+ TAD [-240 /IS IT A SPACE?
+ SZA CLA
+ JMP I SPNOR /NO --RETURN--
+ JMS I [GETC /YES - GET NEXT CHARACTER
+ JMP SPNOR+1 /LOOP
+
+
+/HANDLER FOR PAUSE PSEUDO-OP
+/END-OF-TAPE OR END-OF-FILE
+
+PAUSEX, AC4000
+ DCA CHAR /SET END-OF-LINE CHARACTER
+ TAD [LINBUF+120 /REINITIALIZE TEXT POINTER
+ DCA TXTPTR
+ CLA CMA
+ DCA I (INCHCT /INDICATE EMPTY BUFFER
+ ISZ I (INEOF /SET END-OF-FILE
+ JMP I [LOOKEX /--EXIT TO MAIN--
+ PAGE
+\f/OUTPUT 2 CHARACTER ERROR CODE
+
+ERROR1, 0
+ DCA ERROR5
+ TAD ERROR5
+ JMS I [RTL6
+ RAL
+ AND [77
+ TAD [240 /CONVERT SIXBIT TO ASCII
+ JMS I OERROR /OUTPUT FIRST CHAR
+ TAD ERROR5
+ AND [77
+ TAD [240
+ JMS I OERROR /OUTPUT SECOND CHAR
+ JMP I ERROR1 /--RETURN--
+
+/HANDLER FOR FIELD PSEUDO-OP
+
+FIELDX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
+ JMS I [DUMPZ /DUMP PAGE ZERO LITERALS
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /TRIM TO RIGHT 3 BITS
+ AND [7
+ DCA FLDIND /STORE FOR LISTING
+ TAD PASS /IS THIS PASS 2?
+ SZA CLA
+ JMP FIELDY /NO - PREPARE TO EXIT
+ TAD FLDIND /YES - GET FIELD NUMBER
+ CLL RTL
+ RAL /AND CHANNELS 7 AND 8
+ TAD [7700
+ JMS I OCHAR /OUTPUT FIELD SETTING
+FIELDY, JMS I [CLEAN /CLEAN UP THINGS
+ TAD [200 /RESET ORIGIN TO 200
+ JMP STAR1
+
+/CHANGE LAST 2 LOCATIONS TO:
+/ CLA
+/ JMP STAR1+1
+/FOR INDAC GROUP TO OMIT RE-ORIGIN
+\f/HANDLER FOR PAGE PSEUDO-OP
+
+PAGEX, JMS I [DUMPS /DUMP SAME PAGE LITERALS
+ JMS I (XLISTZ /ANY EXPRESSION?
+ JMP PAGEY /NO
+ JMS I [EXP /YES - GET EXPRESSION
+ TAD VALUE
+ JMS I [RTL6
+ RAL /GET PAGE NUMBER
+ JMP STAR3-1
+
+PAGEY, TAD LOC /NO ARGUMENT - FIND NEXT PAGE
+ TAD [177
+ AND [7600
+STAR3, DCA VALUE
+ TAD VALUE /GET START OF PAGE
+STAR1, JMS I [PUNORG /PUNCH ORIGIN
+ JMS I [FINDSP
+ TAD [LITBUF /RESET POINTERS
+ DCA TEMP
+ TAD I TEMP
+ DCA LITPTR /INITIALIZE LITERAL POINTER FOR NEW PAGE
+ DCA LAST1
+ JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
+
+/HANDLER FOR FIXMRI PSEUDO-OP
+
+FIXMRX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [TSTALP /IS CHARACTER ALPHABETIC?
+ JMP FIXMR1 /YES-CONTINUE
+ JMS I [ICMESG /NO - GENERATE IC MESSAGE, GET NEXT CHAR
+ JMP FIXMRX+1 /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
+FIXMR1, JMS I [GETTAG /PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED SWITCH
+ SKP
+FIXMR2, JMS I [ICMESG
+ JMS I [SPNOR /IGNORE SPACES
+ TAD CHAR /WAS CHARACTER = ?
+ TAD (-"=
+ SZA CLA
+ JMP FIXMR2 /NO - PRINT IC MESSAGE AND KEEP LOOKING
+ /FALL INTO EQUALS PROCESSOR
+\f/HANDLER FOR =
+
+ AC4000 /FALL INTO HERE FROM FIXMRI
+EQUAL, JMS I [PUSHA /PUSH FIXMRI FLAG
+ JMS I [GETC /GET NEXT CHARACTER
+ TAD I (NAME1 /STORE THE SYMBOL NAME
+ JMS I [PUSHA /ON THE PUSH DOWN LIST
+ TAD I (NAME2
+ JMS I [PUSHA
+ TAD I (NAME3
+ JMS I [PUSHA
+ TAD THISTG /AND ITS PRESENT (OR FUTURE)
+ JMS I [PUSHA /POSITION IN THE SYMTAB
+ TAD ALPHAI
+ JMS I [PUSHA /STORE UNDEFINED INDICATOR
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION TO RIGHT OF =
+ TAD I PDLXR
+ DCA ALPHAI /RESTORE UNDEFINED INDICATOR
+ TAD I PDLXR
+ DCA THISTG /RESTORE SYMBOL TABLE POSITION
+ TAD I PDLXR /RESTORE TAG NAME
+ DCA I (NAME3
+ TAD I PDLXR
+ DCA I (NAME2
+ TAD I PDLXR
+ DCA I (NAME1
+ ISZ UNDFSW /WAS ANY PART OF DEFINITION UNDEFINED?
+ JMP EQUAL3 /NO
+ JMS I PERROR /YES - GENERATE IE ERROR MESSAGE
+ IE
+ ISZ PDLXR /CLEAR EXTRA WORD FROM PDL
+ JMP I [PUNVAL /FORGET ABOUT DEFINING TAG
+\f/MORE = PROCESSING
+
+EQUAL3, ISZ ALPHAI /WAS TAG DEFINED BEFORE?
+ JMP .+3 /YES - CHECK FOR ILLEGAL REDEFINITION
+ JMS I [INSRTG /NO - INSERT TAG INTO SYMBOL TABLE
+ JMP EQUAL2 /AND BYPASS ILLEGAL REDEF CHECK
+ JMS I [FINDTG /PUT TAG IN TAG1-TAGE AND VALUE2
+ TAD VALUE
+ CIA
+ TAD VALUE2
+ SZA CLA /WERE DEFINITIONS THE SAME?
+ TAD TAG1 /NO - IS IT A PERMANENT SYMBOL?
+ SMA CLA
+ JMP EQUAL2 /NO - OK TO REDEFINE
+ JMS I [ERROR /YES - GENERATE RD ERROR MESSAGE FIRST
+ RD
+EQUAL2, TAD VALUE /DEFINE OR REDEFINE
+ DCA VALUE2
+ AC3777
+ AND TAG2 /CLEAR OLD FIXMRI BIT
+ TAD I PDLXR /INSERT NEW ONE
+ DCA TAG2
+ JMS I [PUTTAG /STORE TAG
+ JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
+ PAGE
+\f/ROTATE AC 6 LEFT
+
+RTL6, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I RTL6 /--RETURN--
+
+
+/GET NEXT CHARACTER ROUTINE
+/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
+/TO THE PROGRAM
+/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED
+
+GETC, 0
+ ISZ TXTPTR /POINT TO NEXT CHARACTER
+GETC7, TAD I TXTPTR /GET NEXT CHARACTER
+ SZA /IS IT 0?
+ JMP GETC8 /NO - MORE ARE IN THIS LINE
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP GETC1 /NO
+ TAD [LINBUF /YES
+ DCA TXTPTR /RESET POINTER TO BEGINNING
+ TAD I TXTPTR /GET 1ST CHARACTER
+ SNA /IS IT 0?
+ JMP GETC1 /YES - LINE HAS BEEN PRINTED
+ TAD [-215 /IS IT 215?
+ SNA CLA
+ JMP GETC2 /YES - DO NOT PRINT THE SPACES
+ TAD [211 /NO-OUTPUT 2 TABS
+ JMS I OERROR
+ TAD [211
+ JMS I OERROR
+GETC2, JMS LINPRT /NOW PRINT THE LINE
+GETC1, TAD (-121
+ DCA TXTSWT
+ TAD (LINBUF-1
+ DCA TXTPTR /RESET POINTER
+ ISZ TXTPTR
+GETC6, JMS I (INPUT /GET NEXT CHARACTER
+ JMP GETC4 /215
+ DCA I TXTPTR /STORE THE CHARACTER
+ ISZ TXTSWT /TOO MANY?
+ JMP GETC6-1 /NO
+ CLA CMA /YES
+ DCA TXTSWT
+ JMP GETC6
+\fGETC4, DCA I TXTPTR /SET END
+ ISZ TXTPTR
+ DCA I TXTPTR /SET END OF LINE
+ TAD [LINBUF
+ DCA TXTPTR /RESET POINTER
+ CLA CMA
+ DCA TXTSWT /RESET SWITCH
+ JMP GETC7 /GET THAT CHARACTER
+
+GETC8, TAD [-215 /IS IT A CARRIAGE RETURN?
+ SNA
+ JMP GETC12 /YES-END OF LINE
+ TAD GETCI /NO-
+ TAD (215-"/ /IS IT A /?
+ SNA /YES-
+ JMP GETC13 /"/" IS END
+ TAD ("/-"; /IS IT A ;?
+ SNA /YES-
+ JMP GETC12 /";" IS END
+ TAD (";-211 /IS IT A TAB?
+ SZA
+ TAD (211-240 /OR A SPACE?
+ SZA CLA
+ JMP GETC9 /NO-NOT ANYTHING SPECIAL
+ ISZ TXTSWT /YES-2ND OCCURANCE?
+ JMP GETC+1 /YES - IGNORE
+ TAD [240
+ DCA CHAR /NO - GIVE A SPACE
+ JMP I GETC /--RETURN--
+
+GETC16, ISZ CONDSW /DECREMENT CONDITIONAL COUNTER
+ JMP GETC15
+GETC17, TAD [LINBUF+120
+ DCA TXTPTR
+GETC12, AC4000
+GETC9, TAD I TXTPTR
+ DCA CHAR /STORE CHARACTER
+ CLA CMA
+ DCA TXTSWT /SET THE SWITCH
+ JMP I GETC /--RETURN--
+\fGETC13, TAD CONDSW /CURRENTLY IN CONDITIONALS?
+ SNA
+ JMP GETC17 /NO
+ DCA CONDSW /STORE UPDATED CONDITIONAL LEVEL
+GETC15, ISZ TXTPTR /YES-SCAN LINE FOR < AND >
+ TAD I TXTPTR
+ TAD [-215 /IS CHARACTER A CARRIAGE RETURN?
+ SNA
+ JMP GETC17 /YES
+ TAD (215-"> /NO IS IT A >?
+ SNA
+ JMP GETC16 /YES
+ TAD (">-"< /NO-IS IT <?
+ SNA CLA
+ STA /YES - INCREMENT CONDITIONAL COUNTER
+ JMP GETC13 /NO - KEEP LOOKING
+
+
+/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
+/ CARRIAGE RETURN
+/ /
+/ ;
+
+/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
+/ CARRIAGE RETURN
+\f/PRINT A LINE OF SOURCE CODE
+
+LINPRT, 0
+ TAD (LINBUF-1
+ DCA XREG1 /SET POINTER TO LINE
+LINPR1, TAD I XREG1 /GET CHARACTER
+ SNA /IS IT END OF LINE?
+ JMP I LINPRT /YES - END LINE
+ JMS I OERROR /NO - OUTPUT CHARACTER
+ DCA I [LINBUF /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
+ JMP LINPR1
+
+/HANDLE PHASE ERROR
+/AND ALL ERROR EXITS TO MONITOR
+
+SYMOFL, CLA
+ TAD (SE /SYMBOL TABLE EXCEEDED MESSAGE
+MONERR, DCA MONER1 /ERROR IS SERIOUS ENOUGH TO
+PHASE, TAD (OTYPEO / CAUSE IMMEDIATE RETURN TO
+ DCA OERROR / MONITOR
+ JMS I [ERROR
+MONER1, PH /STORE ERROR TYPE HERE
+ JMP I [7600 /***EXIT TO MONITOR***
+
+
+/FIND CURRENT PAGE NUMBER
+/EXIT WITH NUMBER IN AC
+
+FINDSP, 0
+ TAD LOC
+ AND [7600
+ JMS I [RTL6
+ JMP I FINDSP /--RETURN--
+ PAGE
+\f/**********************************************************
+/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
+/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **
+
+SWAP1=.
+
+/PASS 3 LISTING OUTPUT
+
+LISOUT, 0
+ DCA LISOU2
+ TAD XLISTX /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I LISOUT /YES--RETURN--
+ ISZ LISCNT /NO-WAS PREVIOUS CHARACTER A 215?
+ JMP LISOU1 /NO
+ ISZ LINCNT /WAS IT END OF PAGE?
+ JMP LISOU1 /NO
+ ISZ THISPG /YES-START OVERFLOW PAGE
+BEGIAB, JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+HSWIT1, JMS I [FORMFD /0 IF /H SWITCH OPTION TO SUPRESS PAGING
+ ISZ LINCNT
+LISOU1, TAD LISOU2 /IS CHARACTER A CARRIAGE RETURN?
+ TAD [-215
+ SNA
+ JMP LISOU3 /YES - OUTPUT CR/LF
+ TAD [215 /NO - RESTORE CHARACTER
+ JMS I OCHAR /OUTPUT CHARACTER
+ JMP I LISOUT /--RETURN--
+
+LISOU3, CLA CMA
+ DCA LISCNT /REMEMBER THE 215 FOR NEXT TIME
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ JMP I LISOUT /--RETURN--
+
+LISCNT, -1
+LISOU2, 0
+\f/FORM FEED OUTPUT ROUTINES
+
+FORMFD, 0
+ TAD LINCNT /GET LINE COUNTER
+ TAD FORMLN
+ SNA CLA /ARE WE AT TOP OF PAGE?
+ JMP I FORMFD /YES - NO NEED FOR FORM FEED
+ TAD XLISTX /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I FORMFD /YES--RETURN--
+HSWITC, JMP FORMF1 /0 IF /T OR TTY:; JMP FORMF3 IF /H
+ /OUTPUT IF TTY:OR /T OPTION
+ TAD LINCNT
+ TAD [-4
+ DCA LINCNT
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ ISZ LINCNT
+ JMP CRLF1 /OUTPUT LINE FEED
+ /CRLF1 WILL RETURN TO
+ /JMP-1 UNTIL LINCNT HAS
+ /BEEN BUMPED SUFFICIENTLY
+ TAD FORMM6
+ DCA LINCNT
+ TAD MINUS /OUTPUT ------
+ JMS I OCHAR
+ ISZ LINCNT /* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
+FORMF1, JMP .-3 /* STA
+ TAD [-4 /* DCA LINCNT /GENERATE ONE FORM FEED
+ DCA LINCNT /* STA /TURN CR INTO FF
+ JMS CRLF /OUTPUT CR/LF OR FF/LF
+ ISZ LINCNT
+ JMP CRLF1 /OUTPUT LINE FEED
+ TAD FORMLN
+ CIA
+ DCA LINCNT
+FORM22, TAD [HEADER-1 /OUTPUT HEADER
+ DCA XREG2
+ DCA LSTCNT
+FORM30, TAD I XREG2 /GET NEXT CHARACTER OF HEADING
+ SNA /IS IT LAST + 1
+ JMP FORM20 /YES
+ JMS I OCHAR /NO-OUTPUT IT
+ TAD LSTCNT
+ TAD [-HEDLEN /DONE "HEDLEN" CHARACTERS YET?
+ SZA CLA
+ JMP FORM30 /NO-CONTINUE
+ TAD FORMHD /YES-START SYSTEM HEADER
+ JMP FORM22 /WHICH STARTS AT HEADER+HEDLEN
+
+FORMLN, LNPRPG
+FORMHD, HEDLEN
+MINUS, "-
+\f/TTY: OR /T OUTPUTS FORM FEED AS
+/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
+/------
+/CARRIAGE RETURN, 5 LINE FEEDS
+/HEADER
+/NO OPTIONS TREATS F/F AS
+/F/F, LF, CR/LF
+/HEADER
+
+/ /H OPTION TREATS F/F AS 2 CR/LF
+
+/USER HEADER IS "HEDLEN" CHARACTERS WIDE
+/ASSEMBLER HEADER ENDS WITH 0
+
+
+/OUTPUT PAGE NUMBERS
+
+FORM20, TAD EDITPG /OUTPUT EDITOR PAGE NUMBER
+ JMS FORMF4
+ TAD THISPG /IS THERE PAGE OVERFLOW?
+ SNA CLA
+FORM21, JMP FORMF3 /NO
+ TAD MINUS /YES
+ JMS I OCHAR /OUTPUT -
+ TAD THISPG /OUTPUT NUMBER OF OVERFLOW PAGE
+ JMS FORMF4
+ /OUTPUT IF /H OPTION
+FORMF3, JMS CRLF /OUTPUT 2 CR/LF
+ JMS CRLF
+ JMP I FORMFD /--RETURN--
+\f/DECIMAL PRINT ROUTINE
+
+FORMF4, 0
+ DCA FORMF6 /SAVE NUMBER
+ TAD FORM8F
+ DCA CRLF /POINT TO DIVISION LIST
+FORM12, DCA FORMF7 /START WITH 0
+ JMP .+3
+FORMF5, DCA FORMF6
+ ISZ FORMF7 /ADD 1 TO DIGIT
+ TAD I CRLF /SUBTRACT 1000, 100, OR 10
+ SNA
+ JMP FORM11 /0 IS END OF TABLE - NO MORE DIGITS
+ TAD FORMF6
+ SMA /OVERFLOW
+ JMP FORMF5 /NO-KEEP SUBTRACTING
+ CLA /YES-DIGIT DONE
+ ISZ CRLF /BUMP LIST POINTER
+ TAD FORMF7 /WAS DIGIT A 0?
+ SNA
+ JMP FORM12 /YES
+ TAD ["0 /NO-MAKE IT ASCII
+ JMS I OCHAR /OUTPUT DIGIT
+ AC4000
+ JMP FORM12 /4000 IN AC FORCES SIGNIFICANCE
+
+FORM11, TAD FORMF6 /GET LAST DIGIT (UNITS PLACE)
+ TAD ["0
+ JMS I OCHAR /OUTPUT DIGIT
+ JMP I FORMF4 /--RETURN--
+
+FORMM6, -6
+FORM8F, FORMF8
+\f/OUTPUT CARRIAGE RETURN/LINE FEED
+/ENTER WITH AC=-1 TO GENERATE F/F LF
+
+HEDCL2,
+CRLF, 0
+ TAD [215
+ JMS I OCHAR
+CRLF1, TAD [212 /RE-ENTRY FOR MULTIPLE LINE FEEDS
+ JMS I OCHAR
+ JMP I CRLF /--RETURN--
+
+/CLEAR PAGE HEADING BUFFER
+
+FORMF7,
+HEDCLR, 0
+ TAD [-HEDLEN /SET HEADING BUFFER
+ DCA HEDCL2 /TO TABS
+ TAD [HEADER-1
+ DCA XREG2
+ TAD [211
+ DCA I XREG2
+ ISZ HEDCL2
+ JMP .-3
+ JMP I HEDCLR /--RETURN--
+ PAGE
+\f/SYMBOL TABLE OUTPUT (COLUMNAR)
+ /*CODE TO GENERATE DDT COMPATIBLE*
+ /**SYMBOL TABLE--SUBSTITUTED WITH*
+ /**ONCE ONLY CODE IF NEEDED*******
+ IFZERO HASH<
+
+SYMPRT, 0
+ ISZ EDITPG /NEW PAGE
+ DCA THISPG
+ JMS I [FORMFD
+ TAD SMIN67 /DCA I SYMPR6-1
+ DCA SYMPR7 /JMS SYMPR9+6
+SYMPR8, DCA SYMPR2 /TAD [377 //RUBOUT
+ CLA CMA /JMS I OERROR
+ DCA THISTG /CLA CMA
+ TAD SYMPR2 /DCA THISTG
+ CMA /TAD [215 //CARRIAGE RETURN
+ DCA SYMPR3 /JMS I OERROR
+SYMPR5, ISZ SYMPR3 /JMS SYMPPP
+ JMP SYMPR4 /JMP SYMPR9-1
+ TAD [-4 /JMP SYMPR6+2
+ DCA SYMPR3 /HSWIT1
+SYMPR6, JMS SYMPPP /204 //EOT
+ JMP SYMPRB
+SYMPR1, TAD [1777
+ AND TAG1 /OUTPUT TAG
+ JMS I SDIV45
+ TAD TAG2
+ JMS I SDIV45
+ TAD TAG3
+ JMS I SDIV45
+ TAD [240
+ JMS I OERROR /OUTPUT SPACE
+ TAD VALUE2
+ JMS OCTPRT /OUTPUT OCTAL VALUE
+ ISZ SYMPR3 /JMP SYMPR5-2
+ JMP SYMPR0 /TAD SYMPR6
+SYMPR9, TAD [215 /JMS I OERROR /CARRIAGE RETURN
+ JMS I OERROR /TAD [377 //RUBOUT
+SYMPRB, ISZ SYMPR7 /JMS I OERROR
+ JMP SYMPRA /JMS SYMPR9+6
+HSWIT2, JMS I [FORMFD /DCA LINCNT /0 IF NOT /H
+ TAD SMIN67 /JMP I SYMPRT //--RETURN--
+ DCA SYMPR7 /0
+ TAD SYMOFS /TAD [-200
+SYMPRA, IAC /DCA SYMPR2
+ TAD SYMPR2 /TAD [200 //LEADER-TRAILER
+ JMP SYMPR8 /JMS I OERROR
+
+SYMPR4, JMS SYMPPP /ISZ SYMPR2
+ JMP I SYMPRT /JMP SYMPR4-2 /--RETURN--
+ JMP SYMPR5 /JMP I SYMPR9+6
+
+SDIV45, DIV45
+SMIN67, 1-LNPRPG
+\fSYMPR0, TAD SMIN67
+ DCA SYMPPB
+ JMS SYMPPP /SKIP 67(8) SYMBOLS
+ JMP SYMPR9
+ ISZ SYMPPB
+ JMP .-3
+ JMS I [ERROR1
+ JMS I [ERROR1
+ JMS I [ERROR1
+ JMP SYMPR1 /GO PRINT THE 67TH(8) SYMBOL
+
+SYMPR2= LINKSW
+SYMPR3= UNDFSW
+SYMPR7= ALPHAI
+SYMPPB= CHKSUM
+
+SYMPPP, 0
+ ISZ THISTG
+SYMOFS, 245
+ TAD THISTG
+ CLL CIA
+ TAD HIGHTG
+ SNL CLA
+ JMP I SYMPPP /--RETURN--
+ JMS I [FINDTG
+ AC4000
+ AND TAG1
+ TAD TAG3
+ SPA SZL CLA
+ JMP SYMPPP+1
+ ISZ SYMPPP
+ JMP I SYMPPP /--RETURN--
+/SYMNCL, -4 /DEFAULT IN LIU OF =N OPTION
+/SYMOFS, 245 /OFFSET TO FIRST SYM ON NEXT PAGE
+
+ >
+\f IFNZRO HASH<
+
+SYMPRT, 0
+ ISZ EDITPG
+ DCA THISPG
+ JMS I [FORMFD /OUTPUT A HEADING
+ JMS I SYMHND /NOW READ THE SYMBOL TABLE SORT OVERLAY
+ 0200 /2 PAGES
+SYMSRT, OUDEVH+400 /TO HERE
+ ASWAP+1 /FROM HERE
+ JMP I SYMERR /UGH
+ JMS I SYMSRT /SORT THEM AND SET LINK
+SYMNWP, DCA SYMTAG /POINT TO SYMBOL
+ SZL /LINK OFF IF ANY SYMBOLS TO LIST
+ JMP I SYMPRT /NONE --RETURN--
+ TAD SMIN67 /SET LINE/PAGE COUNT
+ DCA SYMLCT
+SYMPAG, TAD HIGHTG
+ CLL CIA
+ TAD SYMTAG
+ SZL CLA
+ JMP I SYMPRT /NO MORE IF AT HIGHTAG NOW
+ TAD SYMTAG
+ DCA THISTG /PREPARE TO PRINT LEFTMOST SYMBOL
+ TAD SYMNCL /4 PER LINE (DEFAULT)
+ DCA SYMCCT /TO COLLUMS/LINE CNTR
+ JMP SYMGO
+SYMLIN, JMS I [ERROR1
+ JMS I [ERROR1
+ JMS I [ERROR1
+ TAD HIGHTG
+ CLL CIA
+ TAD THISTG
+ SZL CLA
+ JMP SYMNXL /SKIP TO NEXT LINE IF OFF TABLE
+\fSYMGO, JMS I [FINDTG /OK, GET IT
+ TAD TAG1
+ JMS I SDIV45
+ TAD TAG2
+ JMS I SDIV45
+ TAD TAG3
+ JMS I SDIV45
+ TAD [240
+ JMS I OERROR
+ TAD VALUE2 /PRINT VALUE NOW
+ JMS OCTPRT
+SYMDDT, TAD SMIN67
+ CLL CIA
+ TAD THISTG
+ DCA THISTG
+ SZL
+ JMP SYMNXL /SKIP IF WRAP AROUND
+ ISZ SYMCCT /ELSE DO NEXT COLUMN
+ JMP SYMLIN
+SYMNXL, TAD [215
+ JMS I OERROR /CR/LF
+ ISZ SYMTAG /POINT TO NEXT SYMBOL
+ ISZ SYMLCT
+ JMP SYMPAG
+HSWIT2, JMS I [FORMFD
+ TAD SYMTAG
+ CLL
+ TAD SYMOFS /OFFSET TO NEXT SYMBOL
+ JMP SYMNWP /DO THE NEXT PAGE
+
+SDIV45, DIV45
+SMIN67, -67
+SYMERR, SYSERR
+SYMHND, 7607
+SYMOFS, 245 /DEFAULT
+SYMNCL, -4
+ SYMTAG= LINKSW
+ SYMLCT= UNDFSW
+ SYMCCT= ALPHAI
+ ZBLOCK 4 /WASTE SOME SPACE
+ >
+
+
+/END OF AREA WHICH MAY BE SWAPPED OUT
+/DURING PASSES 1 AND 2
+/**********************************************************************
+
+ ENDOVL= .
+\f/OCTAL PRINT ROUTINE
+/ENTER WITH # TO BE OUTPUT IN AC
+/** DO NOT USE TEMPS BELOW THIS LOC!
+
+OCTPRT, 0
+ DCA OCTPR1
+ TAD [-4
+ DCA OCTPR3
+OCTPR2, TAD OCTPR1 /GET EACH DIGIT SEPARATELY
+ CLL RTL
+ RAL
+ DCA OCTPR1
+ TAD OCTPR1
+ RAL
+ AND [7
+ TAD ["0 /MAKE IT INTO AN ASCII CHARACTER
+ JMS I OERROR /OUTPUT IT
+ ISZ OCTPR3
+ JMP OCTPR2
+ JMP I OCTPRT /--RETURN--
+
+OCTPR1, 0
+OCTPR3, 0
+\f/OUTPUT ONE REGISTER
+
+PUNONE, 0
+ TAD PASS /WHICH PASS IS THIS?
+ SNA
+ JMP PUNON2 /PASS 2--OUTPUT BINARY
+ SPA CLA
+ JMP PUNON3 /PASS 1--EXIT
+ TAD FLDIND /GET FIELD NUMBER
+ TAD ["0 /CONVERT TO ASCII
+ JMS I OERROR /PRINT IT
+ TAD LOC /GET LOW ORDER 4 DIGITS (LOC CTR)
+ JMS OCTPRT /PRINT IT TOO
+ TAD OFFSET /IF THIS CODE IS IN A RELOC SECTION,
+ SZA CLA /
+ TAD (1200 /FLAG THE LOCATION COUNTER WITH A *
+DTORG1, JMS I [ERROR1 /OUTPUT 2 SPACES
+ TAD VALUE
+ JMS OCTPRT /OUTPUT CONTENTS
+ TAD I [LINBUF /IS THERE SOURCE CODE TO DUMP?
+ SNA CLA
+ JMP PUNON1 /NO-OUTPUT CARRIAGE RETURN
+ TAD LINKSW /YES-DUMP LINK SWITCH (' ) OR ( )
+ JMS I [ERROR1
+ JMS I [LINPRT /DUMP SOURCE CODE
+ JMP PUNON3 /AND EXIT
+
+PUNON1, TAD LINKSW /NO LINE - OUTPUT LINK SWITCH ANYWAY
+ SZA /IF THERE IS ONE
+ JMS I [ERROR1
+ TAD [215 /OUTPUT CARRIAGE RETURN
+ JMS I OERROR
+PUNON3, DCA LINKSW /CLEAR LINK SWITCH
+ JMP I PUNONE /--RETURN--
+
+/PASS 2-OUTPUT ONE REGISTER
+
+PUNON2, TAD VALUE /GET CONTENTS
+ CLL
+ JMS I [PUNOUT /OUTPUT AS 2 FRAMES
+ JMP PUNON3 /AND EXIT
+ PAGE
+\f/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
+/***WHEN OVERLAYED BY PUSHDOWN LIST**
+
+/ARRANGE TO OUTPUT ONE REGISTER
+
+PUNBIN, 0
+ DCA VALUE
+ JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ TAD [LITBUF
+ DCA TEMP2 /POINT TO NUMBER OR LITERALS
+ TAD LOC
+ AND [177
+ DCA TEMP
+ TAD I TEMP2 /IS PAGE FULL?
+ CIA
+ TAD TEMP
+ ISZ TEMP
+ SPA CLA
+ JMP ONEOK /NO-OK TO ADD ONE MORE REGISTER
+ TAD TEMP /YES-
+ DCA I TEMP2
+ JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ JMS I PPEZE /GENERATE PE OR ZE ERROR
+ONEOK, JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ TAD [TPINST
+ DCA TEMP2
+ TAD TEMP /IS THIS ADDRESS HIGHER THAN PREVIOUS
+ CIA /HIGH INSTRUCTION PAGE?
+ TAD I TEMP2
+ SMA CLA
+ JMP PUNMOD /NO
+ TAD TEMP /YES-THIS IS NEW HIGH INSTRUCTION
+ DCA I TEMP2
+
+PUNMOD, JMS I [PUNONE /OUTPUT THIS REGISTER
+ ISZ LOC /GET NEXT LOCATION
+ TAD LOC /IF THE "ISZ" SKIPS IT IS O.K. (A 0)
+ AND [177 /IS THIS FIRST INSTRUCTION ON NEXT PAGE?
+ SZA CLA
+ JMP I PUNBIN /NO--RETURN--
+ JMS I [FINDSP /YES-FIND CURRENT PAGE NUMBER
+ TAD [LITBUF /RESET POINTERS
+ DCA TEMP2
+ TAD I TEMP2
+ DCA LITPTR
+ JMP I PUNBIN /--RETURN--
+
+PPEZE, PEZE
+\fHEADER, "S;"Y;"M;"B;"O;"L;"S
+ 211;211;211;211;211 /FOR /N HEADER
+
+/************************************************************
+/CODE OVERLAYED ON PASS 3
+/BY USER HEADER BUFFER
+
+/CONTINUATION OF EXPUNGE HANDLER
+/ENTER ON PASS 1 ONLY
+
+EXPUNW, IFZERO HASH<
+ DCA TEMP1
+ DCA EXPUN2 /CLEAR NEW HIGH TAG COUNTER
+ TAD HIGHTG
+ CMA
+ DCA TEMP3 /SAVE NUMBER OF SYM TBL ENTRIES
+EXPUNY, TAD TEMP1
+ DCA THISTG
+ JMS I [FINDTG /GET A SYMBOL
+ TAD TAG1 /ONLY SAVE THE SYMBOL IF
+ RTL
+ CLA /IT WAS A PSEUDO-OP, OR
+ TAD TAG3 /THE SYMBOLS I OR Z
+ SNL SMA CLA
+ JMP EXPUA4 /NO-FORGET TAG
+ TAD EXPUN2 /YES-RETURN TAG TO SYMBOL TABLE
+ DCA THISTG
+ JMS I [PUTTAG
+ ISZ EXPUN2
+EXPUA4, ISZ TEMP1
+ ISZ TEMP3 /DONE YET?
+ JMP EXPUNY /NO- TRY NEXT TAG
+ CLA CMA /YES
+ TAD EXPUN2 /RESET HIGH TAG
+ DCA HIGHTG
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+EXPUN2, 0
+ >
+\f IFNZRO HASH<
+ /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
+ /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)
+
+ DCA THISTG /POINT TO FIRST ENTRY
+ TAD TAGMAX /SET THE COUNT
+ CIA
+ DCA TEMP1
+EXPUNL, JMS I [FINDTG /GO GET ONE
+ TAD TAG1
+ RTL
+ CLA
+ TAD TAG3
+ SPA SZL CLA /PSEUDO OP?
+ JMP EXPUNS /YES, SKIP DELETION
+ DCA TAG1 /NO, WIPE IT
+ DCA TAG2
+ DCA TAG3
+ JMS I [PUTTAG /AND PUT IT BACK
+ STA
+ TAD HIGHTG
+ DCA HIGHTG /DECREMENT SYMBOL COUNT
+EXPUNS, ISZ THISTG /POINT TO NEXT ENTRY
+ ISZ TEMP1 /TALLY COUNT
+ JMP EXPUNL /GET ANOTHER
+ JMP I [LOOKEX /DONE --RETURN--
+ >
+
+/***************************************************************
+\f/ASSEMBLER HEADER BUFFER
+
+ ZBLOCK HEADER+HEDLEN-.
+
+ " ;" ;"P;"A;"L;"8;"-
+ "V;"1;VERSION-12+"0;SUBVERSION
+ "
+DATE, "N;"O;" ;"D;"A;"T;"E;" /GETS SET TO DD-MMM-YY IF DATE PRESENT
+ " ;" ;"P;"A;"G;"E;" ;0
+\f/PUSHDOWN LIST
+/OCCUPIES NEXT 43(8) LOCATIONS
+PDLND=.
+
+
+
+/*********************************************************
+/ONCE ONLY CODE FOR /D OPTION
+/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
+/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST
+
+DSWIT1, IFZERO HASH<
+ RELOC SYMPRT+4
+
+ DCA I SYMPRF
+ JMS SYMPRC
+ TAD [377
+ JMS I OERROR
+ CLA CMA
+ DCA THISTG
+SYMPRE, TAD [215
+ JMS I OERROR
+ JMS SYMPPP
+ JMP SYMPRD
+ JMP SYMPR1
+SYMPRF, HSWIT1
+SYM204, 204
+ RELOC
+
+ >
+ IFNZRO HASH<
+ RELOC SYMNWP
+ DCA THISTG
+ DCA I SYMHSW
+ JMS DDTLDR
+ TAD [377
+ JMS I OERROR
+SYMLUP, TAD [215
+ JMS I OERROR
+ TAD HIGHTG
+ CLL CIA
+ TAD THISTG
+ SZL CLA
+ JMP SYMXIT
+ JMP SYMGO
+SYMHSW, HSWIT1
+ RELOC
+ >
+DSWITA= .
+
+/**********************************************************
+ PAGE
+\f/*************************************************************
+
+/PAL8 TABLES - LOAD OVER INITIALIZATION CODE
+
+PDLST= PDLND+42 /PUSHDOWN LIST 43(8) LOCS LONG
+
+
+LINBUF= PDLST+1 /LINE BUFFER OCCUPIES 122(8) LOCATIONS
+
+LITBUF= LINBUF+122 /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
+ / SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS
+
+TPINST= LITBUF+40 /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
+ / SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS
+
+LITBF2= TPINST+40-17 /LITERAL BUFFER 2 CONTAINS UP TO 160(8)
+ /PAGE 0 LITERALS, SUBSCRIPTS 20-177
+
+LITBF1= LITBF2+200-100 /LITERAL BUFFER 1 CONTAINS UP TO 100(8)
+ /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177
+
+/*************************************************************
+\f/ONCE ONLY CODE FOR ASSEMBLER START UP
+/OVERLAYED BY BUFFERS
+
+/HANDLES SWITCH OPTIONS
+
+BEGIN, CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 5 /*COMMAND DECODER*
+ 2001 /DEFAULT INPUT EXTENSION IS .PA
+NOCD, CDF 10 /RETURN
+ TAD I (7604 /IS THERE A BINARY FILE EXTENSION?
+ SNA
+ TAD (216 /NO - DEFAULT EXTENSION IS .BN
+ DCA I (7604 /YES
+ TAD I (7611 /IS THERE A LISTING FILE EXTENSION?
+ SNA
+ TAD (1423 /NO - DEFAULT EXTENSION IS .LS
+ DCA I (7611
+ TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED?
+ CDF
+ AND (20
+ZT7640, SNA CLA
+ JMP BEGINA /NO
+BEGIAA, DCA I (HSWITC /YES - GENERATE CR/LF IN PLACE OF F/F
+ JMP BEGIN2
+
+BEGINA, TAD [7605 /WAS TTY THE PASS 3 DEVICE?
+ JMS I (OTYPE
+ AND (770
+ SNA CLA
+ JMP BEGIAA /YES - GENERATE CR/LF IN PLACE OF F/F
+ DCA I (BEGIAB /NOT /T OR TTY:
+
+BEGIN2, CDF 10
+ TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED?
+ CDF
+ AND (40
+ SZA CLA
+ DCA I (SSWITC /YES -OMIT SYMBOL TABLE
+ CDF 10
+ AC2000
+ AND I (MPARAM+1
+ CDF
+ SNA CLA /WAS THE /N OPTION SELECTED?
+ JMP BEGIN4 /NO
+ TAD BEGSKP /SET SWITCH
+ DCA I (NSWITC /YES -SYMBOL TABLE BUT NO LISTING
+\fBEGIN4, CDF 10
+ TAD I (MPARAM /WAS THE /H OPTION SELECTED?
+ CDF
+ AND (20
+ZH7640, SNA CLA
+ JMP BEGINB /NO
+BEGHSW, TAD I (FORM21 /YES -SUPPRESS LISTING PAGE FORMAT
+ DCA I (HSWITC
+ DCA I (HSWIT1
+BEGSKP, CLA SKP
+BEGINB, DCA I (HSWIT2
+ CDF 10
+ TAD I (MPARAM /WAS THE /D OPTION SELECTED?
+ CDF
+ AND [400
+ZD7640, SNA CLA
+ JMP BEGIN1 /NO
+ TAD I XREG1 /YES -DDT COMPATIBLE SYMBOL TABLE
+ DCA I LAST3 /SUBSTITUTE ALTERNATE CODE
+ ISZ DSWIT3 /INTO SYMBOL TABLE OUTPUT ROUTINE
+ JMP .-3
+ TAD I XREG2
+ DCA I LAST4
+ ISZ DSWIT4
+ JMP .-3
+
+BEGIN1, TAD I (JSBITS /RESET JOB STATUS WORD TO
+ AND (6777 /INDICATE PAL8 NOT RESTARTABLE
+ TAD (1000
+ DCA I (JSBITS
+ CIF CDF 10
+ JMS I (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE
+ JMP I (BEGINZ /CONTINUE ON
+\f
+DSWIT3, DSWIT1-DSWITA
+DSWIT4, DSWIT2-DSWITB
+ PAGE
+\f/ONCE ONLY CODE CONTINUED
+/ASSEMBLER INITIALIZATION PROCEDURES
+
+
+BEGINZ, TAD [7600 /WHAT DEVICE FOR BINARY OUTPUT?
+ JMS I (OTYPE
+ SMA CLA
+ TAD (-70 /STAND-ALONE
+ TAD (-10 /DIRECTORY
+ DCA I (SWAPR2+LEADER /SET AMOUNT OF LEADER TRAILER
+ DCA LAST1 /NO DEFINED TAG
+BEGIN5, IFZERO HASH<
+ CDF
+ TAD I BLK1 /MOVE SYMBOL TABLE TO FIELD 1
+ CDF 10
+ DCA I BLK2
+ ISZ BLK1
+ ISZ BLK2
+ ISZ BLK3
+ JMP BEGIN5
+ >
+ CDF
+ DCA I [LINBUF+120 /SET BUFFER POINTERS
+ DCA I (LINBUF+121
+ TAD [7600 /IS PTP BINARY OUTPUT DEVICE?
+ JMS I (OTYPE
+ DCA BLK1
+ TAD BLK1
+ AND (770
+ TAD (-20
+ SNA CLA
+ DCA I (PTPSW /YES - SET PTP SWITCH
+ TAD BLK1 /NO - IS IT A DIRECTORY DEVICE?
+ SPA CLA
+ JMP .+3 /NO
+ TAD (TAD [77 /YES - SET DIRECTORY SWITCH
+ DCA I (DIRSW
+ TAD [7605 /IS PTP GETTING LISTING OUTPUT?
+ JMS I (OTYPE
+ AND (770
+ TAD (-20
+ SNA CLA
+ DCA I (SWAPR2+PTPSW1 /YES - SET PASS 3 PTP SWITCH
+ TAD [7605 /NO - IS DIRECTORY DEVICE GETTING
+ JMS I (OTYPE /LISTING OUTPUT?
+ SPA CLA
+ JMP .+3 /NO
+ TAD (TAD [77 /YES - SET PASS 3 DIRECTORY SWITCH
+ DCA I (SWAPR2+DIRSW1
+ JMP I (BEGINF
+\fMONLST, TEXT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
+ *.-1
+
+/CONTINUED CHECK OF COMMAND DECODER OPTIONS
+
+BEGINH, CDF 10
+ TAD I (MPARAM /WAS THE /G OR /L OPTION CHOSEN?
+ CDF
+ AND (41
+ SNA CLA
+ JMP I (BEGISW /NO
+ CDF 10 /YES
+ TAD I [7600
+ SZA CLA /WAS THERE A BINARY OUTPUT FILE?
+ JMP YESBIN /YES
+BINLOP, TAD PALBIN /NO - CREATE FILE PAL8BN.TM
+ DCA I PALBIX /ON SYSTEM DEVICE
+ ISZ BINLOP
+ ISZ PALBIX
+ ISZ BINCNT
+ JMP BINLOP
+ CDF
+ TAD (-10 /SET AMOUNT OF LEADER TRAILER
+ DCA I (SWAPR2+LEADER
+\f/SET UP FOR LOAD OR LOAD AND GO
+
+YESBIN, CDF
+ CIF 10
+ CLA IAC
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 2 /* LOOKUP PERMANENT FILE *
+LOAD, PLOAD /FILENAME ABSLDR.SV
+BINCNT, -5 /FILE LENGTH
+ JMP NOLOAD /ABSLDR.SV NOT FOUND
+ TAD LOAD /NORMAL RETURN
+ DCA I (CHAIN /SET STARTING BLOCK NUMBER
+ DCA I (LSWITC /FOR CHAIN CALL
+ JMP I (BEGISW
+
+NOLOAD, JMS I [ERROR /GENERATE LD ERROR MESSAGE
+ LD
+ JMP I (BEGISW /ASSEMBLE BUT DO NOT CHAIN TO LOADER
+
+BLK1, SYMS
+BLK2, 7600+SYMS-SYME
+BLK3, SYMS-SYME
+
+PALBIX, 7600
+PALBIN, 1
+ FILENAME PAL8BN.TM
+ PAGE
+\fCCC, TAD I CC231 /FINAL PIECE OF STARTUP ONCE-ONLY CODE
+ SNA
+ TAD CC23
+ DCA I CC231 /"HSWITC"=JMP FORMF1 IF WAS 0
+BEGISW, CDF 10
+ TAD I CCJWD
+ CDF 0
+ AND CCJBIT
+ZJ7640, SNA CLA /WAS /J OPTION SPECIFIED?
+ DCA I CCJLOC /NO - PRINT UNASSEMBLED CONDITIONAL CODE
+ CDF 10
+ TAD I CCWWD
+ CDF 0
+ AND CCWBIT
+ZW7640, SNA CLA /WAS /W OPTION SPECIFIED?
+ JMP D4 /V3C
+D5, TAD I CC231
+ CIA
+ TAD CC23
+ SZA CLA /ARE WE OUTPUTTING FF'S IN LISTING?
+ JMP BEGIS3 /NO
+ TAD CC24 /YES - SUBSTITUTE SOME CODE
+ DCA I CC25
+ TAD CC26
+ DCA I CC27
+ TAD CC24
+ DCA I CC28
+BEGIS3, JMS I OVLL7 /CALL SYSTEM DEVICE
+ 4200 /WRITE 2 PAGES
+ SWAP1 /FORM SWAP1
+ ASWAP /INTO TEMP AREA
+ JMP I OVLL8 /ERROR?!
+ TAD I LAST2 /MOVE PASS 1&2 ONLY CODE
+ DCA I TAGXR /OVER PASS3 SWAPPED OUT CODE
+ ISZ CC29
+ JMP .-3
+ IFNZRO HASH<
+ JMS I CCHSH /FINALLY HASH OUT THE TABLE
+ >
+
+ JMP I .+1
+ START2-1 /OK - NOW GO DO SOME ASSEMBLING!
+D4, DCA I CCWLOC /NO - DON'T WIPE LITERALS AS YOU DUMP THEM
+ DCA I (D3
+ JMP D5 /V3C
+\fOVLL7, 7607
+OVLL8, SYSER3
+
+CC231, HSWITC
+CC23, FORMF1&177+5200
+CC24, STA
+CC25, FORMF1
+CC26, DCA LINCNT
+CC27, FORMF1+1
+CC28, FORMF1+2
+CC29, SWAPB2-SWAPE2
+
+ IFNZRO HASH<
+CCHSH, HSHSMS
+ >
+CCJWD, MPARAM
+CCJBIT, 4
+CCJLOC, IFTST4
+CCWWD, MPARAM+1
+CCWBIT, 2
+CCWLOC, LITHAK
+PLOAD, FILENAME ABSLDR.SV
+
+CKBAT, TAD I CC7777 /GET BATCH FLAG WORD
+ CLL RTL
+ SNL CLA /BATCH RUNNING?
+ JMP I CCOPTM /NO, GO WITH LINK OFF
+ TAD I CC7777
+ AND CC0070 /GET BATCH FIELD
+ TAD CCCIF0 /FORM CIF TO BATCH FIELD
+ DCA OTYPB1 /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
+ TAD CCJMSB /LOG INSTEAD
+ DCA OTYPB2
+ TAD OTYPTD
+ DCA OTYPB3
+ JMP I CCOPTM /RETURN TO CORE DETERMINER, LINK SET
+
+CC7777, 7777
+CCOPTM, OPTIM4
+CC0070, 70
+CCCIF0, CIF 0
+CCJMSB, JMS I [BATOUT
+\f/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE
+
+ IFNZRO .-LITBF1-200&4000 <*LITBF1+200>
+
+OTYPEO, 0 /TYPE A CHARACTER, CHECKING FOR ^O AND ^C
+ DCA OTYPEC /SAVE CHAR
+ JMS CTCCHK /CHECK FOR ^C - RETURN CHAR-203 IN AC
+ TAD (-14
+ SNA CLA /^O?
+ JMP I OTYPEO /YES
+OTYPTD, TAD OTYPEC
+OTYPB1, TLS
+OTYPB2, TSF
+OTYPB3, JMP .-1 /WAIT FOR TTY
+ TAD [-215
+OTYPCR, SZA CLA /SET TO CLA DURING "ERRORS DETECTED" STUFF
+ JMP I OTYPEO
+ TAD [212 /IF CHAR WAS CR, TYPE LF
+ JMP OTYPEO+1
+OTYPEC, 0
+
+CTCCHK, 0 /CHECK FOR ^C
+ TAD [200
+ KRS /OR IN KEYBOARD CHAR
+ TAD (-203
+ SNA
+ KSF /3B BUT WAS CHAR REALLY THERE?
+ JMP I CTCCHK /NO ^C - RETURN
+ JMP I [7600 /RETURN TO OS/8
+
+TTLMSG, "E-240^100+"R-240 /ERRORS DETECTED:
+ "R-240^100+"O-240
+ "R-240^100+"S-240
+ "D-240
+ "E-240^100+"T-240
+ "E-240^100+"C-240
+ "T-240^100+"E-240
+ "D-240^100+":-240
+ 0
+
+ "L-240^100+"I-240 /LINKS GENERATED:
+ "N-240^100+"K-240
+ "S-240^100
+ "G-240^100+"E-240
+ "N-240^100+"E-240
+ "R-240^100+"A-240
+ "T-240^100+"E-240
+ "D-240^100+":-240
+ 0
+ PAGE
+\f/OUTPUT A CHARACTER TO OUTPUT DEVICE
+/CALLED BY JMS I OCHAR
+/WITH CHARACTER IN 8-BIT ASCII IN AC
+
+OUTPT1, PUNCHX /PASS 2=PUNCHX; 3=XLISTX
+
+OUTPUT, 0
+ AND [377 /MASK OUT LEFT 4 BITS
+ DCA OUTPT2 /STORE
+ TAD I OUTPT1 /IS THIS PASS 3 AND
+ SNA
+ TAD OUTINH /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I OUTPUT /YES--RETURN--
+ TAD OUTPT2 /NO - GET CHARACTER
+ AND [200
+ SNA CLA
+ TAD OUTPT2 /IF LESS THAN 200, THEN
+ TAD CHKSUM /ADD IT TO CHECKSUM
+ DCA CHKSUM
+ TAD OUTPT2 /GET CHARACTER
+ TAD (-211 /IS IT A TAB?
+ SNA CLA
+ JMP OUTPT3 /YES - OUTPUT SPACES
+ JMS OUTPUX /NO - OUTPUT CHARACTER
+ TAD OUTPT2 /IS IT LINE FEED?
+ TAD (-212
+ SZA CLA
+ JMP I OUTPUT /NO--RETURN--
+ TAD [7773 /YES - RESET LSTCNT
+ DCA LSTCNT
+ JMP I OUTPUT /--RETURN--
+
+\f/OUTPUT SPACES INSTEAD OF TAB
+
+OUTPT3, TAD [240
+ DCA OUTPT2
+ JMS OUTPUX /OUTPUT SPACE
+ TAD LSTCNT /TAB STOPS ARE EVERY 8 SPACES
+ AND [7
+ SZA CLA
+ JMP .-4
+ JMP I OUTPUT /--RETURN--
+
+/OUTPUT THE CHARACTER
+/PACKS CHARACTERS IN STANDARD OS/8 FORMAT
+
+OUTPUX, 0
+ ISZ OUJMP /BUMP 3-WAY SWITCH
+OUJMP, HLT /WILL BE CHANGED - SHOULD NEVER HALT
+ JMP OCHAR1 /CHARACTER #1
+ JMP OCHAR2 /CHARACTER #2
+OCHAR3, TAD OUTPT2 /CHARACTER #3
+ CLL RTL
+ RTL
+ AND [7400
+ TAD I OUPOLD /ADD 4 BITS TO WORD 1
+ DCA I OUPOLD
+ TAD OUTPT2
+ CLL RTR
+ RTR
+ RAR
+ AND [7400
+ TAD I OUPTR /ADD 4 BITS TO WORD 2
+ DCA I OUPTR
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUFFER FULL?
+ JMP OUCHLV /NO
+ TAD [200 /YES
+ JMS I (OUTDMP /DUMP BUFFER
+ JMS OUSETP /RESET POINTERS
+ JMP OUCHLV
+
+\fOCHAR2, TAD OUPTR /SAVE POINTER
+ DCA OUPOLD
+ ISZ OUPTR
+OCHAR1, TAD OUTPT2
+ DCA I OUPTR /SET 8 BIT WORD
+OUCHLV, TAD OUTPT2
+ TAD [40
+ AND [100 /CHECK FOR PRINTABLE CHAR
+ SZA CLA /IF IT IS,
+ ISZ LSTCNT /BUMP TAB COUNT
+OUTINH, 0 /ALWAYS 0 OR 1!
+ JMP I OUTPUX /--RETURN--
+
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTPT2, 0
+
+OUSETP, 0
+ TAD [7600 /SET OUTPUT WORD COUNT
+ DCA OUDWCT /TO 200
+ TAD (OUBUF
+ DCA OUPTR /RESET POINTER
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ CLL /MUST CLEAR LINK!!
+ JMP I OUSETP /--RETURN--
+\f/HANDLER FOR DEVICE PSEUDO-OP
+
+DEVICX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD [-5
+ JMP DEVIC1 /PACK 4 CHARACTERS
+
+
+/HANDLER FOR FILENAME PSEUDO-OP
+
+FILENX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD (-7
+ JMS FILE1 /PACK 6 CHARACTERS
+ TAD CHAR
+ TAD [-". /WAS CHARACTER . ?
+ SNA CLA
+ JMS I [GETC /YES-SKIP TO EXTENSION
+ AC7775
+DEVIC1, JMS FILE1 /PACK 2 CHARACTERS
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/PACK CHARACTERS
+/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY
+
+FILE1, 0
+ DCA FILE6 /SAVE # OF CHARACTERS TO PACK
+ DCA I (TEXT6 /RESET PACK SWITCH
+FILE4, JMS I [TSTALN /IS CHARACTER IN CHAR ALPHANUMERIC?
+ SKP
+ JMP FILE5 /NO-DONE PACKING
+ ISZ FILE6 /YES-TOO MANY CHARACTERS?
+ JMP FILE3 /NO-O.K.
+ CLA CMA /YES
+ DCA FILE6 /RESET # OF CHARACTERS AND IGNORE
+ JMP FILE2
+
+FILE3, TAD CHAR
+ JMS I (TEXT2 /PACK A CHARACTER
+FILE2, JMS I [GETC /GET A CHARACTER
+ JMP FILE4 /TEST IT
+
+ JMS I (TEXT2 /PACK A ZERO CHAR
+FILE5, ISZ FILE6 /ARE WE DONE?
+ JMP .-2 /NO - PAD WITH ZEROES
+ JMP I FILE1 /YES--RETURN--
+FILE6, 0
+ PAGE
+\f/HANDLER FOR TEXT PSEUDO-OP
+/SPACES ARE IGNORED TO DELIMITER
+/DELIMITER IS FIRST PRINTING CHARACTER
+/OTHER THAN SPACE
+/NON-PRINTING CHARACTERS ARE ILLEGAL
+/A PRINTING CHARACTER HAS EITHER BIT 5
+/OR BIT 6 SET, BUT NOT BOTH
+
+TEXT8, JMS I [GETC /GET NEXT CHARACTER
+TEXTX, CLL CLA CML RAR /AC=4000
+ DCA GETCI /; AND / ARE NOT END OF LINE
+ JMS TEXT1A /CHECK FOR PRINTING CHARACTER
+ JMP TEXT8 /NON PRINTING - IGNORE
+ TAD [-240 /IGNORE SPACES UNTIL DELIMITER
+ SNA /HAS BEEN FOUND
+ JMP TEXT8
+ TAD [240 /RESTORE CHARACTER
+ CIA
+ DCA VALUE2 /STORE NEGATIVE DELIMITER
+ DCA TEXT6 /SET PACKING SWITCH
+TEXT3, JMS I [GETC /GET NEXT CHARACTER
+ JMS TEXT1A /IS IT A PRINTING CHARACTER?
+ JMP TEXT9 /NO - IC
+ TAD VALUE2 /YES - IS IT DELIMITER?
+ SNA CLA
+ JMP TEXT4 /YES - TERMINATE
+ TAD CHAR /NO - PACK AND OUTPUT
+ JMS TEXT2 /PACK IT
+ JMP TEXT3
+
+TEXT4, DCA GETCI /RESET GETCI TO CALL ; AND / END OF LINE
+ JMS I [GETC /SKIP DELIMITER
+TEXT4X, JMS TEXT2 /OUTPUT 0 TO FILE
+ JMS TEXT2
+/CHANGE TEXT4X TO:
+/ NOP
+/FOR NO EXTRA WORD OF ZEROS
+ DCA GETCI /RESET GETCI IN CASE WE HIT CR
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\fTEXT9, JMS I [ERROR /GENERATE IC ERROR MESSAGE
+ IC
+ JMP TEXT3
+
+/SKIP ON PRINTING CHARACTER
+
+TEXT1A, 0
+ TAD CHAR
+ SPA SNA CLA /IS CHARACTER -
+ JMP TEXT4X /YES
+ TAD CHAR
+ TAD [40
+ AND [100
+ SZA CLA /IS THE CHAR PRINTING?
+ ISZ TEXT1A /YES - INCREMENT RETURN
+ TAD CHAR /WITH CHARACTER IN AC
+ JMP I TEXT1A /--RETURN--
+
+/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
+/ENTER WITH CHARACTERS IN AC
+
+TEXT2, 0
+ AND [77 /GET RIGHT 6 BITS
+ ISZ TEXT6 /WHICH HALF OF WORD?
+ JMP TEXT5 /LEFT
+ TAD TEXT7 /RIGHT--ADD IN LEFT HALF
+ JMS I [PUNBIN /OUTPUT IT
+ JMP I TEXT2 /--RETURN--
+
+TEXT5, JMS I [RTL6 /GET LEFT HALF OF WORD
+ DCA TEXT7 /SAVE IT
+ CLA CMA /SET SWITCH FOR RIGHT HALF
+ DCA TEXT6
+ JMP I TEXT2 /--RETURN--
+
+TEXT6, 0
+TEXT7, 0
+\f/HANDLER FOR EXPUNGE PSEUDO-OP
+
+EXPUNX, TAD PASS /IS THIS PASS 1
+ SMA CLA
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ JMP I (EXPUNW /YES-CONTINUE AT EXPUNW
+
+
+
+/CLOSE OUTPUT FILE
+
+OCLOSE, 0
+ TAD I (OUTINH /OUTPUT INHIBITED?
+ SZA CLA
+ JMP I OCLOSE /YES--RETURN--
+PTPSW, TAD [232 /NO-0 IF PTP: - OUTPUT ^Z
+ JMS I OCHAR
+ JMS I OCHAR /AND ZEROS
+FILLLP, JMS I OCHAR
+DIRSW, TAD [177 /TAD [77 IF NOT DIRECTORY
+ AND I (OUDWCT /FILL OUT BUFFER OR HALF BUFFER
+ SZA CLA /WITH ZEROS
+ JMP FILLLP
+ TAD I (OUDWCT /IS THERE OUTPUT TO BE DUMPED?
+ TAD [200
+ SZA
+ JMS OUTDMP /YES - DUMP IT
+ TAD OUFILE /GET DEVICE NUMBER IN AC
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 4 /*CLOSE OUTPUT FILE*
+OUCNAM, 0 /POINTER TO FILENAME TO BE DELETED
+OUCCNT, 0 /LENGTH OF NEW PERMANENT FILE
+ JMP SYSER3 /DE**FATAL ERROR**
+ JMP I OCLOSE /--RETURN--
+
+OUFILE, ZBLOCK 5
+\f/OUTPUT DUMP
+/AC CONTAINS CONTROL WORD FOR DUMP
+
+OUTDMP, 0
+ TAD [4000 /BE SURE CONTROL WORD IS
+ DCA OUCTLW /A WRITE OPERATION
+ TAD OUBLK /GET STARTING BLOCK NUMBER
+ TAD OUCCNT /ADD IN COUNT
+ DCA OUREC /SET THIS BLOCK NUMBER
+ TAD OUCTLW
+ TAD [100 /ROUND HALF-BLOCK, IF ANY
+ CLL RTL
+ RTL
+ RTL
+ AND [17 /GET THIS COUNT
+ TAD OUCCNT
+ DCA OUCCNT /ADD TO TOTAL COUNT
+ TAD OUCCNT /IS OUTPUT DEVICE FULL?
+ CLL CML
+ TAD OUELEN /CHECK AGAINST MAXIMUM LENGTH
+ SNL SZA CLA
+ JMP SYSER2 /DF**FATAL ERROR**
+ JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER
+OUCTLW, 0 /CONTROL WORD
+ OUBUF /BEGINNING OF OUTPUT BUFFER
+OUREC, 0 /STARTING BLOCK NUMBER
+SYSER3, CLA SKP /ERROR RETURN
+ JMP I OUTDMP /--RETURN--
+SYSERR, TAD (DE /DE **FATAL ERROR**
+ JMP I [MONERR
+
+OUHNDL, 0
+OUBLK, 0
+OUELEN, 0
+
+SYSER2, TAD (DF /GENERATE DF ERROR MESSAGE
+ JMP I [MONERR /**FATAL ERROR**
+ PAGE
+\f/MAINLINE CODE
+
+LOOKE2, 0 /WAS THIS END OF LINE
+ TAD CHAR / OR END OF CONDITIONAL?
+ TAD [-">
+ SNA
+ JMP CONEND /END OF CONDITIONAL
+ TAD (">
+ SMA CLA
+ JMP I LOOKE2 /NOT END OF LINE--RETURN--
+LOOKE1, JMS I [GETC /GET A CHARACTER
+MAIN, JMS I (CTCCHK /CHECK FOR ^C
+ CLA /** CTCCHK RETURNS AC NON-ZERO!
+ JMS I [SPNOR /IGNORE SPACES
+ TAD CHAR
+ TAD (-"$ /WAS IT $ ?
+ SNA /YES--
+ JMP I (ENDPAS /NO-END THIS PASS
+ TAD ("$-"*
+ SNA CLA /WAS IT * ?
+ JMP STAR /YES-HANDLE *
+ JMS I [TSTALP /NO-WAS IT ALPHABETIC?
+ JMP ALPHA /YES
+ JMS LOOKE2 /NO
+TOEXP, JMS I [EXP /GET REST OF EXPRESSION
+ TAD LININD
+ DCA LINKSW /STORE LINK SWITCH
+ TAD VALUE
+ JMS I [PUNBIN /OUTPUT THE REGISTER
+LOOKEX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ JMS LOOKE2 /IS LINE ENDED?
+ILCHAR, JMS I [ERROR /NO-GENERATE IC ERROR MESSAGE
+ IC
+ JMP CONEN1
+
+CONEND, TAD CONDSW /ARE WE INTO CONDITIONALS?
+ SNA
+ JMP ILCHAR /NO - > IS ILLEGAL
+ IAC /ONE LESS CONDITIONAL
+ DCA CONDSW
+CONEN1, JMS I [GETC /GET NEXT CHARACTER
+ JMP LOOKEX /AND TRY FOR END AGAIN
+\f/HANDLER FOR *
+
+STAR, JMS I [GETC /GET NEXT CHARACTER AFTER *
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET REST OF EXPRESSION
+STAR0, DCA STARSW /ENTER HERE FROM RELOC WITH AC = -1
+ ISZ UNDFSW /WAS ANYTHING UNDEFINED?
+ JMP .+3
+ JMS I [ERROR /YES-GENERATE UO ERROR MESSAGE
+ UO
+ TAD VALUE /NO
+ DCA OP
+ TAD LOC /IS THIS THE SAME PAGE AS
+ AND [7600 /THE PREVIOUS CODE?
+ CIA
+ TAD OP
+ AND [7600
+ SNA CLA
+ JMP STAR2 /YES-PUNCH ORIGIN
+ JMS I [DUMPS /NO-DUMP LITERALS
+ TAD OFSBUF /SET OFFSET TO NEW VALUE
+ DCA OFFSET /AFTER LITERALS ARE DUMPED.
+ TAD OP /PUNCH NEW ORIGIN, SET "VALUE"
+ JMP I (STAR3 /FOR LISTING, AND SET UP IN NEW PAGE
+
+STAR2, TAD OFSBUF /SET OFFSET TO NEW VALUE
+ DCA OFFSET /
+ TAD OP
+ JMS I [PUNORG /PUNCH ORIGIN
+ DCA LAST1 /CLEAR LAST DEFINED SYMBOL
+ JMP I [PUNVAL
+
+ALPHA, JMS I [GETTAG /PICK UP TAG-IS IT IN TABLE?
+ DCA ALPHAI /STORE UNDEFINED TAG SWITCH
+ TAD TAG3 /IS IT A PSEUDO-OP?
+ SPA CLA
+ JMP I VALUE2 /YES-GO TO ITS HANDLER
+ TAD CHAR /NO
+ TAD (-", /WAS IT TERMINATED BY , ?
+ SNA
+ JMP COMMA /YES-DEFINE THE SYMBOL
+ TAD (",-"= /NO-WAS IT TERMINATED BY = ?
+ SNA CLA
+ JMP I (EQUAL /YES-EQUATE THE SYMBOL
+ AC4000 /NO
+ JMP TOEXP /TREAT AS AN EXPRESSION
+\f/HANDLER FOR ,
+
+COMMA, JMS I [GETC /GET NEXT CHARACTER
+ ISZ ALPHAI /WAS TAG DEFINED PREVIOUSLY?
+ JMP COMMA2 /YES
+ TAD LOC /NO-STORE CURRENT ADDRESS FOR DEFINITION
+ DCA VALUE2
+ JMS I [INSRTG /PUT TAG IN SYMBOL TABLE
+COMMA1, TAD TAG1 /STORE FOR ERROR MESSAGE OUTPUT
+ DCA LAST1
+ TAD TAG2
+ DCA LAST2
+ TAD TAG3
+ DCA LAST3
+ TAD VALUE2
+ DCA LAST4
+ JMP MAIN /--EXIT TO MAIN--
+
+COMMA2, TAD LOC /DO NEW AND OLD DEFINITIONS AGREE?
+ CIA
+ TAD VALUE2
+ SNA CLA
+ JMP COMMA1 /YES-ALLOW REDEFINITION
+ JMS I [ERROR /NO-GENERATE ID ERROR MESSAGE
+ ID
+ JMP MAIN /--EXIT TO MAIN--
+\fOPTABL, OP0 /+
+ OP1 /-
+ OP6 /%
+ OP2 /&
+ OP5 /(SPACE)
+OPEXPL, OP5 /! - CHANGED TO OP3 IF /B ON
+ OP4 /^
+ PAGE
+\f/EXPRESSION PROCESSOR
+/POSSIBLE RECURSIVE ENTRY
+/ENTER WITH CHARACTER IN CHAR
+
+EXP, 0
+ DCA EXPIND /SET INDICATOR (NOT 0 IF NO MRI FOUND)
+ DCA LININD /CLEAR LINK GENERATED SWITCH (' )
+ DCA VALUE /START WITH "VALUE" = 0
+ DCA UNDFSW /CLEAR UNDIFINED SWITCH
+ TAD EXP
+ JMS I [PUSHA /SAVE RETURN ADDRESS
+ DCA OP /OP=0; ADD
+ TAD EXPIND
+ SPA CLA
+ JMP I (EXPINT
+ TAD CHAR /IS CHARACTER A + ?
+ TAD [-"+
+ CLL RTR /PUT THE 2 BIT IN THE LINK
+ SZA CLA /WAS CHAR 53(+) OR 55(-)?
+ JMP EXP1A /NO
+ RAL /YES - OP IS 0 OR 1, DEPENDING
+EXP1, DCA OP
+ JMS I [GETC /GET NEXT CHARACTER
+ ISZ EXPIND /MRI NO LONGER LEGAL ON THIS LINE
+EXP1A, TAD CHAR /IS CHARACTER A . ?
+ TAD [-".
+ SNA
+ JMP PERIOD /YES-GO TO . HANDLER
+ TAD (".-"" /NO-IS IT " ?
+ SNA
+ JMP QUOTE /YES-GO TO " HANDLER
+ TAD (""-"[ /NO-IS IT [ ?
+ CLL
+ SZA
+ TAD ("[-"( /OR (?
+ SNA CLA
+ JMP I (LIT /YES - LITERAL - LINK HOLDS WHICH KIND
+ JMS I [TSTALP /NO-IS IT ALPHABETIC?
+ JMP I (ALPHA1 /YES-HANDLE SYMBOL
+ JMS I [TSTNUM /NO-IS IT NUMERIC?
+ JMP NUMBER /YES-HANDLE NUMBER
+
+EXP2, JMS ENDCHK /NO-CHECK FOR END
+ JMP EXP1A /NOGO - TRY AGAIN
+ TAD OP
+ TAD [-4 /IS OP SPACE (4)
+ SNA CLA
+ JMP I (EXPXIT /YES-EXIT
+ JMS I [ERROR
+ IC /GIVE IC MESSAGE ON ILLEGAL OPERATOR
+ JMP I (EXPINT /EXIT ANYWAY
+\f/END OF EXPRESSION CHECK
+/SKIP IF OK
+
+ENDCHK, 0
+ TAD CHAR
+ TAD (-"] /IS CHARACTER A ] ?
+ SZA /YES-SKIP A EXIT
+ TAD ("]-") /IS CHARACTER A ) ?
+ SZA /YES-SKIP A EXIT
+ TAD (")-"> /IS CHARACTER A > ?
+ SZA /YES-SKIP AND EXIT
+ TAD (">-"< /IS CHARACTER A < ?
+ SNA
+ JMP ENDCH1 /YES-SKIP AND EXIT
+ TAD ("<
+ SPA CLA /IS IT END-OF-LINE?
+ JMP ENDCH1 /YES-SKIP AND EXIT
+ JMS I [ICMESG /NO - GENERATE IC MESSAGE AND GET NEXT CHAR
+ JMP I ENDCHK /--RETURN--
+
+ENDCH1, ISZ ENDCHK /INCREMENT RETURN ADDRESS
+ JMP I ENDCHK /--RETURN--
+
+NUMBER, DCA TEMP
+NUMBE2, TAD RADIX /IS THE CURRENT RADIX OCTAL?
+ SNA CLA
+ TAD CHAR /YES-IS THE DIGIT GREATER THAN 7?
+ TAD (-"8
+ SMA CLA
+ JMP NUMBE3 /YES-ILLEGAL CHARACTER
+ TAD TEMP /NO-ADD IT TO THE PREVIOUS
+ CLL RAL /ACCUMULATED VALUE
+ CLL RAL
+ DCA TEMP2
+ TAD RADIX /IS RADIX OCTAL?
+ AND TEMP /NO
+ TAD TEMP2 /YES
+ CLL RAL
+ TAD CHAR
+ TAD (-"0
+ DCA TEMP
+ JMS I [GETC /GET NEXT CHARACTER
+NUMBE4, JMS I [TSTNUM /IS IT NUMERIC?
+ JMP NUMBE2 /YES-CONTINUE ACCUMULATING NUMBER
+ TAD TEMP /NO-STORE NUMBER
+NUMBE1, DCA VALUE2
+NUMBE5, TAD OP /GO COMBINE IT VIA LAST OPERATION
+ TAD (OPTABL
+ DCA TEMP /FIND THE OPERATOR HANDLER
+ TAD I TEMP
+ DCA TEMP
+ JMP I TEMP /GO TO THE HANDLER
+\f/8 OR 9 FOUND DURING OCTAL RADIX
+
+NUMBE3, JMS I [ICMESG /GENERATE IC ERROR MESSAGE AND
+ JMP NUMBE4 /IGNORE CHARACTER
+
+
+/HANDLER FOR .
+
+PERIOD, JMS I [GETC /GET NEXT CHARACTER
+ TAD LOC /MAKE CURRENT LOCATION
+ JMP NUMBE1 /INTO VALUE OF NUMBER
+
+/HANDLER FOR "
+
+QUOTE, ISZ TXTPTR
+ TAD I TXTPTR /GET CHARACTER FROM TEXT BUFFER
+ TAD [-215 /WAS IT CARRIAGE RETURN?
+ SNA CLA
+ JMP QUOTE1 /YES-IT IS IC-IGNORE "
+ TAD I TXTPTR /NO-PUT ASCII CODE INTO
+ DCA VALUE2 /VALUE WORD
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP NUMBE5 /RETURN TO EXPRESSION PROCESSOR
+
+/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT
+
+QUOTE1, JMS I [ERROR /GENERATE IC ERROR MESSAGE
+ IC
+ CLA CMA
+ DCA CHAR
+ JMP I (EXPXIT
+ PAGE
+\f/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER
+
+ALPHA1, JMS I [GETTAG /PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED INDICATOR
+ALPHA3, TAD TAG3 /IS IT A PSEUDO-OP?
+ SMA CLA
+ JMP .+3
+ JMS I [ERROR /YES-GENERATE IP ERROR MESSAGE
+ IP
+ ISZ ALPHAI /NO-WAS IT UNDEFINED?
+ JMP ALPHA0
+ ISZ UNDFSW /YES-SET UNDEFINED SWITCH
+ TAD PASS /IS THIS PASS 1?
+ SPA CLA
+ JMP ALPHA0 /YES-SUPPRESS ERROR MAESSAGE
+ JMS I [ERROR /NO-GENERATE US ERROR MESSAGE
+ US
+ALPHA0, TAD TAG2 /NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
+ SPA CLA
+ TAD CHAR /YES-GET TERMINATING CHARACTER
+ TAD [-240 /WAS IT SPACE?
+ SZA CLA
+ JMP I (NUMBE5 /NOT MEMREF FOLLOWED BY SPACE
+ JMS I [SPNOR /YES-IGNORE SPACES
+ TAD CHAR
+ SPA CLA
+ JMP I (NUMBE5
+ TAD EXPIND /IS MEMORY REFERENCE INSTRUCTION OK?
+ SZA CLA
+ JMP I (NUMBE5 /NO-
+ DCA IZIND /YES-CLEAR I AND Z INDICATOR
+ TAD VALUE2 /STORE MRI ON PUSHDOWN LIST
+ JMS I [PUSHA
+\fALPHA6, TAD IZIND
+ JMS I [PUSHA /PUSH THE I AND Z INDICATOR
+ JMS I [TSTALP /WAS TERMINATING CHARACTER ALPHABETIC?
+ SKP
+ JMP ALPHA4 /NO-
+ JMS I [GETTAG /YES-PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED INDICATOR
+ AC2000
+ AND TAG1 /WAS IT AN I OR Z?
+ SNA CLA
+ JMP ALPHA5 /NO
+ TAD VALUE2 /YES-WAS IT I?
+ SNA
+ IAC /NO - SET LOW ORDER
+ TAD I PDLXR /GET OLD IZIND FROM PDL
+ DCA IZIND /SET NEW IZIND
+ JMS I [SPNOR /IGNORE SPACES
+ JMP ALPHA6
+
+EXPINT, TAD EXPIND
+ TAD [4000
+ DCA EXPIND
+ JMP ALPHA3
+
+ALPHA5, AC4000
+ALPHA4, IAC
+ JMS I [EXP /GET REST OF EXPRESSION
+ TAD I PDLXR /RETRIEVE MRI
+ DCA IZIND
+ TAD I PDLXR
+ DCA VALUE2
+ /FALL INTO NEXT PAGE
+\f/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION
+
+ TAD VALUE /GET ADDRESS
+ AND [7600
+ SNA /IS IT PAGE 0?
+ JMP FIX4 /YES
+ CIA /NO-IS IT ON CURRENT PAGE?
+ TAD LOC
+ AND [7600
+ SNA CLA
+ JMP FIX2 /YES
+ TAD VALUE /NO-SET UP LINK
+ JMS I (FINDS
+ DCA VALUE
+ TAD FIXMD0 /SET ' IN LISTING
+ DCA LININD
+ ISZ LINK /BUMP NUMBER OF LINKS GENERATED
+FIXMD0, 0700 /PROTECTION FOR ISZ
+LGERR, SKP /JMS I PERROR IF /E SPECIFIED
+ LG
+ JMS ADDIND /SET INDIRECT BIT IN INSTRUCTION
+FIX2, TAD [200 /SET CURRENT PAGE BIT
+ TAD VALUE2
+ DCA VALUE2
+ TAD IZIND
+ AND [77 /WAS Z SPECIFIED?
+ SNA CLA
+ JMP FIX4 /NO
+ JMS I [ERROR /YES - ILLEGAL REFERENCE
+ IZ /TO PAGE 0
+FIX4, TAD IZIND /WAS THERE AN I?
+ AND [7700
+ SZA CLA
+ JMS ADDIND /YES - ADD INDIRECT BIT TO INSTRUCTION
+ TAD VALUE /GET ADDRESS
+ AND [177
+ TAD VALUE2 /GET OP CODE
+ DCA VALUE /STORE
+POPJ, TAD I PDLXR
+ DCA TEMP /POP A WORD OFF THE STACK
+ JMP I TEMP /JUMP THROUGH IT.
+\fADDIND, 0 /ROUTINE TO ADD INDIRECT BIT TO AN INSTR
+ TAD VALUE2
+ CMA
+ AND [400
+ SZA /WAS THERE ONE ALREADY?
+ JMP .+3 /NO
+ JMS I [ERROR /YES - ILLEGAL INDIRECT
+ II
+ TAD VALUE2
+ DCA VALUE2
+ JMP I ADDIND
+
+/ ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB
+
+PTCH, 0 /RUNS IN DF 10
+ TAD (7647 /POINT TO DEVICE
+ DCA PTR /HANDLER RESIDENCY TABLE
+ TAD [-17 /IT HAS 15 ENTRIES
+ DCA KNTR /V3C
+KLOOP, TAD I PTR /GET HANDLER ENTRY POINT
+ AND [7600 /LOOK AT PAGE IT'S ON
+ TAD [-INDEVH /IS IT ON THE PAGE WE PUT BUFFER OVER?
+ SNA CLA /WELL?
+ DCA I PTR /YES IT IS, WIPE IT FROM RESIDENCY
+ ISZ PTR /LOOK AT NEXT ENTRY
+ ISZ KNTR /ANY MORE ENTRIES?
+ JMP KLOOP /YES, MIGHT HAVE TO WIPE SEVERAL GUYS
+ TAD [200 /INCREASE INPUT BUFFER SIZE
+ JMP I PTCH /V3C
+ PAGE
+\f/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
+/ACCORDING TO LAST OPERATOR
+
+OP0, TAD VALUE2 /HANDLER FOR +
+ TAD VALUE /** OP0+1 AND OP0+2 JUMPED TO **
+ DCA VALUE
+EXP3, TAD CHAR /GET LAST OPERATOR
+ TAD [-"+ /WAS IT A + OR - ?
+ CLL RTR
+ SNA
+ JMP PLSMIN /YES - LINK=0 FOR +, 1 FOR -
+ RTL
+ TAD ("+-"%
+ CLL RAR
+ SNA /IS THE CHAR % OR &?
+ JMP DIVAND /YES - LINK=0 FOR %, 1 FOR &
+ RAL
+ TAD ("%-240
+ CLL RAR
+ SNA /IS THE CHAR SPACE OR !?
+ JMP BLKEXP /YES - LINK=0 FOR SPACE, 1 FOR !
+ RAL
+ TAD (240-"^
+ SNA CLA /IS THE CHAR ^?
+ JMP MUL /YES - LINK IRRELEVANT
+ JMS I (ENDCHK /NO-SEE IF END OF LINE FOUND
+ JMP EXP3 /NO-TRY AGAIN
+EXPXIT, TAD UNDFSW /EXIT FROM EXP
+ SNA CLA /RESTORE EXIT POINT
+ JMP I (POPJ /--EXIT VIA POPJ--
+ CLA CMA
+ DCA UNDFSW /SET UNDEFINED SWITCH
+ DCA VALUE /RESULT IS 0
+ JMP I (POPJ /--EXIT VIA POPJ--
+\fMUL, CLL IAC /LINK DOESN'T COUNT FOR ^
+BLKEXP, IAC /** BLANK ASSUMED TO BE 4 ELSEWHERE **
+DIVAND, IAC
+PLSMIN, RAL
+ JMP I (EXP1 /GET REST OF EXPRESSION
+
+/HANDLER FOR &
+
+OP2, TAD VALUE
+ AND VALUE2
+ JMP OP0+2
+
+
+/HANDLER FOR ^
+/MULTIPLY BY REPEATED ADDITION
+
+OP4, TAD VALUE
+ CIA
+ DCA TEMP
+ TAD VALUE2
+ ISZ TEMP
+ JMP .-2
+ JMP OP0+2
+
+OP1, TAD VALUE2 /- OPERATOR
+ CIA
+ JMP I (OP0+1 /JUMP INTO ADD OPERATOR
+
+/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:
+
+OP3, TAD VALUE
+ JMS I [RTL6
+ AND [7700 /ISOLATE 6 BITS AND FALL INTO "OR"
+ DCA VALUE /V3C
+
+/HANDLER FOR ! AND SPACE AS INCLUSIVE OR
+
+OP5, TAD VALUE
+ CMA
+ AND VALUE2
+ JMP I (OP0+1
+\f/CHARACTER INPUT CHECK
+/ENTER WITH CHARACTER IN AC
+
+LSTCH9, SZA /IGNORE NULL (0)
+ TAD (-177
+ SZA /IGNORE RUBOUT (377)
+ TAD (177-13
+ SZA /IGNORE VERTICAL TAB (213)
+ IAC
+ SNA
+ JMP I (INPUT+1 /IGNORE LINE FEED (212)
+ TAD [12-32 /WAS IT ^Z (END-OF-FILE=232)?
+ SNA
+ JMP I (ENDCHR /YES - GET NEXT FILE
+ TAD (32-15 /NO - WAS IT CARRIAGE RETURN?
+ SNA
+ JMP LSTCHR /YES - LAST CHARACTER OF LINE
+ IAC /NO
+ SNA /WAS IT FORM FEED (214)?
+ JMP FORCHR /YES - HANDLER FORM FEED
+ ISZ I (INPUT
+ TAD (14+200
+ DCA LSTCH5 /STORE CHARACTER
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP LSTCH4 /NO -
+ ISZ LSTCH6 /YES - FILLING HEADER AREA?
+ JMP LSTCH3 /YES
+ CLA CMA /NO - RESET SWITCH
+ DCA LSTCH6
+LSTCH4, TAD I (INPUT
+ DCA TEMP
+ TAD LSTCH5 /GET CHARACTER IN AC
+ JMP I TEMP /-EXIT FROM INPUT-
+
+LSTCH3, ISZ LSTCH7 /FILLING HEADER
+ TAD LSTCH5 /STORE CHARACTER IN HEADER AREA
+ DCA I LSTCH7
+ JMP LSTCH4
+
+LSTCH5, 0
+LSTCH6, -HEDLEN
+LSTCH7, HEADER-1
+\fLSTCHR, TAD FORMSW /CARRIAGE RETURN WAS FOUND
+ SNA CLA /HAS THERE BEEN A FORM FEED?
+ JMP LSTCH1 /NO -
+ DCA FORMSW /YES - CLEAR FORM FEED SWITCH
+ ISZ EDITPG /GO TO NEXT EDITOR PAGE
+ DCA THISPG /CLEAR OVERFLOW PAGE
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMS I [FORMFD /YES - GENERATE FORM FEED
+LSTCH1, TAD [215 /NO - CARRIAGE RETURN IS CHARACTER
+ DCA LSTCH5
+ JMP LSTCH4-2 /EXIT
+
+FORCHR, ISZ FORMSW /SET FORM FEED SWITCH
+ JMP I (INPUT+1 /GET ANOTHER CHARACTER
+
+FORMSW, 1
+ PAGE
+\f/ERROR MESSAGE OUTPUT
+
+DUMPS1,
+ERROR, 0
+ CLA
+ ISZ ERCNT /COUNT THE ERRORS
+ERPLUS, "+ /PROTECTION
+ TAD I ERROR /GET ERROR MESSAGE
+ ISZ ERROR /INCREMENT RETURN ADDRESS
+ JMS I [ERROR1 /OUTPUT 2 CHARACTER ERROR MESSAGE
+ TAD (JMP I [7600 /PUT EXIT TO MONITOR
+CSWIT1, DCA I (LSWITC /IN SWITCH - "CLA" IF /C
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMP ERROR4 /YES - CARRIAGE RETURN/LINE FEED
+ JMS I [ERROR1 /NO - OUTPUT 2 SPACES
+ TAD [1777 /IS THERE A TAG SAVED?
+ AND LAST1
+ SNA
+ JMP ERROR3 /NO
+ JMS I (DIV45 /YES - OUTPUT FIRST 2 CHARACTERS
+ TAD LAST2 /OUTPUT SECOND 2 CHARACTERS
+ JMS I (DIV45
+ TAD LAST3
+ JMS I (DIV45 /OUTPUT THIRD 2 CHARACTERS
+ TAD LAST4 /IS ERROR LOCATION SAME AS LAST TAG?
+ CIA
+ TAD LOC
+ SNA CLA
+ JMP ERROR4 /YES - CARRIAGE RETURN
+ TAD ERPLUS
+ JMS I OERROR
+ TAD LAST4
+ CIA
+ERROR3, TAD LOC /OUTPUT 4 DIGIT ADDRESS OR INCREMENT
+ JMS I (OCTPRT
+ERROR4, TAD [215 /OUTPUT CARRIAGE RETURN/LINE FEED
+ JMS I OERROR
+ JMP I ERROR /--RETURN--
+\f/RESET LITERAL TABLES AND POINTERS
+
+DUMPS5,
+CLEAN, 0
+ TAD (LITBUF-1
+ DCA XREG1 /SET LITERAL TABLE POINTER
+ TAD (TPINST-1
+ DCA XREG2 /SET TOP INST. TABLE POINTER
+ TAD (-40
+ DCA TEMP
+ TAD [200
+ DCA I XREG1 /SET LITERAL TABLE ENTRIES TO 200
+ DCA I XREG2 /SET TOP INST. TABLE ENTRIES TO 0
+ ISZ TEMP
+ JMP .-4
+ DCA LAST1 /CLEAR LAST DEFINED TAG
+ JMP I CLEAN /--RETURN--
+
+/DUMP CURRENT PAGE LITERALS
+
+DUMPS, 0
+ JMS I [FINDSP
+ SNA /IF THIS IS PAGE 0,
+ JMP I DUMPS /--RETURN--
+ TAD [LITBUF
+ DCA DUMPS1
+ TAD LITPTR
+ CIA CLL
+ TAD I DUMPS1
+ DCA DUMPS2 /STORE NUMBER OF LITERALS ON THIS PAGE
+ SZL /ARE THERE ANY?
+ JMP D2 /V3C
+ DCA STARSW /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
+ TAD LOC
+ AND [7600
+ TAD I DUMPS1
+ JMS I [PUNORG /OUTPUT ORIGIN
+ TAD I DUMPS1
+ TAD [LITBF1
+DUMPS3, DCA DUMPS5
+ TAD I [LINBUF /SAVE LINBUF
+ JMS I [PUSHA
+ DCA I [LINBUF
+DUMPS6, TAD I DUMPS5
+ DCA VALUE
+JMSPUN, JMS I [PUNONE /OUTPUT ONE REGISTER
+ ISZ LOC
+ ISZ DUMPS5
+LITHAK, ISZ I DUMPS1 /DESTROY RECORD OF CURRENT PAGE LITERALS -
+ /ZEROED IF NO /W OPTION SPECIFIED
+ ISZ DUMPS2
+ JMP DUMPS6
+ TAD I PDLXR
+ DCA I [LINBUF /RESTORE LINBUF
+D2, TAD DUMPS1 /WIPE REMEMBRANCE OF TOP OF PAGE (JR)
+ TAD (40 /V3C
+ DCA DUMPS5
+D3, DCA I DUMPS5
+ JMP I DUMPS /--RETURN--
+\f/HANDLER FOR ZBLOCK PSEUDO-OP
+/RESERVES AS MANY WORDS OF ZERO
+/AS VALUE OF EXPRESSION
+
+ZBLOCX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET THE EXPRESSION
+ TAD VALUE
+ CMA /PROTECT AGAINST ZERO CASE
+ DCA TEMP3 /STORE NEGATIVE AS COUNTER
+ JMP ZBLOCZ /JUMP INTO LOOP
+ZBLOCY, JMS I [PUNBIN /OUTPUT ONE WORD OF ZERO
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ DCA I (PUNMOD /YES - PREVENT OUTPUT
+ZBLOCZ, ISZ TEMP3 /NO - DONE YET?
+ JMP ZBLOCY /NO - CONTINUE
+ TAD JMSPUN /YES - RESTORE PUNMOD
+ DCA I (PUNMOD
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/DUMP PAGE 0 LITERALS
+
+DUMPS2,
+DUMPZ, 0
+ TAD DUMPZ /RESET EXIT FROM DUMPS
+ DCA DUMPS
+ TAD [200
+ CIA CLL
+ TAD I [LITBUF /STORE THE NUMBER OF LITERALS ON PAGE 0
+ DCA DUMPS2
+ SZL /ARE THERE ANY?
+ JMP I DUMPS /NO - ** DUMPZ IS DESTROYED **
+ TAD I [LITBUF
+ JMS I [PUNORG /OUTPUT ORIGIN
+ TAD I [LITBUF /SET VALUES FOR DUMPS
+ TAD (LITBF2
+ JMP DUMPS3
+ PAGE
+\f/ENTER A TAG INTO SYMBOL TABLE
+
+ IFZERO HASH<
+INSRTG, 0
+ TAD VALUE2 /SAVE VALUE 2
+ JMS I [PUSHA
+ ISZ HIGHTG /COUNT IN THIS TAG
+ TAD TAGMAX
+ CLL CIA /GET LIMIT OF SYMBOL STORAGE
+ TAD HIGHTG /IS THERE ROOM FOR ONE MORE?
+ SZL
+ JMP I (SYMOFL /NO - SE**FATAL ERROR**
+ TAD TAGMAX /YES - IS USR IN CORE?
+ TAD (-1340
+ SZL CLA
+ JMP GETTG5 /YES
+ TAD [7700 /NO - RESET ADDRESS TO
+ DCA IOMON /USR NON-RESIDENT
+ AC7776
+ AND I (JSBITS /RESET JOB STATUS WORD TO
+ DCA I (JSBITS /SAVE CORE WHEN USR CALLED
+GETTG5, TAD THISTG /SEARCH SYMBOL TABLE
+ DCA TEMP2
+ TAD HIGHTG
+ IAC
+ DCA THISTG
+GETTG8, AC7776
+ TAD THISTG
+ DCA THISTG
+ JMS I [FINDTG /GET NEXT TAG FROM SYMBOL TABLE
+ ISZ THISTG
+ TAD THISTG
+ CIA
+ TAD TEMP2 /DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
+ SNA CLA
+ JMP GETTG9 /YES-PUT IT THERE AND EXIT
+ JMS I [PUTTAG /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
+ JMP GETTG8
+
+/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
+/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE
+
+GETTG9, TAD I (NAME1 /GET CURRENT TAG
+ DCA TAG1 /PUT IT IN TAG1-TAG3
+ TAD I (NAME2
+ DCA TAG2
+ TAD I (NAME3
+ DCA TAG3
+ TAD I PDLXR /RESTORE VALUE 2
+ DCA VALUE2
+ JMS I [PUTTAG /PUT TAG1 - TAG3 INTO SYMBOL TABLE
+ JMP I INSRTG /--RETURN--
+
+TAGMAX, 1740 /12K=3740, ...
+ >
+
+/ IFNZRO HASH< /***HACK ONLY***
+/TLYREF, 0 /TALLY REFS TO SYMBOL TABLE
+/ ISZ NREFL
+/ JMP I TLYREF
+/ ISZ NREFH
+/ JMP I TLYREF
+/ JMP I TLYREF
+/TLYPRB, 0 /TALLY PROBES INTO TABLE
+/ JMS I [FINDTG /FUDGE, OUT OF ROOM
+/ ISZ NPROBL
+/ JMP I TLYPRB
+/ ISZ NPROBH
+/ JMP I TLYPRB
+/ JMP I TLYPRB
+/NREFH, 0
+/NREFL, 0
+/NPROBH, 0
+/NPROBL, 0
+/ > /***HACK ONLY***
+\f IFNZRO HASH<
+
+ /INSERT A TAG INTO THE HASH TABLE
+
+INSRTG, 0
+ ISZ HIGHTG /BUMP SYM NUM (SKIPS ON 0)
+ TAD HIGHTG
+ STL CMA
+ TAD TAGMAX
+ SNA SZL CLA /STILL ROOM FOR AT LEAST 2 MORE?
+ JMP I (SYMOFL /NO SE** FATAL ERROR**
+ TAD I (NAME1
+ DCA TAG1
+ TAD I (NAME2
+ DCA TAG2
+ TAD I (NAME3
+ DCA TAG3
+ JMS I [PUTTAG /NOW ACTUALLY INSERT IT
+ JMP I INSRTG
+ >
+\f/OUTPUT 2 CHARACTER WORD
+/FROM SYMBOL TABLE FORMAT
+/DIVIDE BY 45(8)
+
+DIV45, 0
+ RAL
+ CLL RAR /CLEAR SIGN BIT
+DIV45A, ISZ DIV45C
+ TAD (-45
+ SMA
+ JMP DIV45A
+ TAD (45
+ JMS DIV45E
+ DCA DIV45B
+ STA
+ TAD DIV45C
+ JMS DIV45E
+ JMS I [RTL6
+ TAD DIV45B
+ JMS I [ERROR1 /OUTPUT 2 CHARACTERS
+ DCA DIV45C /CLEAR DIV45C FOR NEXT GO-ROUND
+ JMP I DIV45 /--RETURN--
+
+DIV45B, 0
+DIV45C, 0 /** MUST BE 0 WHEN DIV45 IS ENTERED **
+
+DIV45E, 0
+ SNA
+ JMP I DIV45E
+ TAD (-33
+ SMA
+ TAD (20-40-33
+ TAD (33+40
+ JMP I DIV45E /--RETURN--
+\f/HANDLER FOR FIXTAB PSEUDO-OP
+
+FIXTBX, TAD PASS /IS THIS PASS 1?
+ SMA CLA
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ JMP I (FIXTAY /YES--DO FIXTAB
+
+/SET FIELD
+
+SETFLD, 0
+ CLA CLL /SETFLD CALLED WITH AC RANDOM
+ DCA SETFL1 /INITIALIZE FIELD
+ IFNZRO HASH<
+ TAD USROFS /FUDGE FOR KEEPING USR AROUND
+ >
+ TAD THISTG
+SETFLP, ISZ SETFL1
+ CML
+ TAD (-1740 /PUT 1740 SYMBOLS IN EACH FIELD
+ SNL /IS THE DIVIDE THROUGH?
+ JMP SETFLP /NO - CONTINUE
+ IFZERO HASH<
+ CLL CMA RTL /AC CONTAINED REM-1740; THIS MAKES IT INTO
+ TAD (-1 /7573-4*REM WHICH IS THE ADDRESS WE WANT
+ >
+ IFNZRO HASH<
+ CLL RTL /AC GETS 0201 TO 7775
+ TAD (-202 /AC GETS 7777 TO 7573 FOR TAGXR
+ >
+ DCA TAGXR /TO STICK INTO AN AUTO-XR
+ TAD SETFL1
+ CLL RTL
+ RAL
+ TAD SETFL2
+ DCA SETFL1
+SETFL1, HLT
+ JMP I SETFLD /--RETURN--
+ IFNZRO HASH<
+USROFS, 0 /GETS 400 IF KEEPING USR
+ >
+\f/FIND TAG
+/GET TAG FROM SYMBOL TABLE
+/PUT IT INTO TAG1-TAG3
+/WITH ITS VALUE IN VALUE2
+
+FINDTG, 0
+ TAD THISTG
+ JMS SETFLD
+ TAD I TAGXR
+ DCA TAG1
+ TAD I TAGXR
+ DCA TAG2
+ TAD I TAGXR
+ DCA TAG3
+ TAD I TAGXR
+ DCA VALUE2
+SETFL2, CDF
+ JMP I FINDTG /--RETURN--
+
+/OPTIMIZATION MAY CHANGE SETFLD TO
+/REMOVE CLA ON ENTRY
+ PAGE
+\f/BEGINNING OF PASS CODE
+
+ JMS I (IOPEN /SET INPUT ROUTINE TO OPEN FILE
+START2, ISZ PASS /SET UP COUNTERS AND POINTERS
+ DCA XLISTX /CLEAR XLIST SWITCH
+ DCA FLDIND /SET FIELD TO 0
+ DCA CONDSW
+ DCA EDITPG
+ DCA LINK
+ DCA RADIX
+ DCA ERCNT
+ DCA GETCI
+ DCA PUNCHX
+ DCA I [LINBUF
+ TAD (PDLST
+ DCA PDLXR
+ JMS I [CLEAN
+ TAD [200
+ DCA LITPTR
+ TAD [200
+ JMS I [PUNORG
+ JMP I (LOOKE1 /--EXIT TO MAIN--
+
+/HANDLER FOR $
+
+ENDPAS, JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
+ DCA OFSBUF /CLEAR OFFSET FOR NEXT PASS
+ TAD PASS /WHAT PASS IS ENDING?
+ SNA
+ JMP I (ENDPA2 /PASS 2
+ SPA CLA
+ JMP I (START1 /PASS 1
+ TAD I [LINBUF /PASS 3
+ SNA CLA /ANYTHING TO PRINT?
+ JMP ENDPA1-1 /NO
+ TAD [211 /YES - TAB OVER TWICE
+ JMS I OERROR
+ TAD [211
+ JMS I OERROR
+ JMS I [LINPRT /PRINT LINE
+ JMS I [DUMPZ /DUMP PAGE 0 LITERALS
+ENDPA1, DCA XLISTX
+/OUTPUT SYMBOL TABLE
+SSWITC, JMS I (SYMPRT /(0 IF /S)
+ TAD I (FORM21
+ DCA I (FORM22
+ JMS I [FORMFD /OUTPUT FORM FEED
+ERMSGS, TAD ERCNT
+ JMS OUTTTL /PRINT "ERRORS DETECTED: N"
+ TAD LINK
+ JMS OUTTTL /PRINT "LINKS GENERATED: N"
+FINLFF, JMS I [FORMFD /PRINT FINAL FF (ZEROED IF NO PASS 3)
+ JMS I (OCLOSE /AND CLOSE THE OUTPUT FILE
+\f/CREF AND LOAD-AND-GO OPTIONS
+/****FINAL EXIT TO MONITOR****
+LSWITC, JMP I [7605 /0 IF /L OR /G OR /C
+ TAD (7616
+ DCA XREG1
+ CDF 10
+CSWITC, TAD I [7600 /"TAD I [7605" IF /C
+ AND [17
+ DCA I XREG1 /SET BINARY DEVICE
+ TAD BINSRT
+
+/EXIT FROM PAL8 BY CHAINING
+/TO NEXT PROGRAM
+/SHOULD BE ABSLDR OR CREF
+
+ DCA I XREG1 /SET STARTING BLOCK
+ DCA I XREG1 /SET 0 TERMINATOR
+ CDF
+ TAD I (JSBITS /SET BIT 11 OF JOB STATUS WORD
+ RAR /SO 10000-11777 IS NOT SAVED
+ CLL CML RAL
+ DCA I (JSBITS
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 6 /*CHAIN TO NEXT PROGRAM*
+CHAIN, 0 /STARTING BLOCK OF NEXT PROGRAM
+
+OUTTTL, 0
+ DCA LAST1 /SAVE NUMBER TO BE PRINTED
+OUTTLL, TAD I TTLPTR /GET A WORD OF MESSAGE
+ ISZ TTLPTR
+ SNA /END?
+ JMP PRTTTL /YES
+ JMS I [ERROR1 /NO - PRINT IT
+ JMP OUTTLL /AND LOOP
+PRTTTL, TAD [240 /PRINT A SPACE
+ JMS I OCHAR
+ TAD LAST1
+ JMS I (FORMF4 /PRINT NUMBER IN DECIMAL
+ JMS I (CRLF /PRINT CR AND 2 LF'S (1 IF PASS 3)
+ JMP I OUTTTL /AND RETURN
+
+TTLPTR, TTLMSG
+\f/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2
+
+LOADOV, JMS I (7607 /CALL SYSTEM DEVICE HANDLER
+ 0200 /SWAP IN CODE UNIQUE TO PASS 3
+ SWAP1 /BUFFER ADDRESS
+ ASWAP /STARTING BLOCK NUMBER
+ JMP I (SYSER3 /DE**FATAL ERROR**
+NSWITC, JMP START2 /(0 IF NO LIST FILE, SKP IF /N) START PASS3
+ JMP ERMSG1
+ JMP ENDPA1
+
+ERMSG1, TAD (OTYPEO /COME HERE IF NO PASS 3 OUTPUT FILE
+ DCA OCHAR
+ TAD (OTYPEO
+ DCA OERROR
+ TAD [7600
+ DCA I (OTYPCR /INHIBIT AUTO-LF ON CARRIAGE RETURN
+ DCA FINLFF /KILL LAST FORM FEED
+ JMP ERMSGS
+
+/ADD BITS TO PUNCH ORIGIN
+
+PUNORG, 0
+ DCA LOC
+ TAD PASS /IS THIS PASS 2?
+ SZA CLA
+ JMP I PUNORG /NO--RETURN--
+ TAD LOC /YES - OUTPUT ORIGIN SETTING
+ TAD OFFSET /"LOC" MAY BE FICTITIOUS - MAKE IT REAL
+ CLL CML
+ ISZ STARSW /INHIBIT PUNCHING ORIGIN IF NECESSARY
+ JMS I [PUNOUT
+ CLA
+ DCA STARSW /RESET SWITCH
+ JMP I PUNORG /--RETURN--
+ PAGE
+\f\f/EVALUATE LITERAL
+
+LIT, STA RAL /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
+ DCA FINDS1 /SAVE FLAG
+ JMS I [GETC /GET NEXT CHARACTER
+ JMS I [SPNOR /IGNORE SPACES
+ TAD EXPIND /STORE IMPORTANT VALUES PRIOR TO
+ JMS I [PUSHA /ENTRANCE INTO EXP
+ TAD OP
+ JMS I [PUSHA
+ TAD VALUE
+ JMS I [PUSHA
+ TAD FINDS1
+ JMS I [PUSHA
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /FIND LITERAL IN TABLE
+ ISZ I PDLXR /PAGE 0?
+ JMP .+3
+ JMS FINDS /NO
+ SKP
+ JMS FIND0 /YES
+ DCA VALUE2 /STORE ADDRESS
+ TAD I PDLXR
+ DCA VALUE
+ TAD I PDLXR /RESTORE SAVED VALUES
+ DCA OP
+ TAD I PDLXR
+ DCA EXPIND
+ TAD CHAR /IGNORE ) OR ]
+ TAD (-")
+ SZA
+ TAD (")-"]
+ SNA CLA
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP I (NUMBE5 /RETURN TO EXPRESSION PROCESSOR
+
+
+PEZE, 0 /SUBR TO ISSUE PE OR ZE MESSAGE
+ SNA CLA /WHICH ONE?
+ JMP .+4 /PAGE 0
+ JMS I PERROR
+ PE
+ JMP I PEZE
+ JMS I PERROR
+ ZE
+ JMP I PEZE
+\f/FIND LITERAL ON CURRENT PAGE
+
+FINDS, 0
+ DCA FINDS1
+ TAD LOC
+ AND [7600
+ SNA /IS THIS PAGE 0?
+ JMP FIND01 /YES
+ DCA FINDS2 /NO - SAVE PAGE NUMBER
+ TAD [LITBF1
+ DCA FIND0
+ TAD [7700 /ALLOW 100(8) CURRENT PAGE LITERALS
+ DCA FORMF6
+ TAD LITPTR /GET PG ADDR OF 1ST LITERAL IN BUFFER
+FIND02, DCA FINDS3
+ TAD FINDS2
+ JMS I [RTL6
+ TAD [LITBUF
+ DCA TEMP
+ TAD FIND0 /COMPUTE ACTUAL CORE ADDRESS OF LITERAL
+ TAD I TEMP
+ DCA TEMP2
+ TAD FINDS3 /COMPUTE THE NUMBER OF ENTRIES
+ CIA
+ TAD I TEMP /IN THE LITERAL BUFFER
+ SNA
+ JMP FINDS6 /NONE
+ DCA FINDS3
+FINDS4, TAD I TEMP2 /GET LITERAL FROM TABLE
+ CIA
+ TAD FINDS1 /AND CURRENT LITERAL
+ SNA CLA /DO THEY MATCH?
+ JMP FINDS5 /YES
+ ISZ TEMP2 /NO - BUMP COUNTERS
+ ISZ FINDS3
+ JMP FINDS4 /TRY AGAIN
+FINDS6, TAD FINDS2
+ JMS I [RTL6
+ TAD [TPINST
+ DCA FINDS3
+ TAD I TEMP /DOES THIS OVERFLOW PAGE?
+ CIA
+ TAD I FINDS3
+ SPA CLA
+ JMP FINDS7 /NO
+
+\fFIND03, TAD FINDS2 /PAGE FULL - WHICH PAGE?
+ JMS PEZE /GENERATE PE OR ZE MESSAGE
+ CLA CMA
+ JMP FINDS9
+FINDS7, CLA CMA
+ TAD I TEMP /IS PAGE FULL?
+ AND FORMF6
+ SNA CLA
+ JMP FIND03 /YES - OUTPUT ERROR MESSAGE
+ CLA CMA
+ TAD I TEMP /NO
+ DCA I TEMP
+FINDS9, TAD I TEMP
+ TAD FIND0
+ DCA TEMP2
+ TAD FINDS1
+ DCA I TEMP2
+FINDS5, TAD FIND0 /GET ADDRESS OF LITERAL
+ CIA
+ TAD TEMP2
+ TAD FINDS2
+ JMP I FINDS /--RETURN--
+
+
+/FIND LITERAL ON PAGE 0
+
+FIND0, 0
+ DCA FINDS1
+ TAD FIND0 /RESET EXIT FROM FINDS
+ DCA FINDS
+FIND01, DCA FINDS2 /SET POINTERS
+ TAD (LITBF2
+ DCA FIND0
+ TAD [7760 /ALLOW 160(8) PAGE 0 LITERALS
+ DCA FORMF6
+ TAD [200
+ JMP FIND02
+
+FINDS1, 0
+FINDS2, 0
+FINDS3, 0
+ PAGE
+\f/HANDLER FOR IFZERO PSEUDO-OP
+
+IF0, TAD (10 /IFTST1, SNA CLA
+
+/HANDLER FOR IFNZERO PSEUDO-OP
+
+IFN0, TAD IFSZA /IFTST1, SZA CLA
+ DCA IFTST1
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION
+IFTST3, TAD CHAR /GET LAST CHARACTER
+ TAD (-"<
+ SNA CLA /IS IT <?
+ JMP IFTST2 /YES
+ JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
+IFTST9, JMS I [SPNOR /IGNORE SPACES
+ JMP IFTST3 /TRY AGAIN
+
+IFTST2, JMS I [GETC /GET NEXT CHARACTER
+ TAD CONDSW
+ CIA
+ DCA CONDTM /SET NUMBER OF NESTED CONDITIONALS
+ CLA CMA /DECREMENT NUMBER OF NESTED CONDITIONALS
+ TAD CONDSW
+ DCA CONDSW
+ TAD VALUE
+IFTST1, HLT /SZA CLA OR SNA CLA
+ JMP I (MAIN /--EXIT TO MAIN--
+IFTST5, TAD CONDSW /DONE WITH ALL CONDITIONALS IN NEST?
+ TAD CONDTM
+ SMA CLA
+ JMP I (MAIN /YES --EXIT TO MAIN--
+ TAD CHAR
+ TAD (-"< /NO - GET NEXT CHARACTER
+ SNA /IS IT <?
+ JMP IFTST6 /YES - HANDLE NEXT CONDITIONAL
+ TAD ("<-"> /NO - IS IT >?
+IFSZA, SZA CLA
+ JMP IFTST4 /NO - FINISH THIS CONDITIONAL
+ AC7776
+IFTST6, CMA
+ TAD CONDSW
+ DCA CONDSW
+IFTST4, DCA I [LINBUF /INHIBIT LISTING OF UNASSEMBLED CODE -
+ /ZEROED IF /J OPTION NOT SPECIFIED
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP IFTST5
+\f/HANDLER FOR IFDEF PSEUDO-OP
+
+IFD, TAD (10 /IFTST1, SNA CLA
+
+/HANDLER FOR IFNDEF PSEUDO-OP
+
+IFND, TAD IFSZA /IFTST1, SZA CLA
+ DCA IFTST1
+IFTST7, JMS I [SPNOR /IGNORE SPACES
+ JMS I [TSTALP /IS NEXT CHARACTER ALPHABETIC
+ JMP IFTST8 /YES
+ JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
+ JMP IFTST7 /KEEP TRYING
+
+IFTST8, JMS I [GETTAG /PICK UP TAG
+ DCA VALUE /STORE UNDEFINED INDICATOR
+ TAD TAG3 /WAS IT A PSEUDO-OP?
+ SMA CLA
+ JMP IFTST9 /NO
+ JMS I [ERROR /YES - GENERATE IP ERROR MESSAGE
+ IP
+ JMP IFTST9
+
+ICMESG, 0
+ JMS I [ERROR
+ IC /IC COMES OUT ON ALL PASSES
+ TAD CHAR
+ SPA CLA
+ JMP I [LOOKEX /END OF LINE - GO AWAY
+ JMS I [GETC /GET NEXT CHAR
+ JMP I ICMESG
+\fCONDTM,
+
+/PUT TAG IN SYMBOL TABLE
+
+PUTTAG, 0
+ TAD THISTG
+ JMS I (SETFLD /SET FIELD
+ TAD TAG1
+ DCA I TAGXR
+ TAD TAG2
+ DCA I TAGXR
+ TAD TAG3
+ DCA I TAGXR
+ TAD VALUE2
+ DCA I TAGXR
+ CDF
+ JMP I PUTTAG /--RETURN--
+
+
+/PUSHDOWN ROUTINE
+/PUT NEW ENTRY ON PUSHDOWN STACK
+
+PUSHA, 0
+ DCA TEMP
+ CLA CMA
+ TAD PDLXR
+ DCA PDLXR
+ TAD PDLXR
+ TAD (-PDLND
+ SPA CLA /IS LIST TOO FULL?
+ JMP PUSHA1 /BE**FATAL ERROR**
+ TAD TEMP /NO - MAKE ENTRY
+ DCA I PDLXR
+ CLA CMA
+ TAD PDLXR
+ DCA PDLXR
+ JMP I PUSHA /--RETURN--
+
+PUSHA1, TAD (BE
+ JMP I [MONERR /PUSHDOWN OVERFLOW IS FATAL ERROR
+\f/TEST NUMERIC ROUTINE
+/CALL WITH CHARACTER TO TEST IN "CHAR"
+/SKIPS IF THE CHARACTER IS NOT NUMERIC
+
+TSTNUM, 0
+ TAD CHAR /GET THE CHARACTER
+ TAD (-"9-1
+ CLL
+ TAD ("9-"0+1
+ SNL CLA /CHECK FOR RANGE 0-9
+ ISZ TSTNUM /OUT OF RANGE
+ JMP I TSTNUM /--RETURN--
+
+/TEST ALPHANUMERIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF CHARACTER IS NOT ALPHANUMERIC
+
+TSTALN, 0
+ JMS I [TSTNUM /IS IT NUMERIC
+ JMP I TSTALN /YES--RETURN--
+ JMS I [TSTALP /IS IT ALPHABETIC
+ JMP I TSTALN /YES--RETURN--
+ ISZ TSTALN /NEITHER
+ JMP I TSTALN /--RETURN--
+
+/TEST ALPHABETIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF NOT ALPHABETIC
+
+TSTALP, 0
+ TAD CHAR
+ TAD (-"Z-1
+ CLL
+ TAD ("Z-"A+1
+ SNL CLA /CHECK FOR RANGE A-Z
+ ISZ TSTALP /OUT OF RANGE
+ JMP I TSTALP /--RETURN--
+ PAGE
+\f/INPUT ROUTINE
+/UNPACKS CHARACTERS FROM BUFFER
+
+INPUT, 0
+ ISZ INCHCT /ARE THERE CHARACTERS LEFT IN BUFFER?
+ JMP I CHARLV /YES - FETCH ONE
+ TAD INEOF /NO - WAS OLD FILE ENDED?
+ SZA CLA
+ JMP ENDCHR /YES - START NEW FILE
+INGBUF, TAD INCTLA /NO
+ AND [7600
+ JMS I [RTL6
+ TAD INCTR
+ SNL
+ DCA INCTR
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR /SET CONTROL WORD
+ RTR
+ RTR
+ TAD INCTLA
+ DCA INCTLW
+ JMS I INHNDL /CALL INPUT DEVICE HANDLER
+INCTLW, 0 /CONTROL WORD
+INBUFP, INBUF /INPUT BUFFER ADDRESS
+INREC, 0 /STARTING BLOCK NUMBER
+ JMP INERRX /ERROR RETURN
+INBREC, TAD INCTLA /NORMAL RETURN
+ AND [7600
+ JMS I [RTL6
+ TAD INREC
+ DCA INREC /RESET STARTING BLOCK NUMBER
+ TAD INCTLW
+ AND [7600
+ CLL RAL
+ TAD INCTLW
+ AND [7600
+ CIA
+ DCA INCHCT /SET CHARACTER COUNT
+ TAD INBUFP
+ DCA INPTR /SET BUFFER POINTER
+\f/CHARACTERS ARE FOUND IN BUFFER
+/IN STANDARD OS/8 PACKING
+/WORD 1: AAA A11 111 111
+/WORD 2: BBB B22 222 222
+/WHICH REPRESENTS 3 CHARACTERS
+/CHARACTER 1: 11 111 111
+/CHARACTER 2: 22 222 222
+/CHARACTER 3: AA AAB BBB
+
+
+ICHAR1, TAD I INPTR /PICK UP CHARACTER WORD 1
+ JMS CHARLV /CHECK RIGHT 8 BITS
+ICHAR2, TAD I INPTR /PICK UP WORD 1
+ ISZ INPTR /(INCREMENT POINTER TO WORD 2)
+ AND [7400 /WITH WORD 1 IN AC
+ DCA INCTLW /RETRIEVE LEFT 4 BITS AND SAVE
+ TAD I INPTR /PICK UP WORD 2
+ JMS CHARLV /CHECK RIGHT 8 BITS
+ICHAR3, TAD I INPTR /PICK UP WORD 2
+ ISZ INPTR /(POINT TO NEXT WORD 1)
+ AND [7400 /WITH WORD 2 IN AC
+ CLL RTR /RETRIEVE LEFT 4 BITS
+ RTR
+ TAD INCTLW /PUT BOTH SETS OF 4 BITS TOGETHER
+ RTR
+ RTR
+ JMS CHARLV /CHECK CHARACTER
+ JMP ICHAR1 /TRY NEXT SET OF 2 WORDS
+
+INERRX, ISZ INEOF
+ SMA CLA /EOF OR FATAL ERROR?
+ JMP INBREC /EOF - UNPACK THIS BUFFER
+ JMP I (SYSERR /FATAL - GENERATE DE ERROR MESSAGE
+
+INCHCT, -1
+INEOF, 1
+INPTR, 0
+INCTR, 0
+INCTLA, 0
+INFPTR, 7617
+\f/START NEW FILE
+
+ENDCHR, ISZ I (FORMSW /^Z OR EOF SIMULATES FORM FEED
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP NXTFLE /NO
+ JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
+ TAD [-HEDLEN
+ DCA I (LSTCH6
+ TAD [HEADER-1
+ DCA I (LSTCH7
+ DCA LSTCNT
+NXTFLE, TAD (INDEVH+1 /SET ADDRESS OF DEVICE HANDLER
+ DCA INHNDL
+ CDF 10
+ TAD I INFPTR
+ CDF
+ SNA
+ JMP FAKDLR /END OF FILE - FAKE A $
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 1 /*FETCH HANDLER*
+INHNDL, 0 /LOADING ADDRESS OF HANDLER
+ HLT /ERROR RETURN
+ CDF 10 /V3C
+ TAD INHNDL /NORMAL RETURN - HANDLER IN CORE
+ AND [7600
+ TAD [-INDEVH /SEE IF INPUT HANDLER IS IN 7200
+ SZA CLA
+ JMS I (PTCH /IT IS - INCREASE SIZE OF BUFFER
+ /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
+ TAD INCTL
+ DCA INCTLA /DF=10
+ TAD I INFPTR
+ AND [7760
+ SZA
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA INCTR
+ ISZ INFPTR
+ TAD I INFPTR
+ DCA INREC /RESET STARTING BLOCK NUMBER
+ ISZ INFPTR
+ DCA INEOF
+ CDF
+ JMP INGBUF
+\fFAKDLR, TAD (244
+ JMS CHARLV /CALL THE COROUTINE
+ TAD [215 /WITH $ AND CR
+ JMS CHARLV /TO END THE ASSEMBLY.
+ JMP I (PHASE /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL
+
+CHARLV, 0 /CHARACTER IN AC
+ AND [177 /AND OFF LEFT 5 BITS
+ JMP I (LSTCH9 /RETURN TO LSTCH9
+ PAGE
+\f/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
+/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
+/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
+/ADDED TO CHECKSUM
+
+DTORGX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION
+ TAD PASS /IS THIS PASS 2?
+ SNA
+ JMP DTORG2 /YES
+PUNVA1, SPA SNA CLA /NO - IS THIS PASS 3?
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ TAD LININD /GET LINK SWITCH FROM "EXP"
+ DCA LINKSW /YES
+ TAD [LOOKEX /FIX PUNONE TO EXIT TO MAIN
+ DCA I (PUNONE
+ TAD [211 /OUTPUT TAB
+ JMS I OERROR
+ JMP I (DTORG1
+
+DTORG2, TAD VALUE /PASS 2 - GET BLOCK NUMBER
+ JMS I [RTL6
+ RAL
+ AND [77
+ TAD (300 /PICK UP CHANNELS 7 AND 8
+ DCA TEMP
+ TAD TEMP
+ TAD CHKSUM /ADD VALUE TO CHECKSUM
+ DCA CHKSUM
+ TAD TEMP
+ JMS I OCHAR /OUTPUT BLOCK NUMBER - FIRST FRAME
+ TAD VALUE
+ AND [77
+ JMS I OCHAR /OUTPUT SECOND FRAME
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/HANDLER FOR %
+/DIVIDE BY REPEATED SUBTRACTION
+
+OP6, DCA TEMP
+ TAD VALUE2
+ CIA
+ DCA VALUE2
+ TAD VALUE
+OP6A, CLL
+ TAD VALUE2 /SUBTRACT DIVISOR FROM DIVIDEND
+ SNL /DONE YET?
+ JMP OP6B /YES - EXIT
+ ISZ TEMP /NO - COUNT ONE MORE SUBTRACTION
+ JMP OP6A /SUBTRACT AGAIN
+OP6B, CLA
+ TAD TEMP /RESULT IS # OF SUBTRACTIONS
+ JMP I (OP0+2
+\f/HANDLER FOR XLIST PSEUDO-OP
+
+XLISTY, JMS XLISTZ /ANY EXPRESSION?
+ JMP XLIST1 /NO
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /USE THE VALUE
+XLIST2, DCA XLISTX /SET SWITCH
+ DCA I [LINBUF /XLIST NEVER LISTS!
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+XLIST1, TAD XLISTX
+ SNA CLA
+ IAC /FLIP IT
+ JMP XLIST2
+
+RELOCY, JMS XLISTZ /RELOCATE PSEUDO-OP - EXPRESSION?
+ JMP RELOC1 /NO
+ JMS I [EXP /GET IT
+ TAD VALUE
+ CIA /COMPUTE OFFSET OF REL LOC CTR
+ TAD LOC /FROM FAKE LOC CTR
+ TAD OFFSET /OFFSET IS CUMULATIVE!
+RELOC2, DCA OFSBUF /SET NEW OFFSET - THIS TAKES EFFECT AFTER
+ STA /THE LITERALS (IF ANY) ARE DUMPED.
+ JMP I (STAR0 /FAKE ORIGIN TO NEW LOC,
+ /ACTUALLY A NO-OP BECAUSE OF OFFSET
+RELOC1, TAD OFFSET /SET OFSBUF=0, LOC=LOC+OFFSET -
+ TAD LOC /THIS CANCELS ALL RELOCATION STUFF.
+ DCA VALUE
+ DCA UNDFSW /JUST IN CASE - "STAR0" CHECKS THIS
+ JMP RELOC2 /STILL MUST OUTPUT *. TO GET IN SYNCH
+\f/HANDLER FOR EJECT PSEUDO-OP
+
+EJECTX, ISZ THISPG
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMP EJECT2 /YES
+EJECT1, TAD CHAR /NO - LOOK FOR NEXT NEGATIVE CHARACTER
+ SPA CLA
+ JMP I [LOOKEX /--EXIT TO MAIN--
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP EJECT1
+
+EJECT2, JMS XLISTZ /PASS 3 - IS THERE AN EXPRESSION?
+ JMP EJECT3 /NO - EXIT
+ JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
+ TAD [-HEDLEN
+ DCA EJECT7 /SET UP FOR 40 NEW CHARACTERS
+ TAD [HEADER-1
+ DCA XREG1 /SET HEADER BUFFER POINTER
+ JMP EJECT4
+
+EJECT6, ISZ EJECT7 /FILLED 40 CHARACTERS YET?
+ JMP EJECT4 /NO - KEEP FILLING
+ CLA CMA /YES - SKIP CHARACTERS TO
+ DCA EJECT7 /END OF LINE
+ JMP EJECT5
+
+EJECT4, TAD CHAR /FILL HEADING BUFFER
+ DCA I XREG1
+EJECT5, CLA CMA
+ DCA TXTSWT
+ JMS I [GETC /GET NEXT CHARACTER
+ TAD CHAR /END OF LINE?
+ SMA CLA
+ JMP EJECT6 /NO - KEEP FILLING
+EJECT3, JMS I [FORMFD /GENERATE FORM FEED
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\fPUNVAL, TAD PASS /IS THIS PASS 3?
+ JMP PUNVA1 /IF SO, LIST STUFF
+
+
+/SEE IF EXPRESSION FOLLOWS XLIST
+/SKIP ON EXPRESSION
+
+EJECT7,
+XLISTZ, 0
+ JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD CHAR
+ TAD [-"> /IS THERE AN EXPRESSION?
+ SNA CLA
+ JMP I XLISTZ /NO--RETURN--
+ TAD CHAR
+ SMA CLA
+ ISZ XLISTZ /YES - INCREMENT RETURN ADDRESS
+ JMP I XLISTZ /--RETURN--
+
+
+/DUMMY ERROR ROUTINE
+/TO SUPPRESS CERTAIN ERROR MESSAGES
+/ON PASS 1
+
+PERRO1, 0
+ ISZ PERRO1 /SKIP ERROR MESSAGE POINTER
+ JMP I PERRO1 /--RETURN--
+
+
+/CONSTANTS FOR DECIMAL PRINT
+
+ DECIMAL
+FORMF8, -1000
+ -100
+ -10
+ 0
+ OCTAL
+ PAGE
+\f/*********************************************************************
+
+INBUF=. /INPUT BUFFER
+
+OUBUF=. /OUTPUT BUFFER
+
+OUDEVH=.+400 /OUTPUT DEVICE HANDLER
+
+INDEVH=7200 /INPUT DEVICE HANDLER
+
+/**********************************************************************
+
+/ EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM
+
+/PASS1:
+
+/ THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
+/ THE INPUT HANDLER GOES IN 7200-7600.
+/ THERE IS NO OUTPUT HANDLER.
+/ HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
+/ LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
+/ SO THAT THE INPUT BUFFER IS 5600-7600
+
+/PASS2 AND PASS3:
+
+/ THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
+/ AT 5600-6200.
+/ THE OUTPUT HANDLER RESIDES IN 6200-6600.
+/ THE INPUT HANDLER RESIDES IN 7200-7600.
+/ THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
+/ BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
+/ THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
+/ DON'T EXIST.
+
+/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
+/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
+/WERE ANY HANDLERS THERE. IF ANY HANDLERS WERE THERE IN THE PAST,
+/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
+\f/MORE ONCE ONLY CODE
+
+OTYPE, 0
+ DCA TEMP
+ CDF 10
+ TAD I TEMP
+ AND [17 /GET DEVICE NUMBER
+ TAD (DCB-1
+ DCA TEMP
+ TAD I TEMP /GET DCB ENTRY
+ CDF
+ JMP I OTYPE /--RETURN--
+
+/CHECK TO SEE HOW MUCH CORE EXISTS
+/AND STORE SYMBOL TABLE ACCORDINGLY
+
+ IFZERO HASH<
+BEGINF, CDF 10 /WAS THE /K OPTION SELECTED TO
+ TAD I (MPARAM /CHECK FOR MORE THAN 8K?
+ CDF 0
+ RTR
+ZK7630, SNL CLA /YES
+ JMP I (CKBAT /NO - CHECK FOR BATCH, USE 8K ONLY
+ CDF 50
+ JMS FLD2 /WHAT IS HIGHEST FIELD?
+ JMP FLD1-1 /5
+ CDF 40
+ JMS FLD2
+ JMP FLD1 /4
+ CDF 30
+ JMS FLD2
+ JMP FLD1+1 /3
+ CDF 20
+ JMS FLD2
+ JMP FLD1+2 /2
+ JMP OPTIM4 /1
+\f TAD [177 /IF FIELD 5, ALLOW 4095 SYMBOLS
+FLD1, TAD (1740 /OTHERWISE ALLOW 1740*(NR OF FIELDS)
+ TAD (1740
+ TAD (1740
+OPTIM0, TAD (1740
+ DCA I (TAGMAX /SET HIGHEST ADDRESS FOR TAGS
+ JMP I (BEGING
+
+OPTIM4, TAD I OPTIM1 /OPTIMIZE SEARCH PATTERN
+ ISZ OPTIM1 /BY SUBSTITUTING CODE IN SEARCH
+ DCA I OPTIM2 /ROUTINE
+ ISZ OPTIM2
+ ISZ OPTIM3
+ JMP OPTIM4
+OPTIM8, TAD I OPTIM5
+ ISZ OPTIM5
+ DCA I OPTIM6
+ ISZ OPTIM6
+ ISZ OPTIM7
+ JMP OPTIM8
+ JMP OPTIM0
+ >
+
+ IFNZRO HASH<
+ /SIZE CHECK OUR MACHINE
+
+BEGINF, CDF 10
+ TAD I (MPARAM
+ CDF
+ RTR /K TO LINK
+ZK7630, SNL CLA /ALTER FOR COMPLEMENT OF K
+ TAD [400 /TAD TO KEEP USR
+ DCA I (USROFS
+ CDF 50
+ JMS FLD2
+ ISZ HIFLD
+ CDF 40
+ JMS FLD2
+ ISZ HIFLD
+ CDF 30
+ JMS FLD2
+ ISZ HIFLD
+ CDF 20
+ JMS FLD2
+ ISZ HIFLD
+ TAD I (7777 /CHECK SOFT CORE SIZE
+ AND (70
+ SNA
+ JMP CKSEV /NOT THERE
+ CLL RTR
+ RAR
+ DCA HIFLD /THERE, SET HIFLD WITH IT
+ TAD HIFLD /TAKE MIN(HIFLD,5)
+ TAD (7772
+ SMA CLA /SMA TO USE HIFLD
+ TAD (5 /ELSE USE 5
+ SZA
+ DCA HIFLD /STORE 5 IF NECESSARY
+CKSEV, CDF 10
+ TAD I (MPARAM+2 /LOOK AT /7
+ CDF
+ AND (4
+ SNA CLA /SNA IF THERE
+ JMP I (CKBAT /ELSE CHECK FOR BATCH
+ TAD (-7 /SET TO PRINT 7 COLUMNS OF STAB
+ DCA I (SYMNCL
+ TAD (67^6 /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
+ DCA I (SYMOFS
+ JMP I (CKBAT /OK, CHECK FOR BATCH NOW
+OPTIM4, SNL /SNL IF BATCH RUNNING
+ JMP I (BEGING /ELSE TAKE DEFAULT TABLE SIZE
+ TAD (BPRIME/SET ALTERNATE TABLE SIZE
+ DCA I (PRIMES /INTO THE ONCE ONLY CODE
+ JMP I (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD
+HIFLD, 1 /8K MINIMUM
+ >
+
+/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
+FLD2, 0
+ TAD (FLD3
+ DCA I (FLD4
+FLD3, CLA
+ TAD I (FLD4
+ NOP
+ CDF
+ TAD (-FLD3
+ SZA CLA
+ JMP FLD5
+ TAD IOMON
+ TAD [-200
+ SNA CLA /IS FIELD THERE?
+ JMP I FLD2 /YES--RETURN--
+ TAD [200
+ DCA IOMON
+FLD5, ISZ FLD2 /NO-INCREMENT RETURN ADDRESS
+ JMP I FLD2 /--RETURN--
+
+FLD4, IOMON
+\f/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
+/IN 8K
+ IFZERO HASH<
+
+OPTIM1, OPTIMA
+OPTIM2, SETFLD+1
+OPTIM3, -7
+
+OPTIM5, OPTIMB
+OPTIM6, GETTG5
+OPTIM7, -21
+
+OPTIMA, RELOC SETFLD+1
+
+ CLL CMA RTL
+ TAD STM202
+ DCA TAGXR
+ CDF 10
+ JMP I SETFLD
+STM202, -202
+SETFL4, 4
+ RELOC
+
+OPTIMB, RELOC GETTG5
+
+ TAD HIGHTG
+ JMS SETFLD
+ TAD TAGXR
+ DCA XREG1
+ TAD XREG1
+ TAD SETFL4
+ DCA XREG2
+ TAD THISTG
+ JMS SETFLD
+OPTIML, TAD I XREG2
+ DCA I XREG1
+ TAD XREG1
+ CIA
+ TAD TAGXR
+ SZA CLA
+ JMP OPTIML
+ CDF
+ RELOC
+ >
+\f/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT
+
+DSWIT2, IFZERO HASH<
+ RELOC SYMPR9-2
+ JMP SYMPRE
+SYMPRD, TAD SYM204
+ JMS I OERROR
+ TAD [377
+ JMS I OERROR
+ JMS SYMPRC
+ DCA LINCNT
+ JMP I SYMPRT
+SYMPRC, 0
+ TAD [-200
+ DCA SYMPR2
+ TAD [200
+ JMS I OERROR
+ ISZ SYMPR2
+ JMP .-3
+ JMP I SYMPRC
+ RELOC
+ >
+ IFNZRO HASH<
+ RELOC SYMDDT
+ ISZ THISTG
+ JMP SYMLUP
+SYMXIT, TAD SYM204
+ JMS I OERROR
+ TAD [377
+ JMS I OERROR
+ JMS DDTLDR
+ DCA LINCNT
+ JMP I SYMPRT
+DDTLDR, 0
+ TAD [7600
+ DCA SYMCCT
+ TAD [200
+ JMS I OERROR
+ ISZ SYMCCT
+ JMP .-3
+ JMP I DDTLDR
+SYM204, 204
+ RELOC
+ >
+DSWITB= .
+ PAGE
+\fBEGING, CIF 10
+ JMS I IOMON /CALL THE USR
+ 12 /TO FIND OUT DSK:
+BEGINJ, TEXT /DSK/
+ 7201 /DUMMY
+ HLT /NEVER!
+/V3C TAD BEGINJ+1 /GET DEVICE NUMBER OF DSK:
+/V3C DCA CC7 /AND SET IT
+ TAD BEGINJ+1
+ DCA I BEGINL /AND SET IT INTO "PALBIN"
+ CDF 10
+ TAD I CC1 /GET PARAMETER WORD 1
+ CDF
+ CLL RTL /OPTION /B INTO LINK
+ AND [400 /IS IT /F?
+ZF7650, SZA CLA
+ DCA I CCX1 /YES: /F => NO 0 FILL
+ZB7430, SNL /IS IT /B?
+ JMP .+3
+ TAD CCX2
+ DCA I CCX3 /YES: /B => ! IS SHIFT
+ CDF 10
+ TAD I CC1 /GET WORD 1 AGAIN
+ CDF
+ AND [200 /IS IT /E?
+ZE7640, SNA CLA
+ JMP .+3
+ TAD CCX8
+ DCA I CCX4 /YES: /E => SET 'LG' ERROR
+ CDF 10
+ TAD I CCX5 /GET WORD 2 THIS TIME
+ CDF
+ RTL
+ZO7710, SMA CLA /IS IT /O?
+ JMP .+3
+ DCA I CCX6 /YES: /O => NO 200 ORG
+ ISZ I CCX7
+ CDF 10
+ TAD I CC1 /GET WORD 1 AGAIN
+ AND CC2 /IS IT /C?
+ SNA CLA
+ JMP I CC3 /NO: TRY FOR /L OR /G
+ TAD I CC4 /CREF FILE SPECIFIED?
+ SZA CLA
+ JMP CC5 /YES
+CC6, TAD CC7 /NO: GIVE "CREFLS.TM"
+ DCA I CC4
+ ISZ CC6
+ ISZ CC4
+ ISZ CC8
+ JMP CC6
+\fCC5, CDF
+ CIF 10
+ CLA IAC
+ JMS I IOMON /LOOKUP "CREF.SV"
+ 2
+CC13, CC9 /POINT TO NAME - BACK WITH START
+CC8, -5 /LENGTH GOES HERE
+ JMP CC16 /NOT FOUND!
+ TAD CC30
+ JMS I CC31 /CHECK TYPE FILE
+ SMA CLA
+ JMP CC16 /NOT DIRECTORY IS ERROR
+ TAD CC12
+ DCA I CC121 /CSWITC=TAD I [7605
+ TAD CC11
+ DCA I CC111 /CSWIT1=CLA
+ TAD CC10
+ DCA I CC101 /CSWIT2=DCA BINSRT
+ DCA I CC171 /CMOVE=0
+ TAD CC13
+ DCA I CC131 /CHAIN="CREF.SV"
+ DCA I CC141 /LSWITC=0
+ TAD CC30
+ DCA I CC301 /NOPA22=7612
+ DCA I CC20 /"BEGIAB"=0
+ TAD CC21
+ DCA I CC211 /"DIRSW1"=TAD [177
+ TAD CC22
+ DCA I CC221 /"PTPSW1"=TAD [232
+ JMP I .+1
+ CCC /KEEP GOING (SIGH)
+
+CC16, JMS I [ERROR
+ CF /OPTION /C ERROR
+ JMP I CC3 /TRY FOR /L OR /G
+\fCC171, SWAPR2+CMOVE
+CC141, LSWITC
+CC131, CHAIN
+CC121, CSWITC
+CC12, TAD I [7605
+CC111, CSWIT1
+CC11, CLA
+CC101, SWAPR2+CSWIT2
+CC10, DCA BINSRT
+CC301, SWAPR2+NOPA22
+CC30, 7612
+CC31, OTYPE
+CC1, MPARAM
+CC2, 1000
+CC3, BEGINH
+CC4, 7612
+
+CCX1, TEXT4X /V3C
+CCX2, OP3
+CCX3, OPEXPL
+CCX4, LGERR
+CCX5, MPARAM+1
+CCX6, FIELDY+1
+CCX7, FIELDY+2
+CCX8, JMS I PERROR
+
+CC7, 1
+ FILENAME CREFLS.TM
+CC9, FILENAME CREF.SV
+
+CC20, BEGIAB
+CC21, TAD [177
+CC211, SWAPR2+DIRSW1
+CC22, TAD [232
+CC221, SWAPR2+PTPSW1
+
+BEGINL, PALBIN
+ PAGE
+\f/***********************************************************************
+/SYMBOL TABLE
+/MOVED BY ASSEMBLER TO FIELD 1
+/MUST REMAIN IN ALPHABETICAL ORDER
+/***********************************************************************
+
+SYMS, 5777 /TERMINATOR
+ 3777 /IMPOSSIBLE (LIMITING) SYMBOL
+ 5777
+ 0000
+ IFNZRO HASH< /PSEUDO OPS MUST GO FIRST FOR EXPUNGE
+ "I-300^45+4000+2000 /I
+ 0
+ 0
+ 0400
+
+ "P-300^45+"A-300+4000 /PAUSE
+ "U-300^45+"S-300
+ "E-300^45+4000
+ PAUSEX
+
+ "P-300^45+"A-300+4000 /PAGE
+ "G-300^45+"E-300
+ 4000
+ PAGEX
+
+ "T-300^45+"E-300+4000 /TEXT
+ "X-300^45+"T-300
+ 4000
+ TEXTX
+
+ "R-300^45+"E-300+4000 /RELOC
+ "L-300^45+"O-300
+ "C-300^45+4000
+ RELOCY
+
+ "O-300^45+"C-300+4000 /OCTAL
+ "T-300^45+"A-300
+ "L-300^45+4000
+ OCTALX
+
+ "N-300^45+"O-300+4000 /NOPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ NOPUNX
+
+
+ "I-300^45+"F-300+4000 /IFZERO
+ "Z-300^45+"E-300
+ "R-300^45+"O-300+4000
+ IF0
+\f "I-300^45+"F-300+4000 /IFNZRO
+ "N-300^45+"Z-300
+ "R-300^45+"O-300+4000
+ IFN0
+
+ "I-300^45+"F-300+4000 /IFNDEF
+ "N-300^45+"D-300
+ "E-300^45+"F-300+4000
+ IFND
+
+ "I-300^45+"F-300+4000 /IFDEF
+ "D-300^45+"E-300
+ "F-300^45+4000
+ IFD
+
+ "F-300^45+"I-300+4000 /FIXTAB
+ "X-300^45+"T-300
+ "A-300^45+"B-300+4000
+ FIXTBX
+
+ "F-300^45+"I-300+4000 /FIXMRI
+ "X-300^45+"M-300
+ "R-300^45+"I-300+4000
+ FIXMRX
+
+ "F-300^45+"I-300+4000 /FILENAME
+ "L-300^45+"E-300
+ "N-300^45+"A-300+4000
+ FILENX
+
+ "F-300^45+"I-300+4000 /FIELD
+ "E-300^45+"L-300
+ "D-300^45+4000
+ FIELDX
+
+ "E-300^45+"X-300+4000 /EXPUNGE
+ "P-300^45+"U-300
+ "N-300^45+"G-300+4000
+ EXPUNX
+
+ "E-300^45+"N-300+4000 /ENPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ ENPUNX
+
+ "E-300^45+"J-300+4000 /EJECT
+ "E-300^45+"C-300
+ "T-300^45+4000
+ EJECTX
+\f "D-300^45+"T-300+4000 /DTORG
+ "O-300^45+"R-300
+ "G-300^45+4000
+ DTORGX
+
+ "D-300^45+"E-300+4000 /DEVICE
+ "V-300^45+"I-300
+ "C-300^45+"E-300+4000
+ DEVICX
+
+ "D-300^45+"E-300+4000 /DECIMAL
+ "C-300^45+"I-300
+ "M-300^45+"A-300+4000
+ DECIMX
+ >
+ "Z-300^45+"B-300+4000 /ZBLOCK
+ "L-300^45+"O-300
+ "C-300^45+"K-300+4000
+ ZBLOCX
+
+ "Z-300^45+4000+2000 /Z
+ 0
+ 0
+ 0000
+
+ "X-300^45+"L-300+4000 /XLIST
+ "I-300^45+"S-300
+ "T-300^45+4000
+ XLISTY
+
+ "T-300^45+"S-300+4000 /TSK
+ "K-300^45
+ 0
+ 6045
+
+ "T-300^45+"S-300+4000 /TSF
+ "F-300^45
+ 0
+ TSF
+
+ "T-300^45+"P-300+4000 /TPC
+ "C-300^45
+ 0
+ TPC
+
+ "T-300^45+"L-300+4000 /TLS
+ "S-300^45
+ 0
+ TLS
+
+ "T-300^45+"F-300+4000 /TFL
+ "L-300^45
+ 0
+ 6040
+\f IFZERO HASH<
+ "T-300^45+"E-300+4000 /TEXT
+ "X-300^45+"T-300
+ 4000
+ TEXTX
+ >
+ "T-300^45+"C-300+4000 /TCF
+ "F-300^45
+ 0
+ TCF
+
+ "T-300^45+"A-300+4000 /TAD
+ "D-300^45+4000
+ 0
+ TAD 0
+
+ "S-300^45+"Z-300+4000 /SZL
+ "L-300^45
+ 0
+ SZL
+
+ "S-300^45+"Z-300+4000 /SZA
+ "A-300^45
+ 0
+ SZA
+
+ "S-300^45+"W-300+4000 /SWP
+ "P-300^45
+ 0
+ 7521
+
+ "S-300^45+"T-300+4000 /STL
+ "L-300^45
+ 0
+ STL
+
+ "S-300^45+"T-300+4000 /STA
+ "A-300^45
+ 0
+ STA
+
+ "S-300^45+"R-300+4000 /SRQ
+ "Q-300^45
+ 0
+ 6003
+
+ "S-300^45+"P-300+4000 /SPA
+ "A-300^45
+ 0
+ SPA
+\f "S-300^45+"N-300+4000 /SNL
+ "L-300^45
+ 0
+ SNL
+
+ "S-300^45+"N-300+4000 /SNA
+ "A-300^45
+ 0
+ SNA
+
+ "S-300^45+"M-300+4000 /SMA
+ "A-300^45
+ 0
+ SMA
+
+ "S-300^45+"K-300+4000 /SKP
+ "P-300^45
+ 0
+ SKP
+
+ "S-300^45+"K-300+4000 /SKON
+ "O-300^45+"N-300
+ 0
+ 6000
+
+ "S-300^45+"G-300+4000 /SGT
+ "T-300^45
+ 0
+ 6006
+
+ "R-300^45+"T-300+4000 /RTR
+ "R-300^45
+ 0
+ RTR
+
+ "R-300^45+"T-300+4000 /RTL
+ "L-300^45
+ 0
+ RTL
+
+ "R-300^45+"T-300+4000 /RTF
+ "F-300^45
+ 0
+ 6005
+
+ "R-300^45+"S-300+4000 /RSF
+ "F-300^45
+ 0
+ RSF
+\f "R-300^45+"R-300+4000 /RRB
+ "B-300^45
+ 0
+ RRB
+
+ "R-300^45+"P-300+4000 /RPE
+ "E-300^45
+ 0
+ 6010
+
+ "R-300^45+"M-300+4000 /RMF
+ "F-300^45
+ 0
+ RMF
+
+ "R-300^45+"I-300+4000 /RIF
+ "F-300^45
+ 0
+ RIF
+
+ "R-300^45+"I-300+4000 /RIB
+ "B-300^45
+ 0
+ RIB
+
+ "R-300^45+"F-300+4000 /RFC
+ "C-300^45
+ 0
+ RFC
+ IFZERO HASH<
+ "R-300^45+"E-300+4000 /RELOC
+ "L-300^45+"O-300
+ "C-300^45+4000
+ RELOCY
+ >
+ "R-300^45+"D-300+4000 /RDF
+ "F-300^45
+ 0
+ RDF
+
+ "R-300^45+"A-300+4000 /RAR
+ "R-300^45
+ 0
+ RAR
+
+ "R-300^45+"A-300+4000 /RAL
+ "L-300^45
+ 0
+ RAL
+\f "P-300^45+"S-300+4000 /PSF
+ "F-300^45
+ 0
+ PSF
+
+ "P-300^45+"P-300+4000 /PPC
+ "C-300^45
+ 0
+ PPC
+
+ "P-300^45+"L-300+4000 /PLS
+ "S-300^45
+ 0
+ PLS
+
+ "P-300^45+"C-300+4000 /PCF
+ "F-300^45
+ 0
+ PCF
+
+ "P-300^45+"C-300+4000 /PCE
+ "E-300^45
+ 0
+ 6020
+ IFZERO HASH<
+ "P-300^45+"A-300+4000 /PAUSE
+ "U-300^45+"S-300
+ "E-300^45+4000
+ PAUSEX
+
+ "P-300^45+"A-300+4000 /PAGE
+ "G-300^45+"E-300
+ 4000
+ PAGEX
+ >
+ "O-300^45+"S-300+4000 /OSR
+ "R-300^45
+ 0
+ OSR
+
+ "O-300^45+"P-300+4000 /OPR
+ "R-300^45
+ 0
+ OPR
+ IFZERO HASH<
+ "O-300^45+"C-300+4000 /OCTAL
+ "T-300^45+"A-300
+ "L-300^45+4000
+ OCTALX
+ >
+\f IFZERO HASH<
+ "N-300^45+"O-300+4000 /NOPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ NOPUNX
+ >
+ "N-300^45+"O-300+4000 /NOP
+ "P-300^45
+ 0
+ NOP
+
+ "M-300^45+"Q-300+4000 /MQL
+ "L-300^45
+ 0
+ 7421
+
+ "M-300^45+"Q-300+4000 /MQA
+ "A-300^45
+ 0
+ 7501
+
+ "L-300^45+"A-300+4000 /LAS
+ "S-300^45
+ 0
+ LAS
+
+ "K-300^45+"S-300+4000 /KSF
+ "F-300^45
+ 0
+ KSF
+
+ "K-300^45+"R-300+4000 /KRS
+ "S-300^45
+ 0
+ KRS
+
+ "K-300^45+"R-300+4000 /KRB
+ "B-300^45
+ 0
+ KRB
+
+ "K-300^45+"I-300+4000 /KIE
+ "E-300^45
+ 0
+ 6035
+
+ "K-300^45+"C-300+4000 /KCF
+ "F-300^45
+ 0
+ 6030
+\f "K-300^45+"C-300+4000 /KCC
+ "C-300^45
+ 0
+ KCC
+
+ "J-300^45+"M-300+4000 /JMS
+ "S-300^45+4000
+ 0
+ JMS 0
+
+ "J-300^45+"M-300+4000 /JMP
+ "P-300^45+4000
+ 0
+ JMP 0
+
+ "I-300^45+"S-300+4000 /ISZ
+ "Z-300^45+4000
+ 0
+ ISZ 0
+
+ "I-300^45+"O-300+4000 /IOT
+ "T-300^45
+ 0
+ IOT
+
+ "I-300^45+"O-300+4000 /ION
+ "N-300^45
+ 0
+ ION
+
+ "I-300^45+"O-300+4000 /IOF
+ "F-300^45
+ 0
+ IOF
+ IFZERO HASH<
+ "I-300^45+"F-300+4000 /IFZERO
+ "Z-300^45+"E-300
+ "R-300^45+"O-300+4000
+ IF0
+
+ "I-300^45+"F-300+4000 /IFNZRO
+ "N-300^45+"Z-300
+ "R-300^45+"O-300+4000
+ IFN0
+
+ "I-300^45+"F-300+4000 /IFNDEF
+ "N-300^45+"D-300
+ "E-300^45+"F-300+4000
+ IFND
+ >
+\f IFZERO HASH<
+ "I-300^45+"F-300+4000 /IFDEF
+ "D-300^45+"E-300
+ "F-300^45+4000
+ IFD
+ >
+ "I-300^45+"A-300+4000 /IAC
+ "C-300^45
+ 0
+ IAC
+ IFZERO HASH<
+ "I-300^45+4000+2000 /I
+ 0
+ 0
+ 0400
+ >
+ "H-300^45+"L-300+4000 /HLT
+ "T-300^45
+ 0
+ HLT
+
+ "G-300^45+"T-300+4000 /GTF
+ "F-300^45
+ 0
+ 6004
+
+ "G-300^45+"L-300+4000 /GLK
+ "K-300^45
+ 0
+ GLK
+ IFZERO HASH<
+ "F-300^45+"I-300+4000 /FIXTAB
+ "X-300^45+"T-300
+ "A-300^45+"B-300+4000
+ FIXTBX
+
+ "F-300^45+"I-300+4000 /FIXMRI
+ "X-300^45+"M-300
+ "R-300^45+"I-300+4000
+ FIXMRX
+
+ "F-300^45+"I-300+4000 /FILENAME
+ "L-300^45+"E-300
+ "N-300^45+"A-300+4000
+ FILENX
+
+ "F-300^45+"I-300+4000 /FIELD
+ "E-300^45+"L-300
+ "D-300^45+4000
+ FIELDX
+ >
+\f IFZERO HASH<
+ "E-300^45+"X-300+4000 /EXPUNGE
+ "P-300^45+"U-300
+ "N-300^45+"G-300+4000
+ EXPUNX
+
+ "E-300^45+"N-300+4000 /ENPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ ENPUNX
+
+ "E-300^45+"J-300+4000 /EJECT
+ "E-300^45+"C-300
+ "T-300^45+4000
+ EJECTX
+
+ "D-300^45+"T-300+4000 /DTORG
+ "O-300^45+"R-300
+ "G-300^45+4000
+ DTORGX
+
+ "D-300^45+"E-300+4000 /DEVICE
+ "V-300^45+"I-300
+ "C-300^45+"E-300+4000
+ DEVICX
+
+ "D-300^45+"E-300+4000 /DECIMAL
+ "C-300^45+"I-300
+ "M-300^45+"A-300+4000
+ DECIMX
+ >
+ "D-300^45+"C-300+4000 /DCA
+ "A-300^45+4000
+ 0
+ DCA 0
+
+ "C-300^45+"M-300+4000 /CML
+ "L-300^45
+ 0
+ CML
+
+ "C-300^45+"M-300+4000 /CMA
+ "A-300^45
+ 0
+ CMA
+
+ "C-300^45+"L-300+4000 /CLL
+ "L-300^45
+ 0
+ CLL
+\f "C-300^45+"L-300+4000 /CLA
+ "A-300^45
+ 0
+ CLA
+
+ "C-300^45+"I-300+4000 /CIF
+ "F-300^45
+ 0
+ CIF
+
+ "C-300^45+"I-300+4000 /CIA
+ "A-300^45
+ 0
+ CIA
+
+ "C-300^45+"D-300+4000 /CDF
+ "F-300^45
+ 0
+ CDF
+
+ "C-300^45+"A-300+4000 /CAF
+ "F-300^45
+ 0
+ 6007
+
+ "B-300^45+"S-300+4000 /BSW
+ "W-300^45
+ 0
+ 7002
+
+ "A-300^45+"N-300+4000 /AND
+ "D-300^45+4000
+ 0
+ AND 0
+
+ 4001 /TERMINATOR
+ 0000 /IMPOSSIBLE (LIMITING) SYMBOL
+ 4000
+ 0000
+
+SYME=.
+
+/**********************************************************************
+/TOP OF SYMBOL TABLE
+/**********************************************************************
+\fSWAP2=.
+
+/**********************************************************************
+/CODE UNIQUE TO PASSES 1 AND 2
+/SWAPPED IN FOR PASSES 1 AND 2
+/OVERLAYED DURING PASS 3 *** NO LITERALS ***
+
+ RELOC 1000 /ASSEMBLED INTO 1000-1247
+
+ SWAPB2= .
+ SWAPR2= SWAP2-SWAPB2 /RELOCATION FACTOR FOR THIS CODE
+
+OOPEN, 0
+ TAD OPEN01 /OPEN BINARY AND LISTING FILES
+ DCA XOUHND /SET ADDRESS OF DEVICE HANDLER
+ TAD OPEN02
+ DCA XOUBLK
+ TAD [-5
+ DCA XOUELE /SET NEW OUTPUT FILE LENGTH
+ CDF 10
+ TAD I OUFPTR
+ CDF
+ DCA I XOUBLK
+ ISZ XOUBLK
+ ISZ OUFPTR
+ ISZ XOUELE /INCREMENT OUTPUT FILE LENGTH
+ JMP .-7
+ TAD OPEN02
+ IAC
+ DCA XOUBLK /SET POINTER TO NEW FILENAME
+ TAD XOUBLK
+ DCA I OPEN04
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 13 /*RESET SYSTEM TABLES*
+ DCA I OPEN05 /DELETE UNCLOSED FILES AND
+ TAD I OPEN02 /DELETE HANDLERS
+ AND [17 /GET NEW DEVICE HANDLER #
+ SNA /OUTPUT INHIBIT?
+ JMP ONOFIL /YES
+ CIF 10 /NO
+ JMS I IOMON /CALL USER SERVICE ROUTINE
+ 1 /*FETCH DEVICE HANDLER*
+XOUHND, 0 /LOADING ADDRESS
+ HLT /HANDLER NOT AVAILABLE
+OUENTR, TAD I OPEN02 /NORMAL RETURN - GET OUTPUT
+ CIF 10 /DEVICE NUMBER AND FILE LENGTH
+\f JMS I IOMON /CALL NEW SERVICE ROUTINES
+ 3 /*ENTER OUTUT FILE
+XOUBLK, 0 /POINTER TO FILENAME
+XOUELE, 0 /FILE LENGTH
+ JMP OEFAIL /ERROR RETURN
+ DCA I OPEN06 /NORMAL RETURN
+ JMS I OPEN07
+ TAD XOUHND
+ TAD [200 /LINK IS CLEAR!!
+ SNL CLA
+ TAD [400
+ TAD OUFDEV
+ DCA I OUFINP
+ TAD I OUFINP
+ CLL RAR
+ CIA
+ TAD OU3501
+ DCA INCTL
+ ISZ OOPEN
+ TAD XOUHND
+ DCA I OPEN09
+ TAD XOUBLK
+ DCA I OPEN10
+ TAD XOUELE
+ DCA I OPEN11
+ JMP I OOPEN /--RETURN--
+
+OEFAIL, TAD I OPEN02
+ AND [7760
+ SNA CLA
+ JMP I OPEN12 /DE**FATAL ERROR**
+ TAD I OPEN02
+ AND [17
+ DCA I OPEN02
+ JMP OUENTR
+
+ONOFIL, ISZ I OPEN05 /SET OUTPUT INHIBIT SWITCH
+ JMP I OOPEN /--RETURN--
+
+OUFPTR, 7600
+
+OPEN01, OUDEVH+1
+OPEN02, OUFILE
+OPEN04, OUCNAM
+OPEN05, OUTINH
+OPEN06, OUCCNT
+OPEN07, OUSETP
+OPEN09, OUHNDL
+OPEN10, OUBLK
+OPEN11, OUELEN
+OPEN12, SYSERR
+OU3501, 3501
+OUFDEV, OUDEVH
+OUFINP, INBUFP
+\f/CONTINUATION OF FIXTAB HANDLER
+
+FIXTAY, IFZERO HASH<
+ TAD HIGHTG /SET POINTERS TO TABLE
+ CMA
+ >
+ IFNZRO HASH<
+ TAD TAGMAX
+ CIA
+ >
+ DCA TEMP3
+ DCA THISTG
+FIXTAX, JMS I [FINDTG /GET A TAG
+ AC3777
+ AND TAG1
+ IFNZRO HASH<
+ SZA
+ >
+ TAD [4000 /SET BIT 0 OF FIRST WORD TO 1
+ DCA TAG1 /RETURN IT TO TABLE
+ JMS I [PUTTAG
+ ISZ THISTG
+ ISZ TEMP3 /DONE WITH TABLE YET?
+ JMP FIXTAX /NO
+ JMP I [LOOKEX /YES--EXIT TO MAIN--
+
+/OUTPUT ONE REGISTER - BINARY
+/ENTER WITH CONTENTS IN AC
+
+PUNOUT, 0
+ DCA PUNOU1
+ TAD PUNOU1
+ RTR
+ RTR
+ RTR
+ AND [177
+ JMS I OCHAR /OUTPUT FIRST FRAME
+ TAD PUNOU1
+ AND [77
+ JMS I OCHAR /OUTPUT SECOND FRAME
+ JMP I PUNOUT /--RETURN--
+
+PUNOU1,
+IOPEN, 0 /SET UP INPUT ROUTINE
+ CLA CMA /TO OPEN FILE
+ DCA I IOPEN1
+ ISZ I IOPEN2
+ TAD IOPEN3
+ DCA I IOPEN4
+ ISZ I IOPEN5
+ TAD [LINBUF+120
+ DCA TXTPTR
+ JMP I IOPEN /--RETURN--
+
+IOPEN1, INCHCT
+IOPEN2, INEOF
+IOPEN3, 7617
+IOPEN4, INFPTR
+IOPEN5, FORMSW
+ PAGE
+\f/START PASS 2 *** NO LITERALS HERE EITHER ***
+
+START1, TAD [ERROR
+ DCA PERROR /RESET PREUDO-ERROR ROUTINE
+ JMS I ST1OPN /OPEN PASS 2 OUTPUT FILE
+ JMP NOPA21 /NO PASS 2 IF PASS 3
+NOPA23, TAD I ST1OBL
+ DCA BINSRT
+ DCA PUNCHX /CLEAR PUNCH INHIBIT
+ JMS START3
+ JMP I .+1
+ START2-1
+
+NOPA21, CDF 10
+ TAD I NOPA22 /IS THERE A PASS 3?
+ CDF
+ SNA CLA
+ JMP NOPA23 /NO - DO PASS 2
+ ISZ PASS /SKIP PASS 2
+ NOP
+ JMP NOPAS2 /CONTINUE TO PASS 3
+
+NOPA22, 7605
+
+START3, 0 /GENERATE LEADER/TRAILER
+ TAD LEADER
+ DCA TXTPTR
+ TAD [200
+ JMS I OCHAR
+ ISZ TXTPTR
+ JMP .-3
+ JMP I START3 /--RETURN--
+
+LEADER, -10
+\f/END PASS 2
+
+ENDPA2, JMS I [DUMPZ /DUMP PAGE 0 LITERALS
+ DCA PUNCHX
+ CLL /V3C
+ TAD CHKSUM /OUTPUT CHECKSUM
+ JMS I [PUNOUT /PUNCH THE CHECKSUM
+ JMS START3 /GENERATE LEADER/TRAILER
+ JMS I EN2CLS /CLOSE PASS 2 OUTPUT FILE
+NOPAS2, TAD EN2LSO
+ DCA OERROR /SET NEW OUTPUT TO BE LISTING
+ ISZ I EN2OU1
+CMOVE, JMP CMOVA /ZEROED IF /C
+ CDF 10 /MOVE CODE FOR /C OPTION
+CMOVB, TAD I CMOV1
+ DCA I CMOV2 /MOVE OUTPUT FILE STORAGE
+ ISZ CMOV1
+ ISZ CMOV2
+ ISZ CMOV3
+ JMP CMOVB /LOOP
+CMOVA, CDF
+ JMS I ST1OPN /OPEN 3RD PASS FILE
+ DCA I CMOV4 /NO 3RD PASS
+ TAD I ST1OBL /GET FILE START
+CSWIT2, CLA /"DCA BINSRT" IF /C
+ TAD PTPSW1
+ DCA I EN2PTP /RESET PAPERTAPE SWITCH
+ TAD DIRSW1
+ DCA I EN2DIR /RESET DIRECTORY SWITCH
+ JMS I PIOPEN
+ JMP I .+1
+ LOADOV /OVERLAY THIS AREA WITH PASS3 CODE
+
+PIOPEN, IOPEN
+DIRSW1, TAD [177
+PTPSW1, TAD [232
+
+CMOV1, 7605
+CMOV2, 7600
+CMOV3, -12
+CMOV4, NSWITC
+EN2CLS, OCLOSE
+EN2LSO, LISOUT
+EN2OU1, OUTPT1
+EN2PTP, PTPSW
+EN2DIR, DIRSW
+ST1OPN, OOPEN
+ST1OBL, OUBLK
+SWAPE2, RELOC
+ IFNZRO ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
+ PAGE
+\f IFNZRO HASH<
+
+ /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS
+
+HSHSMS, 0
+ JMS I (7607 /WRITE THE SYMBOL TABLE SORT OVERLAY
+ 4210 /2 PAGES FROM FIELD 1
+ OUDEVH+400 /FROM HERE
+ ASWAP+1 /TO HERE
+ JMP I (SYSERR/WONDERFUL.
+ TAD I (USROFS
+ SZA CLA /SZA IF KICKING OUT USR
+ TAD (12 /ELSE FUDGE POINTER
+ TAD I (HIFLD /FIRST SET HASH TABLE SIZE
+ TAD PRIMES /ACCORDING TO CORE SIZE
+ DCA PRIME
+ TAD I PRIME
+ DCA PRIME
+ TAD PRIME
+ CIA
+ DCA I (MPRIME
+ TAD I (USROFS
+ SZA CLA
+ JMP KPUSR /JMP IF KEEPING USR
+ CDF 10 /SERVE NOTICE WE'RE OCCUPYING FIELD 1
+ AC7776
+ AND I (JSBITS
+ DCA I (JSBITS
+ TAD [7700
+ DCA IOMON /AND POINT AT PROPER MONITOR E.P.
+KPUSR, CDF
+ TAD I (MPRIME /HOW MANY SLOTS TO WIPE
+ DCA LAST3 /TO COUNTER
+ TAD I (USROFS
+ CLL RTL
+ TAD (7777 /FUDGE THE INITIAL AUTO XR
+ JMP CLRGO /INTO THE LOOP NOW
+CLRLUP, TAD LAST1
+ TAD (-7577
+ SZA CLA /SZA IF NEED TO DO NEXT FIELD
+ JMP CLCDF0+1/ELSE CLEAR ANOTHER
+ TAD (10
+ TAD CLCDF0
+ DCA CLCDF0 /CDF INSTR GETS BUMPED
+ STA
+CLRGO, DCA LAST1 /XRGETS SET
+CLCDF0, CDF 10 /INITIALLY CDF 10
+ DCA I LAST1
+ DCA I LAST1
+ DCA I LAST1
+ DCA I LAST1
+ ISZ LAST3 /SKP IF NO MORE
+ JMP CLRLUP /ELSE DO ANOTHER
+ CDF /THE TABLE IS CLEAN
+ TAD (HSHRTN
+ DCA I [GETTAG
+ STA
+ DCA HIGHTG /HIGHTG=CURRENT SYMBOL INDEX
+ TAD (SYMS+3 /USE THESE AUTO XR'S NOW
+ DCA LAST1
+ TAD LAST1
+ DCA LAST2
+HSHLP, TAD I LAST1
+ AND [1777 /FIRST, STRIP THE TYPE BITS
+ DCA I (NAME1
+ AC3777
+ AND I LAST1
+ DCA I (NAME2
+ AC3777
+ AND I LAST1
+ DCA I (NAME3
+ ISZ LAST1 /SKIP THE VALUE
+ JMP I (GETTGH /GO FIND IT'S PLACE
+HSHRTN, CLA CLL
+ TAD I LAST2
+ DCA I (NAME1
+ TAD I LAST2
+ DCA I (NAME2
+ TAD I LAST2
+ DCA I (NAME3
+ TAD I LAST2
+ DCA VALUE2
+ JMS I (INSRTG /AND STORE IT
+ TAD LAST1
+ TAD (1-SYME+4
+ SZA CLA
+ JMP HSHLP /LOOP IF MORE TO GO
+ JMP I HSHSMS /--RETURN--
+
+PRIMES, .
+ 1737 /1 FIELD
+ 3673 /2 FIELDS
+ 5633 /3 FIELDS
+ 7577 /4 FIELDS
+ 7775 /5 FIELDS (THE LAST MOSTELY WASTE)
+ BPRIMES=.-1 /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
+ 1737 /1 FIELD (MEANS NO BATCH)
+ 3133 /2 FIELDS
+ 5075 /3 FIELDS
+ 7035 /4 FIELDS
+ 7775 /5 FIELDS (SOME OF WASTE FOR BATCH)
+
+ 1335 /STILL ANOTHER ALTERNATE SET IF KEEPING USR
+ 3273
+ 5237
+ 7175
+ 7775
+
+ 0
+ 2535
+ 4465
+ 6437
+ 7775
+
+ PAGE
+ >
+\f/**************************************************************
+/PAGE 0 LITERALS
+/**************************************************************
+ IFNZRO HASH<
+
+ /SYMBOL TABLE SORT OVERLAY
+ /ONLY SWAPPED IF TABLE WILL BE LISTED
+
+ /FIRST, SOME EQUATES
+
+ PPUTTAG= [PUTTAG
+ PFINDTG= [FINDTG
+ O1777= [1777
+ O7774= [7774
+
+ SXR= XREG1
+ TXR= XREG2
+ SXR2= LAST1
+ TXR2= LAST2
+ UXR= LAST3
+ DXR= LAST4
+
+ BEG= LOC
+ END= OFFSET
+ LO= OFSBUF
+ HI= STARSW
+ MED= OP
+
+ FIELD 1 /SET THE FIELD NOW
+\f *OUDEVH+400 /IT GOES HERE
+
+SORTAB, 0 /FIRST LOC IN PAGE
+ TAD TAGMAX
+ CIA
+ DCA TEMP /TEMP=#CELLS TO SCAN
+
+ /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
+ /OUT WITH EMPTIES AND PERMANENTS
+
+ DCA HIGHTG /TARGET POINTER
+ DCA TEMP2 /SOURCE POINTER
+DEFLP, TAD TEMP2
+ DCA THISTG
+ JMS I PFINDTG /GET THE NEXT STAB CELL
+ TAD TAG1
+ CLL RAL
+ SNA SZL CLA /AND THERE BUT NOT FIXED?
+ JMP DEFNUL /NO, DON'T STORE IT
+ TAD O1777 /YES,DISCARD THE TYPE BITS NOW
+ AND TAG1
+ DCA TAG1
+ AC3777
+ AND TAG2
+ DCA TAG2
+ AC3777
+ AND TAG3
+ DCA TAG3
+ TAD HIGHTG
+ DCA THISTG
+ JMS I PPUTTAG
+ ISZ HIGHTG
+DEFNUL, ISZ TEMP2
+ ISZ TEMP /TRY AGAIN
+ JMP DEFLP
+ JMS I (SORT /NOW SORT THEM
+ JMP I SORTAB /EXIT TO PRTSTAB
+\f /MOVE A SYMBOL THRU THE TABLE
+
+SMOV, 0
+ TAD SXR2 /GET SOURCE DF+XREG
+ JMS GETFLD
+ DCA SMVCD1
+ TAD TXR
+ DCA SXR
+ TAD TXR2
+ JMS GETFLD
+ DCA SMVCD2
+ TAD O7774
+ DCA SSWT
+SMVCD1, 0
+ TAD I SXR
+SMVCD2, 0
+ DCA I TXR
+ ISZ SSWT
+ JMP SMVCD1
+SMVCD0, CDF
+ JMP I SMOV
+
+ /AUXILLIARY FIELD+XREG SETTER
+
+GETFLD, 0
+ CLL
+ TAD I (USROFS /IF KEEPING USR
+ DCA TXR /AC=SYM NUM
+ DCA SMVCD2
+ TAD TXR
+ ISZ SMVCD2
+ CML
+ TAD (-1740
+ SNL
+ JMP .-4
+ CLL RTL
+ TAD (-202 /SETS AS IN SETFLD...
+ DCA TXR /TENTATIVELY SET TXR
+ TAD SMVCD2
+ CLL RTL
+ RAL
+ TAD SMVCD0
+ JMP I GETFLD /EXIT WITH AC SET TO CDF INSTR
+\f /ROUTINE TO EXCHANGE SYMBOLS LO AND HI
+
+SSWT, 0
+ TAD HI
+ JMS GETFLD
+ DCA SWCDF1
+ TAD SWCDF1
+ DCA SWCDF3
+ TAD TXR
+ DCA SXR
+ TAD SXR
+ DCA SXR2 /SXR'S FOR HIGH SYMBOL
+ TAD LO
+ JMS GETFLD
+ DCA SWCDF2
+ TAD TXR
+ DCA TXR2 /TXR'S FOR LOW SYMBOL
+ TAD O7774
+ DCA SMOV /COUNTER
+
+SWCDF1, 0
+ TAD I SXR /GET HI SYM WORD
+ DCA GETFLD /HOLD IT
+SWCDF2, 0
+ TAD I TXR /GET LO
+ DCA SCOM /HOLD IT
+ TAD GETFLD
+ DCA I TXR2 /STORE HI IN LOW
+SWCDF3, 0
+ TAD SCOM /NOW STORE LO
+ DCA I SXR2 /IN HI
+ ISZ SMOV
+ JMP SWCDF1+1
+ CDF
+ JMP I SSWT
+\f /COMPARE SYMBOLS + SET LINK THEREBY
+
+SCOM, 0
+ DCA THISTG /AC=TAG #
+ JMS I (SETFLD
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG1
+ SZA CLA
+ JMP SCOMRT
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG2
+ SZA CLA
+ JMP SCOMRT
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG3
+ SNA CLA
+ HLT /NEVER
+SCOMRT, CDF
+ JMP I SCOM
+
+ PAGE
+
+
+
+
+
+
+
+
+\f /SORT ROUTINE HERE
+
+SORT, 0
+ DCA BEG /INITIALIZE PARTITION BOUNDS
+ STA STL
+ TAD HIGHTG
+ DCA END /ARE THERE ANY SYMBOLS?
+ SZL
+ JMP I SORT /NO EXIT WITH LINK SET
+ TAD (LITBF1-1+26 /OK, SET STACK NOW
+ DCA DXR
+ TAD DXR
+ DCA UXR
+
+SLOOP, STA
+ TAD LEVEL
+ DCA LEVEL
+SLOOP2, TAD BEG
+ STL CIA
+ TAD END
+ SNA SZL
+ JMP OKCOOL /END.LOS.BEG
+ CLL RAR
+ TAD BEG
+ DCA MED /MED=BEG+(END-BEG)/2
+ TAD MED
+ DCA THISTG
+ JMS I PFINDTG /T=A(MED)
+ TAD BEG
+ DCA LO /LO=BEG
+ TAD END
+ DCA HI /HI=END
+ TAD MED
+ CIA
+ TAD BEG
+ SNA CLA
+ JMP JUSTWO /BEG.EQ.MED
+\f TAD LO
+ DCA SXR2
+ TAD MED
+ DCA TXR2
+ JMS I (SMOV /A(MED)=A(LO)
+BEGLP, ISZ LO
+ TAD LO
+ CLL CIA
+ TAD HI
+ SNL CLA
+ JMP DONE /HI.LOS.LO
+ TAD LO
+ JMS I (SCOM /T.GT.A(LO) TO LINK
+ SZL CLA
+ JMP BEGLP /T.GT.A(LO)
+ JMP ENDGO /T.LT.A(LO)
+ENDLP, TAD LO
+ CLL CIA
+ TAD HI
+ SNL CLA
+ JMP DONE /IF HI.LO.LO
+ENDGO, TAD HI
+ JMS I (SCOM
+ SZL CLA
+ JMP SWITCH
+ STA
+ TAD HI
+ DCA HI
+ JMP ENDLP
+SWITCH, JMS I (SSWT
+ STA
+ TAD HI
+ DCA HI
+ JMP BEGLP
+\fDONE, TAD HI
+ DCA SXR2
+ TAD BEG
+ DCA TXR2
+ JMS I (SMOV /A(BEG)=A(HI)
+ TAD HI
+ DCA THISTG
+ JMS I PPUTTAG /A(HI)=T
+ AC7776
+ TAD UXR
+ DCA UXR
+ TAD UXR
+ DCA DXR
+ TAD HI
+ CLL CIA
+ TAD MED
+ SZL CLA
+ JMP HIBIGR /DEFER HIGH FOR LATER
+ TAD BEG
+ DCA I DXR /DEFER LO FOR LATER
+ STA
+ TAD HI
+ DCA I DXR
+ TAD HI
+ IAC
+ DCA BEG
+ JMP SLOOP
+HIBIGR, TAD HI
+ IAC
+ DCA I DXR
+ TAD END
+ DCA I DXR
+ STA
+ TAD LEVEL /CLUMSY
+ DCA LEVEL
+ CLL STA
+ TAD HI
+ DCA END
+ SNL /PROTECT AGAINST WRAP AROUND
+ JMP OKCOOL
+ JMP SLOOP2
+
+JUSTWO, TAD HI
+ JMS I (SCOM
+ SZL CLA
+ JMS I (SSWT /SWITCH IF T.GT.A(HI)
+OKCOOL, CLA CLL /NOW CONSIDER PREV PARTITIONS
+ TAD I UXR
+ DCA BEG
+ TAD I UXR
+ DCA END
+ ISZ LEVEL
+ JMP SLOOP2 /REITERATE
+ JMP I SORT /DONE, RETURN WITH A CLEAR LINK
+LEVEL, 0
+ PAGE
+ >
+\f /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
+ /IN THE HEADING
+
+ IFZERO HASH <
+ FIELD 1
+ *OUDEVH+400
+ >
+
+FMTDAT, 0
+ TAD I (MDATE /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
+ CDF /RUN WITH DF = 0
+ SNA
+ JMP NODATE /EXIT IF NO DATE
+ DCA DATWD /ELSE STORE DATE WORD
+ TAD ("0-1
+ DCA I DATPTR /SET FIRST DIGIT OF DAY
+ TAD DATWD /NOW GET DAY BITS
+ CLL RTR
+ RAR
+ AND (37
+ JMS DIV10 /DO DAY DIGITS NOW
+ TAD ("-
+ DCA I DATPTR /STORE DASH
+ ISZ DATPTR
+ TAD DATWD /NOW GET MONTH BITS
+ TAD (7400 /REDUCE TO ORIGIN 0
+ AND (7400
+ CLL RTL
+ RTL
+ RAL
+ DCA DIV10
+ TAD DIV10
+ CLL RAR /GENERATE 1.5*MONTH INDEX
+ TAD DIV10
+ TAD (MONLST /INDEX MONTH LIST (SIXBIT)
+ DCA MONPTR
+ TAD (-3
+ DCA DIV10 /SET 3 TIMES THRU LOOP
+ SZL
+ JMP MONGO /IF EVEN START AT RIGHT HALF
+MONLP, TAD I MONPTR
+ CLL RTR
+ RTR
+ RTR
+ JMS MONPUT /PUT LEFT CHAR
+MONGO, TAD I MONPTR
+ JMS MONPUT /PUT RIGHT CHAR
+ ISZ MONPTR
+ JMP MONLP /LOOP FOR MORE
+MONPUT, 0
+ TAD (40
+ AND (77
+ TAD (40 /CONVERT TO 7BIT
+ DCA I DATPTR
+ ISZ DATPTR
+ ISZ DIV10
+ JMP I MONPUT /RETURN TO UNPACK LOOP
+ TAD ("-
+ DCA I DATPTR /PUT ANOTHER DASH
+ ISZ DATPTR
+ TAD ("6
+ DCA I DATPTR /SETUP YEAR TENS DIGIT FOR DIVIDE
+ TAD I (BIPCCL
+ AND (600 /GET YEAR EXTENSION FROM 600 BITS
+ CLL RTR
+ RTR
+ DCA DIV10
+ TAD DATWD /NOW GET YEAR
+ AND (7 /ISOLATE IT
+ TAD DIV10 /ADD EXTENSION
+ JMS DIV10 /UNPACK IT
+NODATE, CIF CDF /NOW RETURN
+ JMP I FMTDAT
+
+DIV10, 0
+ ISZ I DATPTR
+ TAD (-12
+ SMA
+ JMP .-3 /REDUCE MON 10.
+ TAD (12+"0
+ ISZ DATPTR
+ DCA I DATPTR /STORE LOW DIGIT
+ ISZ DATPTR
+ JMP I DIV10 /--RETURN--
+
+DATPTR, DATE
+DATWD, 0
+MONPTR, 0
+
+ PAGE
+
+ $$$$$
--- /dev/null
+This area contains the files contained on system release DECtape #6.
+
+Directory of OS/8 V3D DECtape 6 labeled: AL-4696C-SA 2/15/78
+ OS/8 V3D SRC DT 6 OF 7
+ (replaces DEC-S8-OSYSB-B-UA6)
+
+
+PAL8 .PA 291 01-AUG-77 RESORC.PA 72 01-AUG-77
+BOOT .PA 21 01-AUG-77 CAMP .PA 83 01-AUG-77
+MCPIP .PA 102 01-AUG-77 DIRECT.PA 51 01-AUG-77
+
+ 6 files in 620 blocks - 110 free blocks
+
+
--- /dev/null
+/14 OS/8 RESOURCES PROGRAM
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+
+/ S.R.
+
+/SAVE INFO:
+
+/ .R ABSLDR
+/ *RESORC$
+/ .SAVE SYS RESORC;12000=6003
+
+/CORE MAP:
+
+/0000-1777 C.D.
+/2000-2377 DEVICE NAME AND LENGTH TABLE
+/2400-2777 OUTPUT BUFFER (DOESN'T OVERLAP BETA REGISTER)
+/3000-3377 INPUT HANDLER
+/3400-3777 OUTPUT HANDLER
+/4000-7377 INPUT DIRECTORY
+/4000-7577 INPUT HANDLERS (LOSE 2ND HALF OF LAST ONE)
+
+/FIELD 1
+
+/10000-11777 USR
+/11400-11777 INPUT KBM
+/12000-15577 PROGRAM
+/15600-16177 INPUT BLOCK 0
+/16200-17577 INPUT USR
+
+ INPBL0=5600
+ INPKBM=1400
+ INPUSR=6200
+ INPHND=4000
+
+ FAST=20
+ DIG=21
+ EXTEN=22
+
+ DEVNUM=23 /DEVICE NUMBER OF HANDLER
+ CNT=24
+ PDNT=25 /PTS TO DEVICE NAME TABLE
+ TEMP=26
+ PUDNT=27 /PTS TO USER DEVICE NAME TABLE
+ PDHIT=30 /PTS TO DEVICE HANDLER INFO TABLE
+ PDCWT=31 /PTS TO DEVICE CONTROL WORD TABLE
+ PTYP=32
+ LFT=33
+ RT=LFT+1
+ DVNO=35
+ BLOC=36
+ PDHRT=37 /POINTS TO DEVICE HANDLER RESIDENCY TABLE
+ UN=6
+ X0=10
+ XR1=11
+
+ RESVERSION="A
+
+/FIXES SINCE FIELD TEST RELEASE:
+
+/1. 'INPUT ERROR' MESSAGE NO LONGER GARBLED
+/2. '%NON SYSTEM DEVICE' NEVER PRINTS HANDLERS
+
+/FIXES FOR MAINTENANCE RELEASE (V3C):
+
+/3. INCORPORATED PATCH SEQ NO 1 ALLOWS DISTINGUISHING BETWEEN
+/ HIGH AND LOW SPEED PTR'S AND ADDITIONAL CASSETTES
+/ [DSN FEB 1975]
+
+/4. FIXED LENGTHS OF DF32'S AND RF08'S [SUPERSEDES PATCH SEQ #2
+/ DSN APR 1975]
+
+/5. CHANGED VERSION NUMBER TO V3, UPDATED COPYRIGHT
+/6. ADDED DUMP, LST, AND RX-- TO INTERNAL NAME TABLES
+
+/7. ADDED DETAILS ABOUT DUMP AND FLOPPIES TO TABLES
+
+/V3D CHANGES:
+
+/8. ADDED NAMES SLU AND LQP TO TABLES
+/9. CAN DISTINGUISH LQP KIND OF LPTR
+/10. FIXED BUG ABOUT DUMPING BUFFER FULL OF NULLS
+/11. REMOVED LITTLE-USED 'OUT', 'DEV' FROM NAME TABLES
+\f FIELD 1
+
+ *2000
+
+START, SKP
+ JMP NOCD /CHAIN ENTRY POINT
+/ JMS I (7700 /WE ASSUME THE USR IS IN CORE
+/ 10 /DON'T HAVE TO LOCK USR IN CORE IF JSW SET RIGHT
+CD, JMS I (200
+ 5 /COMMAND DECODE
+ 2331 /DEFAULT INPUT EXTENSION = 'SY'
+NOCD, DCA CTRLO
+ JMS OPENO /OPEN OUTPUT FILE
+ DCA FILENO
+ TAD (7617
+ DCA INPTR /POINT TO FIRST INPUT FILE
+ TAD I (7644
+ AND (4 / V OPTION?
+ SZA CLA
+ JMS TYPEV /OUTPUT VERSION #
+ JMS SETSW
+ DCA FLAG
+ TAD I (7617
+ SNA CLA
+ JMS SPCASE /NO FIRST ARG MEANS USE SYS: IN SPECIAL SENSE
+ JMP INL2
+INLOOP, TAD I INPTR /GET INPUT FILE # AND LENGTH
+ SNA CLA
+ JMP FINI /NO MORE INPUT
+ JMS PRDASH
+INL2, TAD I INPTR
+ AND (17
+ DCA DVNO /GET 4-BIT DEVICE #
+ ISZ FILENO
+ TAD I INPTR
+ AND (7760 /GET NEGATIVE OF FILE LENGTH
+ DCA FILEN
+ ISZ INPTR
+ TAD I INPTR /GET STARTING BLOCK OF FILE
+ DCA SBLOCK
+ ISZ INPTR
+ TAD DVNO
+ JMS GETDCW
+ SMA CLA
+ JMP NOFLST /DEVICE IS NOT FILE STRUCTURED
+ JMS OPENI /GET INPUT HANDLER
+ JMS DIRECT /ASCERTAIN DIRECTORY INFO
+ JMS HNDLRS /ASCERTAIN HANDLERS
+ TAD EXTEN
+ SZA CLA
+ JMS CNTSLT
+ JMS MONVER /ASCERTAIN MONITOR VERSION #
+NEXT, JMS CRLF
+ DCA FLAG
+ JMP INLOOP
+\fNOFLST, JMS PRINT
+ TEXT /%DEV IS NOT FILE STRUCTURED/
+ JMP NEXT
+
+FINI, JMS CLOSEO /CLOSE OUTPUT FILE
+FINIS, TAD I (7642
+ SMA CLA
+ JMP CD /COMMAND LINE ENDED WITH CR
+ CIF CDF 0 /COMMAND LINE ENDED WITH ALTMODE
+ JMP I (7605 /GO BACK TO MONITOR
+
+/CURRENT PIP /Y FILES ARE 50 (DEC) = 62 (OCTAL) BLOCKS LONG
+
+GETDCW, 0
+ AND (17
+ TAD (7757 /GET PTR INTO DEVICE CONTROL WORD TABLE
+ DCA DCW
+ TAD I DCW /GET D.C.W.
+ DCA DCW /SAVE (WHY?)
+ TAD DCW
+ JMP I GETDCW
+
+SETSW, 0
+ DCA FAST
+ DCA EXTEN
+ CLA IAC
+ AND I (7643
+ SNA CLA
+ JMP NOTF
+ ISZ FAST
+ JMP I SETSW
+NOTF, TAD I (7643
+ AND (200
+ SNA CLA
+ JMP I SETSW
+ ISZ EXTEN
+ ISZ FAST
+ JMP I SETSW
+
+/FAST GT 0 IF /L OR /E SWITCH SET
+/EXTEN=1 IF /E SWITCH SET AND /L NOT SET
+\fINPTR, 0 /POINTS TO INPUT FILE LIST
+FILEN, 0 /INPUT FILE LENGTH (NEG IN BITS 0-7)
+DCW, 0 /INPUT DEVICE CONTROL WORD
+FILENO, 0 /INPUT FILE NUMBER IN INPUT LIST
+SBLOCK, 0 /STARTING BLOCK # OF INPUT FILE
+FLAG, 0 /NON-ZERO MEANS SPECIAL CASE OF NO FIRST ARG
+
+SPCASE, 0
+ ISZ FLAG /NOTE SPECIAL CASE
+ CLA IAC
+ DCA I (7617 /FORCE FIRST INPUT TO BE SYS:
+ JMP I SPCASE
+ PAGE
+\fPRINT, 0
+ TAD I PRINT
+ DCA PRT
+ ISZ PRINT
+ TAD PRT
+ JMS RTR6
+ JMS PR
+ JMP I PRINT
+ TAD PRT
+ JMS PR
+ JMP I PRINT
+ JMP PRINT+1
+PRT, 0
+RTR6, 0
+TTY212, RTR
+ RTR
+ RTR
+ JMP I RTR6
+
+PR, 0
+ AND (77
+ SNA
+ JMP I PR
+ TAD (240
+ AND (77
+ TAD (240
+ JMS PUTO
+ ISZ PR
+ JMP I PR
+
+TPRINT, 0 /PRINT TO TELETYPE
+ CLA
+ TAD I TPRINT
+ DCA PRT
+ ISZ TPRINT
+ TAD PRT
+ JMS RTR6
+ JMS TPUT
+ TAD PRT
+ JMS TPUT
+ JMP TPRINT+1
+
+TPUT, 0
+ AND (77
+ SNA
+ JMP PUTCR
+ TAD (240
+ AND (77
+ TAD (240
+ JMS TYPE
+ JMP I TPUT
+
+PUTCR, JMS TCRLF
+ JMP I TPRINT
+\fTYPE, 0
+ DCA TYTEM
+ TAD CTRLO
+ SZA CLA
+ JMP I TYPE /DON'T TYPE IF CONTROL/O FLAG SET
+ KSF
+ SKP
+ JMS LOOKC
+ TAD TYTEM
+ JMS TYPE2
+ JMP I TYPE
+
+TYTEM, 0
+CTRLO, 0 /NON-ZERO MEANS CTRLO/O WAS STRUCK
+
+TYPE2, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I TYPE2
+
+LOOKC, 0
+ KRB
+ AND (177
+ TAD (-17
+ SNA /IS IT ^O?
+ JMP CTROLO /YES
+ TAD (17-3 /NO
+ SZA CLA /IS IT ^C?
+ JMP I LOOKC /NO
+ CIF CDF 0 /YES
+ JMP I (7605
+CTROLO, TAD ("^
+ JMS TYPE2
+ TAD ("O
+ JMS TYPE2
+ ISZ CTRLO
+ TAD (215
+ JMS TYPE2
+ TAD TTY212
+ JMS TYPE2
+ JMP I TYPE
+\fTYPEV, 0
+ JMS PRINT
+ TEXT /RESORC V4 /
+ *.-2
+ RESVERSION&77+6300
+ *.+1
+ JMS CRLF
+ JMP I TYPEV
+
+CRLF, 0
+ TAD (215
+ JMS PUTO
+ TAD TTY212
+ JMS PUTO
+ JMP I CRLF
+
+TCRLF, 0
+ TAD (215
+ JMS TYPE
+ TAD (212
+ JMS TYPE
+ JMP I TCRLF
+
+DLST, -1750 /1000
+ -144 /100
+ -12 /10
+ -1 /1
+ 0 /END
+ PAGE
+\fCLOSEO, 0 /CLOSE OUTPUT FILE
+ TAD (232 /PUT ^Z IN BUFFER
+ JMS PUTO
+ TAD (-577 /V3D
+ DCA KNT /SEND 577 NULLS TO OUTPUT BUFFER
+ JMS PUTO /THIS GUARANTEES TO PURGE IT
+ ISZ KNT
+ JMP .-2
+ TAD I (7600
+ JMS I (200
+ 4 /CLOSE
+L7601, 7601 /POINTER TO OUTPUT FILE NAME
+OUTLEN, 0 /LENGTH OF OUTPUT FILE
+ HLT /SYSTEM ERROR, CANNOT OCCUR
+ JMP I CLOSEO
+OPENO, 0
+ JMS OINIT
+ DCA OUTLEN
+ TAD (3401
+ DCA OENTRY
+ TAD I (7600
+ SNA CLA
+ JMP DEFALT
+ TAD I (7600
+ JMS GETDCW
+ RAL
+ SPA CLA
+ JMP NOWR /READ ONLY
+ TAD I (7600
+ JMS I (200
+ 1 /FETCH DEVICE HANDLER (POSSIBLY 2-PAGE)
+OENTRY, 3401 /INTO PAGE 3400
+ HLT /SYSTEM ERROR CANNOT OCCUR
+O2, TAD L7601
+ DCA SBLKO
+ TAD I L7601
+ SNA
+ TAD (2205 /RE
+ DCA I L7601 /DEFAULT OUTPUT NAME IS RE
+ DCA OLEN
+ TAD I (7604
+ SNA
+ TAD (1423 /LS
+ DCA I (7604 / .LS IS DEFAULT OUTPUT EXTENSION
+ TAD I (7600
+ JMS I (200
+ 3 /ENTER OUTPUT FILE
+SBLKO, 7601 /POINTS TO OUTPUT FILE NAME
+OLEN, 0 /COMPLEMENT OF ACTUAL OUTPUT FILE LENGTH
+ JMP DEVFUL /OUTPUT DEVICE FULL
+ TAD SBLKO
+ DCA OBLOCK
+ TAD OLEN
+ SZA
+ TAD (-1
+ DCA OLEN
+ JMP I OPENO
+
+KNT, 0
+\fDEFALT, TAD (3100 /SET TTY: AS DEFAULT OUTPUT DEVICE
+ DCA DVN
+ TAD (3401
+ DCA OENT
+ JMS I (200
+ 1 /FETCH HANDLER BY NAME
+ 2424 /TT
+DVN, 3100 /DEVICE TTY:
+OENT, 3401 /INTO 3400
+ JMP NOTTY /NO TTY: ON SYS:
+ TAD OENT
+ DCA OENTRY
+ TAD DVN
+ DCA I (7600
+ JMP O2
+
+OUTERR, JMS TPRINT
+ TEXT /?OUTPUT ERROR/
+ JMS CRLF
+ JMP FINIS
+\fTRY09, 0
+ TAD (60
+ CIA
+ TAD NAM
+ DCA DIG
+ TAD DIG
+ CLL
+ TAD (-10 /TRY DIGITS 0-7
+ SZL CLA
+ JMP I TRY09
+ TAD DIG
+ TAD (60
+ TAD RT
+ DCA RT
+ JMP GOTIT
+
+PUTSP, 0
+ TAD (40
+ JMS PUTO
+ JMP I PUTSP
+ PAGE
+\fPUTO, 0
+ AND (377
+ CDF 0
+ JMP I PUTJMP
+PUTJMP, X1
+X1, DCA I PUTPT1
+ TAD (X2
+ DCA PUTJMP
+PUTLV, CDF 10
+ JMP I PUTO /RETURN
+
+X2, DCA I PUTPT2
+ TAD (X3
+ DCA PUTJMP
+ JMP PUTLV
+
+X3, DCA TMP
+ TAD TMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I PUTPT1
+ DCA I PUTPT1
+ TAD TMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I PUTPT2
+ DCA I PUTPT2
+ ISZ PUTPT1
+ ISZ PUTPT1
+ ISZ PUTPT2
+ ISZ PUTPT2
+ TAD (X1
+ DCA PUTJMP
+ ISZ PUTKNT
+ JMP PUTLV
+ CDF 10 /BUFFER FILLED
+ ISZ OLEN
+ SKP
+ JMP DEVFUL /CAN'T WRITE ANYMORE
+ CIF 0
+ TAD OENTRY
+ DCA OENTR /GET ON SAME PAGE
+ JMS I OENTR
+ 4200 /WRITE 1 BLOCK
+ 2400 /FIELD 0, LOC 2400
+OBLOCK, 0 /OUTPUT BLOCK #
+ JMP OUTERR
+ ISZ OUTLEN
+ ISZ OBLOCK /POINT TO NEXT BLOCK
+ JMS OINIT
+ JMP I PUTO /RETURN
+\fPUTPT1, 0
+PUTPT2, 0
+PUTKNT, 0
+
+ZLQP, IAC /23
+PLAT4, IAC /22
+PLAT3, IAC /21
+PLAT2, IAC /20
+PLAT1, IAC /17
+ZXTRA, IAC /16
+ZKL8E, IAC /15
+ZRK8E, IAC /14
+ZRK8, IAC /13
+ZASR, IAC /12
+ZTA8, IAC /11
+ZTD8, IAC /10
+ZL645, IAC /7
+ZLPSV, IAC /6
+ZLV8E, IAC /5
+Z026, IAC /4
+Z029, IAC /3
+ZLSPT, IAC /2
+ZPT8E, IAC /1
+NOKIND, CLL RAL
+/PRINTS NAME FROM TABLE, ENTER WITH ENTRY # IN AC
+PRNAM, TAD (TABASE
+ JMS PUTNAM
+ JMS UNIT
+ JMP KINDRET
+\fTMP,
+GETD77, 0
+ TAD (7707
+ DCA MASK
+ TAD (-6704 /V3C
+ JMS SRCH
+ RTR
+ RAR
+ AND (7
+ JMP I GETD77
+
+QTTY, TAD I PDHIT
+ SMA CLA /1 OR 2 PAGE?
+ JMP ZASR /1 PAGE
+ JMP ZKL8E /2 PAGE
+
+QRK8E, TAD I PDHIT
+ AND (7
+ CLL RAR
+ DCA UN
+ JMP ZRK8E
+
+OENTR,
+TSTUN, 0
+ TAD I PDHIT
+ AND (7
+ DCA UN
+ JMP I TSTUN
+
+
+QRK8, JMS TSTUN
+ JMP ZRK8
+ PAGE
+\fNAME, 0
+ DCA NAM
+ TAD FAST
+ SZA CLA
+ JMP TRY1
+ STA
+ TAD DEVNUM
+ SNA CLA
+ JMP TRY1
+ TAD (",
+ JMS PUTO
+TRY1, TAD (LIST1
+ DCA NM1
+LP1, TAD I NM1
+ SNA
+ JMP TRY2
+ DCA LFT
+ ISZ NM1 /TRY A-B
+ TAD (-2 /CHANGE TO -4 TO TRY A-D
+ DCA TEMP
+ DCA RT
+LP1X, TAD RT
+ TAD (100
+ DCA RT
+ JMS COMB
+ JMS TRY09
+ ISZ TEMP
+ JMP LP1X
+ JMP LP1
+
+NAM, 0 /SPECIFIED NAME
+NM1, 0
+
+TRY2, TAD (LIST2
+ DCA NM1
+LP2, TAD I NM1
+ SNA
+ JMP TRY3
+ DCA LFT
+ ISZ NM1
+ TAD I NM1
+ ISZ NM1
+ DCA RT
+ JMS COMB
+ DCA TEMP
+ TAD TEMP
+ CIA
+ TAD NAM
+ SNA CLA
+ JMP GOTIT
+ TAD TEMP
+ JMS TRY09
+ JMP LP2
+\f/TRY0 SHOULD BE SPECIAL CASE TESTS
+
+TRY3, TAD NAM
+ JMS RTR6
+ AND (37
+ SNA
+ JMP TRY4
+ JMS SETIFA
+ CLL RAR
+ JMS RTR6
+ DCA LFT
+ TAD NAM
+ AND (77
+ JMS SETIFA
+ TAD LFT
+ DCA LFT
+ DCA RT
+ JMP GOTIT
+
+SETIFA, 0
+ SNA
+ JMP I SETIFA
+ TAD (-33
+ SPA
+ JMP LETR
+ TAD (33-60
+ CLL
+ TAD (-12
+ SZL
+ JMP NODI
+ TAD (12+60-33
+LETR, TAD (33
+ JMP I SETIFA
+NODI, CLA
+TRY4, TAD NAM
+ JMS NNAME
+NAMLV, JMP I NAME
+\fCMFLG, 0
+
+/COMB, 0
+/ TAD RT
+/ SZA CLA
+/ STA
+/ DCA CMFLG
+/ TAD LFT
+/ TAD RT
+/ ISZ CMFLG
+/ JMP I COMB
+/ CLL RAL
+/ STL RAR
+/ JMP I COMB /TURN ON BIT 0 OF 1 WORD NAME
+
+LIST1, TEXT /DTMTLTTDCSRKRFRX/
+/ ZBLOCK 1 /PATCH SPACE
+
+PRDASH, 0
+ JMS PRINT
+ TEXT /------/
+ JMS CRLF
+ JMS CRLF
+ JMP I PRDASH
+\fRTL6, 0
+ RTL
+ RTL
+ RTL
+ JMP I RTL6
+ PAGE
+\fDEVFUL, JMS TPRINT
+ TEXT /?OUTPUT DEV FULL/
+ JMP FINIS
+
+NOWR, JMS TPRINT
+ TEXT /?OUTPUT DEV IS READ-ONLY/
+ JMP FINIS
+NOTTY, JMS TPRINT
+ TEXT /?TTY DOES NOT EXIST/
+ JMP FINIS
+\fOINIT, 0
+ TAD (-200
+ DCA PUTKNT
+ TAD (2400
+ DCA PUTPT1
+ TAD (2401
+ DCA PUTPT2
+ TAD (X1
+ DCA PUTJMP
+ JMP I OINIT
+\fREADI, 0
+ TAD I READI
+ DCA ARG1
+ ISZ READI
+ TAD I READI
+ DCA ARG2
+ ISZ READI
+ TAD I READI
+ DCA ARG3
+ ISZ READI
+ CIF 0
+ JMS I IENTRY
+ARG1, 0
+ARG2, 0
+ARG3, 0
+ JMP INERR
+ JMP I READI /REURN
+
+INERR, JMS TPRINT
+ TEXT /?INPUT ERROR/
+ JMP FINIS
+
+OPENI, 0 /FECTH INPUT HANDLER
+ TAD (3001 /INTO PAGES 3000, 3200
+ DCA IENTRY
+ TAD DVNO
+ JMS I (200
+ 1 /FETCH HANDLER
+IENTRY, 3001
+ HLT /SYSTEM ERROR, CAN'T OCCUR
+ JMP I OPENI
+\fPRFREE, 0
+ JMS PRINT
+ TEXT /FREE DEVICE SLOTS: /
+ TAD FREEDV
+ JMS XPRINT
+ JMS PRINT
+ TEXT /, FREE BLOCK SLOTS: /
+ TAD SLKNT
+ JMS XPRINT
+ JMP I PRFREE
+ PAGE
+\fDIRECT, 0
+ TAD SBLOCK
+ SZA CLA
+ JMP I DIRECT /NO DIRECTORY INFO FOR FILES
+ JMS READI
+ 1400 /READ 6 BLOCKS
+ 4000 /INTO 04000
+ 1 /FROM BLOCK 1
+ JMS DVALID /CHECK IF VALID DIRECTORY
+ TAD FAST
+ SNA CLA
+ JMP I DIRECT /NO DIRECT IN FAST MODE
+ JMS CRLF
+ DCA USED
+ DCA UNUSED
+ DCA NFILES
+ DCA NMTS
+ DCA NSEGS
+ STL CLA RAR /4000
+DIRLUP, DCA DIRPTR
+ ISZ NSEGS
+ JMS GETDIR
+ DCA NENTRY /- NO. OF ENTRIES IN SEGMENT
+ JMS GETDIR
+ DCA STBLK /STARTING BLOCK # OF FIRST FILE IN SEGMENT
+ JMS GETDIR
+ DCA LINK /LINK TO NEXT SEGMENT
+ JMS GETDIR
+ CLA /IGNORE FLAG WORD TO TENTATIVE FILE
+ JMS GETDIR
+ DCA AIW /# OF ADDITIONAL INFO WORDS
+ TAD NENTRY
+ DCA DKNT
+SEGLUP, JMS GETDIR
+ SNA CLA
+ JMP EMPTY /AN EMPTY ENTRY
+ TAD AIW
+ CIA
+ TAD (3
+ TAD DIRPTR
+ DCA DIRPTR /POINT TO FILE LENGTH
+ JMS GETDIR /GET NEG OF NUMBER OF BLOCKS IN FILE
+ SNA
+ JMP NEXTF /A TENTATIVE FILE, IGNORE
+ CIA
+ TAD USED
+ DCA USED
+ ISZ NFILES
+ JMP NEXTF
+EMPTY, JMS GETDIR
+ CIA
+ TAD UNUSED
+ DCA UNUSED
+ ISZ NMTS
+NEXTF, ISZ DKNT /ANY MORE ENTRIES IN THIS SEGMENT?
+ JMP SEGLUP /YES
+ TAD LINK
+ SNA CLA
+ JMP GOTINFO
+ TAD NSEGS
+ CMA
+ TAD LINK /ASSUME LINKS ARE IN ORDER
+ SZA CLA
+ JMP BADDIR
+ STA /GO TO NEXT SEGMENT
+ TAD DIRPTR
+ AND (7400
+ TAD (400
+ JMP DIRLUP
+\fDKNT, 0
+USED, 0 /NO. OF BLOCKS USED
+UNUSED, 0 /# OF UNUSED BLOCKS ON DEVICE
+NFILES, 0 /# OF FILES
+NMTS, 0 /# OF EMPTIES
+NSEGS, 0 /# OF DIRECTORY SEGMENTS USED
+GOTINFO,JMS PRINFO
+LVDIR, JMS CRLF
+ JMS CRLF
+ JMP I DIRECT
+
+NENTRY, 0 /- # OF ENTRIES IN SEGMENT
+STBLK, 0 /STARTING BLOCK # OF FIRST FILE IN SEGMENT
+LINK, 0 /LINK TO NEXT SEGMENT
+AIW, 0 /# OF ADDITIOANAL INFORMATION WORDS
+
+GETDIR, 0
+ CDF 0
+ TAD I DIRPTR
+ CDF 10
+ ISZ DIRPTR
+ JMP I GETDIR
+
+DIRPTR, 0
+\fXPRINT, 0
+ SNA
+ JMP NONEPR
+ JMS OPRINT
+ JMP I XPRINT
+
+NONEPR, JMS PRINT
+ TEXT /NONE/
+ JMP I XPRINT
+
+SLOTAB, ZBLOCK 10 /KEEPS TRACK OF USED SLOTS
+
+GETTYP, 0
+ CDF 0
+ TAD I PTYP
+ CDF 10
+ JMP I GETTYP
+
+QTC08,
+QLINC, JMS TSTUN
+ JMP NOKIND
+ PAGE
+\fPRINFO, 0
+ TAD EXTEN
+ SNA CLA
+ JMP NOFLS /JUST # OF FREE BLOCKS UNLESS /E
+ TAD NFILES
+ SNA
+ JMP NOFLS
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / FILES IN /
+ TAD USED
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / BLOCKS/
+ STA
+ TAD NSEGS
+ SNA CLA
+ JMP ONESEG
+ JMS PRINT
+ TEXT / USING /
+ TAD NSEGS
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / SEGMENTS/
+ONESEG, JMS CRLF
+NOFLS, TAD UNUSED
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / FREE BLOCKS/
+ TAD EXTEN
+ SNA CLA
+ JMP I PRINFO
+ TAD NMTS
+ CLL RAR
+ SNA CLA
+ JMP MT1
+ JMS PRINT
+ TEXT / (/
+ TAD NMTS
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / EMPTIES)/
+MT1, CLA IAC
+ TAD AIW
+ SZA CLA
+ JMS PRAIW
+ JMP I PRINFO
+
+PRAIW, 0
+ JMS CRLF
+ TAD AIW
+ CIA
+ STL
+ JMS DPRINT
+ JMS PRINT
+ TEXT / EXTRA INFO WDS/
+ JMP I PRAIW
+\f/HNDGET GETS VALUE IN HANDLER FROM REL LOC IN AC
+
+HNDGET, 0
+ TAD BLOC
+ DCA TEMP
+ CDF 0
+ TAD I TEMP
+ CDF 10
+ JMP I HNDGET
+
+PUTNAM, 0
+ DCA PUTNMT
+ TAD I PUTNMT
+ JMS PUTPAK
+ ISZ PUTNMT
+ TAD I PUTNMT
+ JMS PUTPAK
+ JMP I PUTNAM
+PUTNMT, 0
+/THIS PRINTS A 4 CHAR NAME, ARG IN AC.
+
+COMB, 0 /TEMP
+ TAD LFT
+ TAD RT
+ SMA
+ TAD (4000
+ JMP I COMB
+ PAGE
+\fKIND, 0
+ JMS PUTSP
+ TAD BLOC
+ SNA CLA
+ JMP NOKIND
+ JMS GETTYP
+ SNA
+ JMP NOKIND
+ DCA TEMP
+ JMP I TEMP /BRANCH TO APPROPRIATE SUBROUTINE
+KINDRET,JMP I KIND
+
+/KIND SUBROUTINES
+/ENTER WITH BLOC POINTING TO HANDLER BLOCK IN CORE
+
+/SRCH SEARCHES THE HANDLER FOR THE NEGATIVE
+/OF THE NON-ZERO VALUE IN THE AC.
+/MASKED BY MASK.
+/IF FOUND, RETURN IS MADE WITH VALUE(WITHOUT MASK) IN AC
+/IF NOT FOUND, AC IS 0 UPON RETURN
+
+SRCH, 0
+ DCA LOOK4
+ STA
+ TAD BLOC
+ DCA XR1
+ TAD (-230 /V3C MUST SEARCH 2 PAGES; TROUBLE IF TA8E IS IN LAST SLOT
+ DCA SRCHCNT
+SRCHLP, CDF 0
+ TAD I XR1
+ CDF 10
+ DCA TEMP
+ TAD TEMP
+ AND MASK
+ TAD LOOK4
+ SNA CLA
+ JMP SRCHGOT
+ ISZ SRCHCNT
+ JMP SRCHLP
+ JMP I SRCH
+
+SRCHGOT,TAD TEMP
+ JMP I SRCH
+
+SRCHCNT,-400
+LOOK4, 0
+/ **** NOTE: ALL HANDLERS SHOULD BE PADDED OUT TO FILL PAGE
+/ WITH ZEROES
+/BUILD SHOULD WRITE ZEROES IN 2ND PAGE OF ONE PAGE HANDLER
+\f/SPECIAL PURPOSE ROUTINES
+
+QPTP,
+QPTR, STA
+ DCA MASK
+ TAD (-6021
+ JMS SRCH
+ SZA CLA
+ JMP ZPT8E
+ JMP ZLSPT
+
+/FOR TYPE PTR
+/ IF HANDLER CONTAINS A 6021 IT IS A PT8E
+/ OTHERWISE IT IS A LSPT
+
+QCR8E, TAD (104
+ JMS HNDGET
+ TAD (-3203
+ SNA
+ JMP Z029
+ TAD (3203-7735
+ SNA CLA
+ JMP Z026
+ JMP NOKIND
+
+/FOR TYPE CR8E
+/ IF REL LOC 104 IS A 3203 IT IN 029 KIND
+/ IF REL LOC 104 IS A 7735 IT IS AN 026 KIND
+/ OTHERWISE IT IS AN UNKNOWN KIND
+
+QLPTR, STA
+ DCA MASK
+ TAD (-6652 /SEARCH FOR A 6652
+ JMS SRCH
+ SZA CLA
+ JMP ZL645 /FOUND IT
+ CLA IAC /LOOK AT REL LOC 1
+ JMS HNDGET
+ TAD (-4
+ SNA
+ JMP ZLV8E
+ TAD (4-14
+ SNA CLA
+ JMP ZLPSV
+ JMP NOKIND
+
+/IF HANDLER CONTAINS A 6652 IT'S AN L645
+/OTHERWISE, DEPENDS ON REL LOC 1
+/ IF REL LOC 1 IS A 14, IT'S A LPSV
+/ IF REL LOC 1 IS A 4, IT'S A LV8E
+/ OTHERWISE IT'S UNKNOWN (POSSIBLY OLD LP08 OR LS8E KIND)
+
+MASK, 0
+\fQTD8E, JMS GETD77
+ CIA
+ TAD (10
+ DCA TEMP
+ TAD KTD8+1
+ AND (7700
+ TAD TEMP
+ DCA KTD8+1
+ TAD I PDHIT
+ RTR
+ RAR
+ STA
+ TAD TEMP
+ CML RAL /TIMES 2 + LINK
+ DCA UN
+ JMP ZTD8
+
+/FIGURE OUT KIND OF TD8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
+/ N TYPE
+/ 7 TD8A
+/ 6 TD8B
+/..
+/ 1 TD8G
+/ 0 TD8H
+
+QTA8E, JMS GETD77
+ IAC
+ DCA TEMP
+ TAD KTA8+1
+ AND (7700
+ TAD TEMP
+ DCA KTA8+1
+ STA
+ TAD I PDHIT
+ AND (177
+ SNA CLA
+ CLA IAC
+ DCA UN
+ STA
+ TAD TEMP
+ CLL RAL
+ TAD UN
+ DCA UN
+ JMP ZTA8
+\f/FIGURE OUT KIND OF TA8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
+
+/ N KIND
+/ 0 TA8A
+/ 1 TA8B
+/...
+/ 6 TA8G
+/ 7 TA8H
+ PAGE
+\f/DECIMAL PRINT
+/LINK OFF MEANS PRINT LEADING SPACES
+/LINK ON MEANS DON'T PRINT LEADING SPACES OR ZEROS
+
+DPRINT, 0
+ DCA DTM
+ RAR
+ DCA LNK
+ DCA ZFLG
+ TAD (DLST
+ DCA PLST
+DPL2, DCA DYG
+DPLUP, TAD I PLST
+ SNA
+ JMP I DPRINT
+ CLL
+ TAD DTM
+ SNL
+ JMP NEGG
+ ISZ DYG
+ DCA DTM
+ JMP DPLUP
+
+NEGG, CLA
+ TAD DYG
+ TAD ZFLG
+ SNA
+ JMP PRBLNK
+ TAD (60
+ JMS PUTO
+ STL CLA RAR /4000
+ DCA ZFLG
+ISZZ, ISZ PLST
+ JMP DPL2
+
+PRBLNK, TAD LNK
+ CLL RAL
+ TAD L40
+ SNL
+ JMS PUTO
+ CLA
+ JMP ISZZ
+DYG, 0
+PLST, 0
+ZFLG, 0 /4000 MEANS PASSED LEADING ZEROES
+\f/PRINTS A 2-DIGIT OCTAL NUMBER WITH LEADING 0'S
+
+OPRINT, 0
+ DCA OTEM
+ TAD OTEM
+ RTR
+ RAR
+ JMS OPRI
+ TAD OTEM
+ JMS OPRI
+ JMP I OPRINT
+
+OPRI, 0
+ AND (7
+ TAD (260
+ JMS PUTO
+ JMP I OPRI
+
+PRINT4, 0
+ DCA DTM
+ TAD DTM
+ JMS RTR6
+ JMS OPRINT
+ TAD DTM
+ JMS OPRINT
+ JMP I PRINT4
+
+DTM, 0
+
+PUTPAK, 0
+ DCA DTM
+ TAD DTM
+ JMS RTR6
+ JMS PR
+ JMS BLNKIT
+ TAD DTM
+ JMS PR
+ JMS BLNKIT
+ JMP I PUTPAK
+
+BLNKIT, 0
+ TAD FAST
+ SZA CLA
+ TAD L40
+ JMS PR
+L40, 40 /CAN'T HURT TO CALL PR WITH A 0
+ JMP I BLNKIT
+\fLNK,
+VERSN, 0
+ JMS PUTSP
+ TAD BLOC
+ SNA CLA
+ JMP SYSV /TEMP (ENTRY PT IS IN FIELD 1 7600
+ TAD I PDHIT
+ AND (177
+ TAD BLOC
+GOVR, DCA DTM
+ JMS GETV
+ CLL IAC
+ TAD (-34
+ SZL CLA
+ JMP NOOOP
+ JMS GETV
+PUTVR, SZA
+ TAD L40
+ TAD L40
+ JMS PUTO
+ JMP I VERSN
+
+OTEM,
+GETV, 0
+ CDF 0
+ TAD I DTM
+ CDF 10
+ JMP I GETV
+
+NOOOP, STA
+ TAD DTM /SCAN BACKWARDS FOR HANDLER VERSION # (LT 33)
+ JMP GOVR
+
+SYSV, TAD I PDHRT
+ AND (177
+ TAD (INPBL0+200
+ DCA DTM
+ TAD I DTM
+ CLL
+ TAD (-34
+ SNL CLA
+ TAD I DTM /PRINT BAD VERSION # AS SPACE
+ JMP PUTVR
+ PAGE
+\fMONVER, 0
+ TAD FAST
+ SNA CLA
+ JMP I MONVER
+ TAD I (1400
+ TAD (-7607
+ SNA
+ JMP NOTV3
+ TAD (7607+60
+ DCA TEMPX
+ TAD I (1400+31
+ DCA TMPTWO
+OS8, TAD ("O
+ JMS PUTO
+MONV2, JMS PRINT
+ TEXT \S/8 V\
+ TAD TEMPX
+ JMS PUTO
+ TAD TMPTWO
+ JMS PUTO
+ JMS CRLF
+ JMP I MONVER
+
+TMPTWO, 0
+TEMPX, 0
+
+NOTV3, TAD (40
+ DCA TMPTWO
+/CHECK FOR PS/8 AND COS
+ JMP OS8
+\fLIST2, DEVICE LPT
+ DEVICE TTY
+ DEVICE PTR
+ DEVICE PTP
+ DEVICE CDR
+ DEVICE SYS
+ DEVICE DSK
+ DEVICE CDP
+/ DEVICE DEV
+/ DEVICE OUT
+/ DEVICE INP
+ DEVICE BAT
+ DEVICE NULL /SHOULD BE IN NEXT TABLE
+ DEVICE LST /V3C
+ DEVICE DUMP
+ DEVICE SLU
+ DEVICE LQP
+ ZBLOCK 10 /PATCH SPACE
+ 0
+
+/LIST3, DEVICE NULL
+/ DEVICE TEST
+/ DEVICE LIST
+/ DEVICE DUMP /V3C
+/ ZBLOCK 2 /PATCH SPACE
+/ 0
+
+/INTERESTING NOTE: 'BAT', 'FOO2' AND 'RKC6' ALL HASH OUT TO 6601
+/** WANT TO CHANGE AIW PRINTER TO SAY 'NO' ADDITIONAL INFO WORDS
+/IF THERE ARE NONE.
+\f/DTN
+/DKN
+GOTIT, TAD FAST
+ SZA CLA
+ JMS PUTSP
+ TAD (LFT
+ JMS PUTNAM
+ TAD FAST
+ SZA CLA
+ JMS PUTSP
+ JMP NAMLV
+\fTABASE, 4040;4040 /0
+ DEVICE PT8E /1
+ DEVICE KS33 /2
+ DEVICE 029 /3
+ DEVICE 026 /4
+ DEVICE LV8E /5
+ DEVICE LPSV /6
+ DEVICE L645 /7
+KTD8, DEVICE TD8 /10
+KTA8, DEVICE TA8 /11
+ DEVICE AS33 /12
+ DEVICE RK01 /13
+ DEVICE RK05 /14
+ DEVICE KL8E /15
+ DEVICE XTRA /16
+ TEXT / =1/ /17
+ TEXT / =2/ /20
+ TEXT / =3/ /21
+ TEXT / =4/ /22
+ DEVICE LQP /23
+ PAGE
+\f/FORMAT OF SYSTEM HEAD FILE
+
+/REL BLK CONTENTS ABS BLK ON DEV
+
+/0 BOOTSTRAP & PAGE 0'S 0
+/1-4 KEYBOARD MONITOR 7-12
+/5-7 USR 13-15
+/10-17 DEVICE HANDLERS 16-25
+/20 ENTER 26
+/21-42 SCRATCH BLOCKS 27-50
+/43-45 COMMAND DECODER 51-53
+/46-47 SAVE,DATE 54-55
+/50 ERROR OVERLAY 56
+/51 CHAIN OVERLAY 57
+/52-55 ODT 60-63
+/56 RESERVED FOR EXPN 64
+/57 CCL SCRATCH 65
+/60 12K TD8E HANDLER 66
+/61 CCL OVERLAY 67
+\f/DIR DID NOT GET IN CORE ON /F?
+
+DEV, DCA BLCK0
+ TAD (66
+ DCA BLCK66
+ TAD (7
+ DCA KBM
+ TAD (13
+ DCA USRBLK
+ CDF 0
+ TAD I (4001 /GET STARTING BLOCK # OF FILES
+ CDF 10
+ TAD (-7
+ SNA CLA
+ JMP NONSYS /FILES START AT BLOCK 7 OF DEVICE
+ TAD (16
+/CHECK TO SEE THAT DEVICE HAS SYSTEM ON IT
+ JMP RD
+
+NONSYS, JMS PRINT
+ TEXT /%NON SYSTEM DEVICE/
+ JMP NEXT
+
+BADFIL, JMS PRINT
+ TEXT /%NOT A SYSTEM HEAD/
+ JMP NEXT
+
+BADMON, JMS PRINT
+ TEXT /%BAD MONITOR/
+ JMP NEXT
+\fDVALID, 0
+ STL CLA RAR /4000
+ DCA DIRPTR
+ JMS GETDIR
+ CLL
+ TAD (200
+ SNL CLA
+ JMP BADDIR
+ JMS GETDIR
+ SNA
+ JMP BADDIR
+ TAD (-400 /REMEMBER COS
+ SMA CLA
+ JMP BADDIR
+ JMS GETDIR
+ CLA /LINKS THOROUGHLY CHECKED ELSEWHERE
+ JMS GETDIR
+ SNA
+ JMP OKDIR
+ TAD (-1400
+ CLL
+ TAD (-1000
+ SZL CLA
+ JMP BADDIR
+OKDIR, JMS GETDIR
+ SPA SNA CLA
+ JMP I DVALID
+BADDIR, JMS PRINT
+ TEXT \?BAD DIRECTORY\
+ JMP LVDIR
+\fUNIT, 0
+ JMS PUTSP
+ TAD BLOC
+ SNA CLA
+ JMP TSTSUN
+ TAD UN
+ SPA
+ TAD (40+1-60
+ZOUN, TAD (60
+ JMS PUTO
+ JMP I UNIT
+
+TSTSUN, TAD I PDHRT
+ TAD (-7607
+ SZA CLA
+ CLA IAC /ASSUME CORESIDENT HANDLERS ARE UNIT 1
+ JMP ZOUN /ELSE, NO UNIT
+ PAGE
+\fHNDLRS, 0
+ TAD SBLOCK
+ SNA /IS IT A FILE?
+ JMP DEV /NO
+ DCA BLCK0 /YES
+ TAD BLCK0
+ TAD (60
+ DCA BLCK66
+ TAD FILEN
+ TAD (-6340
+ SZA CLA
+ JMP BADFIL /FILE DOESN'T HAVE LENGTH 50 (DECIMAL)
+ TAD BLCK0
+ IAC
+ DCA KBM
+ TAD BLCK0
+ TAD (5
+ DCA USRBLK
+ TAD BLCK0
+ TAD (10
+RD, DCA HNDBLK
+ JMS READI /READ IN BLOCK 0
+ 210 /2 PAGES
+ INPBL0
+FREEDV, /# OF FREE DEVICE NUMBERS
+BLCK0, 0
+ TAD I (INPBL0+212 /** DEPENDS ON TD8E HANDLER
+ TAD (-3
+ SZA CLA /IS IT 12K TD8E?
+ JMP NOTD8E /NO
+ JMS READI /YES
+ 110 /1 PAGE
+ INPBL0
+BLCK66, 66
+NOTD8E, TAD I (INPBL0+200
+ TAD (-4207
+ SZA CLA
+ JMP BADMON /BAD MONITOR ON DEVICE
+ DCA 7 /DELETE CURRENT USR DIRECTORY SEGMENT
+ /SINCE KBM READS OVER IT
+ JMS READI /READ IN KEYBOARD MONITOR
+ 211 /ONLY FIRST 2 PAGES
+ INPKBM
+KBM, 7
+ JMS READI /READ IN USR
+ 611 /6 PAGES
+ INPUSR
+USRBLK, 13
+ JMS READI /READ IN ALL HANDLERS (EXCEPT 2ND PAGE OF LAST ONE)
+ 1700 /17 PAGES
+ INPHND
+HNDBLK, 16
+ TAD (-17
+ DCA CNT
+ DCA FREEDV
+ JMS ZEROSL
+ DCA DEVNUM
+ JMS SETPTS
+ JMS HEADING
+LOOP, ISZ DEVNUM /PT TO NEXT HANDLER
+ TAD I PDNT /LOOK AT DEVICE NAME
+ SNA CLA
+ JMP NOXXT
+ TAD EXTEN
+ SNA CLA
+ JMP NONUM
+ TAD DEVNUM
+ JMS OPRINT
+NONUM, TAD I PDNT
+ JMS NAME /PRINT NAME
+ TAD FAST
+ SNA CLA
+ JMP NEXXT
+ JMS TIPE /PRINT TYPE
+ TAD EXTEN
+ SNA CLA
+ JMP PUSER
+ JMS MODE /PRINT MODE
+ JMS SIZE /PRINT SIZE
+ JMS BLOCK /PRINT BLOCK # OF LOC OF HANDLER
+ STA
+ DCA UN
+ JMS KIND /PRINT KIND
+ JMS VERSN /PRINT HANDLER VERSION #
+ JMS ENTRY
+PUSER, TAD I PUDNT
+ SNA CLA
+ JMP EOL
+ TAD I PUDNT
+ JMS NAME /PRINT USER NAME
+EOL, JMS CRLF
+NEXXT, ISZ PDNT
+ ISZ PUDNT
+ ISZ PDHIT
+ ISZ PDCWT
+ ISZ PDHRT
+ ISZ CNT
+ JMP LOOP
+ JMS CRLF
+ JMP I HNDLRS
+
+NOXXT, ISZ FREEDV
+ JMP NEXXT
+\f PAGE
+\fHEADING,0
+ TAD FAST
+ SNA CLA
+ JMP I HEADING
+ TAD EXTEN
+ SNA CLA
+ JMP REGLR
+ JMS PRINT
+ TEXT /# NAME TYPE MODE SIZ BLK KIND U V ENT USER/
+ JMP HDLV
+REGLR, JMS PRINT
+ TEXT / NAME TYPE USER/
+HDLV, JMS CRLF
+ JMP I HEADING
+\fSETPTS, 0
+ TAD I (INPUSR+36
+ TAD (INPUSR
+ DCA PDNT
+ TAD FLAG
+ SZA CLA
+ TAD (7741-141-INPBL0
+ TAD (INPBL0+141
+ DCA PUDNT
+/CHANGE FOR FLAG?
+ TAD I (INPUSR+37
+ TAD (INPUSR
+ DCA PDHIT
+/FLAG?
+ TAD (INPBL0+160
+ DCA PDCWT
+ TAD (INPBL0+47
+ DCA PDHRT /DEVICE HANDLER RESIDENCY TABLE
+ JMP I SETPTS
+\fCODE, 0 /DEVICE CODE
+
+NNAME, 0
+ DCA TIPE
+ TAD ("(
+ JMS PUTO
+ TAD TIPE
+ JMS PRINT4
+ TAD (")
+ JMS PUTO
+ JMP I NNAME
+
+TIPE, 0
+ TAD I PDCWT
+ RTR
+ RAR
+ AND (77
+ DCA CODE
+ TAD CODE
+ CLL RTL
+ TAD (TYPTBL
+ DCA PTYP
+ JMS GETTYP
+ ISZ PTYP
+ SNA
+ JMP UNKN
+ JMS PUTPAK
+ JMS GETTYP
+ JMS PUTPAK
+ ISZ PTYP /POINT TO SIZE
+ JMP I TIPE
+UNKN, JMS PUTSP
+ TAD CODE
+ JMS OPRINT
+ JMS PUTSP
+ ISZ PTYP
+ JMP I TIPE
+\fSIZE, 0
+ JMS GETTYP
+ CIA
+ CLL
+ JMS DPRINT
+ JMS PUTSP
+ ISZ PTYP /POINT TO KIND SUBROUTINE
+ JMP I SIZE
+
+QLPTRX, TAD I PDHIT
+ SMA CLA /1 OR 2 PAGE?
+ JMP QLPTR /1 PG
+ JMP ZLQP /2 PG
+ PAGE
+\fMODE, 0
+ JMS PUTSP
+ TAD (-4
+ DCA MKNT
+ TAD I PDCWT
+ RTL
+ RAL
+ JMS MSET
+ "R
+ TAD I PDCWT
+ RTL
+ JMS MSET
+ "W
+ TAD I PDCWT
+ RAL
+ CML
+ JMS MSET
+ "F
+ JMS PUTSP
+ ISZ MKNT
+ JMP .-3
+ JMP I MODE
+
+MSET, 0
+ CLA
+ TAD I MSET
+ DCA MCHAR
+ ISZ MSET
+ SZL
+ JMP I MSET
+ ISZ MKNT
+ TAD MCHAR
+ JMS PUTO
+ JMP I MSET
+
+MKNT, 0
+\fET,
+BLOCK, 0
+ TAD I PDHIT
+ JMS RTL6
+ AND (17
+ SNA
+ JMP SYS
+ DCA SLTM
+ STA
+ TAD SLTM
+ CLL RTR
+ RTR
+ RAR
+ TAD (INPHND
+ DCA BLOC
+ TAD SLTM
+ TAD (15
+ JMS OPRINT
+ TAD I PDHIT
+ SMA CLA
+ TAD (40-"+
+ TAD ("+
+ JMS PUTO /"+" MEANS 2 PAGE HANDLER
+ TAD SLTM
+ TAD (SLOTAB-1
+ DCA SLTM
+ ISZ I SLTM
+ JMP I BLOCK
+SYS, JMS PRINT
+ TEXT /SYS/
+ DCA BLOC /0 MEANS RESIDENT WITH SYS:
+ JMP I BLOCK
+
+MCHAR,
+ENTRY, 0
+ JMS PUTSP
+ TAD BLOC
+ SNA CLA
+ JMP SYSENT
+ TAD I PDHIT
+EN2, DCA ET
+ TAD ET
+ JMS RTR6
+ AND (1
+ SZA
+ TAD (20
+ TAD (40
+ JMS PUTO
+ TAD ET
+ JMS OPRINT
+ JMP I ENTRY
+
+SYSENT, TAD I PDHRT
+ JMP EN2
+\fSLTM, 0
+
+SLKNT,
+ZEROSL, 0
+ TAD (-10
+ DCA SLTM
+ TAD (SLOTAB-1
+ DCA X0
+ DCA I X0
+ ISZ SLTM
+ JMP .-2
+ JMP I ZEROSL
+
+CNTSLT, 0
+ TAD (-10
+ DCA SLTM
+ DCA SLKNT
+ TAD (SLOTAB-1
+ DCA X0
+CNSLP, TAD I X0
+ SNA CLA
+ ISZ SLKNT
+ ISZ SLTM
+ JMP CNSLP
+ JMS PRFREE
+ JMS CRLF
+ JMP I CNTSLT
+ PAGE
+\f FIELD 0
+
+ *2000
+
+/ DEVICE LENGTH TABLE
+
+/FORMAT OF THIS TABLE:
+
+/1,2 DEVICE GENERALIZED NAME (CORR TO TYPE)
+/3 NEG OF LENGTH
+/4 ADDRESS OF SUBR IN FIELD 1 FOR SPECIALIZATION
+
+TYPTBL, DEVICE TTY ;0000;QTTY /0
+ DEVICE PTR ;0000;QPTR /1
+ DEVICE PTP ;0000;QPTP /2
+ DEVICE CR8E;0000;QCR8E /3
+ DEVICE LPTR;0000;QLPTRX /4 V3D
+ DEVICE RK8 ;1520;QRK8 /5
+ DEVICE RF08;6001;PLAT1 /6 V3C
+ DEVICE RF08;4002;PLAT2 /7
+ DEVICE RF08;2003;PLAT3 /10
+ DEVICE RF08;0004;PLAT4 /11 RF'S NOW ONLY HAVE LOGICALLY 1777 BLOCKS
+ DEVICE DF32;7601;PLAT1 /12
+ DEVICE DF32;7402;PLAT2 /13 V3C
+ DEVICE DF32;7203;PLAT3 /14
+ DEVICE DF32;7004;PLAT4 /15 DF'S HAVE 177 BLOCKS
+ DEVICE TC08;6437;QTC08 /16
+ DEVICE LINC;6437;QLINC /17
+ DEVICE TM8E;0000;0 /20
+ DEVICE TD8E;6437;QTD8E /21
+ DEVICE BAT ;0000;0 /22
+ DEVICE RK8E;1520;QRK8E /23
+ DEVICE NULL;0000;0 /24
+ DEVICE RX8E;7022;0 /25
+ ZBLOCK 4 /26
+ DEVICE TA8E;0000;QTA8E /27
+ DEVICE VR12;0000;0 /30
+ ZBLOCK 4 /31
+ ZBLOCK 4 /32
+ ZBLOCK 4 /33
+ ZBLOCK 4 /34
+ ZBLOCK 4 /35
+ DEVICE DUMP;0000;0 /36
+ ZBLOCK 4 /37
+ ZBLOCK TYPTBL+400-.
+ PAGE
+\f FIELD 1
+ *2000
+ $
--- /dev/null
+/5 OS/8 SYMBOLIC EDITOR, V12
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/5 JULY 1972 EF
+
+/COPYRIGHT 1971,1972 DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASSACHUSSETTS 01754
+
+/THE SYMBOLIC EDITOR IS A LINE-ORIENTED
+/TEXT EDITOR WITH CHARACTER AND STRING
+/SEARCH CAPABILITIES. IT IS DESIGNED
+/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
+
+/THE DESIGN OF THE EDITOR IS SIMILAR
+/TO THAT OF THE PAPER TAPE SYMBOLIC
+/EDITOR AND THE DISK MONITOR SYSTEM
+/EDITOR.
+
+
+/ OS/8 V3 CHANGES S.R.
+
+/1. ?5 ERROR REMOVED
+/2. ALLOW CHAINING TO EDIT
+/3. ADDED VERSION # COMMAND (#)
+/4. COMBINED ^C ROUTINES, TAKING OUT BRANCH THRU 17667
+/5. ALLOWED PARITY CHARACTERS EVERYWHERE
+/
+/
+/ FIX FOR V10 J.K. 1975
+/
+/ THE CLOSE ERROR MESAGE 2? WAS BEING
+/ GIVEN INSTEAD OF FILE FULL MESSAGE
+/ WHEN THE INPUT FILE FIT INTO THE EDIT BUFFER
+/ BUT WAS TOO LARGE FOR THE AVAILIBLE SPACE ON THE
+/ OUTPUT DEVICE.
+
+/ V11 CHANGES 25-MAY-77 DAVID SPECTOR
+
+/1. ESCAPE KEY NO LONGER ECHOED
+/2. SCOPE MODE SUPPORTED
+/3. ONCE-ONLY CODE MOVED TO INPUT HANDLER
+/ AREA IN ORDER TO FREE LOCS 3000-3177
+
+/ V12 CHANGES 27-JUN-77 EDWARD P. STEINBERGER
+/
+/ALLOWED ESCAPE(233) TO BE AN INPUT CHARACTER IN TEXT MODE.
+/ECHOS AS "$" ON TERMINAL OR LINEPRINTER (IF V), OUTPUT
+/TO FILE AS ESCAPE
+
+\f/THE LOADING AND SAVING PROCEDURE FROM PAPER TAPE IS:
+/ .R ABSLDR
+/ *PTR:/9$^
+/ .SAVE SYS EDIT
+/
+
+/THE STARTING ADDRESS IS 00200.
+
+/COMMAND DECODER RULES:
+/*OUTPUT FILE<UP TO 9 INPUT FILES/OPTIONS
+
+/OPTIONS:
+/A RETURN CONTROL TO EDITOR AFTER FILE CLOSE
+/ (CALLS COMMAND DECODER FOR NEW FILES)
+/ (DEFAULT IS RETURN TO MONITOR)
+/B CONVERT 2 OR MORE SPACES TO TAB ON INPUT
+/D DELETE OLD COPY OF OUTPUT FILE BEFORE
+/ STORING NEW FILE
+
+/ERROR CODES:
+/ 0 FAILURE IN INPUT DEVICE HANDLER
+/ 1 FAILURE IN OUTPUT DEVICE HANDER
+/ 2 COULD NOT CLOSE FILE
+/ 3 COULD NOT OPEN FILE
+/ 4 DEVICE HANDLER COULD NOT BE LOADED
+
+ VERSION=12
+ PATCH="A /PATCH LEVEL A
+\f/COMMANDS:
+
+/A APPEND TEXT TO BUFFER
+/I INSERT TEXT INTO BUFFER
+/C CHANGE TEXT IN BUFFER
+/L LIST TEXT IN BUFFER
+/D DELETE TEXT IN BUFFER
+/K KILL BUFFER
+/M MOVE TEXT WITHIN BUFFER
+/G GET AND LIST TAGGED LINE IN BUFFER
+/B LIST # OF CORE LOCATIONS LEFT IN BUFFER
+/S CHARACTER SEARCH
+/J INTER-BUFFER STRING SEARCH
+/F AFTER J, SEARCH FOR NEXT OCCURRANCE
+/ OF SAME STRING
+/$ INTRA-BUFFER STRING SEARCH
+/R READ TEXT INTO BUFFER FROM INPUT DEVICE
+/N WRITE BUFFER, KILL, AND READ NEXT PAGE
+/Y INPUT TEXT PAGE, NO OUTPUT
+/P WRITE TEXT BUFFER TO OUTPUT DEVICE
+/T PUNCH TRAILER TAPE
+/E OUTPUT BUFFER, TRANSFER REST OF
+/ INPUT FILE TO OUTPUT FILE
+/ CLOSE OUTPUT FILE
+/Q IMMEDIATE END OF FILE
+/V PRINT ON LP08
+/# TYPE VERSION NUMBER
+\f
+/ABBREVIATIONS
+
+/.LT. LESS THAN
+/.LE. LESS THAN OR EQUAL TO
+/.GT. GREATER THAN
+/.GE. GREATER THAN OR EQUAL TO
+/ R RIGHT
+/ L LEFT
+
+/SPECIAL COMMENTS
+
+/SINCE THE EDITOR IS CODED ACROSS PAGE BOUNDARIES, IT IS
+/NECESSARY TO BE AWARE OF THE EFFECTS OF THE INSERTION
+/OR DELETION OF CODE. FOR THIS REASON, THE LIMITS
+/OF PERMISSABLE PAGE BOUNDARY WANDERING
+/ARE INDICATED WITH THE FOLLOWING CONSTRUCTION:
+
+/-----------------------------------------------------------------------
+/SOMEWHERE BETWEEN LINES, THE PAGE BOUNDARY MUST OCCUR
+/-----------------------------------------------------------------------
+\f
+*1
+
+/MISCELLANEOUS POINTER AND CONSTANTS
+
+BUFEND, 6100 /WARNING FOR END OF BUFFER
+P7700, 7700 /MONITOR CALL LOCATION
+
+M77, -77
+ NOP /RESERVED FOR ODT
+ NOP / "
+ NOP / "
+
+C77, 77
+M40, -40
+C100, 100
+C277, 277 /QUESTION MARK
+
+/AUTO-INDEX REGISTERS
+
+AXOUT, 0 /OUTPUT INDEX
+AXCOMB, 0 /COMBINE POINTER
+AXTEM, 0 /TEMPORARY INDEX
+AXIN, 0 /STORAGE INDEX
+
+/CONSTANTS
+
+M4, -4 /LETTER COUNT
+P177, 177
+MCR, -215
+M240, -240
+P40, 40
+C200, 200 /(START & RESTART)
+\f
+
+/LISTS
+
+/TAG SEARCH LIST-
+LIST7=.
+
+C240, 240 /SPACE
+ 257 /COMMENT DELIMITER (/)
+
+/OUTPUT LIST
+LIST4=.
+
+ESC, 233 /ESC-V12
+CTAB, 211 /TAB
+C215, 215 /CARRIAGE RETURN
+ 212 /LINE FEED
+ 214 /FORM FEED
+ 377 /RUBOUT
+ 216 /CONTROL N (^N)
+M27, -27 /LIST DELIMITER
+
+/SPECIAL CHARACTER LIST FOR
+/INPUT IN TEXT MODE
+LIST5=. /USED AT AONE
+ 240 /SPACE
+LIST6=. /USED AT SFOUND
+ 225 / ^U
+C214, 214 /FORM FEED
+BELL, 207 / ^G (BELL)
+C212, 212 /LINE FEED
+CRO, 377 /RUBOUT
+
+LIST3=.
+ 215 /LIST BRANCHER
+ 000 /(SEARCH CHARACTER)
+RST3I, RESET3 /RESET AND SAVE BUFFER
+MCHIN1, -CHIN-1 /LIST DELIMITER
+\f
+
+/CONSTANTS AND POINTERS
+
+CCR=C215 /CARRIAGE RETURN
+CLF=C212 /LINE FEED
+MTABS, -10 /TAB COUNTER
+DELT, DELP
+CHI1, CHIN
+IGNORE, CHIN+1
+END, 200
+KEYBD, I33
+CCON, JMP I AXCOMB
+ COM1-1
+UTR1, UTRA
+FIN1, FIND
+LIS1, LIST
+LIS, LISTER
+NINE, 12
+NUMB, -272
+OUT1, OUT
+OUTL1=.
+LOW, OUTL
+CZ, NOP /CONTENTS OF START
+ONUM, GTOP
+SORTJ, SORTB
+PACK1, PACBUF
+
+SXS1, TAD CHAR /CONTENTS OF L3
+SXS2, SLOOK&177+5200 /JMP SLOOK
+L3I, L3 /PATCH POINTER
+L2I, L2 /CONTINUE SEARCH - LETTERS
+ENDLNI, ENDLN
+SPCNO, MOR+4 /PACK
+SPCGO, MOR+1 /SORT
+\f
+
+/CHAR IS ALWAYS SET BY OUT, SOMETIMES BY SORTB;
+/IT IS ALWAYS USED BY PACK AND SORTB.
+CHAR, 0
+MOV1=.
+COUNTP, 0 /NUMBER OF PAGES
+CNT=. /PRINT COUNTER
+XCT, 0 /UNPACK SWITCH
+XCTIN, 0 /PACK SWITCH
+ECHOSW, 1 /NON-ZERO TO PRINT
+SAVE, 0
+TABIND, 0 /TABS OR SPACES SWITCH
+TEMP, 0 /V3
+THIS, 0 /LINE POINTER.
+OUTDEV, OUTL /POINTER TO OUTPUT SUBROUTINE
+GRBAGE, GARBAG /GARBAGE COLLECTOR
+MARK, 0 /OBJECT LINE IN G.C.
+XSAV, 0 /HOLD INPUT POINTER.
+BUFR, 200
+CFRS, FRST
+KILL1, KILL+3
+CHKARG, CHKARX
+ERSW, ERROR /ERROR ROUTINE
+L1I, L1
+
+EKILLL, 0 /E CMD SWITCH 1 IF E NOT ALLOWED
+
+/I-O RELATED POINTERS AND WORDS
+
+P232, 232 /V3
+BUFRDI, BUFRD /OR CHIN...IN DEVICE POINTER
+BUFWTI, BUFWT /WRITE OUTPUT TO DEVICE
+CLFLI, FLCLOS /SET TO CLOSE FILE
+P37, 37 /V3
+JMPCH, PUNCH&177+5200 /DESTROYED BY YANK
+\f
+/ERROR ROUTINE POINTERS
+
+SERR0I, SERR0
+SERR1I, SERR1
+SERR2I, SERR2
+SERR4I, SERR4
+
+GTEM=. /NEXT 6-BITS OF UNPACK
+DTEM=. /NEXT POINTER IN DELETE CHAIN
+
+
+/ERROR ROUTINE
+/REJECTS ILLEGAL COMMAND
+/AND TYPES ?
+
+ERROR=JMS .
+ 0
+ELIM, 7600 /GRP2-CLA
+ TAD C277
+ JMS I OUTL1 /PRINT "?"
+CZONE, TAD CZ /RESET PATCHES
+ DCA I TE1
+JMPTE1, JMP I TE1 /*RETURN TO COMMAND MODE*
+
+
+UPAROI, UPAROW /GENERATE ^ CHARACTER
+MONITOR, MONIT /MONITOR EXIT ROUTINE
+STRIND, 0
+STRFIN, SFIND1
+TE1, START
+
+/VARIABLES
+THSN, 0 /CURRENT LINE NUMBER
+LSTN, 0 /LAST LINE NUMBER
+TCNT, 0 /TAB COUNT
+ADD, 0
+ARG0, 0
+ARG1, 0240
+ARG2, -1
+
+POTYPE, OTYPE
+COMM5, COM5
+K7600, 7600
+TEMPO, 0
+K1210, 1210
+X203, -203
+K1320, 1320
+
+FRST, 0 /FIRST LINE ADDRESS
+MOV2=TEMPO
+LSTCHK, 0 /DIGIT ACCEPTED FLAG
+\f *177
+ INIT /INITIALIZATION CODE
+ /EITHER 3000 OR VALUE OF RESET
+
+
+ *200
+ STA /V3 NORMAL START OR RESTART ADDR
+ DCA TEMP /V3 CHAIN START ADDR
+ JMP I 177 /START AT 3000 OR RESET
+/HANDLER FOR ^U (IF IN COMMAND MODE)
+START, NOP /V3 MAY BE MODIFIED
+ TAD LOW /ENTER COMMAND MODE
+ DCA OUTDEV /INITIALIZE KEYBOARD
+ DCA TABIND /CLEAR TAB INDICATOR
+ ISZ ECHOSW /SET UP FOR ECHO
+ DCA LIST3+1
+ TAD SXS1
+ DCA I L3I
+ TAD ERSW /RESET ERROR SWITCH AT L1
+ DCA I L1I
+ TAD CZONE
+ DCA I COMM5
+ DCA LSTCHK /CLEAR DIGIT ACCEPTED
+ TAD CCR /OUTPUT CARRIAGE RETURN
+ JMS I OUT1
+/HANDLER FOR CARRIAGE RETURN (COMMAND MODE)
+ TAD SIGN /OUTPUT #
+ JMS I OUT1
+GTOP, DCA ARG0 /CLEAR ARGUMENTS
+ DCA ARG2
+/HANDLER FOR SPACE OR +
+GEXP, TAD NONE
+/HANDLER FOR -
+GMIN, TAD CMPT
+ DCA G2 /SET SIGN TO + OR -
+DBCV2, DCA TEMP
+CMCHK, JMS I CHI1 /INPUT ONE CHARACTER
+ TAD NUMB
+ CLL
+ TAD NINE
+ SZL /WAS IT A DIGIT?
+ JMP COUNT /YES - CONTINUE ACCEPTING NUMBERS
+\f
+
+GLOM, CLA /NO
+ TAD TEMP /GET ACCUMULATED NUMBER
+G2, HLT /(NOP) OR (CIA) TO HANDLE SIGN
+ TAD ARG2
+ DCA ARG2 /STORE NEW ARGUMENT
+ JMS SORTB /WAS LAST CHARACTER SPECIAL?
+ LIST1-1 /YES - COMPARE TO LIST
+ OPS1-LIST1 /AND BRANCH TO HANDLER
+ TAD CHAR /NO - SAVE COMMAND CHARACTER
+ DCA SAVE
+ JMS I CHI1 /INPUT ONE CHARACTER
+ JMS SORTB /IS IT CARRIAGE RETURN, ^C, OR ^U?
+ LIST1A-1 /YES - EXIT TO HANDLER
+ OPS1A-LIST1A
+ ERROR /NO - TRY AGAIN
+\f
+/CHECK LEGALITY OF ARGUMENTS
+/ARG0 CONTAINS FIRST ARGUMENT
+/ARG2 CONTAINS SECOND ARGUMENT
+
+RETRN, TAD ARG0
+ SNA /IS ARG0=0?
+ TAD ARG2 /YES - ARG0=ARG2
+ DCA ARG0 /NO
+ TAD ARG2
+ CMA
+ TAD ARG0
+ SMA /IS ARG0 .LE. ARG2?
+ ERROR /NO
+ DCA ARG1 /YES - ARG1=ARG0-ARG2-1
+ TAD ARG0
+ SPA CLA /IS ARG0 .GE. 0?
+ ERROR /NO
+ TAD SAVE /YES - GET COMMAND CHARACTER
+ JMS SORTB /IS IT A LEGAL COMMAND?
+ LIST2-1 /YES - MATCH TO LIST
+ OPS2-LIST2 /AND BRANCH TO ITS HANDLER
+ ERROR /NO - TRY AGAIN
+
+
+/COMMAND IDENTIFICATION LIST
+LIST2=. /COMMAND LETTERS
+ 305 /E
+ 301 /A
+ 311 /I
+ 303 /C
+ 313 /K
+ 304 /D
+ 314 /L
+ 316 /N
+ 320 /P
+ 322 /R
+ 312 /J
+ 306 /F
+ 324 /T
+ 315 /M
+ 307 /G
+ 323 /S
+ 331 /Y
+ 321 /Q
+ 302 /B
+ 326 /V
+SIGN, "# /V3 VERSION #
+NONE, -41 /"NOP-CIA"
+\f
+/SORT AND BRANCH ROUTINE
+/LOOKS FOR MATCH BETWEEN CHAR
+/AND ELEMENTS OF TABLE 1 SPECIFIED
+/CALLING SEQUENCE:
+/ JMS I (SORTB
+/ TABLE1-1
+/ TABLE2-TABLE1
+/ RETURN IF NO MATCH
+/DISPATCHES TO CORRESPONDING ADDRESS IN TABLE 2
+
+SORTB, 0
+ SZA /IS CHARACTER STORED YET?
+ DCA CHAR /NO - STORE IT
+ TAD I SORTB /YES
+ ISZ SORTB
+ DCA AXTEM /STORE TABLE 1 ADDRESS
+ TAD I AXTEM /GET TABLE ENTRY
+ SPA /DONE YET?
+ JMP SEX /YES - EXIT
+CMPT, CIA /NO
+ TAD CHAR /GET CHARACTER
+ SZA CLA /DO THEY MATCH?
+ JMP .-6 /NO - KEEP TRYING
+ TAD AXTEM /YES - THEY MATCH
+ TAD I SORTB /GET DISPATCH TABLE ADDRESS
+ DCA SORTB
+ TAD I SORTB
+ DCA SORTB /SET RETURN ADDRESS
+ JMP I SORTB /--RETURN--VIA DISPATCH TABLE
+SEX, ISZ SORTB /MATCH NOT FOUND
+ CLA
+ JMP I SORTB /--
+
+
+/DECIMAL ADDITION ROUTINE
+/FOR NUMERIC ARGUMENTS OF COMMANDS
+/ENTER WITH INPUT DIGIT IN SORTB
+/EXIT WITH ACCUMULATED NUMBER IN AC
+COUNT, DCA SORTB
+ ISZ LSTCHK /GOT A DIGIT NOW
+ TAD TEMP
+ RTL CLL
+ TAD TEMP
+ RAL
+ TAD SORTB
+ JMP DBCV2 /RETURN TO MAIN SEQUENCE
+\f/-----------------------------------------------------------------
+
+/DISPATCH LIST FOR COMMAND HANDLERS
+OPS2, ENDFIL /E
+ APP /A
+ XNS /I
+ CNGE /C
+ KILL /K
+ DELE /D
+ LIST /L
+ COMBO /N
+ PUNCH /P
+ TELE /R
+ JERK /J
+ BARROW /F
+ PUNCT /T
+ MOVEM /M
+ GETTAG /G
+ XCRET /S
+ YANK /Y
+ Q /Q
+ CORSPC /B
+ VIEW /V
+ VERSN /#
+\f/END OF INPUT TEXT LINE ROUTINE
+
+EOL, JMS I ENDLNI /RESET LINK CELLS
+ ISZ LSTN /INCREMENT LINE POINTERS
+ ISZ THSN
+ TAD BUFEND
+ CLL CIA
+ TAD AXIN
+ SNL CLA /IS THE BUFFER FULL?
+/------------------------------------------------------------
+ JMP MOR /NO - KEEP FILLING
+ TAD BELL /YES - RING WARNING BELL
+ JMS I OUTL1
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+
+
+/CONTINUATION OF HANDLERS FOR A, C, AND I COMMANDS
+APP1, TAD LSTN /APPEND
+ DCA ARG0 /RESET ARG0 TO END OF TEXT
+ JMP INS
+CNGE1, JMS I DELT /CHANGE - DELETE LINES AND
+XNS1, TAD ARG0 /INSERT
+ SNA CLA /ANY ARGUMENTS?
+INS, ISZ ARG0 /NO - INSERT AT BEGINNING OF TEXT
+ TAD ARG0
+ JMS I FIN1 /FIND THE POINTER
+ DCA THIS
+ ISZ TABIND /SET TAB INDICATOR
+ CDF 10
+ TAD I THIS /GET LINK TO BUFFER
+ CDF 0
+ DCA XSAV
+ CMA
+ TAD ARG0
+ DCA THSN /SET LINE POINTER
+AONE, TAD BUFR /BEGIN LINE
+ DCA AXIN
+ DCA XCTIN
+MOR, JMS I BUFRDI /GET A CHARACTER
+ JMS I SORTJ /IS IT SPECIAL? (SEE LIST)
+ LIST5-1
+ INLIST-LIST5 /YES - GO TO ITS HANDLER
+ JMS PACBUF /NO - PACK IT
+ JMP MOR /FETCH ANOTHER
+\f
+/CHARACTER PACKING ROUTINE
+/CONVERTS CHARACTER IN CHAR TO INTERNAL CODE
+/AND CALLS PCK1 TO PACK IT INTO BUFFER
+/ENTER AND EXIT WITH AC CLEAR
+
+PACBUF, 0
+ CLL
+ TAD AXIN /DON'T ADD CHARACTERS
+ TAD K1210 /IF AXIN ABOVE 6570
+ SZL CLA /IS THERE ROOM FOR THIS ONE?
+ ERROR /NO
+ TAD CHAR /YES
+ TAD M240
+ SPA /IS IT 200-237?
+ JMP ESCA /YES - ATTACH 77
+ TAD M77
+ SMA SZA /IS IT 337 OR LESS?
+ JMP ESCA /NO - ATTACH 77
+ TAD P40 /YES - IS IT 277?
+ SNA CLA
+ JMP ESCA /YES - ATTACH 77
+TR1, TAD CHAR /240-337 EXCEPT 277
+ AND C77 /MASK OUT LEFT 6 BITS
+ JMS PCK1 /PACK IT
+ JMP I PACBUF /--RETURN--
+ESCA, CLA /200-237, 277,340-377
+ TAD C77 /PACK A 77
+ JMS PCK1
+ JMP TR1 /PACK THE CHARACTER
+\f
+/PACK CHARACTERS INTO TEXT BUFFER
+/ENTER WITH 6-BIT CODE IN AC
+
+PCK1, 0
+ ISZ XCTIN /LEFT HALF OR RIGHT HALF?
+ JMP ROT /LEFT HALF
+ DCA UTRA /RIGHT HALF - STORE CHARACTER
+ TAD UTRA /GET CHARACTER
+ TAD ADD /GET PREVIOUS CHARACTER
+ CDF 10
+ DCA I AXIN /STORE IN FIELD 1 BUFFER
+ CDF 0
+ DCA ADD
+ JMP I PCK1 /--RETURN--
+ROT, CLL RTL /LEFT HALF
+ RTL
+ RTL /ROTATE 6 LEFT
+ DCA ADD /RETAIN UNTIL NEXT CHARACTER
+ CMA /IS READY
+ DCA XCTIN /RESET L OR R SWITCH
+ JMP I PCK1 /--RETURN--
+
+ UTEST=PACBUF /TEMPORARY
+\f
+/CHARACTER UNPACKING ROUTINE
+/CONVERTS ONE CHARACTER FROM
+/BUFFER FORMAT TO 8-BIT ASCII
+/EXIT WITH CHARACTER IN AC
+
+UTRA, 0
+ CLA CMA /INITIALIZE TO -1
+ DCA UTEST
+EXTR, ISZ XCT /LEFT HALF OR RIGHT HALF?
+ JMP GET3 /RIGHT HALF
+ CDF 10 /LEFT HALF
+ TAD I AXOUT /GET BUFFER WORD
+ CDF 0
+ DCA GTEM
+ TAD GTEM
+ RTR /ROTATE 6 RIGHT
+ RTR
+ RTR
+ JMP GET4 /SKIP TO GETA
+GET3, CLA CMA /RESET L - R SWITCH
+ DCA XCT
+ TAD GTEM
+GET4, AND C77 /MASK OUT LEFT 6 BITS
+ TAD M77
+ CLL
+ SNA /WAS IT 77?
+ ISZ UTEST /YES - WAS IT LEFT HALF?
+ JMP GET5 /NO - CONTINUE
+ JMP EXTR /YES - GET OTHER HALF
+GET5, TAD P37
+ ISZ UTEST /RESTORE THE CHARACTER
+ CML
+ SNL
+ TAD C100
+ TAD C240
+ TAD X203 /IS IT A ^C?
+ SNA
+ JMP UTRA+1 /YES - IGNORE IT
+ TAD M27 /NO - IS IT A ^Z?
+ SNA
+ JMP UTRA+1 /YES - IGNORE IT
+ TAD P232 /NO - RESTORE CHARACTER
+ JMP I UTRA /--RETURN--
+\f
+/-------------------------------------------------------------
+/INPUT LIST FOR SPECIAL CHARACTERS IN TEXT MODE
+INLIST=.
+ SPACES /SPCS
+ CTRLU /^U
+ FULL /FORM
+ FULL /BELL
+ RUB4+1 /LINE FEED
+ RUB1 /RUBOUT
+ EOL /CARRIAGE RETURN
+
+/HANDLER FOR FORM FEED OR ^G
+FULL, TAD IGNORE /
+ TAD MCHIN1 /
+ SNA CLA /IN APPEND MODE?
+ JMP I TE1 /YES*RETURN TO COMMAND MODE*
+ TAD LSTN /NO - IS BUFFER EMPTY?
+ SNA CLA /
+/--------------------------------------------------------------
+ JMP I MORI /YES - IGNORE FORM FEED
+ JMP I TE1 /NO*RETURN TO COMMAND MODE*
+
+MORI, MOR
+
+
+/SET UP TO READ FROM INPUT DEVICE
+/USED BY C AND R COMMANDS
+/CALLED WITH SEQUENCE
+/ JMS I PSETUP
+/ INPUT ROUTINE
+/ CONTINUATION OF HANDLER
+/EXITS TO CONTINUATION OF HANDLER
+
+SETUP, 0
+ TAD I SETUP /GET READ AREA FROM ARGS
+ DCA BUFRDI
+ TAD I SETUP /LOCATION FOR IGNORED CHARACTERS
+ IAC CLL /V12
+ DCA IGNORE
+ ISZ SETUP /SETUP PROPER RETURN POINT
+ TAD I SETUP
+ DCA SETUP
+ TAD BUFR
+ TAD K1320
+ SZL CLA /IS BUFFER FULL?
+ ERROR /YES - DON'T READ
+ JMP I SETUP /--RETURN--
+ 0 /*** A FREE LOCATION!!!***
+
+\f
+/SUPERVISOR FOR DELETION OF TEXT LINES
+
+DELP, 0
+ JMS I CHKARG /CHECK ARGUMENT VALIDITY
+ TAD ARG0
+ DCA THSN /SET CURRENT LINE #
+ TAD ARG1 /SAVE # DELETED
+ DCA LISTER
+ TAD ARG0 /GET POINTER TO LINE
+ JMS I FIN1 /TO BE DELETED
+ DCA THIS /STORE IT
+DELP1, CDF 10
+ TAD I THIS
+ DCA MARK /CORE ADDRESS OF OBJECT LINE
+ TAD I MARK
+ DCA I THIS /CHAIN NEW POINTERS TO DELETE LINE
+ TAD MARK
+ CDF 0
+ JMS I GRBAGE /PHYSICALLY DELETE THE LINE
+ ISZ ARG1 /ALL SPECIFIED LINES DELETED?
+ JMP DELP1 /NO - CONTINUE
+ TAD LSTN /IF 1,/D..MAKE CURRENT=0
+ SNA CLA
+ DCA THSN
+ TAD LISTER /BUMP TOTAL DOWN
+ TAD LSTN
+ DCA LSTN
+ JMP I DELP /YES--RETURN--
+
+
+/HANDLER FOR <
+EXLAS, CLA CLL CMA RAL /PRINT LAST LINE - AC=7776=-2
+/HANDLER FOR > OR LINE FEED
+EXNEX, TAD THSN /PRINT NEXT LINE
+ IAC
+ SNA /IS IT AN EXISTING LINE?
+ ERROR /NO
+ DCA ARG0 /YES SAVE EFFECTIVE ARGUMENTS
+ CMA
+ DCA ARG1
+/HANDLER FOR L COMMAND
+LIST, TAD LOW /SET KEYBOARD AS OUTPUT
+ DCA OUTDEV
+ ISZ TABIND /SET TAB INDICATOR
+ JMS LISTER /OUTPUT LINE(S)
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+\f
+/LISTING OUTPUT ROUTINE
+/OUTPUTS LINES INDICATED BY ARG0,ARG1
+
+LISTER, 0
+ TAD ARG0
+ SZA CLA /ANY ARGUMENTS?
+ JMP L0 /YES - SET THEM UP
+ TAD LSTCHK /ALLOW 0L?
+ SZA CLA
+ ERROR /NOPE
+ TAD LSTN /NO - SET TO LIST BUFFER
+ CIA
+ DCA ARG1
+ ISZ ARG0 /SET TO LINE 1
+L0, TAD ARG0
+ CIA
+ TAD LSTN
+ SPA CLA /ARGUMENTS IN RIGHT RANGE?
+L1, ERROR /NO -( OR JMP I TE1)
+ TAD ARG0
+ JMS I FIN1 /GET POINTERS
+ DCA THIS /SAVE POINTER
+ CMA
+ CDF 10
+ TAD I THIS /GET START
+ DCA AXOUT
+ TAD I AXOUT /SAVE POINTER FOR SEARCH
+ DCA XSAV
+ TAD AXOUT /SAVE OBJECT LINE FOR GARBAGE COLLECT
+ DCA MARK
+ CDF 0
+ CMA
+ DCA XCT
+ TAD ARG0 /SET POINTER
+ DCA THSN
+ ISZ ARG0 /SET FOR NEXT LINE
+/(HANDLER FOR FORM FEED DURING CHARACTER SEARCH)
+L2, JMS I UTR1 /UNPACK A CHARACTER
+ JMS I OUT1 /PRINT A CHARACTER
+ JMS I CPTSTI /WAS IT ^O OR ^C FROM KEYBOARD?
+ JMP L3 /NO - CONTINUE
+ TAD C317 /YES - ^O
+ JMS I UPAROI /GENERATE ^O
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+L3, TAD CHAR /OR (JMP SLOOK)
+ TAD MCR
+ SZA CLA /WAS IT END OF LINE?
+ JMP L2 /NO - KEEP UNPACKING
+ ISZ ARG1 /YES - DONE YET?
+ JMP L0 /NO - GET NEXT LINE
+ JMP I LISTER /YES --RETURN--
+
+CPTSTI, CTRLP /TEST FOR ^O AND ^C
+C317, 317
+\f
+/------------------------------------------------------------
+/SEARCH ROUTINES
+
+
+/HANDLER FOR CARRIAGE RETURN
+SRETN, JMS I ENDLNI /TERMINATE THIS LINE
+ TAD MARK /AND NOW GARBAGE COLLECT
+ JMS I GRBAGE
+ ISZ ARG1 /DONE YET?
+ JMP I LIS1 /NO - GET NEXT LINE
+ JMP I TE1 /YES*RETURN TO COMMAND MODE*
+
+SLOOK, JMS I SORTJ /SEARCH DONE?
+ LIST3-1 /(CARRIAGE RETURN OR SEARCH CHARACTER)
+ LISTGO-LIST3 /YES - GO TO ITS HANDLER
+ JMS I PACK1 /NO-PACK SEARCHED CHARACTERS
+ JMP I L2I /CONTINUE SEARCH
+
+ IFNZRO SLOOK&1000 <PGERR,XXX>
+
+/HANDLER FOR ^G DURING CHARACTER SEARCH
+/CHANGE SEARCH CHARACTER
+SCONT, JMS I KEYBD /FETCH NEW SEARCH CHARACTER
+ DCA LIST3+1 /STORE IT IN LIST
+ JMP I L2I /CONTINUE SEARCH
+
+/HANDLER FOR LINE FEED DURING SEARCH
+SLINE, TAD CCR
+ DCA CHAR
+ JMS I ENDLNI
+ ISZ ARG0 /MOVE POINT
+ ISZ THSN /BUMP CURRENT LINE COUNT
+ ISZ LSTN /ADD A LINE.
+/HANDLER FOR _ DURING SEARCH
+SBAR, TAD CCR /CTRL-U
+ JMS I OUT1 /OUTPUT CARRIAGE RETURN
+ TAD BUFR /RESTART PACK BUFFER
+ DCA AXIN
+ DCA XCTIN
+/-------------------------------------------------------------------
+SFOUND, JMS I CHI1 /GET A CHARACTER
+ JMS I SORTJ /SPECIAL SEARCH COMMAND?
+ LIST6-1
+ SRNLST-LIST6 /YES - GO TO HANDLER
+/HANDLER FOR SEARCH CHARACTER FOUND
+SGOT, JMS I PACK1 /NO-PACK INSERTS
+ JMP SFOUND /CONTINUE INPUT
+
+
+\f
+/TELETYPE CHARACTER FETCH ROUTINE
+/ENTER WITH AC CLEAR
+/EXIT WITH CHARACTER IN CHAR AND AC
+/FORCE CHANNEL 8
+/BLANK TAPE & LEADER TRAILER IGNORED
+
+CHIN, 0
+ DCA CHAR /CLEAR CHARACTER
+ JMS I KEYBD
+ AND P177 /MASK PARITY
+ SNA /IGNORE BLANK AND L/T
+ JMP CHIN+1
+ TAD C200 /RESTORE CHARACTER
+ JMS I OUT1 /ECHO INPUT
+ TAD CHAR
+ JMP I CHIN /--RETURN--
+
+
+/SEARCH TEXT BUFFER FOR LINE
+/WHOSE NUMBER IS ONE LESS THAN
+/THE CONTENTS OF THE AC
+/EXIT WITH ADDRESS OF LINK CELL IN AC
+
+FIND, 0 /LOCATE LINE BUFFER
+ CIA
+ SMA /IS LINE NUMBER TOO SMALL?
+ ERROR /YES
+ DCA TEMP /NO - STORE NEGATIVE OF LINE #
+ TAD TEMP
+ IAC
+ TAD LSTN
+ SPA CLA /IS LINE NUMBER TOO LARGE?
+ ERROR /YES
+ TAD CFRS /NO
+ JMP FIND1
+FIND2, CDF 10
+ TAD I SAVE /CHAIN THROUGH LIST
+ CDF 0
+ SZA /FAILSAFE
+FIND1, DCA SAVE
+ ISZ TEMP /DONE YET?
+ JMP FIND2 /NO - KEEP CHAINING
+ TAD SAVE /YES - GET LINE NUMBER
+ JMP I FIND /--RETURN--
+
+
+CON, 6030 /CONVERSION CONSTANTS
+ 7634
+ 7766
+ 7777
+\f
+BOX=COUNTP
+VAL=ARG0
+
+/HANDLER FOR : OR =
+/PRINTS REQUESTED LINE NUMBER
+/WHICH IS FOUND IN ARG2 ON ENTRY
+
+PRNT, TAD ARG2
+ DCA VAL /SET NUMBER TO BE PRINTED
+ TAD M4
+ DCA CNT /SET CHARACTER COUNT
+ TAD ADDR
+ DCA XYZ+2
+FLOOZ, DCA BOX
+ CLL
+ TAD VAL /IF VAL IS TOO LARGE, IT LOOKS
+ SMA CLA /LIKE A NEG NO. THE LINK
+ TAD K50 /DETERMINES THE END POINT IN THAT CASE
+ TAD K7430 /7430=SZL; 7500=SMA
+ DCA XYZ+3
+ JMP .+4
+ ISZ BOX
+ CLL
+XYZ, DCA VAL
+ TAD VAL
+ NOP /TAD CON +() SOME DISPLACEMENT
+ SMA /OR, IF VAL TOO BIG,SZL
+ JMP XYZ-2 /KEEP ADDING THE SAME CONSTANT
+ CLA
+ TAD BOX /BOX HAS THE NUMBER COUNT
+ TAD C260 /MAKE ASCII DIGIT
+ JMS I OUTL1 /OUTPUT THE DIGIT
+ ISZ XYZ+2 /ADD IN NEXT CONVERSION CONSTANT LATER
+ ISZ CNT /DONE ALL FOUR?
+ JMP FLOOZ /NO - KEEP CONVERTING
+ JMP I TE1 /YES*RETURN TO COMMAND MODE*
+
+C260, 260
+ADDR, TAD CON
+K50, 50
+K7430, 7430
+\f
+/CHARACTER OUTPUT ROUTINE
+
+OUT, 0
+ DCA CHAR
+/ESC PATCH 25-MAY-77 DS
+/ TAD ECHOSW
+/ SNA CLA /ECHO SUPPRESSED?
+ JMS I .+1 /DS
+ ESCPA /DS
+ JMP I OUT /YES--RETURN--
+ JMS I SORTJ /NO - IS IT A FORMAT CHARACTER?
+ LIST4-1 /YES - EXIT TO ITS HANDLER
+ OUTLIS-LIST4
+ ISZ TCNT /NO - COUNT ONE LETTER
+ TAD CHAR
+OUTX, JMS I OUTDEV /OUTPUT THE CHARACTER
+ JMP I OUT /--RETURN--
+
+
+/CARRIAGE RETURN HANDLER
+
+OUTCRL, TAD CCR
+ JMS I OUTDEV /OUTPUT CARRIAGE RETURN
+ DCA TCNT /CLEAR TAB COUNTER
+ TAD CLF /OUTPUT LINE FEED
+ JMP OUTX
+
+
+/TAB HANDLER - TAB/RUBOUT
+
+OUTRT, TAD CTAB
+ JMS I OUTDEV /OUTPUT TAB
+ CIF 10
+ JMS I POTYPE /TEST TYPE OF OUTPUT
+ SPA CLA /IS IT DIRECTORY DEVICE?
+ JMP I OUT /YES--RETURN--
+ TAD CRO /NO - OUTPUT RUBOUT
+ JMP OUTX
+
+
+/TAB HANDLER - SPACES
+
+OUTTAB, TAD TABIND
+ SNA CLA /OUTPUT TAB/RUBOUT INSTEAD?
+ JMP OUTRT /YES - GO TO OTHER TAB HANDLER
+ TAD TCNT /NO -
+ TAD MTABS /REDUCE SPACE COUNT TO 8 OR LESS
+ SMA
+ JMP .-2
+ DCA TCNT
+ TAD C240 /OUTPUT SPACES
+ JMS I OUTDEV
+ ISZ TCNT /DONE YET?
+ JMP .-3 /NO - CONTINUE
+ JMP I OUT /YES--RETURN--
+
+\f
+/-----------------------------------------------------------------------
+/I-O SUBROUTINES
+
+
+/HANDLER FOR S COMMAND
+
+XCRET, JMS I KEYBD /GET THE SEARCH CHARACTER
+ DCA LIST3+1 /SAVE IT IN LIST
+ TAD SXS2
+ DCA I L3I /MAKE LISTER JUMP TO SLOOK
+ TAD BUFR
+ DCA AXIN /BUILD NEW TEXT IMAGE HERE
+ DCA XCTIN
+ TAD CHI1 /READ POINT IS CHIN
+ IAC
+ DCA IGNORE
+ JMP I LIS1
+
+/LIST OF SPECIAL CHARACTERS FOR G COMMAND
+TAGLIST=.
+ GTAG2 /SPACE
+ GTAG2 //
+ GTAG2 /ESC
+ GTAG2 /TAB
+ GTAG2 /CARRIAGE RETURN
+
+/-----------------------------------------------------------------------
+
+
+/LOW SPEED OUTPUT ROUTINE
+/ENTER WITH CHARACTER IN AC
+
+OUTL, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I OUTL /--RETURN--
+
+/LOW SPEED INPUT ROUTINE
+/CHECKS FOR ^C
+/EXIT WITH CHARACTER IN AC
+
+I33, 0
+ KSF
+ JMP .-1
+ JMS CTCK
+ KRB
+ AND P177
+ TAD C200
+ JMP I I33 /NO--RETURN--
+\f
+/SET UP APPEND, CHANGE, INSERT TO WORK
+/EACH READS KEYBOARD, NOT DEVICE
+
+CNGEL, CNGE1-XNS1
+XNSL, XNS1-APP1
+
+/HANDLER FOR C COMMAND
+CNGE, TAD CNGEL
+
+/HANDLER FOR I COMMAND
+XNS, TAD XNSL
+
+/HANDLER FOR A COMMAND
+APP, TAD APPL
+ DCA DEST /RETURN POINT
+ ISZ ECHOSW
+ JMS I PSETUP
+ CHIN /KEYBOARD INPUT
+DEST, APP1
+
+
+/SPECIAL OUTPUT LIST
+OUTLIS=.
+ ESCOUT /233 - ESC - V12
+ OUTTAB /211 - TAB
+ OUTCRL /215 - CARRIAGE RETURN
+ OUTX+1 /212 - LINE FEED
+ OUTX+1 /214 - FORM FEED
+ OUTX+1 /377 - RUBOUT
+ CTRLN /216 - CNTRL N
+
+\f/CHECK TTY FOR ^C OR ^O INPUT
+/EXIT TO MONITOR ON ^C
+/SKIP ON ^O
+
+CTRLP, 0
+ KSF
+ JMP I CTRLP /--RETURN--
+ JMS CTCK
+ TAD M14 /NO - IS IT ^O?
+ SZA CLA
+ JMP I CTRLP /NO--RETURN--
+ ISZ CTRLP /YES
+ KCC
+ JMP I CTRLP /--RETURN--
+
+M14, -14
+CTCK, 0
+ TAD C200
+ KRS
+ TAD X203
+ SNA
+ JMP I MONITOR
+ JMP I CTCK
+
+
+
+/HANDLER FOR P COMMAND
+
+PUNCH, ISZ ECHOSW
+ TAD BUFWTI /SETUP TO WRITE INTO OUTPUT BUFFER
+ DCA OUTDEV
+PUNC, JMS I LIS /WRITE THE EDITOR BUFFER
+ TAD C214 /OUTPUT FORM FEED
+ JMS I OUTDEV
+/HANDLER FOR T COMMAND
+PUNCT, CDF 10
+ TAD I K7600
+ CDF 0
+ SNA CLA /IS THERE AN OUTPUT DEVICE?
+ JMP I TE1 /NO*RETURN TO COMMAND MODE*
+ TAD BUFWTI /YES - SET UP TO WRITE INTO
+ DCA OUTDEV /OUTPUT BUFFER
+ TAD M40
+ DCA CTRLP /SET TRAILER COUNTER
+ CIF 10
+ JMS I POTYPE /
+ SMA CLA /DIRECTORY DEVICE FOR OUTPUT?
+ JMS I OUTDEV /NO - OUTPUT LEADER TRAILER
+ ISZ CTRLP /DONE YET?
+ JMP .-5 /NO - CONTINUE
+ TSF /YES - RESET FLAG
+ JMP .-1
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+\f/HANDLER FOR R COMMAND
+
+TELE=.
+TELEN, TSF
+ JMP .-1
+ DCA ECHOSW /INHIBIT ECHO
+ JMS I PSETUP /SETUP TO READ FROM
+ BUFRD /INPUT DEVICE
+APPL, APP1 /APPEND TEXT TO BUFFER
+
+/HANDLER FOR Y COMMAND
+
+YANK, TAD COM1 /YANK KILLS 'P' PART OF N
+ JMP COMBOA
+
+/HANDLER FOR N COMMAND
+
+COMBO, TAD JMPCH /YANK WIPES COM1-1
+COMBOA, DCA I CCON+1
+ TAD ARG0
+ SNA /ANY ARGUMENTS
+ IAC /NO - ASSUME 1
+ CIA
+ DCA COUNTP /SET NUMBER OF PAGES TO YANK
+ TAD CCON /(JMP I AXCOMB)
+ DCA I TE1 /SET TE1 TO ALLOW LOOPING
+COMB, TAD CCON+1 /THROUGH PUNCH, KILL, READ
+ DCA AXCOMB /CYCLE
+ DCA ARG0 /CLEAR ARGUMENTS
+ DCA ARG2
+ DCA LSTCHK /DON'T INHIBIT LISTER!
+ DCA TABIND /CLEAR IN CASE OF MULTIPLE N
+ JMP PUNC /OUTPUT BUFFER
+COM1, JMP I KILL1 /KILL BUFFER
+ JMP TELEN /READ NEW BUFFER FULL
+ ISZ COUNTP /DONE YET?
+ JMP COMB /NO - CONTINUE
+ CLA CLL CML RAL /YES-AC=1 - RESET CURRENT LINE NUMBER
+ DCA THSN /.=1 ON RETURN
+COM5, TAD CZ /RESTORE TE1
+ DCA I TE1
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+/IT IS VITAL TO KEEP DUMB1 AND COM5 ON THE SAME PAGE
+DUMB1, JERK1
+PSETUP, SETUP /V3
+\f
+/-----------------------------------------------------------------------
+
+LIST1=.
+ 212 /LINE FEED
+ 240 /SPACE
+ 253 /PLUS (+)
+ 254 /COMMA (,)
+ 255 /MINUS (-)
+ 256 /PERIOD (.)
+ 257 /SLASH (/)
+ 274 /<
+ 275 /=
+ 276 />
+ 000 /(DUMMY ENTRY)
+ 375 /ALTMODE ASR-33
+ 376 /ALTMODE ASR-35
+ 233 /ESCAPE KEY
+ 242 /DOUBLE QUOTE (")
+ 244 /DOLLAR SIGN ($)
+ 377 /RUBOUT
+ 272 /COLON (:)
+LIST1A, 215 /CARRIAGE RETURN
+ 225 /^U
+ 203 /^C
+
+
+/HANDLER FOR G COMMAND
+
+GETTAG, ISZ THSN
+ TAD ARG0
+ SNA /ANY ARGUMENTS
+ TAD THSN /NO - BEGIN WITH NEXT LINE (.+1)
+ DCA ARG0 /YES - SET ARGUMENTS
+ SKP
+GTAG2, ISZ ARG0
+ IAC
+ TAD ARG0
+ JMS I FIN1 /GET NEXT LINE
+ DCA AXOUT
+ CMA
+ DCA XCT
+ JMS I UTR1 /UNPACK FIRST CHARACTER
+ JMS I SORTJ /DOES IT BEGIN A TAG?
+ LIST7-1 /NO - TAGLIST EXITS
+ TAGLIST-LIST7 /TO GTAG2
+ JMP I LIS1 /YES - PRINT LINE
+\f
+MP1=ARG1
+MP2=ARG0
+MP3=ARG2
+
+/HANDLER FOR M COMMAND
+/ENTER WITH FIRST LINE TO MOVE IN MOV1
+/LAST LINE TO MOVE IN MOV2
+/MOV2 .GT. MOV1
+/DESTINATION LINE IN ARG2
+
+
+MOVEM, TAD MOV1
+ CIA /ARG2 MAY NOT BE BETWEEN
+ TAD ARG2 /MOV1 AND MOV2
+ SPA CLA /IS MOV1 .GT. ARG2?
+/-----------------------------------------------------------------------
+ JMP .+6 /YES - O.K.
+ TAD MOV2
+ CMA
+ TAD ARG2
+ SPA SNA CLA /IS MOV2 .LT. ARG2?
+ ERROR /NO-FAULTY LOGIC IN COMMAND
+ TAD MOV1 /YES
+ JMS I FIN1
+ DCA MP1 /STORE FIRST LINE POINTER
+ IAC
+ TAD MOV2
+ JMS I FIN1
+ DCA MP2 /STORE LAST LINE POINTER
+ TAD ARG2
+ JMS I FIN1
+ DCA MP3 /STORE DESTINATION LINE POINTER
+ CDF 10 /ALL FOUND
+ TAD I MP1 /SWAP POINTERS-
+ DCA TEMP /RESET THE LINK COORDS
+ TAD I MP2
+ DCA I MP1
+ TAD I MP3
+ DCA I MP2
+ TAD TEMP
+ DCA I MP3
+ CDF 0
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+
+SRNLST=.
+ SBAR /BACK ARROW (_)
+ L2 /FORM FEED
+ SCONT /BELL
+ SLINE /LINE FEED
+ RUB1 /RUB OUT
+
+LISTGO=.
+ SRETN /CARRIAGE RETURN
+ SGOT /SEARCH CHARACTER FOUND
+\f
+/HANDLER FOR RUBOUT IN TEXT OR SEARCH
+RUB1, TAD AXIN
+ CIA
+ TAD BUFR
+ TAD XCTIN
+ SZA CLA /IS THERE ANYTHING ON THIS LINE?
+ TAD ECHOSW /OR ECHO INHIBITED?
+ SNA CLA
+ JMP I IGNORE /YES-IGNORE RUBOUT
+/SCOPE PATCH 25-MAY-77 DS
+/ TAD SPLAT /NO-
+/ JMS I OUT1 /OUTPUT BACKSLASH
+ JMS I .+1 /DS
+ RUBPA /DS
+/DELETE CHAR FROM BUFFER
+ TAD AXIN /GET LAST WORD OF INPUT
+ DCA MOV1
+ CDF 10
+ DCA I BUFR /PREVENTS INFINITE RUBOUTS
+ TAD I MOV1
+ ISZ XCTIN /WHICH HALF OF WORD?
+ JMP RUB2
+ AND C77
+ TAD M77
+ SZA CLA /TEST EXTENSION
+ JMP RUB4
+RUB3, CMA
+ DCA XCTIN
+ CMA
+ TAD AXIN
+ DCA AXIN
+ TAD I MOV1
+ AND P7700
+RUB4, DCA ADD
+ CDF 0
+ JMP I IGNORE /CHIN+1
+RUB2, AND P7700
+ TAD C100
+ SZA CLA
+ JMP RUB3
+ DCA I MOV1
+ JMP RUB3+1
+\f
+/HANDLER FOR SPACE IN TEXT MODE
+SPACES, TAD ECHOSW
+ CLA /OR SZA CLA IF B OPTION
+ JMP I SPCNO /PACK IT - (MOR+4)
+ CMA /SET COUNTER
+SP2, DCA CNT
+ JMS I BUFRDI /GET LAST CHARACTER
+ TAD M240
+ SNA CLA /WAS IT SPACE?
+ JMP SP2 /YES-IGNORE EXTRA SPACES
+/-----------------------------------------------------------------------
+ TAD CHAR /NO
+ DCA SAVE /SAVE NON-SPACE
+ ISZ CNT /WAS THERE MORE THAN 1 SPACE?
+ TAD M27 /YES- STORE TAB
+ TAD C240 /NO-STORE SPACES
+ DCA CHAR
+ JMS I PACK1
+ TAD SAVE
+ JMP I SPCGO /SORT - (MOR+1)
+
+/HANDLER FOR $ (PART OF M COMMAND)
+
+MOVE, TAD ARG0 /ARG2 .GE. ARG0
+ CIA
+ TAD ARG2
+ SPA CLA /ARE LINES TO BE MOVED LEGITIMATE
+ ERROR /NO
+ TAD ARG0 /YES-
+ DCA MOV1 /SET POINTER TO FIRST LINE
+ TAD ARG2
+ DCA MOV2 /SET POINTER TO LAST LINE
+ JMP I ONUM /CONTINUE COMMAND INPUT
+\f
+OPS1, EXNEX /LINE FEED
+ GEXP /SPACE
+ GEXP /PLUS
+ FIRS /COMMA
+ GMIN /MINUS
+ PERI /POINT(.)
+ SLAS /SLASH
+ EXLAS /BACKUP(<)
+ PRNT /=
+ EXNEX /ALT(>)
+ DBCV2 /DUMMY
+ AMODE /ALTMODE ASR-33
+ AMODE /ALTMODE ASR-35
+ AMODE /ESCAPE KEY
+ DBLQUO /"
+ MOVE /DOLLAR SIGN
+ ELIM /COMMAND RUBOUT
+ PRNT /:
+ GTOP-2 /CARRIAGE RETURN
+ START /^U
+ MONIT /^C (MONITOR RESTART)
+OPS1A, RETRN /RETURN
+/-----------------------------------------------------------------------
+OLDTE1, START /^U
+ MONIT /^C
+\f
+/HANDLER FOR E COMMAND
+
+ENDFIL, TAD EKILLL /IS E COMMAND ALLOWED?
+ SZA CLA
+ ERROR /NO-NO INPUT SPECIFIED
+ CLA CMA /YES-RESET ARGUMENTS
+ DCA ARG0
+ TAD JMPTE1 /SKIP LISTER IF EMPTY BUFFER
+ DCA I L1I
+ TAD FLCLSI /CLOSE FILE SETUP
+ DCA ELIM /CLOSES FILE ON READ FAILURE
+ JMP I COMBOP
+
+COMBOP, COMBO
+FLCLSI, JMP I CLFLI
+AONEI, AONE
+
+/HANDLER FOR ^U IN TEXT MODE
+CTRLU, JMS CTRLU1 /GENERATE A ^U
+ JMP I AONEI /AND CONTINUE
+
+/PRINT ^U
+CTRLU1, 0
+ TAD C325
+ JMS I UPAROI /PRINT ^U
+ TAD CCR /AND A CR/LF
+ JMS I OUT1
+ JMP I CTRLU1 /--RETURN--
+C325, 325
+
+/CHECK VALIDITY OF ARGUMENTS
+/FOR D COMMAND
+CHKARX, 0
+ TAD ARG0
+ CIA
+ IAC
+ TAD ARG1
+ TAD LSTN
+ SPA CLA /DO LINES EXIST?
+ ERROR /NO
+ JMP I CHKARX /YES--RETURN--
+\f
+/HANDLER FOR .
+PERI, TAD THSN
+ SKP
+/HANDLER FOR /
+SLAS, TAD LSTN
+ DCA TEMP /SAVE LINE NUMBER
+ DCA CHAR
+ ISZ LSTCHK /GOT EITHE . OR / IN ARGS
+ JMP I .+1 /FETCH REST OF ARGUMENT
+ GLOM
+
+/END OF A NEW TEXT LINE
+/PACK CARRIAGE RETURN INTO BUFFER
+/SET LINK CELLS AROUND NEW LINE
+/ENTER WITH:
+/ CHAR CONTAINS CARRIAGE RETURN
+/ THIS CONTAINS ADDRESS OF LINK
+/ CELL OF PRECEDING TEXT LINE
+/ XSAV CONTAINS ADDRESS OF LINK
+/ CELL OF FOLLOWING TEXT LINE
+/ BUFR CONTAINS ADDRESS OF LINK
+/ CELL OF NEW TEXT LINE
+
+ENDLN, 0
+ JMS I PACK1 /PACK CARRIAGE RETURN
+ CDF 10
+ TAD ADD
+ SZA
+ DCA I AXIN
+ TAD BUFR /RESET LINK CELL
+ DCA I THIS /OF PREVIOUS LINE
+ TAD XSAV
+ DCA I BUFR /RESET LINK CELL OF NEW LINE
+ TAD BUFR
+ DCA THIS /RESET POINTER TO LINK CELL
+ ISZ AXIN
+ TAD AXIN
+ DCA BUFR /RESET FOR NEXT LINE
+ DCA XCTIN /CR CHARACTER SWITCH
+ CDF 0
+ JMP I ENDLN /--RETURN--
+
+\f
+/HANDLER FOR ^C
+/AND OTHER EXITS TO MONITOR
+
+MONIT, JMS FXSTWD /SET JOB STATUS TO SAVE CORE
+ TSF /MAKE SURE TTY FLAG IS SET
+ JMP .-1
+ JMP I K7600 /****EXIT TO MONITOR****
+
+/CLEAR BIT 11 OF JOB STATUS WORD
+
+FXSTWD, 0
+ CIF 10
+ JMS I JSWSET /IF NONZERO TEXT,SAVE BUFFER
+ JMP I FXSTWD /--RETURN--
+SPCP1A, SPACES+1
+BUFRD1, BUFRD+1
+
+/RESET POINTERS AND SAVE BUFFERS
+
+RESET3, JMS FXSTWD
+CIFTEN, CIF 10 /CLEAR BIT 11 OF JSW
+ JMS I P7700 /CALL USER SERVICE ROUTINES
+ 10 /*LOCK USR IN CORE*
+ TAD CIFTEN /RESET POINTERS
+ DCA I BUFRD1
+ DCA EKILLL
+ TAD OLDTE1
+ DCA TE1
+ TAD CZ
+ DCA I TE1
+ TAD K7600
+ DCA ELIM
+ TAD K7600
+ DCA I SPCP1A
+ TAD LOW
+ DCA OUTDEV
+ ISZ ECHOSW
+ TAD JMPCH
+ DCA I CCON+1
+ ISZ FXSTWD /WASTE TIME FOR TTY FLAG
+ JMP .-3
+ CIF CDF 10
+ JMP I .+1 /GO CALL COMMAND DECODER
+ START1
+JSWSET, INSET
+
+\f
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+
+/READ,WRITE,AND RELATED ROUTINES
+
+ OURECS=4 /SIZE OF OUTPUT BUFFER
+
+*2000
+
+/HANDLER FOR Q COMMAND
+
+Q, JMS I FXSWDI /CLEAR BIT 11 OF JSW
+ CDF 10
+ TAD I K7600
+ CDF 0
+ SNA CLA /WAS AN OUTPUT DEVICE SPECIFIED?
+ ERROR /NO-
+FLCLOS, TAD LSTN
+ SNA CLA /IS BUFFER EMPTY?
+ JMP FLCLS1 /YES-CLOSE FILE
+ TAD FLCLI /NO-
+ DCA TE1 /SET UP RETURN FROM P COMMAND
+ JMP I .+1
+ PUNCH /WRITE CURRENT BUFFER
+
+/CLOSE FILE ON E OR Q COMMAND
+
+FLCLS1, JMS I PTCH1 /GO TO PATCH TO HANDLE FILE FULL
+ CLA CMA /TELL SYSTEM I/O MONITOR IS IN CORE
+ CDF 10
+ DCA I P7700
+ CDF 0
+ JMP I K7600 /****EXIT TO MONITOR***
+/
+PTCH1, PATCH1
+\f
+
+/INPUT ROUTINE FROM DEVICE
+/VIA INPUT DEVICE HANDLER
+BUFRD, 0
+ CIF 10
+ JMS I ICHARI /FETCH A CHARACTER
+ JMP ERRD /ERROR IN READING FROM BUFFER
+ DCA CHAR /INTERFACE LOCATION
+ TAD CHAR
+ AND P177
+ SNA /IS IT L/T?
+ JMP BUFRD+1 /YES-GET NEXT CHARACTER
+ TAD C200 /NO RESTORE CHARACTER
+ JMP I BUFRD /--RETURN--
+
+ERRD, SPA CLA /FATAL OR EOF?
+ JMP I SERR0I /FATAL-OUTPUT ERROR MESSAGE
+ TAD ERSW /DISABLE FURTHER READS
+ DCA BUFRD+1
+ TAD I COMM5 /IF THIS IS NEGATIVE, DO ONE
+ SMA CLA /MORE SEARCH (POSSIBLY) IN THE CASE
+ JMP BUFRD+1 /THAT NO FINAL FORM FEED EXISTS
+ CLA IAC /SET CURRENT LINE TO 1 AND SEARCH
+ DCA THSN /ONCE MORE
+ JMP I .+1
+ SFIND2
+
+ICHARI, ICHAR /CHARACTER ROUTINES
+FLCLI, FLCLS1
+
+\f
+/OUTPUT ROUTINE TO DEVICE
+/VIA OUTPUT DEVICE HANDLER
+
+BUFWT, 0
+ CIF 10
+ JMS I OCHARI /OUTPUT A CHARACTER
+ JMP ERWT /OUTPUT FAILED
+BUFRTN, TAD BUFWTI /RESET OUTPUT DEVICE HANDLER POINTER
+ DCA OUTDEV
+ JMP I BUFWT /--RETURN--
+
+ERWT, SPA CLA /FATAL, OR NO MORE ROOM?
+ JMP I SERR1I /FATAL-OUTPUT ERROR MESSAGE
+ JMS I FXSWDI /FIX JOB STATUS WORD-NO MORE ROOM
+ TAD I TE1 /STORE POINTERS
+ DCA PTE1
+ TAD ELIM
+ DCA PELIM
+ TAD TE1
+ DCA PPTE1
+ CDF 10
+ ISZ I PANICI /SET PANIC DUMP
+ TAD MORECS /PREPARE TO CLOSE PRESENT OUT FILE
+ TAD I OCNTI /THIS GIVES OPTIMUM CLOSE LENGTH
+ SPA
+ JMP PATCH2
+ DCA I OCNTI
+ TAD I OREC /WRITE A ^Z
+ DCA CLSREC /DIRECTLY TO THE DEVICE
+ TAD I OHNDL /HANDLER ENTRY POINT
+ DCA TEMPO
+ CDF 0
+ JMS I TEMPO /CALL OUTPUT DEVICE HANDLER
+ 4110 /THE BUFFER IS A PAGE OF THE EDITOR
+ 7000 /WITH A 232 IN THE FIRST LOCATION
+CLSREC, 0 /RECORD NUMBER HERE
+ JMP I SERR1I /**WRITE FAILURE** 1*
+ CDF CIF 10
+ JMS I OCLSI /CLOSE THE FILE IN PANIC MODE
+ JMP I SERR2I /**FILE CLOSE FAILED**2*
+ CIF 10
+ JMS I C200 /CALL USER SERVICE ROUTINES
+ 11 /*DISMISS USR FROM CORE*
+PATCH2, CLA
+ CDF 0
+ TAD POINT /PRINT OUT"FULL" AND RETURN
+ DCA AXIN
+ TAD I AXIN /FETCH CHARACTER
+ SNA /DONE YET?
+ JMP I RST3I /YES-RESET & CALL COMMAND DECODER
+ JMS I OUTL1 /NO - OUTPUT CHARACTER
+ JMP .-4 /GET NEXT CHARACTER
+\f
+FXSWDI, FXSTWD
+OCNTI, OUCCNT
+PANICI, PANIC
+OCHARI, OCHAR
+MORECS, -OURECS+1 /THIS ALLOWS US TO 'MANUALLY' WRITE
+ /A FORM FEED AND A ^Z.
+
+POINT, FULLST-1
+OREC, OUREC
+OHNDL, OUHNDL
+
+/RESET POINTERS STORED PREVIOUSLY
+BUFRET, TAD PPTE1
+ DCA TE1
+ TAD PTE1
+ DCA I TE1
+ TAD PELIM
+ DCA ELIM
+ JMP BUFRTN
+
+PPTE1, 0
+PELIM, 0
+PTE1, 0
+OCLSI, OCLOSE /V3 FILE CLOSE ROUTINE
+
+/-----------------------------------------------------------------------
+
+/ERROR MESSAGE- FULL -
+FULLST, 306 /F
+ 325 /U
+ 314 /L
+ 314 /L
+ 215 /CARRIAGE RETURN
+ 212 /LINE FEED
+ 0 /DELIMITER
+\f
+SRCBUF, ZBLOCK 24 /SEARCH BUFFER
+
+
+/SPECIAL CHARACTER LIST FOR STRING SEARCH
+SLST=.
+ 247 /"
+ 242 /'
+ 377 /RUBOUT
+ 203 /^C
+ 225 /^U
+/-----------------------------------------------------------------------
+NEXBUF, DUMB1&177+5600 /JMP I DUMB1
+
+/DISPATCH LIST FOR STRING SEARCH
+
+OSLST, QUO1 /"
+ QUO2 /'
+ FORGET /RUBOUT
+ MONIT /^C
+ RLEAS /^U IN STRING SEARCH
+\f
+
+/GENERATE ^ FOLLOWED BY THE CHARACTER
+/WHICH IS IN AC ON ENTRY
+
+UPAROW, 0
+ DCA TEMPO /SAVE CHARACTER
+ TSF
+ JMP .-1
+ TAD C336
+ JMS I OUTL1 /PRINT ^
+ TAD TEMPO
+ JMS I OUTL1 /PRINT CHARACTER
+ JMP I UPAROW /--RETURN--
+C336, 336
+
+
+/HANDLER FOR ^U DURING STRING SEARCH
+RLEAS, JMS I (CTRLU1
+ JMP I (START /^U GETS US BACK TO #
+
+/HANDLER FOR ALTMODE
+
+AMODE, DCA STRIND /NEED SETUP
+ JMS I STRFIN /SEARCH FOR STRING
+ ERROR
+ TAD THSN /RESULT IS LINE NUMBER
+ JMP I .+1 /LINK TO COMMAND STRUCTURE
+ GTOP+1
+
+
+/HANDLER FOR J COMMAND
+
+JERK, DCA STRIND /SETUP FOR SEARCH
+JERK1, JMS I STRFIN /SEARCH FOR STRING
+ JMP GMOR /GET NEXT BUFFER
+ TSF
+ JMP .-1 /JUST TO BE SURE
+ TAD CZ /RESTORE MONITOR EXIT
+ DCA I TE1
+ JMP I TE1 /*POSSIBLE RETURN TO COMMAND MODE*
+\f
+/GET NEXT BUFFER FOR S SEARCH
+
+GMOR, TAD I CNTRI
+ SNA CLA /IS BUFFER EMPTY?
+ ERROR /NO
+ ISZ STRIND /YES-BYPASS SETUP
+ TAD NEXBUF
+ DCA I COMM5 /SET UP READ OF ONE BUFFER
+ IAC
+ DCA ARG0
+ TAD EKILLL
+ SZA CLA /IS THERE AN OUTPUT DEVICE?
+ JMP I .+2 /NO
+ JMP I .+2 /YES
+ YANK /NO OUTPUT
+ COMBO /THERE IS OUTPUT
+
+
+/HANDLER FOR F COMMAND
+
+BARROW, ISZ STRIND /CONTINUES LOOKING FOR EXISTING STRING
+ ISZ THSN /INCREMENT FOR NEXT LINE
+ JMP JERK1
+CNTRI, CNTR
+
+/HANDLER FOR "
+
+DBLQUO, ISZ THSN /USES STRING NOW IN BUFFER
+ ISZ STRIND /NO SETUP REQUIRED
+ JMP AMODE+1
+
+/HANDLER FOR B COMMAND
+
+CORSPC, CLL
+ TAD BUFR
+ TAD K1320
+ SZL CLA /IS ANY CORE LEFT?
+ JMP ZROCOR /NO
+ TAD BUFR /YES-SET UP NUMBER OF LOCATIONS
+ CIA /IN ARG2
+ TAD BUFEND
+ TAD K360
+ZROCOR, DCA ARG2
+ JMP I .+1
+ PRNT
+K360, 360
+\f
+/HANDLER FOR K COMMAND
+
+KILL, TAD ARG0 /IN CASE HE TYPED N,MK
+ SZA CLA /INSTEAD OF N,ML. SAVE HIM!!
+ ERROR
+ TAD END /RESET BUFFER POINTERS
+ DCA BUFR /TO REFLECT EMPTY BUFFER
+ DCA LSTN
+ DCA THSN
+ CDF 10 /ZERO FIELD 1 POINTER
+ DCA I CFRS
+ CDF 0
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+
+/ROUTINE TO REASSIGN INPUT HANDLER
+/AFTER A PANIC DUMP AND RESTART
+
+PIASGN, CDF CIF 10
+ TAD I PINEOF
+ SZA CLA /IS THERE A HANDLER TO RESTORE?
+ JMP I PIRETN /NO - BACK TO FIELD 1
+ TAD I IHPAGE /YES -
+ DCA PIHND /GET HANDLER PAGE
+ TAD I IDVNO
+ CDF 0 /I/O MONITOR IS IN CORE AT THIS POINT
+ JMS I C200 /CALL USER SERVICE ROUTINES
+ 1 /*FETCH HANDLER*
+PIHND, 0
+ JMP I SERR4I /**DEVICE HANDLER ERROR**+**
+ TAD PIHND
+ CDF CIF 10
+ DCA I PIHNDL /PUT NEW HANDLER ADDRESS BACK
+ JMP I PIRETN /AND RETURN
+
+PIRETN, PANOPN /GO OPEN OUTPUT FILES
+PIHNDL, INHNDL
+IHPAGE, I1 /I1 CONTAINS "INDEVH+1"
+IDVNO, INDEV
+PINEOF, INEOF
+
+/HANDLER FOR # COMMAND
+
+VERSN, TAD ("V /V3
+ JMS I OUTL1 /V3 PRINT V
+ TAD (VERSION&70%10+260 /V3
+ JMS I OUTL1 /V3 PRINT VERSION #
+ TAD (VERSION&7+260
+ JMS I OUTL1 /V3C PRINT 2ND NUMBER OF VERSION #
+ TAD (PATCH /V3
+ JMS I OUTL1 /V3 PRINT PATCH LEVEL
+ JMP I TE1 /V3 RESTART
+\f*2400
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+/STRING SEARCH ROUTINE
+/CALLED BY $(ALTMODE) AND J COMMAND HANDLERS
+
+SFIND1, 0
+ ISZ ECHOSW
+ TAD STRIND /IS SETUP NECESSARY
+ SZA CLA
+ JMP SFIND2 /NO.
+ TAD MSCNT
+ DCA BUFCNT /SET COUNTER
+ TAD SBUF
+ DCA AXIN /BEGIN SEARCH BUFFER
+ TAD ATSIGN
+ JMS I OUTL1 /OUTPUT $
+ ISZ TABIND
+RLOOP, JMS I CHI1 /FETCH CHARACTER FROM TTY
+ JMS I SORTJ /IS IT SPECIAL FOR SEARCH STRING?
+ SLST-1 /YES-HANDLE IT
+ OSLST-SLST
+ ISZ BUFCNT /NO-SEARCH BUFFER FULL?
+ JMP STORE /NO-STORE THIS CHARACTER
+ CLA CMA
+ DCA BUFCNT /YES-DON'T ALLOW ANY MORE
+ JMP RLOOP-1 /BUT KEEP ECHOING HIS
+STORE, TAD CHAR /STORE CHARACTER IN SEARCH BUFFER
+ DCA I AXIN
+ JMP RLOOP
+
+/HANDLER FOR "
+QUO2, TAD THSN /START AT .+1
+/HANDLER FOR '
+QUO1, IAC /START AT .=1
+ DCA THSN
+ TAD AXIN
+ CIA /MAKE UP COUNT OF NO. CHARS NOW IN
+ TAD SBUF /SEARCH BUFFER
+ DCA CNTR
+ DCA I AXIN /END STRING WITH A 0
+SFIND2, TAD CNTR
+ SNA CLA /IS BUFFER EMPTY?
+ JMP ER1 /YES-PREPARE TO EXIT
+ JMS NUCHAR /NO GET FIRST STRING CHARACTER
+ TAD THSN
+ JMS I FIN1 /GET APPROPRIATE POINTER
+ DCA THIS /THE TRICK IS TO GET THE NEXT
+ DCA CHFND
+ CDF 10 /POINTER SO THAT WE NEVER HAVE TO GO
+ TAD I THIS /BACK TO THE FIND ROUTINE
+\f
+COMBAK, DCA TMP2
+ TAD I TMP2
+ DCA NEXTPT
+ CDF 0
+ TAD THSN
+ CIA
+ TAD LSTN
+ SPA CLA /LAST LINE?
+ JMP ER1 /YES-FINISHED WITH BUFFER
+ TAD TMP2 /NO
+ DCA AXOUT /SET TO UNPACK CHARACTERS
+ CMA
+ DCA XCT
+UPK1, JMS I UTR1 /UNPACK A CHARACTER
+ DCA TMP2
+ TAD TMP2
+ TAD MCR
+ SZA CLA /END OF LINE?
+ JMP NOCR /NO
+ ISZ THSN /YES-INCREMENT LINE COUNTER
+ JMS NUCHAR /FORGET PREVIOUS MATCHES ON NEW LINE
+ DCA CHFND
+ CDF 10
+ TAD NEXTPT /AND GET NEXT LINE
+ JMP COMBAK
+
+NOCR, TAD TMP2 /CHARACTER OTHER THAN CARRIAGE RETURN
+ TAD TMP1 /GET A CHARACTER FROM SEARCH BUFFER
+ SZA CLA /DO THEY MATCH
+ JMP UPK /NO
+ ISZ CHFND /YES-BUMP A RANDOM POINTER
+ CLA CMA
+ DCA FMATCH /SIGNIFY FIRST MATCH
+ JMS NUCHA /GET NEXT SEARCH CHARACTERR
+ JMP UPK1 /AND ANOTHER BUFFER CHARACTER
+
+UPK, ISZ FMATCH /WAS THIS FIRST MATCH?
+ JMP NOTSO /NO-NO PROBLEM
+ TAD XCT /YES-DON'T LET THE POINTERS BE
+ SPA CLA /BE CHANGED
+ JMP WREK
+ CMA
+ TAD AXOUT
+ DCA AXOUT
+ CMA
+WREK, DCA XCT
+NOTSO, JMS NUCHAR /GET FIRST CHARACTER OF SEARCH STRING
+ DCA CHFND
+ JMP UPK1 /TRY AGAIN
+\f
+STFIN, TAD CHFND /END OF STRING-DO COUNTS MATCH?
+ TAD CNTR
+ SNA CLA
+ JMP GOOD /YES-SEARCH SUCCESSFUL
+ER1, TAD LSTN /IF BUFFER EMPTY, SET .=0
+ SZA CLA
+ IAC
+ DCA THSN
+ SKP /CAUSE ERROR RETURN (?)
+GOOD, ISZ SFIND1 /INCREMENT RETURN
+ JMP I SFIND1 /--RETURN--
+
+/GET NEXT SEARCH CHARACTER
+NUCHA, 0
+ TAD .-1 /SET TO RETURN FROM NUCHAR
+ DCA NUCHAR
+ JMP NEXX
+
+/GET FIRST CHARACTER OF SEARCH STRING
+NUCHAR, 0
+ TAD SBUF
+ DCA AXIN
+NEXX, TAD I AXIN
+ SNA /END OF STRING?
+ JMP STFIN /YES
+ CIA /NO - NEGATE SEARCH CHARACTER
+ DCA TMP1 /AND STORE IT
+ JMP I NUCHAR /--RETURN--
+
+ENDA=SRCBUF-1
+ATSIGN, 244
+TMP1, 0
+TMP2, 0
+CNTR, 0
+FMATCH, 0
+BUFCNT, 0
+NEXTPT, 0
+CHFND, 1 /MUST BE NONZERO INITIALLY
+SBUF, ENDA
+MSCNT, -24
+
+/HANDLER FOR RUBOUT IN SEARCH STRING
+
+FORGET, TAD CCR
+ JMS I OUT1 /OUTPUT CARRIAGE RETURN
+ JMP SFIND1+1
+
+\f
+ *2600
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+ THISX=COUNTP
+ THISX2=DTEM
+ RELCNT=LPT
+
+
+/GARBAGE COLLECTION ROUTINE
+/ENTER WITH NUMBER OF LINE TO BE DELETED
+/IN AC
+
+GARBAG, 0
+ DCA LINPTR /SAVE OBJECT LINE ADDRESS
+ TAD LINPTR
+ DCA AXCOMB /SCAN LINE LOOKING FOR 7715 OR 1500 (CR)
+ IAC /CNT HOLDS
+ DCA CNT /TOTAL # LOCS IN THIS LINE
+ CDF 10
+COLECT, ISZ CNT
+ TAD I AXCOMB /GET A WORD
+ TAD K63
+ SNA /IS IT 7715?
+ JMP FINONE /YES-END OF LINE
+ TAD K6215
+ SZA CLA /NO-IS IT 1500?
+ JMP COLECT /NO-TRY NEXT WORD
+FINONE, TAD CNT /YES MINUS CNT GIVES AMOUNT
+ CIA /TO REDUCE CERTAIN POINTERS
+ DCA RELCNT
+ CDF 0
+ IAC /GO THROUGH LIST OF POINTERS
+ JMS I FIN1 /& OFFSET POINTERS WHICH WILL BE MOVED
+ CDF 10 /MOVED ALONG WITH TEXT
+GBG2, DCA THISX /SAVE POINTER
+ TAD I THISX /GET ADDRESS OF THIS LINE
+ SNA /DONE WITH STRING?
+ JMP GBGEND /YES
+ JMS CGEPTR /DECREASE POINTER IF NECESSARY
+ DCA I THISX /STORE NEW POINTER
+ TAD THISX2
+ JMP GBG2 /DO NEXT LINE
+\f
+GBGEND, CDF 0 /ALL POINTERS ARE REDUCED. NOW,
+ CLL CML
+ TAD BUFR /PHYSICALLY MOVE CORE TO
+ CIA /CORRESPOND WITH POINTERS
+ TAD AXCOMB /AXCOMB POINTS TO FIRST LOC. TO GO
+ SMA SNL /POINTERS O.K.?
+ ERROR /NO
+ DCA XCT /YES-SET UP OTHER POINTERS
+ CDF 10
+ CMA
+ TAD LINPTR
+ DCA AXOUT
+ TAD I AXCOMB /MOVE TEXT
+ DCA I AXOUT
+ ISZ XCT /ALL TEXT MOVED?
+ JMP .-3 /NO-CONTINUE MOVING
+ CDF 0 /YES
+ TAD AXOUT
+ DCA BUFR /RESET TOP OF BUFFER
+ TAD BUFR /REDUCE AXIN FOR CHARACTER SEARCH
+ DCA AXIN
+ TAD THIS /NOW DECREASE THIS IF IT IS NECESSARY
+ JMS CGEPTR
+ DCA THIS
+ JMP I GARBAG /--RETURN--
+
+LINPTR, 0
+K63, 63
+
+CGEPTR, 0 /THIS ROUTINE DETERMINES IF THE
+ DCA THISX2 /OF THE AC MUST BE DECREASED BY RELCNT.
+ CLL /IF THISX2 IS GREATER THAN LINPTR
+ TAD THISX2 /DECREASE THISX2 BY RELCNT.
+ CIA
+ TAD LINPTR /THIS EFFECTIVELY DECREASE ALL POINTERS
+ SNL CLA /WHICH HAVE TO BE RELOCATED
+ TAD RELCNT
+ TAD THISX2
+ JMP I CGEPTR
+
+/HANDLER FOR V COMMAND
+
+VIEW, TAD (LPT /SET UP LISTER TO EXIT TO LPT
+ DCA OUTDEV
+ ISZ TABIND
+ JMS I LIS /LIST BUFFER
+ TAD C214 /AND OUTPUT A FORM FEED
+ JMS I OUTDEV
+ JMP I TE1 /*RETURN TO COMMAND MODE*
+
+
+/LINE PRINTER OUTPUT ROUTINE
+/ENTER WITH CHARACTER IN AC
+/EXIT WITH AC CLEAR
+
+LPT, 0
+ 6666 /LLS
+ 6661 /LSF
+ JMP .-1
+ CLA
+ JMP I LPT /--RETURN--
+\f/HANDLER FOR ,
+
+FIRS, TAD ARG2
+ JMP I ONUM
+
+K6215, 6215
+
+
+/THE FOLLOWING GIVES ERROR MESSAGES FOR I/O RELATED ERRORS
+/EACH IS A FATAL ERROR AND WILL ALWAYS EXIT THROUGH
+/7600, SAVING THE TEXT BUFFER.
+/N IS THE ERROR IDENTIFICATION CODE
+/N=0=> FAILED IN READING DEVICE
+/N=1=> FATAL WRITE ERROR
+/N=2=> FILE CLOSE ERROR
+/N=3=> FILE OPEN ERROR
+/N=4=> DEVICE HANDLER ERROR
+
+SERR4, IAC
+SERR3, IAC
+SERR2, IAC
+SERR1, IAC
+SERR0, DCA TEMPO
+ TLS
+ TSF
+ JMP .-1
+ TAD C215
+ JMS I OUTL1 /OUTPUT CARRIAGE RETURN
+ TAD CLF
+ JMS I OUTL1 /OUTPUT LINE FEED
+ TAD C277
+ JMS I OUTL1 /OUTPUT?
+ TAD TEMPO
+ TAD P260
+ JMS I OUTL1 /SEND ERROR CODE
+ TAD C303
+ JMS I UPAROI /SEND ^C
+ JMP I MONITO /****EXIT TO MONITOR****
+
+P260, 260
+C303, 303
+
+DELE, JMS I DELT /DELETE THE LINES
+ TSF
+ JMP .-1
+ JMP I TE1
+
+CTRLN, TAD C316
+ JMS I UPAROI /ECHO ^N
+ JMP I .+1
+ OUTX+1
+C316, 316
+/
+PATCH1, 0
+ CIF 10
+ JMS I OCLSE /CLOSE FILE
+ SKP
+ JMP I PATCH1 /FILE CLOSED OK -RETURN
+ SPA CLA
+ JMP SERR2 /**FILE CLOSE FAILED**2*
+ JMP I NOROOM /RAN OUT OF SPACE WHILE CLOSING
+/
+NOROOM, ERWT+2
+OCLSE, OCLOSE
+\f/***********************************************************************
+
+/THE CODE AT 3000 IS ONCE ONLY CODE. IT TAKES THE FIELD 1
+/PART OF THE CODE WHICH IS INITIALLY IN FIELD 0 AND MOVES
+/IT UP TO THE PROPER LOCATIONS IN FIELD 1.
+ *3000
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+
+INIT, TAD (3177 /COLD LOAD STARTS AT 3200
+ DCA AXIN
+ TAD (6577 /CODE SHOULD BE IN 6600 OF FIELD 1
+ DCA AXOUT
+ TAD (7000 /MOVE 1000 LOCATIONS UP
+ DCA COUNTA
+LOOP, CDF 0
+ TAD I AXIN /MOVE CODE
+ CDF 10
+ DCA I AXOUT
+ ISZ COUNTA /DONE YET?
+ JMP LOOP /NO
+ DCA AXIN /YES-RESET COUNTERS
+ DCA AXOUT
+ CDF 0 /PUT A NOP INTO LOC. 203
+ TAD (NOP
+ DCA I (START
+ TAD RST3I /CHANGE START ADDRESS TO SAVE BUFFER
+ DCA 177
+ CIF CDF 10
+ JMP I K6600 /STARTING ADDRESS IS 16600
+K6600, 6600 /FIELD 1 STARTING ADDRESS
+
+COUNTA, 0
+
+/ERR5, CDF 0 /SET NOT RESTARTABLE BIT IF CHAIN
+/ TAD I (1000
+/ TAD I (7746
+/ DCA I (7746
+/ JMP I (SERR5 /AND GIVE ?5^C
+\f/MISCELLANEOUS PATCHES (NOT ONCE-ONLY!)
+
+/ESCAPE PATCH 25-MAY-77 DS
+
+ESCPA, 0
+ ISZ ESCPA /SKIP OVER PATCH ADDR
+ TAD ECHOSW /IS ECHO SUPPRESSED?
+ SNA CLA
+ JMP I ESCPA /YES, RETURN
+ TAD CHAR /NO, TEST FOR ESC
+ TAD (-233)
+ SNA CLA /V12
+ JMP .+3 /V12
+ ISZ ESCPA /PRINT UNLESS IT IS ESC
+ JMP I ESCPA
+ TAD I CHI1 /V12 - TAD CHIN
+ TAD (-CMCHK-1
+ SZA CLA /COMMAND MODE?
+ ISZ ESCPA /NO, OUTPUT IT
+ JMP I ESCPA /YES, DON'T OUTPUT IT NOW
+ /V12
+
+/SCOPE PATCH 25-MAY-77 DS
+
+RUBPA, 0
+ ISZ RUBPA /SKIP OVER PATCH ADDR
+ CDF 10 /LOOK AT "SCOPE" BIT IN
+ TAD I (7726) /RESIDENT MONITOR
+ CDF 00
+ AND (200)
+ SZA CLA
+ JMP RP1
+ TAD SPLAT /NO SCOPE, PRINT BACKSLASH
+RP2, JMS I OUT1 /PRINT
+ JMP I RUBPA /DONE, DELETE THE CHAR
+RP1, TAD (210) /SCOPE, PRINT BACK SPACE
+ JMS I OUT1
+ TAD (240) /THEN A SPACE
+ JMS I OUT1
+ TAD (210) /THEN ANOTHER BACK SPACE
+ JMP RP2
+SPLAT, 334 /ACKNOWLEDGE RUBOUT
+
+\f/ROUTINE TO HANDLE ESCAPE OUTPUT
+/V12 - 27-JUN-77 ES
+
+ESCOUT, TAD OUTDEV
+ TAD (-OUTL
+ SZA
+ TAD (OUTL-LPT
+ SZA CLA /OUTPUT TO TERMINAL OR LINEPRINTER?
+ TAD (233-"$ /NO, OUTPUT ESC
+ TAD ("$ /YES, OUTPUT "$"
+ JMP OUTX /DO IT
+
+/MORE STUFF MAY BE INSERTED HERE
+
+/LITERALS
+ PAGE
+\f *3200
+/********************************************************************
+/CODE MOVED TO 16600-16762
+
+NOPUNC
+*6600
+ENPUNC
+
+
+/OURECS=4
+/SETUP FOR USING GENERAL INPUT, OUTPUT ROUTINES
+ INBUF=4200 /INPUT BUFFER AT 04200
+ INCTL=0600 /INPUT CONTROL - 6 PAGES
+ INRECS=3 /3 RECORDS INTO FIELD 0
+ INDEVH=3200 /INPUT HANDLER AT 03200
+
+ OUBUF=5600 /OUTPUT BUFFER AT 05600
+ OUCTL=5000 /OUTPUT CONTROL - 8 PAGES
+ OUDEVH=3600 /OUTPUT HANDLER AT 03600
+
+ MPARAM=7643 /OPTION SWITCHES
+
+
+ JMS I L7700 /CALL USER SERVICE ROUTINES
+ 10 /*LOCK USR IN CORE*
+ CDF 0 /V3
+ ISZ I PTEMP /V3 WERE WE CHAINED TO?
+ JMP CHN /V3 YES
+ CDF 10 /V3 NO
+START1, JMS I L200 /CALL USER SERVICE ROUTINES
+ 5 /*COMMAND DECODER*
+ 0
+CHN, CDF 10
+ TAD K7620 /RESET OUTDMP
+ DCA I THOLE
+ TAD I P7600A /OUTPUT LIST
+ AND C17
+SZCL, SZA CLA /IS THERE AN OUTPUT DEVICE?
+ JMP NXTOP /YES
+ CDF 0 /NO-DISALLOW E COMMAND
+ ISZ I EKILSW
+ CDF 10
+NXTOP, TAD I PARAM
+ RAL /B BIT TO BIT 0
+ DCA DVHAND /SAVE PARAM. SWITCH
+ TAD DVHAND
+ SMA CLA /WAS /B OPTION SPECIFIED?
+ JMP NEWOP /NO
+P7600A, 7600 /YES-
+ TAD SZCL /SET UP TO CONVERT SPACES TO TABS
+ CDF 0
+ DCA I SPCP1
+ CDF 10
+\fNEWOP, TAD DVHAND
+ RTL
+ SMA CLA /WAS /D OPTION SPECIFIED?
+ JMP FILOP /NO
+ TAD I OHANDL /YES-HANDLER BROUGHT IN FOR D OPTION
+ DCA DVHAND
+ TAD I P7600A /DEVICE NUMBER
+ JMS I L200 /CALL USER SERVICE ROUTINES
+ 1 /*ASSIGN*
+DVHAND, 0
+ JMP ISERR4 /**DEVICE HANDLER ERROR**4**
+ TAD I P7600A /GET DEVICE NUMBER
+ JMS I L200 /CALL USER SERVICE ROUTINES
+ 4 /*CLOSE*
+ 7601
+ 0
+JLSTN, LSTN /PAGE ZERO. 'AND' SOME ADDRESS
+FILOP, TAD PANIC /PANIC CASE?
+ SNA
+ JMS I IOPENI /SET BUFFER POINTERS OR RESTORE HANDLER
+ SZA CLA /YES-
+ JMP GINDVH /RESTORE INPUT DEVICE HANDLER IN PANIC MODE
+PANOPN, JMS I OOPENI /OPEN OUTPUT FILES
+ SMA CLA /ERROR RETURN
+ SKP /NORMAL RETURN
+ JMP ISERR3 /**FILE OPEN ERROR**3**
+ TAD PANIC /PANIC CASE?
+ SNA CLA
+ JMP NOPAN /NO
+ TAD I P7600A /YES IF NO OUTPUT,DON'T ALLOW HIM
+ SNA CLA /TO DESTROY HIS TEXT
+ JMP START1
+ TAD K5000 /SET TO WRITE BUFFER
+ JMS I ODMP /DUMP IT
+ JMP ISERR1 /**FATAL WRITE ERROR**1**
+ CLA IAC
+\fNOPAN, DCA DVHAND
+ DCA PANIC /CLEAR PANIC SWITCH
+ JMS I L200 /CALL USER SERVICE ROUTINES
+ 11 /*DISMISS USR FROM CORE*
+ JMS I OUSTPI /RE-INITIALIZE OUTPUT POINTERS
+ CLA IAC
+ JMS I SETJSI
+ CDF 0 /IF LSTN#0, CLEAR FRST
+ TAD I JLSTN /BUT IN FIELD 1
+ SNA CLA
+ DCA FRST
+ CIF CDF 0
+ TAD DVHAND
+ SNA CLA /PANIC MODE?
+ JMP I STRTUP /NO-START THE EDITOR
+ TLS
+ JMP I .+1 /YES - RESUME OUTPUT
+ BUFRET
+
+GINDVH, CDF CIF 0
+ JMP I .+1
+ PIASGN
+
+ISERR3, JMS I L200 /CALL USER SERVICE ROUTINES
+ 11 /*DISMISS USR FROM CORE*
+ CIF CDF 0
+ JMP I ASERR3 /**FILE OPEN ERROR**3**
+
+ISERR4, JMS I L200 /CALL USER SERVICE ROUTINES
+ 11 /*DISMISS USR FROM CORE*
+ CIF CDF 0
+ JMP I ASERR4 /**DEVICE HANDLER ERROR**4**
+
+ISERR1, JMS I L200 /CALL USER SERVICE ROUTINES
+ 11 /*DISMISS USR FROM CORE*
+
+ CIF CDF 0
+ JMP I ASERR1 /**FATAL WRITE ERROR**1**
+\fSETJSI, SETJSB
+L200, 200
+STRTUP, START
+PANIC, 0
+SPCP1, SPACES+1
+IOPENI, IOPEN
+OOPENI, OOPEN
+EKILSW, EKILLL
+ODMP, OUTDMP
+OHANDL, O1
+C17, 17
+PARAM, MPARAM
+L7700, 7700
+ASERR1, SERR1
+ASERR3, SERR3
+ASERR4, SERR4
+K5000, 5000 /OUTPUT BUFF CONTROL WORD
+OUSTPI, OUSETP
+THOLE, TSTHOL
+K7620, 7620
+PTEMP, TEMP
+
+/***********************************************************************
+\f *3400
+/***********************************************************************
+/CODE MOVED TO 17000-17173
+
+NOPUNC
+*7000
+ENPUNC
+
+ 232 /THIS PAGE IS ^Z BUFFER
+/SET UP ROUTINE FOR OUTPUT
+/INITIALIZES CHARACTERS POINTERS
+OUSETP, 0
+ TAD I PANICJ /IS IT PANIC DUMP TIME?
+ SZA CLA /IF YES, DONT RESET POINTERS
+ JMP I OUSETP /--RETURN--
+ TAD C1 /GET SIZE OF BUFFER IN DOUBLEWORDS
+ CIA /NEGATE IT
+ DCA OUDWCT
+ TAD C2
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
+ JMP I OUSETP /--RETURN--
+
+/OUTPUT A CHARACTER
+/ENTER WITH CHARACTER IN 8-BIT ASCII
+/IN AC
+OCHAR, 0
+ AND C377 /MASK OUT EXTRA BITS
+ DCA OUTEMP
+ KRS
+ TAD M203
+ SNA CLA
+ KSF
+ JMP .+3
+ CIF CDF 0
+ JMP I C7600
+ RDF /NO-
+ TAD CDIF0
+ DCA OUCRET
+ TAD OUTINH /IS OUTPUT INHIBITED?
+ SZA CLA
+ JMP PSTOP /NO
+ CDF OUFLD /YES-SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /3 WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND K7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF 3RD CHAR
+\f TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND K7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD OUCT /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I DMPO /DUMP THE BUFFER
+ JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, ISZ OCHAR
+OUCRET, HLT /RESTORE CALLING FIELDS
+ JMP I OCHAR /--RETURN--
+
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+\f/FETCH OUTPUT DEVICE CONTROL WORD
+
+OTYPE, 0
+ RDF
+ TAD CDIF0
+ DCA OTRTN
+ CDF 10
+ TAD I C7600 /FETCH OUTPUT DEVICE NUMBER
+ AND P17
+ TAD DCBM1 /+DCB-1
+ DCA OUTEMP /FETCH DEVICE CONTROL WORD
+ TAD I OUTEMP
+OTRTN, HLT /RESTORE CALLING FIELDS
+ JMP I OTYPE /--RETURN--
+PSTOP, CIF 0 /PRINTS ? WHEN NO OUTPUT DEV
+ ERROR
+
+INSET, 0
+ DCA OTYPE /SAVE AC
+ RDF
+ TAD CDIF0
+ DCA INSTRT /SET RETURN FIELDS
+ CDF 0
+ TAD I PLASTN
+ CDF 10
+ SNA CLA /IS THERE ANYTHING IN BUFFER?
+ IAC /NO-NO NEED TO SAVE USR AREA
+ JMS SETJSB /YES-
+ TAD OTYPE /RESTORE AC
+INSTRT, CIF CDF 0 /RESTORE CALLING FIELDS
+ JMP I INSET /--RETURN--
+\f/SET JOB STATUS BIT 11 TO SAVE OR NOT SAVE
+/ENTER WITH AC=0 OR 1, DEPENDING ON BUFFER
+
+SETJSB, 0
+ DCA JSBTM /SAVE AC
+ CDF 0
+ CLA CLL CMA RAL
+ AND I PJSBTS /CLEAR BIT 11 OF JSW
+ TAD JSBTM /SET ACCORDING TO AC
+ DCA I PJSBTS
+ CDF 10
+ JMP I SETJSB /--RETURN--
+
+JSBTM, 0
+PJSBTS, 7746
+PLASTN, LSTN
+
+DCB=7760
+C1, OUCTL&3700
+C2, OUBUF
+C377, 377
+M203, -203
+CDIF0, CDF CIF 0
+K7400, 7400
+OUCT, OUCTL
+C7600, 7600
+P17, 17
+DCBM1, DCB-1
+DMPO, OUTDMP
+PANICJ, PANIC
+/***********************************************************************
+\f *3600
+/***********************************************************************
+/CODE MOVED TO 17200-17376
+NOPUNC
+*7200
+ENPUNC
+/OPEN OUTPUT FILE
+
+O17, 17
+OOPEN, 0
+OU7600, 7600
+ TAD OU7601
+ DCA OUBLK
+ TAD O1
+ DCA OUHNDL /SET OUTPUT HANDLER ENTRY
+ CDF 10
+ TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+ SNA /IS THERE AN OUTPUT DEVICE?
+ JMP ONOFIL /NO - INHIBIT OUTPUT
+ JMS I O200 /CALL USER SERVICE ROUTINES
+ 1 /*ASSIGN,FETCH HANDLER*
+OUHNDL, 2600 /OUTPUT DEVICE HANDLER ENTRY
+ JMP I SERR4A /**DEVICE HANDLER ERROR**4**
+OUENTR, TAD I OU7600
+ JMS I O200 /CALL USER SERVICE ROUTINES
+ 3 /*ENTER OUTPUT FILE*
+OUBLK, 7601 /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
+ DCA OUCCNT
+ DCA I O2 /ZERO OUTPUT INHIBIT FLAG
+ TAD OUBLK
+ DCA OUREC /INITIALIZE OUTPUT RECORD NUMBER
+ JMS I O3
+ ISZ OOPEN
+OORETN, JMP I OOPEN
+OEFAIL, TAD I OU7600
+ AND O7760 /GET REQUESTED LENGTH
+ SNA CLA /WAS IT AN INDEFINITE REQUEST
+ JMP ONTERR /YES - CANNOT ENTER THE FILE
+ TAD I OU7600
+O200, AND O17 /MAKE THE REQUESTED LENGTH ZERO
+ DCA I OU7600
+ JMP OUENTR /TRY, TRY AGAIN
+ONTERR, CLA CLL CML RAR /AC=2
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
+ONOFIL, ISZ I O2
+ JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ JMS OUNREC /COMPUTE NO. OF RECORDS
+ TAD OUCCNT
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+TSTHOL, SNL CLA /IF ZERO OR POSITIVE,GIVE ERROR
+ JMP OUERR
+ CDF CIF 0
+ CDF 10
+ JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER
+OUCTLW, 0 /CONTROL WORD
+ OUBUF /BUFFER ADDRESS
+OUREC, 0 /RECORD NUMBER
+ JMP OUERR /THERE ARE NO SOFT OUTPUT HANDLER ERRORS
+ JMS OUNREC
+ TAD OUREC
+ DCA OUREC /UPDATE OUTPUT RECORD NUMBER
+ ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
+OUERR, JMP I OUTDMP /--RETURN--
+\f
+/CLOSE OUTPUT FILE
+OCLOSE, 0
+ TAD K7660 /SET UP SNL SZA CLA FOR CLOSE
+ DCA TSTHOL
+ CDF 10
+ TAD I PANICC
+ SZA CLA
+ JMP NODUMP
+ TAD I O2
+ SZA CLA /IS OUTPUT INHIBITED?
+ JMP OCISZ /YES - CLOSE IS A NOP
+ TAD O232 /OUTPUT A ^Z
+ JMS I O4
+ JMP OCRET /AND SOME 0'S
+ JMS I O4
+ JMP OCRET
+FILLLP, JMS I O4
+ JMP OCRET
+ JMS I O5 /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD O100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+ TAD O77 /BOUNDARY-OTHERWISE HALF RECORD
+ AND I O6
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I O6 /GET DOUBLEWORD COUNT LEFT
+ TAD O7
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES - DON'T DO IT - ^Z IS ALREADY OUT
+ TAD O8 /PUT IN FIELD BITS AND WRITE BIT
+ JMS OUTDMP
+ JMP OCRET /ERROR OCCURRED WHILE DUMPING THE BUFFER
+NODUMP, JMS I O7700 /CALL USER SERVICE ROUTINES
+ 10 /*LOCK USR IN CORE*
+ TAD I OU7600 /DEVICE NUMBER
+ JMS I O200 /CALL USER SERVICE ROUTINES
+ 4 /*CLOSE OUTPUT FILE*
+OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
+OUCCNT, 0
+ SKP /ERROR WHILE CLOSING THE FILE
+OCISZ, ISZ OCLOSE
+OCRET, CIF CDF 0 /RESTORE CALLING FIELDS
+ JMP I OCLOSE /--RETURN--
+PANICC, PANIC
+\f/CONVERT OUTPUT CONTROL WORD
+/TO NUMBER OF RECORDS
+OUNREC, 0
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND O17
+ JMP I OUNREC /--RETURN--
+
+K7660, SNL SZA CLA
+O1, OUDEVH+1
+O7700, 7700
+O2, OUTINH
+O3, OUSETP
+O7760, 7760
+O232, 232
+O4, OCHAR
+O5, OTYPE
+O100, 100
+O77, 77
+O6, OUDWCT
+O7, OUCTL&3700
+O8, 4000+OUFLD
+SERR4A, ISERR4
+
+/***********************************************************************
+\f INFLD=INCTL&70 /FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /FIELD OF OUTPUT BUFFER
+/***********************************************************************
+/CODE MOVED TO 17400 -17574
+
+*4000
+NOPUNC
+*7400
+ENPUNC
+
+/PREPARE TO OPEN NEW INPUT FILE
+
+IN7400, 7400
+IOPEN, 0
+ CLA CMA
+ DCA INCHCT /SET INCHCT TO FORCE A READ
+ ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+ TAD I7617
+ DCA INFPTR /RESET FILE POINTER
+ JMP I IOPEN /--RETURN--
+INPTR, 0
+INDEV, 0
+
+/INPUT A CHARACTER
+
+ICHAR, 0
+IN7600, 7600
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SNA CLA /DID LAST READ YIELD END-OF-FILE?
+ JMP INGBUF /NO-DO ANOTHER
+INNEWF, CDF 10
+ TAD I1
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
+ DCA INDEV /SAVE IT FOR PANIC
+ TAD INDEV
+ SNA /ANY MORE?
+ JMP EOFERR /NO - OUT OF INPUT
+ JMS I PINSET /YES-SAVE BUFFER IF NECESSARY
+ JMS I I7700 /CALL USER SERVICE ROUTINE
+ 1 /*ASSIGN, FETCH HANDLER*
+INHNDL, 0
+ JMP I SERR4B /**DEVICE HANDLER ERROR**+**
+ TAD I INFPTR
+ AND I7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH >=256
+\f TAD I17 /ADD HIGH ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR
+ DCA INREC /STORE STARTING RECORD NUMBER OF FILE
+ ISZ INFPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+INGBUF, TAD INCTR
+ CLL
+ TAD I2
+ SNL
+ DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CONTROL WORD
+ TAD I3
+ DCA INCTLW
+ CDF CIF 0
+ CDF 10
+ JMS I INHNDL /CALL INPUT DEVICE HANDLER
+INCTLW, 0 /CONTROL WORD
+INBUFP, INBUF /INPUT BUFFER
+INREC, 0 /NUMBER OF RECORDS
+ JMP INERRX /SOME KIND OF HANDLER ERROR
+INBREC, TAD INREC
+ TAD I2
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A ERROR
+ SMA CLA /WHICH TYPE WAS IT?
+ JMP INBREC /END OF FILE - RESUME PROCESSING
+INERR, CLA CLL CML RAR /BAD - GIVE ERROR RETURN WITH NEGATIVE AC
+EOFERR, JMP INRTRN
+\fINJMP, HLT /3 WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND IN7400
+ CLL RTR
+ RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND I377
+ TAD IM232
+ SNA /IS THE CHARACTER A ^Z?
+ JMP INNEWF /YES - GET A NEW FILE
+ TAD I232 /RESTORE THE CHARACTER
+ ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
+INRTRN, CDF CIF 0 /RESTORE CALLING FIELDS
+ JMP I ICHAR /--RETURN--
+
+INCHCT, -1
+INFPTR, 7617
+INEOF, 1
+
+ INCTR=IOPEN
+PINSET, INSET
+I7617, 7617
+I1, INDEVH+1
+I7760, 7760
+I17, 17
+I2, INRECS
+I3, INCTL+1
+I377, 377
+IM232, -232
+I232, 232
+I7700, 7700
+SERR4B, ISERR4
+
+$
+/***********************************************************************
+\f
--- /dev/null
+/3.1 OS/8 V3 FOTP 5-AUGUST-1975 (NOT HALLOWEEN)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/WITH FAILSAFE CHANGES NOV 17, 1973 R.L.
+
+
+/ FOTP (FILE ORIENTED TRANSFER PROGRAM) H.J.
+
+
+/CORE MAP
+
+/FROM TOP OF CORE
+
+/ FIELD 2 GETS CONDITIONALLY USED AS BUFFER
+
+/ FIELD 1
+/ 7777-7600 MONITOR
+/ 7577-4600 INCORE OUTPUT DIRECTORY
+/ 4577-2000 FOTP CODE
+/ 1777-0 RESIDENT USR
+/
+/ FIELD 0
+/ 7777-7600 MONITOR
+/ 7577-7200 ERROR MESSAGES
+/ 7177-0 WORK AREA AS:
+/
+/ AT TOP- OUTPUT HANDLER IF NEEDED
+/ 1 OR 2 PAGES
+
+/ INPUT HANDLER IF NEEDED
+/ 1 OR 2 PAGES
+
+/ INPUT DEVICES DIRECTORY
+/ (ONLY USED PORTION)
+
+/ THE TRANSFER BUFFER IN 8K
+/ IS WHAT EVER REMAINS.
+
+/FIXES FOR MAINTENANCE RELEASE: (S.R. 5-AUG-75)
+
+/1. CHANGED COPYRIGHT DATE
+/2. INCORPORATED SEQ #1 PATCH (DSN MARCH 1975)
+/ PERMITS FOTP TO RECOVER FROM A MONITOR ERROR 6
+/ BY UNFAKING THE SYSTEM HANDLER
+/3. UPDATED FOTP VERSION NUMBER TO V8
+/4. ADDED SPACE FOR A PATCH LEVEL
+/5. ALLOWED /T SWITCH TO WORK IN CONJUNCTION WITH /R
+/6. PERMITS RENAMING A FILE TO IT'S OWN NAME
+/7. IF NO OUTPUT DEVICE IS SPECIFIED WITH /R,
+/ ASSUME OUT DEV=INPUT DEVICE.
+
+/8. FIXED BUG RE ADDITIONAL INFO WORDS
+\f/PAGE 0 LOCATIONS OS/8 USR WON'T MANGLE
+
+ PTR=20
+ CNT=21
+ INFPTR=22
+ OUHAND=23
+ INHAND=24
+ FPAGE=25
+ EPTR=26
+ INSCNT=27
+ TEMP=30
+ OKFLAG=31
+ IFCNT=32
+ BUFSIZ=33
+ INFWDS=34
+ BDPTR=35
+ GPTR1=36
+ INEOF=37
+
+/AUTO INDEX REGISTERS USR WILL ALLOW ME TO USE TEMPORARILY
+
+ XR=10
+ XR1=11
+ XR2=12
+
+
+/VARIOUS CONSTANTS THAT CAN BE GENERATED
+
+ AC2=CLA CLL CML RTL
+ AC4000=CLA CLL CML RAR
+ ACM2=CLA CLL CMA RAL
+ ACM3=CLA CLL CMA RTL
+
+/ LOCATIONS REFERENCED IN OS/8
+
+ ALTOPT=7642
+ OPT1=7643
+ OPT2=7644
+ DATE=7666
+ DIRKEY=7 /"DIRECTORY SEGMENT IN CORE" KEY
+
+/SYMBOLIC FOTP LOCATIONS:
+
+OUBUFR= 4600 /OUTPUT BUFFER - IN FIELD 1
+INBUFR= 0 /INPUT BUFFER - IN FIELD 0
+LSTFPG= 7000 /FIRST LOC OF LAST FREE PAGE IN FIELD 0
+FAKHND= 200 /LOCATION OF OS/8 FAKEOUT HANDLER
+VERSION= 11 /VERSION NUMBER
+SUBVER= 01 /SUB VERSION (PATCH LEVEL)
+ /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+\f/STARTS AT 4600 IN FIELD 1 (ONCE ONLY CODE)
+
+/SAVE INFO:
+
+/ .LOAD FOTP(89P)
+/ .SAVE SYS FOTP;14600
+
+ FIELD 1
+ *2000
+
+CDCALL, JMS I (200 /SEE WHAT THE PERSON WANTS
+FIVE, 5
+STAR, 5200 /IN SPECIAL MODE
+
+BYPSCD, JMS I (INTERC /CATCH CALLS TO 7600
+
+ TAD I (7600 /SAVE USER OUTPUT DEVICE
+ DCA I (USEROD /-FOR LATER
+
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+ TAD (-10 /8CHARACTERS TO LOOK AT
+ DCA CNT /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C, TAD (7605
+ JMS I (GTSXBT /GET A CHAR
+ TAD (-"?!7700 /CHECK FOR ?
+ SNA CLA
+ JMP QINO /? IN OUTPUT NOT ALLOWED
+ ISZ CNT
+ JMP S1C
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+
+ TAD (7605
+S4L, DCA PTR
+ TAD (-10
+ DCA CNT
+ACK, TAD PTR
+ JMS I (GTSXBT
+ TAD (-"*!7700 /CHECK TO SEE IF CHARACTER *
+ SZA CLA /SKIP IF IT IS
+ JMP CNTUP /GO LOOK AT NEXT
+ AC2
+ TAD CNT /ARE WE AT EXTENSION
+ SZA /SKIP IF YES
+ TAD (6 /ARE WE AT START OF FILENAME?
+ SNA CLA /SKIP IF NOT
+ ISZ CNT /BUMP COUNT ONLY IF OK
+ TAD PTR /LOOK AT NEXT CHAR
+ JMS I (GTSXBT
+ SZA CLA /SKIP IF ITS NULL - OK
+ JMP AINO /ERROR
+CNTUP, ISZ CNT /BUMP TO NEXT CHAR
+ JMP ACK /CONTINUE CHECKING
+ TAD I PTR /ANY MORE INPUT
+ SNA CLA /SKIP IF THERE IS
+ JMP NULLCK
+ TAD FIVE /BUMP TO NEXT ENTRY
+ TAD PTR
+ JMP S4L
+\f/ CHECK FOR NULL OUTPUT SPECIFICATION AND MAKE *.*
+
+NULLCK, TAD I (7601 /WAS OUTPUT FILENAME GIVEN?
+ SZA CLA /SKIP IF NONE
+ JMP DIDEML
+ TAD STAR /PUT AN ASTERISK IN
+ DCA I (7601 /FILENAME
+ TAD STAR
+ DCA I (7604 /AND EXTENSION
+
+/THIS CODE SETS A DEFAULT OUTPUT DEVICE ON DELETE
+
+DIDEML, TAD I (7600 /IS AN OUTPUT DEVICE SPECIFIED?
+ SZA /SKIP IF NOT
+ JMP ODSPEC /NOTE DEVICE NUMBER IN AC
+ TAD I (OPT1 /CHECK FOR /D
+ AND (400
+ SZA CLA /SKIP IF NOT /D
+ JMP MOV /OUTPUT=INPUT
+ TAD I (OPT2 /V3C
+ AND (100 /CHECK FOR /R
+ SZA CLA /V3C
+MOV, TAD I (7605 /WE'LL SUBSTITUTE FIRST INPUT DEVICE FOR USER
+ODSPEC, AND (17 /CLEAR USER SPECIFIED LENGTH
+ DCA I (7600 /WE KNOW BETTER
+
+/THE FOLLOWING BRINGS IN THE OUTPUT DEVICE HANDLER,
+/READS THE DIRECTORY INTO CORE AND VERIFIES IT.
+
+ TAD (LSTFPG /SET THE FREE SPACE POINTER
+ DCA FPAGE /TO THE LAST FREE PAGE IN FIELD 0
+ TAD I (7600 /IS THERE AN OUTPUT DEVICE?
+ SZA /IF NO OUTPUT, DON'T FETCH HANDLER
+ JMS I (ASSIGN /GET THE HANDLER AND ALLOCATE ITS SPACE
+ DCA OUHAND /AC RETURNS HANDLER ENTRY POINT
+ JMS I (ODIRIN /READ IN THE OUTPUT DIRECTORY
+ TAD (7605 /INGIALIZE INPUT POINTER
+
+/THIS IS THE BEGINING OF THE INPUT FILE LOOP
+
+DOMOIN, DCA INFPTR /POINTER TO CURRENT INPUT
+ TAD I INFPTR /WHEN 0 NO MORE INPUT
+ SNA /SKIP IF MORE TO DO
+ JMP I (ENDCHK /DO END PROCESSING
+ JMS I (ASSIGN /ASSIGN AND ALLOCATE SPACE FOR INPUT HANDLER
+ DCA INHAND /AND SAVE ITS ENTRY ADDRESS
+
+/THE FOLLOWING 2 INSTRUCTIONS HELP AVOID ALL KINDS OF
+/PROBLEMS WITH THE MONITOR. IF A HANDLER GETS LOADED, THE
+/MONITOR MAKES IT RESIDENT FOR OTHER PEOPLE AND DOESN'T DELETE
+/ITS RESIDENT STATUS IF A REQUEST IS MADE FOR A NEW HANDLER
+/TO BE LOADED OVER IT IF THE NEW HANDLER IS ALREADY RESIDENT
+
+ TAD FPAGE /SAVE FREE SPACE POINTER HERE
+ DCA SFUDG
+ JMP I (PG1 /LINK TO NEXT SECTION
+
+SFUDG, 0
+\fONDERR, JMS I (ERROR
+ ODRERR+40 /ERROR READING OUT DIR
+AINO, JMS I (ERROR
+ ILLA+40 /ILLEGAL *
+QINO, JMS I (ERROR
+ ILLQ+40 /ILLEGAL ?
+
+ PAGE
+\f/CHECK FOR NON FILE STRUCTURED INPUT
+/WE CAN'T HANDLE IT
+
+PG1, TAD I INFPTR
+ TAD (7757
+ DCA TEMP
+ TAD I TEMP /IS FILE STRUCTURED BIT ON
+ SMA CLA /SKIP IF IT IS
+ JMP NFIN /ERROR
+ CIF 0
+ JMS I INHAND /READ INPUT DEVICES DIRECTORY
+ 1400
+IDBUF, INBUFR
+ 1
+ JMP INDERR /ERROR
+ CDF 0
+ TAD I IDBUF /MAKE SURE THAT THE
+ CMA CLL /DIRECTORY OF
+ TAD I (INBUFR+2 /THE DEVICE IS
+ CDF 10 /GOOD
+ SNL
+ TAD (7700 /(SEE COMMENT ON TEST IN ROUTINE "ODIRIN")
+ SZL CLA /SKIP IF ITS GOOD
+ JMP BIDIR /ERROR
+
+/FIND LAST BLOCK OF DIRECTORY
+
+ AC2 /LINK TO NEXT SGMENT NUMBER
+FNDLST, DCA PTR /SAVE IT
+ CDF 0
+ TAD I PTR /IS THERE ANOTHER SEGMENT?
+ SNA CLA /SKIP IF YES
+ JMP ATIT /NO...WE ARE POINTING TO LAST
+ TAD PTR /BUMP TO NEXT SEGMENT
+ TAD (400
+ JMP FNDLST /LOOK AGAIN
+ATIT, ACM3 /AC=7775
+ AND PTR /AND OUT 2'S BIT
+ TAD (400 /TOTAL SIZE OF IN CORE DIRECTRY
+ CIA /NEGATE FOR ISZ
+ DCA CNT
+ TAD FPAGE /WE ARE GOING TO PACK DIRECTORY
+ TAD (200 /RIGHT UP TO INPUT HANDLER SO
+ TAD CNT /WE GET MAX SIZE TRANSFER BUFFER
+ DCA FPAGE /ADJUSTED FREE CORE POINTER
+ CMA
+ TAD FPAGE
+ DCA XR1 /SET UP PLACE TO MOVE TO
+ CMA
+ DCA XR2 /ALWAYS COMES FROM 0
+ TAD I XR2 /MOVE
+ DCA I XR1 /IT
+ ISZ CNT
+ JMP .-3
+\f/SET SAME DEVICE FLAG FLAG 4000 IF /D
+
+ CDF 10
+ TAD I (OPT1
+ AND (400
+ RTL CLL /PUT /D BIT INTO AC 0
+ RAL
+ DCA SDFLG
+
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+/ALSO MAKE NULL INPUT FILENAMES *.*
+/BUT ONLY IF NOT /D
+
+ TAD INFPTR /OK LETS GO THROUGH
+ DCA PTR /THE INPUT SPECIFICATIONS
+GETCNT, ISZ PTR /POINT TO FILENAME WORD
+ TAD (3 /SET TEMP TO POINT TO EXTENSION
+ TAD PTR
+ DCA TEMP
+ TAD SDFLG /ARE WE DOING /D
+K7450, SNA /SKIP IF YES - AC NON 0
+ TAD I PTR /NO /D - LOOK AT FILENAME
+ SZA CLA /ITS NULL PUT IN *.*
+ JMP NOSUB /DONT CHANGE IT
+ TAD (5200 /MAKE IT *
+ DCA I PTR
+ TAD (5200 /.*
+ DCA I TEMP
+NOSUB, CLA IAC /TEMP+1 POINTS TO NEW INPUT
+ TAD TEMP
+ DCA PTR
+/NOTE CNT WAS SET BY ISZ'ING TO ZERO
+ ISZ CNT /KEEP COUNT OF DEVICES IN GROUP
+ TAD I (OPT2 /CHECK FOR /U (UGLY SWITCH)
+ AND (10
+ SZA CLA /SKIP IN NO /U
+ JMP NOPTIM /WERE FORCED TO DO ONE AT A TIME
+ TAD I PTR /COMPARE DEVICE NUMBERS
+ CIA /IN A GROUPING
+ TAD I INFPTR
+ SNA CLA /SKIP IF NEW GROUP
+ JMP GETCNT /WE'LL DO ALL THE SAME AT ONCE
+NOPTIM, TAD CNT
+ CIA /NEGATE COUNT
+ DCA INSCNT /AS NUMBER OF INPUTS TO DO AT ONCE
+ TAD PTR /SAVE WHERE TO CONTINUE FOR REST
+ DCA I (MOIN
+\f/THE FOLLOWING CHECKS TO SEE IF A OPERATION
+/IS BEING DONE FROM A DEVICE TO ITSELF
+
+ TAD I (7600 /GET DEVICE NUMBER
+ TAD (7646 /HANDLER ENTRY POINT TABLE
+ DCA TEMP
+ TAD I INFPTR /GET INPUT ENTRY POINT
+ TAD (7646
+ DCA PTR
+ TAD I PTR /CHECK INPUT ENTRY POINT AGAINST
+ CIA
+ TAD I TEMP /OUTPUT ENRTY POINT
+ SNA CLA /SKIP IF THEY ARE DIFFERENT
+ ISZ SDFLG /SET SAME DEVICE FLAG, AC11
+ TAD FPAGE /SET POINTER TO
+ DCA BDPTR /START OF DIRECTORY
+ DCA TYPFND /CLEAR FOUND FILE FLAG
+ JMP I (NBLOCK /LINK TO SOME MORE
+
+TYPFND, 0
+SDFLG, 0 /NEGATIVE MEANS /D, ODD MEANS OUTPUT DEV=INPUT DEV
+
+NFIN, JMS I (ERROR
+ NFLEIN+40 /NON FILE STRUCTED INPUT
+INDERR, JMS I (ERROR
+ BADIRD+40 /ERROR READING INPUT DIR
+BIDIR, JMS I (ERROR
+ BIDIRM+40 /NOT A GOOD DIRECTORY
+
+ PAGE
+\f/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK, STA
+ TAD BDPTR /POINTER TO START OF DIR BLOCK
+ DCA XR
+ CDF 0
+ TAD I XR /GET COUNT OF NUMBER OF ENTRIES
+ DCA ENTCNT /SAVE LOCALLY TO AVOID HERB'S BUG
+ TAD I XR /GET BLOCK NUMBER FIRST FILE
+ DCA BLOCK
+ TAD I XR /NEXT SEGMENT NUMBER
+ DCA LFLAG /IF IT 0 WE AT END
+ ISZ XR /SKIP TENTATIVE FILE WORD
+ TAD I XR /GET -NUMBER OF INFO WORDS
+ CIA /MAKE POSITVE
+ DCA INFWDS
+ TAD XR /POINT TO FIRST
+ IAC /ENTRY
+ DCA EPTR
+
+BLOOP, TAD I EPTR /GET FILENAME WORD
+ CDF 10
+ SNA CLA /SKIP IF FILE HERE
+ JMP EMPTY /NO... ITS REALLY AN EMPTY
+ TAD INSCNT /SET NUMBER OF INPUT TO LOOK
+ DCA NCNT /AT ALL AT ONCE
+ DCA MATFLG /CLEAR MATCH FLAG
+ TAD INFPTR /ADDRESS OF FIRST INPUT
+ SKP
+MN1, TAD GPTR2 /ADDRESS OF CURRENT INPUT
+ TAD (5 /GTSXBT SUBR REQUIRES US TO
+ DCA GPTR2 /POINT TO END OF FIELD
+ TAD EPTR /POINT DIRECTORY POINTER TO
+ TAD (4 /END OF ENTRY FOR SAME REASON
+ DCA GPTR1
+ TAD GPTR1 /SET EPNEXT TO POINT TO
+ TAD INFWDS /MINUS NUMBER OF BLOCKS IN
+ DCA EPNEXT /FILE WORD
+ TAD (-10 /NUMBER OF CHARS TO LOOK AT
+WILDNM, DCA CNT
+\fMLP, TAD GPTR2 /OK - GET A CHARACTER FROM
+ JMS I (GTSXBT /STRING
+ TAD (-"*!7700 /IS IT AN *
+ SNA /SKIP IF NOT *
+ JMP WILDA /YEP... ITS A WILD CARD
+ TAD ("*-"? /IS IT A ?
+ SNA /SKIP IF NOT
+ JMP WILD /YES... FORCE MATCH ON THIS CHAR
+ TAD ("?&77 /RESTORE VALUE
+ CIA /NEGATE
+ DCA CHAR /AND SAVE
+ TAD GPTR1 /NOW GET CHAR FROM DIRECTORY
+ CDF 0
+ JMS I (GTSXBT
+ CDF 10
+ TAD CHAR /DO CHARS MATCH
+ SZA CLA /SKIP IF THEY DO
+ JMP NM1 /NO MATCH ON THIS INPUT
+WILD, ISZ CNT /BUMP COUNT OF CHARS & POINTER
+ JMP MLP /COMPARE ALL 8
+MEXT, ISZ MATFLG /A MATCH!!!!!!!
+NM1, CLA /WILD CARD COMES HERE WITH ICHY AC
+ ISZ NCNT /HAVE WE CHECKED GROUP OF INPUTS
+ JMP MN1 /NO CHECK WHOLE GROUP
+ TAD MATFLG /HAVE THERE BEEN ANY MATCHES
+ SZA CLA /SKIP IF NOT
+ TAD (4 /WILL INVERT /V SWITCH
+ TAD I (OPT2 /ADD SWITCH
+ AND (4 /ISOLATE IT
+ CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+ SZA CLA
+ TAD I EPNEXT /GET -NUMBER OF BLOCKS
+ CDF 10
+ SZA /SKIPS IF TENTATIVE OR NOT CANDIDATE
+ JMP I (GOT1 /PROCESS FILE
+NENT, TAD EPNEXT /POINT EPTR TO BLOCK
+ DCA EPTR /COUNT OF FILE
+ SKP
+EMPTY, ISZ EPTR /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+ CDF 0
+ TAD I EPTR /GET BLOCK COUNT
+ CIA /MAKE POSITIVE
+ TAD BLOCK
+ DCA BLOCK /KEEP SUM
+ ISZ EPTR /POINT TO NEXT ENTRY
+ ISZ ENTCNT /BUMP THE NUMBER OF ENTRIES
+ JMP BLOOP /NOT DONE WITH SEGMENT
+ CDF 10
+ TAD (400 /BUMP TO NEXT SEGMENT
+ TAD BDPTR
+ DCA BDPTR
+ TAD LFLAG /DID WE PROCESS LAST SEGMENT
+ SZA CLA /SKIP IF WE DID
+ JMP NBLOCK /PROCESS NEW SEGNENT
+ TAD I (SFUDG /RESET FREE CORE POINTER
+ DCA FPAGE /TO PRESERVE INPUT HANDLER IF PRESENT
+ JMP I (SAYNON
+
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT /GET CURRENT CHAR POSITION
+ TAD (6 /ADD SIZE OF FILENAME
+ SPA /SKIP IF IN EXTENSION FIELD
+ JMP WILDNM /THIS BUMPS TO EXTENSION
+ JMP MEXT /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR, 0
+EPNEXT, 0
+GPTR2, 0
+LFLAG, 0
+NCNT, 0
+BLOCK, 0
+MATFLG, 0
+ENTCNT, 0
+
+
+ PAGE
+\fGOT1, DCA IFCNT /-# OF BLOCKS IN AC
+ JMS I (DATCHK /VERIFY IF /C OR /O ALSO MATCH
+ ISZ I (TYPFND /COMES BACK IF THEY DO -
+ /TURN OFF NO FILES MSG FOR THIS INPUT GROUP
+ TAD I (OPT2 /CHECK FOR /T
+ AND (20
+ SNA CLA /SKIP IF /T
+ TAD INFWDS /SEE IF DATE PRESENT
+ CDF 0
+ SZA CLA /SKIP IF NO DATE OR /T
+ TAD I GPTR1
+ CDF 10
+ SZA /SKIP IF NO DATE OR /T
+ DCA I (DATE /GIVE MONITOR FILES DATE
+ TAD (-4 /MAKE 2 COPIES
+ DCA CNT /OF THE INPUT
+ CMA /FILE NAME IN
+ TAD EPTR /FIELD 1 TO
+ DCA XR /WORK WITH THEM
+ TAD (SPOT-1 /MAKE THEM AT SPOT
+ DCA XR1 /AND SPOT1
+ TAD (SPOT1 /SPOT1 WILL ALWAYS
+ DCA PTR /CONTAIN THE ORIGINAL
+MOVENT, CDF 0 /AND SPOT WILL
+ TAD I XR /CONTAIN THE
+ CDF 10 /UPDATED VERSION AS
+ DCA I PTR /REFLECTED FROM
+ TAD I PTR /THE OUTPUT SPECIFICATION
+ ISZ PTR /-
+ DCA I XR1 /-
+ ISZ CNT /-
+ JMP MOVENT /-
+ TAD I (7601 /GET OUTPUT FILENAME
+ TAD (-5200 /WAS IT *
+ SNA CLA /SKIP IF NOT
+ JMP TSTEXT /YES... LEAVE FILENAME ALONE
+ TAD I (7601 /REPLACE INPUT NAME
+ DCA I (SPOT /WITH GIVEN
+ TAD I (7602 /OUTPUT
+ DCA I (SPOT+1 /SPECIFICATION
+ TAD I (7603
+ DCA I (SPOT+2 /-
+TSTEXT, TAD I (7604 /SEE IF EXTENSION
+ TAD (-5200 /WAS *
+ SNA CLA /SKIP IF IT WASNT
+ JMP .+3 /LEAVE INPUT DEFAULT ALONE
+ TAD I (7604 /REPLCE EXTENSION
+ DCA I (SPOT+3 /WITH GIVEN EXTENSION
+ DCA TRFLG /CLEAR THE TRANSFER FLAG
+ TAD I (OPT2 /IS /R ON?
+ AND (100
+ TAD I (SDFLG /OR /D OR INPUT DEV=OUTPUT DEV?
+ SNA /SKIP IF ANY
+ JMP SETGD /WE ARE DEFINITELY OK
+ SMA CLA /IF /D THEN CHECK OUTPUT
+ TAD (SPOT1-SPOT /OTHERWISE INPUT
+ JMS I (LOOKUP
+ JMP NSETGD /NO OUTPUT FILE GIVEN
+ SNA /AC=BLOCK NO OF FILE OR 0 IF NONE
+ JMP I (NENT /NO FILE - DO NOTHING
+ DCA TEMP /SAVE - WE MIGHT NEED IT
+ TAD I (SDFLG /IF OPERATION IS TRANSFER THEN
+ /TRFLG IS SET IF FILE HAS NOT
+ /MOVED; IF /D TRFLG MUST NOT BE
+ /SET ; WE DONT CARE ABOUT
+ /RENAME - ITS IRRELEVANT.
+ SMA CLA /SKIP IF /D- WILL CAUSE TRFLG=0
+ TAD TEMP /GET THE BLOCK FILE IS NOW AT
+ CIA /CHECK AGAINST ORIGINAL
+ TAD I (BLOCK /LOCATION
+ SNA CLA /SKIP IF IT MOVED - NOTE THAT
+ /IF THIS SKIPS THE USER IS DOING
+ /A PLAY WITH DEATH OPERATION
+SETGD, ISZ TRFLG /ENABLE TRANSFERING OF THE FILE
+NSETGD, TAD I (SDFLG /SET UP TO PROMPT OR LIST
+ SPA CLA /SKIP IF NOT /D
+ TAD (SPOT-SPOT1 /USE OUTPUT NAME
+ TAD (SPOT1+4 /USE INPUT NAME
+ JMS I (PRINTE /SEE IF HE WANTS TO BE PROMPTED
+FLSRSM, TAD I (OPT2
+ RTL /PUT /N INTO LINK
+ AND (400 /ISOLATE /R OPTION
+ SZA CLA /SKIP IF NOT /R
+ JMP I (RENAME /GO TO RENAME CODE
+ TAD I (SDFLG /CHECK FOR NO /D AND SAME DEV
+ SPA SNA CLA /SKIP IF NO /D AND SANE DEV
+ TAD I (7600 /IS THERE AN OUTPUT?
+ SNA SZL /SKIP IF NO /N AND OUTPUT DEV
+ /DIDNT SKIP IF NO /D AND SAME DEVICE
+ JMP NODEL /DONT DELETE
+ JMS I (FAKUSR /FAKE USR HANDLER CALLS
+ JMS I (200 /CALL USR
+ 4 /CLOSE
+ SPOT /OUTPUT FILE NAME
+ 0
+ CLA SKP /O.K. TO GET CLOSE ERROR NOW
+ ISZ I (WRTDIR /SIGNAL CHANGE MADE TO DIRECTRY
+ JMS I (UNFAK /FIXUP HANDLER ADDRESS AGAIN
+NODEL, CLA
+ TAD TRFLG /SET AC NOT 0 IF TRANSFER GO AHEAD
+ JMP I (NPG /LINK TO SOME MORE
+
+TRFLG, 0
+
+
+ PAGE
+\f/THIS PAGE OF CODE PERFORMS FILE MOVES FROM
+/INPUT TO OUTPUT
+
+NPG, SNA CLA /SKIP IF WE CAN DO TRANSFER
+ JMP NFUNCT /GO PROCESS NEXT ENTRY
+
+/THE FOLLOWING SMALL STRANGE PIECE OF CODE
+/DYNAMICALLY ALLOCATES THE BUFFER ACCORDING
+/TO THE FREE SPACE IN FIELD 0 (INCLUDING
+/DIRECTORY SHRINKING) OR ALLOCATES 15 BLOCKS
+/IN FIELD 2 IF ITS AVAILABLE.
+
+F2C1, TAD (7400 /BECOMES TAD EPTR IF ONLY 8K
+ AND (7400 /CALCULATE FREE SPACE
+ RAL CLL /SIZE
+ RTL /AND SAVE
+ RTL /IT
+ DCA BUFSIZ
+ TAD IFCNT /SET THE OUTPUT
+ CIA /FILE COUNT
+ DCA OFCNT /AS POSITIVE NIMBER OF BLOCKS
+ TAD OFCNT /SET THE NUMBER
+ AND (7400 /OF BLOCKS
+ SNA CLA /UP FOR ENTER
+ TAD OFCNT /IF IT IS LESS
+ RTL CLL /THAN 256 OR
+ RTL /SET IT TO 0
+ DCA TEMP /FOR FILES GREATER THAN 256
+ TAD (SPOT /SET THE ADDRESS OF THE
+ DCA SBLKN /OUTPUT NAME
+ TAD I (7600 /IS THERE AN OUTPUT FILE?
+ SNA /SKIP IF THERE IS
+ JMP NFUNCT /DO NO TRANSFER
+ TAD (7757 /INDEX INTO TENTATIVE FILE
+ DCA MSIZE /TABLE IN ORDER TO
+ TAD I MSIZE /CLEAR OUT ANY
+ AND (7770 /TENTATIVE WE DONT WANT
+ DCA I MSIZE /THIS COMES IF AN I/O ERROR HIT
+ TAD I (7600 /DO THE ENTER
+ JMS I (FAKUSR /MAKE USR USE IN CORE HANDLER
+ TAD TEMP /ADD IN BLOCK COUNT
+ JMS I (200
+ 3 /ENTER
+SBLKN, SPOT
+MSIZE, 0
+ JMP I (NOROOM /ENTER FAILED
+ TAD I (SVDATE /RESTORE REAL DATE TO MONITOR
+ DCA I (DATE
+ JMS I (UNFAK /REMOVE OUR FAKE HANDLER
+ JMS I (ADDINF /COPY ADDITIONAL INFO WORDS
+ TAD IFCNT /SEE IF ENTER SIZE
+ STL CIA /GIVEN BACK IS
+ TAD MSIZE /ENOUGH - HANDLES >255 AND
+ SNL SZA CLA /NON FILE STRUCTURED
+ JMP I (NOROOM /LENGTHS. NOT ENOUGH
+ DCA INEOF /CLEAR INPUT END OF FILE
+ TAD SBLKN /SET THE OUTPUT BLOCK NUMBER
+ DCA OBLCKN
+ TAD I (BLOCK /SET THE INPUT BLOCK NUMBER
+ DCA BLOCKN
+
+\f/THE FOLLOWING PIECE OF CODE IS A TRICKY PIECE
+/THAT CALCULATES THE NUMBER OF BLOCKS TO READ
+
+MOVEIT, TAD IFCNT /GET THE NUMBER OF BLOCKS
+ CLL /ITS NEGATIVE
+ TAD BUFSIZ /ADD ON BUFFER SIZE
+ SNL /SKIP IF MORE ROOM AVAILABLE THAN NEEDED
+ DCA IFCNT /OTHERWISE RESAVE NEW COUNT
+ SZL /SKIP IF NOT AT END OF FILE
+ ISZ INEOF /SET END OF FILE INDICATOR
+ CIA /MAKES -BUFSIZ+COUNT
+ TAD BUFSIZ /MAKES COUNT OF NUMBER OF BLOCK
+ RTR CLL /BUILD THE
+ RTR /INPUT CONTROL
+ RTR /WORD
+F2C2, TAD (20 /BECOMES NOP IF ONLY 8K
+ DCA INCTLW /SET INPUT CONTROL WORD
+ JMS I (CINTER /CHECK FOR ^C
+ SKP /SKIP IF NOT
+ JMP I (CTCDE /ABORT OPERATION
+ CIF 0
+ JMS I INHAND /READ INPUT HUNK
+INCTLW, 0
+ 0
+BLOCKN, 0
+ JMP I (RDERR /WELL- SCRATCH THAT FILE
+ TAD BLOCKN /UPDATE BLOCK COUNT
+ TAD BUFSIZ
+ DCA BLOCKN
+ AC4000 /SET THE OUTPUT
+ TAD INCTLW /CONTROL WORD
+ DCA OUCTLW
+ JMS I (CINTER /CHECK FOR ^C
+ SKP /SKIP IF NOT
+ JMP I (CTCDE /ABORT OPERATION
+ ISZ I (MUSTWT /SIGNAL REAL OUTPUT DONE
+ CIF 0
+ JMS I OUHAND /WRITE A HUNK OF FILE
+OUCTLW, 0
+ 0
+OBLCKN, 0
+ JMP I (WRTERR /WHAT A CRUMBY OUTPUT DEVICE
+ TAD OBLCKN /UPDATE THE
+ TAD BUFSIZ /OUTPUT FILE
+ DCA OBLCKN /BLOCK NUMBER
+ TAD INEOF /SEE IF THATS ALL FOLKS
+ SNA CLA /SKIP IF WE TRANSFERED FILE
+ JMP MOVEIT /DO SOME MORE
+ TAD I (7600 /OK - LETS MAKE IT PERMANENT
+ JMS I (FAKUSR /TELL USR TO USE INCORE HANDLER
+ JMS I (200
+ 4 /CLOSE
+ SPOT
+OFCNT, 0
+ JMP I (CLOERR /THIS IS IMPOSSIBLE (I HOPE)
+ JMS I (UNFAK /ENABLE SYSTEM USE OF REAL HANDLER
+ ISZ I (WRTDIR /SET WE CHANGED DIRECTORY FLAG
+NFUNCT, JMP I (NENT /I KNOW ITS INEFFICIENT TO JUMP HERE
+ /BUT- IT'S CLEAN...
+ PAGE
+\f/HERE COMES GOBBS AND GOBBS OF GOODY LITTLE ROUTINES
+
+/FIRST WE HAVE A NICE LITTLE ROUTINE WHICH WILL DO
+/HANDY LITTLE THINGS LIKE FETCH A HANDLER
+/AND IN ADDITION ALLOCATE THE SPACE FOR IT.
+/JUST IMAGINE THIS CAN BE YOURS FOR THE LOW LOW PRICE
+/OF 23 INSTRUCTIONS
+
+ASSIGN, 0
+ DCA TEMP /SAVE DEVICE NUMBER
+ TAD TEMP
+ JMS I (200
+ 12 /INQUIRE ABOUT HANDLER
+HADDR1, 0
+ JMP I (CLOERR /CANT HAPPEN (I HOPE)
+ TAD HADDR1 /DID WE GET BACK ADDRESS
+ SZA /SKIP IF NOT- NON-RESIDENT
+ JMP I ASSIGN /YES... RETURN ITS ENTRY POINT
+ SKP
+TWOPAG, IAC /TURN ON 2-PAGE BIT
+ TAD FPAGE /GET FREE SPACE POINTER
+ DCA HADDR2 /SET FOR FETCH
+ TAD FPAGE /TAKE AWAY
+ TAD (-200 /PAGE FROM
+ DCA FPAGE /FREE SPACE
+ TAD TEMP /GET DEVICE NUMBER
+ JMS I (200
+ 1 /FETCH
+HADDR2, 0
+ JMP TWOPAG /FAILED- MUST BE 2-PAGER
+ TAD HADDR2 /RETURN ENTRY POINT ADDRESS
+ JMP I ASSIGN
+\f/THIS UTILITY ROUTINE RETURNS A SIS BIT
+/CHARACTER FROM ANY FIELD (SET ON ENTRY)
+/FROM ADDRESS IN AC-COUNT(IN HALF WORDS)
+
+GTSXBT, HLT
+ CLL RAL /DOUBLE POINTER ADDRESS
+ TAD CNT /ADD NEGATIVE DISPLACEMENT
+ CML RAR /GET WORD ADDRESS AGAIN
+ DCA TEMP /SAVE IT
+ TAD I TEMP /GET WORD
+ SNL /SKIP IF WE WANT RIGHT HALF
+ JMS ROTR6 /MAKE LEFT HALF RIGHT HALF
+ AND (77 /GET LOW SIX BITS
+ JMP I GTSXBT
+
+
+ROTR6, 0
+ RTR
+ RTR
+ RTR
+ JMP I ROTR6
+
+/THIS TAKES A SIX BIT CHAR IN AC AND CONVERTS
+/IT TO ASCII TO TYPE IT
+
+CONVTP, HLT
+ SZA /CONVERT 0 TO BLANKS
+ TAD (240
+ AND (77
+ TAD (240
+ JMS I (TYPE /TYPE IT
+ JMP I CONVTP
+\f/TYPE TAKES A CHARACTER IN THE AC AND CALLS
+/TTY TO TYPE IT IF ^O IS NOT IN AFFECT
+/ALSO CHECKS FOR ^C AND ^P
+
+TYPE, HLT
+ DCA READKB /SAVE CHARACTER
+ JMS I (CINTER /SEE IF ^C
+ SKP /NO
+ JMP I (CTCDE /ABORT OPERATION IF ^C OR ^P
+ TAD (217 /^O
+ JMS I (CTYPE /SEE IF TYPED
+ SKP /SKIP IF NOT
+ DCA ECHO /CLEAR ECHO SWITCH
+ TAD ECHO /IS ECHO IN EFFECT
+ SNA CLA /SKIP IF YES
+ JMP I TYPE /IGNORE CHARACTER IF ^O
+ TAD READKB /TYPE CHAR
+ JMS TTY
+ JMP I TYPE
+
+TTY, 0
+ DCA TCHAR /SAVE CHAR
+ TAD TCHAR /GET CHAR BACK
+ /** NEXT 4 LOCATIONS REPLACED IF BATCH ACTIVE BY:
+TTYOUT, TLS /** SKP
+ TSF /** 7400 /ADDRESS OF BATCH OUTPUT ROUTINE
+ JMP .-1 /** CIF TOPFIELD
+ CLA /** JMS I .-2
+ TAD TCHAR /GET CHAR AGAIN
+ TAD (-215 /IF WE JUST TYPED A C.R. TYPE
+ SZA CLA /A L.F.
+ JMP I TTY
+ TAD (12
+ JMP TTY+1
+TCHAR, 0
+
+/GET A CHARACTER FROM KEYBOARD AND
+/CHECK FOR ^C AND ^P
+
+READKB, HLT
+ KSF
+ JMP .-1
+ JMS I (CINTER /IS IT ^C
+ SKP /SKIP IF NOT
+ JMP I (CTCDE /YES
+ KRB /READ IT
+ AND (177 /AND GET RID OF
+ TAD (200 /PARITY
+ JMP I READKB
+\f/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK, 0
+ TAD I (OPT1 /CHECK /C
+ JMS MDATE
+ NOP /RETURN HERE WITH AC=0 IF NO /C
+ SZA CLA /RETURN HERE WITH AC=0 IF DATES MATCH
+ JMP I (NENT /DATES DONT MATCH AND /C GIVEN
+ TAD I (OPT2 /CHECK /V
+ JMS MDATE
+ CMA CLA /SET AC=-1 IF NO /V
+ SNA CLA /RETURN HERE AC=0 IF DATES SAME
+ JMP I (NENT /DATES SAME WITH /V-IGNORE FILE
+ JMP I DATCHK /CONTINUE
+
+MDATE, 0 //O AND /V ARE AC2
+ RTL /IS IT OPTION ON?
+ SMA CLA /SKIP IF IT IS
+ JMP I MDATE /NO- RETURN WITH 0 AC
+ ISZ MDATE /SKIP RETURN
+ CDF 0
+ TAD I GPTR1 /GET DATE WORD
+ CIA
+ CDF 10
+ TAD I (SVDATE /COMPARE WITH MONITORS, 0 IF =
+ JMP I MDATE
+
+ECHO, 1
+
+
+ PAGE
+\f/THIS IS THE CORE DEVICE HANDLER
+/THE USR IS MADE TO COME HERE BY A CALL TO FAKUSR.
+/THIS HANDLER SWAPS THE DESIRED BLOCK INTO
+/THE USR AREA AND WRITES THE BLOCK BACK INTO THE
+/INCORE DIRECTORY.
+
+/THE CODE SET UP IN FIELD 0 TO CALL THE HANDLER IS:
+/ *FAKHND
+/ 0 /ENTRY POINT
+/ TAD FAKHND /GET RETURN ADDRESS
+/ CIF CDF 10
+/ JMP I .+1 /PLOP UP TO BODY OF HANDLER IN FIELD 1
+/ FAKBDY
+
+
+FAKBDY, DCA RETLOC /SAVE ARGUMENT ADDRESS
+ TAD I RETLOC /GET CONTROL WORD
+ RAL /R/W BIT INTO LINK
+ CLA RAL /R/W BIT INTO AC11
+ TAD DCAXR1 /IF WRITE MAKE DCA XR2 ELSE XR1
+ DCA DCASPT /SAVE WHERE WE NEED IT
+ ISZ RETLOC /BUMP TO LOCATION (ALWAYS 1400 FROM USR)
+ ISZ RETLOC /BUMP TO BLOCK NUMBER
+ TAD I RETLOC /GET IT
+ ISZ RETLOC /BUMP TO ERROR RETURN
+ ISZ RETLOC /NOW TO GOOD RETURN (WE WONT FAIL)
+ CLL RTR /MULTIPLY BY 400(8)
+ RTR
+ RAR
+ TAD (4177 /ADD ON TO BEGINING OF DIRECTRY
+DCAXR1, DCA XR1 /SAVE IN BOTH XR1
+ TAD XR1
+ DCA XR2 /AND XR2
+ TAD (1377 /NOW SAVE USR BLOCK AREA
+DCASPT, HLT /IN EITHER XR1 OR XR2 (R OR W)
+ TAD (-400 /SET WORD TRANSFER COUNT
+ DCA CNT
+ TAD I XR2 /GET A WORD
+ DCA I XR1 /PUT A WORD
+ ISZ CNT
+ JMP .-3
+ JMP I RETLOC /GO BACK TO USR
+\f/THIS ROUTINE DOES THE SETUP OF THE INCORE
+/DIRECTORY HANDLER AND CHANGES THE REAL
+/HANDLERS ENTRY POINT IN THE MONITOR SO THAT
+/THE USR WILL CALL IT.
+
+FAKUSR, 0
+ DCA UNFAK /SAVE DEVICE NUMBER
+ TAD UNFAK /INDEX INTO MONITORS RESIDENCY
+ TAD (7646 /TABLE
+ DCA TABAD
+ TAD WRTDIR /SEE IF DEVICE HAS DIRECTORY
+ SPA CLA /SKIP IF IT DOES
+ JMP NOSUBST /!!!DONT CHANGE IF NON-FILE DEV
+ TAD (FAKHND /PUT OUR HANDLERS ADDRESS IN
+ DCA I TABAD /MONITORS TABLE
+NOSUBST,CDF 0
+ TAD (1200 /PUT IN HANDLER INTERFACE CODE
+ DCA I (FAKHND+1 /INTO FIELD 0 AS GIVEN ABOVE
+ TAD (CIF CDF 10
+ DCA I (FAKHND+2
+ TAD (5604
+ DCA I (FAKHND+3
+ TAD (FAKBDY
+ DCA I (FAKHND+4
+ CDF 10
+ TAD UNFAK /RETURN WITH DEVICE NUMBER IN AC
+ JMP I FAKUSR
+
+UNFAK, 0
+ CLA /V3C
+ TAD OUHAND /RESET MONITORS TABLE TO
+ DCA I TABAD /POINT TO REAL HANDLER
+ DCA TABAD /V3C
+ JMP I UNFAK
+
+TABAD, 0
+RETLOC, 0
+\f/ENTER HERE IF A BRANCH TO 7600 OR 7605 OCCURS
+
+FIXDIR, JMS UNFAK /JUST IN CASE
+ JMS I (CINTER /CHECK FOR ^C
+ NOP
+ AC4000 /EITHER WAY GO BACK TO
+ DCA I (ALTOPT /MONITOR BUT AFTER WE HANDLE DIRECTORY
+CTCDE, TAD MUSTWT /IS MUST WRITE SET?
+ SNA CLA /SKIP IF /Q OR MUST WRITE
+ TAD WRTDIR /CHECK TO SEE IF WE HAVE TO
+ SPA SNA CLA /WRITE THE DIRECTORY
+ JMP ENDCHK /CONTINUE
+ DCA WRTDIR /KEEP OLD DIRECTORY
+ JMS I (ERROR /TELL HIM
+ DSVED+40
+
+ENDCHK, ISZ I (ECHO /TURN ON ECHO
+ JMS DIROUT /WRITE OUT THE OUTPUT DIRECTORY
+ JMS I (RESTORE /RESTORE 7600 IN FIELD 0
+ TAD I (OPT2 /GET OPTION /W
+ RTR
+ SNL CLA /SKIP FOR VESION NUMBER
+ JMP NOVER
+ DCA I (OPT2 /STOPS RECUSION WITH ^P
+ JMS I (ERROR /PRINT VERSION NUMBER
+ VERNO+40
+ TAD (215
+ JMS I (TYPE
+NOVER, TAD I (ALTOPT /GO BACK TO MONITOR?
+ SMA CLA /SKIP IF YES
+ JMP I (CDCALL /CALL THE CD AGAIN
+ CIF CDF 0 /RETURN TO MONITOR
+ JMP I (7605
+
+
+MUSTWT, 0
+SVDATE, 0
+WRTDIR, 0
+\fDIROUT, 0 /ROUTINE TO WRITE THE OUTPUT DIRECTORY
+ TAD WRTDIR /AC>0 IF WE HAVE TO WRITE IT
+ SPA SNA CLA /SKIP TO WRITE DIRECTORY
+ JMP I DIROUT
+ CIF 0
+ JMS I OUHAND /WRITE DIRECTORY BACK ONTO DEVICE
+ 5410
+ 4600
+ 1
+ JMP I (ODERR /IS HE IN TROUBLE...
+ DCA WRTDIR /CLEAR WRITE DIRECTORY FLAG
+ JMP I DIROUT /RETURN
+ PAGE
+\f/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF
+/ONE WE WANTED
+
+CTYPE, 0
+ DCA T2 /SAVE CHARACTER
+ TAD (200 /GT RID OF PARITY
+ KRS /SEE WHATS IN BUFFER
+ CIA
+ TAD T2 /COMPARE AGAINST DESIRED ONE
+ SNA CLA /SKIP IF NOT ONE
+ KSF /IS FLAG UP?
+ JMP I CTYPE /NO... JUST RETURN
+ KCC /CLEAR CHARACTER
+ TAD ("^ /OUTPUT ^
+ JMS I (TTY
+ TAD T2
+ TAD (100 /CHAR
+ JMS I (TTY
+ TAD (215
+ JMS I (TTY
+ ISZ CTYPE /SKIP RETURN
+ JMP I CTYPE
+
+T2, 0
+
+/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED
+
+CINTER, 0
+ TAD (203 /CHECK FOR ^C
+ JMS CTYPE
+ JMP UPPCK /NO CHECK FOR ^P
+ JMP SPURGE /YES SET ALTMODE BIT
+UPPCK, TAD (220
+ JMS CTYPE
+ JMP I CINTER /NOT EITHER ^P OR ^C
+ SKP /IF ^P CLEAR ALTMODE BIT
+SPURGE, CMA /SET BIT
+ DCA I (ALTOPT
+ ISZ CINTER /SKIP RETURN
+ JMP I CINTER
+\f/THIS ROUTINE MODIFIES THE THE MONITOR RETURN
+/LOCATIONS TO COME BACK TO FOTP AND SAVES WHAT
+/WAS THERE SO RESTORE CAN RESTORE THEM
+
+INTERC, 0
+ TAD I (DATE
+ DCA I (SVDATE /SAVE MONITOR DATE
+ CDF 0
+ TAD I (7600 /SAVE 7600,7601,7602,7605
+ DCA SCODE /AND REPLACE WITH
+ TAD (CIF CDF 10 /CIF CDF 10
+ DCA I (7600 /JMP I .+1
+ TAD I (7601 /FIXDIR
+ DCA SCODE+1 /7605 GETS JMP 7600
+ TAD (5602 /THIS ENABLES FOTP TO WRITE
+ DCA I (7601 /OUT DIRECTORY AN MANUAL ABORT
+ TAD I (7602 /OR IF HANDLER PICKS UP ^C
+ DCA SCODE+2 /AND TRIES TO GO TO MONITOR
+ TAD (FIXDIR
+ DCA I (7602
+ TAD I (7605
+ DCA SCODE+3
+ TAD (5200
+ DCA I (7605
+ CDF 10
+ JMP I INTERC
+
+/THIS ROUTINE SIMPLY RESTORES THE MONITOR
+/LOCATIONS TO THEIR ORIGINAL VALUE
+
+RESTORE,0
+ TAD I (SVDATE /RESTORE DATE
+ DCA I (DATE
+ CDF 0
+ TAD SCODE
+ DCA I (7600 /RESTORE LOCATIONS
+ TAD SCODE+1
+ DCA I (7601
+ TAD SCODE+2
+ DCA I (7602
+ TAD SCODE+3
+ DCA I (7605
+ CDF 10
+ JMP I RESTORE
+
+SCODE, 0;0;0;0
+\f/THIS IS THE MAGIC MESSAGE PRINTER
+/IT IS ACTUALLY USED MORE THAN JUST FOR ERROR MESSAGES
+/IF THE MESSAGE ENDS WITH A % THEN THE OPERATION
+/IS ABORTED OTHERWISE CONTROL IS RETURNED
+/TO THE CALLER AND NO CRLF IS GIVEN
+/ALL MESSAGES COMMING THROUGH HERE ARE ECHOED
+
+ERROR, 0
+ CLA CLL /JUNK MIGHT BE IN AC
+ TAD I (ECHO /SAVE ECHO STATUS SO WE CAN
+ DCA I (ECTMP /RESTORE IT AFTER MESSAGE
+ ISZ I (ECHO /TURN ON ECHO
+ TAD (-100 /USED SO WE CAN USE GTSXBT TO
+ DCA CNT /UNPACK THE MESSAGES
+PLOOP, TAD I ERROR /CONTAINS ADDRESS OF MESSAGE
+ CDF 0 /IN FIELD 0
+ JMS I (GTSXBT /GET CHARACTER
+ CDF 10
+ TAD (-45 /IS IT %
+ SNA /SKIP IF NOT
+ JMP CRLF /WE HIT EOM AND CALLER NO WANT CONTROL
+ TAD ("%&77 /RESTORE CHARACTER
+ DCA DFLAG /SAVE IT FOR LATER
+ TAD DFLAG /PRINT IT, 0 PRINTS AS BLANK
+ JMS I (CONVTP
+ ISZ CNT /BUMP TO NEXT CHAR IN MESSAGE
+ TAD DFLAG /ARE WE AT END
+ SZA CLA /SKIP IF WE ARE
+ JMP PLOOP /DO ANOTHER CHARACTER
+ ISZ ERROR /SKIP ADDRESS OF MESSAGE
+ JMP I ERROR /RETURN
+CRLF, TAD (215 /PRINT CR
+ JMS I (TYPE /LF
+ JMP I (ENDCHK /FINISH PROCESSING
+
+DFLAG, 0
+ PAGE
+\f/THIS ROUTINE PRINTS A FILENAME.EXTENSION
+
+PNMSUB, 0
+ DCA NMEPLC /SAVE ADDRESS OF NAME
+ TAD (-10 /SET CHAR COUNT
+ DCA CNT
+PNLOOP, TAD NMEPLC /GET THE SIXBIT CHAR
+ JMS I (GTSXBT
+ SZA /SKIP IF NULL CHAR
+ JMS I (CONVTP /PRINT CHAR
+ TAD (3 /SEE IF AT START OF
+ TAD CNT /EXTENSION
+ SZA CLA /SKIP IF SO
+ JMP .+3
+ TAD (". /PRINT THE DOT
+ JMS I (TYPE
+ ISZ CNT
+ JMP PNLOOP /KEEP GOING
+ JMP I PNMSUB
+
+NMEPLC, 0
+ECTMP, 0
+
+RDERR, JMS I (ERROR
+ INERR+40 /ERROR READING FILE
+DYSTF1, TAD (SPOT1+4 /PRINT INPUT FILE NAME
+DYSTUF, JMS I (PNMSUB
+ TAD (215
+ JMS I (TYPE
+ TAD ECTMP /RESTORE ECHO FLAG AS
+ DCA I (ECHO /SAVED ON ENTRY TO ERROR
+ JMP I (NENT /GO TO NEXT FILE
+WRTERR, JMS I (ERROR
+ OUERR+40 /ERROR WRITING FILE
+POUTNM, TAD (SPOT+4 /PRINT OUTPUT FILE NAME
+ JMP DYSTUF
+NORUMX, JMS I (ERROR /NOT ENOUGH ROOM FOR
+ SPRBLM+40 /FILE ON OUTPUT DEVICE
+ JMP DYSTF1
+\f/ROUTINE WHICH PRINTS NO FILES MSG IF NECESSARY
+/IT WONT PRINT MESSAGE IF ANY FILE IN A SO CALLED
+/INPUT GROUP MATCHES(A BUG?)
+
+SAYNON, TAD I (TYPFND /GET INPUT MATCH FLAG
+ SZA CLA /SKIP IF NOTHING MATCHED
+ JMP GOBCK /DONT DO MESSAGE
+TLP, JMS I (ERROR /PRINT MESSAGE
+ NOFILE+40
+ TAD INFPTR /POINT TO END OF INPUT ENTRY
+ TAD (5 /TO MAKE GTSXBT WORK CORRECTLY
+ DCA INFPTR
+ TAD INFPTR /PRINT THE FILE NAME
+ JMS I (PNMSUB
+ TAD (OTAB-2 /NOW PRINT /V,/C,/O IF
+ DCA XR2 /ANY OF THEM SPECIFIED
+NOPT1, ISZ XR2 /FIX POINTER WHEN SWITCH NOT ON
+NOPT, TAD I XR2 /GET ADDRESS OF OPTION
+ SNA /SKIP IF NOT AT END
+ JMP CRIT /WE ARE AT END
+ DCA TEMP
+ TAD I TEMP /GET OPTION WORD
+ AND I XR2 /AND WITH OPTION BIT
+ SNA CLA /SKIP IF OPTION GIVEN
+ JMP NOPT1 /DO ANOTHER
+ TAD ("/ /PRINT /
+ JMS I (TYPE
+ TAD I XR2 /OPTION
+ JMS I (TYPE
+ JMP NOPT /DO ANOTHER
+CRIT, TAD (215 /END WITH A CRLF
+ JMS I (TYPE
+ TAD ECTMP /RESTORE ECHO FLAG THAT ERROR
+ DCA I (ECHO /SAVED
+ ISZ INSCNT /PRINT MESSAGE FOR ALL FILES
+ JMP TLP /IN GROUP
+GOBCK, TAD I (USEROD /GET USER SPECIFIED DEVICE
+ SNA CLA /SKIP IF HE GAVE ONE
+ TAD I (SDFLG /IF HE DIDNT WE CANT HANDLE /D
+ SPA CLA /SKIP IF NO /D
+ TAD I MOIN /YEP. /D BETTER NOT BE ANY MORE INPUT
+ SZA CLA /THERE WASN'T - O.K.
+ JMP DELERR /WARN HIM OF THE SHORTCOMING
+ TAD MOIN /GET SAVED INPUT POINTER
+ JMP I (DOMOIN /AND DO SOME MORE INPUTS
+
+DELERR, JMS I (ERROR
+ CNTDEL+40 /MULTIPLE DEVICE DELETE
+ TAD (215
+ JMS I (TYPE
+ JMS I (ERROR
+ CNTDE2+40
+
+USEROD, 0
+MOIN, 0
+\f/TABLE OF SWITCHES FOR "NO FILES" MESSAGE
+
+OTAB, OPT2
+ 4
+ "V
+ OPT1
+ 1000
+ "C
+ OPT2
+ 1000
+ "O
+ 0
+
+ PAGE
+\f/THIS ROUTINE HANDLES THE /L AND /Q OPTIONS
+/IF EITHER IS ON IT PRINTS THE NAME
+/THEN IF ITS /Q IT PRINTS A ? AND WAITS FOR
+/A RESPONSE. IF Y IT RETURNS, ANYTHING ELSE
+/AND IT GOES TO PROCESS THE NEXT DIRECTORY ENTRY
+
+PRINTE, 0
+ DCA I (NMEPLC /SAVE ADDRESS OF NAME
+ TAD I (OPT1 /CHECK /L
+ RAR
+ SZL CLA /SKIP IF NO /L
+ JMP PIT /PRINT NAME
+ TAD I (OPT2 /CHECK /Q
+ AND (200
+ SNA CLA /SKIP IF /Q
+ JMP I PRINTE /RETURN
+ ISZ I (ECHO /IF /Q FORCE ECHO ON
+PIT, TAD I (NMEPLC /NOW PRINT FILENAME
+ JMS I (PNMSUB
+ DCA OKFLAG /CLEAR OKFLAG
+ TAD I (OPT2 /WAS IT /Q?
+ AND (200
+ SNA CLA /SKIP IF /Q
+ JMP FUNCT2 /JUST PRINT CRLF
+ TAD ("? /PRINT ?
+ JMS I (TYPE
+ CMA /SET OKFLAG NO GOOD
+ DCA OKFLAG
+ JMS I (READKB /GET A CHAR
+ TAD (-"Y /IS IT Y?
+ SNA CLA /SKIP ON NO
+ ISZ OKFLAG /IT WAS Y, SET OK AND SKIP
+ TAD ("N-"Y /GET N
+ TAD ("Y /GET Y
+ JMS I (TYPE /ECHO IT
+FUNCT2, TAD (215 /PRINT CRLF
+ JMS I (TYPE
+ TAD OKFLAG /OKFLG=0 MEANS YES
+ SZA CLA /SKIP IF TO PROCESS FILE
+ JMP I (NFUNCT /SKIP THIS FILE
+ JMP I PRINTE /RETURN
+
+ODERR, CLA
+ DCA I (WRTDIR /FIX RECURSION
+ JMS I (ERROR
+ ODIERR+40 /ERROR WRITING DIRECTORY
+BODIR, JMS I (ERROR
+ BODORM+40 /BAD OUTPUT DIRECTORY
+CLOERR, JMS I (ERROR
+ SERR+40 /SYSTEM ERROR
+ HLT /DONT LET HIM CONTINUE
+ JMP .-1 /IT CAN ONLY GET WORSE
+
+SPOT, ZBLOCK 4 /ROOM FOR OUTPUT FILE NAME
+SPOT1, ZBLOCK 4 /ROOM FOR INPUT FILE NAME
+\f/CODE TO HANDLE OUT OF ROOM CONDITION ON OUTPUT DEVICE
+
+NOROOM, JMS I (UNFAK /RESTORE THE REAL OUTPUT HANDLER
+ TAD I (OPT1
+ AND (100 /CHECK FOR THE /F OPTION SPECIFIED
+ SNA CLA
+ JMP I (NORUMX /NO - GIVE AN ERROR MESSAGE
+ JMS I (DIROUT /FAILSAFING - WRITE OUT THE OUTPUT DIRECTORY
+ JMS I (ERROR /PRINT THE MESSAGE
+ FLSFMS+40 /"MOUNT NEXT OUTPUT VOLUME"
+ JMS I (READKB /GET AN ANSWER
+ CLA /ANY CHAR EXCEPT ^C OR ^P IS YES
+ TAD (215
+ JMS I (TYPE /PRINT CRLF
+ JMS ODIRIN /READ IN THE NEW OUTPUT DIRECTORY
+ JMP I (FLSRSM /RECOMPUTE THE PENDING TRANSFER.
+
+ODIRIN, 0 /SUBROUTINE TO READ IN THE OUTPUT DIRECTORY
+ TAD I (7600 /GET OUTPUT DEVICE NUMBER
+ SNA /IS IT PRESENT?
+ JMP NOUTFL /NO - DON'T READ OUTPUT DIRECTORY
+ TAD (7757 /ADD ADDRESS OF MONITOR TABLE
+ DCA TEMP /TO INDEX INTO IT
+ TAD I TEMP /FILE STRUCTURED BIT IS 0
+ SMA CLA /SKIP IF DIRECTORY DEVICE
+ JMP NOUTFL /WE DONT WANT TO READ OR WRITE DIRECTORY
+ CIF 0
+ JMS I OUHAND /READ DIRECTORY
+ 1410
+ODBUF, OUBUFR
+ 1
+ JMP I (ONDERR /ERROR
+ TAD I ODBUF
+ CMA CLL /CHECK FOR LEGAL OUTPUT DIRECTORY - FIRST
+ TAD I (OUBUFR+2 /WORD OF AN OS/8 DIRECTORY IS .LT. 50
+ SNL /AND THE THIRD WORD MUST BE .LT. 7,
+ TAD (7700 /SO WE CAN CHECK FOR THE SUM OF THOSE
+ SZL CLA /WORDS BEING .LT. 64
+ JMP I (BODIR /ERROR - CANT BE DIRECTORY
+ SKP
+NOUTFL, AC4000 /WRTDIR MINUS MEANS DONT WRITE
+ DCA I (WRTDIR /DIRECTORY
+ DCA I (MUSTWT /CLEAR THE MUST WRITE FLAG
+ DCA DIRKEY /CLEAR THE OS/8 DIRECTORY KEY
+ JMP I ODIRIN /RETURN
+ PAGE
+\f/SUBROUTINE TO DO LOOKUPS ON OUTPUT DEVICE
+/DOES IMMEDIATE RETURN IF NO OUTPUT DEVICE
+/OTHERWISE RETURNS WITH BLOCK OF FILE IN AC OR
+/0 IN AC MEANING NOT FOUND OR NON-FILE STRUCTURED DEVICE
+LOOKUP, 0
+ TAD (SPOT /ADDRESS OF FILE NAME
+ DCA PLACE
+ TAD I (7600 /GET OUTPUT DEVICE
+ SNA /SKIP IF PRESENT
+ JMP I LOOKUP /NO OUTPUT DEVICE
+ JMS I (FAKUSR /FAKE OUT THE USR
+ JMS I (200
+ 2 /LOOKUP
+PLACE, SPOT
+ 0
+ DCA PLACE /NOT FOUND, 0 PLACE
+ JMS I (UNFAK /RESTORE RESIDENT HANDLER
+ ISZ LOOKUP /SKIP RETURN
+ TAD PLACE /WITH BLOCK IN AC
+ JMP I LOOKUP
+\f/HERE IS WHAT WE HAVE ALL BEEN WAITING FOR
+
+ //////////////////////////////////////
+ / /
+ / RENAME /
+ / /
+//////////////////////////////////////
+
+RENAME, JMS LOOKUP
+ JMP I (CLOERR /SUPER SYSTEM DISASTER
+ DCA OBLOCK /V3C SAVE BLOCK OF NEW NAME (IF ANY)
+ TAD (SPOT1-SPOT /LOOKUP INPUT FILE
+ JMS LOOKUP
+ JMP I (CLOERR /SUPER SYSTEM DISASTER
+ CIA /LOOKUP INPUT NAME ON OUTPUT DEVICE
+ TAD OBLOCK /IS IT SAME SPOT AS NEW NAME ON OUTPUT DEVICE?
+ SZA CLA /V3C
+ JMS EXERR /NO, MAYBE ALREADY EXISTS
+ TAD I (1404 /GET ADDRESS OF FILE
+ TAD 17 /FROM MONITOR BY THE
+ TAD (-4 /DOCUMENTED METHOD
+ DCA TEMP
+ TAD (SPOT-1 /GET NEW OUTPUT NAME
+ DCA XR1
+ TAD (-4 /SET UP COUNT OF WORDS TO MOVE
+ DCA CNT
+RNAM, TAD I XR1 /MOVE THEM
+ DCA I TEMP
+ ISZ TEMP
+ ISZ CNT
+ JMP RNAM /CONTINUE TILL DONE
+ TAD I (1404 /V3C
+ SNA CLA /BUT IS THERE ROOM FOR DATE?
+ JMP NONUDA /NO, NO ADDITIONAL INFO WORDS
+ TAD I (DATE /YES, MOVE DATE
+ DCA I TEMP /INTO NEW FILENAME ENTRY
+NONUDA, JMS WRKEY /V3C
+ ISZ I (WRTDIR /INDICATE DIRECTORY CHANGED
+ JMP I (NFUNCT /DO NEXT FILE
+
+WRKEY, 0 /V9
+ TAD DIRKEY /GET "SEGMENT IN CORE" KEY
+ AND (7 /ISOLATE SEGMENT NUMBER
+ DCA SEGNO /NUMBER FOR WRITE
+ CIF 0
+ JMS I 51 /CALL HANDLER USR USED TO DO
+ 4210 /LOOKUP, THIS POINTS TO FOTPS
+ 1400 /INCORE DIRECTORY HANDLER
+SEGNO, 0 /REWRITE UPDATED DIRECTORY BLOCK
+ JMP I (CLOERR /SYSTEM ERROR
+ JMP I WRKEY
+\fEXERR, 0 /BLOCK NUMBERS DIFFERENT
+ TAD OBLOCK /LOOK AT BLOCK NUMBER OF EXISTING FILE
+ SNA CLA /DID IT REALLY EXIST?
+ JMP I EXERR /NO, OK TO RENAME TO THIS NAME
+ JMS I (ERROR /YES, TRYING TO RENAME TO EXISTING NAME
+ RENERR+40 /FILE ALREADY EXISTS
+ JMP I (POUTNM
+
+OBLOCK, 0 /TEMPORARY, HOLDS BLOCK NUMBER OF ALREADY
+ /EXISTING FILE WITH SAME NAME AS PROPOSED NEW NAME
+ /ON OUT PUT DEVICE (OR 0 IF NONE)
+\f/THIS ROUTINE TRANSFERS THE ADDITIONAL
+/INFORMATION WORDS OF THE INPUT FILE WHEN COPYING
+/IT IF THERE ARE ANY
+
+ADDINF, 0
+ CLA IAC /AC=1
+ TAD I (1404 /GET NUMBER OF WORDS FROM OUTPUT DIRECTORY
+ SMA /SKIP IF 2 OR MORE
+ JMP NOTRAN /WE DONT TOUCH IT
+ DCA LOOKUP /SAVE NEGATIVE NUMBER TO MOVE
+ TAD LOOKUP /ADD NUMBER TO LOC 17
+ TAD 17 /TO FIND ADDR(SECOND)
+ DCA PPTR1 /USE 17
+ TAD INFWDS /GET NUMBER OF AIW IN INPUT
+ CIA /NEGATE
+ IAC /ADD 1
+ SMA /SKIP IF MORE THAN 1 AIW
+ JMP ZEROUT /ZERO OUTPUT AIW
+ DCA TEMP /SAVE COUNT
+MOVEM, ISZ GPTR1 /BUMP PTR (1ST TIME PAST DATE)
+ CDF 0
+ TAD I GPTR1 /GET WORD
+ZLOOP, CDF 10
+ DCA I PPTR1 /PUT IT INTO OUTPUT DIRECTORY
+ ISZ PPTR1
+ ISZ LOOKUP /HAS OUTPUT COUNT OVERFLOWED?
+ JMP MORE /MORE OUTPUT TO DO
+ JMS WRKEY /V9
+NOTRAN, CLA /EXIT
+ JMP I ADDINF /WERE DONE
+MORE, ISZ TEMP /BUMP INPUT COUNT
+ JMP MOVEM /IT HASNT OVERFLOWED
+ZEROUT, CLA CMA /NO MORE INPUT WORDS-
+ DCA TEMP /SO FIX UP TO ZERO REST OF OUTPUT WORDS
+ JMP ZLOOP /DO ALL THE OUTPUTS
+
+PPTR1, 0
+ PAGE
+\f/** THIS IS THE STARTING ADDRESS OF FOTP!!!
+
+FOTP, JMS INIT /REGULAR ENTRY POINT
+ JMS INIT /CHAIN ENTRY POINT
+ JMP I (CDCALL /CALL COMMAND DECODER
+ JMP I (BYPSCD /DONT CALL COMMAND DECODER
+INIT, 0
+ ISZ INIT /DO SKIP RETURN
+ CLA CLL
+ CDF 0
+ TAD I (7777 /GET BATCH CONTROL WORD
+ AND (70
+ TAD FCIF0 /FORM CIF TO BATCH FIELD
+ DCA BATCIF
+ TAD I (7777
+ CDF 10
+ RTL
+ SNL CLA /BATCH RUNNING?
+ JMP NOBTCH /NO
+BMOVLP, TAD BATOUT
+ DCA I TTOUTP /MOVE IN SUBSTITUTE TTY OUTPUT CODE
+ ISZ BMOVLP
+ ISZ TTOUTP
+ ISZ TTCNT4
+ JMP .-5
+ STA
+NOBTCH, DCA CORFUJ / =0 IF NO BATCH, -1 IF BATCH
+MOVMSG, TAD I ONCE /MOVE MSGS TO LOWER FIELD
+ CDF 0
+ DCA I ONLY
+ CDF 10
+ TAD I M1
+ CDF 0 /MOVE CORE DETERMINER
+ DCA I M1 /INTO FIELD 0 ALSO
+ CDF 10
+ ISZ M1
+ ISZ ONCE
+ ISZ ONLY
+ ISZ CODE
+ JMP MOVMSG
+ TAD (2000 /SET RESTART LOCATION
+ CDF 0
+ DCA I (7745
+ TAD (6403 /SET JSW
+ DCA I (7746
+ CDF 10
+FCIF0, CIF 0
+ JMS I (CORE
+ TAD CORFUJ /COMPUTE AMOUNT OF CORE EXCLUDING BATCH FIELD
+ TAD (-1
+ SZA CLA /SKIP IF WE HAVE ONLY 8K (OR 12K AND BATCH)
+ JMP I INIT
+ TAD (TAD EPTR /PATCH LOCATIONS IN FOTP
+ DCA I (F2C1 /TO WORK WITH ONLY 8K
+ TAD (NOP
+ DCA I (F2C2
+ JMP I INIT /START
+
+M1, .&7600
+ONCE, MSGS
+ONLY, LSTFPG+200
+CODE, 7400
+
+CORFUJ, 0
+TTCNT4, -4
+TTOUTP, TTYOUT
+BATOUT, SKP /OUTPUT TO BATCH LOG
+ 7400
+BATCIF, HLT
+ TTYOUT+1&177+4600 /JMS I .-2
+\f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
+/BANKS IN AC.
+/MUST RUN IN FIELD 0.
+
+CORE, 0
+ TAD C6203
+ RDF
+ DCA CORRTN
+ CDF 0
+ TAD I (7777
+ AND (70
+ SNA /DOES LOCATION 7777 SPECIFY CORE SIZE?
+ JMP CORELP /NO
+ CLL RTR /YES - BELIEVE IT.
+ RAR
+ JMP CORRTN
+CORELP, CDF 0 /NEEDED FOR PDP-8L
+ TAD TRYFLD /GET FLD TO TST
+ CLL RTL
+ RAL
+ AND COR70 /MASK USEFUL BITS
+ TAD CORELP
+ DCA .+1 /SET UP CDF TO FLD
+COR706, 0
+ TAD I CORLOC /SAV CURRENT CONTENTS
+ NOP /HACK FOR PDP-8
+ DCA .-3
+ TAD .-2 /7000 IS A GOOD PATTERN
+ DCA I CORLOC
+COR70, 70 /HACK FOR PDP-8.,NO-OP
+ TAD I CORLOC /TRY TO READ BK 7000
+ 7400 /HACK FOR PDP-8,.NO-OP
+ TAD .-1 /GUARD AGAINST WRAP AROUND
+ TAD CORLOC+1 /TAD 1400
+ SZA CLA
+ JMP .+5 /NON EXISTENT FLD EXIT
+ TAD COR706 /RESTORE CONTENS DESTROYED
+ DCA I CORLOC
+ ISZ TRYFLD /TRY NXT HIGHER FLD
+ JMP CORELP
+ STA
+ TAD TRYFLD
+CORRTN, 0
+ JMP I CORE
+CORLOC, COR70+2 /ADR TO TST IN EACH FLD
+ 1400 /7000+7400+1400=0
+TRYFLD, 1 /CURRENT FLD TO TST
+C6203, 6203
+
+ PAGE
+\f/FOTP'S ERROR MESSAGES
+/THESE RESIDE IN FIELD 0 LOCATIONS 7200-7577
+
+MSGS,
+
+ NOPUNCH
+ *LSTFPG+200
+ ENPUNCH
+
+ILLQ, TEXT /ILLEGAL ?%/
+ILLA, TEXT /ILLEGAL *%/
+SERR, TEXT /SYSTEM ERROR/
+RENERR, TEXT /ALREADY EXISTS-/
+VERNO, 0617;2420;4026 /FOTP V
+VERLOC, VERSION+60^100+SUBVER /ONE-DIGIT VERSION NUMBER AND 1 CHAR PATCH LEVEL
+ 0
+BADIRD, TEXT /ERROR READING INPUT DIRECTORY%/
+ODRERR, TEXT /ERROR READING OUTPUT DIRECTORY%/
+ODIERR, TEXT /ERROR WRITING OUTPUT DIRECTORY%/
+SPRBLM, TEXT /NO ROOM, SKIPPING-/
+INERR, TEXT /ERROR ON INPUT DEVICE-SKIPPING-/
+OUERR, TEXT /ERROR ON OUTPUT DEVICE-SKIPPING-/
+NFLEIN, TEXT /USE PIP FOR NON-FILE STRUCTURED INPUT%/
+NOFILE, TEXT /NO FILES OF THE FORM:/
+BIDIRM, TEXT /BAD INPUT DIRECTORY%/
+BODORM, TEXT /BAD OUTPUT DIRECTORY%/
+CNTDEL, TEXT /DELETES PERFORMED ONLY ON INPUT DEVICE GROUP 1/
+CNTDE2, TEXT /CAN'T HANDLE MULTIPLE DEVICE DELETES%/
+DSVED, TEXT /ORIGINAL DIRECTORY PRESERVED%/
+FLSFMS, TEXT /MOUNT NEXT OUTPUT VOLUME:/
+
+ FIELD 1 /SELF-STARTING BINARY LOADER STUFF FOR ABSLDR
+ *FOTP
+ $
--- /dev/null
+
+&
+
+ OS/78 V1
+
+ COMMAND SUMMARY
+
+ASSIGN ASSIGN NAME TO DEVICE LOAD LOAD FILE
+BASIC ENTER BASIC SYSTEM MAP PRINT BITMAP
+COMPARE COMPARE SOURCE FILES MEMORY RESTRICT MEMORY USAGE
+COMPILE COMPILE FILE ODT RUN OCTAL DEBUGGER
+COPY COPY FILE PAL ASSEMBLE FILE
+CREATE OPEN EDIT FILE R RUN PROGRAM FROM SYS
+CREF ASSEMBLE AND CREF RENAME RENAME FILE
+DATE SPECIFY DATE RUN RUN PROGRAM
+DEAS DEASSIGN LOGICAL DEVICES SAVE SAVE MEMORY IMAGE
+DELETE DELETE FILE SET ALTER DEVICE
+DIRECT PRINT DIRECTORY SQUISH SQUISH DEVICE
+DUPLIC COPIES DISKETTES START START PROGRAM
+EDIT EDIT FILE SUBMIT START BATCH
+EXECUTE COMPILE AND RUN TERMIN ENTER TERMINAL MODE
+GET GET MEMORY IMAGE TYPE TYPE FILE
+HELP LIST HELP INFORMATION U[A-C] STORE COMMAND
+LIST LIST FILE ZERO ZERO DEVICE
+\f
+&ABSLDR
+ ABSLDR.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:BINFILE.BN,...
+.LOAD BINFILE.BN,... /FROM DSK
+
+@SWITCHES:
+/8 PROG DOESN'T USE BELOW 02000
+/9 PROG DOESN'T USE BELOW 12000
+/G GO
+/I MEMORY IMAGE FILE
+/R RESET
+/S MULTIPLE BINARIES/FILE
+/N FORCE LOADING TO FIELD N (N IS AN OCTAL DIGIT)
+=FNNNN SET STARTING ADDRESS
+\f
+&BASIC
+ BASIC.SV
+
+@CALLING COMMANDS:
+.BASIC
+
+@INTERNAL COMMANDS:
+BYE EXIT FROM BASIC
+LIST LIST CURRENT PROGRAM'S STATEMENTS
+NAME RENAME CURRENT PROGRAM
+NEW PREPARE FOR A NEW PROGRAM
+OLD RETRIEVE AN OLD PROGRAM
+RUN RUN CURRENT PROGRAM
+SAVE SAVE CURRENT PROGRAM
+SCRATCH DELETE CURRENT PROGRAM
+
+.HELP BCOMP PRINTS BASIC COMPILER ERROR MESSAGES
+.HELP BRTS PRINTS BASIC RUN-TIME ERROR MESSAGES
+\f
+&BCOMP
+ BCOMP.SV (ERRORS)
+
+@ERRORS:
+CH ERROR IN CHAIN STATEMENT NM MISSING LINE NUMBER
+DE ERROR IN DEF STATEMENT OF OUTPUT FILE ERROR
+DI ERROR IN DIM STATEMENT PD PUSHDOWN STACK OVERFLOW
+FN ERROR IN FILE NUMBER OR NAME QS STRING LITERAL TOO LONG
+FP INCORRECT FOR STATEMENT SS BAD SUBSCRIPT OR FUNCTION ARG
+FR ERROR IN FUNCTION ARGS ST SYMBOL TABLE OVERFLOW
+IF ERROR IN IF STATEMENT SY SYSTEM INCOMPLETE
+IO I/O ERROR TB PROGRAM TOO BIG
+LS MISSING EQUALS SIGN IN LET TD TOO MUCH DATA IN PROGRAM
+LT STATEMENT TOO LONG TS TOO MANY CHARS IN STRING
+MD MULTIPLY DEFINED LINE NUMBER UD ERROR IN UDEF STATEMENT
+ME MISSING END STATEMENT UF FOR STATEMENT WITHOUT NEXT
+MO OPERAND EXPECTED, NOT FOUND US UNDEFINED STATEMENT NUMBER
+MP PARENTHESIS ERROR UU USE STATEMENT ERROR
+MT OPERAND OF MIXED TYPE XC CHARS AFTER END OF LINE
+NF NEXT STATEMENT WITHOUT FOR
+\f
+&BRTS
+ BRTS.SV (ERRORS)
+
+@ERRORS:
+BO NO MORE BUFFERS AVAILABLE GS TOO MANY NESTED GOSUBS
+CI IN CHAIN,DEVICE NOT FOUND IA ILLEGAL ARG IN UDEF
+CL IN CHAIN,FILE NOT FOUND IF ILLEGAL DEV:FILENAME
+CX CHAIN ERROR IN INQUIRE FAILURE
+DA READING PAST END OF DATA IO TTY INPUT BUFFER OVERFLOW
+DE DEVICE DRIVER ERROR LM TAKING LOG OF NEGATIVE NUMBER
+DO NO MORE ROOM FOR DRIVERS OE DRIVER ERROR WHILE OVERLAYING
+DV ATTEMPT TO DIVIDE BY ZERO OV NUMERIC OR INPUT OVERFLOW
+EF LOGICAL END OF FILE PA ILLEGAL ARG IN POS
+EM NEGATIVE NUMBER TO REAL POWER RE READING PAST END OF FILE
+EN ENTER ERROR SC CONCATENATED STRING TOO LONG
+FB USING FILE ALREADY IN USE SL STRING TOO LONG OR UNDEFINED
+FC CLOSE ERROR SR READING STRING FROM NUMERIC FILE
+FE FETCH ERROR ST STRING TRUNCATION ON INPUT
+FI CLOSING OR USING UNOPENED FILE SU SUBSCRIPT OUT OF RANGE
+FM FIXING NEGATIVE NUMBER SW WRITING STRING INTO NUMERIC FILE
+FN ILLEGAL FILE NUMBER VR READING VARIABLE LENGTH FILE
+FO FIXING NUMBER > 4095 WE WRITING PAST END OF FILE
+GR RETURN WITHOUT GOSUB
+\f
+&COMPAR
+ SRCCOM.SV
+
+@CALLING COMMANDS:
+.COMPAR DEV:OUTFILE.PA<DEV:INFILE1.PA,DEV:INFILE2.PA
+.COMPAR OUTFILE.PA<INFILE1.PA,INFILE2.PA /FILES ON DSK
+
+@SWITCHES:
+/B COMPARE BLANK LINES
+/C DON'T COMPARE (SLASHED) COMMENTS
+/S DON'T COMPARE TABS AND SPACES
+/T CONVERT TABS TO SPACES ON OUTPUT
+/X DON'T COMPARE OR PRINT COMMENTS
+
+@ERRORS:
+?0 INSUFFICIENT MEMORY
+?1 INPUT ERROR FILE 1 (OR LESS THAN 2 INPUT FILES)
+?2 INPUT ERROR FILE 2
+?3 OUTPUT FILE TOO LARGE
+?4 OUTPUT ERROR
+?5 CAN'T OPEN OUTPUT FILE
+\f
+&CREF
+ CREF.SV
+
+@CALLING COMMANDS:
+.CREF DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA
+.CREF DEV:INFILE.PA /LISTING TO LINE PRINTER ONLY
+.CREF INFILE.PA /LISTING TO LINE PRINTER, INPUT FILE ON DSK
+
+@SWITCHES:
+/E DON'T DELETE CREFLS.TM
+/M MAMMOTH (TWICE AS MANY SYMBOLS, TWICE AS SLOW)
+/P NO PASS 1 LISTING
+/U NO LISTING OR SYMBOL TABLE
+/X NO LITERALS
+\f
+&DIRECT
+ DIRECT.SV
+
+@CALLING COMMANDS
+.DIR DEV:FILETYPE /* IS WILD NAME OR EXTENSION
+.DIR FILETYPE /? IS WILD CHARACTER
+
+@SWITCHES:
+/B INCLUDE STARTING BLOCK NUMBERS (OCTAL)
+/C LIST ONLY FILES WITH CURRENT DATE
+/E INCLUDE EMPTIES
+/F FAST MODE
+/M LIST EMPTIES ONLY
+/O LIST ONLY FILES WITH OTHER THAN TODAY'S DATE
+/R LIST REMAINDER OF FILES AFTER FIRST ONE (BUT USE /C,/O)
+/U TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V LIST FILES NOT OF FORM SPECIFIED
+/W GIVE VERSION NUMBER
+=N USE N COLUMNS
+\f
+&DUPLIC
+ RXCOPY.SV
+
+@CALLING COMMANDS:
+.DUPLIC OUTDEV:<INDEV:
+
+@SWITCHES:
+/M MATCH WITH NO IMPLIED COPY
+/N COPY WITH NO IMPLIED MATCH
+/P PAUSE BEFORE AND AFTER ACCESSING DISK
+/R READ OUTPUT DEVICE WITH NO IMPLIED COPY OR MATCH
+/V PRINT VERSION NUMBER
+\f
+&EDIT
+&CREATE
+ EDIT.SV
+
+@CALLING COMMANDS: INTERNAL COMMANDS:
+.EDIT DEV:OUTFILE.PA<DEV:INFILE.PA A APPEND TEXT
+.CREATE OUTFILE.PA B LIST # LOCATIONS LEFT
+\r C CHANGE TEXT
+@SWITCHES: D DELETE TEXT
+/A RETURN TO EDITOR ON CLOSE E TRANSFER REST OF DATA,CLOSE
+/B CONVERT SPACES TO TAB F AFTER J,RESUME SEARCH
+/D PREDELETE G GET AND LIST TAGGED LINE
+ I INSERT TEXT
+@ERRORS: J INTER-BUFFER SEARCH
+?0 INPUT ERROR K KILL BUFFER
+?1 OUTPUT ERROR L LIST TEXT
+?2 CLOSE ERROR M MOVE TEXT
+?3 OPEN ERROR N WRITE TEXT,READ NEXT PAGE
+?4 COULDN'T LOAD HANDLER P WRITE BUFFER TO OUTPUT
+ Q IMMEDIATE END OF FILE
+ R READ FROM INPUT DEVICE
+ S CHARACTER SEARCH
+ V LIST ON LINE PRINTER
+ Y INPUT PAGE,NO OUTPUT
+\f
+&FORTRAN
+&F4
+ F4.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:RALFFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.COMPILE INFILE.FT /FROM DSK
+
+@SWITCHES:
+/N SUPPRESS INTERNAL STATEMENT NUMBERS
+/Q OPTIMIZE
+
+.HELP F4ERR PRINTS FORTRAN ERROR MESSAGES
+\f
+&F4ERR
+ MK MISSPELLED KEYWORD
+AA TOO MANY ARGS ARE ARRAYS ML MULTIPLY DEFINED LINE NUMBERS
+AS BAD ASSIGN STATEMENT MM MISMATCHED PARENTHESIS
+BD BAD DIMENSIONS MO EXPECTED OPERAND MISSING
+BS BAD STATEMENT IN BLOCK DATA MT MIXED VARIABLE TYPES
+CL BAD COMPLEX LITERAL OF ERROR WRITING OUTPUT FILE
+CO SYNTAX ERROR IN COMMON OP ILLEGAL OPERATOR
+DA BAD SYNTAX IN DATA STATEMENT OT WRONG OPERAND TYPE
+DE ILLEGAL STATEMENT AT END OF DO PD COMPILER STACK OVERFLOW
+DF BAD DEFINE FILE STATEMENT PH BAD PROGRAM HEADER LINE
+DH HOLLERITH FIELD ERROR QL NESTING ERROR IN EQUIVALENCE
+DL WRONG DATA/VARIABLE LIST LENGTH QS SYNTAX ERROR IN EQUIVALENCE
+DN DO-END MISSING RD REDEFINING VARIABLE DIMENSIONS
+DO SYNTAX ERROR IN DO RT REDEFINING VARIABLE TYPE
+DP BAD DO LOOP PARAMETER RW SYNTAX ERROR IN READ/WRITE
+EX SYNTAX ERROR IN EXTERNAL SF BAD ARITHMETIC FUNCTION
+GT SYNTAX ERROR IN GOTO SN ILLEGAL NAME IN CALL
+GV VARIABLE NOT INTEGER OR REAL SS SUBSCRIPT EXPRESSION ERROR
+HO HOLLERITH FIELD ERROR ST SYMBOL TABLE FULL
+IE ERROR READING INPUT FILE SY SYSTEM ERROR
+IF IMPROPER STATEMENT TD BAD SYNTAX IN TYPE DECLARATION
+LI BAD ARG TO LOGICAL IF US UNDEFINED STATEMENT NUMBER
+LT INPUT LINE TOO LONG VE VERSION ERROR
+\f
+&LOAD
+ LOAD.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:OUTFILE.LD<DEV:INFILE1.RL,...
+
+@SWITCHES:
+/C MORE INPUT TO LOAD
+/G CHAIN TO RUN-TIME SYSTEM
+/L ACCEPT LIBRARY FILE
+/S SYMBOL MAP
+\f
+&MAP
+ BITMAP.SV
+
+@CALLING COMMANDS:
+.MAP MAPFILE.MP<INFILE.BN,...
+
+@SWITCHES:
+/N FORCES MAPPING OF ALL FILES TO FIELD N (0-7)
+/R RESET INTERNAL MAP
+/S ALLOW MULTIPLE BINARIES PER FILE
+/T INVERT TTY-STYLE OUTPUT SWITCH
+\f
+&ODT
+ ODT
+
+@CALLING COMMANDS:
+.ODT
+
+@INTERNAL COMMANDS:
+NNNNN/ OPEN LOC N+ OPEN CURRENT LOC+N
+/ REOPEN LAST OPENED LOC N- OPEN CURRENT LOC-N
+NN DEPOSIT NN IN OPEN LOC NNG GO
+<CR> CLOSE PREVIOUSLY OPENED LOC NNB ESTABLISH BREAKPOINT
+<LF> CLOSE LOC, OPEN NEXT LOC B REMOVE BREAKPOINT
+^ CLOSE,OPEN LOC ADDRESSED A OPEN AC
+_ CLOSE,OPEN LOC POINTED TO L OPEN LINK
+M OPEN SEARCH MASK C CONTINUE FROM BREAKPOINT
+ <LF> OPEN LOWER SEARCH LIMIT NNC CONTINUE NN TIMES
+ <LF> OPEN UPPER SEARCH LIMIT D OPEN DATA FIELD
+NNW SEARCH FOR NN IN LIMITS F OPEN FIELD FOR ^,_, W
+^O SUPRESS PRINTING
+\f
+&PAL
+ PAL8.SV
+
+@CALLING COMMANDS:
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA/C
+.PAL INFILE.PA
+
+@SWITCHES:
+/B TREAT ! AS BYTE SHIFT /K USE EXTRA MEMORY
+/C CHAIN TO CREF /L LOAD
+/E ENABLE ERROR MSG ON LINK GENERATED /N NO LISTING
+/F DISABLE 0-FILL IN TEXT /O DISABLE ORIGIN 200
+/G GO /S NO SYMBOL TABLE
+/H NON-PAGINATED OUTPUT /T NO FORM FEEDS
+/J DON'T LIST LINES CONDITIONALIZED OUT /W DON'T REMEMBER LITERALS
+
+.HELP PALERR PRINTS PAL8 ERROR MESSAGES
+\f
+&PALERR
+ PAL8.SV (ERRORS)
+
+@ERRORS:
+BE TABLES OVERLAPPED
+CF CREF.SV NO ON SYS:
+DE DEVICE ERROR
+DF DEVICE FULL
+IC ILLEGAL CHARACTER
+ID ILLEGAL REDEFINITION
+IE ILLEGAL EQUALS
+II ILLEGAL INDIRECT
+IP ILLEGAL PSEUDO-OP
+IZ ILLEGAL PAGE ZERO REF
+LD SYS:ABSLDR.SV NOT FOUND
+LG LINK GENERATED
+PE PAGE EXCEEDED
+PH END OF SOURCE CONDITIONALIZED OUT
+RD REDEFINITION
+SE SYMBOL TABLE EXCEEDED
+UO UNDEFINED ORIGIN
+US UNDEFINED SYMBOL
+ZE PAGE 0 EXCEEDED
+\f
+&SET
+ SET.SV
+
+@CALLING COMMANDS:
+.SET DEV PARAMETER(S)
+.SET DEV NO PARAMETER(S)
+
+@PARAMETERS:
+READONLY DECLARE DEVICE TO BE READ ONLY
+WIDTH N SET WIDTH OF LINE PRINTER OR TTY
+LC DECLARE LINE PRINTER OR TTY TO HAVE LOWER CASE
+ECHO RESTORE TTY CHARACTER ECHOING
+PAGE RESTORE TTY ^S AND ^Q FACILITIES
+SCOPE ERASE CHARACTER ON TTY RUBOUTS
+ESC DISPLAY ESC(ASCII 033) WITHOUT CONVERTING IT TO $ SIGN
+ARROW DISPLAY CONTROL CHARACTERS WITH UP ARROW (E.G. ^C, ^S)
+HEIGHT [M] SET TTY SCREEN HEIGHT
+PAUSE [N] SET TTY PAUSE TIME
+COL N SET DIRECT TO USE N COLUMNS (.SET TTY COL 2)
+INIT XXXXX CAUSE SYS TO EXECUTE XXXXX ON BOOTSTRAPPING
+\f
+&SUBMIT
+ BATCH.SV
+
+@CALLING COMMANDS:
+.SUBMIT SPOOLDEV:<INPUTDEV:FILE.BI
+
+@SWITCHES:
+/E DON'T ABORT ON MONITOR, CD AND CCL ERRORS
+/Q NO BATCH LOG
+/H HUSH
+/T OUTPUT TO TTY
+/U UNATTENDED
+\f
+&LIST
+©
+&RENAME
+&DELETE
+&TYPE
+ FOTP.SV
+
+@CALLING COMMANDS:
+.COPY DEV:OUTFILE.EX<DEV:INFILE.EX /* IS WILD NAME OR EXTENSION
+.REN DEV:NEWFILE.EX<DEV:OLDFILE.EX /? IS WILD CHARACTER
+.DEL DEV:FILE.EX
+.LIST DEV:FILE.EX /= .COPY LPT:<DEV:FILE.EX
+.TYPE DEV:FILE.EX /= .COPY TTY:<DEV:FILE.EX
+
+@SWITCHES:
+/C MATCH ONLY FILES WITH CURRENT DATE
+/F REQUEST NEW DEVICE IF OUT OF ROOM
+/L TYPE LOG OF INPUT FILENAME MATCHES
+/N NO PRE-DELETE
+/O MATCH ONLY FILES WITH OTHER THAN TODAY'S DATE
+/Q QUERY USER ABOUT FILE BEFORE OPERATION
+/T USE TODAY'S DATE
+/U TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V MATCH FILES NOT OF FORM SPECIFIED
+/W PRINT VERSION #
+\f
+&ASSIGN
+&DATE
+&DEASSIGN
+&GET
+&MEMORY
+&R
+&RUN
+&SAVE
+&START
+&SQUISH
+&TERMIN
+&UA
+&ZERO
+ KEYBOARD AND OTHER COMMANDS
+
+@CALLING COMMANDS:
+.ASSIGN DEV NAME /ASSIGN NAME TO DEVICE
+.DAY DD-MON-YY /ENTER DATE INTO SYSTEM
+.DEASSIGN /DEASSIGN LOGICAL DEVICE NAMES
+.GET DEV FILE.EX /LOAD MEMORY IMAGE
+.MEMORY N /SPECIFIES HIGHEST FIELD AVAILABLE
+.R FILE /EXECUTE FILE.SV FROM SYS
+.RUN DEV FILE.EX /EXECUTE FILE.EX FROM THE DEVICE
+.SAVE DEV FILE.EX /SAVE MEMORY IMAGE
+.SQUISH DEV: /COMPRESS FILE STORAGE ON DEVICE
+.START FNNNN /START EXECUTION
+.TERMIN /ENTER TERMINAL MODE
+.UA COMMAND /SAVE COMMAND(.UA<CR> EXECUTES IT)
+.ZERO DEV: /ZERO DEVICE'S DIRECTORY
+\f\f
--- /dev/null
+
+&ABSLDR
+ ABSLDR.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:BINFILE.BN,...
+.LOAD BINFILE.BN,... /FROM DSK
+
+@SWITCHES:
+/8 PROG DOESN'T USE BELOW 02000
+/9 PROG DOESN'T USE BELOW 12000
+/G GO
+/I CORE IMAGE FILE
+/P PROG DOESN'T DESTROY EXTENDED BATCH RESIDENT
+/R RESET
+/S MULTIPLE BINARIES/FILE
+/N FORCE LOADING TO FIELD N (N IS AN OCTAL DIGIT)
+=FNNNN SET STARTING ADDRESS
+\f
+&BASIC
+ BASIC.SV
+
+@CALLING COMMANDS:
+.BASIC
+.R BASIC
+
+@INTERNAL COMMANDS:
+BYE EXIT FROM BASIC
+LIST LIST CURRENT PROGRAM'S STATEMENTS
+NAME RENAME CURRENT PROGRAM
+NEW PREPARE FOR A NEW PROGRAM
+OLD RETRIEVE AN OLD PROGRAM
+RUN RUN CURRENT PROGRAM
+SAVE SAVE CURRENT PROGRAM
+SCRATCH DELETE CURRENT PROGRAM
+
+.HELP BCOMP PRINTS BASIC COMPILER ERROR MESSAGES
+.HELP BRTS PRINTS BASIC RUN-TIME ERROR MESSAGES
+\f
+&BCOMP
+ BCOMP.SV (ERRORS)
+
+@ERRORS:
+CH ERROR IN CHAIN STATEMENT
+DE ERROR IN DEF STATEMENT
+DI ERROR IN DIM STATEMENT
+FN ERROR IN FILE NUMBER OR FILE NAME
+FP INCORRECT FOR STATEMENT
+FR ERROR IN FUNCTION ARGS
+IF ERROR IN IF STATEMENT
+IO I/O ERROR
+LS MISSING EQUALS SIGN IN LET
+LT STATEMENT TOO LONG
+MD MULTIPLY DEFINED LINE NUMBER
+ME MISSING END STATEMENT
+MO OPERAND EXPECTED AND NOT FOUND
+MP PARENTHESIS ERROR
+MT OPERAND OF MIXED TYPE
+NF NEXT STATEMENT WITHOUT FOR
+NM MISSING LINE NUMBER
+OF OUTPUT FILE ERROR
+PD PUSHDOWN STACK OVERFLOW
+QS STRING LITERAL TOO LONG
+SS SUBSCRIPT OR FUNCTION ARG ERROR
+ST SYMBOL TABLE OVERFLOW
+SY SYSTEM INCOMPLETE
+TB PROGRAM TOO BIG
+TD TOO MUCH DATA IN PROGRAM
+TS TOO MANY CHARS IN STRING LITERALS
+UD ERROR IN UDEF STATEMENT
+UF FOR STATEMENT WITHOUT NEXT
+US UNDEFINED STATEMENT NUMBER
+UU USE STATEMENT ERROR
+XC EXTRA CHARS AFTER LOGICAL END OF LINE
+
+\f
+&BRTS
+ BRTS.SV (ERRORS)
+
+@ERRORS:
+BO NO MORE FILE BUFFERS AVAILABLE
+CI INQUIRE FAILURE IN CHAIN. DEVICE NOT FOUND
+CL LOOKUP FAILURE IN CHAIN. FILENAME NOT FOUND.
+CX CHAIN ERROR
+DA ATTEMPT TO READ PAST END OF DATA LIST
+DE DEVICE DRIVER ERROR
+DO NO MORE ROOM FOR DRIVERS
+DV ATTEMPT TO DIVIDE BY 0
+EF LOGICAL END OF FILE
+EM ATTEMPT TO RAISE A NEGATIVE NUMBER TO A REAL POWER
+EN ENTER ERROR
+FB ATTEMPT TO USE A FILE ALREADY IN USE
+FC CLOSE ERROR
+FE FETCH ERROR
+FI ATTEMPT TO CLOSE OR USE AN UNOPENED FILE
+FM ATTEMPT TO FIX NEGATIVE NUMBER
+FN ILLEGAL FILE NUMBER
+FO ATTEMPT TO FIX NUMBER GREATER THAN 4095
+GR RETURN WITHOUT A GOSUB
+GS TOO MANY NESTED GOSUBS
+IA ILLEGAL ARGUMENT IN UDEF FUNCTION CALL
+IF ILLEGAL DEV:FILENAME SPECIFICATION
+IN INQUIRE FAILURE
+IO TTY INPUT BUFFER OVERFLOW
+LM ATTEMPT TO TAKE LOG OF A NEGATIVE NUMBER
+OE DRIVER ERROR WHILE OVERLAYING
+OV NUMERIC OR INPUT OVERFLOW
+PA ILLEGAL ARGUMENT IN POS FUNCTION
+RE ATTEMPT TO READ PAST END OF FILE
+SC STRING TOO LONG AFTER CONCATENATING
+SL STRING TOO LONG OR UNDEFINED
+SR ATTEMPT TO READ STRING FROM NUMERIC FILE
+ST STRING TRUNCATION ON INPUT
+SU SUBSCRIPT OUT OF DIM STATEMENT RANGE
+SW ATTEMPT TO WRITE STRING INTO NUMERIC FILE
+VR ATTEMPT TO READ VARIABLE LENGTH FILE
+WE ATTEMPT TO WRITE PAST END OF FILE
+\f
+&BOOT
+ BOOT.SV
+
+@CALLING COMMANDS:
+.BOOT/DV
+
+@SWITCHES:
+/CA TA8E CASSETTE CAPS-8
+/DK ANY DISK
+/DL LINCTAPE DIAL
+/DM ANY DISK DISK MONITOR
+/DT ANY TAPE
+/LT LINCTAPE
+/PT PT8E (LOADS BINLDR)
+/RE RK8E DISK
+/RF RF08,DF32 DISKS
+/RK RK8 DISK
+/RX RX8E FLOPPY DISK
+/TD TD8E DECTAPE
+/TY TYPESET (UNIT 4)
+/VE VERSION #
+/TC TC08 DECTAPE ALL SYSTEMS
+/ZE ZEROES CORE (FIELD 0)
+
+DEVICES ARE UNIT 0 IF NOT SPECIFIED
+
+DV. HALT AFTER LOADING BOOTSTRAP
+\f
+&BUILD
+ BUILD.SV
+
+@INTERNAL COMMANDS:
+$ALTER GRP,LOC
+$ALTER GRP,LOC=VALUE
+$BOOT
+$BUILD
+$CTL ACTNAM
+$CTL ACTNAM=VALUE
+$CORE N
+$DCB ACTNAM
+$DCB ACTNAM=VALUE
+$DELETE ACTNAM,...
+$DSK ACTNAM
+$DSK GRP:NAME
+$EXAMINE GRP,LOC
+$INSERT GRP
+$INSERT GRP:NAME,...
+$LOAD DEV:FILENM.BN
+$LOAD ACTNAM
+$NAME ACTNAM=NEWNAM
+$PRINT
+$QLIST
+$REPLACE ACTNAM,...=GRP:NEWNAM,,,
+$SIZE ACTNAM
+$SIZE ACTNAM=VALUE
+$SYS GRP
+$SYS GRP:NAME,...
+$UNLOAD GRP
+$UNLOAD GRP:NAME,...
+
+@ERRORS:
+?BAD ARG NO DEVICE NAME IN LOAD COMMAND
+?BAD INPUT INPUT NOT A VALID BINARY FILE
+?BAD LOAD BINARY HANDLER NOT IN CORRECT FORMAT
+?BAD ORIGIN ORIGIN IN BINARY FILE NOT IN RANGE 200-577
+?CORE NOT ENOUGH MEMORY AVAILABLE
+?DSK DSK IS NOT FILE STRUCTURED
+?HANDLERS MORE THAN 15 HANDLERS ARE ACTIVE
+I/O ERROR ERROR DURING LOAD
+?NAME MISSING NAME
+NO ROOM TOO MANY DEVICE HANDLERS LOADED
+NAME NOT FOUND DEVICE OR FILE NAME NOT FOUND
+?PLAT TOO MANY PLATTERS SPECIFIED FOR DEVICE
+?SYNTAX BAD SYNTAX
+?SYS HANDLER IS NOT A SYSTEM HANDLER OR TWO SYSTEM HANDLERS
+ ARE ACTIVE OR HANDLER CORESIDENT WITH NON-ACTIVE SYS
+SYS ERROR I/O ERROR OCCURED WITH SYSTEM HANDLER. PRESS CONTINUE
+ TO RETRY
+SYS NOT FOUND NO ACTIVE HANDLER BY NAME OF SYS DURING BOOTSTRAP
+\f
+&
+&CCL
+OS/8 MONITOR COMMANDS
+
+CMD PROG EXPL
+
+ASSIGN KBM ASSIGNS LOGICAL NAME
+BACKSP CAMP BACKSPACES DEV
+BASIC BASIC ENTERS BASIC SYSTEM
+BOOT BOOT BOOTSTRAPS TO DEV
+CCL CCL DISABLES CCL
+COMPARE SRCCOM COMPARES FILES
+COMPILE PAL8 COMPILES PROG
+ F4/FORT
+ BASIC
+ RALF
+ SABR
+COPY FOTP COPIES FILES
+CREATE EDIT OPENS FILE FOR EDITING
+CREF PAL8 ASSEMBLES AND CHAINS TO CREF
+ CREF CREF'S LISTING
+DATE KBM/CCL SPECIFIES DATE
+DEAS CCL DEASSIGNS LOGICAL DEVICES
+DELETE FOTP DELETES FILES
+DIRECT DIRECT PRINTS DIRECTORIES
+DUPLIC RXCOPY COPIES RX DISKS
+EDIT EDIT EDITS FILE
+EOF CAMP WRITES END-OF-FILE
+EXECUTE PAL8 COMPILES AND EXECUTES
+ F4/FORT
+ BASIC
+ RALF
+ SABR
+ ABSLDR LOADS AND EXECUTES
+ LOAD(ER)
+GET KBM GETS CORE-IMAGE
+HELP HELP LIST'S HELP FILE
+LIST FOTP LISTS FILES
+LOAD ABSLDR LOADS FILES
+ LOAD(ER)
+MAKE TECO MAKES NEW FILE FOR EDITING
+MAP BITMAP PRINTS BITMAP
+MEMORY CCL SPECIFIES MACHINE CORE SIZE
+MUNG TECO MUNGS FILE WITH TECO MACRO
+ODT KBM RUNS OCTAL DEBUGGER
+PAL PAL8 RUNS PAL8
+PRINT LPTSPL RUNS 'LPTSPL' IF PRESENT
+PUNCH FOTP PUNCHES DATA
+R KBM RUNS PROGRAM FROM SYS:
+RENAME FOTP RENAMES FILES
+RESORC RESORC PRINTS RESOURCES OF SYSTEMS
+REWIND CAMP REWINDS DEV
+RUN KBM RUNS PROGRAM
+SAVE KBM SAVES CORE IMAGE
+SET SET ALTERS PARAMETERS
+SKIP CAMP SKIPS RECORDS
+SQUISH PIP SQUISHES DEV
+START KBM STARTS PROG
+SUBMIT BATCH STARTS BATCH JOB
+TECO TECO EDITS FILE
+TYPE FOTP TYPES FILES
+UA CCL REMEMBERS COMMAND
+UB CCL
+UC CCL
+UNLOAD CAMP UNLOADS DEV
+VERSION CCL TYPES VERSION #
+ZERO PIP ZEROES DEV
+
+
+
+
+@SWITCHES:
+-L OUTPUT TO LPT:
+-S OUTPUT TO TV:
+-T OUTPUT TO TTY:
+-P OUTPUT TO PTP:
+-D OUTPUT TO DUMP:
+-N OUTPUT TO NULL:
+-LS PRODUCE LISTING
+-NB NO BINARY YET
+-MP PRODUCE MAP
+-EXT SET DEFAULT EXTENSION
+
+@FEATURES:
+/X PASS SWITCH OPTION X TO PROGRAM
+(XYZ) PASS SWITCH OPTIONS TO PROGRAM
+[N] MAX OUTPUT SIZE
+=NNN PASS OCTAL NUMBER TO PROGRAM
+#NNN TAKE INTERNAL OCTAL FORM OF FILENAME
+ @FILE REPLACE IN CMD LINE BY FILE'S CONTENTS
+$ COMPLEMENT DEFAULT ALTMODE SWITCH
+\f
+&CREF
+ CREF.SV
+
+@CALLING COMMANDS:
+.CREF DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA
+.CREF DEV:INFILE.PA /LISTING TO LINE PRINTER ONLY
+.CREF INFILE.PA /LISTING TO LINE PRINTER, INPUT FILE ON DSK
+
+@SWITCHES:
+/E DON'T DELETE CREFLS.TM
+/M MAMMOTH (TWICE AS MANY SYMBOLS, TWICE AS SLOW)
+/P NO PASS 1 LISTING
+/Q SABR
+/R RALF
+/U NO LISTING OR SYMBOL TABLE
+/X NO LITERALS
+\f
+&DIRECT
+ DIRECT.SV
+
+@CALLING COMMANDS
+.DIR DEV:LISTFILE.DI<DEV:FILETYPE /* IS WILD NAME OR EXTENSION
+.DIR FILETYPE /? IS WILD CHARACTER
+
+@SWITCHES:
+/B INCLUDE STARTING BLOCK NUMBERS (OCTAL)
+/C LIST ONLY FILES WITH CURRENT DATE
+/E INCLUDE EMPTIES
+/F FAST MODE
+/I PRINT ADDITIONAL INFO WORDS
+/L USUAL MODE
+/M LIST EMPTIES ONLY
+/O LIST ONLY FILES WITH OTHER THAN TODAY'S DATE
+/R LIST REMAINDER OF FILES AFTER FIRST ONE (BUT USE /C,/O)
+/U TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V LIST FILES NOT OF FORM SPECIFIED
+/W GIVE VERSION NUMBER
+=N USE N COLUMNS
+\f
+&EDIT
+&CREATE
+ EDIT.SV
+
+@CALLING COMMANDS:
+.EDIT DEV:OUTFILE.PA<DEV:INFILE.PA
+.CREATE OUTFILE.PA
+
+@SWITCHES:
+/A RETURN TO EDITOR ON CLOSE
+/B CONVERT 2 OR MORE SPACES TO TAB
+/D PREDELETE
+
+@ERRORS:
+?0 INPUT ERROR
+?1 OUTPUT ERROR
+?2 CLOSE ERROR
+?3 OPEN ERROR
+?4 COULDN'T LOAD DEVICE HANDLER
+
+@INTERNAL COMMANDS:
+A APPEND TEXT
+B LIST # OF CORE LOCATIONS LEFT
+C CHANGE TEXT
+D DELETE TEXT
+E OUTPUT BUFFER, TRANSFER REST OF DATA, AND CLOSE
+F AFTER J, SEARCH FOR NEXT OCCURRRENCE OF SAME STRING
+G GET AND LIST TAGGED LINE
+I INSERT
+J INTER-BUFFER STRING SEARCH
+K KILL BUFFER
+L LIST TEXT
+M MOVE TEXT
+N WRITE BUFFER, KILL AND READ NEXT PAGE
+P WRITE TEXT BUFFER TO OUTPUT
+Q IMMEDIATE END OF FILE
+R READ TEXT FROM INPUT DEVICE
+S CHARACTER SEARCH
+T PUNCH TRAILER TAPE
+V PRINT ON LP08
+Y INPUT TEXT PAGE, NO OUTPUT
+# PRINT VERSION NO.
+
+\f
+&EPIC
+ EPIC.SV
+
+@SWITCHES:
+/0$ PAPER TAPE I/O TO/FROM OS/8 FILES
+ /E DON'T PUNCH EOT
+ /H SET HIGH BIT=N
+ /L LOW SPEED
+ /P PUNCH PATCH
+ /Z REL BLOCK=0
+ =N REL BLOCK TO PATCH
+ NO OUT FILE IS READ
+
+FILE</1$ EDIT 'FILE'
+ C CURRENT STATUS
+ E EXIT TO CD
+ O,N OPEN BLOCK N
+ R,N READ BLOCK N
+ S,N,M SEARCH FOR N WITH MASK M
+ W WRITE
+
+FILE1<FILE2/2$ COMPARE FILE1 AND FILE2
+ /A ABORT
+ /B BAD BLOCKS ONLY
+\f
+&FORT
+ FORT.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.EXE INFILE.FT
+
+@SWITCHES:
+/G GO
+/K KEEP FORTRN.TM
+/L LOAD
+
+@ERRORS:
+
+ALOG ATTEMPT TO COMPUTE LOG OF NEGATIVE NUMBER
+IOER INPUT/OUTPUT ERROR
+CHER CHAIN ERROR
+FMT1 INVALID FORMAT STATEMENT
+FMT2 ILLEGAL CHARACTER IN I FORMAT
+FMT3 ILLEGAL CHARACTER IN E OR F FORMAT
+DIVZ ATTEMPT TO DIVIDE BY 0
+EXP ARGUMENT TO EXP TOO LARGE
+OVFL FLOATING POINT OVERFLOW
+FLPW ATTEMPT TO RAISE NEGATIVE NUMBER TO REAL POWER
+SQRT ATTEMPT TO TAKE SQUARE ROOT OF NEGATIVE NUMBER
+FIX ATTEMPT TO FIX NUMBER GREATER THAN 2047
+\f
+&FRTS
+ FRTS.SV
+
+@SWITCHES:
+/C CARRIAGE CONTROL SWITCH
+/E IGNROE ERRORS
+/H HALT BEFORE STARTING
+/P PUNCH TO PAPER TAPE
+\f
+&F4
+&FORTRAN
+ F4.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:RALFFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.COMPILE INFILE.FT /FROM DSK
+
+@SWITCHES:
+/A RETURN TO KBM AFTER COMPILATION
+/F PRODUCE RALF LISTING
+/N SUPPRESS INTERNAL STATEMENT NUMBERS
+/Q OPTIMIZE
+
+.HELP F4ERR PRINTS FORTRAN IV COMPILER ERROR MESSAGES
+\f
+&F4ERR
+ F4.SV (ERRORS)
+
+@ERRORS:
+AA MORE THAN 6 SUBROUTINE ARGUMENTS ARE ARRAYS
+AS BAD ASSIGN STATEMENT
+BD BAD DIMENSIONS
+BS ILLEGAL STATEMENT IN BLOCK DATA SUBPROGRAM
+CL BAD COMPLEX LITERAL
+CO SYNTAX ERROR IN COMMON STATEMENT
+DA BAD SYNTAX IN DATA STATEMENT
+DE ILLEGAL STATEMENT AT END OF DO
+DF BAD DEFINE FILE STATEMENT
+DH HOLLERITH FIELD ERROR IN DATA STATEMENT
+DL DATA LIST AND VARIABLE LIST ARE NOT SAME LENGTH
+DN DO-END MISSING OR INCORRECTLY USED
+DO SYNTAX ERROR IN DO OR IMPLIED DO
+DP DO LOOP PARAMETER NOT INTEGER OR REAL
+EX SYNTAX ERROR IN EXTERNAL STATEMENT
+GT SYNTAX ERROR IN GOTO STATEMENT
+GV ASSIGNED OR COMPUTED GOTO VARIABLE NOT INTEGER OR REAL
+HO HOLLERITH FIELD ERROR
+IE ERROR READING INPUT FILE
+IF IMPROPER STATEMENT USED WITH LOGICAL IF
+LI ARGUMENT TO LOGICAL IF IS NOT LOGICAL
+LT INPUT LINE TOO LONG (TOO MANY CONTINUATIONS)
+MK MISSPELLED KEYWORD
+ML MULTIPLY DEFINED LINE NUMBER
+MM MISMATCHED PARENTHESES
+MO EXPECTED OPERAND IS MISSING
+MT MIXED VARIABLE TYPES
+OF ERROR WRITING OUTPUT FILE
+OP ILLEGAL OPERATOR
+OT OPERAND TYPE WRONG FOR GIVEN OPERATOR
+PD COMPILER STACK OVERFLOW, STATEMENT TOO BIG OR TOO MANY NESTED LOOPS
+PH BAD PROGRAM HEADER LINE
+QL NESTING ERROR IN EQUIVALENCE STATEMENT
+QS SYNTAX ERROR IN EQUIVALENCE STATEMENT
+RD ATTEMPT TO REDEFINE THE DIMENSIONS OF A VARIABLE
+RT ATTEMPT TO REDEFINE THE TYPE OF A VARIABLE
+RW SYNTAX ERROR IN READ/WRITE STATEMENT
+SF BAD ARITHMETIC STATEMENT FUNCTION
+SN ILLEGAL SUBROUTINE NAME IN CALL
+SS ERROR IN SUBSCRIPT EXPRESSION
+ST COMPILER SYMBOL TABLE FULL
+SY SYSTEM ERROR; PASS MISSING OR NO ROOM FOR OUTPUT
+TD BAD SYNTAX IN TYPE DECLARATION STATEMENT
+US UNDEFINED STATEMENT NUMBER
+VE VERSION ERROR
+\f
+&LIBRA
+ LIBRA.SV
+
+@SWITCHES:
+/C CONTINUE INPUT SPECIFICATIONS
+/I INSERTION DECISION
+/R REPLACE MODULE
+/Z REPLACE LIBRARY
+=N EXTRA BLOCKS
+\f
+&LOAD
+ LOAD.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:OUTFILE.LD<DEV:INFILE1.RL,...
+
+@SWITCHES:
+/C MORE INPUT TO LOAD
+/G CHAIN TO RUN-TIME SYSTEM
+/L ACCEPT LIBRARY FILE
+/O MORE OVERLAYS
+/S SYMBOL MAP
+/U IGNORE RULES GOVERNING SUBROUTINE CALLS BETWEEN OVERLAYS
+\f
+&LOADER
+ LOADER.SV
+
+@CALLING COMMANDS:
+.LOAD MAPFILE.MP<INFILE.RL,...
+
+@SWITCHES:
+/G GO
+/H 2 PAGE HANDLERS
+/I OS/8 FILE INPUT
+/L 1ST INPUT FILE IS LIBRARY FILE
+/M PRODUCE MAP
+/O OS/8 FILE OUTPUT
+/P OUTPUT COUNT OF FREE PAGES
+/R RESTART
+/U OUTPUT UNDEFINED SYMBOLS
+/N LOAD IN FIELD N (0-7) OR HIGHER
+=N SET STARTING ADDRESS
+\f
+&MAP
+&BITMAP
+ BITMAP.SV
+
+@CALLING COMMANDS:
+.MAP MAPFILE.MP<INFILE.BN,...
+
+@SWITCHES:
+/N FORCES MAPPING OF ALL FILES TO FIELD N (0-7)
+/R RESET INTERNAL MAP
+/S ALLOW MULTIPLE BINARIES PER FILE
+/T INVERT TTY-STYLE OUTPUT SWITCH
+\f
+&ODT
+ ODT
+
+@CALLING COMMANDS:
+.ODT
+
+@INTERNAL COMMANDS:
+NNNNN/ OPEN LOC
+/ REOPEN LAST OPENED LOC
+NN<CR> DEPOSIT NN IN OPEN LOC, CLOSE LOC
+NN<LF> DEPOSIT NN IN OPEN LOC, CLOSE LOC, OPEN AND DISPLAY NEXT LOC
+NN;... DEPOSIT NN IN OPEN LOC, CLOSE AND OPEN NEXT LOC
+<CR> CLOSE PREVIOUSLY OPENED LOC
+<LF> CLOSE LOC, OPEN NEXT LOC
+N+ OPEN CUR LOC+N
+N- OPEN CUR LOC-N
+^ CLOSE LOC, OPEN LOC ADDRESSED BY CONTENTS
+_ CLOSE LOC, OPEN POINTED TO BY CONTENTS
+NNG GO
+NNB ESTABLISH BREAKPOINT
+B REMOVE BREAKPOINT
+A OPEN AC
+L OPEN LINK
+C CONTINUE FROM BREAKPOINT
+NNC CONTINUE, ITERATE NN TIMES
+M OPEN SEARCH MASK
+ <LF> OPEN LOWER SEARCH LIMIT
+ <LF> OPEN UPPER SEARCH LIMIT
+NNW SEARCH CORE FOR NN MASKED BETWEEN LIMITS
+D OPEN DATA FIELD (0010=FIELD 1)
+F OPEN FIELD FOR ^, _, W (0010=FIELD 1)
+^O SUPRESS PRINTING
+\f
+&PAL8
+&PAL
+ PAL8.SV
+
+@CALLING COMMANDS:
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA/C
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS<DEV:INFILE.PA
+.PAL INFILE.PA /FROM DSK
+
+.HELP PALERR PRINTS PAL8 ERROR MESSAGES
+
+@SWITCHES:
+/B TREAT ! AS BYTE SHIFT
+/C CHAIN TO CREF
+/D DDT-COMPATIBLE SYMBOL TABLE
+/E ENABLE ERROR MSG ON LINK GENERATED
+/F DISABLE 0-FILL IN TEXT
+/G GO
+/H NON-PAGINATED OUTPUT
+/J DON'T LIST LINES CONDITIONALIZED OUT
+/K USE EXTRA CORE
+/L LOAD
+/N NO LISTING
+/O DISABLE ORIGIN 200 AFTER FIELD
+/S NO SYMBOL TABLE
+/T NO FORM FEEDS
+/W DON'T REMEMBER LITERALS
+\f
+&PALERR
+ PAL8.SV (ERRORS)
+
+@ERRORS:
+BE TABLES OVERLAPPED
+CF CREF.SV NO ON SYS:
+DE DEVICE ERROR
+DF DEVICE FULL
+IC ILLEGAL CHARACTER
+ID ILLEGAL REDEFINITION
+IE ILLEGAL EQUALS
+II ILLEGAL INDIRECT
+IP ILLEGAL PSEUDO-OP
+IZ ILLEGAL PAGE ZERO REF
+LD SYS:ABSLDR.SV NOT FOUND
+LG LINK GENERATED
+PE PAGE EXCEEDED
+PH END OF SOURCE CONDITIONALIZED OUT
+RD REDEFINITION
+SE SYMBOL TABLE EXCEEDED
+UO UNDEFINED ORIGIN
+US UNDEFINED SYMBOL
+ZE PAGE 0 EXCEEDED
+\f
+&PIP
+ PIP.SV
+
+@SWITCHES:
+/A ASCII MODE
+/B BINARY MODE
+/C ELIM TRAILING BLANKS
+/D DELETE OUTPUT FILE BEFORE TRANSFER
+/G IGNORE ERRORS
+/I IMAGE MODE
+/O OKAY TO COMPRESS OR ZERO
+/S SQUISH
+/T CONVERT TABS TO SPACES, ETC.
+/V VERSION #
+/Y COPY SYSTEM HEAD
+/Z ZERO OUTPUT DIRECTORY BEFORE TRANSFER
+=N # OF ADDITIONAL INFO WORDS (/Z OR /S)
+=N SIZE TO CLOSE OUTPUT FILE (/I)
+\f
+&PIP10
+ PIP10.SV
+
+@SWITCHES:
+/B BINARY MODE
+/D DELETE OLD OUTPUT FILE BEFORE TRANSFER
+/F FAST PDP-10 DIRECTORY
+/I IMAGE MODE
+/L LIST PDP-10 DIRECTORY
+/P PRESERVE LINE NUMBERS
+/Z ZERO PDP-10 DIRECTORY BEFORE TRANSFER
+\f
+&DUPLIC
+&RXCOPY
+ RXCOPY.SV
+
+@CALLING COMMANDS:
+.DUPLIC OUTDEV:<INDEV:
+
+@SWITCHES:
+/M MATCH WITH NO IMPLIED COPY
+/N COPY WITH NO IMPLIED MATCH
+/P PAUSE BEFORE AND AFTER ACCESSING DISKS
+/R READ OUTPUT DEVICE WITH NO IMPLIED COPY OR MATCH
+/V PRINT VERSION NUMBER
+\f
+&SABR
+ SABR.SV
+
+@CALLING COMMANDS:
+.COMPILE BINFILE.RL,LISTFILE.LS,MAPFILE.MP<INFILE.SB
+.EXE DEV:BINFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.SB
+
+@SWITCHES:
+/F INPUT IS FROM FORT
+/G CHAIN TO LOADER AND GO
+/L CHAIN TO LOADER
+/N NO LISTING
+/S NO SYMBOL TABLE
+
+@ERRORS:
+A WRONG NO. OFARG'S
+C BAD CHAR
+D I/O ERROR
+E NO END STMNT
+I ILLEGAL SYNTAX
+L SYS:LOADER.SV NOT FOUND
+M MULTIPLY DEFINED SYMBOL
+S SYMBOL OVERFLOW
+U UNDEFINED SYMBOL
+\f
+&SET
+ SET.SV
+
+@CALLING COMMANDS:
+.SET DEV PARAMETER(S)
+.SET DEV NO PARAMETER(S)
+
+@PARAMETERS:
+READONLY DECLARE DEVICE TO BE READ ONLY
+FILES DECLARE DEVICE TO BE FILE STRUCTURED
+DVC CHANGE DEVICE CODES
+VERSION X CHANGE VERSION
+LOCATION N[=M] EXAMINE OR CHANGE LOCATIONS
+LV8E DECLARE LINE PRINTER TO BE AN LV8E
+LA8A DECLARE LINE PRINTER TO BE LA180 ON DKC8-AA
+LA78 SAME AS .SET LPT NO LA8A
+WIDTH N SET WIDTH OF LINE PRINTER OR TTY
+LC DECLARE LINE PRINTER OR TTY TO HAVE LOWER CASE
+ECHO RESTORE TTY CHARACTER ECHOING
+PAGE RESTORE TTY ^S AND ^Q FACILITIES
+TAB IN TTY PRINT TABS (DON'T SIMULATE WITH SPACES)
+FILL IN TTY APPEND FILL CHARACTERS AFTER TABS
+FLAG IN TTY FLAG LOWER CASE CHARACTERS
+SCOPE ERASE CHARACTER ON TTY RUBOUTS
+ESC PRINT ESC(ASCII 033) WITHOUT CONVERTING IT TO $ SIGN
+ARROW PRINT CONTROL CHARACTERS WITH UP ARROW (E.G. ^C, ^S)
+HEIGHT [M] SET TTY SCREEN HEIGHT
+PAUSE [N] SET TTY PAUSE TIME
+COL N SET DIRECT TO USE N COLUMNS (.SET TTY COL 2)
+CODE N CHANGE TTY IOTS OR CARD READER CODES
+PARITY EVEN/ODD SET MAGTAPE PARITY
+OS8 DECLARE SYS TO BE OS/8
+OS78 DECLARE SYS TO BE OS/8
+INIT XXXXX CAUSE SYS TO EXECUTE XXXXX ON BOOTSTAPPING
+\f
+&SRCCOM
+&COMPAR
+ SRCCOM.SV
+
+@CALLING COMMANDS:
+.COMPAR DEV:OUTFILE.PA<DEV:INFILE1.PA,DEV:INFILE2.PA
+.COMPAR OUTFILE.PA<INFILE1.PA,INFILE2.PA /FILES ON DSK
+
+@SWITCHES:
+/B COMPARE BLANK LINES
+/C DON'T COMPARE (SLASHED) COMMENTS
+/S DON'T COMPARE TABS AND SPACES
+/T CONVERT TABS TO SPACES ON OUTPUT
+/X DON'T COMPARE OR PRINT COMMENTS
+
+@ERRORS:
+?0 INSUFFICIENT CORE
+?1 INPUT ERROR FILE 1 (OR LESS THAN 2 INPUT FILES)
+?2 INPUT ERROR FILE 2
+?3 OUTPUT FILE TOO LARGE
+?4 OUTPUT ERROR
+?5 CAN'T OPEN OUTPUT FILE
+\f
+&BATCH
+&SUBMIT
+ BATCH.SV
+
+@CALLING COMMANDS:
+.SUBMIT SPOOLDEV:<INPUTDEV:FILE.BI
+
+@SWITCHES:
+/C CARDS
+/E DON'T ABORT ON MONITOR, CD AND CCL ERRORS
+/P PTR
+/Q NO BATCH LOG
+/H HUSH
+/T OUTPUT TO TTY
+/U UNATTENDED
+/6 USE 026 CARD CODES
+\f
+&TECO
+&MAKE
+&MUNG
+ TECO.SV
+
+@CALLING COMMANDS:
+.TECO DEV:OUTFILE.PA<DEV:INFILE.PA
+.TECO FILE.PA /ON DSK
+.MAKE DEV:OUTFILE.PA
+.MAKE OUTFILE.PA /ON DSK
+.MUNG DEV:INFILE.PA,TECO MACRO ARGUMENT TEXT
+
+@ERRORS:
+?ILL ILLEGAL COMMAND
+?UTC UNTERMINATED COMMAND
+?IQN ILLEGAL Q-REGISTER NAME
+?PDO INTERNAL PUSH DOWN OVERFLOW (RECURSION)
+?MEM MEMORY OVERFLOW
+?STL SEARCH STRING TOO LONG
+?ARG ARGUMENT ERROR
+?IFN ILLEGAL FILE NAME
+?SNI SEMICOLON NOT IN ITERATION
+?BNI CLOSE BRACKET NOT IN ITERATION
+?POP POINTER OFF PAGE
+?QMO Q-REGISTER OVERFLOW
+?UTM UNTERMINATED MACRO
+?OUT OUTPUT ERROR
+?INP INPUT ERROR
+?FER FILE ERROR
+?FUL OUTPUT COMMAND WOULD HAVE OVERFLOWED
+?NAY NEGATIVE ARGUMENT TO Y
+?IEC ILLEGAL E CHARACTER
+?IQC ILLEGAL " CHARACTER
+?NAE NO ARGUMENT BEFORE =
+?NAU NO ARGUMENT BEFORE U
+?NAQ NO ARGUMENT BEFORE "
+?SRH FAILING SEARCH
+?NAP NEGATIVE OR 0 ARGUMENT TO P
+?NAC NEGATIVE ARGUMENT TO ,
+?NIC NEGATIVE OR 0 ITERATION COUNT
+?NAS NEGATIVE OR 0 COUNT TO SEARCH
+?WLO CAN'T WRITE OUT ERROR MESSAGE OVERLAY
+?NFO NO FILE FOR OUTPUT
+\f
+&FOTP
+&LIST
+©
+&RENAME
+&TYPE
+&DELETE
+ FOTP.SV
+
+@CALLING COMMANDS:
+.COPY DEV:OUTFILE.EX<DEV:INFILE.EX /* IS WILD NAME OR EXTENSION
+.REN DEV:NEWFILE.EX<DEV:OLDFILE.EX /? IS WILD CHARACTER
+.DEL DEV:FILE.EX
+.LIST DEV:FILE.EX /= .COPY LPT:<DEV:FILE.EX
+.TYPE DEV:FILE.EX /= .COPY TTY:<DEV:FILE.EX
+
+@SWITCHES:
+/C MATCH ONLY FILES WITH CURRENT DATE
+/D DON'T TRANSFER (I.E. AT MOST ONLY DELETE)
+/F REQUEST NEW DEVICE IF OUT OF ROOM
+/L TYPE LOG OF INPUT FILENAME MATCHES (*)
+/N NO PRE-DELETE
+/O MATCH ONLY FILES WITH OTHER THAN TODAY'S DATE
+/Q QUERY USER ABOUT FILE BEFORE OPERATION (*)
+/R RENAME
+/T USE TODAY'S DATE
+/U TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V MATCH FILES NOT OF FORM SPECIFIED
+/W PRINT VERSION #
+
+NOTES:
+
+(*) /D CAUSES LOG OF OUTPUT FILES (IF /L ALSO)
+
+IF INDEV: EQUALS OUTDEV:, THEN /N IS FORCED.
+
+IF NO INPUT FILE, *.* IS FORCED EXCEPT FOR /D
+IF OUTPUT DEVICE SPECIFIED, BUT NO FILE, *.* IS ASSUMED.
+
+^P ABORT OPERATION, FIX OUTPUT DIRECTORY
+^C FIX OUTPT DIRECTORY, RETURN TO OS/8
+^O SUPPRESS TYPEOUT
+\f
+&ASSIGN
+&DATE
+&DEASSIGN
+&GET
+&MEMORY
+&R
+&RUN
+&SAVE
+&START
+&SQUISH
+&UA
+&ZERO
+ KEYBOARD MONITOR AN OTHER COMMANDS
+
+@CALLING COMMANDS:
+.ASSIGN DEV NAME /ASSIGN NAME TO DEVICE
+.DAY DD-MON-YY /ENTER DATE INTO SYSTEM
+.DEASSIGN /DEASSIGN LOGICAL DEVICE NAMES
+.GET DEV FILE.EX /LOAD CORE IMAGE
+.MEMORY N /SPECIFY HIGHEST MEMORY FIELD AVAILABLE
+.R FILE /EXECUTE FILE.SV FROM SYS
+.RUN DEV FILE.EX /EXECUTE FILE.EX FROM THE DEVICE
+.SAVE DEV FILE.EX /SAVE CORE IMAGE
+.SQUISH DEV: /COMPRESS FILE STORAGE ON DEVICE
+.START FNNNN /START EXECUTION
+.UA COMMAND /SAVE COMMAND(.UA<CR> EXECUTES IT)
+.ZERO DEV: /ZERO DEVICE'S DIRECTORY
+\f
--- /dev/null
+/12 OS8 MONITOR SYSTEM OS8 VERS. 3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/13-APRIL-1977 RL/EF/HJ/SR
+
+
+ /THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM
+ /AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM
+ /IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8
+ /USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE
+ /QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH.
+ /THIS VERSION IS COMPATIBLE WITH CCL.
+
+/ SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:
+
+ MEOVLY=26 /DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
+ MCDREC=51 /COMMAND DECODER
+ MSOVLY=54 /"SAVE W. ARGS" OVERLAY
+ MSOVL2=55 /SECOND PART OF SAVE W. ARGS
+ MERRTN=56 /MONITOR ERROR ROUTINE
+ MRUNRC=57 /"CHAIN" OVERLAY
+ ODTREC=60 /SYSTEM ODT
+ MFREE=70 /BEGINNING OF FILE STORAGE
+ CCB=7400
+ CSOVLY=400
+ RSOVL1=1400
+ RSOVL2=2000
+
+ VERSNO=3
+ PATCHLEV="Q
+
+/V3 CHANGES:
+
+/1. CCL SUPPORT
+/2. FIXED KILLER CLOSE BUG
+/3. ADDED VERSION NUMBER
+/4. ^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN
+/5. CALL TO USR WITH CODE OF 0 GIVES ERROR
+/6. MONITOR ERROR MESSAGES NOW GIVE EXPLANATION
+/7. ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT
+/8. DIRECTORY VERIFICATION HAS IMPROVED
+
+/V3 FIXES TO ABSLDR:
+
+/1. ALLOWED PARITY ^C
+/2. PUT IN SELF-STARTING STUFF
+/3. FIXED CCB BUG FOR 17600
+
+/FIXES TO FIELD RELEASE
+
+/1. ABSLDR CHECKS PAGE 0 LITERALS
+/2. FIXED BUG RE MONITOR ERROR MESSAGES
+/3. ADDITIONAL INFO FIX
+/4. BATCH FIX
+
+/FIXES FOR MAINTENANCE RELEASE:
+
+/1. CHANGED VERSION NUMBER OF MONITOR TO V3M
+/2. INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
+/ [SEQ #1, DSN APRIL 1975]
+/3. ALLOW CHAIN TO WORK ON FULL FIELD SAVES
+/ [SEQ #2, DSN JUNE 1975]
+/4. ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
+/ [SEQ #1, DSN OCTOBER 1975]
+/5. ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
+/ MAINT. RELEASE VERSION # IS V4
+/6. SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975
+
+/V3D AND OS/78 CHANGES:
+
+/1. ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
+/2. CHANGED VERSION NUMBER TO V3Q
+/3. ADDED DATE/78 CHANGES
+/4. FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
+/5. ADDED STUFF FOR LINKER [USES SOFSET]
+/6. CHANGED ABSLDR DATE TO 1-JUNE-77
+/7. DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
+/8. ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
+/9. ALLOW @ IN KBM COMMAND
+/10. COULD RUN INIT.CM ON SYSTEM START-UP
+/11. CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
+/12. CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
+\f /KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT
+
+ FIELD 0
+ MTHREE=CLA CLL CMA RTL
+ *200
+PRINT, JMP I PRNAME /MUST BE AT 200 FOR BATCH
+ JMP .+3 /****GETS CIF CDF N FOR BATCH*****
+ TSF /****GETS JMP I .+1******
+ JMP .-1 /*GETS BOSPRT*****
+ TLS
+ CLA
+ TAD [7000
+ DCA PRINT+1
+ JMP I PRINT
+GETNAM, 0
+ DCA NM1
+ DCA NM2
+ DCA NM3
+ DCA NM4
+ TAD [NM1
+ DCA PN
+ CLA CMA
+ DCA PRDSW
+GTNMX, DCA NMCT
+ TAD I LXR
+ TAD [-240
+ SNA
+ JMP .-3
+ TAD [240
+ SKP
+GTNMLP, TAD I LXR
+ DCA TMP
+ TAD TMP
+ TAD [-256
+ SNA
+ JMP PERIOD
+ TAD [-2
+ CLL
+ TAD [-12
+ SNL CLA
+ JMP NINSRT
+ TAD [-301
+ TAD TMP
+ CLL CML
+ TAD [-32
+ SNL CLA
+ JMP EONAME
+NINSRT, TAD NMCT
+ TAD [-6
+ SMA CLA
+ JMP GTNMLP
+ TAD NMCT
+ CLL RAR
+ TAD PN
+ DCA TEMP1
+ TAD TMP
+ AND [77
+ SZL
+ JMP .+4
+ RTL
+ RTL
+ RTL
+ TAD I TEMP1
+ DCA I TEMP1
+ ISZ NMCT
+ JMP GTNMLP
+PERIOD, ISZ PRDSW
+ JMP EONAME
+ ISZ PN
+ TAD [4
+ JMP GTNMX
+EONAME, TAD NMCT
+ SZA CLA
+ ISZ GETNAM
+ JMP I GETNAM
+\fPRNAME, 4000
+ TAD NM1
+ JMS PRWD
+ TAD NM2
+ JMS PRWD
+ TAD NM3
+ JMS PRWD
+ TAD NM4
+ SNA CLA
+ JMP I PRNAME
+ TAD [256
+ JMS PCHAR
+ TAD NM4
+ JMS PRWD
+ JMP I PRNAME
+PRINLP, JMS PRWD
+ ISZ PRMESG
+ SKP
+ IFNZRO .-330 <CCLTRB,ERRR>
+PRMESG, 0
+ CLA
+ TAD I PRMESG
+ SZA
+ JMP PRINLP
+ TSF
+ JMP .-1
+ JMP I ERRET
+PRWD, 0
+ DCA TMP
+ TAD TMP
+ RTR
+ RTR
+ RTR
+ JMS PCHAR
+ TAD TMP
+ JMS PCHAR
+ JMP I PRWD
+PCHAR, 0
+ AND [77
+ SNA
+ JMP I PCHAR
+ TAD [240
+ AND [77
+ TAD [240
+ JMS I PCH
+ JMP I PCHAR
+\fPRINTQ, JMS PRMESG
+ TEXT /?/
+ 0
+
+ *367
+KSV2A, SAVE2A
+SAVE2, TAD I LXR
+ SNA /ARE THERE ARGUMENTS?
+ JMP I KSV2A /NO..USE CCB
+ JMS I [SHNDLR /READ IN ARGUMENT OVERLAY
+ 0201
+ CSOVLY
+ MSOVLY
+ JMP KMONER /NORMAL RETURN IS TO 400
+\f *400
+KMNTRY, JMP I HANDAD /V3
+ 0 /FREE LOCATION !
+PCRLF, JMS I [CRLF
+ IFNZRO .-403 <BTCHER,XXXX>
+
+KEYMON, JMS I GLINE
+ TAD [BEGLN-1 /ADDRESS REFERENCED BY INIT
+ DCA LXR
+ JMS I GNAME
+/V3D JMP I [PRINTQ
+ XXX=[PRINTQ /NEED LITERAL IN SAME PLACE
+ NOP /V3D ALLOW @ IN NAME
+ JMS I [SRCH
+ -123; ASSIGN
+ -2301; SAVE
+ -2225; RUN
+ -705; GET
+ -2200; R
+ -2324; START
+ -1704; ODT
+ -0405; DEAS
+ IFNZRO .-431 <SEECCL,ZZZ>
+ -0401; DATE
+ 0
+ JMP I .+1
+CCLSW, PRQMRK /MODIFIED FOR CCL TO 'GETCCL'
+ IFNZRO CCLSW-435 <SEECCL,ZZ>
+
+ASSIGN, TAD [12
+ JMS GDEVNO
+ TAD [UDNAME-1
+ DCA TM1
+ JMS I GNAME
+ JMP ASGN2+1 /NO USER DEV. DO A DEASSIGN
+ TAD NM2 /SEE IF WE HASH IT
+ SNA
+ JMP ASGN2 /DON'T HASH..ONLY 1 OR 2 CHARS
+ TAD NM1
+ RAL /LINK BECOMES 4000 IF NECESSARY
+ CLA CML RAR
+ TAD NM2
+ASGN2, TAD NM1
+ JMP I [ASDONE
+\fR, DCA I [GETSW
+ TAD P6203
+ JMS I [RESET
+ ISZ RUNSW
+ TAD [SHNDLR
+ DCA HANDAD
+ CLA IAC
+ JMP RGETPG
+GDEVNO, 0
+ DCA ASNM1-1
+ JMS I [MINCOR
+ JMS I GNAME
+ JMP I [KMER4
+ TAD NM1
+ DCA ASNM1
+ TAD NM2
+ DCA ASNM1+1
+ TAD HNDLAD
+ DCA HANDAD
+ CIF 10
+ JMS I SYSTEM
+ 1
+ASNM1, 0;0
+HANDAD, KMINIT /V3
+ JMP I [KMER1
+ TAD ASNM1+1
+ JMP I GDEVNO
+\fGET, TAD [SKP
+RUN, DCA I [GETSW
+ TAD P6203
+ JMS I [RESET
+ DCA RUNSW
+ CLA IAC
+ JMS GDEVNO
+RGETPG, JMS RSCOMN
+ JMS I [MINCOR
+ TAD SENTER
+ CIF 10
+ JMS I SYSTEM
+ 2
+PGNAME, NM1
+ MOVBUF /USED AS POINTER TO FIELD 1 SR
+ JMP I [KMER2
+ JMP I [RLOADR
+RSCOMN, 0
+ DCA SENTER
+ TAD HANDAD
+ DCA DEVHND
+ JMS I GNAME
+ JMP I [KMER4
+ TAD NM4
+ SNA
+ TAD [2326
+ DCA NM4
+ JMP I RSCOMN
+SAVE, TAD [SAVE12 /CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE
+ DCA ERRET
+ TAD I [JSBITS
+ JMS I [RESET
+ CIF 10 /MOVE THE LINE BUFFER TO 1600 DURING
+ JMS I PGNAME+1 /A SAVE, AS HANDLER WIPES IT OUT
+ TAD LXR /LET'S MOVE THE REGISTER AROUND
+ TAD [SVLNBF-BEGLN
+ DCA LXR
+ TAD [1001
+ DCA HNDLAD
+ CLA IAC
+ JMS GDEVNO
+ JMS RSCOMN
+ JMP I [SAVE2
+HNDLAD, /REPLACED WITH 1001 BY SAVE
+
+WRCTLB, 7001 /WRITE OVERLAY AND CCB
+ JMS I [SHNDLR
+ 4600
+ 6200
+ MTEMP+6
+ JMP KMONER
+ JMP I WRCTLB
+\f *573 /LOADS SYSTEM ODT OVER THE MONITOR
+ODT, JMS I PGTOUT
+ JMS I [SHNDLR
+ 1001
+ 0
+ ODTREC
+ /LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
+\f *600
+START, DCA TEMP1
+ DCA TEMP2
+ TAD I LXR /V3
+ SZA /V3
+ JMP I [STRTX /V3
+ TAD I [JFIELD
+ DCA I [MSTCDF
+ TAD I [JSBITS
+ AND [1000
+ SZA CLA
+ JMP I [KMER3
+ TAD I [JSBITS
+ JMS I [RESET /RESET ONLY IF NO START ADR SPECIFIED
+ TAD I [JSTART
+STCOMN, DCA I [MSTADR
+ TSF
+ JMP .-1 /WAIT FOR PRINTER TO FINISH
+ JMS I PGTOUT
+ TAD I [JSBITS
+ SPA CLA
+ JMP I [MSTCDF
+ TAD [SHNDLR
+ DCA I [MREAD-1
+ TAD [1000
+ DCA I [MREAD+1
+ DCA I [MREAD+2
+ TAD [MTEMP+4
+ DCA I [MREAD+3
+ TAD FUDJMP
+ DCA I [MSWITC
+ JMP I [MREAD
+\fMINCOR, 0
+ CIF 10
+ JMS I SYSTEM
+ 10
+ CDF 10
+ DCA I [OLDT9 /ZERO OUT "DIRECTORY IN CORE" KEY
+ CDF 0
+ TAD [200
+ DCA SYSTEM
+ JMP I MINCOR
+RLOADR,
+RUN1, TAD I [PGNAME
+ DCA FILE
+ JMS I DEVHND
+ 0101
+ CCB
+FILE, 0 /READ IN THE HEADER BLOCK
+ JMP KMONER /ERROR WHILE READING HEADER BLOCK
+ TAD I [CCB
+ JMS I [CCBTST /TEST FOR VALID CORE CONTROL
+ TAD I [CCB+3 /V3D
+ RAL /V3D
+ JMS I KRCHK /V3D CAN'T RUN SYSTEM CUSP UNDER OS78
+ TAD I [CCB+1
+ DCA I [MSTCDF
+ TAD I [CCB+2
+ DCA I [MSTADR /MOVE THE STARTING ADDRESS INTO UPPER CORE
+ TAD I [CCB+1
+ DCA I [JFIELD
+ TAD I [CCB+2
+ DCA I [JSTART
+ TAD I [CCB+3 /SET UP THE JOB INFORMATION AREA
+ JMS I [RESET /AND CLEAR INFORMATION ABOUT "RUN" HANDLER
+ TAD FUDJMP
+ DCA I [MSWITC /SET MSWITC TO INHIBIT LOADING 7400
+GETSW, SKP /SKP FOR GET, NOP FOR RUN
+ JMP RUN2
+ TAD P6203
+ DCA I [MSTCDF
+ TAD [7600
+ DCA I [MSTADR /IF A GET, SET STARTING ADDRESS TO RETURN
+ /TO MONITOR
+\fRUN2, TAD I [CCB
+ CLL CMA RAL /POINT TO LAST DOUBLEWORD IN CCB
+ TAD [CCB+4
+ DCA TM1 /TM1 POINTS TO SEG. ADDRESS
+ TAD I TM1 /STORE ADDRES TO READ POSSIBLE OVERLAY
+ DCA I [MREAD+2
+ ISZ TM1 /POINT TO SEGMENT CONTROL WORD
+ TAD DEVHND /IF THE HANDLER IS IN 7600, OR
+ TAD [200 /IF THE SEGMENT DOES NOT LOAD OVER
+ CLA RAL /7000, NO OVERLAY IS NEEDED. ALSO IF
+ TAD I TM1 /THE SEGMENT IS IN FIELDS 1-7.
+ AND [77
+RUN5A, SZA CLA
+ JMP I [RUN6 /NO PROBLEMS.. READ STUFF IN
+ TAD I [MREAD+2 /SEE IF WE OVERLAY 7000
+ CLL CML RAR
+ TAD I TM1 /ADD IN CONTROL WORD
+ TAD [300
+ SPA /IF NEGATIVE, 7000 IS NOT OVERLAYED
+ JMP RUN5A
+ TAD [7600 /GETS 0, 100, 200, OR 300
+ SMA /IF POSITIVE READ 3 PAGE OVERLAY
+ ISZ I [PGNAME+1 /POINT TO NEXT TO LAST RECORD
+ TAD [300
+ DCA RDCNT
+ TAD I [PGNAME+1
+ CMA /GET RECORD TO READ OVERLAY FROM
+ TAD FILE
+ DCA R7000
+ JMS I DEVHND /READ OVERLAY FROM THE FILE INTO PAGES
+RDCNT, 0 /BEFORE CCB
+ 6200 /THEN WRITE THE WHOLE MESS OUT
+R7000, 0
+ JMP I [RERR
+ JMS I [WRCTLB /WRITE OUT THE OVERLAY+CCB
+ DCA .-1 /BUT ONLY ONCE!!
+ ISZ RUNSW
+ DCA I [MSWITC /ENABLE READ OF OVERLAY
+ TAD RDCNT /SEE IF THIS SEG IS EXHAUSTED
+ CIA
+ TAD I TM1
+ SPA SNA
+ ISZ I [CCB /ARE WE DONE ALL SEGMENTS?
+ SKP /NOT YET. LOOP UNTIL DONE
+ JMP I [MSWITC
+RUN5, DCA I TM1 /SAVE ALTERED CONTROL WORD
+ JMP RUN2
+\f/ASDONE, CDF 10
+/ DCA I TM1 /THIS COULD BE OPTIMIZED
+/ CDF 0
+/ JMP I [KEYMON
+
+KMER1, JMS I [PRNAME /DEVICE NOT AVAILABLE
+ JMS I [PRMESG
+ TEXT / NOT AVAILABLE/
+\f *1000
+/MUST BE AT 1000 FOR BATCH
+BEGLN, 0 /LINE BUFFER COULD BECOME "@
+ "I
+ "N
+ "I
+ "T
+KMINIT, CDF 10 /INITIALIZATION - DESTROYED BY LINE BUFFER
+ ISZ I [7700 /LOC 17700=7777 IF I/O MONITOR IS KNOWN
+ JMP .+3 /TO BE IN CORE, SO SET UP
+ TAD [200 /THE INITIAL POINTER FOR CALLS TO THE MONITOR
+ DCA SYSTEM /ACCORDINGLY
+ CDF 0
+ TAD I LXR
+ DCA I X1
+ ISZ TEMP2
+ JMP .-3
+ CDF 10
+ TAD MVFROM
+ DCA I PDBUF
+ ISZ .-2
+ ISZ PDBUF
+ ISZ MVCNT
+ JMP .-5
+ CDF 0
+ TAD I PDBUF+1 /SEE IF BATCH IS SET
+ RAL /IF YES, GO TO PAGE 0 TO CONTINUE
+ SMA CLA /IF IT ISN'T, CONTINUE NORMALLY
+ JMP INTGO /NORMAL KEYBOARD SYSTEM
+ DCA I RTWTPT /DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING
+ TAD I [JSBITS /IS BOS IN PLACE?
+ AND DCBF
+ SNA CLA
+ JMP BATCH /NO. GO READ IT IN.
+ JMP BCHGO /YES. START IT UP.
+INTGO, TAD [200
+ KRS
+ TAD M203
+ SNA CLA /IS THERE A ^C IN THE READER BUFFER
+ KSF /WITH THE FLAG ON?
+ JMP I ERRET /NO - PRINT CRLF AND PERIOD
+ JMP CLR /V3D
+/CCLADR, GETCCL /V3D DIDN'T SEEM TO BE USED
+RTWTPT, RUNTWT
+DCBF, 400
+/START
+PMSRST, SHNDLR&177+4200 /JMS SHNDLR
+ 0300
+ 7000
+ MTEMP+6
+ HLT /CONTAINS SECOND COPY OF OS/78 BIT
+ CDF CIF 0
+ TCF
+/END
+MVCNT, MOVBUF-MVT3-1
+PDBUF, MOVBUF
+\fMVFROM, NOPUNCH
+ *7626
+ ENPUNCH
+MOVBUF, 7777 /USED IN BATCH SETUP
+ TAD I MVT1 /MOVE THE LINE BUFFER FROM 1000
+ DCA I MVT2 /TO 1655
+ ISZ MVT1
+ ISZ MVT2
+ ISZ MVT3
+ JMP .-5
+ CIF CDF 0
+ JMP I MOVBUF
+
+MVT1, BEGLN
+MVT2, SVLNBF
+MVT3, -112
+
+
+ *1077 /V3D
+INIT, CDF 10 /V3D (INITIALIZATION)
+ TAD DCBF
+ DCA I ROT /RESTORE LOC 7677 TO '400'
+ CDF 0
+ DCA KMINIT /END LINE WITH 0
+ TLS
+ JMP I CRLF /FAKE OUT KBM AS IF USER TYPED @INIT
+
+
+CLR, KCC
+ JMP I .+1
+ CTRLC
+\f *1112
+ ENPUNCH
+
+DIGTLP, TAD I LXR
+STRTX, TAD (-270
+ CLL
+ TAD [10
+ DCA TMP1 /V3
+ SNL
+ JMP EONUM
+/V3 ISZ DIGFLG
+ JMS ROT
+ JMS ROT
+ JMS ROT
+ TAD TEMP2
+ TAD TMP1
+ DCA TEMP2
+ JMP DIGTLP
+EONUM, TAD TEMP1
+ AND [7
+ CLL RTL
+ RAL
+ TAD KM6203
+ DCA I [MSTCDF
+ TAD TEMP2
+ JMP I .+1
+ STCOMN
+
+ROT, 7677 /V3D NEEDED FOR INIT
+ TAD TEMP2
+ CLL RAL
+ DCA TEMP2
+ TAD TEMP1
+ RAL
+ DCA TEMP1
+ JMP I ROT
+\fDEAS, TAD [UDNAME-1
+ DCA X1
+ TAD [-17
+ DCA TM1
+ CDF 10
+ DCA I X1
+ ISZ TM1
+ JMP .-2
+KM6203, CDF CIF 0
+ JMP I [KEYMON
+
+ASDONE, CDF 10 /V3
+ DCA I TM1 /V3
+ JMP KM6203 /V3
+
+
+CRLF, KEYMON+1 /V3D NEEDED FOR INIT
+ TAD [215
+ DCA NM1
+ JMS I (PRNT
+ TAD [212
+ JMS I PCH
+ JMP I CRLF
+
+M203, -203
+ PAGE
+\f/NOTE: XR=AMFLAG !
+
+ *1200
+ /TELETYPE INPUT ROUTINE
+XGLINE, KEYMON+1 /MUST BE AT 1200 FOR BATCH & CCL
+ TAD [".
+ JMS I PCH
+ DCA RBFLAG
+ TAD [BEGLN-1
+CHLM1, DCA LXR
+ DCA AMFLAG /ZERO ALTMODE FLAG
+CHLOOP, KSF
+ JMP CHLOOP
+ TAD [200
+ KRS
+ DCA NM1
+ KCC
+ JMS SRCH
+ -225;CTRLU
+ -215;CARRET
+ -377;RUBOUT
+ -375;ALTMOD /THIS AREA GETS MODIFIED BY SET
+ -376;ALTMOD
+ -233;ALTMOD
+ -212;LFEED
+ -200;CHLOOP
+ -217;CHLOOP /IGNORE ^O
+ -203;CTRLC /MUST BE JUST BEFORE 0
+ /MUST BE HERE FOR CCL
+ 0
+ JMS PRNT
+CINSRT, TAD NM1
+ DCA I LXR
+ TAD LXR
+ TAD [-BEGLN-110
+ SPA CLA
+ JMP CHLOOP
+CARRET, JMS I [CRLF
+ TAD LXR
+ TAD [1-BEGLN
+ SNA CLA
+ JMP XGLINE+1
+ DCA I LXR
+ DCA I LXR
+ JMP I XGLINE
+\f/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
+/**** BEWARE! ***
+
+PRNT, 0
+ ISZ RBFLAG
+ JMP .+3
+ TAD ["\
+ JMS I PCH
+ DCA RBFLAG
+ TAD NM1
+ JMS I PCH
+ JMP I PRNT
+CTRLC,
+CTRLU, TAD ["^
+ JMS I PCH
+ TAD NM1
+ TAD [100
+CLRLIN, JMS I PCH
+RBSPCL, JMS I [CRLF
+ JMP XGLINE+1
+
+ALTMOD, TAD ["$
+ DCA NM1
+ JMS PRNT
+ ISZ AMFLAG /NOTE ALTMODE
+ JMP CARRET+1
+RUBOUT, TAD LXR
+ TAD [1-BEGLN
+ SNA CLA
+ JMP RBSPCL
+ TAD ["\ /MUST BE HERE
+ ISZ RBFLAG
+ JMS I PCH
+ CLA CMA
+ DCA RBFLAG
+ TAD LXR
+ DCA TEMP1
+ TAD I TEMP1
+ JMS I PCH
+LBCKUP, CLA CMA
+ TAD LXR
+ JMP CHLM1
+\fSRCH, 0
+ TAD I SRCH
+ ISZ SRCH
+ SNA
+ JMP I SRCH
+ TAD NM1
+ SNA CLA
+ JMP SFND
+ ISZ SRCH
+ JMP SRCH+1
+SFND, TAD I SRCH
+ DCA TEMP1
+ JMP I TEMP1
+LFEED, JMS I [CRLF
+ DCA I LXR
+ TAD [".
+ JMS I PCH
+ TAD [BEGLN-1
+ DCA XR
+ TAD I XR
+ SNA
+ JMP LBCKUP
+ JMS I PCH
+ JMP .-4
+
+PRQMRK, JMS I [PRNAME
+ JMP I [PRINTQ
+ IFNZRO PRQMRK-1357 <SEECCL,ZZXX>
+ ZBLOCK 1 /A FREE LOCATION!
+
+ IFNZRO .-1362 <FIXCCL,ERRRR>
+
+GETCCL, TAD [6003
+ JMS I [RESET
+ TAD [67 /CCL OVERLAY BLOCK IS BLOCK 67 ***
+ DCA OV
+ JMP DATE2
+DATE, TAD TMP
+ SNA CLA
+ JMP I [CCLSW-1 /USED TO BE JMP GETCCL
+DATE2, JMS I [SHNDLR /READ IN DATE OVERLAY
+ 0201
+ 0400
+OV, MSOVL2
+ JMP KMONER
+ JMP I [600
+ PAGE
+\f *1400
+SAVE2A, JMS I [SHNDLR
+ 0201
+ 400
+ MTEMP+10
+ JMP KMONER
+SAVE3, TAD [603
+ DCA XR
+ TAD I [600
+ DCA TM1
+ TAD TM1
+ JMS I [CCBTST /CHECK TM1 FOR VALID CCB
+SAVE3A, ISZ XR
+ TAD I XR /GET THE I/O CONTROL WORD OF THIS SEGMENT
+ JMS I PROTAT /EXTRACT THE LENGTH FROM IT
+ TAD CLENGT
+ DCA CLENGT /UPDATE THE LENGTH OF THE FILE
+ ISZ TM1
+ JMP SAVE3A /LOOP FOR ALL SEGMENTS OF THE FILE
+ TAD CLENGT /USE THIS LENGTH WHEN ENTERING THE FILE
+ CLL RTL
+ RTL
+ TAD SENTER
+ CIF 10
+ JMS I SYSTEM
+ 3 /ENTER
+SFILE, NM1
+ 0 /LENGHT UNIMPORTANT
+ JMP SAVERR
+ TAD SENTER
+ CIF 10
+ JMS I SYSTEM
+ 4 /CLOSE
+ NM1 /NAME FOR "CLOSE"
+CLENGT, 1 /CLOSING LENGTH
+ JMP SAVERR
+ TAD [603
+ DCA XR
+ JMS I PGTOUT /KICK THE I/O MONITOR OUT IF NECESSARY
+ TAD I [JSBITS
+ RAL
+ CMA /IF JOB LOADS INTO LOCS 0-1777,
+ SNL SMA CLA /BUT NOT INTO LOCS 10000-11777,
+ JMS LOADF0 /LOAD 0-1777 INTO 10000-11777 NOW
+ TAD SFILE
+ DCA SWFILE
+ JMS SWRITE /WRITE OUT CONTROL BLOCK
+SAVE4, TAD I XR
+ DCA SADR
+ CLA CLL CML RAR
+ TAD I XR
+ DCA SCTL
+\fSAVE5, TAD SADR
+ RAL
+ SZL SPA CLA /DOES THIS SEGMENT START BELOW 2000?
+ JMP SAVE8 /NO - NOTHING TO WORRY ABOUT
+ TAD SCTL
+ AND [70
+ SZA CLA /FIELD 0?
+ JMP SAVE8 /NO - SAVE AS IS
+SAVE6, JMS LOADF0 /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR
+SAVE7, CLA CMA
+ TAD SCTL
+ CLL RAL
+ TAD SADR
+ RAL
+ SZL SPA CLA /CHECK WHETHER UPPER LIMIT IS ABOVE 2000
+ JMP SAVE7A /IT IS - MUST MAKE 2 WRITES
+ TAD SCTL /TOTALLY CONTAINED IN 0-1777
+ TAD [10 /CHANGE FIELD 0 TO FIELD 1 AND CONTINUE
+ JMP SAVE8A
+SAVE7A, TAD SCTL /WRITE IN 2 PARTS -
+ DCA TM1
+ TAD SADR
+ CIA /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000
+ TAD [2020
+ CLL CML RAR
+ DCA SCTL
+ JMS SWRITE
+ CLA CLL CML RTR
+ DCA SADR
+ TAD SCTL /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000
+ AND [3700
+ CIA
+ TAD TM1
+ SMA /FULL FIELD SAVE IN F0 MAKES THIS +
+ TAD [4000 /COMPENSATE FOR THAT CASE
+SAVE8A, DCA SCTL
+SAVE8, JMS SWRITE
+ ISZ I [600
+ JMP SAVE4
+SAVE12, JMS I [SHNDLR
+ 0610
+ 0
+ MONTOR /FORCE THE I/O MONITOR BACK INTO CORE
+ JMP KMONER /(OY VEH!)
+ CLA CMA
+ CDF 10
+ DCA I [7700 /TELL THE KEYBOARD MONITOR THAT ITS IN CORE
+ JMP I [7605 /*** DEPENDS ON 7605 BEING A CDF CIF 10 ***
+
+\fLOADF0, 0
+ ISZ F0OVLY /HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE?
+ JMP I LOADF0 /EVIDENTLY
+ JMS I [SHNDLR
+ 1010
+F0OVLY, -1 /WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE
+ MTEMP+4
+ JMP KMONER
+ JMP I LOADF0
+
+SWRITE, 0
+ JMS I DEVHND
+SCTL, 4101
+SADR, 600
+SWFILE, 0
+ JMP SAVERR
+ TAD SCTL
+ JMS I PROTAT
+ TAD SWFILE
+ DCA SWFILE /BUMP RECORD NUMBER
+ JMP I SWRITE
+SAVERR, JMS I [PRMESG
+ TEXT /SAVE ERROR/
+PROTAT, ROTAT
+\f *1600
+KMER4, JMS I [PRMESG
+ TEXT /TOO FEW ARGS/
+CCBTST, 0 /EXAMINE COUNT WORD OF CCB FOR VALIDITY
+ /ASCII AND BINARY FILES USUALLY FAIL THIS TEST
+ CMA
+ AND [7740
+ SNA CLA
+ JMP I CCBTST /IT WAS VALID
+CIERR, TAD [7605
+ DCA ERRET /RELOAD MONITOR ON THIS ERROR
+ JMS I [PRMESG /IT WASN'T - TELL THE USER
+ TEXT /CORE IMAGE ERR/
+GETOUT, 0 /SUBROUTINE TO KICK MONITOR OUT IF NECESSARY
+ TAD I [JSBITS
+ RAR
+ CLA
+ TAD SYSTEM
+ SZL SPA CLA /IS THE SYSTEM IN CORE AND SHOULD IT BE?
+ JMP I GETOUT
+ CIF 10 /YES AND NO - KICK IT OUT
+ JMS I SYSTEM
+ 11 /BYE BYE
+ TAD [7700
+ DCA SYSTEM
+ JMP I GETOUT
+\fSVLNBF,
+KMER2, JMS I [PRNAME
+ JMS I [PRMESG
+ TEXT / NOT FOUND/
+/
+/NEXT 112 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE
+/
+
+RESET, 0
+ DCA I [JSBITS /MARK AREAS FOR I/O OPTOMIZATION
+ JMS I [MINCOR
+ CIF 10
+ JMS I SYSTEM
+ 13 /RESET DEVICE HANDLERS AND OUTPUT FILES
+/V3D CDF 0 /THIS INSTRUCTION SEEMS UNNECESSARY
+ JMP I RESET
+
+RCHK, 0
+ AND I RADR /V3D
+ AND [200 /CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
+ SNA CLA
+ JMP I RCHK
+ JMP CIERR /V3D CAN'T FALL INTO KMER3
+ /BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
+KMER3, JMS I [PRMESG
+ TEXT /NO!!/
+
+RUN6, TAD I TM1 /STORE CONTROL WORD FOR LAST SEG.
+ DCA I [MREAD+1
+ TAD RUNSW /IS THIS R OR RUN?
+ SNA CLA
+ JMS I [WRCTLB /RUN
+ TAD I RFILE /V3D FOR LINKER
+ DCA I RCTL /V3D SAVE BLOCK NUMBER IN 'SOFSET'
+ TAD I RFILE
+RUN7, IAC
+ DCA RUNFIL /STORE STARTING BLOCK NUMBER
+ TAD DEVHND
+ DCA I [MREAD-1
+ TAD DEVHND
+ DCA RUNHND /STORE DEVICE HANDLER ENTRY IN THIS PAGE
+ TAD I ADR1
+ DCA I ADR2
+ ISZ ADCNT
+ JMP .-3
+ JMP I .+1 /AND GO TO IT
+ RUN8&177+7400
+
+RFILE, FILE
+ADCNT, RUN8&177+7600
+\fRUN8, ISZ I R7400 /IS THIS THE LAST PARAMETER PAIR?
+ JMP RUN9 /NO - KEEP LOADING
+ TAD RUNFIL
+ DCA I RMRD3 /MOVE THE RECORD NUMBER INTO THE FINAL READ
+ TSF
+RUNTWT, JMP .-1 /WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!)
+ JMP I .+1
+ MREAD /READ THE LAST SEGMENT AND START UP
+RUN9, TAD I RUNADR
+ DCA RADR /SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT
+ ISZ RUNADR
+ TAD I RUNADR
+ DCA RCTL /AND THE READ CONTROL WORD
+ JMS I RUNHND
+RCTL, SOFSET /V3D THESE ARE STORED INTO ONLY AFTER MOVING
+RADR, OS78 /V3D
+RUNFIL, 0
+ JMP RERR /INPUT ERROR READING THE PROGRAM
+ TAD RCTL
+ JMS ROTAT /GET THE BLOCK LENGTH OF THIS SEGMENT
+ TAD RUNFIL
+ DCA RUNFIL /UPDATE THE BLOCK NUMBER FROM IT
+ ISZ RUNADR
+ JMP RUN8 /BACK FOR ANOTHER ONE
+
+RERR, CIF 10
+ JMS I RU7700
+ 7
+ 0 /TOTALLY MEANINGLESS
+RUNADR, CCB+4
+R7400, 7400
+RMRD3, MREAD+3
+RU7700, 7700
+RUNHND, 0
+ IFNZRO ROTAT-SVLNBF-112&4000 <ERROR>
+ *1765 /MUST BE AT TOP OF PAGE
+ROTAT, 0
+ CLL RTR
+ RTR
+ RTR
+ AND RU37
+ SNA
+ TAD RU37
+ IAC
+ CLL RAR
+ JMP I ROTAT
+RU37, 37
+\f /OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
+ *2000 /GOES INTO 400
+SAVE1A, TAD (1603
+ DCA X1
+ DCA TM1
+ CDF 10
+ DCA I [OLDT9
+S6203, CIF CDF 0
+ TAD (SGETOUT-RSOVL2 /POINTER TO NEW GETOUT
+
+ DCA PGTOUT /LIKEWISE "GETOUT"
+ JMS I [SHNDLR
+ 0210
+ 1400
+ MTEMP+10 /READ IN CONTROL BLOCK
+ JMP KMONER
+ JMS LXRBAK /RESET LXR TO LOOK AT FIRST CHAR
+ JMS LXRBAK
+ DCA DASHFG
+SNUMLP, JMS SGTNUM
+ JMP SDLOOK /NO NUMBER - GET DELIMETER
+ TAD I LXR
+ TAD (-"-
+ SNA CLA
+ JMP SVDASH
+ JMS LXRBAK
+ TAD DASHFG
+ SNA CLA /WAS THERE A LOWER LIMIT?
+ JMS DASHSB /NO - SET LOWER LIMIT TO UPPER LIMIT
+ TAD TEMP1
+ CIA CLL CML
+ TAD OLD1
+ SZA CLA /ARE THE FIELDS THE SAME?
+ JMP KMER5 /NO - ERROR
+ TAD TEMP2
+ AND [7600
+ TAD [200
+ DCA TEMP2
+ TAD TEMP2
+ CIA
+ TAD OLD2
+ SZL CLA /IS UPPER LIMIT > LOWER LIMIT?
+ JMP KMER5 /NO - ERROR
+ CDF 10
+ TAD OLD1
+ DCA I X1
+ TAD OLD2
+ DCA I X1
+ TAD TEMP2
+ DCA I X1 /CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT)
+ /IN THE TABLE IN FIELD 1
+ ISZ TM1 /BUMP ENTRY COUNT
+\fSDLOOK, CDF 0
+ TAD I LXR
+ SNA
+ JMP I (SVEND-RSOVL1
+ TAD (-",
+ SNA
+ JMP SNUMLP-1
+ TAD (",-";
+ SNA
+ JMP SSTADR
+ TAD (";-"=
+ SNA CLA
+ JMP I (SSBITS-RSOVL1
+KMER5, JMS I [PRMESG
+ TEXT /BAD ARGS/
+LXRBAK, 0
+ CLA CMA
+ TAD LXR
+ DCA LXR
+ JMP I LXRBAK
+SVDASH, TAD DASHFG
+ SZA CLA
+ JMP KMER5
+ ISZ DASHFG
+ JMS DASHSB
+ JMP SNUMLP
+SSTADR, JMS SGTNUM
+ JMP KMER5 /NULL STARTING ADR - ERROR
+ TAD TEMP1
+ AND [7
+ CLL RTL
+ RAL
+ TAD S6203
+ CDF 10
+ DCA I (1601 /STORE AWAY STARTING FIELD
+ TAD TEMP2
+ DCA I (1602 /AND STARTING ADDRESS
+ JMP SDLOOK
+DASHSB, 0
+ TAD TEMP1
+ AND [7
+ DCA OLD1
+ TAD TEMP2
+ AND [7600
+ DCA OLD2
+ JMP I DASHSB
+DASHFG, 0
+OLD1, 0
+OLD2, 0
+
+\fSGTNUM, 0 /GET A NUMBER ROUTINE
+ DCA DIGFLG /CLEAR DIGIT COLLECTED FLAG
+ DCA TEMP1
+ DCA TEMP2
+ JMS I (STARTX-RSOVL1
+ JMP .+4
+ TAD (20
+ SNA CLA
+ JMP .-4
+ JMS LXRBAK /SHOVE INDEX BACK
+ TAD DIGFLG /IS DIGIT PRESENT?
+ SZA CLA
+ ISZ SGTNUM
+ JMP I SGTNUM
+ PAGE
+\f *2200 /LOADS INTO 600
+SSBITS, JMS I (SGTNUM-RSOVL1
+ JMP I (KMER5-RSOVL1
+ TAD TEMP2
+ CDF 10
+ DCA I (1603
+ JMP I (SDLOOK-RSOVL1
+SVEND, JMS I [SHNDLR
+ 0101
+ 0400
+ MSOVL2 /READ IN SECOND PART OF OVERLAY
+ JMP KMONER
+ TAD TM1
+ SNA
+ JMP I (MOVECB-RSOVL2
+ CIA
+ CDF 10
+ DCA I (1600
+ /NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON
+ /DECREASING FIELD AND INCREASING ADDRESS
+ /WITHIN THE FIELD.
+ TAD (1603
+ DCA P1
+ CLA IAC
+ TAD I (1600
+ SNA
+ JMP I (SORTED-RSOVL2 /RIDICULOUS TO SORT ONE ITEM
+ DCA TEMP1
+OUTRLP, TAD (3
+ TAD P1
+ DCA P2
+ TAD TEMP1
+ DCA TEMP2
+INERLP, TAD P1
+ DCA LXR
+ TAD P2
+ DCA X1
+ TAD I LXR
+ CIA CLL
+ TAD I X1
+ SNA CLA
+ JMP TIE /FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD
+ SZL
+ JMP SWITCH /WRONG ORDER - SWITCH 'EM
+TIENTY, TAD P2
+ TAD (3
+ DCA P2 /INDEX TO NEXT ENTRY
+SWNTRY, ISZ TEMP2
+ JMP INERLP
+ TAD P1
+ TAD (3
+ DCA P1 /ELEMENT IS IN PLACE - GO TO NEXT POSITION
+ ISZ TEMP1
+ JMP OUTRLP
+ JMP I (SORTED-RSOVL2 /SORT COMPLETE - CHECK FOR CONSISTENCY
+\fTIE, TAD I LXR
+ CIA CLL
+ TAD I X1
+ SZL CLA /TEST FOR ADRESSES IN ASCENDING ORDER
+ JMP TIENTY /YES - DONT HAVE TO SWAP
+SWITCH, JMS SWSUBR
+ JMS SWSUBR
+ JMS SWSUBR
+ CLA CLL CMA RTL
+ TAD P1
+ DCA P1 /RESET FIRST POINTER
+ JMP SWNTRY /AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT
+SWSUBR, 0
+ ISZ P1
+ ISZ P2
+ TAD I P1
+ DCA TM1
+ TAD I P2
+ DCA I P1
+ TAD TM1
+ DCA I P2
+ JMP I SWSUBR
+P1, 0
+P2, 0
+
+\fSTARTX, 0
+ TAD I LXR /ANYTHING LEFT?
+ SNA
+ JMP I STARTX /NO.. TAKE EMPTY RETURN
+ SKP
+ADGTLP, TAD I LXR
+ TAD (-270
+ CLL /SEE IF THIS IS A DIGIT
+ TAD [10
+ SNL
+ JMP AONUM /NO.. GET OUT
+ DCA TMP1
+ ISZ DIGFLG
+ JMS ROT2
+ JMS ROT2
+ JMS ROT2
+ TAD TEMP2
+ TAD TMP1
+ DCA TEMP2
+ JMP ADGTLP /KEEP LOOKING
+AONUM, ISZ STARTX
+ JMP I STARTX
+
+ROT2, 0
+ TAD TEMP2
+ CLL RAL /WE NEED THIS BECAUSE THE HANDLER
+ DCA TEMP2 /WIPED THE FIRST COPY (MAYBE!!!)
+ TAD TEMP1
+ RAL
+ DCA TEMP1
+ JMP I ROT2
+ PAGE
+\f *2400 /LOADS INTO 400 ON TOP OF SAVE1A
+SORTED, TAD I (1600
+ IAC
+ SNA /IS THERE ONLY ONE ITEM IN THE LIST?
+ JMP MERGED /YES - DON'T COMPRESS FURTHER
+ DCA TEMP1
+ TAD (1603
+ DCA X1
+ TAD (1606
+ DCA LXR
+ /NOW CHECK THE SORTED FILE FOR CONSISTENCY
+ /OVERLAPPING SEGMENTS ARE ERRORS,
+ /ABUTTING SEGMENTS ARE TO BE CONDENSED IN
+ /THE INTERESTS OF SPEED
+MRGLP, TAD I LXR
+ CIA
+ TAD I X1
+ SZA CLA
+ JMP NOCMPR /DIFFERENT FIELDS - INCOMPARABLE
+ ISZ X1
+ TAD I X1
+ CIA
+ CLL
+ TAD I LXR
+ SNA CLA
+ JMP BUTTNG /UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
+ SZL CLA
+ JMP NXTONE /UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE
+ CDF 0 /UPPER LIM(2) > LOWER LIM(1) - ERROR
+ JMS I [PRMESG
+ TEXT /BAD ARGS/
+BUTTNG, CLA CMA
+ TAD X1
+ DCA X1
+ TAD I LXR
+ DCA I X1 /SET UPPER LIM(2) = UPPER LIM(1)
+ TAD X1
+ TAD (-1777
+ SZA CLA
+ JMP .-5 /AND COMPRESS OUT THE LOWER ENTRY
+ ISZ I (1600 /DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW)
+ JMP SORTED /START OVER FROM BEGINNING
+
+NOCMPR, ISZ X1
+ ISZ X1
+ ISZ LXR
+NXTONE, ISZ LXR
+ ISZ TEMP1
+ JMP MRGLP /NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS
+ /INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E.
+ /DEVICE-HANDLER ARGUMENTS
+\fMERGED, TAD (1603
+ DCA LXR
+ TAD (1603
+ DCA X1
+ TAD I (1603
+ AND (1777
+ TAD (6000
+ DCA I (1603 /INITIALIZE STATUS BITS TO NO OVERLOADS
+ TAD I (1600
+ DCA TEMP1
+MERGLP, TAD I LXR
+ DCA TEMP2
+ TAD I LXR
+ AND (7400
+ DCA TMP1
+ TAD TMP1
+ DCA I X1 /STORE ADDRESS
+ TAD TMP1
+ CIA
+ TAD I LXR /FORM UPPER LIM - LOWER LIM
+ CLL RTR
+ RTR
+ TAD TEMP2 /ADD IN FIELD
+ RAL
+ RTL /ROTATE WHOLE MESS INTO PLACE
+ DCA I X1
+ TAD TMP1
+ CLL RAL
+ SZL SPA CLA /IS THE LOWER LIMIT < 2000?
+ JMP NXTSEG /NO
+ TAD TEMP2
+ RAR
+ SZA CLA /YES- IS THE FIELD 0 OR 1?
+ JMP NXTSEG /NO
+ SNL
+ IAC
+ CMA CML RTR
+ AND I (1603 /AND OUT THE PROPER OVERLOAD BIT
+ DCA I (1603
+NXTSEG, ISZ TEMP1
+ JMP MERGLP
+MOVECB, TAD (1577
+ DCA LXR
+ TAD (577
+ DCA X1
+ TAD [7600
+ DCA TEMP1
+CBMOVE, CDF 10 /FINAL CODE TO MOVE NEW CONTROL BLOCK
+ TAD I LXR /INTO PAGE 600 OF FIELD 0
+ CDF 0
+ DCA I X1
+ ISZ TEMP1
+ JMP CBMOVE
+ JMP I (SAVE3 /EXIT TO SAVE PROCESSOR
+
+\fSGETOUT,0 /REPLACES "GETOUT" WHICH WE'VE STORED OVER
+ TAD I [JSBITS
+ RAL /ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS
+ SPA CLA
+ JMP I SGETOUT
+ CIF 10
+ JMS I SYSTEM
+ 11
+DECIMB, JMP I SGETOUT /DECIMB ONLY CALLED BY NEXT PAGE
+ /PART OF NEXT PAGE'S ROUTINE:
+ TAD NM2 /ALL NEW FOR V3D
+ TAD NM4 /ONLY ALLOW 2 CHARS FOR MM
+ SNA CLA
+ ISZ DECIMB
+ TAD NM1
+ RTR
+ RTR
+ JMP I DECIMB
+ PAGE
+\f *2600 /DATE PROCESSOR - LOADS IN 400, RUNS IN 600
+DATEXX, JMS DECIM
+NUM2, DCA NUM2
+ TAD NUM2
+ TAD M40
+ SMA CLA
+ JMP BADNUM /DAY > 31
+ JMS I GNAME
+L30, 30 /NOTHING FOUND WILL GIVE ERROR LATER
+/ DCA NUM1 /NUM1 IS INITIALLY 0
+NEWLUP, ISZ MONPTR
+ ISZ NUM1
+ TAD I MONPTR
+ ISZ MONPTR
+ SMA
+ JMP BADNUM /SYMBOLIC MONTH NOT FOUND
+ TAD NM1
+ SNA CLA /SKIP IF FIRST 2 LETTERS DON'T MATCH
+ TAD NM2
+ TAD I MONPTR
+ SZA CLA
+ JMP NEWLUP /SECOND 2 LETTERS DON'T MATCH
+/*** TEST DELIMETER HERE
+ TAD NUM1
+ CLL RTL
+ RTL
+ RAL
+ TAD NUM2
+ RTL
+ RAL
+ DCA NUM2
+ DCA DDELIM /MAKE END-OF-LINE THE DELIMITER
+ JMS DECIM
+ TAD (-106 /SCALE DOWN TO RANGE 1970-1999
+ SPA
+ JMP BADNUM /DIDN'T MAKE THE RANGE
+ DCA NUM1
+ TAD NUM1
+ AND L30 /ISOLATE EXTENSION DATE BITS
+ CLL RTL
+ RTL
+ DCA TM1
+ TAD I (BIPCCL
+ AND L7177 /STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
+ TAD TM1
+TSLUP, DCA I (BIPCCL
+ TAD NUM1
+ AND [7
+ TAD NUM2 /COMBINE WITH MONTH AND DAY
+ CDF 10
+ DCA I (MDATE /STORE IN SYSTEM DATE CELL
+ TSF /7605 SETS THE DF
+ JMS L7177 /TIME OUT A BIT
+ JMP I [7605 /IN CASE RUNNING UNDER BATCH
+L7177, 7177 /JMS IS LONGER THAN JMP
+ ISZ DDELIM /DDELIM IS 0 AT END
+ JMS TSLUP /WAIT FOR TELETYPE TO DIE DOWN (RF08)
+ JMP I [7605 /RETURN TO MONITOR
+\fDDELIM, -"-
+
+/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE
+
+CNV, 0
+ AND [77
+ SNA
+ JMP NUL
+ TAD (-60
+ SPA
+ JMP BADNUM
+ JMP I CNV
+NUL, TAD TM1
+ JMP GODE
+
+DECIM, 0
+ JMS I GNAME
+M40, -40 /NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
+ TAD TMP
+ TAD DDELIM /COMPARE AGAINST DESIRED DELIMETER
+ SNA CLA /DASH OR NULL
+ JMS I (DECIMB-2400+400
+ JMP BADNUM /DELIMETER BAD
+ RTR
+ JMS CNV
+ DCA TM1
+ TAD TM1
+ CLL RTL
+ TAD TM1
+ RAL
+ DCA TEMP2
+ TAD NM1
+ JMS CNV
+ TAD TEMP2
+GODE, SZA
+ JMP I DECIM
+BADNUM, CLA /CRAP IN AC
+ TAD [7605
+ DCA ERRET
+ JMS I [PRMESG
+ TEXT /BAD DATE/
+NUM1, 0 /MONTH NUMBER (MUST BE 0 INITIALLY)
+\fMONS, -1201 /JAN
+ -1600
+ -0605 /FEB
+ -0200
+ -1501 /MAR
+ -2200
+ -0120 /APR
+ -2200
+ -1501 /MAY
+ -3100
+ -1225 /JUN
+ -1600
+ -1225 /JUL
+ -1400
+ -0125 /AUG
+ -0700
+ -2305 /SEP
+ -2000
+ -1703 /OCT
+ -2400
+ -1617 /NOV
+ -2600
+ -0405 /DEC
+ -0300
+MONPTR, MONS-2600+600-1 /RELOCATES TO PAGE 600
+ /MUST BE POSITIVE
+
+ PAGE
+\f *3000 /MONITOR ERROR PROCESSOR - LOADS INTO 11400
+DLYLPX, AND I 0
+D7600, 7600
+ TAD MERRNO
+ CLL RAL
+ ISZ I (ZERO-1400
+ ISZ I (ZERO-1400 /V3C
+ ISZ I (ZERO-1400
+ JMP DLYLPX /WAIT FOR TELEPRINTER (WITHOUT CDF'S)
+ SNA
+ JMP USRERR
+ CLL RAL
+ RTL
+ RTL
+ TAD (6040
+ DCA I (MERTYP-1400
+MERCMN, TAD (MERRXR-1400
+ JMS EPRINT
+ TAD I (FPUTX
+ RTR
+ RAR
+ AND (7
+ TAD (60
+ JMS MERPCH
+ CLA CLL CMA RAL
+ TAD I (MONITO
+ RAL
+ DCA T1
+ TAD (-4
+ DCA T2
+MEROLP, TAD T1
+ RTL
+ RAL
+ DCA T1
+ TAD T1
+ AND (7
+ TAD (60
+ JMS MERPCH
+ ISZ T2
+ JMP MEROLP
+ TAD MERRNO
+ CLL RAL
+ SNA
+ JMP NOEXPL /NO EXPLANATION FOR USER ERRORS
+ CLL RAR
+ TAD (EXPLTBL-1401 /PRINT EXPLANATION
+ DCA T1 /GET ADDRESS INTO MESSAGE TABLE
+ TAD (240
+ JMS MERPCH
+ TAD ("(
+ JMS MERPCH
+ TAD I T1 /GET ADDRESS OF MESSAGE
+ JMS EPRINT
+ TAD (")
+ JMS MERPCH
+ TAD MERRNO
+NOEXPL, TAD (3773
+ SPA CLA
+ CLA CMA
+ DCA I (7700
+ DCA OLDT9
+ CLA CLL CML RAR
+ DCA MERRNO
+ CDF 0
+ TAD I (JSBITS
+ AND (6777
+ TAD (1000
+ DCA I (JSBITS /SET THE CURRENT JOB UNSTARTABLE
+ CDF CIF 0
+ JMP I D7600
+USRERR, CLA CLL
+ JMS I (FGET
+ TAD (4060
+ DCA I (UERTYP-1400
+ TAD (UERRXR-MERRXR
+ JMP MERCMN
+MERPCH, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I MERPCH
+ZERO, 0
+\fEPRINT, 0
+ DCA T2
+EPRLUP, TAD I T2
+ RTR
+ RTR
+ RTR
+ JMS EPR
+ TAD I T2
+ JMS EPR
+ ISZ T2
+ JMP EPRLUP
+
+EPR, 0
+ AND (77
+ SNA
+ JMP I EPRINT
+ TAD (240
+ AND (77
+ TAD (240
+ JMS MERPCH
+ JMP I EPR
+ PAGE
+\f *3200 /LOADS INTO 1600
+
+MERRXR, TEXT \MONITOR ERROR 0 AT \
+ MERTYP=MERRXR+7
+
+UERRXR, TEXT \USER ERROR 0 AT \
+ UERTYP=UERRXR+5
+
+EXPLTBL,MON1-1400
+ MON2-1400
+ MON3-1400
+ MON4-1400
+ MON5-1400
+ MON6-1400
+ MON7-1400
+
+MON1, TEXT \CLOSE ERROR\
+MON2, TEXT \DIRECTORY I/O ERROR\
+\fMON3, TEXT \DEVICE HANDLER NOT IN CORE\
+MON4, TEXT \ILLEGAL USR CALL\
+MON5, TEXT \I/O ERROR ON SYS:\
+MON6, TEXT \DIRECTORY OVERFLOW\
+MON7, TEXT \RESERVED\
+\f /EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
+ *3400 /EXECUTES IN FIELD 0 IN PAGE 7400
+MCHNX, DCA MCHREC /STORE STARTING RECORD #
+ TAD MCHREC
+ DCA I (SOFSET /V3D SAVE STARTING ADDRESS
+ CIF 10
+ JMS I (200
+ 13 /RESET ALL DEVICE ASSIGNMENTS
+ 0 /BUT DON'T CLEAR OUTPUT FILES
+ CIF 10
+ JMS I (200
+ 11 /KICK MONITOR OUT AND RESTORE CORE IF NECESSARY
+ JMS MCHRD /PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200
+ TAD I (7200 /TEST FOR SAVE FILE!
+ CMA /TEST FOR VALID CCB
+ AND (7740
+ SZA CLA
+ JMP CHERR
+ TAD I (7201
+ DCA I (MSTCDF /TRANSFER INFORMATION FROM CONTROL BLOCK
+ CLA IAC
+ TAD I (7202
+ DCA I (MSTADR /TO PAGE 7600
+ TAD I (7203
+ TAD (1000
+ DCA I (JSBITS
+ TAD (7204
+ DCA MCHT1
+ TAD MCHFJM
+ DCA I (MSWITC
+ TAD (TCF
+ DCA I (MSTCDF+1
+MCHN1, ISZ I (7200
+ JMP MCHN2
+ TAD I MCHT1
+ DCA I (MREAD+2
+ ISZ MCHT1
+ TAD I MCHT1
+ DCA I (MREAD+1
+ TAD MCHREC
+ DCA I (MREAD+3
+ TAD (SHNDLR
+ DCA I (MREAD-1
+ JMP I (MREAD
+MCHN2, TAD I MCHT1
+ DCA MCHADR /SET UP COMMAND TO READ NEXT SEGMENT
+ ISZ MCHT1
+ TAD I MCHT1
+ DCA MCHCTL
+ JMS MCHRD /READ IT
+ ISZ MCHT1
+ JMP MCHN1 /LOOP ON NUMBER OF SEGMENTS
+\fMCHRD, 0
+ JMS I (SHNDLR
+MCHCTL, 0101 /1 RECORD INTO FIELD 0 STARTING FORWARDS
+MCHADR, 7200
+MCHREC, 0
+ JMP CHERR /CHAIN ERROR
+ TAD MCHCTL
+MCHBMP, CLL RTR
+ RTR
+ RTR
+ AND (37
+ SNA /V3C
+ TAD (40 /0 MEANS FULL 4K READ
+ IAC
+ CLL RAR
+ TAD MCHREC
+ DCA MCHREC
+ JMP I MCHRD
+MCHT1, 0
+MCHFJM, MSTCDF&177+5200 /"JMP MSTCDF"
+
+CHERR, ISZ CHERR1
+ JMP CHERR /LET TTY DIE DOWN
+ ISZ CHERR2
+ JMP CHERR
+CHTADC, TAD CHARS
+ SNA
+ JMP I (7600 /DONE..BACK TO MONITOR
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ ISZ CHTADC /NEXT LETTER
+ JMP CHTADC
+\fCHERR1, 0
+CHERR2, -6
+CHARS, "C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
+ PAGE
+\f *4000 /SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
+ WRITE=JMS I SYSHND
+ JMS SYSSWP /SWAP SYSTEM DEVICE HANDLER INTO 7600
+
+ WRITE; 4200; 7400; 0; JMP BERR /BOOTSTRAP
+ TAD RBFLAG
+ SZA CLA
+ JMP .+6
+ WRITE; 4210; DCOUNT; 01; JMP BERR /DIRECTORY
+ WRITE; 5001; 0000; 07; JMP BERR /KEYBOARD MONITOR
+ WRITE; 4610; 0000; MONTOR; JMP BERR /USR
+ WRITE; 4111; 3400; MEOVLY; JMP BERR /"ENTER" OVERLAY
+ WRITE; 4701; 2000; MSOVLY; JMP BERR /SAVE OVERLAY,
+ /ERROR ROUTINE AND "CHAIN"
+ TAD RBFLAG
+ SZA CLA
+ JMP .+13
+ WRITE; 4101; LDRCTL; MFREE; JMP BERR /ABSLDR CONTROL BLOCK
+ WRITE; 5010; 2000;MFREE+1; JMP BERR /ABSLDR
+ JMS I (4200 /OUTPUT THE DEVICE HANDLERS
+ JMP BERR
+ JMS SYSSWP /SWAP BACK PAGE 7600
+ CLA CMA
+ HLT
+ CLA
+ JMP I .+1
+BERR, 7600
+ JMS SYSSWP
+ HLT
+ JMP .-1
+W6600, 6600
+W7600, 7600
+SYSSWP, 0
+ TAD W6600
+ DCA SYTM1
+ TAD W7600
+ DCA SYTM2
+SWAPLP, TAD I SYTM1
+ DCA TMSY
+ TAD I SYTM2
+ DCA I SYTM1
+ TAD TMSY
+ DCA I SYTM2
+ ISZ SYTM1
+ ISZ SYTM2
+ JMP SWAPLP
+ JMP I SYSSWP
+
+ /CONTROL BLOCK FOR ABSOLUTE LOADER
+LDRCTL, 7777 /ONE CONTIGUOUS LOAD
+ 6213 /STARTING ADDRESS IN FIELD 1
+ 2000 /STARTING LOCATION=12000
+ 6003 /DOES NOT LOAD OVER EITHER MONITOR AREA
+ /ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE
+ /ONLY FOR FIRST CALL TO COMMAND DECODER
+ 2000 /FIRST(AND ONLY) SEGMENT STARTS AT 2000
+ 1010 /IN FIELD 1 AND IS 10 PAGES LONG
+
+ IFNZRO LDRCTL-4113 <BLDER,XQX>
+
+SYTM1, 0
+SYTM2, 0
+TMSY, 0
+SYSHND, 7607
+ PAGE
+\f *7400
+ NOPUNCH
+ *7600
+ ENPUNCH
+ /UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES
+ /LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION
+
+MOFILE, ZBLOCK 17 /OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX)
+ /5 WORDS PER ENTRY - DEVICE # AND FILE NAME
+MIFILE, ZBLOCK 24 /INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX)
+ /2 WORDS PER ENTRY - DEVICE # AND RECORD #
+
+ /LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR
+ /(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER
+ /PART OF NUMERICAL ARGUMENT
+
+MPARAM, ZBLOCK 4 /PARAMETER TABLE - 7643-7646
+ /FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9).
+ /FOURTH WORD - CONTAINS THE LOW ORDER BITS OF
+ /THE NUMERICAL ARGUMENT
+
+
+
+ /TABLE OF DEVICE HANDLERS PRESENTLY IN CORE
+DVHNDL, 7607;7607;0;0;0;0;0
+ 0;0;0;0;0;0;0;0
+MDATE, 0 /HOLDS THE CURRENT DATE- 4 BIT MONTH,
+ /5 BIT DAY, 3 BIT YEAR FROM 1970
+MGET, CIF 0
+ JMS SHNDLR /INST FIELD IS 0
+ 1000 /READ 4 RECORDS INTO FIELD 0
+ 0 /LOCATIONS 0-1777
+ 7 /KEYBOARD MONITOR FOLLOWS DIRECTORY
+PJSBTS, JSBITS /SERVES AS A HALT (WATCH IT!)
+SCDCIF, CDF CIF 0
+ JMP I .+1
+ KMNTRY /V3D GETS CHANGED TO INIT
+\fMCALL1, 0
+ DCA MARG1 /SAVE AC AS IT MAY CONTAIN AN ARGUMENT
+ RDF /GET CALLING FIELD
+ TAD SCDCIF
+ DCA SMCIF
+ CDF 0
+ TAD I PJSBTS
+ RAR
+ CDF 10
+ SZL CLA /DOES JOB USE LOCS 10000-11777?
+ JMP MONRD /NO - DONT SAVE THEM
+ CIF 0
+ JMS SHNDLR
+ 5010
+ 0
+ MTEMP
+ HLT
+MONRD, CIF 0
+ JMS SHNDLR
+ 610
+ 0
+ MONTOR
+SCOPE, HLT /BIT 4 IS A 1 IF CONSOLE IS A SCOPE
+ JMP MSTART /START THE MONITOR UP IN PAGE 0
+MRETRN, CIF 0
+ JMS SHNDLR
+ 1010 /READ 10 RECS INTO FIELD 1
+ 0
+ MTEMP /TEMP REGION ON SYS
+ HLT /SYS HAS PROBLEMS
+SMCIF, 0
+ JMP I MCALL1
+\fMARG1, 0
+ /TABLE OF USER DEVICE NAMES
+ /ALSO USED BY SYSTEM ODT
+
+UDNAME, 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
+\fDCB, ZBLOCK 17 /DEVICE CONTROL BLOCK - SET IN "CONFIG"
+
+
+
+
+
+
+
+
+
+ /********************************************************
+ / MAP OF SYSTEM DEVICE AS OF 2/21/73
+ /********************************************************
+ / * 256 WORD RECORDS *
+ /********************************************************
+
+ / RECORDS CONTENTS
+ / ------- --------
+
+ / 0 MONITOR BOOTSTRAP
+ / 1- 6 SYSTEM DIRECTORIES
+ / 7-12 KEYBOARD MONITOR
+ / 13-15 I/O MONITOR(CALLABLE MONITOR)
+ / 16-25 DEVICE HANDLER RECORDS
+ / 26 MONITOR "ENTER" OVERLAY
+ / 27-50 MONITOR SCRATCH AREA FOR SAVING CORE
+ / 51-53 COMMAND DECODER
+ / 54-55 "SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
+ / 56 MONITOR ERROR ROUTINE
+ / 57 "CHAIN" PROCESSOR
+ / 60-63 SYSTEM ODT
+ / 64 RESERVED FOR EXPANSION
+ /65 CCL REMINISCENSES
+ / 66 USED BY TWO-PAGE SYS HANDLER
+ / 67 USED BY CCL (CCL OVERLAY)
+ / 70-END FILE STORAGE
+\f SHNDLR=7607 /ENTRY POINT TO SYSTEMS HANDLER
+
+ *6600
+ NOPUNCH
+ *7600
+ ENPUNCH
+
+ /SYSTEM HANDLER AND FIELD 0 UPPER PAGE
+ /INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE
+ DVHORG=16 /DEVICE HANDLER RECORDS
+ MTEMP=27
+ MONTOR=13
+ JMS SHNDLR
+ 5000 /SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0
+ 0 /(LOCATIONS 0-1777)
+ MTEMP+4
+ 7602 /TROUBLE WITH SYSTEM DEVICE
+ CDF CIF 10
+ JMP MGET /NOW GO READ IN THE KEYBOARD MONITOR
+\f *6744 /INFORMATION ABOUT CURRENT JOB
+ NOPUNCH
+ *7744
+ ENPUNCH
+JFIELD, 6203 /A CDF CIF N INSTRUCTION TO START THE JOB
+JSTART, 7600 /THE STARTING ADDRESS
+JSBITS, 1000 /VARIOUS STATUS BITS - USED FOR OPTIMIZATION
+ /BIT 4000 - JOB DID NOT LOAD INTO 00000-01777
+ /BIT 2000 - JOB DID NOT LOAD INTO 10000-11777
+ /BIT 1000 - JOB IS NOT RESTARTABLE
+ /BIT 400 - DOESN'T DESTROY BATCH MONITOR
+ /BIT 2 - JOB DOES NOT USE LOCS 00000-01777
+ /BIT 1 - JOB DOES NOT USE LOCS 10000-11777
+SOFSET, 0 /FOR FUTURE(AND MAYBE PRESENT) USE
+
+ /DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP
+ 7750
+ 7751
+ 7752
+ 7753
+ 7754
+ 7755
+ /MONITOR PATCH TO HELP BLEEP LOADER
+ 0 /ADDRESS OF HANDLER FOR DEVICE USED
+MREAD, JMS I .-1
+ 0
+ 0
+ 0
+ HLT
+MSWITC, JMP .+6 /ZEROED IF PG 7000 (HANDLER) MUST BE READ OVER
+ JMS SHNDLR
+ 0300
+ 7000 /THIS AREA MODIFIED BY ODT
+ MTEMP+6
+OS78, HLT /BIT 4 IS A 1 IF OS/78 IS RUNNING
+MSTCDF, CDF CIF 0
+ TCF /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
+ JMP I .+1
+MSTADR, 0
+SBLOCK, 0
+BIPCCL, 0 /MORE STATUS BITS.
+ /BIT 1: 1=> BATCH IS IN PROGRESS
+ /BITS 6-8: FIELD OF BATCH MONITOR
+ /HIGHEST CORE FIELD USED BY OS/8
+ /OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
+\f *0
+ VERSNO /OS/8 VERSION 3
+KMONER, CLA
+ TAD [7605
+ DCA ERRET
+ JMS I [PRMESG
+ TEXT /SYSTEM ERR/
+
+/THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER
+/THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD!
+
+LXR, PMSRST-1
+X1, MSWITC /THESE TWO ARE USED AT INITIALIZATION.
+ADR1, RUN8-1
+ADR2, RUN8&177+7377 /USED DURING R, AND RUN COMMANDS
+XR,
+AMFLAG, 0 /1 MEANS SAW ALTMODE
+ /MUST NOT MOVE FOR CCL AND BATCH
+
+ *20
+RBFLAG, 0 /MUST BE AT LOCATION 20
+TEMP2, -7
+SYSTEM, 7700
+PCH, PRINT
+GLINE, XGLINE
+GNAME, GETNAM
+DEVHND, 7607
+FUDJMP, MSTCDF&177+5200
+P6203, 6203
+TMP, PATCHLEV /MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL
+PGTOUT, GETOUT
+ERRET, PCRLF /MUST BE AT 33 FOR CCL
+
+/THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW
+/VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS
+/READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ.
+
+NM1, 203 /THIS MUST BE A 203!
+BATCH, /ENTRY TO READ NEW BATCH MONITOR
+NM2, JMS I [7607 /THE BATCH INITIALIZER ALTERS SOME VALUES
+NM3, 610 /IN THIS LIST...THIS ONE**********
+NM4, 0 /THIS ONE*****GETS ADDRESS OF BOS.
+TEMP1, 13 /******GETS RECORD OF BOS*****
+TM1, SKP CLA /ERROR. DON'T RUN BATCH
+TMP1, JMP BCHGO
+NMCT, DCA I KM1 /CLEAR BATCH FLAG.
+PN, JMP KMONER
+PRDSW,
+KM1, 7777
+BCHGO,
+RUNSW, CIF CDF 0
+DIGFLG, JMP I .+1
+SENTER, KMINIT /GETS ENTRY POINT (BOS)
+KRCHK, RCHK
+\f FIELD 1
+\f /FIELD 1
+ /OS/8 MONITOR - MONITOR ROUTINES
+ /THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1
+ /IT REPLACES CORE FROM 200-1777
+ /AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION
+ /MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC.
+ MAXCMD=13
+ *200
+MONITO, 0 /MONITOR SUBROUTINE
+ DCA MACARG /STORE AC ARG
+ DCA USERFG /SET FLAG TO INDICATE WE WERE CALLED DIRECTLY
+ RDF /GET CALLING FIELD
+ TAD [CDF CIF 0
+ DCA FGETX
+MRENTR, TAD FGETX
+ DCA FPUTX /FOR LOADING AND STORING CALLING SEQUENCE
+ JMS FGET /GET FIRST ARGUMENT[AND SET DATA FIELD 1)
+ ISZ MONITO
+ CLL
+ TAD [-MAXCMD-1
+ SZL
+ JMP MERROR
+ TAD JMPMAX
+ DCA .+1 /BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
+FGET, 0 /MUST PRESERVE LINK
+ TAD MONITO
+ JMS FGETW
+ JMP I FGET
+/MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT'
+ MERROR
+ MASSIGN
+ MLOOKUP
+ MENTER
+ MCLOSE
+ MCD
+ MCHAIN
+ MERR
+ MESCAP
+ MESCPR
+ MASGN
+MRSETP, MRESET
+FPUT, 0 /MUST FOLLOW LAST ADDRESS IN JUMP TABLE
+FPUTX, 0
+ DCA I MONITO
+ CDF CIF 10
+JMPMAX, JMP I FPUT
+MEOERR, ISZ MERRNO
+MIOERR, ISZ MERRNO
+MERROR, ISZ MERRNO
+ ISZ MERRNO
+ ISZ MERRNO
+ ISZ MERRNO
+MERR, CLA
+ CIF 0
+ JMS I [SHNDLR
+ 0210
+ 1400
+ MERRTN
+ HLT
+ JMP I .-3
+\fMCD, CLA CLL CML RAR
+ JMS CDSWAP /SWAP OUT CORE IF NECESSARY
+ JMS FGET
+ DCA T1
+ CIF 0
+ JMS I [SHNDLR
+ 0601
+ 0
+ MCDREC
+ JMP MIOERR
+ TAD FPUTX
+ CDF CIF 0
+ JMS I [200
+ DCA FPUTX
+ TAD FPUTX
+ DCA FGETX
+ JMS CDSWAP /RESTORE THE SWAPPED CORE IF NECESSARY
+ STL /LINK MUST BE ON AT MRESET
+ JMP I MRSETP /AFTER CD, RESET DEVICE AREA
+MCHAIN, JMS FGET
+ DCA T1 /BUFFER THE ARGUMENT
+ CIF 0
+ JMS I [SHNDLR
+ 0101
+ 7400
+ MRUNRC
+ JMP MIOERR
+ TAD T1 /LOAD THE BUFFERED ARGUMENT
+ CDF CIF 0
+ JMP I .-5
+MLNOTF, CLA
+ ISZ MONITO
+MNEXT, TAD USERFG
+MESCAP, CLL RAR
+ TAD MONITO
+ DCA I [7700
+ TAD FPUTX
+ DCA I [SMCIF
+ CLA IAC CML
+ CDF 0
+ AND I [JSBITS
+ CDF 10
+ RAR
+ SZL SPA CLA /RESTORE CORE IF USERFG=1 AND JSW[11]=0
+ JMP I [SMCIF
+ JMP I [MRETRN
+MESCPR, CLL CML
+ JMP MESCAP+1
+FGETW, 0
+ DCA FPUT
+FGETX, HLT
+ TAD I FPUT
+ CDF CIF 10
+ JMP I FGETW
+\fCDSWAP, 0
+ TAD ME1000 /FORM READ OR WRITE OPERATION
+ DCA MCDCTL
+ CDF 0
+ TAD I [JSBITS
+ CDF 10
+ RTR
+ SZL CLA /IS IT NECESSARY TO SAVE CORE?
+ JMP I CDSWAP /NO
+ CIF 0
+ JMS I [SHNDLR
+MCDCTL, 0
+ 0
+ MTEMP+4
+ JMP MIOERR
+ JMP I CDSWAP
+
+EOVFLO, CIF 0
+ JMS I [SHNDLR
+ 0111
+ME1000, 1000 /ENTER OVERLAY LOADS OVER ENTER (NATCH)
+ MEOVLY
+ JMP MIOERR
+ JMP I ME1000
+\f *400
+ /ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER
+ /(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY)
+ /AND ADJUST TABLES(IF NECESSARY). IS THIS REALLY NECESSARY?
+MASGN, CLA IAC
+MASSIGN, DCA ASFLAG
+ TAD MACARG
+ SZA /IS DEVICE NUMERIC OR SYMBOLIC?
+ JMP DFOUND /NUMERIC
+ JMS I [FGET /GET HIGH ORDER 2 CHARS OF NAME
+ ISZ I [MONITO
+ SNA
+ JMP I [MRTRN+1 /FIRST WORD OF NAME MUST BE NON-ZERO
+ DCA NAME
+ JMS I [FGET
+ SNA /IS NAME >2 CHARACTERS LONG?
+ JMP NOHASH /NO - DON'T HASH
+ TAD NAME
+ RAL
+ CLL CML RAR /FORCE SIGN BIT OF HASH NAME ON
+ DCA NAME
+NOHASH, TAD [UDNAME-1 /SEARCH USER NAME TABLE FIRST
+DSRCH, DCA XR
+ TAD [-17
+ DCA T2
+DSRCLP, TAD I XR
+ CIA
+ TAD NAME
+ SNA CLA
+ JMP DSFND
+ ISZ T2
+ JMP DSRCLP
+ TAD XR
+ SMA CLA /WHICH TABLE DID WE JUST SEARCH?
+ JMP I [MRTRN+1 /SYSTEM TABLE - ERROR
+ TAD [SDNAME-1
+ JMP DSRCH /GO SEARCH SYSTEM TABLE
+DSFND, TAD T2
+ TAD [20
+ JMS I [FPUT /PUT NUMBER INTO CALLING SEQUENCE
+ JMS I [FGET /GET IT BACK IN AC, BUMPING POINTER
+ ISZ I [MONITO
+DFOUND, JMS I [MCKDEV /DETERMINE ITS VALIDITY (NON-ZERONESS)
+ /AND FORM POINTERS
+ SNA /IS THE DEVICE HANDLER IN CORE?
+ TAD I T2
+ SNA /DOES A HANDLER EXIST FOR THE DEVICE?
+ JMP I [MLNOTF /NO - SAME AS THE DEVICE NOT EXISTING
+ CMA RAL /GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK
+ SNL CLA /TWO PAGE HANDLER?(IF HANDLER IS IN CORE,
+ /THIS TEST IS RANDOM BUT WE DON'T CARE)
+ TAD [100 /YES - FORCE A TWO-PAGE READ
+ TAD [100
+ DCA DVHCTL
+ TAD T1
+ DCA T7 /SAVE T1 AS WE WILL DESTROY IT LATER
+ TAD I T1
+ TAD ASFLAG
+ SZA CLA /DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING?
+ JMP AFINIS /NO - HE MUST HAVE TASTE.
+ JMS I [FGET /FETCH PAGE IN WHICH HANDLER IS TO BE LOADED
+ RAR /GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE
+ /PUT THE "TWO PAGE HANDLER" FLAG INTO IT
+ SNL SMA /IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE?
+ JMP I [MLNOTF /NO - GIVE AN ERROR RETURN
+ RAL /YES - ROTATE BACK
+ AND [7600 /MAKE IT LEGAL
+ DCA DVHLOC
+ JMS GETREC
+ DCA DVHREC
+ CIF 0
+ JMS I [SHNDLR
+DVHCTL, 0 /READ ONE OR TWO PAGES INTO FIELD 0
+DVHLOC, 0
+DVHREC, 0
+ JMP I [MIOERR /SYSTEM DEVICE ERROR
+ /NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS
+ TAD [-17 /AND MARK OFF THOSE WHICH ARE NOW IN CORE
+ DCA T4
+DVHCLP, TAD T4
+ JMS I [MCKDEV /LOW ORDER BITS OF T4 GO THROUGH 1-17
+ CMA
+ TAD DVHLOC
+ CLL CML RAR
+ TAD DVHCTL /IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE
+ SMA CLA /LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER)
+ DCA I T1 /MARK IT AS WIPED
+ JMS GETREC
+ CIA
+ TAD DVHREC
+ SZA CLA
+ JMP NOTINC
+ TAD I T2
+ AND [177
+ TAD DVHLOC
+ DCA I T1
+NOTINC, ISZ T4
+ JMP DVHCLP
+AFINIS, TAD I T7
+ JMP I [MRTRN /STORE HANDLER ADDRESS AND EXIT
+\fGETREC, 0
+ TAD I T2 /GET RECORD OF DEVICE HANDLER
+ CLL RTL
+ RTL
+ RTL /EXTRACT THE RECORD NUMBER
+ AND [17
+ TAD [DVHORG-1 /ADD THE BASE OF DEVICE HANDLER STORAGE
+ JMP I GETREC
+
+MCKDEV, 0 /MUST PRESERVE LINK
+ AND [17
+ SNA
+ JMP I [MERROR /DEVICE 0 IS ILLEGAL
+ DCA NAME
+ TAD NAME
+ TAD [SDVHND-1 /FORM POINTER INTO HANDLER IMAGE TABLE
+ DCA T2
+ TAD NAME
+ TAD [DVHNDL-1
+ DCA T1
+ TAD NAME
+ TAD [DCB-1
+ DCA T8 /FORM POINTER TO DCB ENTRY FOR DEVICE
+ TAD I T1
+ JMP I MCKDEV
+
+ IFNZRO .-564 <REASSEMBLE CONFIG>
+SDNAME, ZBLOCK 17 /SYSTEM DNAME TABLE - SET UP BY "CONFIG"
+\f IFZERO .+200&1000 <*600>
+ /LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE
+ /ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE
+ /IS NOT FILE ORIENTED
+MLOOKUP,CLL /SET RDCAT MODE TO INPUT
+ JMS MRDCAT
+ JMP ERETRN /NON-FILE STRUCTURED DEVICE
+ JMS MDSRCH /SEARCH THE DIRECTORY FOR THE FILE
+ JMP MRTRN+1 /NOT FOUND - TAKE ERROR RETURN
+LRETRN, TAD T5
+ CIA
+ TAD I [DORG /CONVERT T5 TO A RECORD NUMBER
+ERETRN, JMS I [FPUT
+ ISZ I [MONITO
+ TAD T6
+ CIA /STORE FILE LENGTH AS A NEGATIVE NUMBER
+MRTRN, JMS I [FPUT /THIS CODE IS JUMPED TO BY SEVERAL ROUTINES
+MRTRN2, ISZ I [MONITO
+ JMP I [MLNOTF
+
+MRDCAT, 0
+ SZA
+ JMP MRDREN /NOT THE FIRST SEGMENT - DON'T SET UP POINTERS
+ DCA T5 /ZERO STARTING BLOCK NUMBER
+ DCA T6 /ZERO FILE LENGTH
+ TAD MACARG /GET DEVICE NUMBER FROM AC
+ JMS I [MCKDEV /CHECK LEGALITY AND FORM POINTERS
+ SNA
+ JMP I [MERROR+1 /DEVICE HANDLER IS NOT IN CORE - ERROR
+ DCA T9 /ADDRESS OF DEVICE HANDLER
+ JMS I [FGET
+ DCA T4 /STORE THE POINTER TO THE FILE NAME IN T4
+ SNL
+ CML RAR
+ RTR /FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK
+ AND I T8
+ SZA CLA /TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0)
+ JMP MRTRN+1 /FAILED THE TEST - ERROR RETURN
+ TAD I T8
+ SMA CLA
+ JMP I MRDCAT /DEVICE IS NOT FILE-ORIENTED
+ ISZ MRDCAT
+ CLA IAC
+MRDREN, DCA MCATRC /STORE SEGMENT NUMBER
+ TAD T9 /USE LOW ORDER BITS
+ AND [177 /OF DEVICE HANDLER ENTRY POINT
+ CLL RTL /AND THE REQUESTED SEGMENT NUMBER
+ RAL /TO FORM A "UNIQUE" KEY
+ TAD MCATRC /FOR THIS SEGMENT OF THIS DIRECTORY
+ /(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT
+ /STARTING OFFSET IN ITS PAGE)
+ CIA
+ TAD OLDT9 /COMPARE KEY AGAINST KEY OF CURRENT SEGMENT
+ SNA /ARE THEY THE SAME?
+ JMP INLRDY /YES - DON'T READ SEGMENT, ITS IN CORE
+ CIA
+ TAD OLDT9
+ DCA OLDT9 /STORE THE KEY OF THE NEW IN-CORE SEGMENT
+ CLA CLL CML RAR /CHANGE WRITE TO READ
+ JMS MWRCAT
+INLRDY, TAD I [DCOUNT
+ CML CMA RAL
+ SZL SPA
+ JMP JMPME2
+ CMA CML RAR /NEW V3 DIRECTORY VERIFYER
+ DCA NFILES /FIRST WORD IN CATALOG = -# OF FILES IN CATALOG
+ TAD [DPROPR-1
+ DCA XR /SET XR TO POINT TO FIRST FILE ENTRY
+ JMP I MRDCAT /RETURN TO BUMPED ADDRESS
+MDSRCH, 0
+FSRCLP, TAD I XR
+ SNA CLA /EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY
+ JMP SKPMTF /SO SKIP THE 4 WORD COMPARE ON THEM
+ CLA CMA
+ TAD XR
+ DCA XR
+ TAD [-4
+ DCA T6
+ TAD T4
+ DCA T7
+SRCWDL, TAD T7
+ JMS I [FGETW
+ CIA
+ TAD I XR
+ SZA CLA /COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS)
+ JMP NXTFIL
+ ISZ T7
+ ISZ T6
+ JMP SRCWDL
+ JMS BUMPXR /SKIP GARBAGE WORDS
+ TAD I XR
+ SNA
+ JMP SKPMTF+1 /UNCLOSED OUTPUT FILES DONT COUNT
+ CIA
+ DCA T6 /STORE FILE LENGTH
+ ISZ MDSRCH
+ JMP I MDSRCH
+NXTFIL, TAD T6
+ IAC
+ JMS BUMPXR /SKIP REST OF NAME AND GARBAGE WORDS
+SKPMTF, TAD I XR /GET LENGTH OF THIS ENTRY
+ TAD T5
+ DCA T5 /ADD TO BLOCK STARTING ADDRESS
+ ISZ NFILES
+ JMP FSRCLP
+ DCA T5 /RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT
+ TAD I [DLINK /DIRECTORY EXHAUSTED - ANY MORE?
+ SZA
+ JMP MRDREN
+ JMP I MDSRCH
+
+BUMPXR, 0 /ROUTINE TO SKIP (DWASTE+AC) WORDS
+
+ TAD I [DWASTE
+ CIA /DWASTE IS NEGATIVE AND SO IS AC
+ TAD XR
+ DCA XR
+ JMP I BUMPXR
+
+MWRCAT, 0
+ TAD [4210
+ DCA CATCTL
+ CIF 0
+ JMS I T9
+CATCTL, 4210 /WRITE 2 RECORDS FROM FIELD 1
+ 1400
+MCATRC, 1
+JMPME2, JMP I [MERROR+2 /CANNOT REWRITE CATALOG
+ JMP I MWRCAT
+
+ IFNZRO .-772 <REASSEMBLE CONFIG> /USED TO BE 766
+SDVHND, ZBLOCK 17 /DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
+\f IFZERO 1000&. <*1000>
+ /ENTER PROCESSOR FOR MONITOR
+ /FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE
+ /AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE
+ /"CLOSE" PROCESSOR.
+MENTER, DCA EPASS /SET UP FOR PASS 1
+ JMS I [MRDCAT /READ CATALOG AND SET UP NFILES AND XR
+ JMP I [ERETRN /NON-FILE-STRUCTURED DEVICE
+ JMS I [CONSOL
+ DCA T2 /INTIIALIZE STARTING BLOCK NUMBER COUNTER
+ TAD [DPROPR-1
+ DCA XR /RESTORE XR (CONSOLIDATOR DESTROYED IT)
+ TAD MACARG
+ CLL RTR
+ RTR
+ AND [377 /GET REQUESTED LENGTH FROM AC BITS 0-7
+ CIA
+ DCA T3 /T3=REQUESTED LENGTH. IF T3=0, MEANS RETURN
+ /LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN
+ /SMALLEST BLOCK OF LENGTH =>T3.
+ TAD I T8 /GET FCB ENTRY
+ AND [7
+ SZA CLA /ANY ACTIVE TENTATIVE FILES ON THIS DEVICE?
+ JMP I [MRTRN+1 /YES - TAKE ERROR RETURN
+MELOOP, TAD I XR
+ SNA CLA
+ JMP MEMPTY /EMPTY SPACE - LOOK AT LENGTH
+ MTHREE /OCCUPIED - IGNORE
+ JMS I [BUMPXR
+ TAD I XR
+MELEND, TAD T2
+ DCA T2 /UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY
+ ISZ NFILES
+ JMP MELOOP /GO TO NEXT ENTRY
+
+ /DIRECTORY BLOCK EXHAUSTED
+ TAD EPASS
+ SZA CLA /WHAT PASS ARE WE IN?
+ JMP EFINUP /SECOND PASS - THIS IS FOR KEEPS
+ TAD I [DLINK /FIRST PASS
+ SZA /ANY MORE SEGMENTS?
+ JMP I [MRDREN /YES - CONTINUE
+
+
+ /DONE - SEE IF OUR BEST IS GOOD ENOUGH.
+ TAD T4
+ JMS I [FGETW
+ SZA CLA /CHECK THAT FIRST WORD OF NAME IS NON-ZERO
+ TAD T6
+ SNA CLA /AND THAT WE FOUND WHAT WE WANTED
+ JMP I [MRTRN2 /OTHERWISE GIVE ERROR RETURN
+ TAD ASFLAG /GET NUMBER OF BEST SEGMENT
+ ISZ EPASS /AND RESTART THE ALGORITHM IN PASS 2
+ JMP I [MRDREN /(TAKES LESS SPACE THAN SAVING XR AND NAME)
+
+ /EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION
+
+EFINUP, TAD XR
+ DCA T1
+ TAD [-4
+ JMS I [BUMPXR
+ TAD I [DWASTE
+ CIA
+ TAD XR /CATALOG MUST HAVE ROOM FOR ONE MORE FILE
+ TAD [-1772 /AFTER THIS FILE IS ENTERED
+ SMA CLA /WILL NEW ADDITION OVERFLOW CATALOG?
+ JMP I [EOVFLO /YUP - CALL OVERLAY TO EXTEND DIRECTORY
+MELP2, TAD I T1 /MOVE REST OF CATALOG UP
+ DCA I XR /TO CREATE SPACE FOR NEW ENTRY
+ CLA CMA
+ TAD T1
+ DCA T1
+ CLA CMA CLL RAL
+ TAD XR
+ DCA XR
+ TAD T1
+ CIA CLL CML
+ TAD NAME
+ SZA CLA /HAVE WE PUSHED UP EVERYTHING?
+ JMP MELP2 /NO, KEEP PUSHING
+ TAD [-4
+ DCA T1 /NOW MOVE THE USERS FILE NAME
+ TAD NAME
+ DCA XR
+ TAD T4
+ JMS I [FGETW /[IN THE USERS FIELD, OF COURSE)
+ DCA I XR
+ ISZ T4
+ ISZ T1 /INTO THE EMPTY SPACE JUST CREATED
+ JMP .-5
+ TAD I [MDATE /PUT DATE OF CREATION INTO FILE NAME
+ DCA I XR /THIS WILL BE DESTROYED IF DWASTE=0
+ IAC /ADJUST XR BUMP BECAUSE OF DATE STORE
+ JMS I [BUMPXR
+ DCA I XR /GIVE THE NEWLY ENTERED FILE A LENGTH OF 0
+ TAD XR /PUT A POINTER TO THE LENGTH WORD OF THE
+ DCA I [DFLAG /NEW ENTRY INTO THE DIRECTORY HEADER
+ CLA CMA
+ TAD I [DCOUNT
+ DCA I [DCOUNT /INCREASE THE FILE COUNT BY 1
+ TAD I T8
+ TAD ASFLAG
+ DCA I T8 /SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
+ JMS I [MWRCAT /WRITE THE ALTERED CATALOG BACK OUT
+ JMP I [LRETRN /STORE ARGS BACK JUST LIKE "LOOKUP"
+\fMEMPTY, TAD I XR
+ CIA CLL
+ DCA T1 /SAVE LENGTH OF CURRENT ENTRY
+ TAD T3
+ TAD T6
+ CLA /LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH
+ TAD T3
+ SNA
+ CML /IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM
+ TAD T1
+ CLA CML /LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN
+ /BEST LENGTH AND CURRENT LENGTH
+ TAD T1
+ CIA
+ TAD T6
+ SZL SNA CLA /TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS,
+ /DEPENDING ON WHETHER LINK IS ON OR OFF
+ JMP MNOCHG /MIN(MAX)=BEST - NOTHING TO DO
+ TAD T1
+ DCA T6 /MAKE CURRENT ENTRY NEW "BEST"
+ CLA CLL CMA RAL
+ TAD XR
+ DCA NAME /REMEMBER CATALOG LOCATION
+ TAD I [MCATRC
+ DCA ASFLAG /ALSO DIRECTORY SEGMENT NUMBER
+ TAD T2
+ DCA T5 /AND STARTING BLOCK NUMBER
+MNOCHG, TAD T1
+ CIA
+ JMP MELEND /GO UPDATE THE BLOCK NUMBER
+\f /CLOSE PROCESSOR - CLOSES AN OUTPUT FILE WHICH WAS OPENED
+ /BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE
+ /CLOSING LENGTH OF THE FILE. PERFORMS A DIRECTORY CLEANUP AFTER
+ /CLOSING THE FILE. IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S
+ /NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND
+ /ONLY IF NO OUTPUT FILE WAS ENTERED). AN ERROR RETURN IS
+ /GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER
+ /AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE.
+
+MCLOSE, JMS I [MRDCAT /GET THE CATALOG
+ JMP CRETRN /NON-FILE STRUCTURED DEVICE - RETURN NORMALLY
+ CLA IAC /GET THE NEXT WORD IN THE CALLING SEQUENCE
+ JMS I [FGET
+ DCA T1 /GET CLOSING LENGTH AND STORE IT AWAY
+ JMS I [MDSRCH /SEARCH FOR THE OLD COPY
+ JMP NODLET /NO OLD COPY
+ MTHREE
+ TAD I [DWASTE
+ JMS SQUISH /SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY
+ DCA I XR2 /AND MAKE THE OTHER TWO INTO AN EMPTY
+ TAD T6 /FILE ENTRY WITH THE SAME LENGTH
+ CIA
+ DCA I XR2 /AS THE OLD COPY
+ TAD I T8
+ AND [7
+ SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE
+ JMP EOCLOS /NO - FINISH UP AND GET OUT
+ CIA /GET THE SEGMENT NUMBER WE WANT
+ TAD I [MCATRC
+ SNA CLA
+ JMP .+3
+ JMS CONSOL
+ JMS I [MWRCAT /NO - WRITE OUT THE ONE WE SQUISHED
+ TAD I [DFLAG /GET LOCATION OF TENTATIVE FILE
+ CIA CLL
+ TAD XR2
+ SZL CLA /IS THE ENTRY TO BE CLOSED ABOVE THE ONE
+ JMP .+3 /WE JUST DELETED?
+ MTHREE /YES - MOVE THE POINTER DOWN
+ TAD I [DWASTE /TO COMPENSATE FOR THE SQUISHING
+ TAD I [DFLAG /THE POINTER WILL NOW POINT
+ DCA I [DFLAG /TO THE LENGTH WORD.
+ /(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE)
+
+NODLET, TAD I T8
+ AND [7
+ SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE?
+ JMP I [MRTRN+1 /WHAT DID HE CALL US FOR? - ERROR
+ JMS I [MRDCAT /YES - READ IN THE CORRECT SEGMENT
+ TAD I [DFLAG
+ DCA T4 /T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY
+ TAD T1
+ CIA /IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY
+ DCA I T4 /DURING CONSOLIDATION
+ ISZ T4
+ ISZ T4
+ CLL CML
+ TAD T1
+ TAD I T4 /SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY
+ SNL SZA
+ JMP I [MERROR+3 /THIS CREEP HAS GONE AND DESTROYED HIS TAPE
+ DCA I T4
+EOCLOS, JMS CONSOL /CONSOLIDATE THE DIRECTORY
+ TAD [7770
+ AND I T8
+ DCA I T8
+ SKP
+CRETRN, TAD [7600 /DO A WRITE OF 0 PAGES. (MAGTAPE)
+ JMS I [MWRCAT
+ ISZ I [MONITO
+ JMP I [MRTRN2
+\f /CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM.
+ /ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM.
+CONSOL, 0
+ TAD [DPROPR-1
+ DCA XR
+ TAD I [DCOUNT
+ DCA T7 /T7 = FILE COUNT
+CONLP, TAD I XR
+ SNA CLA /EMPTY FILE?
+ JMP CONMTF /YES - GO CHECK FOR NULL AND 2 IN A ROW
+ MTHREE
+ JMS I [BUMPXR /GET PAST THE GARBAGE WORDS
+ TAD I XR /GET COUNT
+ SZA CLA /WOULD THIS HAPPEN TO BE A NULL FILE?
+ JMP CONLPT /NAH, GO TO NEXT ONE
+ TAD [-5 /YEAH, REMOVE IT ENTIRELY
+ TAD I [DWASTE /INCLUDING THE WASTE WORDS
+SQCOMN, JMS SQUISH
+ ISZ I [DCOUNT /BUMP DOWN FILE COUNT IN DIRECTORY
+ ISZ NFILES /AS WELL AS THE TEMPORARY ONE IN PAGE 0
+ NOP /V3 RL INSISTS
+ JMP CONSOL+1 /REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
+ /HAVE BROUGHT TWO FREE ENTRIES TOGEHER
+/ THE ABOVE NOP FIXES THE KILLER CLOSE BUG
+CONLPT, ISZ T7
+ JMP CONLP /MORE FILES - KEEP PLUGGING
+ JMP I CONSOL /RETURN FROM CONSOLIDATOR
+CONMTF, TAD I XR /IS THIS FREE ENTRY NULL?
+ SNA
+ JMP SQTRIV /YES - SQUASHITLIKEABUG
+ DCA T2 /NO - SAVE LENGTH
+ TAD XR
+ DCA SQUISH /SAVE POSITION OF LENGTH WORD
+ ISZ T7 /WAS IT THE LAST FILE?
+ SKP /NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!)
+ JMP I CONSOL /YES - RETURN FROM CONSOLIDATOR
+ TAD I XR
+ SZA CLA /TWO EMPTIES IN A ROW?
+ JMP CONLP+3 /NO - SLIP BACK INTO LOOP
+ TAD I XR
+ TAD T2 /YES - COMBINE LENGTHS
+ DCA I SQUISH /STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
+SQTRIV, CLA CMA CLL RAL
+ JMP SQCOMN /SQUISH OUT 2 WORDS
+\fMRESET, TAD [-17
+ DCA T3
+MRSETL, TAD T3
+ JMS I [MCKDEV
+/LINK MUST BE ON AT THIS POINT
+ TAD [200
+ SZL CLA /ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
+ DCA I T1
+ JMS I [FGET
+ SZA CLA
+ TAD [7
+ CMA STL
+ AND I T8
+ DCA I T8 /DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
+ ISZ T3
+ JMP MRSETL
+ JMP I [MNEXT
+
+/SUBR TO COLLAPSE DIRECTORY AFTER A POINT
+SQUISH, 0
+ TAD XR
+ DCA XR1
+ CLA CLL CMA RAL
+ TAD XR1
+ DCA XR2 /SET UP XR2 FOR CHANGING SQUISHED ENTRY
+SQLOOP, TAD I XR
+ DCA I XR1 /MOVE DOWN ONE WORD
+ TAD XR
+ TAD [-1777
+ SZA CLA /AT END YET?
+ JMP SQLOOP /NO, KEEP GOING
+ JMP I SQUISH
+\f *1400
+ /INITIAL DIRECTORY FOR MONITOR
+ /DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)
+
+DCOUNT, -2 /TWO ENTRIES
+DORG, MFREE /FILE STORAGE STARTS AT BLOCK "MFREE"
+DLINK, 0 /THIS IS THE ONLY DIRECTORY RECORD
+DFLAG, 0 /THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE
+DWASTE, -1 /# OF WASTED WORDS PER ENTRY
+DPROPR, 0102 /AB
+ 2314 /SL
+ 0422 /DR
+ 2326 /.SV
+ 3017 /V3D ENCODING FOR 1-JUN-77
+ -5 /FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS)
+ 0 /EMPTY SPACE
+ -1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
+
+ IFNZRO .-1415 <CNFER,QQQ>
+\f *3400 /"ENTER" OVERLAY TO USR - RUNS IN 11000
+ JMP .+3
+MSEGLM, -7 /# DIRECT. SEGS
+NEWLEN, -10
+MEOVLP, TAD I [DLINK
+ SNA CLA
+ JMP MELAST /LAST SEGMENT - MUST CREATE A NEW ONE
+ ISZ I [DCOUNT /BUMP ENTRY COUNT DOWN
+ JMS I [MWRCAT /WRITE OUT THIS SEGMENT
+ JMS MSKIPF /FIND END OF SHORTENED DIRECTORY
+ DCA MEFCNT /PREPARE TO TRANSFER LAST ENTRY
+ TAD (MEOVLS-1
+ DCA XR1 /INTO NEXT DIRECTORY SEGMENT
+ TAD I XR
+ DCA I XR1
+ ISZ MEFCNT /THROUGH A BUFFER AT LOC 11200
+ TAD XR
+ CIA
+ TAD T1 /T1 WAS SET UP BY "ENTER"
+ SZA CLA
+ JMP .-7
+ TAD I T1 /GET LENGTH OF MOVED ENTRY
+ DCA MEOCNT
+ TAD I [DLINK
+ JMS I [MRDCAT /READ NEXT SEGMENT
+ JMS I [CONSOL /MAKE SURE IT IS AT ITS SMALLEST
+ TAD I [DORG
+ TAD MEOCNT
+ DCA I [DORG /BUMP FILE ORIGIN DOWN
+ JMS MSKIPF /FIND LAST LOC IN NEW SEGMENT
+MELP3, TAD XR
+ DCA METMP1
+ TAD XR
+ TAD MEFCNT
+ DCA METMP2 /PREPARE TO PUSH ALL ENTRIES UP
+ TAD I METMP1
+ DCA I METMP2 /DO THE PUSHING
+ STA
+ TAD XR
+ DCA XR
+ TAD XR
+ TAD (-DWASTE
+ SZA CLA /ARE WE THROUGH?
+ JMP MELP3 /NO
+ TAD (MEOVLS-1
+ DCA XR /PREPARE TO MOVE THE SAVED ENTRY INTO THE
+ CLA CMA /NEW SEGMENT
+ TAD I [DCOUNT
+ DCA I [DCOUNT /INCREASE ENTRY COUNT OF NEW SEGMENT
+ TAD MEFCNT
+ CIA
+MECOMN, DCA MEFCNT /STORE NUMBER OF WORDS TO MOVE
+ TAD [DWASTE
+ DCA XR1
+ TAD I XR
+ DCA I XR1
+ ISZ MEFCNT
+ JMP .-3 /MOVE THE ENTRY IN
+ JMS MSKIPF
+ TAD XR
+ DCA T1 /T1=LAST LOC IN SEGMENT
+ TAD I [DWASTE
+ CIA
+ TAD XR
+ TAD [-1772
+ SMA CLA /HAVE WE MADE THIS SEGMENT TOO BIG?
+ JMP MEOVLP /YES - LOOP UNTIL WE GET IT RIGHT
+ JMS I [MWRCAT /WRITE OUT NEW SEGMENT
+ JMP MEOXIT /READ IN ENTER AND CONTINUE
+\fMWRONG, IAC
+MELAST, TAD NEWLEN
+ DCA METMP1 /LENGTH OF NEW SEGMENT
+ TAD METMP1
+ CIA
+ TAD I [DCOUNT
+ SMA /WERE THERE "NEWLEN+1"
+ JMP MWRONG /NO - SET OUR SIGHTS LOWER
+ DCA I [DCOUNT /ADJUST LENGTH OF OLD SEGMENT
+ JMS MSKIPF /FIND BOUNDARY LOC BETWEEN SEGMENTS
+ TAD I [MCATRC
+ IAC
+ DCA I [DLINK /LINK THE OLD LAST SEGMENT TO
+ TAD I [DLINK /THE NEWLY CREATED ONE
+ TAD MSEGLM
+ SMA CLA
+ JMP I (MEOERR /PROVIDED THAT THERE IS ROOM FOR ANOTHER
+ JMS I [MWRCAT /WRITE OUT THE NEXT-TO-LAST SEGMENT
+ ISZ I [MCATRC /BUMP RECORD NUMBER FOR NEXT WRITE
+ ISZ OLDT9 /LIKEWISE BUMP DIRECTORY KEY
+ TAD METMP1
+ DCA I [DCOUNT
+ TAD MEOCNT
+ CIA
+ TAD I [DORG
+ DCA I [DORG /SET UP PARAMETERS OF THE NEW SEGMENT
+ DCA I [DLINK /MARK IT AS THE NEW LAST SEGMENT
+ TAD XR
+ TAD [-1777 /SET UP COUNT OF WORDS TO SLIDE DOWN
+ JMP MECOMN /USE COMMON CODE TO SLIDE WORDS AND EXIT
+
+MSKIPF, 0 /SUBR TO FIND LAST LOC USED IN A SEGMENT
+ /ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT
+ TAD I [DCOUNT
+ DCA MNOFIL
+ TAD [DWASTE
+ DCA XR
+ DCA MEOCNT /INITIALIZE POINTER(XR) AND COUNT(MEOCNT)
+MSKPLP, TAD I XR
+ SNA CLA
+ JMP MEOMTY
+ MTHREE
+ TAD I [DWASTE /BUMP POINTER TO LENGTH WORD OF FILE ENTRY
+ CIA
+ TAD XR
+ DCA XR
+MEOMTY, TAD I XR
+ TAD MEOCNT
+ DCA MEOCNT
+ ISZ MNOFIL
+ JMP MSKPLP
+ JMP I MSKIPF
+\fMEOCNT, 0
+MEFCNT, 0
+METMP1, 0
+METMP2, 0
+MNOFIL, 0
+ MEOVLS=1200 /DESTROYS PART OF "CLOSE" OP FOR BUFFER
+ PAGE
+\f EJECT ABSLDR
+ /ABSOLUTE LOADER FOR OS/8 - VERSION 4A
+ *2000
+ CTLBLK=3400
+ BUFFER=CTLBLK
+ XFIELD=20
+ ORIGIN=21
+ B1=22
+ B2=23
+ B3=24
+ C1=25
+ C2=26
+ C3=27
+ WD=30
+ WD1=31
+ WD2=32
+ FILPTR=33
+ PG7400=34
+ LSTFLD=35
+ LOADXR=11
+ABSLDR, JMS I (CTINIT
+ JMS I (CTINIT
+ JMP CALLCD
+ JMP NOCD
+NEXTCD, JMS I (NEXFIL
+CALLCD, JMS I [200
+ 5 /COMMAND DECODE
+ 0216 /ASSUMED EXTENSION IS .BN
+NOCD, TAD [6001
+ CDF 0
+ DCA I [JSBITS /SET JSBITS TO SAVE CD AREA NEXT TIME
+ CDF 10
+ TAD I [MPARAM+1
+ AND [100
+ SZA CLA /IS /R SWITCH ON?
+ JMS I (CTINIT /YES - RE-INITIALIZE LOADER TABLES
+LD7400, 7400
+ TAD (MIFILE
+ DCA FILPTR
+ JMS I (SETADR /GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE
+NEWFIL, TAD (7001
+ DCA HANDLR
+ TAD I FILPTR
+ AND [7760
+ SZA /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA RCDCNT
+ TAD I FILPTR
+ ISZ FILPTR
+ SNA
+ JMP NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES
+ JMS I [200
+ 1 /ASSIGN
+HANDLR, 7001 /LOAD INTO 7000 IF NOT ALREADY LOADED
+ JMP I (IOERR
+ TAD I FILPTR
+ DCA RECNO
+ ISZ FILPTR
+ CLA CMA
+ DCA CHCNT
+ DCA REOF
+ TAD I [MPARAM /TEST FOR /I
+ AND (10
+ SNA CLA
+ JMP I (LOADER /I IS NOT ON
+ ISZ OFLG /IS /I ALLOWED?
+ JMP I (OERR /NO!
+ JMP I (SLASHO
+\fGETCH, 0 /GET-NEXT-INPUT-CHARACTER ROUTINE
+ TAD [200
+ KRS
+ TAD (-203
+ SNA CLA
+ KSF
+ SKP
+ JMP I (MGET
+ ISZ JMPGET
+ ISZ CHCNT
+JMPX, JMP JMPGET
+ TAD REOF
+ SZA CLA
+ JMP I GETCH /EOF REACHED BEFORE LOGICAL END - ERROR
+ CIF 0
+ JMS I HANDLR
+ 0210 /READ 2 RECORDS INTO FIELD 1
+PBUFFR, BUFFER
+RECNO, 0
+ JMP RERROR
+ ISZ RECNO
+ ISZ RCDCNT
+ SKP
+ ISZ REOF
+ TAD (-601
+ DCA CHCNT
+ TAD PBUFFR
+ DCA CHPTR
+ TAD JMPX
+ DCA JMPGET
+ JMP GETCH+1
+\fJMPGET, JMP .
+ JMP CHAR1
+ JMP CHAR2
+CHAR3, TAD JMPX
+ DCA JMPGET
+ TAD I CHPTR
+ AND LD7400
+ CLL RTR
+ RTR
+ TAD CHTMP
+ RTR
+ RTR
+ ISZ CHPTR
+ JMP GCHCOM
+CHAR2, TAD I CHPTR
+ AND LD7400
+ DCA CHTMP
+ ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM, AND (377
+ ISZ GETCH
+ JMP I GETCH
+RERROR, SPA CLA
+ JMP I (IOERR /AN ACTUAL READ ERROR - AMAZING!
+ ISZ REOF
+ JMP RECNO+2
+REOF, 0
+CHCNT, 0
+CHPTR, 0
+CHTMP, 0
+RCDCNT, 0
+OFLG, -1 /SWITCH FOR /O OPTION
+ PAGE
+\f *2200
+PUTWD, 6402 /ABSLDR VERSION NUMBER
+ CMA
+ AND I B2 /AND OUT THE PAGE SLOT IN THE PAGE TABLE
+ DCA I B2
+ TAD ORIGIN
+ DCA ORGX
+ TAD XFIELD
+ CLL RTR
+ RTR
+ SZA CLA /TEST FOR FIELDS 0 OR 1
+ JMP PUTIT /NEITHER - STORE AS IS
+ SNL
+ JMP FLD0
+ TAD ORIGIN
+ SPA CLA
+ JMP FLD1
+ CLA CLL CML RTR
+ TAD ORIGIN
+ SMA CLA
+ JMP .+3
+ ISZ I (OVLYFG /SET FLAG THAT LOADER IS BEING OVERLAYED
+ TAD (2400 /LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14
+LCOMPR, TAD ORIGIN
+ RTL
+ RTL
+ RAL
+ AND [17
+ TAD (MTEMP
+RLCOMN, DCA PGTMP
+ TAD BUFREC
+ CIA
+ TAD PGTMP
+ SNA CLA
+ JMP DONTWR
+ JMS WRBUF
+WRIBUF, CLA /MODIFIED..IF NOT /O GETS SZA CLA
+ JMP DONTWR
+ CIF 0
+ JMS I [SHNDLR
+ 0210
+ 1400 /USE CATALOG SPACE
+PGTMP, 0
+ JMP I (LIOERR
+DONTWR, DCA OLDT9 /MARK THE CATALOG DESTROYED
+ TAD PGTMP
+ DCA BUFREC
+ TAD ORIGIN
+ AND [377
+ TAD PTRBFR
+ DCA ORGX
+ JMP PUTIT2
+\fFLD1, CLL
+ TAD ORIGIN /IGNORE LOCATIONS ABOVE 17600
+ TAD [200
+ SZL CLA
+ JMP I PUTWD
+PUTIT, TAD XFIELD
+ TAD [7770 /CONSTRUCT CDF N FOR PROPER FIELD
+PUTIT2, TAD CDF10
+ DCA .+1
+M7, -7
+ TAD C3
+ DCA I ORGX
+CDF10, CDF 10
+ JMP I PUTWD
+FLD0, TAD ORIGIN /CHECK FOR STUFF IN PAGE 7000
+ TAD (1000
+ SNL CLA /IF NON ZERO,OVERLAY
+ JMP PUTIT
+ TAD [7400 /FORM RECORD NO. FOR OVERLAY
+ ISZ PG7400 /SET OVERLAY FLAG
+ JMP LCOMPR /FORM RECORD NO.
+WRBUF, CALONC
+ TAD BUFREC
+ SNA
+ JMP I WRBUF
+ CIF 0
+ JMS I [SHNDLR
+ 4210
+PTRBFR, 1400
+BUFREC, 0
+ JMP I (LIOERR
+ DCA BUFREC
+ /BAD I/O ON SYSTEM DEVICE
+ JMP I WRBUF
+\fORGX,
+NEXFIL, ERTRN
+ JMS WRBUF /WRITE WHATEVER
+ TAD I [MPARAM-1
+ SPA CLA
+ JMP I (BUILD
+ TAD I (MPARAM
+ AND (40
+ SZA CLA
+ JMP I (BUILD
+ JMP I NEXFIL
+
+CORTAB, ZBLOCK 30 /ONCE-ONLY CODE INSERTED HERE KATER
+ ZBLOCK 2 /EXTRA NEEDED BY ONCE-ONLY CODE
+ /NOT USED BY CORE TABLE
+ PAGE
+\f *2400
+ITSOVR, JMS ASSEMB
+ CIA
+ TAD LCKSUM
+SZAIN, SZA CLA
+ JMP I (BADCKS
+ TAD I [MPARAM+1
+ AND L40
+ SNA CLA
+ JMP I (NEWFIL
+LOADER, DCA LCKSUM
+ DCA I (OFLG /CANCEL FURTHER /I'S
+ TAD SZAIN
+ DCA I (WRIBUF
+ JMS GETFLD
+ DCA XFIELD
+ TAD [200
+ DCA ORIGIN
+ JMS I (GETCH
+ JMP I (NEWFIL
+ SNA
+ JMP .-3
+ TAD [-200
+ SZA CLA
+ JMP LOADER+1
+LEADER, JMS I (GETCH
+ JMP I (NEWFIL
+ SNA
+ JMP LOADER+1
+ TAD [-200
+ SNA
+ JMP LEADER
+NEWWD, SMA
+ JMP FIELDW
+ TAD [200
+ DCA WD1
+ JMS I (GETCH
+ JMP I (BADINP
+ DCA WD2
+ JMS I (GETCH
+ JMP I (BADINP
+ TAD [-200
+ SNA
+ JMP ITSOVR
+ DCA WD
+ JMS ASSEMB
+ SNL
+ JMP DATAWD
+ DCA ORIGIN
+ DCA I (LOADWD /ZERO 'DATA LOADED' FLAG V3
+ JMP GETNXT
+\fDATAWD, JMS I (LOADWD
+ ISZ ORIGIN
+L40, 40
+GETNXT, TAD WD1
+ TAD WD2
+ TAD LCKSUM
+ DCA LCKSUM
+ TAD WD
+ JMP NEWWD
+\fASSEMB, 0
+ TAD WD1
+ CLL RTL
+ RTL
+ RTL
+ TAD WD2
+ JMP I ASSEMB
+FIELDW, TAD (-32
+ SNA
+ JMP CTLZ
+ TAD (-46
+ SPA
+ JMP NOTXP
+ DCA WD1
+ TAD WD1
+ AND [7 /V3C
+ SZA CLA
+ JMP NOTXP
+ TAD WD1
+ AND (70
+ DCA XFIELD
+ JMS I (GETCH
+ JMP I (BADINP
+ TAD [-200
+ SZA
+ JMP NEWWD
+NOTXP, CLA
+ TAD LCKSUM
+ SNA CLA
+ JMP LOADER
+ JMP I (BADINP
+LCKSUM, 0
+CTLZ, TAD LCKSUM
+ SZA CLA
+ JMP I (BADINP
+ JMP I (NEWFIL
+\fGETFLD, 0
+ DCA C1
+ TAD I (MPARAM+2
+ AND (1774
+ SNA
+ JMP I GETFLD
+ RTL
+ RAL
+ ISZ C1
+ SNL
+ JMP .-3
+ CLA CMA
+ TAD C1
+ CLL RTL
+ RAL
+ JMP I GETFLD
+ PAGE
+\f *2600
+BUILD, TAD (CORTAB+25
+ DCA B1
+ TAD I (CORTAB+3
+ CLL CMA
+ AND [7760
+ SNA CLA
+ CML
+ TAD I (CORTAB
+ CMA
+ AND [7760
+ SNA CLA
+ IAC
+ RTR
+ DCA I (CTLBLK+3
+ TAD (CTLBLK+3
+ DCA LOADXR
+ TAD [-10
+ DCA C1
+ TAD [70
+ DCA FIELDB
+ DCA I (CTLBLK
+FLDLP, TAD FIELDB
+ TAD [-20
+ SMA CLA /IGNORE 07600 AND 17600 IN CCB /V3
+ CMA /IN THE CORE MAP
+ TAD [-37
+ DCA C2
+ DCA LOWERA
+MTLOOP, JMS I (SHFT
+ SNL CLA
+ JMP INUSE
+ TAD LOWERA
+MTRSME, TAD [200
+ DCA LOWERA
+ ISZ C2
+ JMP MTLOOP
+ JMP FLDOVR
+INUSE, TAD LOWERA
+ TAD [200
+ DCA UPPERA
+ ISZ C2
+ SKP
+ JMP ENDRGN-2
+ JMS I (SHFT
+ SZL CLA
+ JMP ENDRGN
+ TAD UPPERA
+ JMP INUSE+1
+ CLA CMA
+ DCA C2
+ENDRGN, TAD LOWERA
+ AND [7400
+ DCA I LOADXR
+ ISZ I (CTLBLK
+ TAD LOWERA
+ AND [7400
+ CIA
+ TAD UPPERA
+ CLL RAR
+ TAD FIELDB
+ DCA I LOADXR
+ TAD UPPERA
+ JMP MTRSME
+\fFLDOVR, TAD FIELDB
+ TAD [-10
+ DCA FIELDB
+ CLA CLL CMA RTL
+ TAD B1
+ DCA B1
+ ISZ C1
+ JMP FLDLP
+ TAD I (CTLBLK
+ SNA
+ JMP I (NULERR
+ CIA
+ DCA I (CTLBLK
+ TAD I [MPARAM+1 /CLOBBER BATCH?
+ AND [400
+ TAD I (MPARAM+2 /AH ED, BUG IF YOU SPEC /P/1 TO LOADER
+ AND (403
+ TAD I (CTLBLK+3
+ DCA I (CTLBLK+3
+ TAD LSTFLD
+ AND [7
+ CLL RTL
+ RAL
+ TAD [CDF CIF 0
+ DCA I (CTLBLK+1
+ SKP
+ORG200, TAD [200
+ TAD LSTADR
+ SZA /V3
+ JMP NOORG /V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT
+ TAD I (LOADWD /V3 NO EXPLICIT START ADDR
+ CLA /REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF
+/* SZA CLA /V3 IS IT SELF STARTING BIN FORMAT?
+ JMP ORG200 /V3 NO
+ TAD XFIELD /V3 YES
+ TAD [CIF CDF 0 /V3
+ DCA I (CTLBLK+1 /V3
+ TAD I (ORIGIN /V3
+NOORG, DCA I (CTLBLK+2
+ JMP I (LGTOUT /WRITE CONTROL BLOCK AND EXIT
+FIELDB, 0
+\fUPPERA,
+SETADR, 0
+ TAD I (MPARAM+3
+ SNA /IS THERE A STARTING ADDRESS SPECIFIED?
+ JMP I SETADR /NO
+ DCA LSTADR
+ TAD I [MPARAM-1
+ DCA LSTFLD
+ JMP I SETADR
+
+LOWERA, 0
+LSTADR, 0
+ PAGE
+\f *3000
+ZOFILE, MOFILE
+ZOUCNT, -47
+LGTOUT, TAD PG7400
+ SNA CLA
+ JMP .+7
+ CIF 0
+ JMS I [SHNDLR
+ 0300
+ 7000
+ MTEMP+15
+ JMP I (LIOERR
+ CIF 0
+ JMS I [SHNDLR
+ 4210
+ CTLBLK-200
+ MTEMP+10
+ JMP I (LIOERR
+ TAD I (CTLBLK+2
+ DCA CTL2 /MOVE THINGS INTO THIS PAGE
+ TAD I (CTLBLK+3
+ DCA CTL3 /SO WE CAN REFERENCE THEM WITH DF=0
+ TAD I [MPARAM
+ AND (40
+ SNA CLA
+ JMP LNOGO
+ TAD CTL3
+ RAL
+ SPA CLA /ARE WE OVERLAYING THE I/O MONITOR?
+ JMP LKICKM /NO
+ CDF 0
+ DCA I [JSBITS /YES - SET JSBITS TO FORCE A READ
+ CDF 10
+ JMS I [200
+ 13 /RESET I/O DEVICES AND FILES
+LKICKM, JMS I [200
+ 11 /KICK MONITOR OUT
+ /********************************************
+ /NO PAGE ZERO REFERENCES AFTER THIS POINT
+ /PAGE ZERO MAY CONTAIN USER CODE
+ /********************************************
+ DCA I ZOFILE /ZERO OUT COMMAND DECODER AREA
+ ISZ ZOFILE
+ ISZ ZOUCNT
+ JMP .-3
+ TAD I (CTLBLK+1
+ CDF 0
+ DCA I (MSTCDF
+ TAD CTL2
+ DCA I (MSTADR /SET UP STARTING ADDRESS IN FIELD 0
+ JMP LMOVRD
+\fLNOGO, TAD CTL3 /ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES
+ SPA CLA /ARE WE OVERLAYING THE KEYBOARD MONITOR?
+ TAD (5 /NO - RETURN TO NON-SAVING ENTRY
+ TAD [7600
+ CDF 0
+ DCA I (MSTADR
+ TAD ZCDIF0
+ DCA I (MSTCDF
+ CLA CMA
+LMOVRD, CDF 10
+ DCA I (7700 /SET 7700 TO -1 IF NO GO
+ TAD I (CTLBLK+1
+ CDF 0
+ DCA I (JFIELD /SET UP PARAMETERS IN FIELD 0
+ TAD CTL2
+ DCA I (JSTART
+ TAD CTL3
+ DCA I (JSBITS
+LMOVLP, TAD COMBO
+ DCA I COMBPT
+ ISZ LMOVLP
+ ISZ COMBPT
+ ISZ COMBCT
+ JMP LMOVLP /MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0
+ZCDIF0, CDF CIF 0
+ TAD OVLYFG
+ SZA CLA
+ JMP I (MREAD /LOADER OVERLAYED - GO READ OVERLAY
+ JMP I (MSTCDF /LOADER NOT OVERLAYED - WHY READ?
+COMBPT, MREAD-1
+COMBCT, -7
+COMBO, 7607
+ MREAD-1&177+4600 /JMS I .-1
+ 1010
+ 2000
+ MTEMP+11 /LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
+ HLT
+ MSTCDF&177+5200 /JMP MSTCDF
+CTL2, 0
+CTL3, 0
+OVLYFG, 0
+\fLOADWD, 0
+ DCA C3
+ TAD XFIELD
+ CLL RAR
+ TAD XFIELD
+ RTR
+ TAD (CORTAB-1
+ DCA B2
+ TAD ORIGIN
+ AND [7600
+ CLL RTL
+ RTL
+ RTL
+ ISZ B2
+ TAD (-14
+ SMA
+ JMP .-3
+ DCA CTL2
+ CLL CML
+ RAL
+ ISZ CTL2
+ JMP .-2
+ JMS I (PUTWD
+ JMP I LOADWD
+ PAGE
+\f *3200
+ERPCH, 0
+ AND (77 /GET LOW ORDER 6 BITS
+ SZA
+ JMP NZCHAR
+ JMS ERR
+FILMSG, TEXT /, FILE 0/
+NZCHAR, TAD (240
+ AND (77
+ TAD (240 /CONVERT TO ASCII
+ JMS LDRPCH /PRINT
+ JMP I ERPCH /AND RETURN
+LDRPCH, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I LDRPCH
+SHFT, 0
+ CLA CLL CMA RTL
+ DCA C3
+ CLA CLL CML RTL
+ TAD B1
+SHFTLP, DCA B3
+ TAD I B3
+ RAL
+ DCA I B3
+ CLA CMA CML
+ TAD B3
+ ISZ C3
+ JMP SHFTLP
+ JMP I SHFT /NOTE: SHFT LEAVES AC NON-ZERO
+\fERR, ONCE /CAN'T USE PAGE 0 LITERALS
+ CLA
+ CDF 10
+ TAD I (FILPTR /ZERO CHAR GETS REPLACED BY "FILE #"
+ TAD (322 /MAGIC NUMBER
+ CLL CML RAR /AC NOW CONTAINS " #"
+ DCA FILMSG+3
+ERRLUP, TAD I ERR
+ SNA
+ JMP EOMESG /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
+ RTR
+ RTR
+ RTR
+ JMS ERPCH
+ TAD I ERR
+ JMS ERPCH
+ ISZ ERR
+ JMP ERRLUP
+EOMESG, TAD (215 /TERMINATE MESSAGE WITH CR-LF
+ JMS LDRPCH
+ TAD (212
+ JMS LDRPCH
+ERTRN, JMP I (ABSLDR /RETURN TO LOADER STARTING ADDRESS
+IOERR, JMS ERR
+ TEXT %I/O ERROR%
+BADINP, JMS ERR
+ TEXT /BAD INPUT/
+BADCKS, JMS ERR
+ TEXT / BAD CHECKSUM/
+NULERR, JMS CTINIT
+ NOP
+ JMS ERR
+ TEXT /NO INPUT/
+\fLIOERR, JMS ERR
+ TEXT /SYSTEM I-O ERROR/
+OERR, JMS ERR
+ TEXT %NO /I!%
+
+CTINIT, 0
+CALONC, JMS I ERR /CALL ONCE-ONLY CODE
+ TAD (-30
+ DCA C1
+ TAD (CORTAB-1
+ DCA LOADXR
+ CLA CMA
+ DCA I LOADXR
+ ISZ C1
+ JMP .-3
+ DCA LSTFLD
+ DCA I (LSTADR /V3 SET INITIAL STARTING ADDRESS TO 0
+ DCA I (OVLYFG
+ DCA PG7400
+ ISZ CTINIT
+ JMP I CTINIT
+ PAGE
+\f
+*CTLBLK+200
+
+/CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT
+/USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED,
+/AS IT IS USED FOR A BUFFER
+
+SLASHO, CLA CMA
+ DCA I (OFLG /RE ENABLE /I
+ TAD I (HANDLR
+ DCA GLONK /ENTRY POINT TO HANDLER
+ TAD I (RECNO
+ DCA CCBLOK
+ CIF 0
+ JMS I GLONK /READ IN CORE CONTROL BLOCK
+ 0110
+CCBPTR, CTLBLK
+CCBLOK, 0
+ JMP I (OERR /DATA FAILURE
+ TAD I CCBPTR /NO. SEGMENTS
+ CMA /TEST FOR BAD CORE IMAGE
+ AND L7740
+ SZA CLA
+ JMP I (BADINP /NOT CORE IMAGE
+ TAD I CCBPTR
+ DCA SEGCNT
+ TAD I SGSTAD /THIS CODE IS NEW FOR V3D
+/ AND [70 /GET FIELD
+ CLL RTR
+ RAR
+ DCA I (LSTFLD
+ ISZ SGSTAD
+ TAD I SGSTAD
+ DCA I (LSTADR
+ ISZ SGSTAD
+ TAD I SGSTAD /GET JSW FROM SAVE FILE
+ AND [400
+ DCA TEMP /PRESERVE /P
+ TAD I [MPARAM+1
+ AND (7377
+ TAD TEMP
+ DCA I [MPARAM+1
+ TAD I SGSTAD
+ AND (3 /PRESERVE LAST 2 BITS
+ DCA TEMP
+ TAD I (MPARAM+2
+ AND [7774
+ TAD TEMP
+ DCA I (MPARAM+2
+ ISZ SGSTAD
+NEWSEG, TAD I SGSTAD /SEGMENT START ADDRESS
+ DCA ORIGIN
+ TAD I SGFDLT /FIELD AND LENGTH
+ AND L77
+ DCA XFIELD
+ TAD I SGFDLT
+ AND [7700
+ SNA /V3C
+ STL CLA RAR /AC4000
+ DCA SEGLTH
+ TAD SEGLTH
+TWOPG, TAD [7600
+ SMA CLA /NO.. IS TWO PAGE SEGMENT LEFT?
+ TAD [7600 /YES..-400 TO WORD COUNT
+ TAD [7600 /NO.. -200 TO WORD COUNT
+ DCA WDCT
+ TAD SEGLTH
+ TAD [7600 /BUMP DOWN LENGTH LEFT
+ DCA SEGLTH
+
+ ISZ CCBLOK /POINT TO NEXT DATA RECORD
+ TAD CCBLOK
+ DCA DATRC
+ DCA OLDT9 /MARK DIRECTORY DESTROYED
+ CIF 0
+ JMS I GLONK /READ THE DATA RECORD IN
+ 0210
+ 1400 /INTO 11400
+TEMP,
+DATRC, 0
+ JMP I (IOERR /DATA FAILURE
+ CLA CMA
+ TAD ORIGIN
+ AND [177
+ TAD (1200 /SET UP INPUT POINTER
+ CHARPT=10
+ DCA CHARPT
+LOOPI, TAD I CHARPT
+ JMS I (LOADWD /MOST OF THE WORK
+ ISZ ORIGIN
+L7400, 7400 /NOP
+ ISZ WDCT /FINISHED THIS BLOCK?
+ JMP LOOPI
+ JMS I (WRBUF /YES.. WRITE THE STUFF OUT
+ DCA I (BUFREC /SO THAT WRBUF DOESN'T SCREW US UP
+ TAD SEGLTH /V3C (REARRANGED)
+ SMA SZA /ALL PAGES DONE?
+ JMP TWOPG /NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
+ ISZ SEGCNT /YES, ANY MORE SEGMENTS
+ SKP
+ JMP RENEW /RESET CCB POINTER FOR NEXT /I
+ CLA CLL CML RTL
+ TAD SGSTAD
+ DCA SGSTAD
+ CLA CLL CML RTL
+ TAD SGFDLT
+ DCA SGFDLT /POINT TO NEXT CCB ENTRIES
+ JMP NEWSEG
+
+GLONK, 0 /HANDLER ENTRY POINT HERE
+WDCT, 0
+SEGCNT, 0
+SEGLTH, 0
+CTLBLK=3400
+
+SGFDLT, CTLBLK+5 /FIELD AND LENGTH WORD
+SGSTAD, CTLBLK+1 /SEGMENT START ADDRESS
+
+L7740,
+RENEW, 7740 /USED TO CLEAR AC
+L77, 77 /MIGHT OR MIGHT NOT SKIP
+ TAD (CTLBLK+1
+ DCA SGSTAD
+ TAD (CTLBLK+5
+ DCA SGFDLT
+ JMP I (NEWFIL
+ PAGE
+\f *CORTAB /ONCE-ONLY CODE
+
+ONCE, 0 /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
+ DCA I WRBUF /DON'T CALL AGAIN
+ TAD [400
+ TAD K7400
+ SZA CLA
+ JMP OLDMON
+ TAD [7
+ TAD M7
+ SNA CLA
+ JMP I ONCE /THEY AGREE
+OLDMON, TAD KERR
+ DCA I NEXFIL
+ JMS I PERR /THEY DON'T
+ TEXT /INCOMPATIBLE/ /MUST BE AN EVEN # OF CHARS LONG
+ CIF CDF 0
+ JMP I K7605
+K7400, 7400
+PERR, ERR
+K7605, 7605
+KERR, ERR&177+5600
+\f /PAGE 0 - TEMPORARIES AND LITERALS.
+ /LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS
+ /IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS)
+
+ /LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS
+
+ *7
+OLDT9, 0 /POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE
+
+ *15
+XR1, 0
+XR2, 0
+XR, 0
+ *20 /ENTRY TO MONITOR FROM A CALL TO 17700 -
+ /CAN BE DESTROYED AFTER IT IS EXECUTED
+MSTART, TAD I T1
+ DCA MACARG
+ TAD I [7700
+ DCA I [MONITO
+ TAD I [SMCIF
+ DCA I T2 /FAKE A CALL TO "MONITO"
+ TAD I [MONITO
+ RAL
+ SNL SMA CLA
+ TAD I [SMCIF
+ TAD T3
+ SNA CLA /CHECK FOR A CALL FROM 10000-11777
+ JMP I [MERROR /YES - GIVE ERROR IMMEDIATELY
+ JMP I T4 /NO - SLIDE INTO MONITOR CODE
+
+ *36 /POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD"
+ SDNAME /SYSTEM DEVICE NAME TABLE
+ SDVHND /DEVICE HANDLER ENTRY TABLE
+\f *40 /LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE
+USERFG, 1 /MUST BE IN 40 - SEE CD LISTING
+T1, MARG1 /MUST BE AT 41
+T2, FGETX
+T3, -6213
+T4, MRENTR
+T5, 0
+T6, 0
+T7, 0
+T8, 0
+T9, 0
+NAME, 0
+NFILES, 0
+ASFLAG, 0
+MACARG, 0
+EPASS, 0
+MERRNO, 4000
+MEOXIT, CIF 0 /RETURN FROM ENTER OVERLAY
+ JMS I [SHNDLR
+ 0210
+ 1000
+ MONTOR+2 /RESTORE LOCS 1000-1377 OF USR
+ HLT /HELP!
+ JMP I .+1
+ MENTER /RESTART ENTER OPERATION COMPLETELY
+\f $
+\f
--- /dev/null
+/2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f DTRB=6772
+ DTLB=6774
+ DTXA=6764
+ DTCA=6762
+ DTRA=6761
+ DTSF=6771
+
+
+/WRITTEN BY MARK BRAMHALL 1970
+/MODIFIED FOR TD8E BY R. LARY 1973
+/DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
+/
+/PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
+/
+/COMMAND DECODER RULES:
+/
+/*OUTPUT_INPUT,INPUT,...
+/
+/OUTPUT IS:
+/ DEV:FILE.EXT[NN]
+/ DEFAULT DEVICE IS DSK:
+/ [NN] IGNORED IF PDP-10 OUTPUT
+/ IF /L OR /F DEFAULT OUTPUT IS TTY:
+/
+/INPUT IS:
+/ DEV:FILE.EXT
+/ DEFAULT DEVICE IS DSK:
+/ FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
+/ UP TO NINE (9) INPUT FILES
+/
+/OPTIONS ARE:
+/ /L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
+/ /F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
+/ /Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
+/ /D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
+/ /B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
+/ /I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
+/ /P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)
+
+
+/ MAINTENACE RELEASE FIXES:
+
+/1. DATE 75 STUFF
+/2. TD8E RELIABILITY IMPROVEMENTS
+/3. ANSI DATE OUTPUT FORMAT
+/4. INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
+/ RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
+/ DECTAPES ON A TD8E.
+\f/COMMAND DECODER SETS UP:
+/
+/AT "MOUTPU" THE LIST--
+/ LLL LLL LLD DDD OR UUU 100 000 000
+/ NAME (TRIMMED) NAME (EXCESS 40)
+/ NAME NAME
+/ NAME NAME
+/ EXTENSION EXTENSION
+/ 0 EXTENSION
+/
+/ OS8 FILE OR PDP-10 FILE
+/
+/WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
+/
+/AT "MINPUT" THE LIST--
+/ LLL LLL LLD DDD OR UUU 100 000 000
+/ START BLOCK ANY BLOCK
+/
+/ OS8 FILE OR PDP-10 FILE
+/
+/THE LIST ENDS WITH A ZERO (0) WORD
+/
+/AT "MPARAM" THE BLOCK--
+/ ABC DEF GHI JKL
+/ MNO PQR STU VWX
+/ YZ0 123 456 789
+/
+/WHICH ARE THE OPTION CHARACTERS
+/
+/THE = CONSTRUCTION IS NOT IMPLEMENTED
+\f/DEFINITIONS
+
+VERSION= 3 /VERSION NUMBER
+SUBVER= 01 /PATCH LEVEL
+ /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+
+DIRECT=7000 /PDP-10 DIRECTORY BUFFER (FIELD 1)
+IBUF10=3000 /PDP-10 INPUT BUFFER (FIELD 1)
+INBUF=3000 /OS8 INPUT BUFFER (FIELD 1)
+OBUF10=5000 /PDP-10 OUTPUT BUFFER (FIELD 1)
+OUBUF=5000 /OS8 OUTPUT BUFFER (FIELD 1)
+
+OUDEVH=7200 /OUTPUT DEVICE (FIELD 0)
+INDEVH=6600 /INPUT DEVICE (FIELD 0)
+
+INCTL=1010 /INPUT CONTROL
+OUCTL=5010 /OUTPUT CONTROL
+INRECS=4 /INPUT RECORDS
+
+MDATE=7666 /MONITOR'S DATE (FIELD 1)
+
+MINPUT=7617 /INPUT LIST (FIELD 1)
+MOUTPU=7600 /OUTPUT LIST (FIELD 1)
+MPARAM=7643 /PARAMETER LIST (FIELD 1)
+JSBITS=7746 /0S8 JOB STATUS BITS
+
+DCB=7760 /DEVICE CONTROL BLOCK (FIELD 1)
+PTP=20 /DCB VALUE OF THE PAPER TAPE PUNCH
+\f/PAGE ZERO AND POINTERS
+
+*10
+
+INDEX0, 0 /AUTO-INDEX REGISTERS
+INDEX1, 0
+INDEX2, 0
+INDEX3, 0
+INDEX4, 0
+INDEX5, 0
+INDEX6, 0
+IXR, 0 /INPUT LIST INDEX REGISTER
+
+*20
+
+UNIT10, 0 /CURRENT PDP-10 UNIT (U400)
+
+POINT, 0 /GENERAL POINTER
+
+CNTR, 0 /GENERAL COUNTER
+
+TEMP1, 0 /TEMPORARIES
+TEMP2, 0
+TEMP3, 0
+TEMP4, 0
+TEMP5, 0
+TEMP6, 0
+
+CHARNI, 0 /CHARACTER INPUT NUMBER
+CHARNO, 0 /CHARACTER OUTPUT NUMBER
+
+OUNIT, 0 /OUTPUT UNIT
+IUNIT, 0 /INPUT UNIT
+
+IBLOCK, 0 /INPUT BLOCK
+OBLOCK, 0 /OUTPUT BLOCK
+
+INPUT, 0 /INPUT ROUTINE POINTER
+OUTPUT, 0 /OUTPUT ROUTINE POINTER
+
+IPOINT, 0 /INPUT POINTER
+OPOINT, 0 /OUTPUT POINTER
+
+SAVELN, 0 /OPTION /P SWITCH
+
+MODE, 0 /OPTION /I AND /B SWITCH
+
+WORDS, 0 /WORDS LEFT COUNTER
+
+DATE, 0 /TODAY'S DATE
+
+FREEP, 0 /POINT TO FREE SPOT
+
+PRINT0, 0 /PRINT ROUTINE TEMPORARIES
+PRINT1, 0
+PRINT2, 0
+PRINT3, 0
+PRINTC, 0 /240 FOR LEADING SPACES
+
+RBFLAG, 0 /RUBOUT FLAG
+
+CDDEVF, 0 /DEFAULT DEVICE NAME
+ 0
+
+CDNAME, 0 /FILE NAME
+ 0
+ 0
+CDEXT, 0 /FILE EXTENSION
+ 0
+ 0 /FILLER WORD
+
+PERSW, 0 /PERIOD SWITCH
+
+DEVSW, 0 /DEVICE SWITCH
+
+CDDEV, 0 /DEVICE
+ 0
+
+INSEG, 0 /PDP-10 UNIT WITH DIRECTORY IN CORE
+
+PDP10D, ZBLOCK 10 /LIST OF KNOWN PDP-10 UNITS
+
+CDCNT, 0 /INPUT LIST COUNTER
+
+CDI04, 0 /POINTER SAVE
+
+XDSK, TEXT /DSK/ /DEFAULT DEVICE DSK:
+
+OCHARY, 0 /TEMPORARY
+DVTYPE, 0 /DEVICE TYPE HOLDER
+TDUNIT, 0 /0 OR 4000
+TAPFUN, 0 /DECTAPE FUNCTION
+DATE75, 0 /1 MEANS HAD H.O. BIT ON
+XDATE, 0 /POINTS TO EXTRA DATE BIT
+HIDATE, 0 /HIGH-ORDER BIT OF TODAY'S DATE
+
+/ KLUDGE FOR DATE-75 BUG:
+/ ONLY CONSIDER 1 MORE BIT OF PRECISION
+/ INSTEAD OF ALL 3 EXTRA BITS
+/ SINCE OS/8 DATE WILL RUN OUT BEFORE
+/ THAT FAILS
+ PAGE
+\f JMP I (PIP10 /NORMAL ENTRY
+ JMS ERROR /PIP10 CANNOT BE CHAINED TO
+ ERMES0-1
+
+/ERROR ROUTINES
+
+IOERR, JMS ERROR /I/O ERROR
+ ERMES1-1
+
+NOROOM, JMS ERROR /NO ROOM IN TAPE OR DIRECTORY
+ ERMES2-1
+
+NOOFIL, JMS ERROR /NO SUCH DEVICE
+ ERMES3-1
+
+FNOTFD, JMS ERROR /FILE NOT FOUND
+ ERMES9-1
+NOT10F, JMS ERROR /NOT A PDP-10 FILE
+ ERMES4-1
+
+ERDELF, JMS ERROR /ERROR DELETING A FILE
+ ERMES5-1
+
+NOTPSF, JMS ERROR /NOT A OS8 FILE
+ ERMES6-1
+
+NOOOFL, JMS ERROR /ERROR OPENING THE OUTPUT FILE
+ ERMES7-1
+
+SYNTAX, JMS ERROR /SYNTAX ERROR
+ ERMES8-1
+
+ERROR, 0 /ERROR ROUTINE
+ CLA
+ CDF
+ TAD I ERROR
+ DCA INDEX0 /POINT TO MESSAG-1
+ TAD (ERROR3
+ DCA OUTPUT /SET TTY: OUTPUT
+ JMS ERROR4 /PRINT THE STRING
+ JMP I (PIPCD /AND BACK TO NORMAL
+
+ERROR4, 0 /PRINT THE STRING POINTED BY INDEX0
+ TAD I INDEX0
+ DCA TEMP1 /SAVE WORD
+ TAD TEMP1
+ RTR
+ RTR
+ RTR
+ JMS ERROR2 /BREAK IT DOWN
+ TAD TEMP1
+ JMS ERROR2
+ JMP ERROR4+1 /LOOP
+
+ERROR2, 0
+ AND [77 /USE 6 BITS
+ SNA
+ JMP I ERROR4 /END
+ DCA TEMP2
+ TAD TEMP2
+ AND (40
+ SNA CLA
+ TAD (100
+ TAD [200 /MAKE A CHAR
+ TAD TEMP2
+ TAD (-337 /_ IS SPECIAL
+ SNA
+ TAD (215-337
+ TAD (337
+ JMS ERROR7 /PUT IT
+ JMP I ERROR2
+
+ERROR7, 0
+ DCA TEMP2
+ TAD TEMP2
+ JMS I OUTPUT
+ TAD TEMP2
+ TAD (-215
+ SZA CLA
+ JMP I ERROR7
+ TAD (212
+ JMP ERROR7+1
+
+ERROR3, 0
+ TLS
+ TSF
+ JMP .-1
+ CLA
+ JMP I ERROR3
+\f/PRINT ROUTINE
+
+PRINT, 0
+ DCA PRINT0
+PRINT7, DCA PRINTC /SET SWITCH
+ TAD (PRINTL
+ DCA PRINT1
+ CLL CLA CMA RTL
+ DCA PRINT3
+PRINT4, DCA PRINT2
+ JMP .+3
+
+ DCA PRINT0
+ ISZ PRINT2
+ TAD PRINT0
+ TAD I PRINT1
+ SMA
+ JMP .-5
+ CLA
+ ISZ PRINT1
+ TAD PRINT2
+ SZA
+ JMP PRINT5 /IT IS NON-ZERO
+ TAD PRINTC
+ SZA
+ JMS I OUTPUT /PRINT LEADING SPACE IF DESIRED
+ JMP PRINT6
+
+PRINT5, TAD ("0
+ JMS I OUTPUT
+ CLL CLA CML RAR
+PRINT6, ISZ PRINT3
+ JMP PRINT4
+ TAD PRINT0
+ TAD ("0
+ JMS I OUTPUT
+ JMP I PRINT
+ PAGE
+\f/PDP-10 DECTAPE SERVICE ROUTINE
+/
+/CALL:
+/ JMS READT /READ PDP-10 DECTAPE
+/ BUFFER /BUFFER ADDRESS - FIELD 1
+/ BLOCK /BLOCK NUMBER
+/
+/ JMS WRITET /WRITE PDP-10 DECTAPE
+/ BUFFER /BUFFER ADDRESS - FIELD 1
+/ BLOCK /BLOCK NUMBER
+/
+/THE UNIT IS IN "UNIT10"
+
+TCON2, 2 /MUST BE AT BEGINNING OF PAGE!
+
+WRITET, 0 /WRITE PDP-10 DECTAPE
+ CDF /BE SURE OF FIELD 0
+ TAD WRITET
+ STL
+ JMS I (TDIOCK /CHECK FOR TD IO
+ TAD I WRITET /GET BUFFER ADDRESS
+ DCA TBUF /AND SAVE IT
+ JMS RWTEST /TEST DIRECTION
+WRITE2, JMS I (FLIP /REVERSE - FLIP BUFFER NOW
+ TAD (50
+WRITE1, DCA TAPFUN /SET FUNCTION (30=READ, 50=WRITE)
+ DTLB /SEARCH INTO FIELD 0
+ TAD (TBLK
+ DCA I TCA /TAPE BLOCK INTO "TBLK"
+TERR, RTL /ERROR BIT IS 0 INITIALLY
+ RAL /SHIFT END ZONE BIT INTO LINK
+ CML CLA /CLEAR REST OF THE JUNK
+ TAD [200 /'GO' BIT
+TSTART, SNL /SKIP IF NO REVERSE DIRECTION
+ TAD [400 /'REVERSE' BIT
+ DTXA /START DRIVE GOING
+TLOOP, JMS I (DTWAIT
+
+TOUT, SPA /ERROR?
+ JMP TERR /YES - CHECK IT
+ DTRA /CHECK DIRECTION
+ RTL
+ RTL /DIRECTION BIT INTO LINK
+TMOD1, SZL CLA /'SNL CLA' IF REVERSE MODE
+TMOD4, TAD TCON2 /'CLL CLA CMA RAL' IF REVERSE MODE
+ TAD TBLK /GET BLOCK FOUND
+ CMA
+ TAD I WRITET /GET BLOCK DESIRED
+ CMA
+ SZA CLA /SKIP IF FOUND THE BLOCK
+ JMP TSTART /NOT FOUND - GO AGAIN
+TMOD2, SZL CLA /'SNL CLA' IF REVERSE MODE
+ JMP TSTART+1 /FOUND BUT WRONG DIRECTION - REVERSE IT
+ CLA CMA
+ TAD TBUF /GET BUFFER ADDRESS-1
+ DCA I TCA /SET ADDRESS
+ TAD (10
+ DTLB /SET FIELD 1 BUFFER
+ TAD TAPFUN
+ DTXA /SET READ OR WRITE
+ TAD TM600
+ DCA I TWC /SET WORD COUNT OF 600 OCTAL WORDS
+ DTSF /FLAG?
+ JMP .-1 /NO - WAIT
+ DTRB /CHECK FOR ERRORS
+ SPA CLA
+ JMP I (IOERR /ERROR!!
+ TAD [200
+ DTXA /STOP THE DRIVE
+TMOD3, JMS I (FLIP /POSSIBLE FLIP AFTER READ
+ ISZ WRITET
+ JMP I WRITET /EXIT
+
+TCA, 7755 /DECTAPE CURRENT ADDRESS
+TWC, 7754 /DECTAPE WORD COUNT
+TBLK, 0 /SET TO BLOCK FOUND IN SEARCH
+TBUF, 0 /HOLDS BUFFER ADDRESS
+
+/READ ENTRY POINT
+
+READT, 0 /PDP-10 DECTAPE READ
+ CDF /INSURE FIELD 0
+ TAD READT
+ CLL
+ JMS I (TDIOCK /CHECK FOR TD IO
+ TAD I READT /GET BUFFER ADDRESS
+ DCA TBUF /AND SAVE IT
+ TAD READT
+ DCA WRITET /MOVE RETURN ADDRESS
+ JMS RWTEST /CHECK DIRECTION
+ NOP /NO INITIAL FLIP IF REVERSE
+ TAD (30 /READ FUNCTION
+ JMP WRITE1 /GO DO REST OF THE ROUTINE
+\fRWTEST, 0 /CHECK DIRECTION TO READ/WRITE AND SEARCH
+ ISZ WRITET
+ JMS I (GOLDBK /GET OLD BLOCK NUMBER (NEGATIVE)
+ TAD I WRITET /GET DESIRED BLOCK
+ DCA TBLK /SAVE FOR FUTURE USE
+ SZL CLA
+ TAD (10 /FORWARD - SZL CLA
+ TAD TMOD6 /REVERSE - SNL CLA
+ DCA TMOD1 /SET UP FOR DIRECTION
+ TAD TMOD1
+ DCA TMOD2
+ SNL CLA
+ TAD WRITE2 /REVERSE - FLIP BUFFER AFTER
+ DCA TMOD3 /FORWARD - NO BUFFER FLIP
+TMOD6, SNL CLA
+ TAD (7344-1200 /REVERSE - CLL CLA CMA RAL
+ TAD TMOD5 /FORWARD - TAD TCON2
+ DCA TMOD4 /X0002 OR 17776
+ SZL CLA
+ ISZ RWTEST /FORWARD - 2ND EXIT
+ IAC
+ SNL
+ CIA /REVERSE DIRECTION
+ TAD I WRITET
+ SPA
+TM600, CLA /NO LOWER THAN 0
+ DCA I TAPFUN /SET NEW LAST SERVICED BLOCK
+ TAD TBLK /REMEMBER SAVING THIS?
+ CLL
+ SMA SZA /<0 AND 0 SKIP AND HAVE LINK=0
+ CLL CML CIA />0 BECOMES <0 AND HAS LINK=1
+TMOD5, TAD TCON2
+ CLA RTR /LINK HAS SEARCH DIRECTION
+ RTR
+ TAD (10 /ADD 'SEARCH' BIT
+ DTCA DTXA /LOAD SEARCH AND DIRECTION
+ TAD UNIT10 /GET UNIT
+ DTXA /ADD UNIT (ALSO FLIPS DIRECTION)
+ JMP I RWTEST /EXIT
+ PAGE
+\f/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS
+
+OLDTBL, 0;0;0;0;0;0;0;0
+/FLIP THE BUFFER ROUTINE
+
+FLIP, 0 /FLIP A 600 WORD BUFFER (FIELD 1)
+ TAD I (TBUF /BUFFER START
+ DCA FLIP1 /SET START
+ TAD (577
+ TAD I (TBUF
+ DCA FLIP2 /SET END (END=START+577)
+ TAD (-300
+ DCA FLIP3 /SET COUNT (600/2=300)
+ CDF 10 /BUFFER IS IN FIELD 1
+FLIP6, TAD I FLIP1 /GET START
+ JMS FLIP4 /FLIP IT
+ DCA FLIP5 /SAVE TEMPORARILY
+ TAD I FLIP2 /GET END
+ JMS FLIP4 /FLIP IT
+ DCA I FLIP1 /PUT END INTO START
+ TAD FLIP5
+ DCA I FLIP2 /PUT START INTO END
+ ISZ FLIP1 /BUMP POINTERS
+ CLA CMA
+ TAD FLIP2
+ DCA FLIP2
+ ISZ FLIP3 /DONE?
+ JMP FLIP6 /NO - LOOP
+ CDF /BACK TO FIELD 0
+ JMP I FLIP /EXIT
+
+FLIP1, 0 /START POINTER
+FLIP2, 0 /END POINTER
+FLIP3, 0 /COUNTER
+FLIP5, 0 /TEMPORARY
+FLIP7, 0 /FLIPPING TEMPORARIES
+FLIP8, 0 /" "
+
+FLIP4, 0 /FLIP A CELL
+ DCA FLIP7 /SAVE IT
+ TAD FLIP7
+ RTL
+ RTL
+ AND (7 /GET ...1
+ DCA FLIP8 /ACCUMULATE RESULT
+ TAD FLIP7
+ RTR
+ RAR
+ AND (70 /GET ..2.
+ TAD FLIP8
+ DCA FLIP8 /BUILD RESULT
+ TAD FLIP7
+ AND (70
+ CLL RTL
+ RAL /GET .3..
+ TAD FLIP8
+ DCA FLIP8 /BUILD RESULT
+ TAD FLIP7
+ AND (7
+ CLL RTR
+ RTR /GET 4...
+ TAD FLIP8
+ CMA /GET NOT 4321
+ JMP I FLIP4 /EXIT
+\f/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE
+
+TDIOCK, 0
+ DCA TDRET /SAVE RETURN ADDR
+ RAR
+ DCA TDFUN /SAVE READ/WRITE
+ JMS I (GET10D /GET TYPE OF DECTAPE
+ TAD (-2
+ SZA CLA
+ JMP I TDIOCK /TC08 - CONTINUE
+ TAD I TDRET
+ DCA TDBUF /SAVE BUF ADDR
+ ISZ TDRET
+ JMS GOLDBK /GET OLD BLOCK #
+ TAD I TDRET
+ CLA RAL /GET DIRECTION
+ TAD (110 /ONE BLOCK, FIELD 1
+ TAD TDFUN
+ DCA TDFUN /SAVE FINAL FUNCTION WORD
+ JMS I (TDUSET /SET UP HANDLER
+ TAD TDUNIT
+ SPA CLA
+ TAD (DTA1-DTA0
+ TAD (DTA0
+ DCA TDIOCK /SET UP HANDLER ENTRY PTR
+ TAD I TDRET
+ DCA I TAPFUN
+ TAD I TAPFUN
+ DCA TDBLK
+ JMS I TDIOCK
+TDFUN, 0
+TDBUF, 0
+TDBLK, 0
+ JMP I (IOERR
+ ISZ TDRET
+ JMP I TDRET
+TDRET, 0
+
+GOLDBK, 0
+ TAD UNIT10 /GET THE UNIT WE NEED
+ CLL RTL
+ RTL /SHIFT INTO BITS 9-11
+ TAD (OLDTBL
+ DCA TAPFUN /POINT TO THIS UNIT'S POSITION
+ TAD I TAPFUN /GET LAST SERVICED BLOCK
+ CLL CIA
+ JMP I GOLDBK
+ PAGE
+\f/GET A LINE ROUTINE
+
+GLINE, 0 /GET A LINE
+ TAD ["*
+ JMS I [ERROR3 /ANNOUNCE US WITH A *
+ DCA RBFLAG /RESET RUBOUT FLAG
+ TAD [LINBUF-1
+ DCA IXR /POINT TO THE BUFFER
+CHLOOP, KSF
+ JMP CHLOOP /WAIT FOR TTY:
+ TAD [200
+ KRS /READ TTY:
+ DCA TEMP1
+ KCC
+ TAD [SPADR-1
+ DCA INDEX0 /SET LIST SEARCH
+ TAD I INDEX0
+ SNA
+ JMP .+6 /END OF LIST
+ TAD TEMP1
+ SNA CLA
+ JMP I INDEX0 /FOUND SO JUMP
+ ISZ INDEX0
+ JMP .-7 /LOOP
+
+ JMS PRNT /PRINT IT
+CINSRT, TAD TEMP1
+ DCA I IXR /STORE THE CHARACTER
+ TAD IXR
+ TAD (-LINBUF-100
+ SZA CLA
+ JMP CHLOOP /GET ANOTHER CHARACTER
+ JMS CRCR
+ JMP I (SYNTAX /ERROR
+
+CARRET, JMS CRCR
+CLFINI, DCA I IXR /SET END
+ DCA I IXR
+ JMP I GLINE /EXIT
+
+SPADR, -225;JMP CTRLU
+ -215;JMP CARRET
+ -377;JMP RUBOUT
+ -375;JMP ALTMOD
+ -376;JMP ALTMOD
+ -233;JMP ALTMOD
+ -200;JMP CHLOOP
+ -217;JMP CHLOOP
+ -337;JMP BAKARR
+ -212;JMP LFEED
+ -203;JMP CTRLC
+ 0
+
+BAKARR, JMS PRNT /"_"
+ TAD ["<
+ JMP CINSRT+1 /USE "<" INSTEAD
+
+CTRLC,
+CTRLU, TAD ["^
+ JMS I [ERROR3 /CONTROL CHARACTERS
+ TAD TEMP1
+ TAD [100
+CLRLIN, JMS I [ERROR3
+ JMS CRCR
+ TAD I INDEX0
+ SZA CLA
+ JMP GLINE+1 /NOT "^C"
+ TSF
+ JMP .-1
+ JMP I (7605 /TO MONITOR
+
+CRCR, 0
+ TAD [215
+ DCA TEMP1
+ JMS PRNT
+ TAD [212
+ JMS I [ERROR3 /PRINT CR-LF
+ JMP I CRCR
+
+ALTMOD, TAD ["$
+ DCA TEMP1 /ALTMODE IS "$"
+ JMS PRNT
+ JMP CLFINI /ENDS THE LINE
+
+RUBOUT, TAD IXR
+ TAD (1-LINBUF
+ SNA CLA
+ JMP RBSPCL /SPECIAL TREATMENT
+ TAD ("\
+ ISZ RBFLAG
+ JMS I [ERROR3 /PRINT \
+ CLA CMA
+ DCA RBFLAG /SET FLAG
+ TAD IXR
+ DCA TEMP2
+ TAD I TEMP2
+ JMS I [ERROR3 /PRINT RUBED CHAR
+LBCKUP, CLA CMA
+ TAD IXR
+ JMP CHLOOP-1 /GO GET ANOTHER
+
+RBSPCL, ISZ RBFLAG
+ JMP CLRLIN+1 /NOT INTO RUBOUTS
+ TAD ("\
+ JMP CLRLIN
+
+PRNT, 0
+ ISZ RBFLAG
+ JMP .+3
+ TAD ("\
+ JMS I [ERROR3 /END OF RUBOUTS
+ DCA RBFLAG
+ TAD TEMP1
+ JMS I [ERROR3 /PRINT CHAR
+ JMP I PRNT
+
+LFEED, JMS CRCR
+ DCA I IXR /SET END
+ TAD [LINBUF-1
+ DCA IXR
+ TAD ["*
+ JMS I [ERROR3
+ TAD I IXR /PRINT THE LINE
+ SNA
+ JMP LBCKUP
+ JMP .-4
+ PAGE
+\f/FIND A SLOT ROUTINE
+/SLOT NUMBERS BETWEEN 0 AND 1101
+/RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
+/
+/CALL:
+/ JMS FINDSL /FIND A SLOT
+/ SLOT# /SLOT NUMBER
+/ (AC) /VALUE OF SLOT RETURNED
+/
+/SLOT NUMBER OF 0 RETURNS 7777
+
+FINDSL, 0 /FIND A SLOT
+ CLA CMA
+ TAD I FINDSL /GET SLOT NUMBER-1
+ ISZ FINDSL
+ SPA /WAS IT 0?
+ JMP FINDSA /YES
+ JMS DIV7 /NO - DIVIDE BY 7
+ TAD (JMP I FINDS0+7
+ DCA DIV1 /USE REMAINDER FOR JUMPING
+ CDF 10 /BUFFER IS IN FIELD 1
+DIV1, HLT /TEMPORARY AND JUMP CELL
+
+FINDSA, CLA CMA
+ JMP I FINDSL /EXIT WITH 7777 FOR SLOT NUMBER 0
+
+FINDS0, FINDS1 /JUMP TABLE
+ FINDS2
+ FINDS3
+ FINDS4
+ FINDS5
+ FINDS6
+ FINDS7
+
+/DIVIDE BY 7 ROUTINE
+
+DIV7, 0 /DIVIDE BY 7
+ DCA DIV1 /SAVE IT
+ TAD (DIRECT
+ DCA POINT /POINT TO DIRECTORY
+ TAD DIV1
+DIV3, TAD (-7 /SUBTRACT 7'S
+ SPA
+ JMP I DIV7 /EXIT WITH REMAINDER
+ ISZ POINT /BUMP POINTER BY 3
+ ISZ POINT
+ ISZ POINT
+ JMP DIV3 /AND LOOP
+
+/FIND SLOT ROUTINE #1
+/USE WORD 1 BITS 0-4
+
+FINDS1, TAD I POINT /GET CELL
+ RTL
+ RTL
+ RTL /GET FIRST 5 BITS
+FINDS8, AND [37 /ONLY 5 BITS
+ CDF /BACK TO FIELD 0
+ JMP I FINDSL /AND EXIT WITH VALUE IN AC
+
+/FIND SLOT ROUTINE #2
+/USE WORD 1 BITS 5-9
+
+FINDS2, TAD I POINT
+ RTR /USE BITS 5-9
+ JMP FINDS8
+
+/FIND SLOT ROUTINE #3
+/USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2
+
+FINDS3, TAD I POINT
+ AND [3 /USE BITS 10-11 OF 1ST WORD
+ CLL RTL
+ RAL /SHIFT TO BITS 7-8
+ DCA DIV1 /SAVE IT
+ ISZ POINT /NEXT WORD
+ TAD I POINT
+ CLL RTL
+FINDS9, RTL /GET INTO BITS 8-11
+ AND [17 /GET ONLY BITS 8-11
+ TAD DIV1 /ADD OTHER BITS
+ JMP FINDS8
+
+/FIND SLOT ROUTINE #4
+/USE WORD 2 BITS 3-7
+
+FINDS4, ISZ POINT /USE 2ND WORD
+ TAD I POINT
+ RTR /USE BITS 3-7
+ JMP FINDS2+1
+
+/FIND SLOT ROUTINE #5
+/USE WORD 2 BITS 8-11 AND WORD 3 BIT 0
+
+FINDS5, ISZ POINT /USE 2ND WORD
+ TAD I POINT
+ AND [17
+ CLL RAL /GET BITS 7-10
+ DCA DIV1 /AND SAVE THEM
+ ISZ POINT /NEXT WORD
+ CLL CLA CML RAR
+ AND I POINT /GET BIT 0
+ JMP FINDS9
+
+/FIND SLOT ROUTINE #6
+/USE WORD 2 BITS 1-5
+
+FINDS6, ISZ POINT
+ ISZ POINT /USE 3RD WORD
+ TAD I POINT
+ RAL
+ JMP FINDS1+1
+
+/FIND SLOT ROUTINE #7
+/USE WORD 3 BITS 6-10
+
+FINDS7, ISZ POINT
+ ISZ POINT /USE 3RD WORD
+ TAD I POINT
+ RAR /GET RID OF LAST BIT
+ JMP FINDS8
+\f/DELETE A PDP-10 ENTRY
+/
+/CALL:
+/ (AC) /POINT TO NAME-1 (FIELD 1)
+/ JMS DELETE /DELETE A PDP-10 ENTRY
+/ -NO- /NOT FOUND
+/ -OK- /ENTRY DELETED
+
+DELETE, 0 /DELETE A PDP-10 ENTRY
+ JMS I (FIND /TRY TO FIND IT FIRST
+ JMP I DELETE /NOT FOUND
+ ISZ DELETE /FOUND - 2ND EXIT
+ DCA DELET1 /SAVE SLOT NUMBER
+ CLA IAC
+ DCA DELET2 /START AT SLOT 1
+ TAD (-1101
+ DCA DELET3 /DO 1101 SLOTS
+ JMS FINDSL /FIND A SLOT
+DELET2, 0 /SLOT NUMBER
+ CIA
+ TAD DELET1 /IS IT ONE OF OURS?
+ SZA CLA
+ JMP DELET4 /NO
+ TAD DELET2 /YES
+ DCA .+2 /SET SLOT NUMBER AGAIN
+ JMS I (FILLSL /FILL WITH A 0
+ 0
+ 0 /FILL WITH A 0
+DELET4, ISZ DELET2 /NEXT SLOT
+ ISZ DELET3 /MORE?
+ JMP DELET2-1 /YES - LOOP
+ CDF 10 /DIRECTORY IS IN FIELD 1
+ DCA I INDEX0 /REMEMBER "FIND" SETTING THIS UP?
+ DCA I INDEX0 /REMOVE THE FILE NAME
+ DCA I INDEX0
+ TAD INDEX0
+ TAD [77
+ DCA INDEX0 /POINT TO EXTENSION
+ DCA I INDEX0
+ DCA I INDEX0 /REMOVE EXTENSION
+ DCA I INDEX0
+ CDF
+ JMP I DELETE /EXIT
+
+DELET1, 0 /HOLDS FOUND SLOT NUMBER
+DELET3, 0 /COUNTER
+ PAGE
+\f/FILL A SLOT ROUTINE
+/
+/CALL:
+/ JMS FILLSL /FILL A SLOT
+/ SLOT# /SLOT NUMBER
+/ VALUE /VALUE TO FILL SLOT WITH
+/
+/SLOT NUMBER 0 IS ILLEGAL!
+
+FILLSL, 0 /FILL A SLOT ROUTINE
+ CLA CMA
+ TAD I FILLSL /GET SLOT NUMBER-1
+ ISZ FILLSL
+ JMS I (DIV7 /DIVIDE BY 7
+ TAD (JMP I FILLS0+7
+ DCA FILLS9 /USE REMAINDER FOR JUMPING
+ TAD I FILLSL /GET VALUE
+ ISZ FILLSL
+ AND [37 /5 BIT VALUE ONLY
+ CDF 10 /DIRECTORY IS IN FIELD 1
+FILLS9, HLT /TEMPORARY AND JUMP CELL
+
+/JUMP TABLE
+
+FILLS0, FILLS1
+ FILLS2
+ FILLS3
+ FILLS4
+ FILLS5
+ FILLS6
+ FILLS7
+
+FILLSA, 0 /TEMPORARY
+
+/FILL SLOT ROUTINE #1
+/BITS 0-4 OF WORD 1
+
+FILLS1, CLL RTR
+ RTR /VALUE INTO BITS 0-4
+ RTR
+ DCA FILLS9 /SAVE VALUE
+ TAD I POINT
+ AND [177 /AND OFF BITS 0-4
+FILLS8, TAD FILLS9 /ADD IN VALUE
+ DCA I POINT /SET NEW WORD
+ CDF /BACK TO FIELD 0
+ JMP I FILLSL /EXIT
+
+/FILL SLOT ROUTINE #2
+/BITS 5-9 OF WORD 1
+
+FILLS2, CLL RTL /VALUE INTO BITS 5-9
+ DCA FILLS9 /SAVE VALUE
+ TAD I POINT
+ AND (7603 /AND OFF BITS 5-9
+ JMP FILLS8
+
+/FILL SLOT ROUTINE #3
+/BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2
+
+FILLS3, DCA FILLS9 /SAVE VALUE
+ TAD FILLS9
+ CLL RAR
+ CLL RAR /GET BITS 10-11
+ CLL RAR
+ DCA FILLSA /SAVE
+ TAD I POINT
+ AND (7774 /AND OFF BITS 10-11
+ TAD FILLSA /ADD IN BITS 10-11
+ DCA I POINT /SET NEW WORD
+ ISZ POINT /GOTO WORD 2
+ TAD FILLS9
+ AND [7 /GET BITS 0-2
+ CLL RTR
+ RTR /SHIFT THEM
+ DCA FILLS9 /SAVE VALUE
+ TAD I POINT
+ AND (777 /AND OFF BITS 0-2
+ JMP FILLS8
+
+/FILL SLOT ROUTINE #4
+/BITS 3-7 OF WORD 2
+
+FILLS4, CLL RTL
+ RTL /SHIFT INTO POSITION
+ DCA FILLS9 /AND SAVE
+ ISZ POINT /USE WORD 2
+ TAD I POINT
+ AND (7017 /AND OFF BITS 3-7
+ JMP FILLS8
+
+/FILL SLOT ROUTINE #5
+/BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3
+
+FILLS5, DCA FILLS9
+ TAD FILLS9 /GET VALUE
+ CLL RAR /GET BITS 8-11
+ DCA FILLSA /AND SAVE
+ ISZ POINT /USE WORD 2 FIRST
+ TAD I POINT
+ AND [7760 /AND OFF BITS 8-11
+ TAD FILLSA /ADD IN THOSE BITS
+ DCA I POINT /SET NEW WORD 2
+ ISZ POINT /NOW WORD 3
+ CLA IAC
+ AND FILLS9 /GET BIT 0
+ CLL RTR /AND SHIFT INTO POSITION
+ DCA FILLS9 /AND SAVE IT
+ CLL CLA CMA RAR
+ AND I POINT /AND OFF BIT 0
+ JMP FILLS8
+
+/FILL SLOT ROUTINE #6
+/BITS 1-5 OF WORD 3
+
+FILLS6, CLL RTL
+ RTL /SHIFT INTO POSITION
+ RTL
+ DCA FILLS9 /AND SAVE
+ ISZ POINT
+ ISZ POINT /USE WORD 3
+ TAD I POINT
+ AND (4077 /AND OFF BITS 1-5
+ JMP FILLS8
+
+/FILL SLOT ROUTINE #7
+/BITS 6-10 OF WORD 3
+/BIT 11 OF WORD 3 A 0
+
+FILLS7, CLL RAL /SHIFT INTO POSITION
+ DCA FILLS9 /AND SAVE
+ ISZ POINT
+ ISZ POINT /USE WORD 3
+ TAD I POINT
+ AND [7700 /AND OFF BITS 6-11
+ JMP FILLS8
+\fFIX75, 0 /DF 10
+ CDF /SET H.O. DATE WORD OF FILE
+ TAD I (SLOTNO /ENTRY NO. OF FILE
+ CLL RAL /*3
+ TAD I (SLOTNO /SINCE 1 -10 WORD= 3 -8 WORDS
+ TAD (DIRECT-1 /POINT TO HIGH ORDER BIT OF DATE
+ DCA FIXPTR /V3C
+ CDF 10
+ STA CLL RAL /OTHER STUFF IS VERY IMPORTANT
+ AND I FIXPTR /SO KEEP IT
+ TAD HIDATE /OR IN THIS BIT
+ DCA I FIXPTR /AND WRITE IT BACK
+ JMP I FIX75
+
+FIXPTR, 0 /POINTS TO WORD CONTAINING H.O. DATE
+ PAGE
+\f/GET NEXT SLOT ROUTINE
+/GOES BY 5'S EITHER FORWARD OR BACKWARD
+/
+/CALL:
+/ (AC) /CURRENT BLOCK NUMBER
+/ JMS NEXTSL /GET NEXT SLOT
+/ (AC) /NEXT BLOCK NUMBER
+/
+/GOES TO "NOROOM" IF DIRECTORY FULL
+
+NEXTSL, 0 /GET NEXT SLOT
+ TAD NEXTDI /ADD IN DIRECTION FACTOR
+ SPA
+ JMP NEXTS2 /<0 MEANS REVERSE DIRECTION
+ TAD [-1102
+ SMA
+ JMP NEXTS2 />1101 MEANS REVERSE DIRECTION
+ TAD (1102
+ DCA NEXTS1 /SET NEW BLOCK NUMBER
+ JMS I (FINDSL /IS THIS SLOT FREE?
+NEXTS1, 0 /BLOCK NUMBER
+ SZA CLA
+ JMP NEXTS3 /NO - NOT FREE
+ TAD NEXTS1 /FREE
+ DCA NEXTS7+1 /SET BLOCK AGAIN
+NEXTS7, JMS I (FILLSL /FILL THIS SLOT THEN
+ 0 /SLOT TO FILL
+SLOTNO, 0 /VALUE TO FILL WITH
+ TAD NEXTDI
+ SMA CLA /MAKE SURE DIRECTION IS -4 OR 4
+ TAD (10
+ TAD (-4
+ DCA NEXTDI
+ TAD NEXTS7+1 /GET NEW BLOCK
+ JMP I NEXTSL /EXIT
+
+NEXTS2, CLA /REVERSE DIRECTION
+ TAD NEXTDI
+ SMA CLA /SET 0 OR 1101
+ TAD (1101
+ DCA NEXTS1 /INTO BLOCK NUMBER
+ TAD NEXTDI
+ CIA /REVERSE DIRECTION
+ JMP NEXTS3+1 /GO PRETEND WE FOUND A FULL SLOT
+
+NEXTS3, TAD NEXTDI
+ SMA CLA /MAKE DIRECTION -1 OR 1
+ CLL CLA CMA RAL
+ CMA
+ DCA NEXTDI /DIRECTION IS -1 OR 1
+ TAD [-1102
+ DCA NEXTS4 /CHECK 1102 BLOCKS
+ TAD NEXTS1
+ DCA NEXTS5 /SET START BLOCK
+ JMS I (FINDSL /CHECK A SLOT
+NEXTS5, 0 /SLOT TO CHECK
+ SNA CLA
+ JMP NEXTS6 /FOUND A FREE SLOT
+ ISZ NEXTS4 /TRY MORE?
+ SKP /YES
+ JMP I (NOROOM /NO - OUT OF ROOM
+ TAD NEXTS5
+ TAD NEXTDI /ADD DIRECTION TO SLOT
+ SPA
+ JMP NEXTS2 /<0 IS TOO FAR
+ TAD [-1102
+ SMA
+ JMP NEXTS2 />1101 IS TOO FAR
+ TAD (1102
+ DCA NEXTS5 /SET NEW BLOCK
+ JMP NEXTS5-1 /KEEP GOING
+
+NEXTS6, TAD NEXTS5 /GET FREE BLOCK
+ JMP NEXTS7-1 /AND SET IT
+
+NEXTS4, 0 /COUNTER
+
+NEXTDI, 0 /DIRECTION (5, -5, 1, -1)
+
+/MORE PDP-10 OUTPUT
+
+/OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+OCHAR3, TAD OCHARY
+ CLL RTR
+ RTR
+ AND [7
+ TAD I OPOINT
+ DCA I OPOINT
+ ISZ OPOINT
+ TAD OCHARY
+ AND [17
+ CLL RTR
+ RTR
+ RAR
+ JMP I (OCHARD
+\fMONTBL, "J;"A;"N
+ "F;"E;"B
+ "M;"A;"R
+ "A;"P;"R
+ "M;"A;"Y
+ "J;"U;"N
+ "J;"U;"L
+ "A;"U;"G
+ "S;"E;"P
+ "O;"C;"T
+ "N;"O;"V
+ "D;"E;"C
+ PAGE
+\f/PDP-10 CHARACTER OUTPUT ROUTINE
+/
+/CALL:
+/ (AC) /CHARACTER
+/ JMS OCHR10 /OUTPUT TO PDP-10
+/ -RETURN- /O.K. RETURN
+
+OCHR10, 0 /OUTPUT TO PDP-10
+ DCA OCHARY /SAVE CHAR
+ TAD MODE /IMAGE MODE?
+ SZA
+ JMP OC10A1 /YES /I OR /B
+ TAD OCHARY /NO - USE 7 BITS
+ AND [177
+OC10A2, DCA OCHARY
+OC10A3, TAD CHARNO /GET CHAR NUMBER
+ TAD (JMP I OCHARX
+ DCA OCHARZ /USE TO SET UP JUMP
+ CDF 10 /BUFFER IS IN FIELD 1
+OCHARZ, 0 /JUMP TO THE ROUTINE
+
+OC10A1, SMA CLA /BINARY?
+ JMP OC10A3 /NO
+ TAD OCHARY /YES
+ AND [377
+ JMP OC10A2
+
+OCHARX, OCHAR0
+ OCHAR1
+ OCHAR2
+ OCHAR3
+ OCHAR4
+
+/OUTPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+OCHAR0, TAD I [OBUF10+2
+ AND [177 /GET COUNT
+ TAD (-177
+ SZA CLA
+ JMP OCHARA /STILL ROOM IN BUFFER
+ CDF /NO ROOM IN BUFFER
+ TAD OBLOCK
+ JMS I (NEXTSL /GET THE NEXT BLOCK NUMBER
+ DCA OCHARZ /AND SAVE IT
+ CDF 10 /BACK TO FIELD 1
+ TAD OCHARZ
+ AND [7700
+ CLL RTR
+ RTR
+ RTR /GET LINK POINTER
+ DCA I [OBUF10
+ TAD OCHARZ
+ AND [77
+ CLL RTL
+ RTL
+ RTL
+ TAD I [OBUF10+1
+ DCA I [OBUF10+1 /AND SET POINTER
+ TAD OUNIT
+ DCA UNIT10 /SET OUR UNIT
+ TAD OBLOCK
+ DCA .+3 /AND OUR BLOCK
+ JMS I (WRITET /WRITE PDP-10 DECTAPE
+ OBUF10
+ 0 /BLOCK NUMBER IS SET
+ CDF 10 /BACK TO FIELD 1
+ DCA I [OBUF10
+ TAD I [OBUF10+1
+ AND [77
+ DCA I [OBUF10+1 /CLEAR POINTER
+ TAD OCHARZ
+ DCA OBLOCK /SET NEW BLOCK
+ TAD I [OBUF10+2
+ AND [7400
+ DCA I [OBUF10+2 /ZERO COUNT
+ TAD (OBUF10+3
+ DCA OPOINT /RESET POINTER
+OCHARA, ISZ I [OBUF10+2 /BUMP COUNT
+ TAD MODE /IMAGE MODE?
+ SNA
+ JMP OCHARB /NO
+ SMA CLA /BINARY?
+ JMP OC10A4 /NO
+ DCA I OPOINT /YES
+ ISZ OPOINT
+ DCA I OPOINT
+ ISZ OPOINT
+ TAD OCHARY
+ DCA I OPOINT /SET 8 BITS
+ ISZ OPOINT
+OCHARC, CDF /BACK TO FIELD 0
+ JMP I OCHR10 /EXIT
+
+OC10A5, ISZ OPOINT
+OC10A4, TAD OCHARY
+ JMP OCHARD
+
+OCHARB, TAD OCHARY
+ CLL RTL
+ RTL
+ RAL /USE BITS 0-6
+OCHARD, DCA I OPOINT /SET IT
+ ISZ CHARNO /BUMP CHARACTER NUMBER
+ JMP OCHARC
+
+/OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+OCHAR1, TAD MODE
+ SZA CLA
+ JMP OC10A5
+ TAD OCHARY
+ CLL RAR /GET BITS 7-11
+ CLL RAR
+ TAD I OPOINT
+ DCA I OPOINT /SET WORD 1
+ ISZ OPOINT /NOW WORD 2
+ TAD OCHARY
+ AND [3
+ CLL RTR
+ RAR /GET BITS 0-1
+ JMP OCHARD
+
+/OUTPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+OCHAR2, TAD MODE
+ SZA CLA
+ JMP OC10A6
+ TAD OCHARY
+ CLL RTL
+ RAL /GET BITS 2-8
+ TAD I OPOINT
+ JMP OCHARD
+
+/OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
+/BIT 11 WORD 3 IS 0
+
+OCHAR4, TAD OCHARY
+ CLL RAL /BITS 4-10
+ TAD I OPOINT
+OC10A7, DCA I OPOINT /SET WORD 3
+ ISZ OPOINT
+ DCA CHARNO /RESET CHARACTER NUMBER
+ JMP OCHARC
+
+OC10A6, ISZ OPOINT
+ TAD OCHARY
+ JMP OC10A7
+ PAGE
+\f/PDP-10 CHARACTER INPUT
+/
+/CALL:
+/ JMS ICHR10 /PDP-10 INPUT
+/ -EOF- /END OF FILE RETURN
+/ (AC) /NORMAL RETURN - CHARACTER IN AC
+
+ICHR10, 0 /PCP-10 INPUT ROUTINE
+ TAD CHARNI
+ TAD (JMP I ICHARX
+ DCA ICHARY /USE CHARACTER NUMBER TO FORM JUMP
+ CDF 10 /BUFFER IS IN FIELD 1
+ICHARY, 0 /TEMPORARY AND JUMP CELL
+
+ICHARX, ICHAR0
+ ICHAR1
+ ICHAR2
+ ICHAR3
+ ICHAR4
+
+/INPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+ICHAR0, TAD WORDS /GET NUMBER OF WORD LEFT
+ SZA CLA
+ JMP ICHARA /STILL MORE WORDS LEFT
+ TAD IBLOCK /GET NEXT BLOCK
+ SNA
+ JMP ICHARC+1 /NONE - EOF
+ DCA .+5 /SET NEXT BLOCK
+ TAD IUNIT
+ DCA UNIT10 /SET OUR UNIT
+ JMS I (READT /READ PDP-10 DECTAPE
+ IBUF10
+ 0 /OUR BLOCK IS SET
+ CDF 10 /BACK TO FIELD 1
+ TAD I [IBUF10+2
+ AND [177
+ DCA WORDS /SET NUMBER OF WORDS
+ TAD I [IBUF10+1
+ RTR
+ RTR
+ RTR
+ AND [77
+ DCA IBLOCK /SET NEXT BLOCK
+ TAD I [IBUF10
+ AND [77
+ CLL RTL
+ RTL
+ RTL
+ TAD IBLOCK
+ DCA IBLOCK /SET NEXT BLOCK
+ TAD (IBUF10+3
+ DCA IPOINT /RESET POINTER
+ JMP ICHAR0
+
+ICHARA, CLA CMA
+ TAD WORDS
+ DCA WORDS /COUNT DOWM ON NUMBER OF WORDS
+ TAD MODE /IMAGE MODE?
+ SNA
+ JMP ICHARB /NO
+ SMA CLA
+ JMP IC10A1
+ ISZ IPOINT /YES
+ ISZ IPOINT
+ TAD I IPOINT /GET WORD 3
+ ISZ IPOINT
+ AND [377 /USE 8 BITS
+ICHARC, ISZ ICHR10 /2ND EXIT
+ CDF /BACK TO FIELD 0
+ JMP I ICHR10 /EXIT
+
+ICHARB, TAD SAVELN /PRESERVE OPTION?
+ SZA CLA
+ JMP ICHARF /YES
+ CLL CLA CML RTL /NO
+ TAD IPOINT
+ DCA ICHARY /POINT TO WORD 3
+ TAD I ICHARY
+ CLL RAR
+ SNL CLA
+ JMP ICHARF /WORD O.K.
+ ISZ IPOINT
+ ISZ IPOINT /IGNORE THIS WORD
+ ISZ IPOINT
+ JMP ICHAR0
+
+ICHARF, TAD I IPOINT
+ RTR
+ RTR /GET BITS 0-6
+ RAR
+ICHARD, ISZ CHARNI /BUMP COUNTER
+ AND [177 /USE 7 BITS
+ TAD [200 /ADD BIT 8
+ JMP ICHARC
+
+/INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+ICHAR1, TAD MODE
+ SZA CLA
+ JMP IC10A1
+ TAD I IPOINT
+ AND [37
+ CLL RTL /GET BITS 7-11
+ DCA ICHARY
+ ISZ IPOINT /USE WORD 2 NOW
+ TAD I IPOINT
+ CLL RTL
+ RAL
+ AND [3 /GET BITS 0-1
+ICHARE, TAD ICHARY /ADD IN OTHER BITS
+ JMP ICHARD
+
+/INPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+ICHAR2, TAD MODE
+ SZA CLA
+ JMP IC10A3
+ TAD I IPOINT
+ RAR
+ RTR /GET BITS 2-8
+ JMP ICHARD
+
+/INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+ICHAR3, TAD I IPOINT
+ AND [7
+ CLL RTL
+ RTL /GET BITS 9-11
+ DCA ICHARY
+ ISZ IPOINT /USE WORD 3 NOW
+ TAD I IPOINT
+ RTL
+ RTL
+ RAL
+ AND [17 /GET BITS 0-3
+ JMP ICHARE
+
+/INPUT CHARACTER #4 - BITS 4-10 WORD 3
+
+ICHAR4, DCA CHARNI /RESET CHARACTER COUNT
+ TAD I IPOINT
+ ISZ IPOINT
+ RAR
+ JMP ICHARD+1
+
+IC10A3, DCA CHARNI
+ SKP
+IC10A1, ISZ CHARNI
+ TAD I IPOINT
+ ISZ IPOINT
+ JMP ICHARC
+ PAGE
+\f/CLOSE A PDP-10 FILE
+/
+/CALL:
+/ JMS CLOS10 /CLOSE A PDP-10 FILE
+/ -RETURN-
+
+CLOS10, 0 /CLOSE A PDP-10 FILE
+ TAD MODE /IMAGE MODE?
+ SPA CLA
+ JMP CLOS1A /YES - NO FILL NEEDED
+ TAD CHARNO
+ SNA CLA
+ JMP CLOS1A /CHARACTER NUMBER IS 0 - FILL DONE
+ JMS I (OCHR10 /0 FILL
+ JMP .-4 /LOOP
+
+CLOS1A, TAD OUNIT
+ DCA UNIT10 /SET OUR UNIT
+ TAD OBLOCK
+ DCA .+3 /SET THE BLOCK
+ JMS I (WRITET /WRITE PDP-10 DECTAPE
+ OBUF10
+ 0 /BLOCK IS SET
+ TAD (MOUTPU
+ JMS I (DELETE /DELETE THE OLD FILE
+ NOP /O.K. IF IT IS NOT THERE
+ TAD FREEP
+ DCA INDEX0 /POINT TO THE FREE SPOT
+ TAD [MOUTPU
+ DCA INDEX1 /POINT TO THE FILE NAME
+ CDF 10 /TO FIELD 1
+ TAD I INDEX1
+ DCA I INDEX0
+ TAD I INDEX1 /SET THE NAME
+ DCA I INDEX0
+ TAD I INDEX1
+ DCA I INDEX0
+ TAD INDEX0
+ TAD [77
+ DCA INDEX0 /POINT TO THE EXTENSION
+ TAD I INDEX1
+ DCA I INDEX0 /SET THE EXTENSION
+ TAD I INDEX1
+ DCA I INDEX0
+ TAD DATE
+ DCA I INDEX0 /SET THE DATE
+ JMS I (FIX75 /V3C SET HIGH ORDER BIT TOO
+ JMS I (WRITET /WRITE PDP-10 DECTAPE
+ DIRECT /DIRECTORY
+ 144 /BLOCK 100 BASE 10
+ JMP I CLOS10 /EXIT
+\f/OPEN A PDP-10 FILE FOR OUTPUT
+/
+/CALL:
+/ JMS OOPN10 /OPEN A PDP-10 FILE
+/ -RETURN-
+
+OOPN10, 0 /OPEN A PDP-10 FILE
+ TAD (ZFREE-1
+ JMS I (FIND /FIND A FREE SPOT
+ JMP I (NOROOM /NO ROOM LEFT
+ DCA I (SLOTNO /SET THIS SLOT
+ TAD INDEX0
+ DCA FREEP /SAVE POINTER TO FREE SPOT
+ CLA CMA
+ DCA I (NEXTDI /SET DIRECTION = -1
+ TAD (144
+ JMS I (NEXTSL /FIND FIRST OPEN SLOT
+ DCA OBLOCK /AND SET IT
+ CDF 10
+ TAD I [MOUTPU
+ DCA OUNIT /SET UNIT
+ TAD OBLOCK
+ AND [17
+ CLL RTR
+ RTR
+ RAR
+ DCA I [OBUF10+2 /SET FIRST BLOCK POINTER
+ TAD OBLOCK
+ CLL RTR
+ RTR
+ AND [77
+ DCA I [OBUF10+1 /SET FIRST BLOCK POINTER
+ DCA I [OBUF10 /ZERO LINK POINTER
+ DCA CHARNO /RESET CHARACTER NUMBER
+ TAD (OBUF10+3
+ DCA OPOINT /RESET POINTER
+ CDF
+ JMP I OOPN10 /EXIT
+\f/OPEN PDP-10 INPUT FILE
+/
+/CALL:
+/ (AC) /POINT TO FILE NAME-1
+/ JMS IOPN10 /OPEN PDP-10 INPUT FILE
+/ -NO- /NOT THERE
+/ (AC) /ANY BLOCK OF THE FILE
+
+IOPN10, 0 /OPEN PDP-10 INPUT FILE
+ JMS I (FIND /FIND THE FILE
+ JMP I IOPN10 /NOT THERE
+ DCA IOPN1B /SAVE SLOT NUMBER
+ TAD (143
+ DCA IOPN1A
+ TAD (CLA CMA
+ DCA IOPN1D
+IOPN1F, JMS I (FINDSL /FIND A SLOT
+IOPN1A, 0 /SLOT TO FIND
+ CIA
+ TAD IOPN1B /IS IT US?
+ SNA CLA
+ JMP IOPN1C /YES
+IOPN1D, CLA CMA
+ TAD IOPN1A /BUMP BLOCK NUMBER
+ SPA
+ JMP IOPN1E /TOO FAR
+ TAD [-1102
+ SMA
+ JMP I IOPN10 /TOO FAR - EXIT
+ TAD (1102
+ DCA IOPN1A /SET NEW BLOCK
+ JMP IOPN1F /RETRY
+
+IOPN1B, 0 /SLOT THAT WE WANT
+
+IOPN1E, CLA
+ TAD (CLA IAC
+ JMP IOPN1F-1 /CHANGE DIRECTION AND RETRY
+
+IOPN1C, TAD IOPN1A
+ CDF
+ ISZ IOPN10
+ JMP I IOPN10 /EXIT
+ PAGE
+\f/CONVERT OS8 DATE TO PDP-10 DATE
+
+CVDATE, 0
+ SNA
+ JMP I CVDATE /0 CONVERTS TO 0
+ DCA TEMP1
+ TAD TEMP1 /V3C
+ RTR
+ RAR
+ AND [37
+ TAD (-1 /GET DAY
+ DCA DATE4 /V3C
+ TAD TEMP1
+ AND [7 /GET OS8 YEAR (-1970)
+DECIMAL
+ TAD (1970-1964
+OCTAL
+ DCA DATE1 /SAVE YEAR
+ TAD DATE1
+ CLL RAL /*2
+ TAD DATE1 /*2+1=*3
+ CLL RTL /*3*4=*12
+ DCA DATE1 /DATE1=DATE1*12
+ TAD TEMP1
+ RTL
+ RTL
+ RAL
+ AND [17 /GET MONTH
+ TAD (-1
+ TAD DATE1 /ADD IN MONTH
+ DCA DATE1
+ TAD DATE1
+ CLL RAL /*2
+ TAD DATE1 /*2+1=*3
+ DCA TEMP2
+ TAD TEMP2
+ CLL RTL /*3*4=*12
+ TAD TEMP2 /*12+*3=*15
+ CLL RAL /*15*2=*30
+ TAD DATE1 /*30+1=*31
+ TAD DATE4 /V3C ADD IN DAY
+ DCA DATE1 /DATE1=DATE1+MONTH-1 * 31
+ RAL /V3C LINK NOW HAS HIGH ORDER DATE BIT
+ DCA HIDATE /ONLY WITHIN RANGE OF OS/8
+ TAD DATE1 /RETURN LOW ORDER 12 BITS OF DATE
+ JMP I CVDATE
+
+DATE1, 0
+DATE4, 0
+
+/TYPE A PDP-10 DATE
+\fDATE10, 0
+ SZL /LINK HAD HIGH ORDER BIT
+ TAD (4 /IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
+ DCA DATE1 /SAVE VALUE
+ RAL /V3C
+ DCA DATE75 /SAVE FACT THAT NEED 'NUTHER 11 YEARS
+ TAD (100 /V3C BASE IS (19)64
+ DCA DATE2 /WILL BE YEAR
+DATE11, TAD DATE1
+ SMA CLA
+ JMP DATE12 /MUST BE POSITIVE
+ ISZ DATE2 /BUMP YEAR
+ TAD DATE1
+ TAD (-564 /-372 DECIMAL (DAYS PER YEAR)
+ DCA DATE1
+ JMP DATE11
+
+DATE12, DCA DATE3 /WILL BE MONTH
+ TAD DATE1 /DIVIDE BY 31
+ TAD (-37
+ SPA
+ JMP .+4
+ ISZ DATE3 /BUMP MONTH
+ DCA DATE1
+ JMP .-6
+
+ CLA
+ ISZ DATE1 /+1 IS DAY
+ TAD DATE3 /DIVIDE BY 12
+ TAD (-14
+ SPA
+ JMP .+4
+ ISZ DATE2 /BUMP YEAR
+ DCA DATE3
+ JMP .-6
+
+ CLA
+ TAD DATE1
+ TAD (-12
+ SMA CLA
+ JMP DATE9
+ TAD ("0
+ JMS I OUTPUT /PRINT LEADING 0 IF NECESSARY
+DATE9, TAD DATE1
+ JMS I (PRINT /PRINT DAY
+ TAD ("-
+ JMS I OUTPUT
+ TAD DATE3
+ TAD DATE3
+ TAD DATE3 /V3C MULTIPLY BY 3
+ TAD (MONTBL /ADD IN BASE OF MONTH NAMES
+ DCA MONPTR /POINT TO PROPER MONTH NAME
+ TAD I MONPTR /GET CHAR 1
+ JMS I OUTPUT /PRINT IT
+ ISZ MONPTR /POINT TO NEXT CHAR
+ TAD I MONPTR /GET CHAR 2
+ JMS I OUTPUT /PRINT IT
+ ISZ MONPTR /V3C
+ TAD I MONPTR
+ JMS I OUTPUT
+ TAD ("-
+ JMS I OUTPUT
+ TAD DATE75 /V3C
+ SZA CLA
+ TAD (13 /ADD 11 YEARS IF H.O. BIT ON
+ TAD DATE2
+ JMS I (PRINT /PRINT YEAR
+ JMP I DATE10
+
+DATE2, 0 /YEAR
+DATE3, 0 /MONTH
+MONPTR, 0 /V3C POINTS TO MONTH NAME
+ PAGE
+\fDECIMAL
+PRINTL, -1000
+ -100
+ -10
+OCTAL
+
+PRINTZ, 0 /PRINT WITH LEADING SPACES
+ DCA PRINT0
+ TAD PRINTZ
+ DCA I (PRINT
+ TAD (240
+ JMP I (PRINT7
+
+/ZERO A DIRECTORY (PDP-10)
+
+ZERO10, 0 /ZERO THE PDP-10 DIRECTORY
+ TAD I [MOUTPU
+ AND [17
+ SZA CLA
+ JMP I (NOT10F /NOT A PDP-10
+ TAD I [MOUTPU
+ DCA UNIT10 /SET UNIT
+ TAD (DIRECT-1
+ DCA INDEX0 /POINT TO DIRECTORY
+ TAD (-600
+ DCA CNTR /COUNT OF 600
+ DCA I INDEX0 /ZERO THE DIRECTORY
+ ISZ CNTR
+ JMP .-2 /LOOP
+ TAD (7570
+ DCA I (DIRECT /SAVE BLOCKS 1 AND 2
+ TAD (170
+ DCA I (DIRECT+52 /SAVE BLOCK 144
+ TAD (777
+ DCA I (DIRECT+367 /SAVE BLOCKS 1102 ON UP
+ CLA CMA
+ DCA I (DIRECT+370
+ JMS I (WRITET /WRITE PDP-10 DECTAPE
+ DIRECT /DIRECTORY
+ 144 /DIRECTORY BLOCK
+ CDF 10
+ JMP I ZERO10 /EXIT
+\f/DELETE A PDP-10 FILE
+
+DELE10, 0 /DELETE A PDP-10 FILE
+ TAD I [MOUTPU
+ AND [17
+ SZA
+ JMP DELOS8 /DELETE A OS8 FILE
+ TAD I [MOUTPU
+ DCA UNIT10 /SET UNIT
+ TAD [MOUTPU
+ CDF
+ JMS I (DELETE /DELETE THE PDP-10 FILE
+ JMP I (ERDELF /NOT THERE
+ JMS I (WRITET /WRITE PDP-10 DECTAPE
+ DIRECT
+ 144 /DIRECTORY BLOCK
+ JMP I DELE10 /EXIT
+
+DELOS8, CIF CDF 10
+ JMS I (DELPS1 /DELETE A OS8 FILE
+ JMP I DELE10
+ JMP I (ERDELF /ERROR DELETING THE FILE
+\fPAGE
+
+/GET THE NEXT INPUT FILE
+
+NEXIFL, 0 /GET THE NEXT INPUT FILE
+ DCA CHARNI /RESET STUFF
+ DCA WORDS
+ CDF 10
+ CLA CMA
+ DCA I (INCHCT
+ DCA I (INEOF
+ TAD (INDEVH+1
+ DCA INDEVX
+ TAD I IXR /GET NEXT
+ SNA
+ JMP NEXIF2 /E.O.F
+ DCA IUNIT
+ TAD I IXR
+ DCA IBLOCK /SET START BLOCK
+ CDF
+ TAD IUNIT
+ AND [17
+ SNA
+ JMP NEXIF1 /PDP-10 FILE
+ CIF 10
+ JMS I [200
+ 1
+INDEVX, 0
+ JMP I (NOOFIL
+ CDF 10
+ TAD INDEVX
+ DCA I (INHNDL
+ TAD IBLOCK
+ DCA I (INREC
+ TAD IUNIT
+ AND [7760
+ SZA
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA I (INCTR
+ TAD (ICHRPS
+ JMP NEXIF3
+
+NEXIF1, TAD IUNIT
+ DCA UNIT10
+ TAD IBLOCK
+ DCA .+3
+ JMS I (READT
+ IBUF10
+ 0 /READ ANY BLOCK
+ CDF 10
+ TAD I [IBUF10+2
+ RTL
+ RTL
+ RAL
+ AND [17
+ DCA IBLOCK
+ TAD I [IBUF10+1
+ AND [77
+ CLL RTL
+ RTL
+ TAD IBLOCK
+ DCA IBLOCK /SET START BLOCK
+ TAD (ICHR10
+NEXIF3, DCA INPUT /SET ROUTINE POINTER
+ ISZ NEXIFL
+NEXIF2, CDF
+ JMP I NEXIFL /EXIT
+
+ICHRPS, 0
+ CIF CDF 10
+ JMS I (ICHARP
+ SKP
+ ISZ ICHRPS
+ JMP I ICHRPS
+
+OCHRPS, 0
+ CIF 10
+ JMS I (OCHARP
+ JMP I (IOERR
+ JMP I OCHRPS
+ PAGE
+\fPIP10, CDF 10 /STARTS HERE - JUMPED TO FROM 200
+ DCA HIDATE /V3C
+ TAD I (MDATE /GET TODAY'S DATE
+ CDF
+ JMS I (CVDATE /CONVERT IT
+ DCA DATE /AND STORE IT
+ TAD (3401 /UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
+ DCA I (JSBITS
+PIPCD, CDF
+ JMS I (CD /COMMAND DECODE
+ CDF 10
+ TAD I (MPARAM
+ AND (2010
+ CLL RAL
+ DCA MODE /SET /I SWITCH
+ TAD I (MPARAM+1
+ AND (400
+ DCA SAVELN /SET /P SWITCH
+ TAD I (MPARAM
+ AND (101
+ SZA CLA
+ JMP I (LIST10 /EITHER /F OR /L
+ TAD I [MOUTPU
+ SZA CLA
+ JMP PIP001 /IS AN OUTPUT FILE
+ TAD I (MINPUT
+ SNA CLA
+ JMP PIPCD /NO OUTPUT OR INPUT FILES
+ JMP I (NOOOFL /INPUT, BUT NO OUTPUT
+
+PIP001, CLL CLA CML RTR
+ AND I (MPARAM+2
+ SZA CLA
+ JMS I (ZERO10 /IT IS /Z OPTION
+ TAD (OUDEVH+1
+ DCA OUDEVX
+ TAD I [MOUTPU
+ AND [17
+ SZA
+ JMP PIPB /OUTPUT IS OS8
+ TAD I [MOUTPU
+ DCA UNIT10 /SET UNIT
+ JMS I (READT
+ DIRECT /GET DIRECTORY INTO CORE
+ 144
+PIPA, CDF 10
+ TAD OUDEVX
+ DCA I (OUHNDL
+ TAD I (MPARAM
+ AND (400
+ SZA CLA
+ JMS I (DELE10 /DELETE A PDP-10 FILE FIRST
+ CDF 10
+ TAD (MINPUT-1
+ DCA IXR
+ TAD I IXR
+ SNA CLA
+ JMP PIPCD /NO INPUT
+ TAD (MINPUT-1
+ DCA IXR /SET INPUT LIST
+ TAD I [MOUTPU
+ AND [17
+ CDF
+ SZA CLA
+ JMP PIPC /OUTPUT IS OS8
+ JMS I (OOPN10 /OPEN PDP-10 OUTPUT
+ TAD (OCHR10
+PIPD, DCA OUTPUT /SET OUTPUT ROUTINE
+PIPE, SZA CLA /IS IT ERROR OR EOF
+ JMP I (IOERR /ERROR
+ JMS I (NEXIFL /GET NEXT FILE
+ JMP PIPF /FINAL EOF
+ JMS I INPUT /GET INPUT
+ JMP PIPE /EOF OR ERROR
+ JMS I OUTPUT /OUTPUT
+ JMP .-3 /LOOP
+
+PIPC, CIF CDF 10
+ JMS I (OOPNPS /OPEN OS8 OUTPUT
+ JMP I (NOOOFL
+ TAD (OCHRPS
+ JMP PIPD
+
+PIPB, CDF 0
+ CIF 10
+ JMS I [200
+ 1 /GET OS8 OUTPUT HANDLER
+OUDEVX, 0
+ JMP I (NOOFIL
+ JMP PIPA
+
+PIPF, CDF 10
+ TAD I [MOUTPU /NOW CLOSE THE OUTPUT FILE
+ AND [17
+ CDF
+ SZA CLA
+ JMP PIPG
+ JMS I (CLOS10
+ JMP PIPCD
+
+PIPG, CIF CDF 10
+ JMS I (OCLOSE
+ JMP I (IOERR
+ JMP PIPCD
+ PAGE
+\fLIST10, TAD (OUDEVH+1
+ DCA OUDEVY
+ TAD (OUDEVH+1
+ DCA OUDEVZ
+ TAD (3100 /RESET THINGS
+ DCA LISTDV+1
+ TAD I [MOUTPU
+ SZA
+ JMP LIST11 /OUTPUT FILE EXISTS
+ CDF 0
+ CIF 10
+ JMS I [200
+ 1
+LISTDV, TEXT /TTY/ /LOOKUP THE TTY:
+OUDEVY, 0
+ JMP I (NOOOFL
+ CDF 10
+ TAD LISTDV+1
+ DCA I [MOUTPU /SET TTY: DEVICE NUMBER
+ TAD I [MOUTPU
+LIST11, AND [17
+ SNA
+ JMP I (NOTPSF /NOT A OS8 FILE
+ CDF 0
+ CIF 10
+ JMS I [200
+ 1 /LOOKUP DEVICE
+OUDEVZ, 0
+ JMP I (NOOFIL
+LIST12, CDF CIF 10
+ TAD OUDEVZ
+ DCA I (OUHNDL
+ JMS I (OOPNPS /OPEN OUTPUT FILE
+ JMP I (NOOOFL
+ TAD (OCHRPS
+ DCA OUTPUT /SET OUTPUT ROUTINE
+ CDF 10
+ TAD I (MINPUT
+ DCA UNIT10
+ CDF
+ TAD UNIT10
+ SNA
+ JMP I (PIPCD /NO INPUT
+ AND [17
+ SZA CLA
+ JMP I (NOT10F
+ JMS I (READT /READ THE DIRECTORY
+ DIRECT
+ 144
+ TAD (LISTL-1
+ DCA INDEX0
+ TAD (-40
+ DCA CNTR
+ DCA I INDEX0 /CLEAR THE COUNTS
+ ISZ CNTR
+ JMP .-2
+ TAD (-1101
+ DCA LIST13
+ CLA IAC
+ DCA LIST14
+ JMS I (FINDSL /FIND ALL SLOTS
+LIST14, 0
+ TAD (LISTL
+ DCA LIST15
+ ISZ I LIST15 /COUNT THE NUMBER IN EACH SLOT
+ ISZ LIST14
+ ISZ LIST13
+ JMP LIST14-1
+ JMS I (CRLF
+ TAD I (LISTL
+ JMS I (PRINTZ /PRINT FREE BLOCKS
+ TAD (LISTM1-1
+ DCA INDEX0
+ JMS I (ERROR4 /"FREE BLOCKS"
+ JMS I (CRLF
+ TAD (-26
+ DCA LIST13
+ TAD (DIRECT+370
+ DCA INDEX6
+ TAD (DIRECT+2 /HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
+ DCA XDATE /PDP-10 WORD AT BEGIN OF DIRECTORY
+ /THIS IS END OF EVERY 3RD PDP-8 WORD
+LIST17, CDF 10 /MAIN LOOP
+ TAD I INDEX6
+ SNA
+ JMP I (LIST16 /DO NOT PRINT THIS BLANK ENTRY
+ JMS I (LIST18
+ TAD I INDEX6
+ JMS I (LIST18
+ TAD I INDEX6
+ JMS I (LIST18
+ CDF
+ TAD (".
+ JMS I OUTPUT
+ JMP I (LIST22
+
+LIST13, 0
+LIST15, 0
+ PAGE
+\fLIST22, CDF 10
+ TAD INDEX6
+ TAD [77
+ DCA INDEX5
+ TAD I INDEX5 /GET EXTENSION
+ JMS LIST18
+ TAD I INDEX5
+ AND [7700
+ JMS LIST18
+ CLA IAC
+ AND I (MPARAM
+ SNA CLA
+ JMP LIST19 /NO EXTRA IF NOT /L
+ JMS LIST18
+ CDF
+ TAD I (LIST13
+ TAD (LISTL+27
+ DCA LIST23
+ TAD I LIST23 /GET NUMBER OF BLOCKS
+ JMS I (PRINTZ
+ JMS LIST18
+ TAD I XDATE /V3C
+ RAR /HIGH ORDER BIT OF DATE TO LINK
+ CLA
+ TAD I INDEX5
+ CDF
+ JMS I (DATE10
+LIST19, CDF
+ JMS CRLF
+LIST20, CDF
+ TAD XDATE /V3C
+ TAD (3 /POINT TO NEXT DATE H.O. BIT
+ DCA XDATE
+ ISZ I (LIST13
+ JMP I (LIST17 /LOOP
+ JMS CRLF
+ JMP I (PIPG /CLOSE THE FILE
+
+LIST16, ISZ INDEX6
+ ISZ INDEX6
+ JMP LIST20
+
+CRLF, 0
+ TAD [215
+ JMS I OUTPUT
+ TAD [212
+ JMS I OUTPUT
+ JMP I CRLF
+
+LIST23, 0
+
+LIST18, 0
+ CDF
+ DCA TEMP1
+ TAD TEMP1
+ RTR
+ RTR
+ RTR
+ JMS LIST21
+ TAD TEMP1
+ JMS LIST21
+ CDF 10
+ JMP I LIST18
+
+LIST21, 0
+ AND [77
+ TAD [240
+ JMS I OUTPUT
+ JMP I LIST21
+\f/FIND A PDP-10 ENTRY IN DIRECTORY
+/
+/CALL:
+/ (AC) /POINT TO NAME-1 (FIELD 1)
+/ JMS FIND /FIND A PDP-10 ENTRY
+/ -NO- /NOT FOUND
+/ (AC) /SLOT NUMBER IF FOUND
+
+FIND, 0 /FIND A PDP-10 FILE
+ DCA FIND4 /SAVE POINTER
+ TAD (DIRECT+370
+ DCA INDEX0 /POINT TO DIRECTORY START
+ TAD (-26
+ DCA CNTR /22 DECIMAL FILES
+ CDF 10 /DIRECTORY IS IN FIELD 1
+FIND2, TAD FIND4 /GET POINTER
+ DCA INDEX2 /POINT TO NAME,EXT
+ TAD I INDEX0
+ CIA
+ TAD I INDEX2 /CHECK WORD 1
+ SZA CLA
+ JMP FIND1 /NO
+ TAD I INDEX0
+ CIA
+ TAD I INDEX2 /CHECK WORD 2
+ SZA CLA
+ JMP FIND1+1 /NO
+ TAD I INDEX0
+ CIA
+ TAD I INDEX2 /CHECK WORD 3
+ SZA CLA
+ JMP FIND1+2 /NO
+ TAD INDEX0
+ TAD [77
+ DCA INDEX1 /POINT TO EXTENSIONS
+ TAD I INDEX1
+ CIA
+ TAD I INDEX2 /CHECK WORD 4
+ SZA CLA
+ JMP FIND1+2 /NO
+ TAD I INDEX1
+ AND [7700
+ CIA
+ TAD I INDEX2 /CHECK WORD 5
+ SZA CLA
+ JMP FIND1+2 /NO
+ CLL CLA CMA RTL
+ TAD INDEX0
+ DCA INDEX0 /POINT TO ENTRY AGAIN
+ TAD CNTR
+ TAD (27
+ ISZ FIND /WE FOUND IT - 2ND EXIT
+FIND3, CDF /BACK TO FIELD 0
+ JMP I FIND /EXIT
+
+FIND1, ISZ INDEX0 /EXTRA POINTER BUMPS
+ ISZ INDEX0
+ ISZ CNTR /MORE FILES?
+ JMP FIND2 /YES - LOOP
+ JMP FIND3 /NO - NOT FOUND
+
+FIND4, 0 /POINTER TO NAME-1
+ PAGE
+\fLINBUF=.
+LISTL, ZBLOCK 105
+
+LISTM1, TEXT / FREE BLOCKS PIP10 V/
+VERLOC, *.-1
+ 60+VERSION^100+SUBVER
+ 3700
+
+ERMES0, TEXT /_PIP10 CANNOT BE CHAINED TO_/
+ERMES1, TEXT #_I/O ERROR_#
+
+ERMES2, TEXT /_DEVICE FULL_/
+
+ERMES3, TEXT /_NO SUCH DEVICE_/
+
+ERMES4, TEXT /_NOT PDP-10 FILE_/
+
+ERMES5, TEXT /_ERROR DELETING FILE_/
+
+ERMES6, TEXT /_NOT OS8 FILE_/
+
+ERMES7, TEXT /_OUTPUT FILE OPEN ERROR_/
+
+ERMES8, TEXT /_SYNTAX ERROR_/
+ERMES9, TEXT /_FILE NOT FOUND_/
+\f/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10
+
+TDUSET, 0
+ TAD UNIT10
+ CLL RTL
+ RAL
+ AND (7
+ TAD (DVCTBL
+ DCA DVCPTR
+ RAR
+ DCA TDUNIT /SAVE EVEN/ODD BIT
+ TAD (TDUTBL
+ DCA TDUPTR
+TDULP, TAD I TDUPTR
+ SNA
+ JMP I TDUSET
+ DCA TDUT
+ TAD I TDUT
+ AND (7
+ TAD I DVCPTR
+ DCA I TDUT
+ ISZ TDUPTR
+ JMP TDULP
+TDUPTR, 0
+TDUT, 0
+DVCPTR, 0
+DVCTBL, 6770;6760;6750;6740
+
+TDUTBL, DIO01
+ DIO02
+ DIO03
+ DIO04
+ DIO05
+ DIO06
+ DIO07
+ DIO08
+ DIO09
+ DIO10
+ DIO11
+ DIO12
+ DIO13
+ DIO14
+ DIO15
+ DIO16
+ DIO17
+ DIO18
+ DIO19
+ DIO20
+ DIO21
+ DIO22
+ IOTX1
+ IOTX2
+ IOTX3
+ IOTX4
+ IOTX5
+ IOTX6
+ IOTX7
+ IOTX8
+ 0
+ PAGE
+\f/GET A CHARACTER
+
+GCH, 0
+ TAD I IXR /GET A CHAR
+ TAD (-240
+ SNA
+ JMP GCH+1 /IGNORE SPACES
+ TAD (240-"/
+ SNA
+ JMP SLASH
+ TAD ("/-"(
+ SNA
+ JMP OPENP
+ TAD ("(
+ JMP I GCH /EXIT
+
+SLASH, TAD I IXR
+ JMS SLSHCH /GET OPTION
+ JMP GCH+1
+
+OPENP, TAD I IXR
+ TAD (-")
+ SNA
+ JMP GCH+1 /END
+ TAD (")
+ JMS SLSHCH /GET OPTION
+ JMP OPENP
+
+SLSHCH, 0
+ SNA
+ JMP I (SYNTAX /ERROR
+ DCA TEMP6
+ TAD (MPARAM-1
+ DCA TEMP5 /POINT TO PARAMETERS
+ JMS DECODE
+ JMP I (SYNTAX
+ SZL
+ TAD (32 /ADD
+ TAD (-14
+ ISZ TEMP5
+ SMA
+ JMP .-3 /FIND DIVIDED BY 12
+ DCA TEMP4
+ CLL CML
+ RAL
+ ISZ TEMP4
+ JMP .-2 /SHIFT A BIT
+ DCA TEMP4 /SAVE IT
+ CDF 10
+ TAD TEMP4
+ CMA
+ AND I TEMP5
+ TAD TEMP4 /OR IN THAT BIT
+ DCA I TEMP5
+ CDF
+ JMP I SLSHCH
+
+DECODE, 0
+ TAD TEMP6
+ TAD (-"9-1
+ CLL
+ TAD ("9+1-"0
+ SZL
+ JMP DECOD1
+ TAD ("0-"Z-1
+ CLL CML
+ TAD ("Z-"A+1
+ SNL
+DECOD1, ISZ DECODE
+ JMP I DECODE
+
+EXA40, 0
+ TAD (CDNAME
+ DCA TEMP5
+ TAD (-5
+ DCA TEMP4
+EXA401, CLL CLA CML RAR
+ TAD I TEMP5
+ AND [7700
+ CLL RAL
+ SZA
+ RAR
+ DCA TEMP3
+ TAD I TEMP5
+ TAD (40
+ AND [77
+ TAD (-40
+ SZA
+ TAD (40
+ TAD TEMP3
+ DCA I TEMP5
+ ISZ TEMP5
+ ISZ TEMP4
+ JMP EXA401
+ JMP I EXA40
+ PAGE
+\f/GET A NAME ROUTINE
+
+GNAME, 0
+ DCA CDDEV /CLEAR AREA
+ DCA CDDEV+1
+ CLA CMA
+ DCA DEVSW /ALLOW DEVICES
+GNAME1, DCA CDNAME /CLEAR NAME,EXTENSION
+ DCA CDNAME+1
+ DCA CDNAME+2
+ DCA CDEXT
+ DCA CDEXT+1
+ CLA CMA
+ DCA PERSW /ALLOW EXTENSIONS
+ TAD (CDNAME
+ DCA POINT /SET POINTER
+ DCA CNTR /SET SWITCH
+GNAME2, JMS I (GCH /GET A CHAR
+ DCA TEMP6
+ TAD TEMP6
+ SNA
+ JMP GNAME6 /END
+ TAD (-":
+ SNA
+ JMP GNAME5 /: IS DEVICE
+ TAD (":-".
+ SNA
+ JMP GNAME4 /. IS EXTENSION
+ TAD (".
+ DCA TEMP6 /SAVE THE CHAR
+ JMS I (DECODE
+ JMP GNAME6-1 /NOT 0-9 OR A-Z IS END
+ CLA
+ TAD TEMP6
+ AND [77 /GET TRIMMED ASCII
+ ISZ CNTR
+ JMP GNAME3 /LEFT HALF
+ TAD I POINT
+ DCA I POINT /SET RIGHT HALF
+ ISZ POINT
+ JMP GNAME2 /LOOP
+
+GNAME3, CLL RTL
+ RTL
+ RTL
+ DCA I POINT /SET LEFT HALF
+ CLA CMA
+ DCA CNTR
+ TAD POINT
+ TAD (-CDEXT-2
+ SZA CLA
+ JMP GNAME2 /LOOP
+ JMP GNAME2-1 /LOOP - IGNORE
+
+GNAME4, TAD CDNAME
+ SZA CLA
+ ISZ PERSW
+ JMP I (SYNTAX /ERROR
+ DCA CDEXT
+ DCA CDEXT+1 /CLEAR EXTENSION
+ TAD (CDEXT
+ JMP GNAME2-2 /GET EXTENSION
+
+GNAME5, ISZ DEVSW
+ JMP I (SYNTAX /ERROR
+ ISZ PERSW
+ JMP I (SYNTAX /ERROR
+ TAD CDNAME
+ SNA
+ JMP I (SYNTAX /ERROR
+ DCA CDDEV
+ TAD CDNAME+1
+ DCA CDDEV+1 /SET DEVICE
+ JMP GNAME1 /NOW GET THE NAME
+
+ CLA
+GNAME6, DCA CDEXT+2
+ TAD CDEXT+1
+ AND [7700
+ DCA CDEXT+1
+ ISZ PERSW
+ JMP I GNAME /EXIT
+ DCA CDEXT
+ DCA CDEXT+1 /CLEAR EXTENSION
+ JMP I GNAME /EXIT
+ PAGE
+\fCD, 0
+ TAD [MOUTPU-1
+ DCA INDEX0
+ TAD (-47
+ DCA CNTR
+ CDF 10
+ DCA I INDEX0 /CLEAR AREAS
+ ISZ CNTR
+ JMP .-2
+ CDF
+ CIF 10
+ JMS I [200
+ 13 /RESET TABLES
+ 0
+ DCA INSEG /NO DIRECTORY IN CORE
+ DCA PDP10D /NO KNOWN PDP-10 DRIVES
+ DCA PDP10D+1
+ DCA PDP10D+2
+ DCA PDP10D+3
+ DCA PDP10D+4
+ DCA PDP10D+5
+ DCA PDP10D+6
+ DCA PDP10D+7
+ DCA CDCNT /ZERO INPUT COUNT
+ JMS I (GLINE /GET A LINE
+ TAD [LINBUF-1
+ DCA IXR
+ TAD I IXR
+ SNA
+ JMP NOBAKB /NO "<" IS LINE
+ TAD (-"<
+ SZA CLA
+ JMP .-5
+ TAD [LINBUF-1
+ DCA IXR
+ TAD XDSK
+ DCA CDDEVF /SET "DSK" AS DEFAULT
+ TAD XDSK+1
+ DCA CDDEVF+1
+ JMS I (GNAME /GET THE NAME
+ TAD TEMP6
+ TAD (-"[
+ SZA CLA
+ JMP CDX03 /NO SIZE SPECIFIED
+CDX01, JMS I (GCH
+ TAD (-"]
+ SNA
+ JMP CDX02 /END OF SIZE
+ TAD ("]-"0
+ SPA
+ JMP I (SYNTAX /ERROR
+ DCA TEMP1
+ TAD CDEXT+2
+ CLL RTL
+ TAD CDEXT+2
+ RAL
+ TAD TEMP1
+ DCA CDEXT+2 /ADD IN NUMBER
+ TAD TEMP1
+ TAD (-11
+ SMA SZA CLA
+ JMP I (SYNTAX /ERROR
+ JMP CDX01
+
+CDX02, JMS I (GCH
+ SKP
+CDX03, TAD TEMP6
+ TAD (-"<
+ SZA CLA
+ JMP I (SYNTAX /ERROR
+ JMS I (CDOUTX /SET OUTPUT STUFF
+NOBAKA, TAD (MINPUT-1
+ DCA INDEX6
+ TAD XDSK
+ DCA CDDEVF /SET DEFAULT
+ TAD XDSK+1
+ DCA CDDEVF+1
+ TAD IXR
+ DCA CDI04 /SAVE POINTER
+ JMS I (GCH
+ SNA CLA
+ JMP I CD /NO INPUT FILES
+ TAD CDI04
+ DCA IXR /RESET POINTER
+CDI01, JMS I (GNAME /GET A FILE
+ ISZ DEVSW
+ JMP CDI02 /DEVICE SPECIFIED
+ TAD CDDEVF
+ DCA CDDEV
+ TAD CDDEVF+1
+ DCA CDDEV+1 /SET DEFAULT DEVICE
+CDI02, TAD CDDEV
+ DCA CDDEVF
+ TAD CDDEV+1
+ DCA CDDEVF+1 /SET NEW DEFAULT
+ ISZ CDCNT /COUNT INPUT FILES
+ TAD CDCNT
+ TAD (-12
+ SMA CLA
+ JMP I (SYNTAX /TOO MANY FILES
+ JMS I (CDINX /SET INPUT STUFF
+ TAD TEMP6
+ SNA
+ JMP I CD /MAIN EXIT
+ TAD (-",
+ SNA CLA
+ JMP CDI01
+ JMP I (SYNTAX /ERROR
+
+NOBAKB, TAD [LINBUF-1
+ DCA IXR
+ JMP NOBAKA
+ PAGE
+\fCDOUTX, 0 /SET OUTPUT STUFF
+ ISZ DEVSW
+ JMP CDOUT9 /DEVICE SPECIFIED
+ TAD CDNAME
+ SNA CLA
+ JMP I CDOUTX /NO NAME AND NO DEVICE IS NOTHING
+ TAD CDDEVF
+ DCA CDDEV
+ TAD CDDEVF+1
+ DCA CDDEV+1 /SET DEFAULT DEVICE
+CDOUT9, TAD (OUDEVH+1
+ DCA CDOUT2 /SET OUTPUT HANDLER ADDRESS
+ TAD [MOUTPU-1
+ DCA INDEX6
+ TAD CDDEV
+ DCA CDOUT1
+ TAD CDDEV+1
+ DCA CDOUT1+1 /SET DEVICE
+ CIF 10
+ JMS I [200
+ 12 /FIND HANDLER
+CDOUT1, 0
+ 0
+CDOUT2, 0
+ JMP I (NOOFIL
+ TAD CDOUT1+1
+ JMS I (GTDVTP /GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
+ SZA CLA
+ JMP CDOUT3 /NOT DECTAPE
+ TAD (OUDEVH+1
+ DCA CDOUT5
+ TAD CDOUT1+1
+ CIF 10
+ JMS I [200
+ 1 /GET HANDLER
+CDOUT5, 0
+ JMP I (NOOFIL
+ TAD CDOUT5
+ JMS SETUNT /SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
+ JMS I (ROCK /CHECK THE TAPE
+ JMP CDOUT3 /NOT PDP-10 DECTAPE
+ JMS I (EXA40 /EXCESS 40 CONVERSION
+ TAD UNIT10
+ JMP CDOUT4 /SET PARAMETERS
+
+CDOUT3, DCA CDEXT+1
+ TAD CDEXT+2 /GET LENGTH
+ TAD (-400
+ SPA CLA
+ TAD CDEXT+2 /O.K. - USE LENGTH
+ CLL RTL
+ RTL
+ AND [7760 /8 BIT LENGTH
+ TAD CDOUT1+1 /ADD IN DEVICE NUMBER
+CDOUT4, CDF 10
+ DCA I INDEX6 /SET DEVICE
+ TAD CDNAME
+ DCA I INDEX6 /SET NAME
+ TAD CDNAME+1
+ DCA I INDEX6
+ TAD CDNAME+2
+ DCA I INDEX6
+ TAD CDEXT
+ DCA I INDEX6
+ TAD CDEXT+1
+ DCA I INDEX6
+ CDF
+ JMP I CDOUTX /EXIT
+
+SETUNT, 0
+ STL
+ TAD (-7607
+ SZA /IF IT IS 7607,
+ TAD (7 /ITS UNIT 0
+ AND (7
+ CLL CML RTR
+ RTR
+ DCA UNIT10
+ TAD DVTYPE
+ AND (10
+ SNA CLA
+ JMP I SETUNT /TC08 - FINISHED
+ CLL
+ TAD UNIT10
+ AND (7000 /TD8E ENTRY POINTS ARE STRANGE -
+ TAD UNIT10 /MUST ROTATE UNIT NUMBER LEFT 1
+ SZL
+ TAD (1000
+ DCA UNIT10
+ JMS I (TDUSET /SET UP TD8E OPCODES
+ JMP I SETUNT
+ PAGE
+\fCDINX, 0 /SET INPUT STUFF
+ TAD (OUDEVH+1
+ DCA CDIN1
+ TAD CDDEV
+ DCA CDIN2 /SET DEVICE
+ TAD CDDEV+1
+ DCA CDIN2+1
+ CIF 10
+ JMS I [200
+ 1 /GET HANDLER
+CDIN2, 0
+ 0
+CDIN1, 0
+ JMP I (NOOFIL
+ TAD CDIN2+1
+ JMS GTDVTP /COMPARE DCB ENTRY WITH TC08 OR TD8E
+ SZA CLA
+ JMP CDIN3 /NOT DECTAPE
+ TAD CDIN1
+ JMS I (SETUNT /SET UP UNIT NUMBER
+ JMS I (ROCK /CHECK THE TAPE
+ JMP CDIN3 /NOT PDP-10 DECTAPE
+ JMS I (EXA40 /DO EXCESS 40
+ TAD INSEG
+ CIA
+ TAD UNIT10 /IS DIRECTORY IN CORE?
+ SNA CLA
+ JMP CDIN8 /YES - NO READ
+ TAD CDNAME
+ SNA CLA
+ JMP CDIN7 /NO NAME - NO READ
+ JMS I (READT
+ DIRECT /READ DIRECTORY
+ 144
+ TAD UNIT10
+ DCA INSEG /SET DIRECTORY IN CORE
+CDIN8, TAD (-5
+ DCA CNTR
+ TAD (CDNAME-1
+ DCA INDEX0
+ TAD (CDINXX-1
+ DCA INDEX1
+ TAD I INDEX0
+ CDF 10
+ DCA I INDEX1
+ CDF
+ ISZ CNTR
+ JMP .-5
+ TAD (CDINXX-1
+ JMS I (IOPN10 /OPEN THE PDP-10 FILE
+ JMP I (FNOTFD
+CDIN7, DCA CDIN4
+ TAD UNIT10
+ JMP CDIN6
+
+CDIN3, TAD (CDNAME
+ DCA CDIN4
+ TAD CDNAME
+ SNA CLA
+ JMP CDIN9 /NO LOOKUP IF NO NAME
+ TAD CDIN2+1
+ CIF 10
+ JMS I [200
+ 2
+CDIN4, CDNAME /LOOKUP
+CDIN5, 0
+ JMP I (FNOTFD
+ TAD CDIN5
+ TAD (400
+ SPA
+ CLA
+ CLL RTL
+ RTL
+ AND [7760 /GET LENGTH
+ TAD CDIN2+1 /ADD DEVICE
+CDIN6, CDF 10
+ DCA I INDEX6
+ TAD CDIN4
+ DCA I INDEX6 /SET BLOCK STARTING
+ CDF
+ JMP I CDINX
+
+CDIN9, DCA CDIN4
+ JMP CDIN6-1
+
+GTDVTP, 0
+ TAD (DCB-1
+ DCA TEMP1
+ CDF 10
+ TAD I TEMP1 /GET DCB ENTRY
+ CDF
+ DCA DVTYPE
+ TAD DVTYPE
+ AND (770
+ TAD (-210
+ SZA
+ TAD (30
+ JMP I GTDVTP
+ PAGE
+\fROCK, 0
+ JMS GET10D /GET ENTRY IN TAPE TYPE TABLE
+ SNA
+ JMP ROCK4 /UNKNOWN - ROCK IT
+ SMA CLA
+ ISZ ROCK
+ JMP I ROCK /EXIT
+
+GET10D, 0
+ TAD UNIT10
+ CLL RTL
+ RTL
+ TAD (PDP10D
+ DCA TEMP5 /POINT TO KNOWN TABLE
+ TAD I TEMP5
+ JMP I GET10D
+
+ROCK4, CLA CMA
+ DCA I TEMP5
+ TAD DVTYPE
+ AND (10
+ SZA CLA /WHAT KIND OF TAPE?
+ JMP TDCHK /TD8E
+ TAD (OBUF10-1
+ DCA I (7755
+ TAD (10
+ DTLB
+ROCK1, RTL
+ RAL
+ SZL CLA
+ TAD (-400
+ TAD UNIT10
+ TAD (210
+ DTCA DTXA
+ROCK2, JMS DTWAIT
+
+ROCK3, SPA
+ JMP ROCK1
+ CLA
+ TAD (OBUF10-1
+ DCA I (7755
+ TAD (-600
+ DCA I (7754
+ TAD (30
+ DTXA
+ DTSF DTRB
+ JMP .-1
+ SPA CLA
+ JMP ROCK4 /RETRY
+ TAD [200
+ DTXA /STOP DRIVE
+ TAD I (7754
+ SZA CLA
+ JMP I ROCK /OS8 UNIT
+ CLA IAC
+SET10, DCA I TEMP5
+ ISZ ROCK
+ JMP I ROCK /PDP-10 UNIT
+
+DTWAIT, 0 /WAIT FOR DECTAPE FLAG
+ DTSF DTRB
+ SKP CLA
+ JMP I DTWAIT
+ KSF
+ JMP DTWAIT+1
+ TAD [200
+ KRS
+ TAD (-203
+ SZA CLA
+ JMP DTWAIT+1
+ TAD [200
+ DTXA /STOP THE TAPE
+ JMP I [7600
+
+TDCHK, CLA STL RTR
+ TAD TDUNIT
+IOTX1, SDLC
+ CLA
+IOTX2, SDRC
+ AND (100 /CHECK FOR TAPE NOT READY
+ SZA CLA
+ JMP TDCHK /WAIT FOR TAPE TO COME UP
+ TAD TDUNIT
+ TAD (1000
+IOTX3, SDLC
+ JMS SKIP4
+ JMS SKIP4
+IOTX4, SDSS
+ JMP .-1
+IOTX5, SDRC
+ AND [77
+ TAD (-26
+ SZA CLA /WAIT FOR GUARD
+ JMP IOTX4
+ DCA TDT
+TDCLP, JMS SKIP4
+ ISZ TDT
+ AND [77
+ TAD (-51 /SEARCH FOR SOME CRAP NEAR END OF RECORD
+ SZA CLA
+ JMP TDCLP
+ TAD I (UNIT
+IOTX6, SDLC /STOP TAPE
+ CLA
+ TAD TDT
+ TAD (-611 /9 WORDS FOR GOOD LUCK
+ SZA CLA
+ JMP I ROCK
+ STL RTL /SET TABLE ENTRY TO 2 FOR TD8E TAPE
+ JMP SET10
+
+SKIP4, 0
+IOTX7, SDSQ
+ JMP .-1
+IOTX8, SDRC
+ JMP I SKIP4
+TDT, 0
+ PAGE
+ FIELD 0 /DUMP PG 0 LITERALS HERE
+\f/TD8E DECTAPE ROUTINE
+/VERSION 01
+
+/JULY 2 1971 GB/RL/EF
+
+/COPYRIGHT 1971 DIGITAL EQUIPMENT CORP.
+/ MAYNARD, MASS.
+
+/ABSTRACT--
+/ THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+ DRIVE=10 /UNITS 0 AND 1 SELECTED
+ ORIGIN=6200 /ENTRIES AT 6200 AND 6204
+ AFIELD=0 /INITIAL FIELD SETTING
+ MFIELD=00 /AFIELD*10=MFIELD
+ WDSBLK=600 /384 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/ DRIVE=10 IMPLIES UNITS 0 &1
+/ DRIVE=20 IMPLIES UNITS 2&3
+/ DRIVE=30 IMPLIES UNITS 4&5
+/ DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/ MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/ LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/ THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/ THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE
+/ IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/ 128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/ BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/ FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/ FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/ DRIVE=20
+/ ORIGIN=3000
+/ AFIELD=2
+/ MFIELD=20
+/ WDSBLK=400
+\f
+/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/ CDF CURRENT
+/ CIF MFIELD /MFIELD=FIELD ASSEMBLED IN
+/ JMS ENTRY /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+ /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/ ARG1
+/ ARG2
+/ ARG3
+/ ERROR RETURN
+/ NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD BIT0: 0=READ, 1=WRITE
+/ BITS 1-5: # BLOCKS IN OPERATION
+/ BITS 6-8: FIELD OF BUFFER AREA
+/ BIT 9: UNUSED
+/ BIT 10: # OF WORDS/BLOCK.
+/ 0= WDSBLK, 1=WDSBLK-1
+/ BIT 11: 1=START FORWARD, 0=REVERSE
+
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/ TOO GREAT A BLOCK NUMBER
+/ FATAL ERRORS TAKE ERROR RETURN WITH THE
+/ AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/ IF NO PROPER UNIT IS SELECTED, THE ERROR
+/ RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+\f
+/THE TD8E IOT'S ARE:
+ SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+ SDST=7002-DRIVE /SKIP ON TIMING ERROR
+ SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+ SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+ SDLD=7005-DRIVE /LOAD DATA REGISTER
+ SDRC=7006-DRIVE /READ COMMAND REGISTER
+ SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+
+ BLOCK=DTA1
+
+ FIELD AFIELD
+ *ORIGIN
+DTA0, 0 /ENTRY POINT FROM UNIT 0
+ CLA CLL /0 TO LINK
+ JMP DTA1X
+C1000, 1000
+DTA1, 0 /UNIT 2 ENTRY
+ CLA CLL CML /1 TO LINK
+ TAD DTA1
+ DCA DTA0 /PICK UP ARGS AT DTA0
+DTA1X, RAR
+ DCA UNIT /LINK TO UNIT POSITION
+ RDF
+ TAD C6203 /GET DATA FIELD AND SETUP RETURN
+ DCA LEAVE
+ TAD I DTA0 /GET FUNCTION WORD
+DIO01, SDLD /PUT FUNCTION INTO DATA REGISTER
+ CLL RTR /AC STILL HAS FUNCTION. PUT # WORDS PER
+ /BLOCK INTO LINK
+ SZL CLA /KNOCK ONE OFF WDSBLK?
+ IAC /YES
+ TAD MWORDS
+ DCA WCOUNT /STORE MASTER WORD COUNT
+ ISZ DTA0 /TO BUFFER
+ TAD I DTA0
+ DCA BUFF
+ ISZ DTA0 /TO BLOCK NUMBER
+ TAD I DTA0
+ DCA BLOCK
+ ISZ DTA0 /POINT TO ERROR EXIT
+ CIF CDF MFIELD /TO ROUTINES DATA FIELD
+DIO02, SDRD /GET FUNCTION INTO AC
+ CLL RAL
+ AND CM200 /GET # PAGES TO XFER
+ DCA PGCT
+DIO03, SDRD
+C374, AND C70 /GET FIELD FOR XFER
+ TAD C6203 /FORM CDF N
+ DCA XFIELD /IF=0 AND DF=N AT XFER.
+ CLA CLL CMA RTL
+ DCA TRYCNT /3 ERROR TRIES
+ TAD UNIT /TEST FOR SELECT ERROR
+DIO04, SDLC
+DIO05, SDRC
+ AND C100
+ SZA CLA
+ JMP FATAL-1
+\f
+DIO06, SDRD /PUT FUNCT INTO XFUNCT IN SECOND PG.
+ DCA I CXFUN
+ TAD WCOUNT
+ DCA I CXWCT
+DIO07, SDRD /GET MOTION BIT TO LINK
+ CLL RAR
+ JMP GO /AND START THE MOTION.
+DIO08,
+RWCOM, SDST /ANY CHECKSUM ERRORS?
+ SZA CLA /OR CHECKSUM ERRORS?
+ JMP TRY3 /PLEASE NOTE THAT THE LINK IS ALWAYS
+ /SET AT RWCOM. GETCHK SETS IT.
+ TAD PGCT /NO ERROR..FINISHED XFER?
+ TAD CM200
+ SNA
+ JMP EXIT /ALL DONE. GET OUT
+ DCA PGCT /NEW PAGE COUNT
+ ISZ BLOCK /NEXT BLOCK TO XFER
+ TAD WCOUNT /FORM NEXT BUFFER ADDRESS
+ CIA
+ TAD BUFF
+ DCA BUFF
+ CLL CML /FORCES MOTION FORWARD
+GO, CLA CML RTR /LINK BECOMES MOTION BIT
+ TAD C1000
+ TAD UNIT /PUT IN 'GO' AND UNIT #
+DIO09, SDLC /LOOK FOR BLOCK NO.
+
+ JMS I CRDQUD /WAIT AT LEAST 6 LINES TO LOOK
+ JMS I CRDQUD
+CM200, 7600 /COULD HAVE SAVED A LOC. HERE
+DIO10,
+SRCH, SDSS
+ JMP .-1 /WAIT FOR SINGLE LINE FLAG
+DIO11, SDRC
+ CLL RTL /DIRECTION TO LINK. INFO BITS
+ /ARE SHIFTED.
+ AND C374 /ISOLATE MARK TRACK BITS
+ TAD M110 /IS IT END ZONE?
+ SNA /THE LINK STAYS SAME THRU THIS
+ JMP ENDZ
+ TAD M20 /CHECK FOR BLOCK MARK
+ SZA CLA
+ JMP SRCH
+DIO12, SDRD /GET THE BLOCK NUMBER
+ SZL /IF WE ARE IN REVERSE, LOOK FOR 3
+ /BLOCKS BEFORE TARGET BLOCK. THIS
+ /ALLOWS TURNAROUND AND UP TO SPEED.
+ TAD C3 /REVERSE
+ CMA
+ TAD BLOCK
+ CMA /IS IT RIGHT BLOCK?
+ SNA
+ JMP FOUND /YES..HOORAY!
+M110, SZL SNA CLA /NO, BUT ARE WE HEADED FOR IT?
+ /ABOVE SNA IS SUPERFLUOUS.
+ JMP SRCH /YES
+DIO13,
+ENDZ, SDRC /WE ARE IN THE END ZONE
+ CLL RTL /DIRECTION TO LINK
+/V3C SZL CLA /ARE WE IN REVERSE?
+ JMP GO /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3, CLA CLL /V3C
+ ISZ TRYCNT
+ JMP GO /TRY 3 TIMES
+ JMP FATAL /LINK OFF MEANS AC=4000 ON RETURN
+EXIT, ISZ DTA0
+ CLL CML /AC=0 ON NORMAL RETURN
+FATAL, TAD UNIT
+DIO14, SDLC /STOP THE UNIT
+ CLA CML RAR
+LEAVE, HLT
+ JMP I DTA0
+
+\f
+C6203, 6203
+CRDQUD, RDQUAD
+WCOUNT, 0
+BUFF, 0
+MWORDS, -WDSBLK
+UNIT, 0
+CXFUN, XFUNCT
+M20, -20
+PGCT, 0
+CXWCT, XWCT
+C100, 100
+TRYCNT, -3
+
+
+ *ORIGIN+170
+FOUND, SZL CLA /RIGHT BLOCK. HOW ABOUT DIRECTION?
+ JMP GO /WRONG..TURN AROUND
+ TAD UNIT /PUT UNIT INTO LINK
+ CLL RAL /AC IS NOW 0
+C70, 70 /********DON'T MOVE THIS!!!!******
+C3, 3
+ TAD BUFF /GET BUFFER ADDRESS
+XFIELD, HLT /INTO NEXT PAGE
+
+ *ORIGIN+200
+
+ CIF MFIELD
+ DCA XBUFF /SAVE ADDRESS
+ RAR /NOW GET UNIT #
+ DCA XUNIT
+ SDRC /V3C
+ SDLC /V3C
+ TAD XWCT
+ DCA DWORDS /WORD COUNTER
+DIO15,
+REVGRD, SDSS
+ JMP .-1 /LOOK FOR REVERSE GUARD
+DIO16, SDRC
+ AND K77
+ TAD CM32 /IS IT REVERSE GUARD?
+ SZA CLA
+ JMP REVGRD /NO.KEEP LOOKING
+ TAD XFUNCT /GET FUNCTION READ OR WRITE
+K7700, SMA CLA
+ JMP READ /NEG. IS WRITE
+DIO17,
+WRITE, SDRC
+ AND C300 /CHECK FOR WRITE LOCK AND SELECT ERROR
+ CLL CML /LOCK OUT AND SELECT ARE AC 0 ERRORS
+ SZA CLA
+ JMP I CFATAL /FATAL ERROR. LINK MUST BE ON
+/ JMS RDQUAD /NO ONE EVER USES THIS WORD!
+/ CLA
+ STA /V3C HACK FOR PDP-6
+ JMS WRQUAD /V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
+ TAD C1400
+ TAD XUNIT /INITIATE WRITE MODE
+DIO18, SDLC
+ CLA CMA
+ JMS WRQUAD /PUT 77 IN REVERSE CHECKSUM
+ CLA CMA
+ DCA CHKSUM
+WRLP, TAD I XBUFF /GLORY BE! THE ACTUAL WRITE!
+ JMS WRQUAD
+ ISZ XBUFF /BUMP CORE POINTER
+K77, 77 /ABOVE MAY SKIP
+ ISZ DWORDS /DONE THIS BLOCK?
+ JMP WRLP /NOT YET..LOOP A WHILE
+ TAD XFUNCT /IS THE OPERATION FOR WDSBLK PER BLOCK?
+ CLL RTR /IF NO, WRITE A 0 WORD
+ SZL CLA
+
+ JMS WRQUAD /WRITE A WORD OF 0
+ JMS GETCHK /DO THE CHECK SUM
+ JMS WRQUAD /WRITE FORWARD CHECKSUM
+ JMS WRQUAD /ALLOW CHECKSUM TO BE WRITTEN
+ JMS WRQUAD /V3C WRITE REST OF CHECKSUM [PDP-6]
+ JMP I CRWCOM
+
+
+READ, JMS RDQUAD
+ JMS RDQUAD
+ JMS RDQUAD /SKIP CONTROL WORDS
+ AND K77
+ TAD K7700 /TACK 7700 ONTO CHECKSUM.
+ DCA CHKSUM /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP, JMS RDQUAD
+ JMS EQUFUN /COMPUT CHECKSUM AS WE GO
+ DCA I XBUFF /IT GETS CONDENSED LATER
+ ISZ XBUFF
+C300, 300 /PROTECTION
+ ISZ DWORDS /DONE THIS OP?
+ JMP RDLP /NO SUCH LUCK
+ TAD XFUNCT /IF OP WAS FOR WDSBLK-1, READ AND
+ CLL RTR /CHECKSUM THE LAST TAPE WORD
+ SNL CLA
+ JMP RDLP2
+ JMS RDQUAD /NOT NEEDED FOR WDSBLK/BLOCK
+ JMS EQUFUN /CHECKSUM IT
+RDLP2, JMS RDQUAD /READ CHECKSUM
+ AND K7700
+ JMS EQUFUN
+ JMS GETCHK /GET SIX BIT CHECKSUM
+ JMP I CRWCOM
+
+WRQUAD, 0 /WRITE OUT A 12 BIT WORD
+ JMS EQUFUN /ADD THIS TO CHECKSUM
+DIO19, SDSQ /SKIP ON QUADLINE FLAG
+ JMP .-1
+DIO20, SDLD /LOAD DATA ONTO BUS
+ CLA /SDLD DOESN'T CLEAR AC
+ JMP I WRQUAD
+
+RDQUAD, 0 /READ A 12 BIT WORD
+DIO21, SDSQ
+ JMP .-1
+DIO22, SDRD /READ DATA
+ JMP I RDQUAD
+
+\f
+EQUFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM
+ CMA
+ DCA EQUTMP /ACTUALLY CHECKSUMS ON DECTAPE ARE
+ TAD EQUTMP /EQUIVALENCE OF ALL WORDS IN A RECORD
+ AND CHKSUM /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+ CIA /IS ASSOCIATIVE, WE CAN DO IT 12
+ CLL RAL /BITS AT A TIME AND CONDENSE LATER.
+ TAD EQUTMP /THIS ROUTINE USES THESE IDENTITIES:
+ TAD CHKSUM /A+B=(A.XOR.B)+2*(A.AND.B)
+ DCA CHKSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+ TAD EQUTMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+ CMA
+ JMP I EQUFUN
+
+GETCHK, 0 /FORM 6 BIT CHECKSUM
+ CLA
+ TAD CHKSUM
+ CMA
+ CLL RTL
+ RTL
+ RTL
+ JMS EQUFUN
+ CLA CLL CML /FORCES LINK ON AT RWCOM
+ TAD CHKSUM
+ AND K7700
+ JMP I GETCHK
+
+CFATAL, FATAL
+CRWCOM, RWCOM
+XFUNCT, 0
+CM32, -32
+C1400, 1400
+CHKSUM, 0
+DWORDS, 0
+XBUFF, 0
+XWCT, 0
+EQUTMP, 0
+XUNIT, 0
+ PAGE
+\fFIELD 1
+
+*2000
+
+ZFREE, ZBLOCK 5
+
+INCTR, 0
+INHNDL, 0
+INPTR, 0
+
+DELPS1, 0
+ JMS I (200
+ 4
+ MOUTPU+1
+ 0
+ ISZ DELPS1
+ CIF CDF 0
+ JMP I DELPS1
+
+ICHARP, 0
+ ISZ INJMP
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SZA CLA
+ JMP INEXIT
+INGBUF, TAD INCTR
+ CLL
+ TAD (INRECS
+ SNL
+ DCA INCTR
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR
+ RTR
+ RTR
+ TAD (INCTL+1
+ DCA INCTLW
+ CIF 0
+ JMS I INHNDL
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMP INERRX
+INBREC, TAD INREC
+ TAD (INRECS
+ DCA INREC
+ TAD INCTLW
+ AND (7600
+ CLL RAL
+ TAD INCTLW
+ AND (7600
+ CMA
+ DCA INCHCT
+ TAD INJMPP
+ DCA INJMP
+ TAD INBUFP
+ DCA INPTR
+ JMP ICHARP+1
+
+INERRX, ISZ INEOF
+ SMA CLA
+ JMP INBREC
+INERR, CLL CLA CML RAR
+ JMP INEXIT
+
+INJMP, HLT
+ JMP INCHR1
+ JMP INCHR2
+INCHR3, TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND (7400
+ CLL RTR
+ RTR
+ TAD INCTLW
+ RTR
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+
+INCHR2, CDF 0
+ TAD I (MODE
+ CDF 10
+ SMA SZA CLA
+ JMP IC8A1
+ TAD I INPTR
+ AND (7400
+ DCA INCTLW
+ ISZ INPTR
+IC8A2, TAD I INPTR
+INCOMN, AND (377
+ TAD (-232
+ SNA
+ JMP INEXIT
+ TAD (232
+ ISZ ICHARP
+INEXIT, CIF CDF 0
+ JMP I ICHARP
+
+INEOF, 1
+INCHCT, -1
+
+INCHR1, CDF 0
+ TAD I (MODE
+ CDF 10
+ SPA SNA CLA
+ JMP IC8A2
+IC8A3, TAD I INPTR
+ ISZ INPTR
+ JMP INEXIT-1
+
+IC8A1, TAD INJMPP
+ DCA INJMP
+ ISZ INCHCT
+ JMP IC8A3
+ PAGE
+\fOOPNPS, 0
+ TAD (MOUTPU+1
+ DCA OUBLK
+ TAD I (MOUTPU
+ JMS I (200
+ 3
+OUBLK, 0
+OUELEN, 0
+ JMP OUEFAL
+ DCA OUCCNT
+ JMS I (OUSETP
+ ISZ OOPNPS
+OUEEXT, CIF CDF 0
+ JMP I OOPNPS
+
+OUEFAL, TAD I (MOUTPU
+ AND (7760
+ SNA CLA
+ JMP OUEEXT
+ TAD I (MOUTPU
+ AND (17
+ DCA I (MOUTPU
+ JMP OOPNPS+1
+
+OUHNDL, 0
+
+OUTDMP, 0
+ DCA OUCTLW
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC
+ TAD OUCTLW
+ CLL RTL
+ RTL
+ RTL
+ AND (17
+ TAD OUCCNT
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA
+ JMP I OUTDMP
+ CIF 0
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMP I OUTDMP
+ ISZ OUTDMP
+ JMP I OUTDMP
+
+OCLOSE, 0
+ CDF 0
+ TAD I (MODE
+ CDF 10
+ SMA SZA CLA
+ JMP OULLLP+2
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP
+ SZA CLA
+ TAD (232
+ JMS I (OCHARP
+ JMP OURET
+ JMS I (OCHARP
+ JMP OURET
+OULLLP, JMS I (OCHARP
+ JMP OURET
+ JMS I (OTYPE
+ SPA CLA
+ TAD (100
+ TAD (77
+ AND I (OUDWCT
+ SZA CLA
+ JMP OULLLP
+ TAD I (OUDWCT
+ TAD (OUCTL&3700
+ SNA
+ JMP OUDUMP
+ TAD (4010
+ JMS OUTDMP
+ JMP OURET
+OUDUMP, TAD I (MOUTPU
+ JMS I (200
+ 4
+ MOUTPU+1
+OUCCNT, 0
+ SKP
+ ISZ OCLOSE
+OURET, CIF CDF 0
+ JMP I OCLOSE
+ PAGE
+\fOUTEMP, 0
+
+OUJMP, HLT
+ JMP OCHR1
+ JMP OCHR2
+OCHR3, TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+OC8A1, DCA I OUPTR
+ TAD OUJMPP
+ DCA OUJMP
+ ISZ OUPTR
+ ISZ OUDWCT
+ JMP OUCOMN
+ TAD (OUCTL
+ JMS I (OUTDMP
+ JMP OUCRET
+ JMS OUSETP
+ JMP OUCOMN
+
+OUSETP, 0
+ TAD (OUCTL&3700
+ CIA
+ DCA OUDWCT
+ TAD (OUBUF
+ DCA OUPTR
+ TAD OUJMPP
+ DCA OUJMP
+ JMP I OUSETP
+
+OCHARP, 0
+ DCA OUTEMP
+ RDF
+ TAD (CIF CDF 0
+ DCA OUCRET
+ CDF 0
+ TAD I (MODE
+ SMA SZA CLA
+ JMP .+4
+ TAD OUTEMP
+ AND (377
+ DCA OUTEMP
+ CDF 10
+ ISZ OUJMP
+OUJMPP, JMP OUJMP
+
+OCHR2, CDF 0
+ TAD I (MODE
+ CDF 10
+ SMA SZA CLA
+ JMP OC8A2
+ TAD OUPTR
+ DCA OUPOLD
+ ISZ OUPTR
+OCHR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, ISZ OCHARP
+OUCRET, CIF CDF 0
+ JMP I OCHARP
+
+OUPOLD, 0
+OUPTR, 0
+OUDWCT, 0
+
+OTYPE, 0
+ TAD I (MOUTPU
+ AND (17
+ TAD (DCB-1
+ DCA OUSETP
+ TAD I OUSETP
+ JMP I OTYPE
+
+CDINXX, ZBLOCK 5
+
+OC8A2, ISZ OUPTR
+ TAD OUTEMP
+ JMP OC8A1
+ PAGE
+\f$-$-$
+\f
--- /dev/null
+This area contains the files contained on system release DECtape #7.
+
+Directory of OS/8 V3D DECtape 7 labeled: AL-4697C-SA 2/15/78
+ OS/8 V3D SRC DT 7 OF 7
+ (replaces DEC-S8-OSYSB-B-UA7)
+
+
+OS8 .PA 199 01-AUG-77 PIP10 .PA 172 01-AUG-77
+EDIT .PA 160 01-AUG-77 HELP8 .HL 55 01-AUG-77
+FOTP .PA 108 01-AUG-77 HELP78.HL 31 01-AUG-77
+
+ 6 files in 725 blocks - 5 free blocks
+
+
--- /dev/null
+/ BIN LOADER, RUNNABLE FROM OS/8
+
+ DEV=400 /DEVICE 40 FOR BOOT
+
+ AUTO1=10
+ AUTO2=11
+
+*30
+ 6743 / RK05 BOOTSTRAP - FOR CONVENIENCE
+ JMP .
+
+*200
+ CLA CLL
+ TAD PTR1
+ DCA AUTO1
+ TAD PTR2
+ DCA AUTO2
+ TAD CTRP
+ DCA CTR
+LOOP,
+ TAD I AUTO1
+ DCA I AUTO2
+ ISZ CTR
+ JMP LOOP
+
+ CAF / THAT'S NEW!
+ JMP I LOADER
+
+
+LOADER, 7777 / STARTING ADDRESS
+CTRP, -200 / LOADER SIZE
+CTR, 0 / COUNTER
+PTR1, 3777 / LOADER SOURCE ADDR -1
+PTR2, 7577 / LOADER TARGET ADDR -1
+LFIELD, 0 / LOADER TARGET FIELD
+
+*4000 /THIS WILL GO TO THE LAST PAGE!
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 1212
+ 7402
+ 7402
+ 7402
+ 7402
+ 7402
+ 7402
+ 0000
+ 3212
+ 4260
+ 1300
+ 7750
+ 5237
+ 2212
+ 7040
+ 5227
+ 1212
+ 7640
+ 5230
+ 1214
+ 0274
+ 1341
+ 7510
+ 2226
+ 7750
+ 5626
+ 1214
+ 0256
+ 1257
+ 3213
+ 5230
+ 0070
+ 6201
+ 0000
+ 0000
+ 6001 DEV
+ 5262
+ 6006 DEV
+ 3214
+ 1214
+ 5660
+ 6011
+ 5270
+ 6016
+ 5265
+ 0300
+ 4343
+ 7041
+ 1215
+ 7402
+ 6002 DEV
+ 6014
+ 6214
+ 1257
+ 3213
+
+/ 7604 / LOAD SR
+ CLA CMA
+ 7700
+ 1353
+ 1352
+ 3261
+ 4226
+ 5313
+ 3215
+ 1213
+ 3336
+ 1214
+ 3376
+ 4260
+ 3355
+ 4226
+ 5275
+ 4343
+ 7420
+ 5336
+ 3216
+ 1376
+ 1355
+ 1215
+ 5315
+ 6201
+ 3616
+ 2216
+ 7600
+ 5332
+ 0000
+ 1376
+ 7106
+ 7006
+ 7006
+ 1355
+ 5743
+ 5262
+ 0006
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 5301
+$
\ No newline at end of file
--- /dev/null
+/ BIN LOADER
+
+ DEV=400 /DEVICE 40 FOR BOOT
+ DFIELD=00 /LOADER'S TARGET FIELD
+
+*0
+ JMP 100
+ *100
+ CAF
+ CLA CLL
+ CDF 0
+ TAD I1
+ DCA I A1
+ TAD I2
+ DCA I A2
+ CIF 0
+ JMP 30
+I1, 6743
+I2, JMP 31
+A1, 30
+A2, 31
+
+ *30
+ JMP 0
+
+*200
+ JMP I START
+START, 7600
+
+ *7600
+
+ CDF DFIELD
+ JMP 7777
+
+ *7617
+
+ 1212
+ 7402
+ 7402
+ 7402
+ 7402
+ 7402
+ 7402
+ 0000
+ 3212
+ 4260
+ 1300
+ 7750
+ 5237
+ 2212
+ 7040
+ 5227
+ 1212
+ 7640
+ 5230
+ 1214
+ 0274
+ 1341
+ 7510
+ 2226
+ 7750
+ 5626
+ 1214
+ 0256
+ 1257
+ 3213
+ 5230
+ 0070
+ 6201
+ 0000
+ 0000
+ 6001 DEV
+ 5262
+ 6006 DEV
+ 3214
+ 1214
+ 5660
+ 6011
+ 5270
+ 6016
+ 5265
+ 0300
+ 4343
+ 7041
+ 1215
+ 7402
+ 6002 DEV
+ 6014
+ 6214
+ 1257
+ 3213
+
+/ 7604 / LOAD SR
+ CLA CMA
+ 7700
+ 1353
+ 1352
+ 3261
+ 4226
+ 5313
+ 3215
+ 1213
+ 3336
+ 1214
+ 3376
+ 4260
+ 3355
+ 4226
+ 5275
+ 4343
+ 7420
+ 5336
+ 3216
+ 1376
+ 1355
+ 1215
+ 5315
+ 6201
+ 3616
+ 2216
+ 7600
+ 5332
+ 0000
+ 1376
+ 7106
+ 7006
+ 7006
+ 1355
+ 5743
+ 5262
+ 0006
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 0000
+ 5301
+$
--- /dev/null
+/ MODIFIED SILENT VERSION, HACHTI 2008
+/ KERMIT FOR DEC 12-BIT MACHINES
+
+/ LAST EDIT: 06-SEP-1990 11:00:00 CJL
+
+ XLIST OFF
+ IFNDEF OFF <OFF= 1> /TURN LISTING OFF
+ IFNDEF ON <ON= 0> /TURN LISTING ON
+ XLIST ON; IFZERO 1 <
+
+
+
+
+
+
+
+
+*** **** *********** ********* *** *** *** *********** ***** ****
+*** **** *********** ********** **** **** *** *********** ***** ******
+*** **** *** *** **** **** **** *** *** *** *** ***
+*** **** *** *** *** ***** ***** *** *** *** ** ****
+*** **** *** *** *** ***** ***** *** *** *** ** ***
+******* *** *** **** ************ *** *** *** **
+****** ********** ********** *** **** *** *** *** ***** *** **
+******* ********** ********* *** **** *** *** *** ***** *** **
+*** **** *** *** **** *** ** *** *** *** *** **
+*** **** *** *** **** *** ** *** *** *** *** **
+*** **** *** *** **** *** *** *** *** *** **
+*** **** *********** *** **** *** *** *** *** *** *********
+*** **** *********** *** **** *** *** *** *** *** *********
+ > XLIST ON
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+/ COPYRIGHT (C) 1989, 1990 BY THE TRUSTEES OF COLUMBIA UNIVERSITY IN THE CITY OF
+/ NEW YORK.
+
+
+
+/ PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY OR USE THIS
+/ DOCUMENT AND THE PROGRAM(S) DESCRIBED IN IT, EXCEPT FOR EXPLICITLY COMMERCIAL
+/ PURPOSES.
+\f/ EDIT HISTORY. /014 CJL
+
+/ 052 06-SEP-1990 BUG FIX. CHARLES LASNER (CJL)
+
+/ SENDING A FILE WHICH EXACTLY FILLS THE LAST DATA PACKET AT THE
+/ END OF THE FILE WILL CAUSE THE PACKET TO BE SENT TWICE. THE
+/ ROUTINE DIDN'T CHECK FOR AN EMPTY OUTPUT BUFFER AT EOF.
+
+/ 051 29-AUG-1990 BUG FIX. CJL
+
+/ PDP-8/A NOT IDENTIFIED CORRECTLY IN CPUID ROUTINE. THE UPDATED
+/ PC IS WHAT IS LOADED INTO THE AC WHEN 7016 IS EXECUTED ON THE
+/ KK-8/A CPU. THE ROUTINE WAS CHECKING FOR THE NON-UPDATED VALUE.
+/ ALSO NEW DOCUMENTATION FOR PRE-CLEARING MEMORY FOR BENEFIT OF
+/ ENCODED BINARY FILES.
+\f/ 050 06-SEP-1989 DECMATE I SUPPORT, ETC. CJL
+
+/ THIS EDIT IMPLEMENTS DECMATE I SUPPORT USING THE DP278-A OR -B.
+/ A NEW CONDITIONAL 'PORT' SELECTS WHICH PORT IS TO BE USED. IF
+/ KERMIT-12 IS RUN ON DECMATE I (WHILE NOT CONFIGURED FOR SERIAL
+/ PRINTER PORT COMMUNICATIONS; SEE EDIT 048.) THEN REMOTE
+/ COMMUNICATIONS TAKES PLACE ON THE PORT SELECTED AT ASSEMBLY TIME
+/ ('PORT=0' OR 'PORT=1'). ADDED BAUD RATE PARAMETER 'BRATE' TO
+/ SELECT REMOTE COMMUNICATIONS BAUD RATE FROM THE STANDARD TABLE;
+/ DEFAULTS TO 1200 BAUD ('BRATE=7').
+
+/ 049 30-AUG-1989 REMOTE FLOW CONTROL, ETC. CJL
+
+/ THIS EDIT IMPLEMENTS FLOW CONTROL SUPPORT (IF FLOW CONTROL IS
+/ ENABLED) FOR THE REMOTE LINE WHILE SENDING PACKETS TO THE REMOTE
+/ KERMIT REGARDLESS OF STATE. PREVIOUSLY, FLOW CONTROL ONLY
+/ APPLIED TO CONNECT MODE. LOCAL FLOW CONTROL (TOWARDS THE REMOTE
+/ KERMIT) IS UNNECESSARY AS LOCAL BUFFERS FOR REMOTE INPUT ARE
+/ ALWAYS AVAILABLE. CERTAIN ROUTINE CHANGES MADE FOR BENEFIT OF
+/ DECMATE I SUPPORT IN A SUBSEQUENT EDIT.
+
+/ 048 24-AUG-1989 DECMATE II, ETC. SUPPORT. CJL
+
+/ ONCE-ONLY CODE ADDED TO IMPLEMENT DECMATE II, ETC. REMOTE LINE
+/ SUPPORT ON SERIAL COMMUNICATIONS PORT. SELECTED PORT IS
+/ INDICATED ON OPENING BANNER IF OPERATING ON DECMATE.
+
+/ THIS EDIT PROVIDES BASIC SUPPORT OF THE DECMATE II COMMUNICATIONS PORT AS AN
+/ AUTOMATIC FEATURE OF THE STANDARD RELEASE OF K12MIT. AUTOMATIC DETECTION OF
+/ DECMATE II, ETC. HARDWARE IS PERFORMED UNLESS THE PDP-8-TYPE REMOTE LINE
+/ SUPPORT IS ASSEMBLED FOR THE SERIAL PRINTER AS THE REMOTE LINE ('SPRINT' IS
+/ SET OR EQUIVALENT).
+
+/ THIS EDIT INCORPORATES ALL OF THE INFORMATION TAKEN FROM VARIOUS SOURCES
+/ REGARDING DECMATE PORT INITIALIZATION, ETC. EVERY ATTEMPT HAS BEEN MADE TO
+/ COMPLETELY SET ALL APPROPRIATE REGISTERS, ETC. FOR DECMATE II, III, III+
+/ OPERATION. NO SUPPORT EXISTS FOR THE DECMATE III BUILT-IN MODEM OPTION, AS
+/ EXPLICIT DOCUMENTATION IS NOT AVAILABLE (SOME OF THE INITIALIZATION CODE IS
+/ APPARENTLY USED TO DISABLE THE MODEM). THESE ROUTINES ARE ONLY KNOWN TO WORK
+/ ON THE DECMATE II, AS THE III (ESPECIALLY WITH OPTIONAL MODEM) AND THE III+
+/ HAVEN'T BEEN AVAILABLE TO THE AUTHOR FOR TESTING. THE INITIALIZATION CODE
+/ WILL BE UPDATED LATER TO INCLUDE PANEL REQUESTS, ETC. TO CORRECT ANY
+/ PROBLEMS, ETC. DECMATE-SPECIFIC FEATURES (SUCH AS SETUP COMMANDS) WILL BE
+/ ADDED LATER AND ENABLED FROM THESE ROUTINES.
+
+/ THIS EDIT INCORPORATES NON-INTERRUPT ROUTINES WHICH HAVE BEEN TESTED AT THE
+/ MAXIMUM COMMUNICATIONS SPEED OF THE DECMATE II (19200 BAUD). THEY WILL
+/ SUFFICE FOR ALL KERMIT IMPROVEMENTS SHORT OF SLIDING WINDOWS AT WHICH TIME
+/ INTERRUPT-DRIVEN I/O WILL BE REQUIRED. (INTERRUPT-DRIVEN I/O IS ILLEGAL ON
+/ CERTAIN OS/8 SYSTEMS WHERE INTERRUPTS ARE HARMFUL TO THE SYSTEM OR NON-SYSTEM
+/ HANDLERS.)
+\f/ 047 21-AUG-1989 CODE CLEANUP. CJL
+
+/ STREAM-LINED CONNECT MODE ROUTINES FOR MINIMUM USE OF IOTS. THIS
+/ IS IN PREPARATION FOR EVENTUAL DECMATE II OPERATION, AND TO
+/ MINIMIZE K12PCH PATCH FILE SIZE. CERTAIN NON-CONNECT ROUTINES
+/ MOVED TO FACILIATE CONNECT ROUTINE REORGANIZATION.
+
+/ 046 15-AUG-1989 CODE CLEANUP. CJL
+
+/ ADDED NEW (NON-CONNECT) MODE COMMUNICATIONS ROUTINES FOR EVENTUAL
+/ DECMATE USE. ELIMINATION OF 'IREM' AND 'IREMW' ROUTINES IN FAVOR
+/ OF 'COMIN'. ELIMINATION OF 'OREM' IN FAVOR OF 'COMOUT'. ADDED
+/ STATUS UPDATE ROUTINE ('UPSTATUS') FOR EVENTUAL DECMATE II, ETC.
+/ USAGE. ELIMINATED PDP-8, DECMATE I, DECMATE II CONDITIONALS.
+/ REORGANIZED SERIAL LINE CONDITIONALS AND ADDED NEW 'SPRINT'
+/ PARAMETER FOR SERIAL PRINTER PORT USAGE AS COMMUNICATIONS PORT.
+/ ADDED ONCE-ONLY CODE ADDED TO AUTOMATICALLY RECOGNIZE DECMATE I
+/ AND II OPERATION UNLESS ASSEMBLED FOR REMOTE COMMUNICATIONS ON
+/ SERIAL PRINTER PORT ('SPRINT' SET). UPDATED K12PCH.PAL TO
+/ CORRESPOND TO NEW DEFINITIONS. DEFINED EVENTUALLY NEEDED
+/ COMMUNICATIONS PORT INSTRUCTIONS FOR DECMATE II; ACTUAL DECMATE
+/ II OPERATION WILL BE DEFINED IN A SUBSEQUENT EDIT. DOCUMENTED
+/ NEW LOADING AND SAVING INSTRUCTIONS FOR K12MIT TO ALLOW FOR
+/ ONCE-ONLY CODE IN 10000-11777 WITHOUT SWAPPING THE CODE OUT FOR
+/ THE USR. THIS ELIMINATES OVERHEAD WHEN LOADING K12MIT, BUT IS
+/ DIFFERENT FROM THE FORMER INSTRUCTIONS WHICH ASSUMED NO OTHER
+/ USAGE OF 10000-11777 OTHER THAN THE (LOCKED-IN) USR.
+
+/ THIS EDIT PROVIDES THE FRAMEWORK FOR AUTOMATIC DETECTION OF PROGRAM EXECUTION
+/ OF K12MIT ON ANY MEMBER OF THE DECMATE FAMILY (I, II, III, III+). WHEN
+/ 6120-TYPE CPU DETECTION OCCURS, THE DECMATE I OR II-TYPE COMMUNICATIONS PORT
+/ INITIALIZE CODE IS AUTOMATICALLY SELECTED AS NECESSARY UNLESS THE PDP-8-TYPE
+/ ROUTINES ARE ASSEMBLED (WITH 'SPRINT' SET OR EQUIVALENT USER SETTINGS, ETC.)
+/ FOR THE VT-78-TYPE PRINTER PORT (32/33), IN WHICH CASE THE COMMUNICATIONS IS
+/ DONE VIA THE PRINTER PORT ON THE DECMATE (WHICH IS ALMOST PDP-8 COMPATIBLE AND
+/ IS ACCOMODATED AS SUCH).
+
+/ SUBSEQUENT EDITS SHOULD PROVIDE FOR A DECMATE I PARAMETER TO CONTROL THE PORT
+/ SELECTION, AS THERE ARE AT LEAST TWO VARIANT OPTIONS BOARDS (DP-278A AND
+/ DP-278B) EACH CONSISTING OF TWO PORTS.
+\f/ 045 12-AUG-1989 BUG FIX. CJL
+
+/ FINISH, GET, AND RECEIVE COMMANDS FAIL TO ABORT PROPERLY
+/ (ESPECIALLY AFTER THE SEND COMMAND HAS BEEN USED), AS THE CURRENT
+/ OPERATING MODE ('KMODE') IS NEVER PROPERLY SET, OR IS SET AFTER
+/ SEVERAL PACKETS HAVE BEEN SENT. EACH COMMAND NOW SETS ITS OWN
+/ OPERATING MODE BEFORE INITIATING ANY PACKETS.
+
+/ 044 11-AUG-1989 CODE CLEANUP. CJL
+
+/ CHANGED 'CCMSG' TO 'ABMSG' WITH CLEARER MESSAGE. CHANGED
+/ 'CCFLAG' TO 'ABFLAG' FOR CONSISTENCY. CHANGED ABORT CHARACTER
+/ FROM <^C> TO CHOICE OF <^X> OR <^Z> FOR CONSISTENCY. ELIMINATED
+/ 'ITTY' AND 'ITTYW' ROUTINES BY USING 'CTLCTST' AND 'INPUT'
+/ ROUTINES ALREADY AVAILABLE A/O EDIT 043. ELIMINATED 'TCHAR' IN
+/ FAVOR OF 'INCHAR' AVAILABLE A/O EDIT 043.
+
+/ 043 07-AUG-1989 CODE CLEANUP, ETC. CJL
+
+/ REWRITE OF CONSOLE SUPPORT ROUTINES INCLUDING FORCED-ECHO OUTPUT
+/ AND COLUMN COUNT FOR <HT> SIMULATION IN PREPARATION FOR IMPENDING
+/ USER-INTERFACE REWRITE. 'SCRIBE', 'LININP', AND 'ESCPRNT'
+/ ROUTINES NOW CALL "P7ECHO" ROUTINE TO ENSURE PRINTING OF CRUCIAL
+/ MESSAGES.
+
+/ 042 13-JUN-1989 CODE CLEANUP. CJL
+
+/ FIXED VARIOUS NAK-RELATED BUGS AND SEND-INIT PROBLEMS AS IN K278
+/ (SOME OF THE K278 STUFF IS DEFICIENT!). CALCULATION OF PROPER
+/ SEQUENCE NUMBER FOR NAK CORRECTED OVER FORMER (K08MIT AND K278)
+/ VERSIONS. ADDED ERROR MESSAGE FOR FULL-DISK PROBLEM.
+
+/ 041 12-MAY-1989 BUG FIX. CJL
+
+/ VARIOUS VERSIONS (DECMATE) WON'T FUNCTION REMOTELY WHILE KL-8
+/ VERSIONS WORK FINE. ADDED REMOTE LINE READ IOT TO INITIALIZE
+/ REMOTE LINE AT STARTUP TIME FOR VERSIONS REQUIRING THIS.
+/ CORRESPONDING CHANGES IN PATCH FILE MADE FOR REMOTE LINE READ IOT
+/ IN TWO PLACES.
+\f/ 040 07-MAR-1989 COSMETIC CLEANUP. CJL
+
+/ CLEANUP OF EDIT HISTORY AND OTHER COMMENTS.
+
+/ 039 21-MAY-1988 CODE CLEANUP. CJL
+
+/ ADDED VARIABLE 'INIECHO' TO ALLOW DEFAULT CONNECT-MODE STATE TO
+/ BE HALF-DUPLEX ("SET LOCAL-ECHO ON"). MODIFIED INPUT SERVICE
+/ ERROR ADDRESSES TO SIMPLIFY ERROR TABLES.
+
+/ 038 19-MAY-1988 CODE CLEANUP. CJL
+
+/ ELIMINATED TRAILER FILES DURING ASSEMBLY BY CREATING VARIABLES
+/ 'GENMSG' AND 'UMSG.' THIS ALLOWS THE HEADER FILE (PARAM.PA) TO
+/ CONTAIN THE LOCAL MESSAGE TEXT WITHOUT SUBSEQUENT OVERLAY (WHICH
+/ WAS WHY THERE FORMERLY WAS A TRAILER FILE CAPABILITY). OVERLAY
+/ BY K12PCH.BN WILL DEFAULT TO CREATION OF A DUMMY USER MESSAGE
+/ (WITHIN K12PCH) ENCOURAGING LOCAL CUSTOMIZATION. K12MIT.BN WILL
+/ CONTAIN A NULL MESSAGE BY DEFAULT UNLESS CUSTOMIZED IN PARAM.PA.
+
+/ 037 21-JAN-1988 BUG FIX. CJL
+
+/ RESET OS/8 DEVICE CONTROL WORD TABLE TO DELETE TENTATIVE FILE IN
+/ CASE OF PRIOR INPUT SERVICE ERROR.
+
+/ 036 20-JAN-1988 BUG FIX. CJL
+
+/ RESET 'OFFLG' WHEN DOING INPUT SERVICE IN CASE PRIOR ERRORS LEAVE
+/ THE FLAG SET.
+
+/ 035 14-JAN-1988 USR RESIDENT CODING. CJL
+
+/ CALLS TO USR NOW USE 10200 INSTEAD OF 17700. NO SWAP OVERHEAD
+/ WHEN OPENING OR CLOSING FILES.
+
+/ 034 13-JAN-1988 CODE CLEANUP. CJL
+
+/ ALL EIGHT-BIT ORIENTED CONSOLE CODE ELIMINATED; NOW IGNORES
+/ PARITY (JUST SEVEN BITS).
+
+/ 033 12-JAN-1988 CODE CLEANUP. CJL
+
+/ 'TTYOUT' AND 'OTTY' ROUTINES ELIMINATED; NOW USES 'P7CH' FOR ALL
+/ CONSOLE OUTPUT (EXCEPT FOR CONNECT MODE).
+
+/ 032 12-JAN-1988 CODE CLEANUP. CJL
+
+/ VARIOUS ROUTINES REWRITTEN TO ELIMINATE DEPENDENCIES ON CPU TYPE
+/ BEYOND THE CLASSIC PDP-8.
+\f/ 031 11-JAN-1988 CODE CLEANUP. CJL
+
+/ ELIMINATED 'RTDISP' AND CHANGED CALLING CONVENTION FOR DISPATCH
+/ ROUTINE. ALL CALLERS NOW LOCAL OR VIA LOCAL POINTERS. ADDED
+/ SEVERAL CONDITIONAL PARAMETERS AND LABELS FOR BENEFIT OF
+/ K12PCH.PAL.
+
+/ 030 05-JAN-1988 CODE CLEANUP. CJL
+
+/ CHANGED LOWER/UPPER CASE CONDITIONAL ASSEMBLY PARAMETERS AND MORE
+/ EFFICIENT CODE.
+
+/ 029 21-DEC-1987 CODE CLEANUP. CJL
+
+/ CHANGED CALLING CONVENTIONS FOR 'SCRIBE' AND SIMILAR ROUTINES AND
+/ REWROTE 'COMMAND' ROUTINE.
+
+/ 028 15-DEC-1987 CODE CLEANUP. CJL
+
+/ COMPLETE REWRITE OF FILE LOOKUP ROUTINE. 'LUKUP' NOW USES FIELD
+/ ONE BUFFER AND ITS OWN AUTO-INDEX REGISTER CONSERVING PROGRAM
+/ SPACE.
+
+/ 027 05-DEC-1987 CODE CLEANUP. CJL
+
+/ CHANGED DISPATCH ('DISPA0') ROUTINE TO USE 'SRCHTABLE' ROUTINE.
+/ ALL CALLS MADE COMPATIBLE. ELIMINATED 'SCANC' CODE. ELIMINATED
+/ CODE WITHIN 'DPARS' ROUTINE. 'LUKUP' ROUTINE NOW DOES ITS OWN
+/ DISK I/O. ELIMINATED 'BLKIN' ROUTINE.
+
+/ 026 27-NOV-1987 NEW CONNECT MODE CODE. CJL
+
+/ TOTAL REWRITE OF ALL CONNECT MODE CONSOLE AND REMOTE INPUT AND
+/ OUTPUT TERMINAL ROUTINES. CONNECT IS NOW FULLY BUFFERED IN ALL
+/ DIRECTIONS. IF FLOW CONTROL IS OBEYED, ANY BAUD RATE CAN BE
+/ ACCOMODATED BOTH LOCALLY AND REMOTE (UP TO 9600 BAUD TESTED,
+/ SHOULD WORK TO AT LEAST 19200 BAUD BY INSPECTION). TESTED WITH
+/ FAST VT-100 EMULATOR CONSOLE TO PROVE ESCAPE SEQUENCES ARE NOT
+/ DROPPED WHEN LOCAL TERMINAL IS FASTER THAN REMOTE LINE. LIMITED
+/ USE OF SUBROUTINES TO IMPROVE HIGH BAUD RATE OPERATION. ADDED
+/ TABLE-DRIVEN ERROR EXITROUTINE FOR SEND ROUTINES.
+
+/ THIS EDIT PROVIDES FULLY BUFFERED INPUT/OUTPUT ROUTINES FOR BOTH LOCAL AND
+/ REMOTE PORTS. NO INTERRUPTS ARE USED FOR MAXIMUM COMPATIBILITY WITH OS/8
+/ DEVICES (SOME OF WHICH ARE INTOLERANT OF INTERRUPTS, SUCH AS TD-8/E). REMOTE
+/ FLOW CONTROL (IF ENABLED) WILL SIGNAL BUFFER FILLING VIA <DC3> WHEN THE BUFFER
+/ IS 3/4 FULL. WHEN THE BUFFER REACHES 1/4 FULL, THE REMOTE WILL BE SENT <DC1>
+/ TO ALLOW FURTHER OUTPUT. REMOTE FLOW CONTROL IS SUPPORTED IN BOTH DIRECTIONS;
+/ LOCAL FLOW CONTROL IS FROM THE KEYBOARD ONLY.
+
+/ WHILE THE CONSOLE OUTPUT IS PAUSED BY <DC3>, THE BUFFER WILL FILL WITH OUTPUT
+/ CHARACTERS. WHEN THE USER RELEASES THE CONSOLE WITH <DC1>, THE BUFFER WILL
+/ RAPIDLY EMPTY (ASSUMING THE CONSOLE IS FASTER THAN THE REMOTE LINE). THIS
+/ ALLOWS THE USER TO PAUSE THE CONSOLE WITHOUT BACKING UP THE REMOTE LINE UP TO
+/ THE LIMITS OF BOTH LOCAL OUTPUT AND REMOTE INPUT BUFFERS.
+\f/ 025 24-NOV-1987 NEW FEATURES AND CODE CLEANUP. CJL
+
+/ PROPER INTERRUPT SETUP FOR <^C> AND <^P>, ECHO STATE. ALL
+/ MESSAGES IN NEW FORMAT, (SOME NEW ONES HAVE BETTER CONTENT).
+/ ELIMINATED 'PRI6B' AND 'REM6B' ROUTINES. NEW AND IMPROVED INPUT
+/ SERVICE ERROR CODE MOVED TO PROPER PAGE. REWROTE CONNECT
+/ ROUTINES TO ALLOW NON-INTERRUPT BUFFERED I/O LATER. CREATED NEW
+/ VARIABLE 'ESCHAR' AND PARAMETER 'ESCAPE' TO SET DEFAULT ESCAPE
+/ CHARACTER. ESCAPE CHARACTER CAN BE CHANGED IN MEMORY AND WILL BE
+/ USED CORRECTLY BY ALL ROUTINES. ADDED 'ESCPRNT' ROUTINE TO
+/ HANDLE ALL CASES (INCLUDING NON-CONTROL CHARACTERS). DEFAULT
+/ ESCAPE PARAMETER VALUE COMPATIBLE WITH K08V2, BUT IS A USER
+/ PARAMETER, CONFIGURED AS OTHER PARAMETERS DEFINED IN EDIT 017.
+/ CREATED ESCAPE FUNCTION TABLE FOR EXPANSION LATER. NOW SUPPORTS
+/ ESCAPE C(LOSE) IN UPPER OR LOWER CASE, ESCAPE ESCAPE (SEND ONE
+/ ESCAPE CHARACTER). ALL BAD ESCAPE COMMANDS WILL ISSUE <BEL>
+/ CHARACTER TO WARN USER THAT COMMAND IS ILLEGAL AND OTHERWISE WAS
+/ IGNORED. CREATED NEW VARIABLE 'ECHOFLAG' TO ALLOW LOCAL ECHO IN
+/ CONNECT MODE.
+
+/ 024 19-NOV-1987 NEW FEATURES. CJL
+
+/ NEW STARTUP MESSAGES AND HELP METHOD VIA COMMAND. CPU TYPE
+/ IDENTIFICATION TO ALLOW FUTURE VERSIONS TO CHECK FOR QUIRKS AND
+/ MODEL DEPENDENCIES. THE DEFAULT PROMPT REFLECTS THE ACTUAL CPU
+/ TYPE (THUS "KERMIT-12>" ON PDP-12). VERSION, REVISION, AND DATE
+/ NOW EQUATED SYMBOLS.
+
+/ 023 18-NOV-1987 NEW CONSOLE I/O PACKAGE. CJL
+
+/ NEW CONSOLE I/O ROUTINES WITH DC1/DC3 SUPPORT FOR CONSOLE
+/ TERMINAL MESSAGES NOT ASSOCIATED WITH ANY REMOTE ACTIVITY (NOT TO
+/ BE USED DURING CONNECT MODE). USES FIELD ONE FOR MESSAGE TEXT TO
+/ ALLOW FOR MORE PROGRAM SPACE. THE MESSAGES ARE NOW GIVEN IN
+/ UPPER/LOWER SIXBIT FORMAT. SUPPORT FOR <^P> RESTART AND <^O> TO
+/ FLIP ECHO. UPPER-CASE CAN BE FORCED BY CHANGING A VARIABLE
+/ ('UPONLY').
+
+/ 022 17-NOV-1987 BUG FIX. CJL
+
+/ EXTRA-LONG INIT PACKETS CORRUPTING PROGRAM; NOW CHECKS FOR AND
+/ IGNORES EXTRA CAPABILITIES BEYOND 'CAPAS' BYTE.
+\f/ 021 17-NOV-1987 CODE CLEANUP. CJL
+
+/ REWROTE TENTATIVE OUTPUT FILE LENGTH CODE FOR MORE CONSISTENCY.
+/ RENAMED "FINISH" COMMAND CORRECTLY (FORMERLY "BYE").
+
+/ FORMER CODE REGARDING THE TENTATIVE FILE MAXIMUM LENGTH WAS ACCEPTABLY
+/ ORGANIZED FOR ORIGINAL PS/8, OS/8 CONVENTIONS. WITH THE EVOLUTION OF THE
+/ OPERATING SYSTEM INTO OS/78 (VERSIONS 1-4) AND OS/278 (VERSIONS 1-2), THE
+/ ENTER OPERATION HAS BEEN CHANGED WITH DANGEROUS CONSEQUENCES.
+
+/ THE ORIGINAL DEFINITION OF THE LENGTH RETURNED BY ENTER IS THE ACTUAL LENGTH
+/ OF THE LARGEST EMPTY (IN TWO'S COMPLEMENT FORM). IF RECORD 7777 IS PART OF
+/ THE ACTUAL LARGEST EMPTY (FULL SIZE DEVICE AND THE LARGEST EMPTY IS LAST ON
+/ THE DEVICE), THEN THE LENGTH RETURNED IS ONE LESS (THIS IS A LONG STANDING
+/ BUG). SINCE THERE IS NO STRAIGHT-FORWARD WAY TO DETERMINE THIS, THE LENGTH IS
+/ ASSUMED TO BE CORRECT.
+
+/ TESTS WITH THE DECUS VERSION OF OS/278 (DM-101) REVEAL A DANGEROUS CHANGE:
+/ THE LENGTH RETURNED IS TWO LARGER THAN ACTUALLY EXISTS!
+
+/ TO COUNTERACT THIS, EDIT 010 INSERTED A DECREMENT OF TWO INTO THE LENGTH
+/ BEFORE PASSING IT BACK TO THE KERMIT FILE WRITING ROUTINE. THE FILE WRITING
+/ ROUTINE THEN ADDS ONE TO THE LENGTH TO CREATE A "DANGER COUNT", I.E., IN TWO'S
+/ COMPLEMENT NOTATION, THIS IS THE AMOUNT THAT WILL INDICATE FILE OVERFLOW
+/ SHOULD IT REACH ZERO.
+
+/ THIS HAS NOW BEEN REORGANIZED TO ALLOW THE ENTER ROUTINE TO SET THE DANGER
+/ COUNT DIRECTLY. OS/8 USERS MUST ALLOW FOR THE EXTRA ROOM (WHICH MUST BE
+/ PRESENT BUT WILL NOT BE USED), SINCE NO CHECK FOR SYSTEM VERSION WILL BE
+/ PERFORMED.
+
+/ 020 16-NOV-1987 NEW ROUTINES AND CODE CLEANUP. CJL
+
+/ REWROTE ENTIRE OUTPUT FILE PACK ROUTINE. NOW SUPPORTS
+/ ASCII/BINARY INTERNAL FILE MODE FOR LATER USE. USES OUTPUT
+/ BUFFER IN FIELD ONE (SAME DEFINITIONS AS INPUT BUFFER) TO ALLOW
+/ MORE PROGRAM SPACE. END OF FILE CONVENTION IN ASCII MODE NOW
+/ INCLUDES ENSURING <^Z> CHARACTER PACKED INTO FILE (OR NOT).
+/ REWROTE ENTIRE OUTPUT FILE CLOSE ROUTINE TO IMPLEMENT <^Z>
+/ SCHEME. ELIMINATED SEPARATE OUTPUT FILE INITIALIZE ROUTINE; USE
+/ SPECIAL ROUTINE CALL INSTEAD. FIXED PACKET WRITE BUG.
+
+/ 019 15-NOV-1987 NEW ROUTINES AND CODE CLEANUP. CJL
+
+/ FIXED UNPACK <^Z> BUG. REWROTE ENTIRE INPUT FILE UNPACK ROUTINE.
+/ NOW SUPPORTS ASCII/BINARY INTERNAL FILE MODE FOR LATER USE. USES
+/ INPUT BUFFER IN FIELD ONE TO ALLOW MORE PROGRAM SPACE. BUFFER
+/ FIELD DEFINED VIA SYMBOLS TO ALLOW CHANGES IN THE FUTURE. END OF
+/ FILE CONVENTION IN ASCII MODE NOW INCLUDES SENDING <^Z> CHARACTER
+/ OR NOT. ELIMINATED SEPARATE INPUT FILE INITIALIZE ROUTINE; USE
+/ SPECIAL ROUTINE CALL INSTEAD.
+
+/ 018 09-NOV-1987 BUG FIX AND CODE CLEANUP. CJL
+
+/ FIXED RECEIVE BUG; NOW ALLOW DEV: ON RECEIVE.
+\f/ 017 05-NOV-1987 NEW FEATURES. CJL
+
+/ CONDITIONAL ASSEMBLY PARAMETERS ADDED FOR MACHINE TYPE (PDP-8,
+/ DECMATE I, DECMATE II/III/III+), REMOTE LINE AND LOCAL TERMINAL
+/ INTERFACE DEFINITIONS.
+
+/ 016 05-NOV-1987 CODE CLEANUP. CJL
+
+/ OPTIMIZATION OF CODE, LITERALS, CONSTANTS.
+
+/ 015 04-NOV-1987 BUG FIX. CJL
+
+/ INPUT SERVICE ROUTINE ERROR DOES JMP INSTEAD OF JMS WHEN CALLING
+/ COMMON ERROR HANDLER.
+
+/ 014 02-NOV-1987 SOURCE FILE CLEANUP. CJL
+
+/ SOURCE FILE COSMETICALLY CLEANED UP AND RENAMED TO K12MIT.PAL
+/ WHICH CONFORMS WITH CUCCA NAMING CONVENTION. NO ACTUAL BINARY
+/ CODE CHANGES BEYOND K08V2. THIS EDIT HISTORY ADDED. ENTRIES
+/ PRIOR TO 014 TRANSCRIBED BY CJL.
+
+/ SINCE THE PDP-12 (AND OTHER 12-BIT DEC MACHINES) IS THE INTENDED ENVIRONMENT
+/ FOR THIS PROGRAM, IT IS NOW KNOWN AS KERMIT-12.
+
+/ ASSEMBLING THE SOURCE FILE PRODUCES BINARY IDENTICAL TO K08V2.PA CONFIRMING
+/ THAT SOURCE CLEANUP DOESN'T DAMAGE THE CODING (K08V2 IS NOW OBSOLETE).
+
+/ 013 01-OCT-1987 CHANGE TO VERSION 2.0. R. SCHLERF (RICH)
+
+/ CHANGED 'RKIOT'/'RTIOT' TO 43/44 REMOTE LINE IOT (LOCAL
+/ PREFERENCE). CHANGED 'ESCAPE' CHARACTER TO ^] ('CONX1') FOR
+/ GENERIC CONFORMITY. ADDED VERSION/COMMAND BANNER AT STARTUP FOR
+/ MINI-HELP. INCORPORATED K278 CHANGES 003-006, 009-010 (NO
+/ INTERRUPTS). DELETED 'ERRMSG.' NOW USES 'STXERR' AT 'CLOOP9'+2
+/ FOR PROGRAM SPACE. TO CONFORM TO GENERIC KERMIT, "BACK ON PDP8"
+/ MESSAGE DELETED AND REPLACED WITH BEEP <^G>. MESSAGE "SENDING
+/ FILE XXXXXX.XX CREATED ON DD-MM-YY" REDUCED TO "SENDING FILE
+/ XXXXXX.XX" TO CONFORM TO GENERIC KERMIT. PARITY BIT IS IGNORED
+/ ON BOTH REMOTE AND TTY LINES. OUTPUT PARITY IS SET TO SPACE.
+
+/ PROGRAM RENAMED TO K08V2.PA AND MADE AVAILABLE TO CUCCA BY:
+
+/ RICHARD SCHLERF (RICH)
+/ AMERICAN CYANAMID COMPANY
+/ MEDICAL RESEARCH DIVISION
+/ LEDERLE LABORATORIES
+/ BUILDING 190 ROOM 115H
+/ PEARL RIVER, NEW YORK 10965
+/ (914) 732-2186 (09:00 TO 16:00)
+
+/ SINCE PRIMARY APPLICATION OF K08V2 IS FOR PDP-8 USAGE, THE MODIFICATIONS NOT
+/ SPECIFIC TO DECMATE II/III FROM K278 WERE MOVED TO THE K08MIT VERSION. FUTURE
+/ VERSIONS WILL INCORPORATE THE DECMATE FEATURES AND THUS OBSOLETE ALL OTHER
+/ VERSIONS AT THAT TIME.
+\f/ 012 04-JUN-1986 PROGRAM FIX. SEPP STADELMANN (SSTA)
+
+/ RE-INITIALIZE VIA 'V30ST' AS ROM SETUP CLEARS COMPOSETABLE, ETC.
+
+/ 04-JUN-1986 VERSION RELEASED TO CUCCA BY MARTYN HEMMINGS (DEC GERMANY) AND
+/ SEPP STADELMANN (DEC SWITZERLAND) OF:
+
+/ DIGITAL EQUIPMENT CORPORATION (DEC)
+/ 146 MAIN STREET
+/ MAYNARD, MASS 01754
+/ (617) 897-5111
+
+/ CUCCA RENAMED FILES (KERMIT.PA AND KERCOM.PA) TO K278.PA AND K278COM.PA (WHICH
+/ DOESN'T REALLY CONFORM TO THE NAMING CONVENTION).
+
+/ CUCCA VERSION OF K278.PA FOUND TO BE DEFECTIVE. FILE REPAIRED BY:
+
+/ CHARLES LASNER (CJL)
+/ CLA SYSTEMS
+/ 72-55 METROPOLITAN AVENUE
+/ MIDDLE VILLAGE, NEW YORK 11379-2107
+/ (718) 894-6499
+
+/ REPAIRED FILE (K278.PA) NOW AVAILABLE AT CUCCA.
+
+/ PROGRAM IS NOW THE DECMATE II/III (III-PLUS) KERMIT ONLY. HOOKS WERE LEFT IN
+/ FOR PDP-8 VERSION, BUT NOT IMPLEMENTED. K278 DOES WORK WITH ADDITIONAL
+/ IMPLEMENTATIONS OF KERMIT, BUT RECEIVE COMMAND DOES NOT WORK. PROGRAM YIELDS
+/ RECOVERABLE SYSTEM ERROR/HALT WHEN EXITING TO FLOPPY-BASED DECMATE II SYSTEM.
+/ CONNECT MODE IS VT200 8-BIT WHICH CONFUSES EVEN/ODD PARITY SYSTEMS. K278 DOES
+/ NOT SUPPORT SETUP KEY OF DECMATE, BUT IMPLEMENTS SETUP COMMAND.
+
+/ 011 04-JUN-1986 NEW FEATURES. SSTA
+
+/ 'PRQ3' CODE CONDITIONALS. ROM SETUP COMMAND IMPLEMENTED FOR DMII/III.
+/ AUTOMATIC UPPERCASE SELECT ON RETURN FROM CONNECT.
+
+/ 010 13-MAR-1986 BUG FIX. MARTYN HEMMINGS (MART)
+
+/ FULL DISK HANDLED WELL.
+
+/ 009 13-MAR-1986 BUG FIX. MART
+
+/ CLEAN UP BREAK AND GET.
+\f/ 008 12-MAR-1986 BUG FIX. MART
+
+/ CLEAR INPUT CHARACTERS FROM COMMUNICATIONS PORT WHEN IN IDLE
+/ LOOP.
+
+/ 007 11-MAR-1986 NEW FEATURES AND BUG FIX. MARTYN HEMMINGS AND
+/ SSEP STADELMANN
+/ (MART+SSTA)
+
+/ INTERRUPT DRIVEN AND BUG FIX.
+
+/ 006 10-MAR-1986 NEW FEATURE. MART+SSTA
+
+/ DEVICE PARSE ON GET.
+
+/ 005 10-MAR-1986 BUG FIX. MART+SSTA
+
+/ NO DATE IN FILE WITH <^Z> INTACT.
+
+/ 004 10-MAR-1986 NEW FEATURES AND BUG FIX. MART+SSTA
+
+/ MAXIMUM RECEIVE BUFFER FIXUP ('RTERMI'), 15 SECOND TIME-OUT
+/ DURING CONNECT.
+
+/ 003 10-MAR-1986 BUG FIX. SSTA
+
+/ TWO PAGE HANDLER FIX.
+
+/ K08MIT.PAL COPIED TO DEC ENGINEERING NETWORK (NODE LSMVAX::) ULTIMATELY TO
+/ EUROPE (NODE VIRGIN::) WHERE PROGRAM BECAME KERMIT.PAL AND KERCOM.PAL.
+
+/ KERMIT.PAL AND KERCOM.PAL ARE TWO SOURCE FILES ASSEMBLED TOGETHER TO PRODUCE
+/ THE RUNNING KERMIT-8. *THEY ARE FOR THE DECMATE II/III/III-PLUS ONLY.*
+
+/ 002 18-JUL-1985 ORIGINAL RELEASE. RANDY HIPPE
+
+/ 18-JUL-1985 VERSION RELEASED TO CUCCA BY JERRY SANDS AND RANDY HIPPE OF:
+
+/ BUREAU OF ENGRAVING, INC.
+/ 3311 BROADWAY N.E.
+/ MINNEAPOLIS, MN 55413
+/ (612) 623-0900 X218
+
+/ CUCCA RENAMED FILE (KER8.PAL) TO K08MIT.PAL WHICH CONFORMS TO NAMING
+/ CONVENTION OF KERMIT FILES.
+
+/ K08MIT SUPPORTS CONNECT, BYE (REALLY FIN), EXIT, SEND, GET, RECEIVE ONLY.
+
+/ PROGRAM PRONE TO GETTING "CONFUSED" AND OUTPUTS FILE DATE ATTRIBUTE BOTH AS
+/ 'CAPAS' BYTE FEATURE AND ASCII TEXT INSERTED INTO CONTENTS OF FILE AHEAD OF
+/ FILE DATA. COMMAND PROCESSOR ACCEPTS UPPER-CASE COMPLETE COMMANDS ONLY. <^C>
+/ ABORT FEATURE TAKES VERY LONG TIME TO ACT (IF AT ALL!). MANY KERMITS WILL NOT
+/ WORK WITH K08MIT; HOWEVER, K08MIT WAS TESTED SUCCESSFULLY WITH KERMIT-20.
+
+/ 001 30-JUL-1984 FIRST VERSION (KER8.PAL). JERRY SANDS
+\f/ HARDWARE HINTS AND KINKS.
+
+
+/ KERMIT-12 REQUIRES THE FOLLOWING STANDARD OS/8 FAMILY CONFIGURATION:
+
+/ PDP-8 FAMILY MEMBER WITH AT LEAST 8K MEMORY.
+
+/ OS/8 SYSTEM DEVICE (WITH OS/8 FAMILY OPERATING SYSTEM RESIDENT).
+
+/ KL8-COMPATIBLE CONSOLE INTERFACE.
+
+/ 7/8-BIT ASCII EXTERNAL CONSOLE TERMINAL DEVICE (TTY:).
+
+/ KL8-COMPATIBLE REMOTE INTERFACE TO OTHER KERMIT.
+
+/ NOTE: ASSEMBLY PARAMETERS OF KERMIT-12 ALLOW FOR LOCAL KERMIT CONTROLLING
+/ TERMINALS TO BE OTHER THAN THE PRIMARY OS/8 CONSOLE DEVICE. THE ACTUAL
+/ HARDWARE MUST STILL CONFORM TO THE SAME REQUIREMENTS (THE DEVICE CODES WOULD
+/ THEN BE USER-SPECIFIED AND DIFFER FROM THE STANDARD 03/04) AS THE STANDARD
+/ CONSOLE INTERFACE AND TERMINAL.
+
+/ SPECIAL DECMATE CONSIDERATIONS:
+
+/ DECMATE USAGE IS USUALLY OBTAINED BY ASSEMBLING FOR THE STANDARD CONSOLE
+/ DEVICE (03/04), AS THE BUILT-IN FIRMWARE/SLUSHWARE OF THE DECMATES IS
+/ SUFFICIENTLY COMPATIBLE WITH THE PDP-8 HARDWARE FOR KERMIT-12'S REQUIREMENTS.
+/ (THE ONLY OTHER ACCEPTABLE CONSOLE DEVICE ON THE DECMATE IS THE PRINTER PORT.)
+
+/ DECMATE REMOTE COMMUNICATIONS PORTS ARE *RADICALLY* DIFFERENT FROM
+/ KL8-COMPATIBLE PORTS. THESE ARE HANDLED AUTOMATICALLY BY ONCE-ONLY CODE WHICH
+/ DETECTS THE USAGE OF KERMIT-12 ON THE SPECIFIC DECMATE SYSTEM, AND
+/ SELF-CONFIGURATION AS APPROPRIATE. THERE IS ONE EXCEPTION TO THIS, NAMELY IF
+/ THE COMMUNICATIONS PORT CODE IS ASSEMBLED FOR THE PRINTER PORT (32/33), THEN
+/ THE PRINTER PORT, *NOT* THE COMMUNICATIONS PORT WILL BE USED. THE STANDARD
+/ ASSEMBLY OF KERMIT-12 IS FOR A PDP-8 WITH DEVICE 40/41 COMMUNICATIONS PORT.
+/ THIS DESIGNATED VERSION WILL SELF-CONFIGURE WHEN EXECUTED ON A DECMATE.
+\f/ CONFIGURATION RESTRICTIONS:
+
+/ WHEN INTERRUPTS ARE SUPPORTED AGAIN, DEVICES SUCH AS THE TD-8/E WON'T WORK.
+/ THE NON-INTERRUPT VERSION SHOULD WORK TO 19200 BAUD ON THE PDP-8/E CPU, SO
+/ THIS SHOULD NOT BE A PROBLEM. INTERRUPT-DRIVEN VERSIONS OF KERMIT-12 MUST BE
+/ RUN ONLY ON SYSTEMS WHERE *ALL* INTENDED DEVICES CAN HAVE THEIR HANDLERS
+/ INTERRUPTED BY THE CONSOLE AND REMOTE LINE INTERRUPT HANDLERS. WHEN IN DOUBT,
+/ THE NON-INTERRUPT VERSION MUST BE USED (CURRENTLY THE ONLY VERSION).
+
+/ IF FLOW CONTROL IS DISABLED (DUE TO XON/XOFF BEING UNAVAILABLE) THEN THE
+/ CONSOLE BAUD RATE MUST MEET OR EXCEED THE REMOTE LINE RATE. THE USER MUST
+/ TAKE MINIMAL CARE NOT TO OVERLOAD THE INTERNAL BUFFERS OF KERMIT-12, AS THIS
+/ WILL YIELD THE ERROR MESSAGE: KEYBOARD INPUT ERROR!
+
+/ THIS IS NOT LIKELY TO OCCUR UNLESS ONE "PLAYS" WITH A KEYBOARD WHICH CAN
+/ GENERATE NUMEROUS ESCAPE SEQUENCES AS THE BUFFERS ARE QUITE ADEQUATE FOR ALL
+/ REASONABLE TERMINAL APPLICATIONS. SIMILARLY, IF THE REMOTE LINE DOES NOT OBEY
+/ XON/XOFF PROTOCOL (WHILE KERMIT-12 HAS IT ENABLED), THEN INTERNAL BUFFER
+/ OVERFLOW WILL YIELD THE ERROR MESSAGE: REMOTE LINE INPUT ERROR!
+
+/ THESE ERRORS ARE EXTREMELY UNLIKELY AND CAN ONLY BE CREATED BY MISUSE OF FLOW
+/ CONTROL (THE ONLY EXCEPTION TO THIS IS THE ATTEMPT TO USE KERMIT-12 WITH THE
+/ CONSOLE BAUD RATE SLOWER THAN THE REMOTE LINE BAUD RATE WITH FLOW CONTROL
+/ DISABLED). IF FLOW CONTROL IS ENABLED AND OBEYED THEN THE BUFFERING OF REMOTE
+/ LINE INPUT WILL OCCUR WHILE SHORT PAUSES OCCUR ON THE CONSOLE (ASSUMING THE
+/ USER FREEZES/UNFREEZES THE DISPLAY OFTEN AND THE CONSOLE DISPLAY BAUD RATE IS
+/ FASTER THAN THE REMOTE LINE BAUD RATE) WITH PRACTICALLY NO REMOTE LINE DELAY.
+
+/ FLOW CONTROL IS NOT YET SUPPORTED DURING KERMIT TRANSFERS. SINCE KERMIT-12
+/ DOES NOT SUPPORT SLIDING WINDOWS, KERMIT-12 WILL NEVER GENERATE OUTGOING
+/ XON/XOFF SEQUENCES. FUTURE REVISIONS WILL SUPPORT INCOMING XON/XOFF FROM THE
+/ REMOTE KERMIT. XON/XOFF PROTOCOL DURING CONNECT MODE IS COMPLETELY AVAILABLE
+/ AT THE USER'S OPTION.
+
+/ CONSOLE TERMINALS ARE REQUIRED TO SUPPORT "GLASS TTY:" FEATURES, I.E. THE
+/ PRINTING ASCII CHARACTER SET (LOWER-CASE DESIRABLE) AND THE CONTROL CHARACTERS
+/ <CR>, <LF>, AND <BEL> (THE LAST FOR VARIOUS AUDIBLE REPORTS ONLY). TERMINALS
+/ LACKING LOWER-CASE SUPPORT SHOULD "FOLD" LOWER-CASE CHARACTERS TO UPPER-CASE
+/ AUTOMATICALLY. TERMINALS SUCH AS THE VT05 CAN HAVE THE KEYBOARD LOWER-CASE
+/ ENABLED, AS KERMIT-12 SUPPORTS OPTIONAL OUTPUT FOLDING. THE UPPER-CASE ONLY
+/ OPTION SHOULD BE ENABLED FOR TERMINALS WHICH IGNORE LOWER-CASE INPUT FROM THE
+/ HOST, AS KERMIT-12 GENERATES NUMEROUS LOWER-CASE MESSAGE CHARACTERS (WHICH
+/ BECOME UPPER-CASE IF THIS OPTION IS SET). THE <BS> CHARACTER IS REQUIRED FOR
+/ VISUAL RUBOUT (<BS> <SPACE> <BS>) ONLY. FUTURE VERSIONS WILL SUPPORT
+/ HARD-COPY BACKSPACE TO REMOVE THIS REQUIREMENT. ALL TERMINAL FEATURES (SUCH
+/ AS ACTUAL VT-100 FUNCTIONALITY) ARE FREELY PASSED TO THE HOST DURING CONNECT
+/ MODE; THE ONLY CHARACTER ACTUALLY RESERVED IS THE ESCAPE CHARACTER WHICH WILL
+/ BE TREATED AS A SEVEN-BIT CHARACTER ONLY. IF THE USER PRESSES THE ESCAPE
+/ CHARACTER TWICE, THEN THE SEVEN-BIT REPRESENTATION OF THE CHARACTER IS SENT
+/ ONCE; THERE IS NO WAY TO SEND THE ESCAPE CHARACTER WITH THE HIGH-BIT SET.
+/ SINCE THE ESCAPE CHARACTER ITSELF CAN BE SET TO ALMOST ANY SEVEN-BIT VALUE,
+/ THIS SHOULD NOT BE A SERIOUS LIMITATION. TERMINALS THAT DON'T "BEEP" WHEN THE
+/ <BEL> CHARACTER IS SENT SHOULD NOT OUTPUT A PRINTABLE RENDITION OF THE <^G>
+/ CHARACTER, AS THIS WOULD DISRUPT THE TERMINAL OUTPUT AND INTERNAL COLUMN COUNT
+/ DURING VARIOUS MESSAGE SEQUENCES, ETC.
+\f/ KL-8/E INTERFACES SHOULD BE SETUP WITH THE FOLLOWING STANDARD SETTINGS:
+
+/ 1 STOP BIT ABOVE 110 BAUD WITH 8 BITS DATA.
+
+/ FUNCTIONAL BAUD RATES INCLUDE 110, 150, 300, 600, 1200, 2400, 4800, 9600,
+/ 19200, 38400 AND 76800. 2400 BAUD REQUIRES A REVISION "B" OR BETTER M8650
+/ MODULE (IF ONE USES DEC'S DOCUMENTATION OF AVAILABLE SPLIT-LUG OPTIONS).
+/ ACTUAL BAUD RATES UP TO APPROXIMATELY 100 KBAUD SHOULD WORK WHEN KERMIT-12
+/ BECOMES INTERRUPT-DRIVEN. RATES OTHER THAN 110 BAUD REQUIRE A 19.6608 MHZ
+/ BAUD-RATE OSCILLATOR.
+
+/ THE BAUD RATES STATED ABOVE ARE ACTUALLY AVAILABLE ON THE KL-8/E, BUT REQUIRE
+/ A SINGLE SOLDER JUMPER TO IMPLEMENT THE PROPER BAUD RATE ABOVE 2400 BAUD.
+/ CHANGING BAUD-RATE GENERATOR CRYSTALS WILL PRODUCE OTHER RATES AS NECESSARY.
+/ (SEND INQUIRIES TO CLA SYSTEMS FOR INFORMATION REGARDING KL-8/E MODIFICATIONS
+/ INCLUDING UPGRADED BAUD-RATE OSCILLATORS, ETC.) KERMIT-12 HAS BEEN TESTED TO
+/ 9600 BAUD AND SHOULD WORK TO 19200 BAUD (AS OF THE CURRENT VERSION).
+
+
+/ KL8-J/A INTERFACES SHOULD BE SETUP WITH THE FOLLOWING STANDARD SETTINGS:
+
+/ 1 STOP BIT ABOVE 110 BAUD WITH 8 BITS DATA NO PARITY.
+
+/ FUTURE VERSIONS OF KERMIT-12 WILL SUPPORT VARIOUS SOFTWARE-GENERATED PARITY
+/ OPTIONS. THE FRAMING AND OVERRUN ERRORS CAN BE ENABLED AND WILL EVENTUALLY BE
+/ SUPPORTED (BUT THE PARITY GENERATOR SHOULD BE DISABLED TO PREVENT INTERACTION
+/ WITH THE SOFTWARE USE OF PARITY GENERATION/DETECTION).
+
+/ ALL BAUD RATES ARE SUPPORTABLE:
+
+/ 110, 150, 300, 600, 1200, 2400, 4800, 9600, 19200.
+
+/ 19200 BAUD IS ACHIEVED BY CUTTING JUMPER "W2" AND ADDING JUMPER "W5" AND THEN
+/ SETTING THE BOARD FOR WHAT IS NORMALLY 9600 BAUD. A WESTERN DIGITAL TR-1602-B
+/ OR EQUIVALENT UART IS REQUIRED TO SUPPORT 19200 BAUD; MOST OF THE RECENT
+/ PRODUCTION DEC M8655 BOARDS USE THE SMC COMM 2017 UART WHICH MEETS OR EXCEEDS
+/ THIS REQUIREMENT. EARLY M8655 BOARDS USE GI UARTS IN CERAMIC PACKAGES WHICH
+/ *CANNOT* BE USED AT 19200 BAUD (MANY ARE FLAKY AT 9600 BAUD!).
+
+/ RECEIVE BAUD RATE SHOULD BE IDENTICAL TO TRANSMIT BAUD RATE. (DO NOT SET THE
+/ RECEIVE=150 BAUD SWITCH!)
+\f/ OTHER INTERFACES:
+
+/ DKC-8/A (8/A OPTION BOARD #1) INTERFACES SHOULD BE SETUP AS PER THE KL8-J/A
+/ SPECIFICATIONS INCLUDING THE REQUIREMENTS OF THE UART. SOME DEC DOCUMENTATION
+/ INDICATED A PROHIBITION ON THE USE OF 19200 BAUD, BUT THIS IS OBVIATED BY THE
+/ USE OF THE SAME UARTS AS IN THE KL8-J/A.
+
+/ EARLIER DEVICES SUCH AS PT08, DP-12, KL-8/F OR DC02 (CHANNEL ZERO ONLY) SHOULD
+/ WORK CORRECTLY AS FACTORY WIRED (MOST OF THESE DEVICES DO NOT SUPPORT OPTIONS
+/ KERMIT-12 WOULD REQUIRE TO BE DISABLED ANYWAY. THESE INCLUDE PARITY
+/ GENERATION, FRAMING ERROR DETECTION, ETC.). TO UTILIZE THESE DEVICES, THE
+/ ASSEMBLY PARAMETERS FOR USER DEVICES AND THEIR RESPECTIVE DEVICE CODE VALUES
+/ SHOULD BE GIVEN DURING ASSEMBLY (SEE ASSEMBLY INSTRUCTIONS). PROPER DEVICE
+/ CODE VALUES MUST BE OBTAINED FOR THE SELECTED INTERFACE, AS THERE ARE MANY
+/ ACTUAL POSSIBILITIES. (DP-12 DEVICES ARE GENERALLY DEVICE 40/41; PT08/DC02
+/ INTERFACES ARE GENERALLY DEVICE 11/12, ETC.)
+\f/ ASSEMBLY INSTRUCTIONS.
+
+/ KERMIT-12 CAN BE ASSEMBLED BY EITHER OF TWO METHODS:
+
+
+/ P?S/8 METHOD:
+
+/ ASSUMING THE EXTENDED-LENGTH FILE KERM12 IS THE SOURCE FILE, THE FOLLOWING
+/ COMMAND WILL PRODUCE A FULLY ORNAMENTED LISTING:
+
+/ .PAL KB1,KB2,KB3,KB4<KERM12(ACEJLMNPQSX8)
+
+/ OPTION SWITCH BREAKDOWN:
+
+/ /A ALL SYMBOLS IN SYMBOL PRINTOUT.
+
+/ /C OPTIMIZE CORE DURING ASSEMBLY FOR MORE SYMBOLS, LESS BUFFERS.
+/ THIS OPTION SHOULD BE DELETED IF MORE THAN 8K IS AVAILABLE FOR
+/ ASSEMBLY.
+
+/ /E FORGET LITERAL BOUNDARIES WHEN LEAVING THE CURRENT PAGE.
+
+/ /J *DO NOT* TERMINATE TEXT STRINGS WITH EXTRA ZERO WORD.
+
+/ /L PERFORM SECOND-PASS LISTING.
+
+/ /M CHAIN TO MAP FOR BITMAP OUTPUT AT END OF ASSEMBLY.
+
+/ /N ENABLE NEATNESS ADORNMENTS TO LISTING OUTPUT.
+
+/ /P ENABLE PRINTER-ORIENTED (WIDE MODE) LISTING OUTPUT.
+
+/ /Q ENABLE LITERALS ONLY, GENERATED LINKS ARE ERRORS.
+
+/ /S ENABLE SYMBOL TABLE PRINTOUT.
+
+/ /X ENABLE CROSS-REFERENCE OUTPUT AT END OF ASSEMBLY.
+
+/ /8 ENABLE FULL SYMBOL TABLE INCLUDING LINC MODE CROSS ASSEMBLY.
+
+/ THE NUMBER OF BINARY FILES REQUIRED (KB1, KB2, KB3, ETC.) IS TO BE DETERMINED
+/ AT ASSEMBLY TIME, AS KERMIT-12 WILL TEND TO GROW LARGER AS FEATURES ARE ADDED.
+
+/ P?S/8 PAL IS THE PREFERRED METHOD OF ASSEMBLING K12MIT DURING DEVELOPMENT DUE
+/ TO SUPERIOR ERROR DIAGNOSTICS AND OVERALL SPEED. K12MIT COULD GROW TO A SIZE
+/ BEYOND THE CAPABILITIES OF OS/8 CREF. THIS LIMITATION CANNOT APPLY TO THE
+/ P?S/8 DEVELOPMENT ENVIRONMENT.
+
+/ P?S/8 PAL CAN PRODUCE A LISTING OF K12MIT, BUT THE BINARY FILES CREATED BY THE
+/ ASSEMBLY MUST BE TRANSFERRED TO AN OS/8 ENVIRONMENT FOR USE, SINCE K12MIT (AS
+/ SPECIFICALLY WRITTEN) IS FOR THE OS/8 FAMILY OF SYSTEMS ONLY.
+
+/ NOTE: P?S/8 IS *NOT* A DEC PRODUCT; IT IS SOLD COMMERCIALLY AND IS AVAILABLE
+/ FREE OF CHARGE (EXCEPT FOR MEDIA HANDLING CHARGES, ETC.) *ONLY* TO QUALIFIED
+/ INSTITUTIONS. CONTACT CJL FOR ADDITIONAL INFORMATION ON ACQUIRING P?S/8.
+\f/ OS/8 FAMILY OF SYSTEMS METHOD:
+
+/ K12MIT.PA CAN BE ASSEMBLED WITH PAL8 VERSION B0 WHICH IS AVAILABLE FROM DECUS
+/ AS PART OF THE OS/278 RELEASE. PAL8 VERSION B0 WILL RUN ON ANY OS/8 FAMILY
+/ SYSTEM, AS IT HAS NO HARDWARE DEPENDENCIES BEYOND THE ORIGINAL PDP-8
+/ REQUIREMENT (NO BSW OR IAC ROTATE OR CAF OR R3L INSTRUCTIONS AS WAS INTENDED).
+/ THIS ALSO APPLIES TO CREF VERSION B0 WHICH IS REQUIRED WHEN A CROSS-REFERENCE
+/ IS REQUESTED. PAL8 VERSION B0 AND CREF VERSION B0 ARE AVAILABLE AS PART OF
+/ THE KERMIT-12 DISTRIBUTION AS K12PL8.ENC AND K12CRF.ENC RESPECTIVELY. SEE THE
+/ DOCUMENTATION OF K12DEC FOR INFORMATION ON PRODUCING PAL8.SV AND CREF.SV FROM
+/ THESE ENCODED FILES.
+
+/ ASSUMING CCL IS ENABLED, THE FOLLOWING COMMAND WILL PRODUCE A BINARY AND FULLY
+/ ORNAMENTED LISTING:
+
+/ .PAL DEV:K12MIT.BN,DEV:K12MIT.LS,DEV:KSCR.TM<DEV:PARAM.PA,DEV:K12MIT.PA(CEFMW)
+
+/ DEV: IS THE APPLICABLE DEVICE WHERE THE FILES RESIDE. STANDARD EXTENSIONS
+/ ARE ASSUMED (.BN FOR BINARY, .LS FOR LISTING, .PA FOR PAL SOURCE). THE
+/ KSCR.TM TEMPORARY OUTPUT FILE SPECIFICATION IS OPTIONAL, BUT IS DEFAULTED TO
+/ SYS:CREFLS.TM IF NOT EXPLICITLY GIVEN. MANY SYSTEM DEVICES ARE TOO SMALL TO
+/ SUPPORT THIS TEMPORARY FILE, THUS THE FILE MAY BE DIRECTED TO ANOTHER
+/ AVAILABLE DEVICE WITH SUFFICIENT SPACE.
+
+/ THE PARAM.PA FILE IS OPTIONAL AND USED TO PASS SHORT USER PARAMETERS, ETC. TO
+/ THE ASSEMBLY.
+
+/ OPTION SWITCH BREAKDOWN:
+
+/ /C CHAIN TO CREF.SV TO PRODUCE A CROSS-REFERENCED LISTING FILE.
+
+/ /E GENERATED LINKS ARE ERRORS.
+
+/ /F *DO NOT* TERMINATE TEXT STRINGS WITH EXTRA ZERO WORD.
+
+/ /M USE MAMMOTH SYMBOL TABLE OPTION FOR CREF.
+
+/ /W FORGET LITERAL BOUNDARIES WHEN LEAVING THE CURRENT PAGE.
+
+/ LOADING INSTRUCTIONS:
+
+/ .LOAD DEV:K12CLR,K12MIT.BN THIS LOADS THE BINARY CLEAR AND KERMIT
+/ .SAVE DEV K12MIT.SV=1 THIS SAVES THE CORE IMAGE
+
+/ THE JOB STATUS WORD (=1) INDICATED THAT K12MIT.SV LOADS INTO 10000-11777, BUT
+/ SHOULD NOT BE SAVED/RESTORED WHEN THE USR IS LOADED OVER THIS AREA OR
+/ DISMISSED (THE USR IS ACTUALLY NEVER DISMISSED IN NORMAL K12MIT OPERATION).
+/ OTHER BITS MAY BE SET AT THE USER'S OPTION, BUT ARE UNNECESSARY; THE BIT
+/ INDICATED SERVES ONLY TO REDUCE SYSTEM OVERHEAD REGARDING THE DISPOSITION OF
+/ 10000-11777. THE BINARY FILE K12CLR.BN (CREATED BY ASSEMBLING K12CLR.PA)
+/ LOADS ZEROES INTO ALL OF MEMORY TO CREATE A "CLEAN" CORE IMAGE FILE, WHICH
+/ MAKES THE ENCODED BINARY FILE SMALLER DUE TO REPEAT COMPRESSION.
+\f/ PASSING SHORT PARAMETER FILES.
+
+/ WHEN INSERTING A SHORT USER MODIFICATION FILE IN THE INPUT STREAM (PARAM.PAL)
+/ THE FOLLOWING SHOULD BE NOTED:
+
+/ ALWAYS PUT THE SHORT PARAMETER FILE (CONTAINING EQUATED SYMBOLS SUCH AS
+/ USER=1, ETC.) IN FRONT OF K12MIT.PAL.
+
+/ IF TTY: IS USED FOR DIRECT TYPE-IN OF THESE PARAMETERS, THE INFORMATION NEED
+/ ONLY BE TYPED ENDING WITH <^Z> DURING PASS 1. SUBSEQUENT PASSES REQUIRE THE
+/ ENDING <^Z> ONLY. IF THIS METHOD IS USED, A LISTING WITHOUT THE USER INPUT
+/ WHICH DID THE CUSTOMIZING OF KERMIT-12 CAN BE CREATED. NOTE: IF BINARY IS
+/ GENERATED BY THE CONTENTS OF THE PARAMETER FILE (SUCH AS USE OF THE LOCAL TEXT
+/ MESSAGE, ETC.), THE INFORMATION MUST BE TYPED IN DURING PASS 2. THE PASS 3
+/ LISTING MAY CONTAIN THE INFORMATION IF SO DESIRED, REQUIRING A REPETITION OF
+/ THE INPUT. PASS 1 INPUT OF THE INFORMATION IS EFFECTIVELY IGNORED, AS NO
+/ DEFINITIONS ARE CREATED ('LCLMSG' IS DEFINED ELSEWHERE, ETC.).
+
+/ EXPERIENCED PDP-8 USERS NEW TO PAL8 VERSION B0 TAKE SPECIAL NOTICE:
+
+/ DUE TO HARDWARE LIMITATIONS OF THE DECMATES, THE KEYBOARD FLAG WILL BE CLEARED
+/ DURING PDP-8 PAL8 B0 OPERATION. THE KL8E TTY: HANDLER WILL NO LONGER BE ABLE
+/ TO BUFFER <^Z> DURING THE ASSEMBLY; YOU MUST WAIT UNTIL THE HANDLER ACCESSES
+/ THE KEYBOARD ON EACH PASS *THEN* PRESS <^Z> TO CONTINUE THE ASSEMBLY.
+
+
+/ CREATING A CUSTOM MESSAGE FROM THE PARAMETER FILE.
+
+/ IF SO DESIRED, A CUSTOM LOCAL HEADER MESSAGE MAY BE ADDED BY INSERTING THE
+/ FOLLOWING INTO THE PARAMETER FILE:
+
+/ BUFFLD= 10 /THESE PROBABLY
+/ FILBUFF=2000 /WON'T CHANGE!
+
+/ GENMSG= 0 /DON'T GENERATE STANDARD (NULL) MESSAGE
+/ UMSG= 0 /DON'T GENERATE STANDARD (DUMMY) USER MESSAGE
+
+/ FIELD BUFFLD%10 /FIELD FOR TEXT MESSAGE
+
+/ *FILBUFFER /LOCAL MESSAGE LOADS THERE
+
+/LCLMSG,TEXT "%^I^NSERT ^L^OCAL ^M^ESSAGE ^H^ERE!%"
+
+/ ZBLOCK LCLMSG+40-. /ZERO REST OF MESSAGE AREA
+
+/ TEXT IS IN UPPER/LOWER-CASE SIXBIT WITH '^' MEANING SHIFT CASE (INITIALLY
+/ LOWER-CASE) AND '%' MEANING <CR>, <LF>.
+\f/ OTHER METHODS:
+
+/ KERMIT-12 *CANNOT* BE ASSEMBLED BY PAL10 (LAST KNOWN VERSION OF PDP-8
+/ CROSS-ASSEMBLER FOR TOPS10 (142)) BECAUSE IT LACKS CERTAIN FEATURES:
+
+/ DOES NOT SUPPORT 'RELOC' PSEUDO-OP.
+
+/ DOES NOT SUPPORT PAGE ZERO REDEFINE (CAUSES "Z" ERROR ON SOURCE FILES WHICH
+/ DON'T HAVE ERRORS WHEN ASSEMBLED BY EITHER P?S/8 PAL OR OS/8 PAL8).
+
+/ INCORRECTLY HANDLES 'ZBLOCK' PSEUDO-OP (LEADS TO "Q" ERROR ON SOURCE FILES
+/ WHICH DON'T HAVE ERRORS WHEN ASSEMBLED BY EITHER P?S/8 PAL OR OS/8 PAL8).
+
+/ DOES NOT SUPPORT LITERAL "FORGETTING" (P?S/8 PAL OPTION /E OR OS/8 PAL8 OPTION
+/ /W) WHICH IS REQUIRED FOR DEFINING OVERLAY AREAS, ETC.
+
+/ DOES NOT SUPPORT TEXT WITHOUT ZERO WORD FILL (P?S/8 PAL OPTION /J OR OS/8 PAL8
+/ OPTION /F FULFILLS THIS REQUIREMENT) WHICH IS REQUIRED FOR TEXT MESSAGES.
+
+
+/ P?S/8 PAL IS AN IMPROPER SUPERSET OF PAL10. PAL10 SUPPORTS MACRO-8 MODE AS AN
+/ OPTION AND AUTOMATIC FIELD DUMP BITMAPS; ALL OTHER KNOWN PAL10 FEATURES EXIST
+/ IN P?S/8 PAL INCLUDING THE SUPPORT OF THE AUTOMATIC FIELD DUMP BITMAP
+/ PSEUDO-OPS ('ENBITS' AND 'NOBITS').
+
+/ OS/8 PAL8 (VERSION B0) IS A SUBSET OF P?S/8 PAL WHICH HAS SEVERAL SYNTACTIC
+/ QUIRKS (WHICH ARE AVOIDABLE, BUT NONETHELESS ARE INCOMPATIBLE WITH BOTH P?S/8
+/ PAL AND PAL10 IN CERTAIN MINOR WAYS); REGARDLESS, PAL8 LACKS THE
+/ COMPATIBILITY PROBLEMS OF PAL10.
+
+/ MAINTAINING SOURCE COMPATIBILITY.
+
+/ KERMIT-12 SOURCE FILE CONVENTIONS DEMAND THE USE OF THE COMMON SUBSET OF P?S/8
+/ PAL AND OS/8 PAL8 (VERSION B0). CERTAIN FORMS OF STATEMENTS SHOULD BE
+/ AVOIDED:
+
+/ TAD /NOT LEGAL IN PAL8
+/ 0+TAD /NOT LEGAL IN PAL10, AND POSSIBLY WRONG IN PAL8
+/ TAD (3)+1 /GENERATES SAME AS "TAD (3+1)" IN PAL8
+/ -A!-B /UNARY OPERATOR HANDLED WRONG IN PAL8
+/ I+N /NOT LEGAL IN PAL8
+/ N+I /NOT LEGAL IN PAL8
+/ I I /NOT LEGAL IN PAL8
+
+/ THIS REQUIREMENT IS EASILY MET BY KERMIT-12 AS MOST OF THESE CASES ARE
+/ ESOTERIC QUIRKS AND NOT NEEDED FOR THIS ASSEMBLY.
+
+/ THE RESTRICTIONS OF PAL10 (EVEN THOUGH IT HAS OTHER DESIRABLE FEATURES, MOST
+/ OF WHICH IT SHARES WITH P?S/8 PAL) ARE TOO SEVERE TO ALLOW USABLE ASSEMBLY OF
+/ THIS PROGRAM. BETTER CROSS-ASSEMBLERS MAY EXIST ELSEWHERE WHICH ARE
+/ SOURCE-COMPATIBLE WITH KERMIT-12.
+\f/ USE OF P?S/8 LANGUAGE EXTENSIONS.
+
+/ P?S/8 OFFERS SEVERAL USEFUL FEATURES OVER PAL8 (AND PAL10) WHICH MAY BE USEFUL
+/ FOR ASSEMBLY DEVELOPMENT OF KERMIT-12. THESE INCLUDE LANGUAGE ELEMENTS SUCH
+/ AS "TAD (3)+1" HANDLED CORRECTLY, OR PSEUDO-OPS SUCH AS "PAUSE EXPR" WHERE THE
+/ VALUE OF 'EXPR' WILL BE DISPLAYED ON THE SYSTEM CONSOLE DURING THE ASSEMBLY
+/ WHEN THAT POINT IN THE ASSEMBLY IS REACHED. TO ACCESS THESE FEATURES AND
+/ STILL PROVIDE COMPATIBILITY WITH PAL8 (VERSION B0), THE FOLLOWING CODING
+/ TECHNIQUE IS SUGGESTED:
+
+
+/ IFNDEF PQS <PQS=0> /WILL BE 0 ON PAL8, PAL10
+
+
+/ IFZERO PQS < /DO PAL8, ETC. STUFF HERE
+
+/ FOO= (TABLE) /DEFINE POINTER TO ADDRESS OF TABLE
+
+/ TAD FOO-1 /GET (POINTER TO ADDRESS OF TABLE)-1
+/ DCA XR1 /SETUP AUTO-INDEX REGISTER
+
+/ WISH WE HAD PAUSE AND ERROR PSEUDO-OPS IN PAL8.
+
+/ > /END OF PAL8, ETC. VARIANT
+
+
+/ IFNZRO PQS < /DO P?S/8 PAL STUFF HERE
+
+/ TAD (TABLE)-1 /GET (POINTER TO ADDRESS OF TABLE)-1
+/ DCA XR1 /SETUP AUTO-INDEX REGISTER
+
+/ IFNDEF PASS <PASS=0>/DEFINE PASS VARIABLE
+
+/ PASS= PASS+1 /BUMP EVERY ASSEMBLER PASS
+
+/ PAUSE PASS /DISPLAY PASS NUMBER
+
+/ IFNZRO .&4000 <
+
+/ ERROR 1234 /DISPLAY ERROR MESSAGE IF THERE ARE PROBLEMS
+
+/ >
+
+/ > /END OF P?S/8 PAL VARIANT
+
+
+/ THIS ALLOWS TEMPORARY DEVELOPMENT FEATURES OR PERMANENT ELEMENTS WHICH MAY BE
+/ MORE ELEGANTLY EXPRESSED IN P?S/8 PAL VARIANT CODING, WHILE THE PAL8 (VERSION
+/ B0) VERSION CAN STILL BE USED (VIA DIRECT OCTAL, MULTIPLE EQUATE STATEMENTS,
+/ CONDITIONAL FLUSH AS IN THE ABOVE EXAMPLE, ETC. AS NECESSARY) FOR STANDARD
+/ ASSEMBLY OF KERMIT-12.
+\f/ ASSEMBLY PARAMETERS.
+
+/ SEVERAL PARAMETERS MUST BE CHANGED WITHIN K12MIT.PA (OR PASSED TO THE
+/ ASSEMBLER VIA A SHORT FILE INSERTED INTO THE ASSEMBLY STREAM BEFORE THE MAIN
+/ FILE):
+
+/ SETTING KEY= [RECEIVE IOT CODE FOR CONSOLE KEYBOARD] DEFINES THE CONSOLE
+/ KEYBOARD IOT CODE (DEFAULT IS 03).
+
+/ SETTING TTY= [TRANSMIT IOT CODE FOR CONSOLE OUTPUT] CHANGES THE CONSOLE
+/ PRINTER IOT CODE (DEFAULT IS 04).
+
+/ THE FOLLOWING DEFINITIONS ARE ESSENTIALLY FOR KL8-TYPE DEVICES ONLY, AS THE
+/ CODE DEMANDS KL8 HARDWARE COMPATIBILITY. MODELS OTHER THAN PDP-8 (SUCH AS
+/ DECMATE) GENERALLY EITHER PLACE RESTRICTIONS ON AVAILABLE INTERFACES (OTHER
+/ SOFTWARE DESIGNATES A SERIAL INTERFACE AS A LOGICAL PRINTER PORT; DECMATES
+/ SUPPORT A FIRMWARE "PRINT SCREEN" KEY WHICH ENFORCES THIS.), OR DON'T ALLOW
+/ USABLE PLUG-IN OPTIONS.
+
+/ IGNORING BUILT-IN DECMATE SUPPORT, THE FOLLOWING PARAMETERS ARE ACTIVE:
+
+/ SETTING DEV30= 1 CREATES DEVICE 30/31 REMOTE LINE IOTS.
+
+/ SETTING DEV40= 1 CREATES DEVICE 40/41 REMOTE LINE IOTS.
+
+/ SETTING LEDERLE=1 CREATES DEVICE 43/44 REMOTE LINE IOTS (AND A CUSTOM
+/ HEADER).
+
+/ SETTING ORIGNAL=1 CREATES DEVICE 33/34 REMOTE LINE IOTS (ORIGINAL
+/ SETTINGS).
+
+/ SETTING SPRINT= 1 CREATES DEVICE 32/33 REMOTE LINE IOTS (SERIAL PRINTER
+/ PORT).
+
+/ SETTING USER= 1 CREATES DEVICE XX/XY REMOTE LINE IOTS.
+
+/ IF NONE OF THESE ARE SET, THEN DEV40=1 APPLIES BY DEFAULT.
+
+
+
+/ SETTING USER= 1 REQUIRES THE USER TO DEFINE TWO ADDITIONAL VALUES:
+
+/ XX= [RECEIVE IOT DEVICE CODE] (DEFAULT IS 40).
+
+/ XY= [TRANSMIT IOT DEVICE CODE] (DEFAULT IS 41).
+\f/ SETTING SPRINT= 1 INHIBITS THE BUILT-IN CHECK FOR DECMATE OPERATION AND
+/ USES THE SERIAL PRINTER PORT FOUND ON ALL
+/ WPS-8-CONFIGURED PDP-8/E, PDP-8/A CONFIGURATIONS,
+/ VT-78, AND ALL DECMATES (VT-278, DECMATE II, III,
+/ III+) FOR REMOTE COMMUNICATIONS.
+
+/ THE USE OF THE SERIAL PRINTER PORT FOR REMOTE COMMUNICATIONS PURPOSES MAY BE
+/ PROBLEMATIC DUE TO CONSIDERATIONS SUCH AS THE RS-232 CONNECTION TO THE PRINTER
+/ IS A MODEM (DCE), RATHER THAN A TERMINAL (DTE) (DECMATE II, ETC. REQUIRES A
+/ GENDER CHANGER.), OR THE SOFTWARE DESIGNATION OF THE PORT AS BEING ALLEDGEDLY
+/ *ONLY* FOR A PRINTER, SUCH AS WHEN CERTAIN SYSTEMS SUPPORT THE "PRINT SCREEN"
+/ KEY AS A SCREEN DUMP TO THE SERIAL PRINTER PORT, ETC. THESE ISSUES ARE NOT
+/ RELEVANT TO KERMIT-12 OPERATION, AS THE "PRINT SCREEN" KEY IS NOT SUPPORTED BY
+/ KERMIT-12 IN THIS CONFIGURATION AS SUCH (FUTURE VERSIONS COULD REDEFINE THE
+/ "PRINT SCREEN" KEY TO SUCH FUNCTIONS AS DUMP SCREEN TO A FILE, ETC.).
+
+/ SETTING BRATE= NN SETS THE DEFAULT BAUD RATE (FOR SYSTEMS THAT SUPPORT
+/ THIS FEATURE) FROM A TABLE OF VALUES (0-15) AS
+/ FOLLOWS:
+
+/ NN BAUD RATE
+
+/ 00 50
+/ 01 75
+/ 02 110
+/ 03 134.5
+/ 04 150
+/ 05 300
+/ 06 600
+/ 07 1200
+/ 08 1800
+/ 09 2000
+/ 10 2400
+/ 11 3600
+/ 12 4800
+/ 13 7200
+/ 14 9600
+/ 15 19200
+
+/ SETTING ESCAPE= NNNN SETS THE DEFAULT ESCAPE CHARACTER TO NNNN.
+
+/ SETTING FLOW= 1 ENABLES FLOW-CONTROL BY DEFAULT.
+/ SETTING FLOW= 0 DISABLES FLOW-CONTROL BY DEFAULT.
+
+/ SETTING FMODE= 0177 SETS THE DEFAULT FILE MODE TO ASCII.
+/ SETTING FMODE= 4377 SETS THE DEFAULT FILE MODE TO BINARY.
+\f/ SETTING GENMSG= 0 CAUSES NO BINARY TO BE GENERATED WHERE 'LCLMSG' IS
+/ DEFINED. THIS ALLOWS THE PARAMETER FILE (PARAM.PA) OR
+/ SUBSEQUENT OVERLAY BY K12PCH.BN TO DEFINE THE LOCAL
+/ HEADER MESSAGE. THIS PARAMETER SHOULD NOT BE SET
+/ UNLESS ONE OF THESE METHODS IS USED, ELSE THE HEADER
+/ MESSAGE WILL BE UNDEFINED. (NOTE: IF K12PCH.BN
+/ GENERATES A HEADER MESSAGE, THEN THIS PARAMETER IS
+/ UNIMPORTANT, AS K12PCH.BN OVERLAYS THE BINARY OF
+/ K12MIT.)
+/ SETTING GENMSG= 1 CAUSES A HEADER MESSAGE TO BE GENERATED. THE CONTENTS
+/ OF THE MESSAGE ARE CREATED BY SETTING LEDERLE=1 OR
+/ UMSG=1. IF EITHER IS ZERO, A DEFAULT (NULL) MESSAGE
+/ WILL BE GENERATED.
+
+/ SETTING ICLOSE= 1 ENSURES A <^Z> AT <EOF> OF ASCII INPUT FILES BY
+/ DEFAULT.
+/ SETTING ICLOSE= 0 CLOSES ASCII INPUT FILES AS RECEIVED BY DEFAULT.
+
+/ SETTING INIECHO=0 CAUSES A FULL-DUPLEX CONNECT MODE STATE WITH NO LOCAL
+/ CHARACTER ECHOING BY DEFAULT.
+/ SETTING INIECHO=1 CAUSES A HALF-DUPLEX CONNECT MODE STATE WITH LOCAL
+/ ECHO OF ALL CONSOLE CHARACTERS BY DEFAULT.
+
+/ SETTING LOWER= 0 ALLOWS LOWER-CASE CONSOLE OUTPUT BY DEFAULT.
+/ SETTING LOWER= -40 FOLDS LOWER-CASE CONSOLE OUTPUT TO UPPER-CASE BY
+/ DEFAULT.
+
+/ SETTING OCLOSE= 0 PREVENTS DEFAULT SENDING OF <^Z> AT <EOF> OF ASCII
+/ FILES.
+/ SETTING OCLOSE= 1 CAUSES <^Z> TO BE SENT AT <EOF> OF ASCII FILES BY
+/ DEFAULT.
+
+/ SETTING PORT= 0 CAUSES THE DP-278 PORT 0 TO BE USED IF KERMIT-12 IS
+/ RUN ON A DECMATE 1 (ASSUMING SPRINT=0).
+/ SETTING PORT= 1 CAUSES THE DP-278 PORT 1 TO BE USED IF KERMIT-12 IS
+/ RUN ON A DECMATE 1 (ASSUMING SPRINT=0).
+
+/ SETTING RETCNT= NNNN SETS THE PACKET RETRY COUNT TO NNNN BY DEFAULT.
+/ SETTING UMSG= 0 PREVENTS THE LOCAL USER HEADER MESSAGE FROM BEING
+/ GENERATED.
+/ SETTING UMSG= 1 CAUSES THE LOCAL USER HEADER MESSAGE TO BE GENERATED.
+/ THE PARAMETER GENMSG=1 IS REQUIRED TO BE SET. THE
+/ SOURCE MUST BE MODIFIED LOCALLY TO CHANGE THE MESSAGE
+/ TEXT FROM "INSERT LOCAL USER MESSAGE HERE!," AS THIS
+/ IS THE DEFAULT CONTENTS.
+\f/ KERMIT-12 FOR THE FAMILY OF 12-BIT DEC MACHINES.
+
+/ BRIEF USAGE DESCRIPTION.
+
+/ KERMIT-12 IS AN IMPLEMENTATION OF THE KERMIT PROTOCOL FOR THE FAMILY OF 12-BIT
+/ DEC (AND COMPATIBLE) MACHINES GENERALLY KNOWN AS PDP-8 OR DECMATE.
+
+/ AS OF THE CURRENT IMPLEMENTATION, THE FOLLOWING COMMANDS ARE EFFECTIVE:
+
+/ 1. CONNECT (TO REMOTE SYSTEM AS TERMINAL).
+
+/ 2. SEND FILESPEC (TO REMOTE RECEIVER OR SERVER).
+
+/ 3. RECEIVE FILESPEC (FROM REMOTE SENDER).
+
+/ 4. GET FILESPEC (FROM REMOTE SERVER).
+
+/ 5. FINISH (SERVING).
+
+/ 6. SETUP (ON DECMATE II/III/III-PLUS ONLY). **** NOT IMPLEMENTED ****
+
+/ 7. EXIT (TO OPERATING SYSTEM).
+
+/ 8. HELP (DISPLAYS HELP MESSAGE).
+
+/ FILESPEC MAY BE ANY LOCAL (OS/8) FILE-STRUCTURED DEVICE:FILENAME.EXTENSION,
+/ WHERE THE FILENAME AND EXTENSION WILL BE TRUNCATED TO 6 ALPHANUMERICS AND 2
+/ ALPHANUMERICS RESPECTIVELY, AS NECESSARY (THIS IS REFERRED TO AS 6.2 FILENAME
+/ FORMAT). THE DEVICE: FIELD IS OPTIONAL; ALL COMMANDS USING THE DEVICE:
+/ FIELD FOR LOCAL DEVICE SPECIFICATION WILL USE THIS DEVICE AS THE SOURCE OR
+/ DESTINATION AS NECESSARY FOR THE LOCAL FILES. IF THE DEVICE: FIELD IS
+/ OMITTED, THE DEFAULT DEVICE DSK: WILL BE USED. THE ACTUAL DEVICE USED MAY BE
+/ SELECTED BEFORE INVOKING KERMIT-12 BY USING THE OS/8 ASSIGN COMMAND:
+
+/ .ASSIGN DEV DSK
+
+/ WHERE DEV IS ANY AVAILABLE FILE-STRUCTURED DEVICE.
+
+/ KERMIT-12 USES AN UNUSUAL SCHEME FOR ITS PROMPT: THE ACTUAL DEFAULT PROMPT
+/ TEXT IS PARTIALLY TAKEN FROM THE ACTUAL MACHINE KERMIT-12 IS CURRENTLY
+/ EXECUTING ON. FOR EXAMPLE, IF KERMIT-12 HAS DETERMINED THE CPU TYPE AS
+/ PDP-8/E, THE PROMPT WILL BE:
+
+/ KERMIT-8/E>
+
+/ THIS ALLOWS KERMIT-12 USERS (WITH DIFFERENT CPU-TYPE MACHINES) TO DISTINGUISH
+/ MESSAGES ORIGINATING FROM THE RESPECTIVE SYSTEMS. FUTURE VERSIONS WILL
+/ SUPPORT USER PROMPT STRINGS TO ALLOW MORE DISTINCTIVE SYSTEM MESSAGES.
+
+/ THE HELP OR CONNECT COMMANDS MAY BE USED TO DETERMINE THE CURRENT CONNECT MODE
+/ ESCAPE CHARACTER.
+\f/ COMMAND RESTRICTIONS.
+
+/ THE SEND COMMAND ALLOWS DEVICE:FILENAME.EXTENSION (6.2) WITH WILD-CARD
+/ SUBSTITUTION. A * MAY BE GIVEN FOR AN ENTIRE FIELD (EITHER FILENAME OR
+/ EXTENSION OR BOTH) ONLY. A ? WILL MATCH ANY SINGLE CHARACTER WHICH MUST
+/ EXIST IN THE ACTUAL FILENAME OR EXTENSION, UNLESS RIGHT-MOST IN THE FIELD.
+/ ALL MATCHING FILES WILL BE SENT. NO OUTBOUND FILENAME (AS-NAME) FACILITY
+/ EXISTS AT THIS TIME.
+
+/ THE RECEIVE COMMAND ALLOWS OPTIONAL DEVICE: ONLY. *THE FILENAME AND
+/ EXTENSION ARE NOT ALLOWED*. NAMES OF RECEIVED FILES WILL BE MODIFIED IF
+/ NECESSARY TO CONFORM TO THE 6.2 FORMAT. *IMPLEMENTATION RESTRICTION* :
+/ CERTAIN REMOTE FILENAMES CONTAINING NON-ALPHANUMERIC CHARACTERS MAY CAUSE
+/ KERMIT-12 TO HASTILY ABORT THE TRANSMISSION AND RETURN TO COMMAND LEVEL.
+
+/ THE GET COMMAND ALLOWS OPTIONAL DEVICE: TO DETERMINE DESTINATION OF THE
+/ INCOMING FILES. THE OUTBOUND FILESPEC MUST CONFORM TO LOCAL CONVENTIONS
+/ (FILENAME AND EXTENSION ARE NOT LIMITED TO 6.2 FORMAT; THE DEVICE: FIELD
+/ WILL NOT BE SENT TO THE REMOTE KERMIT UNLESS IT IS ILLEGAL WITHIN OS/8
+/ SPECIFICATIONS, SUCH AS TOO MANY DEVICE LETTERS. IN THIS CASE, THE DEFAULT
+/ DEVICE DSK: APPLIES, AND THE ENTIRE "DEVICE" FIELD IS SENT ALONG WITH ANY
+/ FILENAME AND EXTENSION). CERTAIN REMOTE SYSTEMS ARE INCOMPATIBLE WITH THIS
+/ IMPLEMENTATION, AS IMBEDDED SPACES OR NON-ALPHANUMERIC CHARACTERS ARE NOT
+/ ALLOWED, EVEN THOUGH THEY MAY BE REQUIRED ON THE REMOTE SYSTEM. WILD-CARD
+/ CHARACTERS ARE ALLOWED, BUT ONLY AS SPECIFIED IN THE SEND COMMAND ABOVE.
+
+/ <^X> OR <^Z> CAN BE USED TO ABORT KERMIT TRANSMISSIONS (EVENTUALLY) BUT IS
+/ NORMALLY A SLOW PROCESS, SINCE THE CHECKING IS DONE BY A SOFTWARE TIMEOUT
+/ SCHEME. AT THE PRESENT TIME, THERE IS NO DISTINCTION BETWEEN THESE THO
+/ CHARACTERS, SO IT IS NOT POSSIBLE TO ABORT A SINGLE FILE; THE ENTIRE BATCH OF
+/ FILES INVOLVED IN THE TRANSFER IS ABORTED.
+
+/ DECMATE II/III/III-PLUS CONSIDERATIONS:
+
+/ FUNCTION KEYS SEND <ESC> SEQUENCES SPECIFIED BY SLUSHWARE/FIRMWARE. ALL SOFT
+/ FUNCTION KEYS ARE THEREFORE INEFFECTIVE (EXCEPT FOR HOLD SCREEN WHICH ALWAYS
+/ WORKS).
+
+/ CONNECT MODE RUNS IN 8-BIT MODE.
+
+/ THE COMPOSE KEY IS ENABLED FOR USE WITH A LOADED COMPOSE TABLE.
+
+/ ANY VALID DECMATE II/III/III-PLUS CHARACTER SET IS ALLOWED WHILE IN CONNECT
+/ MODE (MCS TCS LINE, ETC.). ALL <ESC> SEQUENCES ARE PASSED TO THE
+/ SLUSHWARE/FIRMWARE UNMODIFIED.
+
+/ KEYBOARD UPPER-CASE LOCK WILL ALWAYS BE AUTOMATICALLY APPLIED UPON RETURN FROM
+/ CONNECT MODE.
+\f/ DEFINITIONS. /017 CJL
+
+ *200 /FOR DEFINITIONS /047 CJL
+
+/ REMOTE LINE PARAMETERS; SET ONLY ONE AS NECESSARY. /046 CJL
+
+ IFNDEF DEV30 <DEV30= 0> /USE DEVICE 30/31 VALUES
+ IFNDEF DEV40 <DEV40= 0> /USE DEVICE 40/41 VALUES
+ IFNDEF LEDERLE <LEDERLE=0> /USE LEDERLE LABS VALUES
+ IFNDEF ORIGNAL <ORIGNAL=0> /USE ORIGINAL VALUES
+ IFNDEF SPRINT <SPRINT=0> /USE DEVICE 32/33 VALUES
+ IFNDEF USER <USER= 0> /USE USER-DEFINED VALUES
+
+ REMOTE= DEV30+DEV40+LEDERLE+ORIGNAL /SET REMOTE LINE IOT CODE
+ REMOTE= REMOTE+SPRINT+USER /SET REMOTE LINE IOT CODE
+
+ IFZERO REMOTE <DEV40= 1> /DEFAULT TO DEVICE 40/41 VERSION
+
+/ DEV30 PARAMETERS.
+
+ IFNZRO DEV30 <
+
+ IFNDEF REC <REC= 30> /DEVICE 30 INPUT
+ IFNDEF SEN <SEN= 31> /DEVICE 31 OUTPUT
+
+ >
+
+/ DEV40 PARAMETERS (DEFAULT).
+
+ IFNZRO DEV40 <
+
+ IFNDEF REC <REC= 40> /DEVICE 40 INPUT
+ IFNDEF SEN <SEN= 41> /DEVICE 41 OUTPUT
+
+ >
+
+/ LEDERLE PARAMETERS. /038 CJL
+
+ IFNZRO LEDERLE <
+
+ IFNDEF REC <REC= 43> /DEVICE 43 INPUT
+ IFNDEF SEN <SEN= 44> /DEVICE 44 OUTPUT
+ IFNDEF GENMSG <GENMSG=1> /GENERATE LOCAL HEADER MESSAGE
+ IFNDEF UMSG <UMSG= 0> /DON'T GENERATE USER MESSAGE
+
+ >
+
+/ ORIGNAL PARAMETERS.
+
+ IFNZRO ORIGNAL <
+
+ IFNDEF REC <REC= 33> /DEVICE 33 INPUT
+ IFNDEF SEN <SEN= 34> /DEVICE 34 OUTPUT
+
+ >
+\f/ SPRINT PARAMETERS. /046 CJL
+
+ IFNZRO SPRINT <
+
+ IFNDEF REC <REC= 32> /DEVICE 32 INPUT
+ IFNDEF SEN <SEN= 33> /DEVICE 33 OUTPUT
+
+ >
+
+/ USER PARAMETERS.
+
+ IFNZRO USER <
+
+ IFNDEF XX <XX= 40> /DEFAULT TO DEVICE 40
+ IFNDEF XY <XY= 41> /DEFAULT TO DEVICE 41
+ IFNDEF REC <REC= XX> /DEVICE XX INPUT
+ IFNDEF SEN <SEN= XY> /DEVICE XY OUTPUT
+ IFNDEF GENMSG <GENMSG=1> /GENERATE LOCAL HEADER MESSAGE
+ IFNDEF UMSG <UMSG= 1> /GENERATE USER MESSAGE
+
+ >
+
+/ REMOTE LINE IOT DEFINITIONS.
+
+/ RECEIVE DEFINITIONS.
+
+ RKRBIOT=REC^10+6006 /READ REMOTE, CLEAR FLAG
+ RKSFIOT=REC^10+6001 /SKIP ON REMOTE INPUT FLAG
+
+/ TRANSMIT DEFINITIONS.
+
+ RSBIOT= SEN^10+6003 /SET BAUD RATE FROM AC[8-11]
+ RTLSIOT=SEN^10+6006 /TRANSMIT CHARACTER, CLEAR FLAG
+ RTSFIOT=SEN^10+6001 /SKIP ON TRANSMIT FLAG
+
+/ CONSOLE TTY: DEFINITIONS. /017 CJL
+
+/ KEYBOARD DEFINITIONS. /017 CJL
+
+ IFNDEF KEY <KEY= 03> /KEYBOARD DEVICE CODE
+
+ KCCIOT= KEY^10+6002 /CLEAR CONSOLE KEYBOARD FLAG, AC
+ KRBIOT= KEY^10+6006 /READ CONSOLE KEYBOARD BUFFER, CLEAR FLAG
+ KRSIOT= KEY^10+6004 /READ CONSOLE KEYBOARD BUFFER STATIC
+ KSFIOT= KEY^10+6001 /SKIP ON CONSOLE KEYBOARD FLAG
+
+/ TELEPRINTER DEFINITIONS. /017 CJL
+
+ IFNDEF TTY <TTY= 04> /TELEPRINTER DEVICE CODE
+
+ TLSIOT= TTY^10+6006 /PRINT CHARACTER, CLEAR FLAG
+ TSFIOT= TTY^10+6001 /SKIP ON TELEPRINTER FLAG
+\f/ DEFAULT ESCAPE CHARACTER DEFINITION. /025 CJL
+
+ IFNDEF ESCAPE <ESCAPE="]&37> /DEFAULT IS CONTROL-]
+
+/ DEFAULT LOWER-CASE ENABLE DEFINITION. /030 CJL
+
+ IFNDEF LOWER <LOWER= 0/-40> /LOWER-CASE IS ALLOWED AS IS
+ /CHANGE TO -40 IF LOWER-CASE
+ /SHOULD BE FOLDED TO UPPER-CASE
+
+/ DEFAULT RETRY COUNT DEFINITION. /031 CJL
+
+ IFNDEF RETCNT <RETCNT=5> /DEFAULT IS FIVE RETRIES
+
+/ DEFAULT FILE MODE DEFINITION. /031 CJL
+
+ IFNDEF FMODE <FMODE= 4377> /DEFAULT IS ASCII FILE MODE
+ /4377 IS BINARY FILE MODE
+
+/ DEFAULT FLOW-CONTROL MODE DEFINITION. /031 CJL
+
+ IFNDEF FLOW <FLOW= 1> /DEFAULT IS FLOW-CONTROL ENABLED
+
+/ DEFAULT ASCII INPUT FILE <^Z> DISPOSITION. /031 CJL
+
+ IFNDEF ICLOSE <ICLOSE=1> /ENSURE <^Z> AT ASCII <EOF>
+
+/ DEFAULT ASCII OUTPUT FILE <^Z> DISPOSITION. /031 CJL
+
+ IFNDEF OCLOSE <OCLOSE=0> /<^Z> NOT SENT AT ASCII <EOF>
+
+/ DEFAULT LOCAL MESSAGE GENERATION DEFINITIONS. /038 CJL
+
+ IFNDEF GENMSG <GENMSG=1> /DEFAULT IS TO GENERATE A MESSAGE
+ IFNDEF UMSG <UMSG= 0> /DEFAULT IS NO DUMMY USER MESSAGE
+ IFNDEF LEDERLE <LEDERLE=0> /DEFAULT IS NO LEDERLE MESSAGE
+
+/ THE NULL MESSAGE WILL BE GENERATED BY DEFAULT.
+
+/ ECHO DEFINITION. /039 CJL
+
+ IFNDEF INIECHO <INIECHO=0> /DEFAULT IS NO LOCAL ECHO
+
+/ DEFAULT DECMATE I PORT DEFINITION. /050 CJL
+
+ IFNDEF PORT <PORT= 0> /DEFAULT IS PORT ZERO
+
+/ DEFAULT BAUD RATE DEFINITION. /050 CJL
+
+ IFNDEF BRATE <BRATE= 7> /DEFAULT IS 1200 BAUD
+\f/ STATE DEFINITIONS.
+
+ STDAT= "D&137 /DATA
+ STACK= "Y&137 /ACK
+ STNAK= "N&137 /NAK
+ STSIN= "S&137 /SEND-INIT
+ STBRK= "B&137 /BREAK LINK
+ STFIL= "F&137 /FILENAME HEADER
+ STEOF= "Z&137 /END OF FILE OR REPLY
+ STERR= "E&137 /ERROR PACKET
+ STATT= "A&137 /FILE ATTRIBUTES
+ STRIN= "R&137 /RECEIVE-INIT
+ STEOT= "B&137 /BREAK TRANSMISSION
+ STGEN= "G&137 /KERMIT GENERIC COMMAND
+
+/ DEFAULT INIT PARAMETERS.
+
+ DEFCK= "1&177 /DEFAULT 1 CHARACTER CHECKSUM /014 CJL
+ DEFEOL= 15+40 /CR IS DEFAULT <EOL>
+ DEFQCTL= "#&177 /"#" IS DEFAULT QCTL
+
+/ BUFFER DEFINITIONS. /014 CJL
+
+ DECIMAL /MAKE IT EASIER /014 CJL
+
+ DEFMAXL=94 /DEFAULT MAXIMUM PACKET SIZE
+
+ LINSIZ= 32 /KEYBOARD LINE BUFFER SIZE
+
+ OCTAL /BACK TO NORMAL /014 CJL
+
+ BUFSIZE=200 /128 CHARACTER RING BUFFERS /026 CJL
+ /FOR NO-INTERRUPT CONNECT MODE
+\f/ CONTROL CHARACTER DEFINITIONS. /023 CJL
+
+ CNTRLA= "A&37 /<^A> DEFAULT MARK CHARACTER /023 CJL
+ CNTRLB= "B&37 /<^B> /046 CJL
+ CNTRLC= "C&37 /<^C> PROGRAM EXIT CHARACTER /023 CJL
+ CNTRLD= "D&37 /<^D> /046 CJL
+ CNTRLE= "E&37 /<^E> /046 CJL
+ CNTRLF= "F&37 /<^F> /046 CJL
+ CNTRLG= "G&37 /<^G> BELL CHARACTER /023 CJL
+ CNTRLH= "H&37 /<^H> BACKSPACE CHARACTER /023 CJL
+ CNTRLI= "I&37 /<^I> HORIZONTAL TAB CHARACTER /043 CJL
+ CNTRLJ= "J&37 /<^J> LINEFEED CHARACTER /023 CJL
+ CNTRLK= "K&37 /<^K> VERTICAL TAB CHARACTER /046 CJL
+ CNTRLL= "L&37 /<^L> FORM FEED CHARACTER /046 CJL
+ CNTRLM= "M&37 /<^M> CARRIAGE RETURN CHARACTER /023 CJL
+ CNTRLN= "N&37 /<^N> /046 CJL
+ CNTRLO= "O&37 /<^O> ECHO FLIP CHARACTER /023 CJL
+ CNTRLP= "P&37 /<^P> PROGRAM RESTART CHARACTER /023 CJL
+ CNTRLQ= "Q&37 /<^Q> OUTPUT RESUME CHARACTER /023 CJL
+ CNTRLR= "R&37 /<^R> /046 CJL
+ CNTRLS= "S&37 /<^S> OUTPUT WAIT CHARACTER /023 CJL
+ CNTRLT= "T&37 /<^T> /046 CJL
+ CNTRLU= "U&37 /<^U> /046 CJL
+ CNTRLV= "V&37 /<^V> /046 CJL
+ CNTRLW= "W&37 /<^W> /046 CJL
+ CNTRLX= "X&37 /<^X> FILE ABORT CHARACTER /044 CJL
+ CNTRLY= "Y&37 /<^Y> /046 CJL
+ CNTRLZ= "Z&37 /<^Z> ABORT AND <EOF> CHARACTER /044 CJL
+ DELETE= 177 /<DEL> DELETE OR <RO> CHARACTER /034 CJL
+ LOWERC= "C&177+40 /LOWER-CASE C (CLOSE CHARACTER) /025 CJL
+ UPPERC= "C&177 /UPPER-CASE C (CLOSE CHARACTER) /025 CJL
+
+/ I/O AND FIELD DEFINITIONS. /019 CJL
+
+ BUFFLD= 10 /I/O BUFFER FIELD /019 CJL
+ DIRFLD= 10 /DIRECTORY LOOKUP BUFFER FIELD /028 CJL
+ DMIFLD= 10 /DECMATE ONCE-ONLY CODE FIELD /046 CJL
+ MSGFLD= 10 /TEXT MESSAGE FIELD /023 CJL
+ PAGCNT= 2 /I/O BUFFER SIZE IN PAGES /019 CJL
+ PRGFLD= 00 /PROGRAM FIELD /019 CJL
+ USRFLD= 10 /USR FIELD /020 CJL
+
+/ OS/8 MONITOR DEFINITIONS. /014 CJL
+
+ SBOOT= 7600 /MONITOR EXIT LOCATION IS 07600 /014 CJL
+ USR= 7700 /NON-LOCKED USR ENTRY POINT /035 CJL
+\f/ USER SERVICE ROUTINE AND HANDLER DEFINITIONS. /020 CJL
+
+ CLOSE= 4 /CLOSE TENTATIVE OUTPUT FILE /020 CJL
+ ENTER= 3 /ENTER TENTATIVE OUTPUT FILE /020 CJL
+ FETCH= 1 /FETCH HANDLER /020 CJL
+ INQUIRE=12 /INQUIRE ABOUT HANDLER /020 CJL
+ LOOKUP= 2 /LOOKUP FILE /020 CJL
+ RESET= 13 /RESET DEVICE CONTROL WORD TABLE/037 CJL
+ USRIN= 10 /LOCK USR IN CORE /020 CJL
+ WRITE= 4000 /I/O CALL WRITE BIT /020 CJL
+
+/ INSTRUCTION DEFINITIONS.
+
+ CLCL= 6136 /CLEAR CLOCK FLAG (8/A, ETC.) /046 CJL
+ CLSK= 6131 /SKIP ON, CLEAR CLOCK FLAG /046 CJL
+ CLSK8A= 6137 /SKIP ON CLOCK FLAG (8/A, ETC.) /046 CJL
+ COM= 0017 /COMPLEMENT AC
+ DCAC= DCA . /CURRENT PAGE DCA INSTRUCTION /047 CJL
+ IAAC= 6171 /"A" REGISTER TO AC
+ IACA= 6167 /AC TO "A" REGISTER
+ ISZC= ISZ . /CURRENT PAGE ISZ INSTRUCTION /050 CJL
+ JMPC= JMP . /CURRENT PAGE JMP INSTRUCTION /047 CJL
+ JMPIC= JMP I . /CURRENT PAGE JMP I INSTRUCTION /047 CJL
+ JMSC= JMS . /CURRENT PAGE JMS INSTRUCTION /047 CJL
+ JMSIC= JMS I . /CURRENT PAGE JMS I INSTRUCTION /047 CJL
+ LINC= 6141 /GOTO LINC MODE
+ PDP= 0002 /GOTO PDP-8 MODE
+ PRQ3= 6236 /TYPE THREE PANEL REQUEST /046 CJL
+ TADC= TAD . /CURRENT PAGE TAD INSTRUCTION /047 CJL
+ R3L= 7014 /ROTATE AC (NOT LINK) LEFT 3 /046 CJL
+
+/ NUMERIC LOAD DEFINITIONS. /014 CJL
+
+ NL0000= CLA /LOAD AC WITH 0000 /046 CJL
+ NL0001= CLA IAC /LOAD AC WITH 0001 /014 CJL
+ NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 /014 CJL
+ NL0003= CLA STL IAC RAL /LOAD AC WITH 0003 (8/I ON UP) /046 CJL
+ NL0004= CLA CLL IAC RTL /LOAD AC WITH 0004 (8/I ON UP) /046 CJL
+ NL0006= CLA STL IAC RTL /LOAD AC WITH 0006 (8/I ON UP) /046 CJL
+ NL0010= CLA IAC RAL RAR /LOAD AC WITH 0010 (6120) /024 CJL
+ NL0100= CLA IAC BSW /LOAD AC WITH 0100 (8/E ON UP) /024 CJL
+ NL3776= CLA CLL CMA RAR RAL /LOAD AC WITH 3776 (8/I OR 8/L) /024 CJL
+ NL3777= CLA CLL CMA RAR /LOAD AC WITH 3777 /046 CJL
+ NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 /014 CJL
+ NL5777= CLA CLL CMA RTR /LOAD AC WITH 5777 /046 CJL
+ NL6000= CLA STL IAC RTR /LOAD AC WITH 6000 (8/I ON UP) /046 CJL
+ NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 /014 CJL
+ NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 /014 CJL
+ NL7777= CLA CMA /LOAD AC WITH 7777 /014 CJL
+\f/ DECMATE I COMMUNICATIONS PORT DEFINITIONS. /050 CJL
+
+ IPORT0= 30 /COMMUNICATIONS PORT 0 INPUT DEVICE CODE
+
+ RKFL0= IPORT0^10+6000 /SET COMMUNICATIONS PORT 0 INPUT FLAG
+ RKSF0= IPORT0^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT 0 INPUT FLAG
+ RKCC0= IPORT0^10+6002 /CLEAR AC
+ RKIE0= IPORT0^10+6005 /PORT 0 INPUT INTERRUPT ENABLE PER AC[11]
+ RKRB0= IPORT0^10+6006 /READ COMMUNICATIONS PORT 0 INTO AC
+
+ OPORT0= 31 /COMMUNICATIONS PORT 0 OUTPUT DEVICE CODE
+
+ RTFL0= OPORT0^10+6000 /SET COMMUNICATIONS PORT 0 OUTPUT FLAG
+ RTSF0= OPORT0^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT 0 OUTPUT FLAG
+ RTCF0= OPORT0^10+6002 /NOP
+ RTIE0= OPORT0^10+6005 /PORT 0 OUTPUT INTERRUPT ENABLE PER AC[11]
+ RTLS0= OPORT0^10+6006 /WRITE COMMUNICATIONS PORT 0 FROM AC
+
+ IPORT1= 34 /COMMUNICATIONS PORT 1 INPUT DEVICE CODE
+
+ RKFL1= IPORT1^10+6000 /SET COMMUNICATIONS PORT 1 INPUT FLAG
+ RKSF1= IPORT1^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT 1 INPUT FLAG
+ RKCC1= IPORT1^10+6002 /CLEAR AC
+ RKIE1= IPORT1^10+6005 /PORT 1 INPUT INTERRUPT ENABLE PER AC[11]
+ RKRB1= IPORT1^10+6006 /READ COMMUNICATIONS PORT 1 INTO AC
+
+ OPORT1= 35 /COMMUNICATIONS PORT 1 OUTPUT DEVICE CODE
+
+ RTFL1= OPORT1^10+6000 /SET COMMUNICATIONS PORT 1 OUTPUT FLAG
+ RTSF1= OPORT1^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT 1 OUTPUT FLAG
+ RTCF1= OPORT1^10+6002 /NOP
+ RTIE1= OPORT1^10+6005 /PORT 1 OUTPUT INTERRUPT ENABLE PER AC[11]
+ RTLS1= OPORT1^10+6006 /WRITE COMMUNICATIONS PORT 1 FROM AC
+
+ PCON= 36 /PORT STATUS AND CONTROL DEVICE CODE
+
+ SMFL= PCON^10+6000 /SET MODEM CHANGE FLAG
+ MFSK= PCON^10+6001 /SKIP ON, CLEAR MODEM CHANGE FLAG
+ WCON0= PCON^10+6002 /WRITE COMMUNICATIONS PORT 0 CONTROL REGISTER
+ PSR= PCON^10+6003 /READ PORT STATUS REGISTER
+ PMR= PCON^10+6004 /READ PORT MODEM REGISTER
+ MFIE= PCON^10+6005 /LOAD MODEM CHANGE INTERRUPT ENABLE PER AC[11]
+ WCON1= PCON^10+6006 /WRITE COMMUNICATIONS PORT 1 CONTROL REGISTER
+ RACD= PCON^10+6007 /RESET ACTIVE COMMUNICATIONS PORT PER AC[0]
+\f/ DECMATE II, ETC. COMMUNICATIONS PORT DEFINITIONS. /046 CJL
+
+ PORTIN= 30 /COMMUNICATIONS PORT INPUT DEVICE CODE
+
+ IFL= PORTIN^10+6000 /SET COMMUNICATIONS PORT INPUT/OUTPUT FLAG
+ ISF= PORTIN^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT INPUT/OUTPUT FLAG
+ ICF= PORTIN^10+6002 /NOP (CLEAR THE AC?)
+ INOP1= PORTIN^10+6003 /(NOP?)
+ IRS= PORTIN^10+6004 /READ COMMUNICATIONS PORT RECEIVE BUFFER
+ IIE= PORTIN^10+6005 /COMMUNICATIONS PORT I/O INTERRUPT ENABLE PER AC[11]
+ IRB= PORTIN^10+6006 /READ COMMUNICATIONS PORT RECEIVE BUFFER
+ INOP2= PORTIN^10+6007 /(NOP?)
+
+ PORTOUT=31 /COMMUNICATIONS PORT OUTPUT DEVICE CODE
+
+ DUMBFL= PORTOUT^10+6000 /SET COMMUNICATIONS PORT DUMMY FLAG
+ DUMBSF= PORTOUT^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT DUMMY FLAG
+ DUMBCF= PORTOUT^10+6002 /NOP (CLEAR THE AC?)
+ ONOP1= PORTOUT^10+6003 /(NOP?)
+ OPC= PORTOUT^10+6004 /LOAD COMMUNICATIONS PORT TRANSMIT BUFFER
+ DUMBIE= PORTOUT^10+6005 /COMMUNICATIONS PORT DUMMY INTERRUPT ENABLE PER AC[11]
+ OLS= PORTOUT^10+6006 /LOAD COMMUNICATIONS PORT TRANSMIT BUFFER
+ ONOP2= PORTOUT^10+6007 /(NOP?)
+
+ PORTCON=36 /COMMUNICATIONS PORT CONTROL DEVICE CODE
+
+ MFL= PORTCON^10+6000 /SET MODEM CHANGE FLAG
+ MSF= PORTCON^10+6001 /SKIP ON, CLEAR MODEM CHANGE FLAG
+ MLC= PORTCON^10+6002 /LOAD MODEM CONTROL REGISTER
+ MSB= PORTCON^10+6003 /LOAD BAUD RATE REGISTER
+ MRS= PORTCON^10+6004 /READ MODEM STATUS REGISTER
+ MIE= PORTCON^10+6005 /MODEM CHANGE INTERRUPT ENABLE PER AC[11]
+ MPSCC= PORTCON^10+6006 /ACCESS MULTIPROTOCOL SERIAL COMMUNICATIONS CONTROLLER
+ MPRESET=PORTCON^10+6007 /RESET MULTIPROTOCOL SERIAL COMMUNICATIONS CONTROLLER
+\f/ MISCELLANEOUS DEFINITIONS. /014 CJL
+
+/ STATIC DATE CALCULATIONS. /024 CJL
+
+/ THESE EQUATIONS CAUSE PRINTABLE TEXT OF THE DATE PARTICULARS, WHICH ARE GIVEN
+/ IN OS/8 INTERNAL FORMAT. PROGRAM MAINTAINENCE REQUIRES THE UPDATE OF VERSION,
+/ REVISION, REVDATE, AND REVDGRP. REVDATE AND REVDGRP SHOULD BE OBTAINED FROM
+/ THE SYSTEM WHEN RELEASING A NEW VERSION AFTER FIRST CORRECTLY INVOKING THE
+/ SYSTEM DATE COMMAND.
+
+/ VERSION=[ANY NUMBER IN THE RANGE 00-143 (DECIMAL 00-99)]
+
+/ REVISIO=[ANY SIX-BIT ALPHA (A-Z); DO NOT FORGET &77]
+
+/ REVDATE=[THE CONTENTS OF 17666 (DATE WORD)]
+
+/ REVDGRP=[THE CONTENTS OF 07777 (ONLY BITS[3-4] ARE USED)]
+
+
+
+ IFNDEF REVDATE <REVDATE=4464> /REVISION DATE (LOCATION 17666)
+
+ IFNDEF REVDGRP <REVDGRP=0400> /REVISION 8 YEAR DATE GROUP (LOCATION 07777)
+
+ IFNDEF REVISIO <REVISIO="G&77> /REVISION OF KERMIT-12
+
+ IFNDEF VERSION <VERSION=12> /VERSION OF KERMIT-12
+
+
+ DAY= REVDATE&370%10 /REVISION DAY
+
+ DGROUP= REVDGRP&600%20 /REVISION DATE GROUP (WHICH 8 YEARS)
+
+ MONTH= REVDATE&7400%400 /REVISION MONTH
+
+ YEAR= REVDATE&7+DGROUP+106 /REVISION YEAR (SINCE 1900)
+\f FIELD PRGFLD%10 /STARTING FIELD /038 CJL
+
+ *0 /START AT THE BEGINNING /014 CJL
+
+INTPC, .-. /PC FROM INTERRUPT (IF ANY) /014 CJL
+ JMP I INTPC /RETURN WITH INTERRUPTS OFF /014 CJL
+
+ABFLAG, .-. /FILE ABORT FLAG /044 CJL
+TABLEJU,.-. /MATCHING VALUE FOR SRCHTABLE ROUTINE /025 CJL
+
+ IFNZRO .-4 <ERROR .> /014 CJL
+ODT, ZBLOCK 7-. /RESERVED FOR OS/8 ODT /014 CJL
+RATE, BRATE /BAUD RATE /050 CJL
+
+ *10 /GET TO AUTO-INDEX AREA /014 CJL
+
+XR0, .-. /AUTO-INDEX ZERO /014 CJL
+XR1, .-. /AUTO-INDEX ONE /014 CJL
+DIRXR, PORT /DIRECTORY LOOKUP DEDICATED AUTO-INDEX /028 CJL
+ /INITIALIZED FOR DECMATE I ONCE-ONLY /050 CJL
+
+/ THE REMAINING LOCATIONS THROUGH 000017 MUST BE USED DIRECTLY ONLY, SO AS TO
+/ NOT CAUSE INADVERTANT AUTO-INDEXING.
+
+/ COLUMN COUNTER FOR CONSOLE ROUTINES (NEVER USED INDIRECTLY). /043 CJL
+
+COLUMN, .-. /CONSOLE OUTPUT COLUMN COUNTER /043 CJL
+
+/ CONSOLE TERMINAL ECHO SWITCH (NEVER USED INDIRECTLY). /020 CJL
+
+ECHOSW, 0 /0=ECHO, 4000=DON'T ECHO /020 CJL
+
+/ LATEST (NON-CONNECT MODE) CHARACTER (NEVER USED INDIRECTLY). /043 CJL
+
+INCHAR, .-. /LATEST INPUT CHARACTER FROM CONSOLE /043 CJL
+
+/ CURRENT KERMIT MODE (NEVER USED INDIRECTLY). /025 CJL
+
+KMODE, .-. /CURRENT MODE OF KERMIT /025 CJL
+
+/ KERMIT MODE FLAG VALUES. /014 CJL
+
+/ MLINE= 1 /KERMIT IS ON-LINE
+ MSEND= 2 /KERMIT IS IN SEND MODE
+ MREC= 3 /KERMIT IS IN RECEIVE MODE
+
+/ LATEST CHARACTER SENT TO OUTPUT FILE (NEVER USED INDIRECTLY). /020 CJL
+
+LATEST, .-. /LATEST CHARACTER SENT TO OUTPUT FILE /020 CJL
+\f *20 /GET PAST AUTO-INDEX AREA
+
+INFLAG, .-. /DECMATE INPUT AVAILABLE FLAG /046 CJL
+OUTFLAG,.-. /DECMATE OUTPUT AVAILABLE FLAG /046 CJL
+TEMP, 0
+RCHAR, 0 /REMOTE LINE CURRENT INPUT CHAR
+SCAN1, 0 /
+SCAN2, 0 /
+KEYDSP, 0 /DISPATCH ADDRESS FOR KEYWORD MATCH
+BININP, 0 /BINARY REGISTER FOR DECIMAL INPUT
+PTABLE, 0 /
+LPTR, 0 /HOLDS LINE POINTER
+STATE, 0 /CURRENT STATE
+RETRY, -RETCNT /PACKET ERROR RETRY COUNTER /031 CJL
+RTRYC, 0 /USE THIS FOR ACTUAL COUNTER
+
+/ CURRENT PACKET I/O DATA. /014 CJL
+
+PAKPTR, 0 /POINTER TO OUTPUT PACKET POINTER
+PAKCKS, 0 /HOLDS CURRENT OUTPUT PACKET CHECKSUM TOTAL
+CURSEQ, 0 /CURRENT SEQ NUMBER
+QFLAG, 0 /NON-ZERO WHEN NO CONTROL QUOTING
+
+/ RECEIVE "INIT" REGISTERS. /014 CJL
+
+RMAXL, DEFMAXL+40 /MAX LENGTH FOR DATA PACKET (DEFAULT)
+RTIME, 0 /TIME-OUT VALUE
+RNPAD, 0 /NUMBER OF PADDING CHARS
+RPADC, 0 /CHAR USED FOR PADDING
+REOL, DEFEOL /TERMINATOR CHAR USED FOR END OF PACKET
+RQCTL, DEFQCTL /CONTROL CHAR PREFIX CHAR
+RQBIN, 0 /PARITY CHAR PREFIX CHAR (CHARS GT 177)
+RCHKT, DEFCK /CHECKSUM TYPE (DEFAULT TYPE 1)
+RREPT, 0 /PREFIX CHAR FOR REPEATED CHARS
+RCAPAS, 0 /EXTRA CAPABILITY BIT MASK
+
+/ ZBLOCK 4 /RESERVED FOR EXTRA CAPABILITIES /022 CJL
+
+ INITEND=. /END OF INIT REGISTERS /022 CJL
+
+HNDADR, 0 /FILE DEVICE HANDLER ADDRESS
+FORCEP, 0 /FLAG FOR FORCED OUTPUT OF PACKET WHEN THERE IS
+ / NO DATA (JUST SOH, LEN, SEQ, AND CHECKSUM)
+PRSERR, 0 /HOLDS PARSE POSITION FOR REPORTING ERRORS
+PACK6P, 0 /POINTER TO STORAGE OF 6 BIT CHARS
+PACK6F, 0 /FLAG FOR WHICH BYTE TO STORE
+GET6P, 0 /POINTER USED IN THE GET6 ROUTINE
+GET6F, 0 /FLAG USED IN THE GET6 ROUTINE
+MOVE4, 0 /COUNTER FOR "MOVE"
+INIFLG, 0 /INIT DONE FLAG
+MQ, .-. /"MQ" TEMPORARY REGISTER /032 CJL
+\f/ FILE NAME PARSE REGISTERS. /014 CJL
+
+FNPTR, 0 /POINTER TO WHERE TO PUT A PARSED FILE NAME
+WILDF, 0 /WILD CARD IN FILE NAME FLAG
+
+/ FILE INFORMATION. /014 CJL
+
+FSBLK, 0 /FILE START BLOCK
+FLEN, 0 /FILE LENGTH
+DEVNUM, 0 /PARSED DEVICE NUMBER HERE
+OFFLG, 0 /OUTPUT FILE OPEN FLAG
+ODNAME, 0 /POINTER TO USER SPECIFIED DEVICE FOR OUTPUT
+ODNUMB, 0 /OUTPUT DEVICE NUMBER
+
+/ PARITY VARIABLES. /014 CJL
+
+/MARK, 0200 /SET BIT [8] FOR COMMAND INPUTS /A013
+/PARITY,0 /PARITY MASK (0=SPACE, 200=MARK) /AM013
+
+/ INTERNAL FILE MODE FLAG. /019 CJL
+
+FILMODE,FMODE /ASCII=0177, BINARY=4377 /019 CJL
+
+/ UPPER-CASE ONLY FLAG. /023 CJL
+
+UPONLY, LOWER /0=UPPER/LOWER CASE, -40=UPPER-CASE ONLY/030 CJL
+
+/ <^C> DISPATCH ADDRESS. /023 CJL
+
+UCADDRE,SBOOT /<^C> ADDRESS SHOULD BE SET AS NECESSARY/023 CJL
+
+/ <^P> DISPATCH ADDRESS. /023 CJL
+
+UPADDRE,CHKCLR /<^P> ADDRESS SHOULD BE SET AS NECESSARY/023 CJL
+
+/ ESCAPE CHARACTER FOR CONNECT MODE. /025 CJL
+
+ESCHAR, ESCAPE /ESCAPE CHARACTER FOR CONNECT MODE /025 CJL
+
+/ FLOW CONTROL FLAG. /026 CJL
+
+FLOWFLA,-FLOW /0=NO FLOW CONTROL, 7777=FLOW CONTROL /049 CJL
+ /VIA <^S>/<^Q>
+
+/ KEYBOARD INPUT ERROR FLAG. /026 CJL
+
+KEYERRO,.-. /0=NO ERROR, NON-ZERO=BAD CHARACTER /026 CJL
+ /OR BUFFER OVERRUN
+\f/ REMOTE LINE INPUT ERROR FLAG. /026 CJL
+
+RINERRO,.-. /0=NO ERROR, NON-ZERO=BAD CHARACTER /026 CJL
+ /OR BUFFER OVERRUN
+
+/ REMOTE LINE OUTPUT FLOW CONTROL WAIT FLAG. /026 CJL
+
+REMWAIT,.-. /0=DON'T WAIT, 4000=WAIT FOR <^Q> /026 CJL
+
+/ REMOTE INPUT WAIT FLAG. /026 CJL
+
+/ FLAG STATES:
+
+/ VALUE ACTION
+
+/ 0000 BUFFER IS LESS THAN 3/4 FULL. INPUT FREELY ALLOWED
+/ WITHOUT FLOW CONTROL RESTRICTIONS. IF BUFFER BECOMES
+/ 3/4 FULL AND FLOW CONTROL IS IN EFFECT THEN CHANGE
+/ STATE TO 0001.
+
+/ 0001 BUFFER IS NOW 3/4 FULL. OUTPUT <^S> TO REMOTE AND
+/ THEN CHANGE STATE TO 4000.
+
+/ 4000 WAITING FOR BUFFER TO EMPTY TO LESS THAN 1/4 FULL. IF
+/ FLOW CONTROL IS BEING OBEYED, THEN BUFFER SHOULD NOW
+/ BE EMPTYING.
+
+/ 7777 BUFFER IS NOW LESS THAN 1/4 FULL. OUTPUT <^Q> TO
+/ REMOTE AND THEN CHANGE STATE TO 0000.
+
+RINWAIT,.-. /REMOTE INPUT WAIT FLAG /026 CJL
+
+/ REMOTE LINE OUTPUT BUFFER POINTERS. /026 CJL
+
+REMINSE,.-. /REMOTE OUTPUT INSERTION POINTER /026 CJL
+REMREMO,.-. /REMOTE OUTPUT REMOVAL POINTER /026 CJL
+\f/ POINTER FOR THE PACKET INPUT AND OUTPUT ROUTINES
+
+ SPACK= JMS I . /SEND A PACKET TO REMOTE
+ SPACK0 /PUT IN A POINTER
+
+ FPACK= JMS I . /FORMAT PACKET
+ FPACK0 /PUT IN THE POINTER
+
+ RPACK= JMS I . /RECEIVE A PACKET FROM REMOTE
+ ILINK /PUT IN A POINTER
+
+/ POINTERS FOR OUTPUT ROUTINES
+
+ PRI8B= JMS I . /PRINT 8 BIT STRING ON TTY
+ PRI8B0 /PUT IN THE POINTER
+
+ REM8B= JMS I . /SEND 8 BIT STRING DOWN REMOTE LINE
+ REM8B0 /PUT IN THE POINTER
+
+/ MISC.
+
+ PACK6= JMS I . /DEFINE CALL TO ROUTINE
+ PACK60 /POINTER TO ROUTINE
+
+ GET6= JMS I . /DEFINE THE INSTRUCTION
+ GET60 /PUT IN THE POINTER
+
+ MOVE= JMS I . /DEFINE CALL TO MOVE ROUTINE
+ MOVE0 /POINTER
+
+ CLEAR= JMS I . /DEFINE CALL FOR "CLEAR" ROUTINE
+ CLEAR0 /POINTER
+\f PAGE /START ON NEW PAGE /A014 CJL
+
+/ KERMIT-12 PROGRAM STARTS HERE. /A014 CJL
+
+CLOOP, JMP I (INITIALIZE) /**** INITIALIZED **** CLA CLL /024 CJL
+ JMS I [CRESET] /RESET CONSOLE ROUTINE STUFF
+ DCA ABFLAG /CLEAR ABORT FLAG /044 CJL
+ DCA REMWAIT /CLEAR REMOTE FLOW CONTROL WAIT /049 CJL
+CLDMZAP,JMS DMINIT /INITIALIZE DECMATE PORT /048 CJL
+
+/ THE PREVIOUS INSTRUCTION IS FOR DECMATE OPERATION ONLY. THE DEFAULT
+/ INSTRUCTION IS FOR KL8 INTERFACES ONLY.
+
+ *CLDMZAP /OVERLAY DECMATE CODE /048 CJL
+
+CLDMZAP,NOP /DON'T INITIALIZE DECMATE PORT /048 CJL
+ TAD RATE /GET BAUD RATE
+SETBAUD,MSB /SET REMOTE BAUD RATE /050 CJL
+
+/ THE PREVIOUS INSTRUCTION IS FOR DECMATE II OPERATION ONLY. /050 CJL
+
+ *SETBAUD /OVERLAY DECMATE II CODE /050 CJL
+
+SETBAUD,NOP /NOT APPLICABLE ON DECMATE I /050 CJL
+
+/ THE PREVIOUS INSTRUCTION IS FOR DECMATE I OPERATION ONLY. THE DEFAULT
+/ INSTRUCTION IS FOR KL8 INTERFACES ONLY.
+
+ *SETBAUD /OVERLAY DECMATE I CODE /050 CJL
+
+SETBAUD,RSBIOT /SET REMOTE BAUD RATE /050 CJL
+ JMS I [SCRIBE] /DO A /025 CJL
+ CRLF /<CR>, <LF> /025 CJL
+ JMS I [SCRIBE] /GIVE THEM THE /025 CJL
+/ PRMTMSG /PROMPT MESSAGE /025 CJL
+ PRMT2
+ JMS I (LININP) /GET INPUT LINE FROM USER
+ TAD (CMDTBL) /GET ADDRESS OF PARSE TABLE /M014 CJL
+ DCA PTABLE /STORE FOR PARSER
+ TAD (LINBUF) /GET INPUT LINE BUFFER ADDRESS /M014 CJL
+
+CLOOP1, JMS I (KEYPRS) /PARSE OFF A KEYWORD
+ JMP CLOOP9 /NO MATCH ON KEYWORD
+ JMP CLOOP /END OF LINE DETECTED
+ DCA LPTR /STORE POINTER TO NEXT POS ON LINE
+ JMS I KEYDSP /DISPATCH TO SERVICE
+ JMP CLOOP7 /ERROR RETURN FROM SERVICE DISPATCH
+ TAD LPTR /RE-GET COMMAND LINE POINTER
+ JMP CLOOP1 /CONTINUE LINE PARSE
+
+CLOOP7, SNA /SKIP IF A RETURNING MESSAGE PASSED /029 CJL
+ JMP CLOOP /JUST GO BACK TO COMMAND LOOP /029 CJL
+ DCA RETARG /STORE IN-LINE /029 CJL
+ JMS I [SCRIBE] /CALL MESSAGE PRINT ROUTINE
+RETARG, .-. /WILL BE PASSED MESSAGE ADDRESS
+ JMP CLOOP /KEEP GOING
+\fCLOOP9, JMS I [SCRIBE] /COMPLAIN OF /025 CJL
+ CMERMSG /BAD COMMAND /025 CJL
+ JMP CLOOP /GO AGAIN
+
+/ ROUTINE TO FORMAT A PACKET OF DATA
+/ CALL: FPACK
+/ DATA ADDRESS (DATA MUST ALREADY BE CONTROL/QUOTED AND MUST
+/ NOT BE LONGER THAN THE LARGEST PACKET)
+/ PACKET TYPE
+
+FPACK0, 0
+ CLA CLL /INSURE CLEAR AC
+ TAD I FPACK0 /GET THE DATA ADDRESS
+ DCA FP1 /STORE IN SOURCE POINTER
+ ISZ FPACK0 /BUMP ARGUMENT POINTER
+ TAD I FPACK0 /NOW GET TYPE
+ DCA I (RSTYP) /STORE
+ ISZ FPACK0 /BUMP ARGUMENT POINTER
+ TAD (RSDTA /GET ADDRESS OF DATA BUFFER
+ DCA FP2 /STORE IN DESTINATION POINTER
+
+ TAD (40+3 /SET FOR LENGTH COUNTER
+ DCA I (RSLEN) /STORE IN PACKET
+ DCA FP3 /INIT CHECKSUM
+ TAD CURSEQ /GET CURRENT SEQ NUMBER
+ AND [77] /MODULO 64 /014/016 CJL
+ TAD [40] /TAKE CHAR(SEQUENCE NUMBER) /014/016 CJL
+ DCA I (RSSEQ) /PUT INTO PACKET
+FPACK2, TAD I FP1 /GET A CHAR FROM SOURCE
+ SPA /SKIP IF NOT END
+ JMP FPACK3 /END
+ TAD FP3 /COMBINE WITH CHECKSUM
+ DCA FP3 /AND RETURN
+ TAD I FP1 /GET CHAR BACK AGAIN
+ DCA I FP2 /NOW PUT INTO DESTINATION
+ ISZ I (RSLEN) /BUMP THE LENGTH
+ ISZ FP1 /BUMP THE SOURCE POINTER
+ ISZ FP2 /BUMP THE DESTINATION POINTER
+ JMP FPACK2 /LOOP
+\fFPACK3, CLA CLL /CLEAR THE AC
+ TAD FP3 /GET CALCULATED CHECKSUM
+ TAD I (RSLEN) /INCLUDE THE LENGTH
+ TAD I (RSSEQ) /AND THE SEQUENCE
+ TAD I (RSTYP) /AND THE TYPE
+ JMS I [CKSUM] /GET IT CORRECT
+ DCA I FP2 /STORE WITH PACKET
+ ISZ FP2 /BUMP PACKET POINTER
+ TAD REOL /GET ANY END OF LINE TO INCLUDE
+ TAD [-40] /MAKE IT A REAL CHARACTER /014/016 CJL
+ SNA /SKIP IF EOL CHAR REQUIRED
+ JMP FPACK4 /NO EOL CHAR
+ DCA I FP2 /STORE EOL CHAR WITH PACKET
+ ISZ FP2 /BUMP POINTER
+FPACK4, NL7777 /SET -1 /032 CJL
+ DCA I FP2 /PACKET NOW COMPLETE
+ TAD RETRY /SET UP RE-TRY COUNTER
+ DCA RTRYC
+ ISZ CURSEQ /BUMP SEQUENCE NUMBER FOR NEXT TIME
+ NOP /PROTECT ISZ
+ JMP I FPACK0 /RETURN
+
+FP1, 0 /POINTER TO SOURCE DATA
+FP2, 0 /POINTER TO PACKET BUFFER
+FP3, 0 /RUNNING CHECKSUM
+
+/ DECMATE INITIALIZE ROUTINE. /048 CJL
+
+DMINIT, .-. /DECMATE PORT INITIALIZE ROUTINE/048 CJL
+DMI01, TAD DM234/(234) /GET SCD ENABLE VALUE /050 CJL
+DMI02, WCON0 /WRITE CONTROL REGISTER 0 (1) /050 CJL
+DMI03, NL0000 /INDICATE PORT 0 (1) /050 CJL
+DMI04, RACD /RESET THE ACTIVE PORT /050 CJL
+DMI05, ISZ DMWASTE /WASTE /050 CJL
+DMI06, JMP DMI05 /SOME TIME /050 CJL
+DMI07, ISZ DMWASTE /WASTE /050 CJL
+DMI08, JMP DMI07 /SOME TIME /050 CJL
+DMI09, RTFL0 /SET PORT 0 (1) OUTPUT FLAG /050 CJL
+DMI10, TAD DM2516/(2516) /SETUP FOR 8 BITS, NO PARITY /050 CJL
+DMI11, JMS DMSEND /SEND TO MODE REGISTER 1 /050 CJL
+DMI12, TAD RATE /GET BAUD RATE /050 CJL
+DMI13, TAD DM2460/(2460) /ADD ON CLOCK ENABLE VALUES /050 CJL
+DMI14, JMS DMSEND /SEND TO MODE REGISTER 2 /050 CJL
+DMI15, TAD DM3425/(3425) /GET ENABLE AND RESET VALUE /050 CJL
+DMI16, JMS DMSEND /SEND TO COMMAND REGISTER /050 CJL
+DMI17, RKRB0 /DO A DUMMY READ ON PORT 0 (1) /050 CJL
+\f/ THE PREVIOUS INSTRUCTIONS ARE FOR DECMATE I OPERATION ONLY. THE DEFAULT
+/ INSTRUCTIONS ARE FOR DECMATE II, ETC. INTERFACES ONLY.
+
+ *DMI01 /OVERLAY DECMATE I CODE /050 CJL
+
+DMI01, ISZ DMWASTE /WASTE /048 CJL
+DMI02, JMP DMI01 /SOME TIME /048 CJL
+DMI03, ISZ DMWASTE /WASTE /048 CJL
+DMI04, JMP DMI03 /SOME TIME /048 CJL
+DMI05, ISF /SKIP ON AND CLEAR PORT FLAG /048 CJL
+DM50, 50/NOP /JUST IN CASE /048 CJL
+DMI07, IRB /READ THE PORT BUFFER /048 CJL
+DMI08, CLA /CLEAN UP /048 CJL
+DMI09, TAD DM50/(50) /GET OUTPUT INTERRUPT VALUE /048 CJL
+DMI10, MPSCC /CLEAR OUTPUT INTERRUPT /048 CJL
+DMI11, TAD (60-50) /GET ERROR RESET VALUE /048 CJL
+DMI12, MPSCC /CLEAR OVERRUN ERRORS /048 CJL
+DMI13, TAD (70-60) /SET END OF INTERRUPT VALUE /048 CJL
+DMI14, MPSCC /CLEAR THE INTERRUPT /048 CJL
+DMI15, DCA OUTFLAG /INDICATE OUTPUT IS AVAILABLE /048 CJL
+DMI16, DCA INFLAG /CLEAR INPUT AVAILABLE FLAG /048 CJL
+DMI17, JMP I DMINIT /RETURN /048 CJL
+
+/ DECMATE I INITIALIZE CODE CONTINUES HERE. /050 CJL
+
+DMISET, RTFL0 /SET PORT 0 (1) OUTPUT FLAG /050 CJL
+ CLA /CLEAN UP /050 CJL
+ JMP I DMINIT /RETURN /050 CJL
+
+DMSEND, .-. /DECMATE I SEND ROUTINE /050 CJL
+DMISKP, RTSF0 /SKIP ON PORT 0 (1) OUTPUT FLAG /050 CJL
+ JMP DMISKP /WAIT FOR IT /050 CJL
+DMIOUT, RTLS0 /SEND TO PORT 0 (1) REGISTER /050 CJL
+ CLA /CLEAN UP /050 CJL
+ JMP I DMSEND /RETURN /050 CJL
+
+DMWASTE,.-. /TIMER TEMPORARY /050 CJL
+DM234, 234 /CONSTANT 0234 /050 CJL
+DM2460, 2460 /CONSTANT 2460 /050 CJL
+DM2516, 2516 /CONSTANT 2516 /050 CJL
+DM3425, 3425 /CONSTANT 3425 /050 CJL
+
+ PAGE
+\f/ ROUTINE TO SEND THE FORMATTED PACKET /027 CJL
+/ ARGUMENTS: CALL+1 NON-ZERO = AWAIT RESPONSE
+/ ZERO = DO NOT AWAIT RESPONSE
+/ CALL + 2 DISPATCH TABLE-2 /027 CJL
+
+SPACK0, 0
+ REM8B; RSBUF /SEND PACKET JUST COMPLETED
+ TAD I SPACK0 /DO WE GET A RESPONSE?
+ ISZ SPACK0 /BUMP POINTER PAST ARGUMENT
+ SNA CLA /SKIP IF YES
+ JMP I SPACK0 /ALL DONE HERE
+ RPACK /GET PACKET BACK FROM REMOTE
+ TAD I SPACK0 /DID WE WANT A DISPATCH?
+ ISZ SPACK0 /BUMP PAST ARGUMENT
+ SNA /SKIP IF YES
+ JMP I SPACK0 /EXIT IF NO
+ DCA SPACARG /STORE IN-LINE /031 CJL
+ JMS DISPATCH /CALL DISPATCH ROUTINE /031 CJL
+SPACARG,.-. /WILL BE DISPATCH TABLE-2 /031 CJL
+ JMP I SPACK0 /NOT FOUND, GOTTA RETURN
+
+/ CONSOLE RESET ROUTINE. /024 CJL
+
+CRESET, .-. /CONSOLE RESET ROUTINE
+ CLA CLL /CLEAN UP
+ DCA ECHOSW /ENABLE OUTPUT ECHO
+ TAD (UPCPRT) /ALLOW THEM TO
+ DCA UCADDRESS /RESTART VIA <^C>
+ TAD [CLOOP] /ALLOW THEM TO
+ DCA UPADDRESS /RESTART VIA <^P>
+ JMP I CRESET /RETURN
+
+/ ALTERNATE CONSOLE RESET ROUTINE. /025 CJL
+
+CREST2, .-. /ALTERNATE CONSOLE RESET ROUTINE
+ JMS CRESET /CLEAR AC AND ENABLE OUTPUT ECHO
+ TAD (KCCZAP) /RENDER <^C>
+ DCA UCADDRESS /TOTALLY HARMLESS
+ TAD (CHKCLR) /MAKE <^P> PRINT "^P"
+ DCA UPADDRESS /AND THEN GO AWAY
+ JMP I CREST2 /RETURN
+\f/ ROUTINE TO CLEAR WORDS OF MEMORY
+/ ENTER WITH: AC = MINUS NUMBER OF WORDS TO CLEAR
+/ MQ = ADDRESS OF WHERE TO START THE CLEAR
+
+CLEAR0, 0
+ DCA CLEAR5 /STORE COUNT OF WORDS
+ TAD MQ /GET ADDRESS TO CLEAR /032 CJL
+ DCA CLEAR6 /STORE IN POINTER
+ DCA I CLEAR6 /ZERO A WORD
+ ISZ CLEAR6 /BUMP POINTER
+ ISZ CLEAR5 /BUMP COUNTER
+ JMP .-3 /LOOP
+ JMP I CLEAR0 /DONE
+
+CLEAR5, 0 /TEMP FOR "CLEAR" ROUTINE
+CLEAR6, 0 /TEMP FOR "CLEAR" ROUTINE
+
+/ ROUTINE TO DISPATCH TO ROUTINE BASED ON VALUE OF "RRTYP". /027 CJL
+
+/ CALLING SEQUENCE:
+
+/ CLA /AC MUST BE CLEAR
+/ JMS DISPATCH /CALL ROUTINE
+/ ADDRESS-2 /DISPATCH TABLE ADDRESS-2
+/ NO MATCH RETURN /RETURNS HERE WITH CLEAR AC IF NO MATCH
+
+/ CALL WILL DISPATCH TO THE CORRESPONDING ROUTINE ON A MATCH IN THE SPECIFIED
+/ TABLE (WHICH ENDS WITH ZERO) WITH A CLEAR AC.
+
+DISPATC,.-. /MATCH "RRTYP" AND DISPATCH ROUTINE
+ CLA /JUST IN CASE /031 CJL
+ TAD I DISPATCH /GET PASSED ARGUMENT
+ ISZ DISPATCH /BUMP PAST THE ARGUMENT
+ DCA DISPA2 /SAVE PASSED ARGUMENT IN-LINE
+ TAD I (RRTYP) /GET VALUE OF "RRTYP"
+ CIA /INVERT FOR TESTING
+ JMS I [SRCHTABLE] /CALL TABLE SEARCH ROUTINE
+DISPA2, .-. /WILL BE TABLE ADDRESS-2
+ SNA CLA /SKIP IF MATCH FOUND
+ JMP I DISPATCH /RETURN ON NO MATCH
+ JMP I TABLEJUMP /DISPATCH TO MATCHING ADDRESS
+\f/ ROUTINE TO PUT CHARS INTO A BUFFER TO GET READY TO FORMAT A PACKET.
+/ ENTER WITH CHAR IN THE AC; IF THE CHAR NEEDS CONTROL QUOTING, IT WILL BE ADDED
+/ EXIT + 2 IF EVERYTHING IS OK
+/ EXIT + 1 IF BUFFER IS FULL
+
+OPBUF, 0 /PUT CHARACTERS INTO BUFFER FOR PACKET ROUTINE
+ JMS I (OPRE) /CHECK FOR PREFIX
+ JMP OPBUF1 /NO PREFIX
+ DCA OP1 /SAVE CONVERTED CHAR
+ TAD RQCTL /GET QUOTE CHAR TO USE
+ DCA I OP2 /PUT RETURNED PREFIX INTO BUFFER
+ ISZ OP2 /BUMP POINTER
+ TAD OP1 /GET BACK CONVERTED CHAR
+OPBUF1, DCA I OP2 /PUT INTO BUFFER
+ ISZ OP2 /BUMP POINTER
+ NL7777 /SET -1 /032 CJL
+ DCA I OP2 /ALWAYS TERMINATE BUFFER
+ TAD RMAXL /GET MAX BUFFER LENGTH
+ TAD (-40+HOLDBF-4 /
+ CIA
+ TAD OP2 /COMPARE WITH WHAT WE HAVE
+ SPA CLA /SKIP IF NO ROOM
+ JMP OPBUF2 /HAVE ROOM
+ JMS INIOPB /RESET BUFFER
+ JMP I OPBUF /TAKE RETURN + 1
+
+OPBUF2, ISZ OPBUF /BUMP RETURN FOR BUFFER NOT FULL
+ JMP I OPBUF /DONE
+
+OP1, 0 /TEMP LOCATION
+OP2, HOLDBF /POINTER FOR HOLD BUFFER
+
+/ ROUTINE TO RE-SET THE HOLD BUFFER.
+
+INIOPB, 0
+ TAD (HOLDBF /RE-SET BUFFER POINTER
+ DCA OP2
+ JMP I INIOPB
+
+/ ROUTINE TO CALCULATE A 1 BYTE CHECKSUM.
+
+CKSUM, 0
+ DCA CKSUM1 /STORE TEMP
+ TAD CKSUM1 /GET BACK
+ RTR;RTR;RTR /GET TWO HIGHEST INTO TWO LOWEST /032 CJL
+ AND (3 /KEEP ONLY BITS 0-1
+ TAD CKSUM1 /GET ORIGINAL
+ AND [77] /KEEP ONLY BITS 0-5 /016 CJL
+ TAD [40] /MAKE A CHAR(CHECKSUM)
+ JMP I CKSUM /DONE, RETURN IN AC
+
+CKSUM1, 0 /TEMP FOR "CKSUM"
+\f PAGE
+\f/ ROUTINE TO INPUT CHARS FROM REMOTE UNTIL A "SOH" CHAR IS FOUND.
+
+GETSOH, 0
+ JMS COMIN /GET A CHARACTER FROM THE REMOTE LINE /046 CJL
+ JMP I GETSOH /TIME-OUT
+ AND [177] /IGNORE PARITY BIT /034 CJL
+ TAD (-CNTRLA) /COMPARE WITH "SOH" /034 CJL
+ SZA CLA /SKIP IF SAME
+ JMP GETSOH+1 /LOOP TILL WE GET ONE
+ ISZ GETSOH /BUMP FOR GOOD RETURN
+ JMP I GETSOH /GOT ONE, DONE
+
+
+/ ROUTINE TO GET A CHAR FROM THE REMOTE LINE AND UPDATE CHECKSUM.
+
+GETIR, 0
+ JMS COMIN /GET A CHARACTER FROM THE REMOTE LINE /046 CJL
+ JMP I GETIR /TIME-OUT RETURN
+ DCA GETIR1 /STORE TEMP
+ TAD GETIR1 /GET CHAR BACK
+ TAD I (ILINK9) /ADD CHECKSUM
+ DCA I (ILINK9) /RETURN UPDATED CHECKSUM
+ TAD GETIR1 /RE-GET CURRENT INPUT CHAR
+ TAD [-15] /CHECK FOR A RETURN
+ SNA CLA /SKIP IF NOT A RETURN
+ JMP I GETIR /WAS A RETURN, TAKE EXIT + 1
+ TAD GETIR1 /RE-GET CHAR FOR RETURN
+ ISZ GETIR /BUMP FOR GOOD RETURN
+ JMP I GETIR /AND RETURN IN THE AC
+
+GETIR1, 0 /TEMP LOCAL TO "GETIR"
+\f/ REMOTE COMMUNICATIONS ROUTINES FOR NON-CONNECT USAGE. /046 CJL
+
+/ REMOTE INPUT ROUTINE. /046 CJL
+
+COMIN, .-. /REMOTE INPUT ROUTINE /046 CJL
+ CLA /CLEAN UP /046 CJL
+ TAD [-15] /SETUP THE /049 CJL
+ DCA TIMEOUT /TIME-OUT FACTOR /046 CJL
+INLUP, TAD INFLAG /IS INPUT AVAILABLE? /046 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *INLUP /OVERLAY DECMATE II CODE /049 CJL
+
+INLUP, SKP /WE'RE NOT A DECMATE II /049 CJL
+ SNA CLA /SKIP IF INPUT AVAILABLE (ON DECMATE II)/049 CJL
+INSKIP, JMP NOTYET /JUMP IF NOT /049 CJL
+INLUP1, DCA INFLAG /CLEAR INPUT AVAILABILITY FLAG /049 CJL
+INREAD, IRB /GET THE CHARACTER /049 CJL
+
+/ THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTIONS
+/ ARE FOR KL8 INTERFACES.
+
+ *INSKIP /OVERLAY DECMATE II CODE /049 CJL
+
+INSKIP, RKSFIOT /INPUT FLAG UP? /049 CJL
+INLUP1, JMP NOTYET /NO, CHECK FOR ABORT, ETC. /049 CJL
+INREAD, RKRBIOT /YES, READ IN THE CHARACTER /049 CJL
+ AND [177] /JUST SEVEN-BIT /046 CJL
+ DCA RCHAR /SAVE THE CHARACTER /046 CJL
+ TAD RCHAR /GET IT BACK /046 CJL
+ ISZ COMIN /BUMP TO GOOD RETURN /046 CJL
+ JMP I COMIN /RETURN /046 CJL
+
+/ COMES HERE IF INPUT NOT AVAILABLE.
+
+NOTYET, JMS I (CTLCTST) /CHECK FOR <^C>, ETC. /044 CJL
+ TAD [-CNTRLZ] /COMPARE POSSIBLE CHARACTER TO <^Z> /044 CJL
+ SZA /SKIP IF IT ALREADY MATCHES /044 CJL
+ TAD [-CNTRLX+CNTRLZ]/ELSE COMPARE TO <^X> /044 CJL
+ SNA CLA /SKIP IF NEITHER ABORT CHARACTER /049 CJL
+ ISZ ABFLAG /SET ABORT FLAG /049 CJL
+ SKP /SKIP IF NOT TOO MANY TIMES /049 CJL
+ JMP .-2 /ENSURE FLAG SETTING /049 CJL
+\fINSTATU,JMS UPSTATUS /UPDATE THE PORT STATUS /049 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *INSTATUS /OVERLAY DECMATE II CODE /049 CJL
+
+INSTATU,NOP /WE'RE NOT A DECMATE II /049 CJL
+ ISZ WASTIME /WASTE SOME TIME /046 CJL
+ JMP INLUP /KEEP TRYING /046 CJL
+ ISZ TIMEOUT /WAITING TOO LONG? /046 CJL
+ JMP INLUP /NO, KEEP TRYING /046 CJL
+ JMP I COMIN /YES, TAKE ERROR RETURN /046 CJL
+
+/ FLOW-CONTROL STATUS ROUTINE. /049 CJL
+
+GETFLOW,.-. /GET FLOW-CONTROL STATUS
+GETFL1, JMS UPSTATUS /UPDATE THE CURRENT STATUS
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *GETFL1 /OVERLAY DECMATE II CODE
+
+GETFL1, NOP /WE'RE NOT A DECMATE II
+ JMS I (RINGET) /GET REMOTE CHARACTER (IF ANY)
+ CLA /THROW IT AWAY
+ TAD REMWAIT /GET REMOTE FLOW STATUS
+ JMP I GETFLOW /RETURN
+
+/ REMOTE OUTPUT ROUTINE. /046 CJL
+
+COMOUT, .-. /REMOTE OUTPUT ROUTINE /046 CJL
+ DCA OUTEMP /SAVE PASSED VALUE /046 CJL
+CMRESET,TAD [-15] /SETUP THE /049 CJL
+ DCA OTIME /TIME-OUT COUNTER /049 CJL
+COMWAIT,JMS GETFLOW /GET REMOTE WAIT STATUS /049 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY. THE DEFAULT INSTRUCTION IS FOR
+/ KL8 INTERFACES.
+
+ *COMWAIT /OVERLAY DECMATE CODE /049 CJL
+
+COMWAIT,NL7777 /SETUP FOR FLOW CONTROL FLAG LOAD /049 CJL
+ AND FLOWFLAG /SHOULD WE WAIT FOR REMOTE FLOW CONTROL?/049 CJL
+ SNA CLA /SKIP IF SO /049 CJL
+ JMP NOWAIT /JUMP IF NOT /049 CJL
+\fFLOWAIT,JMS GETFLOW /GET REMOTE WAIT STATUS /049 CJL
+ SZA CLA /SKIP IF NOT WAITING /049 CJL
+ JMP FLOWAIT /JUMP IF STILL WAITING /049 CJL
+NOWAIT, TAD OUTFLAG /CHECK IF OUTPUT IS AVAILABLE /049 CJL
+CMOUT1, SNA CLA /SKIP IF SO /049 CJL
+CMOUT2, JMP OWAIT /JUMP IF NOT /049 CJL
+DM1AND, DCA OUTFLAG /CLEAR OUTPUT AVAILABILITY FLAG /049 CJL
+CMOUT3, TAD OUTEMP /GET THE PASSED VALUE /049 CJL
+CMOUT4, OLS /OUTPUT IT /049 CJL
+
+/ THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTIONS
+/ ARE FOR KL8 INTERFACES.
+
+ *NOWAIT /OVERLAY DECMATE II CODE /049 CJL
+
+NOWAIT, RTSFIOT /OUTPUT FLAG UP? /049 CJL
+CMOUT1, JMP OWAIT /NO, WAIT FOR IT THERE /049 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *CMOUT1 /OVERLAY DECMATE I CODE /049 CJL
+
+CMOUT1, JMP COMWAIT /NO, WAIT FOR IT /049 CJL
+CMOUT2, TAD OUTEMP /YES, GET PASSED VALUE /049 CJL
+DM1AND, AND [377] /ENSURE EIGHT BITS (FOR DECMATE I) /049 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *DM1AND /OVERLAY DECMATE I CODE /049 CJL
+
+DM1AND, SKP /WE'RE NOT A DECMATE I /049 CJL
+CMOUT3, TAD [400] /FORCE OUTPUT WRITE FOR DECMATE I /049 CJL
+CMOUT4, RTLSIOT /OUTPUT THE CHARACTER /049 CJL
+ CLA /CLEAN UP /049 CJL
+ JMP I COMOUT /RETURN /049 CJL
+
+/ COMES HERE IF OUTPUT NOT READY. /049 CJL
+
+OWAIT, ISZ OWASTE /WASTE SOME TIME /049 CJL
+ JMP COMWAIT /KEEP TRYING /049 CJL
+ ISZ OTIME /WAITING TOO LONG? /049 CJL
+ JMP COMWAIT /NO, KEEP TRYING /049 CJL
+ JMS I (DMINIT) /YES, RESET EVERYTHING /049 CJL
+ JMP CMRESET /TRY, TRY AGAIN /049 CJL
+\f/ DECMATE II, ETC. STATUS UPDATE ROUTINE. /046 CJL
+
+UPSTATU,.-. /UPDATE THE STATUS ROUTINE /046 CJL
+ ISF /COMMUNICATIONS PORT FLAG UP? /046 CJL
+ JMP I UPSTATUS /NO, RETURN /046 CJL
+ NL4000 /SETUP READ OF REGISTER ZERO /046 CJL
+ MPSCC /TELL THE MPSCC CHIP /046 CJL
+ CLA /CLEAN UP /046 CJL
+ MPSCC /READ REGISTER ZERO NOW /046 CJL
+ AND (5) /JUST INPUT AND OUTPUT BITS /046 CJL
+ CLL RAR /MOVE INPUT TO LINK /046 CJL
+ SNA CLA /SKIP IF OUTPUT INTERRUPT /046 CJL
+ JMP INCHK /JUMP IF NOT /046 CJL
+ TAD (050) /GET OUTPUT CLEAR VALUE /046 CJL
+ MPSCC /CLEAR THE OUTPUT INTERRUPT /046 CJL
+ DCA OUTFLAG /INDICATE OUTPUT AVAILABLE NOW /046 CJL
+INCHK, CLA RAL /GET RECEIVE STATUS /046 CJL
+ SZA /SKIP IF INPUT NOT AVAILABLE RIGHT NOW /046 CJL
+ DCA INFLAG /INDICATE NEW INPUT STATUS /046 CJL
+ CLA /CLEAN UP EITHER WAY /046 CJL
+ TAD (070) /GET END OF INTERRUPT VALUE /046 CJL
+ MPSCC /CLEAR THE INTERRUPT /046 CJL
+ CLA /CLEAN UP /046 CJL
+ JMP I UPSTATUS /RETURN /046 CJL
+
+ AND377= AND [377] /INSTRUCTION CONSTANT /049 CJL
+ OUTEMP= COMIN /OUTPUT ROUTINE TEMPORARY /049 CJL
+ TIMEOUT=GETFLOW /TIME-OUT TEMPORARY /049 CJL
+ WASTIME=COMOUT /TIME-OUT TEMPORARY /049 CJL
+
+OTIME, .-. /TIME-OUT TEMPORARY /049 CJL
+OWASTE, .-. /TIME-OUT TEMPORARY /049 CJL
+
+ PAGE
+
+/ HOLD BUFFER FOR CHAR OUTPUT
+
+ DECIMAL
+
+HOLDBF, ZBLOCK 92
+
+ OCTAL
+\f/ ROUTINE TO CHECK FOR CONTROL PREFIX.
+/ ENTER WITH CHAR TO CHECK IN THE AC.
+/ EXIT + 1 WITH CHAR IN THE AC IF NO PREFIX QUOTING.
+/ EXIT + 2 WITH PROPER CHAR IN THE AC AND QUOTING IS REQUIRED.
+
+OPRE, 0 /CHECK FOR CONTROL PREFIX ROUTINE
+ DCA PRETEMP /SAVE THE CHARACTER /032 CJL
+ TAD QFLAG /CHECK FOR IN CTRL QUOTE MODE
+ SZA CLA /SKIP IF YES
+ JMP OPRE1 /NO QUOTE PREFIX
+ TAD PRETEMP /GET THE CHARACTER /032 CJL
+ AND [7740] /QUICK CHECK FOR <40 /014/016 CJL
+ SNA CLA /SKIP IF NOT CONTROL
+ JMP OPRE2 /PREFIX QUOTE
+ TAD PRETEMP /GET THE CHARACTER /032 CJL
+ TAD (-177 /CHECK FOR "DELETE"
+ SNA CLA /SKIP IF NOT
+ JMP OPRE2 /PREFIX QUOTE
+ TAD PRETEMP /GET THE CHARACTER /032 CJL
+ CIA /NEGATE FOR COMPARE
+ TAD RQCTL /SEE IF SAME AS QUOTE CHAR
+ SZA CLA /SKIP IF PREFIX QUOTE
+ JMP OPRE1 /NO PREFIX QUOTE
+ TAD RQCTL /PREFIX WITH PREFIX
+ JMP OPRE3 /PREFIX WITH THE PREFIX
+
+OPRE1, TAD PRETEMP /GET THE CHARACTER /032 CJL
+ JMP I OPRE /DONE
+
+OPRE2, TAD PRETEMP /GET THE CHARACTER /032 CJL
+ TAD [100] /MAKE IT PRINTABLE /016 CJL
+ AND [177] /IN CASE IT WAS 177 /014/016 CJL
+
+OPRE3, ISZ OPRE /BUMP FOR PREFIX RETURN
+ JMP I OPRE /DONE
+
+PRETEMP,.-. /PREFIX TEMPORARY /032 CJL
+
+ PAGE /014 CJL
+\f/ ROUTINE TO SCAN A TEXT LINE FOR KEYWORD DELIMITERS.
+
+/ THIS ROUTINE EXPECTS THE AC TO POINT TO A TEXT LINE TO SCAN AND FINDS THE
+/ FIRST NON-SPACE, NON-END OF LINE CHAR IN THE LINE AND SETS "SCAN1" TO POINT TO
+/ IT. NEXT WE FIND THE LAST CHAR IN THE LINE THAT IS A NON-SPACE, NON-END OF
+/ LINE AND STORE A POINTER TO IT IN "SCAN2". KEYWORDS ARE DELIMITED BY A
+/ BEGINNING OF LINE OR SPACE AT THE BEGINNING AND AN END OF LINE OR A SPACE AT
+/ THE END.
+
+/ ENTER: AC = POINTER TO COMMAND LINE
+
+/ EXIT: (SUCCESS) SCAN1 = POINTER TO FIRST CHAR OF KEYWORD.
+/ SCAN2 = POINTER TO LAST CHAR OF KEYWORD.
+/ RETURN = RETURN + 2 (NO WORDS LEFT IN LINE).
+
+/ EXIT: (FAIL) RETURN = RETURN + 1.
+
+SCNEL, 0 /SCAN ROUTINE
+ JMS I [NOSP] /FIND FIRST NON-SPACE
+ JMP I SCNEL /END OF LINE RETURN
+ DCA SCAN1 /RETURN SCAN LINE POINTER
+ TAD SCAN1 /RE-GET SCAN LINE POINTER
+ JMS I [SP] /FIND FIRST SPACE OR EOL
+ NOP /RETURN HERE ON EOL
+ TAD (-1 /BACK UP TO PREVIOUS CHAR
+ DCA SCAN2 /SET END ELEMENT POINTER
+ ISZ SCNEL /TAKE SUCCESS RETURN
+ JMP I SCNEL /DONE
+
+
+/ ROUTINE TO SCAN THRU A TEXT LINE LOOKING FOR THE NEXT SPACE.
+/ ENTER ROUTINE WITH THE LINE POINTER IN THE AC.
+
+/ EXIT: RETURN + 2 WITH AC = POINTER TO SPACE.
+/ RETURN + 1 WITH AC = POINTER TO END OF LINE.
+
+SP, 0 /CHECK FOR A <SPACE> ROUTINE
+ DCA SCANTP /USE A TEMP POINTER
+ SKP /SKIP INTO LOOP BELOW
+SP1, ISZ SCANTP /BUMP LINE POINTER
+ TAD I SCANTP /GET A CHAR
+ SPA /SKIP IF NOT END OF LINE
+ JMP SP3 /GOT AN END OF LINE
+ TAD [-" !200] /COMPARE WITH <SP> /034 CJL
+ SZA CLA /SKIP IF IS A SPACE
+ JMP SP1 /LOOP TILL SPACE OR EOL
+ ISZ SP /BUMP RETURN FOR SPACE FOUND
+
+SP3, CLA CLL /INSURE A CLEAR AC
+ TAD SCANTP /GET POINTER VALUE
+ JMP I SP /RETURN IN AC
+\f/ ROUTINE TO SCAN THRU A TEXT LINE FOR THE FIRST NON-SPACE.
+/ ENTER ROUTINE WITH POINTER TO THE LINE IN THE AC.
+
+/ EXIT: RETURN + 2 WITH AC = POINTER TO NON-SPACE.
+/ RETURN + 1 WITH AC = POINTER TO END OF LINE.
+
+NOSP, 0 /FIND A NON-<SPACE> ROUTINE
+ DCA SCANTP /USE A TEMP POINTER
+ SKP /SKIP INTO LOOP BELOW
+NOSP1, ISZ SCANTP /BUMP THE LINE POINTER
+ TAD I SCANTP /GET A CHAR FROM THE LINE
+ SPA /SKIP IF NOT EOL
+ JMP NOSP3 /EXIT IF EOL
+ TAD [-" !200] /COMPARE WITH <SP> /034 CJL
+ SNA CLA /SKIP IF NOT SPACE
+ JMP NOSP1 /LOOP TILL SPACE OR EOL
+ ISZ NOSP /BUMP RETURN FOR SPACE FOUND
+NOSP3, CLA CLL /INSURE CLEAR AC
+ TAD SCANTP /GET POINTER
+ JMP I NOSP /RETURN IN AC
+
+
+
+/ ROUTINE TO FIND AN END CHAR IN A STRING.
+/ ENTER ROUTINE WITH POINTER TO THE STRING IN THE AC.
+/ EXIT WITH THE POINTER TO THE FIRST MINUS CHAR IN THE AC.
+
+FNDEND, 0 /FIND END CHAR ROUTINE
+ DCA SCANTP /PUT POINTER IN SCANTP
+FEND1, TAD I SCANTP /GET A CHAR FROM THE STRING
+ SPA CLA /SKIP IF NOT END
+ JMP FEND2 /EXIT IF END OF STRING
+ ISZ SCANTP /BUMP THE POINTER
+ JMP FEND1 /LOOP TILL NON-END OF STRING
+
+FEND2, TAD SCANTP /GET POINTER TO NON-END OF STRING
+ JMP I FNDEND /EXIT WITH POINTER IN AC
+
+SCANTP, 0 /USED IN THE SCAN ROUTINES "SP", "NOSP", "FNDNUL"
+\f/ ROUTINE TO LOOKUP THE KEY WORD POINTED TO BY THE AC IN THE /014 CJL
+/ TABLE POINTED TO BY PTABLE.
+
+/ RETURN + 1 IF NO MATCH IS FOUND WITH AC = ENTRY VALUE.
+/ RETURN + 2 IF NO KEYWORD IS FOUND (EOL DETECTED).
+/ RETURN + 3 IF MATCH IS FOUND WITH THE NEXT PARSE POSITION IN THE LINE IN
+/ THE AC AND THE DISPATCH ADDRESS FROM THE TABLE IN "KEYDSP".
+
+KEYPRS, .-. /KEYWORD PARSE ROUTINE
+ DCA LOOK3 /SAVE IN CASE OF FAIL
+ TAD LOOK3 /RE-GET
+/ AND (137) /MAKE CHARACTER UPPER-CASE, NO PARITY /MD013
+ JMS SCNEL /TRY TO SCAN OFF A KEYWORD
+ JMP KP45 /END OF LINE ENCOUNTERED
+ TAD PTABLE /GET ADDRESS OF TABLE
+ DCA LOOK2 /STORE IN LOCAL POINTER
+
+KP10, TAD SCAN1 /GET ADDRESS OF SCAN ELEMENT
+ DCA LOOK1 /INTO LOCAL POINTER
+
+KP20, TAD I LOOK1 /GET A CHARACTER FROM THE SCAN ELEMENT
+ CIA /NEGATE FOR COMPARE
+ TAD I LOOK2 /GET A CHAR FROM THE TABLE ELEMENT
+ SZA CLA /SKIP IF MATCH
+ JMP KP90 /NO MATCH, SET TO LOOK AT NEXT TABLE ENTRY
+ TAD LOOK1 /CHECK IF ALL ENTERED CHARS MATCH
+ CIA /NEGATE TO COMPARE
+ TAD SCAN2 /HAVE WE MATCHED TO THE TERMINATOR?
+ SNA CLA /SKIP IF NO
+ JMP KP40 /YES, GOT ENOUGH TO MATCH
+ ISZ LOOK1 /MORE TO MATCH, BUMP SCAN ELEMENT POINTER
+ ISZ LOOK2 /BUMP TABLE ELEMENT POINTER
+ JMP KP20 /CONTINUE MATCH LOOP
+
+KP40, TAD LOOK2 /GET CURRENT TABLE POINTER
+ JMS FNDEND /FIND A NULL MARK
+ IAC /BUMP BY 1
+ DCA LOOK1 /STORE IN A POINTER
+ TAD I LOOK1 /GET DISPATCH ADDRESS
+ DCA KEYDSP /PUT INTO DISPATCH ADDRESS
+ ISZ KEYPRS /BUMP RETURN
+ ISZ KEYPRS /BUMP AGAIN
+ CLA CLL IAC /AC = 1
+ TAD SCAN2 /GET POINTER TO END OF CURRENT KEY
+ JMP I KEYPRS /RETURN
+
+/ END OF LINE ENCOUNTERED ON PARSE.
+
+KP45, ISZ KEYPRS /BUMP RETURN ONCE FOR EOL
+
+/ NO MATCHES IN THE TABLE HERE.
+
+KP50, TAD LOOK3 /GET ORIGINAL AC
+ JMP I KEYPRS /RETURN
+\f/ FAILURE ON CURRENT TABLE ENTRY, SET FOR NEXT ENTRY (IF THERE IS ONE) AND TRY
+/ AGAIN.
+
+KP90, TAD LOOK2 /GET TABLE POINTER
+ JMS FNDEND /FIND NEXT TABLE ENTRY
+ IAC;IAC /NEXT ENTRY IS 2 PAST THE NULL
+ DCA LOOK2 /RE-SET LOCAL TABLE POINTER
+ TAD I LOOK2 /CHECK END OF TABLE
+ SNA CLA /SKIP IF NOT END OF THE TABLE
+ JMP KP50 /TAKE NOT FOUND EXIT
+ JMP KP10 /TRY MATCH ON THIS ENTRY
+
+LOOK1, .-. /TEMPORARY FOR KEYPRS /014 CJL
+LOOK2, .-. /TEMPORARY FOR KEYPRS /014 CJL
+LOOK3, .-. /TEMPORARY FOR KEYPRS /014 CJL
+
+/ ROUTINE TO MOVE WORDS OF MEMORY. /014 CJL
+
+/ CALLING SEQUENCE:
+
+/ TAD (DESTINATION) /GET DESTINATION ADDRESS
+/ DCA MQ /INTO MQ /032 CJL
+/ TAD (-COUNT) /GET -NUMBER OF WORDS TO MOVE
+/ DCA MOVE4 /SETUP MOVE COUNTER
+/ TAD (SOURCE) /GET SOURCE ADDRESS
+/ JMS I (MOVE0) /CALL MOVE ROUTINE
+/ RETURN /RETURNS HERE
+
+MOVE0, .-. /MOVE ROUTINE /014 CJL
+ DCA MOVE5 /STORE SOURCE ADDRESS IN LOCAL POINTER
+ TAD MQ /GET DESTINATION ADDRESS /032 CJL
+ DCA MOVE6 /STORE IN LOCAL POINTER
+MOVE1, TAD I MOVE5 /GET A WORD FROM THE SOURCE
+ DCA I MOVE6 /MOVE TO DESTINATION
+ ISZ MOVE5 /BUMP SOURCE POINTER
+ ISZ MOVE6 /BUMP DESTINATION COUNTER
+ ISZ MOVE4 /BUMP COUNTER
+ JMP MOVE1 /LOOP
+ JMP I MOVE0 /DONE
+
+MOVE5, .-. /SOURCE POINTER FOR "MOVE"
+MOVE6, .-. /DESTINATION POINTER FOR "MOVE"
+
+ PAGE /014 CJL
+\f/ ROUTINE TO PARSE OFF A DEVICE NAME FROM THE COMMAND LINE. /O14 CJL
+
+/ CALLING SEQUENCE:
+
+/ TAD (POINTER) /AC CONTAINS POINTER TO COMMAND LINE
+/ JMS I [DPARS] /CALL ROUTINE
+/ ERROR RETURN /AC UNCHANGED
+/ GOOD RETURN /AC NOW POINTS TO REST OF LINE
+
+/ DEVNUM= DEVICE NUMBER TO USE.
+/ ":" IS THE FIFTH CHARACTER IF NOT USING DEFAULT DEVICE.
+
+DPARS, .-. /DEVICE PARSE ROUTINE /014 CJL
+ DCA DPAR10 /SAVE INITIAL POINTER TO LINE
+ TAD DPAR10 /GET POINTER
+ JMS I [NOSP] /GET PAST ANY LEADING SPACES
+ JMP DFDEV /GOT END OF LINE, USE DEFAULT DEVICE
+ DCA DPAR11 /SAVE POINTER TO LINE
+ DCA DEVNAME /INITIALIZE THE DEVICE NAME /014 CJL
+ DCA DEVNAME+1 /FOR "INQUIRE" FUNCTION /014 CJL
+ TAD (DEVNAM) /GET ADDRESS OF WHERE TO PUT DEVICE NAME/014 CJL
+ DCA PACK6P /STORE IN PACK6 POINTER
+ DCA PACK6F /INITIALIZE PACK6 FLAG FOR LOW BYTE /014 CJL
+ TAD (-4) /SET UP A COUNTER /014 CJL
+ DCA DPAR13 /FOR NO MORE THAN 4 CHARS
+DPAR1, TAD I DPAR11 /GET A CHAR FROM THE LINE
+ SNA /SKIP IF NOT <EOL> /014 CJL
+ JMP DFDEV /GOT AN <EOL>, USE DEFAULT DEVICE /014 CJL
+ TAD (-":!200) /CHECK FOR ":" /034 CJL
+ SNA CLA /SKIP IF NOT END OF DEVICE NAME
+ JMP DPAR2 /DEVICE NAME SET UP
+ TAD I DPAR11 /RE-GET CHAR
+ ISZ DPAR11 /BUMP LINE POINTER
+ PACK6 /PACK SIX-BIT /014 CJL
+ ISZ DPAR13 /BUMP CHARACTER COUNTER /014 CJL
+ JMP DPAR1 /CAN CONTINUE
+ TAD I DPAR11 /GET CHARACTER AFTER THE FOURTH /014 CJL
+ TAD (-":!200) /CHECK FOR ":" /034 CJL
+ SZA CLA /SKIP IF YES, ALL IS OK
+ JMP DFDEV /USE THE DEFAULT DEVICE
+DPAR2, ISZ DPAR11 /BUMP POINTER PAST ":"
+ TAD (DEVNAM) /GET PARSED DEVICE NAME ADDRESS /014 CJL
+ JMP DPAR4 /DO AN OS/8 "INQUIRE"
+
+DFDEV, CLA CLL /CLEAN UP /019 CJL
+ TAD DPAR10 /GET ORIGINAL AC FOR
+ DCA DPAR11 /RETURN POINTER
+DPAR4, JMS DVNUM /GET DEVICE NUMBER
+ JMP DPAR8 /DEVICE NAME ERROR
+ DCA DEVNUM /RETURN FOR CALLING PROGRAM
+ TAD DPAR11 /GET CURRENT POINTER
+ ISZ DPARS /BUMP RETURN
+ JMP I DPARS /RETURN /014 CJL
+\fDPAR8, CLA CLL /INSURE CLEAR AC
+ TAD DPAR10 /GET ORIGINAL AC
+ JMP I DPARS /TAKE ERROR EXIT
+
+DPAR10, .-. /TEMPORARY FOR DPARS /014 CJL
+DPAR11, .-. /TEMPORARY FOR DPARS /014 CJL
+DPAR13, .-. /TEMPORARY FOR DPARS /014 CJL
+DEFDEV, DEVICE DSK /DEFAULT DEVICE
+DEVNAM, FILENAM ZZZZZZ.ZZ /DEFAULT FILENAME /014 CJL
+
+/ ROUTINE TO RETURN A DEVICE NUMBER FOR A DEVICE NAME. /014 CJL
+
+/ CALLING SEQUENCE:
+
+/ TAD (ADDRESS) /AC=ADDRESS OF DEVICE NAME
+/ /*OR* 0000 IF "DSK:" IS TO BE USED
+/ ERROR RETURN /INVALID DEVICE
+/ GOOD RETURN /AC=DEVICE NUMBER
+
+DVNUM, .-. /DEVICE NUMBER ROUTINE /014 CJL
+ SNA /SKIP IF DEVICE NAME SPECIFIED
+ TAD (DEFDEV) /ELSE USE DEFAULT /014 CJL
+ DCA DVNUM9 /SAVE IN LOCAL POINTER
+ TAD I DVNUM9 /GET FIRST TWO CHARACTERS OF NAME /014 CJL
+ DCA DVNUM5 /PUT INTO CALL
+ ISZ DVNUM9 /BUMP POINTER
+ TAD I DVNUM9 /GET LAST TWO CHARACTERS OF NAME /014 CJL
+ DCA DVNUM5+1 /PUT INTO CALL
+ CIF USRFLD /GOTO USR FIELD /020 CJL
+ JMS I [USRENTRY] /CALL USER SERVICE ROUTINE /035 CJL
+ INQUIRE /INQUIRE ABOUT HANDLER /020 CJL
+DVNUM5, .-. /FIRST TWO BYTES OF DEVICE NAME /014 CJL
+ .-. /LAST TWO BYTES OF DEVICE NAME /014 CJL
+ 0 /ENTRY POINT OF HANDLER RETURNED HERE
+ JMP I DVNUM /ERROR, TAKE ERROR EXIT
+ TAD DVNUM5+1 /DEVICE NUMBER
+ ISZ DVNUM /BUMP RETURN FOR NO ERROR
+ JMP I DVNUM /RETURN
+
+DVNUM9, .-. /LOCAL FOR "DVNUM" /014 CJL
+\f/ DEVICE HANDLER FETCH ROUTINE. /020 CJL
+
+/ CALLING SEQUENCE:
+
+/ TAD (HANDLERNUMBER) /AC CONTAINS DEVICE HANDLER NUMBER
+/ JMS I [HFETCH] /CALL ROUTINE
+/ ERROR RETURN /COULDN'T LOAD HANDLER
+/ GOOD RETURN /HANDLER LOADED
+
+/ IF THE HANDLER WAS LOADED, THEN HNDADR CONTAINS THE HANDLER ENTRY POINT.
+
+HFETCH, .-. /HANDLER FETCH ROUTINE
+ DCA HANDNUMBER /STORE HANDLER NUMBER
+ TAD (HNDLR+1) /GET OUR BUFFER+(TWO PAGE ALLOWED)
+ DCA HADR /STORE IN-LINE
+ TAD HANDNUMBER /GET HANDLER NUMBER AGAIN
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USRENTRY] /CALL USER SERVICE ROUTINE /035 CJL
+ FETCH /FETCH HANDLER
+HADR, .-. /WILL BE OUR SUGGESTED ADDRESS+TWO PAGES ALLOWED
+ SKP /COULDN'T DO IT
+ ISZ HFETCH /BUMP TO GOOD RETURN
+ CLA CLL /CLEAN UP
+ TAD HADR /GET ACTUAL HANDLER ADDRESS
+ DCA HNDADR /STASH THE POINTER
+ JMP I HFETCH /RETURN EITHER WAY
+
+HANDNUM,.-. /HANDLER NUMBER TEMPORARY
+
+\f/ ROUTINE TO HANDLE THE "FINISH" COMMAND. /021 CJL
+
+FINSRV, 0
+ JMS I [CREST2] /SETUP CONSOLE OUTPUT ROUTINES /025 CJL
+ TAD (MSEND) /GET SEND MODE VALUE /045 CJL
+ DCA KMODE /SETUP PROPER MODE /045 CJL
+ FPACK /FORMAT A PACKET
+ SRVFIN /PACKET DATA ADDRESS
+ STGEN /PACKET TYPE
+
+FIN2, SPACK /SEND PACKET
+ 1 /AWAIT RESPONSE
+ FIN20-2 /DISPATCH LIST FOR RESPONSE /027 CJL
+
+/ NAK OR UNDEFINED RESPONSE HERE
+
+FIN5, ISZ RTRYC /BUMP RE-TRY COUNTER
+ JMP FIN2 /GET RESPONSE AND TRY AGAIN
+ TAD (NOFINISH) /FAILED, RETURN MESSAGE /025 CJL
+ JMP I FINSRV
+
+/ ACK HERE
+
+FIN10, ISZ FINSRV /BUMP FOR NON-ERROR EXIT
+ JMP I FINSRV /DONE
+
+FIN20, STACK; FIN10 /ACK
+ STNAK; FIN5 /NAK
+ 0
+
+SRVFIN, "F&137 /SERVER KERMIT COMMAND TO SHUT DOWN
+ -1 /END OF DATA
+
+ PAGE
+\f/ ROUTINE TO PARSE OFF A FILE NAME.
+/ FILE NAME TO BE PARSED MUST BE LETTERS OR DIGITS AND BE NO MORE THAN
+/ SIX CHARS FOR THE NAME AND TWO CHARS FOR THE EXTENSION.
+
+/ ENTER WITH: AC = POINTER TO FILE NAME TO PARSE.
+/ FNPTR = POINTER TO WHERE TO PUT THE PARSED FILE NAME.
+
+/ NON-ERROR EXIT: AC = POINTER TO REMAINDER OF COMMAND LINE.
+/ RETURN THE CALL + 2.
+
+/ ERROR EXIT: AC = ORIGINAL POINTER.
+/ RETURN THE CALL + 1.
+
+PFNAM, 0
+ DCA PFN10 /SAVE POINTER TO FILE NAME STRING
+ TAD FNPTR /GET POINTER TO FILE NAME BLOCK
+ DCA MQ /SET FOR "CLEAR" ROUTINE /032 CJL
+ TAD (-4 /FOUR WORDS TO CLEAR OUT
+ CLEAR /INIT THE FILE NAME BLOCK
+ TAD PFN10 /GET THE STRING POINTER
+ JMS I [NOSP] /GET PAST ANY LEADING SPACES
+ JMP PFNAM9 /GOT EOL, NO FILE NAME
+ DCA PFN11 /SAVE POINTER
+ TAD FNPTR /GET FILE NAME BLOCK POINTER
+ DCA PACK6P /SET UP THE "PACK6" POINTER
+ DCA PACK6F /INIT THE "PACK6" FLAG
+ TAD (-6 /MAX OF 6 CHARS FOR FILE NAME
+ DCA PFN15 /PUT INTO COUNTER
+ DCA WILDF /INIT THE WILD CARD FLAG
+ JMS NAM /MOVE AND PACK FILE NAME
+ TAD I PFN11 /GET THE TERM CHAR
+ SPA /SKIP IF NOT EOL
+ JMP PFNAM7 /EOL MEANS END OF FILE NAME
+ TAD (-".!200) /COMPARE TO "." /034 CJL
+ SNA /SKIP IF NO
+ JMP PFNAM3 /GO HANDLE EXTENSION
+ TAD (-" +".) /COMPARE TO <SP> /034 CJL
+ SZA CLA /SKIP IF WAS A SPACE
+ JMP PFNAM9 /NOT A SPACE, GOT AN ERROR
+ JMP PFNAM7 /IS A SPACE, END OF FILE NAME
+\fPFNAM3, ISZ PFN11 /BUMP PAST THE "."
+ TAD FNPTR /GET FILE NAME BLOCK POINTER
+ TAD (3) /POINT TO EXTENSION /032 CJL
+ DCA PACK6P /SET "PACK6" POINTER
+ DCA PACK6F /INIT "PACK6" FLAG
+ NL7776 /SET -2 /032 CJL
+ DCA PFN15 /COUNTER FOR 2 EXT CHARS
+ JMS NAM /NOW DO THE EXTENSION
+ TAD I PFN11 /GET THE TERM CHAR
+ SPA /SKIP IF NOT EOL
+ JMP PFNAM7 /GOT COMPLETE FILE NAME HERE
+ TAD [-" !200] /COMPARE TO <SP> /034 CJL
+ SZA CLA /SKIP IF IT WAS
+ JMP PFNAM9 /GOT A FILE NAME ERROR
+PFNAM7, ISZ PFNAM /BUMP RETURN FOR GOOD FILE NAME
+ CLA CLL /INSURE CLEAR AC
+ TAD PFN11 /GET CURRENT STRING POINTER
+ JMP I PFNAM /AND RETURN
+
+PFNAM9, CLA CLL /INSURE CLEAR AC
+ TAD PFN10 /GET ORIGINAL STRING POINTER
+ JMP I PFNAM /TAKE ERROR RETURN
+
+PFN10, 0 /TEMP FOR PFNAM ROUTINE
+PFN11, 0 /TEMP FOR PFNAM ROUTINE
+PFN15, 0 /TEMP FOR PFNAM ROUTINE
+\f/ LOCAL ROUTINE TO "PFNAM" TO MOVE IN THE FILE NAME OR FILE EXTENSION.
+/ ENTER WITH "PFN11" POINTING TO WHERE TO GET THE NAME OR EXTENSION.
+/ AND "PFN15" EQUAL TO THE MAX NUMBER OF CHARS (6 FOR NAME, 2 FOR EXT).
+/ THIS ROUTINE CHECKS FOR WILD CARD CHARS "*" AND "?" AND PUTS THE
+/ "?" CHAR IN FOR ANY CHARS IN THE NAME THAT ARE WILD. ALSO IF ANY
+/ WILD CARD CHARS ARE FOUND THE FLAG "WILDC" IS SET SO BEFORE PARSING
+/ ANY FILE NAME THE "WILDC" FLAG SHOULD BE INITIALIZED.
+
+NAM, 0
+NAM0, TAD I PFN11 /GET A CHAR FROM THE STRING
+ JMS I (ALPNUM) /MUST BE ALPHA OR NUMBER
+ SKP /NOT A ALPHA NUMERIC
+ JMP NAM3 /IS ALPHA NUMERIC
+ TAD (-"?!200) /COMPARE TO "?" /034 CJL
+ SNA /SKIP IF NO
+ JMP NAM2 /YES, JUST PUT IT IN
+ TAD (-"*+"?) /COMPARE TO "*" /034 CJL
+ SZA CLA /SKIP IF YES
+ JMP I NAM /TAKE THE FILE NAME ERROR EXIT
+ ISZ WILDF /SET FLAG FOR WILD CARD FOUND
+NAM1, TAD ["?&77] /GET WILD CARD CHARACTER /034 CJL
+ PACK6 /PUT IN NAME BLOCK
+ ISZ PFN15 /BUMP CHAR COUNTER
+ JMP NAM1 /LOOP TILL ALL FILLED
+ ISZ PFN11 /BUMP THE STRING POINTER
+ JMP NAM9 /EXIT WITH "PFN11" POINTING TO NEXT CHAR
+NAM2, ISZ WILDF /SET FLAG FOR WILD CARD FOUND
+ TAD ["?&77] /GET WILD CARD CHARACTER /034 CJL
+NAM3, PACK6 /PUT THE CHAR INTO THE FILE NAME BLOCK
+ ISZ PFN11 /BUMP THE STRING POINTER
+ ISZ PFN15 /BUMP THE CHAR COUNTER
+ JMP NAM0 /LOOP
+
+NAM4, TAD I PFN11 /NOW GET TO A TERMINATOR CHAR
+ JMS I (ALPNUM) /BY FINDING FIRST NON-ALPHNUMERIC
+ JMP NAM9 /NOW WE CAN QUIT
+ CLA CLL /IGNORE EXCESS CHARS
+ ISZ PFN11 /BUMP THE STRING POINTER
+ JMP NAM4 /LOOP
+
+NAM9, CLA CLL /LEAVE WITH A CLEAR AC
+ JMP I NAM /RETURN
+\f/ ROUTINE TO SEND A PACKET.
+/ ENTER WITH ADDRESS OF PACKET DATA IN CALL + 1.
+/ AND TYPE OF PACKET IN CALL + 2.
+/ EXIT CALL + 4 IF ACK RETURNED.
+/ EXIT CALL + 3 IF NAK OR OTHER PACKET TYPE RETURNED.
+
+SNDP, 0
+ TAD I SNDP /GET DATA ADDRESS
+ DCA SNDP1 /STORE IN CALL
+ ISZ SNDP /BUMP POINTER
+ TAD I SNDP /GET PACKET TYPE
+ DCA SNDP2 /STORE IN CALL
+ ISZ SNDP /BUMP
+
+ FPACK /FORMAT A PACKET
+SNDP1, 0 /DATA ADDRESS GOES HERE
+SNDP2, 0 /PACKET TYPE GOES HERE
+
+SNDP3, SPACK /SEND A DATA PACKET
+ 1 /GET RESPONSE
+ SNDP9-2 /RESPONSE DISPATCH TABLE ADDRESS /027 CJL
+
+/ HERE ON NOT "NAK" OR "ACK" RESPONSE.
+
+ SKP
+
+/ HERE ON "ACK".
+
+SNDP5, ISZ SNDP /BUMP RETURN
+
+ ISZ SNDP /BUMP RETURN
+ JMP I SNDP /EXIT
+
+/ HERE ON NAK.
+
+SNDP4, ISZ RTRYC /BUMP THE RE-TRY COUNTER
+ JMP SNDP3 /RE-TRY
+ JMP I SNDP /TAKE RETURN + 3
+
+SNDP9, STACK; SNDP5 /ACK
+ STACK; SNDP4 /NAK
+ 0
+
+ PAGE /014 CJL
+\f IFZERO 1 <
+
+/ ROUTINE TO PARSE OFF A DECIMAL NUMBER.
+/ ENTER ROUTINE WITH A POINTER TO THE PARSE LINE IN THE AC.
+/ EXIT: RETURN + 1 FOR NO NUMBER.
+/ RETURN + 2 FOR INVALID NUMBER.
+/ RETURN + 3 FOR VALID NUMBER.
+
+/ IN ALL CASES ON RETURN THE AC WILL CONTAIN A POINTER TO THE NEXT CHAR TO PARSE
+/ IN THE LINE. ANY NUMBER PARSED WILL BE CONVERTED TO BINARY AND PUT INTO THE
+/ REGISTER "BININP".
+
+DECPRS, 0
+ JMS I [NOSP] /GET PAST ANY LEADING SPACES
+ JMP I DECPRS /GOT AN END OF LINE, AC POINTS TO IT
+ DCA DP10 /SAVE POINTER TO LINE
+ TAD DP10 /RE-GET POINTER TO LINE
+ DCA DP11 /STORE IN OUR LINE POINTER
+ DCA BININP /INIT BINARY REGISTER
+ DCA DP13 /INIT PARSED NUMBER FLAG
+ SKP /SKIP INTO LOOP BELOW
+DP1, ISZ DP11 /BUMP THE LINE POINTER
+ TAD I DP11 /GET A CHAR FROM THE LINE
+ JMS DECCK /CHECK FOR PROPER ASCII DECIMAL
+ JMP DP5 /NOT PROPER ASCII DECIMAL
+ ISZ DP13 /FLAG NUMBER INPUT
+ TAD (-"0 /MAKE BINARY
+ DCA DP12 /AND STORE
+ TAD BININP /GET PREVIOUS INPUT
+ JMS MUL10 /AND MULTIPLY TIMES 10
+ SZL /SKIP IF NO OVERFLOW ENCOUNTERED
+ JMP DP6 /GOT AN OVERFLOW ERROR
+ TAD DP12 /COMBINE WITH CURRENT INPUT
+ SZL /SKIP IF NO OVERFLOW ERROR
+ JMP DP6 /GOT AN OVERFLOW ERROR
+ DCA BININP /RETURN ACCUMULATED SUM
+ JMP DP1 /LOOP
+
+DP5, CLA CLL /AC MAY NOT BE CLEAR
+ TAD DP13 /ANY NUMBERS INPUT YET?
+ SNA CLA /SKIP IF YES
+ JMP DP6 /TAKE THE NO NUMBER INPUT RETURN
+ ISZ DECPRS /BUMP THE RETURN
+ ISZ DECPRS /TWICE FOR GOOD NUMBER INPUT RETURN
+ TAD DP11 /GET POINTER TO LINE
+ JMP I DECPRS /AND RETURN
+
+DP6, CLA CLL /AC MAY NOT BE CLEAR
+ TAD DP10 /GET ORIGINAL LINE POINTER
+ ISZ DECPRS /BUMP THE RETURN
+ JMP I DECPRS /TAKE THE INVALID NUMBER RETURN
+
+ >
+\f IFZERO 1 <
+
+DP10, 0 /TEMP FOR DECPRS
+DP11, 0 /TEMP FOR DECPRS
+DP12, 0 /TEMP FOR DECPRS
+DP13, 0 /TEMP FOR DECPRS
+
+/ ROUTINE TO MULTIPLY THE VALUE OF THE AC TIMES 10.
+/ VALUE IN THE AC IS ASSUMED BINARY.
+
+/ THE NUMBER IS RETURNED IN THE AC. IF THE LINK IS SET THE MULTIPLY
+/ OVERFLOWED 12 BITS.
+
+MUL10, 0
+ DCA MULTMP /SAVE THE NUMBER
+ TAD MULTMP /GET THE NUMBER BACK
+ CLL RTL /MULTIPLY TIMES 4
+ TAD MULTMP /TIMES 5
+ SNL /SKIP IF ALREADY OVERFLOWED /025 CJL
+ RAL /TIMES 10
+ JMP I MUL10 /RETURN NUMBER IN AC
+ /THE LINK HAS ANY OVERFLOW
+
+MULTMP, 0 /TEMP STORAGE FOR MUL10 ROUTINE
+
+
+
+/ ROUTINE TO CHECK FOR A VALID ASCII DECIMAL VALUE.
+
+/ ENTER WITH ASCII CHAR IN THE AC.
+/ EXIT RETURN + 1 IF NON-VALID ASCII DECIMAL WITH CHAR IN AC.
+/ EXIT RETURN + 2 IF VALID ASCII DECIMAL WITH CHAR IN AC.
+
+DECCK, 0
+ DCA DECCK5 /STORE THE CHAR TO CHECK
+ TAD DECCK5 /GET THE CHAR
+ TAD (-"0 /CHECK FOR LESS THAN 0
+ SPA /SKIP IF NOT LESS THAN 0
+ JMP DECCK1 /NON-ASCII DECIMAL
+ TAD ("0-"9-1 /CHECK GREATER THAN 9
+ SMA CLA /SKIP IF LE 9
+ JMP DECCK1 /INVALID ASCII DECIMAL
+ ISZ DECCK /BUMP RETURN FOR VALID ASCII DECIMAL
+DECCK1, TAD DECCK5 /RE-GET ORIGINAL CHAR IN AC
+ JMP I DECCK /RETURN
+
+
+DECCK5, 0 /TEMP FOR "DECCK" ROUTINE
+
+ >
+\f/ ROUTINE TO INPUT A COMMAND LINE FROM THE KEYBOARD. /013/014 CJL
+
+LININP, 0
+ TAD (LINBUF /GET ADDRESS OF LINE BUFFER
+ DCA LIN50 /STORE IN A POINTER
+LIN1, JMS I (INPUT) /GET A CHARACTER FROM THE KEYBOARD /044 CJL
+ TAD (-CNTRLM) /COMPARE TO <CR> /034 CJL
+ SNA /SKIP IF NOT A RETURN
+ JMP LIN2 /LINE IS INPUT
+ TAD (-DELETE+CNTRLM)/COMPARE TO <DEL> /034 CJL
+ SNA CLA /SKIP IF NOT A DELETE
+ JMP LIN5 /OFF TO HANDLE A DELETE
+ TAD LIN50 /GET VALUE OF LINE POINTER
+ TAD (-LINBUF-LINSIZ /COMPARE WITH END OF LINE BUFFER
+ SMA CLA /SKIP IF ROOM IN LINE BUFFER
+ JMP LIN10 /BEEP FOR FULL BUFFER
+ TAD INCHAR /GET THE KEYBOARD CHARACTER AGAIN /044 CJL
+ TAD (-140) /COMPARE TO LOWER-CASE LIMIT /034 CJL
+ SMA /SKIP IF BELOW LIMIT /034 CJL
+ TAD [-40] /ELSE MAKE IT UPPER-CASE /034 CJL
+ TAD (140) /RESTORE THE CHARACTER /034 CJL
+ DCA I LIN50 /STORE IN THE LINE BUFFER
+ ISZ LIN50 /BUMP THE LINE BUFFER POINTER
+ NL7777 /SET -1 /032 CJL
+ DCA I LIN50 /TERMINATE THE LINE
+ TAD INCHAR /GET THE LATEST KEYBOARD CHARACTER BACK /044 CJL
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ JMP LIN1 /LOOP TILL A RETURN TYPED
+
+LIN2, NL7777 /SET -1 /032 CJL
+ DCA I LIN50 /INSURE STRING TERMINATED
+ JMS I [SCRIBE] /DO A /025 CJL
+ CRLF /<CR>, <LF> /025 CJL
+ JMP I LININP /DONE
+
+/ HANDLE A DELETE TYPED IN
+
+LIN5, TAD LIN50 /FIND OUT FIRST IF...
+ TAD (-LINBUF /WE ARE AT THE BEGINNING OF THE LINE
+ SNA CLA /SKIP IF NO
+ JMP LIN1 /JUST IGNORE THE DELETE
+ NL7777 /SET -1 /032 CJL
+ TAD LIN50 /GET THE LINE POINTER
+ DCA LIN50 /RETURN BACKED UP
+ DCA I LIN50 /ZERO THE CHAR
+ TAD (CNTRLH) /GET A <BS> /025 CJL
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ TAD [" &177] /GET A <SPACE> /025 CJL
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ TAD (CNTRLH) /GET A <BS> /025 CJL
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ JMP LIN1 /BACK TO INPUT
+\f/ HANDLE FULL LINE BUFFER HERE
+
+LIN10, CLA CLL /ENSURE CLEAR AC
+ TAD [CNTRLG] /GET A <BEL> CHARACTER /025 CJL
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ JMP LIN1 /WAIT FOR EITHER RETURN OF DELETE KEY
+
+LIN50, 0 /TEMP POINTER FOR "LININP" ROUTINE
+\f/ ROUTINE TO PACK TWO SIX-BIT CHARACTERS INTO A WORD. /032 CJL
+
+/ CALLING SEQUENCE:
+
+/ [PACK6PTR => CHARACTER PACKING AREA].
+/ [PACK6FLAG=0 IF PACKING INTO HIGH-ORDER BYTE.
+/ PACK6FLAG=4000 IF PACKING INTO LOW-ORDER BYTE].
+
+/ TAD CHAR /AC CONTAINS CHARACTER TO BE PACKED
+/ PACK6 /CALL VIA PAGE ZERO POINTER
+
+/ RETURNS WITH AC CLEAR AND PACK6PTR AND PACK6FLAG UPDATED FOR NEXT PACKING.
+
+PACK60, .-. /PACK SIX-BIT ROUTINE
+ AND [77] /JUST SIX-BIT
+ DCA PACK6TEMP /SAVE FOR NOW
+ NL4000 /SET INVERSION BIT
+ TAD PACK6FLAG /REVERSE THE FLAG
+ DCA PACK6FLAG /STORE BACK
+ SZL /WAS IT CLEAR?
+ JMP PACKIT /NO, GO DO LOW-ORDER
+ TAD PACK6TEMP /GET THE CHARACTER
+ RTL;RTL;RTL /MOVE UP
+ DCA I PACK6PTR /STORE IT
+ JMP I PACK60 /RETURN
+
+PACKIT, TAD I PACK6PTR /GET PREVIOUS HIGH-ORDER HALFWORD
+ TAD PACK6TEMP /ADD ON LATEST
+ DCA I PACK6PTR /STORE BOTH
+ ISZ PACK6PTR /BUMP FOR NEXT TIME
+ JMP I PACK60 /RETURN
+
+PACK6TE,.-. /PACK6 TEMPORARY
+\f/ ROUTINE TO COMPARE TWO FILE NAMES FOR EQUALITY.
+/ THE ROUTINE WILL CHECK EACH OF THE 8 FILE NAME CHARS AND IF A
+/ CHAR IN THE FIRST FILE NAME (THE ONE WE ARE LOOKING FOR) CONTAINS
+/ A "?" IT WILL MATCH ON THE SECOND FILE NAME CHAR.
+/ ENTER WITH "FCMP1" POINTING TO THE FILE NAME TO FIND, AND "FCMP2"
+/ POINTING TO THE FILE NAME TO TRY AND MATCH. EXIT + 1 IF NO MATCH
+/ AND EXIT + 2 IF MATCH. (IF NON-ZERO AC ON ENTRY, THE AC IS ASSUMED
+/ TO HAVE THE VALUE FOR "FCMP2".)
+
+FMATCH, 0
+ SZA /SKIP IF NO ARGUMENT IN AC
+ DCA FCMP2 /THIS ARGUMENT CAME IN THE AC
+ TAD FCMP1 /GET ADDRESS OF FIRST FILE NAME BLOCK
+ DCA GET6P /STORE IN A POINTER
+ DCA GET6F /INIT FLAG FOR "GET6" ROUTINE
+ TAD FCMP2 /GET ADDRESS OF SECOND FILE NAME BLOCK
+ DCA FMATP /STORE IN A LOCAL POINTER
+ DCA FMATF /INIT LOCAL FLAG
+ TAD (-10 /8 CHARS TO DO
+ DCA FMATC /STORE IN LOCAL COUNTER
+
+FMAT1, NL4000 /SET 4000 /032 CJL
+ TAD FMATF /GET FLAG
+ DCA FMATF /RETURN FLAG, LINK CONTAINS STATUS
+ TAD I FMATP /GET A WORD FROM THE SECOND NAME
+ SZL /SKIP IF HIGH-ORDER WANTED NOW /032 CJL
+ JMP FSWIT /JUMP IF LOW-ORDER WANTED NOW /032 CJL
+ RTR;RTR;RTR /MOVE DOWN HIGH-ORDER /032 CJL
+ SKP /DON'T BUMP YET /032 CJL
+FSWIT, ISZ FMATP /BUMP THE POINTER /032 CJL
+ AND [77] /KEEP ONLY BOTTOM 6 BITS /016 CJL
+ DCA FMATT /STORE IN A TEMP
+ GET6 /NOW GET A CHAR FROM FIRST NAME
+ TAD (-77 /CHECK IF WILD
+ SNA /SKIP IF NO
+ JMP FMAT2 /NO MATCH CHECK ON A WILD CARD
+ TAD [77] /RESTORE THE CHARACTER /014/016 CJL
+ CIA /NEGATE FOR COMPARE
+ TAD FMATT /COMPARE WITH SECOND FILE NAME
+ SZA CLA /SKIP IF IS A MATCH
+ JMP I FMATCH /THIS IS NOT A MATCH
+
+FMAT2, ISZ FMATC /BUMP COUNTER
+ JMP FMAT1 /LOOP, MORE TO CHECK
+ ISZ FMATCH /BUMP RETURN FOR MATCH
+ JMP I FMATCH /GOT A MATCH
+
+FMATP, 0 /POINTER FOR "FMATCH"
+FMATC, 0 /COUNTER FOR "FMATCH"
+FMATF, 0 /FLAG FOR "FMATCH"
+FMATT, 0 /TEMP FOR "FMATCH"
+FCMP1, 0 /POINTER FOR FIRST FILE NAME BLOCK
+FCMP2, 0 /POINTER FOR SECOND FILE NAME BLOCK
+\f PAGE /014 CJL
+\f/ REMOTE LINK INPUT ROUTINE.
+/ CALL = RPACK.
+
+ILINK, 0
+ TAD RETRY /SET UP A RE-TRY COUNT
+ DCA ILINK6 /RE-TRY COUNT FOR INPUT ERRORS
+
+ILINK0, JMS I (GETSOH) /FIRST GET THE "SOH" BYTE
+ JMP ILINK2 /RETURN HERE ON TIME-OUT
+ DCA ILINK9 /INIT CHECKSUM REGISTER
+ TAD [RRLEN] /GET REMOTE RECEIVE BUFFER ADDRESS
+ DCA ILINK8 /STORE IN LOCAL POINTER
+ JMS I (GETIR) /GET A CHAR
+ JMP ILINK2 /GOT A RETURN OR TIME-OUT
+ DCA I ILINK8 /STORE LENGTH IN BUFFER
+ TAD I ILINK8 /GET LENGTH CHAR BACK
+ TAD (-40-1 /CHAR FUNCTION - LENGTH BYTE
+ CIA /NEGATE FOR COUNTER
+ DCA ILINK7 /STORE IN LOCAL COUNTER
+
+ILINK1, ISZ ILINK8 /BUMP POINTER
+ JMS I (GETIR) /GET NEXT CHAR
+ JMP ILINK2 /GOT A RETURN
+ DCA I ILINK8 /STORE IN BUFFER
+ ISZ ILINK7 /BUMP COUNTER
+ JMP ILINK1 /LOOP
+
+ ISZ ILINK8
+ NL7777 /SET -1 /032 CJL
+ DCA I ILINK8
+ TAD ILINK9 /GET CALCULATED CHECKSUM
+ JMS I [CKSUM] /CALCULATE 1 BYTE CHECKSUM
+ CIA /NEGATE FOR COMPARE
+ DCA ILINK7 /STORE TEMP
+ JMS I (GETIR) /NOW GET CHECKSUM
+ JMP ILINK2 /GOT A RETURN
+ TAD ILINK7 /COMPARE WITH CALCULATED CHECKSUM
+ SNA CLA /SKIP IF NOT SAME
+ JMP ILINK4 /ARE SAME
+
+ILINK2, CLA CLL /INSURE CLEAR AC
+ ISZ ILINK6 /BUMP RE-TRY COUNTER
+ JMP ILINK3 /CAN RE-TRY
+ TAD (RPERMSG) /GET MESSAGE FOR FATAL PACKET ERROR /025 CJL
+ JMP I [CLOOP7] /AND ABORT THE MESS
+
+ILINK3, TAD ABFLAG /GET ABORT FLAG /044 CJL
+ SZA CLA /SKIP IF NO
+ JMP I (ABORT) /ABORT THIS
+ JMS I (SNDNAK) /SEND BACK A "NAK"
+ JMP ILINK0 /AND TRY AGAIN
+\fILINK4, TAD ABFLAG /GET ABORT FLAG /044 CJL
+ SNA CLA /SKIP IF YES
+ JMP I ILINK /NOPE, RETURN
+ JMP I (ABORT)
+
+ILINK6, 0 /LOCAL TO "ILINK"
+ILINK7, 0 /LOCAL TO "ILINK"
+ILINK8, 0 /LOCAL TO "ILINK"
+ILINK9, 0 /LOCAL TO "ILINK"
+
+/ HELP COMMAND ROUTINE. /024 CJL
+
+HELPSRV,.-. /HELP ROUTINE
+ JMS I [CRESET] /RESET CONSOLE ROUTINE STUFF
+ JMS I [SCRIBE] /GIVE THEM THE
+ HELPMSG /HELP MESSAGE
+ TAD ESCHAR /GET THE ESCAPE CHARACTER
+ JMS I [ESCPRNT] /PRINT IT
+ JMS I [SCRIBE] /DO A
+ CRLF /<CR>, <LF>
+ ISZ HELPSRV /BUMP PAST ERROR RETURN
+ JMP I HELPSRV /RETURN
+
+/ ROUTINE TO PRINT THE DATA IN THE RECEIVED PACKET.
+
+PRIPAK, 0
+ PRI8B; RRDTA /PRINT THE DATA
+ JMS I [SCRIBE] /DO A /025 CJL
+ CRLF /<CR>, <LF> /025 CJL
+ JMP I PRIPAK /DONE
+
+ PAGE /014 CJL
+\f/ ROUTINE TO SERVICE A SEND REQUEST.
+
+SNDSRV, 0
+ JMS I [CREST2] /SETUP CONSOLE OUTPUT ROUTINES /025 CJL
+ TAD (MSEND) /FIRST SET MODE TO SEND
+ DCA KMODE /PUT INTO MODE FLAG
+ TAD LPTR /GET CURRENT LINE POINTER
+ DCA PRSERR /SAVE LINE POSITION
+ TAD PRSERR /GET LINE POSITION
+ JMS I [DPARS] /TRY TO PARSE OFF A DEVICE NAME
+ JMS SNDERROR /RETURN A DEVICE NAME ERROR /026 CJL
+SER1, DCA PRSERR /SAVE LINE POINTER /026 CJL
+ TAD (FNBLK /GET FILE NAME BLOCK ADDRESS
+ DCA FNPTR /STORE IN POINTER
+ TAD PRSERR /GET STRING POINTER
+ JMS I [PFNAM] /PARSE OFF THE FILE NAME
+ JMS SNDERROR /FILE NAME PARSE ERROR /026 CJL
+SER2, DCA PRSERR /SAVE THE STRING POINTER /026 CJL
+ TAD PRSERR /GET THE STRING POINTER
+ JMS I [NOSP] /FIND THE END OF STRING
+ SKP /GOT END OF STRING HERE
+ JMS SNDERROR /SYNTAX ERROR /026 CJL
+SER3, DCA PRSERR /RETURN POINTER /026 CJL
+ TAD DEVNUM /GET THE DEVICE NUMBER PARSED
+ JMS I [HFETCH] /FETCH A HANDLER FOR THIS
+ JMS SNDERROR /HANDLER FETCH ERROR /026 CJL
+SER4, DCA FILFND /INIT FILE FOUND FLAG
+ DCA INIFLG /CLEAR THE INIT DONE FLAG
+ NL0001 /INITIALIZE DIRECTORY /028 CJL
+ DCA SLFLAG /LOOKUP FLAG /028 CJL
+SNDSV1, TAD (FNBLK /GET FILE NAME BLOCK ADDRESS
+ DCA I (FCMP1) /SET FOR FILE TO FINE
+ TAD SLFLAG /GET DIRECTORY FLAG /028 CJL
+ JMS I (LUKUP) /FIND A MATCH FOR THIS FILE
+ JMS SNDERROR /DIRECTORY I/O ERROR /026 CJL
+SER5, JMP S00 /FILE NOT FOUND /026 CJL
+ ISZ FILFND /BUMP FILE FOUND COUNT
+ DCA SLFLAG /DON'T INITIALIZE LOOKUP AGAIN
+ JMS I (SNDPRO) /PROCESS THIS FILE FOR SEND
+ JMS SNDERROR /ERROR IN FILE SEND PROCESS /026 CJL
+SER6, TAD WILDF /WAS WILD CARD FILE SPEC? /026 CJL
+ SZA CLA /SKIP IF NO
+ JMP SNDSV1 /GOT WILD CARD, TRY FOR NEXT
+S00, TAD FILFND /CHECK FOR ANY FILES FOUND
+ SNA CLA /SKIP IF YES
+ JMS SNDERROR /RETURN FILE NOT FOUND ERROR /026 CJL
+SER7, JMS BRKXMT /BREAK THE SEND /026 CJL
+ TAD PRSERR /GET CURRENT CURSOR POSITION
+ DCA LPTR /UPDATE
+ ISZ SNDSRV /BUMP RETURN
+ JMP I SNDSRV /AND DONE
+\f/ SEND ERRORS COME HERE. /026 CJL
+
+SNDERRO,.-. /SEND ERROR ROUTINE
+ CLA /CLEAN UP
+ TAD SNDERROR /GET CALLER
+ JMS I [SRCHTABLE] /GO MATCH IT
+ SNERTABLE-1-1 /IN ERROR TABLE
+ JMP I SNDSRV /TAKE ERROR EXIT WITH MESSAGE ADDRESS IN AC
+
+/ SEND ERROR MESSAGE DISPATCH TABLE. /026 CJL
+
+SNERTAB,-SER1; DNERMSG /DEVICE NAME ERROR
+ -SER2; FNERMSG /FILE NAME ERROR
+ -SER3; FSERMSG /FILE NAME SYNTAX ERROR
+ -SER4; SHFEMSG /HANDLER FETCH ERROR
+ -SER5; SDERMSG /DIRECTORY I/O ERROR
+ -SER6; SNDEMSG /SEND ERROR
+ -SER7; NOTFND /LOOKUP
+ 0 /THIS ENDS THE LIST
+
+FILFND, 0 /HOLDS COUNT OF # OF FILES FOUND
+SLFLAG, .-. /LOOKUP INITIALIZE FLAG /028 CJL
+FNBLK, 0
+ 0
+ 0
+ 0
+\f/ ROUTINE TO RE-SET THE SEND.
+
+BRKXMT, .-.
+ CLA CLL /INSURE CLEAR AC
+ DCA INIFLG /CLEAR THE INIT SEND FLAG
+ FPACK /FORMAT A PACKET
+ NODATA /NO DATA FOR THIS PACKET
+ STEOT /"EOT" PACKET TYPE
+ SPACK /SEND THE PACKET
+ 1 /READ RESPONSE /042 CJL
+ 0 /DO NOT DISPATCH /042 CJL
+ JMP I BRKXMT /DONE
+
+/ ROUTINE TO SEND OUT A NAK WITHOUT DISTURBING THE NORMAL PACKET BUFFER.
+
+SNDNAK, 0
+ NL7777 /-1 /042 CJL
+ TAD CURSEQ /ADD ON CURRENT SEQUENCE NUMBER /042 CJL
+ AND [77] /MODULO 64 /042 CJL
+ TAD [40] /TAKE CHAR(SEQUENCE NUMBER) /042 CJL
+ DCA NAKPAK+2 /PUT IN NAK PACKET BUFFER
+ TAD NAKPAK+1 /GET LENGTH
+ TAD NAKPAK+2 /GET SEQ
+ TAD NAKPAK+3 /GET TYPE
+ JMS I [CKSUM] /CALCULATE CHECKSUM
+ DCA NAKPAK+4 /PUT IN CHECKSUM
+ TAD REOL /GET ANY EOL REQUIRED
+ TAD [-40] /UN-CHAR IT /014/016 CJL
+ SNA /SKIP IF USING
+ NL7777 /NO EOL, PUT IN -1 INSTEAD /032 CJL
+ DCA NAKPAK+5 /PUT EOL IN
+ REM8B; NAKPAK /SEND NAK TO REMOTE
+ JMP I SNDNAK /DONE
+
+
+NAKPAK, CNTRLA /MARK /042 CJL
+ " &77+3 /LENGTH OF NAK PACKET /042 CJL
+ .-. /SEQUENCE NUMBER GOES HERE /042 CJL
+ STNAK /DATA TYPE
+ .-. /CHECKSUM /042 CJL
+ .-. /<EOL> IF USED /042 CJL
+ -1 /TERMINATE
+
+/ FILENAME BUFFER. /014 CJL
+
+NAMBUFF,ZBLOCK 12 /FILENAME.EXTENSION (WITH TERMINATOR) GOES HERE
+\f PAGE /014 CJL
+\f/ ROUTINE TO SERVICE A "GET" COMMAND.
+
+GETSRV, 0
+ JMS I [CREST2] /SETUP CONSOLE OUTPUT ROUTINES /025 CJL
+ TAD (MREC) /GET OUR MODE VALUE /045 CJL
+ DCA KMODE /SETUP NOW /045 CJL
+ TAD LPTR /GET CURRENT LINE POINTER
+ DCA PRSERR /SAVE
+ TAD PRSERR /RE-GET IT
+ JMS I [DPARS] /PARSE OFF THE DEVICE NAME /006/014 CJL
+ JMP GSRV50 /ERROR IN DEVICE NAME /006
+ JMS I [NOSP] /FIND BEGINNING OF A FILE NAME
+ JMP GSRV22 /GOT <EOL>, NO FILE NAME /006/014 CJL
+ DCA GSRV90 /STORE BEGINNING ADDRESS
+ TAD GSRV90 /NOW WE LOOK FOR
+ JMS I [SP] /THE END OF THE LINE
+ SKP /GOT THE END OF THE LINE HERE
+ JMP .-2 /NOT END YET, CONTINUE
+ DCA PRSERR /STORE POINTER TO EOL
+ NL7777 /SET -1 /032 CJL
+ DCA I PRSERR /TERMINATE FILE NAME WITH -1
+ DCA CURSEQ /RE-SET THE SEQUENCE
+ TAD GSRV90 /GET ADDRESS OF FILE NAME
+
+GSRV10, FPACK /FORMAT THE PACKET
+GSRV90, 0 /DATA ADDRESS HERE
+ STRIN /RECIEVE INIT PACKET
+
+GSRV12, SPACK /SEND THE PACKET
+ 1 /GET RESPONSE
+ GSRV80-2 /DISPATCH TABLE /027 CJL
+
+/ SERVICE A NAK OR UNDEFINED.
+
+GSRV15, ISZ RTRYC /BUMP THE RE-TRY COUNTER
+ JMP GSRV12 /TRY AGAIN
+ JMP I GETSRV /GIVE UP
+
+/ SERVICE A SEND/INIT FROM THE REMOTE.
+
+GSRV20, JMS I (INPSRV) /HANDLE JUST LIKE A RECEIVE
+ JMP GSRV21 /ERROR RETURN FROM "INPSRV"
+ ISZ GETSRV /BUMP RETURN FOR NO ERROR
+ TAD PRSERR /UPDATE THE CURRENT LINE POINTER
+ DCA LPTR
+GSRV21, JMP I GETSRV
+
+GSRV22, CLA CLL /MAKE SURE WE ARE CLEAR /009/014 CJL
+ TAD [NOTFND] /GET ERROR MESSAGE ADDRESS /025 CJL
+ JMP I GETSRV /TAKE ERROR RETURN /009/014 CJL
+
+/ GOT AN ERROR PACKET, DISPLAY ERROR AND ABORT.
+
+GSRV40, JMS I [PRIPAK] /PRINT OUT THE ERROR PACKET
+ JMP I GETSRV /TAKE THE ERROR EXIT
+\f/ GOT DEVICE ERROR. /006/014 CJL
+
+GSRV50, CLA CLL /ENSURE CLEAR AC /006/014 CJL
+ TAD (DNERMSG) /GET ERROR MESSAGE ADDRESS /025 CJL
+ JMP I GETSRV /TAKE ERROR RETURN /006/014 CJL
+
+/ DISPATCH TABLE.
+
+GSRV80, STERR; GSRV40 /ERROR PACKET RETURNED
+ STSIN; GSRV20 /SEND INIT PACKET RETURNED
+ STNAK; GSRV15 /NAK PACKET RETURNED
+ 0 /TERMINATE TABLE
+\f/ ROUTINE TO SERVICE A "RECEIVE" COMMAND.
+
+RECSRV, 0
+ JMS I [CREST2] /SETUP CONSOLE OUTPUT ROUTINES /025 CJL
+ TAD (MREC) /GET OUR MODE VALUE /045 CJL
+ DCA KMODE /SETUP NOW /045 CJL
+ TAD LPTR /GET CURRENT LINE POINTER
+ DCA PRSERR /SAVE IT
+ TAD PRSERR /GET IT BACK
+ JMS I [DPARS] /PARSE OFF DEVICE NAME /018 CJL
+ JMP RECS30 /ERROR IN DEVICE NAME /018 CJL
+ JMS I [NOSP] /CHECK IF BEGINNING OF FILE NAME /014 CJL
+ SKP /GOT <EOL> HERE /018 CJL
+ JMP RECS60 /SOMETHING ELSE ON LINE, ERROR /014 CJL
+ DCA PRSERR /SAVE CURRENT LINE POINTER /018 CJL
+ RPACK /GET SEND/INIT PACKET FROM REMOTE
+ JMS I (DISPATCH) /DISPATCH BASED ON RRTYP /031 CJL
+ RECS80-2 /TABLE ADDRESS /027/031 CJL
+ JMP RECS60 /DON'T KNOW WHAT IT IS
+
+/ GOT A SEND INIT PACKET.
+
+RECS10, JMS I (INPSRV) /OFF TO HANDLE INPUT
+ JMP RECS60 /ERROR RETURN
+
+/ TAKE THE NON-ERROR RETURN.
+
+RECS20, ISZ RECSRV /BUMP FOR NON-ERROR RETURN
+ TAD PRSERR /GET CURRENT CURSOR POSITION /018 CJL
+ DCA LPTR /UPDATE IT /018 CJL
+ JMP I RECSRV
+
+/ GOT ERROR IN DEVICE NAME. /018 CJL
+
+RECS30, CLA CLL /CLEAN UP /018 CJL
+ TAD (DNERMSG) /GET ERROR MESSAGE ADDRESS /025 CJL
+ JMP I RECSRV /TAKE ERROR RETURN /018 CJL
+
+/ TAKE THE ERROR RETURN.
+
+RECS60, CLA
+ JMP I RECSRV /TAKE ERROR EXIT
+
+/ DISPATCH TABLE.
+
+RECS80, STSIN; RECS10 /SEND INIT PACKET DISPATCH
+ STEOT; RECS60 /END OF CONNECTION
+ STBRK; RECS20 /BREAK TRANSMISSION
+ 0
+
+RECS90, 0 /TEMP FOR "RECSRV"
+\f/ KEYBOARD LINE BUFFER. /014 CJL
+
+LINBUF, ZBLOCK LINSIZE /LINE BUFFER
+
+ PAGE /014 CJL
+\f/ ROUTINE TO SERVICE INPUT OF A FILE.
+
+INPSRV, 0
+ JMS I (SETINI) /SET UP INIT REGISTERS
+ DCA OFFLG /INITIALIZE OUTPUT FILE FLAG /036 CJL
+ CIF USRFLD /GOTO USR FIELD /037 CJL
+ JMS I [USRENTRY] /CALL USER SERVICE ROUTINE /037 CJL
+ RESET /RESET TABLES /037 CJL
+ DCA CURSEQ /RE-SET THE SEQUENCE NUMBER
+
+ FPACK /FORMAT A PACKET
+ INIDAT /PACKET DATA ADDRESS
+ STACK /"ACK" PACKET TYPE
+
+
+INPS01, SPACK /SEND A PACKET
+ 1 /AWAIT RESPONSE
+ INPS91-2 /DISPATCH TABLE ADDRESS /027 CJL
+
+/ NAK OR UNDEFINED RESPONSE HERE.
+
+INPS02, ISZ RTRYC /GOT A NAK, CHECK RE-TRY COUNT
+ JMP INPS01 /RE-TRY THE INIT
+ JMS INPERROR /GIVE UP /025 CJL
+
+ IER02= . /ERROR TABLE ADDRESS /039 CJL
+
+INPS03, FPACK /FORMAT A PACKET
+ NODATA /NO DATA
+ STACK /"ACK" PACKET TYPE
+
+INPS05, SPACK /SEND A PACKET
+ 1 /AWAIT RESPONSE
+ INPS90-2 /DISPATCH TABLE ADDRESS /027 CJL
+ JMS INPERROR /UNDEFINED RESPONSE /025 CJL
+
+ IER05= . /ERROR TABLE ADDRESS /039 CJL
+
+/ GOT A DATA PACKET, WRITE TO OUTPUT FILE.
+
+INPS10, TAD OFFLG /CHECK THE OUTPUT FILE FLAG
+ SNA CLA /SKIP IF OUTPUT FILE OPEN
+ JMS INPERROR /ABORT AND EXIT /025 CJL
+IER10, JMS I (WRIPAK) /WRITE THE PACKET TO THE FILE /039 CJL
+ JMS INPERROR /ERROR WRITING PACKET /025 CJL
+IER11, JMP INPS03 /LOOP /039 CJL
+\f/ GOT A FILE HEADER PACKET, OPEN FILE.
+
+INPS20, TAD OFFLG /CHECK IF OUTPUT FILE OPEN
+ SZA CLA /SKIP IF NO
+ JMS INPERROR /ABORT IF FILE ALREADY OPEN /025 CJL
+IER20, TAD I [RRLEN] /GET CURRENT PACKET LENGTH /039 CJL
+ TAD (-40-3 /CALCULATE LENGTH OF DATA
+ SPA /SKIP IF DATA IN THE PACKET
+ JMS INPERROR /ELSE AN ERROR /025 CJL
+IER21, TAD (RRDTA) /CALCULATE LAST BYTE IN DATA /039 CJL
+ DCA INPS81 /STORE IN POINTER
+ NL7777 /SET -1 /032 CJL
+ DCA I INPS81 /TERMINATE NAME WITH A MINUS WORD
+ TAD (FNBLK /GET ADDRESS OF FILE NAME BLOCK
+ DCA FNPTR /SAVE FOR NAME PARSE
+ TAD (RRDTA /GET ADDRESS OF DATA IN PACKET
+ JMS I [PFNAM] /PARSE OFF THE FILE NAME
+ JMS INPERROR /ERROR IN FILE NAME /025 CJL
+
+/ GET TARGET DEVICE.
+
+IER23, CLA CLL /CLEAR AC FROM FILE NAME PARSE /039 CJL
+ TAD DEVNUM /GET DEVICE NUMBER PARSED /006
+ DCA ODNUMB /SAVE OUTPUT DEVICE NUMBER
+ TAD ODNUMB /GET NUMBER BACK
+ JMS I [HFETCH] /FETCH HANDLER FOR THIS DEVICE
+ JMS INPERROR /HANDLER FETCH ERROR /025 CJL
+IER24, TAD (FNBLK) /GET ADDRESS OF FILE NAME BLOCK /039 CJL
+ DCA INPS22 /PUT IN CALL
+ TAD ODNUMB /GET DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD /020 CJL
+ JMS I [USRENTRY] /CALL USER SERVICE ROUTINE /035 CJL
+ ENTER /ENTER TENTATIVE FILE /020 CJL
+INPS22, 0 /
+ 0 /
+ JMS INPERROR /NO DIRECTORY ROOM /025 CJL
+IER22, TAD INPS22 /GET NEW FILE START BLOCK /039 CJL
+ DCA FSBLK /SAVE
+ TAD INPS22+1 /GET INDICATED MAXIMUM FILE SIZE /021 CJL
+ IAC /GIVE ONE MORE THAN 2 LESS /021 CJL
+ DCA FLEN /SAVE AS DANGER COUNT /021 CJL
+ ISZ OFFLG /SET FLAG FOR OUTPUT FILE OPEN
+ NL7777 /INDICATE INITIALIZATION /020 CJL
+ JMS I [PUTBYTE] /INITIALIZE OUTPUT FILE ROUTINE /020 CJL
+ HLT /THIS CAN'T HAPPEN! /020 CJL
+ TAD FNPTR /GET POINTER TO 6 BIT FILE NAME
+ JMS I [FILN8] /MAKE 8 BIT FORMATTED STRING
+ JMS I [SCRIBE] /TELL THEM
+ FRECMSG /WE ARE RECEIVING
+ PRI8B; NAMBUF /WHICH FILE WE ARE RECEIVING
+ JMS I [SCRIBE] /DO A
+ CRLF /<CR>, <LF>
+ JMP INPS03 /LOOP
+\f/ GOT AN END OF FILE PACKET.
+
+INPS30, TAD OFFLG /ANY OUTPUT FILE OPEN?
+ SNA CLA /SKIP IF YES
+ JMS INPERROR /ERROR /025 CJL
+IER30, JMS I [FILCLOSE] /CLOSE THE FILE /020/039 CJL
+ JMS INPERROR /ERROR CLOSING THE FILE /025 CJL
+IER31,/ DCA OFFLG /RE-SET FILE OPEN FLAG /D009/039 CJL
+ JMP INPS03 /CONTINUE
+
+/ GOT AN END OF TRANSMISSION PACKET.
+
+INPS40, TAD OFFLG /WAS A FILE OPEN?
+ SZA CLA /SKIP IF NO
+ JMS I [FILCLOSE] /CLOSE ANY OPEN FILE /020 CJL
+ NOP /ERROR CLOSING THE FILE **** FIX THIS ****
+ FPACK /FORMAT A PACKET
+ NODATA /NO DATA IN PACKET
+ STACK /"ACK" PACKET TYPE
+
+ SPACK /SEND THE PACKET
+ 0 /NO RESPONSE
+ ISZ INPSRV /BUMP RETURN FOR NO ERROR
+ JMP I INPSRV /TAKE NON-ERROR EXIT
+
+/ GOT AN ERROR PACKET.
+
+INPS50, JMS I [PRIPAK] /PRINT THE PACKET DATA
+ JMP I INPSRV /AND TAKE THE ERROR EXIT /009/014 CJL
+
+/ INPUT ERRORS COME HERE. /025 CJL
+
+INPERRO,.-. /INPUT ERROR ROUTINE /025 CJL
+ FPACK /FORMAT A PACKET /025 CJL
+ NODATA /NO DATA /025 CJL
+ STBRK /"BREAK LINK" PACKET TYPE /025 CJL
+ SPACK /SEND THE PACKET /025 CJL
+ 0 /NO RESPONSE /025 CJL
+ TAD INPERROR /GET CALLER /025 CJL
+ JMS I [SRCHTABLE] /TRY TO FIND A MATCH /025 CJL
+ INERTABLE-1-1 /IN ERROR TABLE /025 CJL
+ SNA /SKIP IF FOUND PARTICULAR MESSAGE /025 CJL
+ TAD (RERRMSG) /ELSE USE GENERAL MESSAGE /025 CJL
+ JMP I INPSRV /TAKE ERROR RETURN /025 CJL
+
+/ TEMPS FOR "INPSRV".
+
+INPS80, 0
+INPS81, 0
+\f PAGE /014 CJL
+\f/ DISPATCH TABLES FOR "INPSRV".
+
+INPS90, STDAT; INPS10 /HANDLE DATA PACKETS
+ STEOF; INPS30 /HANDLE EOF PACKET
+ STEOT; INPS40 /HANDLE END OF TRANSMISSION PACKET
+ STFIL; INPS20 /HANDLE FILE NAME PACKET
+ STERR; INPS50 /HANDLE ERROR PACKET
+ 0 /TERMINATE TABLE
+
+INPS91, STNAK; INPS02 /HANDLE A NAK PACKET
+ STFIL; INPS20 /HANDLE FILE NAME PACKET
+ STERR; INPS50 /HANDLE ERROR PACKET
+ 0 /TERMINATE TABLE
+
+/ INPUT ERROR MESSAGE DISPATCH TABLE. /025/039 CJL
+
+INERTAB,-IER05; UPERMSG /UNDEFINED PACKET ERROR /025 CJL
+ -IER11; DSFLMSG /DISK OVERFLOW ERROR /042 CJL
+ -IER22; RIDEMSG /DIRECTORY FULL ERROR /025 CJL
+ -IER23; RFLNMSG /RECEIVED FILE NAME ERROR /025 CJL
+ -IER24; RHFEMSG /HANDLER FETCH ERROR /025 CJL
+ -IER31; FCLEMSG /FILE CLOSE ERROR /025 CJL
+ 0 /THIS ENDS THE LIST /025 CJL
+\f/ ROUTINE TO CHECK FOR AN ALPHABETIC OR NUMERIC CHAR.
+/ ENTER WITH THE CHAR IN THE AC.
+/ EXIT + 2 IF ALPHABETIC OR NUMERIC WITH CHAR IN THE AC.
+/ EXIT + 1 IF NON-ALPHABETIC OR NUMERIC WITH CHAR IN THE AC.
+
+ALPNUM, 0
+ JMS ALPHA /CHECK FOR ALPHA FIRST
+ SKP /NON-ALPHA RETURN, MUST CHECK NUMERIC
+ JMP ALPNM1 /IS ALPHA, TAKE RETURN + 2
+ JMS NUMRC /CHECK IF NUMERIC
+ SKP /NOT NUMERIC
+ALPNM1, ISZ ALPNUM /BUMP RETURN FOR ALPHA-NUMERIC
+ JMP I ALPNUM /DONE
+
+
+/ ROUTINE TO CHECK FOR AN ALPHABETIC CHARACTER.
+/ ROUTINE ASSUMES UPPER CASE.
+/ ENTER ROUTINE WITH CHAR IN THE AC.
+/ EXIT + 2 IF THE CHAR IS ALPHABETIC WITH THE CHAR IN THE AC.
+/ EXIT + 1 IF THE CHAR IS NOT ALPHABETIC WITH THE CHAR IN THE AC.
+
+ALPHA, 0
+ DCA ALPHA1 /STORE THE CHAR FOR RETURN
+ TAD ALPHA1 /GET THE CHAR
+ TAD (-"Z!200-1) /ADD ON UPPER LIMIT /034 CJL
+ CLL /INIT LINK FOR A FLAG
+ TAD ("Z-"A+1
+ SZL /SKIP IF NOT A LETTER
+ ISZ ALPHA /IS A LETTER, BUMP RETURN
+ CLA CLL /CLEAR AC
+ TAD ALPHA1 /RESTORE CHAR IN THE AC
+ JMP I ALPHA /TAKE PROPER RETURN
+
+ALPHA1, 0 /TEMP FOR ALPHA ROUTINE
+
+/ ROUTINE TO CHECK FOR A NUMERIC CHARACTER.
+/ ENTER WITH THE CHAR TO CHECK IN THE AC.
+/ EXIT + 2 IF NUMERIC WITH THE CHAR IN THE AC.
+/ EXIT + 1 IF NON-NUMERIC WITH THE CHAR IN THE AC.
+
+NUMRC, 0
+ DCA NUMRC1 /SAVE THE CHAR FOR RETURN
+ TAD NUMRC1 /GET THE CHAR BACK
+ TAD (-"9!200-1) /ADD ON UPPER LIMIT /034 CJL
+ CLL /INIT LINK FOR A FLAG
+ TAD ["9-"0+1] /016 CJL
+ SZL /SKIP IF NOT A DIGIT
+ ISZ NUMRC /BUMP RETURN FOR NUMERIC
+ CLA CLL /CLEAR AC
+ TAD NUMRC1 /RESTORE CHAR IN THE AC
+ JMP I NUMRC /DONE
+
+NUMRC1, 0 /TEMP FOR NUMRC CHECK ROUTINE
+\f/ ROUTINE TO WRITE THE CURRENT INPUT PACKET TO THE OUTPUT FILE.
+/ ENTER: NOTHING.
+/ EXIT: + 2 = WRITE SUCCESSFUL.
+/ + 1 = WRITE NOT SUCCESSFUL.
+
+WRIPAK, 0
+ TAD I [RRLEN] /GET LENGTH OF PACKET
+ TAD (RRDTA-40-3 /CALCULATE END OF BUFFER
+ DCA W90 /PUT INTO POINTER
+ DCA I W90 /ZERO AFTER END OF BUFFER
+ TAD (RRDTA /GET ADDRESS OF DATA
+ DCA W90 /PUT INTO POINTER
+
+W10, TAD I W90 /GET A CHAR FROM PACKET
+ SNA /SKIP IF NOT END
+ JMP W60 /END, EXIT
+ CIA /NEGATE FOR COMPARE
+ TAD RQCTL /COMPARE WITH CURRENT QUOTE CHAR
+ SNA CLA /SKIP IF NOT QUOTE CHAR
+ JMP W20 /IS QUOTE, HANDLE SPECIAL
+ TAD W92 /WAS LAST CHAR A QUOTE?
+ SZA CLA /SKIP IF NO
+ TAD (-100 /IT WAS, FIX UP THIS CHAR
+ JMP W25 /HANDLE REST BELOW
+
+W20, TAD W92 /CURRENT CHAR A QUOTE, CHECK PREVIOUS
+ SNA CLA /SKIP IF YES
+ JMP W30 /JUST THIS CHAR IS QUOTE, SET FLAG
+
+W25, TAD I W90 /GET CHAR FROM BUFFER
+ JMS I [PUTBYTE] /OUTPUT TO FILE /020 CJL
+ JMP I WRIPAK /ERROR IN OUTPUT /M020 CJL
+ JMP W35 /FINISH BELOW
+
+W30, NL0001 CLL /GOTA SET FLAG FOR QUOTE CHARACTER /032 CJL
+
+W35, DCA W92 /SET UP QUOTE FLAG
+ ISZ W90 /BUMP POINTER
+ JMP W10 /LOOP
+
+W60, ISZ WRIPAK /BUMP RETURN FOR OK
+ JMP I WRIPAK /DONE
+
+W90, 0 /POINTER FOR "WRIPAK"
+W92, 0 /TEMP FOR "WRIPAK"
+\f/ TABLE SEARCH ROUTINE. /025 CJL
+
+/ CALLING SEQUENCE:
+
+/ TAD VALUE /AC CONTAINS VALUE TO MATCH
+/ JMS I [SRCHTABLE] /CALL ROUTINE
+/ TABLE-2 /ADDRESS(TABLE)-2
+/ RETURN /ALWAYS RETURNS HERE
+
+/ IF AC=0 THEN NO MATCH OCCURRED.
+
+/ IF AC IS NON-ZERO, THEN AC CONTAINS CORRESPONDING VALUE TO MATCH WHICH IS ALSO
+/ STORED IN TABLEJUMP.
+
+/ TABLE FORMAT.
+
+/ -VALUE; CORRESPONDING VALUE /TABLE PAIR
+/ ""; "" /ADDITIONAL PAIRS AS NECESSARY
+/ 0 /ZERO TERMINATES THE TABLE
+
+SRCHTAB,.-. /TABLE SEARCH ROUTINE
+ DCA TABLEJUMP /SAVE PASSED VALUE TO MATCH
+ TAD I SRCHTABLE /GET PASSED POINTER ARGUMENT
+ DCA XR0 /STASH THE POINTER
+ ISZ SRCHTABLE /BUMP PAST ARGUMENT
+SRCHLUP,ISZ XR0 /BUMP TO NEXT PAIR
+ TAD I XR0 /GET A TABLE VALUE
+ SNA /END OF TABLE?
+ JMP I SRCHTABLE /YES, RETURN WITH CLEAR AC
+ TAD TABLEJUMP /COMPARE TO DESIRED
+ SZA CLA /SKIP IF IT MATCHES
+ JMP SRCHLUP /JUMP IF NOT
+ TAD I XR0 /GET CORRESPONDING VALUE
+ DCA TABLEJUMP /STASH IT
+ TAD TABLEJUMP /GET IT BACK
+ JMP I SRCHTABLE /RETURN WITH CORRESPONDING VAUE IN AC
+
+ PAGE /014 CJL
+\f IFZERO 1 <
+
+/ OS8 DIRECTORY FILE DATA SETUP.
+/ ENTER WITH THE DIRECTORY DATE WORD IN THE AC.
+/ EXIT WITH THE DATE IN THE BUFFER "DATBUF".
+
+FILD8, 0
+ DCA FILD89 /SAVE THE DATE WORD
+ TAD FILD89 /GET DATA WORD
+ AND (7 /KEEP ONLY YEAR BITS
+ TAD (116 /ADD 78 YEARS
+ MQL /PUT INTO MQ REGISTER
+ TAD (DATEYR /GET POINTER TO YEAR
+ JMS DECCON /CONVERT TO ASCII DATE
+ TAD FILD89 /GET DATE WORD BACK
+ CLL RTR /SHIFT DAY DOWN
+ RAR
+ AND (37 /KEEP ONLY DAY BITS
+ MQL /PUT IN MQ REGISTER
+ TAD (DATEDA /GET POINTER TO DAY
+ JMS DECCON /CONVERT TO ASCII DAY
+ TAD FILD89 /GET DATE WORD BACK
+ BSW /GET MONTH
+ CLL RTR /DOWN
+ AND (17 /KEEP ONLY MONTH BITS
+ MQL /INTO MQ REGISTER
+ TAD (DATEMO /GET ADDRESS OF WHERE TO PUT MONTH
+ JMS DECCON /CONVERT
+ JMP I FILD8 /ALL DONE
+
+FILD89, 0 /TEMP FOR "FILD8"
+
+
+/ ROUTINE TO CONVERT A BINARY VALUE INTO A TWO DIGIT ASCII DECIMAL NUMBER.
+/ ENTER WITH WHERE TO STORE THE CONVERTED NUMBER IN THE AC AND THE NUMBER IN THE
+/ MQ REGISTER.
+
+DECCON, 0
+ DCA DECC20 /STORE THE POINTER
+ TAD ("0&177-1 /GET AN ASCII ZERO
+ DCA I DECC20 /START OUT WITH A ZERO
+ MQA /GET THE BINARY VALUE
+DECC01, ISZ I DECC20 /BUMP
+ TAD (-12 /SUB 10
+ SMA /SKIP IF NO MORE DIVISION
+ JMP DECC01 /ELSE KEEP GOING
+ TAD (12+"0&177 /CONVERT REMAINDER TO ASCII
+ ISZ DECC20 /BUMP POINTER
+ DCA I DECC20 /STORE
+/ JMS FMTDAT /FORMAT FOR PRINTING /D013
+ JMP I DECCON /DONE
+
+ >
+\f IFZERO 1 <
+
+DECC20, 0 /LOCAL POINTER TO DECCON
+
+/ ROUTINE TO SET UP THE DATE IN A MM-DD-YY FORMAT TO PUT IN FRONT OF A FILE TO
+/ PASS THE FILES DATE (TEMPORY AND NOT PART OF THE KERMIT PROTOCOL).
+
+FMTDAT, 0
+ TAD DATEMO /GET FIRST CHAR OF DATE
+ DCA FDATE /MOVE IT
+ TAD DATEMO+1
+ DCA FDATE+1
+ TAD DATEDA
+ DCA FDATE+3
+ TAD DATEDA+1
+ DCA FDATE+4
+ TAD DATEYR
+ DCA FDATE+6
+ TAD DATEYR+1
+ DCA FDATE+7
+ JMP I FMTDAT /QUICK AND DIRTY
+
+DATBUF, "#&177 /FILE CREATION DATE ATTRIBUTE
+ 6+40 /LENGTH OF DATE (CHAR(X))
+DATEYR, 0 /ASCII YEAR GOES HERE
+ 0
+DATEMO, 0 /ASCII MONTH GOES HERE
+ 0
+DATEDA, 0 /ASCII DAY GOES HERE
+ 0
+ -1 /TERMINATE
+
+/ FORMATTED DATE GOES HERE.
+
+SETDAT,"ANGLEBRACKET&177 /COMMENT SIGN
+
+FDATE, 0
+ 0
+ "-&177
+ 0
+ 0
+ "-&177
+ 0
+ 0
+ 12
+ 15
+ -1
+
+ >
+\f/ DIRECTORY LOOKUP ROUTINE. /028 CJL
+
+/ CALLING SEQUENCE:
+
+/ NL0001 /IF INITIALIZING THE DIRECTORY
+
+/ OR
+
+/ CLA /CLEAR AC IF SUBSEQUENT CALL
+
+/ JMS I (LUKUP) /CALL ROUTINE
+/ I/O ERROR /DIRECTORY I/O ERROR RETURN WITH AC DIRTY
+/ NOT FOUND /FILE NOT FOUND RETURN
+/ FOUND /LATEST FILE MATCHES REQUEST
+
+/ SETS FLEN TO -(FILE LENGTH) IN RECORDS.
+
+/ SETS FSBLK TO STARTING RECORD OF FILE.
+
+/ MODIFIES DIRECTORY SEGMENT SLIGHTLY (NOT TO BE WRITTEN BACK).
+
+/ DEPENDS ON DIRXR BEING UNTOUCHED BY OTHER ROUTINES.
+
+LUKUP, .-. /DIRECTORY LOOKUP ROUTINE
+ SNA /INITIALIZING DIRECTORY?
+ JMP NXTFILE /NO, JUST GET ANOTHER FILE IF POSSIBLE
+NEXTSEG,DCA DIRRECORD /STORE LATEST DIRECTORY SEGMENT RECORD
+ JMS I HNDADR /CALL I/O HANDLER
+ PAGCNT^100+DIRFLD /READ IN A DIRECTORY SEGMENT
+ DIRBUFFER /DIRECTORY I/O BUFFER
+DIRRECO,.-. /WILL BE LATEST SEGMENT NUMBER
+ JMP I LUKUP /I/O ERROR, TAKE DIRTY IMMEDIATE RETURN
+ CDF DIRFLD /GOTO DIRECTORY FIELD
+ TAD I (FRSTRECORD) /GET FIRST RECORD OF FIRST ENTRY
+ DCA FSBLK /STASH IT
+ TAD (ENTSTRT-1) /POINT TO
+ DCA DIRXR /ENTRIES
+LOOKLUP,TAD I DIRXR /GET FIRST WORD OF ENTRY
+ SNA /SKIP IF NOT EMPTY
+ JMP EMPENTRY /JUMP IF EMPTY ENTRY
+ DCA FNAME /STORE FIRST FILENAME WORD
+ TAD I DIRXR /GET NEXT
+ DCA FNAME+1 /STORE SECOND FILENAME WORD
+ TAD I DIRXR /GET NEXT
+ DCA FNAME+2 /STORE THIRD FILENAME WORD
+ TAD I DIRXR /GET NEXT
+ DCA FNAME+3 /STORE EXTENSION WORD
+ NL7777 /BACKUP
+ TAD I (AIWNUMBER) /GET ADDITIONAL INFORMATION WORD COUNT
+ DCA AIWCNT /STASH THE COUNTER
+DCADATW,DCA DATWORD /CLEAR THE DATE WORD
+ TAD DCADATW/(DCA DATWORD)/GET STORING INSTRUCTION
+ DCA AIWSTORE /STORE IN-LINE
+ JMP AIWTEST /START LOOP THERE
+\fAIWLUP, TAD I DIRXR /GET A WORD FROM ENTRY
+AIWSTOR,DCA DATWORD+.-. /STORE IN PROPER WORD
+ ISZ AIWSTORE /BUMP TO NEXT INSTRUCTION
+AIWTEST,ISZ AIWCNT /DONE ALL ADDITIONAL INFORMATION WORDS?
+ JMP AIWLUP /NO, KEEP GOING
+ TAD I DIRXR /GET THE FILE LENGTH
+ SNA /SKIP IF VALID
+ JMP TENTRY /JUMP IF ONLY TENTATIVE FILE (NO LENGTH)
+ DCA FILENGTH /STORE FILE LENGTH
+ CDF PRGFLD /BACK TO OUR FIELD
+/ JMS I (FILTER) /CHECK IF WE LIKE THIS ONE
+ TAD (FNAME) /POINT TO LATEST FILENAME
+ JMS I (FMATCH) /CHECK FOR A MATCH
+ JMP NXTFILE /FORGET THIS ONE, IT DIDN'T MATCH
+ TAD FILENGTH /GET FILE LENGTH
+ DCA FLEN /GIVE TO CALLER TO DESTROY
+ TAD (FNAME) /POINT TO FILENAME
+ JMS I [FILN8] /PUT IN CHARACTER FORM IN BUFFER
+ ISZ LUKUP /BUMP TO FILE MATCH RETURN
+ JMP FLEXIT /EXIT THERE
+
+/ COMES HERE FROM SUBSEQUENT CALL OR MATCH FAILURE.
+
+NXTFILE,CDF DIRFLD /GOTO BUFFER FIELD
+ TAD FILENGTH /GET LATEST FILE LENGTH
+ SKP /DON'T DO EMPTY LENGTH
+
+/ COMES HERE TO BYPASS AN EMPTY ENTRY.
+
+EMPENTR,TAD I DIRXR /GET LENGTH OF EMPTY
+ CIA /WANT POSITIVE FORM
+ TAD FSBLK /UPDATE TO NEXT FILE RECORD
+ DCA FSBLK /STORE UPDATED VALUE
+TENTRY, ISZ I (FILECNT) /DONE WITH THIS SEGMENT?
+ JMP LOOKLUP /NO, KEEP GOING
+ TAD I (DIRLINK) /GET LINK TO NEXT SEGMENT
+ CDF PRGFLD /BACK TO OUR FIELD
+ SZA /END OF DIRECTORY?
+ JMP NEXTSEGMENT /NO, GO DO NEXT SEGMENT
+FLEXIT, ISZ LUKUP /BUMP PAST I/O ERROR EXIT
+ JMP I LUKUP /RETURN FOR FILE NOT FOUND
+
+AIWCNT, .-. /ADDITIONAL INFORMATION WORD COUNTER
+DATWORD,.-. /DATE WORD STORED HERE (0000 IF NONE)
+ ZBLOCK 7 /ROOM FOR MORE ADDITIONAL INFORMATION WORDS
+FILENGT,.-. /LATEST FILE LENGTH
+FNAME, ZBLOCK 4 /FILENAME AND EXTENSION STORED HERE
+
+ PAGE
+\f/ OS/8 FILE UNPACK ROUTINE. /019 CJL
+
+/ THIS ROUTINE UNPACKS BYTES FROM THE INPUT FILE ACCORDING TO THE CURRENT VALUE
+/ OF FILMODE:
+
+/ FILMODE CONTAINS 0177 (ASCII MODE). ALL BYTES ARE TREATED AS SEVEN-BIT ASCII
+/ CHARACTERS BY STRIPPING THE HIGH-ORDER BIT. END OF FILE IS THE <^Z> CHARACTER
+/ WHICH WILL BE SENT OR NOT ACCORDING TO THE CONTENTS OF OCTLZFLAG. IF
+/ OCTLZFLAG CONTAINS NON-ZERO, THEN <^Z> WILL BE SENT AT <EOF>; THE NEXT CALL
+/ WILL YIELD THE <EOF> RETURN. IF OCTLZFLAG CONTAINS ZERO, THEN DETECTION OF
+/ <^Z> YIELDS THE <EOF> RETURN IMMEDIATELY.
+
+/ FILMODE CONTAINS 4377 (BINARY MODE). ALL BYTES ARE TREATED AS EIGHT-BIT
+/ CHARACTERS AND WILL BE SENT WITHOUT <^Z> CHECK. THE NEXT CALL AFTER THE LAST
+/ BYTE OF THE LAST RECORD HAS BEEN SENT YIELDS THE <EOF> RETURN.
+
+/ CALLING CONSIDERATIONS:
+
+/ OCTLZFLAG MUST BE SETUP ACCORDINGLY IF IN ASCII MODE.
+
+/ FILMODE MUST BE SETUP ACCORDINGLY.
+
+/ FLEN MUST CONTAIN -(FILE LENGTH IN RECORDS) WHEN INITIALIZING THE INPUT FILE.
+/ IT WILL BE MODIFIED BY CALLING THIS ROUTINE.
+
+/ FSBLK MUST CONTAIN THE THE STARTING RECORD WHEN INITIALIZING THE INPUT FILE.
+
+/ HNDADR MUST ALREADY BE SETUP TO CALL THE INPUT HANDLER.
+
+/ CALLING SEQUENCE:
+
+/ CLA /OR NL7777 IF INITIALIZING THE INPUT FILE
+/ JMS I (GETBYTE) /CALL ROUTINE
+/ I/O ERROR RETURN /FATAL INPUT ERROR OCCURRED; AC CONTAINS JUNK
+/ END OF FILE /<EOF> OCCURRED
+/ GOOD RETURN /AC CONTAINS LATEST SEVEN/EIGHT-BIT CHARACTER
+
+GETBYTE,.-. /GET A BYTE ROUTINE
+ SNA CLA /INITIALIZING?
+ JMP I PUTC /NO, GO GET NEXT BYTE
+ TAD FSBLK /GET STARTING RECORD OF INPUT FILE
+ DCA GETRECORD /STORE IN-LINE
+GETNEWR,JMS I HNDADR /CALL I/O HANDLER
+ PAGCNT^100+BUFFLD /READ SOME PAGES INTO BUFFER FIELD
+GETCORE,FILBUFFER /BUFFER ADDRESS
+GETRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP I GETBYTE /INPUT ERROR!
+ TAD GETCORE/(FILBUFFER) /SETUP THE
+ DCA BUFPTR /BUFFER POINTER
+\fGETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
+ JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
+ JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
+ TAD THIRD /GET THIRD BYTE
+ JMS PUTC /SEND IT BACK
+ TAD BUFPTR /GET THE POINTER
+ TAD (-PAGCNT^200-FILBUFFER) /COMPARE TO LIMIT
+ SZA CLA /SKIP IF AT END
+ JMP GETLOOP /KEEP GOING
+ ISZ GETRECORD /BUMP TO NEXT RECORD
+ ISZ FLEN /DONE ALL RECORDS? (BINARY MODE ONLY)
+ JMP GETNEWRECORD /NO, GO DO ANOTHER ONE
+
+/ BINARY <EOF> REACHED HERE.
+
+ JMP GETEOF /TAKE SKIP RETURN TO MAIN CALLER
+
+PUTONE, .-. /SEND BACK A BYTE ROUTINE
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD I BUFPTR /GET LATEST WORD
+ AND [7400] /JUST THIRD-BYTE NYBBLE
+ CLL RAL /MOVE UP
+ TAD THIRD /GET OLD NYBBLE (IF ANY)
+ RTL;RTL /MOVE UP NYBBLE BITS
+ DCA THIRD /SAVE FOR NEXT TIME
+ TAD I BUFPTR /GET LATEST WORD AGAIN
+ JMS PUTC /SEND BACK CURRENT BYTE
+ ISZ BUFPTR /BUMP TO NEXT WORD
+ JMP I PUTONE /RETURN
+
+PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
+ CDF PRGFLD /BACK TO OUR FIELD
+ RAL /MOVE UP
+ STL RAR /MOVE DOWN WITH BIT[0] SET
+ AND FILMODE /KEEP ONLY GOOD BITS
+ TAD [-CNTRLZ] /COMPARE TO <^Z>
+ SNA /SKIP IF NOT ASCII MODE <EOF>
+ JMP GETEND /JUMP IF ASCII MODE <EOF>
+GETUPZ, TAD [CNTRLZ] /RESTORE THE CHARACTER
+ AND [377] /ENSURE EIGHT-BIT (MIGHT ALREADY BE SEVEN-BIT)
+ ISZ GETBYTE /BUMP PAST <EOF> RETURN
+GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN
+ JMP I GETBYTE /RETURN TO MAIN CALLER
+
+/ GOT <Z> IN ASCII MODE.
+
+GETEND, TAD OCTLZFLAG /GET <^Z> DISPOSITION FLAG
+ SNA CLA /SKIP IF SET
+ JMP GETEOF /JUST RETURN <EOF> CONDITION
+ TAD (GETEOF) /POINT TO <EOF>
+ DCA PUTC /FOR NEXT TIME
+ JMP GETUPZ /GIVE THEM BACK <^Z> THIS TIME
+\f/ OS/8 FILE PACK ROUTINE. /020 CJL
+
+/ THIS ROUTINE PACKS BYTES INTO THE OUTPUT FILE ACCORDING TO THE CURRENT VALUE
+/ OF FILMODE:
+
+/ FILMODE CONTAINS 0177 (ASCII MODE). ALL BYTES ARE TREATED AS SEVEN-BIT ASCII
+/ CHARACTERS BY STRIPPING THE HIGH-ORDER BIT.
+
+/ FILMODE CONTAINS 4377 (BINARY MODE). ALL BYTES ARE TREATED AS EIGHT-BIT
+/ CHARACTERS AND WILL BE WRITTEN AS IS.
+
+/ CALLING CONSIDERATIONS:
+
+/ FILMODE MUST BE SETUP ACCORDINGLY.
+
+/ FLEN MUST CONTAIN -(MAXIMUM FILE LENGTH IN RECORDS) WHEN INITIALIZING THE
+/ TENTATIVE OUTPUT FILE. IT WILL BE MODIFIED BY CALLING THIS ROUTINE.
+
+/ FSBLK MUST CONTAIN THE STARTING RECORD WHEN INITIALIZING THE TENTATIVE OUTPUT
+/ FILE.
+
+/ HNDADR MUST ALREADY BE SETUP TO CALL THE OUTPUT HANDLER.
+
+/ CALLING SEQUENCE:
+
+/ NL7777 /ANY NEGATIVE VALUE
+/ JMS I [PUTBYTE] /CALL ROUTINE TO INITIALIZE
+/ IMPOSSIBLE /CAN'T RETURN HERE
+/ GOOD RETURN /ALWAYS RETURNS HERE
+
+/ OR
+
+/ TAD (CHAR&377) /ANY EIGHT-BIT (OR LESS) VALUE
+/ JMS I [PUTBYTE] /CALL ROUTINE TO PACK A CHARACTER
+/ ERROR RETURN /I/O ERROR WHILE WRITING A BUFFER
+/ GOOD RETURN /CHARACTER PACKED WITH NO ERRORS
+
+/ ALL RETURNS CLEAR THE AC.
+
+PUTBYTE,.-. /OUTPUT A BYTE ROUTINE
+ SPA /ARE WE INITIALIZING?
+ JMP PUTINITIALIZE /YES
+ AND FILMODE /REDUCE TO SEVEN-BIT/EIGHT-BIT
+ DCA LATEST /SAVE LATEST CHARACTER
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD LATEST /GET LATEST CHARACTER
+ JMP I PUTNEXT /GO WHERE YOU SHOULD GO
+
+PUTNEXT,.-. /EXIT ROUTINE
+ ISZ PUTBYTE /BUMP TO GOOD RETURN
+PUTERRO,CLA CLL /CLEAN UP
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMP I PUTBYTE /RETURN TO MAIN CALLER
+\fPUTINIT,CLA /CLEAN UP
+ TAD FSBLK /GET STARTING RECORD OF TENTATIVE FILE
+ DCA PUTRECORD /STORE IN-LINE
+ DCA I (FLENGTH) /CLEAR ACTUAL FILE LENGTH
+PUTNEWR,TAD PUTCORE/(FILEBUFFER) /SETUP THE
+ DCA BUFPTR /BUFFER POINTER
+PUTLOOP,JMS PUTNEXT /GET A CHARACTER
+ DCA I BUFPTR /STORE IT
+ TAD BUFPTR /GET POINTER VALUE
+ DCA TEMPTR /SAVE FOR LATER
+ ISZ BUFPTR /BUMP TO NEXT
+ JMS PUTNEXT /GET A CHARACTER
+ DCA I BUFPTR /STORE IT
+ JMS PUTNEXT /GET A CHARACTER
+ RTL;RTL /MOVE UP
+ AND [7400] /ISOLATE HIGH NYBBLE
+ TAD I TEMPTR /ADD ON FIRST BYTE
+ DCA I TEMPTR /STORE COMPOSITE
+ TAD LATEST /GET LATEST CHARACTER
+ RTR;RTR;RAR /MOVE UP AND
+ AND [7400] /ISOLATE LOW NYBBLE
+ TAD I BUFPTR /ADD ON SECOND BYTE
+ DCA I BUFPTR /STORE COMPOSITE
+ ISZ BUFPTR /BUMP TO NEXT
+ TAD BUFPTR /GET LATEST POINTER VALUE
+ TAD (-PAGCNT^200-FILBUFFER) /COMPARE TO LIMIT
+ SZA CLA /SKIP IF AT END
+ JMP PUTLOOP /KEEP GOING
+ CDF PRGFLD /BACK TO OUR FIELD
+ ISZ FLEN /TOO MANY RECORDS?
+ SKP /SKIP IF NOT
+ JMP I PUTBYTE /TAKE ERROR RETURN
+ JMS I HNDADR /CALL I/O HANDLER
+ PAGCNT^100+BUFFLD+WRITE /WRITE SOME PAGES FROM BUFFER FIELD
+PUTCORE,FILBUFFER /BUFFER ADDRESS
+PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP PUTERROR /OUTPUT ERROR!
+ ISZ I (FLENGTH) /BUMP ACTUAL LENGTH
+ ISZ PUTRECORD /BUMP TO NEXT RECORD
+ JMP PUTNEWRECORD /KEEP GOING
+
+BUFPTR, .-. /INPUT/OUTPUT BUFFER POINTER
+
+/ ASCII FILE MODE <^Z> OUTPUT DISPOSITION FLAG.
+
+OCTLZFL,OCLOSE /ZERO=DON'T SEND <^Z> AT <EOF>,
+ /NON-ZERO=SEND <^Z> AT <EOF>
+
+ THIRD= PUTNEXT /THIRD BYTE TEMPORARY
+
+ TEMPTR= PUTONE /TEMPORARY BUFFER POINTER
+\f PAGE
+\f/ OUTPUT FILE CLOSE ROUTINE /020 CJL
+
+/ THIS ROUTINE CLOSES THE OPEN OUTPUT FILE ACCORDING TO THE CURRENT VALUE OF
+/ FILMODE:
+
+/ FILMODE CONTAINS 0177 (ASCII MODE). ALL BYTES PRIOR TO CLOSE ARE STRIPPED
+/ SEVEN-BIT CHARACTERS. IF THE LAST CHARACTER SENT TO PUTBYTE (CONTENTS OF
+/ LATEST) IS A <^Z>, THEN JUST CLOSE THE FILE. IF NOT, THEN IF ICTLZFLAG IS
+/ NON-ZERO, INSERT A <^Z> CHARACTER INTO THE FILE AS <EOF> INDICATOR, ELSE JUST
+/ CLOSE THE FILE.
+
+/ FILMODE CONTAINS 4377 (BINARY MODE). ALL BYTES PRIOR TO CLOSE ARE EIGHT-BIT
+/ CHARACTERS. IF NECESSARY, <NUL> CHARACTERS WILL BE APPENDED TO THE END OF THE
+/ LAST BLOCK OF THE FILE TO FILL IT. THE FILE IS CLOSED OTHERWISE UNMODIFIED.
+
+/ CALLING CONSIDERATIONS.
+
+/ OFFLG MUST BE SET (OUTPUT FILE IS OPEN).
+
+/ FLENGTH MUST CONTAIN THE ACTUAL FILE LENGTH.
+
+/ LATEST MUST CONTAIN THE LAST BYTE SENT TO THE OUTPUT FILE VIA PUTBYTE (ASCII
+/ MODE ONLY).
+
+/ ICTLZFLAG MUST BE SETUP ACCORDINGLY.
+
+/ FILMODE MUST BE SETUP ACCORDINGLY.
+
+/ CALLING SEQUENCE:
+
+/ CLA CLL /CLEAR AC
+/ JMS I (FILCLOSE) /CALL ROUTINE
+/ ERROR RETURN /ERROR WHILE CLOSING FILE
+/ GOOD RETURN /FILE CLOSED PROPERLY
+
+/ ON RETURN, OFFLG WILL BE CLEAR; THE AC WILL BE CLEAR ALSO.
+
+FILCLOS,.-. /OUTPUT FILE CLOSE ROUTINE
+ TAD FILMODE /GET CURRENT FILE MODE
+ SPA CLA /SKIP IF ASCII
+ JMP CLOSIT /JUMP IF BINARY
+ TAD LATEST /GET LATEST CHARACTER
+ TAD [-CNTRLZ] /COMPARE TO <^Z>
+ SZA CLA /SKIP IF <^Z> ALREADY IN FILE
+ TAD ICTLZFLAG /GET <^Z> DISPOSITION FLAG
+ SNA CLA /SKIP IF SET
+ JMP CLOSIT /JUMP IF NOT
+ TAD [CNTRLZ] /GET A <^Z>
+\fCLOSLUP,JMS I [PUTBYTE] /OUTPUT A BYTE
+ JMP CLOSERROR /ERROR WHILE WRITING
+CLOSIT, TAD I (BUFPTR) /GET THE BUFFER POINTER
+ TAD (-FILBUFFER) /COMPARE TO RESET VALUE
+ SZA CLA /SKIP IF IT MATCHES
+ JMP CLOSLUP /ELSE KEEP GOING
+ TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USRENTRY] /CALL USER SERVICE ROUTINE /035 CJL
+ CLOSE /CLOSE FILE
+ FNBLK /=> FILENAME
+FLENGTH,.-. /ACTUAL FILE LENGTH
+CLOSERR,SKP CLA /ERROR WHILE CLOSING THE FILE
+ ISZ FILCLOSE /BUMP RETURN IF NO ERRORS
+ DCA OFFLG /CLEAR OUTPUT FILE OPEN FLAG
+ JMP I FILCLOSE /RETURN TO CALLER
+
+/ ASCII FILE MODE <^Z> INPUT DISPOSITION FLAG.
+
+ICTLZFL,ICLOSE /ZERO=DON'T ENSURE <^Z> IN FILE, NON-ZERO=PACK <^Z>
+ /IF LAST CHARACTER WASN'T <^Z>
+\f/ SEND PROCESSING
+
+SNDPRO, 0
+ TAD INIFLG /CHECK IF SEND/INIT HAS BEEN DONE
+ SZA CLA /SKIP IF NO
+ JMP SNDP10 /RIGHT INTO FILE TRANSFER
+ TAD (DEFCK /SET UP DEFAULT CHECKSUM
+ DCA RCHKT
+ TAD (DEFEOL /GET DEFAULT EOL
+ DCA REOL /AND SET IT
+ TAD (DEFQCTL /GET DEFAULT QUOTE CONTROL CHAR
+ DCA RQCTL /AND SET IT UP
+ TAD (DEFMAXL+40 /GET DEFAULT MAX BUFFER SIZE
+ DCA RMAXL /SET IT UP
+ DCA CURSEQ /RE-SET SEQUENCE NUMBER
+ JMS I (SNDI00) /HANDLE "SEND-INIT"
+ JMP I SNDPRO /TAKE ERROR RETURN /014 CJL
+
+/ SEND FILE HEADER DISPATCH ROUTINE
+
+SNDP10, FPACK /FORMAT A PACKET
+ NAMBUF /ADDRESS OF FILE HEADER FOR DATA
+ STFIL /"FIL" PACKET TYPE
+
+SNDP11, SPACK /SEND A PACKET
+ 1 /AWAIT RESPONSE
+ SNDP96-2 /DISPATCH TABLE ADDRESS /026 CJL
+
+/ GOT A NAK OR UNDEFINED HERE
+
+SNDP12, ISZ RTRYC /BUMP THE COUNTER
+ JMP SNDP11 /TRY AGAIN
+ JMP I SNDPRO /TAKE ERROR RETURN /014 CJL
+
+/ FILE CREATION DATE HANDLING
+
+SNDP15, IFZERO 1 <
+
+ TAD RCAPAS /CHECK IF REMOTE SUPPORTS FILE
+ AND (10 / ATTRIBUTES
+ SNA CLA /SKIP IF YES
+ JMP SNDP20 /SKIP IF NO
+ FPACK /FORMAT PACKET
+ DATBUF /DATE DATA
+ STATT /"ATT" PACKET TYPE
+
+SNDP16, SPACK /SEND THE PACKET
+ 1 /AWAIT RESPONSE
+ SNDP98-2 /DISPATCH TABLE ADDRESS /027 CJL
+ JMP I SNDPRO /TAKE ERROR RETURN /014 CJL
+
+ >
+\f/ GOT ACK HERE
+
+SNDP20, JMS I [SCRIBE] /TELL THEM /025 CJL
+ FSENMSG /WE ARE SENDING /025 CJL
+ PRI8B; NAMBUF /TELL THEM THE NAME OF THE FILE
+ JMS I [SCRIBE] /DO A /025 CJL
+ CRLF /<CR>, <LF> /025 CJL
+ JMS SLOOP
+ SKP /ERROR RETURN
+ ISZ SNDPRO /BUMP FOR NON-ERROR EXIT
+ JMP I SNDPRO
+\f/ DATA SEND LOOP.
+/ ROUTINE TO GET CHARS FROM THE INPUT BUFFER AND SEND THEM TO REMOTE
+/ VIA PACKET TRANSFERS. RETURN + 1 IF ERROR, + 2 IF DONE.
+
+SLOOP, 0
+ JMS I (INIOPB) /INIT OUTPUT PACKET HOLD BUFFER
+ NL7777 /INITIALIZE INPUT FILE ROUTINE /019 CJL
+SLOP01, JMS I (GETBYTE) /GET A FILE CHARACTER /019 CJL
+ JMP I SLOOP /FATAL I/O ERROR /026 CJL
+ JMP SLOP15 /HERE ON EOF
+ JMS I (OPBUF) /PUT INTO PACKET BUFFER
+ SKP /RETURN HERE ON BUFFER FULL
+ JMP SLOP01 /RETURN HERE IF STILL ROOM
+
+/ PACKET IS FULL HERE, WE MUST SEND IT.
+
+ FPACK /FORMAT A PACKET
+ HOLDBF /DATA ADDRESS
+ STDAT /"DAT" PACKET TYPE
+
+SLOP05, SPACK /SEND PACKET
+ 1 /AWAIT RESPONSE
+ SLOP90-2 /RESPONSE TABLE ADDRESS /027 CJL
+
+/ HERE ON NAK OR FALL THRU ON UNDEFINED RESPONSE ABOVE.
+
+SLOP10, ISZ RTRYC /BUMP THE RE-TRY COUNTER
+ JMP SLOP05 /TRY AGAIN
+ JMP I SLOOP /TAKE ERROR RETURN /026 CJL
+
+/ HERE ON END OF FILE -- SEND THEM WHAT WE HAVE.
+
+SLOP15, TAD I (OP2) /GET THE POINTER /052 CJL
+ TAD (-HOLDBF) /COMPARE TO EMPTY VALUE /052 CJL
+ SNA CLA /SKIP IF NOT EMPTY /052 CJL
+ JMP SLOP35 /JUMP IF EMPTY /052 CJL
+ FPACK /FORMAT A PACKET
+ HOLDBF /ADDRESS OF DATA
+ STDAT /"DAT" PACKET TYPE
+
+SLOP20, SPACK /SEND A PACKET
+ 1 /AWAIT RESPONSE
+ SLOP92-2 /DISPATCH TABLE ADDRESS /027 CJL
+
+/ NAK FOR LAST PACKET.
+
+SLOP25, ISZ RTRYC /BUMP RE-TRY COUNTER
+ JMP SLOP20 /TRY AGAIN
+ JMP I SLOOP /TAKE ERROR RETURN /026 CJL
+\f/ ACK FOR FINAL PACKET, SEND AN EOF PACKET.
+
+SLOP35, JMS I [SNDP] /SEND A PACKET
+ NODATA /NO DATA
+ STEOF /MAKE IT AN EOF PACKET
+ JMP I SLOOP /NAK, TAKE ERROR RETURN
+ JMP I SLOOP /OTHER THAN ACK, NAK; TAKE ERROR RETURN /026 CJL
+ ISZ SLOOP /EOF ACCEPTED, BUMP FOR GOOD RETURN
+ JMP I SLOOP /TAKE GOOD RETURN
+
+ PAGE
+\fSLOP90, STACK; SLOP01 /ACK, CONTINUE
+ STNAK; SLOP10 /NAK, HANDLE
+ 0
+
+SLOP92, STACK; SLOP35 /ACK, CONTINUE
+ STNAK; SLOP25 /NAK, HANDLE
+ 0
+
+/ COMMAND DISPATCH TABLE FOR SEND SERVICE.
+
+SNDP96, STACK; SNDP15 /FILE HEADER ACKNOWLEDGED
+ STNAK; SNDP12 /NAK RETURNED, RE-TRY
+ 0 /END OF TABLE
+
+SNDP98, STACK; SNDP20 /DATE ATTRIBUTE ACKNOWLEDGED
+ 0 /END OF TABLE
+\f/ ROUTINE TO HANDLE A "SEND-INIT" COMMAND.
+/ RETURN + 1 IF ERROR.
+/ RETURN + 2 IF SUCCESSFUL.
+
+SNDI00, 0
+ FPACK /FORMAT A PACKET
+ INIDAT /ADDRESS OF DATA FOR PACKET
+ STSIN /"SIN" PACKET TYPE
+
+SNDI02, SPACK /SEND A PACKET
+ 1 /AWAIT RESPONSE
+ SNDI80-2 /RESPONSE TABLE TYPE /027 CJL
+
+/ HERE ON NAK OR UNDEFINED.
+
+SNDI05, ISZ RTRYC /BUMP RE-TRY COUNTER
+ JMP SNDI02 /TRY AGAIN
+ JMP I SNDI00 /TAKE ERROR EXIT
+
+/ HERE ON ACK.
+
+SNDI10, JMS SETINI /SET UP THE INIT REGISTERS
+ NL0001 CLL /NOW FLAG THE SEND/INIT DONE /032 CJL
+ DCA INIFLG /BY MAKING THIS NON-ZERO
+ ISZ SNDI00 /BUMP FOR NON-ERROR RETURN
+ JMP I SNDI00 /BACK TO MAIN SEND PROCESSING
+
+SNDI80, STACK; SNDI10 /GOT AN ACK
+ STNAK; SNDI05 /NAK
+ 0 /END OF TABLE
+
+
+/ ROUTINE TO MOVE THE SEND/INIT OR RECEIVE/INIT PACKET INTO THE INIT REGISTERS.
+
+SETINI, 0
+ TAD (RMAXL /GET ADDRESS OF RECEIVE INIT REGISTERS
+ DCA MQ /SETUP FOR CLEAR ROUTINE /032 CJL
+ TAD (RMAXL-INITEND) /GET -(NUMBER OF REGISTERS) /022 CJL
+ CLEAR /CLEAR OUT A CHUNK OF MEMORY /M013
+/ TAD (RMAXL /GET ADDRESS OF RECEIVE INIT REGISTERS
+/ DCA MQ /SETUP FOR MOVE ROUTINE /032 CJL
+ TAD I [RRLEN] /GET LENGTH OF PACKET JUST INPUT
+ TAD (-40-4 /COUNT OF DATA RECEIVED
+ TAD (RMAXL-INITEND) /COMPARE TO MAXIMUM ALLOWED /022 CJL
+ SMA SZA /SKIP IF NOT TOO MANY /022 CJL
+ CLA /ELSE USE ALLOWED MAXIMUM /022 CJL
+ TAD (INITEND-RMAXL) /RESTORE VALUE /022 CJL
+ CIA /MAKE IT NEGATIVE
+ DCA MOVE4 /SAVE FOR "MOVE" ROUTINE
+ TAD (RRDTA /ADDRESS OF DATA IN PACKET
+ MOVE /MOVE THE INIT REGISTERS
+ JMP I SETINI /DONE
+\f IFZERO 1 < /D013
+
+/ ROUTINE TO SEND THE DATE IN A DATA PACKET.
+/ RETURN + 1 IF ERROR, + 2 IF SUCCESSFUL.
+
+DATOUT, 0
+ JMS INIOPB /INSURE PACKET HOLD BUFFER INITIALIZED
+ TAD (SETDAT /GET ADDRESS OF DATE
+ DCA DATOU9 /PUT INTO POINTER
+
+DATOU1, TAD I DATOU9 /GET A CHAR
+ ISZ DATOU9 /BUMP POINTER
+ SPA /SKIP IF NOT ENT
+ JMP DATOU2 /DONE
+ JMS OPBUF /PUT INTO HOLD BUFFER
+ SKP /HOLD FULL, SEND IT
+ JMP DATOU1 /LOOP
+
+DATOU2, CLA CLL /INSURE CLEAR AC
+ FPACK /FORMAT A PACKET
+ HOLDBF /DATA ADDRESS
+ STDAT /DATA PACKET
+
+DATOU3, SPACK /SEND THE PACKET
+ 1 /GET RESPONSE
+ DATOU7-2 /DISPATCH TABLE ADDRESS /027 CJL
+
+/ HERE ON NAK OR UNDEFINED RESPONSE.
+
+DATOU4, ISZ RTRYC /BUMP RE-TRY COUNTER
+ JMP DATOU3 /TRY AGAIN
+ JMP I DATOUT /ABORT
+
+/ HERE ON ACK.
+
+DATOU5, ISZ DATOUT /BUMP FOR GOOD RETURN
+ JMP I DATOUT /EXIT
+
+DATOU7, STACK; DATOU5 /ACK
+ STNAK; DATOU4 /NAK
+ 0
+
+DATOU9, 0 /TEMP POINTER FOR DATOUT
+
+ > /D013
+\f/ HANDLE AN ABORT REQUEST.
+
+ABORT, CLA CLL /INSURE CLEAR AC
+ DCA ABFLAG /CLEAR ABORT FLAG NOW /044 CJL
+ TAD KMODE /GET CURRENT MODE
+ TAD (-MSEND /IS IT A SEND?
+ SZA /SKIP IF YES
+ JMP ABORT2 /NOT SEND
+
+ JMS I [SNDP] /SEND OUT A PACKET
+ ABORT9 /WHICH HAS A "D" IN THE DATA
+ STEOF /AND IS AN EOF PACKET
+ NOP /WE GOT NAK BACK HERE
+ NOP /WE GOT NEITHER NAK OR ACK HERE
+ JMS I (BRKXMT) /BREAK THE SEND
+ JMP ABORT3 /FINISH THE ABORT
+
+ABORT2, TAD (MSEND-MREC /CHECK IF IN RECEIVE MODE
+ SZA CLA /SKIP IF YES
+ JMP ABORT3 /JUST BACK TO COMMAND LOOP
+ JMS I [SNDP] /SEND A PACKET BACK FOR AN ABORT
+
+ IFZERO 1 < /D009
+
+ ABORT8 /WHICH HAS AN "X" IN THE DATA
+ STACK /MAKE IT AN ACK PACKET
+ NOP /NAK HERE
+ NOP /NOT NAK OR ACK HERE
+
+ > /D009
+
+ NODATA /NO DATA /A009
+ STBRK /BREAK TRANSMISSION /A009
+ NOP /NAK HERE /A009
+ CLA /NOT ACK OR NAK HERE /A009
+ TAD OFFLG /GET FILE OPEN FLAG /A009
+ SZA CLA /IS IT OPEN YET? /A009
+ JMS I [FILCLOSE] /CLOSE THE OUTPUT FILE /020 CJL
+ CLA /ERROR DURING CLOSE **** FIX THIS ****
+ABORT3, TAD (ABMSG) /GET MESSAGE ADDRESS /044 CJL
+ JMP I [CLOOP7] /DISPLAY THE ABORT
+
+ABORT9, "D&137 /DATA PACKET FOR SEND ABORT
+ -1
+
+ PAGE /014 CJL
+\f/ ROUTINE TO PRINT 8 BIT CHARS ON THE TTY. ENTER ROUTINE WITH THE ADDRESS OF
+/ THE TEXT IN THE AC OR IF AC IS ZERO THE ADDRESS IS IN THE CALL + 1. TEXT
+/ TERMINATES ON A MINUS WORD.
+
+PRI8B0, 0
+ SZA /SKIP IF ADDRESS NOT IN AC
+ JMP PRI8B1 /ADDRESS IS IN THE AC
+ TAD I PRI8B0 /GET ADDRESS FROM CALL + 1
+ ISZ PRI8B0 /BUMP RETURN POINTER
+PRI8B1, DCA MQ /SAVE ADDRESS OF STRING /032 CJL
+ TAD [P7ECHO] /GET CONSOLE OUTPUT ROUTINE ADDRESS /043 CJL
+ JMS EIGHTB /AND SEND IT
+ JMP I PRI8B0 /ALL DONE
+
+/ ROUTINE TO SEND 8 BIT CHARS DOWN THE REMOTE LINE. ENTER ROUTINE WITH THE
+/ ADDRESS OF THE TEXT IN THE AC OR IF AC IS ZERO THE ADDRESS IS IN THE CALL + 1.
+/ TEXT TERMINATES ON A MINUS WORD.
+
+REM8B0, 0
+ SZA /SKIP IF ADDRESS NOT IN AC
+ JMP REM8B1 /ADDRESS IN AC
+ TAD I REM8B0 /GET ADDRESS FROM CALL + 1
+ ISZ REM8B0 /BUMP RETURN
+
+REM8B1, DCA MQ /SAVE ADDRESS OF STRING /032 CJL
+ TAD (COMOUT) /GET ADDRESS OF REMOTE OUTPUT ROUTINE /046 CJL
+ JMS EIGHTB /AND SEND THE STRING
+ JMP I REM8B0 /DONE
+
+
+/ ROUTINE TO SEND 8 BIT DATA. ENTER WITH ADDRESS OF DATA IN THE MQ AND THE
+/ ADDRESS OF THE ROUTINE TO TAKE EACH BYTE IN THE AC. TEXT TERMINATES ON A
+/ MINUS WORD.
+
+EIGHTB, 0
+ DCA EIGHT5 /STORE POINTER TO ROUTINE
+ TAD MQ /GET STRING POINTER /032 CJL
+ DCA EIGHT6 /STORE IN LOCAL POINTER
+
+EIGHT1, TAD I EIGHT6 /GET A CHAR
+ ISZ EIGHT6 /BUMP THE POINTER
+ SPA /SKIP IF NOT EOL
+ JMP EIGHT2 /GOT EOL
+ JMS I EIGHT5 /CALL OUTPUT ROUTINE
+ CLA CLL /INSURE CLEAR AC
+ JMP EIGHT1 /LOOP
+
+EIGHT2, CLA CLL /CLEAR THE AC
+ JMP I EIGHTB /DONE
+
+EIGHT5, 0 /POINTER TO ROUTINE TO DO OUTPUT
+EIGHT6, 0 /POINTER TO TEXT TO OUTPUT
+\f/ ROUTINE TO UNPACK 6-BT CHARS FROM MEMORY. BEFORE CALLING INIT "GET6P" AS A
+/ POINTER TO THE STRING LOCATION AND "GET6F" SHOULD BE ZEROED TO START WITH THE
+/ TOP BYTE OF THE FIRST MEMORY LOCATION.
+
+GET60, 0
+ NL4000 /SET 4000 /032 CJL
+ TAD GET6F /GET THE FLAG
+ DCA GET6F /RETURN THE FLAG
+ TAD I GET6P /GET TWO BYTES
+ SZL /HIGH-ORDER WANTED? /032 CJL
+ JMP GETSWT /JUMP IF NOT /032 CJL
+ RTR;RTR;RTR /MOVE DOWN HIGH-ORDER HALF /032 CJL
+ SKP /DON'T BUMP POINTER YET /032 CJL
+GETSWT, ISZ GET6P /BUMP TO NEXT WORD /032 CJL
+ AND [77] /STRIP UNUSED BITS /016 CJL
+ JMP I GET60 /DONE
+
+
+/ LOCAL ROUTINE TO "FILN8" TO MAKE THE 6 BIT CHAR IN THE AC INTO 8 BITS AND
+/ STORE IN A STRING.
+
+MOV8, .-. /6-BIT CHARACTER => 7-BIT CHARACTER /028 CJL
+ SNA /SKIP IF SOMETHING PASSED /028 CJL
+ TAD [" &77] /ELSE SUPPLY A <SPACE> /025 CJL
+ TAD [" &77] /INVERT THE CHARACTER /028 CJL
+ AND [77] /JUST SIX-BITS /014/016 CJL
+ TAD [" &77] /MAKE IT SEVEN-BIT ASCII /028 CJL
+ DCA I MOV8P /STORE IN THE STRING /028 CJL
+ ISZ MOV8P /BUMP POINTER FOR NEXT TIME /028 CJL
+ JMP I MOV8 /RETURN /028 CJL
+
+MOV8P, 0 /POINTER FOR "MOV8" ROUTINE
+\f/ ROUTINE TO PULL A FILE NAME IN 6 BIT POINTED TO BY THE AC AND PLACE IN THE
+/ FILE NAME BUFFER IN 8 BIT ADDING IN THE "." TO SEPARATE FILE NAME AND
+/ EXTENSION. A MINUS WORD WILL FOLLOW THE NAME.
+
+FILN8, 0
+ DCA GET6P /SET POINTER FOR "GET6"
+ DCA GET6F /SET FLAG FOR "GET6"
+ TAD (NAMBUF /GET ADDRESS OF THE NAME BUFFER
+ DCA MOV8P /SET IN A POINTER
+ TAD (-6 /6 NAME CHARS TO DO
+ DCA FILN8C /SAVE IN COUNTER
+ GET6 /PULL A CHAR
+ SZA /SKIP IF A SPACE
+ JMS MOV8 /PUT INTO THE BUFFER
+ ISZ FILN8C /BUMP COUNTER
+ JMP .-4 /LOOP TILL ALL 6 DONE
+ TAD (".&177) /GET A "." /034 CJL
+ JMS MOV8 /PUT WITH FILE NAME
+ NL7776 /SET -2 /032 CJL
+ DCA FILN8C /2 EXTENSION CHARS
+ GET6 /GET NEXT CHAR
+ SZA /SKIP IF A SPACE
+ JMS MOV8 /PUT WITH NAME
+ ISZ FILN8C /BUMP COUNTER
+ JMP .-4 /LOOP
+ NL7777 /SET -1 /032 CJL
+ DCA I MOV8P /TERMINATE THE STRING
+ JMP I FILN8 /AND RETURN
+
+FILN8C, 0 /COUNTER FOR "FILN8"
+
+ PAGE
+\f/ CONSOLE I/O ROUTINES, ETC. /023 CJL
+
+/ CONSOLE MESSAGE PRINT ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I [SCRIBE] /CALL MESSAGE PRINT ROUTINE
+/ MESSAGEADDRESS /MESSAGE ADDRESS PASSED IN-LINE
+
+/ AC CAN BE DIRTY ON CALL.
+
+/ RETURNS WITH CLEAR AC.
+
+/ MESSAGE FORMAT:
+
+/ ALL UPPER-CASE CHARACTERS ARE ALLOWED TO EXIST IN THE MESSAGE EXCEPT '%' AND
+/ '^' WHICH ARE RESERVED. A ZERO HALF-WORD TERMINATES THE MESSAGE STRING. IF
+/ '%' IS DETECTED, A <CR> AND <LF> WILL BE OUTPUT. IF '^' IS DETECTED, THE
+/ PREVAILING CASE WILL BE REVERSED. INITIAL CASE IS LOWER-CASE. IF 'UPONLY' IS
+/ SET TO 7740, ALL CASE CHANGES ARE IGNORED AND THE OUTPUT IS FORCED TO
+/ UPPER-CASE ONLY. THE MESSAGE ADDRESS MUST BE IN FIELD ONE AND MUST NOT
+/ OVERLAP AREAS RESERVED FOR OTHER PURPOSES (OS/8 RESIDENT AT 17600-17777, USR
+/ LOCATIONS 10000-11777, ETC.).
+
+
+SCRIBE, .-. /CONSOLE MESSAGE PRINT ROUTINE
+ CLA /CLEAN UP /029 CJL
+ TAD [P7ECHO] /POINT TO /043 CJL
+RSCRENT,DCA MSGOUT /CONSOLE PRINT ROUTINE
+ TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT
+ DCA SCRPTR /STASH THE POINTER
+ ISZ SCRIBE /BUMP PAST ARGUMENT
+ TAD UPONLY /GET UPPER-ONLY VALUE /030 CJL
+ TAD [140] /ADD ON LOWER-CASE VALUE /030 CJL
+ DCA SCRCASE /STORE INITIAL CASE VALUE
+SCRLUP, CDF MSGFLD /GOTO MESSAGE FIELD
+ TAD I SCRPTR /GET LEFT HALF-WORD
+ RTR;RTR;RTR /MOVE OVER
+ JMS SCRPRNT /PRINT IT
+ CDF MSGFLD /GOTO MESSAGE FIELD
+ TAD I SCRPTR /GET RIGHT HALF-WORD
+ JMS SCRPRNT /PRINT IT
+ ISZ SCRPTR /BUMP TO NEXT PAIR
+ JMP SCRLUP /KEEP GOING
+\fSCRPRNT,.-. /CHARACTER PRINT ROUTINE
+ CDF PRGFLD /BACK TO OUR FIELD
+ AND [77] /JUST SIX BITS
+ SNA /END OF MESSAGE?
+ JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER
+ DCA SCRCHAR /NO, SAVE FOR NOW
+ TAD SCRCHAR /GET IT BACK
+ TAD (-"%!200) /IS IT "%"?
+ SNA /SKIP IF NOT
+ JMP SCRCRLF /JUMP IF IT MATCHES
+ TAD [-"^+100+"%] /IS IT "^"
+ SNA CLA /SKIP IF NOT
+ JMP SCRFLIP /JUMP IF IT MATCHES
+ TAD SCRCHAR /GET THE CHARACTER
+ AND [40] /DOES CASE MATTER?
+ SNA CLA /SKIP IF NOT
+ TAD SCRCASE /ELSE GET PREVAILING CASE
+ TAD SCRCHAR /GET THE CHARACTER
+SCRPRLF,JMS I MSGOUT /PRINT THE CHARACTER
+ JMP I SCRPRNT /RETURN
+
+SCRCRLF,TAD [CNTRLM] /GET A <CR>
+ JMS I MSGOUT /PRINT IT
+ TAD [CNTRLJ] /GET A <LF>
+ JMP SCRPRLF /CONTINUE THERE
+
+SCRFLIP,TAD UPONLY /GET UPPER-ONLY FLAG
+ SZA CLA /SKIP IF OFF
+ JMP I SCRPRNT /RETURN IF ON
+ TAD SCRCASE /GET CURRENT CASE
+ CIA /INVERT IT
+ TAD (140+100) /ADD SUM OF POSSIBLE VALUES
+ DCA SCRCASE /STORE NEW INVERTED CASE
+ JMP I SCRPRNT /RETURN
+
+/ REMOTE LINE MESSAGE PRINT ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I [RSCRIBE] /CALL MESSAGE PRINT ROUTINE
+/ MESSAGEADDRESS /MESSAGE ADDRESS PASSED IN-LINE
+
+/ AC CAN BE DIRTY ON CALL.
+
+/ RETURNS WITH CLEAR AC.
+
+/ MESSAGE FORMAT AND RESTRICTIONS ARE IDENTICAL TO SCRIBE ROUTINE.
+
+RSCRIBE,.-. /REMOTE LINE MESSAGE PRINT ROUTINE
+ CLA /CLEAN UP /029 CJL
+ TAD RSCRIBE /GET OUR CALLER
+ DCA SCRIBE /MAKE IT THEIRS
+ TAD (COMOUT) /POINT TO REMOTE OUTPUT ROUTINE
+ JMP RSCRENTRY /CONTINUE THERE
+\f/ ESCAPE CHARACTER PRINT ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ TAD ESCHAR /OR OTHER CHARACTER TO PRINT
+/ JMS I [ESCPRNT] /CALL ROUTINE
+/ RETURNS WITH CLEAR AC HERE
+
+/ CAUSES CHARACTER TO PRINT LITERALLY IF CHARACTER>37.
+/ CAUSES MESSAGE "CONTROL-" FOLLOWED BY CHARACTER+100 IF CHARACTER<40.
+
+ESCPRNT,.-. /ESCAPE CHARACTER PRINT ROUTINE
+ DCA ESCTEMP /SAVE PASSED VALUE
+ TAD ESCTEMP /GET IT BACK
+ TAD [-40] /COMPARE TO CONTROL LIMIT
+ SMA CLA /SKIP IF LESS THAN LIMIT
+ JMP ESPRINT /JUMP IF NOT
+ JMS I [SCRIBE] /GIVE THEM THE
+ CONTMSG /CONTROL MESSAGE
+ TAD [100] /MAKE IT UPPER-CASE, NOT CONTROL
+ESPRINT,TAD ESCTEMP /GET ORIGINAL VALUE
+ JMS I [P7ECHO] /PRINT IT /043 CJL
+ JMP I ESCPRNT /RETURN
+
+ MSGOUT= RSCRIBE /OUTPUT ROUTINE POINTER
+
+ESCTEMP,.-. /TEMPORARY FOR ESCPRNT ROUTINE
+SCRCASE,.-. /CURRENT MESSAGE CASE
+SCRCHAR,.-. /LATEST MESSAGE CHARACTER
+SCRPTR, .-. /MESSAGE POINTER
+
+ PAGE
+\f/ ROUTINE TO HANDLE THE "CONNECT" COMMAND. /025 CJL
+
+CONSRV, .-. /CONNECT SERVICE ROUTINE
+ JMS I [CREST2] /SETUP CONSOLE OUTPUT ROUTINES /025 CJL
+ JMS I [SCRIBE] /GIVE THE
+ CONNMSG /OPENING MESSAGE
+ TAD ESCHAR /GET THE CURRENT <ESCAPE> CHARACTER
+ JMS I [ESCPRNT] /PRINT IT
+ JMS I [SCRIBE] /GIVE THEM THE
+ CON2MSG /BRIDGING MESSAGE
+ JMS I [SCRIBE] /PRINT OUT THE
+ CPUMSG /ACTUAL CPU TYPE
+ JMS I [SCRIBE] /GIVE THEM THE
+ CON3MSG /CLOSING MESSAGE
+CORESET,DCA ESCFLAG /CLEAR <ESCAPE> SEEN FLAG
+ TAD ESCHAR /GET THE <ESCAPE> CHARACTER
+ DCA ESCH /STORE IN SEARCH LIST
+ JMS I (CONRESET) /RESET CONSOLE ROUTINES
+ JMS I (REMRESET) /RESET REMOTE LINE ROUTINES
+CONNLUP,TAD KEYERROR /GET KEYBOARD ERROR FLAG
+ SNA /SKIP IF KEYBOARD ERROR
+ TAD RINERROR /ELSE GET REMOTE ERROR FLAG
+ SZA CLA /SKIP IF NEITHER KEYBOARD NOR REMOTE LINE ERRORS
+ JMP KERROR /JUMP IF KEYBOARD ERROR
+ JMS I (CONTEST) /TEST IF CONSOLE CAN TAKE OUTPUT
+ JMP TESTKEYBOARD /JUMP IF NOT
+ JMS I (REMINPUT) /TEST IF ANY REMOTE INPUT
+ SKP /SKIP IF NONE
+ JMS I (CONOUT) /OUTPUT TO CONSOLE
+TESTKEY,TAD ECHOFLAG /GET LOCAL ECHO FLAG
+ TAD ESCFLAG /ADD ON <ESCAPE> SEEN FLAG
+ SNA CLA /SKIP IF LOCAL ECHO POSSIBLY NEEDED
+ JMP NOLOCALECHO /JUMP IF NOT
+ JMS I (CONTEST) /TEST IF CONSOLE CAN TAKE OUTPUT
+ JMP BUFCHECK /JUMP IF NOT
+NOLOCAL,JMS I (REMTEST) /TEST IF REMOTE CAN TAKE OUTPUT
+ JMP BUFCHECK /JUMP IF NOT
+ JMS I (KEYINPUT) /TEST IF ANY KEYBOARD INPUT
+ JMP BUFCHECK /JUMP IF NOT
+ DCA KEYLATEST /SAVE FOR LATER
+ TAD KEYLATEST /GET IT BACK
+ AND [177] /WANT SEVEN-BIT VERSION FOR TESTS
+ CIA /INVERT IT
+ DCA TESTCHAR /SAVE FOR LATER
+ TAD ESCFLAG /<ESCAPE> SEEN LAST TIME?
+ SNA CLA /SKIP IF SO
+ JMP NOESCAPE /JUMP IF NOT
+ TAD TESTCHAR /GET TEST VAUE
+ JMS I [SRCHTABLE] /SEARCH FOR IT
+ ESCLIST-1-1 /SEARCH TABLE POINTER
+ SNA CLA /SKIP IF FOUND
+ JMP ESCOMPLAIN /JUMP IF NOT
+ JMP I TABLEJUMP /GO WHERE YOU'RE SUPPOSED TO
+\f/ COMES HERE IF PREVIOUS WAS NOT THE <ESCAPE> CHARACTER.
+
+NOESCAP,TAD TESTCHAR /GET THE LATEST CHARACTER
+ TAD ESCHAR /COMPARE TO <ESCAPE> CHARACTER
+ SZA CLA /SKIP IF IT MATCHES
+ JMP OUTCHAR /JUMP IF NOT
+ NL7777 /SET THE
+/ DCA ESCFLAG /<ESCAPE> SEEN FLAG
+/ JMP BUFCHECK /CONTINUE THERE
+ JMP NOESENTRY /CONTINUE THERE
+
+/ COMES HERE IF BOTH PREVIOUS AND LATEST ARE THE <ESCAPE> CHARACTER.
+
+ESCTYPE,DCA ESCFLAG /CLEAR THE <ESCAPE> SEEN FLAG AND OUTPUT
+
+/ COMES HERE IF PREVIOUS AND LATEST CHARACTER ARE NOT THE <ESCAPE> CHARACTER.
+
+OUTCHAR,TAD ECHOFLAG /GET LOCAL ECHO FLAG
+ SNA CLA /SKIP IF SET
+ JMP NOECHO /JUMP IF NOT
+ TAD KEYLATEST /GET LATEST CHARACTER
+ JMS I (CONOUT) /OUTPUT TO CONSOLE
+NOECHO, TAD KEYLATEST /GET LATEST CHARACTER
+ JMS I (REMOUT) /OUTPUT TO REMOTE
+ JMP BUFCHECK /CONTINUE THERE
+
+/ COMES HERE IF PREVIOUS WAS THE <ESCAPE> CHARACTER AND THE LATEST IS NOT
+/ A VALID <ESCAPE> COMMAND CHARACTER.
+
+ESCOMPL,TAD [CNTRLG] /GET A <BEL>
+ JMS I (CONOUT) /OUTPUT TO CONSOLE
+NOESENT,DCA ESCFLAG /CLEAR <ESCAPE> SEEN FLAG
+BUFCHEC,JMS I PUPSTATUS /UPDATE THE PORT STATUS /047 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY. THE DEFAULT INSTRUCTION IS FOR
+/ KL8 INTERFACES.
+
+ *BUFCHECK /OVERLAY DECMATE CODE /047 CJL
+
+BUFCHEC,NOP /DON'T CHECK PORT STATUS /047 CJL
+
+ JMS I (RINUPDATE) /CHECK FOR MORE REMOTE INPUT
+ JMS I (KEYUPDATE) /CHECK FOR MORE KEYBOARD INPUT
+ JMS I (REMUPDATE) /CHECK FOR MORE REMOTE OUTPUT
+ JMS I (CONUPDATE) /CHECK FOR MORE CONSOLE OUTPUT
+ JMP CONNLUP /GO BACK FOR MORE
+
+/ COMES HERE ON <ESCAPE> C(LOSE).
+
+ESCLOSE,ISZ CONSRV /BUMP TO GOOD RETURN
+ JMP I CONSRV /RETURN
+\fKERRLUP,JMS I PUPSTATUS /UPDATE THE PORT STATUS /047 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY. THE DEFAULT INSTRUCTION IS FOR
+/ KL8 INTERFACES.
+
+ *KERRLUP /OVERLAY DECMATE CODE /047 CJL
+
+KERRLUP,NOP /DON'T CHECK PORT STATUS /047 CJL
+
+ JMS I (RINUPDATE) /CHECK FOR MORE REMOTE INPUT
+ JMS I (KEYUPDATE) /CHECK FOR MORE KEYBOARD INPUT
+ JMS I (REMUPDATE) /CHECK FOR MORE REMOTE OUTPUT
+ JMS I (CONUPDATE) /CHECK FOR MORE CONSOLE OUTPUT
+
+/ COMES HERE ON KEYBOARD INPUT ERROR.
+
+KERROR, JMS I (CONTEST) /CONSOLE READY FOR OUTPUT?
+ JMP KERRLUP /NO, GO WAIT AWHILE
+ TAD I (CONINSERT) /GET CONSOLE INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD I (CONREMOVE) /COMPARE TO CONSOLE REMOVAL POINTER
+ SZA CLA /SKIP IF CONSOLE OUTPUT BUFFER EMPTY
+ JMP KERRLUP /GO WAIT FOR AWHILE
+ TAD KEYERROR /KEYBOARD INPUT ERROR?
+ SNA CLA /SKIP IF SO
+ JMP RIERTST /JUMP IF NOT
+ JMS I [SCRIBE] /TELL THEM
+ KERRMSG /WE HAD A KEYBOARD ERROR
+RIERTST,TAD RINERROR /REMOTE INPUT ERROR?
+ SNA CLA /SKIP IF SO
+ JMP CORESET /JUMP IF NOT
+ JMS I [SCRIBE] /TELL THEM
+ RIERMSG /WE HAD A REMOTE LINE ERROR
+ JMP CORESET /RESTART
+
+/ <ESCAPE> CHARACTER SEARCH LIST.
+
+ESCLIST,UPPERC; ESCLOSE /<ESCAPE> C(LOSE)
+ LOWERC; ESCLOSE /<ESCAPE> C(LOSE) (LOWER-CASE)
+ESCH, .-.; ESCTYPE /<ESCAPE> <ESCAPE>
+ 0 /THIS ENDS THE LIST
+
+/ LOCAL ECHO FLAG FOR CONNECT MODE.
+
+ECHOFLA,INIECHO /0=DON'T ECHO, NON-ZERO=ECHO /039 CJL
+ESCFLAG,.-. /<ESCAPE> CHARACTER SEEN FLAG
+KEYLATE,.-. /LATEST KEYBOARD CHARACTER
+PUPSTAT,UPSTATUS /POINTER TO DECMATE STATUS UPDATE /047 CJL
+TESTCHA,.-. /LATEST KEYBOARD TEST CHARACTER
+\f PAGE
+\f/ CONNECT-MODE SUPPORT ROUTINES. /047 CJL
+
+/ CONSOLE KEYBOARD ROUTINES. /047 CJL
+
+/ KEYBOARD INPUT ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (KEYINPUT) /CALL ROUTINE
+/ NO INPUT /RETURN IF NO INPUT
+/ INPUT /RETURN IF INPUT AVAILABLE
+
+/ THE AC WILL BE CLEAR IF THE IMMEDIATE RETURN IS TAKEN FOR NO INPUT.
+
+/ THE AC WILL CONTAIN THE LATEST CHARACTER IF THE SKIP RETURN IS TAKEN.
+
+KEYINPU,.-. /KEYBOARD INPUT ROUTINE
+ TAD KEYINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD KEYREMOVE /COMPARE TO REMOVAL POINTER
+ SNA CLA /SKIP IF BUFFER NOT EMPTY
+ JMP KEYCHECK /JUMP IF BUFFER EMPTY
+ TAD KEYREMOVE /GET REMOVAL POINTER
+ DCA KEYTEMP /SAVE FOR LATER
+ NL0001 /SET INCREMENT
+ TAD KEYREMOVE /UPDATE REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [KEYBUFFER] /MAKE IT ABSOLUTE
+ DCA KEYREMOVE /STORE UPDATED POINTER
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD I KEYTEMP /GET THE LATEST CHARACTER
+ CDF PRGFLD /BACK TO OUR FIELD
+ SKP /DON'T GET ANOTHER CHARACTER /047 CJL
+
+/ COMES HERE IF BUFFER IS EMPTY.
+
+KEYCHEC,JMS KEYGET /TRY TO GET A CHARACTER NOW /047 CJL
+ ISZ KEYINPUT /GOT ONE, SO TAKE SKIP RETURN /047 CJL
+ JMP I KEYINPUT /RETURN EITHER WAY
+\f/ KEYBOARD BUFFER UPDATE ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (KEYUPDATE) /CALL ROUTINE
+
+/ RETURNS WITH CLEAR AC. ANY KEYBOARD INPUT WHICH JUST OCCURRED WILL BE
+/ BUFFERED; CALLS TO KEYINPUT WILL RETRIEVE THE CHARACTERS.
+
+KEYUPDA,.-. /KEYBOARD BUFFER UPDATE ROUTINE
+ JMS KEYGET /TRY TO GET A CHARACTER NOW /047 CJL
+ SKP /GOT ONE, DON'T LEAVE YET /047 CJL
+ JMP I KEYUPDATE /CHARACTER NOT AVAILABLE NOW, RETURN /047 CJL
+ CDF BUFFLD /GOTO BUFFER FIELD
+ DCA I KEYINSERT /STORE IN THE BUFFER
+ CDF PRGFLD /BACK TO OUR FIELD
+ NL0001 /SET INCREMENT
+ TAD KEYINSERT /UPDATE POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [KEYBUFFER] /MAKE IT ABSOLUTE
+ DCA KEYINSERT /STORE BACK UPDATED POINTER
+ TAD KEYINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD KEYREMOVE /COMPARE TO REMOVAL POINTER
+ SNA CLA /SKIP IF NOT EQUAL
+KSERROR,ISZ KEYERROR /INDICATE KEYBOARD ERROR
+ JMP I KEYUPDATE /RETURN
+ JMP KSERROR /MAKE SURE ERROR IS INDICATED
+\f/ KEYBOARD GET A CHARACTER ROUTINE. /047 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS KEYGET /CALL ROUTINE
+/ CHARACTER AVAILABLE /RETURNS HERE WITH LATEST CHARACTER
+/ NO CHARACTER AVAILABLE /RETURNS HERE IF NO CHARACTER OR HANDLED FLOW-CONTROL
+
+/ NORMAL RETURN HAS LATEST CHARACTER IN AC.
+
+/ SKIP RETURN HAS CLEAR AC.
+
+/ IF FLOWFLAG=0, FLOW CHARACTERS ARE UNPROCESSED AND CAUSE NORMAL RETURN.
+
+KEYGET, .-. /KEYBOARD GET A CHARACTER ROUTINE
+KGTEST, KSFIOT /FLAG UP?
+ JMP KEYGNONE /NO, TAKE SKIP RETURN
+KGREAD, KRBIOT /YES, READ THE CHARACTER
+ SPA /SKIP IF NO UART ERRORS
+ ISZ KEYERROR /INDICATE KEYBOARD ERROR
+ SKP /SKIP IF NOT TOO MANY ERRORS
+ JMP .-2 /ENSURE KEYBOARD ERROR IS INDICATED
+ AND [377] /JUST EIGHT-BIT
+ DCA KEYTEMP /SAVE FOR NOW
+ TAD FLOWFLAG /GET FLOW CONTROL FLAG
+ SNA CLA /SKIP IF SET
+ JMP KEYGEXIT /JUMP IF NOT
+ TAD KEYTEMP /GET THE CHARACTER
+ AND [177] /JUST SEVEN-BIT
+ TAD [-CNTRLS] /COMPARE TO <^S>
+ SNA /SKIP IF OTHER
+ JMP KWATSET /JUMP IF IT MATCHES
+ TAD [-CNTRLQ+CNTRLS]/COMPARE TO <^S>
+ SNA CLA /SKIP IF OTHER
+ JMP KWATCLEAR /JUMP IF IT MATCHES
+KEYGEXI,TAD KEYTEMP /GET THE CHARACTER
+ JMP I KEYGET /TAKE IMMEDIATE RETURN
+
+/ COMES HERE ON <^S> TO SET OUTPUT WAIT.
+
+KWATSET,NL4000 /SET WAIT VALUE
+
+/ COMES HERE ON <^Q> TO CLEAR OUTPUT WAIT.
+
+KWATCLE,DCA CONWAIT /STORE NEW STATE
+KEYGNON,ISZ KEYGET /BUMP RETURN ADDRESS
+ JMP I KEYGET /TAKE SKIP RETURN
+\f/ CONSOLE TERMINAL ROUTINES.
+
+/ CONSOLE OUTPUT ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ TAD CHAR /CHARACTER TO OUTPUT IN AC
+/ JMS I (CONOUT) /CALL ROUTINE
+/ RETURN /RETURNS HERE WITH CLEAR AC
+
+CONOUT, .-. /CONSOLE OUTPUT ROUTINE
+ DCA CONTEMP /SAVE PASSED VALUE
+ TAD CONINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD CONREMOVE /COMPARE TO REMOVAL POINTER
+ TAD CONWAIT /ADD ON WAIT STATUS
+ SZA CLA /SKIP IF BUFFER EMPTY AND NOT WAITING /047 CJL
+ JMP CSTUFF /JUMP IF CHARACTER MUST BE BUFFERED
+ TAD CONTEMP /GET PASSED VALUE /047 CJL
+ JMS I (CONPUT) /TRY TO OUTPUT THE CHARACTER NOW /047 CJL
+ JMP CSTUFF /COULDN'T OUTPUT IT, SO BUFFER IT /047 CJL
+ JMP I CONOUT /RETURN
+
+CSTUFF, TAD CONTEMP /GET THE CHARACTER
+ CDF BUFFLD /GOTO BUFFER FIELD
+ DCA I CONINSERT /STORE THE CHARACTER
+ CDF PRGFLD /BACK TO OUR FIELD
+ NL0001 /SET INCREMENT
+ TAD CONINSERT /UPDATE POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [CONBUFFER] /MAKE IT ABSOLUTE
+ DCA CONINSERT /STORE BACK UPDATED POINTER
+ JMP I CONOUT /RETURN
+
+/ CONSOLE OUTPUT TEST ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I (CONTEST) /CALL ROUTINE
+/ NOT READY /RETURN IF OUTPUT NOT READY FOR NEXT CHARACTER
+/ READY /OUTPUT CAN ACCEPT ANOTHER CHARACTER NOW
+
+CONTEST,.-. /CONSOLE OUTPUT TEST ROUTINE
+ NL0001 /SET BUFFER INCREMENT
+ TAD CONINSERT /GET UPDATED INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD CONREMOVE /COMPARE TO REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ SZA CLA /SKIP IF BUFFER IS FULL
+ ISZ CONTEST /BUMP RETURN IF NOT
+ JMP I CONTEST /RETURN EITHER WAY
+\f/ CONSOLE OUTPUT BUFFER UPDATE ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I (CONUPDATE) /CALL ROUTINE
+/ RETURN /RETURN WITH CLEAR AC
+
+/ THE CONSOLE OUTPUT BUFFERING ROUTINES WILL UPDATE POINTERS, ETC. IF ANY
+/ STATUS HAS CHANGED SINCE THE LAST CALL.
+
+CONUPDA,.-. /CONSOLE OUTPUT UPDATE ROUTINE
+ TAD CONWAIT /FLOW CONTROL WAIT SET?
+ SZA CLA /SKIP IF NOT
+ JMP I CONUPDATE /JUST RETURN IF SO
+ TAD CONINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD CONREMOVE /COMPARE TO REMOVAL POINTER
+ SNA CLA /SKIP IF BUFFER CONTAINS SOMETHING /047 CJL
+ JMP I CONUPDATE /RETURN IF BUFFER EMPTY /047 CJL
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD I CONREMOVE /GET A CHARACTER FROM THE BUFFER
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMS I (CONPUT) /TRY TO OUTPUT THE CHARACTER NOW /047 CJL
+ JMP I CONUPDATE /COULDN'T DO IT, SO JUST RETURN /047 CJL
+ NL0001 /SET BUFFER INCREMENT
+ TAD CONREMOVE /UPDATE REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [CONBUFFER] /MAKE IT ABSOLUTE
+ DCA CONREMOVE /STORE UPDATED POINTER
+ JMP I CONUPDATE /RETURN
+
+CONINSE,.-. /CONSOLE OUTPUT INSERTION POINTER
+CONREMO,.-. /CONSOLE OUTPUT REMOVAL POINTER
+
+/ CONSOLE FLOW CONTROL WAIT FLAG.
+
+CONWAIT,.-. /0=DON'T WAIT, 4000=WAIT FOR <^Q>
+KEYINSE,.-. /KEYBOARD BUFFER INSERTION POINTER
+KEYREMO,.-. /KEYBOARD BUFFER REMOVAL POINTER
+
+ CONTEMP=CONUPDATE /CONSOLE OUTPUT TEMPORARY
+
+ KEYTEMP=CONUPDATE /KEYBOARD INPUT TEMPORARY
+
+ PAGE
+\f/ REMOTE LINE ROUTINES.
+
+/ REMOTE LINE INPUT ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (REMINPUT) /CALL ROUTINE
+/ NO INPUT /RETURN IF NO INPUT
+/ INPUT /RETURN IF INPUT AVAILABLE
+
+/ THE AC WILL BE CLEAR IF THE IMMEDIATE RETURN IS TAKEN FOR NO INPUT.
+
+/ THE AC WILL CONTAIN THE LATEST CHARACTER IF THE SKIP RETURN IS TAKEN.
+
+REMINPU,.-. /REMOTE LINE INPUT ROUTINE
+ TAD RININSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD RINREMOVE /COMPARE TO REMOVAL POINTER
+ SNA CLA /SKIP IF BUFFER NOT EMPTY
+ JMP RINCHECK /JUMP IF BUFFER EMPTY
+ TAD RINREMOVE /GET REMOVAL POINTER
+ DCA RINTEMP /SAVE FOR LATER
+ NL0001 /SET INCREMENT
+ TAD RINREMOVE /UPDATE REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD (RINBUFFER) /MAKE IT ABSOLUTE
+ DCA RINREMOVE /STORE UPDATED POINTER
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD I RINTEMP /GET THE LATEST CHARACTER
+ CDF PRGFLD /BACK TO OUR FIELD
+ DCA RINTEMP /SAVE FOR LATER
+ TAD FLOWFLAG /GET FLOW CONTROL FLAG
+ SNA CLA /SKIP IF SET
+ JMP REMINEXIT /JUMP IF NOT
+ NL4000 /SET WAITING VALUE
+ TAD RINWAIT /ARE WE WAITING TO EMPTY?
+ SZA CLA /SKIP IF SO
+ JMP REMINEXIT /JUMP IF NOT
+ TAD RININSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD RINREMOVE /COMPARE TO REMOVAL POINTER
+ AND [BUFSIZE^3%4] /JUST 3/4 BITS
+ SZA CLA /SKIP IF BUFFER NOW 1/4 FULL (OR LESS)
+ JMP REMINEXIT /JUMP IF NOT
+ NL7777 /SET BUFFER EMPTYING VALUE
+ DCA RINWAIT /STORE FOR OUTPUT ROUTINE
+REMINEX,TAD RINTEMP /GET THE CHARACTER
+ SKP /DON'T GET ANOTHER ONE /047 CJL
+
+/ COMES HERE IF REMOTE LINE INPUT BUFFER IS EMPTY.
+
+RINCHEC,JMS RINGET /TRY TO GET A CHARACTER NOW /047 CJL
+ ISZ REMINPUT /GOT ONE, SO TAKE SKIP RETURN /047 CJL
+ JMP I REMINPUT /RETURN EITHER WAY
+\f/ REMOTE LINE INPUT BUFFER UPDATE ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (RINUPDATE) /CALL ROUTINE
+
+/ RETURNS WITH CLEAR AC. ANY REMOTE LINE INPUT WHICH JUST OCCURRED WILL BE
+/ BUFFERED; CALLS TO REMINPUT WILL RETRIEVE THE CHARACTERS.
+
+RINUPDA,.-. /REMOTE LINE INPUT BUFFER UPDATE ROUTINE
+ JMS RINGET /TRY TO GET A CHARACTER NOW /047 CJL
+ SKP /GOT ONE, DON'T LEAVE YET /047 CJL
+ JMP I RINUPDATE /CHARACTER NOT AVAILABLE NOW, RETURN /047 CJL
+ CDF BUFFLD /GOTO BUFFER FIELD
+ DCA I RININSERT /STORE IN THE BUFFER
+ CDF PRGFLD /BACK TO OUR FIELD
+ NL0001 /SET INCREMENT
+ TAD RININSERT /UPDATE POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD (RINBUFFER) /MAKE IT ABSOLUTE
+ DCA RININSERT /STORE BACK UPDATED POINTER
+ TAD RININSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD RINREMOVE /COMPARE TO REMOVAL POINTER
+ SNA /SKIP IF BUFFER NOT FULL
+ ISZ RINERROR /INDICATE REMOTE LINE INPUT ERROR
+ SKP /SKIP IF NO OVERFLOW
+ JMP .-2 /ENSURE ERROR IS SET
+ TAD [BUFSIZE^3%4] /SUBTRACT 1/4 BUFFER'S WORTH
+ AND [BUFSIZE^3%4] /JUST 3/4 BUFFER BITS
+ SNA CLA /SKIP IF NOT 3/4 FULL
+ TAD FLOWFLAG /ELSE CHECK IF FLOW CONTROL IS ENABLED
+ SNA CLA /SKIP IF 3/4 FULL AND FLOW CONTROL IS ENABLED
+ JMP I RINUPDATE /JUST RETURN
+ TAD RINWAIT /GET INPUT WAIT FLAG
+ SNA CLA /SKIP IF ALREADY SET
+ ISZ RINWAIT /SET TO <^S> STATE
+ JMP I RINUPDATE /RETURN
+\f/ REMOTE LINE GET A CHARACTER ROUTINE. /047 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (RINGET) /CALL ROUTINE
+/ CHARACTER AVAILABLE /RETURNS HERE WITH LATEST CHARACTER
+/ NO CHARACTER AVAILABLE /RETURNS HERE IF NO CHARACTER OR HANDLED FLOW-CONTROL
+
+/ NORMAL RETURN HAS LATEST CHARACTER IN AC.
+
+/ SKIP RETURN HAS CLEAR AC.
+
+/ IF FLOWFLAG=0, FLOW CHARACTERS ARE UNPROCESSED AND CAUSE NORMAL RETURN.
+
+RINGET, .-. /REMOTE LINE GET A CHARACTER ROUTINE
+RINTEST,TAD INFLAG /IS INPUT AVAILABLE?
+RINGT0, SNA CLA /SKIP IF SO
+RINREAD,JMP RINGNONE /JUMP IF NOT
+RINGT1, DCA INFLAG /CLEAR AVAILABILITY FLAG
+RINGT2, IRB /READ IN THE CHARACTER
+
+/ THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTIONS
+/ ARE FOR KL8 INTERFACES.
+
+ *RINTEST /OVERLAY DECMATE II CODE
+
+RINTEST,RKSFIOT /FLAG UP?
+RINGT0, JMP RINGNONE /NO, TAKE SKIP RETURN
+RINREAD,RKRBIOT /YES, READ THE CHARACTER
+RINGT1, SKP /NO ERRORS ON DECMATE I
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *RINGT1 /OVERLAY DECMATE I CODE
+
+RINGT1, SPA /SKIP IF NO UART ERRORS
+RING2, ISZ RINERROR /INDICATE REMOTE LINE INPUT ERROR
+ SKP /SKIP IF NOT TOO MANY ERRORS
+ JMP .-2 /ENSURE REMOTE LINE INPUT ERROR IS INDICATED
+ AND [377] /JUST EIGHT-BIT
+ DCA RINTEMP /SAVE FOR NOW
+ TAD FLOWFLAG /GET FLOW CONTROL FLAG
+ SNA CLA /SKIP IF SET
+ JMP RINGEXIT /JUMP IF NOT
+ TAD RINTEMP /GET THE CHARACTER
+ AND [177] /JUST SEVEN-BIT
+ TAD [-CNTRLS] /COMPARE TO <^S>
+ SNA /SKIP IF OTHER
+ JMP RWATSET /JUMP IF IT MATCHES
+ TAD [-CNTRLQ+CNTRLS]/COMPARE TO <^S>
+ SNA CLA /SKIP IF OTHER
+ JMP RWATCLEAR /JUMP IF IT MATCHES
+RINGEXI,TAD RINTEMP /GET THE CHARACTER
+ JMP I RINGET /TAKE IMMEDIATE RETURN
+\f/ COMES HERE ON <^S> TO SET OUTPUT WAIT.
+
+RWATSET,NL4000 /SET WAIT VALUE
+
+/ COMES HERE ON <^Q> TO CLEAR OUTPUT WAIT.
+
+RWATCLE,DCA REMWAIT /STORE NEW STATE
+RINGNON,ISZ RINGET /BUMP RETURN ADDRESS
+ JMP I RINGET /TAKE SKIP RETURN
+
+/ REMOTE LINE RESET ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (REMRESET) /CALL ROUTINE
+/ RETURN /RETURN WITH CLEAR AC
+
+/ RETURNS WITH CLEAR AC AND ALL REMOTE LINE VARIABLES RESET.
+
+REMRESE,.-. /REMOTE LINE RESET ROUTINE
+ TAD [REMBUFFER] /SETUP THE REMOTE LINE
+ DCA REMINSERT /OUTPUT INSERTION POINTER
+ TAD [REMBUFFER] /SETUP THE REMOTE LINE
+ DCA REMREMOVE /OUTPUT REMOVAL POINTER
+ TAD (RINBUFFER) /SETUP THE REMOTE LINE
+ DCA RININSERT /INPUT INSERTION POINTER
+ TAD (RINBUFFER) /SETUP THE REMOTE LINE
+ DCA RINREMOVE /INPUT REMOVAL POINTER
+ DCA REMWAIT /CLEAR REMOTE OUTPUT WAIT
+ DCA RINWAIT /CLEAR REMOTE INPUT WAIT
+ DCA RINERROR /CLEAR REMOTE INPUT ERROR
+ JMP I REMRESET /RETURN
+
+RININSE,.-. /REMOTE INPUT INSERTION POINTER
+RINREMO,.-. /REMOTE INPUT REMOVAL POINTER
+RINTEMP,.-. /REMOTE INPUT TEMPORARY /047 CJL
+
+ PAGE
+\f/ REMOTE LINE OUTPUT ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ TAD CHAR /CHARACTER TO OUTPUT IN AC
+/ JMS I (REMOUT) /CALL ROUTINE
+/ RETURN /RETURNS HERE WITH CLEAR AC
+
+REMOUT, .-. /REMOTE LINE OUTPUT ROUTINE
+ DCA REMTEMP /SAVE PASSED VALUE
+ TAD REMINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD REMREMOVE /COMPARE TO REMOVAL POINTER
+ TAD REMWAIT /ADD ON WAIT STATUS
+ SZA CLA /SKIP IF BUFFER EMPTY AND NOT WAITING /047 CJL
+ JMP RSTUFF /JUMP IF CHARACTER MUST BE BUFFERED
+ TAD REMTEMP /GET PASSED VALUE /047 CJL
+ JMS I (REMPUT) /TRY TO OUTPUT THE CHARACTER NOW /047 CJL
+ JMP RSTUFF /COULDN'T OUTPUT IT, SO BUFFER IT /047 CJL
+ JMP I REMOUT /RETURN
+
+RSTUFF, TAD REMTEMP /GET THE CHARACTER
+ CDF BUFFLD /GOTO BUFFER FIELD
+ DCA I REMINSERT /STORE IN BUFFER
+ CDF PRGFLD /BACK TO OUR FIELD
+ NL0001 /SET BUFFER INCREMENT
+ TAD REMINSERT /BUMP INSERTION POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [REMBUFFER] /MAKE IT ABSOLUTE
+ DCA REMINSERT /STORE UPDATED POINTER
+ JMP I REMOUT /RETURN
+
+/ REMOTE LINE OUTPUT TEST ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I (REMTEST) /CALL ROUTINE
+/ NOT READY /RETURN IF OUTPUT NOT READY FOR NEXT CHARACTER
+/ READY /OUTPUT CAN ACCEPT ANOTHER CHARACTER NOW
+
+/ AC WILL BE CLEARED AFTER THE CALL.
+
+REMTEST,.-. /REMOTE LINE OUTPUT TEST ROUTINE
+ NL0001 /SET BUFFER INCREMENT
+ TAD REMINSERT /GET INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD REMREMOVE /COMPARE TO REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ SZA CLA /SKIP IF BUFFER IS FULL
+ ISZ REMTEST /BUMP RETURN IF BUFFER IS NOT FULL
+ JMP I REMTEST /RETURN EITHER WAY
+\f/ REMOTE LINE OUTPUT BUFFER UPDATE ROUTINE.
+
+/ CALLING SEQUENCE:
+
+/ JMS I (REMUPDATE) /CALL ROUTINE
+/ RETURN /RETURN WITH CLEAR AC
+
+/ THE REMOTE LINE OUTPUT BUFFERING ROUTINES WILL UPDATE POINTERS, ETC. IF ANY
+/ STATUS HAS CHANGED SINCE THE LAST CALL.
+
+REMUPDA,.-. /REMOTE LINE OUTPUT UPDATE ROUTINE
+ TAD RINWAIT /GET INPUT WAIT FLAG
+ CLL RAL /MAIN STATE BIT TO LINK
+ SNA CLA /SKIP IF OUTPUT FLOW CHARACTER NEEDED /047 CJL
+ JMP REMCHECK /JUMP IF CHARACTER NOT NEEDED NOW /047 CJL
+ TAD (CNTRLQ) /ASSUME RELEASE CHARACTER NEEDED /047 CJL
+ SNL /SKIP IF SO /047 CJL
+ TAD [CNTRLS-CNTRLQ] /ELSE CHANGE IT TO HOLD CHARACTER /047 CJL
+ JMS I (REMPUT) /TRY TO OUTPUT IT NOW /047 CJL
+ JMP REMCHECK /COULDN'T DO IT, FORGET IT FOR NOW /047 CJL
+ CML RAR /SET NEW STATE VALUE /047 CJL
+ DCA RINWAIT /STORE IT
+REMCHEC,TAD REMWAIT /GET OUTPUT WAIT FLAG
+ SZA CLA /SKIP IF NOT WAITING
+ JMP I REMUPDATE /JUST RETURN IF WAITING
+ TAD REMINSERT /GET OUTPUT INSERTION POINTER
+ CIA /INVERT FOR TEST
+ TAD REMREMOVE /COMPARE TO OUTPUT REMOVAL POINTER
+ SNA CLA /SKIP IF BUFFER CONTAINS SOMETHING /047 CJL
+ JMP I REMUPDATE /RETURN IF BUFFER EMPTY /047 CJL
+ CDF BUFFLD /GOTO BUFFER FIELD
+ TAD I REMREMOVE /GET A CHARACTER FROM THE BUFFER
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMS I (REMPUT) /TRY TO OUTPUT THE CHARACTER NOW /047 CJL
+ JMP I REMUPDATE /COULDN'T DO IT, SO JUST RETURN /047 CJL
+ NL0001 /SET BUFFER INCREMENT
+ TAD REMREMOVE /BUMP REMOVAL POINTER
+ AND [BUFSIZE-1] /JUST BUFFER BITS
+ TAD [REMBUFFER] /MAKE IT ABSOLUTE
+ DCA REMREMOVE /STORE UPDATED POINTER
+ JMP I REMUPDATE /RETURN
+
+ REMTEMP=REMUPDATE /REMOTE OUTPUT TEMPORARY
+\f/ LOW-LEVEL CONSOLE OUTPUT ROUTINE. /047 CJL
+
+/ CALLING SEQUENCE:
+
+/ [CHARACTER TO OUTPUT IN THE AC]
+
+/ JMS I (CONPUT) /CALL ROUTINE
+/ NO OUTPUT /RETURNS HERE IF OUTPUT UNAVAILABLE
+/ OUTPUT /RETURNS HERE IF CHARACTER WAS OUTPUT
+
+CONPUT, .-. /CONSOLE OUTPUT ROUTINE
+CONTSF, TSFIOT /FLAG UP?
+ JMP CONCLEAR /NO, FORGET IT
+CONTLS, TLSIOT /YES, OUTPUT THE CHARACTER NOW
+ ISZ CONPUT /TAKE SKIP RETURN
+CONCLEA,CLA /CLEAN UP
+ JMP I CONPUT /RETURN EITHER WAY
+
+/ CONSOLE RESET ROUTINE. /026 CJL
+
+/ CALLING SEQUENCE:
+
+/ JMS I (CONRESET) /CALL ROUTINE
+/ RETURN /RETURN WITH CLEAR AC
+
+/ RETURNS WITH CLEAR AC AND ALL CONSOLE VARIABLES RESET.
+
+CONRESE,.-. /CONSOLE RESET ROUTINE
+ TAD [CONBUFFER] /SETUP THE
+ DCA I (CONINSERT) /CONSOLE OUTPUT INSERTION POINTER
+ TAD [CONBUFFER] /SETUP THE
+ DCA I (CONREMOVE) /CONSOLE OUTPUT REMOVAL POINTER
+ TAD [KEYBUFFER] /SETUP THE
+ DCA I (KEYINSERT) /KEYBOARD INSERTION POINTER
+ TAD [KEYBUFFER] /SETUP THE
+ DCA I (KEYREMOVE) /KEYBOARD REMOVAL POINTER
+ DCA I (CONWAIT) /CLEAR OUTPUT WAIT
+ DCA KEYERROR /CLEAR KEYBOARD ERROR
+ JMP I CONRESET /RETURN
+\f/ LOW-LEVEL REMOTE LINE OUTPUT ROUTINE. /047 CJL
+
+/ CALLING SEQUENCE:
+
+/ [CHARACTER TO OUTPUT IN THE AC]
+
+/ JMS I (REMPUT) /CALL ROUTINE
+/ NO OUTPUT /RETURNS HERE IF OUTPUT UNAVAILABLE
+/ OUTPUT /RETURNS HERE IF CHARACTER WAS OUTPUT
+
+REMPUT, .-. /REMOTE LINE OUTPUT ROUTINE
+DM1AN2, AND [377] /ENSURE EIGHT BIT /049 CJL
+
+/ THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY. THE DEFAULT INSTRUCTION IS
+/ FOR KL8 INTERFACES.
+
+ *DM1AN2 /OVERLAY DECMATE II CODE /049 CJL
+
+DM1AN2, SKP /WE'RE NOT A DECMATE I /049 CJL
+ TAD [400] /SET WRITE BIT /049 CJL
+REMTSF, DCA RMPTEMP /SAVE PASSED VALUE
+RMPUT0, TAD OUTFLAG /CHECK IF OUTPUT IS AVAILABLE
+REMTLS, SNA CLA /SKIP IF SO
+RMPUT1, JMP I REMPUT /RETURN IF NOT
+REMCLEA,TAD RMPTEMP /GET THE PASSED VALUE
+RMPUT2, OLS /OUTPUT THE CHARACTER NOW
+
+/ THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY. THE DEFAULT INSTRUCTIONS
+/ ARE FOR KL8 INTERFACES.
+
+ *REMTSF /OVERLAY DECMATE II CODE
+
+REMTSF, RTSFIOT /FLAG UP?
+RMPUT0, JMP REMCLEAR /NO, FORGET IT
+REMTLS, RTLSIOT /YES, OUTPUT THE CHARACTER NOW
+RMPUT1, ISZ REMPUT /TAKE SKIP RETURN
+REMCLEA,CLA /CLEAN UP
+RMPUT2, JMP I REMPUT /RETURN EITHER WAY
+
+ CLA /CLEAN UP
+ DCA OUTFLAG /INDICATE OUTPUT IS UNAVAILABLE
+ ISZ REMPUT /TAKE SKIP RETURN
+ JMP I REMPUT /RETURN TO CALLER
+
+ RMPTEMP=CONRESET /REMOTE OUTPUT TEMPORARY
+
+ PAGE
+\f/ SEVEN-BIT COMMAND TABLES. /034 CJL
+
+ CMDTBL= . /COMMAND TABLE HERE
+
+ "C&177; "O&177; "N&177 /\
+ "N&177; "E&177; "C&177 / >CONNECT COMMAND
+ "T&177; -1 //
+ CONSRV /CONNECT ROUTINE ADDRESS
+
+ "F&177; "I&177; "N&177 /\
+ "I&177; "S&177; "H&177 / >FINISH COMMAND
+ -1 //
+ FINSRV /FINISH ROUTINE ADDRESS
+
+ "E&177; "X&177; "I&177 /EXIT
+ "T&177; -1 /COMMAND
+ EXITKERMIT /EXIT ROUTINE ADDRESS
+
+ "S&177; "E&177; "N&177 /SEND
+ "D&177; -1 /COMMAND
+ SNDSRV /SEND ROUTINE ADDRESS
+
+ "G&177; "E&177; "T&177 /GET
+ -1 /COMMAND
+ GETSRV /GET ROUTINE ADDRESS
+
+ "R&177; "E&177; "C&177 /\
+ "E&177; "I&177; "V&177 / >RECEIVE COMMAND
+ "E&177; -1 //
+ RECSRV /RECEIVE ROUTINE ADDRESS
+\f "H&177; "E&177; "L&177 /HELP
+ "P&177; -1 /COMMAND
+ HELPSRV /HELP ROUTINE ADDRESS
+
+ -1 /THIS ENDS THE TABLE /034 CJL
+
+/ REMOTE PACKET INPUT BUFFER. /014 CJL
+
+RRBUF, 0 /MARK
+RRLEN, 0 /PACKET LENGTH
+RRSEQ, 0 /PACKET SEQ
+RRTYP, 0 /PACKET TYPE
+
+ DECIMAL
+
+RRDTA, ZBLOCK 91 /DATA GOES HERE
+
+ OCTAL
+
+RTERMI, 0 /ADD LOCATION WHERE TERMINATOR IS STORED/A004
+ /ON RECEIVE IF BUFFER IS MAXIMUM LENGTH /A004
+
+/ REMOTE PACKET OUTPUT BUFFER
+
+RSBUF, CNTRLA /PACKET BUFFER (BEGINS WITH "SOH") /034 CJL
+RSLEN, 0 /PACKET LENGTH GOES HERE
+RSSEQ, 0 /PACKET SEQUENCE GOES HERE
+RSTYP, 0 /PACKET TYPE GOES HERE
+
+ DECIMAL
+
+RSDTA, ZBLOCK 91 /DATA GOES HERE
+
+ 0 /CHECKSUM HERE ON MAX PACKET
+ 0 /EOL (IF USED HERE ON MAX PACKET)
+ 0 /INTERNAL TERMINATOR HERE ON MAX PACKET
+
+ OCTAL
+\f/ SEND-INIT PACKET DEFINITION
+
+INIDAT, DECIMAL
+
+ 94+32 /94 CHARS MAX
+
+ OCTAL
+
+ "/&177 /15 SECOND TIME-OUT /M013/014 CJL
+ " &177 /NO PADDING
+ 0+100&177 /NO PADDING CHAR
+ " &177+15 /CR FOR EOL
+ "#&177 /QUOTE CHAR
+ "N&137 /NO 8TH BIT QUOTING
+ "1&177 /CHECK TYPE 1
+ " &177 /NO REPEAT CHAR
+ " &177+0 /NO EXTRA CAPABILITY
+NODATA, -1 /END OF DATA (USE THIS FOR SENDING NO-DATA)
+\f PAGE /GET TO NEXT PAGE /028 CJL
+
+/ NO-INTERRUPT CONSOLE INPUT/OUTPUT SUPPORT ROUTINES. /023 CJL
+
+/ MODIFIED FOR FORCED-ECHO AND COLUMN-COUNTING. /043 CJL
+
+/ CONSOLE INPUT ROUTINE. RETURNS LATEST CHARACTER WITHOUT ECHOING. MAY BE
+/ CALLED WITH DIRTY AC. RETURNS LATEST SEVEN-BIT CHARACTER TYPED WHILE FIELDING
+/ POTENTIAL <^S>/<^Q> PROTOCOL.
+
+INPUT, .-. /CONSOLE INPUT ROUTINE
+INPWAIT,JMS CHKUP /TRY TO GET A CHARACTER
+ TAD INCHAR /GET THE CHARACTER
+ SNA /SKIP IF ANYTHING CAME IN
+ JMP INPWAIT /WAIT FOR ANYTHING
+ JMP I INPUT /RETURN WITH LATEST CHARACTER
+
+/ CONSOLE OUTPUT ROUTINE. OUTPUTS CHARACTER IN AC (INCLUDING <HT> VIA
+/ SIMULATION). RETURNS WITH CLEAR AC. SUBJECT TO CONSOLE ECHO STATUS (ECHOSW).
+
+P7CH, .-. /CONSOLE OUTPUT ROUTINE
+ TAD (-CNTRLI) /COMPARE TO <HT>
+ SNA /SKIP IF OTHER
+ JMP DOTAB /JUMP IF <HT>
+ TAD L11/(CNTRLI) /RESTORE THE CHARACTER
+ JMS P7CHAR /PRINT IT (UPDATING COLUMN COUNT)
+ JMP I P7CH /RETURN
+
+DOTAB, TAD [" &177] /GET A <SPACE>
+ JMS P7CHAR /OUTPUT IT
+ TAD COLUMN /GET CURRENT COLUMN COUNT
+ AND [7] /JUST TAB BITS
+ SZA CLA /SKIP IF NOW AT NEW TAB STOP
+ JMP DOTAB /ELSE KEEP GOING
+ JMP I P7CH /RETURN
+
+/ FORCED-ECHO CONSOLE OUTPUT ROUTINE. SAME AS P7CH BUT CLEARS ECHOSW BEFORE
+/ OUTPUT OF THE CHARACTER.
+
+P7ECHO, .-. /CONSOLE OUTPUT WITH FORCED-ECHO ROUTINE
+ DCA P7TEMP /SAVE PASSED VALUE
+ DCA ECHOSW /CLEAR ECHO STATUS
+ TAD P7TEMP /RESTORE THE CHARACTER
+ JMS P7CH /CALL MAIN ROUTINE
+ JMP I P7ECHO /RETURN
+\fCHKUP, .-. /CHECK FOR <^C>, ETC. ROUTINE
+ JMS CTLCTST /CALL LOW-LEVEL INPUT CHECK ROUTINE
+ SNA /SKIP IF ANYTHING CAME BACK
+ JMP CHKCLR /ELSE FORGET IT
+ TAD (-CNTRLP) /COMPARE TO <^P>
+ SNA /SKIP IF OTHER
+ JMP DOUP /GO HANDLE <^P> THERE
+ IAC /TAD (-CNTRLO+CNTRLP)/COMPARE TO <^O>
+ SNA /SKIP IF OTHER
+ JMP DOUO /GO HANDLER <^O> THERE
+ TAD (-CNTRLS+CNTRLO) /COMPARE TO <^S>
+ SZA CLA /SKIP IF IT MATCHES
+ JMP I CHKUP /RETURN ON UNIMPORTANT CHARACTERS
+UQWAIT, JMS CTLCTST /CALL LOW-LEVEL INPUT CHECK ROUTINE
+ TAD (-CNTRLQ) /COMPARE TO <^Q>
+ SZA CLA /SKIP IF IT MATCHES
+ JMP UQWAIT /ELSE WAIT FOR <^Q> FOREVER
+CHKCLR, DCA INCHAR /OBLITERATE INPUT CHARACTER
+ JMP I CHKUP /RETURN
+
+/ COMES HERE TO HANDLE <^P>.
+
+DOUP, TAD ("P&177) /GET A "P"
+ JMS UPRINT /PRINT "^P"
+ JMP I UPADDRESS /GO WHERE YOU SHOULD
+
+/ COMES HERE TO HANDLE <^O>.
+
+DOUO, TAD ("O&177) /GET AN "O"
+ JMS UPRINT /PRINT "^O"
+ NL4000 /SET REVERSING BIT
+ TAD ECHOSW /REVERSE THE ECHO STATE
+ DCA ECHOSW /STORE BACK
+ JMP CHKCLR /OBLITERATE <^O> AND RETURN
+
+CTLCTST,.-. /LOW-LEVEL <^C> TEST ROUTINE
+ CLA /CLEAN UP
+KSFLOC, KSFIOT /FLAG UP?
+ JMP I CTLCTST /NO, JUST RETURN
+KRSZAP, KRSIOT /**** 6120 **** KRBIOT
+ AND [177] /JUST SEVEN-BIT
+ DCA INCHAR /SAVE THE CHARACTER
+ NL7775 /SET -<^C> VALUE
+ TAD INCHAR /COMPARE TO CHARACTER
+ SNA CLA /SKIP IF OTHER THAN <^C>
+ JMP I UCADDRESS /JUMP IF <^C>
+KCCZAP, KCCIOT /**** 6120 **** 0000
+ TAD INCHAR /GET THE CHARACTER
+ JMP I CTLCTST /RETURN
+\fP7CHAR, .-. /LOWER-LEVEL CONSOLE PRINT ROUTINE
+ DCA P7TEMP /SAVE PASSED VALUE
+P7AGN, JMS CHKUP /CHECK FOR <^C>, ETC.
+ TAD ECHOSW /GET CURRENT ECHO STATUS
+ SPA CLA /SKIP IF ECHO ON
+ JMP P7OFF /JUMP IF ECHO OFF
+ TAD P7TEMP /GET THE PASSED VALUE BACK
+ JMS P7OUT /TRY TO OUTPUT IT
+ JMP P7AGN /COULDN'T OUTPUT, GO WAIT THERE
+P7OFF, JMS CHKUP /CHECK FOR <^C>, ETC.
+ TAD P7TEMP /GET THE CHARACTER BACK
+ AND [140] /JUST QUADRANT BITS
+ SZA CLA /SKIP IF CONTROL CHARACTER
+ ISZ COLUMN /BUMP COLUMN IF PRINTING CHARACTER
+L11, CNTRLI/NOP /JUST IN CASE
+ TAD P7TEMP /GET THE CHARACTER AGAIN
+ TAD (-CNTRLM) /COMPARE TO <CR>
+ SNA /SKIP IF NOT <CR>
+ DCA COLUMN /CLEAR COLUMN COUNT ON <CR>
+ TAD (-CNTRLH+CNTRLM)/COMPARE TO <BS>
+ SNA CLA /SKIP IF OTHER
+ NL7777 /SET BACKUP VALUE
+ TAD COLUMN /UPDATE COLUMN COUNT
+ DCA COLUMN /STORE BACK
+ JMP I P7CHAR /RETURN
+
+P7OUT, .-. /LOW-LEVEL CONSOLE OUTPUT ROUTINE
+P7TSF, TSFIOT /FLAG UP?
+ JMP I P7OUT /NO, TAKE IMMEDIATE RETURN WITH AC INTACT
+P7TLS, TLSIOT /YES, OUTPUT IT
+ CLA /CLEAN UP
+ ISZ P7OUT /BUMP RETURN ADDRESS
+ JMP I P7OUT /TAKE SKIP RETURN TO CALLER
+
+/ COMES HERE TO HANDLE <^C> IF SO ENABLED.
+
+UPCPRT, TAD ("C&177) /GET A "C"
+ JMS UPRINT /PRINT "^C"
+KCCZP2, KCCIOT /**** 6120 **** 0000
+ JMP I [CLOOP] /RESTART
+
+UPRINT, .-. /"^"<CHARACTER> PRINTING ROUTINE
+ DCA P7TEMP /SAVE PASSED VALUE
+ TAD ("^&177) /GET AN "^"
+ JMS P7OUT /OUTPUT IT
+ JMP .-1 /WAIT FOR IT
+ TAD P7TEMP /GET PASSED VALUE
+ JMS P7OUT /OUTPUT IT
+ JMP .-1 /WAIT FOR IT
+ JMP I UPRINT /RETURN
+
+P7TEMP, .-. /OUTPUT ROUTINE TEMPORARY
+\f PAGE
+
+/ HANDLER I/O BUFFER DEFINITIONS. /014 CJL
+
+ HNDLR= . /BUFFER FOR DISK I/O HANDLER /014 CJL
+
+ *PAGCNT^200+HNDLR /RESET ORIGIN PAST HANDLER BUFFER /014 CJL
+
+ IFNZRO SBOOT-.&4000 <ERROR .> /028 CJL
+
+ *SBOOT-2 /JUST BEFORE EXIT ADDRESS /025 CJL
+EXITKER=. /WHERE TO EXIT TO /025 CJL
+ 0
+ CAF /PHPH
+\f/ ONCE-ONLY INITIALIZATION CODE. /024 CJL
+
+ *HNDLR /OVER AVAILABLE SPACE
+
+INITIAL,CLA CLL /CLEAN UP
+COUTINI,TLSIOT /RAISE CONSOLE OUTPUT FLAG /046 CJL
+ TAD INITIA/(CLA CLL)/GET REPLACEMENT INSTRUCTION
+ DCA I [CLOOP] /DON'T COME BACK TO US
+ JMS I (MACHINE) /IDENTIFY CPU TYPE
+ DCA CPUTEMP /SAVE IT
+ TAD CPUTEMP /GET CPU TYPE
+ TAD (-13) /COMPARE TO DEADLY 6120 VALUE
+ SNA CLA /SKIP IF OTHER
+ JMP INI6120 /JUMP IF IT MATCHES
+ROUTINI,RTLSIOT /INITIALIZE REMOTE OUTPUT /046 CJL
+RININIT,RKRBIOT /INITIALIZE REMOTE INPUT /046 CJL
+ CLA /CLEAN UP
+INITPRT,
+/PHPHPH
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ INITMSG /OPENING MESSAGE
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ DAYMSG /DAY MESSAGE
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ MONMSG /MONTH MESSAGE
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ YEARMSG /YEAR MESSAGE
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ CPUTMSG /CPU ID MESSAGE
+ TAD CPUTEMP /*1
+ CLL RTL /*4
+ TAD CPUTEMP /*5
+ TAD (CPULIST) /POINT TO PROPER MESSAGE
+ DCA TST6120 /STORE IN-LINE
+/ JMS I [SCRIBE] /TELL THEM THEIR
+ SKP /PHPH
+TST6120,0 /ACTUAL CPU ID
+/ JMS I [SCRIBE] /GIVE THEM THE
+/ CLOSMSG /CLOSING MESSAGE
+DMPRZAP,JMP .+3 /**** DECMATE USAGE DETECTED **** 0000
+ JMS I [SCRIBE] /GIVE THEM THE
+SPZAP, DMPOMSG /DECMATE PORT MESSAGE
+ JMS I [SCRIBE] /GIVE THEM THE
+ CRLF /END OF LINE
+ JMS I [SCRIBE] /GIVE THEM THE
+ LCLMSG /LOCAL PREFERENCE MESSAGE
+/ JMS I [SCRIBE] /TELL THEM THEY CAN
+/ THLPMSG /ASK FOR HELP
+ TAD CPUTEMP /GET CPU TYPE
+ CLL RTL /*4
+ TAD (CPUPRMPT-1) /POINT TO PROPER ENTRY
+ DCA XR0 /STASH THE POINTER
+ TAD (-4) /GET MOVE COUNT
+ JMS MESMOVE /MOVE THE PROPER PROMPT TEXT
+ PROMID-1 /TO THERE
+\f TAD CPUTEMP /*1
+ CLL RTL /*4
+ TAD CPUTEMP /*5
+ TAD (CPUIDLST-1) /POINT TO PROPER ENTRY
+ DCA XR0 /STASH THE POINTER
+ TAD (-5) /GET MOVE COUNT
+ JMS MESMOVE /MOVE THE PROPER CPU ID TEXT
+ CPUMSG-1 /TO THERE
+ CIF USRFLD /GOTO USR FIELD /035 CJL
+ JMS I (USR) /CALL USER SERVICE ROUTINE /035 CJL
+ USRIN /LOCK USR IN /035 CJL
+
+/ DO FURTHER INITIALIZATION HERE.
+
+ JMP I [CLOOP] /GO BACK TO KERMIT PROPER
+
+/ COMES HERE TO INITIALIZE 6120-BASED MACHINES. /046 CJL
+
+INI6120,DCA I (KCCZAP) /ELIMINATE KCCIOT
+ DCA I (KCCZP2) /ELIMINATE KCCIOT
+ ISZ I (KRSZAP) /TURN KRSIOT
+ ISZ I (KRSZAP) /INTO KRBIOT
+ TAD ROUTINITIALIZE /GET OUTPUT INITIALIZE INSTRUCTION /046 CJL
+ TAD (-6336) /COMPARE TO POSSIBLE VALUE /046 CJL
+ SZA CLA /SKIP IF IT MATCHES SERIAL PRINTER VALUE/046 CJL
+ JMP TRYDM1 /JUMP IF NOT CONFIGURED FOR SERIAL PORT /046 CJL
+ TAD RININITIALIZE /GET INPUT INITIALIZE INSTRUCTION /046 CJL
+ TAD (-6326) /COMPARE TO POSSIBLE VALUE /046 CJL
+ SNA CLA /SKIP IF NOT CONFIGURED FOR SERIAL PORT /046 CJL
+ JMP DMSER /JUMP IF SERIAL PORT CONFIGURATION /046 CJL
+TRYDM1, CLSK /SKIP ON, CLEAR CLOCK FLAG IF DECMATE II/046 CJL
+ NOP /JUST IN CASE /046 CJL
+ CLCL /CLEAR VT278 CLOCK FLAG /046 CJL
+ NOP /JUST IN CASE /046 CJL
+ ISZ TST6120 /WASTE /046 CJL
+ JMP .-1 /SOME TIME /046 CJL
+ CLSK8A /VT278 CLOCK FLAG UP? /046 CJL
+ JMP TRYDM2 /NO, TRY DECMATE II, ETC. /046 CJL
+ DCA DMPRZAP /MAKE IT PRINT OUR MESSAGE /050 CJL
+ CIF CDF DMIFLD /GOTO DECMATE ONCE-ONLY CODE FIELD /046 CJL
+ JMP I (DM1INIT) /CONTINUE THERE /046 CJL
+
+TRYDM2, CLSK /CLOCK FLAG UP? /046 CJL
+ JMP ROUTINITIALIZE /NO, MUST BE SOMEBODY ELSE! /046 CJL
+ DCA DMPRZAP /MAKE IT PRINT OUR MESSAGE /048 CJL
+ CIF CDF DMIFLD /GOTO DECMATE ONCE-ONLY FIELD /046 CJL
+ JMP I (DM2INIT) /CONTINUE THERE /046 CJL
+
+/ COMES HERE IF SERIAL PORT CONFIGURATION ON DECMATE.
+
+DMSER, DCA DMPRZAP /MAKE IT PRINT OUR MESSAGE /048 CJL
+ TAD (DMPPMSG) /GET OUR MESSAGE ADDRESS /048 CJL
+ DCA SPZAP /STORE IN-LINE /048 CJL
+ JMP ROUTINITIALIZE /CONTINUE THERE
+\fMESMOVE,.-. /MESSAGE MOVE ROUTINE
+ DCA MMOVCNT /SAVE PASSED COUNT
+ TAD I MESMOVE /GET THE PASSED ARGUMENT
+ DCA XR1 /SET IT UP
+ ISZ MESMOVE /BUMP PAST ARGUMENT
+ CDF MSGFLD /GOTO BUFFER FIELD
+MESMVLP,TAD I XR0 /GET A WORD
+ DCA I XR1 /PUT A WORD
+ ISZ MMOVCNT /DONE YET?
+ JMP MESMVLP /NO, GO BACK
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMP I MESMOVE /YES, RETURN
+
+CPUTEMP,.-. /TEMPORARY FOR MACHINE TYPE
+MMOVCNT,.-. /TEMPORARY FOR MOVE COUNT
+
+ PAGE
+\f/ CPU IDENTIFYING ROUTINE. /024 CJL
+
+/ RETURNS VALUE IN AC ACCORDING TO THE FOLLOWING RULE:
+
+/ AC CPU TYPE
+
+/ 0 UNKNOWN (DCC112, MP-12?)
+/ 1 PDP-5 (THE INCOMPATIBLE ONE!)
+/ 2 PDP-8 (THE REAL ONE!)
+/ 3 PDP-8/S (THE SLOW ONE!)
+/ 4 LINC-8 (THE STRANGE ONE!)
+/ 5 PDP-8/I (THE ORANGE ONE!)
+/ 6 PDP-8/L (THE STRIPPED-DOWN ONE!)
+/ 7 PDP-12 (THE GREEN ONE! (BLUE?))
+/ 10 PDP-8/E (THE FAST ONE!)
+/ 11 PDP-8/A (THE WIDE ONE!)
+/ 12 6100 (THE MICRO ONE!)
+/ 13 6120 (THE HARRIS ONE!)
+
+MACHINE,.-. /MACHINE IDENTIFYING ROUTINE
+ CLA CLL /THIS WORKS ON EVERYBODY!
+ TAD 0 /GET PDP-5 PC
+ DCA MACHTEMP /SAVE IT
+ TAD (IMA5-1) /GET PDP-5 NEW PC
+ DCA 0 /STORE IT
+
+/ IF WE GET HERE, WE'RE NOT A PDP-5.
+
+ TAD MACHTEMP /GET OLD LOCATION ZERO
+ DCA 0 /RESTORE IT
+ NL3776 /PDP-8/I, L WEIRDNESS
+ TAD (-3776) /COMPARE TO POSSIBLE VALUE
+ SNA CLA /SKIP IF NOT THOSE TWO
+ JMP IMA8IL /JUMP IF ONE OF THEM
+
+/ IF WE GET HERE, WE'RE NOT A PDP-8/I OR PDP-8/L.
+
+ NL7776 /SETUP -2
+ TAD (-7776) /COMPARE TO EXPECTED VALUE
+ SZA CLA /SKIP IF OK
+ JMP IMA8S /JUMP IF RETARDED BROTHER
+
+/ IF WE GET HERE, WE'RE NOT A PDP-8/S.
+
+ NL0100 /SETUP 0100
+ TAD (-100) /COMPARE TO EXPECTED VALUE
+ SNA CLA /SKIP IF STRAIGHT PDP-8
+ JMP IMAOMNIBUS /JUMP IF NEWER CPU
+\f/ IF WE GET HERE, WE ARE A PDP-8, BUT ARE WE A LINC-8?
+
+ NL7777 /SETUP LINC TEST VALUE
+ IACA /LOAD LINC "A" REGISTER
+ CLA /CLEAN UP
+ IAAC /GET IT BACK
+ IAC /ADD ONE
+ SNA CLA /SKIP IF NO LINC HARDWARE
+ JMP IMAL8 /JUMP IF LINC-8
+
+/ SINCE WE DON'T CARE ABOUT PERIPHERALS, WE ARE A PDP-8.
+
+ JMP IMA8 /GO TELL THEM WE ARE A PDP-8
+
+/ COMES HERE IF PDP-8/I OR PDP-8/L.
+
+IMA8IL, NL7777 /SETUP TEST VALUE
+ CLA!401 /DO PDP-8/I GROUP THREE EAE CLA
+ SZA CLA /SKIP IF PDP-8/I
+ JMP IMA8L /JUMP IF NOT
+
+/ IF WE GET HERE, WE ARE A PDP-8/I, BUT ARE WE A PDP-12?
+
+ LINC /GOTO LINC MODE
+ COM /COMPLEMENT AC IF PDP-12, ELSE A HARMLESS AND
+ PDP /GOTO PDP8 MODE IF PDP-12, ELSE HARMLESS AND
+ IAC /ADD ONE FOR TEST
+ SNA CLA /SKIP IF JUST PDP-8/I
+ JMP IMA12 /JUMP IF ACTUALLY A LINC-8/I
+
+/ SINCE WE DON'T CARE ABOUT PERIPHERALS, WE ARE JUST A PDP-8/I.
+
+ JMP IMA8I /TELL THEM WE ARE A PDP-8/I
+
+IMAOMNI,RTL RTR /DO STRANGE OMNIBUS INSTRUCTION
+PC8A, SNA /SKIP IF NOT A MICRO CHIP
+ JMP IMA61 /JUMP IF ONE OF THOSE THINGS
+ TAD (.&7600+16^7777) /CHECK FOR PDP-8/E VALUE
+ SNA /SKIP IF NOT HIM
+ JMP IMA8E /JUMP IF IT IS A PDP-8/E (/F OR /M OR 8A-6XX)
+ TAD (.&7600+16-PC8A) /COMPARE TO PDP-8/A VALUE /051 CJL
+ SNA CLA /SKIP IF SOMEBODY ELSE
+ JMP IMA8A /JUMP IF IT MATCHES
+
+/ IF WE GET HERE, SOME STRANGE PROCESSOR IS RUNNING US.
+
+ JMP IMAUNKNOWN /YOU FIGURE IT OUT!
+\f/ IF WE GET HERE, WE ARE A 6100 OR 6120.
+
+IMA61, NL0010 /DO 6120 SPECIAL INSTRUCTION
+ TAD (-10) /COMPARE TO EXPECTED VALUE
+ SNA CLA /SKIP IF OTHER
+ JMP IMA6120 /JUMP IF IT MATCHES
+
+/ WE APPARENTLY ARE ON A 6100, SO TELL THEM SO.
+
+ JMP IMA6100 /TELL THEM WE ARE A 6100 MACHINE (VT-78, ETC.)
+
+/ RETURN GAUNTLET.
+
+IMA6120,IAC /SET 6120 VALUE
+IMA6100,IAC /SET 6100 VALUE
+IMA8A, IAC /SET PDP-8/A VALUE
+IMA8E, IAC /SET PDP-8/E VALUE
+IMA12, IAC /SET PDP-12 VALUE
+IMA8L, IAC /SET PDP-8/L VALUE
+IMA8I, IAC /SET PDP-8/I VALUE
+IMAL8, IAC /SET LINC-8 VALUE
+IMA8S, IAC /SET PDP-8/S VALUE
+IMA8, IAC /SET PDP-8 VALUE
+IMA5, IAC /SET PDP-5 VALUE
+IMAUNKN,JMP I MACHINE /RETURN
+
+MACHTEM,.-. /TEMPORARY FOR LOCATION ZERO
+
+ PAGE
+\f FIELD PRGFLD%10 /DUMP THE LITERALS NOW
+\f/ LAYOUT OF FIELD ONE (PERMANENT CONTENTS). /046 CJL
+
+ NOPUNCH /FOOL THE ASSEMBLER /046 CJL
+
+ FIELD USRFLD%10 /USR FIELD /046 CJL
+
+ *0 /WHERE IT LOADS /046 CJL
+
+USRLOAD,ZBLOCK 200-. /GET TO ENTRY POINT /046 CJL
+
+ USRENTR=. /LOCKED-IN USR ENTRY POINT /046 CJL
+
+USRENTR,ZBLOCK 2000-. /USR OWNS REST OF THIS AREA /046 CJL
+
+ FILBUFF=. /FILE I/O DONE HERE /046 CJL
+
+ FIELD BUFFLD%10 /FILE I/O BUFFER FIELD /046 CJL
+
+ *FILBUFFER /RESET ORIGIN /046 CJL
+
+FILBUFF,ZBLOCK PAGCNT^200 /THIS IS THE FILE I/O BUFFER /046 CJL
+
+ DIRBUFF=. /DIRECTORY LOOKUP I/O DONE HERE /028 CJL
+
+ FIELD DIRFLD%10 /DIRECTORY LOOKUP BUFFER FIELD /028 CJL
+
+ *DIRBUFFER /RESET ORIGIN /028 CJL
+
+FILECNT,.-. /-(NUMBER OF ENTRIES IN THIS SEGMENT)
+FRSTREC,.-. /FIRST RECORD OF FIRST ENTRY IN THIS SEGMENT
+DIRLINK,.-. /LINK TO NEXT SEGMENT; 0 IF LAST ACTIVE ONE
+ .-. /TENTATIVE ENTRY POINTER STORED HERE
+AIWNUMB,.-. /-(NUMBER OF ADDITIONAL INFORMATION WORDS)
+
+ ENTSTRT=. /FILE ENTRIES START HERE /046 CJL
+
+ ZBLOCK PAGCNT^200+DIRBUFFER-. /DIRECTORY ENTRIES HERE /046 CJL
+
+/ CONNECT MODE I/O BUFFERS. /026 CJL
+
+KEYBUFF,ZBLOCK BUFSIZE /KEYBOARD BUFFER /026 CJL
+CONBUFF,ZBLOCK BUFSIZE /CONSOLE OUTPUT BUFFER /026 CJL
+RINBUFF,ZBLOCK BUFSIZE /REMOTE INPUT BUFFER /026 CJL
+REMBUFF,ZBLOCK BUFSIZE /REMOTE OUTPUT BUFFER /026 CJL
+
+ FLD1ADR=. /SPACE AVAILABLE FOR TEXT, ETC. /046 CJL
+
+ ENPUNCH /UN-FOOL THE ASSEMBLER /046 CJL
+\f/ DECMATE ONCE-ONLY CODE. /046 CJL
+
+ FIELD DMIFLD%10 /DECMATE ONCE-ONLY CODE FIELD /046 CJL
+
+ *USRLOAD /OVER USR ROUTINE /046 CJL
+
+/ PAGE ZERO FOR ONCE-ONLY CODE. /046 CJL
+
+ *10 /GET TO AUTO-INDEX AREA /048 CJL
+
+XR0, .-. /AUTO-INDEX ZERO /048 CJL
+
+ *USRENTRY /OVER USR ENTRY POINT /046 CJL
+
+/ DECMATE I ONCE-ONLY CODE. /046 CJL
+
+DM1INIT,JMS I (DM1PORT) /INITIALIZE THE REMOTE PORTS /050 CJL
+ TAD (DM1LIST-1) /POINT TO REPLACEMENT LIST /050 CJL
+ JMS REPLACE /ZAP IN ALL OF OUR PATCHES /050 CJL
+ CDF PRGFLD /GOTO MAIN FIELD /050 CJL
+ TAD I (DIRXR) /GET PORT SELECTION /050 CJL
+ SNA CLA /SKIP IF PORT 1 REQUIRED /050 CJL
+ JMP USEP0 /JUMP IF PORT 0 REQUIRED /050 CJL
+ TAD (DM1SEC-1) /POINT TO REPLACEMENT LIST /050 CJL
+ JMS REPLACE /ZAP IN SECONDARY PATCHES /050 CJL
+USEP0, CIF CDF PRGFLD /BACK TO REST OF INITIALIZATION /046 CJL
+ JMP I (INITPRT) /CONTINUE THERE /046 CJL
+
+/ DECMATE II, ETC. ONCE-ONLY CODE. /046 CJL
+
+DM2INIT,JMS I (DMIPORT) /INITIALIZE THE REMOTE PORT /048 CJL
+ TAD (DM2LIST-1) /POINT TO REPLACEMENT LIST /048 CJL
+ JMS REPLACE /ZAP IN ALL OF OUR PATCHES /048 CJL
+ CIF CDF PRGFLD /BACK TO REST OF INITIALIZATION /046 CJL
+ JMP I (INITPRT) /CONTINUE THERE /046 CJL
+
+REPLACE,.-. /REPLACEMENT ROUTINE /048 CJL
+ DCA XR0 /SAVE PASSED LIST POINTER /048 CJL
+REPLUP, CDF DMIFLD /BACK TO OUR FIELD /048 CJL
+ TAD I XR0 /GET AN ADDRESS /048 CJL
+ SNA /SKIP IF NOT AT END OF LIST /048 CJL
+ JMP I REPLACE /RETURN IF END OF LIST /048 CJL
+ DCA REPADR /STASH THE ADDRESS /048 CJL
+ TAD I XR0 /GET THE REPLACEMENT VALUE /048 CJL
+ CDF PRGFLD /GOTO ZAPPING FIELD /048 CJL
+ DCA I REPADR /ZAP IT IN /048 CJL
+ JMP REPLUP /KEEP GOING /048 CJL
+
+REPADR, .-. /REPLACEMENT ADDRESS TEMPORARY /048 CJL
+\f/ DECMATE I PORT INITIALIZE ROUTINE /050 CJL
+
+DM1PORT,.-. /DECMATE I PORT INITIALIZE ROUTINE
+ TAD (234) /GET PORT 0 SCD ENABLE VALUE
+ WCON0 /WRITE PORT 0 CONTROL REGISTER
+ NL0000 /INDICATE PORT 0
+ JMS PRTINIT /INITIALIZE PORT 0
+
+/ CHANGE ALL IOTS TO PORT 1 VALUES.
+
+IOCLUP, ISZ PSETF1 /BUMP SET FLAG INSTRUCTION
+ ISZ PDUMRD /BUMP DUMMY READ INSTRUCTION
+ ISZ PSETF2 /BUMP SET FLAG INSTRUCTION
+ ISZ PSKIP /BUMP SKIP ON FLAG INSTRUCTION
+ ISZ PLOAD /BUMP LOAD INSTRUCTION
+ ISZ IOTCNT /DONE YET?
+ JMP IOCLUP /NO, KEEP GOING
+
+ TAD (234) /GET PORT 1 SCD ENABLE VALUE
+ WCON1 /WRITE PORT 1 CONTROL REGISTER
+ NL4000 /INDICATE PORT 1
+ JMS PRTINIT /INITIALIZE PORT 1
+ JMP I DM1PORT /RETURN
+
+PRTINIT,.-. /LOW-LEVEL PORT INTIALIZE ROUTINE
+ RACD /RESET DESIRED PORT
+ ISZ PWASTE /WASTE
+ JMP .-1 /SOME TIME
+ CLA /CLEAN UP
+PSETF1, RTFL0 /SET THE FLAG NOW
+ TAD (2516) /SETUP FOR 8 BITS, NO PARITY, ETC.
+ JMS PSEND /SEND TO MODE REGISTER 1
+ CDF PRGFLD /GOTO MAIN FIELD
+ TAD I (RATE) /GET BAUD RATE NOW
+ CDF DMIFLD /BACK TO OUR FIELD
+ TAD (2460) /ADD ON CLOCK ENABLES, ETC.
+ JMS PSEND /SEND TO MODE REGISTER 2
+ TAD (3425) /GET ENABLE AND RESET VALUE
+ JMS PSEND /SEND TO COMMAND REGISTER
+PDUMRD, RKRB0 /DO A DUMMY READ NOW
+PSETF2, RTFL0 /SET THE FLAG NOW
+ CLA /CLEAN UP
+ JMP I PRTINIT /RETURN
+
+PSEND, .-. /PORT WRITE ROUTINE
+PSKIP, RTSF0 /FLAG UP?
+ JMP PSKIP /NO, WAIT FOR IT
+PLOAD, RTLS0 /YES, LOAD THE VALUE
+ CLA /CLEAN UP
+ JMP I PSEND /RETURN
+
+IOTCNT, RKFL0-RKFL1 /INTER-DEVICE IOT COUNT
+PWASTE, 0 /TIMER TEMPORARY
+\f PAGE
+\f/ DECMATE II, ETC. PORT INITIALIZE ROUTINE. /048 CJL
+
+/ THIS ROUTINE IS MOSTLY "DARK GREY MAGIC" WHICH IS PRIMARILY DERIVED FROM THE
+/ "OFFICIAL" INFORMATION TAKEN FROM THE ONLY KNOWN DOCUMENTATION, THE DECMATE II
+/ PROGRAMMER'S REFERENCE MANUAL: EK-DECM2-RM-001. VARIOUS EMPLOYEES OF DIGITAL
+/ EQUIPMENT CORPORATION (A MULTI-NATIONAL COMPANY) HAVE ADDITIONALLY CONTRIBUTED
+/ TO THIS EFFORT BY PROVIDING PORTIONS OF THE "SACRED SLUSHWARE NOTES" ON A NOT
+/ NECESSARILY WILLING BASIS THROUGH THEIR RELEASED WORKS, SUCH AS, BUT NOT
+/ LIMITED TO, THE SOURCES OF THE PARTICULAR VERSION OF KERMIT-8 KNOWN AS K278.
+/ IT IS ASSUMED THAT THESE PEOPLE HAVE ACCESS TO BETTER DOCUMENTATION OF THE
+/ HARDWARE, AND ESPECIALLY DOCUMENTATION OF THE THREE DIFFERENT MODELS OF
+/ DECMATE (II, III, III+) THAT THESE ISSUES APPLY TO.
+
+/ SINCE IT IS NOT KNOWN WHETHER THE K278, ETC. CODE IS SPECIFIC AND PRECISE, OR
+/ MERELY SLOPPY, VARIOUS "QUIRKY" CODING TECHNIQUES HAVE BEEN LEFT "AS IS", WITH
+/ COMMENTS REGARDING POTENTIAL VARIANCE WITH DOCUMENTATION NOTED WHERE
+/ NECESSARY. THE ORDER OF ACCESS TO THE REGISTERS HAS BEEN LEFT INTACT IN CASE
+/ OF POTENTIAL INTERACTION. SEVERAL CHANGES HAVE BEEN MADE BEYOND THIS WORK AS
+/ A RESULT OF TRIAL-AND-ERROR, AND ALSO HAND DIS-ASSEMBLY OF SEVERAL DECMATE
+/ DISKETTES' CONTENTS.
+
+/ IT IS HOPED THAT FUTURE "NEGOTIATIONS" WITH DEC ALLOW FOR PROPER DISCLOSURE OF
+/ THESE ISSUES TO AVOID POTENTIAL SOFTWARE FAILURES EVIDENT IN THESE ROUTINES
+/ DUE TO LACK OF PROPER DOCUMENTATION.
+
+DMIPORT,.-. /COMMUNICATIONS PORT INITIALIZE ROUTINE
+
+/ ACCORDING TO THE DECMATE II MANUAL, THE FOLLOWING INSTRUCTION IS UNDEFINED.
+
+ MPRESET /RESET MULTIPROTOCOL COMMUNICATIONS CONTROLLER CHIP
+
+/ THE DECMATE III HAS AN INTERNAL MODEM OPTION WHICH IS NOT AVAILABLE IN THE
+/ DECMATE II. THE INTERFACE TO THIS DEVICE IS APPARENTLY SHARED WITH THE MPSCC
+/ MODEM INTERFACE WE NORMALLY USE, SO THE REGISTER ACCESS MUST BE MORE CAREFULLY
+/ DEFINED. THE APPARENT DIFFERENTIATION IS THE CURRENT VALUE OF THE DATA FIELD,
+/ NAMELY EITHER FIELD 0 OR 1. IT IS NOT KNOWN WHETHER THE THREE-BIT VALUE OF
+/ THE DATA FIELD IS SIGNIFICENT (PRESUMABLY FOR FUTURE EXPANSION), OR MERELY THE
+/ DATA FIELD'S LOW-ORDER BIT IS USED, AS ALL KNOWN EXAMPLES OF ALLEDGEDLY
+/ FUNCTIONAL CODE USE APPROPRIATE CDF 00 AND CDF 10 ONLY. APPARENTLY THE MODEM
+/ INTERFACE IS REFERRED TO AS "A" AND THE MPSCC INTERFACE IS REFERRED TO AS "B".
+
+ TAD (030) /GET RESET VALUE
+ CDF 00 /TALKING TO REGISTER 0A
+ MPSCC /RESET COMMUNICATIONS CHIP
+ CDF 10 /TALKING TO REGISTER 0B
+ MPSCC /RESET COMMUNICATIONS CHIP
+\f/ ACCORDING TO THE DECMATE II MANUAL, CONTROL REGISTER 2 "HAS NO RELEVANT
+/ BITS... IF IT IS EVER WRITTEN, IT MUST BE WRITTEN WITH ALL ZEROS." APPARENTLY
+/ THE MODEM INTERFACE DEMANDS A NON-ZERO VALUE BE WRITTEN TO REGISTER 2
+/ (PRESUMABLY TO DISABLE IT). TO SATISFY THE ABOVE REQUIREMENT (WHATEVER THIS
+/ IMPLIES!), REGISTER 2(B) IS WRITTEN WITH ALL ZEROS *LAST* IN CASE THIS IS A
+/ DECMATE II WHERE THE DATA FIELD CONSIDERATIONS ARE MEANINGLESS.
+
+ CDF 00 /TALKING TO REGISTER 0A
+ NL0002 /WANT REGISTER 2A
+ MPSCC /SELECT IT
+ TAD (020-2) /GET RESET VALUE
+ MPSCC /LOAD IT
+ CDF 10 /TALKING TO REGISTER 0B
+ NL0002 /WANT REGISTER 2B
+ MPSCC /SELECT IT
+ NL0000 /GET RESET VALUE (000)
+ MPSCC /LOAD IT
+
+/ THE K278 CODE DOES NOT HAVE SETUP CODE FOR REGISTER 4B, PRESUMABLY BECAUSE THE
+/ CODE PERFORMS A PANEL REQUEST (PRQ3) WHICH SETS UP THE EQUIVALENT VALUES FOR
+/ ASYNCHRONOUS OPERATION WITH ONE STOP BIT AND NO PARITY. IT IS NOT KNOWN IF
+/ THE DECMATE III EVEN *HAS* A REGISTER 4B, BUT PRESUMABLY IT IS AVAILABLE FOR
+/ LOADING THE RIGHT VALUES COMPATIBLE WITH THE DECMATE II, OR ATTEMPTING TO LOAD
+/ IT IS INNOCUOUS.
+
+ CDF 00 /TALKING TO REGISTER 0A
+ NL0004 /WANT REGISTER 4A
+ MPSCC /SELECT IT
+ TAD (104-4) /SETUP FOR ASYNCHRONOUS, ONE STOP BIT, NO PARITY
+ MPSCC /LOAD IT
+ CDF 10 /TALKING TO REGISTER 0B
+ NL0004 /WANT REGISTER 4B
+ MPSCC /SELECT IT
+ TAD (104-4) /SETUP FOR ASYNCHRONOUS, ONE STOP BIT, NO PARITY
+ MPSCC /LOAD IT
+\f/ THE DOCUMENTED VALUES (FOR DECMATE II) REGARDING CONTROL REGISTER 1 INDICATE
+/ THE PROPER VALUE OF 022, WHERE BIT[9] IS DEFINED AS A ZERO. THE VALUE OF 026
+/ IS TAKEN FROM K278 WHERE PRESUMABLY THE EXTRA BIT IS NECESSARY FOR SOME
+/ DECMATE III OBSCURITY.
+
+/ THE FOLLOWING CODE IS REDUNDANT FOR LOADING REGISTER 0A BEFORE AND AFTER
+/ LOADING REGISTER 0B. THIS IS EITHER A MISTAKE OR OBSCURELY NECESSARY (TAKEN
+/ FROM K278).
+
+ CDF 00 /TALKING TO REGISTER 0A
+ NL0001 /WANT REGISTER 1A
+ MPSCC /SELECT IT
+ TAD (026-1) /GET SETUP VALUE
+ MPSCC /LOAD IT
+ CDF 10 /TALKING TO REGISTER 0B
+ NL0001 /WANT REGISTER 1B
+ MPSCC /SELECT IT
+ TAD (026-1) /GET SETUP VALUE
+ MPSCC /LOAD IT
+ CDF 00 /TALKING TO REGISTER 0A
+ NL0001 /WANT REGISTER 1A
+ MPSCC /SELECT IT
+ TAD (026-1) /GET SETUP VALUE
+ MPSCC /LOAD IT
+
+/ THE DECMATE III INTERNAL MODEM IS PROBABLY ASYNCHRONOUS 8 BIT ONLY. ASSUMING
+/ THE RECEIVE SIDE OF THE INTERNAL MODEM IS ALWAYS "ENABLED", REGISTER 3A WOULD
+/ BE UNNECESSARY. THE K278 CODE DOES NOT ADDRESS REGISTER 3 AS AN A/B PAIR,
+/ PRESUMABLY BECAUSE REGISTER 3 IS NOT DECODED AND IS EFFECTIVELY REGISTER 3B
+/ REGARDLESS OF THE DATA FIELD. THIS IS EITHER TRUE, OR THE K278 CODING FAILS
+/ TO PROPERLY INITIALIZE THE DECMATE III MPSCC PORT.
+
+ NL0003 /WANT REGISTER 3
+ MPSCC /SELECT IT
+ TAD (301-3) /SETUP FOR 8 BITS AND ENABLE RECIVER
+ MPSCC /LOAD IT
+
+/ A SIMILAR SITUATION EXISTS FOR THE TRANSMITTER SIDE OF THE DECMATE III
+/ INTERNAL MODEM. REGISTER 5 IS UTILIZED ACCORDINGLY.
+
+ TAD (5-301) /WANT REGISTER 5
+ MPSCC /SELECT IT
+ TAD (150-5) /GET TRANSMITTER ENABLE, 8 BITS VALUE
+ MPSCC /LOAD IT
+
+/ THE DECMATE II REFERENCE MANUAL INDICATES THE PROPER SETTING FOR THE MODEM
+/ CONTROL REGISTER AS EITHER 030 OR 130 DEPENDING ON WHETHER BIT[5] INDICATES
+/ INTERNAL OR EXTERNAL TIMING (WHERE ONE OF THESE IS ILLEGAL FOR ASYNCHRONOUS
+/ OPERATION!). THE SETTING OF BITS [10] AND [11] WOULD INDICATE ENABLING OF
+/ BOTH LOCAL AND REMOTE LOOPBACKS, YET WE SET ONLY THESE BITS (ALA K278)
+/ ALLEDGEDLY FOR THE PURPOSE OF SETTING RTS AND DTR (WHICH ARE DOCUMENTED AS
+/ BEING BITS[7] AND [8] RESPECTIVELY).
+
+ NL0003 /SET VALUE
+ MLC /LOAD IT
+\f CLA /CLEAN UP
+
+/ THE BAUD RATE SHOULD BE SET HERE IF DESIRED.
+
+/ TAD BAUD /GET BAUD RATE
+/ MSB /LOAD IT
+ CLA /CLEAN UP
+ JMP I DMIPORT /RETURN
+\f/ DECMATE II, ETC. REPLACEMENT LIST. /048 CJL
+
+DM2LIST,CLDMZAP / *CLDMZAP
+
+ DMINIT&177+JMSC /CLDMZAP,JMS DMINIT
+
+ SETBAUD / *SETBAUD /050 CJL
+
+ MSB /SETBAUD,MSB /050 CJL
+
+ INLUP / *INLUP
+
+ TAD INFLAG /INLUP, TAD INFLAG
+
+ INSKIP / *INSKIP
+
+ NOTYET&177+JMPC /INSKIP, JMP NOTYET
+ INLUP1; DCA INFLAG /INLUP1, DCA INFLAG
+ INREAD; IRB /INREAD, IRB
+
+ INSTATUS / *INSTATUS
+
+ UPSTATUS&177+JMSC /INSTATU,JMS UPSTATUS
+
+ GETFL1 / *GETFL1
+
+ UPSTATUS&177+JMSC /GETFL1, JMS UPSTATUS
+
+ COMWAIT / *COMWAIT
+
+ GETFLOW&177+JMSC /COMWAIT,JMS GETFLOW
+
+ NOWAIT / *NOWAIT
+
+ TAD OUTFLAG /NOWAIT, TAD OUTFLAG
+ CMOUT1; SNA CLA /CMOUT1, SNA CLA
+ CMOUT2; OWAIT&177+JMPC /CMOUT2, JMP OWAIT
+ DM1AND; DCA OUTFLAG /DM1AND, DCA OUTFLAG
+ CMOUT3; OUTEMP&177+TADC /CMOUT3, TAD OUTEMP
+ CMOUT4; OLS /CMOUT4, OLS
+
+ BUFCHECK / *BUFCHECK
+
+ PUPSTATUS&177+JMSIC /BUFCHEC,JMS I PUPSTATUS
+
+ KERRLUP / *KERRLUP
+
+ PUPSTATUS&177+JMSIC /KERRLUP,JMS I PUPSTATUS
+\f RINTEST / *RINTEST
+
+ TAD INFLAG /RINTEST,TAD INFLAG
+ RINGT0; SNA CLA /RINGT0, SNA CLA
+ RINREAD;RINGNONE&177+JMPC /RINREAD,JMP RINGNONE
+ RINGT1; DCA INFLAG /RINGT1, DCA INFLAG
+ RINGT2; IRB /RINGT2, IRB
+
+ REMTSF / *REMTSF
+
+ RMPTEMP&177+DCAC /REMTSF, DCA RMPTEMP
+ RMPUT0; TAD OUTFLAG /RMPUT0, TAD OUTFLAG
+ REMTLS; SNA CLA /REMTLS, SNA CLA
+ RMPUT1; REMPUT&177+JMPIC /RMPUT1, JMP I REMPUT
+ REMCLEA;RMPTEMP&177+TADC /REMCLEA,TAD RMPTEMP
+ RMPUT2; OLS /RMPUT2, OLS
+
+ 0 /THIS ENDS THE LIST
+
+ PAGE
+\f/ DECMATE I REPLACEMENT LIST. /050 CJL
+
+DM1LIST,CLDMZAP / *CLDMZAP
+
+ DMINIT&177+JMSC /CLDMZAP,JMS DMINIT
+
+ SETBAUD / *SETBAUD
+
+ NOP /SETBAUD,NOP
+
+ DMI01 / *DMI01
+
+ DM234&177+TADC /DMI01, TAD DM234/(234)
+ DMI02; WCON0 /DMI02, WCON0
+ DMI03; NL0000 /DMI03, NL0000
+ DMI04; RACD /DMI04, RACD
+ DMI05; DMWASTE&177+ISZC /DMI05, ISZ DMWASTE
+ DMI06; DMI05&177+JMPC /DMI06, JMP DMI05
+ DMI07; DMWASTE&177+ISZC /DMI07, ISZ DMWASTE
+ DMI08; DMI07&177+JMPC /DMI08, JMP DMI07
+ DMI09; RTFL0 /DMI09, RTFL0
+ DMI10; DM2516&177+TADC /DMI10, TAD DM2516/(2516)
+ DMI11; DMSEND&177+JMSC /DMI11, JMS DMSEND
+ DMI12; TAD RATE /DMI12, TAD RATE
+ DMI13; DM2460&177+TADC /DMI13, TAD DM2460/(2460)
+ DMI14; DMSEND&177+JMSC /DMI14, JMS DMSEND
+ DMI15; DM3425&177+TADC /DMI15, TAD DM3425/(3425)
+ DMI16; DMSEND&177+JMSC /DMI16, JMS DMSEND
+ DMI17; RKRB0 /DMI17, RKRB0
+
+ DMISET / *DMISET
+
+ RTFL0 /DMISET, RTFL0
+
+ DMISKP / *DMISKP
+
+ RTSF0 /DMISKP, RTSF0
+\f DMIOUT / *DMIOUT
+
+ RTLS0 /DMIOUT, RTLS0
+
+ INSKIP / *INSKIP
+
+ RKSF0 /INSKIP, RKSF0
+
+ INREAD / *INREAD
+
+ RKRB0 /INREAD, RKRB0
+
+ COMWAIT / *COMWAIT
+
+ GETFLOW&177+JMSC /COMWAIT,JMS GETFLOW
+
+ NOWAIT / *NOWAIT
+
+ RTSF0 /NOWAIT, RTSF0
+ CMOUT1; OWAIT&177+JMPC /CMOUT1, JMP OWAIT
+
+ DM1AND / *DM1AND
+
+ AND377 /DM1AND, AND [377]
+
+ CMOUT4 / *CMOUT4
+
+ RTLS0 /CMOUT4, RTLS0
+
+ RINTEST / *RINTEST
+
+ RKSF0 /RINTEST,RKSF0
+
+ RINREAD / *RINREAD
+
+ RKRB0 /RINREAD,RKRB0
+ RINGT1; SKP /RINGT1, SKP
+
+ DM1AN2 / *DM1AN2
+
+ AND377 /DM1AN2, AND [377]
+
+ REMTSF / *REMTSF
+
+ RTSF0 /REMTSF, RTSF0
+
+ REMTLS / *REMTLS
+
+ RTLS0 /REMTLS, RTLS0
+
+ 0 /THIS ENDS THE LIST
+\f/ DECMATE I SECONDARY REPLACEMENT LIST /050 CJL
+
+DM1SEC, DMI02 / *DMI02
+
+ WCON1 /DMI02, WCON1
+ DMI03; NL4000 /DMI03, NL4000
+
+ DMI09 / *DMI09
+
+ RTFL1 /DMI09, RTFL1
+
+ DMI17 / *DMI17
+
+ RKRB1 /DMI17, RKRB1
+
+ DMISET / *DMISET
+
+ RTFL1 /DMISET, RTFL1
+
+ DMISKP / *DMISKP
+
+ RTSF1 /DMISKP, RTSF1
+
+ DMIOUT / *DMIOUT
+
+ RTLS1 /DMIOUT, RTLS1
+
+ INSKIP / *INSKIP
+
+ RKSF1 /INSKIP, RKSF1
+
+ INREAD / *INREAD
+
+ RKRB1 /INREAD, RKRB1
+
+ NOWAIT / *NOWAIT
+
+ RTSF1 /NOWAIT, RTSF1
+
+ CMOUT4 / *CMOUT4
+
+ RTLS1 /CMOUT4, RTLS1
+
+ RINTEST / *RINTEST
+
+ RKSF1 /RINTEST,RKSF1
+
+ RINREAD / *RINREAD
+
+ RKRB1 /RINREAD,RKRB1
+
+ REMTSF / *REMTSF
+
+ RTSF1 /REMTSF, RTSF1
+\f REMTLS / *REMTLS
+
+ RTLS1 /REMTLS, RTLS1
+
+ 0 /THIS ENDS THE LIST
+\f/ ONCE-ONLY TEXT MESSAGES. /024 CJL
+
+ FIELD BUFFLD%10 /FILE I/O BUFFER FIELD
+
+ *FILBUFFER /OVER FILE I/O BUFFER
+
+/ LOCAL PREFERENCE MESSAGE. /024 CJL
+
+/ USE SOMETHING APPROPRIATE HERE TO CUSTOMIZE KERMIT-12 TO YOUR MACHINE.
+
+/ THIS LOCATION SHOULD BE MAINTAINED SINCE IT IS DOCUMENTED TO BE HERE.
+
+ XLIST OFF
+ IFZERO GENMSG <
+ XLIST ON
+LCLMSG, *LCLMSG+40 /EMPTY HOLE FOR USER MESSAGE /039 CJL
+
+ XLIST OFF >
+ IFNZRO GENMSG <
+ IFNZRO LEDERLE <
+ XLIST ON
+LCLMSG, TEXT "%^T^HANKS TO: ^B^ILL ^S^MITH AND ^D^INGER ^M^ILLER%"
+
+ XLIST OFF >
+ IFNZRO UMSG <
+ XLIST ON
+LCLMSG, TEXT "%^I^NSERT LOCAL USER MESSAGE HERE!%^"
+
+ XLIST OFF >
+ IFZERO LEDERLE!UMSG <
+ XLIST ON
+LCLMSG, TEXT "^^^^^^^^^^^^^^^^^^^^^^"/DEFAULT IS NO MESSAGE
+
+ XLIST OFF >
+ IFNZRO LCLMSG+40-. <
+ XLIST ON
+ ZBLOCK LCLMSG+40-. /LEAVE PATCHING SPACE
+
+ XLIST OFF >
+ >
+ XLIST ON
+CLOSMSG,TEXT "^]^" /CPU TYPE CLOSING MESSAGE
+\f/ CPU IDENTIFICATION LIST; ALL MUST BE 5 WORDS LONG (EXCEPT LAST)./024 CJL
+
+CPULIST,TEXT "^U^NKNOWN" /00=UNKNOWN
+ TEXT "^PDP^-5^^" /01=PDP-5
+ TEXT "^PDP^-8^^" /02=PDP-8
+ TEXT "^PDP^-8/S" /03=PDP-8/S
+ TEXT "^LINC^-8^" /04=LINC-8
+ TEXT "^PDP^-8/I" /05=PDP-8/I
+ TEXT "^PDP^-8/L" /06=PDP-8/L
+ TEXT "^PDP^-12^" /07=PDP-12
+ TEXT "^PDP^-8/E" /10=PDP-8/E
+ TEXT "^PDP^-8/A" /11=PDP-8/A
+\f TEXT "6100^^^^^" /12=6100
+ TEXT "6120^" /13=6120; LAST CAN BE SHORT!
+CPUTMSG,TEXT "%^[C^PU TYPE IS: " /CPU TYPE MESSAGE
+DAYMSG, DAY%12^66+DAY+6060 /DAY MESSAGE
+ TEXT " "
+DMPOMSG,TEXT " ^[U^SING ^C^OMMUNICATIONS" /DECMATE PORT MESSAGE
+ TEXT " ^P^ORT^]"
+DMPPMSG,TEXT " ^[U^SING ^P^RINTER ^P^ORT^]^" /DECMATE SERIAL PORT MESSAGE
+\fINITMSG,TEXT "%^PS/8 PS/12 OS/8 OS/12 " /INITIAL MESSAGE
+ TEXT "OS/78 OS/278 K^ERMIT-12 ^V"
+INMSG2, VERSION%12^66+VERSION+6060 /VERSION DIGITS
+INMSG3, "^^100+REVISION /REVISION
+ TEXT " " /END OF MESSAGE
+ XLIST OFF
+ IFZERO MONTH-1 <
+ XLIST ON
+MONMSG, TEXT "^J^ANUARY ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-2 <
+ XLIST ON
+MONMSG, TEXT "^F^EBRUARY " /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-3 <
+ XLIST ON
+MONMSG, TEXT "^M^ARCH ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-4 <
+ XLIST ON
+MONMSG, TEXT "^A^PRIL ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-5 <
+ XLIST ON
+MONMSG, TEXT "^M^AY ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-6 <
+ XLIST ON
+MONMSG, TEXT "^J^UNE " /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-7 <
+ XLIST ON
+MONMSG, TEXT "^J^ULY " /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-10 <
+ XLIST ON
+MONMSG, TEXT "^A^UGUST " /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-11 <
+ XLIST ON
+MONMSG, TEXT "^S^EPTEMBER ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-12 <
+ XLIST ON
+MONMSG, TEXT "^O^CTOBER ^" /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-13 <
+ XLIST ON
+MONMSG, TEXT "^N^OVEMBER " /MONTH MESSAGE
+ XLIST OFF >
+ IFZERO MONTH-14 <
+ XLIST ON
+MONMSG, TEXT "^D^ECEMBER " /MONTH MESSAGE
+ XLIST OFF >
+ IFNZRO MONMSG+7-. <
+ XLIST ON
+
+ ZBLOCK MONMSG+7-. /EMPTY SPACE FOR ALIGNMENT
+
+ XLIST OFF >
+ XLIST ON
+\fTHLPMSG,TEXT "%^T^YPE ^HELP<CR>^ FOR HELP%^" /TYPE HELP MESSAGE
+YEARMSG,TEXT "19" /YEAR MESSAGE
+ YEAR%12^66+YEAR+6060 /YEAR DIGITS
+ TEXT "^" /END OF MESSAGE
+\f/ CPU-SPECIFIC PROMPT LIST. /024 CJL
+
+CPUPRMP,TEXT "??^>^^^" /UNKNOWN
+ TEXT "5^>^^^^" /PDP-5
+ TEXT "8^>^^^^" /PDP-8
+ TEXT "8^/S>^^" /PDP-8/S
+ TEXT "LINC-8>" /LINC-8
+ TEXT "8^/I>^^" /PDP-8/I
+ TEXT "8^/L>^^" /PDP-8/L
+ TEXT "12^>^^^" /PDP-12
+ TEXT "8^/E>^^" /PDP-8/E
+ TEXT "8^/A>^^" /PDP-8/A
+ TEXT "78^>^^^" /6100
+ TEXT "278^>^^" /6120
+\f/ CPU-SPECIFIC IDENTIFICATION LIST. /025 CJL
+
+CPUIDLS,TEXT "^U^NKNOWN" /UNKNOWN
+ TEXT "^PDP^-5^^" /PDP-5
+ TEXT "^PDP^-8^^" /PDP-8
+ TEXT "^PDP^-8/S" /PDP-8/S
+ TEXT "^LINC^-8^" /LINC-8
+ TEXT "^PDP^-8/I" /PDP-8/I
+ TEXT "^PDP^-8/L" /PDP-8/L
+ TEXT "^PDP^-12^" /PDP-12
+ TEXT "^PDP^-8/E" /PDP-8/E
+ TEXT "^PDP^-8/A" /PDP-8/A
+\f TEXT "^VT^-78^^" /VT-78
+ TEXT "^DEC^MATE" /6120
+\f FIELD MSGFLD%10 /MESSAGE FIELD
+
+ *FLD1ADR /PERMANENT LOAD ADDRESS /046 CJL
+ /TEXT MESSAGES LOAD HERE/046 CJL
+
+ABMSG, TEXT "%^F^ILE ^A^BORT%^" /FILE ABORT MESSAGE
+CMERMSG,TEXT "?^I^NVALID COMMAND^" /COMMAND ERROR MESSAGE
+CONNMSG,TEXT "%(^C^ONNECTING TO HOST, TYPE " /FIRST CONNECT MESSAGE
+CONTMSG,TEXT "^C^ONTROL-^" /CONTROL CHARACTER MESSAGE
+\fCON2MSG,TEXT " ^C^ TO RETURN TO ^" /BRIDGING CONNECT MESSAGE
+CON3MSG,TEXT ")%^" /FINAL CONNECT MESSAGE
+CPUMSG, ZBLOCK 5 /CPU ID MESSAGE GOES HERE
+/CRLF, TEXT "%" /<CR>, <LF> MESSAGE
+DNERMSG,TEXT "?^E^RROR IN DEVICE NAME" /DEVICE NAME ERROR MESSAGE
+DSFLMSG,TEXT "?^D^ISK FULL!" /DISK OUT OF ROOM ERROR MESSAGE
+FCLEMSG,TEXT "?^E^RROR CLOSING FILE" /FILE CLOSE ERROR MESSAGE
+\fFNERMSG, TEXT "?^E^RROR IN FILE NAME" /FILE NAME ERROR MESSAGE
+FRECMSG,TEXT "^R^EC: ^" /RECEIVING FILE MESSAGE
+FSENMSG,TEXT "^S^END: ^" /SENDING FILE MESSAGE
+FSERMSG,TEXT "?^F^ILE NAME SYNTAX ERROR" /FILE NAME ERROR MESSAGE
+\fHELPMSG,TEXT "%^S^UPPORTED COMMANDS ARE:%%" /HELP MESSAGE
+ TEXT "^CONNECT^ (TO REMOTE SYSTEM) %"
+ TEXT "^SEND DEV:FILNAM.EX^ %"
+\f TEXT "^RECEIVE DEV:^ (FILENAME AND EXTENSION ^NOT^ ALLOWED)%"
+ TEXT "^GET DEV:FILNAM.EX^%"
+ TEXT "^FINISH^ (SERVER)%"
+\f TEXT "^EXIT^ (TO OPERATING SYSTEM) %"
+ TEXT "^HELP^ (THIS MESSAGE)%"
+ TEXT "%^E^SCAPE CHARACTER: "
+KERRMSG,TEXT "%^K^EYBOARD INPUT ERROR!%" /KEYBOARD ERROR MESSAGE
+
+ CRLF= .-1 /<CR>, <LF> MESSAGE
+\fNOFINIS,TEXT "?^U^NABLE TO TELL HOST THAT " /FINISH ERROR MESSAGE
+ TEXT "SESSION IS FINISHED"
+NOTFND, TEXT "?^U^NABLE TO LOCATE FILE^" /FILE NOT FOUND MESSAGE
+PRMTMSG,TEXT "^K^ERMIT-^" /STATIC PORTION OF PROMPT MESSAGE
+PROMID, ZBLOCK 23 /MODIFIED PORTION OF PROMPT MESSAGE
+PRMT2, TEXT "^K12>" /PHPH
+RERRMSG,TEXT "?^R^ECEIVE FAILURE^" /GENERAL RECEIVE FAILURE MESSAGE
+\fRFLNMSG,TEXT "?^E^RROR IN RECEIVED FILE NAME"/RECEIVED NAME ERROR MESSAGE
+ TEXT "^"
+RHFEMSG,TEXT "^U^NABLE TO RECEIVE - HANDLER" /HANDLER FETCH ERROR MESSAGE
+ TEXT " ERROR^"
+\fRIDEMSG,TEXT "?^U^NABLE TO RECEIVE -" /DIRECTORY FULL ERROR MESSAGE
+ TEXT " INSUFFICIENT DIRECTORY SPACE"
+RIERMSG,TEXT "%^R^EMOTE LINE INPUT ERROR!%^" /REMOTE LINE ERROR MESSAGE
+\fRPERMSG,TEXT "?^U^NABLE TO RECEIVE LATEST " /LATEST PACKET ERROR MESSAGE
+ TEXT "PACKET^"
+SDERMSG,TEXT "?^U^NABLE TO SEND - DIRECTORY "/DIRECTORY INPUT ERROR MESSAGE
+ TEXT "ERROR"
+SHFEMSG,TEXT "?^U^NABLE TO SEND - HANDLER " /HANDLER FETCH ERROR MESSAGE
+ TEXT "ERROR"
+\fSNDEMSG,TEXT "?^U^NABLE TO SEND" /GENERAL SEND ERROR MESSAGE
+UPERMSG,TEXT "?^U^NABLE TO RECEIVE - DATA " /RECEIVED DATA ERROR MESSAGE
+ TEXT "ERROR"
+
+ $ /THAT'S ALL FOLK!
projects / pdp8.git / commitdiff