|
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: 70656 (0x11400)
Types: TextFile
Names: »algpass03tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass03tx «
; jz.fgs.1987.09.10 algol 8, pass 0, page ...1...
; b. h99 ; fp names; this block head must always
; w. ; be loaded from somewhere, before pass 0 text;
b. e107 ; begin block algol 6 translator;
w. ;
d.
p.<:fpnames:>
l.
;**********************************************************
;* *
;* compiler version, release and date (e103, e104, e105) *
;* *
;* should be updated each time the compiler is updated *
;* *
;**********************************************************
e15 = 0 ; special testoutput;
e18 = h35 ; fp console message;
e22 = h20 ; fp current input zone descriptor (fp = file processor);
e25 = h19 ; fp current program zone descriptor;
e28 = h22 ; fp input block;
e31 = h27 ; fp connect input;
e32 = h7 ; fp end program;
e33 = h26 ; fp outchar;
e34 = h31 ; fp outtext;
e35 = h32 ; fp outinteger;
e37 = h65 ; end fp with break;
e39 = 512 ; segment length of object program;
e43 = h21 ; fp current output zone descriptor;
e44 = h29 ; fp stack zone;
e45 = h30 ; fp unstack zone;
e48 = h0 ; fp start buffer and share description;
e49 = h1 ; fp start process description;
e50 = h2 ; fp start status handling description;
e51 = h3 ; fp start record description of zone;
e52 = h5 ; fp length of zone descriptor;
e53 = h6 ; fp length of share descriptor;
e54 = h4 ; fp start of users parameters; - pass 1 expects h4 to link h3 nb nb
e55 = h54 ; fp lookup area
e57 = h10 ; fp interrupt address;
e58 = h17 ; fp parent description;
\f
; fgs 1986.02.18 algol 8, pass 0, page ...1a...
c. h57<2 ; if system2 then begin
e60 = h52 ; fp first note;
e61 = h53 ; fp last note + 22;
z. ; end system2
c. h57<3 ; if system3 then
e61 = h53 ; fp size of available area in front of zone buffer
z.
e63 = h8 ; fp current command;
e65 = h15 ; fp console description address;
e66 = h16 ; fp own process description address;
e67 = h79 ; fp terminate zone;
e68 = h55 ; fp base program;
e70 = h51 ; fp mode bits
e77 = h57 ; monitor version (may be 2 or 3)
e78 = h28 ; fp connect output
e80 =-12<1+0; standard size and -document for workarea (see fp connect)
; (4 segm for cur.in, 4 for copy, 4 for listing)
e81 = -4<1+0; - - - - - sortarea - - -
e84 = h33 ; fp outend
e86 = -1<1+0; room left for error messages after pass12
e95 = h95 ; fp close up text output
e101= 4 ; no of bytes for anonym. bytes in blocks
e103 = 2 ; version of algol compiler
e104 = 3<12 + 0 ; release of algol compiler
e105 = 1987<12 + 1001 ; date of algol compiler
e106 = 1 ; smallest version number in external accepted by pass9
c. h57<2 ; if system2 then begin
e99 = h10+14 ; fp break routine
e100= 14 ; bytes i reg.dump area
z. ; end else
c. h57<3 ; if system 3 then begin
e99 = h10+h76; fp break routine
e100= h76 ; bytes in reg.dump area
z. ; end system 3
m. algol 6, pass 0 redefine e-names
t.
\f
; fgs 1986.02.18 algol 8, pass 0, page ...1b...
s. c76, d38, f31, h5, j3 ; begin pass 0 segment;
w. ;
k = 10000+e68 ; k has this value to provoke slang test
; of relative byte addresses;
e38: h5 ; length of entire pass 0 (in bytes), translator length;
0 ; dummy word (slang)
jl. d22. ; entry pass 0: goto initialize translator;
e103 ; version of this compiler
\f
; fgs 1985.10.25 algol 6, pass 0, page 2
b. a15, b21 ; begin block: next pass, print char, print text, print integer;
w. ;
b5:f28:0 ; pass no;
b4: 1<21 ; interrupt mask (pass 0);
c7: rl. w0 b4. ; next pass: w0 := interrupt mask(pass 0);
al. w3 d29. ; w3 := interrupt address (pass 0);
jd 1<11 ; set interrupt;
rl. w0 b5. ;
sn. w0 (d7.) ; if pass no = stop pass then
jl. d0. ; goto end translation;
am. (d24.) ;
bz w0 e49+1 ;
se w0 4 ; if kind of translator medium <> 4 then
jl. a2. ; goto next pass from tape;
rl. w1 e38. ; next pass from backing store:
ld w2 -9 ; segment :=
rs. w1 (d21.) ; translator length//512;
ls w2 -15 ; from core := translator length mod 512;
al. w1 c0. ; first core := first free core;
rs. w1 (d27.) ;
al w1 x1+510 ; last core := first core + 510;
rs. w1 (d23.) ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
al. w1 c0. ; to core := first free core;
rl. w0 e38. ;
wa. w0 x2+c0. ; translator length :=
rs. w0 e38. ; translator length + pass length;
rl. w3 x2+c0. ; remaining := pass length;
\f
; rc 28.10.1975 algol 6, pass 0, page 3
a0: sn w3 0 ; move words:
jl. a3. ; if remaining = 0 then goto prepare pass;
sn w2 512 ; if from core = 512 then
jl. a1. ; goto transfer segments;
rl. w0 x2+c0. ; word(to core) :=
rs w0 x1 ; word(first free core + from core);
al w1 x1+2 ; to core := to core + 2;
al w2 x2+2 ; from core := from core + 2;
al w3 x3-2 ; remaining := remaining - 2;
jl. a0. ; goto move words;
a1: al w2 x3-1 ; transfer segments:
ls w2 -9 ;
ls w2 9 ; first core := to core;
al w2 x2+510 ; last core := first core + 510 +
wa w2 2 ; (remaining - 1)//512*512;
rs. w1 (d27.) ;
sl. w2 (f26.) ; if last core >= last work for pass then
jl. a12. ; alarm(<:pass trouble:>);
rs. w2 (d23.) ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
jl. a3. ; goto prepare pass;
a12: jl. w3 d8. ; alarm pass trouble:
al. w3 d14. ; print linehead;
al w2 1 ; set return(break); w2 := 1;
jl. w1 c13. ; writetext(<:pass trouble:>);
<:pass trouble<0>:>;
a2: al. w0 c0. ; next pass from tape:
rs. w0 (d27.) ; first core := first free core;
rl. w0 f26. ;
rs. w0 (d23.) ; last core := last work for pass ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
d28: am. (c0.) ; test pass length; last of pass :=
al. w3 d11. ; first free core + pass length - 1;
se w3 (x1+e51+2) ; if last of pass <> last byte(record) then
jl. a12. ; goto alarm pass trouble;
a3: bz. w0 d6. ; prepare pass:
ls w0 -1 ; pass no :=
rs. w0 b5. ; bits(12,22,second word of pass);
se w0 11 ; if pass no = 11 then
jl. a13. ; begin
jl. c7. ; end;
a13: se w0 12 ; if pass no = 12 then
jl. a15. ; begin
rl. w2 c71. ; if connection mask = 0 then
sn w2 0 ; goto next pass;
jl. c7. ; end;
a15: sh w0 15 ; if pass no > 15 or pass no < 1 then
sh w0 0 ; goto alarm pass trouble;
jl. a12. ;
\f
; fgs 1985.11.04 algol 6, pass 0, page 4
al. w2 c0. ; pass entry :=
bz. w1 d10. ; first free core + bits(0,11,second word of pass);
wa w2 2 ; comment: the address is calculated in
rs. w2 b11. ; this funny way to give a 24-bits
; not negative number;
sn w0 1 ; if passno = 1 then
jl. a9. ; goto update;
rl. w1 f1. ; unused outbuf :=
ws. w1 f0. ; last outaddress -
rs. w1 b8. ; current outaddress ;
c. (:e15 a. 1<0:) - 1 ; if spec testoutput pass0 then
jl. w1 d38. ; begin
rl. w0 b8. ; write (out, curr-, last in and out);
jl. w2 d19. ; write8 (out, unused outbuf);
z. ; end;
jl. w3 c8. ; output segment; <*send the last segment*>
rl. w3 f20. ; saved outsegment :=
rs. w3 b9. ; segment (output descr);
rl. w3 c20. ;
jl. w2 c59. ; wait segment (output); <*check it*>
rl. w3 f13. ; saved insegment :=
es. w3 h0. ; segment (input descr) -
rs. w3 b10. ; increment;
rl. w1 d6. ; if change direction then
ac. w0 (h0.) ; increment :=
sz w1 1 ; - increment;
hs. w0 h0. ; segment (input descr) :=
rl. w0 b9. ; if change direction then
so w1 1 ; (saved outsegment
rl. w0 f13. ; else
es. w0 h0. ; segment (input descr)) -
rs. w0 f13. ; increment ;
jl. w3 d9. ; input segment; <*check and send for the segment*>
rl. w1 f4. ; used segments :=
al w1 x1+1 ; used segments +
rs. w1 f4. ; 1 ;
rl. w1 d6. ;
sz w1 1 ; if change direction then
jl. a4. ; goto change direction;
rl. w0 f3. ; current inaddress :=
rs. w0 f2. ; last inaddress; <*check it at next inbyte*>
jl. a8. ; goto print information;
a4: ; change direction:
jl. w3 d9. ; input segment; <*check in and send for the next*>
rl. w0 f2. ; current in address :=
ws. w0 b8. ; current in address -
es. w0 h0. ; unused outbuf -
rs. w0 f2. ; increment ;
dl. w1 f1. ; w0 := current outaddress;
rs. w1 f0. ; current outaddress := last outaddress;
rs. w0 f1. ; last outaddress := w0;
rl. w0 b10. ; segment (output descr) :=
rs. w0 f20. ; saved insegment;
jl. a8. ; goto print information;
b8: 0 ; unused outbuf ;
b9: 0 ; saved outsegment;
b10: 0 ; saved insegment ;
b11: 0 ; pass entry ;
\f
; jz.fgs 1986.02.18 algol 6, pass 0, page ...5...
e69: ;
d15: al w2 1 ; backing store fault:
ls w2 (0) ;
sn w0 1 ; w2 := 1 shift result;
wa w2 x1 ; if result = 1 then w2 := w2 + statusword;
d14: rs. w2 f9. ; break: sorry := w2;
rs. w3 b12. ; save(address of areaname);
d18: al w2 0 ; finis translation :
rx. w2 f24. ; w2 := message buffer address(byte input);
al. w1 d17. ; w1 := answer address;
se w2 0 ; if w2 <> 0 then
jd 1<11+18 ; wait answer;
al w2 0 ;
rx. w2 f25. ; w2 := message buffer address(byte output);
se w2 0 ; if w2 <> 0 then
jd 1<11+18 ; wait answer;
rl. w2 f9. ; return fp:
al. w1 b21. ; text := addr(<:algol end:>);
rl. w0 c17. ; w0 := modebits;
sn w2 0 ; if -,sorry then
jl. a14. ; goto ok;
al. w3 f23. ; w3 := address(name of output area);
c. e77<3 ; if system 3 then begin
al. w1 b2. ; w1 := tail address;
jd 1<11+42 ; lookup entry (work area);
rl. w1 f4. ; tail(1) := used segments;
rs. w1 b2. ;
al. w1 b2. ; w1 := tail address;
jd 1<11+44 ; change entry (work area);
z. ; end system 3;
al. w1 b13. ; text := addr(<:***algol sorry:>);
a14: rl. w0 e29. ; ok: w0 := modebits;
sz w0 1<7 ; if work area created by pass 0
jd 1<11+48 ; then remove entry;
rl. w0 e29.
jl. w3 c13. ; writetext(string text);
c.e77<3 ; if system 3 then
sz w0 1<10 ; if warning then
al w2 x2+2 ; add warning bit;
z.
c.e77<2 ; if system 2 then
al w3 -1-1<6 ; clear fpwarningbit;
la. w3 e70-k+e38-e68;
sz w0 1<10 ; if warning then
al w3 x3+1<6 ; fpwarningbit := 1;
rs. w3 e70-k+e38-e68;
z.
\f
; fgs 1985.12.18 algol 6,pass 0, page ...5a...
al w0 32 ; writesp;
jl. w3 c12. ;
rl. w0 f4. ; write(<<d>, used segments);
jl. w3 c14. ;
32<12 + 1 ;
al. w3 f23. ; w3 := addr(name of output area);
jd 1<11+64 ; remove process(name of byte input area);
al w0 10 ;
jl. w3 c12. ; writechar(<new line>);
rl. w1 b12. ; w1 := saved address of areaname;
al w3 x1 ;
se w3 0 ; if addr(saved area name) <> 0 then
jd 1<11+64 ; remove process(saved area);
am. (c23.) ;
b1 = k + 1; end program ;
jl e32 ; goto fpbase + end program;
e82:
b12: 0 ; saved name address;
b21: <:<10>algol end<0>:>;
b13: <:<10>***algol sorry<0>:>;
b2: 0, r.10 ; lookup area for change of work area
\f
; fgs 1987.09.11 algol 8, pass 0, page ...5b...
d29: <:algolix<0>:> ; interrupt address:
0, r.4 ; initially name to lookup to
; decide ix default option;
c.e100-16
jl. 2 , r.(:d29.+e100+2:)>1
z.
al. w2 d29. ; interrupt: w2 := interrupt address;
c36: al w0 0 ; interupt service:
rl. w3 c23. ; set interupt
al w3 x3+e57 ; (0,fp-interupt service);
jd 1<11+0 ; w3:=fpbase+
al w1 x2+e100-1 ; fp-interupt;
a6: rl w0 x2 ; move next: w0 := word(w2);
rs w0 x3 ; word(w1+fp interrupt address) := w0;
al w3 x3+2 ; w1 := w1+2;
al w2 x2+2 ; w2 := w2+2;
sh w2 x1 ; if w1 <= interrupt address + (breaksize-1) then
jl. a6. ; goto move next;
c. e77<3 ; if system3 then begin
rl. w3 c23. ; w3 := fp base;
am (x3+e57+10); if break instruction = ks
bl w0 -2 ; then enter fp break routine
h. sn w0, ks w. ; comment if fp is not present
jl x3+e99 ; a break will happen
z.
al w1 e99 ;
hs. w1 b1. ; end program := fp break;
jl. w3 d5. ; print line;
al w2 1 ; w2 := 1;
al w3 0 ; addr(area name) := 0;
jl. d14. ; goto break;
\f
; fgs 1985.10.30 algol 6, pass 0, page ...6...
d0: al. w0 d18. ; end translation:
rs. w0 b11. ; pass entry := finis translation;
a8: rl. w0 c17. ; print information:
am. (b5.) ;
se w3 x3 ; if pass no = 0
so w0 1<2 ; or -,survey then
jl. a9. ; goto update;
jl. w3 d8. ; print linehead;
rl. w0 f10. ;
jl. w2 d19. ; write(8,sum 0);
rl. w0 f11. ;
jl. w2 d19. ; write(8,sum 1);
rl. w0 f4. ;
jl. w2 d20. ; write(4,used segments);
rl. w0 c9. ;
jl. w2 d20. ; write(4, inf 1);
rl. w0 f16. ;
jl. w2 d20. ; write(4,inf 2);
a9: ; update:
c. (:e15 a. 1<0:) - 1 ; if spec testoutput pass0 then
jl. w1 d38. ; write (out, curr-, last in and out);
z. ;
am. (c23.) ;
jl w3 e84-6 ; outend;
rl. w0 b14. ;
rl. w1 b5. ; outside pass interval := false;
rs. w1 f31. ; pass := pass no;
dl. w3 c18. ;
sl w1 x2 ; if pass no < lower pass no
sl w1 x3+1 ; or pass no > upper pass no
rl. w0 b15. ; then outside pass interval := true;
d3: rs. w0 j1. ; comment: see carret;
al w0 1 ; w0 := 1;
bl. w3 h0. ;
rl. w2 d6. ; if backward pass then
se w3 -1 ; begin
jl. a11. ; w0 := old linecounter;
rl. w0 b16. ; if change direction then
sz w2 1 ; w0 := linecounter
rl. w0 f8. ; end;
a11: rs. w0 b16. ; old linecounter := w0;
bs. w0 h0. ; w0 := w0 - increment;
rs. w0 f8. ; linecounter := w0;
al w0 0 ;
rs. w0 f14. ; linecounter 1 := 0;
rs. w0 c9. ; inf 1 := 0;
rs. w0 f16. ; inf 2 := 0;
al w0 -1-1<5 ;
la. w0 c17. ;
rs. w0 c17. ; testoutput := false;
jl. w3 c1. ; carret; comment: to test lineinterval;
rl. w0 f0. ;
bs. w0 h0. ; current outaddress :=
rs. w0 f0. ; current outaddress - increment;
jl. (b11.) ; goto word(pass entry);
b14: jl. h1 ; outside pass interval = false;
b15: rx. w1 h2 ; outside pass interval = true;
b16: 0 ; old linecounter;
\f
; rc 25.3.1969 algol 6, pass 0, page 7
d19: am 4 ; write(8,w0):
d20: al w1 4 ; write(4,w0):
hs. w1 a10. ; set positions in layout;
rx. w0 b17. ; swap(w0,space);
jl. w3 c12. ; writechar;
rx. w0 b17. ; swap(w0,space);
jl. w3 c14. ; writeinteger;
a10 = k + 1 ; digits ;
32<12 ;
jl x2 ; return;
b17: 32 ; space ;
c12: ds. w1 b18. ; printchar:
ds. w3 b19. ; save(w0,w1,w2,w3);
rl w2 0 ; w2 := w0;
am. (c23.) ;
jl w3 e33-2 ; outchar; comment: fp current output;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3 ; return;
c13: ds. w1 b18. ; print text:
ds. w3 b19. ; save(w0,w1,w2,w3);
al w0 x1 ; w0 := w1;
am. (c23.) ;
jl w3 e34-2 ; outtext; comment fp current output;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3 ; return;
c14: ds. w1 b18. ; print integer:
ds. w3 b19. ; save(w0,w1,w2,w3);
rl w2 x3 ;
rs. w2 b20. ; layout := word(return);
am. (c23.) ;
jl w3 e35-2 ; outinteger; comment fp current output;
b20: 0 ; layout ;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3+2 ; return;
0 ; saved w0 ;
b18: 0 ; saved w1 ;
0 ; saved w2 ;
b19: 0 ; saved w3 ;
e. ; end block: next pass, print char, print text, print integer;
\f
; rc 8.4.1969 algol 6, pass 0, page 8
b. a1, b12 ; begin block: test line, byte sums,
w. ; print linehead, print w0, print line;
d1: ds. w3 b3. ; test line:
rx. w0 c17. ; save(w2,w3);
lo. w0 b1. ; testoutput := true;
dl. w3 c19. ; comment: carret sets w1 = linecounter;
sl w1 x2 ; if linecounter < lower line no
sl w1 x3+1 ; or linecounter > upper line no
bs. w0 b0. ; then testoutput := false;
rx. w0 c17. ; comment: testoutput = modebit(18);
rl. w2 b2. ; restore(w2);
rx. w1 f8. ; swap(linecounter,w1); comment see j1;
jl. (b3.) ; return;
d2: ds. w0 b3. ; byte sums:
bz w3 1 ;
am. (f10.) ; comment: the instruction al w3 x3
al w3 x3 ; is used to avoid integer overflow;
rs. w3 f10. ; sum 0 := sum 0 + right(w0);
am. (f11.) ; sum 1 := sum 0 + sum 1;
al w3 x3 ;
rs. w3 f11. ;
rl. w0 b3. ; restore(w0);
rl. w3 c17. ;
b0 = k+1 ; 1<5 ;
sz w3 1<5 ; if testoutput then
jl. w3 c16. ; print w0;
rl. w3 b2. ; restore(w3);
rx. w2 f0. ; swap(current outaddress,w2);
jl. d16. ; goto test outaddress;
b1: 1<5 ;
b2: 0 ; saved w
b3: 0 ; saved w
d8: ds. w1 b4. ; print linehead:
rs. w3 b5. ; save(w0,w1,w3);
al w0 10 ;
rs. w0 f15. ; printcount := 10;
jl. w3 c12. ; writechar(<new line>);
al. w1 b10. ; w1 := address(<: :>);
rl. w0 f31. ;
sh w0 -1 ; if pass no > -1 then
jl. a0. ; begin
jl. w3 c14. ; writeinteger(<:dd:>,pass no);
32<12 + 2 ; w1 := address(<:. :>)
al. w1 f12. ; end;
a0: jl. w3 c13. ; writetext;
al w0 -1 ; pass no := -1;
rs. w0 f31. ;
dl. w1 b4. ; restore(w0,w1);
jl. (b5.) ; return;
0 ; saved w0 ;
b4: 0 ; saved w1 ;
b5: 0 ; saved w3 ;
b10: <: :> ;
f12: <:. :> ;
f10: 0 ; sum 0 ;
f11: 0 ; sum 1 ;
f31: 0 ; pass ;
\f
; rc 24.3.1969 algol 6, pass 0, page 9
c16: ds. w0 b7. ; print w0:
rl. w3 f8. ; save(w0,w3);
se. w3 (f14.) ; if linecounter <> linecounter 1 then
jl. w3 d5. ; print line;
rl. w3 f15. ;
al w3 x3+1 ; printcount := printcount + 1;
sh w3 9 ; if printcount > 9 then
jl. a1. ; begin
jl. w3 d8. ; print linehead;
al w3 0 ; printcount := 0;
a1: rs. w3 f15. ; end;
bz w0 1 ; byte := right(w0);
jl. w3 c14. ; writeinteger(<:ddddd:>,w0);
32<12+5 ;
rl. w0 b7. ; restore(w0);
jl. (b6.) ; return;
b6: 0 ; saved w3 ;
b7: 0 ; saved w0 ;
d5: rs. w3 b9. ; print line:
rs. w1 b8. ; save(w1,w3);
jl. w3 d8. ; print linehead;
al. w1 b11. ;
jl. w3 c13. ; writetext(<:line:>);
jl. w3 c27. ; print linecount;
al. w1 b12. ;
jl. w3 c13. ; writetext(<:<32><32>:>);
rl. w3 f8. ;
rs. w3 f14. ; linecounter 1 := linecounter;
rl. w1 b8. ; restore(w1);
jl. (b9.) ; return;
b8: 0 ; saved w1 ;
b9: 0 ; saved w3 ;
b12: <:<32><32>:> ;
f14: 0 ; linecounter 1;
b11: <:line<0>:> ;
e. ; end block: test line, bytesums, print linehead, printw0, print line;
\f
; fgs 1985.10.25 algol 6, pass 0, page 10
; procedure wait segment(i/o description);
; if message buffer address = 0, the function is empty; otherwise
; a wait answer is performed, defined by message buffer address,
; segment is increased by increment and (first core,last core) and
; (other first core, other last core) are exchanged;
; call: w3 := description address; jl. w2 d12. ;
; exit: all registers unchanged;
b. a3, b0 ; begin block: wait segment;
w. ;
c59: ;
d12: am (x3+22) ; wait segment:
sn w3 x3 ; if message buffer address = 0 then
jl x2 ; return;
ds. w1 b0. ; save(w0,w1);
rx w2 x3+22 ; swap(w2,message buffer address);
a1: al. w1 d17. ; repeat: w1 := answer address;
jd 1<11+18 ; wait answer;
al w2 0 ; w2 := 0;
sn w2 (x1) ; if status word <> 0
se w0 1 ; or result <> 1 then
jl. a0. ; goto bad answer;
c. (:e15 a. 1<0:) - 1 ; if special test output pass0 then
b. a1 ; begin
w. ;
rs. w1 a1. ; save w1;
jl. w1 d37. ; write pass0 testoutput (<:wait:>);
jl. a0. ; continue;
<:<10> wait <0>:> ;
a0: rl. w1 a1. ; restore w1;
jl. a3. ; continue;
a1: 0 ; saved w1
e. ; end block testoutput;
z.
a3: am (x1+2) ; if bytes transferred = 0 then
se w3 x3 ; begin
jl. a2. ; w1 := message address;
al w1 x3+10 ; send message;
jd 1<11+16 ; goto repeat;
jl. a1. ; end;
a2: rx w2 x3+22 ; swap(w2,message buffer address);
dl w1 x3+20 ;
rx w0 x3+12 ; swap(first core, other first core);
rx w1 x3+14 ; swap(last core, other last core);
ds w1 x3+20 ;
rl w0 x3+16 ;
ba. w0 h0. ; segment := segment + increment;
sh w0 -1 ; if segment <= -1 then
wa. w0 f5. ; segment := segment + available segments;
sl. w0 (f5.) ; if segment >= available segments then
ws. w0 f5. ; segment := segment - available segments;
rs w0 x3+16 ;
dl. w1 b0. ; restore(w0,w1);
jl x2 ; return;
a0: rs w2 x3+22 ; bad answer: message buffer address := 0;
jl. d15. ; goto backing store fault;
d17: 0,0,0,0,0,0,0,0 ; answer;
0 ; saved w0 ;
b0: 0 ; saved w1 ;
e. ; end wait segment ;
\f
; fgs 1985.10.25 algol 6, pass 0, page 11
b. a2, b3 ; begin block: next segment;
w. ;
d4: ds. w2 b2. ; next segment: save(w1,w2);
rs w3 x2+10 ; last address := w3;
rl w3 x2+12 ; w3 := address of i/o description;
rl. w2 f4. ;
wa w2 x3+24 ; used segments :=
rs. w2 f4. ; used segments + segment increment;
sh. w2 (f5.) ; if used segments > available segments then
jl. a0. ; begin comment: work area exceeded;
al. w1 b0. ; w1 := address of alarm text;
jl. c5. ; alarm(<:program too big:>)
; end;
a0: jl. w2 d12. ; wait segment;
al w1 x3+10 ; w1 := message address;
jd 1<11+16 ; send message;
rs w2 x3+22 ; address of message buffer := w2;
c. (:e15 a. 1<0:) - 1 ; if special testoutput pass 0 then
b. a1 ; begin
w. ;
rs. w1 a1. ; save w1;
jl. w1 d37. ; write test (<:send:>);
jl. a0. ; continue;
<:<10> send <0>:> ;
a0: rl. w1 a1. ; restore w1;
jl. a2. ; continue;
a1: 0 ; saved w1;
e. ; end;
z. ;
a2: bl. w1 h0. ; w2 := other first core;
dl w3 x3+20 ; w3 := other last core;
lo. w3 b3. ; w3 := w3 or boolean 1 ; comment: odd address;
sn w1 -1 ; if increment = -1 then
rx w2 6 ; swap(w2,w3); comment: backward pass;
am. (b2.) ;
rx w3 10 ; swap(w3,last address);
rl. w1 b1. ; restore(w1);
am. (b2.) ; return address := return address + 2;
jl 2 ; return;
b0: <:program too big<0>:> ;
b1: 0 ; saved w1 ;
b2: 0 ; saved w2 ;
b3: 1 ; boolean 1 ;
e. ; end block: next segment;
\f
; fgs 1985.10.30 algol 8, pass 0, page ...11a...
c. (:e15 a. 1<0:) - 1 ; if special testoutput pass0 then
b. a7 ; begin block testoutput
w. ;
d37: ds. w1 a1. ; procedure write (out, segment, first, last);
ds. w3 a3. ; begin
al w1 x1+2 ; w0 := addr text from call;
jl. w3 c13. ; outtext (out, text);
am. (a3.) ;
zl w0 +10 ;
al. w1 a4. ;
se w0 3 ; if input then
al. w1 a5. ; outtext (out, <:in:>
jl. w3 c13. ; else
am. (a3.) ; outtext (out, <:out:>);
rl w0 +16 ;
jl. w3 c14. ; outinteger (out, segment);
32<12+5 ;
am. (a3.) ;
rl w0 +12 ;
jl. w3 c14. ; outinteger (out, first);
32<12+10 ;
am. (a3.) ;
rl w0 +14 ;
jl. w3 c14. ; outinteger (out, last);
32<12+10 ;
dl. w1 a1. ;
dl. w3 a3. ;
jl x1 ; end procedure write (out, segment, first, last);
d38: ds. w1 a1. ; procedure write (out, curr-, last- in and out);
ds. w3 a3. ; save registers;
al. w1 a6. ;
jl. w3 c13. ; write (out, text1);
rl. w0 f2. ;
jl. w2 d19. ; write8 (out, current in);
rl. w0 f3. ;
jl. w2 d19. ; write8 (out, last in);
al. w1 a7. ;
jl. w3 c13. ; write (out, text2);
rl. w0 f0. ;
jl. w2 d19. ; write8 (out, curr out);
rl. w0 f1. ;
jl. w2 d19. ; write8 (out, last out);
dl. w1 a1. ;
dl. w3 a3. ;
jl x1 ; end procedure write (out, curr-, last in and out);
a0: 0 ; saved w0 ;
a1: 0 ; saved w1 ;
a2: 0 ; saved w2 ;
a3: 0 ; saved w3 ;
a4: <: in <0>:> ;
a5: <: out <0>:> ;
a6: <:<10>curr-, last in <0>:>
a7: <:<10>curr-, last out <0>:>
e. ; end block testoutput
z. ;
\f
; fgs 1985.10.25 algol 6, pass 0, page 12
; byte input description:
f22: 0,0,0,0,0 ; 0 name and name table address;
3<12 ; 10 operation = input;
f6: 0 ; 12 first core;
f7: 0 ; 14 last core;
f13: 1 ; 16 segment;
0 ; 18 other first core;
f17: 0 ; 20 other last core;
f24: 0 ; 22 message buffer address;
-1 ; 24 segment increment;
; byte output description:
f23: 0,0,0,0,0 ; 0 name and name table address;
5<12 ; 10 operation = output;
f18: 0 ; 12 first core;
f19: 0 ; 14 last core;
f20: 0 ; 16 segment;
0 ; 18 other first core;
f21: 0 ; 20 other last core;
f25: 0 ; 22 message buffer address;
1 ; 24 segment increment;
e79 = f23 ; addr of pass 0 work area name
; pass 0 key variables:
d7 : 9 ; stop pass;
d21: 0 ; abs address of segment (program process descriptor (16));
d27: 0 ; abs address of first core (program share descriptor ( 2));
d23: 0 ; abs address of last core (program share descriptor (10));
d24: 0 ; abs address of program zone descriptor ;
\f
; fgs 1986.02.18 algol 6, pass 0, page ...13...
; the official pass 0 - entries (i.e. references using e-names)
; are found in the following (resident) part of pass 0;
e71:c71: 0 ; pass12-parameters : connection mask;
e72:c72: 0 ; first line;
e73:c73: 0 ; last line;
e74:c74: 0 ; first name line;
e75:c75: 0 ; last name line;
e76:c76: 0 , r.5 ; sortareaname and address;
e107: <:algftnrts<0>:>; name of runtime system
0 ; name table addr
b. b2 ; begin block: carret, alarm, message, repeat
w. ; input byte, outbyte, inbyte, print linecount;
; procedure carret;
; the routine increases the linecounter by increment; if then
; the linecounter belongs to lineinterval and pass no belongs to
; passinterval, the boolean testoutput is set to true, otherwise
; it is set to false;
; call: jl. w3 e1. ;
; exit: w0,w1,w2 unchanged;
c1: ;
e1: rx. w1 f8. ; carret:
ba. w1 h0. ; linecounter :=
j1: rx. w1 f8. ; linecounter + increment;
jl x3 ; if outside passinterval then return
; else goto test line;
h1 = d1 - j1 ; comment : see d3, where j1: rx. w1 f8. is modif;
; procedure message;
; the routine prints the string: <linehead>line<linecounter><text>;
; call: w1 := address of <text>; jl. w3 e4. ;
; exit: w0,w1,w2 unchanged ;
; procedure alarm;
; the routine works as message, but terminates the translation;
; call: w1 := address of <text>; jl. e5. ;
c5: ;
e5: al w3 1 ; alarm:
rs. w3 f9. ; sorry := 1;
al. w3 d0. ; set return(end translation);
c4: ;
e4: rs. w3 b0. ; message: save(return);
jl. w3 d5. ; print line;
jl. w3 c13. ; writetext;
jl. (b0.) ; return;
b0: 0 ; saved return ;
; procedure repeat input byte;
; the routine decreases current inaddress by increment;
; call: jl. w3 e11. ;
; exit: w0,w1,w2 unchanged;
c11: ;
e11: rx. w3 f2. ; repeat input byte:
bs. w3 h0. ; current inaddress :=
rx. w3 f2. ; current inaddress - increment;
jl x3 ; return;
\f
; fgs.jz 1986.02.18 algol 8, pass 0, page ...14...
; procedure outbyte;
; the routine outputs the rightmost byte of w0 to work; if pass infor-
; mation (survey) is wanted, then sum and double sum of all bytes
; are calculated; if pass no belongs to pass interval and linecounter
; belongs to lineinterval, then the byte is printed also;
; call: w0 := byte to be output; jl. w3 e3. ;
; exit: w0,w1,w2 unchanged;
e3: c3: ;
j0: rx. w2 f0. ; outbyte: if passinf then goto byte sums
; jl. d2. ; else swap(w2,current outaddress);
d16: sn. w2 (f1.) ; test outaddress:
e8:c8:jl. w2 d4. ; if current outaddress = last outaddress then
h0 = k+1 ; increment ; output segment: next segment; comment see below;
al w2 x2+1 ; w2 := w2 + increment;
hs w0 x2 ; return from next segment: byte(w2) := right(w0);
rx. w2 f0. ; swap(w2,current outaddress);
jl x3 ; return;
f0: 0 ; e20-4 ; current outaddress;
f1: 0 ; e20-2 ; last outaddress; warning: next segment uses x2+10;
e20:c20:0; ; output description; warning: - - - x2+12;
h3 = d2 - j0 ;
; procedure inbyte;
; the routine supplies the next byte from work;
; call: jl. w3 e2. ;
; exit: w2 = inputbyte; left(w2) = 0; w0,w1 unchanged;
c2: ;
e2: rl. w2 f2. ; inbyte:
sn. w2 (f3.) ; if current inaddress = last inaddress then
e90:
d9: jl. w2 d4. ; input segment: next segment; comment: see below;
ba. w2 h0. ; current inaddress := current inaddress + increment;
rs. w2 f2. ; return from next segment:
bz w2 x2 ; w2 := byte zeroes(current inaddress);
jl x3 ; return;
f2: 0 ; e21-4 ; current inaddress;
f3: 0 ; e21-2 ; last inaddress; warning: next segment uses x2+10;
e21:c21:0; ; input description; warning: - - - x2+12;
; procedure print linecount;
; the routine prints the integer linecount;
; call: jl. w3 e27. ;
; exit: w0,w1,w2 unchanged;
e64: 10 ; bossline
c27: ;
e27: ds. w0 b2. ; print linecount:
rl. w0 f28. ;
se w0 1 ; if pass=1 then
jl. c6. ; begin
j2=k+1
al w0 0 ; bossline.no
; al w0 1 ; bossline.yes
sn w0 0 ;
jl. c10. ; if bossline.yes then
rl. w0 e64. ; then write(out,bossline);
jl. w3 c14. ;
32<12+6 ;
c10:
j3=k+1
al w0 0 ; blocks.no
; al w0 1 ; blocks.yes
sn w0 0 ;
jl. c6. ; if blocks.yes then
rl. w0 e85. ; write(out,begincount);
jl. w3 c14. ;
32<12+3 ; end;
c6: rl. w0 f8. ; save(w0,w3);
jl. w3 c14. ; w0 := linecounter;
32<12+6 ; writeinteger(<:ddddd:>,w0);
rl. w0 b2. ; restore(w0);
jl. (b1.) ; return;
b1: 0 ; saved w3 ;
b2: 0 ; saved w0 ;
e. ; end block: carret, alarm, message, repeat input byte,
; outbyte, inbyte, print linecount;
\f
; fgs 1986.02.18 algol 6, pass 0, page ...15...
h2 = k - j1 ;
e6: f8: 0 ; linecount;
e7: jl. c7. ; end pass: goto next pass;
f4: 0 ; e9-4 used segments;
f5: 0 ; e9-2 available segments;
e9: c9: 0 ; e9 inf 1 (pass information);
f16: 0 ; e9+2 inf 2 (pass information);
f26: 0 ; e9+4 last work for pass;
0 ; e9+6 contextmode(0 or 1, used by pass 1 and 2)
e10: <:stack:> ; alarm text;
e12: jl. c12. ; writechar: goto printchar;
e13: jl. c13. ; writetext: goto printtext;
e14: jl. c14. ; writeinteger: goto printinteger;
e16: jl. c16. ; print byte: goto print w0;
e17:c17: 1<13+1<12+1<8+1<3+1<1 ; modebits1 : fp-, connect-, index-, message.yes
e29: 0<10+0<5 ; modebits2 : warning-, fortran.no
0 ; e19-6 lower pass no in passinterval;
c18: 0 ; e19-4 upper pass no in passinterval;
1 ; e19-2 lower line no in lineinterval;
e19:c19: 1<22 ; e19 upper line no in lineinterval;
jl. d8. ; e19+2 goto print linehead;
e23:c23: 0 ; fileprocessor base;
e24: 0 ; fileprocessor result note;
e26: jl. d0. ; terminate translation: goto end translation;
e36: jl. c36. ; interrupt from passes: goto interrupt service;
e40:f9: 0 ; sorry (answer to fileprocessor);
e41: 1<21 ; interrupt mask (pass 7, object code);
e42:f15: 0 ; printcount;
e46: 0 ; start source name list (pass 1);
e47: 0 ; start insert list;
e56: 0<7+0<6+0<3+0<2+0<1+1<0; modechange allowed (1<7 for xref)
e59: jl. c59. ; wait segment: goto wait segment;
e62:d13: 0 ; abs address of entry inblock (fileprocessor entry);
e83: 0 ; max no of copy params (for pass 1)
e102=f11 ; double(sum1,sum2)
e0 = k, c0 = k ; the current pass will be loaded here:
d11 = c0 - 1 ;
d10 = c0 + 2 ;
d6 = c0 + 3 ;
; first free core:
m. algol 6, pass 0 resident
\f
; fgs 1987.09.11 algol 8, pass 0, page ...16...
b. a60, b40 ; begin block: initialize translator;
w. ;
b0: -2 ; after use reused for result of lookup algolix (fixed ix default)
b1: 0 ; top command (address of the command algol);
d22: rs. w1 c23. ; initialize translator:
la. w3 b0. ; fpbase := w1;
rs. w3 b1. ; top command := w3 and -2; comment: even address;
rl. w0 e41. ; w0 := interrupt mask (1 shift 21);
al. w3 d29. ; w3 := interrupt address (pass 0);
jd 1<11 ; set interrupt;
am. (c23.) ; w1 :=
al w1 e55 ; addr fp lookup area;
al. w3 d29. ; w3 := addr name (interrupt address really);
jd 1<11+42 ; lookup tail;
rs. w0 b0. ; fixed default := result;
rl. w3 b1. ; restore w3;
bz w0 x3 ;
al. w2 f22. ; w2 := address of dummy name;
se w0 6 ; if command algol not preceded by <=> then
jl. a1. ; goto no result area;
am. (c23.)
al w1 e55 ; w1:=lookup area
al w3 x3-8 ;
jd 1<11+42 ; lookup outfil
b.j2,w.
se w0 0 ;
jl. j1. ; if found
rl w2 x1 ; and
sl w2 0 ; not bs
jl. j2. ;
bz w2 x1+1 ;
se w2 4 ;
jl. a4. ; then alarm;
j2: rs w0 x1+12 ; clear tail(12:18);
rs w0 x1+14
rs w0 x1+16 ;
rs w0 x1+18 ;
jd 1<11+44 ; change entry;
j1:
e.
al w2 x3 ; w2 := address of result area name or note;
c. e77<2 ; if system 2 then begin
rl w0 x2 ; w0 := first word of name;
al w3 x1+e60+4 ; w3 := address of document name(first fp note);
a0: sn w0 (x3-4) ; may be next note:
jl. a2. ; if w0 = name of current note then
; goto get work area;
al w3 x3+22 ; current note := current note + 1; w3 := w3 + 22;
sh w3 x1+e61 ; if current note <= last fp note then
jl. a0. ; goto may be next note;
z. ; end system 2;
a1: al w0 -1-1<8 ; no result area:
la. w0 c17. ;
rs. w0 c17. ; note supplied by fp := false;
al w3 x2 ; w3 := w2;
a2: al w0 x3-4 ; get work area:
rs. w0 e24. ; save address(result note);
al w2 x3 ; w2 := addr of name;
rl w0 x2 ; w0 := first part of name;
se w0 0 ; if w0 = 0 then
jl. a3. ; begin
al w0 1<7 ; work area created by pass 0 := true;
lo. w0 c17. ;
rs. w0 c17. ;
c. e77<2 ; if system 2 then begin
al. w1 d25. ; w1 := tail address;
jd 1<11+40 ; create entry (work name);
se w0 0 ; if result <> 0 then goto error;
jl. a4. ; end;
z. ; end system 2;
\f
;rc 76.06.28 algol 6, pass 0, page ...16a...
a3: al w1 0 ; comment: no zone;
al w0 e80 ; comment: take standard actions for workarea;
am. (c23.) ;
jl w3 +e78 ; connect output;
se w0 0 ; if connect trouble then goto error;
jl. a4. ;
dl w1 x2+4 ; move name of workarea to
ds. w1 f22.+2 ; name parts of
ds. w1 f23.+2 ; byte i-o descriptions;
dl w1 x2+8 ;
ds. w1 f22.+6 ;
ds. w1 f23.+6 ;
al w3 x2+2 ; process description(work area);
jd 1<11+8 ; reserve process(workarea);
jd 1<11+4 ;
se w0 0 ; if process does not exist then
jl. a5. ; begin
a4: al w2 1 ; error: w2 := error, other reason;
al. w3 d14. ; set return (break);
jl. w1 c13. ; outtext (<:***algol object area:>);
<:***algol object area<10><0>:> ;
; end;
a5: am (0) ; comment: find number of segments
rl w1 +18 ; in area process;
rs. w1 f5. ; available segments := number of segments;
\f
; fgs 1987.09.10 algol 6, pass 0, page 17
am. (b1.) ; w2 := other last core(output) :=
al w2 -8 ; top command - 8;
al w1 x2-510 ; w1 := other first core(output) := w2-510;
ds. w2 f21. ;
al w1 x1-512 ; w1 := w1-512;
al w2 x1+510 ; w2 := w1+510;
ds. w2 f19. ; first core(output) := w1;
al w2 x2+1 ; last core(output) := w2;
ds. w2 f1. ; current outaddress := w1;
al w1 x1-512 ; last outaddress := w2 + 1;
al w2 x1+510 ; w1 := w1-512; w2 := w1+510;
ds. w2 f17. ; other first core(input) := w1;
al w1 x1-512 ; other last core(input) := w2;
al w2 x1+510 ; w1 := w1-512; w2 := w1+510;
ds. w2 f7. ; first core(input) := w1;
al w2 x2+1 ; last core(input) := w2;
ds. w2 f3. ; current inaddress := w1;
al w1 x1-2 ; last inaddress := w2+1;
rs. w1 c9.+4 ; last work for pass := w1-2;
sl. w1 c0.+512 ; if last work for pass < first free core + 512 then
jl. a31. ; begin
al. w3 d14. ; set return(break);
al w2 1 ; w2 := 1;
jl. w1 c13. ; writetext(<:***pass trouble:>);
<:<10>***pass trouble<0>:> ;
; end;
a31: al. w0 f23. ;
rs. w0 c20. ; set address of byte output description;
al. w0 f22. ;
rs. w0 c21. ; set address of byte input description;
rl. w2 b1. ; command point := top command;
al w2 x2-4 ; top source list :=
rs. w2 b6. ; start source name list :=
rs. w2 e46. ; top command -4;
al w2 x2-2 ; top command :=
rx. w2 b1. ; top command - 6;
al. w0 b36. ; top copy list:=
rs. w0 b7. ; work area;
rl. w0 b0. ;
se w0 0 ; if not fixed ix default then
jl. a50. ; begin <*produce default from cpu*>
al w0 1 ; w0 :=
ls w0 15 ; 1<15 <*mode.ix*> or
lo. w0 c17. ; modeword1;
gg w1 34 ;
sl w1 60 ; if cpu identification >= 60 then
rs. w0 c17. ; modeword1 := w0;
; end;
a50: jl. w3 a21. ; scan: nextparam;
bl w1 x2 ;
sh w1 3 ; if endparam then
jl. a55. ; goto finisscan;
rl w1 x2 ; if param<>spacename
se. w1 (b12.) ; then goto scan;
jl. a50. ;
se. w3 (b26.) ; if nextparam<>pointname
jl. a50. ; then goto scan;
al. w1 b39. ; search option in group2 and 3:
a51: sl. w1 b15. ; nextoption: if not found then
jl. a50. ; goto scan;
al w1 x1+12 ; w1:=option addr;
dl w0 x1+2 ; w3w0:=optionname;
sn w0 (x2+4) ; if param1<>
se w3 (x2+2) ; option1 then
jl. a51. ; goto nextoption;
\f
; rc 1975.01.15 algol 6, pass 0, page 17a
dl w0 x1+6 ; if param2<>
sn w0 (x2+8) ; option2 then
se w3 (x2+6) ; goto nextoption;
jl. a51. ;
jl. w3 a21. ; next param;
rl w3 x2+4 ;
se w3 0 ; if param2<>0 then
jl. a50. ; goto scan;
rl w3 x2+2 ;
se. w3 (b4.) ; if -,(param=yes
sn. w3 (b5.) ; or param=no) then
se w3 x3 ;
jl. a50. ; goto scan;
ac w0 (x1+10) ; if yesor no then
bs. w0 1 ; modechange not allowed;
la. w0 e56. ;
rs. w0 e56. ;
rl w0 x2+2 ;
se. w0 (b4.) ; if param=no then
jl. a52. ; goto no;
rl. w0 c17. ; modebit:=
lo w0 x1+10 ; modebit
rs. w0 c17. ; or optionbit;
jl. a50. ; goto scan;
a52: ac w0 (x1+10) ; no:
bs. w0 1 ; modebit:=
la. w0 c17. ; modebit
rs. w0 c17. ; and -,optionbit;
jl. a50. ; goto scan;
b32: <:on:> ;
b33: <:off:> ;
b34: 1<0 ; listbit
a55: rl. w1 e56. ; finisscan:
so w1 1<0 ;
jl. a56. ; if listchange allowed then
rl. w0 c17. ;
am e70-e68 ; begin
rl. w1 e38. ; if fp mode.listing then
lo. w0 b34. ;
sz w1 1<8 ; modebits:=modebits or 1;;
rs. w0 c17. ; end;
a56: rl. w2 b1. ; restore w2
al w2 x2+6 ;
a6: am. (c23.) ; scan parameter list:
rs w2 e63 ; fp current command := command point;
jl. w3 a21. ; next param;
bl w1 x2 ;
sh w1 3 ; if preceding delimiter < 4 then
jl. a22. ; goto end parameters;
rl w1 x2 ;
sn. w1 (b12.) ; if parameter = (space, name) then
jl. a26. ; goto test name;
\f
; rc 1975.01.15 algol 6, pass 0, page 18
b2 = k+1 ; alarm state ; alarm next:
a27: se w3 x3 ; if alarm state then
jl. a25. ; goto list parameter;
al. w1 b8. ;
hs. w1 b2. ; alarm state := true;
jl. w3 c13. ; writetext(<:algol param:>);
a25: bz w1 x2 ; list parameter:
al. w1 x1+b13. ;
jl. w3 c13. ; writetext(delimiter table(delimiter));
al. w3 a6. ; set return(scan parameter list);
bz w0 x2+1 ;
al w1 x2+2 ; w1 := address(param);
se w0 4 ; if param is name then
jl. c13. ; goto writetext;
rl w0 x2+2 ; w0 := param;
jl. w3 c14. ; writeinteger(<space>,1);
32<12+1 ;
jl. a6. ; goto scan parameter list;
a26: al w1 0 ; test name:
hs. w1 b2. ; alarm state := false;
bz w1 6 ;
al w0 0 ; file:=0;
sn w1 4 ; if following delimiter = <space> then
jl. a19. ; goto source list;
se w1 8 ; if following delimiter <> point then
jl. a27. ; goto alarm next;
a7: al. w1 b14. ; search option table: entry := base option table;
a8: sl. w1 b15. ; next option:
jl. a20. ; if entry >= last of options then
al w1 x1+12 ; goto maybe source;
dl w0 x1+2 ; entry := entry + 12;
sn w0 (x2+4) ; comment: an entry in the option
se w3 (x2+2) ; table consists of:
jl. a8. ; 0 - 7 : name of option.
dl w0 x1+6 ; 8 - 9 : action on integer, action on name
sn w0 (x2+8) ; 10 - 11: modebits to set;
se w3 (x2+6) ; if param <> option name(entry) then
jl. a8. ; goto next option;
jl. w3 a21. ; next param;
bz w0 x2+1 ;
se w0 4 ; if parameter = <name> then
jl. a10. ; goto yes or no;
bl w0 x1+8 ; integer:
hs. w0 b3. ; action := action on integer(entry);
a9: rl. w0 c17. ; set modebits:
lo w0 x1+10 ; w0 := modebits or bits(entry);
jl. a11. ; goto call action;
\f
; fgs 1986.03.07 algol 6, pass 0, page 19
a10: bl w0 x1+9 ; yes or no:
hs. w0 b3. ; action := action on name(entry);
sn. w1 b28. ; if option name = <:xref:> then
jl. a33. ; goto xref;
sn. w1 b38. ; if optionname=copy
jl. a28. ; then goto copy;
sn. w1 b35. ; if optionname = rts then
jl. a45. ; goto move name to rts name;
rl w0 x2+4 ;
se w0 0 ; if name word 2(param) <> 0 then
jl. a27. ; goto alarm next;
sh. w1 b39. ; if paramgroup>1 and
se w1 x1 ; param=yes
rl w0 x2+2 ; or param=no
se. w0 (b4.) ; then goto scan;
sn. w0 (b5.) ;
jl. a6. ;
rl w0 x2+2 ; if param=on or
se. w0 (b32.) ; param=off
sn. w0 (b33.) ; then goto onoff;
jl. a57. ;
sn. w0 (b4.) ; if name word 1(param) = <:yes:> then
jl. a9. ; goto set modebits;
se. w0 (b5.) ; may be no:
jl. a27. ; if name word 1(entry) <> <:no:> then
a18: ac w0 (x1+10) ; goto alarm next;
bs. w0 1 ;
la. w0 c17. ; w0 := -,bits(entry) and modebits;
a11: rs. w0 c17. ; call action:
rl w0 x2+2 ; modebits := w0;
b3 = k+1; action ; w0 := parameter;
a12: jl. 0 ; goto modifier(action);
a57: sh. w1 b40. ; onoff: if -,group3 then
jl. a27. ; goto alarm next;
rl. w3 e56. ; if -,modechange allowed
so w3 (x1+10) ; then
jl. a6. ; goto scan param list;
sn. w0 (b32.) ; if param=on then
jl. a9. ; goto yes
jl. a18. ; else goto no;
b4: <:yes:> ;
b5: <:no:> ;
b8: <:<10>***algol param<32><0>:>;
\f
; fgs 1986.03.07 algol 6, pass0, page 19a
a30: se. w0 (b4.) ; details name:
jl. a6. ; if parameter = <:yes:> then
al w0 1 ; begin
al w1 11 ; lower pass no := 1;
ds. w1 c18. ; upper pass no := 11;
jl. a6. ; end; goto scan parameter list;
a45: dl w0 x2+4 ; move name to rts name:
ds. w0 e107.+2 ; move
dl w0 x2+8 ; parameter name
ds. w0 e107.+6 ; to
jl. a6. ; rts name;
a13: al w1 -6 ; details: bound := -6;
a14: rs. w0 x1+e19. ; next interval:
sn. w3 (b10.) ; interval bound(bound) := parameter;
jl. w3 a21. ; if next item head = (point,integer) then
; next param;
rs. w0 x1+e19.+2 ; interval bound(bound+2) := parameter;
al w1 x1+4 ; bound := bound + 4;
sh w1 0 ; if bound > 0
se. w3 (b10.) ; or next item <> (point,integer) then
jl. a6. ; goto scan parameter list;
jl. w3 a21. ; next param;
jl. a14. ; goto next interval;
a15: rs. w0 d7. ; stop integer: stop pass := parameter;
a16: al w0 1 ; stop name:
rs. w0 f9. ; sorry := 1;
jl. a6. ; goto scan parameter list;
a28: rl. w1 b7. ; copy:
sl. w1 b37. ; if number of copyparam>max
jl. a27. ; then goto alarm next;
dl w0 x2+4 ;
ds w0 x1+2 ;
dl w0 x2+8 ; move name
ds w0 x1+6 ;
rl. w0 c17. ;
hs w0 x1+9 ; save modebit
al w1 x1+10 ; copypointer.=
rs. w1 b7. ; copypointer+10;
rl. w3 e83. ; no.of copyparam:=
al w3 x3+1 ; no.of copyparam+1;
rs. w3 e83. ;
rl w3 x2+10 ;
ls w3 -12 ; if nextsep<>point
se w3 8 ; then goto
jl. a6. ; scan param list;
jl. w3 a21. ; next param;
rl w1 x2 ;
sn. w1 (b26.) ; if delim=pointname
jl. a28. ; then goto copy;
am. (b7.) ;
hs w0 -10+8 ; save fileno;
sn w0 0 ; if fileno = 0 then
jl. a27. ; goto alarm next;
sn. w3 (b10.) ; if nextdelim=pointinteger then
jl. a27. ; goto alarm next;
se. w3 (b26.) ; if nextdelim<>pointname
jl. a6. ; then goto scan param list;
jl. w3 a21. ; nextparam;
jl. a28. ; goto copy;
b7: 0 ; top copy list;
\f
; rc 1975.10.28 algol 6, pass 0, page 20
a20: rl w3 x2+10 ; maybe source:
se. w3 (b10.) ; if following delim<>pointinteger
jl. a27. ; then goto alarm next;
jl. w3 a21. ; next param;
sn w0 0 ; if fileno=0 then
jl. a27. ; goto alarm next;
am -10 ;
a19: al w3 x2 ;
rl. w1 b6. ; source list: w1 := top source list;
rs. w2 b6. ; save w2
al w2 x3 ;
hs w0 x1+8 ; save fileno
rl. w0 c17. ; save modebits
hs w0 x1+9 ;
dl w0 x2+4 ;
ds w0 x1+2 ; move parameter to
dl w0 x2+8 ; top source list and on;
ds w0 x1+6 ;
al w1 x1+10 ; top source list := top source list + 10;
rl. w2 b6. ; restore w2
rs. w1 b6. ;
jl. a6. ; goto scan parameter list;
b6: 0 ; top source list;
; nextparam
; entry exit
; w0 - fpparameter
; w1 - unchanged
; w2 addr of previous addr of leading
; leading separator separator
; w3 return addr following separator
a21: rs. w3 b9. ; next param:
ba w2 x2+1 ; save return;
al w3 x2 ; command point :=
ba w3 x2+1 ; command point + bits(12,23,item head);
rl w3 x3 ; w3 := next item head;
bl w0 6 ;
sh w0 3 ; if next delimiter < 4 then
rl. w3 b12. ; w3 := (space,name);
rl w0 x2+2 ; w0 := parameter;
jl. (b9.) ; return;
b9: 0 ; saved return;
a22: rl. w2 b6. ; end parameters:
al w2 x2+2 ; start copy list := w2 :=
rs. w2 e47. ; top source list + 2;
al. w1 b36. ; w1 := top command;
\f
; fgs 1985.10.29 algol 6, pass 0, page ...21...
a23: dl w0 x1+2 ; move copyparam:
sn w3 0 ; if name empty then
jl. a24. ; goto set ends;
ds w0 x2+2 ;
dl w0 x1+6 ; move name;
ds w0 x2+6 ;
rl w0 x1+8 ;
rs w0 x2+8 ; move file, modebit
al w1 x1+10 ; pointers:=pointers+10;
al w2 x2+10 ;
jl. a23. ; goto move copyparam;
a24: al w0 0 ; set ends:
rs w0 x2 ; end branch interval list := 0;
rs. w0 (b6.) ; end source list := 0;
rl. w0 c17. ; w0 := modebits;
al w1 1 ;
sz w0 1<9 ; if bossline.yes then
hs. w1 j2. ; modify;
sz. w0 (b30.) ; if blocks.yes then
hs. w1 j3. ; modify;
rl. w1 b17. ;
so w0 1<2 ; if pass information wanted then
jl. a32. ; begin
rs. w1 j0. ; modify procedure outbyte;
c. (:e15 a. 1:) - 1 ; if special testoutput pass 0 then
jl. w3 d8. ; begin print linehead;
al. w1 f22. ; writetext(string name of object area);
jl. w3 c13. ;
rl. w0 c23. ; write4(fp base);
jl. w2 d20. ;
al. w0 c0. ; write4(first of pass);
jl. w2 d20. ;
rl. w0 f26. ; write4(last work for pass);
jl. w2 d20. ;
rl. w0 c17. ; end;
z. ; end;
a32: rl. w1 e41. ;
sz w0 1<6 ; if integer overflow wanted then
wa. w1 b18. ; set bit 1 in interrupt mask;
rs. w1 e41. ;
rl. w1 c23. ;
al w3 x1+e25 ; set abs address of
rs. w3 d24. ; current program zone descriptor;
rl w2 x3+e48+6 ; w2 := address(program share descriptor);
al w0 x2+10 ; set abs address of
rs. w0 d23. ; last core(program share descriptor(10));
al w0 x3+e49+16 ; set abs address of
rs. w0 d21. ; segment(program process description(16));
al w0 x2+2 ; set abs address of
am -1000
rs. w0 d27.+1000 ; first core(program share descriptor(2));
bz w0 x3+e49+1 ;
se w0 18 ; if process kind(program) = 18 then
jl. a29. ; begin comment: translator on magnetic tape;
rl. w0 b19. ; set bit 4 in give up mask;
lo w0 x3+e50 ; comment: inblock will always return by the
rs w0 x3+e50 ; give up action, because last core = last work;
am -1000 ;
al. w0 d28.+1000 ; set give up action to point to the first
rs w0 x3+e50+2 ; instruction after the call of inblock;
; end;
a29: al w1 x1+e28 ; set abs address of
rs. w1 e62. ; inblock (fp entry);
am -1000 ;
jl. c7.+1000 ; goto next pass;
\f
; rc 18.1.1971 algol 6, pass 0, page 21a
a33: rs. w3 b27. ; xref: save (next item pointer);
dl. w1 b21. ;
ds. w1 c73. ; first line := first name line := 0;
ds. w1 c75. ; last line := last name line := maximum;
rs. w0 c71. ; connection mask := 0;
rs. w0 c76. ; sortareaname := undefined;
am b23 ; scan xref option list:
a34: al. w3 b24. ; entry := option table base;
a35: al w3 x3+8 ; entry := entry + 8;
sl. w3 b25. ; if entry >= last of options then
jl. a27. ; goto alarm next;
rl w0 x2+2 ; if param <> option name(entry) then
se w0 (x3) ; goto next option;
jl. a35. ;
dl w1 x2+6 ;
sn w0 (x3+2) ;
se w1 (x3+4) ;
jl. a35. ;
am (x3+6) ;
a36: jl. ; goto action (xref option);
a37: al w0 7 ; xref yes:
rs. w0 c71. ; connection mask := 7;
jl. a6. ; goto scan parameter list;
a38: am 3 ; xref all: mask := 7;
a39: am 2 ; xref use: mask := 4;
a40: am 1 ; xref assign: mask := 2;
a41: al w0 1 ; xref declare: mask := 1;
lo. w0 c71. ; connection mask :=
rs. w0 c71. ; connection mask or mask;
rl. w3 b27. ; w3 := next item head;
se. w3 (b26.) ; if w3 = (point,name) then
jl. a43. ; begin
jl. w3 a21. ; next param;
rs. w3 b27. ; save (next item head);
jl. a34. ; goto scan xref option list; end;
a43: al. w1 c72. ; for w1 := adr(first line),adr(first name line) do
a42: se. w3 (b10.) ; begin if w3 <> (point,integer) then
jl. a44. ; goto sortarea;
jl. w3 a21. ; next param;
rs w0 x1 ; first line(x1) := parameter;
sn. w3 (b10.) ; if next item head = (point,integer) then
jl. w3 a21. ; next param;
ba. w0 1 ; last line(x1) := parameter + 1;
rs w0 x1+2 ;
al w1 x1+4 ;
sh. w1 c74. ;
jl. a42. ; end;
\f
; fgs 1986.03.07 algol 6, pass , page 21b
a44: ; sortarea:
se. w3 (b26.) ; if next item head <> (point,name) then
jl. a6. ; scan parameter list;
jl. w3 a21. ; next param;
rs. w0 c76. ; move parameter to sortareaname;
dl w1 x2+6 ;
ds. w1 c76.+4 ;
rl w0 x2+8 ;
rs. w0 c76.+6 ;
jl. a6. ; goto scan parameter list;
\f
; fgs 1987.05.13 algol 6, pass 0, page ...22...
b17: jl. h3 ; modifier to procedure outbyte;
b18: 1<22 ; modifier to interrupt mask;
b19: 1<19 ; bit 4 to give up mask (block length error;
b20: 0 ; standard values for: first xref-line
b21: 1<22 - 1 + 1<22 ; last xref-line
b10: 8<12 + 4 ; (point,integer);
b11: 4<12 + 4 ; (space,integer);
b12: 4<12 + 10 ; (space,name);
b26: 8<12 + 10 ; (point,name);
b27: 0 ; next item head;
b13 = k - 4 ; delimiter table:
<: :> ; space;
<:=:> ; equal;
<:.:> ; point;
b14 = k - 12 ; option table:
; option name action on action on modebits
; integer name to change
; group 1, not treated in first param scan
<:survey:> ,0,0, h. a27-a12, a6 -a12, w. 1<2
<:stop:> ,0,0, h. a15-a12, a16-a12, w. 1<4
<:details:> ,0, h. a13-a12, a30-a12, w. 1<2
<:blocks:> ,0,0, h. a27-a12, a6 -a12,b30:w.1<11
<:connect:> ,0, h. a27-a12, a6 -a12, w. 1<12
<:fp:> ,0,0,0, h. a27-a12, a6 -a12, w. 1<13
b38: <:copy:> ,0,0, h. a27-a12, a28-a12, w. 0
<:bossline:>,0, h. a27-a12, a6 -a12, w. 1<9
b28: <:xref:> ,0,0, h. a27-a12, a6 -a12, w. 0
b35: <:rts<0>:> ,0,0, h. a27-a12, a45-a12, w. 0
; group 2, yes or no finished in first param scan
b39=k-12
<:message:> ,0, h. a27-a12, a6 -a12, w. 1<1
<:index:> ,0,0, h. a27-a12, a6 -a12, w. 1<3
<:spill:> ,0,0, h. a27-a12, a6 -a12, w. 1<6
<:zonecheck:> , 0, h. a27-a12, a6 -a12, w. 1<14
<:ix:>, ,0,0,0, h. a27-a12, a6 -a12, w. 1<15
<:code:> ,0,0 h. a27-a12, a6 -a12, w. 1<16
; group 3, on off allowed, else as group 2
b40=k-2
b29: <:list:> ,0,0, h. a27-a12, a6 -a12, w. 1<0
b15 = k - 12 ; last of options;
; xref option table:
b22 = k ; first of xref options;
; option name action
<:yes:> , 0 , 0 , a37-a36 ;
<:no:> , 0 , 0 , a6 -a36 ;
b23 = b22-k ; option table base (incl. yes,no )
b24 = k - 8 ; option table base (excl. yes,no )
<:all:> , 0 , 0 , a38-a36 ;
<:use:> , 0 , 0 , a39-a36 ;
<:assign:> , 0 , a40-a36 ;
<:declare:> , a41-a36 ;
b25 = k ; last of xref options;
\f
; fgs 1986.02.18 algol 6, pass 0, page ...23...
d25: 100 ; tail for look up entry and create entry;
d26: 0,r.9 ; segments = 100, dummy entry
b36: 0,r.151 ; max 30 copy-sources
b37=k-2
h5 = k - e38 ; length of entire pass 0;
e89= h5 ; load length for insertproc
e30= h5 ; accumulated length of passes for insertproc
i. ; id list;
e. ; end block: initialize translator;
i. ; id list;
;e. ; end block: pass 0 segment;
m. jz.fgs 1987.09.11 algol 8, pass 0
\f
▶EOF◀