!begin
/[ KAL4 assembler written by John Thomason and copy typed by David Holdsworth
/[ *Q on listing is underlined [ on flex and { in this file -- similarly *u is }
/[ This file needs to be in ISO not UTF-8, i.e. this � is a multiplication sign
/[ comments introduced by /[ have been added in the 21st century
/[ Some hypotheses
/[ Q7 addresses a stack of identifier entries growing down from the top of memory
/[ dictionary entry is 2 words with identifier in 2nd word
/[ 1st word Q syll / line no / word
/[ M7 addresses next free slot
/[ ----- page 01
gap = 0:
bjtime=300: /maximum time limits
fjtime=30: /fjtime is default time limit for all jobs
mcsize=29600: /maximum size for binaries
prog=0: /form B-block
J.8; =H0;
prog=4: JS.rs1; J.rs2; /restart
prog=8:
!begin !label failmark, endmark, zeroout, catfail, fail, ptr, failno;
SET.code; SRM1; QFRQ0/2; ITWO2; M+I2; FMMN0/0; SRM7; IFRQ0/6;
SET48; SRC3; JS.openoutput; JEJ.ptinput; FLINK; ERASE; J.openinput;
opened: ZERO; NOT; DUP; SMMQN2/1; NEG; SHL31; F.indisc; OR; S.indisc;
FMM0/0; SMM1/0; IMTWO7; M+I7; ZERO; SM1.5; MFRQ2/3; J.dumbeg;
*failmark:=0;
endmark:=0;
error:= {*cError*sat*s};
after:= P *safter*s;
fl:= {*cFAILS};
ptr:= {*s ��� *s*d in *s updating *s};
cline:= 0; /basic symbol pointer at start of current line
zeroout: ZERO; OUT; MRWDQ0; /used as default restarts
fl12: SET#5602;
nfail: S.failno;
catfail: SET-100; S.failmark; F.fl; S.error;
fail: JEJ.prog+1; FLINK; ERASE; JNEN.prog-0s1; JNEJ.prog-1;
failm: F.error+1; F.error; JS.printtwo;
FC3; SET#70; AND; SC3; SET#377; DUP; JS.printadd+0s3;
JS.printline; F.after; JS.print8; F.lastlab; REV; JS.printid+0s3;
F.lineno; JS.printline+0s2; JS.prnl;
F.failmark; NOT; NEG; DUP; S.failmark;
DUP; JLTZ.windup; SHL-5; F.endmark; JNEZ.upderr;
FQ13; FQ12; CFRQ0/13; F.cline; SQ12;
pl: FQ12; JEQ.pw-0s1;JS.inbs; JS.oubs; J.pl;REV;
pw: FQ13; JEQ.pr-3;
JS.inbs; SET#240; JNE.prog+1;JS.countl; JS.oubs; J.pw;
F.ptr; JS.printsix; JCNZ13.pr; JCNZ12.pr; SET#240; J.pr+0s3;
pr: JS.inbs; DUP; JS.oubs; SET#240; NEV; JNEZ.pr;
SQ13; SQ12; JNEZ.fl3; JS.round; J.nxitem;
upderr: F.ptr+2; F.ptr+1; JS.printtwo;
FMMN10/0; DUP; SET#377; JS.printid+0s3;
JS.prnl; REV; JEQZ.updfail;
fl3: SET3; J.nfail; /more than 32 errors
/options
*test:= 0; / -1 bin 0 load and go
length:= -1; / 1 C 2 8 3 L 0 8 with text -1 L with text
tables:= 0; / -1 tables 0 w/o tables
ptbin:=0; / 0 disc binaries, #0 P.T. binaries
jq:=0; /0 foreground, 1 background, -1 paper tape
timelt:=0; =H0;
prnl: SET#240; /output newline
/out basic symbol
/ptoubs comes in here
/[ ----- page 02
!begin
!label openoutput, bfr, oubs;
*oubs: VR; DUP; SHL-6; JNEZ.long; JS.bstopr;
char: FMM14/0; SHA6; OR; SMM14/0; JV.nwd; EXITH;
ouch: SET2; JNE.char; M+I14; ERASE;
tfr: SET#177702; SMM14/0; CIFRQ15/14;JCZ15.out8;
PARQ14; LPQ14; J.reset;
out8: SET#30; S.bfr; FQ14; SET8; OUT;
reset: SET16; SRC14; SET.bfr; SM14;
nwd: SET#177776; SMMQN14/0; JCZ14.tfr; EXITH;
tab: ERASE; FMM14/0; SHA6; JNV.prog-0s2; SMM14/0; J.nwd;
long: SET#256; JEQ.tab; SET#377; JEQ.du;
FQ13; REV; SET.endtable-table; SRC13;
*loop: FMQ13.table; STR; ERASE; SHL-36; JEQ.found; JCNZS13;
found: ERASE; FM13.table; FM13.table-1; CAB; SQ13;
STR; SHLD+12; JGEZ.unpk; DUP; JS.unpk; DUP;
unpk: ZERO; SHLD6; JS.ouch; DUP; JNEZ.unpk; ERASE;
du: ERASE; EXITH;
*bfr:=D 0;
openoutput: SET.bfr; SRI15; J.reset;
prog=bfr+17: /output buffer - 17 words for L.P.
/teletype output can overflow into character table
*table:= #0236 000000000000; = # 0240 020000000000;
=#0230 340000000000; =#0241 170000000000; =#0301 350000000000;
=#0214 154245475156; =#0234 154556440000;
=#0321 360000000000; =#0261 150000000000; =#0221 154451660000;
=#0201 151500000000; =#0271 100000000000; =#0242 110000000000;
=#0265 101100000000; =#0322 155645000000; =#0302 154764000000;
=#0202 155464000000; =#0262 154745000000; =#0222 155445000000;
=#0246 160000000000; =#0204 120000000000; =#0224 130000000000;
=#0211 151200000000; =#0231 151300000000; =#0215 156100000000;
=#0235 156500000000; =#0216 140000000000; =#0276 154555020000;
=#0101 156245415400; =#4102 155156644547; =#4562 000000000000;
=#0206 154657620000; =#0326 154457000000; =#0266 156364456000;
=#0306 156556645154; =#0226 156750515445; =#4200 154357555545;
=#5664 000000000000; =#4103 154257575445; =#4156 000000000000;
=#0110 144162624171; =#4120 156062574345; =#44656245 00000000;
=#0237 156641546545; =#0171 155441424554; =#4130 156367516443;
=#50 00000000000000; =#4172 156364625156; =#47 00000000000000;
=#0217 155747560000; =#0205 155146000000; =#0316 156545550200;
=#0225 156450455600; =#0245 154554634500; =#0210 154757645700;
=#0223 154156440000; =#0243 155762000000; =#0263 155155600000;
=#0303 154561660000; =#0203 155657640000; =#0335 156462654500;
=#0315 154641546345; =#4320 155451426241; =#6271 000000000000;
=#0260 155344463100; =#0360 154570516400; =#4340 156345475545;
=#5664 000000000000; =#0300 154154475754; =#0220 070000000000;
=#0777 060000000000;
endtable=prog:
!end
!begin /basic symbol to teletype
*entry: J.outt; /to overwrite oubs
outt: VR; FMM14/0; SHA8; OR;SMM14/0; JV.word; EXITH;
word: JCZ14.tfr; FI14; SMMQN14/0; EXITH;
finoutt: VR; FMM14/0; NOT; SHA8; JNV.prog-0s2; NOT;
SMM14/0; JCZ14.tfr;
F.sixz; SMMQN14/0; JCNZ14.prog-0s5;
tfr: FQ15; SET33; OUT;
FC15; NOT; NEG; SET19; MAX; ERASE; SC15;
F.qwd; SQ14; JNV.end; DC15;
F.sixz+1; SMMQ14/0; F.sixz+2; SMMQ14/0; F.sixz+3; SMMQ14/0;
end: FI14; SMM14/0; EXITH;
openoutt: F.entry; S.oubs; F.qwd; DUP; SQ14; SHC+16; SQ15; M+I15;
SET#736; J.end+0s2;
/[ ----- page 03
*qwd:= Q 39 / 1 / bfr;
sixz:= {*6z *3c Too*smuch*sO/P*3c};
!label openoutt, outt, finoutt;
!end
prog=prog+gap: /allow elbow-room for slotting ptoubs
*transfer: =Q 0 / block /block+639;
texid:= P *n*cT*c------------; /file ident to check chaining
jobno:= P +0/00299; /systems box in case of book /[ a Leeds Univ job no of the KDF9 era
magic:= P PDUX /CUE; /stats code - disc or P.T.
dlost:= -32768;
time:= D 0; / ran/el times for Adrian /[ Adrian Hock was head of user services
eml:= #3777777767650000; /last line of text after SHL2; SHAD5;
!begin !label initial;
initial: F.block+13; JS.discread; F.block; F.block+1;
JS.chfile+1; F.ptbin; JEQZ.open;
SET2; SHC-6; SET4; SRC11; ZERO; FM11.block+2; SHLD-6; CAB; OR;
SMQ11.ablock+3; JCNZ11.prog-1s5; SET#75; OR; S.ablock+7;
open: F.ptfile; JNEZ.opened; F.block+80; S.block; F.block+81; DUP;
NEG; SRM12; JS.chfile; FQ12; S.cline; SET.block+81; +; SQ13; J.opened;
!label inbs, line, options, blocks;
inbs: JCNZ13.next; JCNZ12.nword;
newline: FM12; JNEZ.line; F.inlib; JNEZ.nblock;
*blocks: F.block; JS.discread; JS.chfile; F.block+1;
DUP; NEG; SRM12; SET.block+1; +; SM13;
line: FQ12; S.cline; FMMN12/13; ZERO; SHLD2; REV; ZERO; SHAD5;
SC12; SET8; SC13; REV; JNEZ.dummyl; F.eml; NEV; JEQZ.em;
nword: SET-48; S+C13;
first: M+I12; DC12;
next: SET8; S+C13; SET#377; FMM12/13; SHLC13; AND; EXITH;
em: F.inlib; JNEZ.endlib; SET1; J.nfail;
dummyl: SHL-39; SET#367; +; DUP; SHA-1; JEQZ.ta; ERASE;
dl: FC12; S+M12; CFRQ0/12; J.newline;
ta: S.tables; JS.prnl; ZERO; S.refcount; J.dl;
!end
!label blocks, line, jq, ptbin, test, length, tables, oubs, openoutput;
!label discread, transfer, openinput, inbs, libcall, chfile, reread, erex;
discread: DUP; S.indisc; F.transfer; SHLD16; SHC-16; REV;
SHL16; SET32; OUT; EXITH;
reread: F.ptfile; JNEZ.prog-1; F.indisc; DUP; JS.discread+0s4;
JS.chfile; SHL16; JGEZ.prog+1s3; F.block+80; S.block; EXITH;
libcall: /library insertion
!begin !label lib F.O.C, endlib, nblock, inlib;
F.cline; S.oldcline; JS.input; M+I2; F.idbfr; SQ8;
onelib: FMMQ2/1; DUP; SHL-6; JNEZ.fail; JS.bstopr; F.zer; SHL-24;
ndig: FMMQ2/1; DUP; SET10; SIGN; JGEZ.last; SET#20; OR;
REV; VR; SHA6; OR; JNV.ndig; J.fail;
last: PERM; ZERO; SHLD24; JEQZ.fail; REV; SHLD-6; ERASE; SMMQ8/0;
SET#230; JEQ.last; SET#246; NEV; JNEZ.fail; JCNZ8.onelib; J.fail;
lastlib: ERASE; SET-41; S+C8; SET.f-1; SM8; NC8;
F.blkscan; SQ9; F.lib F.O.C;
nblk: QFRQ8/10; * FMMQN10/0; JLTZ.prog+1s3; *JCNZS10; J.endind;
DUP; JEQZ.endind; JS.discread+0s4;
QFRQ8/10; F.block+639; ZERO;
scan: ERASE; JCZ10.nblk; FMMQN10/0; DUP; JGEZ.scan; QFRQ9/11;
*FMMQ11/0; DUPD; NEV; SHL-18; JEQZ.match; ERASE; JCNZS11; J.scan;
match: FMMQ11/0; DUP; SQ5; JLTZ.match; SI15; FQ5; SMM10/0; J.scan;
endind: ERASE; QFRQ8/10; QFRQ8/9; * FMMQN10/0; DUP; JLTZ.err; SMMQN9/0;
/[ ----- page 04
echeck: JCNZS10; FC9; NEG; S+C8; FQ12; S.q12; FQ13; S.q13; JCZ9.prog+1s3;
JS.prnl; JS.prnl; ZERO; NOT; S.inlib; M+I8; FQ8; J.endlib+0s3;
err: F.mess; JS.print8; SHL-6; SET#56; OR; JS.print8;
F.mess+1; JS.print8; F.failmark; NOT; NEG; S.failmark; J.echeck;
endlib: F.libaddrs; SQ9; JCZ9.exit; FMMQ9/0; FQ9; S.libaddrs;
DUP; SQ9; JS.discread+0s4; FI9;
reset: SET.block; +; SQ13; FMM13/0; SHL30; STR; S.cont; SHC18; DUP; NEG; SRM12;
S+M13; JEJ.nxitem; /symbol is only wanted if JS used
J.inbs+1; /newline to cure running of end of lib file(RRH)
nblock: F.cont; JEQZ.fl8; F.block+639; JS.discread+0s4;
ZERO; J.reset;
exit: JS.restore; F.oldcline; S.cline; JNEJ.inbs; J.nxitem;
restore: F.q12; SQ12; F.q13; SQ13; ZERO; S.inlib; J.reread;
fl8: SET8; J.nfail;
*q12:= 0;
q13:= 0;
oldcline:= 0;
inlib:= 0;
idbfr:= Q 41/1/f;
blkscan:= Q 639/-1/block+639;
lib F.O.C:= 0;
libaddrs:= 0;
cont:= 0;
mess:= P *clibrary 0t *s found;
!end
*ptfile:=0; /non-zero if input is direct from paper tape
tail:= {0/6*s};
syms:= S{*s*d*c*c*t*3d:}; /symbol table for lptobs, print8
= S {= ( ) *a � , / 0123456789 *d @ ; + - . *d
ABCDEFGHIJKLMNOPQRSTUVWXYZ *4x*d};
printtwo: JS.printsix; /print two words via printsix
printsix: /outputs six symbols packed in N1
DUP; NOT; J=Z.erex; ZERO; SHLD8;
JS.oubs; SET#377; OR; J.printsix;
checkz: /used for leading zero suppression
!begin DUP; J=Z.zero; MFRQ0/11; EXITH;
zero: ERASE; FM11; EXITH;
!end
countl: FI1; F.inlib; +; S+I6; EXITH;
chfile: F.block+636; F.block+637;
F.texid+1; NEV; REV; F.texid; NEV; OR; JNEZ.fl12; EXITH;
space: /check store used
FM3; F.inbfr; MAX; FM1; +; ROUND;
space1: FM7; -; F.dlost; MAX; S.dlost;
erex: ERASE; EXITH;
printid: /print packed identifier
!begin SET#236; SM11; SET8; SC11; SHC6;
loop: SHC-12; ZERO; SHLD6; DC11;
JS.checkz; JS.oubs; JCNZ11.loop;
!end ERASE; EXITH;
printadd: /print program address from Q3
!begin SET#236; DUP; SM11; JS.oubs;
FM3; SHL33; SET4; SC11;
word: ZERO; SHLD3; JS.checkz;
JS.oubs; DC11; JCNZ11.word;
SHL-5; F.tail; OR; FC3; SHL21; -; J.printsix;
/[ ----- page 05
!end
printline: /outputs current line number
FI6; SET#236; JS.oubs;
F.ssss; F.decimal; CAB; FRB; SHLD-6;
REV; SHL-2; REV; DUP; JNEZ.prog-0s7; ERASE;
SET#13413; SHLD-16; ERASE; J.printsix;
bstopr: /6-bit B.S. to printer code
!begin SET12; -; DUP; JLTZ.num; SET26; DIVI; SET#41;
ex: +; ROUND; EXITH;
num: SET#34; REV; DUPD; SHA-2; JNEZ.ex;
DUP; SHL-2; CAB; SHL2; +; J.ex;
!end
print8: NOT; DUP; JEQZ.erex; ZERO; NOT; SHLD6; NOT;
JS.lptobs; JS.oubs; J.print8+0s1;
lptobs: SET6; DIVI; SHL3; SC11; SM11;
FM11.syms; SHLC11; SHL-40; EXITH;
!label countl, space, space1, printid, printline, bstopr, print8;
!label initial, fl12, texid, lib F.O.C, openoutt;
!label timelt, printsix, printadd, decimal, printtwo, windup, inlib;
*decimal:=#1212121212121212;
ssss:={*4s};
refcount:=0;
lastlab:=� GORP;
lineno:=0; /line number of last label
inbfr:=8;
failno:=0;
indisc:=0;
flag:=-1;
closestr:= Q #30/#30/#30;
!label ptfile, refcount, lastlab, lineno, inbfr, indisc, flag, dlost;
windup: /end of translate
!begin F.failmark; JEQZ.ok; F.fls; F.failno; NEV; S. okw;
ok: F.k4; JS.printsix; F.okw; JS.print8;
F.ran; JS.printsix; SET#176054; SHL6; F.decimal; SET3; OUT;
F.time; -; SET10; SHL23; �; FRB; SHLD-6; REV; SHC-10; REV; JS.prno;
F.sex; JS.printsix; F.snw; JS.print8; F.snw+1; JS.print8;
JS.space; ZERO; NOT; F.decimal; FMMN0/0; SLINK; FLINK;
F.dlost; +; SHL-5; NOT; NEG; NOT; NEG; SHL5;
FRB; JS.prno; F.snw+2; JS.print8;
F.length; NEG; NOT; JEQZ.end; F.jq; JNEZ.typeend;
SET1; S.length; JS.openoutt; J.ok;
end: JS.finoutt; SET17; OUT;
F.time; -; JS.frb; S.time; F.time+1; JS.frb; S.time+1;
FMMN0/0; SHL24; JS.frb; S.dlost; FM1.3; SHL36; SHL-42;
SET#60; JEQ.pors; SET#63; JEQ.pors; ERASE; ZERO;
pors: SHC-6; F.magic; OR; F.ptfile; JNEZ.prog+0s5; SHL-24;
SHL+24; S.magic; SET7; SRM11; SET.transfer; SI11; FMM11/0; S.transfer;
M+I11; FQ11; SET50; OUT;
F.failmark; JNEZ.stop; EXITH;
typeend: F.length; SHC-1; JLTZ.prog+1s3; SET#276; JS.oubs;
F.test; NOT; F.failmark; OR; JEQZ.end+0s3;
/suppress O.K. flex message after on disc or punched
F.okw; F.texid+1; F.texid; NOT; SHL24; NOT; JS.type; J.end+0s3;
frb: SHA-24; F.decimal; REV; FRB; F.zer; OR; EXITH;
prno: SHLD-6; REV; SHL-2; REV; DUP; JNEZ.prog-0s7; ERASE; J.printsix;
*k4:= {*c KAL4 };
/[ ----- page 06
okw:= P *s O.K. *s;
fls:= P *s FAIL *s*d 0;
ran:= # 4741641406317377;
sex:= {*s secs.};
snw:= P *2s store *s needed *3s words. *c;
zer:=P 00000000;
!label prno, zer;
!end
!label prnl, time, prno, closestr;
!label nfail, options, jobno, ssss, rs1, rs2, fl2, fl6, fl7, fl9;
fl2: SET2; J.nfail; /dictionary meets program
rs1: IONE14; FLINK; J.nfail; /even restart - terminate
rs2: IONE14; SET5; J.nfail; /odd restart
fl6: SET6; J.nfail; /dictionary lost during binary output
fl7: SET7; J.nfail; /error in OUT29
fl9: SET9; J.nfail;
!end
/ Facility added in assembler by A.P.McCann June 1972
/ Input source file may be switched by stmt of type
/ !goto newfile-name where newfile-name is a full 12 char ident. Any chars in
/ amendment field are ignored in searching index. If file is not on disc
/ then a fail message is given and assembler packs up
/
!begin
!begin (block for goto procesing)
!label goto;
/
goto: SI11; /flag for 2 halves of ident
/
/ read 6 chars making half the ident
/
gethalf: SET6; SC11; ZERO; /6 chars in each half
/
/ char fetch loop
/
getchs: SHL6; JS.einbs; JS.bstopr; /get char convert to printer code
OR; DC11; JCNZ11.getchs; /form chars into word
FI11; ZERO; SI11; JNEZ.gethalf; /do other half of ident
SHL12; REV; SHLD-12; /shift into place
F.nctc; OR; ZERO; /ident completed. N1 = text index adrs
/
/ loop for searching text index which is read into input text bfr
/
srchindex: JS.discread; SET.block; SRM12; /M12 points to 1st word of index blk
SET212; FMMQ12/0; SHL-32; -;/get no. of entries in blk
SC12; SET3; SI12; JCZ12.anymo; /Q12 set for scan. jmp if blk empty
* FMMQ12/0; JEQ.maybe; /loop to match top half of ident
/
/ return to search loop if 2nd half of ident doesnt match
/
*contsrch: JCNZS12; /scan all entries in blk
/
/ here when blk finished to see if more blcks
/
anymo: F.block+639; DUP; JNEZ.srchindex; /get next on chain
NOT; SHL30; OR; /mask top 3 chars of ident
JS.print8; JS.print8; /priny ident /[typo for print (?)
F.notfnd; JS.print8; J.catfail; /print not fnd,fail
/
/ half matched ident. see if other half matches
/[ ----- page 07
/
maybe: M-I12; REV; DUP; /N1 = 2nd half
FMMN12/0; NEV; /compare
ZERO; NOT; SHL12; SHC18; AND; /mask amendment no
JEQZ.fnd; /jmp if it matches
REV; M+I12; J.contsrch; /keep looking
/
/ here when located
/
fnd: ERASE; ERASE; FM12.2; JS.discread; /read alpha block
F.block; S.texid; /keep....
F.block+1; S.texid+1; /....identifier
F.block+80; S.block; /NOC
F.block+81; DUP; /word count
NEG; SRM12; /Q12 set up
SET.block+81; +; SQ13; /Q13 set up
J.nxitem; /continue assembling
*notfnd := P *snot*sfnd; /for fail message
nctc := P *n *c T *c *4s; /to complete identifier
/
!end (of goto)
/
bracket: ERASE; ZERO; NOT;
JS.pbs; SET#204; JNE.prog+1s1; REV; NEG; NOT; REV;
SET#224; NEV; JNEZ.prog+0s5; NOT; NEG;
DUP; JNEZ.bracket+0s3; ERASE;
nxitem: FM2; FM3; F.inbfr; MAX; ROUND; DUP; SRM2; MAX; FM1; +; FM7; -;
JGEZ.fl2; ERASE; VR; JNEN.fl9; /check dict. meets prog, nest
/check for comment asterisk etc.
JS.einbs;
return: DUP; SHL-6; J=Z.load; /letter
SET#242; J=.equals; /constant
SET#216; J=.ast;
SET#240; J=.crlf;
SET#214; J=.beginblock; /!begin
SET#234; J=.endblock; /!end
SET#241; J=.slash; / / comments
SET#171; J=.labelspec; / !label list
SET#200; J=.comment; / !comment comments
SET#340; J=.segment; / !segment
SET#204; J=.bracket;
SET#210; J=.goto; /find alternative input file
SET#320; J=.libcall; / !library
SET#230; J=.nxitem-0s1; /extra semicolon
/
load: SMMQN2/1; /read rest of item to semicolon or colon
nxebs: JS.einbs; DUP; SMMQN2/1;
SET#230; J=.instr; SET#240; JEQ.fail;
SET185; NEV; J#Z.nxebs; J.ident;
slash: FC12; S+M12; CFRQ0/12; CFRQ0/13;
crlf: FI1; F.inlib; +; S+I6; J.nxitem-0s1;
comment: F.tables; JEQZ.slash; SET#240; DUP; JS.oubs; REV;
SHL8; F.ssssd; OR; JS.printsix;
ccopy: JS.inbs; DUP; JS.oubs; JNE.ccopy;
/[ ----- page 08
ZERO; S.refcount; J.crlf;
ast: JS.round; JS.einbs; REV; J#.return;
FM3; NEG; NOT; SHL-5;
NOT; NEG; SHL5; SM3; J.nxitem-0s1;
/conversion table for signs in instructions
*spec:
=# 10000000 77775 301; / =HX+; =T-6; =S{+};
=# 11000000 77775 321;
=# 30402737 77764 261;
=# 17244100 77767 221;
=# 20340000 77772 242;
=# 31200000 77772 322;
=# 27370000 77772 202;
=# 27200000 77772 222;
=# 22370000 77772 302;
=# 22200000 77772 262;
speclist:= Q prog-spec / 1 / spec-1;
du:={*6#17}; /dummy syllables for rounding
qn:=0;
qnn:=0;
instr: FC2; NOT; NEG; S+M2;
SHL-4; SC2; IMFRQ0/4; ZERO; NOT; /C2 = 9
!begin /basic parsing scan
nibs: FMMQ2/1; SET#230; J=.eparse;
JCZ2.fail; /instruction pattern too long
DUP; SET12; SIGN; JGEZ.nibs;
IMONE4; SET11; J=.eparse; /type CA
digit: DUPD; ERASE; ABS; SHC-7; JGEZ.dig; /not sign
/ ABS caters for case of no code before digit
ERASE; M-I2; /number signed or invalid - go back to sign
dig: JS.assemno; S.qn;
IONE4; SET#230; JEQ.eparse;
IMTWO4; SET#13; JEQ.eparse; SET#241; JNE.fail;
cnn: ERASE; FMMQ2/1; JS.assemno; /second Q-store number
S.qnn; ITWO4; /type two
SET152; JNE.fail;
/second number not terminated by semicolon
eparse: /pack instruction pattern for location
ZERO; REV;
l: ERASE; REV; DUP; NOT; JEQZ.endpa;
SHLD-6; DUP; JEQZ.l; /letter
SHLD6; SHC-8; F.speclist; SQ11; /symbol
*FMMQN11/0; SHL40; JEQ.prog+1s2; JCNZS11; J.fail;
ERASE; FMM11/0; SHL-8; SC11; SHLC11;
FMMH0/11; OR; J.l+0s1;
endpa: ERASE; / N1 = instruction pattern
!end
!begin M+I4; FM4.tc; /fetch appropriate dope word
/instruction pattern locator
SQ11; MFRQ11/4; FC11; SM11; MFRQ0/10;
high: MFRQ10/9;
loop: FM11; FM9; DUPD; +; SHL-1; SM10; /binary search
NOT; +; REV;
DUP; FMM10/4; SIGN; DUP; JEQZ.found;
CAB; JEQZ.fail;
JGTZ.high; MFRQ10/11; J.loop;
found: SM11; ERASE; ERASE; M+I11;
FMMH10/11; /N1 = blank instruction
FI4; J=Z.store;
FI4; DUP; J09
SET#174377; AND; SET#70001; NEV; JNEZ.cn; /one Q number
F.qn; SHL41; JNV.prog+1s5; J.fail; /shift parameter
setinst: F.qn; SHL32; SHL-8; J.store-0s1;
cnn: F.qnn; DUP; SHL-4; J#Z.fail; /negative or > 15
SHC-16; OR;
cn: F.qn; DUP; SHL-4; J#Z.fail;
SHC-12; OR;
store: DUP; SHL-46; SET2; MAX; ERASE; NOT; NEG; SC4;
ZERO; SHLD8; DC4; JS.storesyll; JCNZ4.prog-1s2; J.nxitem-0s1;
addr: REV; CFRQ0/4; CMFRQ3/6;
/allow funnies and set update pointer for calcadd
DUP; SHL+1; JLTZ.mors; /use instruction to determine address type
DUP; SHL8; SHL-40; SET#360; MAX;
SIGN; NOT; NEG; DUP; NOT; -;
endaddr: SM4; JS.calcadd; /M4 = address type
SET#230; NEV; J#Z.fail; /check terminator semicolon
JS.addup; REV; NOT; J=Z.store; /unmodified
J.cn; /modified
mors: DUP; SHL-40; SET#304; SIGN; ABS; SHL+1; J.endaddr;
!end
addup: /adds the syllable in N1 and word
/in N2 to the instruction in N3.
/mode of arithmetic specified by M4.
!begin DUP; FM4.sw; REV; JNEZ.prog+1; SHL-24; OR;
SLINK; EXIT;
jumpadd: CAB; SHC5; ZERO; SHLD3;
CAB; +; SET6; DIVI; CAB; +;
SHC-8; PERM; +;
jumpword: REV; SHC4; STR;
REV; SHC8; REV; SHLD12; CAB; +;
SHLD-12; REV; SHC-7; REV;
SHLD-1; ERASE; SHC-4; EXITH;
msadd: REV; SHC2; ZERO; SHLD3;
REV; SHC7; REV; SHLD12; CAB; +;
SHLD-12; REV; SHC-7; REV;
SHLD-3; ERASE; SHC-2; EXITH;
setadd: SHL32; REV; SHC+8; VR; SHA2; JV.fail;
SHA-2; +; SHC-8; EXITH;
syll: CAB; SHC+8; DUP; SHL-32; JNEZ.fail; PERM; REV; SHL+35;
REV; SHLD-3; ERASE; +; SHC-8; EXITH;
*sw:= HA setadd; =HA syll;
=HA jumpword; =HA jumpadd;
=HA msadd; =HA fail;
=HA jumpword; =HA fail;
!end
storesyll: /stores syllable in D40-D47 of N1: D0-D39 zero
SET-8; S+C3; SET#377; SHLDC3; NOT;
FMM3/1; AND; /preserve other syllable
OR; SMM3/1; JCZ3.endro-0s2; EXITH;
round: SET-48; S+C3; JCZ3.endro; NC3; FMM3/1; F.du;
SHLDC3; NC3; SHCC3; SMM3/1; ERASE;
M+I3;
endro: SET48; SC3; EXITH;
/process constant
equals: ERASE; JS.einbs;
!begin SET#23; J=.hconst;
SET#17; J=.dconst;
SET#36; J=.sconst;
SET#37; J=.tconst;
SET48; SRI5; /alignment
SET#34; J=.qconst;
common: FC3; FI5; �I;
/[ ----- page 10
JNEZ.fail; ERASE; /check alignment
SET#33; JEQ.pconst; SET#215; JEQ.string;
SET.endinput; SLINK;
input: M+I2; FM2; SET#230; CAB; DUP; SMMQ2/1; SET#271; JEQ.fail;
SET#240; JEQ.fail; JEQ.prog+1s3; JS.einbs; J.input+1s2;
ERASE; SM2;
endinput: EXITH; FMMQ2/1; /usual exit is to this FMMQ
SET#322; JEQ.octal; SET#14; JEQ.aconst;
SET#261; JEQ.xconst; SET#43; JEQ.xconst;
SET#21; JNE.prog+1s1; /number - check F
SM5; FMMQ2/1; /set floating tag
!begin /assemble numeric constant
number: QFRQ0/10; IMFRQ0/11; QFRQ0/8; SET94; SC11;
ZERO; ZERO; CAB; FI5; NEG; NOT; DUP; SRI9; JGTZ.chpm;
FC11; SI9;
chpm: SET#301; JEQ.sign+0s2; SET#321; JEQ.sign;
chdig: DUP; SET10; SIGN; JGEZ.chdot; JS.digits;
chdot: SET11; JEQ.dec;
chten: SET10; JEQ.exp; SET#20; JEQ.exp;
chsl: SET#241; JEQ.slash; M+I9;
chsc: SET#230; NEV; JNEZ.fail;
SET94; FC11; -; SC10; JCZ10.fail; /no digits
/number in C10 I. P. in N1/N2
FM10; FM11; -; SET12; DIVI; SC5;
DUP; ABS; SC11; JLTZ.divide; JCZ11.endexp;
mult: F.const; DUP; PERM; �D; REVD; �+-47;
SET40; S+C10; DC11; JCNZ11.mult;
endexp: JCZ5.endno; FI1;
* SET10; �D; CONT; DC5; JCNZS5;
SET47; FLOAT; FIX; S+C10;
DUP; PERM; �D; REVD; �+-47;
endno: DUP; JEQZ.prog+2s4; DUP; SHL1; JLTZ.prog+1s4;
DC10; SHAD1; J.endno+0s4;
FI10; JEQZ.pos; NEGD;
pos: FM5; JNEZ.float; FM9; NEG; S+C10;
FC10; NEG; NOT; DUP; JGTZ.fail;
FI9; NOT; -; JLTZ.fail; SHADC10; /check shift O.K.
FI5; DUP; JLTZ.storetwo; SET24; NEV; JEQZ.hfix; ROUND;
store: JV.fail; SMM3/1; M+I3; J.nxitem;
float: FC10; DUP; SHA40; JV.fail; ERASE;
FLOATD; FI5; DUP; JLTZ.storetwo;
SET24; NEV; JEQZ.hfloat; ROUNDF; J.store;
divide: SHAD-1; F.const; DUP; REVD; CAB; DIVR; PERM; REV; DIV; ZERO;
PERM; STR; +D; SET-39; S+C10; DC11; JCNZ11.divide; J.endexp;
storetwo: ERASE; SMM3/1; M+I3; J.store;
hfix: ROUNDH; J.storeh;
hfloat: ROUNDHF;
storeh: JV.fail; ZERO; SHLD8; JS.storesyll; ZERO;
SHLD8; JS.storesyll; SHL-40; JS.storesyll; J.nxitem-0s1;
sign: IONE10; ERASE; FMMQ2/1; J.chdig;
dec: ERASE; IONE11; FMMQ2/1; DUP; SET10; SIGN; JGEZ.fail; JS.digits; J.chten;
exp: ERASE; FC11; SET94; NEV; JNEZ.expa; ZERO; NOT; SHAD-1; S+C11;
expa: FMMQ2/1; JS.assemno; SM10; J.chsl;
slash: ERASE; FM5; JNEZ.fail; FMMQ2/1; JS.assemno; SM9; J.chsc;
digits: JCNZ8.dig; DC11; DC8;
dig: SET-4; S+C11; M+I11; ZERO; SHADC11; REVD; SHAD-1; DUPD;
SHAD-2; +D; +D; DUP; JNEZ.shift; SET4; S+C11; J.nxdig;
shift: DUP; SHL1; JLTZ.nxdig; FI1; S+C11; SHAD1; J.shift;
nxdig: FMMQ2/1; DUP; SET10; SIGN; JLTZ.dig; EXITH;
*const:= 128 000 000 000 000; / 10**12 / 40
!label store, storeh;
!end
/[ ----- page 11
hconst: SET24; J.prog+1;
dconst: SET-48; SRI5; ERASE; JS.einbs; J.common;
pconst: ERASE;
!begin
nxchar: JS.pbs; DUP; SHL-6; JNEZ.long;
JS.bstopr; JS.storechar; J.nxchar;
storechar: SET-6; S+C3; SET#77; DUP; PERM; AND; REV; SHLDC3;
NOT; FMM3/1; AND; OR; SMM3/1; JCZ3.endro-0s2; EXITH;
query: ZERO; NOT; SHLC3; NOT; FMM3/1; OR; SMM3/1;
SET6; SC3; J.storechar-1;
long: SET#216; JEQ.ast; SET#230; JNE.find;
fin: ERASE; FC3; FI5; DIVI; JEQZ.nxitem-0s1;
SET#77; JS.storechar; J.fin;
ERASE; JS.countl;
pbs: JS.einbs; SET#240; JEQ.pbs-0s4; EXITH;
!label pbs, lookup, storechar;
find: SET15; JS.lookup;
SHL-18; J.storechar-1;
ast: ERASE; JS.pbs; SET#34; JEQ.query;
DUP; SET10; SIGN; JLTZ.count; FI1;
esym: SC5; SET#322; JEQ.octal;
JS.pbs; REV; ZERO; JS.lookup; SHL-33; J.store;
octal: JS.num; REV; DUP; SHL-6; JNEZ.fail;
store: DUP; JS.storechar; DC5; JCNZ5.store; ERASE;
JS.einbs+1s2; JS.pbs+0s3; J.nxchar+0s3;
count: JS.num; REV; DUP; NEG; NOT; SHL-16; JNEZ.fail; J.esym;
!end
lookup: SC10; SET11; SRC11;
*!begin FMQ11.symtab; SHLC10; SHL-39; JEQ.found; JCNZS11;
J.fail;
found: ERASE; FM11.symtab-1; EXITH;
/tables of specials in P and { constants
*symtab: /P formal/char/P spec/char/BS formal/BS
=# 36 00 301 35 036 236;
=# 16 02 321 36 016 240;
=# 37 04 241 17 037 256;
=# 31 07 246 16 034 215;
=# 14 14 271 10 040 235;
=# 17 77 214 12 014 216;
=# 20 75 224 13 017 377;
=# 33 03 242 11 020 276;
=# 43 06 261 15 045 316;
=# 40 32 220 32 027 220;
=# 27 32 000 00 043 376;
!end
JS.countl;
string: ERASE;
nxsbs: JS.inbs; SET#377; JEQ.string; SET#240; JEQ.string-0s3;
!begin SET#236; JEQ.string; SET#256; JEQ.string;
SET#216; JEQ.ast; SET#235; JEQ.end;
JS.storesyll; J.nxsbs;
end: JS.einbs; SET#230; NEV; JNEZ.fail;
fin: ERASE; FC3; FI5; DIVI; JEQZ.nxitem-0s1;
SET#377; JS.storesyll; J.fin;
ast: ERASE; JS.pbs; DUP; SET10; SIGN; JLTZ.count; FI1; SC5;
esym: SET#322; JEQ.octal; SET30; JS.lookup;
SET#377; AND; JS.store; J.nxsbs;
octal: JS.num; REV; DUP; SHL-8; JNEZ.fail;
JS.store; J.nxsbs+0s3;
store: DUP; JS.storesyll; DC5; JCNZ5.store;
ERASE; EXITH;
count: JS.num; REV; DUP; NEG; NOT; SHL-16; JNEZ.fail; J.esym-0s2;
/[ ----- page 12
!end
sconst: ERASE; SET8; SRI5; JS.einbs; SET#215; JEQ.string; JS.input;
FMMQ2/1; JS.assemno; REV; SET#230; NEV; JNEZ.fail;
SHA39; STR; ERASE; SHL-39; JNV.lastsy; J.fail;
!label num;
num: DUP; SET10; SIGN; CFRQ0/11;
!begin JLTZ.nosign; SET#322; NEV; JNEZ.fail;
ZERO; JS.pbs; DUP; SHL-3; JNEZ.fail;
octnum: OR; SHA3; JS.inbs; DUP; SHL-3; JEQZ.octnum;
REV; SHL-3; REV; SET#377; JNE.exith;
ERASE; ZERO; J.octnum;
nosign: JS.pbs; SET10; DUPD; SIGN; JGEZ.erex;
CAB; MULTD; CONT; +; J.nosign;
!end
tconst: JS.input; M+I2; ZERO; SET#230;
FM3; FC3; SET48; DIVI; SET8; +; PERM; -; SM6; CMFRQ0/4;
JS.part; SHLD-8; JS.storesyll; SHL-40;
lastsy: JS.storesyll; J.nxitem;
part: SC6; JS.calcadd; PERM; REVD; NEV; JNEZ.fail;
SHL13; DUP; JEQZ.prog+1s2; REV; SET#17777; AND;
OR; SLINK; FLINK; EXITH;
qconst: FC3; FI5; NEV; JNEZ.fail; CMFRQ0/4;
FM3; NEG; NOT; SM6; JS.input; M+I2;
SET#241; SET8; JS.part; SHL32; MFRQ3/6;
SET#241; SET40; JS.part; SHL16; OR;
oneadd: SET#230; SET24; JS.part; OR; J.store;
xconst: /instruction pattern constant
!begin ERASE;
xloop: FMMQ2/1; DUP; SHL-6; JNEZ.endx; JS.storechar; J.xloop;
spec: SHL-4; SET#11; AND; J.xloop+1s2;
endx: SET#301; JEQ.spec; SET#321; JEQ.spec;
SET#230; JNE.fail;
align: ERASE; FC3; FI5; DIVI; JEQZ.nxitem-0s1;
ZERO; JS.storechar; J.align;
!end
octal: FI5; DUP; JLTZ.fail; NEG; NOT; SM5; JS.assemno;
!begin REV; SET#241; JNE.end; ERASE; FMMQ2/1;
JS.assemno; SM5;
end: SET#230; NEV; JNEZ.fail; SET47;
FM5; DUP; JLTZ.fail; -; SC5;
DUP; SHLC5; REV; SHCC5; JNE.fail; /bits lost
FI5; SHL-5; JNEZ.store;
DUP; DUP; SHL24; JEQZ.storeh; J.fail;
!end
aconst:
!begin ERASE; FI5; DUP; JLTZ.fail;
CMFRQ3/6; CMFRQ0/4; SET48; NEV;
DUP; JEQZ.oneadd; JS.calcadd;
SET#230; NEV; JNEZ.fail;
ZERO; PERM; JS.addup; J.storeh;
!end
!label storechar, lookup, pbs, input;
!end
/process label declaration
ident:
!begin FC2; NOT; NEG; S+M2; JS.packid;
CMFRQ0/4; /only check repetion in this block
JS.dsearch; J.boob;
FMMQ2/1; SET#271; J=.implicit; /colon
SET#242; NEV; J#Z.fail; /check =
DC4; F.progid; JEQ.patch; SMMN7/0;
ZERO; JS.calcadd; SET#271; NEV; JNEZ.fail;
/[ ----- page 13
/check terminator colon - address value in N1
store: SC11; SM11; IFRQ6/11;
FQ11; SMMQ7/0; /complete dictionary entry
JEQZ.nxitem; /jump if ref. table entry not reqd
F.ssss; JS.printsix; F.lastlab; JS.printid;
JS.printadd; JS.printline;
F.refcount; DUP; NEG; NOT; S.refcount;
F.length; +; JGTZ.nxitem;
ZERO; S.refcount; JS.prnl; J.nxitem;
implicit: ERASE; F.progid; J=.fail; /attempt to declare prog
DUP; SMMN7/0; FI6; S.lineno;
FM3; SET6; FC3; SHL-3; -; DUP; JEQZ.prog+2;
DUPD; ERASE; VR; SHA34; JV.fail; ERASE;
CAB; S.lastlab; F.tables; PERM; J.store;
patch: ERASE; JS.calcadd; SET#271; NEV; J#Z.fail;
DUPD; ERASE; JLTZ.fail; /prog would go negative
FM3; PERM; SET6; REV; -; SHL3; SC3; /syllable
DUP; SM3; MAX; F.inbfr; MAX; S.inbfr; ERASE; J.nxitem-0s1;
boob: JS.because; J.fail;
because: F.bdotodot+1; F.bdotodot; JS.printtwo; SET#377; JS.printid+0s3;
FMM10/0; SHL16; SHL-32; J.printline+0s2;
*bdotodot:= {*cbecause*sof*s};
!label because;
!end
/search dictionary for the work in N1
/C4 = 0 if search to stop at !begin marker (zero entry)
dsearch: CMFRQ7/10; /use current dictionary pointer
sdsearch: /entry with old dictionary pointer in Q10
!begin JCZ10.a+0s3; NC10; ITWO10; M+I10;
*loop: FMMQN10/0; DUP; J=Z.b; J=.match;
loopa: JCNZS10; EXIT.1; /end of dictionary
b: ERASE;
a: JCNZ4.loopa; /pass begins
EXIT.1; /unallocated
match: M-I10; FMM10/0; JGEZ.exith; M+I10; J.loopa;
exith: EXITH;
!label exith;
!end
packid: /packs identifier (backwards and left justified)
!begin SET7; SC2; ZERO; FMM2/1;
DUP; SET12; SIGN; J14
SET210; J=.absolute; SET#215; NEV; JEQZ.str;
JS.packid; F.progid; JEQ.curadd;
JS.dsearch; J.prog+1s3; JCZ4.funny; J.fail;
ERASE; FMM10/0; SQ10; FM10; FC10;
enditem: JCZ9.addin;
NEG; REV; NEG; REV; /negate word/syllable if item -ve
addin: S+C8; S+M8; J.next;
curadd: ERASE; FM3; SET6; FC3; SHL-3; -; J.enditem;
absolute: M+I2; JS.assemno; /word address
REV; SET30; NEV; J=Z.syll;
M-I2; ZERO; J.enditem; /no syllable number
syll: FMMQ2/1; JS.assemno; ROUND; M-I2; J.enditem;
str: M+I2; JS.onesym; J.fail; JS.onesym; J.estr;
REV; SHL8; OR; FMMQ2/1; SET#235; NEV; JNEZ.fail;
estr: ZERO; J.enditem;
onesym: FMMQ2/1; SET#216; JEQ.formal; SET#230; JEQ.fail;
SET#271; JEQ.fail; SET#235; JEQ.erex; EXIT.1;
formal: ERASE; FMMQ2/1; SET30; JS.lookup; SET#377; AND; EXIT.1;
!end
prbs: F.tables; JEQZ.erex;
SHL8; F.ssssd; OR; F.refcount; JEQZ.prog+1s5;
SET#240; SHLD-8; S.refcount;
JS.printsix; JS.printline; J.prnl;
*ssssd:= # 4751723647400377;
lastbegin:=0;
beginblock: JS.prbs;
dumbeg: F.lastbegin; SMM7/0; FQ7; S.lastbegin;
ZERO; SMMQN7/0; J.nxitem;
endblock: QFRQ7/10; ITWO10; ITWO9; FI9; SM8;
JS.prbs; ZERO; NOT; S.endmark; JS.space;
/increments 2 for backward scan from current
/dictionary position. M8 = 2 to ease back-tracking
!begin QFRQ3/5; IFRQ6/8; /preserve line count and prog
/ address: both disturbed by update
NC10; F.lastbegin; SHL-32; S+C10; DC10;
/set up scan of dictionary for this block only
nxentry: JCZ10.tidyup; IFRQ0/4;
*findloc: FMMQ10/8; JGEZ.locitem; *JCNZS10;
J.tidyup; /scans for each located entry
locitem: /for each located entry,
/process corresponding unlocated entries;
/M10 now points to the located entry.
CMFRQ7/9; NC9; FMMN10/0; ZERO;
erscan: ERASE;
*scan: FMMQN9/8; DUP; JEQZ.lastref; JEQ.process; JCNZS9; ZERO;
lastref: ERASE; ERASE; FI4; JLTZ.nxentry;
ZERO; NOT; SMMN10/0; J.nxentry;
/delete located entry unless there is
/a corresponding !label entry
process: FMM9/0; DUP; JGEZ.erscan;
DUP; NOT; SHL-32; JNEZ.notlab; ERASE;
IMONE4; J.delete; /!label entry: delete but remember in I4
notlab: /unlocated entry to be updated
STR; SHAD3; NOT; SM4; /address type
SHL1; STR; SC4; /+/- marker
SHL-4; SQ6; /Q6 set up for update
CMFRQ6/3; /to give correct fail address
update: NC6; FMMN6/1; DUP; FMM6/1; SHLDC6;
NC6; REV; /sylls to be updated at top of N1
FMM10/0; SQ11; FM11; JCZ4.pos; /address value
NC11; NEG; /negate address if -
/[ ----- page 15
pos: FC11; JS.addup; /update
REV; SHLDC6; SMM6/1;
ZERO; NOT; SHL+24; SHLC6; DUP; CAB; AND;
PERM; NOT; AND; OR; SMMN6/1;
delete: ZERO; NOT; SMMN9/0; J.scan;
!label stop, updfail; updfail=delete: /[ a bit sneaky hiding this label definition
tidyup: F.lastbegin; DUP; SQ11; FMMQ11/0;
S.lastbegin; /last !begin is removed from dictionary
FC7; NEG; S+C11; SQ7; J.endtidy;
/set up for removing unwanted entries from dictionary
*tidy: FMMQN11/0; DUP; NOT; JNEZ.keep;
erase: ERASE;
endtidy: JCNZS11;
QFRQ5/3; IFRQ8/6; /restore prog address and line no.
ZERO; S.endmark; F.tables; JEQZ.prog+1; JS.prnl;
F.lastbegin; JNEZ.nxitem; JCZ7.enter; NC7; ITWO7;
*checkunloc: FMMQ7/8; DUP; JLTZ.unloc; ERASE;
endcheck: JCNZS7; IFRQ8/6;
enter: F.failmark; JNEZ.catfail;
F.flag; JEQZ.endbin; F.test; JEQZ.landg;
FM1.7; NOT; JNEZ.endbin-1;
FM3; F.inbfr; MAX; SET8; SHL16; OR;
SM1.7; ERASE; /default filler word
JS.bintod; JS.prod;
endbin: JS.windup;
stop: F.jq; JGEZ.zeroout; F.failno; SHL-1; SET2; NEV; JEQZ.zeroout;
F.ptfile; JEQZ.prog+1; JS.closeptr; JEJ.prog+1; FLINK; ERASE;
JNEN.prog-0s1; JNEJ.prog-1; F.length; SHC-1; JGEZ.close;
JCZ15.close; FC15; SET6; OUT; J.batch; /direct printer
close: F.closestr; SET8; OUT;
batch: F.iden; F.2; SET1; OUT; /re-enter
landg: SET#5603; FMMHN0/1; FMMN0/1; NEV; FMMHN0/0; FMMN0/0;
NEV; SIGN; JGTZ.nfail; ERASE; JS.windup;
F.loopa; DUP; S.5; SM1.5;
F.loopb; DUP; S.6; SM1.6;
F.jobno; SET51; OUT;
FM3; F.inbfr; MAX; NOT; NEG; SRC11; ERASE;
F.timelt; SHL24; FMMHN0/1; DUP; JEQZ.prog+0s4; MAX; ERASE;
SET3; OUT; +; FC11; SHL9; +; ROUNDH; FMMHN0/0; SMMHN0/1; SET2; J.5;
/add trans time + allowance for code copying to give TL
*unlocstr:={unloc*s};
*loopa: FMM11/1; DUMMY; SMMQ11/0; /move code
*loopb: JCNZS11; OUT; /and enter
*iden:= P AL4-----;
unloc: NOT; SHL-32; JEQZ.endcheck; /!label
F.unlocstr; JS.printsix; FMMN7/0; JS.printid;
FMM7/0; SQ6; JS.printline;
JS.prnl; FI7; S.failmark;
J.endcheck;
keep: SMMN7/0; FMM11/8; DUP; NOT; SHL-32;
JEQZ.erase; /ignore remaining !label entries
SMMQ7/0; J.endtidy;
!end
segment: JS.input; M+I2; SET12; SC11;
!begin ZERO; S.flag; FQ3;
SET24; SRC3; M+I3; M+I3;
loop: FMMQ2/1; SET#321; JEQ.skip; SET#241; JEQ.end; DUP; SHL-6; JNEZ.fail;
JS.bstopr; JS.storechar;
eloop: DC11; JCNZ11.loop;
FMMQ2/1; SET#241; JEQ.end; J.fail;
skip: ERASE; SET-6; S+C3; JCNZ3.eloop; SET48; SC3; M+I3; J.eloop;
end: SRC4; M+I4; SQ3;
/[ ----- page 16
JS.calcadd; SET#24; NEV; JNEZ.fail;
FMMH0/0; FMMH0/1; DUP; S.oldij; NEV; JNEZ.filler; /initial jump preserved
DUPD; F.jump; PERM; JS.addup; SMMH0/1; /initial jump
filler: ERASE; JS.calcadd; SET#230; NEV; JNEZ.fail; ERASE;
DUPD; SIGN; JGTZ.fail; DUP; FM1; +; JS.space;
REV; SHL16; OR; DUP; SM1.7; /filler word
chunloc: SQ1; ZERO; NOT; S+I11;
QFRQ7/10; ITWO10; NC10; *FMQ10.2; JLTZ.check;
ok: JCNZS10;
F.failmark; F.test; NOT; OR; JNEZ.nxitem;
FI6; JS.bintod; SI6; JS.prod; F.oldij; SMMH0/1;
F.dlost; JGEZ.fl6; J.nxitem;
prod: FM1.3; FM1.2; SHLD18; JS.print8; SET#7777; OR; JS.print8;
F.ond; JS.print8; F.size; JS.print8; F.hiadd; JS.pr32;
FMMN0/1; SC11; JCZ11.prog+2s4; DC11; F.st; JS.printsix; FC11; JS.pr32;
JS.prnl; F.ond; SHL-6; J.idtype;
pr32: SET#177413; SHL-8; F.decimal; CAB; SHL-5; NOT; NEG; SHL5;
FRB; J.prno;
check: FMM10/0; NOT; SHL-32; JEQZ.ok;
FMM10/0; SQ9; FM9; FM11; SIGN; JGTZ.ok;
FM9; FI11; SIGN; DUP; JEQZ.recheck; JLTZ.ok;
error: SET.ond-err; SRC10; FMQ10.err; JS.printsix;
JCNZ10.prog-1; J.fail;
recheck: ERASE; FC9; SET#70; AND; SET24; SIGN; JGEZ.ok; J.error;
*err:={*c !segment *s needs *s updating};
*ond:= P on*sdisc.;
size:= P *2ssize*s;
st:= {&3s st *s};
hiadd:=0;
oldij:=0;
jump: J.0;
!label prod, hiadd, ond;
!end
labelspec: JS.input; M+I2; SET#230; ZERO;
/set up for search in containing block
!begin F.lastbegin; SQ9; CFRQ0/4;
nxlab: ERASE; JS.packid; QFRQ9/10;
JS.sdsearch; J.boob; /already in outer block
SMMN7/0; ZERO; NOT; SC6;
FQ6; SMMQ7/0;
next: FMMQ2/1; SET#246; JEQ.nxlab;
JEQ.nxitem-0s1; J.fail;
boob: REV; ERASE; DUP; JS.because; NOT; J.next; /cause fail at end of list
!end
einbs:
!begin JCNZ1.ceq; ZERO; /check if middle of :=
b: ERASE;
a: JS.inbs;
DUP; SHL-6; JNEZ.long; DUP; SET#45; REV; SIGN;
SET26; AND; -; EXITH;
long: SET#236; JEQ.b; SET#256; JEQ.b;
SET#377; JEQ.b; SET#265; JNE.long-0s3;
coleq: SC1; SET#271; EXITH;
ceq: CFRQ0/1; SET162; EXITH;
!end
assemno: /assemble signed integer
!begin VR; CFRQ0/5; DUP; SET10; SIGN; JLTZ.input;
FMMQ2/1; REV; SET#321; JEQ.neg; SET#301; JEQ.neg+0s2;
SET#322; NEV; REV; DUP; SHL-3; CAB; OR; JNEZ.fail;
octal: FMMQ2/1; DUP; SHL-3; JNEZ.exit+0s1;
REV; STR; SHAD3; NEG; CONT; OR; J.octal;
exit: ERASE; REV; JCZ5.prog+0s4; NEG; JV.fail; EXITH;
/[ ----- page 17
neg: DC5; ERASE; DUP; SET10; SIGN; JGEZ.fail;
input: FMMQ2/1; SET10; DUPD; SIGN; JGEZ.exit;
CAB; �D; CONT; +; J.input;
!end
/lists of instruction blanks,
/listed according to parser types
*cblanks:
VR;+;+; ZERO;+;+; +;+;+; +D;+;+; +DF;+;+;
+F;+;+; -;+;+; -D;+;+; -DF;+;+; -F;+;+;
ABS;+;+; ABSF;+;+; AND;+;+; BITS;+;+; CAB;+;+;
CONT;+;+; DIV;+;+; DIVD;+;+; DIVDF;+;+; DIVF;+;+;
DIVI;+;+; DIVR;+;+; DUMMY;+;+; DUP;+;+; DUPD;+;+;
ERASE;+;+; EXIT; EXITD; EXITH; FIX;+;+;
FLINK;+; FLOAT;+;+; FLOATD;+;+; FNSC;+; FPHU;+;
FRB;+;+; FRFIS;+; MAX;+;+; MAXF;+;+; MULT;+;+;
MULT+;+; MULT+F;+;+; MULTD;+;+; MULTDF;+;+; MULTF;+;+;
NEG;+;+; NEGD;+;+; NEGDF;+;+; NEGF;+;+; NEV;+;+;
NOT;+;+; OR;+;+; OUT; PERM;+;+; REV;+;+;
REVD;+;+; ROUND;+;+; ROUNDF;+;+; ROUNDH;+;+; ROUNDHF;+;+;
SBANOL;+; =S#175;=S#200;+; SCPDAR;+; SETTR;+;+; SIGN;+;+;
SIGNF;+;+; SLINK;+; SNSC;+; STAND;+;+; STR;+;+;
TOB;+;+;
*cnblanks:
BUSYQ0;+; CLOQ0;+; CTQ0;+; DC0;+; FC0;+; FI0;+;
FM0;+; FQ0;+; IMONE0;+; IMTWO0;+; INTQ0;+; IONE0;+;
ITWO0;+; JCNZS0;+; LPEQ0;+; LPQ0;+; M+I0;+;
M-I0;+; MANUALQ0;+; MBREQ0;+; MBRQ0;+; MBSKQ0;+;
MBTQ0;+; METQ0;+; PREQ0;+; MFRQ0;+; MFSKQ0;+; MGAPQ0;+;
MLBQ0;+; MLWEQ0;+; MLWQ0;+; MRWDQ0;+; MULT++0;+;
MULT+C0;+; MWEQ0;+; MWIPEQ0;+; MWQ0;+; NC0;+;
PARQ0;+; PGAPQ0;+; PIAQ0;+; PIBQ0;+; PICQ0;+;
PIDQ0;+; PIEQ0;+; PIFQ0;+; PIGQ0;+; PIHQ0;+;
PMAQ0;+; PMBQ0;+; PMCQ0;+; PMDQ0;+; PMEQ0;+;
PMFQ0;+; PMGQ0;+; PMHQ0;+; PMKQ0;+; PMLQ0;+;
POAQ0;+; POBQ0;+; POCQ0;+; PODQ0;+; POEQ0;+;
POFQ0;+; POGQ0;+; POHQ0;+; POKQ0;+; POLQ0;+;
PRCEQ0;+; PRCQ0;+; PREQ0;+; PRQ0;+; PWCEQ0;+;
PWCQ0;+; PWEQ0;+; PWQ0;+; S+C0;+; S+I0;+;
S+M0;+; S+Q0;+; SC0;+; SET0; SHA0;+;
SHAC0;+; SHAD0;+; SHADC0;+; SHC0;+; SHCC0;+;
SHL0;+; SHLC0;+; SHLD0;+; SHLDC0;+; SI0;+;
SM0;+; SQ0;+; SRC0;+; SRI0;+; SRM0;+;
TLOQ0;+; TREQ0;+; TRQ0;+; TWEQ0;+; TWQ0;+;
*cnnblanks:
CFRQ0/0;+; CIFRQ0/0;+; CMFRQ0/0;+; FMM0/0;+; FMMH0/0;+;
FMMHN0/0;+; FMMN0/0;+; FMMQ0/0;+; FMMQH0/0;+; FMMQHN0/0;+;
FMMQN0/0;+; IFRQ0/0;+; IMFRQ0/0;+; MFRQ0/0;+; QFRQ0/0;+;
SMM0/0;+; SMMH0/0;+; SMMHN0/0;+; SMMN0/0;+; SMMQ0/0;+;
SMMQH0/0;+; SMMQHN0/0;+; SMMQN0/0;+;
*cablanks:
EXIT.0; EXITH.0; F.0; J.0; JEJ.0;
JEN.0; JEQ.0; JEQZ.0; JGEZ.0; JGTZ.0;
JLEZ.0; JLTZ.0; JNE.0; JNEJ.0; JNEN.0;
JNEZ.0; JNTR.0; JNV.0; JS.0; JTR.0;
JV.0; S.0; SET.0; SET.0;
*cnablanks:
FM0.0; FMQ0.0; JCNZ0.0; JCZ0.0;
/[ ----- page 18
SM0.0; SMQ0.0;
/tables of packed instructions for locator
*ctable:
=� VR; =� ZERO; =� +; =� +D; =� +DF;
=� +F; =� -; =� -D; =� -DF; =� -F;
=� ABS; =� ABSF; =� AND; =� BITS; =� CAB;
=� CONT; =� DIV; =� DIVD; =� DIVDF; =� DIVF;
=� DIVI; =� DIVR; =� DUMMY; =� DUP; =� DUPD;
=� ERASE; =� EXIT; =� EXITD; =� EXITH; =� FIX;
=� FLINK; =� FLOAT; =� FLOATD; =� FNSC; =� FPHU;
=� FRB; =� FRFIS; =� MAX; =� MAXF; =� MULT;
=� MULT+; =� MULT+F; =� MULTD; =� MULTDF; =� MULTF;
=� NEG; =� NEGD; =� NEGDF; =� NEGF; =� NEV;
=� NOT; =� OR; =� OUT; =� PERM; =� REV;
=� REVD; =� ROUND; =� ROUNDF; =� ROUNDH; =� ROUNDHF;
=� SBANOL; =� SBUZZ; =� SCPDAR; =� SETTR; =� SIGN;
=� SIGNF; =� SLINK; =� SNSC; =� STAND; =� STR;
=� TOB;
cntable:
=� BUSYQ; =� CLOQ; =� CTQ; =� DC; =� FC; =� FI;
=� FM; =� FQ; =� IMONE; =� IMTWO; =� INTQ; =� IONE;
=� ITWO; =� JCNZS; =� LPEQ; =� LPQ; =� M+I;
=� M-I0; =� MANUALQ; =� MBREQ; =� MBRQ; =� MBSKQ;
=� MBTQ; =� METQ; =� MFREQ; =� MFRQ; =� MFSKQ; =� MGAPQ;
=� MLBQ; =� MLWEQ; =� MLWQ; =� MRWDQ; =� MULT+;
=� MULT+C; =� MWEQ; =� MWIPEQ; =� MWQ; =� NC;
=� PARQ; =� PGAPQ; =� PIAQ; =� PIBQ; =� PICQ;
=� PIDQ; =� PIEQ; =� PIFQ; =� PIGQ; =� PIHQ;
=� PMAQ; =� PMBQ; =� PMCQ; =� PMDQ; =� PMEQ;
=� PMFQ; =� PMGQ; =� PMHQ; =� PMKQ; =� PMLQ;
=� POAQ; =� POBQ; =� POCQ; =� PODQ; =� POEQ;
=� POFQ; =� POGQ; =� POHQ; =� POKQ; =� POLQ;
=� PRCEQ; =� PRCQ; =� PREQ; =� PRQ; =� PWCEQ;
=� PWCQ; =� PWEQ; =� PWQ; =� S+C; =� S+I;
=� S+M; =� S+Q; =� SC; =� SET; =� SHA;
=� SHAC; =� SHAD; =� SHADC; =� SHC; =� SHCC;
=� SHL; =� SHLC; =� SHLD; =� SHLDC; =� SI;
=� SM; =� SQ; =� SRC; =� SRI; =� SRM;
=� TLOQ; =� TREQ; =� TRQ; =� TWEQ; =� TWQ;
cnntable:
=� CFRQ; =� CIFRQ; =� CMFRQ; =� FMM; =� FMMH;
=� FMMHN; =� FMMN; =� FMMQ; =� FMMQH; =� FMMQHN;
=� FMMQN; =� IFRQ; =� IMFRQ; =� MFRQ; =� QFRQ;
=� SMM; =� SMMH; =� SMMHN; =� SMMN; =� SMMQ;
=� SMMQH; =� SMMQHN; =� SMMQN;
catable:
=� EXIT; =� EXITH; =� F; =� J; =� JEJ;
=� JEN; =� JEQ; =� JEQZ; =� JGEZ; =� JGTZ;
=� JLEZ; =� JLTZ; =� JNE; =� JNEJ; =� JNEN;
=� JNEZ; =� JNTR; =� JNV; =� JS; =� JTR;
=� JV; =� S; =� SET; =� SETA;
cnatable:
=� FM; =� FMQ; =� JCNZ; =� JCZ;
=� SM; =� SMQ;
/dope words for recogniser
tcna:=Q tcna-cnatable/cnablanks/cnatable; /code : number . address
/[ ----- page 19
tca:=Q cnatable-catable/cablanks/catable; /code . address
tc:=Q cntable-ctable/cblanks/ctable; /code only type
tcn:=Q cnntable-cntable/cnblanks/cntable; /code: number
tcnn:=Q catable-cnntable/cnnblanks/cnntable; /code: number / number
bintod: /write binary program to disc
!begin SET#5603; SET.mcsize; FMMN1/0; SHLD24; SIGN; JLEZ.nfail;
FMM0/1; OR; SMM0/1;
SET1; SRM10; SET554; S.size;
FM1.7; SQ11; FM11; FI11; DUPD; /split filler word
DUPD; SRM11; DUP; S.hiadd; FM1; +; FM7; -;
DUP; JS.space1+0s3; JGTZ.fl6;
S.lo; S.hi; -; NOT; NEG; DUP; JLEZ.fail; SC11; ZERO;
*FMMQ11/1; DUMMY; DUMMY; DUMMY; +; JCNZS11; S.sum;
F.ptbin; JEQZ.disc; /jump if disc binary
FM1.2; SHL18; SET#070260; OR; SHL6; SET3; OR; SHC+24; DUP;
S.ablock; SM1.2; FM1.3; S.ablock; F.sum; SMM11/1;
F.jobno; SHL6; SET#1135; SHLD-6; SET5; OUT;
SRC6; S.ablock+2; SET30; SI6; M+I6;
POFQ6; CFRQ6/8; SET.ablock; SI8; SET.ablock+7; SM8; POBQ8;
M-I8; FM1; SI8; M+I8; FMM8/0; SHL+16; SHL-16; NOT; NEG; DUP; SMM8/0;
POAQ8; SQ9; FM1; DUP; S+I9; S+M9; CFRQ6/9; POAQ9; POFQ6;
FC6; SET6; OUT; EXITH;
disc: SET#12345; OUT; ERASE;
fill: F.hi; F.lo; -; F.size; SIGN; JLEZ.last;
FI1; SC11; F.lo; DUP; SI11; F.size; +; DUP; SM11;
FQ11; SMQ10.f-1; S.lo; SET634; S.size; J.fill;
last: CFRQ0/11; F.lo; SI11; F.hi; NOT; NEG; SM11;
FQ11; SM10.f-1; F.sum; SM10.f;
FM1.2; SHL24; F.ncdc; SHLD-24; S.poc;
SM1.2; FM10; S.sum;
JS.writebs;
F.poc; F.sum; SHL16; OR; FM1.3; FM1.2; SET27; OUT;
DUP; JLEZ.exit;
JS.discread+0s4; FM1.2; F.block+636; NEV;
FM1.3; F.block+637; NEV; SHC-18; SHL-12; OR; JNEZ.fl7;
F.asl; SET29; OUT; ZERO;
exit: ERASE; J.reread;
doasl: / Q6 = no. of NOCs / 1 / address of first NOC
SET72; SRC8; /overwritten by A-block if P.T. binary
*ablock: ZERO; SMQ8.block+8; *JCNZS8;
rpt: FMMQ6/0; SET.block+block-f+14; FM6; +;
SM8; SHC-16; SMMH8/0; JCNZ6.rpt; EXITH;
writebs: SET.block; SRM5; FM10.f-1; SQ11; FM11; FI11;
DUP; SRM11; -; SC11; F.poc; SMMQ5/0; FM10.f;
SET26; OUT; DUP; JEQZ.fl7; DUP; S.poc;
SM10.f; /filler word left in nest
M-I10; FM10; JNEZ.notfir;
first: F.sum; SRC6; SET.f+1; SM6; JS.doasl;
F.f; S.block+7; SET7; SRC6; F.block; S.block+80;
*FMM6/1; SMQ6.block; *JCNZS6;
SET80; S+M5;
*notfir: FMMQ11/1; SMMQ5/0; *JCNZS11;
SMM5/0; /copy block and filler
FM1.2; S.block+636; FM1.3; S.block+637;
output: SET638; SRC11; ZERO; ZERO;
*FMQ11.block; DUMMY; STR; +D; JCNZS11;
SHL+16; SHL-16; S.block+638; S.block+639;
F.poc; F.transfer; SHLD+16; SHC-16; REV; SHL+16;
SET23; OUT; SET21; OUT;
/[ ----- page 20
FM10; JNEZ.writebs; EXITH;
*asl:= Q 0 / block+8 / block+72;
f: prog=f+41:
lo:=0; hi:=0; size:=0; sum:=0; poc:=0;
ncdc:= # 07024402;
!label f, ablock;
!end
!label code, input, updfail, nxitem, round, assemno, block, f;
!label options, openinput, case, du, ptbfr, loctfr, stop;
!label dumbeg, openptout, ptinput, block, code, ablock, idtype, type;
!begin !label ptbfr, loctfr, block, code, ptinput, openptout, idtype;
!label options, openinput, type, case;
idtype: FM1.3; FM1.2; NOT; SHL24; NOT;
type: S.flex+2; S.flex+3; S.flex+4; F.jq; JEQZ.x;
ZERO; S.flex+1; F.flex; SET8; OUT;
x: EXITH;
*flex: =Q 0/prog+1/prog+4; =P*32s;
case:= 0;
**block:=0; code=block+640:
prog=prog+40:
findfile: FC12; F.ptfile; JNEZ.loadptread; SET6; OUT;
DUP; ZERO; SHLD6; SET8; SC12;
* SET#36; NEV; NEG; REV; SHLD-42; DC12; JCNZS12;
ERASE; SQ13; REV; ZERO; JS.read;
F.ptbfr+638; S.block+16; J.prog+1;
r: JS.read; SET212; F.ptbfr; SHL-32; -; SRC12;
SET3; SI12; J.l+1;
*l: FMQ12.ptbfr+1; JEQ.c; JCNZS12;
F.ptbfr+639; DUP; JNEZ.r;
notfound: ERASE; DUPD; SM1.2; SM1.3;
SHLD24; REV; SET#5657; OR;
REV; F.tfound; PERM; JS.type; J.stop;
*tfound:= P T*sfound;
mask:=0;
minuses:= P --------;
nctc:= P *4s*n*c T *c;
loctfr:= Q 0 / ptbfr / ptbfr+639;
pres:= #0560 0000 0000 0003; /presumed options
ont:= P punched.;
aaa:= {*s*3a*s};
read: F.loctfr; J.discread+1s1;
c: DUPD; ERASE; FM12.ptbfr-1; NEV; FQ13; AND; JNEZ.l+1;
FM12.ptbfr; SHL16; SHL-45; NEG; NOT; JGTZ.l+1;
FM12.ptbfr-2; S.block+11; FM12.ptbfr-1; S.block+12;
ERASE; ERASE; FM12.ptbfr; S.block+13; J.options;
openinput: /for entry via job queue
!begin F.transfer; SET600; -; SET34; OUT;
/the previous line sets the buffer area as follows:
/block+17 - TL/ST block+11/12 - input file ident
/block+13 - input file F.O.C. block+15 - as Z38 in PROMPT
/block+16 - F.O.C library index block+4 - job number
/block+6 - global disc communication word
/initialise input and decode options
F.block+4; S.jobno;
SET.fjtime; F.block+6; SHL24; SHL-25; JNEZ.settl; ERASE;
/foreground - max TL = default TL; default ST = 0
ZERO; NOT; NEG; S.jq; F.block+15;
SHC-2; JLTZ.prog+1; JS.openptout; /O/P8 allowed in B.J.Q.
SET.bjtime;
/[ ----- page 21
settl: F.block+17; SHL-24; MAX; ERASE; SHL+24; S.block+17;
options: F.block+11; DUP; S.texid; SMM2/1;
F.block+12; DUP; S.texid+1; SHL-18; SHL12;
SET#6560; OR; F.block+15; STR; SHL-46; CAB; OR; SHL+6;
SET#65; OR; SMMN2/1; SHL2; STR; S.tables; SHL4; STR; S.test;
SHL40; BITS; DUP; JNEZ.prog+1; JS.openoutt;
F.length; -; S.length; F.block+16; S.lib F.O.C;
F.jobno; FMMN2/1; FMMQ2/1; SHLD18; JS.print8; SHL-18;
SHLD18; JS.print8; F.sttt; OR; JS.print8;
F.zeroout; SMMQ2/1; FMMN2/0; DUP; SMM2/1; JS.print8;
SET#256; JS.oubs; F.tradix; SET9; OUT; SET30; DIVI;
ERASE; SHA-25; FRB; F.tradix+1; OR; JS.print8; /time
F.block+17; DUP; SMMN1/0; SHL-24; DUP; JNEZ.prog+1s1;
ERASE; SET.fjtime; DUP; S.timelt;
SET60; DIVI; DUPD; ERASE; JNEZ.mins; SET#63; J.endj;
mins: REV; SET100; DIVI; REV; DUP; ZERO; SIGN; +;
SET3; MAX; ERASE; SET#17; +;
endj: CAB; ERASE; F.decimal; CAB; FRB; SET#2020; OR;
REV; SHL12; OR; F.jobno; SHL-18; SHL+18; OR; S.jobno;
F.ptfile; JEQZ.initial; J.initial+2s3;
!label options;
*sttt:= P *2s*3d*3t;
tradix:= # 37120106 12010101; =P 00.00*3c;
!end
**ptbfr:
prog=prog+32:
onoff:=0;
inv:= P Invalid*s message*e box*sno.*e ident*e*2d option*e;
char: JCNZ13.unpk; SET32; SRC13; PARQ12; PREQ12;
unpk: ZERO; NOT; FM13.ptbfr; DUPD; NEV; JEQZ.nwd;
SHLD-42; REV; SM13.ptbfr;
SET#75; JNE.ched; CFRQ0/13; EXITH;
ched: DUP; SHL-3; JEQZ.prog+2; SET#77; JEQ.prog+3; EXITH;
SET6; JEQ.cchar; SET7; JEQ.cchar;
ERASE; FM3; JEQZ.char; ZERO; EXITH;
cchar: SET7; -; S.case; J.char;
nwd: ERASE; ERASE; M+I13; DC13; J.char;
echar: JS.char; SET#32; JEQ.ul; EXITH;
ul: JS.char; REV; JEQ.ul; SET#200; OR; EXITH;
!begin !label ptinput, openptout, loadptread;
ptinput: SET17; OUT; S.time; S.time+1;
ZERO; NOT; S.jq; SET.ptbfr; SI12; SET31; SM12;
M+I12; SET2; SET5; OUT; SC12; CFRQ0/13; SET30; SHL24; S.block+17;
F.pres; S.superm;
SET#275; JS.echar; SET#60; JEQ.pt; SET#75; JEQ.zeroout;
REV; JNE.prog+1s4; JS.echar; REV; JEQ.prog-0s4;
/N1 = first non-uem
SET.tab1; JS.decode; SET4; SC11; F.nctc;
id1: SHL6; JS.char; SET#37; JEQ.invid; SET#34; JEQ.invid;
F.case; JNEZ.invid; OR; DC11; JCNZ11.id1;
DUP; S.texid; SET8; SC11; F.minuses;
id2: JS.char; F.case; JNEZ.invid; SET#37; JEQ.dot; SET#34;
JEQ.invid; DC11; REV; SHL6; OR; JCNZ11.id2; J.jobnum;
dot: ERASE; SHC6; DC11; JCNZ11.prog-0s4;
jobnum: DUP; S.texid+1; JS.char; DUP; SHA-1; SET#17; NEV;
F.case; OR; JNEZ.xjno; SHL6; JS.char;
SET#34; JEQ.xjno; F.case; JNEZ.xjno; OR;
SHL6; JS.char; DUP; SET#17; NEV; F.case; OR; JNEZ.xjno; OR;
SHL6; JS.char; JS.chdig; J.xjno;
OR; SHL6; JS.char; JS.chdig; J.xjno; OR; SHL18; SET#63232;
SHL3; OR; S.jobno; F.ptfile; JEQZ.dc2;
/[ ----- page 22
JS.char; SET#75; NEV; JEQZ.invmess;
SET6; SRC11; ZERO; SMQ11.block+2; JCNZ11.prog-0s4;
FQ3; JS.char; SET.block+2-endptread; SRM3; SET48; SC3; J.prog+1s3;
title: JS.storechar; JS.char; SET#75; JEQ.invtitle;
SET#34; JNE.title; ERASE; SQ3; J.dc2;
pt: S.ptfile; ERASE; SET.endptread; SM1; J.id1-1s2;
loadptread: FMM0/0; F.3; SET4; SHC-12; +; F.2; SET1; OUT;
chdig: F.case; JNEZ.x; DUP; SET#20; SIGN; JLTZ.x;
DUP; SET#31; SIGN; JGTZ.x; EXIT.1;
invtitle: ERASE; SQ3;
invmess: ZERO; S.ptfile; F.inv+1;
typeinv: ZERO; REV; F.inv; JS.type; FC12; SET6; OUT; J.stop;
invid: F.inv+3; J.typeinv;
xjno: F.inv+2; J.typeinv;
setbit: SC10; F.superm; SHCC10; REV; F.onoff; NEV;
NOT; CONT; NC10; SHCC10; S.superm; EXITH;
setdc: JS.setbit;
dc2: SET.tab2;
rdecode: JS.char; REV;
decode: SM11; ZERO; SRM10; J.prog+1s1;
!begin /entered with address of table in N1
skip: ERASE;
!label loop;
loop: JS.char; SHL42; DUP; JLTZ.seek; F.case; JEQZ.seek;
SHC+6; SET#37; JNE.prog+1s3; DUP; NOT; -; J.seek-0s2;
SET#34; JNE.seek; SHC-6; /, to 77, pass ;, reject other c/s
seek: FMMH10/11; DUP; SHC+16; PERM; SHL18; JEQ.found;
REV; DUP; SHL+1; JLTZ.fail; STR; JEQZ.prog+1s1;
ERASE; SET1; S+M10; J.seek;
fail: REV; ERASE; STR; JGEZ.end; M+I10; ERASE; FMMH10/11; SHC16; J.end;
found: ERASE; M+I10; STR; JEQZ.skip;
end: SLINK; EXIT;
!end
*tab1: /decode program and segment
=T8;=S#60; =T6;=S#62; =T5;=S#57; =T4;=S#47; =T3;=S#62;
=T2;=S#41; =Tprogram;=S#255; =Tprogram;=S#337;
=Tfail1;=S#163; =T6;=S#45; =T5;=S#47; =T4;=S#55; =T3;=S#45;
=T2;=S#56; =Tsegment;=S#264; =Tsegment;=S#337;
=Tfail1;
*tab2: /options
=T24;=S#64; =T8;=S#45; / T E
=T3;=S#63; =Ttest;=S#264; =Ttest;=S#337;
=Tfail2;=S#170; =Ttext;=S#264; =Ttext;=S#337; =Tfail2;=S0;
=T7;=S#41; =T4;=S#42; =T3;=S#54; =T2;=S#45;
=Ttables;=S#263; =Ttables;=S#337; =Tfail2;=S0;
=T6;=S#62; =T3;=S#41; =T2;=S#43; =Ttrace;=S#245;
=Ttrace;=S#377; =Tfail2;=S0;
=Ttl;=S#354; =Tfail2;=S0;
=T6;=S#67; =Tfail2;=S#151; =T2;=S#64; =Twith;=S#250;
=Twith;=S#337; =Tfail2;=S0; / W I T H
=T20;=S#57; =T4;=S#65; =Tout;=S#264; =Tout;=S#337; =Tfail2;=S0;
=T9;=S#60; =T7;=S64;=T6;=S51; =T5;=S#55; =T4;=S#51;
=T3;=S#63; =T2;=S#45; =Topt;=S#262; =Topt;=S#337;
=Tfail2;=S#117; =Tfail2;=S#160; =Topl;=S#254;
=Topp;=S#260; =Top8;=S#330; =Tfail2;=S0;
=T4;=S#63; =Tst;=S#264; =Tst;=S#337; =Tfail2;=S0;
/[ ----- page 23
=T6;=S#53; =Tfail2;=S#141; =T2;=S#54; =Tkal;=S#224;
=Tkal;=S#337; =Tfail2;=S0;
=T11;=S#60; =T1;=S#17; =T7;=S#64; =T6;=S#42; =T5;=S#51;
=T4;=S#56; =T3;=S#41; =T2;=S#62; =Tbin;=S#271;
=Tbin;=S#337; =Tfail2;=S0;
=Twith;=S#234; =Tdc2;=S#277; =Tem;=S#375; =Tfail2;
superm=block+15:
fail1=invmess:
fail2: ZERO; F.inv+4; F.inv; JS.type; /invalid option - continue
em: SET.ptbfr+639; FM1; MAX; FM7; -; DUP; JS.space1+0s3; JGTZ.fl2;
ERASE; F.ptbin; JEQZ.prog+1s3; F.ont; S.ond;
F.superm; SHC-2; JLTZ.findfile;
JS.openptout; J.findfile;
/initialise P.T. output
openptout: SET.ptobfr-ptoubs+2; SRC11;
*FM11.ptoubs; SMQ11.oubs; JCNZS11;
F.ssss; NOT; SHL16; NOT; S.ssss; F.aaa; S.ptr;
F.ssssd; NOT; SHL16; SHL-16; NOT; S.ssssd;
F.closestr; DUP; SHL-1; AND; S.closestr;
SET.ptobfr-sh; SRM14; SET31; SC14;
ZERO; NOT; SRI15; EXITH;
segment: ZERO; ZERO; J.setbit;
program: EXITH;
with: ZERO; S.onoff; J.dc2;
out: ZERO; NOT; J.with+0s1;
bin: ZERO; NOT; F.onoff; NEV; S.ptbin; J.dc2;
st: JS.numb; F.block+17; SHL-24; SHL+24;
tlst: OR; S.block+17; SET.tab2; J.decode;
tl: JS.numb; SHL24; F.block+17; SHL24; SHL-24; J.tlst;
op8: F.superm; SHL-2; DUP; +; DUP; NOT; -; S.superm; J.dc2;
opl: F.superm; SET3; OR; S.superm; J.dc2;
opp: JCNZ15.dc2; SET3; DUP; SET5; OUT; SC15; PARQ15;
M+I15; SMM15/0; LPQ15; PARQ15; FI14; S+I15; J.dc2;
opt: ZERO; NOT; SET5; J.setdc;
trace: ZERO; SET1; J.setdc;
text: ZERO; SET4; J.setdc;
tables: ZERO; SET2; J.setdc;
kal=dc2:
test: ZERO; NOT; SET6; J.setdc;
numb: JS.char; JS.chdig; J.fail2; SET#17; AND;
JS.char; JS.chdig; J.endnum;
SET#17; AND; REV; SET10; �D; CONT; +; J.numb+1s7;
endnum: REV; EXITH;
!end
!end
!begin !label ptoubs, sh;
*ptoubs:
sh=ptoubs-oubs:
FQ8; REV; JS.prog+1s2-sh; SQ8; EXITH;
DUP; SHL-6; CFRQ0/15; JNEZ.long;
SET12; -; DUP; JLTZ.num;
SET26; DIVI; SET#41; +;
op=prog-sh: SHC-7; REV; FI15; JNE.xcase;
caseok=prog-sh: ERASE; VR; FMMN14/0;
chars=prog-sh: FC15; JLEZ.notul; REV; FC15; SHAD-6; ERASE; REV;
notul=prog-sh: NC15; SHAD6; JNV.ok; SMMQN14/0; JCZ14.tfr; FI14;
ok=prog-sh: DUPD; ERASE; JNEZ.chars; SMMN14/0; ERASE; EXITH;
more=ok-0s2:
em=prog-sh: SHC-7; SET#75; SHL30; / N2 < 0 if uem
REV; CONT; JS.found+0s4; FMMN14/0;
/[ ----- page 24
SHA6; JNV.prog-0s2-sh; SMMQN14/0; ZERO;
tfr=prog-sh: SET.ptbfr; DUP;
SI14; FQ14; SET8; DUP; F.ptbfr; OUT;
SRM14; SET3; SC14; J.ok-0s2;
num=prog-sh: ZERO; REV; DUP; SHA-2; JEQZ.tendot;
SET.12+#20; J.op-0s1;
tendot=prog-sh: SHL2; SET#43; J.op-0s1;
long=prog-sh: SET.ptbfr-table; SRC8;
*FMQ8.table; SHL3; SHL-39; JEQ.found; JCNZS8;
SET#377; JEQ.dummy; SET#276; JEQ.em; SET#316; JEQ.em; M+I8;
found=prog-sh: ERASE; FM8.table-1; STR; JNEZ.ulword;
setup=prog-sh: ZERO; SHAD11; SHL-9; DUP; JEQZ.caseok;
NEG; NOT; J.op+0s3;
xcase=prog-sh: DUP; SI15; SET7; NEV; SHAD-6; ERASE; FMMN14/0; J.notul+0s2;
ulword=prog-sh: SET#32; SC15; JS.setup; /O/P first six
FM8.table; SHA11; JNV.caseok+0s1; /continuaton word
dummy=prog-sh: ERASE; EXITH;
*table=prog-sh:
=# 0236 000000000000; =# 0240 020000000000; =# 0256 040000000000;
=# 0230 340000000000; =# 1241 170000000000; =# 1301 350000000000;
=# 1321 360000000000; =# 2261 260000000000; =# 2221 270000000000;
=# 2201 200000000000; =# 2271 170000000000; =# 2242 250000000000;
=# 2265 172500000000; =# 2322 350000000000; =# 2302 240000000000;
=# 2202 230000000000; =# 2262 322400000000; =# 2222 322300000000;
=# 2246 370000000000; =# 2204 300000000000; =# 2224 310000000000;
=# 2211 210000000000; =# 2231 220000000000; =# 2215 322100000000;
=# 2235 322200000000; =# 2216 360000000000;
=# 6214 424547515600; =# 2234 324532563244;
=# 6101 624541540000; =# 6102 515664454745; =# 0000 620000000000;
=# 2206 324632573262; =# 2326 324432570000; =# 6266 636445600000;
=# 6306 655664515400; =# 6226 675051544500; =# 6200 435755554556;
=# 0000 640000000000; =# 6103 425757544541; =# 0000 650000000000;
=# 6110 416262417100; =# 6120 606257434544; =# 0000 656245000000;
=# 6237 664154654500; =# 6171 544142455400; =# 6130 636751644350;
=# 6172 636462515647; =# 2217 325732673256; =# 2205 325132460000;
=# 6225 645045560000; =# 6345 455463450000; =# 6210 475764570000;
=# 2223 324132563244; =# 2243 325732620000; =# 2263 325132553260;
=# 2303 324532613266; =# 2203 325632573264; =# 6335 646265450000;
=# 6315 464154634500; =# 6320 545142624162; =# 0000 710000000000;
=# 5260 534446310000; =# 5360 457051640000; =# 6340 634547554556;
=# 0000 640000000000; =# 5300 415447575400; =# 0220 320000000000;
=# 2000 363636363636;
ptbfr=prog-sh:
!end
ptobfr:=D1;
prog=transfer+sh-ptobfr-32: /induce fail if relocation would boob
gap:
prog=ptobfr+2:
!end
!label endbase, ptread;
endbase:
prog=block+640:
ptinbfr:
prog=prog+48:
linebfr:
prog=prog+40:
prog=ptbfr+640-prog: prog=ptbfr+640:
ptread: /entered here by OUT 1
F.case; SET#100; AND; S.case;
SMM0/0; JS.ptindv; REV; S.block+11; DUP; S.block+12; SHC-7;
F.block+15; REV; CONT; DUP; S.block+15; SHL4; JLTZ.withtext;
F.next; SHL32; F.du; SHLD-32; ERASE; S.next; SET#377; SM15;
r: ZERO; F.ltfr; JS.discread-1s1; F.ptbfr+638;
/[ ----- page 25
S.block+16; F.jump; S.blocks; QFRQ0/12; QFRQ0/13; J.options;
withtext: SET#256; SM15; SET+3; S.length; J.r;
*ltfr:= Q 0/ptbfr/ptbfr+639;
*jump: J.ptline; DUMMY; /to align {next} on whole word
ptline: FQ4; FQ5; FQ10; FQ11; FM15; JS.oubs;
SET5; SC11; SET.linebfr-1; SRM10; CFRQ11/5; ZERO;
NOT; SMMQN10/0; JS.ptinbs;
next: DUP; JS.oubs; DUP; FMM10/0; SHL8; OR; SMM10/0; DC11;
SET#236; JEQ.ed; SET#256; JEQ.ed; SET#240; JEQ.nl;
CFRQ0/5; SET#276; JEQ.em; SET#316; JEQ.em;
ed: ERASE; JCNZ11.next-0s3; SET6; SC11; J.next-15;
em: FMM10/0; SHL-8; SHL8; SET#240; OR; SMMQ10/0;
SET#137240; SHL7; SHL-7; SMM10/0;
nl: SET#240; SIGN; MFRQ10/13; FC10; DUP; SRM12; +; NEG;
FMMN12/13; SHL8; REV; SHLD-6; ERASE; FC5; SHLD-2; ERASE;
SMMN12/13; SQ11; SQ10; SQ5; J.line;
!begin !label ptinbs, ptindv, claimptr, closeptr; /[ claimptr does not appear anywhere else
char=prog: SET.ptinbfr+32; SM5; F.fromwell; DUP; SRM4;
F.endwell; NEV; JNEZ.unwell; JS.ptchar; F.case; OR;
SET6; DIVI; SHL3; SC13; SM13; FM13.atable; SHLC13; SHL-40; DUP;
SHL24; SMMQH4/5; FM4; SET#37; AND; DUP; S.endwell; J.prog+2s1;
unwell=prog: FMMQH4/5; SHL-24; FM4; SET#37; AND; S.fromwell; EXITH;
*fromwell=prog:=0; endwell=prog:=0; pres=prog:=0;
ptinbs: F.fromwell; S.pres; JS.char;
SET#220; JEQ.ulw; SET#271; JEQ.ulw; EXITH;
ulw=prog: JS.decode; EXITH;
nabs=prog: F.pres; S.fromwell; J.char;
decode=prog: IFRQ0/5; J.prog+1;
loop=prog: JS.char;
seek=prog: ZERO; FI5; SHAD-2; SM4; SET48; �; SC4;
FM4.btable; SHLC4; DUP; SHL4; SHL-40; CAB; REV; JEQ.match;
REV; SHL-45; DUP; SHC-1; JLTZ.prog+1s2; ERASE; ERASE; EXIT.1; /NABS
SHL-1; JEQZ.alt; SET2; S+I5; J.seek;
alt=prog: FM4.btable+1; FM4.btable; SHLDC4; SHL12; ROUND;
SHL-36; NOT; NEG; S+I5; J.seek;
match=prog: ERASE; SHL-45; SHC-1; STR; NEG; NOT; NEG; S+I5; JEQ.loop;
abs=prog: FM4.btable+1; FM4.btable; SHLDC4; SHL16; ROUND; SHL-40; EXITH;
ptchar=prog: F.q12; SQ12; JCNZ12.unpk; F.qwd; SQ12;
ZERO; SETTR; PREQ12; PARQ12; JTR.par;
SET32; SRC12;
unpk=prog: ZERO; NOT; FM12.ptinbfr; DUPD; NEV; JEQZ.nwd;
SHLD-42; REV; SM12.ptinbfr;
SET#75; JEQ.em; SET#77; JEQ.du;
SET6; JEQ.cch; SET7; JEQ.cch;
F.last; JEQ.chul; DUP; S.last;
exb=prog: FQ12; S.q12; EXITH;
nwd=prog: ERASE; ERASE; M+I12; DC12; J.ptchar+0s5;
chul=prog: SET#32; JNE.exb;
du=prog: ERASE; J.ptchar+0s5;
em=prog: CFRQ0/12; J.exb+0s4;
cch=prog: SET7; NEV; SHL6; S.case; J.ptchar+0s5;
ptindv: SHL32; F.qwd; OR; DUP; S.qwd;
SQ12; PARQ12; EXITH;
closeptr: F.qwd; SHL-32; SET6; OUT; EXITH;
par=prog: SET#5604; J.nfail;
*last:= 0; q12=prog:= 0; qwd=prog:= Q 0/ptinbfr/ptinbfr+31;
*atable=prog:={*s*#376*c*#376*t*10#376/0123456789*l*#012;+-.*#376
ABCDEFGHIJKLMNOPQRSTUVWXYZ*2#376*e*2#376
*s*#376*c*#376*t*10#376:^[]<>=��()*l*#376;#*a,*#376
abcdefghijklmnopqrstuvwxyz*2#376*e*2#376};
*btable=prog:
/[ ----- page 26
=# 1271 0003 2242 0265; =# 0220 3211 0215 3231; =# 0235 3202 0222 3302;
=# 0262 3276 0316 1046; =# 0017 0220 1063 0004; =# 0220 2051 0223 0067;
=# 0220 0067 0220 0046; =# 0220 2076 0110 1047; =# 0013 0220 1052 0013;
=# 0220 0054 0220 0056; =# 0220 2063 0214 1015; =# 0016 0220 0064 0220;
=# 0064 0220 0061 0220; =# 0052 0220 0046 0220; =# 2063 0103 1050 0016;
=# 0220 0064 0220 0062; =# 0220 0062 0220 0052; =# 0220 0063 0220 2071;
=# 0200 1051 0004 0220; =# 2064 0326 1052 0022; =# 0220 1063 0004 0220;
=# 2051 0234 1066 0004; =# 0220 2073 0303 0061; =# 0220 0070 0220 2052;
=# 0245 1053 0017 0220; =# 1064 0004 0220 2067; =# 0206 0046 0220 0061;
=# 0220 0070 0220 2051; =# 0315 1054 0014 0220; =# 0064 1220 0001 1236;
=# 0002 0220 0071 0220; =# 2064 0210 1056 0025; =# 0220 3053 0205 1062;
=# 0004 0220 2065 0263; =# 0063 0220 0071 0220; =# 0052 0220 0054 0220;
=# 0052 0220 2067 0102; =# 1061 0027 0220 1046; =# 0010 0220 0047 0220;
=# 0052 0220 2061 0171; =# 0056 0220 0047 0220; =# 0067 0220 0046 0220;
=# 0067 0220 2076 0320; =# 1063 0006 0220 0064; =# 0220 2071 0203 1064;
=# 0010 0220 3067 0243; =# 0074 0220 2063 0217; =# 2065 0022 0220 0067;
=# 0220 0064 0220 0050; =# 0220 0052 0220 0051; =# 0220 0072 0220 0067;
=# 0220 2052 0120 1067; =# 0010 0220 0052 0220; =# 0046 0220 2061 0101;
=# 1070 0051 0220 1071; =# 0017 0220 1052 0004; =# 0220 2065 0266 0067;
=# 0220 0056 0220 0063; =# 0220 2054 0172 1074; =# 0012 0220 0056 0220;
=# 0071 0220 0051 0220; =# 2055 0130 0052 0220; =# 0054 0220 0062 0220;
=# 0052 0220 0063 0220; =# 2071 0340 1071 0017; =# 0220 1055 0006 0220;
=# 0052 0220 2063 0225; =# 0067 0220 0072 0220; =# 2052 0335 1072 0012;
=# 0220 0063 0220 0071; =# 0220 0056 0220 2061; =# 0306 1073 0012 0220;
=# 0046 0220 0061 0220; =# 0072 0220 2052 0237; =# 1074 0012 0220 0055;
=# 0220 0056 0220 0061; =# 0220 2052 0226 1014; =# 0012 0220 0027 0220;
=# 0022 0220 0032 0220; =# 2027 0300 1020 0010; =# 0220 0043 0220 0024;
=# 0220 2037 0360 0026; =# 0220 0017 0220 0021; =# 0220 2011 0260 0000;
!end
*endptread:
!end
/ !segment /8/endbase-1; /[ do this later
/ !segment -----P /ptread/prog-1; /[ do this later
!end