!begin /[ my grammar is wrong in requiring a begin at the start (DH) [

!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

/[ In order to work with DH's yacc-based cross-assembler, on pages 22 and 23
/[ the =Tprogaddr has been replaced by =TAprogaddr
/[ There are no other occurrences of =TA so that the correct source can
/[ be obtained by a simple multiple edit replaceing =TA by =T
/[ There are also commented mods to the lineprinter symbol conversion tables

/[ ----- 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;
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};
ptr:= #47530661 54317377;   = { 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;    replaced by
!begin !label libFOC, 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.libFOC;
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;
libFOC:= 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*d*c*c*t*3d:};                      /[ DH's assembler has difficulty here - temporary rewrite below
/[       = S {= ( ) *a � , / 0123456789 *d @ ; + - *d        /[ the problem relates to word boundaries ??? and char codes
/[         ABCDEFGHIJKLMNOPQRSTUVWXYZ *4x*d};
syms:= #47577640 50127377;  = #77777671 50502224;
     = S#216; =S#261; =S#246; =S#241; =S#000; =S#001;
     = S{234567};
     = S#010; =S#011; =S#377; =S#012; =S#230; =S#301;
     = S#321; =S#013; =S#377;
     = S {ABCDEFGHIJKLMNOPQRSTUVWXYZ };  = S#376; = S#376; = S#376; = S#376; = S#377;

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-1s1; ERASE;     /[ original had JNEZ.prog-0s7; -- should we allow this
        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, libFOC, 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-1s1; ERASE; J.printsix;        /[ original had JNEZ.prog-0s7;
*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)  /[original had bracketted comment
!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           /[type 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)    /[ [ inserted
/

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#211; J=.slash;         / [ comments -- temporary bootstrap mod

        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: DUMMY; DUMMY; DUMMY; DUMMY; DUMMY; DUMMY;      /[ replaces the next line
/[ 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; JLTZ.addr;   /contains address
        NEG; NOT; J#Z.cnn;
        DUP; SHL-40; SET#304; /check for SET instruction
        NEV; JEQZ.setinst; DUP; SHL-32;

/[ ----- page 09

        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; JLTZ.fail;
        SHLD-6; J#Z.fail;
*pack:  FMMQN2/1; SHLD-6; J#Z.termin; JCNZS2;
skip:   FMMQN2/1; SHL-6; J=Z.skip; EXITH;
termin: SHL6; EXITH;
!end
*progid:= � GORP;       /prog in packid format
calcadd:
!begin  CMFRQ0/8; FMMQ2/1; SET209; J=.setsign;
        SET193; J=.setsign;
        CFRQ0/9; M-I2; J.item+0s2;
funny:  FQ6; SHL4; FC9; NEG; CONT;
        FM4; NOT; SHLD-4; ERASE; SMM7/0; SMMQN7/0;
next:   FMMQ2/1; SET209; JEQ.setsign;
        SET193; J=.setsign;
        FC8; SET6; DIVI; REV; FM8; +; REV; DUP; JEQZ.exit;
        DUPD; ERASE; VR; SHA34; JV.fail; ERASE;
exit:   CAB; EXITH;      /terminator left in N1
setsign: SET193; NEV; SC9;
item:   FMM2/1; DUP; SET10; SIGN; JLTZ.absolute;

/[ ----- page 14

        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};
*err:= S #240; = S #340; = S #236; = S #63; = S #52; = S #52; = {ds *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;+;+;


�+;+;    �+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;+; MGAPQ0;+;
/[MLBQ0;+;   MLWEQ0;+;   MLWQ0;+;   MRWDQ0;+; MULT+0;+;    /[ last entry was originally MULT++0
/[MULT+C0;+; MWEQ0;+;    MWIPEQ0;+; MWQ0;+;   NC0;+;  replaced to sort out MULT+ etc

MLBQ0;+;   MLWEQ0;+;   MLWQ0;+;   MRWDQ0;+; �+0;+;    /[ last entry was originally �++0
�+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-I;    =� MANUALQ; =� MBREQ;  =� MBRQ; =� MBSKQ; =� 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.libFOC;
        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;   =TA program;=S#255;   =TA program;=S#337;     /[ =TA  introduced here
=TAfail1;=S#163;   =T6;=S#45;   =T5;=S#47;   =T4;=S#55;   =T3;=S#45;
             =T2;=S#56;   =TA segment;=S#264;   =TA segment;=S#337;
=TAfail1;

*tab2:  /options

=T24;=S#64;   =T8;=S#45;    / T E
              =T3;=S#63;   =TA test;=S#264;  =TA test;=S#337;
         =TA fail2;=S#170;  =TA text;=S#264;  =TA text;=S#337;  =TA fail2;=S0;
         =T7;=S#41;   =T4;=S#42;   =T3;=S#54;   =T2;=S#45;
                  =TA tables;=S#263;   =TA tables;=S#337;   =TA fail2;=S0;
         =T6;=S#62;   =T3;=S#41;   =T2;=S#43;   =TA trace;=S#245;
                  =TA trace;=S#377;   =TA fail2;=S0;
         =TA tl;=S#354;   =TA fail2;=S0;

=T6;=S#67;   =TA fail2;=S#151;   =T2;=S#64;   =TA with;=S#250;
                       =TA with;=S#337;   =TA fail2;=S0; / W I T H

=T20;=S#57;   =T4;=S#65;   =TA out;=S#264;   =TA out;=S#337;   =TA fail2;=S0;

       =T9;=S#60;   =T7;=S64;=T6;=S51;   =T5;=S#55;   =T4;=S#51;
            =T3;=S#63;   =T2;=S#45;   =TA opt;=S#262;   =TA opt;=S#337;
       =TA fail2;=S#117;   =TA fail2;=S#160;   =TA opl;=S#254;
                    =TA opp;=S#260;   =TA op8;=S#330;   =TA fail2;=S0;

=T4;=S#63;   =TA st;=S#264;   =TA st;=S#337;   =TA fail2;=S0;

/[ ----- page 23

=T6;=S#53;   =TA fail2;=S#141;   =T2;=S#54;   =TA kal;=S#224;
                     =TA kal;=S#337;   =TA fail2;=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;   =TA bin;=S#271;
        =TA bin;=S#337;   =TA fail2;=S0;

=TAwith;=S#234;   =TA dc2;=S#277;   =TA em;=S#375;   =TA fail2;
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+2s1;  /[ original said 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+16; J.op-0s1;           /[ original was    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 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@;+-.*#376
   /[       ABCDEFGHIJKLMNOPQRSTUVWXYZ*2#376*e*2#376
   /[       *S*#376*C*#376*T*10#376:^[]<>=��()*l*#376;#*A,*#376
   /[      abcdefghijklmnopqrstuvwxyz*2#376*e*2#376};



*atable=prog:
      = #47577240 77527376;   /  236 376 240 376 256 376 Q-24834/-24322/-20738
      = #77577376 77577376;   /  376 376 376 376 376 376 Q-258/-258/-258
      = #77577376 50200001;   /  376 376 376 241 000 001 Q-258/-351/1
      = #00401404 01203007;   /  002 003 004 005 006 007 Q515/1029/1543
      = #02004620 02514301;   /  010 011 220 012 230 301 Q2057/-28662/-26431
      = #64205776 03006416;   /  321 013 376 014 015 016 Q-12021/-500/3342
      = #03610021 04411424;   /  017 020 021 022 023 024 Q3856/4370/4884
      = #05213027 06014432;   /  025 026 027 030 031 032 Q5398/5912/6426
      = #06616035 07417440;   /  033 034 035 036 037 040 Q6940/7454/7968
      = #10221043 11022776;   /  041 042 043 044 045 376 Q8482/8996/9726
      = #77537376 77517376;   /  376 276 376 376 236 376 Q-322/-258/-24834
      = #50177256 77577376;   /  240 376 256 376 376 376 Q-24322/-20738/-258
      = #77577376 77577376;   /  376 376 376 376 376 376 Q-258/-258/-258
      = #77534601 42314602;   /  376 271 201 211 231 202 Q-327/-32375/-26238
      = #60521261 44302224;   /  302 242 261 221 204 224 Q-15710/-20079/-31596
      = #44177230 64507246;   /  220 376 230 322 216 246 Q-28418/-26414/-29018
      = #77423047 12024452;   /  376 046 047 050 051 052 Q-474/10024/10538
      = #12626055 13427460;   /  053 054 055 056 057 060 Q11052/11566/12080
      = #14231063 15032466;   /  061 062 063 064 065 066 Q12594/13108/13622
      = #15634071 16435474;   /  067 070 071 072 073 074 Q14136/14650/15164
      = #17237077 77577276;   /  075 076 077 376 376 276 Q15678/16382/-322
      = #77577377 77777777;   /  376 376 377 377 377 377 Q-258/-1/-1



*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   /[ last end in source text




!end
!end
!end
!end
!end
!end
!end
!end
!end }}}}}}}}}}}}}}}}}}}
  // bogus for testing


Director instructions
FNSC 176 001   K7;
FPHU 176 004   K5;
FRFIS 176 010   K4;
SBANOL 175 100   =K1;
SBUZZ 175 200   =K0;
SCPDAR 175 040   =K2;
SNSC 175 020   =K3;