|
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: 33792 (0x8400)
Types: TextFile
Names: »algpass23tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass23tx «
;rc 3.12.1970 algol 6, pass 2, page ...1...
;explanation of pass 2:
;pass 2 recognizes byte strings representing identifiers and
;substitutes a unique byte for each such string. this is done
;regardless of block structure, so that the same identifier will
;be represented by the same byte throughout the text. the values
;of the bytes will be in the range 512< <byte> <4096.
;pass 2 uses three tables to accomplish this task:
;letter table(1:58),
;main(first free after pass 2:first free+2*no. identifiers),
;aux(last word in pass:last word-no.long identifier parts).
;identifiers are packed into these tables and recognized as follows:
;the first character is saved in a working location. the second and
;succeeding characters are packed as an integer base 69 into the
;rightmost 23 bits of word 2 of the current main entry. when this
;is done bit(0) of word 2 is set to 1 and the search routine begins.
;if the identifier cannot be packed into 23 bits, the rightmost 23
;bits of aux words (beginning with the current aux word and working
;backwards in the store) are used. bit(0) in these aux words is set
;to zero except in the word the identifier terminates, where it is
;set to one. then the absolute address of the first aux word used
;for the identifier is placed in word 2 of the current main entry.
;this also makes bit(0) of word 2=0, and the search routine commences.
;if the identifier consists of only one character, current main word 2
;will be all zeroes except bit(0).
;the search routine begins by checking the letter table entry corres-
;ponding to the first character. if it is zero the current main address
;is placed in it, and the not-found action begins. otherwise the
;main entry whose address is stored in the letter table, and succeeding
;entries whose addresses are stored in word 1 of the main entries are
;checked until either the identifier is found or the chain is exhausted.
;in searching for an identifier that uses aux words, bit(0) of word 2
;of a main entry is checked first. if it is a one, the chaining
;continues in the main table; but if it is a zero, the identifier is
;checked against the appropriated entries which word 2 points to.
;when an identifier is found the main base is subtracted from the
;main entry address, divided by 4 (since the addresses refer to bytes),
;added to 513, the identifier base, and output. the current main
;address remains the same. when an identifier is not found the main
;base is subtracted from the current main address and output as above.
;the current main address is increased by 4 (a double word), and the
;pass continues.
;after endpass is recognized and output, pass 2 enters the catalog scan.
;up to 4 catalog segments are read into the free area between main and
;aux words. each algol procedure identifier is unpacked from the catalog
;and packed into the current main word 2 or the necessary number of
;aux words, and the search routine proceeds as before. if the procedure
;identifier is not found, the next one is read in and the process
;continues. if it is found the identifier number is output followed
;by 12 bytes copied from the catalog which contain the procedure kind
;and specifications. the catalog scan continues until the catalog is
;exhausted, a zero is output, and the pass terminates.
\f
; jz 1979.06.22 algol 8, pass 2, page ...2...
k=e0
s. a36,b8,d22,f45,g3,h35,j0
w.
j0:g1 ; number of bytes in pass 2;
h. d0 ; entry address relative to first word;
2<1 ; pass mode bits (0=forward);
w.
f0: 0; current word addr;
f1: 0; main top addr;
f2: 0; aux top addr;
f3: 0; current aux addr; main link
f4: 0; search word;
f5: 0; aux main word addr;
f6: 0; current cat entry addr;
f7: 0; cat entry name part;
f8: <:catalog:> ; name:
0;
0;
f9: 3<12; message:
0; first storage addr;
0; last storage addr;
0; first segment no.;
f15: 0; answer: (8 words) status;
0; number of bytes;
0; number of characters;
0;
0;
0;
0;
0;
f13: 69; packing base;
f14: 613; first identifier;
f16: <:variables<0>:> ;
f17: 1<23; end mark;
f18: 0; aux cat addr;
f19: 0; min interval;
f20: 0; - ;
0; f38-2: beginbits(1)
f38: 0; beginbits(2)
h.
f10: 0, 0; first char, char;
f11: 0, 0; no.entries processed, no.segments processed;
f12: 0, 0; number of segments transported;
w.
h0= 134 ; end pass1
h1= 135 ; error
h2= 136 ; new line
h3= 133 ; last normal terminator
h4= 139 ; space
h5= 144 ; test mode initial
h6 = 75 ; begin
h7 = 95 ; (
h8 = 92 ; ;
h9 =140 ; context
h10=112 ; )
h11=100 ; ,
h12= 84 ; zone
h13= 59 ; 0
h14= 79 ; own
h15= 81 ; long
\f
; jz 1979.06.22 algol 8, pass 2, page ...3...
h16 = 77 ; for
h17 =101 ; :=
h18 = 99 ; while
h19 =104 ; do
h20 =141 ; exit (in context programs)
h21 =142 ; continue (in context programs)
h22 =143 ; repeat (in repeat untill constructs)
h23 = 98 ; until
h24 = 93 ; end
h25 = 94 ; else
h26 = 96 ; -,
h27 = 132 ; extract
h28 = 122 ; =
h29 = 78 ; if
h30 =135 ; error (used for operans count)
h31 =103 ; trouble
h32 =145 ; special delimiter
h33 =146 ; end special delimiter
h34 =139 ; exit (output value)
h35 =140 ; continue (output value)
h.
f21: h12,513,h7,514,h7,515,h11,h30,4093 ; context decl 1:
; zone z(init context(l,
f25:
f22: h10,h11,h13,h11,516,h10,h8,h14,h15,515,h30,4093; context decl 2:
; ),0,context zone proc); own long l;
f26:
f28: h16,517,h17,517,h18,h30,4094 ; while do
f29:
f24: h16,517,h17,517,h11,517,h18,h26,518,h19,h6,h8,h30,4092 ; repeat
f30:
f31: h8,518,h17,h30,4095 ; until(repeat)
f32:
f41: h23, h24, h24, ; until, end, end
f40:
f23: 514,0,r.4,4095,r.8,3<6+19,19<6+19,21<6,0 ; cat specs:
; interval, name, specs for init context(l,i,n,m)
516,0,r.4,4094,r.8,1<6+3,3<6+8,0,0 ; cat specs:
; interval, name, specs for context zone proc(z,s,b)
519,0,r.4,4091,r.8,1<6+10,0,0,0 ; cat specs:
; cat specs for exit operator in context programs
520,0,r.4,4090,r.8,1<6,0,0,0 ; cat specs:
; cat specs for continue operator in context programs;
517,0,r.4,4093,r.8,9<6, 0,0,0 ; cat specs:
; interval, name , specs for while <i> ;
518,0,r.4,4093,r.8,8<6,0,0,0 ; cat specs
; interval, name etc for repeat boolean
f27:
f44: h34 ; exit identifier
f45: h35 ; continue identifier
\f
; fgs 1985.03.08 algol 6, pass 2, page ...4...
w.
b2: 0 ; stop
d19: rs. w3 b2. ; output:
a23: sl. w2 (b2.) ; for byte := core(w2)
jl x1 ; while w2 < stop do
bz w0 x2 ;
jl. w3 e3. ; begin
al w2 x2+1 ; outbyte(byte);
; w2:=w2+1;
jl. a23. ; end;
h.
f42: 5,24, 9,20, h32 ; exit
3,15,14,20, 9,14,21, 5,h32 ; continue
h33 ; end special ident.
w.
f43: 0 ; initial pointer
d21: ; d21 + 1 = initial phase
se w3 x3+1 ; inbyte1:
jl. e2. ; if -,initial phase then goto pass0-inbyte;
rl. w2 f43. ; initial pointer :=
al w2 x2+1 ; initial pointer + 1;
rs. w2 f43. ;
bz w2 x2-1 ; byte := next special;
sn w2 h33 ; if byte = end special then
hs. w2 d21.+1; initial phase := false;
jl x3 ; return;
d0= k-j0;
al. w1 g2. ; start pass 2:
rs. w1 f0. ;
rs. w1 f1. ; current word addr:=main top addr
rl. w1 e9.+4 ; :=lower main limit;
rs. w1 f2. ; aux top addr:=current aux addr
rs. w1 f3. ; :=last word in pass;
rl. w3 e23. ; min interval :=
am (x3+e66) ; own process.catbase;
dl w3 +70 ;
al w3 x3-1 ;
ds. w3 f20. ;
rl. w3 e9.+6 ; w3 := contextmode;
se w3 0 ; if context mode then
jl. d1. ; goto program scan;
al w3 613 ;
hs. w3 f44. ; exit ident := declared;
al w3 614 ;
hs. w3 f45. ; continue ident := declared;
al w3 0 ;
hs. w3 d21.+1 ; initial phase := true;
al. w3 f42. ; initial pointer := start special ident;
rs. w3 f43. ;
d22: jl. w3 d21. ; special ident: inbyte1;
sn w2 h33 ; if byte = end special then
jl. d1. ; goto program scan;
jl. d2. ; goto first char;
\f
; rc 1977.11.02 algol 6, pass 2, page ...5...
d1: jl. w3 e2. ; program scan: byte := inbyte;
d18: sh w2 58 ; check byte:
jl. d2. ; if byte < 59 then goto first char;
b0 = k + 1; incontext ; special bytes:
d3: se w3 x3 ; if incontext then
jl. a21. ; goto check bracket;
se w2 h6 ; if byte <> begin then
jl. a22. ; goto check further;
dl. w1 f38. ; begin:
ld w1 1 ; beginbits :=
ds. w1 f38. ; beginbits shift 1;
al w0 x2 ;
jl. w3 e3. ; outbyte(byte);
jl. w1 d20. ; next relevant;
se w2 h9 ; if byte <> context then
jl. d18. ; goto check byte;
jl. w1 d20. ; next relevant; (expected to be left bracket)
sn w2 h7 ; if byte = left bracket then
jl. a24. ; goto context;
al w0 h12 ;
jl. w3 e3. ; outbyte(zone);
jl. d18. ; goto check byte;
a24: hs. w2 b0. ; context:
al w1 1 ;
hs. w1 b6. ; bracketcount := 1;
al. w2 f21. ; incontext := true;
al. w3 f25. ;
jl. w1 d19. ; output(context decl 1);
jl. d1. ; goto program scan;
a21: se w2 h10 ; check bracket:
jl. a22. ; if byte <> right bracket then goto check further
bl. w1 b6. ; right bracket:
al w1 x1-1 ; bracketcount :=
hs. w1 b6. ; bracketcount - 1;
se w1 0 ; if bracketcount <> 0 then
jl. a22. ; goto check further;
al. w2 f22. ; end context:
al. w3 f26. ;
jl. w1 d19. ; output(context decl 2);
al w0 0 ;
hs. w0 b0. ; initcontext := false;
jl. d1. ; goto program scan;
d20: jl. w3 e2. ; next relevant:
sn w2 h4 ; if inbyte = space then
jl. d20. ; goto next relevant;
se w2 h2 ; if byte <> newline then
jl x1 ; return;
al w0 x2 ;
jl. w3 e3. ; outbyte(byte);
jl. w3 e1. ; new line;
jl. d20. ; goto next relevant;
\f
; rc 1977.11.08 algol 6, pass 2, page ...6...
a22: se w2 h7 ; check further:
jl. a31. ; if byte <> left bracket then goto check exit:
b6=k+1; bracketcount
al w0 0 ; left bracket:
ba. w0 1 ; bracketcount := bracketcount +
hs. w0 b6. ; 1;
jl. a1. ; goto output 1;
a31: se w2 h20 ; check exit:
jl. a32. ; if byte <> exit then goto check2;
bz. w2 f44. ; exit: byte := exit identifier;
jl. a1. ; goto output 1;
a32: se w2 h21 ; check2:
jl. a29. ; if byte <> continue then goto check repeat;
bz. w2 f45. ; continue: byte := continue identifier;
jl. a1. ; goto output 1;
a29: se w2 h22 ; check repeat:
jl. a34. ; if byte <> repeat then goto check until;
al. w2 f24. ; repeat found:
al. w3 f30. ; output(for <i> := <i>, <i> while -, <b>
jl. w1 d19. ; do begin error -4 );
b8 = k + 1; repeat count
al w1 0 ;
al w1 x1+1 ; repeat count :=
hs. w1 b8. ; repeat count + 1;
dl. w1 f38. ; beginbits :=
ld w1 1 ; beginbits shift 1;
al w1 x1+1 ; beginbits :=
ds. w1 f38. ; beginbits + 1;
jl. d1. ; goto program scan;
\f
; jz 1979.08.10 algol 8, pass 2, page ...7...
a34: se w2 h23 ; check until:
jl. a35. ; if byte <> until then goto check end expr;
bz. w0 b3. ; until found:
bl. w1 b8. ; if repeat count = 0
se w1 0 ; or
se w0 0 ; after for then
jl. a27. ; goto check1;
bz. w0 b7. ;
sn w0 h24 ; if until expr = end byte then
jl. w3 e3. ; then outbyte;
rl. w0 f38. ;
so w0 1 ; if beginbits extract 1 = 0 then
jl. a27. ; goto check;
al w1 x1-1 ; repeatcount :=
hs. w1 b8. ; repeatcount - 1;
al w0 h24 ;
hs. w0 b7. ; until expr := end byte;
al. w2 f31. ;
al. w3 f32. ; output(; <b> := error -1);
jl. w1 d19. ;
dl. w1 f38. ;
ld w1 -1 ;
ds. w1 f38. ; beginbits := beginbits shift (-1);
jl. d1. ; goto program scan;
a35: al w0 0 ; check end expr:
se w2 h8 ; if byte = ;
sn w2 h24 ; or byte = end
al w0 h24 ; then byte1 := end;
b7 = k + 1; until expr
se w3 x3 ; if until expr <> 0
se w0 h24 ; or byte1 <> end then
jl. a27. ; goto check;
jl. w3 e3. ; outbyte(byte1);
al w0 0 ;
hs. w0 b7. ; until expr := false;
a27: se w2 h24 ; check: if byte <> end then
jl. a36. ; goto check1;
dl. w1 f38. ; end:
al w3 x1 ; bits := beginbits;
ld w1 -1 ;
ds. w1 f38. ; beginbits := beginbits shift (-1);
so w3 1 ; if bits extract 1 = 0 then
jl. a36. ; goto check;
al. w2 f41. ;
al. w3 f40. ;
jl. w1 d19. ; output(until,end,end);
bl. w1 b8. ;
al w1 x1-1 ;
hs. w1 b8. ; repeatcount := repeatcount - 1;
jl. d1. ; goto programscan;
\f
; rc 1977.11.02 algol 6, pass 2, page ...8...
a36: sn w2 h16 ; check1:
hs. w2 b3. ; if byte=for then
al w0 0 ; after for := true;
sn w2 h19 ; if byte = do then
hs. w0 b3. ; after for := false;
b3=k + 1; after for ;
sn w3 x3 ; if after for
se w2 h18 ; or byte <> while then
jl. a25. ; goto check;
al. w2 f28. ; while:
al. w3 f29. ;
jl. w1 d19. ; output(for <i> := <i> while);
al w0 0 ;
hs. w0 b3. ; after for := false;
jl. d1. ; goto program scan;
a25: sn w2 h9 ; check :
al w2 h12 ; if byte = context then
sh w2 h3 ; byte := zone;
jl. a1. ; if inbyte<=last normal terminator
sn w2 h4 ; then goto output 1;
jl. d1. ; if inbyte=space then goto program scan;
sn w2 h2 ;
jl. a15. ; if inbyte=new line then goto new line;
sn w2 h1 ;
jl. a0. ; if inbyte=error then goto output 2;
sn w2 h0 ;
jl. d15. ; if inbyte=endpass then goto prepare cat scan;
sn w2 h5 ; if inbyte=test mode initial
jl. d17. ; then goto test mode identifier;
al w0 x2 ;
jl. w3 e3. ; output(inbyte);
jl. w3 e2. ;
al w0 x2 ;
jl. w3 e3. ; output(inbyte);
jl. w3 e2. ;
al w0 x2 ;
jl. w3 e3. ; output(inbyte);
jl. w3 e2. ;
a0: al w0 x2 ; output 2;
jl. w3 e3. ; output(inbyte);
jl. w3 e2. ;
a1: al w0 x2 ; output 1;
jl. w3 e3. ; output(inbyte);
jl. d1. ;
a15: al w0 x2 ; new line;
jl. w3 e3. ; output(new line);
jl. w3 e1. ; new line;
jl. d1. ; goto program scan;
\f
;rc 1977.11.08 algol 6, pass 2, page ...9...
d17: al w2 59 ; test mode identifier:
d2: ls w2 1 ; first char:
hs. w2 f10. ;
al w0 0 ; first char:=inbyte;
al w1 0 ; main(top-1):=main(top):=0;
ds. w1 (f1.) ;
a10: jl. w3 d21. ; next char:
sl w2 69 ; w2:=inbyte;
jl. a16. ; if inbyte<69
hs. w2 f10.+1 ; then begin char:=inbyte;
jl. w3 d10. ; packchar;
jl. a10. ; goto next char end;
a16: sn w2 h1 ; else if inbyte<>error then
jl. a18. ; begin search;
jl. w3 d11. ; if identifier not found then
jl. a17. ; begin
rl. w1 f1. ; last iden(link):=main top addr;
sl. w2 g3. ; comment- letter table linking;
am -2 ;
rs w1 x2 ;
rl. w2 f1. ; w2:=main top addr;
al w1 x1+4 ; w1:=main top addr+4;
sl. w1 (f2.) ; if w1>=aux top addr then got stack overflow;
jl. d12. ; main top addr:=w1;
rs. w1 f1. ;
a17: rl. w1 f1. ; current word addr:=main top addr;
rs. w1 f0. ;
al. w0 g3. ;
ws w2 0 ; identifier no.:=
ls w2 -2 ; (identifier no.-main bottom addr)/4
wa. w2 f14. ; first identifier;
bz w0 5 ; if identno>4095 then
al. w1 f16. ; alarm(<:variables:>);
se w0 x2 ;
jl. w3 e5. ;
bz. w3 d21.+1 ; if initial phase then
sn w3 0 ; goto special ident;
jl. d22. ;
jl. w3 e3. ; output(identifier no.);
jl. w3 e11. ; repeat input;
jl. w3 e2. ;
jl. d3. ; goto special bytes; end;
a18: al w0 x2 ;
jl. w3 e3. ; else begin
jl. w3 e2. ; output(inbyte);comment-error;
al w0 x2 ; output(inbyte);comment-error identification;
jl. w3 e3. ; goto next char;
jl. a10. ; end;
\f
;rc 1977.11.02 algol 6, pass 2, page ...10...
d15:al w0 x2 ; prepare cat scan:
jl. w3 e3. ; output(endpass);
am. (f1.) ;
al w0 -4 ;
al. w2 g3. ;
ws w0 4 ;
as w0 -2 ;
wa. w0 f14. ;
jl. w3 e3. ; output(last identifier);
al. w3 f8. ; w3:=<:catalog:>addr;
jd 1<11+6 ; initialise area process;
sn w0 3 ; if result = 1 then
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then
jl. d13. ; goto transport error;
rl. w1 f1. ;
al w1 x1+2 ; first storage addr:=
rs. w1 f9.+2 ; main top addr+2;
rl. w1 f2. ; aux cat addr:=
rs. w1 f18. ; aux top addr;
al w1 x1-8 ; last storage addr:=
rs. w1 f9.+4 ; aux top addr-8;
ws. w1 f9.+2 ; if last storage addr
sh w1 509 ; - first storage addr < 510 then
jl. d12. ; goto stack overflow;
al. w2 f23. ; output context externals:
al. w3 f27. ; output(init context and
jl. w1 d19. ; context zone procs);
d4: al. w1 f9. ; begin drum transport:
al. w3 f8. ; w1:=message addr; w3:=name addr;
jd 1<11+16 ; send message;
al. w1 f15. ; w1:=answer addr; w2:=buffer addr;
jd 1<11+18 ; wait answer;
sn w0 2 ; if message rejcted
jl. d4. ; then goto begin drum transport;
se w0 1 ; if -,normal answer
jl. d13. ; then goto transport error;
bz. w0 f15. ;
sn w0 0 ; if status word=0
jl. d5. ; then goto set seg transported;
so w0 1<6 ; if -,end of area
jl. d13. ; then goto transport error;
al. w3 f8. ; w3:=<:catalog:>addr;
jd 1<11+64 ; remove process;
rs. w0 e9. ; pass inf01:=result;
jl. d14. ; goto end pass;
d5: rl. w1 f9.+2 ; set seg transported:
rs. w1 f6. ; cat entry addr:=first storage addr;
rl. w0 f15.+2 ;
sn w0 0 ; if bytes transferred = 0
jl. d4. ; then goto repeat;
ls w0 -9 ; no. segments transported:=
hs. w0 f12. ; no. bytes transported//512;
al w0 0 ; no. entries processed:=
rs. w0 f11. ; no. segments processed:=0;
\f
;rc 1977.11.02 algol 6, pass 2, page ...11...
d6: rl w0 x1 ; unpack cat entry:
sn w0 -1 ; if namekey-catkey=-1
jl. d9. ; then goto next cat entry;
bz w0 x1+30 ;
se w0 4 ; if content<>4
sl w0 32 ; and content<32
jl. 4 ;
jl. d9. ; then goto next cat entry;
rl w0 x1+6 ; w0:=first word cat name;
al w3 0 ; w3:=0;
ld w0 8 ; w3:=first char;
rs. w0 f7. ; cat entry name part:=
sl w3 97 ; first cat name word shift 8;
al w3 x3-61 ; w3:=2*(if first cat char>96
al w3 x3-35 ; then first cat char-96
ls w3 1 ; else first cat char-35);
rl. w2 x3+g0. ; if letter(w3)=0 then got next cat entry;
sn w2 0 ;
jl. d9. ;
hs. w3 f10. ; first char:=cat char;
al w3 0 ; main(top-1):=main(top):=0;
am. (f1.) ;
rs w3 -2 ;
rs. w3 (f1.) ;
jl. w3 d7. ; next cat char;
jl. w3 d7. ; next cat char;
am. (f6.) ;
rl w2 8 ; w2:=second word cat name;
jl. w3 a3. ; next cat char;
jl. w3 d7. ; next cat char;
jl. w3 d7. ; next cat char;
am. (f6.) ;
rl w2 10 ; w2:=third word cat name;
jl. w3 a3. ; next cat char;
jl. w3 d7. ; next cat char;
jl. w3 d7. ; next cat char;
am. (f6.) ;
rl w2 12 ; w2:=fourth word cat name;
jl. w3 a3. ; next cat char;
al. w3 d8. ; return:=end name; next cat char;
d7: rl. w2 f7. ; procedure next cat char; load name part;
a3: sn w2 0 ; if name part=0
jl. d8. ; then goto end name;
al w1 0 ;
ld w2 8 ; cat entry name part:=
rs. w2 f7. ; cat entry name part shift 8;
al w2 -96 ; char:=(if cat char>96
sh w1 93 ; then cat char-96
al w2 -35 ; else if cat char>64
sh w1 57 ; then cat char-36
al w2 11 ; else cat char+11);
wa w1 4 ;
hs. w1 f10.+1 ;
jl. d10. ; pack char;
\f
;rc 1977.11.02 algol 6, pass 2, page ...12...
d8: jl. w3 d11. ; end name: search if identifier found
jl. d16. ; then goto cat entry found;
d9: rl. w1 f1. ; next cat entry: current word addr:=
rs. w1 f0. ; main top addr;
bz. w2 f11. ; no.entries processed:=
al w2 x2+1 ; no.entries processed+1;
sn w2 15 ; if no. entries processed<15
jl. a5. ; then
hs. w2 f11. ; begin
rl. w1 f6. ; current cat entry addr:=
al w1 x1+34 ; next cat entry addr;
rs. w1 f6. ; goto unpack cat entry;
jl. d6. ; end
a5: bz. w2 f11.+1 ; else
al w2 x2+1 ; begin no.segments processed:=
bz. w1 f12. ; no.segments processed+1;
sn w2 x1 ; if no.segments processed<no.seg.for transport
jl. a6. ; then
hs. w2 f11.+1 ; begin
al w0 0 ; no.entries processed:=0;
hs. w0 f11. ; current cat entry addr:=
rl. w1 f6. ; next segment head;
al w1 x1+36 ;
rs. w1 f6. ; goto unpack cat entry;
jl. d6. ; end
a6: rl. w1 f9.+6 ; else
ba. w1 f12. ; begin segment no.:=segment no.
rs. w1 f9.+6 ; +no.segments for transport;
jl. d4. ; goto begin drum transport end end;
d16: al w0 x2 ; cat entry found:
c.e77<3 ; if monitor 3 then begin
am. (f6.) ; w2w3:= interval.entry;
dl w3 +4 ; if interval.entry does not contain
sh. w2 (f19.) ; min interval then
sh. w3 (f20.) ; goto next cat entry;
jl. d9. ; end;
z.
al. w2 g3. ;
ws w0 4 ;
ls w0 -2 ;
wa. w0 f14. ;
jl. w3 e3. ; output(found identifier no.);
al w1 2 ;
al w2 13 ;
a4: am. (f6.) ; comment: output of name, specs;
bz w0 x1 ; for w1:= 2 step 1 until 13,
jl. w3 e3. ; 26 step 1 until 29
al w1 x1+1 ;
sh w1 x2 ;
jl. a4. ; do output(byte(cat entry addr+w1));
se w2 13 ;
jl. d9. ; goto next cat entry;
al w2 29 ;
al w1 26 ;
jl. a4. ;
\f
;rc 1977.11.02 algol 6, pass 2, page ...13...
;procedure pack char multiplies the current word by 69, adds char,
;and restores the result in the main table if there is space in a
;main word, otherwise an aux word.
d10: rl. w1 (f0.) ; procedure pack char;
wm. w1 f13. ; current word:=current word*69+char;
ba. w1 f10.+1 ;
sx 1 ; if no overflow
ba. w0 1 ; then
sh w1 -1 ; begin
jl. a7. ; current link:=0;
se w0 0 ;
jl. a7. ;
ds. w1 (f0.) ; return;
jl x3 ; end
a7: ld w1 1 ; else begin
ls w1 -1 ; current aux word(bit23):=
rl. w2 f3. ; current word(bit0);
al w2 x2-2 ; current aux addr:=current aux addr-2;
sh. w2 (f1.) ; if current aux addr<=main top addr
jl. d12. ; then goto stack overflow;
rs. w2 f3. ; current word addr:=current aux addr;
rs. w2 f0. ; current aux word+2:=current word;
ds w1 x2+2 ; return;
jl x3 ; end;
;procedure search first marks the search word at (bit0). the search
;then proceeds through the main table for linking and then through
;either the main or aux table looking for an identifier equal to the
;last packed identifier.
d11: rl. w1 f0. ; procedure search;
rl w2 x1 ; search word:=search word or 1(bit0);
lo. w2 f17. ;
rs w2 x1 ;
rs. w2 f4. ;
al. w2 g0. ;
ba. w2 f10. ; w0:=letter table(first char);
rl w0 x2 ;
se. w1 (f1.) ; if current word<>main top addr
jl. a9. ; then goto aux search;
a8: sn w0 0 ; check link: if link=0
jl x3+2 ; then not found return;
rl w2 0 ; else if main(link)=search word
dl w1 x2 ; then found return
se. w1 (f4.) ;
jl. a8. ; else goto check link;
jl x3 ;
\f
;rc 1977.11.02 algol 6, pass 2, page ...14...
a11: rl. w0 f3. ; load link: w0:=main link;
rl. w2 f5. ; w2:=aux main word addr
a9: sn w0 0 ; aux search:
jl. a14. ; if link<>0
rl w2 0 ; then
dl w1 x2 ; begin
sz. w1 (f17.) ; if main(link(bit0))=1
jl. a9. ; then goto aux search;
rs. w0 f3. ; main link:=link;
rs. w2 f5. ; aux main word addr:=last link;
rl. w2 f2. ; for w2:=aux top addr step -1
a12: rl w0 x1 ; do for w1:=main(link) step -1
rs. w0 f4. ; while aux(w1(bit0))=0
rl w0 x2 ; do if aux(w1)<>aux(w2)
se. w0 (f4.) ; then goto load link
jl. a11. ; else
sz. w0 (f17.) ; begin
jl. a13. ; current aux addr:=aux top addr;
al w1 x1-2 ; found return;
al w2 x2-2 ; end;
jl. a12. ;
a13: rl. w2 f5. ;
rl. w1 f2. ;
rs. w1 f3. ;
jl x3 ;
a14: rl. w1 f2. ; else
rs. w1 (f1.) ; begin
rl. w1 f0. ; main(top):=aux top addr;
al w1 x1-2 ; aux top addr:=current aux addr:=
sh. w1 (f1.) ; current word addr-2;
jl. d12. ; if aux top addr<=main top addr
sn. w3 d8.+2 ; then goto stack overflow;
rl. w1 f18. ; if catalog search then
rs. w1 f2. ; auxtop addr:= current auxaddr:= aux cat addr;
rs. w1 f3. ; not found return;
jl x3+2 ; end;
d12: al. w1 e10. ; stack overflow: w1:=<:stack:>addr;
jl. e5. ; terminate pass;
d13: al. w1 f8. ; transport error: w1:=<:catalog:>addr;
jl. e5. ; terminate pass;
d14: al w0 0 ; end pass:
jl. w3 e3. ; output(0);
jl. e7. ; call next pass;
;letter table;
g0=k-2
0 ;
r. 59
w.
g1=(:k-j0:)
e30=e30+g1
g3=k
g2=k+2
i. ; idlist
e.
m. jz 1985.03.08 algol 8, pass 2
\f
▶EOF◀