|
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: 63744 (0xf900)
Types: TextFile
Names: »algpass53tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass53tx «
;rc 4.12.1970 algol 6, pass 5, page ...1...
;pass 5 contents:
;
;pg 1 : descriptions of pass 5
;pg 1 : introduction
;pg 1 : central logic
;pg 2 : layout of store
;pg 3ff : table and stack formats
;pg 6 : code
;pg 8 : central input action
;pg 9 : declaration action
;pg 14 : output description
;pg 20ff: input tables
;pg 20 : kind table
;pg 21 : count table
;pg 22 : increment table
;pg 22 : action table
;pg 24 : initialize pass 5
;general introduction:
; pass 5 allocates storage for the variables and distributes the
;descriptions of the identifiers.
; a table of identifiers, ident table, is build based on the
;declarations collected at block begin. this table is checked for
;double declarations by identifiers left at the place where the
;declaration actually occurred. all other occurrencies of
;identifiers are in the output replaced by the description from
;the table.
;central logic of pass 5:
; when pass 5 is entered at next the central logic inputs a byte and
;treats it in one of three ways depending on the size:
; 1: byte>=min identifier: jump to the current identifier action.
; there are four possible actions on an identifier:
; 1: it is declared, i.e. entered in ident table with the
; current description given by the variable prepare decl.
; this action is set by <begin block> or <begin proc>.
; 2: the entry in ident table is checked for double declaration.
; this action is set by <end decl>, <end bounds>,
; <end zone decl> and <exit proc> and is explicitly performed
; by <label colon>.
; 3: the kind part of the entry in ident table is changed from
; <for label> to <label> and the original description is
; stored in decl stack as an redeclaration.
; this action is set by <do>.
; 4: the corresponding description is output from ident table.
; this action is set by <end head>.
; 2: byte>= interest. the byte is output, return to next.
\f
;rc 4.12.1970 algol 6, pass 5, page ...2...
; 3: byte < interest. the byte refers to the input tables as follows:
; 1: byte>= outbase. kind table(entry) is output and a jump to
; action table(entry) is performed.
; 2: if byte>=type limit then byte//4 is used otherwise the byte
; itself is used as index to the input tables which are:
; kind table gives the kind-type, stored in kind part of
; prepare decl.
; count table gives a counter for storage allocation and
; flags to be stored in ident table.
; increment table determines the number of words to be used
; for storage allocation to the declared identifier.
; action table holds the address of the declaration action
; to be executed.
; the variable prepare decl is assigned with kind, current
; block no and flags. increment and counter is set to their
; respective values from the tables and a jump to the
; declaration action is performed.
; layout of store:
; ================
;lowest address: ( pass 5 code )
; ( )
; ( )
; ( )
; ================
; ( pass 5 ) <- decl base
; ( initialization ) -
; ( code ) - decl stack
; ---------------- -
; ( ) -
; ( ) <- decl top
; ( )
; .....
; ( )
; ( ) <- spec top
; ( ) -
; ( ) - spec stack
; ( ) -
; ( ) <- spec base
; ================
; ( )
; ( st proc table )
; ( ) <- st table base
; ================
; ( )
; ( ident table )
; ( )
; last work for pass: ( )
; ================
\f
; rc 4.12.1970 algol 6, pass 5, page ...3...
;table and stack formats:
; there are four tables and stacks:
; 1: ident table contains four bytes per entry, i.e. per used
; identifier. the format is:
; byte 0: rel addr
; byte 1: bit 0-7: block no, bit 7 =1 if external or global
; bit 8-11: flag
; entry:byte 2: kind
; byte 3: ref part
; the table is initialized to: rel addr=0, block no=0,
; flag=not declared not used.
;
; the table entry for a declared identifier holds:
; rel addr: block relative address or external number
; block no: block number; if external or global then block number+1
; flag : see below
; ref part: refers in some cases to further information in the
; stacks, namely:
; 1. for arrays with known no of subscripts:
; spec stack(ref part+specbase) contains description
; of dope vector.
; 2. for procedures with parameters: spec stack(ref part
; +specbase) contains the specification list.
; 3. for procedure values: decl stack(ref part+declbase)
; contains the description of the procedure.
; for all others ref part is undefined.
;
; the flag determines how the identifiers are distributed.
; following flags are used:
; (0) 0000 formal array with subscripts: treated as (1).
; (1) 0001 array with subscripts: output as (6) followed by
; dope description (also as 6) from spec stack.
; (2) 0010 zone or zone array: treated as (6).
; (4) 0100 proc value: if following delimiter is <first:=> or
; <:=> then output as (6) else treat the word referenced
; by ref part (as 6 or 7).
; (5) 0101 own: output as (6) with block no= no of fictive own
; block.
; (6) 0110 normal identifier: output <kind> <rel addr> <block no>.
; (7) 0111 procedure with parameters: output as (6) followed by
; specification list from spec stack.
; (8) 1000 not declared not used: after error message
; ident table(ident) is replaced by: kind=undeclared,
; block no=current block, flag=normal and is then
; treated as (6).
; (9) 1001 formal identifier: treated as (6).
; (10)1010 undefined procedure: treated as (6).
; (14)1110 normal standard identifier not yet distributed:
; treated as (15).
; (15)1111 standard procedure with parameters not yet distributed:
; the corresponding entry to st table is put into the chain
; of used externals and ident table entry is replaced by:
; rel addr=external no, block no=no of fictive outer
; block+1, flag=flag-8. it is then treated as (6) or (7).
\f
; rc 4.12.1970 algol 6, pass 5, page ...4...
; 2: spec stack holds for each declared (or standard) procedure with
; parameters one or more words in the following format:
; specification word:
; bit 0 - 5: specification - output base for spec
; bit 6 -11: do.
; bit 12-17: do.
; bit 18-23: do.
; last specification first. a zero denotes end of specifications.
;
; for each declared array the spec stack holds 2 words giving the
; corresponding dope description to be output as normal identifier:
; byte 0: rel addr of dope vector.
; byte 1: bit 0- 7: no of subscripts.
; bit 8-11: flag= normal identifier.
; byte 2: kind= <dope description>.
; byte 3: undefined.
;
; the entry into spec stack comes from ref part of the corresponding
; ident word.
; at each block (or proc) begin the address of the topword of the
; spec stack is put into the block stop information in the decl stack.
; at block (or proc) end this address is reset.
; 3: decl stack holds for each block level the declarations which are
; valid outside that block level for identifiers which are redeclared
; in that block. it also holds the pseudo redeclarations of for-
; labels if any when entering the for loop and of locally declared
; identifiers which are used out of scope in array bounds or as
; zone declaration parameters. at the block end (and <end do>,
; <end single do>, <end bounds> and <end check local>) these
; descriptions will be unstacked.
; decl stack holds for each entry three words:
; word 0: absolute address of the corresponding entry in
; ident table.
; word 1 and 2: a copy of the contents of ident table in this location.
;
; an stack-stop is stacked at each of the bytes:
; <begin block>, <begin proc>, <do>, <end bound head>,
; <end zone head> and <end zone array head>. the format of the
; stack-stop is:
; word 1 = 0, word 2 = irrelevant
; word 3 = stop inf = absolute address of top of spec stack.
; the unstacking will be terminated when the stack-stop is met
; and spec top will be set.
\f
; rc 4.12.1970 algol 6, pass 5, page ...5...
; 4: st proc table holds for each possible external 14 bytes in
; following format:
; byte 0 - 1: chain part.
; byte 2 - 9: 8 bytes name of external
; byte 10-13: 4 bytes kind and spec
; where byte 2-13 is copies from the catalogue.
;
; chain part is used to chain those externals together which
; are actually used, so only the catalogue items for the used
; externals are transmitted to the following passes and in the
; sequence in which they are used in the program.
; chain part points at chain part of next used external; it is
; initialized to zero. to the chaining is used two variables:
; chain start : points at chain part of first used external
; chain last : points at chain part of last used external
;
; the ident part of a received external gives an entry to
; ident table which is set to:
; 20 bits address of entry to st table relative to st table base,
; 4 bits flag = not yet distributed external,
; kind= kind from <4 bytes kind and spec>,
; ref part= pointer to spec table if specifications.
\f
; jz 1979.10.09 algol 8, pass 5, page ...6...
k=e0
s. j10, i4, h53, g17, f51, d30, c42, b18, a40
w.
i2: g8 ; number of words in pass 5
h. i3 ; entry address relative to first word
5<1+1; pass mode bits: pass no 5<1 + change of direction
;assignment of bases:
h0 = 512; min identifier
h1 = 198; interest
h2 = 108; outbase
h3 = 15; type limit
h11= 299; spec limit
h25= h3-3; type base
h36= 285; base for output bytes
;input byte values:
h17= 110, h18= 139, h19= 277, h20= 276; nl, error, first:=, :=
;output byte values:
h4 = h36+24, h5 = h36+22; undeclared, error
h7 = h36+39, h8 = h36+ 9; simple int, take value
h9 = h36+56, h10= h36+ 7; dope description, take array
h13= h36+ 6, h14= h36+25; beg proc, label
h24= 240, h27= h36+13; vanished opr, end external
h28= h36+ 3, h30= h36+23; newline, end pass
h35= h36+ 8 ; take zone array
h37= h36- 1, h38= 241; end zone local, internal operand
h39= 278, h40= h36+12; end block, exit block
h41= h36+16 ; label colon
h46= h36+ 29 ; no parproc
;error identifications:
h6 = 16,h21= 17,h22= 18,h23= 15; +decl, for label, local, -decl
;others:
h12= 63<5; block mask
h15= 500; decl for label, internal value
h16= -4; no of fictive own block
h26= 2.1000; st flag diff
h32= -5; par kind diff
h34= -64<5; max block no
h42=2048-97; min working base, max no of bytes for
; work in pass 7 = 97
h47= 513; context zone ident
h49= 519; exit ident
h50= 22; error ident for <:context zone:>
h51= 21; error ident for <:context label:>
h52= 23; error ident for <:context proc:>
\f
; jz 1979.07.06 algol 8, pass 5, page ...7...
h.
f0: 0; rel addr part .
f1: 0; block and flag.
f2: 0; kind part .prepare decl
f3: 0; ref part .
w.h.
-1;
f4: -4 <4+0; current block
h4; <undeclared>
0;
w.
f5: -1<5; block mask
f6: 0; decl top
f7: 0; spec top
h.
f8: 6; normal flag
f9: 0; store for no of ext
h.
i1: ; counter array
f10=k-i1, 0; standard external no
f11=k-i1, 1; global no
f12=k-i1, 0; varible address
f13=k-i1, 0; own address
f14=k-i1, 0; formal address
w.
f15: 2.11<22; array flag test
h.
f16: 0; rel addr of dope vector.
f17: 0; no of subscripts < 4 +0.
f18: h9; <dope description> . dope description
f19: h36+85; spec output base
w.
f20: 0; spec ref
f21: 0; spec base
f23: 0; working location
f24: 0; addr of min ident
f25: 0; ident table base
f26: h14<12; kindpart for label
f27: 0; standard table base
f28: 0; chain start
f29: 0; chain last
f30: 0, 0; ext spec(1:4)
f31: 512<2; min ident*4
f33:<:blocks<0>:> ;
f44:<:variables<0>:>;
h.
f34: -e52; zone increment
f35: 4; formal increment
f36: 1; ext and global increment
f37: -2; array and field increment
f39: -2,f38: -4,-4, -2;simple and own increment, int,real=zone array,long,bool
w.
f40: 0; addr of max ident
f41: 0; return
f42: 2.11111; mask 31
f43: 0, 0; save double register
f51: -h42 ; min work base
\f
; jz 1979.07.06 algol 8, pass 5, page ...8...
d26: al w0 x2 ; ex out: outbyte:= byte;
d0: jl. w3 e3. ; out: output(outbyte);
c0: jl. w3 e2. ; next: input(byte);
sl w2 h0 ; if byte>=min identifier then
j0: jl. ; goto ident action;
sl w2 h1 ; if byte>=interest then
jl. d26. ; goto ex out;
sl w2 h2 ; if byte>=out base then
jl. a1. ; goto output action;
al w1 0 ; if byte<type limit then
sh w2 h3 ; begin entry:= byte;
jl. a0. ; type:= 0;
al w1 2.11 ; end else
la w1 4 ; begin entry:= byte//4 + type base;
ls w2 -2 ; type:= byte mod 4;
al w2 x2+h25 ; end;
a0: hs. w1 b0. ;
bz. w1 x2+g0. ; kind.prepare decl:=
b0=k+1; type ; kind table(entry)+type;
al w1 x1 ;
hs. w1 f2. ;
bz. w1 x2+g1. ; block and flag.prepare decl:=
la. w1 f42. ; current block + bit7-11.count table(entry);
ba. w1 f4. ; comment block no shift 4 + flag. the block no
hs. w1 f1. ; is uneven if global;
bz. w1 x2+g1. ; counter:= bit0-6.count table(entry);
ls w1 -5 ;
hs. w1 b1. ;
bl. w1 x2+g2. ; increment:= incr table(entry);
sl w1 g7 ; if increment>=simple incr then
ba. w1 b0. ; increment:= increment+type;
hs. w1 b2. ;
bl. w1 x2+g3. ; action addr:= action table(entry);
j1: jl. x1 ; goto action addr;
a1: bz. w0 x2+g11. ; output action:
se w0 0 ; outbyte:= kind table(byte);
jl. w3 e3. ; if outbyte<>0 then output(outbyte);
bl. w3 x2+g12. ; action addr:= action table(byte);
al. w1 c0. ; set return(next);
j7: jl. x3 ; goto action addr;
\f
; rc 29.04.1971 algol 6, pass 5, page ...9...
c1: al. w3 i1. ; declare:
b1=k+1; counter ; counter:= counter + counter base;
al w3 x3 ;
bz w0 x3 ; rel addr part.prepare decl:=
hs. w0 f0. ; count array(counter);
b2=k+1; increment ;
j2: ba. w0 ; count array(counter):=
hs w0 x3 ; count array(counter)+increment;
g7=f39-j2;simple incr ;
ls w2 2 ;
wa. w2 f25. ; ident:= byte*4 + ident table base;
dl. w1 f2. ; decl:= prepare decl;
rl w3 x2-2 ; if ident table(ident)=not used then
se w3 8 ; begin
jl. a2. ; new declaration: ident table(ident):= decl;
d1: ds w1 x2 ; goto next;
jl. c0. ; end;
a2: so w3 2.1110 ;
jl. 4 ;
jl. d2. ; if not standard identifier and
lx w3 0 ; block part.ident table(ident)=
sz w3 h12 ; block part.decl then
jl. d2. ; begin
dl. w1 f4.+2 ; double declaration:
bz w0 1 ; rel addr part.decl:= 0;
ba. w0 f8. ; block part.decl:= current block+normal flag;
jl. d1. ; kind part.decl:= <undeclared>;
; goto new declaration;
d2: rl. w3 e9.+2 ; end;
al w3 x3+1 ; redeclaration:
rs. w3 e9.+2 ; information 2:= information 2 + 1;
jl. w3 d27. ; stack decl(ident);
jl. d1. ; goto new declaration;
c2: ls w2 2 ; for label:
wa. w2 f25. ; ident:= byte*4 + ident table base;
bz w1 x2 ; prepare decl:= ident table(ident);
sn w1 h4 ; if kindpart.prepare decl = <undeclared> then
jl. c0. ; goto next;
rl w0 x2-2 ; kindpart.prepare decl:= <label>;
rl. w1 f26. ; goto redeclaration;
ds. w1 f2. ;
jl. d2. ;
d27: rs. w3 f41. ; procedure stack decl(ident);
ds. w1 f43.+2 ; integer ident; comment in w2;
rl. w3 f6. ; begin
al w3 x3+6 ; decl top:= decl top + 6;
rs. w3 f6. ; decl stack(decl top - 4):= ident;
rs w2 x3-4 ; decl stack(decl top):=
dl w1 x2 ; ident table(ident);
ds w1 x3 ;
jl. w3 d3. ; check stack;
dl. w1 f43.+2 ; end redeclaration procedure;
jl. (f41.) ;
\f
; rc 4.12.1970 algol 6, pass 5, page ...10...
c3: jl. w3 d25. ; label colon: byte:= next relevant;
al w0 h41 ; output(<label colon>);
jl. w3 e3. ; label:= true;
hs. w0 b12. ;
c4: ls w2 2 ; check declaration:
wa. w2 f25. ; ident:= byte*4 + ident table base;
bz w0 x2-2 ; decl:= ident table(ident);
hs. w0 b8. ; ext or rel:= rel addr part.decl;
b12=k+1; label ;
sn w3 x3 ; if label then
jl. a11. ; begin
jl. w3 e3. ; output(ext or rel);
al w3 0 ; label:= false
hs. w3 b12. ; end;
a11: bz w1 x2-1 ;
la. w1 f42. ;
sz w1 2.1100 ; flag:= flag part.decl;
jl. a3. ;
bz. w3 b7. ; if flag = zone or flag = zone array
al w3 x3+1 ; or flag = array then
hs. w3 b7. ; head count:= head count + 1;
a3: al w0 h24 ; output( <vanished operand>);
jl. w3 e3. ;
bz w3 x2 ; if kind part.decl= <undeclared>
sn w3 h4 ; and flag <> undef proc then
sn w1 1<4+10 ;
jl. c0. ; error(<+decl>);
al w0 h6 ;
jl. w3 d16. ;
jl. c0. ; goto next;
c35: am h35-h8 ; take zone array: take:=<take zone arr>; goto take;
c36: al w1 h8 ; take value: take:= <take value>;
ls w1 4 ;
c5: al w0 h7 ; take:
ba. w0 b0. ; outbyte:= <simple integer>+type;
jl. w3 e3. ; output(outbyte);
bl. w0 i1.+f14; output(formal address);
jl. w3 e3. ;
bl. w0 f1. ; current block:= block and flag shift -4;
ld w1 -4 ; flag:= block and flag & 2.1111;
jl. w3 e3. ; output(current block);
al w0 x1 ; outbyte:= take;
sz. w1 (f15.) ; if flag <> array then
jl. d0. ; goto out;
bl. w2 i1.+f14;
al w2 x2+4 ;
hs. w2 i1.+f14; formal address:= formal address + 4;
al w3 g4 ; in take array:= true;
hs. w3 b3. ;
\f
; rc 4.12.1970 algol 6, pass 5, page ...11...
c6: jl. w3 e2. ; array declaration:
hs. w2 b4. ; input(byte);
ls w2 1 ; no of subscripts:= byte;
al w3 2 ; dope relative.dope description:=
ba. w3 i1.+f12; variable address-(no of subscripts)*2 + 2;
bs w3 5 ;
hs. w3 f16. ;
al w3 x3-4 ; variable address:= dope relative - 4;
hs. w3 i1.+f12;
ls w2 3 ; subscript.dope relative:=
hs. w2 f17. ; no of subscripts shift 4;
dl. w1 f18. ; comment placed as block part in prepare decl
rl. w3 f7. ; with flag=0;
ds w1 x3 ; spec stack(spec top):= dope description;
al w3 x3-2 ;
rs. w3 f20. ; spec ref:= spec top - 2;
al w3 x3-2 ; spec top:= spec top - 4;
rs. w3 f7. ;
c7: rl. w3 f20. ; par proc decl:
ws. w3 f21. ; refpart.prepare decl:=
hs. w3 f3. ; spec ref - spec base;
b3=k+1;return ; set return(if -, in take array then next
j3: al. w3 c0. ; else take array); check stack;
d3: rs. w3 f23. ; integer procedure check stack;
rl. w3 f7. ; begin
sh. w3 (f6.) ; check stack:= spec top; comment in w3;
jl. i0. ; if decl top >= spec top then
jl. (f23.) ; alarm(<:stack:>);
i0: al. w1 e10. ; end;
jl. w3 e5. ;
g4=k-j3 ;
c8: al w0 c0-j3 ; take array:
hs. w0 b3. ; in take array:= false;
al w0 h10 ;
jl. w3 e3. ; output(<take array>);
bz. w0 f16. ;
jl. w3 e3. ; output(dope relative);
b4=k+1;no of subscripts;
al w0 ; outbyte:= no of subscripts;
jl. d0. ; goto out;
c37: al w0 h24 ; formal: outbyte:= <vanished operand>;
jl. d0. ; goto out;
\f
; jz 1979.07.06 algol 8, pass 5, page ...12...
c9: rl. w1 f7. ; specifications:
rs. w1 f20. ; spec ref:= spec top;
jl. w3 e2. ; input(byte);
a5: al w0 0 ; new spec word: spec word:=0;
al w1 18 ; spec pos:=18;
a6: sh w2 h11 ; new specification: if byte<spec limit then
jl. a7. ; goto finish specifications;
al w2 x2-h11 ; spec:= byte-spec limit;
ls w2 x1 ; spec:=spec shift spec pos;
lo w0 4 ; spec word:=spec word+spec;
jl. w3 e2. ; input(byte);
al w1 x1-6 ; spec pos:=spec pos-6;
sl w1 0 ; if spec pos>=0 then
jl. a6. ; goto new specification;
am a5-e11 ; end word: action:= new spec word; goto in;
a7: al. w1 e11. ; finish specifications:
rl. w3 f7. ; action:= repeat input byte;
rs w0 x3 ; in:
al w3 x3-2 ; spec stack(spec top):=spec word;
rs. w3 f7. ; spec top:=spec top-2;
jl w3 x1 ; goto action;
jl. c0. ; goto next;
c10: al w0 h13 ; begin proc:
jl. w3 e3. ; output(<begin proc>);
ac. w3 j6. ; ref part.prepare decl:=
wa. w3 f6. ; decl top - decl base + 12;
al w3 x3+12 ;
hs. w3 f3. ;
bl. w3 f1. ; block part.prepare decl:=
al w3 x3-2<4 ; block part.prepare decl - 2;
hs. w3 f1. ;
al w3 9 ; formal address:= 9;
hs. w3 i1.+f14;
bz. w0 b8. ; output(ext or rel);
jl. w3 e3. ; comment external no;
am 1 ; procedure block := true; skip next;
c11: al w3 0 ; begin block:
hs. w3 h53. ; else procedure block := false;
jl. w3 e2. ;
bl. w0 f4. ; input(byte);
bl w2 5 ; w2 := signed(input byte);
al w2 x2-e101 ; byte := byte - no of anonym. bytes in blocks;
as w0 -4 ; comment - no of variable bytes;
wa w0 5 ; working base:= current block + byte;
al. w1 f44. ; if working base < min working base
sh. w0 (f51.) ; then alarm(<:variables:>);
jl. w3 e5. ;
jl. w3 e3. ; output(working base);
d4: al w3 c1-j0 ; block start:
hs. w3 j0.+1 ; ident action:= declare;
jl. w3 d28. ; set stop;
al w3 0 ;
hs. w3 b16. ; context := false;
bl. w3 f4. ;
as w3 -4 ;
al w3 x3-1-e101 ; variable address:=current block-1-no of bytes for anonym. bytes in blocks;
hs. w3 i1.+f12;
al w3 -2<4 ;
ba. w3 f4. ; current block := current block - 2;
hs. w3 f4. ;
sl w3 h34 ; if current block >= max block nest then
jl. c0. ; goto next;
al. w1 f33. ; alarm(<:block:>);
jl. w3 e5. ;
\f
;rc 1977.11.03 algol 6, pass 5, page ...13...
c12: al w3 c4-j0 ; exit proc:
hs. w3 j0.+1 ; ident action:=check declaration;
c13: al w0 8 ; exit block:
bl. w1 f4. ; not declared not used:= 0+not used flag;
rl. w2 f24. ;
a8: bl w3 x2-1 ;
so w3 2.1110 ; for i:= min ident step 4 until max ident do
la. w3 f5. ; if block part.ident table(i)=current block
sn w3 x1 ; and flag.ident table(i)<>st flag then
rs w0 x2-2 ; ident table(i):=not declared not used;
al w2 x2+4 ;
sh. w2 (f40.) ;
jl. a8. ;
al w3 2<4 ;
ba. w3 f4. ;
hs. w3 f4. ; current block:= current block+2;
c14: jl. w3 d5. ; unstack for labels:
rs. w2 f7. ; unstack decl(spec top);
jl. c0. ; goto next;
d5: rs. w3 f41. ; procedure unstack decl(stop inf);
ds. w1 f43.+2 ; integer stop inf; comment output in w2;
rl. w3 f6. ; begin
a9: rl w2 x3-4 ; for ident:= decl stack(decl top - 4)
sn w2 0 ; while ident <> 0 do
jl. a10. ; begin
dl w1 x3 ; ident table(ident):= decl stack(decl top);
ds w1 x2 ; decl top:= decl top - 6;
al w3 x3-6 ; end;
jl. a9. ; comment decl top points at stack-stop;
a10: rl w2 x3 ; stop inf:= decl stack(decl top);
rl w0 x3-2 ; context :=
hs. w0 b16. ; decl stack(top-2);
al w3 x3-6 ; decl top:= decl top - 6;
rs. w3 f6. ; end;
dl. w1 f43.+2 ;
jl. (f41.) ;
c41: jl. w3 d25. ; decl zone:
jl. w3 e11. ; w0:=w2:=next relevant; repeat input byte;
sn w2 h47 ; if byte = context zone ident then
hs. w2 b16. ; context := true;
jl. c0. ; goto next;
\f
;rc 1977.11.03 algol 6, pass 5, page ...14...
c15: b16=k+1;context ; output descriptions:
sn w3 x3 ;
se w2 h49 ; if -,context and ident = exit
jl. a37. ; then
al w0 h51 ; error(<:context label:>);
jl. w3 d16. ;
a37: ls w2 2 ;
wa. w2 f25. ; ident:= byte*4 + ident table base;
d6: al w1 2.1111 ; descript:= ident table(ident);
la w1 x2-1 ; normal out: flag:= flag part.descript;
sn w1 4 ; if flag= proc value then
jl. d10. ; goto proc value;
sn w1 8 ; if flag= not declared not used then
jl. d15. ; goto undeclared;
sl w1 14 ; if flag= first use of standard then
jl. d19. ; goto first st use;
d7: bz w0 x2 ; continue out: outbyte:= kind part.descript;
sn w0 h15 ; if outbyte=<for label> then
jl. d13. ; goto for label error;
sn w1 5 ; if flag = own then
jl. d8. ; goto cont dope out;
b11=k+1; local mode ;
se w3 x3 ; if local mode then
jl. d14. ; goto check local;
d8: jl. w3 e3. ; cont dope out:
bl w0 x2-2 ; output(outbyte);
jl. w3 e3. ; output(rel addr part.descript);
bl w0 x2-1 ; outbyte:= block part.descript shift -4;
ls w0 -4 ; if flag= own then
sn w1 5 ; outbyte:= no of fictive own block;
al w0 h16 ;
jl. w3 e3. ; output(outbyte);
sh w1 1 ; if flag = array with subs or
jl. d12. ; flag = formal array with subs then
sn w1 7 ; goto output dope description;
jl. a13. ; if flag = parproc then goto output spec;
d9: rl. w3 e9. ; count output:
al w3 x3+1 ; information 1:= information 1 + 1;
rs. w3 e9. ; goto if -,outerror then next else outerr;
j9: jl. c0. ;
d10: rs. w2 f23. ; proc value: store(ident);
jl. w3 d25. ; byte:= next relevant;
jl. w3 e11. ; repeat input byte := true;
se w2 h19 ; if byte <> <first:=> and byte<> <:=> then
sn w2 h20 ; begin
jl. a12. ; take proc decl from stack:
am. (f23.) ;
bz w2 1 ; ident:= ref part.descript + decl base;
al. w2 x2+j6. ; descript:= decl stack(ident); goto normal out;
jl. d6. ; end;
a12: rl. w2 f23. ; restore(ident);
al w1 6 ; flag:= normal identifier;
jl. d7. ; goto continue out;
d30: bz. w0 b6. ; outerr:
jl. w3 d16. ; error(error type);
al w3 c0-j9 ; outerror:= false;
hs. w3 j9.+1 ; goto next;
jl. c0. ;
;d11: see p. 19
\f
;rc 4.12.1970 algol 6, pass 5, page ...15...
d12: bl w2 x2+1 ; output dope description:
wa. w2 f21. ; stack ref:= ref part.descript+spec base;
al w2 x2+2 ; description:= spec stack(stack ref);
al w1 6 ; flag:= normal identifier;
bz w0 x2 ; outbyte:= kind part.descript;
jl. d8. ; goto cont dope out;
a13: bl w2 x2+1 ; output spec:
jl. a15. ; stack ref:= refpart.descript+specbase; goto inn;
a14: al w2 x2-2 ; next word: stack ref:= stack ref - 2;
a15: am. (f21.) ; inn: stack word:= spec stack(stack ref);
rl w1 x2 ;
al w0 0 ; spec:= stack word // 2**18;
ld w1 6 ; stack word:= stack word shift 6 + endmark;
al w1 x1+63 ;
a16: sn w0 0 ; next spec: if spec = 0 then
jl. d9. ; goto count output;
sn w0 63 ; if spec = endmark then
jl. a14. ; goto next word;
ba. w0 f19. ; spec:= spec + spec output base;
jl. w3 e3. ; output(spec);
al w0 0 ; spec:= stack word // 2**18;
ld w1 6 ; stack word:= stack word shift 6;
jl. a16. ; goto next spec;
d14: bl w3 x2-1 ; check local:
la. w3 f5. ;
sn. w3 (f4.) ; if block no. descript <> current block
sn w0 h4 ; or outbyte = <undeclared> then
jl. d8. ; goto cont dope out;
se w1 9 ; if flag=formal or
sn w1 0 ; flag=formal array with subs then
jl. d8. ; goto cont dope out;
am h22-h21; error type:= <local>; goto a;
d13: am h21-h23; for label error: error type:=<for label>; goto a;
d15: al w0 h23 ; undeclared: error type:=<-decl>;
hs. w0 b6. ; a:
al w0 d30-j9 ; outerror:= true;
hs. w0 j9.+1 ;
dl. w1 f4.+2 ; rel addr part.descript:= 0;
bz w0 1 ;
ba. w0 f8. ; block part.descript:= current block+normal flag;
bz. w3 b6. ; kind part.descript:= <undeclared>;
sn w3 h21 ; if error type = <local> then
al. w2 f2. ; stack decl(ident);
sn w3 h22 ; if error type <> <for label> then
jl. w3 d27. ; ident table(ident):= descript;
ds w1 x2 ;
jl. d6. ; goto normal out;
d16: rs. w3 f23. ; procedure error(error type);
hs. w0 b6. ; value error type; integer error type;
al w0 h5 ; begin
jl. w3 e3. ; output(<error>);
b6=k+1; error type ; output(error type);
al w0 ; end;
jl. w3 e3. ;
jl. (f23.) ;
\f
;rc 1977.11.24 algol 6, pass 5, page ...16...
c16: al w3 0 ; set head count:
hs. w3 b7. ; head count:= 0;
jl. c0. ; goto next;
c17: bz. w0 b0. ; end bound head:
jl. w3 e3. ; output(type);
d17:
b7=k+1; head count ; zone head:
al w0 ; output(head count);
jl. w3 e3. ;
d18: ; zone array head:
b8=k+1; ext or rel ;
al w0 ;
jl. w3 e3. ; output(ext or rel);
hs. w0 b11. ; local mode:= true;
jl. w3 d28. ; set stop;
c18: am c15-c4 ; set descr: ident action:=output description;
c19: am c4-c2 ; goto next;
c20: al w3 c2-j0 ; set check: ident action:= check declarations;
hs. w3 j0.+1 ; goto next;
sn w3 c2-j0 ; set for label: ident action := for label;
jl. w3 d28. ; set stop;
jl. c0. ; goto next;
c21: am d18-d17; end zone arr head:set return(zone array head);
c22: al. w1 d17. ; copy 1;
jl. c31. ; end zone head: set return(zone head); copy 1;
c23: al w0 h37 ; end check local:
jl. w3 e3. ; output(<end zone local>);
am c0-c19 ; set return(next); goto reset local;
c24: al. w1 c19. ; end bounds: set return(set check);
al w3 0 ; reset local:
hs. w3 b11. ; local mode:= false;
jl. w3 d5. ; unstack decl(no interest);
jl x1 ; return;
d28: rs. w3 f41. ; procedure set stop;
rl. w3 f6. ; begin
al w3 x3+6 ; decl top:= decl top + 6;
rs. w3 f6. ; decl stack(decl top):=
jl. w3 d3. ; check stack;
rs. w3 (f6.) ; comment spec top as stop inf;
bz. w3 b16. ;
am. (f6.) ; decl stack(top-2) :=
rs w3 -2 ; context;
al w3 0 ; decl stack(decl top-4):= 0;
am. (f6.) ; end;
rs w3 -4 ;
jl. (f41.) ;
\f
; rc 1977.11.24 algol 7, pass 5, page ...16a...
c42: jl. w3 d25. ; begin zone:
jl. w3 e11. ; next relevant; repeat input byte;
h53=k+1; procedure block
se w3 x3+0 ; if procedure block
se w2 h47 ; and byte = context zone then
jl. a38. ; begin
al w0 h52 ; error(<:context proc:>);
jl. w3 d16. ; goto set head count;
jl. c16. ; end;
a38: bz. w0 b16. ;
se w0 0 ; if context
sn w2 h47 ; and
jl. c16. ; byte <> context zone ident
al w0 h50 ; then
jl. w3 d16. ; error(<:context zone:>);
jl. c16. ; goto set head count;
\f
; rc 4.12.1970 algol 6, pass 5, page ...17...
d19: rl w0 x2-2 ; first st use:
as w0 -4 ; st address:= bit0-19.ident table(ident)
wa. w0 f27. ; shift-4 + st table base;
rl. w3 f29. ;
sn w3 0 ; if chain last = 0 then
al. w3 f28. ; chain start:= st address else
rs w0 x3 ; chain part.st table(chain last):= st address;
rs. w0 f29. ; chain last:= st address;
bz. w3 i1.+f10;
al w3 x3+1 ; rel addr part.ident table(ident):=
hs. w3 i1.+f10; ext no:= ext no + 1;
hs w3 x2-2 ; flag.ident table(ident):= flag-st flag diff;
al w1 x1+(:h16+1:)<4-h26; block.ident table(ident):=
hs w1 x2-1 ; fictive outer block no +1;
jl. d6. ; goto normal out;
c25: al w3 g9 ; begin external:
hs. w3 g5. ; action table(decl no par proc):= decl ext proc;
hs. w3 g16. ; action table(decl no proc not) := decl ext proc;
al w3 g10 ; action table(decl parproc) := decl ext proc;
hs. w3 g17. ; action table(decl parproc not) := decl ext parproc;
hs. w3 g6. ; comment set action table to external;
al w3 -2<4 ;
hs. w3 f4. ; current block:= -2;
hs. w3 b9. ; external:= true;
jl. w3 e2. ; input(dummy byte);
jl. d4. ; goto block start;
c26: al. w3 c0. ; end external:
b9=k+1;external ; set return(next);
sn w3 x3 ; if -,external then
jl. d29. ; out end;
al w0 h27 ;
jl. w3 e3. ; output(<end external>);
al. w2 f30. ;
a29: bz w0 x2 ; for i:= 1 step 1 until 4 do
jl. w3 e3. ; output(ext spec(i));
al w2 x2+1 ;
se. w2 f30.+4 ;
jl. a29. ;
jl. d24. ; goto cont end;
\f
;rc 04.05.1971 algol 6, pass 5, page ...18...
c27: ld w1 50 ; decl ext proc:
al. w3 c0. ; spec1:= spec2:= 0; set return(next);
jl. a17. ; goto contin;
c28: dl. w1 (f20.) ; decl ext par proc: spec1:= spec stack(spec ref);
rx w1 0 ; spec2:= spec stack(spec ref - 2);
al. w3 c7. ; set return(par proc decl);
a17: bz. w2 f2. ; contin:
bz. w2 x2+g15. ; extkind:= ext kind table(type) shift 18;
ls w2 18 ;
sz w0 2.111111; if last spec.spec1 <> 0 then
jl. a19. ; goto test spec2 ;
al w1 0 ; spec2:= 0;
a18: ld w1 -6 ; set ext spec:
wa w0 4 ; ext spec(1:2):=
ds. w1 f30.+2 ; extkind + (spec1 con spec2) shift (-8);
al w2 c0-j1 ;
hs. w2 g5. ; action table(decl no par proc):= next;
hs. w2 g16. ; action table(decl parproc not) := parproc decl;
al w2 c7-j1 ; action table(decl par proc):= par proc decl;
hs. w2 g17. ; action table(decl no par not) := nexti;
hs. w2 g6. ; comment reset action table;
jl x3 ; return;
a19: sz w1 2.111111; test spec2:
jl. a33. ; if last spec. spec2 = 0 then
jl. a18. ; goto set ext spec;
a33: jl. w1 e5. ; alarm(<:ext param:>);
<:ext param<0>:> ;
g9 = c27-j1 ; table address of decl ext proc;
g10= c28-j1 ; - - - decl ext par proc;
h.
g15=k-h46
3,4,5,2,1 ; ext kind table: int, real, long, bool, not
3,4,5,2,1 ; int, real, long, bool, not
w.
j4: c29 ; comment copy procedures called with return in w1;
j5: c30 ;
c29: rx. w1 j4. ; procedure copy 4;begin copy 2; copy 2 end;
c30: rx. w1 j5. ; procedure copy 2;begin copy 1; copy 1 end;
c31: jl. w3 e2. ; procedure copy 1;
al w0 x2 ; begin input(byte);
jl. w3 e3. ; output(byte);
jl x1 ; end;
d20: al w0 h28 ; nl:
jl. w3 e3. ; output(<newline>);
jl. w3 e1. ; nl counter:= nl counter + 1;
jl. d11. ; return(nxt rel 1);
c32: jl. w3 e1. ; nl action: nl counter:= nl counter + 1;
jl. c0. ; goto next;
\f
; jz 1979.10.09 algol 8, pass 5, page ...19...
d21: al w0 h5 ; treat error:
jl. w3 e3. ; output (<error>);
jl. w1 c31. ; copy 1;
jl. d11. ; return(nxt rel 1);
c33: jl. w1 c31. ; error action:
jl. c0. ; copy 1; goto next;
c34: rl. w0 f4. ; end pass 5:
sh w0 h16<4-1; if current block no < no of fictive
jl. w3 d29. ; outer block then
al w0 h30 ; out end;
jl. w3 e3. ; output(<endpass>);
d24: bz. w0 f9. ; cont end:
jl. w3 e3. ; output(no of globals);
bz. w0 i1.+f10; no of st proc:=
bs. w0 f9. ; st ext no - no of ext + 1;
ba. w0 1 ;
jl. w3 e3. ; output(no of externals);
rl. w1 f28. ; next st:= chainstart;
a30: sn w1 0 ; for i:= next st while i<>0 do
jl. w3 a40. ; begin
al w2 x1+2 ; for j:= i+2 step 1 until i+13 do
a20: bz w0 x2 ; output(byte.st table(j));
jl. w3 e3. ; comment <8 bytes name> and
al w2 x2+1 ; <4 bytes kind and spec>;
se w2 x1+14 ; next st:= chain part. st table (i)
jl. a20. ; end st proc output;
rl w1 x1 ; goto take next pass;
jl. a30. ;
a40: al. w2 b17. ;
a39: bz w0 x2 ; output the pseudo
jl. w3 e3. ; external entry
al w2 x2+1 ; with the algol
se. w2 b18. ; version number;
jl. a39. ; used by pass9 only
jl. e7. ; goto next pass;
d25: rs. w3 f41. ; next relevant: store(return);
d11: jl. w3 e2. ; nxt rel 1: input(byte);
al w0 x2 ; outbyte:= byte;
al. w3 d11. ; set return from output(nxt rel1);
sn w2 h17 ; if byte = <newline> then
jl. d20. ; goto nl;
sn w2 h18 ; if byte = <error> then
jl. d21. ; goto treat error;
se w2 h24 ; if byte = <vanished operand> or
sn w2 h38 ; byte = <internal operand> then
jl. e3. ; output(outbyte);
jl. (f41.) ; return;
;c35: see p. 10
;c36: see p. 10
;d26: see p. 8
;d27: see p. 9
;d28: see p. 16
;c37: see p. 11
d29: rs. w3 f41. ; procedure out end;
al w0 h39 ; begin
jl. w3 e3. ; output(<end block>);
al w0 h40 ; output(<exit block>);
jl. w3 e3. ;
jl. (f41.) ; end;
b17: <:*version:>,0, e103, 0 ; pseudo external list item (version)
b18:
\f
; rc 9.1.1971 algol 6, pass 5, page ...20...
h.
; kind table entry : kind - type
g0=k-3 ; kind base
h36+26 ; 3 decl switch : switch
h14 ; 4 decl label : label
h15 ; 5 decl for label : for label
h4 ; 6 decl undef proc : undeclared
h36+51 ; 7 decl zone : zone
h36+57 ; 8 decl zone array : zone array
h36+27 ; 9 formal label : formal label
h4 ; 10 formal general : undeclared
h4 ; 11 formal unspec : undeclared
h36+28 ; 12 formal switch : formal switch
h36+80 ; 13 formal zone : formal zone
h36+57 ; 14 take zone array : zone array
0 ; 15 beg switch : -
;type limit
h7 ; 16 beg parproc : simple
0 ; 20 beg parproc not : -
h7 ; 24 beg no parproc : simple
0 ; 28 beg no par not : -
h36+29 ; 32 decl no parproc : proc no par
h36+33 ; 36 decl no par not : proc no par
h36+34 ; 40 decl parproc : par proc
h36+38 ; 44 decl par not : par proc
h7 ; 48 decl simple : simple
h36+43 ; 52 decl field : field
h36+47 ; 56 decl array field : array field
h7 ; 60 decl own : simple
h36+52 ; 64 decl array : array
h36+52 ; 68 take array : array
h7 ; 72 take value : simple
h36+58 ; 76 formal proc : formal proc
h36+62 ; 80 formal proc not : formal proc
h36+63 ; 84 formal simple : formal simple
h36+67 ; 88 formal field : formal field
h36+71 ; 92 formal array field : formal array field
h36+75 ; 96 formal string : formal string
h36+76 ; 100 anonymous array : anonymous array
0 ; 104 begin bounds : -
;output-action limit
g11=k-h2; kindbase 2
0 ; 108 begin zone : -
0 ; 109 begin zone array : -
h28 ; 110 newline : newline
h36+5 ; 111 begin block : beg block
h36+4 ; 112 begin external : begin ext
0 ; 113 endpass : -
h36+17 ; 114 begin list : beg list
h36+18 ; 115 begin list field : beg list
0 ; 116 specifications : -
0 ; 117 label colon : -
h36+21 ; 118 end zone arr head : beg zone array
h36+20 ; 119 end zone head : beg zone
h36+19 ; 120 end bounds head : beg bounds
h36+10 ; 121 end bounds : end bounds
h36+11 ; 122 end zone decl : end zone decl
0 ; 123 end head : -
0 ; 124 end decl : -
0 ; 125 end check local :
h40 ; 126 exit block : exit block
\f
; rc 4.12.1970 algol 6, pass 5, page ...21...
; kind table entry : kind - type
0 ; 127 end external : -
h36 ; 128 do : do
h36+1 ; 129 end do : end do
h36+2 ; 130 end single do : end single do
h36+14 ; 131 exit proc no type : exit proc no type
h36+15 ; 132 exit type proc : exit type proc
h36+81 ; 133 integer literal : integer literal
h36+82 ; 134 real literal : real literal
h36+83 ; 135 long literal : long literal
h36+84 ; 136 boolean literal : boolean literal
h36+85 ; 137 string first : string first
h36+86 ; 138 string next : string next
h5 ; 139 error : error
; count table entry : counter ,ext, flag
g1=k-3; count base
f11 <5+ 1 <4+ 6 ; 3 decl switch : global ,yes, normal
f11 <5+ 1 <4+ 6 ; 4 decl label : global ,yes, normal
f11 <5+ 1 <4+ 6 ; 5 decl for label : global ,yes, normal
f11 <5+ 1 <4+10 ; 6 decl undef proc : global ,yes, undef proc
f12 <5+ 2 ; 7 decl zone : variable addr ,no , zone
f12 <5+ 2 ; 8 decl zone array : variable addr ,no , zone
f14 <5+ 9 ; 9 formal label : formal addr ,no , formal
f14 <5+ 9 ; 10 formal general : formal addr ,no , formal
f14 <5+ 9 ; 11 formal unspec : formal addr ,no , formal
f14 <5+ 9 ; 12 formal switch : formal addr ,no , formal
f14 <5+ 9 ; 13 formal zone : formal addr ,no , formal
f14 <5+ 9 ; 14 formal zone array : formal addr ,no , formal
4 ; 15 beg switch : - ,no , proc value
;type limit
f12 <5+ 4 ; 16 beg par proc : variable addr ,no , proc value
f12 <5+ 4 ; 20 beg parproc not : variable addr ,no , proc value
f12 <5+ 4 ; 24 beg no parproc : variable addr ,no , proc value
f12 <5+ 4 ; 28 beg no par not : variable addr ,no , proc value
f11 <5+ 1 <4+ 6 ; 32 decl no parproc : global ,yes, normal
f11 <5+ 1 <4+ 6 ; 36 decl no par not : global ,yes, normal
f11 <5+ 1 <4+ 7 ; 40 decl parproc : global ,yes, parproc
f11 <5+ 1 <4+ 7 ; 44 decl par not : global ,yes, parproc
f12 <5+ 6 ; 48 decl simple : variable addr ,no , normal
f12 <5+ 6 ; 52 decl field : variable addr ,no , normal
f12 <5+ 6 ; 56 decl array field : variable addr ,no , normal
f13 <5+ 5 ; 60 decl own : own addr ,no , own
f12 <5+ 1 ; 64 decl array : variable addr ,no , array subscr
f12 <5+ 0 ; 68 take array : variable addr ,no , form arr sub
f14 <5+ 9 ; 72 take value : formal addr ,no , formal
f14 <5+ 9 ; 76 formal proc : formal addr ,no , formal
f14 <5+ 9 ; 80 formal proc not : formal addr ,no , formal
f14 <5+ 9 ; 84 formal simple : formal addr ,no , formal
f14 <5+ 9 ; 88 formal field : formal addr ,no , formal
f14 <5+ 9 ; 92 formal array field: formal addr ,no , formal
f14 <5+ 9 ; 96 formal string : formal addr ,no , formal
f14 <5+ 9 ; 100 anonymous array : formal addr ,no , formal
f14 <5+ 6 ; 104 begin bounds : formal addr ,no , normal
\f
; rc 1977.11.03 algol 6, pass 5, page ...22...
; increment table entry : increment
g2=k-3 ; incr base
f36-j2 ; 3 decl switch : ext
f36-j2 ; 4 decl label : ext
f36-j2 ; 5 decl for label : ext
f36-j2 ; 6 decl undef proc : ext
f34-j2 ; 7 decl zone : zone
f38-j2 ; 8 decl zone array : zone array
f35-j2 ; 9 formal label : formal
f35-j2 ; 10 formal general : formal
f35-j2 ; 11 formal unspec : formal
f35-j2 ; 12 formal switch : formal
f35-j2 ; 13 formal zone : formal
f35-j2 ; 14 take zone array : formal
0 ; 15 beg switch : -
;type limit
f39-j2 ; 16 beg parproc : simple
f39-j2 ; 20 beg par not : simple
f39-j2 ; 24 beg no parproc : simple
f39-j2 ; 28 beg no par not : simple
f36-j2 ; 32 decl no parproc : ext
f36-j2 ; 36 decl no par not : ext
f36-j2 ; 40 decl parproc : ext
f36-j2 ; 44 decl par not : ext
f39-j2 ; 48 decl simple : simple
f37-j2 ; 52 decl field : field
f37-j2 ; 56 decl array field : field
f39-j2 ; 60 decl own : simple
f37-j2 ; 64 decl array : array
f37-j2 ; 68 take array : array
f35-j2 ; 72 take value : formal
f35-j2 ; 76 formal proc : formal
f35-j2 ; 80 formal proc not : formal
f35-j2 ; 84 formal simple : formal
f35-j2 ; 88 formal field : formal
f35-j2 ; 92 formal array field : formal
f35-j2 ; 96 formal string : formal
f35-j2 ; 100 anonymous array : formal
f35-j2 ; 104 begin bounds : formal
; action table entry : action
g3=k-3 ; action base
c0-j1 ; 3 decl switch : next
c0-j1 ; 4 decl label : next
c0-j1 ; 5 decl forlabel : next
c0-j1 ; 6 decl undef proc : next
c41-j1 ; 7 decl zone : decl zone
c0-j1 ; 8 decl zone array : next
c37-j1 ; 9 formal label : formal
c37-j1 ; 10 formal general : formal
c37-j1 ; 11 formal unspec : formal
c37-j1 ; 12 formal switch : formal
c37-j1 ; 13 formal zone : formal
c35-j1 ; 14 take zone array : take zone array
c10-j1 ; 15 beg switch : beg proc
\f
; rc 1977.11.03 algol 6, pass 5, page ...23...
; action table entry : action
; type limit
c10-j1 ; 16 beg par proc : beg proc
c10-j1 ; 20 beg parproc not : beg proc
c10-j1 ; 24 beg no parproc : beg proc
c10-j1 ; 28 beg no par not : beg proc
g5: c0 -j1 ; 32 decl no parproc : next
g16:c0 -j1 ; 36 decl no par not : next
g6: c7 -j1 ; 40 decl parproc : par proc decl
g17:c7 -j1 ; 44 decl par not : par proc decl
c0 -j1 ; 48 decl simple : next
c0 -j1 ; 52 decl field : next
c0 -j1 ; 56 decl array field : next
c0 -j1 ; 60 decl own : next
c6 -j1 ; 64 decl array : array declaration
c5 -j1 ; 68 take array : take
c36-j1 ; 72 take value : take value
c37-j1 ; 76 formal proc : formal
c37-j1 ; 80 formal proc not : formal
c37-j1 ; 84 formal simple : formal
c37-j1 ; 88 formal field : formal
c37-j1 ; 92 formal array field: formal
c37-j1 ; 96 formal string : formal
c37-j1 ; 100 anonymous array : formal
c16-j1 ; 104 begin bounds : set head count
; output action limit
g12=k-h2 ; action base 2
c42-j7 ; 108 begin zone : begin zone
c0 -j7 ; 109 begin zone array : next
c32-j7 ; 110 newline : nl action
c11-j7 ; 111 begin block : begin block
c25-j7 ; 112 begin external : begin external
c34-j7 ; 113 endpass : end pass 5
c31-j7 ; 114 begin list : copy 1
c31-j7 ; 115 begin list field : copy 1
c9 -j7 ; 116 specifications : specifications
c3 -j7 ; 117 label colon : label colon
c21-j7 ; 118 end zone arr head : end zone array head
c22-j7 ; 119 end zone head : end zone head
c17-j7 ; 120 end bounds head : end bounds head
c24-j7 ; 121 end bounds : end bounds
c19-j7 ; 122 end zone decl : set check
c18-j7 ; 123 end head : set descr
c19-j7 ; 124 end decl : set check
c23-j7 ; 125 end check local : end check local
c13-j7 ; 126 exit block : end block
c26-j7 ; 127 end external : end external
c20-j7 ; 128 do : set for label
c14-j7 ; 129 end do : unstack for labels
c14-j7 ; 130 end single do : unstack for labels
c12-j7 ; 131 exit proc no type : end proc
c12-j7 ; 132 exit type proc : end proc
c30-j7 ; 133 integer literal : copy 2
c29-j7 ; 134 real literal : copy 4
c29-j7 ; 135 long literal : copy 4
c31-j7 ; 136 boolean literal : copy 1
c29-j7 ; 137 string first : copy 4
c29-j7 ; 138 string next : copy 4
c31-j7 ; 139 error : copy 1
\f
;rc 4.12.1970 algol 6, pass 5, page ...24...
w.
;following initialization code is later overwritten by
;stacks and tables so j6 becomes decl base, see pg.2;
i3= k-i2; entry pass 5 address
j6: al. w3 c29. ; initialize pass 5:
rs. w3 j4. ; initialize(addresses in copy procedure);
al. w3 c30. ;
rs. w3 j5. ;
jl. w3 e2. ; input (no of ext);
bl w0 5 ;
hs. w2 f9. ;
hs. w2 i1.+f10 ; st ext no:= no of ext;
jl. w3 e2. ; input (no of own cells);
al. w1 f44. ;
sh w2 2047 ; if no of ext < 0 or
sh w0 -1 ; no of own cells < 0 then
jl. w3 e5. ; alarm(<:variables:>);
al w0 x2 ; output (no of own cells);
jl. w3 e3. ;
al w2 x2-1 ;
hs. w2 i1.+f13 ; own address:= no of own cells - 1;
jl. w3 e2. ; input (identifier limit);
ls w2 2 ; init ident table:
rl. w3 e9.+4 ; if last work for pass mod 2<> 0 then
sz w3 1 ; last work for pass:= last work for pass -1;
al w3 x3-1 ; max ident addr:= last work for pass;
rs. w3 f40. ; ident table base:=
ws w3 4 ; last work for pass - identifier limit *4;
rs. w3 f25. ;
wa. w3 f31. ; min ident addr:= ident table base + 512 * 4;
rs. w3 f24. ;
sh. w3 j6. ; if min ident addr<= init pass 5 addr then
jl. i0. ; alarm(<:stack:>);
rl. w1 f40. ;
al w2 8 ; not declared not used:=0+ not used flag;
a21: rs w2 x1-2 ; for i:= max ident step -4 until min ident do
al w1 x1-4 ; first word.ident table(i):=
sl w1 x3 ; not declared not used;
jl. a21. ; first free:=
rs. w1 f27. ; st table base:= min ident -4;
jl. w3 e2. ; read st proc: input (byte);
a22: sn w2 0 ; for i:= first free - 11 while byte<>0 do
jl. a24. ; begin
al w1 x1-14 ; first free:= first free - 14;
al w0 x1+3 ;
sh. w1 j8. ; if first free<= last pass 5 addr then
jl. i0. ; alarm (<:stack:>);
a23: hs w2 (0) ; for j:= i step 1 until i+12 do
jl. w3 e2. ; begin
ba. w0 1 ; st proc table (i):= byte;
se w0 x1+16 ; input (byte);
jl. a23. ; end;
jl. a22. ; end;
\f
; jz.fgs 1983.03.30 algol 6, pass 5, page ...25...
a24: rs. w1 f21. ; treat st proc:
rs. w1 f7. ; spec base:= spec top:= first free;
al. w0 j6. ;
rs. w0 f6. ; decl top:= addr (init pass 5);
al w1 x1+2 ; st:= first free+2;
d22: sl. w1 (f27.) ; new st proc: if st >= st table base then
jl. c0. ; goto next;
al w2 0 ; kindspec1:= word.st proc table(st+10);
dl w0 x1+12 ; kindspec2:= word.st proc table(st+12);
ls w3 1 ; bit 0 = compiler (0:algol, 1:fortran) ignored
ld w3 5 ; kind:= bit 1-5.kindspec1;
sl w2 8 ; if kind < 8then
jl. a27. ; begin
bz. w2 x2+g13. ; comment standard procedure;
hs. w2 b10. ; st kind:= proc kind table(kind);
se w3 0 ; if bit6-23.kind spec1<>0
sn w2 h4 ; and st kind <> <undecl> then
jl. a26. ; begin comment parameters;
ls w3 -6 ;
ld w0 6 ; kindspec1and2:= kindspec1and2 shift 6;
rs. w3 (f7.) ; spec stack(spec top):= kindspec1;
jl. w3 d3. ; check stack; specref:= spec top;
al w3 x3-2 ; spec top:= spec top-2;
am (x1+12) ;
sn w3 x3 ; if kindspec2 <> 0 then
jl. a25. ; begin comment more param;
rs w0 x3 ; spec stack(spec top):= kindspec2;
al w3 x3-2 ; spec top:= spec top - 2;
a25: rx. w3 f7. ; end;
ws. w3 f21. ; spec ref:= spec ref - spec base;
al w0 15 ; flag:= par proc+st flag diff;
jl. d23. ; end parameter proc else
a26: se w2 h4 ; begin if st kind <> <undecl> then
al w2 x2+h32 ; st kind:= st kind + par kind diff;
jl. a28. ; flag:= normal ident+st flag diff;
; end no parameter proc;
; end proc else
a27: ; begin
; comment standard variable or zone;
bz. w2 x2+g14. ; st kind:= st var table(kind);
a28: hs. w2 b10. ; flag:= normal ident + flag diff;
al w0 14 ; end standard variable or zone;
\f
;rc 11.1.1971 algol 6, pass 5, page ...26...
d23: bz w2 x1+1 ; load ident table:
ls w2 2 ; ident:= st proc table (st+1)*4
wa. w2 f25. ; + ident table base;
hs w3 x2+1 ; ref part.ident table (ident):= spec ref;
b10=k+1; st kind ;
al w3 ; kind part.ident table(ident):= st kind;
hs w3 x2 ;
al w3 x1 ; st addr:= (st - st table base)shift 4;
ws. w3 f27. ;
ls w3 4 ;
lo w3 0 ; st addr:= st addr + flag;
rs w3 x2-2 ; bit 0-19. ident table (ident):= st addr;
al w0 0 ;
rs w0 x1 ; chain part. st table (st):= 0;
al w1 x1+14 ; st:= st+14;
j8: jl. d22. ; goto new st proc;
h.
g13=k-1; proc kind table
h36+ 38; 1 param proc no type
h36+ 37; 2 - - boolean
h36+ 34; 3 - - integer
h36+ 35; 4 - - real
h36+36; 5 - - long integer
h4 ; 6 - - long real
h4 ; 7 - - complex
g14=k-8; st var table
h7 + 3; 8 simple boolean
h7 ; 9 simple integer
h7 + 1;10 simple real
h7+2,h4,h4;11, 12, 13 long int, long real, complex
h36+ 51 ;14 zone
;d24 see p.21
;d25 see p.19
;d30 see p.14
;j9 see p.14
w.
g8= k-i2; length of pass 5 in bytes
e30=e30+g8
i.
e.
m. jz 1983.03.30 algol 8, pass 5
\f
▶EOF◀