|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 82176 (0x14100)
Types: TextFile
Names: »algpass33tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass33tx «
;rc 11.1.1971 algol 6, pass 3, page 0
;pass 3 contents:
;page 1 : assignments and definition of initial values
;page 2 : interrupt action used from number packing actions
;page 2 : start of pass 3
;page 3 : end pass 3
;page 3 : error procedure
;page 4 : central input procedure
;page 5 : stack searching procedure
;page 6ff : actions
;page 8ff : procedure-head handling actions
;page 13ff : actions for reading and packing numbers
;page 16 : description of action table for numbers
;page 16 : action table for numbers
;page 17 : description of stack words
;page 17ff : stack words
;page 21ff : description of control tables
;page 23 : input conversion tables
;page 23 : control table for special delimiters
;page 24ff : main control table
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page ...1...
k=e0
s. a46, b52, c71, d28, f43, g19, h99, j4
w.
j0: g0 ; number of words in pass 3
h. c0 ; entry address relative to first word
3<1 + 0 ; pass mode bits:pass no<1+no change of direction
;assignment of bases:
h0 = 114 ,h1 = 59 ; input byte bases for special delimiters,
h2 = 70 ,h3 = 512 ; numbers, normal delimiters, identifiers
h30= 7 ,h31= 200 ; output byte bases
h32= 242 ,h80= 0 ;
h81= 4 ,h82= 10 ;
;output byte values:
h4 = h80+ 3,h7 = h31+ 5; error, end else expr
h8 = h31+ 4,h9 = h31 ; delete call, proc;
h10= h82+ 28,h11= 512; exit proc no type, dummy identifier
h13= h82+ 29,h14= h82+ 33; exit type proc,do
h17= h30+ 53,h18= 15; beg list, value allowed= value-non value spec
h19= h30+ 67,h20= h30+106; declare undef proc, unspec
h21= h30+107,h22= h82+ 38; spec general, end spec
h23= h30+116,h24= h30+ 61; end block,decl switch
h25= h30+117,h26= h30+ 83; end zone block, spec value integer
h27= h30+123,h28= h30+121; case, of switch
h33= h81+ 5,h34= h82+ 24; string next, exit block
h35= h82+ 12,h36= h82+ 22; decl zone, decl zone array
h39= h81+ 0,h40= h81+ 1; integer literal, real literal
h91= h81+ 2,h88= h80+ 0; long literal, new line
h41= h80+ 1,h73= h80+ 2; vanished operand, internal operand
h83= h30+57-h82 ; decl par proc - decl simple
h97= 519,h98= 520; exit ident, continue ident
;input byte value:
h5 = h2 + 33,h78= h0 + 22; trouble, new line
;stack representations:
h6 = 4,h12= 48,h15= 4,h16=108; else ex,beg block,do-singledo,(proc subs
h29= 76,h37= 56,h42= 8,h43= 12; :=switch,beg ext,then ex,trouble
h44= 16,h45= 20,h46= 28,h47= 32; then st,goto,assign, single do
h48= 36,h49= 40,h50= 44,h51= 60; do,else st,beg clean,beg body
h52= 64,h53= 68,h54= 80,h55= 84; of st,beg proc,single comma,:=for
h56= 88,h57= 92,h58= 96,h59= 100; until,while,(zone,next colon,
h60=104,h61=112,h62=120,h63=124; first colon,(left, ,proc subs, ,left
h64=132,h65=148,h66=152,h67=156; of ex,(subex,if ex,if st
h68=160,h69=164,h70=168,h71=172; step, (arr,array comma,case ex
h72=176,h74= 52,h75= 72,h76=116; case st,beg zonbl,beg extpr,(left or ex
h77=128,h79=180,h92=136,h93=140; ,left or ex, prel.ofstat,fieldpar,fieldpar
h94=144,h99=24 ; fieldpar, disable
;others:
h38=0 ; interrupt number
h96=h92/4 - (:h64-11+43:) ; used at c68. (11, 43 == states)
;iso-values for special test output:
h84=100; d-delimiter
h85=124; ø-operand
h86=115; s-state
h87= 99; c-content of stack
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ...2...
w.
b0: 0 ; introuble=false
b1: 0 ; first after trouble = false
b3: 0 ; operand
b4: 0 ; delimbase, work
b7: 0 ; decl
b8: 0 ; for comma count
b9: 0 ; stack entry
h.
b23: -7, -4, -1, 2; no of shifts(1:4)
w.
b24: 2.11100; mask 28
h.
b25: 0 , al w0 ; <al w0> in right byte
w.
; interrupt address: intialize mod 1:
b26: bz. w0 b10. ; <w0>, factor modifier 1:=
b27: lx. w0 b25. ; <w1>, input digit (al w0) exor
hs. w0 b10. ; <w2>, - - (double word) (jl w3 x3);
b28: jl. c3. ; <w3>, exponent goto next;
b30: 0 ; <ex>, exponent sign
0 ; <return address>
0 ; <interrupt cause>
c.e100-16
jl. 2 , r.(:b26.+e100+2:)>1
z.
al. w2 b26. ; monitor in:
rl. w0 b30.+4 ; if interrupt cause<>integer overflow and
se w0 0 ; interrupt cause<>floating point overflow
sl w0 5 ; then
jl. e36. ; goto pass 0 interrupt;
al. w0 d24. ;
sl. w0 (b30.+2); if return address < pack real then
jl. c49. ; goto error 1 else
jl. d23. ; goto error 2;
b31: 10 ; integer 10
b32: 2.111111; mask 63
b33: 0, 1<10; round const
b34: 0 ;bool: exp < -512, true=0
b36: 0 ; maxds
b40: 0 ; store for w1 in numbers
838 860 ; first word of maxlong//2
b44: -3 355 444 ; sec word of maxlong//2
c0=k-j0 ; start pass 3:
al w0 -1 ; set interrupt mask;
al. w3 b26. ; set interrupt address to b26;
jd 1<11+h38; call monitor(set interrupt);
xl. 0 ; ex(21):= ex(22):= ex(23):= 0;
rl. w1 j0. ; ds:= 0; comment w1 = stack pointer
al. w1 x1+j0.-4 ; w1:= addr of pass-end = lower stack limit
rl. w0 e9.+4 ; w0:= last work for pass= upper stack limit;
rs. w0 b36. ; maxds:=w0;
jl. b26. ; output identifier:= true;
; introuble:= first after trouble:= false;
; state:= 27;
; goto initialize mod 1;
\f
;rc 06.05.1971 algol 6, pass 3, page 3
c1: jl. w3 e3. ; endpass: output(outpart);
jl. w3 e2. ; input(identifier limit);
hs. w2 a42. ;
a4: jl. w3 e2. ; new st proc: input(byte);
sn w2 0 ; if byte=0 then
jl. a43. ; goto finish pass 3;
hs. w2 a36. ; id:= byte;
al w1 0 ; for i:=1 step 1 until 16 do
a35: jl. w3 e2. ; begin
al w0 x2 ; input(byte);
jl. w3 e3. ; output(byte);
al w1 x1+1 ; end;
se w1 16 ;
jl. a35. ;
a36=k+1; id
al w0 ;
jl. w3 e3. ; output(id);
jl. a4. ; goto new st proc;
a43: ; finish pass 3
a42=k+1; identifier limit
al w0 ; output(identifier limit);
jl. w3 e3. ; goto new pass;
jl. e7. ;
d0: al. w1 e10. ; error:
jl. e5. ; e0: goto alarm(<:stack:>;
al w0 1 ; e4: error ident:= <-delimiter>;
jl. a0. ; goto on;
al w0 2 ; e8: error ident:=<delimiter>;
jl. a0. ; goto on;
al w0 3 ; e12: error ident:= <-operand>;
jl. a0. ; goto on;
al w0 4 ; e16: error ident:= <operand>;
jl. a0. ; goto on;
al w0 5 ; e20: error ident:= <termination>;
jl. a0. ; goto on;
al w0 19 ; e24: error ident:= <constant>;
a0: rl. w2 b0. ; on: if introuble then
so w2 1 ; begin
jl. a37. ; if error ident<><-delimiter> then
se w0 1 ; goto after operand else
jl. d4. ; goto trouble out
jl. a38. ; end;
a37: jl. w3 e3. ; output(error ident);
al w0 h4 ; output(<error>);
jl. w3 e3. ;
jl. w3 e11. ; repeat input byte:= true;
al w2 1 ;
rs. w2 b0. ; introuble:=
rs. w2 b1. ; first after trouble:= true;
rs. w2 b3. ; operand:=0;
al w2 h5 ; byte:= <trouble>;
jl. d5. ; goto not operand;
d25: bz. w0 b21. ; literal trouble out:
sn w0 h33 ; if kind=<string next> then
jl. d4. ; goto after operand;
a38: al w0 h41 ; trouble out:
jl. w3 e3. ; output(<vanished operand>);
jl. d4. ; goto after operand;\f
;rc 11.1.1971 algol 6, pass 3, page 4
d27: rs. w3 b4. ; procedure error out(byte);integer byte;
jl. w3 e3. ; begin
al w0 h4 ; output(byte);
rl. w3 b4. ; output(<error>);
jl. e3. ; end;
d1: al w3 0 ; after trouble:
se. w3 (b1.) ; if first after trouble then
am b1-b0 ; first after trouble:= false else
rs. w3 b0. ; introuble:= false;
jl. d3. ; goto next1;
;d2: see page 5
c67: bz. w3 b43. ; reset out:
hs. w3 b5. ; state := oldstate;
c2: jl. w3 e3. ; out: output(outpart);
c3: al w3 1 ; next:
rs. w3 b3. ; operand:= 0;
sn. w3 (b0.) ; if introuble then
jl. d1. ; goto after trouble;
d3: jl. w3 e2. ; next 1: input(byte);
sh w2 h3-1 ; if byte<identifier base then
jl. d5. ; goto not operand;
al w0 x2 ; outpart:= byte;
rl. w2 b0. ;
se w2 0 ; if introuble then
al w0 h41 ; outpart:= <vanished operand>;
j3: jl. w3 e3. ; if output identifier then output(outpart) else keep;
al w3 2 ; comment output identifier:true e3,false d8;
se w2 1 ; if -,introuble then
rs. w3 b3. ; operand:= 1;
d4: jl. w3 e2. ; after operand: input(byte);
sl w2 h3 ; if byte>=identifier base then
jl. d0.+4 ; error(-delimiter);
d5: ; not operand:
c.(:e15 a. 1<3:) - 1<3 ; if special test output pass 3 then
al w0 x2 ; begin
jl. w3 e16. ; printbyte(delimiterbyte);
al w0 h84 ; writechar(d);
jl. w3 e12. ;
rl. w0 b3. ;
jl. w3 e16. ; printbyte(operand value);
al w0 h85 ; writechar(ø);
jl. w3 e12. ;
bz. w0 b5. ;
jl. w3 e16. ; printbyte(state);
al w0 h86 ; writechar(s);
jl. w3 e12. ;
z. ; end;
sh w2 h2-1 ; if byte<normaldelimbase then
jl. d19. ; goto initialize number;
sh w2 h0-1 ; if byte < specialdelimbase then
jl. a6. ; goto go on;
bl. w2 x2+g1. ; control word:= special conversion table(byte)
al. w3 x2+g3. ; +control table base;
jl. d7. ; goto special;\f
;rc 1977.11.16 algol 6, pass 3, page ...4a...
a6: bz. w2 x2+g2. ; go on:
al. w2 x2+g3. ; delim base:= normal conversion table(byte)
rs. w2 b4. ; +control table base;
b5= k+1; state
al w3 27 ;
hs. w3 b43. ; oldstate:= state;
ld w0 -2 ;
am. (b4.) ; byte:= delimbase + state//4;
bz w2 x3 ;
al w3 0 ;
ld w0 2 ;
bl. w3 x3+b23. ; s:= no of shifts(state mod 4);
ls w2 x3 ; delimiter meaning word number:= byte shift s
la. w2 b24. ; & mask28;
sn w2 0 ; if delimiter meaning word number = 0 then
jl. d0.+8 ; error(delimiter);
ac w3 x2 ;
wa. w3 b4. ; control word:= delim base - delimiter meaning word
; number; comment control word now points at the first
; byte of the found delimiter word;
d6: bl w2 x3 ; controlword found:
sh w2 -1 ; if byte1(control word)<0 then
jl. d9. ; goto search;
al w0 0 ; if -, bit(operand, allowed operand part(control word))
so. w2 (b3.) ; & -, introuble then
se. w0 (b0.) ; error(operand)
jl. a3. ;
jl. d0.+16 ;
a3: ls w2 -4 ; w2:= new state;
c4: hs. w2 b5. ; normal action: state:= w2;
d7: bl w0 x3+3 ; special: outpart:= byte4(control word);
bz w2 x3+2 ; stack part:= byte3(control word);
bl w3 x3+1 ; switch part:= byte2(control word);
j1: jl. x3 ; goto action(switch part);
; comment w0=out part, w2=stack part;
d8: hs. w0 a7. ; procedure keep;
al w0 h41 ; begin ident:= outpart;
jl. w3 e3. ; output(<vanished operand>);
jl. j3.+2 ; end;
; allowed states:
2.0000 0000 1100 0000 0000 0000; 8, 9
b51: 2.0001 1011 0100 0000 0000 0000; 27,28,30,31,33
c70: hs. w0 b52. ; exit: continue: save output;
bz. w0 b5. ; w0 := state;
dl. w3 b51. ; (w2,w3) := allowed states;
ld w3 (0) ;
sl w2 0 ; if allowed state shift state < 0
jl. d0.+8 ; then error(<:delimiter:>);
b52=k+1; save output;
al w0 0 ; w0 := output;
rl. w2 b0. ; w2 := introuble;
jl. j3. ; goto output operand
j4:
a7=k+1; ident ; comment
sn w0 0 ; ident word no 1
jl w3 x3 ; ident word no 2;\f
c68: ba. w2 b43. ; special par:
rl. w3 b3. ;
sn w2 h64 ; stackpart := stackpart + oldstate;
jl. c69. ; if oldstate <> 11 then
se w3 1<1 ; begin
jl. d0.+12 ; if operand <> 1 then error(-operand);
al w2 x2+h96 ; stackpart := fieldpar(oldstate);
ls w2 2 ; goto ent out;
jl. c11. ; end
c69: se w3 1<0 ; else
jl. d0.+16 ; if operand <> 0 then error(operand);
jl. c14. ; goto ent;
;rc 11.1.1971 algol 6, pass 3, page 5
d9: bz w2 x3+3 ; search:
hs. w2 a8. ; upper:= byte4(control word);
bz w2 x3+2 ;
hs. w2 a9. ; lower-1:= byte3(control word);
bz w2 x3+1 ;
hs. w2 a10. ; base:= byte2(control word);
bz w2 x3 ;
sz w2 1<10 ; if search statement then
jl. a11. ; goto test procarr;
rl. w2 b3. ;
sz w2 1 ; if operand=0 then
jl. d0.+12 ; error(-operand);
bz w2 x1 ; st:= stack(ds);
c.(:e15 a. 1<3:) - 1<3 ; if special test output pass 3 then
al w0 x2 ; begin
jl. w3 e16. ; printbyte(stack content);
al w0 h87 ;
jl. w3 e12. ; writechar(c);
z. ; end;
se w2 h6 ; if st <> <else expr>
jl. a19. ; then goto test top;
al w0 h7 ; outpart:= <end else expr>;
d10: jl. w3 e3. ; outstack: output(outpart);
d2: al w1 x1-4 ; next elem: ds:= ds-1;
a12: bz w2 x1 ; take top: st:= stack(ds);
c.(:e15 a. 1<3:) - 1<3 ; if special test output pass 3 then
al w0 x2 ; begin
jl. w3 e16. ; printbyte(stack content);
al w0 h87 ;
jl. w3 e12. ; writechar(c);
z. ; end;
a19: ; test top:
a8=k+1 ;upper
sh w2 0 ;
a9=k+1 ;lower-1
sh w2 0 ; if st>upper ! st<lower-1 then
jl. d0.+20 ; error(termination);
j2: ;
a10=k+1 ;base
al. w3 x2 ; stackword:= stacktable(base+st);
bl w2 x3 ; w2:= byte1(stack word);
sl w2 0 ; if repeat search bit(stackword) = 0 then
jl. c4. ; goto normal action;
a13: sz w2 1<10 ; if output bit(stackword) = 0 then
jl. d2. ; begin outpart:= byte4(stack word);
bz w0 x3+3 ; goto outstack end;
jl. d10. ; goto next elem;
\f
;rc 11.1.1971 algol 6, pass 3, page 6
a11: rl. w2 b3. ; test procarr:
sz w2 1 ; if operand=0 then
jl. a12. ; goto take top;
sz w2 8 ; if operand=3 then
jl. d0.+16 ; error(operand);
al w0 h8 ; if operand=1 then
sz w2 2 ; outpart:= <proc;> else
al w0 h9 ; outpart:= <delete call>;
jl. w3 e3. ; output(outpart);
jl. a12. ; goto take top;
c61: am h75-h53; set ext proc:
c5: al w3 h53 ; begproc:= <beg ext proc>; goto a;
hs. w3 b41. ; set block proc:
al w3 h23 ; begproc:= <beg proc>;
hs. w3 b42. ; a:endprocblock:= <end block>;
al w3 h10 ;
hs. w3 b2. ; exitproc:= <exit proc no type>;
al w3 d8-j3 ; output identifier:=
hs. w3 j3.+1 ; head alarm:= false;
al w3 0 ; ident:= dummy identifier;
hs. w3 b6. ;
al w3 h11 ;
hs. w3 a7. ;
c6: bz w3 x1 ; setblock:
sn w3 x2 ; if stack(ds)=stack part then
al w3 h12 ; stack(ds):= <begin block>;
hs w3 x1 ;
c7: rs. w0 b7. ; set decl: decl:= outpart;
jl. c3. ; goto next;
c62: am h75-h53; add decl ext:
c8: al w3 h53 ; begproc:= <beg ext proc>; goto b;
hs. w3 b41. ; add decl proc:
al w3 h23 ; begproc:= <beg proc>;
hs. w3 b42. ; b:end proc block:= <end block>;
al w3 h13 ; exitproc:= <exit type proc>;
hs. w3 b2. ;
al w3 d8-j3 ; output identifier:=
hs. w3 j3.+1 ; head alarm:= false;
hs. w2 b6. ; ident:= dummy identifier;
al w3 h11 ;
hs. w3 a7. ;
c9: wa. w0 b7. ; add decl:
rs. w0 b7. ; decl:= decl+outpart;
jl. c3. ; goto next;
c10: rl. w0 b7. ; decl ent: outpart:= decl;
c11: al w1 x1+4 ; ent out:
sl. w1 (b36.) ; ds:= ds+1;
jl. d0. ; if ds>maxds then error(stack);
c12: hs w2 x1 ; ch out:
jl. c2. ; stack(ds):= stack part; goto out;
c13: rl. w0 b7. ; decl:
jl. c2. ; outpart:= decl; goto out;
c46: rl. w3 b7. ; set state:
sn w3 h35 ; if decl=<decl zone> then
hs. w2 b5. ; state:= stack part; comment 35;
sn w3 h36 ; if decl=<decl zone array> then
hs. w0 b5. ; state:= outpart; comment 36;
jl. c3. ; goto next;
\f
;rc 11.1.1971 algol 6, pass 3, page 7
c14: al w1 x1+4 ; ent:
sl. w1 (b36.) ; ds:= ds+1;
jl. d0. ; if ds>maxds then error(stack);
c15: hs w2 x1 ; ch:
jl. c3. ; stack(ds):= stack part; goto next;
c16: jl. w3 e3. ; trouble proc end: output(outpart);
c17: bz w0 x1+1 ; proc end: output(byte2(stack(ds)));
jl. w3 e3. ; comment end block proc;
bz w0 x1+3 ; outpart:= byte4(stack(ds)); comment exit proc;
c18: rl. w3 e9. ; block count:
al w3 x3+1 ; information1:= information1+1;
rs. w3 e9. ;
c19: al w1 x1-4 ; an out:
jl. c2. ; ds:= ds-1; goto out;
c64: jl. w3 e3. ; an block: output(outpart);
al w0 h34 ; outpart:= <exit block>;
jl. c18. ; goto block count;
c20: al w1 x1-4 ; an:
jl. c3. ; ds:= ds-1; goto next;
c21: jl. w3 e3. ; do:
al w0 h14 ; output(outpart);
rl. w3 b8. ; outpart:= <do>;
se w3 0 ; if for comma count <> 0 then
al w2 x2+h15 ; stack part:= stack part + do difference;
jl. c12. ; goto ch out;
c45: ;
b22=k+1; no of ext proc; ext proc check:
al w3 0 ; if no of ext proc <>1 then
sn w3 1 ; begin
jl. c18. ; a24:= outpart;
hs. w0 a24. ;
al w0 7 ; error out(<external>);
jl. w3 d27. ; outpart:= a24
a24=k+1 ; end;
al w0 0 ; goto block count;
jl. c18. ;
c22: rl. w3 b3. ; left parent:
sn w3 1 ; if operand <> 0 then
jl. c11. ; begin
al w2 h16 ; stack part:=
b43=k+1; oldstate
al w3 ; if oldstate=4 then <(left or ex>
sn w3 4 ; else <(proc subs>
al w2 h76 ; outpart:= <begin list>
al w0 h17 ; end;
jl. c11. ; goto ent out;
c23: al w1 x1-4 ; right: ds:= ds-1;
rs. w2 b3. ; operand:= stack part;
jl. w3 e3. ; output(outpart);
jl. d4. ; goto after operand;
c24: jl. w3 e3. ; bounds: output(outpart);
al w0 x2 ; outpart:= stack part;
al w2 0 ; stack par.:= 0;
jl. c23. ; goto right;
c25: rl. w3 b3. ; plusminus:
sz w3 1 ; if operand=0 then
rl w0 5 ; outpart:= stack part; comment monadic operator;
jl. c2. ; goto out;
c65: bz. w3 b22. ; count ext proc:
al w3 x3+1 ; no of ext proc:=
hs. w3 b22. ; no of ext proc + 1;
jl. c17. ; goto proc end;
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ...8...
c26: bz. w3 b5. ; binary:
sh w3 7 ; if(state > 7
jl. 8 ; ! operand = 0
sh w3 44 ; ! state > 44
sh w3 42 ; ! state <= 42
jl. d0.+8 ;
al w3 1 ; ! introuble)
se. w3 (b0.) ; then error(delimiter);
sn. w3 (b3.) ; state:= stackpart;
jl. d0.+8 ; goto out;
hs. w2 b5. ;
jl. c2. ;
c27: al w3 1 ; an trouble:
rs. w3 b0. ; introuble:= true;
al w1 x1-4 ; ds:= ds-1;
jl. d4. ; goto after operand;
c28: jl. w3 e3. ; nl:
jl. w3 e1. ; output(outpart);
d28: rl. w3 b3. ; nlcounter:= nlcounter+1;
sn w3 1 ; return from nl: goto if operand=0 then
jl. d3. ; next1 else
jl. d4. ; after operand;
c29: al w1 x1+4 ; formal list:
rs. w1 b9. ; ds:= stack entry:= ds+1;
rl. w2 j4. ; stack(ds):=
rl. w3 a15. ; instructions(sn w0 <ident>,al w0 <decl>);
wa. w3 b7. ; goto set stop;
jl. d26. ;
c30: bl. w0 a7. ; formal: w0:= ident;
a39: jl. w3 (b9.) ; goto stack(stack entry);comment search in
; stack for ident (in w0),see note at bottom of page 8;
a16: al w3 6 ; return a:
hs. w3 b6. ; head alarm:= true;comment ident already in stack;
jl. c3. ; goto next;
a15: al w0 0 ; instruction modifier used c29+6
a40=k+2; return b ;
a17: jl w3 x3+a40-a16; stop instruction used set stop+6
sl w0 0 ; return b: if w0>=0 and
sl w0 h3+1 ; w0<min.ident
jl. 4 ; then
jl. a16. ; goto return a;comment ident= procedure identifier;
dl. w3 j4.+2 ; w23:= ident words1-2;comment ident not found;
d26: ds w3 x1+2 ; into stack: stack(ds):= w23;
al w1 x1+4 ; set stop:
sl. w1 (b36.) ; ds:= ds+1; if ds>maxds then error(stack);
jl. d0. ; stack(ds):= instruction(jl w3 x3+a40-a16);
rl. w3 a17. ; goto next;
rs w3 x1 ;
jl. c3. ;
;when we enter formal the top of the stack has the following form:
;
; stack entry: sn w0 <procedure ident> , al w0 <decl>
; sn w0 <formal ident 1 > , jl w3 x3
; sn w0 <formal ident 2 > , jl w3 x3
; . . . . .
; w1: jl w3 x3+a40-a16
;
;not two identifiers are the same.
\f
;rc 1976.03.10 algol 6, pass 3, page ...9...
c31: al w3 b16 ; value:
hs. w3 b12. ; mod:= addr(modifier2);
jl. d12. ; goto setspec;
c32: al w3 b17 ; first spec:
hs. w3 b12. ; mod:= addr(modifier1);
d12: al w3 0 ; set spec:
hs. w3 a18. ; specpart(modifier1):= 0;
c33: hs. w2 b13. ; second spec:
ba. w0 a18. ; value allowed:= stack part;
hs. w0 a18. ; specpart(modifier1):= specpart(modifier1)+outpart;
jl. c3. ; goto next;
;the current form of the top part of the stack is:
;
; stack entry: sn w0 <proc ident> , al w0 <decl>
;for each formal identifier there is a double word in one of the
;following three formats:
;
; 1: no value, no spec before: sn w0 <formal ident> , jl w3 x3
; 2: value, no spec yet: sn w0 <formal ident> , jl w3 x3+d15-d13-2
; 3: already specified: sn w0 <formal ident> , al w0 <spec>
; at the end of the list: jl w3 x3+a40-a16
; no two identifiers are the same
c34: rl. w2 j4.+2 ; spec comma:
bl. w0 a7. ; goto stack(stack entry);comment search for ident in
d13: jl. w3 (b9.) ; stack, w2= ident word 2, w0=ident;
al w2 0 ; return aa: val:= 0; comment type 1 found in stack;
d14: ; modify:
b12=k+1; mod ; stack(return addr):= stack(return addr)+val+mod;
wa. w2 0 ; goto next;
lx w2 x3-2 ;
rs w2 x3-2 ;
jl. c3. ;
a41: al w3 6 ; return bb:
hs. w3 b6. ; head alarm:= true;
sl w0 0 ; if ident>=0 and ident<min.ident
sl w0 h3+1 ; then goto next;
jl. 4 ; comment the identifier
jl. c3. ; has already been specified, type 3;
dl. w3 j4.+2 ; w2:= ident word 1;
lx. w3 b10. ; w3:= ident word 2 + modifier 1;
jl. d26. ; goto into stack; comment no match in stack;
d15: rs w2 x3-2 ; return cc: comment type 2 found in stack(return addr);
al w2 h18 ; stack(return addr,right word):= ident word 2;
b13=k+1; value allowed ;
sn w2 0 ; if -, value allowed then
jl. d14. ; begin
al w2 6 ; head alarm := true;
hs. w2 b6. ; val:= 0
al w2 0 ; end; comment value allowed: yes=h18, no=0;
jl. d14. ; goto modify;
\f
;rc 1976.03.10 algol 6, pass 3, page ...10...
h.
b10: jl w3 x3; modifier 1,specification:(al w0) exor (jl w3 x3),
a18: 0; spec
w. ; modifier 1 is initialized in b26,page 2;
b11: d15-d13-2; modifier 2,value
b16=b11-d14 ; addr of modifier2 relative to d14
b17=b10-d14 ; addr of modifier1 relative to d14
c.(:a40-a16-a41+d13+2-1:)a.(:a41-d13-2-1-a40+a16:);
m. pass 3: a40-a16<>a41-d13-2
;if a40-a16<>a41-d13-2 then output warning message during assembly
z.
c35: hs. w2 b14. ; compl head:
al w0 x1-4 ; no spec:= stack part;
ws. w0 b9. ; no of par:= ds-1-stackentry;
ls w0 -2 ;
rl. w2 b9. ;
bz w3 x2+3 ; decl byte:= byte4(stack(stack entry));
sn w0 0 ; if no of par=0 then
al w3 x3+6 ; decl byte:= decl byte+6;
bz. w0 b6. ;
se w0 0 ; if head alarm then
al w3 h19 ; decl byte:= <decl undef proc>;
hs w3 x2+3 ; stack(stack entry):= decl byte;
al w3 0 ; introuble:= false;
rs. w3 b0. ;
a20: al w0 h73 ; for i:= stack entry step 1 until ds-1 do
jl. w3 e3. ; begin output(<internal operand>);
bz w0 x2+1 ; output(byte2(stack(i)));
jl. w3 e3. ; spec:= byte4(stack(i));
bz w0 x2+3 ; if byte3(stack(i)) <> (al w0) then
bz w3 x2+2 ; spec:= no spec;
se. w3 (b25.) ; if spec=<unspec> then
b14=k+1; no spec ; head alarm:= true;
al w0 0 ; output(spec)
al w3 6 ; end;
sn w0 h20 ;
hs. w3 b6. ;
jl. w3 e3. ;
al w2 x2+4 ;
se w2 x1 ;
jl. a20. ;
al w3 e3-j3 ;
hs. w3 j3.+1 ; output identifier:= true;
rl. w1 b9. ; ds:= stack entry;
dl. w0 b15. ; stack(ds):= <beg proc><end proc block>
ds w0 x1+2 ; <0><exit proc>;
al w0 h22 ; output(<end spec>);
jl. w3 e3. ; \f
;rc 11.1.1971 algol 6, pass 3, page 11
jl. w3 e11. ; repeat input byte:= true;
al w0 6 ;
b6=k+1; head alarm
sn w0 ; if head alarm then
jl. w3 d27. ; error out(<head>);
al w3 2 ; if operand=1 then
se. w3 (b3.) ; begin
jl. d4. ; output(<internal operand>);
al w0 h73 ; output(ident);
jl. w3 e3. ; end;
bz. w0 a7. ; goto after operand;
jl. w3 e3. ;
jl. d4. ;
h. ; proc end bytes to be placed in stack:
b41: 0 ; begproc
b42: 0 ; end proc block
b15: 0 ; 0
b2: 0 ; exit proc
w.
c36: bz. w0 j3.+1 ; semicolon:
sn w0 d8-j3 ; if -, output identifier then
jl. c35. ; goto compl head;
al. w3 b37. ; control word:= addr of semicolon7a words in table;
jl. d6. ; goto control word found;
c37: rs. w2 b8. ; for:
jl. c2. ; for comma count:= 0; goto out;
c38: am -2 ; while count:
c39: al w3 1 ; for comma count:= for comma count-1;
am. (b8.) ; goto chout;
al w3 x3 ; count ch out:
rs. w3 b8. ; for comma count:= for comma count+1;
jl. c12. ; goto ch out;
h. ; label proc word to be placed in stack by switch:
b18: 0 , h23 ; <0><end block>
0 , h13 ; <0><exit type proc>
w.
c40: bz w3 x1 ; switch:
sn w3 x2 ; if stack(ds)=stack part then
al w3 h12 ; stack(ds):= <begin block>;
hs w3 x1 ;
dl. w3 b18.+2 ; stack(ds+1):= begin label proc;
ds w3 x1+6 ; stack part := outpart;
bz w2 1 ; goto ent;
jl. c14. ;
c41: al w0 h24 ; switch assign:
jl. w3 e3. ; output(<decl label proc with par>);
al w0 h73 ;
jl. w3 e3. ; output(<internal operand>);
al w0 h11 ;
jl. w3 e3. ; output(<dummy identifier>);
al w0 h26 ;
jl. w3 e3. ; output(<spec value integer>);
al w0 h22 ;
jl. w3 e3. ; output(<end spec>);
\f
;rc 11.1.1971 algol 6, pass 3, page 12
al w0 h27 ;
jl. w3 e3. ; output(<case expr>);
al w0 h73 ;
jl. w3 e3. ; output(<internal operand>);
al w0 h11 ;
jl. w3 e3. ; output(<dummy identifier>);
al w0 h28 ; outpart:= <of switch>;
jl. c11. ; goto ent out;
c63: bz w3 x1 ; set zone:
se w3 h50 ; if stack(ds)= <beg block>
sn w3 h12 ; ! stack(ds)= <beg clean>
jl. a44. ; then
al w2 h25 ; stack(ds):= stack part;
am -3 ; else
a44: hs w2 x1 ; byte2(stack(ds-1)):= <end zone block>;
jl. c7. ; goto set decl;
c42: jl. w3 e2. ; transmit error: input(byte);
al w0 x2 ; comment error identification byte;
al. w3 d28. ; error out(byte);
jl. d27. ; goto return from nl;
b19: 0, 0 ; litbyte(1:4);
c43: hs. w0 b21. ; string: kind:= outpart;
hs. w2 b20. ; no of litbytes:= stack part;
al. w0 b19. ; for i:= 1 step 1 until 4 do
a22: jl. w3 e2. ; begin
hs w2 (1) ; input(byte);
ba. w0 1 ; litbyte(i):= byte;
se. w0 b19.+4 ; end;
jl. a22. ; goto output literal;
jl. d17. ;
c44: hs. w0 b21. ; logic value:
hs. w2 b19. ; kind:= outpart;
al w2 1 ; litbyte(1):= stack part;
hs. w2 b20. ; no of litbytes:= 1;
jl. d17. ; goto output literal;
;c45: see page 7
;c46: see page 6
d16: rl. w1 b40. ; output number: restore(w1);comment stack pointer;
jl. w3 e11. ; repeat input byte:= true;
d17: rl. w0 b0. ; output literal:
sz w0 1 ; if introuble then
jl. d25. ; goto literal trouble out;
bz. w2 b5. ; if state>7 then
al w0 h41 ; begin
al. w3 a45. ; output(<vanished operand>);
sl w2 8 ; goto const err;
jl. e3. ; end;
al w2 0 ;
a23: bz. w0 x2+b19. ; for i:= 1 step 1 until no of litbyte do
jl. w3 e3. ; output(litbyte(i));
al w2 x2+1 ;
b20=k+1 ; no of litbytes
se w2 4 ;
jl. a23. ;
b21=k+1 ; kind
al w0 ;
jl. w3 e3. ; output(kind);
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ...13...
rl. w3 b3. ; after const out:
se w0 h33 ; if kind <> <string next> then
al w3 x3+7 ; operand:= operand+3;
rs. w3 b3. ; if operand=3 then
sn w3 8 ; goto after operand;
jl. d4. ; const err:
a45: jl. w3 e2. ; input(byte);
jl. d0.+16 ; error(operand);
c66: rl. w3 b3. ; ifnum out:
se w3 1 ; if operand <> 0 then
jl. c2. ; goto out;
bz. w3 b43. ; state := oldstate;
hs. w3 b5. ;
d19: rs. w1 b40. ; initialize number: save(w1);comment stack pointer;
jl. w3 e11. ; repeat input byte:= true;
ld w1 64 ; comment w01 is used to build numbers;
ds. w1 b19.+2 ; nstate:= number:= digit:= factor:= 0;
ds. w1 b27. ;
al w2 0 ;
d18: hs. w2 b29. ; next of number:
d20: jl. w3 e2. ; nstate:=w2; input(byte);
sl w2 h1 ; if byte< h1
sl w2 h1+10 ; or byte>=h1+10 then
jl. a1. ; goto other_then_digit else
jl. a14. ; goto digit;
a1: sl w2 h1+10 ; other_than_digit:
sl w2 h1+14 ; if byte< h1+10 or byte>=h1+14 then
jl. a2. ; goto other_than_number_constituent else
jl. a21. ; goto number_constituent;
a2: se w2 h78 ; other_than_number_constituent:
jl. a5. ; if byte<>new line then goto terminator;
jl. w3 e1. ; new_line:
rs. w0 a34. ; carret; save w0;
al w0 h88 ; byte:=new line;
jl. w3 e3. ; output(byte);
rl. w0 a34. ;
jl. d20. ; goto next_of_number;
a34: 0 ; saved w0:
a5: al w3 0 ; terminator:
jl. a25. ; class:=0; goto central_action;
a21: al w3 x2-h1-8 ; number_constituent: ('.+-)
ls w3 2 ; class:=(byte-h1-8)*4;
jl. a25. ; goto central_action;
a14: al w3 4 ; digit:
al w2 x2-h1 ; class:=4; byte:=byte-h1;
rs. w2 b27.+2 ; digit:=byte;
a25: dl. w3 x3+g4. ; central action:
b29=k+1; nstate
ld w3 ;
la. w3 b32. ;
jl. x3+c47. ; goto instruction(number action);
\f
; jz.fgs 1981.03.20 algol 8, pass 3, page ...13a...
d21: ss. w1 b44. ; build_number:
sh w0 -1 ; if f.w.(number)<f.w.(maxlong//10) then
jl. d11. ; goto number_ok;
sn w0 0 ; maybe_error1:
se w1 0 ; if number>maxlong//10 then
jl. c49. ; goto error1;
rl. w0 b27.+2 ; number=maxlong:
sl w0 8 ; if digit>=8 then
jl. c49. ; goto error1;
d11: dl. w1 b19.+2 ; number_ok:
ad w1 2 ;
aa. w1 b19.+2 ;
ad w1 1 ; number:= number*10 + digit;
aa. w1 b27.+2 ;
ds. w1 b19.+2 ;
jl. d18. ; goto next of number;
d22: wm. w1 b31. ; build exponent:
sn w0 0 ; exp:= exp*10;
sh w1 -1 ; comment exp is build in w1;
jl. c49. ; if overflow then goto error1;
wa. w1 b27.+2 ; exp:= exp + digit;
jl. d18. ; goto next of number;
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ..14...
c50:
c47: rl. w2 b26. ; digit after point:
al w2 x2+1 ;
rs. w2 b26. ; factor:= factor+1;
al w2 -18 ; nstate:= -18;
jl. d21. ; goto build number;
c48: al w2 -6 ; digit before point: nstate:= -6;
jl. d21. ; goto build number;
c49: al w2 -42 ; error 1: nstate:= -42;
jl. d18. ; goto next of number;
c51: al w2 -36 ; digit in exp: nstate:= -36;
jl. d22. ; goto build exponent;
c52: al w0 0 ; ten 1:
al w1 1 ; number:= 1;
ds. w1 b19.+2 ;
c53: al w2 1 ; ten2:
rs. w2 b30. ; expsign:= 1;
al w2 -24 ; nstate:= -24;
al w1 0 ; exp:= 0;
jl. d18. ; goto next of number;
c54: al w2 -12 ; point: nstate:= -12;
jl. d18. ; goto next of number;
c55: al w2 -1 ; expminus:
rs. w2 b30. ; expsign:= -1;
c56: al w2 -30 ; expplus: nstate:= -30;
jl. d18. ; goto next of number;
c57: jl. d23. ; goto error 2;
c58: jl. a26. ; goto finish 1;
c59: jl. a27. ; goto finish 2;
c60: jl. a28. ; goto finish 3;
;c61 see page 6
;c62 see page 6
;c63 see page 6
;c64 see page 6
;c65 see page 7
c. c60-c47-64 ; if c60-c47>64 then output warning
m. pass3: c60-c47>64
z. ; message during assembling;
d23: rl. w1 b40. ; error 2:
rl. w3 b0. ; if introuble
se w3 0 ; then repeat input byte:= true;
jl. w3 e11. ;
al w0 h41 ; restore(stack pointer);
jl. w3 e3. ; output(<vanished operand>);
jl. d0.+24 ; error(constant);
a26: sn w0 0 ; finish 1: comment integer;
sh w1 -1 ; if integer overflow (number) then
jl. a46. ; goto finish 4;
rs. w1 b19. ; litbyte(1:2):= right part of number;
al w3 2 ; no of litbytes:= 2;
hs. w3 b20. ; kind:= <integer literal>;
al w3 h39 ; goto output number;
hs. w3 b21. ;
jl. d16. ;
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ...15...
a46: al w3 h91 ; finish 4: comment long;
hs. w3 b21. ; kind := <long literal>;
al w3 4 ; no of litbytes := 4;
hs. w3 b20. ;
jl. a30. ; goto store out;
a27: al w1 1 ; finish 2: comment real without exponent;
rs. w1 b30. ; exp:= 0;
al w1 0 ; expsign:= 1;
a28: rs. w1 b28. ;
al w3 4 ; finish 3: comment real with exponent;
hs. w3 b20. ; no of litbytes:= 4;
al w3 h40 ; kind:= <real literal>;
hs. w3 b21. ;
d24: dl. w1 b19.+2 ; pack real:
nd. w1 b38. ; convert:
b38=k+1; exp ; normalize(number);
al w3 ; exp:= - no of shifts;
sn w3 -2048 ; if exp= -2048 then
jl. a29. ; goto set exp;
al w3 x3+48 ; exp:= exp + 48;
ld w1 -1 ; round:
aa. w1 b33.+2 ; number:= number + round const;
nd w1 3 ; exp1 := normalize(number);
ba w3 3 ; exp := exp+exp1;
a29: hs w3 3 ; set exp: exp part. number:= exp;
rl. w2 b30. ; make float exp:
rl. w3 b28. ; if expsign=-1 then
se w2 1 ; exp:= -exp;
ac w3 x3 ;
ws. w3 b26. ; exp:= exp - factor; comment this is final exponent;
sn w3 0 ; if exp=0 then
jl. a30. ; goto store out;
sh w3 999 ; if exp>=1000
sh w3 -1000 ; or exp<=-1000
jl. d23. ; then goto error2;
ns w3 5 ;
bl w2 5 ; n:= no of significant bits.abs(exp);
al w2 x2+14 ; l:= 14;
ls w2 2 ; comment w2 uneven if positive exp so
al w2 x2+1 ; boolean exp<-512 only true for neg exp;
sl w3 0 ; if exp < 0 then
jl. a31. ; begin
ls w3 1 ; l:= 23 - (n - 2);
al w2 x2-5 ; number:= number/10**(2**n)
sn w2 0 ; end;
am -4 ;
fd. w1 x2+g19. ;
a31: rs. w2 b34. ;
a32: ls w3 1 ; for j:= l step 1 until 23 do
al w2 x2-4 ; if bit(j).exp = 1
sn w3 0 ; then number:= number*10**(2**(23-j));
jl. a33. ;
sh w3 0 ;
fm. w1 x2+g18. ;
jl. a32. ;
a33: am. (b34.) ; if exp < -512
sn w1 x1 ; then number:= number/10**(2**9);
fd. w1 g18. ;
a30: ds. w1 b19.+2 ; store out: litbyte(1:4):= number;
jl. d16. ; goto output number;
;d25:see page 3
;d26:see page 8
;d27:see page 3
;d28:see page 8
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page ...15a...
c71: jl. w3 e3. ; prelim of stat:
; outbyte(trouble);
al w0 h82+37 ; outpart := <end case stat>;
jl. c19. ; goto an out;
\f
;jz.fgs 1981.03.20 algol 8, pass 3, page ...16...
;numbers:
;input byte values in the range from h1(base of numbers) to h2(base
;of normal delimiters) call for a certain logic which reads, analyzes
;and packs the numbers using the following table. this is an action-
;table which is accessed by 1: the class of current input byte and
;2: the current number state. the action is given in the table as an
;address relative to c47=digit after point.
;max. real number:
;when a number of type real is assembled, it is first packed as an
;48 bits integer which later is converted. Allmost the whole range
;allowed by this double word is utilized, and consistency is
;maintained with the read standard procedures which are not allowed
;to cause an integer overflow. a test is performed before
;number:=number*10+digit. The test is carried out by first test-
;ing the double word against maxlong//10. If less there are no
;troubles. If greater, troubles will come. If equal, digit is
;tested against 7 (number*10+digit<=(maxlong//10)*10+7).
;In short, the full range of positive longs becomes available
;to number:
; 140 737 488 355 327
;the number states (nstate) are:
; 0 before number
; -6 following digit before point
; -12 following point
; -18 following digit after point
; -24 following exponent base
; -30 following exponent sign
; -36 following digit after exponent base
; -42 in erroneous number
c48=c48-c47, c49=c49-c47, c50=c50-c47, c51=c51-c47, c52=c52-c47
c53=c53-c47, c54=c54-c47, c55=c55-c47, c56=c56-c47, c57=c57-c47
c58=c58-c47, c59=c59-c47, c60=c60-c47,
h.
; numberstate:
; -42 -36 -30 -24 -18 -12 -6 0
g4=k+2
c57 <6+ c60 , c57 <6+ c57 , c59 <6+ c57 , c58 <6+ c57; terminator
c49 <6+ c51 , c51 <6+ c51 , c50 <6+ c50 , c48 <6+ c48; digit
c49 <6+ c49 , c49 <6+ c49 , c53 <6+ c49 , c53 <6+ c52; '
c49 <6+ c49 , c49 <6+ c49 , c49 <6+ c49 , c54 <6+ c54; .
c57 <6+ c60 , c57 <6+ c56 , c59 <6+ c57 , c58 <6+ c57; +
c57 <6+ c60 , c57 <6+ c55 , c59 <6+ c57 , c58 <6+ c57; -
w.h.
;exponent table for generating real numbers
1280, 0, 0, 4 ; 10**(2**0)
1600, 0, 0, 7 ; 10**(2**1)
1250, 0, 0, 14 ; 10**(2**2)
1525, 3600, 0, 27 ; 10**(2**3)
1136, 3556, 3576, 54 ; 10**(2**4)
1262, 726, 3393, 107 ; 10**(2**5)
1555, 3087, 2640, 213 ; 10**(2**6)
1181, 3363, 3660, 426 ; 10**(2**7)
1363, 3957, 4061, 851 ; 10**(2**8)
1816, 3280, 1397, 1701 ; 10**(2**9)
g18=k-2, g19=g18+4
\f
; jz 1979.09.27 algol 8, pass 3, page 17
;stack words
;there are two types of stack words, repeat words and terminating words,
;each consisting of four bytes:
; 1. repeat words cause the search in the stack to be repeated. they
; are identified by a one in the leftmost position. there again
; are two types of repeat words:
; 1.1 repeat words with output identified by a zero in the second position
; from left. the output part is in byte no. 4.
; 1.2 repeat words without output identified by a one in the second
; position from left.
; 2. terminating words are identified by a zero in the leftmost position.
; they stop the search in the stack. the format is the same as for
; normal action words (see comment to control table) and they are
; treated by the same mechanism - allowed operand part however is
; not used.
;stack words.
;new state, switching part, stack part, output part
h.
;semicolon 4 and semicolon 7:
g5=k-h43
3<10, 0, 0, 0;h43 trouble :-,-,-
2<10, 0, 0,h31+ 7;h44 thenst :-,-,end thenst
2<10, 0, 0,h31+ 8;h45 goto :-,-,end goto
2<10, 0, 0,h31- 1;h99 disable :-,-,enable
2<10, 0, 0,h30+113;h46 assign :-,-,end assign
2<10, 0, 0,h30+ 44;h47 single do:-,-,end single do
2<10, 0, 0,h30+ 43;h48 do :-,-,end do
2<10, 0, 0,h31+ 6;h49 else stat:-,-,end elsest
27,c2 -j1, 0,h82+ 32;h50 beg clean:out,-,semicolon
27,c2 -j1, 0,h82+ 32;h12 beg block:out,-,semicolon
27,c2 -j1, 0,h82+ 32;h74 beg zonbl:out,-,semicolon
27,c2 -j1, 0,h82+ 32;h37 beg ext :out,-,semicolon
27,c2 -j1, 0,h82+ 32;h51 beg body :out,-,semicolon
27,c2 -j1, 0,h30+ 42;h52 of stat :out,-,case semicolon
28,c17-j1, 0, 0;h53 beg proc :procend,-,-
37,c65-j1, 0, 0;h75 beg extpr:count ext proc,-,-
2<10, 0, 0,h30+122;h29 :=switch :-,-,end switch
;end 1 and end 2:
g6=k-h43
3<10, 0, 0, 0;h43 trouble :-,-,-
2<10, 0, 0,h31+ 7;h44 thenst :-,-,end thenst
2<10, 0, 0,h31+ 8;h45 goto :-,-,end goto
2<10, 0, 0,h31- 1;h99 disable :-,-,enable
2<10, 0, 0,h30+113;h46 assign :-,-,end assign
2<10, 0, 0,h30+ 44;h47 single do:-,-,end single do
2<10, 0, 0,h30+ 43;h48 do :-,-,end do
2<10, 0, 0,h31+ 6;h49 else st :-,-,end elsest
20,c19-j1, 0,h82+ 23;h50 beg clean:an out,-,end clean
20,c64-j1, 0,h23 ;h12 beg block:an block,-,end block
20,c64-j1, 0,h25 ;h74 beg zonbl:an block,-,end zone block
20,c45-j1, 0,h82+ 25;h37 beg ext :ext proc check,-,end external
10,c20-j1, 0, 0;h51 beg body :an,-,-
20,c19-j1, 0,h82+ 37;h52 of stat :an out,-,end casest
\f
; jz 1979.09.27 algol 8, pass 3, page 18
;stack words: new state, switching part, stack part, output part;
;else 1 and else2:
g7=k-h42
3,c12-j1, h6,h31+ 3;h42 thenex :ch out,else ex,else ex
34,c27-j1, 0, 0;h43 trouble :an trouble,-,-
9,c12-j1, h49,h82+ 35;h44 thenst :ch out,else st,else st
2<10, 0, 0,h31+ 8;h45 goto :-,-,end goto
2<10, 0, 0,h31- 1;h99 disable :-,-,enable
2<10, 0, 0,h30+113;h46 assign :-,-,end assign
;comma 7:
g8=k-h29
2,c2 -j1, 0,h30+120;h29 :=switch :out,-,case comma
2,c39-j1, h55,h30+108;h54 single comma:countchout,:=for,simp for
2,c39-j1, h54,h30+108;h55 :=for: countchout,single comma,simp for
2,c39-j1, h55,h30+110;h56 until: countchout,:=for,stepelem
2,c39-j1, h55,h30+111;h57 while: countchout,:=for,while elem
2,c2 -j1, 0,h30+ 51;h58 (zone :out,-,zone comma
2,c12-j1, h70,h31+ 23;h59 next colon:chout,arrcomma,not first bound
2,c12-j1, h70,h31+ 22;h60 firstcolon:chout,arrcomma,first bound
2,c12-j1, h62,h30+ 47;h16 (proc subs:chout,,proc subs,first comma
2,c12-j1, h63,h30+ 47;h61 (left :chout,,left,first comma
2,c12-j1, h77,h30+ 47;h76 (left orex:chout,,left or ex,first comma
2,c2 -j1, 0,h30+ 48;h62 ,proc subs:out,-, not first comma
2,c2 -j1, 0,h30+ 48;h63 ,left :out,-, not first comma
2,c2 -j1, 0,h30+ 48;h77 ,left orex:out,-,not first comma
2,c2 -j1, 0,h30+120;h64 of exp :out,-, case comma
;right parenthesis 2:
g9=k-h58
13,c19-j1, 0,h82+ 27;h58 (zone :an out,-,end zone decl
13,c24-j1,h82+26,h31+ 23;h59 next colon:bounds,end bounds,not first bound
13,c24-j1,h82+26,h31+ 22;h60 firstcolon:bounds,end bounds,first bound
1,c23-j1, 1<2,h30+ 45;h16 (proc subs:right,new op,end list one
27,c23-j1, 1<2,h30+ 45;h61 (left :right,new op,end list one
4,c23-j1, 1<2,h30+ 45;h76 (left orex:right,new op,end list one
1,c23-j1, 1<2,h30+ 46;h62 ,proc subs:right,new op,end list more
27,c23-j1, 1<2,h30+ 46;h63 ,left :right,new op,end list more
4,c23-j1, 1<2,h30+ 46;h77 ,left orex:right,new op,end list more
1,c23-j1, 1<3,h30+119;h64 of exp :right,new op,end case exp
43,c23-j1, 1<2,h30+ 45;h92 fieldpar :right,new op,end list one
44,c23-j1, 1<2,h30+ 45;h93 fieldpar :right,new op,end list one
45,c23-j1, 1<2,h30+ 45;h94 fieldpar :right,new op,end list one
1,c23-j1, 1<3,h31+ 31;h65 (subex :right,new op,)
;do 1:
g10=k-h54
27,c21-j1, h47,h31+ 32;h54 singlecomma:do,single do,simple for do
27,c21-j1, h47,h31+ 32;h55 :=for :do,single do,simple for do
27,c21-j1, h47,h31+ 33;h56 until :do,single do,step elem do
27,c21-j1, h47,h31+ 34;h57 while :do,single do,while elem do
;then 1:
g11=k-h66
5,c12-j1, h42,h31+ 2;h66 if ex :ch out,thenex,thenex
8,c12-j1, h44,h82+ 34;h67 if st :ch out,thenst,thenst
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page 19
;stack words: new state, switching part, stack part, output part;
;step 1:
g12=k-h54
2,c12-j1, h68,h31+ 10;h54 singlecomma:ch out,step,step
2,c12-j1, h68,h31+ 10;h55 :=for :ch out,step,step
;until 1:
g13=k-h68
2,c12-j1, h56,h31+ 11;h68 step :ch out, until,until
;while 1:
g14=k-h54
2,c38-j1, h57,h30+112;h54 singlecomma:while count,while,while
2,c12-j1, h57,h30+112;h55 :=for :ch out,while,while
;colon 3:
g15=k-h69
2,c12-j1, h60,h30+ 52;h69 (arr :ch out,first colon,boundcol
2,c12-j1, h59,h30+ 52;h70 array comma:ch out,next colon,boundcol
;of 1:
g16=k-h71
11,c19-j1, 0,h30+118;h71 case ex :an out,-,of expr
26,c12-j1, h79,h82+ 36;h72 case st :ch out,-,of stat
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page 20
;stack words: new state, switching part, stack part, output part;
;trouble 1:
g17=k-h6
3<10, 0, 0, 0;h6 else ex :-,-,-
3<10, 0, 0, 0;h42 then ex :-,-,-
3<10, 0, 0, 0;h43 trouble :-,-,-
34,c11-j1, h43,h30+ 55;h44 thenst :ent out,trouble,trouble
34,c12-j1, h43,h30+ 55;h45 goto :ch out, trouble,trouble
3<10, 0, 0, 0;h99 disable :-,-,-
34,c12-j1, h43,h30+ 55;h46 assign :ch out,trouble,trouble
34,c11-j1, h43,h30+ 55;h47 single do:ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h48 do :ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h49 else stat:ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h50 beg clean:ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h12 beg block:ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h74 beg zonbl:ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h37 beg ext :ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h51 beg body :ent out,trouble,trouble
34,c11-j1, h43,h30+ 55;h52 of stat :ent out,trouble,trouble
32,c16-j1, 0,h30+ 55;h53 beg proc :trprocend, - ,trouble
32,c16-j1, 0,h30+ 55;h75 beg extpr:trprocend, - ,trouble
3<10, 0, 0, 0;h29 := switch:-,-,-
3<10, 0, 0, 0;h54 singlecomma:-,-,-
3<10, 0, 0, 0;h55 :=for :-,-,-
3<10, 0, 0, 0;h56 until :-,-,-
3<10, 0, 0, 0;h57 while :-,-,-
32,c19-j1, 0,h30+ 55;h58 (zone :an out,-,trouble
32,c19-j1, 0,h30+ 55;h59 next colon :an out,-,trouble
32,c19-j1, 0,h30+ 55;h60 first colon:an out,-,trouble
3<10, 0, 0, 0;h16 (proc subs :-,-,-
3<10, 0, 0, 0;h61 (left :-,-,-
3<10, 0, 0, 0;h76 (left or ex:-,-,-
3<10, 0, 0, 0;h62 ,proc subs :-,-,-
3<10, 0, 0, 0;h63 ,left :-,-,-
3<10, 0, 0, 0;h77 ,left or ex:-,-,-
3<10, 0, 0, 0;h64 of expr :-,-,-
3<10, 0, 0, 0;h92 fieldpar :-,-,-
3<10, 0, 0, 0;h93 fieldpar :-,-,-
3<10, 0, 0, 0;h94 fieldpar :-,-,-
3<10, 0, 0, 0;h65 (subexpr :-,-,-
3<10, 0, 0, 0;h66 if expr :-,-,-
3<10, 0, 0, 0;h67 if stat :-,-,-
3<10, 0, 0, 0;h68 step :-,-,-
32,c19-j1, 0,h30+ 55;h69 (array :an out,-,trouble
32,c19-j1, 0,h30+ 55;h70 arr comma :an out,-,trouble
3<10, 0, 0, 0;h71 case expr :-,-,-
3<10, 0, 0, 0;h72 case stat :-,-,-
20,c71-j1, 0,h30+ 55;h79 prelim of stat: prelim of stat,-,trouble
\f
;rc 5.3.1968 algol 5, pass 3, page 21
;control tables
;there are two types of control tables: main control table and control
;table for specials, one of which is accessed by the delimiter input bytes.
;
;1. main control table.
; for each entry the table is arranged as follows:
;
; delimiter action word p
; - - p-1
; . . . . . .
; - - - 1
; entry: 40 delimiter meaning groups
;
;the delimiter meaning groups consist of 3 bits each,thus making 10
;bytes: each group corresponds to a possible state, group no. 0 to state
;no. 0 and so on. a group corresponding to a certain state contains the
;number of the delimiter action word which is relevant for this state.
;there are two types af delimiter action words:
;
;1.1 normal action words identified by zeroes in the two leftmost
; positions. they consist of four bytes and have the following format:
; byte no. 0:action word identification bits (2 bits=zero pos.0-1)
; new state part (6 bits pos.2-7)
; allowed operand part (4 bits pos.8-11)
; byte no. 1: switch part (12 bits)
; byte no. 2: stack part (12 bits)
; byte no. 3: output part (12 bits)
; when the action indicated by the switch part is entered we have:
; w0= output part, right justified.
; w2= stack part, - -
;
;1.2 search words identified by a one in the leftmost position. they
; consist of four bytes and have the following format:
; byte no. 0: search word identification bit (a one in pos.0) a one in
; pos.1 indicates that test for procedure call is performed
; (search statement);a zero in pos.1 indicates that test for
; else expression is performed (search in expression).the
; remaining bits are irrelevant.
; byte no. 1: base address (12 bits) which points into the relevant
; table for stack words.
; byte no. 2: low-1
; byte no. 3: up
; low and up indicates the limits for allowed delimiters in the stack.
; when the search action is entered we have:
; w2= low-1 (pos.0-11)+ up (pos.12-23)
;
;2. control table for special delimiters contains three bytes for each
; special delimiter:
; byte no. 0: switch part (12 bits)
; byte no. 1: parameter part (12 bits)
; byte no. 2: output part (12 bits)
; when the action indicated by the switch part is entered we have:
; w0= output part,right justified
; w2= parameter part,right justified
\f
;rc 5.3.1968 algol 5, pass 3, page 22
;meaning of states:
;no. name preceding symbols
; 0 forbidden
; 1 in expression < <= = >= > <> & ! == => )
; 2 expecting expression , step until while : goto if ( := case
; 3 after else expression else expression
; 4 expection left or expression := )
; 5 after then expression then
; 6 in expression + - * / ** //real string abs round
; mod entier add extract shift
; 7 after not -,
; 8 after then statement then :
; 9 after else statement else :
; 10 after end body end
; 11 after of expression of
; 12 in value part value ,
; 13 aft.array,zone,zone array segm. )
; 14 in specification list procedure field switch string label ,
; 15 after type specification integer real boolean long
; 16 in heading procedure
; 17 in declaration list integer real boolean long field ,
; 18 after formals )
; 19 after type declaration integer real boolean long
; 20 after compound statement end
; 21 in formal list ( , parameter-delimiter
; 22 in for clause for
; 23 in switch declaration switch
; 24 in array declaration ,
; 25 after own own
; 26 after of statement of
; 27 expecting statement ; do : begin (after head:) goto for if :
; case ( := )
; 28 ecpecting statement or decl. ; begin
; 29 begin after head begin
; 30 expect. value or specification ;
; 31 expect. body or specification ;
; 32 trouble in declarations
; 33 trouble in head
; 34 trouble in statement
; 35 in zone declaration ,
; 36 in zone array declaration array ,
; 37 after external external
; 38 after external type integer real boolean
; 39 after declaration zone zone
; 40 after declaration array array
; 41 after specification zone zone
; 42 after specification array array
; 43 in expression after point . )
; 44 exp. left or expr. after . . )
; 45 exp. statement after point . )
; 46
; 47
;possible operand situations:
; 0: no operand
; 1: identifier
; 2: subscripted variable or procedure call
; 3: the rest: literals,subexpressions.
\f
; jz 1979.06.22 algol 8, pass 3, page ...23...
;input conversion table for special delimiters to special control table
h.
g1=k-h0
-1, 2, 5, 8, 11; true false * / **
14, 17, 20, 23, 26; // < =< = >=
29, 32, 35, 38, 41; > =, & ! ==
44, 47, 50, 53, 56; => mod shift extract add
59, 62, 65, 68, 71; endpass error newline stringfirst stringnext
74, 77 ; exit continue
;input conversion table for normal delimiters to main control table
w. g2=k-h2, h.
f0 , f1 , f2 , f3 , f4 ; . + - : goto
f5 , f6 , f7 , f8 , f9 ; begin external for if own
f10, f11, f12, f13, f14 ; integer long real boolean zone
f15, f16, f17, f18, f19 ; field procedure array switch string
f20, f21, f22, f23, f24 ; label value ; end else
f25, f26, f27, f28, f29 ; ( -, step until while
f30, f31, f32, f33, f34 ; , := then trouble do
f35, f36, f37, f38, f39 ; abs case of round entier
f40, f41, f42, f43 ; extend paramdelim ) disable
w. h.
;control table for special delimiters
;switch part, parameter part, output part
g3:
c44 -j1,-1,h81+ 3 ; 0 true :logic value,true ,bool literal
c44 -j1, 0,h81+ 3 ; 3 false :logic value,false,bool literal
c26 -j1, 6,h31+ 15 ; 6 * :binary,new state, *
c26 -j1, 6,h31+ 16 ; 9 / :binary,new state, /
c26 -j1, 6,h31+ 18 ; 12 ** :binary,new state, **
c26 -j1, 6,h31+ 17 ; 15 // :binary,new state, //
c26 -j1, 1,h32+ 0 ; 18 < :binary,new state, <
c26 -j1, 1,h32+ 1 ; 21 =< :binary,new state, =<
c26 -j1, 1,h32+ 2 ; 24 = :binary,new state, =
c26 -j1, 1,h32+ 3 ; 27 >= :binary,new state, >=
c26 -j1, 1,h32+ 4 ; 30 > :binary,new state, >
c26 -j1, 1,h32+ 5 ; 33 =, :binary,new state, =,
c26 -j1, 1,h31+ 26 ; 36 & :binary,new state, &
c26 -j1, 1,h31+ 27 ; 39 ! :binary,new state, !
c26 -j1, 1,h31+ 29 ; 42 == :binary,new state, ==
c26 -j1, 1,h31+ 28 ; 45 => :binary,new state, =>
c26 -j1, 6,h31+ 12 ; 48 mod :binary,new state, mod
c26 -j1, 6,h31+ 19 ; 51 shift :binary,new state, shift
c26 -j1, 6,h31+ 20 ; 54 extract:binary,new state, extract
c26 -j1, 6,h31+ 21 ; 57 add :binary,new state, add
c1 -j1, 0, 0 ; 60 endpass:endpass,-,0
c42 -j1, 0, 0 ; 63 error :transmit error,-,-
c28 -j1, 0,h80+ 0 ; 66 newline:newline,-,newline
c43 -j1, 4,h81+ 4 ; 69 stringfirst:string,4 bytes,stringfirst
c43 -j1, 4, h33 ; 72 stringnext :string,4 bytes,stringnext
c70 -j1, 0,h97+0 ; 75 exit : - , exit ident
c70 -j1, 0,h98+0 ; 78 continue : - , continue ident
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page 24
;main control table
;new state <4+ allowed operand,switch part,stack part,output part
w. k=k-g3-4, h.
2, c67-j1, 0, h82+47; .6: reset out,-,not first point
27 <4+ 2, c35-j1, h20 , 0; .5: compl head,unspec,-
45 <4+ 6, c2 -j1, 0, h82+46; .4: out,-,first point
45 <4+ 7, c66-j1, 0, h82+46; .3: ifnum out,-,first point
44 <4+ 7, c66-j1, 0, h82+46; .2: ifnum out,-,first point
43 <4+ 7, c66-j1, 0, h82+46; .1: ifnum out,-,first point
8.0111, 8.2111, 8.3300, 8.0000, f0 : ; st.0-15
8.0000, 8.0000, 8.0004, 8.4055; 16-31
8.0000, 8.0000, 8.0006, 8.6600; 32-47
6 <4+ 14, c2 -j1, 0, h31+13; +2: out,,+
6 <4+ 15, c25-j1, h32+ 8, h31+13; +1: plusminus,pos,+
8.0111, 8.1121, 8.0000, 8.0000, f1 : ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000;
8.0000, 8.0000, 8.0001, 8.1000; 32-47
6 <4+ 14, c2 -j1, 0, h31+14; -2: out,,-
6 <4+ 15, c25-j1, h32+ 9, h31+14; -1: plusminus,neg,-
8.0111, 8.1121, 8.0000, 8.0000, f2 : ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.1000; 32-47
27 <4+ 2, c35-j1, h20 , 0; :5: compl head,unspec,-
9 <4+ 2, c2 -j1, 0, h82+13; :4: out,-,decl label
2<10, g15-j2, h69- 1, h70 ; :3: search in expression
8 <4+ 2, c2 -j1, 0, h82+13; :2: out,-,decl label
27 <4+ 2, c2 -j1, 0, h82+13; :1: out,-,decl label
8.0333, 8.0030, 8.2400, 8.0000, f3 : ; st.0-15
8.0000, 8.0000, 8.0001, 8.1055; 16-31
8.0000, 8.0000, 8.0003, 8.0000; 32-47
27 <4+ 1, c35-j1, h20 , 0; goto 2: compl head,unspec,-
2 <4+ 1, c14-j1, h45 , 0; goto 1: ent,goto,-
8.0000, 8.0000, 8.1100, 8.0000, f4 : ; st.0-15
8.0000, 8.0000, 8.0001, 8.1022; 16-31
8.0200, 8.0000, 8.0000, 8.0000; 32-47
27 <4+ 1, c15-j1, h52 , 0; begin 4: ch,of stat,-
29 <4+ 1, c35-j1, h20 , 0; begin 3: compl head,unspec,-
28 <4+ 1, c14-j1, h51 , 0; begin 2: ent,beg body,-
28 <4+ 1, c11-j1, h50 , h82+30; begin 1: ent out,beg clean, begin
8.0000, 8.0000, 8.1100, 8.0000, f5 : ; st.0-15
8.0000, 8.0000, 8.0041, 8.1233; 16-31
8.1310, 8.0000, 8.0000, 8.0000; 32-47
37 <4+ 1, c11-j1, h37 , h82+31; external 1: ent out,beg ext,beg ext
8.0000, 8.0000, 8.0000, 8.0000, f6 : ; st.0-15
8.0000, 8.0000, 8.0001, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
27 <4+ 1, c35-j1, h20 , 0; for 2: compl head,unspec,-
22 <4+ 1, c37-j1, 0, h31+ 9; for 1: for,-,for
8.0000, 8.0000, 8.1100, 8.0000, f7 : ; st.0-15
8.0000, 8.0000, 8.0001, 8.1022; 16-31
8.0200, 8.0000, 8.0000, 8.0000; 32-47
\f
;rc 12.12.1970 algol 6, pass 3, page 25
;main control table
;new state <4+ allowed operand,switch part,stack part, output part
27 <4+ 1, c35-j1, h20 , 0; if 5: compl head,unspec
2 <4+ 1, c15-j1, h66 , 0; if 4: ch,if ex,-
2 <4+ 1, c11-j1, h66 , h31+ 1; if 3: ent out,if ex,if
2 <4+ 1, c15-j1, h67 , 0; if 2: ch,if st,-
2 <4+ 1, c11-j1, h67 , h31+ 1; if 1: ent out,if st,if
8.0034, 8.3000, 8.0200, 8.0000, f8 : ; st.0-15
8.0000, 8.0000, 8.0001, 8.1055; 16-31
8.0500, 8.0000, 8.0000, 8.0000; 32-47
25 <4+ 1, c6 -j1, h50 , 0; own 1: set block,beg clean
8.0000, 8.0000, 8.0000, 8.0000, f9 : ; st.0-15
8.0000, 8.0000, 8.0000, 8.1000; 16-31
8.1000, 8.0000, 8.0000, 8.0000; 32-47
38 <4+ 1, c7 -j1, 0, h82+ 0;integer4:set decl,-,decl int
15 <4+ 1, c32-j1, h18 , h30+68;integer3:firstspec,value yes,specint
17 <4+ 1, c7 -j1, 0, h82+14;integer2:set decl,-,own int
19 <4+ 1, c6 -j1, h50 , h82+ 0;integer1:set block,beg clean,decl int
8.0000, 8.0000, 8.0000, 8.0000, f10: ; st.0-15
8.0000, 8.0000, 8.0200, 8.1033; 16-31
8.1300, 8.0400, 8.0000, 8.0000; 32-47
\f
;rc 12.12.1970 algol 6, pass 3, page 25a
;main control table
;new state <4+ allowed operand,switch part,stack part, output part
38 <4+ 1, c7 -j1, 0, h82+ 2;long 5: set decl,-,decl long
6 <4+ 1, c2 -j1, 0, h32+13;long 4: out,-,oplong
15 <4+ 1, c32-j1, h18 , h30+70;long 3: firstspec,value yes,speclong
17 <4+ 1, c7 -j1, 0, h82+16;long 2: set decl,-,own long
19 <4+ 1, c6 -j1, h50 , h82+ 2;long 1: set block,beg clean,decl long
8.0444, 8.4444, 8.0000, 8.0000, f11: ; st.0-15
8.0000, 8.0000, 8.0200, 8.1033; 16-31
8.1300, 8.0500, 8.0000, 8.0000; 32-47
38 <4+ 1, c7 -j1, 0, h82+ 1;real 5: set decl,-,decl real
6 <4+ 1, c2 -j1, 0, h32+14;real 4: out,-,opreal
15 <4+ 1, c32-j1, h18 , h30+69;real 3: firstspec,value yes,specreal
17 <4+ 1, c7 -j1, 0, h82+15;real 2: set decl,-,own real
19 <4+ 1, c6 -j1, h50 , h82+ 1;real 1: set block,beg clean,decl real
8.0444, 8.4444, 8.0000, 8.0000, f12: ; st.0-15
8.0000, 8.0000, 8.0200, 8.1033; 16-31
8.1300, 8.0500, 8.0000, 8.0000; 32-47
38 <4+ 1, c7 -j1, 0, h82+ 3;boolean4:set decl,-,decl bool
15 <4+ 1, c32-j1, h18 , h30+71;boolean3:firstspec,value yes,specbool
17 <4+ 1, c7 -j1, 0, h82+17;boolean2:set decl,-,own bool
19 <4+ 1, c6 -j1, h50 , h82+ 3;boolean1:set block,beg clean,decl bool
8.0000, 8.0000, 8.0000, 8.0000, f13: ; st.0-15
8.0000, 8.0000, 8.0200, 8.1033; 16-31
8.1300, 8.0400, 8.0000, 8.0000; 32-47
41 <4+ 1, c32-j1, 0, h30+80; zone 2:first spec,value no,spec zone
39 <4+ 1, c63-j1, h74 , h35 ; zone 1:set zone,beg zone block,decl zone
8.0000, 8.0000, 8.0000, 8.0000, f14: ; st.0-15
8.0000, 8.0000, 8.0000, 8.1022; 16-31
8.1200, 8.0000, 8.0000, 8.0000; 32-47
14 <4+ 1, c33-j1, h18 , 4; field 4: sec spec,value yes, spec(field-simp)
14 <4+ 1, c33-j1, h18 , -19; field 3: sec spec,value yes, spec(arfield-array)
17 <4+ 1, c9 -j1, 0, 4; field 2: add decl,-,simple field-simple
17 <4+ 1, c9 -j1, 0, -10; field 1: add decl,-,array field-array
8.0000, 8.0000, 8.0000, 8.0004, f15: ; st.0-15
8.0002, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.1030, 8.0000; 32-47
16 <4+ 1, c62-j1, 0, h83;procedure6:add decl ext,0,proc-simple
16 <4+ 1, c61-j1,h50 , h30+56;procedure5:set ext proc,beg clean,proc
14 <4+ 1, c33-j1, 0, 33;procedure4:secspec,valno,proc-simp spec
14 <4+ 1, c32-j1, 0,h30+100;procedure3:firstspec,val no,spec proc
16 <4+ 1, c8 -j1, 0, h83;procedure2:add decl proc,0,proc-simple
16 <4+ 1, c5 -j1, h50 , h30+56;procedure1:set bloc proc,beg clean,proc
8.0000, 8.0000, 8.0000, 8.0004, f16: ; st.0-15
8.0002, 8.0000, 8.0000, 8.1033; 16-31
8.1300, 8.0560, 8.0000, 8.0000; 32-47
\f
;rc 12.12.1970 algol 6, pass 3, page 26
;main control table
;new state <4+ allowed operand,switch part,stack part, output part
14 <4+ 1, c33-j1, 0, 19;array6:sec spec,value no,spec(zonearr-zonedecl)
36 <4+ 1, c9 -j1, 0, 10;array5:add decl,-,zonearray-zone decl
42 <4+ 1, c33-j1, 0, 27;array4:sec spec,value no,array-simp spec
42 <4+ 1, c32-j1, 0, h30+96;array3:firstspec,value no,spec array
40 <4+ 1, c9 -j1, 0, 18;array2:add decl,-,array-simple decl
40 <4+ 1, c6 -j1, h50 , h82+19;array1:set block,beg clean,realarraydecl
8.0000, 8.0000, 8.0000, 8.0004, f17: ; st.0-15
8.0002, 8.0000, 8.0000, 8.1033; 16-31
8.1300, 8.0005, 8.0600, 8.0000; 32-47
14 <4+ 1, c32-j1, 0,h30+105;switch2:firstspec,value no,spec switch
23 <4+ 1, c40-j1, h50 , h53 ;switch1:switch,beg clean,beg proc
8.0000, 8.0000, 8.0000, 8.0000, f18: ; st.0-15
8.0000, 8.0000, 8.0000, 8.1022; 16-31
8.1200, 8.0000, 8.0000, 8.0000; 32-47
6 <4+ 1, c2 -j1, 0, h32+15;string2:out,-,opstring
14 <4+ 1, c32-j1, 0, h30+81;string1:firstspec,value no,spec string
8.0222, 8.2222, 8.0000, 8.0000, f19: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0011; 16-31
8.0100, 8.0000, 8.0000, 8.0000; 32-47
14 <4+ 1, c32-j1, 0, h30+82;label 1:firstspec,value no,spec label
8.0000, 8.0000, 8.0000, 8.0000, f20: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0011; 16-31
8.0100, 8.0000, 8.0000, 8.0000; 32-47
12 <4+ 1, c31-j1, 0, h20 ; value 1: value, value no,undecl spec
8.0000, 8.0000, 8.0000, 8.0000, f21: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0010; 16-31
8.0100, 8.0000, 8.0000, 8.0000; 32-47
b37 = k + g3 + 4
3<10, g5 -j2, h43- 1, h29 ; semicolon 7a: search statement
27 <4+ 7, c36-j1, h20 , 0; ;7: semicolon,unspec,-
31 <4+ 2, c34-j1, 0, 0; ;6: spec comma,-,-
28 <4+ 1, c3 -j1, 0, 0; ;5: next,-,-
2<10, g5 -j2, h43- 1, h29 ; ;4: search in expression
30 <4+ 1, c3 -j1, 0, 0; ;3: next,-,-
31 <4+ 2, c29-j1, 0, 0; ;2: formal list,-,-
28 <4+ 2, c13-j1, 0, 0; ;1: decl,-,-
8.0444, 8.4044, 8.7770, 8.6566, f22: ; st.0-15
8.2131, 8.7000, 8.0007, 8.7077; 16-31
8.5370, 8.0000, 8.0664, 8.4000; 32-47
28 <4+ 1, c35-j1, h21 , 0; end 3: compl head,spec general,-
2<10, g6 -j2, h43- 1, h52 ; end 2: search in expression
3<10, g6 -j2, h43- 1, h52 ; end 1: search statement
8.0222, 8.2022, 8.1100, 8.0000, f23: ; st.0-15
8.0000, 8.1000, 8.0001, 8.1000; 16-31
8.1310, 8.0100, 8.0002, 8.2000; 32-47
\f
;rc 12.12.1970 algol 6, pass 3, page 27
;main control table
;new state <4+ allowed operand,switch part,stack part,output part
2<10, g7 -j2, h42- 1, h46 ; else 2: search in expression
3<10, g7 -j2, h42- 1, h46 ; else 1: search statement
8.0222, 8.2222, 8.1000, 8.0000, f24: ; st.0-15
8.0000, 8.1000, 8.0001, 8.0000; 16-31
8.0000, 8.0000, 8.0002, 8.2000; 32-47
27 <4+ 2, c35-j1, h20 , 0; (7: compl head,unspec,-
2 <4+ 3, c68-j1, h64-11, h30+54; (6: special par,of ex,begin list field
2 <4+ 3, c22-j1, h65 , h31+30; (5: left parent,(subex,(
2 <4+ 2, c11-j1, h61 , h17 ; (4: ent out,(left,beg list
21 <4+ 2, c29-j1, 0, 0; (3: formal list,-,-
2 <4+ 2, c10-j1, h69 , 0; (2: decl ent,(arr,-
2 <4+ 2, c10-j1, h58 , 0; (1: decl ent,(zone,-
8.0555, 8.5555, 8.4406, 8.0000, f25: ; st.0-15
8.3000, 8.0000, 8.2004, 8.4077; 16-31
8.0001, 8.1001, 8.2006, 8.6600; 32-47
7 <4+ 1, c2 -j1, 0, h32+ 6; -,1: out,-,not
8.0111, 8.1100, 8.0000, 8.0000, f26: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
2<10, g12-j2, h54- 1, h55 ; step 1: search in expression
8.0111, 8.0010, 8.0000, 8.0000, f27: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
2<10, g13-j2, h68- 1, h68 ; until 1: search in expression
8.0111, 8.0010, 8.0000, 8.0000, f28: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
2<10, g14-j2, h54- 1, h55 ; while 1: search in expression
8.0111, 8.0010, 8.0000, 8.0000, f29: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
2<10, g8 -j2, h29- 1, h64 ; ,7: search in expression
24 <4+ 1, c46-j1, 35, 36; ,6: set state,new state 35,new state 36
14 <4+ 2, c34-j1, 0, 0; ,5: spec comma,-,-
24 <4+ 2, c46-j1, 35, 36; ,4: set state,new state 35,new state 36
21 <4+ 2, c30-j1, 0, 0; ,3: formal,-,-
12 <4+ 2, c34-j1, 0, 0; ,2: spec comma,-,-
17 <4+ 2, c3 -j1, 0, 0; ,1: next,-,-
8.0777, 8.0077, 8.0000, 8.2655, f30: ; st.0-15
8.0101, 8.0300, 8.4000, 8.0000; 16-31
8.0004, 8.0004, 8.4557, 8.0000; 32-47
\f
; jz.fgs 1982.07.02 algol 8, pass 3, page 28
;main control table
;new state <4+ allowed operand,switch part,stack part,output part
27 <4+ 2, c35-j1, h20 , 0; := 5: compl head,unspec,-
2 <4+ 2, c11-j1, h55 ,h30+109; := 4: ent out, :=for, :=for
4 <4+ 6, c2 -j1, 0,h30+114; := 3: out,-,:=
4 <4+ 6, c11-j1, h46 ,h30+115; := 2: ent out,assign,first:=
2 <4+ 2, c41-j1, h29 , 0; := 1: switch assign,:=switch,-
8.0000, 8.3000, 8.2200, 8.0000, f31: ; st.0-15
8.0000, 8.0041, 8.0002, 8.2055; 16-31
8.0000, 8.0000, 8.0000, 8.3200; 32-47
2<10, g11-j2, h66- 1, h67 ; then 1: search in expression
8.0111, 8.0011, 8.0000, 8.0000, f32: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
32 <4+ 1, c17-j1, 0, 0; trouble 7: proc end,-,-
33 <4+ 1, c29-j1, 0, 0; trouble 6: formal list,-,-
32 <4+ 1, c19-j1, 0, h30+55; trouble 5: an out,-,trouble
32 <4+ 1, c13-j1, 0, 0; trouble 4: decl,-,-
33 <4+ 1, c3 -j1, 0, 0; trouble 3: next,-,-
32 <4+ 1, c2 -j1, 0, h30+55; trouble 2: out,-,trouble
3<10, g17-j2, h6- 1, h79 ; trouble 1: search statement
8.0111, 8.1111, 8.1171, 8.3233, f33: ; st.0-15
8.6434, 8.1315, 8.4211, 8.1233; 16-31
8.0004, 8.4144, 8.4331, 8.1100; 32-47
2<10, g10-j2, h54- 1, h57 ; do 1: search in expression
8.0111, 8.0011, 8.0000, 8.0000, f34: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
6 <4+ 1, c2 -j1, 0, h32+10; abs 1: out,-,abs
8.0111, 8.1111, 8.0000, 8.0000, f35: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
27 <4+ 1, c35-j1, h20 , 0; case 3: compl head,unspec,-
2 <4+ 1, c11-j1, h72 , h27 ; case 2: ent out,case st,case
2 <4+ 1, c11-j1, h71 , h27 ; case 1: ent out,case exp,case
8.0011, 8.1000, 8.0200, 8.0000, f36: ; st.0-15
8.0000, 8.0000, 8.0002, 8.2033; 16-31
8.0300, 8.0000, 8.0000, 8.0000; 32-47
2<10, g16-j2, h71- 1, h72 ; of 1: search in expression
8.0111, 8.0011, 8.0000, 8.0000, f37: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
6 <4+ 1, c2 -j1, 0, h32+11; round 1: out,-, round
8.0111, 8.1111, 8.0000, 8.0000, f38: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
\f
; jz 1979.06.22 algol 8, pass 3, page 29
;main control table
;new state <4+ allowed operand,switch part,stack part,output part
6 <4+ 1, c2 -j1, 0, h32+ 7; entier 1: out,-,entier
8.0111, 8.1111, 8.0000, 8.0000, f39: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
6 <4+ 1, c2 -j1, 0, h32+12; extend 1: out,-,extend
8.0111, 8.1111, 8.0000, 8.0000, f40: ; st.0-15
8.0000, 8.0000, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
21 <4+ 2, c30-j1, 0, 0; param delim 2: formal,-,-
2<10, g8 -j2, h16- 1, h77 ; param delim 1: search in expression
8.0111, 8.0011, 8.0000, 8.0000, f41: ; st.0-15
8.0000, 8.0200, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0001, 8.0000; 32-47
2<10, g9 -j2, h58- 1, h65 ; ) 2: search in expression
18 <4+ 2, c30-j1, 0, 0; ) 1: formal,-,-
8.0222, 8.0022, 8.0000, 8.0000, f42: ; st.0-15
8.0000, 8.0100, 8.0000, 8.0000; 16-31
8.0000, 8.0000, 8.0002, 8.2200; 32-47
27 <4+ 1, c11-j1, h99,h31- 2; 1: ent out, disable, disable
8.0000, 8.0000, 8.1100, 8.0000, f43: ; st.0-15
8.0000, 8.0000, 8.0001, 8.1000; 16-31
8.0000, 8.0000, 8.0000, 8.0000; 32-47
w. k = k+g3+4
g0= k - j0
e30=e30+g0
i.
e.
m. jz 1982.07.82 algol 8, pass 3
\f
▶EOF◀