|
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: 96000 (0x17700)
Types: TextFile
Names: »algpass93tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass93tx «
\f
; fgs.jz 1985.10.03 algol/fortran, pass 9, page 1
s. a203, b33, c50, g62, h35, i10, j10 ; begin segment pass 9;
h8 = 0 ; chain to next catalogentry, relative.
h0 = 2 ; value (rel addr iin entry in external catalog);
h1 = 6 ; area kind - - - - - -
h2 = 8 ; name - - - - - -
h3 = 16 ; entry point - - - - - -
h4 = 18 ; kind and spec - - - - -
h5 = 22 ; ident - - - - - -
h6 = 24 ; sizes - - - - - -
h9 = 26 ; dataentrypoint
h7 = 28 ; entry length - - - - - -
h10 = 64 ; remove process (monitor entry)
h11 = 52 ; create area process - -
h12 = 42 ; look up entry - -
h13 = 16 ; send message - -
h14 = 18 ; wait answer - -
h15 = 44 ; change entry - -
h16 = 76 ;lookup head and tail
h17 = 4 ;process description
h18 = 4 ; name (rel address in fp note)
h19 = 14 ; file number - - - - -
h20 = 16 ; block number - - - - -
h21 = 18 ; content,entry - - - - -
h22 = 20 ; length - - - - -
h23 = 2047; supposed length of shared main entry
h24 =14-h1; length of head-kind rel in ext entry
h28 = 14 ; length of entry in common catalog
h29 = 20 ; length of entry in zonecommon catalog
h30 = 0 ; chain to next common catalog entry, relative
h31 = 2 ; final value
h32 = 4 ; name
h33 = 12 ; length of whole common
h34 = 14 ; description of zonecommon
h35 = 149 ; h35 + 1 = first rs-no for not basic rs.
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 2
k = e0;
w. j0 ; no of bytes in pass 9;
h. j1, 9<1+0 ; entry pass 9, pass no = 9, same direction as pass8;
w. ;
a50: am. (e40.) ; finis assembly:
se w3 x3 ; if stop translation then
jl. e7. ; goto end pass;
; move own core, datapoints and zonecommon
; descriptons to tail of program;
rl. w0 e9.-4 ; outsegment :=
rs. w0 g51. ; segm no for first own :=
rs. w0 g8. ; used segments;
;
; w0 := word to move;
; w1 := index in core;
; w2 := link;
; w3 := index in outputbuffer;
;
rl. w3 g6. ; move core picture:
rl. w1 g28. ;
ac w0 x1 ; length of owns := inf1 :=
wa. w0 g18. ; base of external list -
rs. w0 g52. ; first own
rs. w0 e9. ;
al w0 0 ; rs own1 := <*first free :=*>
rs w0 x1 ; rs own2 := 0; <*no of own/data/zcommon halfs := 0*>
rs w0 x1+2 ; <*rts init knows no of own/data/zcommon halfs*>
al w3 x3+4 ; skip leading two words in outputbuffer;
a85: sl. w1 (g18.) ; if current own address > last own address
jl. a86. ; then goto end own;
rl w0 x1 ;
jl. w2 c22. ; move word(w0) to outputbuffer
al w1 x1+2 ; get address af next own;
jl. a85. ;
; end own:
a86: al w0 0 ; no of bytes moved:=0
rs. w0 g50. ;
rl. w1 g16. ; w1:=address of first catalog entry;
; move data entry points
a87: am (x1+h1) ; nextdata:
sl w1 x1 ; if area kind <> area then
jl. a127. ; goto next entry;
rl w0 x1+h9 ;
se w0 0 ; if data in this unit then
jl. w2 c22. ; move word(w0) to outputbuffer;
a127: rl w0 x1+h8 ; next entry: if last entry then
sn w0 0 ; goto end data;
jl. a88. ;
wa w1 1 ; next entry:=current entry+chain;
jl. a87. ; goto nextdata;
a88: rl. w0 g50. ; enddata:
rs. w0 g53. ; save no of data point bytes;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 3
al w0 0 ;
rs. w0 g50. ; no of bytes moved := 0
rl. w1 g41. ; w1:=address of first zonecommon entry;
; move zonecommon description
a89: rl w0 x1+h30 ; nextzon:
sn w0 0 ; if last zonecommon then
jl. a90. ; goto end copy;
wa w1 1 ; next zonecommon:=current+chain;
rl w0 x1+h31 ; move start of common
jl. w2 c22. ;
rl w0 x1+h34 ; move no of zones, no of shares;
jl. w2 c22. ;
rl w0 x1+h34+2 ; move buffer length
jl. w2 c22. ;
rl w0 x1+h34+4 ; move point for blockprocedure;
jl. w2 c22. ;
jl. a89. ; goto nextzon;
a90: rl. w1 g50. ; endcopy:
rs. w1 g54. ; save no of zonecommonbytes;
wa. w1 g53. ; bytes total := no of zonebytes
wa. w1 g52. ; + no of databytes
rs. w1 g50. ; + no of own bytes
se w1 0 ; if bytes total <> 0 then
jl. w2 c11. ; output last buffer
; transfer values to prog descr vector:
al. w2 b4. ; w2 := addr of prog descr;
dl. w1 e17.+2 ;
ds w1 x2+2 ; modebits word (1:2);
rl. w0 e41. ;
am. (g47.) ;
rl w1 +h0 ;
ds w1 x2+18 ; interrupt mask, entry point to program;
dl. w1 g53. ;
ds w1 x2+22 ; no of own bytes, no of data bytes;
rl. w0 g54. ;
rl. w1 g51. ;
ds w1 x2+26 ; no of zdescr bytes, segm no first own segm;
rl. w0 g42. ;
rs w0 x2+28 ; length of common area;
\f
; fgs.jz 1987.06.04 algol/fortran, pass 9, page 4
; finis program:
rl. w2 e24. ; w2:=address of fp result note
rl. w3 g47. ; w3:=address af program entry
al w0 0 ; block no(note):=
al w1 0 ; file no (note):=
ds w1 x2+h20 ; block no(tail):=
ds w1 x3+h5-2 ; file no (tail):= 0
dl. w1 g36. ; set prog call descr in note and tail;
ds w1 x2+h22 ;
ds w1 x3+h6 ;
rl. w0 b3. ; move prog descr entry from b3
ld w1 -9 ; as seg<12+rel
ls w1 -3 ;
ld w1 -12 ;
rs w1 x3+h4 ; to tail word 7;
dl w1 110 ; set shortclock
ld w1 5 ;
rs w0 x3+h3 ; in tail word 6;
jl. a28. ; goto change.
; finis external procedure:
a52: rl. w3 g16. ; w3:=address of first catalog entry;
am (x3+h1) ;
sn w3 x3 ; if shared entry then
wa w3 x3+h6 ; w3:=address of main entry;
rl. w2 e24. ; w2:=address of fp result note;
dl w1 x3+h6 ; move parameters from tail
ds w1 x2+h22 ; to last part of note;
dl w1 x3+h5-2 ;
ds w1 x2+h20 ;
rl w1 x3+h3 ;
lo. w1 b18. ; set bit 0 in catalog entry
rs w1 x3+h3 ;
rs w1 x2+h19-2 ;
al w1 4 ; content(note):=
hs w1 x2+h21 ; content(tail):= 4
hs w1 x3+h5 ;
; change:
a28: rl. w0 b12. ; set kind and mode
rs w0 x2+2 ; in fp note
c. e77 < 2 ; if system 2 then begin
rl. w1 e17. ; w1:=modebits;
rl. w0 e9.-2 ; w0:=available segments;
so w1 1<7 ; if work area created by pass 0 then
jl. a132. ;
z. ; end system 2;
rl. w0 e9.-4 ; w0:=used segments;
rs w0 x3+h1 ; area length(tail):=w0;
al w0 0 ;
al w1 0 ; clear document name of tail
ds w1 x3+h2+2 ;
ds w1 x3+h2+6 ;
al w1 x3+h1 ; w1:=tail address
al. w3 g5. ; w3:=name of area (output descr)
jd 1<11+h15 ; change entry
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 5
rl. w1 e17. ; if work area created by pass 0 then
sz w1 1<7 ;
jl. e7. ; goto endpass;
rl. w0 (a113.) ;
se w0 0 ; if program
sz w1 1<8 ; or note supplied by fp (always false in system3)
jl. a133. ; then goto add rs segments to prog.;
rl. w3 g16. ; w3:=first entry in catalog
a124: bl w0 x3+h5 ; check entry:
se w0 8 ; if content<> 8 <*not maincat entry*> then
jl. a126. ; goto next entry
al. w2 g0. ; w2 := addr input descr;
dl w1 x3+h2+2 ; save name of external catalog entry
ds w1 x2+2 ; in
dl w1 x3+h2+6 ; name of input descr.;
ds w1 x2+6 ;
rl. w0 b12. ; create new tail
rs w0 x3+h1 ; 1<23 + 4 to modekind in ext cat entry;
al. w2 g5. ; w2 := addr output descr;
dl w1 x2+2 ; name:= name of main entry <*name in output descr*>;
ds w1 x3+h2+2 ; to
dl w1 x2+6 ; name of ext cat entry;
ds w1 x3+h2+6 ;
rl w1 x3+h3 ; set program unit bit (code entry)
lo. w1 b18. ; in entry point for
rs w1 x3+h3 ; catalog entry
al w0 4 ; content:=4
hs w0 x3+h5 ;
rs. w3 g17. ; save address of entry
al w1 x3+h1 ; w1:=tail address
al. w3 g0. ; w3:=name address
jd 1<11+40 ; create entry;
sn w0 3 ; if name conflict then
jd 1<11+44 ; change entry;
se w0 0 ; if result <> 0 then
jl. w1 c7. ; alarm (<:name trouble:>);
jl. a125. ;
<:name trouble<0>:>
a125: rl. w3 g17. ; reset catalog entry
a126: rl w0 x3+h8 ; w0:=chain
sn w0 0 ; if last entry in catalog
jl. e7. ; then goto end pass
wa w3 1 ; w3:=next entry
jl. a124. ; goto check entry
\f
; fgs.jz 1983.06.20 algol/fortran, pass 9, page 6
a133: al w2 0 ; add rs segments to program:
am 2 ;
al. w0 b3. ; w0 := addr prog descr + 2;
el. w1 g58. ; w1 := addr prog descr +
ls w1 9 ; no of rs segments * 512;
al. w1 x1+b3. ;
am. (e9.+4) ; if w1 >= last work for pass +
am 1024 ; gpa input buffers +
sl w1 1026 ; gpa out buffers + 2 then
jl. w1 c9. ; alarm (<:stack:>);
jl. a135. ;
<:stack <0>:> ;
a135: rl. w3 e20. ; first addr output := w0;
ds w1 x3+14 ; last addr output := w1;
rs w2 x3+16 ; outsegment := 0;
rl. w3 e21. ; first addr input := w0;
ds w1 x3+14 ; last addr input := w1;
rl. w2 g25. ; insegment := segm base for rs;
rs w2 x3+16 ;
al. w2 e107. ; move
dl w1 x2+2 ; name of runtime system
ds w1 x3+2 ; to
dl w1 x2+6 ; name gpa input descr;
ds w1 x3+6 ; together with
rl w0 x2+8 ; name table address;
rs w0 x3+8 ;
jl. w3 e90. ; input segments;
rl. w3 e21. ; w3 := gpa input descr;
jl. w2 e59. ; wait segment;
jd 1<11+64 ; remove process (name of rts);
al w1 0 ;
al. w2 b4. ; w2 := index in prog descr;
rl. w3 b3. ; w3 := index in program +
am. (e21.) ; first address input;
wa w3 +18 ;
a123: rl w0 x2 ; repeat
sn w1 (x3) ; if prog (index) <> 0 then
rs w0 x3 ; prog (index) := descr (index);
al w2 x2+2 ; increase
al w3 x3+2 ; indices;
se. w2 b3. ; until index in prog descr =
jl. a123. ; addr of prog descr addr;
jl. w3 e8. ; output segments;
rl. w3 e20. ; w3 := addr of gpa output descr;
jl. w2 e59. ; wait segment;
jl. e7. ; goto end pass;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 7
b4: 0 ; prog descr:
0 ; 30 hwds of working locations mainly
; for transfer of program descriptor
; to runtime system segments:
e103 ; compiler version
e104 ; - release<12 + subrelease
e105 ; - release year<12 + date
b20: 0, r.10 ; during assembly b20 : b20+6 may be
; used as working locations for test-
; output and b4 is used as working location;
b3: 0 ; addr of prog descr: (ends prog descr)
; the following locations are overwritten by add rs segments to program.
b15: 0 ; saved w2, returnaddress
; procedure moveword, w2=returnaddress
; w3=pointer in outputbuffer
; w0=word to set in outbuf
c22: rs. w2 b15. ; save returnaddress;
am. (g7.) ; if not place for this word then
sl w3 +2 ; shiftbuffer;
jl. w2 c11. ;
rs w0 x3 ; set word in buffer;
al w3 x3+2 ; bufferindex:=bufferindex+2
rl. w2 g50. ; no of bytes transferred:=
al w2 x2+2 ; no of bytes transferred + 2
rs. w2 g50. ;
jl. (b15.) ; return
0
b16: 0 ;save registers
0
0
; procedure shiftbuffer: w2=returnaddress
c11: ds. w1 b16. ; save registers;
ds. w3 b16.+4 ;
rl. w1 g8. ;
rl. w3 g47. ; w3:=address of program entry;
sl. w1 (e9.-2) ; if outsegment >= available segments then
jl. a53. ; alarm (<:program too big:>)
jl. w2 c0. ; output segment;
rl. w1 g8. ; outsegment := used segments
al w1 x1+1 ; outsegment + 1
rs. w1 g8. ;
rs. w1 e9.-4 ;
dl. w3 g2. ;
rx. w2 g6. ; shift buffers;
rx. w3 g7. ;
ds. w3 g2. ;
rl. w3 g6. ; w3:=first core output + 4;
al w3 x3+4 ; <*leave 4 halfs on each segment*>
dl. w1 b16. ; w0-w1:=saved wo-w1;
jl. (b16.+2) ; return;
\f
; fgs.jz 1986.03.06 algol/fortran, pass 9, page 8
; next area:
a0: am. (g12.) ;
sn w3 x3 ; if processed <> 0 then
jl. a60. ;
jl. w2 c0. ; begin output segment;
rl. w2 g8. ; outsegment:=
al w2 x2+1 ; outsegment + 1;
rs. w2 g8. ; end;
rs. w2 g27. ; outbase := outsegment;
a60: rl. w3 g15. ;
bz w0 x3+h5 ;
sn w0 8 ; if main catalog entry then
jl. a1. ; begin
al. w3 g0. ; w3:=address of name of process;
rl. w0 g61. ;
sn w0 0 ; if version = 0 then
jl. w1 c17. ; message1 (<:wrong version:>, version);
jl. a13. ; return;
<:wrong version <0>:>
a13: jd 1<11+h10 ; remove process;
se w0 0 ; if not removed then
jl. w1 c17. ; message1 (<:remove proc:>, result);
jl. a1. ; return;
<:remove process <0>:>
; end;
; get next area:
a1: al w0 0 ;
rs. w0 g61. ; version := 0;
rl. w3 g15. ;
a4: rl. w0 e17. ; print pass information:
so w0 1<2 ; if pass information wanted then
jl. a3. ; begin
al w1 x3+h0 ; comment: the pass information is one line
al w2 x1+h1-h0 ; for each entry in the external catalog.
jl. w3 e19.+2 ;
rs. w2 b4. ; the content of the line is the name
a2: bz w0 x1 ; of the entry followed by 6 integers.
jl. w3 e14. ; the integers are:
32<12+6 ; entry segment, entry rel on segment,
al w1 x1+1 ; first segment of this area,
se. w1 (b4.) ; first core in own core area,
jl. a2. ; if area entry then
am (x1) ; first word of date,
sl w3 x3 ;
jl. a56. ; if area entry then
jl. w1 c5. ; second word of the date. the integers
rl. w0 g30. ; are printed in the same order as written
jl. w3 e14. ; above. the first 4 integers are the
48<12+6 ; first 4 bytes of the entry in the
jl. w1 c5. ; external catalog. the last 2 integers
rl. w0 g31. ; are the last 2 words in the external
jl. w3 e14. ; list for the area, or zeroes if
48<12+6 ; the entry does not describe area;
a56: jl. w1 c5. ; writespace;
rl. w1 g15. ; w1 := address(name part(entry));
al w1 x1+h2 ;
el w0 x1 ;
sh w0 0 ; if first half of name > 0 then
jl. a62. ; writetext
jl. w3 e13. ; else
jl. a63. ; writeinteger (rs no);
a62: ac w0 (0) ;
jl. w3 e14. ;
48<12 + 6 ;
al. w1 b33. ;
jl. w3 e13. ;
a63: rl. w3 g15. ; end;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 9
a3: rl w0 x3+h8 ; after inf:
sn w0 0 ; if last entry in external catalog then
jl. a50. ; goto finis assembly;
wa w3 1 ; current entry address:=
rs. w3 g15. ; current entry address + chain;
rl w0 x3+h0+2 ; if base part (entry) = -1 then
se w0 -1 ; begin
jl. a55. ;
al w3 x3+h2 ;
jl. w1 c8. ; message(<:size:>);
jl. a66. ; return;
<:size:> ;
a66: al w3 x3-h2 ;
; start assembly:
a55: am (x3+h1) ; if kind(entry) <= 0 then
sl w3 x3 ;
jl. a4. ; goto print pass information
bz w0 x3+h5 ;
sn w0 8 ; if main catalog entry then
jl. a91. ; begin
al w0 0 ; insegment := 0;
rs. w0 g3. ;
al w3 x3+h2 ; w3 := external.namepart;
rl. w1 g6. ; w1 := first core output <*lookup area*>;
jd 1<11+h16 ; lookup head and tail (w1, w3);
se w0 0 ; if result <> 0 then
jl. a26. ; goto cat error;
bz w2 x3-h2+h5 ; if shared main entry then
sh w2 31 ; begin
jl. a131. ; insegment := content - 32;
al w2 x2-32 ;
rs. w2 g3. ;
rs. w2 g4. ; inbase := insegment;
al w2 h23 ; length := supposed length;
rs w2 x1+14 ; name addr := addr of docname in entry;
am 16-6 ; end else
a131: al w3 x1+6 ; name addr := addr of entry name;
jd 1<11+h11 ; create area process;
se w0 0 ; if result <> 0 then
jl. a26. ; goto cat error;
am +8 ;
rs. w0 g0. ; clear name table addr;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 10
am. g0. ;
al w2 -h2 ; w2 := addr of name in input descr - h2;
jl. w1 c2. ; update name at w2 by name of area process;
am. (g6.) ;
al w2 +h24 ; w2 := entry addr as for external entry;
jd 1<11+h17 ; get area process descr;
am (0) ;
dl w1 -2 ; if entry bases <>
sn w0 (x2-h24+2) ; proc bases then
se w1 (x2-h24+4) ;
jl. w1 c8. ; goto base message;
jl. a5. ; return;
<:bases<0>:> ; message (<:bases:>);
a5: rl. w3 g15. ;
al w3 x3+h2 ; w3 := addr of entry name;
jl. w1 c2. ; update entry name;
bz w0 x2-h24+30 ;
sh w0 31 ; if shared main entry then
jl. a6. ; begin
al w2 x2+2 ; entry addr := entry addr + 2;
al w3 x3+2 ; tail addr := tail addr + 2;
; end;
a6: rl w0 x2+h1 ; compare:
se w0 (x3-h2+h1) ; if tail (tail addr) <> entry (entry addr) then
jl. w1 c9. ; goto entry alarm1 (<:entry changed:>);
jl. a7. ; unused return;
<:entry:> ;
a7: al w3 x3+2 ; entry addr := entry addr + 2;
al w2 x2+2 ; tail addr := tail addr + 2;
am. (g15.) ; if entry addr <> current entry addr then
se w3 h7 ; goto compare;
jl. a6. ; end main catalog entry else
jl. a47. ; begin <*ext cat entry*>
a91: rl. w0 g48. ; insegment:=next insegment;
rs. w0 g3. ;
wa w0 x3+h1 ; next insegment:=next insegment
rs. w0 g48. ; + area size
; end <*ext cat entry*>; end
\f
; fgs.jz 1986.03.03 algol/fortran, pass 9, page 11
a47: rl. w3 g15. ; w3:=saved entry address
al w0 1 ; fortran:=if kind an spec < 0
rl w1 x3+h4 ; then 1
sl w1 0 ;
al w0 0 ; else 0
rs. w0 g46. ;
ls w1 1 ; if program (i.e. kindword1 extract 23 = 0)
sn w1 0 ; then
rs. w3 g47. ; save entry address;
bz w0 x3+h5+1 ; entry address := current entry address;
sl w0 e39-10 ; if start ext list > segm length - 10 then
jl. c13. ; goto relative alarm;
wa. w0 g1. ; current word address :=
rs. w0 b5. ; start of ext list(entry) + first core input;
bz w0 x3+h6 ; program size:=code length(emtry);
rs. w0 g23. ; used segments :=
wa. w0 e9.-4 ; used segments + program size;
rs. w0 e9.-4 ;
sh. w0 (e9.-2) ; if used segments > available segments then
jl. a8. ;
a53: al w3 x3+h2 ;
jl. w1 c9. ; alarm(<:program too big:>);
0 ; unused return;
<:program too big<0>:>;
a8: bz w0 x3+h6+1 ; core length:=
rs. w0 g32. ; byte 2(size part(entry));
bz w0 x3+h0+2 ; program base :=
rs. w0 g9. ; byte 1(base part(entry));
bz w0 x3+h0+3 ; core base :=
rs. w0 g14. ; byte 2(base part(entry));
jl. w2 c1. ; input segment;
jl. w2 c4. ; w0 := next word from external list;
bz w1 0 ;
rs. w1 g34. ; no of globals := byte 1(w0);
bz w0 1 ;
rs. w0 g35. ; no of externals := byte 2(w0);
wa w1 0 ; no of globals and externals :=
rs. w1 g24. ; no of globals + no of externals;
sh. w1 (g38.) ; if no of globals + no of ext > max then
jl. a61. ; begin
rs. w1 g38. ; max := no of globals + no of ext;
rs. w1 e102. ; pass0 (sum2) := max;
rs. w0 e102.-2 ; pass0 (sum1) := no of ext;
a61: ; end;
jl. w2 c4. ; core to copy :=
rs. w0 g33. ; next word from external list;
rl. w3 g46. ; if algol unit then
sn w3 0 ;
al w0 0 ; w0 := 0; (commons = zones = 0)
bz w1 0 ; no of commons:=
rs. w1 g43. ; byte1(w0);
bz w1 1 ; no of zonecommons:=
rs. w1 g44. ; byte2(w0);
al w0 0 ; if fortran unit then
se w3 0 ;
rs. w0 g33. ; core to copy := 0;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 12
rl. w3 g18. ; copy bytes to permanent core
al w1 0 ; index := 0; w3 := base external table;
a9: sl. w1 (g32.) ; next core: if index >= core length
jl. a10. ; then goto global points;
al w1 x1+2 ; index := index + 2;
al w0 0 ; w0 := 0;
sh. w1 (g33.) ; if index <= core to copy then
jl. w2 c4. ; w0 := next word from external list;
rs w0 x3 ; external table(index) := w0;
al w3 x3+2 ; w3 := w3+2;
jl. a9. ; goto next core;
a10: rs. w3 g18. ; global points: base external table := w3;
al w0 0 ; datapoint := false
am. (g15.) ;
rs w0 h9 ;
rl. w1 g34. ; index := 0; count := no of globals;
a11: sh w1 0 ; next global: if count <=0 then
jl. a12. ; goto next external;
al w3 x3+2 ; index := index + 2
al w1 x1-1 ; count := count-1;
jl. w2 c4. ; w0 := next word from external list;
sn w0 0 ; if global=0 (datapoint empty)
jl. a11. ; then goto next global;
bz w2 0 ;
wa. w2 g9. ; segment := byte 1(w0) + program base
sh. w2 (b31.) ; if segment > 4095 then
jl. a105. ; begin
rs. w1 b4. ; save w1;
rl. w2 b31. ; segment := 4095;
al w3 x3+h2 ; w1 := ext cat entry name;
jl. w1 c8. ; message1 (<:size:>, name);
jl. a138. ; return;
<:size<0>:> ;
a138: al w3 x3-h2 ; restore w3;
rl. w1 b4. ; restore w1;
a105: ; end;
hs w2 0 ; byte 1(w0) := segment;
rs w0 x3-2 ; external table(index) := w0;
am. (g34.) ;
sn w1 -1 ; if first global point
am. (g46.) ;
sn w3 x3 ; and fortran unit then
jl. a11. ;
am. (g15.) ; save entry point giving start og
rs w0 h9 ; datainit code;
jl. a11. ; goto next global point;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 13
; next external:
a12: rl. w1 g35. ;
sl w1 1 ; if no of externals > 0 then
jl. a29. ; goto search for external;
rs. w3 g45. ; save start of commonlist
a108: rl. w1 g43. ;
sl w1 1 ; if no of commons > 0 then
jl. a72. ; goto search for common
rl. w1 g44. ;
sl w1 1 ; if no of zonecommons > 0
jl. a80. ; then goto search for zonecommon;
jl. w2 c4. ; date 1 :=
rs. w0 g30. ; next word from external list;
jl. w2 c4. ; date 2 :=
rs. w0 g31. ; next word from external list;
jl. w2 c4. ; remove continuation word
al w0 0 ; processed:=0;
rs. w0 g12. ;
jl. a30. ; goto next segment;
; search for external:
a29: al w1 x1-1 ; no of externals:=
rs. w1 g35. ; no of externals - 1;
rs. w3 g22. ; save external table index;
al. w1 a12. ; set returnaddress from search in
rs. w1 b28. ; catalog to next external
al w1 12 ; read the next 12 bytes giving the
rs. w1 g53. ; next element in external list
jl. w2 c12. ;
a121: rl. w2 g16. ; w2:=first entry in external catalog;
; try this entry in external catalog:
a15: dl w1 x3+2 ;
sn w0 (x2+h2) ;
se w1 (x2+h2+2) ; if name part (external list)<>
jl. a49. ;
dl w1 x3+6 ; name part(external catalog) then
sn w0 (x2+h2+4) ;
se w1 (x2+h2+6) ; try next entry in external catalog;
jl. a49. ;
jl. a19. ; goto found;
a49: rl w0 x2+h8 ; get next external in external catalog:
sn w0 0 ; if chain(entry) = 0 then
jl. a16. ; goto search main catalog;
wa w2 x2+h8 ; current entry address:=current entry address
jl. a15. ; + chain;
; goto try this entry in external catalog;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 14
; search main catalog:
a16: rl. w1 g49. ; w1:=last used;
al w1 x1-h7 ; last used:=last used - entry sice;
am. (g22.) ;
sh w1 11 ; if last used <= top external table + 12
jl. a14. ; then goto stack alarm;
rs. w1 g49. ;
ws w1 5 ; chain(last entry):=w1 - w2;
rs w1 x2+h8 ;
wa w1 5 ;
al w0 0 ; chain(new entry) := 0;
rs w0 x1+h8 ;
al w1 x1+h1 ; tail address := last entry address + h1;
jl. w2 c6. ; look up in main catalog and check;
am (x1) ;
sh w3 x3-1 ; if tail(0) > 0 then
jl. a18. ; goto area entry;
rl. w2 g49. ;
bz. w0 i0. ;
se w0 0 ; if share then
jl. a59. ; goto wrong kind
rl w1 x2+h4 ; w1 := kindword (1);
rs. w2 g21. ; saved entry addr := last entry addr;
al w0 0 ;
ls w1 1 ; delete 1. bit of kind and spec
ld w1 5 ; ident type := bits(0,5,kind word 1);
ls w1 -6 ; rs entry := bits(6,23,kindword 1);
sl w0 8 ; if ident type < 8 <*procedure*>
sn w1 0 ; or rs entry = 0 then <*variable in perm core area*>
jl. a17. ; goto share entry;
\f
; fgs.jz 1985.09.26 algol/fortran, pass 9, page 15
al w1 x1-1 ; rs variable:
am (x2+h2) ;
sh w3 x3-1 ; if normal rs entry and
sh. w1 (g39.) ; rs entry - 1 > no of std rs entries then
jl. a58. ; begin
rx w1 6 ; swop (w1, w3);
jl. w1 c16. ; message (<:rs entry:>, rs no);
rx w1 6 ; swop (w1, w3); end;
a58: ls w1 1 ; rs entry := 2 * (rs entry - 1);
am. (g19.) ;
rl w0 x1 ; entry value := rs table (entry value);
am (x2+h2) ; check special rs entry:
sl w3 x3 ; if name (entry) < 0 then
ls w0 12 ; entry value := entry value shift 12;
rs w0 x2+h0 ; value(entry) := entry value;
al w0 0 ;
rs w0 x2+h0+2 ; base part(entry) := 0;
jl. a20. ; goto update entry name;
a17: al w0 1 ; share entry:
hs. w0 i0. ; share := true;
rl. w2 g16. ; entry:=first entry address;
rl. w3 g49. ;
al w3 x3+h2 ; w3 := address(name part(entry));
jl. a15. ; goto search external catalog;
\f
; fgs.jz 1985.09.26 algol/fortran, pass 9, page 16
a18: rl. w2 g49. ; area entry: entry address:=last used;
rl. w0 g20. ; w0 := current bases;
jl. w1 c3. ; update entry value;
jl. w1 c23. ; goto add entry bases to current bases;
jl. w1 c2. ; update entry name;
a19: ; found:
se. w2 (g62.) ; if entry = version entry then
jl. a104. ; begin
rl. w0 g46. ;
sn w0 0 ; if fortran unit <*and pseudo external added*> then
jl. a77. ; noofglobals + noofexternals :=
rl. w1 g24. ; noofglobals + noofexternals - 1;
al w1 x1-1 ;
rs. w1 g24. ;
a77: rl w0 x3+8 ;
rs. w0 g61. ; version :=ext list.entry.kind (1);
sl w0 (x2+h4) ; if version < ext cat.entry.kind (1) then
jl. a23. ; begin <*version < smallest version number in external accepted*>
al. w3 g0. ; name addr := input.name;
jl. w1 c17. ; message1 (<:wrong version:>, version);
jl. a23. ; end;
<:wrong version<0>:>
; goto prepare next external item;
; end;
a104: sn w3 x2+h2 ; found: if entry=ego
jl. a49. ; then goto try next entry;
i0 = k + 1 ; share ;
sn w3 x3 ; if -,share then
jl. a21. ; goto test kind and spec;
a59: rl w0 x2+h1 ; wrong kind: w0 := tail(0) of entry;
sh w0 0 ; if size <= 0 then
jl. w1 c17. ; begin
jl. a70. ; message1 (<:modekind:>);
<:modekind<0>:> ; end else
a70: sl w0 1 ; w0 :=
rl w0 x2+h0+2 ; base part (entry);
rl. w2 g21. ; entry address := saved entry address;
jl. w1 c3. ; update entry value;
a20: rl. w3 g22. ; update name: w3 := external table index;
jl. w1 c2. ; update entry name;
al w0 0 ;
hs. w0 i0. ; share := false;
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 17
a21: rl w0 x3 ; test kind and spec:
sh w0 0 ; if name (entry) <= 0 then
jl. a23. ; goto prepare next external item;
dl w1 x3+10 ;
sn w0 (x2+h4) ; if kind word 1(entry) <> kind word 1(external)
se w1 (x2+h4+2) ; or kind word 2(entry) <> kind word 2(external)
jl. a22. ; then goto kind alarm;
jl. a23. ; goto prepare next external item;
a22: sn w0 -1 ; if kind and spec = -1 (rs-extend)
jl. a23. ; then goto prepare next external
rs. w1 b4. ; kind alarm:
jl. w1 c8. ;
jl. a67. ; return;
<:kind<0>:> ; message(<:kind:>);
a67: jl. w1 c5. ; writespace;
jl. w3 e14. ;
1<23+32<12+8 ; writeinteger(kind word 1(external));
jl. w1 c5. ;
rl. w0 b4. ; writespace;
jl. w3 e14. ;
1<23+32<12+8 ; writeinteger(kind word 2(external));
a23: rl. w3 g22. ; prepare next external item:
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
ds. w3 b20.+6 ;
ds. w1 b20.+2 ;
al w0 c43 ; test 3, value, 2 bytes
rl w1 x2+h0 ;
jl. w2 c19. ;
z. ; end test;
rl w0 x2+h0 ; restore external table index;
rs w0 x3 ; external table(index) := value(entry);
al w3 x3+2 ; index := index + 2;
jl. (b28.) ; goto next external;
b28: 0 ; returnaddress
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 18
; search for common:
a72: al w1 x1-1 ; no of commons:=
rs. w1 g43. ; no of commons-1
rs. w3 g22. ; save external table index
al w1 12 ;
rs. w1 g53. ;
jl. w2 c12. ; read 12 bytes from external list
rl. w2 g40. ; w2:=first entry in common catalog
a73: dl w1 x3+2 ; try this entry in (zone)common catalog:
sn w0 (x2+h32) ;
se w1 (x2+h32+2) ; if name part(common list) <>
jl. a74. ; name part(common catalog) then
dl w1 x3+6 ; goto get next in common catalog;
sn w0 (x2+h32+4) ;
se w1 (x2+h32+6) ;
jl. a74. ;
jl. a75. ; goto common name match;
a74: rl w0 x2+h30 ; get next in common catalog:
sn w0 0 ; if chain=0 then
jl. a79. ; goto create new common;
wa w2 1 ; common address:=common address + chain;
jl. a73. ; goto check this common;
a75: ; common match:
rl w1 x3+8 ; test length and zone common description
se w1 (x2+h33) ; if length(common list) <>
jl. w1 a107. ; length(common catalog) then
; common alarm;
a76: bz w0 x3+10 ; compute value of this common:
rs w0 x3+0 ; move commonno for first in fictive part
bs w0 x3+11 ; relative for first in fictive part:=
ls w0 11 ; (commonno for forst in fictive part
wa w0 x2+h31 ; - commonno for first in real part)
rs w0 x3+2 ; *2**11 + relative to common base;
rl. w0 b17. ; next commonno := great
rs w0 x3+4 ;
rl. w0 g53. ; if not zonecommon then
se w0 18 ; goto return;
jl. a78. ;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 19
; check zonecommon description:
dl w1 x2+h34+2 ;
sn w0 (x3+12) ;
se w1 (x3+14) ;
jl. a107. ;
rl w0 x2+h34+4 ;
se w0 (x3+16) ;
a107: jl. w1 c8. ; goto message (<:common:>);
jl. a78. ; return;
<:common<0>:> ;
; return:
a78: rl. w3 g22. ; w3:=saved external list index
al w3 x3+4 ; external index:=
jl. a108. ; external index+4
; goto next common;
; create new common in common catalog:
a79: rl. w1 g49. ; last used:=last used - entry size;
al w1 x1-h28 ; quess: entry is common;
rl. w0 g53. ;
se w0 12 ; if entry is zonecommon then
al w1 x1-6 ; entry size:=entry size-6
am. (g22.) ; if last used <= top external table+18 then
sh w1 18 ;
jl. a14. ; goto stack alarm
rs. w1 g49. ; chain(last entry):=w1-w2;
ws w1 5 ;
rs w1 x2+h30 ; move name part of common list
wa w2 3 ; w2:=address of new entry
al w0 0 ; chain:=0
rs w0 x2+h30 ;
dl w1 x3+2 ; to name part of common catalog;
ds w1 x2+h32+2 ;
dl w1 x3+6 ;
ds w1 x2+h32+6 ; move length of common
rl w1 x3+8 ;
rs w1 x2+h33 ;
rl. w1 g42. ; final value(common catalog) := common area length;
rs w1 x2+h31 ;
wa w1 x2+h33 ; common area length:=common area length
rs. w1 g42. ; end;
rl. w0 g53. ;
sn w0 12 ; if common then
jl. a76. ; goto set value in common list;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 20
dl w1 x3+14 ; move zonedescription
ds w1 x2+h34+2 ;
rl w0 x3+16 ;
rs w0 x2+h34+4 ;
jl. a76. ; goto set value in common list;
; search for zonecommon:
a80: al w1 x1-1 ; no of zonecommons:=
rs. w1 g44. ; no of zonecommons-1;
rs. w3 g22. ; save external table index;
al w1 18 ; set element length for check
rs. w1 g53. ;
jl. w2 c12. ; read 18 bytes from external list;
rl w1 x3+16 ; replace externalno in list
rl. w0 g18. ; by final value(external)
sh. w1 (g24.) ; if external no > no of globals
jl. a81. ; and externals
rl. w0 g19. ; then begin base:=base rs-table
ws. w1 g24. ; extno:=extno-globals and externals; end
a81: am (1) ; else base := base external table;
am x1 ; final value := table.base.extno;
rl w0 x1-2 ;
rs w0 x3+16 ;
rl. w2 g41. ; w2:=first entry in zone catalog;
jl. a73. ; goto try this entry in zonecatalog;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 21
; next segment:
a30: rl. w3 g12. ;
sl. w3 (g23.) ; if processed >= program size then
jl. a0. ; goto next area;
al w3 x3+1 ; processed:=processed+1;
rs. w3 g12. ;
jl. w2 c1. ; input segment;
rl. w1 g3. ; insegment:=insegment+1;
al w1 x1+1 ;
rs. w1 g3. ;
sn w3 1 ;
jl. a82. ; if processed <> 1 then
jl. w2 c0. ; begin output segment;
rl. w1 g8. ; outsegment:=
al w1 x1+1 ; outsegment + 1;
rs. w1 g8. ; end;
a82: rl. w2 g1. ; absword address:=first core input;
al w0 2.111 ;
la w0 x2+e39-2 ; segment type := last word extract 3;
sn w0 0 ; if segment type = 0 <*code*> then
al w0 3 ; segment type := 3 <*rs*>;
sn w0 3 ; if segment type = 3 <*rs*> then
rs. w0 g61. ; version := 3; <*to prevent version alarm*>
; <*type 1 : prog, 2 : ext => version check*>
bz w0 x2 ; rel of last point :=
hs. w0 i2. ; byte(absword addr);
sl w0 e39 ; if rel > segm length - 1 then
jl. c14. ; goto relative alarm1;
bz w0 x2+1 ; rel of last absword :=
hs. w0 i1. ; byte(absword addr + 1);
sl w0 e39 ; if rel > segm length - 1 then
jl. c14. ; goto relative alarm1;
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 22
a31: am. (g1.) ; next absword: point addr := absword addr;
i1 = k + 1 ; rel of last absword ; if absword addr >=
sl w2 0 ; first core input + rel of last absword
jl. a36. ; then goto next point;
al w2 x2+2 ; absword addr := absword addr + 2;
rl w0 x2 ; absword := word(absword addr);
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
ds. w1 b20.+2 ;
ds. w3 b20.+6 ;
al w0 c44 ; test 4, absword as 2 bytes
rl w1 x2 ;
jl. w2 c19. ;
z. ; end test;
bl w3 0 ; w3 := external no := bits(0,11,absword);
sz w3 -1<11 ; if bits(0,absword) <> 0 then
jl. a32. ; goto abs own segment or common;
sn w3 0 ; if external no = 0 then
jl. a33. ; goto abs own core;
bz w0 1 ; chain for rel := bits(12,23,absword);
rl. w1 g18. ; w1 := base external table;
sh. w3 (g24.) ; if w3 > no of globals and externals then
jl. a37. ; begin
ws. w3 g24. ; rs no := ext no - (no of globals + no of ext);
sh w3 h35 ; if rs no >= first fortran special then
jl. a42. ; begin
jl. w1 c21. ; get value of rs extended;
jl. a128. ; goto check chain;
a42: am. (g39.) ; end else
sl w3 +1 ; if rs no > no of std rs entries then
jl. w1 c16. ; message (<:rs entry:>);
rl. w1 g19. ; w1 := base rs table;
a37: am x1 ; end; comment: w3 = external no;
am x3 ; external index :=
al w1 x3 ; w1 + 2*external no;
a128: sn w0 0 ; if chain for rel = 0 then
jl. a34. ; goto abs external core;
\f
; fgs.jz 1986.02.18 algol/fortran, pass 9, page 23
zl w3 x1-1 ; abs external and global segments:
se w3 0 ; if rel part = 0 then
jl. a43. ; begin <*special rs entry*>
zl w3 x1-2 ; word (absword addr) :=
rs w3 x2 ; half1 (exttable (index-2));
al w3 0 ; rel part := 0;
jl. a46. ; end else
a43: zl w3 x1-2 ; begin <*segment*>
ls w3 1 ; segment part := 2 * segment part add
wa. w3 b11. ; 3<22;
rs w3 x2 ; word (absword addr) := segment part;
zl w3 x1-1 ; rel part := half2 (exttable (index-1));
; end;
a46: bz w1 1 ; next in chain:
sl w1 e39 ; if rel > segm length - 1 then
jl. c15. ; goto relative alarm2;
wa. w1 g1. ; chain := chain for rel;
bz w0 x1 ; chain for rel := byte(chain + first core input);
hs w3 x1 ; byte(chain + first core input) := rel part;
se w0 0 ; if chain <> 0 then
jl. a46. ; goto next in chain;
jl. a31. ; goto next absword;
; abs own segment or common:
a32: bz w3 1 ; if bits(12.23,absword) = 0 then
sn w3 0 ; goto abs own segment;
jl. a84. ;
; abs common area:
rl. w1 g45. ; w1:=commonlist start
al w1 x1-4 ;
bz w0 0 ; w0:=commonno + 1<12;
la. w0 b13. ; w0:=w0 - 1<12
a83: al w1 x1+4 ; w1:=next in commonlist;
sl w0 (x1) ; if commonno >= first no then
jl. a83. ; take next common list element;
ws w0 x1-4 ; absword:=
ls w0 11 ; (commonno - first commonno(prec. element)
ba w0 x2+1 ; *2**11 + rel;
wa w0 x1-2 ; + rel to commonbase;
wa. w0 b19. ; add 7<21
jl. a35. ; goto store absword;
\f
; fgs.jz 1986.02.18 algol/fortran, pass 9, page 24
a84: rl. w3 g8. ; abs own segment:
ws. w3 g27. ; curr segm :=
zl w0 0 ; outsegment - outbase;
wa w0 6 ; abs word :=
la. w0 b13. ; ((curr segm + rel segm) extract 11 +
wa. w0 g27. ; outbase) *
ls w0 1 ; 2 +
wa. w0 b11. ; 3<22 ;
jl. a35. ; goto store absword;
a33: wa. w0 g14. ; abs own core:
wa. w0 g59. ; abs word := abs word + own base;
jl. a35. ; absword := absword + corebase;
; goto store absword;
a34: ; abs external core:
zl w0 x1-1 ; absword := half2 (exttable (index-2));
se w0 0 ; if absword > 0 then
jl. a51. ; goto normal external no;
zl w0 x1-2 ; absword := half1 (exttable (index-2));
jl. a35. ; goto store absword;
a51: rl w0 x1-2 ; absword := word (exttable (index-2));
a35: rs w0 x2 ; store absword:
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
ds. w1 b20.+2 ;
ds. w3 b20.+6 ;
al w0 c45 ; test 5, new absword as 2 bytes
rl w1 x2 ;
jl. w2 c19. ;
z. ; end test;
jl. a31. ; word(absword addr) := absword;
; goto next absword;
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 25
a36: am. (g1.) ; next point:
i2 = k + 1 ; rel of last point ; if point addr >=
sl w2 0 ; first core input + rel of last point
jl. a40. ; then goto finis update;
al w2 x2+2 ; point addr := point addr + 2;
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
ds. w1 b20.+2 ;
ds. w3 b20.+6 ;
al w0 c46 ; test 6, point as 2 bytes
rl w1 x2 ;
jl. w2 c19. ;
z. ; end test;
rl w0 x2 ; point := word(point addr);
bl w3 0 ; w3 := bits(0,11,point);
sz w3 -1<11 ; if bits(0,point) <> 0 then
jl. a38. ; goto own point;
; external point:
rl. w1 g18. ; w1 := base external table;
sh. w3 (g24.) ; if w3 > no of globals and externals then
jl. a54. ; begin
ws. w3 g24. ; rs no := ext no - (no globals + no ext);
sh w3 h35 ; if rs no >= first fortran special then
jl. a44. ; begin
jl. w1 c21. ; get value of rs extended;
al w3 x1 ; goto set point;
jl. a203. ; goto set point;
a44: am. (g39.) ; end else
sl w3 +1 ; if rs no > no of std rs entries then
jl. w1 c16. ; message (<:rs entry:>);
rl. w1 g19. ; w1 := base rs table;
; end;
a54: am x1 ; end;
am x3 ; external index := w1 + 2*w3;
a203: rl w0 x3-2 ; point := external table(external index - 2);
jl. a39. ; goto store point;
\f
; fgs.jz 1986.02.18 algol/fortran, pass 9, page 26
a38: rl. w3 g8. ; own point:
ws. w3 g27. ; curr segm :=
ea w3 0 ; outsegment - outbase;
la. w3 b13. ; bits (0, 11, point) :=
wa. w3 g27. ; (rel segment + curr segm) extract 11 +
hs w3 0 ; outbase;
a39: rs w0 x2 ; store point:
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
ds. w1 b20.+2 ;
ds. w3 b20.+6 ;
al w0 c47 ; test 7, new point as 2 bytes
rl w1 x2 ;
jl. w2 c19. ;
z. ; end test;
jl. a36. ; word(point addr) := point;
; goto next point;
a40: dl. w3 g2. ; finis update:
rx. w2 g6. ;
rx. w3 g7. ; swap(first core input, first core output);
ds. w3 g2. ; swap(last core input, last core output);
jl. a30. ; goto next segment;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 27
; input description for area i/0:
g0: 0,0,0,0,0 ; name and name table address;
3<12 ; message: operation = input;
g1: 0 ; first core input;
g2: 0 ; last core input;
g3: 0 ; insegment;
g4: 0 ; inbase;
; output description for area i/o:
g5: 0,0,0,0,0 ; name and name table address;
5<12 ; message: operation = output;
g6: 0 ; first core output;
g7: 0 ; last core output;
g8: 0 ; outsegment;
g27: 0 ; outbase;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 28
; other variables:
g11: 0 ; segment;
g12: 0 ; processed;
g13: 0 ; move;
g14: 0 ; core base;
g9: 0 ; program base;
g15: 0 ; current entry address (in external catalog)
g16: 0 ; first entry address - - -
g17: 0 ; last entry address - - -
g18: 0 ; base external table, save length of own core;
g19: 0 ; base rs table;
g20: 0 ; current program base<12 + current core base;
g21: 0 ; saved entry address (in external catalog);
g22: 0 ; saved external table index;
g23: 0 ; program size;
g24: 0 ; no of globals and externals;
g25: 0 ; segment base for rs;
g26: 0 ; first in cycle;
g28: 0 ; first free core = first own
g29: 0 ; rs segments;
g30: 0 ; date 1;
g31: 0 ; date 2;
g32: 0 ; core length;
g33: 0 ; core to copy;
g34: 0 ; no of globals;
g35: 0 ; no of externals;
0 ; prog call descr - 2 : 2<12 + entry point rs
g36: 0 ; prog call descr : load length rs
g37: 0 ; top special rs entries
g38: 0 ; max no of globals + no of externals
g39: 0 ; no of std rs entries
g40: 0 ; first common entry address
g41: 0 ; first zonecommon entry address
g42: 0 ; length of common area
g43: 0 ; no of commons
g44: 0 ; no of zonecommons
g45: 0 ; start of common list
g46: 0 ; fortran, = 1 in case of fortran unit, else 0
g47: 0 ; address of catalog entry holding programdescription
g48: 0 ; segmentno for first segment of next programunit
g49: 0 ; address of last used byte in external catalog
g50: 0 ; no of bytes copied to output
g51: 0 ; segmentno for first segment of core picture
g52: 0 ; no of bytes in core picture
g53: 0 ; no of databytes
g54: 0 ; no of zonedescriptionbytes; base name table
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 29
;************** g54 : base name table, must not be separated from table **
; table holding the 3 first characters of the catalog
; name for rs-no > h35.
; before using the characters is added <:aaa:>.
; after occurence of rs-no i, nametable(i) holds the
; final value.
1<23 + 11<16 + 12<8 + 11 ; h35+1+ 0 lml long * long
1<23 + 11<16 + 3<8 + 11 ; + 1 ldl long / long
1<23 + 8<16 + 15<8 + 8 ; + 2 ipi integer ** integer
1<23 + 11<16 + 15<8 + 8 ; + 3 lpi long ** integer
1<23 + 3<16 + 15<8 + 3 ; + 4 dpd double ** double
1<23 + 11<16 + 2<8 + 3 ; + 5 lcd long conv double
1<23 + 17<16 + 2<8 + 3 ; + 6 rcd real conv double
1<23 + 3<16 + 2<8 + 11 ; + 7 dcl double conv long
1<23 + 3<16 + 2<8 + 17 ; + 8 dcr double conv real
1<23 + 2<16 + 2<8 + 17 ; + 9 ccr complex conv real
1<23 + 3<16 + 0<8 + 3 ; +10 dad double + double
1<23 + 3<16 + 18<8 + 3 ; +11 dsd double - double
1<23 + 3<16 + 12<8 + 3 ; +12 dmd double * double
1<23 + 3<16 + 3<8 + 3 ; +13 ddd double / double
1<23 + 2<16 + 0<8 + 2 ; +14 cac complex + complex
1<23 + 2<16 + 18<8 + 2 ; +15 csc complex - complex
1<23 + 2<16 + 12<8 + 2 ; +16 cmc complex * complex
1<23 + 2<16 + 3<8 + 2 ; +17 cdc complex / complex
1<23 + 8<16 + 13<8 + 17 ; +18 inread
1<23 + 8<16 + 13<8 + 22 ; +19 inw inwrite
1<23 + 17<16 + 4<8 + 0 ; +20 rea read
1<23 + 22<16 + 17<8 + 8 ; +21 wri write
g56: 0 ;
<:rcrcrcrc<0>:> ; the last 9 characters of the name
-1 ; kind and spec for rs-extended
g57: <:aaa:> ; to be added to the name in the table
g55: 0 ; no of rs entries
g58: 0 ; rs segments < 12 + no of rs own bytes
g59: 0 ; own base
g60: 0 ; stepping stone used
0 ; for testoutput
g61: 0 ; version
g62: 0 ; addr of version entry in ext catalog
\f
; fgs.jz 1983.12.28 algol/fortran, pass 9, page 30
; working locations and constants :
b5 : 0 ; current word address
b11: -1<22 ; 2.110000000000000000000000
b12: 1<23 + 4 ; modekind = backing storage
b13: 2047 ; 2.000000000000011111111111
b17: 1<22 ; the greatest common no
b18: 1<23 ; program unit bit
b19: 3<21 ; 2.011000000000000000000000, defines common
0 ;
a110: 0 ;
b22: 0, r.6 ; generated external cat entry: size, name, entry:
b21=k+1 ;
9<18 ; kind and specs (integer variable, rs no)
0 ; -
4<12 ; 4<12 + start external list
0 ; code<12 + core
b26: e106 ; pseudo entry in external catalog, final value: (see below)
e103 ; base part (compiler version)
0 ; modekind
<:*version<0>:> ; name
0 ; -
0 ; entry point
e106 ; kind and specs (smallest version no in ext accepted)
0 ; -
0 ; 4<12 + start external list
0 ; code<12 + core
b27: ; end label:
b31: 4095 ;
b33: <: rs proc<0>:> ;
\f
; fgs.jz 1986.01.18 algol/fortran, pass 9, page 31
; stepping stones to pass0 entries
am -1000 ;
jl. e7.+1000 ; stepping stone to pass0, end pass;
e7= k-4
am -1000 ;
jl. e19.+1002 ; - , print linehead;
e19= k-6
am -1000 ;
jl. e12.+1000 ; - , writechar
e12= k-4
am -1000 ;
jl. e13.+1000 ; - , writetext
e13= k-4
am -1000 ;
jl. e14.+1000 ; - , writeinteger;
e14= k-4
am -1000 ;
jl. e16.+1000 ; - , print byte, used in testoutput
e16= k-4
am -2047 ;
jl. e69.+2047 ; - , backing store fault;
e69= k-4
; pass 0 entries
a109: 0 ; addr of e24. , fp result note
a111: 0 ; value e9. - 4, used segments
a112: 0 ; - e9. - 2, available segments
a113: 0 ; - e9. + 4, last work for pass
a114: 0 ; addr of e9. - 4, used segments
a115: 0 ; - e17. , modebits word1 and word2
a116: 0 ; - e21. , gpa byte input descr
a117: 0 ; - e20. , - output -
a118: 0 ; - e59. , wait segment
a119: 0 ; - e107. , name of rts
a120: 0 ; - e8. , gpa output segment
a147: 0 ; - e40. , boolean stop translation (sorry)
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 32
c0: ; output segment:
am g5-g0 ; w0 := name address(output); skip next;
c1: al. w0 g0. ; input segment:
c10: ds. w3 b2. ; transfer: w0 := name addr(input descr);
rs. w1 b0. ; save(w1,w2,w3);
rl w3 0 ; w3 := name address; (=w0);
a57: ; repeat:
al w1 x3+10 ; w1 := message address;
jd 1<11+h13 ; send message;
al. w1 g10. ; w1 := answer address;
jd 1<11+h14 ; wait answer;
am (x1) ;
sn w3 x3 ; if statusword <> 0
se w0 1 ; or result <> 1 then
jl. e69. ; goto pass 0 backing store fault;
am (x1+2) ;
sn w3 x3 ; if no of bytes transferred = 0
jl. a57. ; then goto repeat;
c. (:e15 a. 1<9:) - 1<9 ; if spec testoutput pass9 then
jl. w2 c25. ; goto write (out, in- or out- mess and answ);
z. ;
dl. w3 b2. ;
rl. w1 b0. ; restore(w1,w2,w3);
jl x2 ; return;
g10: 0,0,0,0,0,0,0,0 ; answer;
b0: 0 ; saved w1;
b1: 0 ; saved w2;
b2: 0 ; saved w3;
\f
; fgs.jz 1986.02.18 algol/fortran, pass 9, page 33
; procedures
c9: al w0 0 ; alarm1: w0 := 0;
c7: rs. w1 b8. ; alarm: mess := false;
c17: rs. w1 b30. ; message 1: mess1 := true;
c8: ds. w0 b10. ; message: save(w0,w3);
;
; w0 maybe integer param
; w1 link, w1+2 text addr
; w2 not used
; w3 addr area name
; all registers are unchanged at return;
rs. w1 b7. ; save return;
jl. w3 e19.+2 ; print linehead;
rl. w1 b9. ; w1 := saved w3;
jl. w3 e13. ; writetext(entry name);
jl. w1 c5. ; writespace;
rl. w1 b7. ; restore(w1);
al w1 x1+2 ; parameter text in return + 2;
jl. w3 e13. ; writetext(parameter);
rl. w1 a115. ;
al w3 1<10 ;
lo w3 x1+2 ; modebits2.warning :=
rs w3 x1+2 ; true ;
al w3 1 ;
rs. w3 (a147.) ; sorry := true;
am. (b8.) ; if mess then
se w3 x3 ; begin
jl. a27. ;
am. (b30.) ;
sn w3 x3 ; if mess1 then
jl. a65. ; begin
rl. w0 b10. ;
jl. w1 c5. ; writespace;
jl. w3 e14. ; writeinteger (w0);
32<12 + 1 ; end;
ld w0 100 ;
ds. w0 b8. ; mess := mess1 := false;
a65: dl. w0 b10. ; restore (w0, w3, w1);
rl. w1 b7. ; return;
jl x1 ; end;
a27: rl. w0 b10. ; print result:
sn w0 0 ; if saved w0 <>0 then
jl. e7. ; begin
jl. w1 c5. ; writespace;
jl. w3 e14. ; writeinteger(result);
32<12+1 ; end;
jl. e7. ; goto end pass;
b30: 0 ; mess1 and
b8 : 0 ; mess must be kept together
b9 : 0 ; saved w3
b10: 0 ; saved w0
b7 : 0 ; saved w1
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 34
; procedures
c15: al w0 x1 ; relative alarm2 : rel into w0
c14: al. w3 g0. ; relative alarm1 : name := name of area
c13: jl. w1 c7. ; goto alarm (<:relative:>);
0 ; unused return;
<:relative<0>:> ;
0 ; b24-2 : saved w0
b24: 0 ; b24 : saved w1
0 ; b25-2 : saved w2
b25: 0 ; b25 : saved w3
c16: ds. w1 b24. ; rs entry message:
ds. w3 b25. ; save registers;
al. w3 g0. ; w3 := addr name of input descr;
rl. w0 b25. ; w0 := saved w3; <*rs no*>
jl. w1 c17. ; goto message1 (<:rs entry:>, w0);
jl. a64. ; return;
<:rs entry<0>:> ;
a64: dl. w1 b24. ;
dl. w3 b25. ; restore registers;
jl x1 ; return;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 35
; procedure lookup in maincat and check:
;
; w0 irrelevant
; w1 ext cat.entry.tail part
; w2 link
; w3 ext table index
; all registers unchanged at return
;
c6: ds. w1 b24. ; lookup in maincat and check:
ds. w3 b25. ;
bl w0 x3 ;
sl w0 0 ; if first half in name < 0 then
jl. a71. ; begin <*special rs entry*>
al w2 x3 ; w2 := index in external table;
wa. w0 g37. ; rs no (cat entry) := first half name signed +
a45: hs. w0 b21. ; top special rs entries;
dl. w0 b22.+2 ; move
ds w0 x1+2 ; cat entry
dl. w0 b22.+6 ; to
ds w0 x1+6 ; tail
dl. w0 b22.+10 ; area
ds w0 x1+10 ; looked
dl. w0 b22.+14 ; up;
ds w0 x1+14 ;
ds w0 x2+10 ; revise kind and specs in ext list;
dl. w0 b22.+18 ;
ds w0 x1+18 ; return;
jl. a146. ; end;
a71: jd 1<11+h12 ; look up entry;
sn w0 3 ; if result = unknown then
jl. a41. ; goto unknown entry;
se w0 0 ; if result <> 0 then
jl. a26. ; goto alarm (<:catalog:>);
bz w2 x1-h1+h5 ;
sn w2 4 ; if content <> 4 then
jl. a146. ; begin
rl w0 x1 ; if size >= 0
sh w0 -1 ; or content < 32 then
sh w2 31 ; goto alarm (<:catalog:>);
jl. a26. ; else
al w0 h23 ; size := supposed size;
rs w0 x1 ; end;
a146: dl. w1 b24. ; restore registers;
dl. w3 b25. ;
jl x2 ; return;
a149: ; prepare rs entry:
rl. w1 b24. ; w1 := ext catalog.entry.tail part;
rl. w2 b25. ; w2 := ext table.entry;
al w0 1 ; w0 := rs entry := 1;
jl. a45. ; goto move rs entry to tail part;
a41: jl. w1 c8. ; unknown entry:
jl. a149. ; goto prepare rs entry;
<:unknown<0>:> ; message (<:unknown:>);
a26: jl. w1 c7. ; catalog error:
0 ; unused return from alarm;
<:catalog<0>:> ; alarm(<:catalog:>, result);
\f
; fgs.jz 1985.09.26 algol/fortran, pass 9, page 36
c5: ds. w0 g10.+2 ; writespace:
al w0 32 ; writechar(<space>);
jl. w3 e12. ;
dl. w0 g10.+2 ;
jl x1 ; return;
c2: rs. w1 b6. ; procedure update entry name:
dl w1 x3+2 ;
ds w1 x2+h2+2 ; move name part of current
dl w1 x3+6 ; external to name part of
ds w1 x2+h2+6 ; entry pointed at by w2;
jl. (b6.) ; return;
b6: 0 ; return ;
c3: rs w0 x2+h0+2 ; procedure update entry value:
rs. w1 b6. ; base part(entry) := w0;
rs w0 x2+h0 ; value (entry) := w0;
sn w0 -1 ; if w0 <> -1 then
jl x1 ; return;
rl w1 x2+h3 ; if entry point(entry) >= 0 then
sh w1 -1 ; begin
jl. a24. ; comment: core reference;
zl w1 1 ; relative own base :=
wa w1 x2+h3 ; half2 (w0) + entry point (entry);
sh. w1 (b31.) ; if relative own base > 4095 then
jl. a68. ; begin
al w0 x1 ; alarm (
jl. w1 c7. ; <:owns:>, relative own base);
<:owns:> ; end;
a68: wa. w1 g59. ; value (entry) := relative own base + own base;
rs w1 x2+h0 ; return;
jl. (b6.) ; end;
a24: zl w1 x2+h3 ; segment reference:
al w1 x1-1<11 ; half1 (value (entry)) :=
hs w1 x2+h0 ; half1 (entry point) - 1<11;
zl w1 0 ; segment := current segment base +
ea w1 x2+h0 ; half1 (value (entry));
sh. w1 (b31.) ; if segment > 4095 then
jl. a69. ; begin
al w0 x1 ; alarm (
jl. w1 c7. ; <:segs:>, segment);
<:segs:> ; end;
a69: hs w1 x2+h0 ; half1 (value (entry)) := segment;
zl w1 x2+h3+1 ; half2 (value (entry)) :=
hs w1 x2+h0+1 ; half2 (entry point);
jl. (b6.) ; return;
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 37
; procedure next word from external list:
c4: rx. w2 b5. ; if current word address <=
am. (g1.) ; first core input+segment length-2
sh w2 e39-12 ;
jl. a25. ; then goto get word;
; get next segment:
zl w0 x2+1 ; save rel:=displacement of
hs. w0 i3. ; word(current word address);
sl w0 e39-10 ; if rel > segm length - 10 then
jl. c14. ; goto relative alarm1;
rl. w2 g3. ; insegment:=insegment+1;
al w2 x2+1 ;
rs. w2 g3. ;
jl. w2 c1. ; input segment;
am. (g1.) ;
i3 = k + 1 ; save rel ; current word address :=
al w2 0 ; first core input + save rel;
a25: rl w0 x2 ; get word:
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
am -1000 ;
ds. w1 b20.+1002 ;
am -1000 ;
ds. w3 b20.+1006 ;
al w0 c42 ;
rl w1 x2 ; test 2, external list word
jl. w2 c20. ;
am 10 ;
al w0 c42 ;
rl w1 x2 ;
jl. w2 c19. ; as halfs
am 20 ;
al w0 c42 ;
rl w1 x2 ;
jl. w2 c24. ; and chars as well;
z. ; end test;
al w2 x2+2 ; w0 := word(current word address);
rx. w2 b5. ; current word address :=
jl x2 ; current word address + 2; return;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 38
b32: 0 ; saved w2, returnaddress
; procedure next element from external list:
; w1=no of words in actual element
; w2=returnaddress
; w3=start address for new element in core
c12: rs. w2 b32. ; save returnaddress
a106: jl. w2 c4. ; w0:=next word from external list
rs w0 x3 ; store word
al w3 x3+2 ; external table index:=external index +1
al w1 x1-2 ; no of words:=no of words-1
sl. w3 (g49.) ; if external index > last byte in catalog
jl. a14. ; then goto stack alarm
se w1 0 ; if no of words <> 0
jl. a106. ; then goto next element
rl. w3 g22. ;
jl. (b32.) ; goto returnaddress
a14: rl. w3 g15. ;
al w3 x3+h2 ; w3:=address of entry name
jl. w1 c9. ; stack owerflow
0 ; unused return;
<:stack<0>:> ;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 39
b29: 0 ; saved return;
b23: 0, r.4 ; save registers;
; procedure rs extended:
c21: rs. w1 b29. ; save returnaddress
al w3 x3-h35 ; transform rs-no to index in name table
ls w3 1 ;
rl. w1 x3+g54. ; w1 := name table(rs-no)
sh w1 -1 ; if w1 >= 0 then
jl. a200. ; begin
a202: al w1 x3+2 ; w1:=pointer to value + 2
al. w1 x1+g54. ;
jl. (b29.) ; return
; end;
a200: wa. w1 b18. ; w1 = 1<23 + name - <:aaa:>
wa. w1 g57. ;
rs. w1 g56. ; create name of head and tail
al. w1 a201. ; set returnaddress from search in
rs. w1 b28. ; catalog
ds. w1 b23.+2 ; save registers
ds. w3 b23.+6 ;
al. w3 g56. ; x3 points to actual name
rs. w3 g22. ; saved ext-index := address of name
jl. a121. ; goto search catalog
a201: dl. w1 b23.+2 ; restore registers
dl. w3 b23.+6 ;
rl. w1 g56. ; move value to name table
rs. w1 x3+g54. ;
jl. a202. ; goto set pointers
\f
; fgs.jz 1985.09.26 algol/fortran, pass 9, page 40
; procedure add bases to current bases (current bases, entry);
;
; call : return :
;
; w0 : current bases unchanged
; w1 : link destroyed
; w2 : addr curr entry addr curr ent
; w3 : not used -
;
; g20: current bases current bases + entry bases
;
b. a1, b2
w.
b0: 0 ; saved link;
b1: 4096 ; limit segments
b2: 4095 ; limit own bytes
c23: rs. w1 b0. ; add bases: save link;
zl w1 0 ; segment base := current bases.segments +
ea w1 x2+h6 ; entry.code segments;
sl. w1 (b1.) ; if segment base >= segment limit then
jl. a1. ; goto overflow;
hs. w1 g20. ; current bases.segments := segment base;
zl w1 1 ; own base := current bases.own base +
ea w1 x2+h6+1 ; entry.own base;
sl. w1 (b2.) ; if own base >= limit then
jl. a1. ; goto overflow;
hs. w1 g20.+1 ; current bases.own base := own base;
jl. (b0.) ; return;
a1: al w1 -1 ; overflow:
rs. w1 g20. ; current bases := (4095, 4095);
jl. (b0.) ; return;
e.
\f
; fgs.jz 1985.12.19 algol/fortran, pass 9, page 41
c. (:e15 a. 1<9:) - 1<9 ; if spec test pass9 then begin
; procedure testoutput
; w0=test numbe
; w1=word to print
; w2=returnaddress
c40 = 0, c41 = 1, c42 = 2, c43 = 3, c44 = 4, c45 = 5, c46 = 6, c47 = 7
b. a2, b1, d4 ; block procedure testoutput
w.
d0: 0 ; saved w0
d1: 0 ; saved w1
d2: 0 ; saved w2 (return)
d3: 0 ; saved w3
d4: <:<10>test <0>:> ; test id
c20: ds. w1 d1. ; print w1 as word:
ds. w3 d3. ; save registers;
al. w0 d4. ;
jl. w2 a0. ; outtext (out, <:<10>test :>);
rl. w0 d0. ;
jl. w2 a1. ; outinteger (out, w0 in call);
rl. w0 d1. ;
jl. w2 a1. ; outinteger (out, w1 in call);
am -1000 ;
al. w2 b20.+1000 ;
dl w1 x2+2 ;
dl w3 x2+6 ;
jl. (d2. ) ; return;
\f
; fgs 1985.12.19 algol/fortran, pass 9, page 41a
c19: ds. w1 d1. ; print w1 as halfs:
ds. w3 d3. ; save registers;
al. w0 d4. ;
jl. w2 a0. ; outtext (out, <:<10>test :>);
rl. w0 d0. ;
jl. w2 a1. ; outinteger (out, w0 in call);
zl. w0 d1. ;
jl. w2 a1. ; outinteger (out, half1 (w1 in call));
zl. w0 d1.+1 ;
jl. w2 a1. ; outinteger (out, half2 (w1 in call));
am -1000 ;
al. w2 b20.+1000 ;
dl w1 x2+2 ;
dl w3 x2+6 ;
jl. (d2. ) ; return;
c24: ds. w1 d1. ; print w1 as chars:
ds. w3 d3. ; save registers;
al. w0 d4. ; outtext (out, <:<10>test :>);
jl. w2 a0. ;
rl. w0 d0. ; outinteger (out, w0 in call);
jl. w2 a1. ;
b0: al w2 32 ;
jl. w1 a2. ; outchar (out, 'sp');
al w2 0 ;
rl. w3 d1. ; char := next char;
ld w3 8 ;
rs. w3 d1. ; save remaining chars;
sh w2 127 ; if char > 127
sh w2 31 ; or char < 32 then
jl. b1. ; goto slut;
jl. w1 a2. ; outchar (out, char);
jl. b0. ;
b1: am -1000 ; slut:
al. w2 b20.+1000 ;
dl w1 x2+2 ;
dl w3 x2+6 ;
jl. (d2.) ; return;
\f
; fgs 1985.12.19 algol/fortran, pass 9, page 41b
a0: am -2000 ; procedure outtext (out, text);
am. (e23.+2000);
jl w3 e34 -2 ; fp outtext (out, text);
jl x2 ; end;
a1: am -2000 ; procedure outinteger (out, integer);
am. (e23.+2000);
jl w3 e35 -2 ; fp outinteger (out, integer, layout);
1<23+32<12+9 ;
jl x2 ; end;
a2: rs w1 0 ; procedure outchar (out, char);
am -2000 ;
am. (e23.+2000);
jl w3 e33 -2 ; fp outchar (out, char);
rl w1 0 ;
jl x1 ; end;
e. ; end block testprocedure
\f
; fgs 1985.11.05 algol/fortran, pass 9, page 41c
b. a3, b1 ; procedure write (out, in- or out- mess and answ);
w. ; begin
c25: ds. w1 a1. ; save registers;
rs. w3 a3. ;
al. w1 b0. ;
jl. w3 e13. ; write (out, <:<10>mess :>);
rl. w1 a3. ; w2 := message address;
jl. w3 e13. ; write (out, area name);
el w0 x1+10 ;
jl. w3 e14. ; write (out, operation);
32<12+3 ;
rl w0 x1+12 ;
jl. w3 e14. ; write (out, first address);
32<12+9 ;
rl w0 x1+14 ;
jl. w3 e14. ; write (out, last address);
32<12+9 ;
rl w0 x1+16 ;
jl. w3 e14. ; write (out, segment);
32<12+6 ;
al. w1 b1. ;
jl. w3 e13. ; write (out, <:<10>answ :>);
rl. w1 a3. ;
jl. w3 e13. ; write (out, area name);
rl. w0 a0. ;
jl. w3 e14. ; write (out, result);
32<12+3 ;
rl. w1 a1. ; w2 := answer address;
rl w0 x1 ;
jl. w3 e14. ; write (out, status);
32<12+9 ;
rl w0 x1+2 ;
jl. w3 e14. ; write (out, halfs xferred);
32<12+9 ;
rl w0 x1+4 ;
jl. w3 e14. ; write (out, chars xferred);
32<12+6 ;
dl. w1 a1. ; restore registers;
rl. w3 a3. ;
jl x2 ; return;
a0: 0 ; saved w0 : result
a1: 0 ; - w1 : answer addr
a3: 0 ; - w3 : mess addr
b0: <:<10>mess <0>:> ;
b1: <:<10>answ <0>:> ;
e. ; end procedure write (out, ...);
z. ; end test;
\f
; fgs.jz 1986.02.18 algol/fortran, pass 9, page 42
; procedure initialize pass 0 entries
c18: al w3 -2047 ;
al. w1 x3+e24.+2047;
rs. w1 a109. ;
al. w1 x3+e9.+2047-4;
rs. w1 a114. ;
rl w1 x1 ; ;
rs. w1 a111. ;
rl. w1 x3+e9.+2047-2;
rs. w1 a112. ;
rl. w1 x3+e9.+2047+4;
rs. w1 a113. ;
al. w1 x3+e17.+2047;
rs. w1 a115. ;
al. w1 x3+e21.+2047;
rs. w1 a116. ;
al. w1 x3+e20.+2047;
rs. w1 a117. ;
al. w1 x3+e59.+2047;
rs. w1 a118. ;
al. w1 x3+e107.+2047;
rs. w1 a119. ;
al. w1 x3+e8.+2047;
rs. w1 a120. ;
al. w1 x3+e40.+2047;
rs. w1 a147. ;
al. w1 g0.+2 ;
rs. w1 x3+g60.+2047;
al. w1 g0.+6 ;
rs. w1 x3+g60.+2047+2;
jl x2 ;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 43
; the following code is overwritten by pass 9
j1 = k - e0 ; define pass 9 entry (rel to first word pass9)
j2: al. w0 g0. ; start pass:
al. w1 g54. ; addr for testoutput of tables;
ds. w1 a110. ;
jl. w2 c18. ; initialize pass0 entries;
rl. w1 (a115.) ; w1 := modebits word 1;
sz w1 1<8 ; if result not supplied by fp is false then
jl. a122. ; addr of result note :=
al. w0 j2. ; first free core;
rs. w0 (a109.) ;
a122: rl. w3 a113. ; w3 := last work for pass;
rl w0 x3-2 ; first entry addr :=
rs. w0 g15. ; curr entry addr :=
rs. w0 g16. ; cont (last work for pass - 2);
rl w0 x3 ;
se w0 0 ; if program then
jl. a136. ; begin
rl. w3 g16. ; entry addr := first antry addr;
a144: rl w0 x3+h8 ; while entry.chain <> 0 do
sn w0 0 ; begin
jl. a145. ;
wa w3 1 ; entry addr := entry.chain;
jl. a144. ; end;
a145: rl. w2 g16. ; <*find last entry and link rts entry up*>
al w2 x2-h7 ; entry := entry - h7;
rs. w2 g49. ; last used :=
rs. w2 g17. ; last entry addr := entry;
ws w2 7 ;
rs w2 x3+h8 ; prev entry.chain := addr prev - adr entry;
wa w2 7 ;
al w0 0 ;
rs w0 x2+h8 ; entry.chain :=
rs w0 x2+h9 ; entry.datapoint := 0;
al w1 x2+h1 ; w1 := addr entry.tail part;
rl. w3 a119. ; w3 := addr of name of rts;
jl. w2 c6. ; lookup and check (w1, w3);
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 44
al w1 x1-h1 ; w1 := addr as for entry in ext cat;
al w0 0 ;
rs. w0 g3. ; insegment := 0;
rl w0 x1+h4 ;
ls w0 -18 ;
se w0 15 ; if kindword1.kind <> 15 then
jl. w1 c9. ; goto alarm (<:kind:>);
jl. a139. ;
<:kind<0>:> ;
a139: bz w2 x1+h5 ; w2 := tail.content key;
rl w0 x1+h1 ;
sl w0 0 ; if tail.size < 0 then
jl. a140. ; begin
sh w2 31 ; if tail.content key > 31 then
jl. a141. ; insegment :=
al w2 x2-32 ; tail.content key - 32;
rs. w2 g3. ;
a141: al w3 x1+h2 ; name addr := addr tail.docname;
; end;
a140: jd 1<11+52 ; create area process (w3);
se w0 0 ; if not created then
jl. w1 c7. ; goto alarm (<:area:>, result);
jl. a142. ;
<:area<0>:> ;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 45
a142: rl w2 x1+h4 ;
ls w2 6 ;
ls w2 -6 ; no of entries :=
rs. w2 g55. ; kindword1.specs;
ls w2 -1 ;
al w2 x2-9 ; top special entries :=
rs. w2 g37. ; no of entries//2 - 9;
rl w0 x1+h6 ; prog bases :=
rs. w0 g58. ; rs segments<12 + rs own bytes;
al. w2 j2. ;
rs. w2 g28. ; first free core := addr start pass;
ea w2 1 ; base external table :=
rs. w2 g18. ; first free core + no of rs own bytes;
rl. w0 g3. ;
rs. w0 g25. ; segm base for rs := insegment;
ea. w0 g58. ; insegment :=
rs. w0 g3. ; insegment + no of rs segments;
rl. w2 g49. ;
al w2 x2-2 ; last addr input := last used - 2;
al w1 x2-510 ; first addr input := last addr input - 510;
ds. w2 g2. ;
rs. w1 g19. ; base rs table := first addr input;
al. w2 g0.-h2 ; from to (name of area process,
jl. w1 c2. ; name of pass9 input descr);
rl. w3 a119. ; from to (name of gpa rts,
rl. w2 g17. ; name of rts ext cat entry);
jl. w1 c2. ;
al w2 x3-h2 ; from to (name of pass9 input descr,
al. w3 g0. ; name of gpa rts);
jl. w1 c2. ;
jl. w2 c1. ; input segment (rs table);
rl w2 x3+8 ; move name table addr area process
am. (a119.) ; to
rs w2 +8 ; name table addr gpa rts name;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 46
; <*move rs interface entries to pass9 names*>
rl. w2 g19. ; index :=
al w2 x2-2 ; base rs table - 2 +
wa. w2 g55. ; no of rs entries;
rl w1 x2 ; own base :=
rs. w1 g59. ; rs table (index);
al w2 x2-2 ; index := index - 2;
zl w0 x2 ; w0 := segm part of prog descr addr;
zl w1 x2+1 ; w1 := rel - - - - - ;
ls w0 9 ; w0 := w0 * 512;
wa w1 0 ; w1 := w1 + w0;
am -1000 ;
rs. w1 b3.+1000 ; prog descr addr := w1;
al w2 x2-8 ; index := index - 8;
rl w1 x2 ; no of std entries :=
rs. w1 g39. ; rs table (index);
al w2 x2-2 ; index := index - 2;
dl w1 x2 ; rs entry point :=
ds. w1 g36. ; rs table (index - 2, index);
al w2 x2-4 ; index := index - 4;
rl. w3 g17. ;
dl w1 x2 ; last entry.final value := rts release;
ds w1 x3+h0+2 ; last entry.base part := rts date;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 47
; <*output of dummy rs segments gpa output*>
zl. w1 g58. ; w1 := no of rs segments;
a143: jl. w3 (a120.) ; repeat
al w1 x1-1 ; output segment;
se w1 0 ; w1 := w1 - 1;
jl. a143. ; until w1 = 0;
; end <*program*>;
; <*finish gpa i/o operations*>
a136: rl. w3 (a116.) ; w1 := addr gpa input descr;
jl. w2 (a118.) ; wait segment; <*finish input*>
rl. w3 (a117.) ; w3 := addr gpa output descr;
jl. w2 (a118.) ; wait segment; <*finish output*>
; <*init pass9 i/o buffers and names*>
rl. w3 a113. ; w3 := lastwork for pass;
al w0 x3+2 ; first addr input := last work for pass+2;
al w1 x3+512 ; last addr input := last work for pass+512;
ds. w1 g2. ;
al w0 x1+2 ; first addr output := last addr input + 2;
al w1 x1+512 ; last addr output := last addr input + 512;
ds. w1 g7. ;
rl. w3 (a116.) ; from to (name gpa input descr,
al. w2 g0.-h2 ; name pass9 input descr);
jl. w1 c2. ;
al. w2 g5.-h2 ; from to (name gpa input descr,
jl. w1 c2. ; name pass9 output descr);
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 48
; compute final value and
; programbase, core base in initial
; catalog.
rl. w3 g16. ; w3:=first entry address
rl. w0 g58. ; current bases :=
rs. w0 g20. ; rs segments<12 + rs own bytes;
a92: rl w0 x3+h1 ; rep:
se w0 0 ; if area length = 0 then
jl. a93. ; begin
rs. w3 g15. ; save w3
wa w3 x3+h6 ; w3:=address of main entry;
al w0 0 ; shared entry:=true
hs. w0 i6. ; end;
a93: rl w0 x3+h0 ;
se w0 0 ; if final value <> 0 then
jl. a95. ; goto next in catalog;
rl. w0 g20. ; base part:=current bases
rs w0 x3+h0+2 ;
al w2 x3 ; w2 := entry address;
jl. w1 c23. ; add bases to current bases;
; shared:
a94: bl w0 x3+h0+2 ; final value segm(current entry):=
ba w0 x3+h3 ; program base(current entry)
hs w0 x3+h0 ; + entry point segm(current entry);
bl w0 x3+h3+1 ;
hs w0 x3+h0+1 ;
i6= k+1 ; shared entry, i=0, area entry, i=1;
a95: se w3 x3+1 ; if shared entry then
jl. a96. ; begin
rl w0 x3+h0+2 ; w0:=program base, core base(current entry);
rl. w3 g15. ; w3:=address of shared entry;
rs w0 x3+h0+2 ; program base, core base(cshared entry)
al w0 1 ; := program base, core base(main entry);
hs. w0 i6. ; shared entry:=false;
jl. a94. ; goto shared;
; end;
a96: rl w0 x3+h8 ;
sn w0 0 ; if chain <> 0 then
jl. a97. ; begin
wa w3 1 ; entry:=entry+chain;
jl. a92. ; goto rep;
; end;
\f
; fgs.jz 1983.05.17 algol/fortran, pass 9, page 49
; move program segments to start
; of area.
a97: rs. w3 g17. ; addr last entry := w3;
rl. w2 (a113.) ;
sn w2 0 ; if program then
rs w0 x3+h1 ; last entry.size := 0; <*rts entry*>
rl. w2 (a117.) ; w2 := addr gpa output byte descr;
rl w1 x2+16 ; inbase := current gpa outsegment;
al w1 x1+1 ; inbase := inbase + 1;
sl. w1 (a112.) ; if inbase >= available segments then
ws. w1 a112. ; inbase := inbase - available segments;
rs. w1 g4. ;
rl. w0 (a114.) ; rs segments:=used segments;
rs. w0 g29. ;
rl. w0 a112. ; w0:=available segments
ws. w0 g4. ; move:=available segments - inbase;
rs. w0 g13. ;
al w1 0 ; segment:=0;
a98: rs. w1 g11. ; save segment;
rl. w3 g12. ;
sl. w3 (g29.) ; if processed >= rs segments then
jl. a103. ; goto end move;
al w3 x3+1 ; processed:=processed+1;
rs. w3 g12. ;
rl. w0 g4. ; insegment:=inbase + segment;
wa. w0 g11. ;
sl. w0 (a112.) ; if insegment >= available segments
ws. w0 a112. ; then insegment := insegment - avail segments;
rs. w0 g3. ;
\f
; fgs.jz 1986.03.06 algol/fortran, pass 9, page 50
jl. w2 c1. ; input segment;
se w3 1 ; if processed <> 1 then
jl. w2 c0. ; output segment;
rs. w1 g8. ; outsegment:=segment;
dl. w3 g2. ;
rx. w2 g6. ;
rx. w3 g7. ; swap(first core input, first core output);
ds. w3 g2. ; swap(flast core input, last core output);
rl. w0 g13. ; if move >= rs segments
sl. w0 (g29.) ; then goto increase segment
jl. a102. ;
; select segments:
a99: wa. w1 g13. ; segment:=segment+move;
a100: al w3 x1+1 ; test choise:
sh. w3 (g29.) ; if segment < rs segments then
jl. a101. ; goto next in cycle;
sh. w3 (a112.) ; if segment < available segments then
jl. a99. ; goto select segment
ws. w1 a112. ; segment:=segment-available segment;
jl. a100. ; goto test choise;
a101: se. w1 (g26.) ; next in cycle:
jl. a98. ; if segment=first in cycle then
a102: al w1 x1+1 ; increase segment:
rs. w1 g26. ; first in cycle:=segment:=
; first in cycle + 1;
jl. a98. ; goto next in cycle;
; end move:
a103: jl. w2 c0. ; output last rs segment
\f
; fgs.jz 1983.06.20 algol/fortran, pass 9, page 51
rl. w3 (a113.) ;
sn w3 0 ; if not program then
jl. a137. ;
am -2047 ;
jl. a52.+2047 ; goto finis external;
a137: al. w2 j2. ; base external table:=
ea. w2 g58.+1 ; no of rs own bytes +
rs. w2 g18. ; first frie core;
el. w2 g58. ; next insegment := outsegment :=
rs. w2 g48. ; used segments := no of rs segments;
rs. w2 g8. ;
rs. w2 (a114.) ;
rs. w2 g27. ; outbase := no of rs segments;
rl. w2 g19. ; w2 := base rs table;
al w0 0 ;
al w2 x2-2 ; first common address:=
rs. w2 g40. ; base rs table - 2;
rs w0 x2 ;
al w2 x2-2 ; first zonecommon address:=
rs. w2 g41. ; base rs-table - 4;
rs w0 x2 ;
; create pseudo entry in external catalog:
al w2 x2-h7 ; last used := last used byte - entry size;
al. w3 b26.+6 ; w3 := addr of name of pseudo entry;
sh. w2 (g18.) ; if last used <= base external table then
jl. w1 c9. ; goto alarm (<:stack:>);
jl. a129. ;
<:stack<0>:> ;
a129: rl. w3 g17. ; w3 := addr last entry;
rs. w2 g49. ; last used byte :=
rs. w2 g17. ; last entry addr :=
rs. w2 g62. ; addr of pseudo entry := last used;
ws w2 7 ; last entry.chain :=
rs w2 x3+h8 ; addr (entry) - addr (last entry);
wa w2 7 ;
al w0 0 ;
rs w0 x2+h8 ; entry.chain :=
rs w0 x2+h9 ; entry.datapoint := 0;
al. w1 b26. ; w1 := index inpseudo entry;
al w2 x2+h0 ; w2 := index in ext cat entry;
a130: rl w0 x1 ; repeat
rs w0 x2 ; ext cat (index) := pseudo (index);
al w1 x1+2 ; increase indices;
al w2 x2+2 ;
se. w1 b27. ; until pseudo entry index = end index;
jl. a130. ;
rl. w3 g16. ; w3:=first entry address
rs. w3 g15. ; save entry address
am -2048 ; stepping
jl. a55.+2048 ; goto start assembly
\f
; fgs.jz 1983.06.20 algol/fortran, pass 9, page 52
0 ; zero to terminate segment
j0 = k - e0 ; no of bytes in pass 9;
e30 = e30 + j0 ; length := length + length pass 9;
i. ; id list;
e. ; end segment pass 9
m. jz.fgs 1987.06.04 alg/ftn, pass 9
i. ; id list;
b. g1 ; begin block insertproc
w.
g0:
g1: (:e30 + 511:) > 9 ; size
0, r.4 ; name
s2 ; shortclock
0, 0 ; file, block count
2 < 12 + 4 ; content, entry
e89 ; load length
d.
p. <:insertproc:>
l.
e. ; end block fpnames
e. ; end block global
\f
▶EOF◀