|
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: 79872 (0x13800)
Types: TextFile
Names: »algpass43tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass43tx «
; jz 1979.09.27 algol 8, pass 4, page ...1...
s. a53, b32, c46, d39, f14, g22, h11, i13, j10
d0 = 511 ; search stackvalue
d3 = 282 ; goto bypass outputvalue
d4 = 283 ; bypass label outputvalue
d5 = 123 ; end head outputvalue
d6 = 129 ; end do stackvalue
d7 = 4 ; decl label stackvalue
d8 = 5 ; decl for label stackvalue
d9 = 1 ; vanished operand inputvalue
d10 = 240 ; vanished operand outputvalue
d12 = 120 ; end bound head outputvalue
d13 = 2 ; array increment byte
d14 = 119 ; end zone head outputvalue
d15 = 125 ; end check local outputvalue
d16 = 124 ; end decl outputvalue
d17 = 116 ; specifications outputvalue, stackvalue
d18 = 48 ; end spec inputvalue
d19 = 4 ; spec array increment byte
d20 = 41 ; begin external inputvalue
d21 = 38 ; exit proc inputvalue
d22 = 39 ; exit type proc inputvalue
d23 = 111 ; begin block outputvalue
d24 = 112 ; begin external outputvalue
d25 = 113 ; end pass 4 outputvalue
d26 = 118 ; end zone array head outputvalue
d31 = 33 ; end clean input value
d32 = 123 ; end block input value
d33 = 126 ; exit block output value
d34 = 519 ; exit input value
d35 = 139 ; error output value
d36 = 21 ; error ident <:context label:>
d37 = 2 ; error ident <:delimiter:>
d38 = 520 ; continue input value
d39 = 24 ; error ident <:case elements:>
h11 = 100 ; max no of bytes in aux stack
k = e0 ;
w. h6 ; no of words in pass 4
h. h7 , 4<1 + 1 ; entry rel to e0, pass 4, change direction
w. ;
\f
; rc 3.12.1970 algol 6, pass 4, page ...2...
a0: bz. w0 x2+f1. ; stack out next:
jl. w3 g5. ; w0 := stackvalue(byte); stack;
c0: ; outnext:
a1: bz. w0 x2+f2. ; w0 := outvalue(byte);
a2: jl. w3 e3. ; out: outbyte;
c1: ; next:
a3: jl. w3 e2. ; byte := inbyte;
a4: al w0 x2 ; after next: w0 := byte;
sl w2 h3 ; if byte >= no interest then
jl. a2. ; goto out;
bl. w3 x2+f0. ;
j0: jl. x3 ; goto action(byte);
; next relevant:
g0: ds. w3 b1. ; save(return,byte);
a5: jl. w3 e2. ; input: byte := inbyte;
sl w2 h0 ; if byte > max special interest then
jl. a6. ; goto byte found;
bl. w3 x2+f3. ;
j1: jl. x3 ; goto action aux(byte);
; byte found:
a6: al w0 x2 ; w0 := byte;
rl. w2 b0. ; byte := saved byte;
jl. (b1.) ; return;
; error 1:
c2: al w0 x2 ; w0 := byte;
jl. w3 e2. ; byte := inbyte;
rx w2 0 ; swap(w0,byte);
jl. w3 e3. ; outbyte;
jl. a7. ; goto vanished operand 1;
; new line 1:
c3: jl. w3 e1. ; carret;
c4: ; vanished operand 1:
a7: bz. w0 x2+f2. ; w0 := outvalue(byte);
jl. w3 e3. ; outbyte;
jl. a5. ; goto input;
b0: 0 ; saved byte ;
b1: 0 ; saved return ;
; test goto bypass:
g1: am d3-d4 ; w0 := <goto bypass>; goto test active;
g2: al w0 d4 ; test bypass: w0 := <bypass>;
i0 = k + 1 ; active ; test active:
sn w0 d3 ; if w0 = active then
jl x3 ; return;
hs. w0 i0. ; active := w0;
jl. e3. ; goto outbyte;
\f
; rc 3.12.1970 algol 6, pass 4, page ...3...
g3: al w0 d5 ; test inhead:
i1 = k + 1 ; end head ; w0 := <end head>;
sn w0 0 ; if inhead then
jl x3 ; return;
hs. w0 i1. ; inhead := true;
jl. e3. ; goto outbyte;
g4: ds. w3 b3. ; copy bytes: save(return,byte);
a8: jl. w3 e2. ; copy: byte := inbyte;
rx w2 0 ; swap(byte,w0);
jl. w3 e3. ; outbyte;
al w0 x2-1 ; w0 := byte-1;
se w0 0 ; if w0 <> 0 then
jl. a8. ; goto copy;
rl. w2 b2. ; restore(byte);
jl. (b3.) ; return;
b2: 0 ; saved byte ;
b3: 0 ; saved return ;
c40: ; output van:
a9: al w0 d10 ; w0 := vanished operand;
jl. w3 e3. ; outbyte;
c5: ;
a10: jl. w3 g0. ; trouble:
bz w2 1 ; byte := next relevant;
sl w0 512 ; if byte > 511 then
jl. a9. ; goto output van;
sl w0 h2 ; if byte > max out of trouble then
jl. a10. ; goto trouble;
sh w0 h1 ; if byte <= max literal then
jl. a11. ; goto skip literal;
al w0 1 ; trouble terminated:
rs. w0 b12. ; counter := 1;
jl. a4. ; goto after next;
a11: bl. w3 x2+f3. ; skip literal:
hs. w3 i12. ; further := auxilliary table(byte);
al w3 5 ; index :=
bs. w3 x2+f1. ; (5 - stackvalue(byte))*2;
am x3 ; goto case index of
jl. x3 ; begin skip 4; skip 3; skip 2; skip 1; end;
jl. w3 e2. ; skip 4: inbyte;
jl. w3 e2. ; skip 3: inbyte;
jl. w3 e2. ; skip 2: inbyte;
jl. w3 e2. ; skip 1: inbyte;
i12= k + 1 ; further ;
j2: jl. 0 ; goto action(further);
\f
; rc 3.12.1970 algol 6, pass 4, page ...4...
g5: al w1 x1+1 ; stack:
sl. w1 (b6.) ; stacktop := stacktop + 1;
jl. a12. ; if stacktop >= usetop then goto stack alarm;
hs w0 x1 ; corebyte(stacktop) := w0;
rx. w1 b22. ; bytes in stack :=
al w1 x1+1 ; bytes in stack + 1;
sl. w1 (e9.) ; if bytes in stack >= inf 1 then
rs. w1 e9. ; inf 1 := bytes in stack;
rx. w1 b22. ;
jl x3 ; return;
a12: al. w1 e10. ; stack alarm:
jl. e5. ; alarm(<:stack:>);
g6: bz w0 x1 ; unstack:
al w1 x1-1 ; w0 := corebyte(stacktop);
rx. w1 b22. ; stacktop := stacktop - 1;
al w1 x1-1 ; bytes in stack :=
rx. w1 b22. ; bytes in stack - 1;
jl x3 ; return;
b22: 0 ; bytes in stack ;
g7: rx. w1 b6. ; stack in use:
al w1 x1-2 ; usetop := usetop - 2;
sh. w1 (b6.) ; if usetop <= stacktop then
jl. a12. ; goto stack alarm;
rs w0 x1 ; core(usetop) := w0;
rx. w1 b23. ;
al w1 x1+1 ; words in use :=
sl. w1 (e9.+2) ; words in use + 1;
rs. w1 e9.+2 ; if words in use >= inf 2 then
rx. w1 b23. ; inf 2 := words in use;
rx. w1 b6. ;
jl x3 ; return;
b23: 0 ; words in use ;
g8: ds. w0 b5. ; cancel entry in use:
dl. w0 b8. ; core(entry) :=
ds. w0 (b7.) ; core(entry-2) := <cancelled entry>;
rl. w0 b5. ;
rx. w1 b23. ; words in use :=
al w1 x1-1 ; words in use - 1;
rx. w1 b23. ;
jl. (b4.) ; return;
b4: 0 ; saved return ;
b5: 0 ; saved w0 ;
b6: 0 ; usetop ;
b7: 0 ; entry ;
h4: 0 ; initial usetop ;
am 0 ; cancelled entry
b8: am 0 ; in use stack;
\f
; rc 29.05.75 algol 6, pass 4, page ...5...
; search use stack:
; the routine searches in use stack from usetop to first blockstop
; for identifier given in w0; on return w0, w1, w2 are unchanged and
; if found: w3 = no of parameters; entry = usestack entry + 1;
; if not found:w3 = 0; entry = address of blockstop + 1;
; note please at return w0=w0 extract 12;
g9: rs. w3 b9. ; search use:
bl w0 1 ;
jl. w3 (b6.) ; goto core(usetop);
jl. a13. ; a search in the usestack terminates
jl. a13. ; in the entry in this table corresponding
jl. a13. ; to the number of parameters;
jl. a13. ;
jl. a13. ; usestack formats:
jl. a13. ;
jl. a13. ; normal entry: sn w0 <identifier>
a13: bz w0 1 ;
al w3 x3-1 ; jl w3 x3+<parameters>
rs. w3 b7. ;
bz w3 x3 ; cancelled entry: am 0
jl. (b9.) ; am 0
b9: 0 ; saved return ; block stop: jl w3 x3
\f
; rc 1977.11.03 algol 6, pass 4, page ...6...
c6: al w0 d5 ; do:
jl. w3 e3. ; w0 := <end head>; outbyte;
rl. w0 b31. ;
bs. w0 1 ; dolevel :=
rs. w0 b31. ; dolevel - 1;
al w0 0 ;
hs. w0 i3. ; last decl := 0;
al w0 x1-1 ;
rs. w0 b10. ; top := stacktop - 1;
a14: al w1 x1-1 ; search end do:
bz w0 x1+1 ; stacktop := stacktop - 1;
se w0 d6 ; if corebyte(stacktop+1) <> <end do> then
jl. a14. ; goto search end do;
a15: sn. w1 (b10.) ; output for label list:
jl. a1. ; if stacktop = top then goto outnext;
al w1 x1+1 ; stacktop := stacktop + 1;
bz w0 x1+1 ; w0 := corebyte(stacktop + 1);
sh w0 511 ; if w0 < 512 then
jl. a17. ; goto change last label decl;
i2 = k + 1 ; last label ;
am 0 ;
se w3 x3-d8 ; if last label <> <decl for label> then
jl. w3 e3. ; outbyte;
a16: hs w0 x1 ; move stack byte: corebyte(stacktop) := w0;
jl. a15. ; goto output for label list;
a17: hs. w0 i2. ; change last label decl:
al w0 d8 ; last label := w0; w0 := <decl for label>;
jl. a16. ; goto move stack byte;
b10: 0 ; top ;
b31: 0 ; dolevel
c7: jl. w3 e1. ; new line:
jl. a1. ; carret; goto outnext;
c8: al w0 0 ; end do:
hs. w0 i3. ; last decl := 0;
rl. w0 b31. ;
ba. w0 1 ; dolevel :=
rs. w0 b31. ; dolevel + 1;
jl. a0. ; goto stack out next;
g10: bz. w0 x2+f1. ; test decl:
i3 = k + 1 ; last decl ; w0 := stackvalue(byte);
sn w0 0 ; if w0 = last decl then
jl x3 ; return;
hs. w0 i3. ; last decl := w0;
jl. g5. ; goto stack;
c9: bz. w0 x2+f1. ; literal: w0 := stackvaluetable(byte);
al. w3 a1. ; set return(outnext);
jl. g4. ; goto copy bytes;
\f
; rc 1977.11.15 algol 6, pass 4, page ...7...
f4: 0 ; 0 owns ; counts(0) ;
0 ; 2 variables ; counts(2) ;
0 ; 4 points ; counts(4) ;
b12: 1 ; counter ;
b13: 0 ; proclevel ;
b14: 0 ; beginlevel ;
0 ; blocklevel ; b14+2 ;
c10: jl. w3 g10. ; declare simple:
jl. w3 g3. ; test decl; test inhead;
al. w3 a3. ; set return(next);
g11: ;
rs. w3 b11. ; stack and copy: save (return);
a18: jl. w3 g0. ; stack and copy 1: next relevant;
sh w0 511 ; if w0 < 512 then
jl. a19. ; goto end ident;
jl. w3 g5. ; stack;
jl. w3 e3. ; outbyte;
bz. w3 x2+f3. ;
ld w0 -6 ; where to count := bits(0,5,auxtable(byte));
ls w0 -18 ; counts(where to count) :=
wa. w0 x3+f4. ; counts(where to count) +
rs. w0 x3+f4. ; bits(6,11,auxtable(byte));
jl. a18. ; goto stack and copy 1;
a19: jl. w3 e11. ; end ident:
bz. w3 x2+f0. ; repeat input byte;
am. (b13.) ;
se w3 x3 ; if proclevel = 0 or
so w3 1 ; bit(11,actiontable(byte)) = 0 then
jl. (b11.) ; return;
al w0 d0 ; w0 := <search>;
rl. w3 b11. ; restore(return);
jl. g5. ; goto stack;
b11: 0 ; saved return ;
c11: jl. w3 g10. ; declare label: test decl;
jl. w3 g0. ; w0 := next relevant;
jl. w3 e11. ; repeat input byte;
se w0 d34 ; if w0 = exit
sn w0 d38 ; or w0 = continue then
jl. a49. ; then goto delim error;
a21: al. w3 a1. ; declare: set return(outnext);
jl. g11. ; goto stack and copy;
a49: al w0 d37 ; delim error:
jl. w3 e3. ;
al w0 d35 ; outbyte(error ident(<:delimiter:>));
jl. w3 e3. ; outbyte(error);
jl. a21. ; goto declare;
\f
; rc 3.12.1970 algol 6, pass 4, page ...8...
g12: ls w0 12 ; test array decl:
hs. w0 i3. ; last decl := 0;
bz w0 0 ;
g14: se w3 x3 ; test zone decl:
jl. e3. ; if declaration then
; goto outbyte;
al w2 d11 ; byte := <decl undef>;
jl. c10. ; goto declare simple;
c12: al w0 d12 ; declare array: w0 := <end bound head>;
jl. w3 g12. ; test array decl;
al w3 0 ;
hs. w3 g14.+1 ; declaration := false;
jl. w3 g10. ; test decl;
rl. w0 b12. ; w0 := counter - 1;
bs. w0 1 ;
jl. w3 g5. ; stack;
rl. w3 f4.+2 ;
wa w3 0 ;
wa w3 0 ; variables := variables +
al w3 x3+d13 ; 2 * w0 + decl array increment;
rs. w3 f4.+2 ;
jl. a21. ; goto declare;
c13: am d14-d26 ; declare zone: w0 := <end zone head>; goto zone;
c14: al w0 d26 ; declare zone array: w0 := <end zone array head>;
hs. w0 i4. ; zone: head := w0;
jl. w3 a41. ; check local;
rl. w0 b12. ; w0 := counter;
jl. w3 g14. ; test zone decl;
al w3 0 ;
hs. w3 g14.+1 ; declaration := false;
jl. w3 g10. ; test decl;
i4 = k + 1 ; head ;
al w0 0 ; w0 := head;
al. w3 a21. ; set return(declare);
jl. e3. ; outbyte;
c15: jl. w3 g3. ; end zone decl:
jl. w3 g1. ; test inhead; test goto bypass;
al w3 1 ;
hs. w3 g14.+1 ; declaration := true;
al w0 0 ;
rs. w0 b12. ; counter := 0;
hs. w0 i10. ; zone comma received := true; check local := true;
jl. a1. ; goto outnext;
c39: al. w3 c31. ; zone comma: set return(count parameters);
i10 = k + 1 ; zo. co. re; check local:
a41: se w3 x3+1 ; if zone comma received then
jl x3 ; begin
al w0 d15 ; w0 := <check local>;
hs. w0 i10. ; zone comma received := false; outbyte;
jl. e3. ; end; return;
\f
; jz 1979.09.27 algol 8, pass 4, page ...9...
c17: al w1 x1-1 ; decl proc int or boo:
jl. a38. ; stacktop := stacktop - 1;
; goto decl parproc int or boo;
c18: al w1 x1-1 ; decl proc real or long: stacktop := stacktop - 1;
c19: am 2 ; decl parproc real or long: w0 := 4;
c38: ; goto count variables;
a38: al w0 2 ; decl parproc int or boo: w0 := 2;
wa. w0 f4.+2 ; count variables:
rs. w0 f4.+2 ; variables := variables + w0;
jl. w3 g0. ; next relevant;
jl. w3 e3. ; outbyte;
jl. w3 e11. ; repeat input byte;
jl. a22. ; goto declare par proc no type;
c20: al w1 x1-1 ; decl proc no type:
c21: ; stacktop := stacktop - 1;
a22: rl. w3 b13. ; decl parproc no type:
al w3 x3-1 ; proclevel :=
rs. w3 b13. ; proclevel - 1;
al. w3 a20. ; set return(declare proc);
g13: rs. w3 b16. ; blockhead:
am. (b13.) ; save(return);
sn w3 x3 ; if proclevel = 0 then
jl. a39. ; goto out of block;
al w0 1 ; collaps use stack:
jl. w3 g9. ; w0 := 1; search use;
jl. w3 g7. ; stack in use;
jl. w3 g7. ; stack in use;
rs. w2 b15. ; save(byte);
rl. w2 b7. ; usetop :=
al w2 x2+1 ; entry + 1;
rs. w2 b6. ; index := usetop;
a23: al w2 x2-4 ; collaps:
bz w0 x2-1 ; index := index - 4; w0 := byte(index-1);
sn w0 1 ; if w0 = 1 then
jl. a24. ; goto finis collaps;
jl. w3 g9. ; search use;
se w3 0 ; if found then
jl. a23. ; goto collaps;
rl w0 x2 ; w0 := core(index);
jl. w3 g7. ; stack in use;
rl w0 x2-2 ; w0 := core(index-2);
jl. w3 g7. ; stack in use;
jl. a23. ; goto collaps;
c43: al w0 4 ; decl switch:
wa. w0 f4.+2 ; variables :=
rs. w0 f4.+2 ; variables + 4;
jl. w3 a52. ; check case elements;
jl. a22. ; goto decl parproc no type;
\f
; jz 1979.09.27 algol 8, pass 4, page ...10...
; finis collaps:
a24: rl. w2 b15. ; restore(byte);
a39: jl. w3 g1. ; out of block: test goto bypass label;
ac. w0 (f4.+2) ; w0 := -variables;
sh w0 -2048 ; if w0 <= -2048 then
al w0 -2048 ; w0 := -2048;
jl. w3 e3. ; outbyte;
rl. w3 b14.+2 ;
al w3 x3-1 ; blocklevel :=
rs. w3 b14.+2 ; blocklevel - 1;
i5 = k + 1 ; variables1 ;
al w0 0 ; variables := variables 1;
rs. w0 f4.+2 ;
sl w3 1 ; if blocklevel > 0 then
jl. (b16.) ; return;
bz. w0 x2+f2. ; w0 := outvalue(byte);
jl. w3 e3. ; outbyte;
jl. a33. ; goto finis pass 4;
b15: 0 ; saved byte ;
b16: 0 ; saved return ;
f11: 1 ; case elem count;
f12: 0 ; save return in check case elements;
c44: rl. w0 f11. ; end case:
jl. w3 g21. ; stack in aux(case elem count);
al w3 1 ;
rs. w3 f11. ; case elem count := 1;
jl. c0. ; goto outnext;
c45: al. w3 c0. ; set return(outnext);
a52: rs. w3 f12. ; check case elements:
rl. w3 f11. ; save return;
sl w3 2047 ; if case elem count >= 2047 then
jl. a50. ; goto case overflow;
; unstack case elem count:
a51: jl. w3 g22. ; unstack from aux(case elem count);
rs. w0 f11. ;
jl. (f12.) ; return;
c46: rl. w3 f11. ; count case elements:
al w3 x3+1 ; count := case elem count + 1;
sl w3 2047 ; if count >= 2047 then
al w3 2047 ; count := 2047;
rs. w3 f11. ; case elem count := count;
jl. c0. ; goto outnext;
a50: al w0 d39 ; case overflow:
jl. w3 e3. ; outbyte(errorident,<:case elements:>);
al w0 d35 ;
jl. w3 e3. ; outbyte(error);
jl. a51. ; goto unstack case elem count;
\f
; jz.fgs 1981.03.20 algol 8, pass 4, page ...10a...
f13: 0 ; aux stack top
f14: 0 ; max aux stack top
g21: rx. w3 f13. ; stack in aux:
al w3 x3-1 ; top := aux stack top - 1;
sh. w3 (f14.) ; if top <= max aux stack top then
jl. a53. ; goto aux stack alarm;
hs w0 x3 ; aux stack(top) := w0;
rx. w3 f13. ; aux stack top := top;
jl x3 ; return;
g22: rx. w3 f13. ; unstack from aux:
bz w0 x3 ; w0 := aux stack top(top);
al w3 x3+1 ; top:=aux stack top+1;
rx. w3 f13. ; aux stack top := top;
jl x3 ; return;
a53: jl. w1 e5. ; aux stack alarm:
<:aux stack<0>:>;
\f
; rc 1977.11.03 algol 6, pass 4, page ...11...
c22: rl. w3 b14. ; begin:
al w3 x3-1 ; beginlevel :=
rs. w3 b14. ; beginlevel - 1;
sl w3 1 ; if beginlevel > 0 then
jl. a3. ; goto next;
jl. w3 g3. ; test inhead;
al w0 d16 ; w0 := <end decl>;
jl. w3 e3. ; outbyte;
; unstack decl:
a25: jl. w3 g6. ; unstack;
a26: sn w0 0 ; test stack byte:
jl. a28. ; if w0 = 0 then goto block stop;
al. w3 a25. ; set return(unstack decl);
se w0 d0 ; if w0 <> <search> then
jl. e3. ; goto outbyte;
; search:
a27: jl. w3 g6. ; unstack;
sh w0 511 ; if w0 < 512 then
jl. a26. ; goto test stack byte;
jl. w3 g9. ; search use;
se w3 0 ; if found then
jl. w3 g8. ; cancel entry in use;
al. w3 a27. ; set return(search);
jl. e3. ; goto outbyte;
; block stop:
a28: jl. w3 g6. ; unstack;
rs. w0 b14. ; beginlevel := w0;
jl. w3 g6. ; unstack;
hs. w0 i3. ; last decl := w0;
jl. w3 g6. ; unstack;
hs. w0 i5. ; variables 1 := w0;
jl. w3 g6. ;
rs. w0 b31. ; dolevel := unstack;
al w0 d17 ; w0 := <specifications>;
al. w3 a3. ; set return(next);
sn w2 d18 ; if byte = <end specifications> then
jl. g5. ; goto stack;
al w0 0 ;
hs. w2 i1. ; inhead := false;
al. w3 a1. ; set return(outnext);
jl. g13. ; goto blockhead;
; for element:
c23: bz. w0 x2+f1. ; assign:
i9 = k + 1 ; warning ; w0 := stackvalue(byte);
se w3 x3 ; if warning then
jl. w3 e3. ; outbyte;
; simple for:
c24: am -1 ; warning := false; goto outnext;
c25: al w0 1 ; set warning:
hs. w0 i9. ; warning := true;
jl. a1. ; goto outnext;
\f
; rc 3.12.1970 algol 6, pass 4, page ...12...
c16: jl. w3 g1. ; spec zone array: test goto bypass;
c26: jl. w3 g0. ; spec search: next relevant;
jl. w3 e11. ; repeat input byte;
jl. w3 g9. ; search use;
al w0 x3 ; w0 := w3;
hs. w0 i6. ; saved ident := w0;
se w3 0 ; if found then
jl. w3 g8. ; cancel entry in use;
bz. w3 x2+f0. ; w3 := action table(byte);
sz w3 1 ; if bit(11,w3) = 0
sn w0 0 ; or w0 = 0 then
jl. c28. ; goto spec other;
jl. w3 g1. ; test goto bypass;
jl. w3 g0. ; next relevant;
jl. w3 e3. ; outbyte;
bz. w0 i6. ; w0 := number of params;
jl. w3 e3. ; outbyte;
rl. w3 f4.+2 ;
wa w3 0 ;
wa w3 0 ; variables := variables +
al w3 x3+d19 ; 2*w0 + spec array increment;
rs. w3 f4.+2 ;
bz. w0 x2+f1. ; w0 := stackvalue(byte);
jl. w3 g5. ; stack;
bz. w0 x2+f3. ; w0 := auxtable(byte);
al. w3 a3. ; set return(next);
jl. e3. ; goto outbyte;
c27: jl. w3 g1. ; specvalue: test goto bypass;
c28: jl. w3 g0. ; specother: next relevant;
al. w3 a0. ; set return(stack out next);
jl. e3. ; goto outbyte;
c29: jl. w3 g3. ; bounds: test inhead;
al w3 1 ;
hs. w3 g14.+1 ; declaration := true;
jl. w3 g1. ; test goto bypass;
a29: al w3 1 ; clear counter: w3 := 1;
jl. a30. ; goto store counter;
c30: rl. w0 b12. ; start count: w0 := counter;
al. w3 a29. ; set return(clear counter);
jl. g5. ; goto stack;
c31: rl. w3 b12. ; count parameters:
al w3 x3+1 ; w3 := counter + 1;
sl w3 511 ; if w3 >= 511 then
al w3 510 ; w3 := 510;
a30: rs. w3 b12. ; store counter: counter := w3;
jl. a1. ; goto outnext;
\f
; rc 1977.11.03 algol 6, pass 4, page ...13...
c41: ; first field point:
am -1 ; list kind := -,begin list else
c32: al w3 1 ; begin list:
hs. w3 i13. ; listkind := begin list;
jl. w3 g0. ; next relevant;
jl. w3 e11. ; repeat input byte;
sh w0 511 ; if not identifier then
jl. a1. ; goto outnext;
am. (b31.) ; check exit operator:
se w3 x3 ; if dolevel = 0
se w0 d34 ; or ident <> exit then
jl. a48. ; goto check proc level;
rs. w0 b32. ; save w0;
al w0 d36 ; exit in do loops:
jl. w3 e3. ; outbyte(
al w0 d35 ; error ident(<:context label:>),
jl. w3 e3. ; error);
rl. w0 b32. ; restore w0;
a48: am. (b13.) ; check proc level:
sn w3 x3 ; if proclevel = 0 then
jl. a31. ; goto output counter;
jl. w3 g9. ; search use;
se w3 0 ; if found then
jl. a44. ; goto get max parameters;
hs. w0 i6. ; save ident := w0;
rl. w0 b12. ; w0 := counter;
bz. w3 i13. ;
sn w3 0 ; if list kind = first point then
al w0 1 ; w0 := 1;
sl w0 15 ; if w0 >= 15
al w0 15 ; w0 := 15;
wa. w0 b18. ; w0 := w0 + <jl w3 x3>;
jl. w3 g7. ; stack in use;
i6 = k + 1 ; save ident ;
al w0 0 ; w0 := save ident;
bz w0 1 ;
wa. w0 b17. ; w0 := w0 + <sn w0 0>;
jl. w3 g7. ; stack in use;
i13=k+1 ; list kind ; output counter:
a31: sn w3 x3 ; if list kind <> begin list then
jl. a1. ; goto outnext;
c42: jl. w3 g6. ; begin list field: unstack;
rx. w0 b12. ; swap(w0,counter);
al. w3 a1. ; set return(outnext);
jl. e3. ; goto outbyte;
b17: sn w0 0 ; normal entry in use:
b18: jl w3 x3 ;
b32: 0 ; saved w0
a44: sl. w3 (b12.) ; get max parameters:
jl. a31. ; if no of param >= counter then
bz. w3 i13. ; then goto output counter;
sn w3 0 ; if list kind = first field point then
jl. a1. ; goto outnext;
rl. w3 b12. ;
sl w3 15 ; no of param(entry) :=
al w3 15 ; if no of param >= 15 then 15
hs. w3 (b7.) ; else counter;
jl. a31. ; goto output counter;
\f
; rc 3.12.1970 algol 6, pass 4, page ...14...
a20: al w0 0 ; declare proc:
hs. w0 i3. ; last decl := 0;
rl. w3 h4. ;
sn. w0 (b13.) ; if proclevel = 0 then
rs. w3 b6. ; usetop := initial usetop;
sn. w0 (b13.) ; if proclevel = 0
rs. w0 b23. ; then words in use := 0;
bz. w0 x2+f2. ; w0 := outvalue(byte);
jl. w3 e3. ; outbyte;
al w0 d4 ;
hs. w0 i0. ; active := <bypass label>;
jl. w3 g10. ; test decl;
jl. w3 g3. ; test inhead;
jl. w3 g11. ; stack and copy;
bz. w3 i7. ;
am. (b14.+2) ;
sn w3 x3-1 ; if blocklevel <> 1 or
se w3 d20 ; -,external then
jl. a3. ; goto next;
hs. w0 i7. ; external := w0 = <begin external>;
jl. a3. ; goto next;
c33: jl. w3 g0. ; end external: next relevant;
jl. w3 e11. ; repeat input byte;
al w3 d20 ;
se w0 d21 ; if w0 = <exit proc> or
sn w0 d22 ; w0 = <exit type proc> then
hs. w3 i7. ; external := true;
jl. c36. ; goto exit block;
c34: al w0 d23 ; begin external:
am -d20 ; w0 := <begin block>;
i7 = k + 1 ; external ;
se w3 x3 ; if -,external then
hs. w0 x2+f2. ; outvalue(byte) := <begin block>;
jl. c22. ; goto begin;
\f
; jz 1979.09.27 algol 8, pass 4, page ...15...
a33: ; finis pass 4:
rl. w1 f14. ; for usetop := stack bottom step -1
a34: al w1 x1-1 ; until top of std proc suite do
bz w0 x1 ; begin
jl. w3 e3. ; w0 := corebyte(stacktop);
se. w1 (b19.) ; outbyte;
jl. a34. ; end;
i11 = k + 1 ; ident lim ;
al w0 0 ; w0 := ident lim;
jl. w3 e3. ; outbyte;
rl. w0 f4. ; w0 := owns;
sl w0 2047 ; if w0 >= 2047 then
al w0 -2048 ; w0 := -2048;
jl. w3 e3. ; outbyte;
rl. w0 f4.+4 ; w0 := points;
sl w0 2047 ; if w0>=2047 then
al w0 -2048 ; w0:=-2048;
jl. w3 e3. ; outbyte;
jl. e7. ; goto end pass;
b19: -13; top of std proc suite; (the constant is the length of an entry)
\f
; rc 1977.11.23 algol 6, pass 4, page ...16...
c35: jl. w3 g3. ; exit proc:
jl. w3 g2. ; test inhead;
rl. w3 b13. ; test bypass;
al w3 x3+1 ; proclevel := proclevel + 1;
rs. w3 b13. ;
al w0 0 ;
hs. w0 i1. ; inhead := false;
c36: rl. w0 b31. ; exit block:
jl. w3 g5. ; stack dolevel);
al w0 0 ;
rs. w0 b31. ; dolevel := 0;
rl. w0 f4.+2 ; w0 := variables;
sl w0 2043 ; if two many variables
al w0 2042 ; then variables := great;
jl. w3 g5. ; w0 := variables; stack;
bz. w0 i3. ; w0 := last decl;
jl. w3 g5. ; stack;
rl. w0 b14. ; w0 := beginlevel;
jl. w3 g5. ; stack;
al w0 0 ;
rs. w0 f4.+2 ; variables := w0 :=
hs. w0 i3. ; last decl := 0;
al w3 1 ;
rs. w3 b14. ; begin level := 1;
jl. w3 g5. ; stack;
rl. w3 b14.+2 ;
al w3 x3+1 ; blocklevel :=
rs. w3 b14.+2 ; blocklevel + 1 ;
al w0 d3 ;
hs. w0 i0. ; active := <goto bypass>;
rl. w0 b21. ; w0 := <use block stop>;
jl. w3 g7. ; stack in use;
jl. a1. ; goto outnext;
b21: jl w3 x3 ; useblockstop;
c37: rl. w3 b14. ; end clean:
al w3 x3+1 ;
rs. w3 b14. ; beginlevel := beginlevel + 1;
jl. a3. ; goto next;
\f
; rc 3.12.1970 algol 6, pass 4, page ...17...
; action table (1)
; the marks +1 are used in some actions to
; distinguish variants of the same action
h. ; input action
;
f0: c7-j0 ; 0 new line new line
c0-j0 ; 1 vanished operand outnext
c0-j0 ; 2 internal operand outnext
c9-j0 ; 3 error literal
h0 = k - f0 ;
; max special interest
c9-j0 ; 4 integer literal literal
c9-j0 ; 5 real literal literal
c9-j0 ; 6 long literal literal
c9-j0 ; 7 boolean literal literal
c9-j0 ; 8 string first literal
c9-j0 ; 9 string next literal
h1 = k - 1 - f0 ;
; max literal
; inputbytes from here to <max out of trouble> terminates trouble
c10-j0 ; 10 decl simple integer declare simple
c10-j0 ; 11 decl simple real declare simple
c10-j0 ; 12 decl simple long declare simple
c10-j0 ; 13 decl simple boolean declare simple
c10-j0 ; 14 decl integer field declare simple
c10-j0 ; 15 decl real field declare simple
c10-j0 ; 16 decl long field declare simple
c10-j0 ; 17 decl boolean field declare simple
c10-j0 ; 18 decl integer array field declare simple
c10-j0 ; 19 decl real array field declare simple
c10-j0 ; 20 decl long array field declare simple
c10-j0 ; 21 decl boolean array field declare simple
c13-j0+1 ; 22 decl zone declare zone
c11-j0 ; 23 decl label declare label
c10-j0 ; 24 decl own integer declare simple
c10-j0 ; 25 decl own real declare simple
c10-j0 ; 26 decl own long declare simple
c10-j0 ; 27 decl own boolean declare simple
c12-j0+1 ; 28 decl integer array declare array
c12-j0+1 ; 29 decl real array declare array
c12-j0+1 ; 30 decl long array declare array
c12-j0+1 ; 31 decl boolean array declare array
c14-j0+1 ; 32 decl zone array declare zone array
c37-j0 ; 33 end clean end clean
c36-j0 ; 34 exit block exit block
c33-j0 ; 35 end external end external
c29-j0 ; 36 end bounds bounds
c15-j0 ; 37 end zone decl end zone decl
c35-j0 ; 38 exit proc no type exit proc
c35-j0 ; 39 exit proc type exit proc
\f
; jz 1979.09.27 algol 8, pass 4, page ...18...
; action table (2)
; input action
c22-j0 ; 40 begin begin
c34-j0 ; 41 begin external begin external
c1 -j0 ; 42 ; next
c6 -j0 ; 43 do do
c0 - j0 ; 44 then statm outnext
c0 -j0 ; 45 else statm outnext
c0 -j0 ; 46 of statm outnext
c44-j0 ; 47 end case statm end case
c22-j0 ; 48 end spec begin
c46-j0 ; 49 case semicolon count case elements
c8 -j0 ; 50 end do end do
c8 -j0 ; 51 end single do end do
; max out of trouble
h2 = k - f0 ;
c30-j0 ; 52 end list one start count
c30-j0 ; 53 end list more start count
c31-j0 ; 54 first comma count parameters
c31-j0 ; 55 not first comma count parameters
c41-j0 ; 56 first point first field point
c0 -j0 ; 57 not first point outnext
c39-j0 ; 58 zone comma zone comma
c31-j0 ; 59 bound colon bound colon, count param
c32-j0 ; 60 begin list begin list
c42-j0 ; 61 begin list field output counter
c5 -j0 ; 62 trouble trouble
c21-j0+1 ; 63 decl parproc no type decl parproc no type
c38-j0+1 ; 64 decl parproc integer decl parproc int or boo
c19-j0+1 ; 65 decl parproc real decl parproc real or long
c19-j0+1 ; 66 decl parproc long decl parproc real or long
c38-j0+1 ; 67 decl parproc boolean decl parproc int or boo
c43-j0+1 ; 68 decl switch decl switch
c20-j0 ; 69 decl proc no type decl proc no type
c17-j0 ; 70 decl proc integer decl proc int or boo
c18-j0 ; 71 decl proc real decl proc real or long
c18-j0 ; 72 decl proc long decl proc real or long
c17-j0 ; 73 decl proc boolean decl proc int or boo
c20-j0+1 ; 74 decl proc undef decl proc no type
d11 = k - 1 - f0;
c28-j0 ; 75 spec simple integer spec other
c28-j0 ; 76 spec simple real spec other
c28-j0 ; 77 spec simple long spec other
c28-j0 ; 78 spec simple boolean spec other
c28-j0 ; 79 spec integer field spec other
c28-j0 ; 80 spec real field spec other
c28-j0 ; 81 spec long field spec other
c28-j0 ; 82 spec boolean field spec other
\f
; jz 1979.09.27 algol 8, pass 4, page ...19...
; action table (3)
; input action
c28-j0 ; 83 spec integer array field spec other
c28-j0 ; 84 spec real array field spec other
c28-j0 ; 85 spec long array field spec other
c28-j0 ; 86 spec boolean array field spec other
c26-j0 ; 87 spec zone spec search
c28-j0 ; 88 spec string spec other
c28-j0 ; 89 spec label spec other
c27-j0 ; 90 spec value integer spec value
c27-j0 ; 91 spec value real spec value
c27-j0 ; 92 spec value long spec value
c27-j0 ; 93 spec value boolean spec value
c27-j0 ; 94 spec value integer field spec value
c27-j0 ; 95 spec value real field spec value
c27-j0 ; 96 spec value long field spec value
c27-j0 ; 97 spec value boolean field spec value
c27-j0 ; 98 spec value integer array field spec value
c27-j0 ; 99 spec value real array field spec value
c27-j0 ; 100 spec value long array field spec value
c27-j0 ; 101 spec value boolean array field spec value
c26-j0+1 ; 102 spec integer array spec search
c26-j0+1 ; 103 spec real array spec search
c26-j0+1 ; 104 spec long array spec search
c26-j0+1 ; 105 spec boolean array spec search
c16-j0 ; 106 spec zone array spec zone array
c26-j0 ; 107 spec proc no type spec search
c26-j0 ; 108 spec proc integer spec search
c26-j0 ; 109 spec proc real spec search
c26-j0 ; 110 spec proc long spec search
c26-j0 ; 111 spec proc boolean spec search
c26-j0 ; 112 spec switch spec search
c26-j0 ; 113 spec undef spec search
c26-j0 ; 114 spec general spec search
c24-j0 ; 115 simple for elem simple for
c23-j0 ; 116 :=for for element
c23-j0 ; 117 step elem for element
c23-j0 ; 118 while elem for element
c25-j0 ; 119 while set warning
c25-j0 ; 120 end assign set warning
c23-j0 ; 121 := assign
c23-j0 ; 122 first:= assign
c0 -j0 ; 123 end block outnext
c0 -j0 ; 124 end zone block outnext
c0 -j0 ; 125 of expr outnext
c44-j0 ; 126 end case expr end case
c46-j0 ; 127 case comma count case elements
c0 -j0 ; 128 of switch outnext
c44-j0 ; 129 end switch end case
c45-j0 ; 130 case check case elements
; no interest:
h3 = k - f0 ;
\f
; rc 3.12.1970 algol 6, pass 4, page ...20...
; stackvalue table (1)
h. ; input stackvalue
;
f1: 0 ; 0 new line not used
0 ; 1 vanished operand not used
0 ; 2 internal operand not used
1 ; 3 error bytes to copy
; max special interest
2 ; 4 integer literal bytes to copy
4 ; 5 real literal bytes to copy
4 ; 6 long literal bytes to copy
1 ; 7 boolean literal bytes to copy
4 ; 8 string first bytes to copy
4 ; 9 string next bytes to copy
; max literal
; inputbytes from here to <max out of trouble> terminates trouble
48 ; 10 decl simple integer decl simple integer
49 ; 11 decl simple real decl simple real
50 ; 12 decl simple long decl simple long
51 ; 13 decl simple boolean decl simple boolean
52 ; 14 decl integer field decl integer field
53 ; 15 decl real field decl real field
54 ; 16 decl long field decl long field
55 ; 17 decl boolean field decl boolean field
56 ; 18 decl integer array field decl integer array field
57 ; 19 decl real array field decl real array field
58 ; 20 decl long array field decl long array field
59 ; 21 decl boolean array field decl boolean array field
7 ; 22 decl zone decl zone
4 ; 23 decl label decl label
60 ; 24 decl own integer decl own integer
61 ; 25 decl own real decl own real
62 ; 26 decl own long decl own long
63 ; 27 decl own boolean decl own boolean
64 ; 28 decl integer array decl integer array
65 ; 29 decl real array decl real array
66 ; 30 decl long array decl long array
67 ; 31 decl boolean array decl boolean array
8 ; 32 decl zone array decl zone array
0 ; 33 end clean not used
0 ; 34 exit block not used
0 ; 35 end external not used
0 ; 36 end bounds not used
0 ; 37 end zone decl not used
0 ; 38 exit proc no type not used
0 ; 39 exit proc type not used
\f
; jz 1979.09.14 algol 8, pass 4, page ...21...
; stackvalue table (2)
; input stackvalue
0 ; 40 begin not used
0 ; 41 begin external not used
0 ; 42 ; not used
0 ; 43 do not used
0 ; 44 then statm not used
0 ; 45 else statm not used
0 ; 46 of statm not used
0 ; 47 end case statm not used
116 ; 48 end spec specifications
0 ; 49 case semicolon not used
129 ; 50 end do end do
129 ; 51 end single do end do
; max out of trouble
0 ; 52 end list one not used
0 ; 53 end list more not used
0 ; 54 first comma not used
0 ; 55 not first comma not used
0 ; 56 first point not used
0 ; 57 not first point not used
0 ; 58 zone comma not used
0 ; 59 bound colon not used
0 ; 60 begin list not used
0 ; 61 begin list field not used
0 ; 62 trouble not used
44 ; 63 decl parproc no type decl parproc no type
40 ; 64 decl parproc integer decl parproc integer
41 ; 65 decl parproc real decl parproc real
42 ; 66 decl parproc long decl parproc long
43 ; 67 decl parproc boolean decl parproc boolean
3 ; 68 decl switch decl switch
36 ; 69 decl proc no type decl proc no type
32 ; 70 decl proc integer decl proc integer
33 ; 71 decl proc real decl proc real
34 ; 72 decl proc long decl proc long
35 ; 73 decl proc boolean decl proc boolean
6 ; 74 decl proc undef decl proc undef
302 ; 75 spec simple integer spec simple integer
303 ; 76 spec simple real spec simple real
304 ; 77 spec simple long spec simple long
301 ; 78 spec simple boolean spec simple boolean
302 ; 79 spec integer field spec simple integer
302 ; 80 spec real field spec simple integer
302 ; 81 spec long field spec simple integer
302 ; 82 spec boolean field spec simple integer
\f
; jz 1979.09.27 algol 8, pass 4, page ...22...
; stackvalue table (3)
; input stackvalue
302 ; 83 spec integer array field spec simple integer
302 ; 84 spec real array field spec simple integer
302 ; 85 spec long array field spec simple integer
302 ; 86 spec boolean array field spec simple integer
307 ; 87 spec zone spec zone
308 ; 88 spec string spec string
309 ; 89 spec label spec label
312 ; 90 spec value integer spec value integer
313 ; 91 spec value real spec value real
314 ; 92 spec value long spec value long
311 ; 93 spec value boolean spec value boolean
312 ; 94 spec value integer field spec value integer
312 ; 95 spec value real field spec value integer
312 ; 96 spec value long field spec value integer
312 ; 97 spec value boolean field spec value integer
312 ; 98 spec value integer array field spec value integer
312 ; 99 spec value real array field spec value integer
312 ; 100 spec value long array field spec value integer
312 ; 101 spec value boolean array field spec value integer
324 ; 102 spec integer array spec integer array
325 ; 103 spec real array spec real array
326 ; 104 spec long array spec long array
323 ; 105 spec boolean array spec boolean array
329 ; 106 spec zone array spec zone array
330 ; 107 spec proc no type spec proc no type
332 ; 108 spec proc integer spec proc integer
333 ; 109 spec proc real spec proc real
334 ; 110 spec proc long spec proc long
331 ; 111 spec proc boolean spec proc boolean
337 ; 112 spec switch spec switch
340 ; 113 spec undef spec undef
338 ; 114 spec general spec general
0 ; 115 simple for elem not used
280 ; 116 :=for while label
280 ; 117 step elem while label
280 ; 118 while elem while label
0 ; 119 while not used
0 ; 120 end assign not used
281 ; 121 := prep assign
281 ; 122 first:= prep assign
0 ; 123 end block not used
0 ; 124 end zone block not used
0 ; 125 of expr not used
0 ; 126 end case expr not used
0 ; 127 case comma not used
0 ; 128 of switch not used
0 ; 129 end switch not used
0 ; 130 case not used
; no interest:
\f
; rc 7.12.1970 algol 6, pass 4, page ...23...
; output table (1)
h. ; input output value
;
f2: 110 ; 0 new line new line
240 ; 1 vanished operand vanished operand
241 ; 2 internal operand internal operand
139 ; 3 error error
; max special interest
133 ; 4 integer literal integer literal
134 ; 5 real literal real literal
135 ; 6 long literal long literal
136 ; 7 boolean literal boolean literal
137 ; 8 string first string first
138 ; 9 string next string next
; max literal
; inputbytes from here to <max out of trouble> terminates trouble
0 ; 10 decl simple integer not used
0 ; 11 decl simple real not used
0 ; 12 decl simple long not used
0 ; 13 decl simple boolean not used
0 ; 14 decl integer field not used
0 ; 15 decl real field not used
0 ; 16 decl long field not used
0 ; 17 decl boolean field not used
0 ; 18 decl integer array field not used
0 ; 19 decl real array field not used
0 ; 20 decl long array field not used
0 ; 21 decl boolean array field not used
108 ; 22 decl zone label colon
117 ; 23 decl label label colon
0 ; 24 decl own integer not used
0 ; 25 decl own real not used
0 ; 26 decl own long not used
0 ; 27 decl own boolean not used
104 ; 28 decl integer array begin bounds integer
105 ; 29 decl real array begin bounds real
106 ; 30 decl long array begin bounds long
107 ; 31 decl boolean array begin bounds boolean
109 ; 32 decl zone array begin zone array
0 ; 33 end clean not used
126 ; 34 exit block exit block
127 ; 35 end external end external
121 ; 36 end bounds end bounds
122 ; 37 end zone decl end zone decl
131 ; 38 exit proc no type exit proc no type
132 ; 39 exit proc type exit proc type
\f
; jz 1979.09.14 algol 8, pass 4, page ...24...
; output table (2)
; input output value
111 ; 40 begin begin block
112 ; 41 begin external begin external
0 ; 42 ; not used
128 ; 43 do do
258 ; 44 then statm then statm
259 ; 45 else statm else statm
260 ; 46 of statm of statm
261 ; 47 end case statm end case statm
0 ; 48 end spec end spec
239 ; 49 case semicolon case semicolon
129 ; 50 end do end do
130 ; 51 end single do end single do
; max out of trouble
262 ; 52 end list one end list one
263 ; 53 end list more end list more
264 ; 54 first comma first comma
265 ; 55 not first comma not first comma
266 ; 56 first point first point
267 ; 57 not first point not first point
268 ; 58 zone comma zone comma
269 ; 59 bound colon bound colon
114 ; 60 begin list begin list
115 ; 61 begin list field begin list field
0 ; 62 trouble not used
20 ; 63 decl parproc no type begin parproc no type
16 ; 64 decl parproc integer begin parproc integer
17 ; 65 decl parproc real begin parproc real
18 ; 66 decl parproc long begin parproc long
19 ; 67 decl parproc boolean begin parproc boolean
15 ; 68 decl switch begin switch
28 ; 69 decl proc no type begin proc no type
24 ; 70 decl proc integer begin proc integer
25 ; 71 decl proc real begin proc real
26 ; 72 decl proc long begin proc long
27 ; 73 decl proc boolean begin proc boolean
28 ; 74 decl proc undef begin proc undef
84 ; 75 spec simple integer formal simple integer
85 ; 76 spec simple real formal simple real
86 ; 77 spec simple long formal simple long
87 ; 78 spec simple boolean formal simple boolean
88 ; 79 spec integer field formal integer field
89 ; 80 spec real field formal real field
90 ; 81 spec long field formal long field
91 ; 82 spec boolean field formal boolean field
\f
; jz 1979.09.27 algol 8, pass 4, page ...25...
; output table (3)
; input output value
92 ; 83 spec integer array field formal int array field
93 ; 84 spec real array field formal rea array field
94 ; 85 spec long array field formal lon array field
95 ; 86 spec boolean array field formal boo array field
13 ; 87 spec zone formal zone
96 ; 88 spec string formal string
9 ; 89 spec label formal label
72 ; 90 spec value integer take value integer
73 ; 91 spec value real take value real
74 ; 92 spec value long take value long
75 ; 93 spec value boolean take value boolean
72 ; 94 spec value integer field take value integer
73 ; 95 spec value real field take value real
74 ; 96 spec value long field take value long
75 ; 97 spec value boolean field take value boolean
72 ; 98 spec value integer array field take value integer
73 ; 99 spec value real array field take value real
74 ; 100 spec value long array field take value long
75 ; 101 spec value boolean array field take value boolean
100 ; 102 spec integer array anonymous array integer
101 ; 103 spec real array anonymous array real
102 ; 104 spec long array anonymous array long
103 ; 105 spec boolean array anonymous array boolean
14 ; 106 spec zone array take zone array
80 ; 107 spec proc no type formal proc no type
76 ; 108 spec proc integer formal proc integer
77 ; 109 spec proc real formal proc real
78 ; 110 spec proc long formal proc long
79 ; 111 spec proc boolean formal proc boolean
12 ; 112 spec switch formal switch
11 ; 113 spec undef formal unspec
10 ; 114 spec general formal general
270 ; 115 simple for elem simple for elem
271 ; 116 :=for :=for
272 ; 117 step elem step elem
273 ; 118 while elem while elem
274 ; 119 while while
275 ; 120 end assign end assign
276 ; 121 := :=
277 ; 122 first:= first:=
278 ; 123 end block end block
279 ; 124 end zone block end zone block
236 ; 125 of expr of expr
237 ; 126 end case expr end case expr
238 ; 127 case comma case comma
224 ; 128 of switch of switch
225 ; 129 end switch end switch
235 ; 130 case case
; no interest:
\f
; rc 7.1.1971 algol 6, pass 4, page ...26...
; auxilliary table (1)
h. ; input table content
;
f3: c3-j1 ; 0 new line action: new line 1
c4-j1 ; 1 vanished operand action: vanished operand 1
c4-j1 ; 2 internal operand action: vanished operand 1
c2-j1 ; 3 error action: error 1
; max special interest
c40-j2 ; 4 integer literal action: output van
c40-j2 ; 5 real literal action: output van
c40-j2 ; 6 long literal action: output van
c40-j2 ; 7 boolean literal action: output van
c40-j2 ; 8 string first action: output van
c5 -j2 ; 9 string next action: trouble
; max literal
; inputbytes from here to <max out of trouble> terminates trouble
;where to count what
2<6 + 2 ; 10 decl simple integer variables 2
2<6 + 4 ; 11 decl simple real variables 4
2<6 + 4 ; 12 decl simple long variables 4
2<6 + 2 ; 13 decl simple boolean variables 2
2<6 + 2 ; 14 decl integer field variables 2
2<6 + 2 ; 15 decl real field variables 2
2<6 + 2 ; 16 decl long field variables 2
2<6 + 2 ; 17 decl boolean field variables 2
2<6 + 2 ; 18 decl integer array field variables 2
2<6 + 2 ; 19 decl real array field variables 2
2<6 + 2 ; 20 decl long array field variables 2
2<6 + 2 ; 21 decl boolean array field variables 2
2<6 + e52 ; 22 decl zone variables zone descr
4<6 + 1 ; 23 decl label points 1
0<6 + 2 ; 24 decl own integer owns 2
0<6 + 4 ; 25 decl own real owns 4
0<6 + 4 ; 26 decl own long owns 4
0<6 + 2 ; 27 decl own boolean owns 2
2<6 + 2 ; 28 decl integer array variables 2
2<6 + 2 ; 29 decl real array variables 2
2<6 + 2 ; 30 decl long array variables 2
2<6 + 2 ; 31 decl boolean array variables 2
2<6 + 4 ; 32 decl zone array variables 4
0 ; 33 end clean not used
0 ; 34 exit block not used
0 ; 35 end external not used
0 ; 36 end bounds not used
0 ; 37 end zone decl not used
0 ; 38 exit proc no type not used
0 ; 39 exit proc type not used
\f
; jz 1979.09.14 algol 8, pass 4, page ...27...
; auxilliary table (2)
; input table content
0 ; 40 begin not used
0 ; 41 begin external not used
0 ; 42 ; not used
0 ; 43 do not used
0 ; 44 then statm not used
0 ; 45 else statm not used
0 ; 46 of statm not used
0 ; 47 end case statm not used
0 ; 48 end spec not used
0 ; 49 case semicolon not used
0 ; 50 end do not used
0 ; 51 end single do not used
; max out of trouble
0 ; 52 end list one not used
0 ; 53 end list more not used
0 ; 54 first comma not used
0 ; 55 not first comma not used
0 ; 56 first point not used
0 ; 57 not first point not used
0 ; 58 zone comma not used
0 ; 59 bound colon not used
0 ; 60 begin list not used
0 ; 61 begin list field not used
0 ; 62 trouble not used
;where to count what
4<6 + 1 ; 63 decl parproc no type points 1
4<6 + 1 ; 64 decl parproc integer points 1
4<6 + 1 ; 65 decl parproc real points 1
4<6 + 1 ; 66 decl parproc long points 1
4<6 + 1 ; 67 decl parproc boolean points 1
4<6 + 1 ; 68 decl switch points 1
4<6 + 1 ; 69 decl proc no type points 1
4<6 + 1 ; 70 decl proc integer points 1
4<6 + 1 ; 71 decl proc real points 1
4<6 + 1 ; 72 decl proc long points 1
4<6 + 1 ; 73 decl proc boolean points 1
4<6 + 1 ; 74 decl proc undef points 1
0 ; 75 spec simple integer not used
0 ; 76 spec simple real not used
0 ; 77 spec simple long not used
0 ; 78 spec simple boolean not used
0 ; 79 spec integer field not used
0 ; 80 spec real field not used
0 ; 81 spec long field not used
0 ; 82 spec boolean field not used
\f
; rc 3.12.1970 algol 6, pass 4, page ...28...
; auxilliary table (3)
; input table content
0 ; 83 spec integer array field not used
0 ; 84 spec real array field not used
0 ; 85 spec long array field not used
0 ; 86 spec boolean array field not used
0 ; 87 spec zone not used
0 ; 88 spec string not used
0 ; 89 spec label not used
0 ; 90 spec value integer not used
0 ; 91 spec value real not used
0 ; 92 spec value long not used
0 ; 93 spec value boolean not used
0 ; 94 spec value integer field not used
0 ; 95 spec value real field not used
0 ; 96 spec value long field not used
0 ; 97 spec value boolean field not used
0 ; 98 spec value integer array field not used
0 ; 99 spec value real array field not used
0 ; 100 spec value long array field not used
0 ; 101 spec value boolean array field not used
68 ; 102 spec integer array output: take array int
69 ; 103 spec real array output: take array real
70 ; 104 spec long array output: take array long
71 ; 105 spec boolean array output: take array boo
; table entries corresponding to the
; following inputbytes are not used
\f
; rc 06.05.71 algol 6, pass 4, page ...29...
; during initialization the store layout is:
; ================
; lowest address: ( pass 4 code )
; ( )
; ( )
; ( )
; ================
; ( pass 4 )
; ( initialization)
; ( code ) <- stack bottom
; ================ -
; ( ) - reference table
; ..... - (1 byte/entry)
; ( ) -
; ================ <- base of interval table
; ( ) - interval table
; ..... - (4 bytes/entry)
; ( ) <- stack top
; ----------------
; ( )
; ( )
; .....
; ( )
; ( )
; ( )
; ( )
; ----------------
; ( ) <- use top
; ..... - std proc table
; ( ) - (13 bytes/entry)
; last work for pass ( ) -
; ================ <- use bottom
\f
; jz 1979.09.26 algol 8, pass 4, page ...30...
w.
h5: rl. w3 e9.+4 ; start pass 4:
rs. w3 f13. ; aux stack top := last work for pass;
al w3 x3-h11 ; max aux stack top := aux stack top - h11;
ls w3 -1 ;
ls w3 1 ; <* max aux stack top is even *>
rs. w3 f14. ; <* h11 is an installation parameter *>
rs. w3 b6. ; usetop := max aux stack top;
al. w1 h8. ; stacktop:= last word pass 4;
jl. w3 e2. ; inbyte;
hs. w2 i11. ; ident lim:= byte;
; the reference table is initialized to zero, indicating that none
; of the identifiers appear in the catalog. reading a standard
; identifier, two things may occur:
; 1. the corresponding reference table element is zero:
; the interval is stored in the interval table, and the
; reference table element is set to the index of the interval
; table. the identifier name and the specifications are stored
; in the standard proc table.
; 2. the reference table element is different from zero:
; the new interval is compared to the interval, outpointed by
; the reference table element. if the new interval is better
; than the other, the old interval is exchanged by the new,
; and the corresponding specifications are exchanged too.
al. w3 a42. ; set return from stack;
al w0 0 ;
a42: al w2 x2-1 ; for i:= 513 step 1 until ident limit do
sl w2 512 ; stack;
jl. g5. ;
so w1 1 ; comment: the interval table must start
jl. w3 g5. ; on an even address;
rs. w1 b20. ; base of interval table:= stacktop;
al w2 0 ;
jl. w3 g15. ; stackbyte in usestack;
; the standard identifiers are read and treated one by one, until
; a zero is met.
a35: jl. w3 e2. ; next std proc suite: w2:= inbyte;
sn w2 0 ; if byte = 0 then
jl. a45. ; goto finish initialization;
hs. w2 i8. ; saved identno:= byte;
al w0 12 ; for w0:= 12 step -1 until 1 do
a36: jl. w3 e2. ; begin
jl. w3 g15. ; w2:= inbyte;
bs. w0 1 ; stackbyte in usestack;
se w0 0 ; end;
jl. a36. ;
al w0 2 ; for w0 := 2 step -1 until 1 do
a46: bs. w0 1 ; begin comment read interval;
jl. w3 e2. ; w2 := inbyte;
rx w2 0 ;
jl. w3 g5. ; stack; comment: used for the next byte...;
jl. w3 g5. ; stack;
al w0 x2 ;
jl. w3 e2. ; w2 := inbyte;
hs w2 x1-1 ; stack(stacktop-1) := byte;
se w0 0 ; end;
jl. a46. ;
i8= k+1 ; saved identno;
al w2 ; w2:= saved identno;
jl. w3 g15. ; stackbyte in usestack;
\f
; jz 1979.10.13 algol 6, pass 4, page ...31...
; at this point, the interval is stacked in the stack, while the
; identifier name and specifications and identno is stacked in
; usestack.
al w2 x2-512 ;
bz w2 5 ; identno:= identno extract 12;
bz. w3 x2+h8. ; if reference table(identno) = 0 then
se w3 0 ; begin
jl. a43. ; comment: this is case 1;
al w3 x1 ; index:= (stacktop -
ws. w3 b20. ; base of interval table)// 4;
ls w3 -2 ; reference table(identno):= index;
hs. w3 x2+h8. ; goto next std proc suite;
jl. a35. ; end;
; case 2. the interval, identifier name, specifications and
; identno are unstacked. (at entry w3 holds the index of the old
; interval).
a43: al w1 x1-4 ; unstack 4 interval bytes;
rx. w1 b22. ;
al w1 x1-4 ;
rx. w1 b22. ;
rx. w1 b6. ; unstack std proc suite;
al w1 x1+13 ;
rx. w1 b6. ;
hs. w3 i8. ; save index in identno;
ls w3 2 ;
wa. w3 b20. ;
al w0 x3 ; w0:= addr of old interval;
dl w3 x3 ; w2w3:= old interval;
al w2 x2+1 ; comment: w2 = upper, w3 = lower;
sh w3 (x1+4) ; if -, new interval is contained
sh w2 (x1+2) ; in old interval then
jl. a35. ; goto next std proc suite;
al w2 x2-1 ; interval.identifier:=
ds w3 (0) ; new interval;
bz. w3 i8. ; w3:= addr of old std proc suite
wm. w3 b19. ; of identifier;
wa. w3 f14. ;
rl. w2 b6. ; w2:= usetop;
bl w0 x2-1 ; specifications.identifier:=
hs w0 x3+11 ; new specifications;
bl w0 x2-2 ;
hs w0 x3+10 ;
bl w0 x2-3 ;
hs w0 x3+9 ;
bl w0 x2-4 ;
hs w0 x3+8 ;
jl. a35. ; goto next std proc suite;
\f
; jz 1979.09.27 algol 8, pass 4, page ...32...
; procedure stackbyte in usestack; the byte in w2 is stacked;
g15: rx. w1 b6. ;
al w1 x1-1 ; usetop:= usetop - 1;
sh. w1 (b6.) ; if usetop <= stacktop then
jl. a12. ; goto stack alarm;
hs w2 x1 ; corebyte(usetop):= w2;
rx. w1 b6. ;
jl x3 ; return;
; the stacks must be initialized. (at entry w2 is zero).
a45: al. w1 h5.-1 ; finish initialization:
rs. w2 b22. ; stacktop:= stackbottom;
al w0 x2 ; words in stack:= 0;
jl. w3 g5. ; stack;
rl. w3 b6. ; top of std proc suite:= usetop;
rs. w3 b19. ;
ls w3 -1 ; usetop:= usetop//2 *2;
ls w3 1 ;
rs. w3 b6. ;
al w2 x3-2 ; initial usetop:= usetop - 2;
rs. w2 h4. ;
ac w3 x3 ; words in usestack:=
wa. w3 f14. ; (max aux stack top - usetop)//2;
ls w3 -1 ;
rs. w3 b23. ;
rl. w0 b21. ; w0:= <useblock stop>;
jl. w3 g7. ; stack in use;
al w0 d25 ; w0:= <end pass>;
am -2047 ;
jl. w3 e3.+2047; outbyte;
am -2047 ;
jl. w3 e2.+2047 ; test end: inbyte;
sn w2 d31 ; if byte <> <end clean> then
jl. a47. ; begin
am -2047
jl. w3 e11.+2047 ; repeat input byte;
jl. a3. ; goto next;
; end;
a47: al w0 d33 ; w0 := <exit block>;
am -2047 ;
jl. w3 e3.+2047 ; outbyte;
al w2 d32 ; w2 := <end block input>;
jl. c36. ; goto exit block;
b20: 0 ; base addr of interval table
h6 = k - e0 ; no of bytes in pass 4;
e30=e30+h6
h7 = h5 - e0 ; entry pass 4 rel to first of pass 4;
h8 = k - 1 ; stackbottom;
i. ; id list
e. ; end pass 4 segment;
m. jz 1981.03.20 algol 8, pass 4
\f
▶EOF◀