|
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: 61440 (0xf000)
Types: TextFile
Names: »ftnpass03tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ftnpass03tx «
\f
; fgs 1983.08.29 fortran, pass 0, page 1
; b. h99 ; fp names; this block head must always
; w. ; be loaded from somewhere, before pass 0 text;
b.
w.
d.
p. <:fpnames:>
l.
b. e107 ; begin block fortran translator;
;************************************************
;* *
;* Remember : *
;* *
;* update e103, e104 and e105 : *
;* *
;* compiler version, release and releasedate *
;* *
;************************************************
w. ;
e15 = 0 ; special testoutput, 1<0 => pass0, 1<9 => pass9;
e18 = h35 ; fp console message;
e22 = h20 ; fp current input zone descriptor (fp = file processor);
e25 = h19 ; fp current program zone descriptor;
e28 = h22 ; fp input block;
e31 = h27 ; fp connect input;
e32 = h7 ; fp end program;
e33 = h26 ; fp outchar;
e34 = h31 ; fp outtext;
e35 = h32 ; fp outinteger;
e37 = h65 ; end fp with break;
e39 = 512 ; segment length of object program;
e43 = h21 ; fp current output zone descriptor;
e44 = h29 ; fp stack zone;
e45 = h30 ; fp unstack zone;
e48 = h0 ; fp start buffer and share description;
e49 = h1 ; fp start process description;
e50 = h2 ; fp start status handling description;
e51 = h3 ; fp start record description of zone;
e52 = h5 ; fp length of zone descriptor;
e53 = h6 ; fp length of share descriptor;
e54 = h4 ; fp start of users parameters;
e55 = h54 ; fp lookup area
e57 = h10 ; fp interrupt address;
e58 = h17 ; fp parent description;
\f
; fgs 1985.09.26 fortran, pass 0, page 1aa
c. h57<2 ; if system 2 then begin
e60 = h52 ; fp first note;
e61 = h53 ; fp last note + 22;
z. ; end system 2
c. h57<3 ; if system 3 then begin
e61 = h53 ; size of available area in front of zone buffer;
z. ; end system 3
e63 = h8 ; fp current command;
e65 = h15 ; fp console description address;
e66 = h16 ; fp own process description address;
e67 = h79 ; fp terminate zone;
e68 = h55 ; fp base program;
e70 = h51 ; fp mode bits;
; e74: ; double word holding date and time
e77 = h57 ; monitor version (may be 2 or 3)
e78 = h28 ; fp connect output
e88 = h33 ; fp outend
e80 =(:-4:)<1+0; standard size and document for workarea (see fp connect)
e81 = 0<1+0 ; - - - - - sortarea - - -
e82 = 1 ; error message basis for pass1
e83 = e82+10; error message basis for pass2
e84 = e83+ 2; error message basis for pass3
e85 = e84+ 9; error message basis for pass4
e86 = e85+15; error message basis for pass5
c. h57<2 ; if system 2 then begin
e99 = h10+14; fp break routine
e100 = 14 ; bytes in reg dump area
z. ; end system 2
c. h57<3 ; if system 3 then begin
e99 = h10+h76; fp break routine
e100 = h76 ; bytes in reg dump area
z. ; end system 3
e103= 2 ; compiler version
e104= 2<12 + 0 ; compiler release<12 + subrelease
e105=1985<12 + 1101 ; compiler release date
e106= 1 ; smallest version number in external accepted by pass9
m. fortran, pass 0 redefine e-names
t.
\f
; fgs 1983.05.17 fortran, pass 0, page 1a
s. c71, d30, f31, h5, j2 ; begin pass 0 segment;
w. ;
k = 10000+ e68 ; k has this value to provoke slang test of
; relative adresses;
e38: h5 ; length of entire pass 0 (hwds), translator length;
0 ; dummy word (slang);
jl. d22. ; entry pass 0: goto initialize translator;
e103 ; compiler version
\f
; rc 22.12.1969 fortran, pass 0, page 2
b. a14, b21 ; begin block: next pass, print char, print text, print integer;
w. ;
d7: 9 ; stop pass;
b5: 0 ; pass no;
b4: 1<21 ; interrupt mask (pass 0);
d21: 0 ; abs address of segment (program process description(16));
d27: 0 ; abs address of first core (program share descriptor(2));
d23: 0 ; abs address of last core (program share descriptor(10));
d24: 0 ; abs address of program zone descriptor;
c7: rl. w0 b4. ; next pass: w0 := interrupt mask(pass 0);
al. w3 d29. ; w3 := interrupt address (pass 0);
jd 1<11 ; set interrupt;
rl. w0 b5. ;
sn. w0 (d7.) ; if pass no = stop pass then
jl. d0. ; goto end translation;
am. (d24.) ;
bz w0 e49+1 ;
se w0 4 ; if kind of translator medium <> 4 then
jl. a2. ; goto next pass from tape;
rl. w1 e38. ; next pass from backing store:
ld w2 -9 ; segment :=
rs. w1 (d21.) ; translator length//512;
ls w2 -15 ; from core := translator length mod 512;
al. w1 c0. ; first core := first free core;
rs. w1 (d27.) ;
al w1 x1+510 ; last core := first core + 510;
rs. w1 (d23.) ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
al. w1 c0. ; to core := first free core;
rl. w0 e38. ;
wa. w0 x2+c0. ; translator length :=
rs. w0 e38. ; translator length + pass length;
rl. w3 x2+c0. ; remaining := pass length;
\f
; rc 17.4.1969 fortran, pass 0, page 3
a0: sn w3 0 ; move words:
jl. a3. ; if remaining = 0 then goto prepare pass;
sn w2 512 ; if from core = 512 then
jl. a1. ; goto transfer segments;
rl. w0 x2+c0. ; word(to core) :=
rs w0 x1 ; word(first free core + from core);
al w1 x1+2 ; to core := to core + 2;
al w2 x2+2 ; from core := from core + 2;
al w3 x3-2 ; remaining := remaining - 2;
jl. a0. ; goto move words;
a1: al w2 x3-1 ; transfer segments:
ls w2 -9 ;
ls w2 9 ; first core := to core;
al w2 x2+510 ; last core := first core + 510 +
wa w2 2 ; (remaining - 1)//512*512;
rs. w1 (d27.) ;
sl. w2 (f26.) ; if last core >= last work for pass then
jl. a12. ; alarm(<:pass trouble:>);
rs. w2 (d23.) ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
jl. a3. ; goto prepare pass;
a12: jl. w3 d8. ; alarm pass trouble:
al. w3 d14. ; print linehead;
al w2 1 ; set return(break); w2 := 1;
jl. w1 c13. ; writetext(<:pass trouble:>);
<:pass trouble<0>:>;
a2: al. w0 c0. ; next pass from tape:
rs. w0 (d27.) ; first core := first free core;
rl. w0 f26. ;
rs. w0 (d23.) ; last core := last work for pass ;
rl. w1 d24. ; w1 := program zone descriptor address;
jl. w3 (d13.) ; input block; comment: fp entry;
d28: am. (c0.) ; test pass length; last of pass :=
al. w3 d11. ; first free core + pass length - 1;
se w3 (x1+e51+2) ; if last of pass <> last byte(record) then
jl. a12. ; goto alarm pass trouble;
a3: bz. w0 d6. ; prepare pass:
ls w0 -1 ; pass no :=
rs. w0 b5. ; bits(12,22,second word of pass);
se w0 11 ; if pass no = 11 then
jl. a13. ; begin
rl. w2 c17. ; if -,branch then
so w2 1<9 ; goto next pass;
jl. c7. ; end;
a13: sh w0 15 ; if pass no > 15 or pass no < 1 then
sh w0 0 ; goto alarm pass trouble;
jl. a12. ;
\f
; rc 23.3.1969 fortran, pass 0, page 4
al. w2 c0. ; pass entry :=
bz. w1 d10. ; first free core + bits(0,11,second word of pass);
wa w2 2 ; comment: the address is calculated in
rs. w2 b11. ; this funny way to give a 24-bits
rl. w1 d6. ; not negative number;
sz w1 1 ; if bit(23,second word of pass) = 1 then
jl. a4. ; goto change direction;
sn w0 1 ; if pass no = 1 then
jl. a9. ; goto update;
jl. w3 c8. ; output segment;
rl. w0 f13. ;
bs. w0 h0. ; segment(byte input) :=
rs. w0 f13. ; segment(byte input) - increment;
jl. w3 d9. ; input segment;
rl. w1 f4. ;
al w1 x1+1 ;
rs. w1 f4. ; used segments := used segments + 1;
rl. w0 f3. ;
rs. w0 f2. ; current inaddress := last inaddress;
jl. a8. ; goto print information;
a4: al w1 12 ; change direction: index := 12;
a5: rl. w0 x1+f22. ; exchange next:
rx. w0 x1+f23. ; swap(byte input description(index),
rs. w0 x1+f22. ; byte output description(index));
al w1 x1+2 ; index := index + 2;
se w1 24 ; if index <> 24 then
jl. a5. ; goto exchange next;
dl. w1 f1. ; w0 := current outaddress;
ws. w1 b10. ; w1 := last outaddress - buffersize;
rl. w2 f3. ; w2 := last inaddress;
rl. w3 f3. ; w3 := last inaddress - buffersize;
ws. w3 b10. ; current inaddress := w0;
ds. w1 f3. ; last inaddress := w1;
ds. w3 f1. ; current outaddress := w2;
ac. w0 (b10.) ; last outaddress := w3;
rs. w0 b10. ; buffersize := -buffersize;
ac. w0 (h0.) ;
hs. w0 h0. ; increment := -increment;
jl. w3 c11. ; repeat input byte;
jl. a8. ; goto print information;
b10: 511 ; buffersize ;
b11: 0 ; pass entry ;
\f
; fgs 1983.05.17 fortran, pass 0, page 5
e69: ;
d15: al w2 1 ; backing store fault:
ls w2 (0) ;
sn w0 1 ; w2 := 1 shift result;
wa w2 x1 ; if result = 1 then w2 := w2 + statusword;
rs. w3 c60. ; save addr of area name;
d14: rs. w2 f9. ; break: sorry := w2;
rl. w3 c60. ; w3 := saved addr of area name;
d18: al w2 0 ; finis translation:
rx. w2 f24. ; w2 := message buffer address(byte input);
al. w1 d17. ; w1 := answer address;
se w2 0 ; if w2 <> 0 then
jd 1<11+18 ; wait answer;
al w2 0 ;
rx. w2 f25. ; w2 := message buffer address(byte output);
se w2 0 ; if w2 <> 0 then
jd 1<11+18 ; wait answer;
rl. w2 f9. ;
al. w1 b21. ; text := addr(<:ftn. end:>);
sn w2 0 ; if -,sorry then
jl. a14. ; goto ok;
al. w3 f23. ; w3 := address(name of output area);
c. e77 < 3 ; if system 3 then begin
al. w1 c71. ; w1 := tail address;
jd 1<11+42 ; lookup entry (work area);
rl. w1 f4. ; tail(1) := used segments;
rs. w1 c71. ;
al. w1 c71. ; w1 := tail address;
jd 1<11+44 ; change entry (work area);
z. ; end system 3;
al. w1 b13. ; text := addr(<:***fortran sorry:>);
a14: rl. w0 c17. ; ok: w0 := modebits;
sz w0 1<7 ; if work area created by pass 0
jd 1<11+48 ; then remove entry;
jl. w3 c13. ; writetext(string text);
rl. w3 e87. ;
sn w3 2 ; if warning.yes then
al w2 x2+2 ; add warning bit to w2;
\f
; fgs 1983.05.17 fortran, pass 0, page 5a
al w0 32 ; writesp;
jl. w3 c12. ;
rl. w0 f4. ; write(<<d>, used segments);
jl. w3 c14. ;
32<12 + 1 ;
al. w3 f23. ; w3 := addr(name of output area);
jd 1<11+64 ; remove process(name of byte input area);
al w0 10 ;
jl. w3 c12. ; writechar(<new line>);
rl. w1 c60. ; w1 := saved address of areaname;
al w3 x1 ;
se w3 0 ; if addr(saved area name) <> 0 then
jd 1<11+64 ; remove process(saved area);
am. (c23.) ;
b1 = k + 1; end program ;
jl e32 ; goto fpbase + end program;
b21: <:<10>fortran end<0>:>;
b13: <:<10>***fortran sorry<0>:>;
\f
; fgs 1983.12.28 fortran, pass 0, page 5b
d29: 0,0,0,0,0,0,0 ; interrupt address:
jl. 2,r.(:d29.+e100+2:)>1; extend dump area
al. w2 d29. ; interrupt: w2 := interrupt address;
c36: al w0 0 ; interrupt service:
rl. w3 c23. ; set interrupt (0,
al w3 x3+e57 ; fp interrupt service);
jd 1<11+0 ;
al w1 x2+e100-1 ;
a6: rl w0 x2 ; move next: w0 := word(w2);
rs w0 x3 ; word(w1+fp interrupt address) := w0;
al w3 x3+2 ; w3 := w3+2;
al w2 x2+2 ; w2 := w2+2;
sh w2 x1 ; if w1 <= interrupt addr + (breaksize-1) then
jl. a6. ; goto move next;
c. e77<3 ; if system3 then begin
rl. w3 c23. ; w3 := fp base;
am (x3+e57+10); if break instruction = ks
bl w0 -2 ; then enter fp break routine
h. sn w0, ks w. ; comment if fp is not present
jl x3+e99 ; a break will happen
z.
al w1 e99 ;
hs. w1 b1. ; end program := fp break;
jl. w3 d5. ; print line;
al w2 1 ; w2 := 1;
al w3 0 ; addr(area name) := 0;
rs. w3 c60. ; save addr of area name;
jl. d14. ; goto break;
\f
; rc 78.03.02 fortran, pass 0, page 6
d0: al. w0 d18. ; end translation:
rs. w0 b11. ; pass entry := finis translation;
a8: rl. w0 c17. ; print information:
am. (b5.) ;
se w3 x3 ; if pass no = 0
so w0 1<2 ; or -,survey then
jl. a9. ; goto update;
jl. w3 d8. ; print linehead;
rl. w0 f10. ;
jl. w2 d19. ; write(8,sum 0);
rl. w0 f11. ;
jl. w2 d19. ; write(8,sum 1);
rl. w0 f4. ;
jl. w2 d20. ; write(4,used segments);
rl. w0 c9. ;
jl. w2 d20. ; write(4, inf 1);
rl. w0 f16. ;
jl. w2 d20. ; write(4,inf 2);
a9: ; update:
am. (c23.) ;
jl w3 e88-6 ; outend;
rl. w0 b14. ;
rl. w1 b5. ; outside pass interval := false;
rs. w1 f31. ; pass := pass no;
dl. w3 c18. ;
sl w1 x2 ; if pass no < lower pass no
sl w1 x3+1 ; or pass no > upper pass no
rl. w0 b15. ; then outside pass interval := true;
d3: rs. w0 j1. ; comment: see carret;
al w0 1 ; w0 := 1;
bl. w3 h0. ;
rl. w2 d6. ; if backward pass then
se w3 -1 ; begin
jl. a11. ; w0 := old linecounter;
rl. w0 b16. ; if change direction then
sz w2 1 ; w0 := linecounter
rl. w0 f8. ; end;
a11: rs. w0 b16. ; old linecounter := w0;
bs. w0 h0. ; w0 := w0 - increment;
rs. w0 f8. ; linecounter := w0;
al w0 0 ;
rs. w0 f14. ; linecounter 1 := 0;
rs. w0 c9. ; inf 1 := 0;
rs. w0 f16. ; inf 2 := 0;
al w0 -1-1<5 ;
la. w0 c17. ;
rs. w0 c17. ; testoutput := false;
jl. w3 c1. ; carret; comment: to test lineinterval;
rl. w0 f0. ;
bs. w0 h0. ; current outaddress :=
rs. w0 f0. ; current outaddress - increment;
jl. (b11.) ; goto word(pass entry);
b14: jl. h1 ; outside pass interval = false;
b15: rx. w1 h2 ; outside pass interval = true;
b16: 0 ; old linecounter;
\f
; rc 25.3.1969 fortran, pass 0, page 7
d19: am 4 ; write(8,w0):
d20: al w1 4 ; write(4,w0):
hs. w1 a10. ; set positions in layout;
rx. w0 b17. ; swap(w0,space);
jl. w3 c12. ; writechar;
rx. w0 b17. ; swap(w0,space);
jl. w3 c14. ; writeinteger;
a10 = k + 1 ; digits ;
32<12 ;
jl x2 ; return;
b17: 32 ; space ;
c12: ds. w1 b18. ; printchar:
ds. w3 b19. ; save(w0,w1,w2,w3);
rl w2 0 ; w2 := w0;
am. (c23.) ;
jl w3 e33-2 ; outchar; comment: fp current output;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3 ; return;
c13: ds. w1 b18. ; print text:
ds. w3 b19. ; save(w0,w1,w2,w3);
al w0 x1 ; w0 := w1;
am. (c23.) ;
jl w3 e34-2 ; outtext; comment fp current output;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3 ; return;
c14: ds. w1 b18. ; print integer:
ds. w3 b19. ; save(w0,w1,w2,w3);
rl w2 x3 ;
rs. w2 b20. ; layout := word(return);
am. (c23.) ;
jl w3 e35-2 ; outinteger; comment fp current output;
b20: 0 ; layout ;
dl. w1 b18. ;
dl. w3 b19. ; restore(w0,w1,w2,w3);
jl x3+2 ; return;
0 ; saved w0 ;
b18: 0 ; saved w1 ;
0 ; saved w2 ;
b19: 0 ; saved w3 ;
e. ; end block: next pass, print char, print text, print integer;
\f
; rc 78.04.28 fortran, pass 0, page 8
b. a3, b12 ; begin block: test line, byte sums,
w. ; print linehead, print w0, print line;
d1: ds. w3 b3. ; test line:
rx. w0 c17. ; save(w2,w3);
lo. w0 b1. ; testoutput := true;
dl. w3 c19. ; comment: carret sets w1 = linecounter;
sl w1 x2 ; if linecounter < lower line no
sl w1 x3+1 ; or linecounter > upper line no
bs. w0 b0. ; then testoutput := false;
rx. w0 c17. ; comment: testoutput = modebit(18);
rl. w2 b2. ; restore(w2);
rx. w1 f8. ; swap(linecounter,w1); comment see j1;
jl. (b3.) ; return;
d2: ds. w0 b3. ; byte sums:
bz w3 1 ;
am. (f10.) ; comment: the instruction al w3 x3
al w3 x3 ; is used to avoid integer overflow;
rs. w3 f10. ; sum 0 := sum 0 + right(w0);
am. (f11.) ; sum 1 := sum 0 + sum 1;
al w3 x3 ;
rs. w3 f11. ;
rl. w3 c17. ;
b0 = k+1 ; 1<5 ;
so w3 1<5 ; if testoutput then
jl. a2. ; begin
jl. w3 c16. ; print w0;
al w0 32 ; outchar(space);
jl. w3 c12. ; end;
a2: dl. w0 b3. ; restore(w3,w0);
rx. w2 f0. ; swap(current outaddress,w2);
jl. d16. ; goto test outaddress;
b1: 1<5 ;
b2: 0 ; saved w
b3: 0 ; saved w
d8: ds. w1 b4. ; print linehead:
rs. w3 b5. ; save(w0,w1,w3);
al w0 10 ;
rs. w0 f15. ; printcount := 10;
jl. w3 c12. ; writechar(<new line>);
al. w1 b10. ; w1 := address(<: :>);
rl. w0 f31. ;
sh w0 -1 ; if pass no > -1 then
jl. a0. ; begin
jl. w3 c14. ; writeinteger(<:dd:>,pass no);
32<12 + 2 ; w1 := address(<:. :>)
al. w1 f12. ; end;
a0: jl. w3 c13. ; writetext;
al w0 -1 ; pass no := -1;
rs. w0 f31. ;
dl. w1 b4. ; restore(w0,w1);
jl. (b5.) ; return;
0 ; saved w0 ;
b4: 0 ; saved w1 ;
b5: 0 ; saved w3 ;
b10: <: :> ;
f12: <:. :> ;
f10: 0 ; sum 0 ;
f11: 0 ; sum 1 ;
f31: 0 ; pass ;
\f
; rc 78.04.28 fortran, pass 0, page 9
c16: ds. w0 b7. ; print w0:
rl. w3 f8. ; save(w0,w3);
se. w3 (f14.) ; if linecounter <> linecounter 1 then
jl. w3 d5. ; print line;
rl. w3 f15. ;
al w3 x3+1 ; printcount := printcount + 1;
sh w3 9 ; if printcount > 9 then
jl. a1. ; begin
jl. w3 d8. ; print linehead;
al w3 0 ; printcount := 0;
a1: rs. w3 f15. ; end;
bz w0 1 ; byte := right(w0);
jl. w3 c14. ; writeinteger(<:ddddd:>,w0);
32<12+5 ;
rl. w0 b7. ; restore(w0);
jl. (b6.) ; return;
b6: 0 ; saved w3 ;
b7: 0 ; saved w0 ;
d5: rs. w3 b9. ; print line:
rs. w1 b8. ; save(w1,w3);
jl. w3 d8. ; print linehead;
al. w1 b11. ;
jl. w3 c13. ; writetext(<:line:>);
jl. w3 c27. ; print linecount;
al. w1 b12. ;
jl. w3 c13. ; writetext(<:<32><32>:>);
rl. w3 f8. ;
rs. w3 f14. ; linecounter 1 := linecounter;
rl. w1 b8. ; restore(w1);
jl. (b9.) ; return;
b8: 0 ; saved w1 ;
b9: 0 ; saved w3 ;
b12: <:<32><32>:> ;
f14: 0 ; linecounter 1;
b11: <:line<0>:> ;
d30: ds. w0 b3. ; print inbyte:
bz. w0 b0. ;
la. w0 c17. ; if details then
so. w0 (b1.) ;
jl. a3. ; begin
al w0 x2 ; w0 := inbyte;
jl. w3 c16. ; print w0;
al w0 42 ; outchar(asteriks);
jl. w3 c12. ; end;
a3: dl. w0 b3. ; restore(w3,w0);
jl x3 ; return;
e. ; end block: test line, bytesums, print linehead, printw0, print line;
\f
; rc 22.12.1969 fortran, pass 0, page 10
; procedure wait segment(i/o description);
; if message buffer address = 0, the function is empty; otherwise
; a wait answer is performed, defined by message buffer address,
; segment is increased by increment and (first core,last core) and
; (other first core, other last core) are exchanged;
; call: w3 := description address; jl. w2 d12. ;
; exit: all registers unchanged;
b. a2, b0 ; begin block: wait segment;
w. ;
c59: ;
d12: am (x3+22) ; wait segment:
sn w3 x3 ; if message buffer address = 0 then
jl x2 ; return;
ds. w1 b0. ; save(w0,w1);
rx w2 x3+22 ; swap(w2,message buffer address);
a1: al. w1 d17. ; repeat: w1 := answer address;
jd 1<11+18 ; wait answer;
al w2 0 ; w2 := 0;
sn w2 (x1) ; if status word <> 0
se w0 1 ; or result <> 1 then
jl. a0. ; goto bad answer;
am (x1+2) ; if bytes transferred = 0 then
se w3 x3 ; begin
jl. a2. ; w1 := message address;
al w1 x3+10 ; send message;
jd 1<11+16 ; goto repeat;
jl. a1. ; end;
a2: rx w2 x3+22 ; swap(w2,message buffer address);
dl w1 x3+20 ;
rx w0 x3+12 ; swap(first core, other first core);
rx w1 x3+14 ; swap(last core, other last core);
ds w1 x3+20 ;
rl w0 x3+16 ;
ba. w0 h0. ; segment := segment + increment;
sh w0 -1 ; if segment <= -1 then
wa. w0 f5. ; segment := segment + available segments;
sl. w0 (f5.) ; if segment >= available segments then
ws. w0 f5. ; segment := segment - available segments;
rs w0 x3+16 ;
dl. w1 b0. ; restore(w0,w1);
jl x2 ; return;
a0: rs w2 x3+22 ; bad answer: message buffer address := 0;
jl. d15. ; goto backing store fault;
d17: 0,0,0,0,0,0,0,0 ; answer;
0 ; saved w0 ;
b0: 0 ; saved w1 ;
e. ; end wait segment ;
\f
; rc 10.3.1969 fortran, pass 0, page 11
b. a1, b3 ; begin block: next segment;
w. ;
d4: ds. w2 b2. ; next segment: save(w1,w2);
rs w3 x2+10 ; last address := w3;
rl w3 x2+12 ; w3 := address of i/o description;
rl. w2 f4. ;
wa w2 x3+24 ; used segments :=
rs. w2 f4. ; used segments + segment increment;
sh. w2 (f5.) ; if used segments > available segments then
jl. a0. ; begin comment: work area exceeded;
al. w1 b0. ; w1 := address of alarm text;
jl. c5. ; alarm(<:program too big:>)
; end;
a0: jl. w2 d12. ; wait segment;
al w1 x3+10 ; w1 := message address;
jd 1<11+16 ; send message;
rs w2 x3+22 ; address of message buffer := w2;
bl. w1 h0. ; w2 := other first core;
dl w3 x3+20 ; w3 := other last core;
lo. w3 b3. ; w3 := w3 or boolean 1 ; comment: odd address;
sn w1 -1 ; if increment = -1 then
rx w2 6 ; swap(w2,w3); comment: backward pass;
am. (b2.) ;
rx w3 10 ; swap(w3,last address);
rl. w1 b1. ; restore(w1);
am. (b2.) ; return address := return address + 2;
jl 2 ; return;
b0: <:program too big<0>:> ;
b1: 0 ; saved w1 ;
b2: 0 ; saved w2 ;
b3: 1 ; boolean 1 ;
e. ; end block: next segment;
\f
; rc 24.02.1972 fortran, pass 0, page 12
; byte input description:
f22: 0,0,0,0,0 ; 0 name and name table address;
3<12 ; 10 operation = input;
f6: 0 ; 12 first core;
f7: 0 ; 14 last core;
f13: 1 ; 16 segment;
0 ; 18 other first core;
f17: 0 ; 20 other last core;
f24: 0 ; 22 message buffer address;
-1 ; 24 segment increment;
; byte output description:
f23: 0,0,0,0,0 ; 0 name and name table address;
5<12 ; 10 operation = output;
f18: 0 ; 12 first core;
f19: 0 ; 14 last core;
f20: 0 ; 16 segment;
0 ; 18 other first core;
f21: 0 ; 20 other last core;
f25: 0 ; 22 message buffer address;
1 ; 24 segment increment;
e79=f23 ; address of pass0 work area name;
\f
; fgs 1983.05.17 fortran, pass 0, page 13
; the official pass 0 - entries (i.e. references using e-names)
; are found in the following (resident) part of pass 0;
e107: <:algftnrts<0>:> ; name of runtime system
0 ; name table address
0 ; date
e74: 0 ; time
c71: 0, r.10 ; work area
c60: 0 ; saved area name;
b. b2 ; begin block: carret, alarm, message, repeat
w. ; input byte, outbyte, inbyte, print linecount;
; procedure carret;
; the routine increases the linecounter by increment; if then
; the linecounter belongs to lineinterval and pass no belongs to
; passinterval, the boolean testoutput is set to true, otherwise
; it is set to false;
; call: jl. w3 e1. ;
; exit: w0,w1,w2 unchanged;
c1: ;
e1: rx. w1 f8. ; carret:
ba. w1 h0. ; linecounter :=
j1: rx. w1 f8. ; linecounter + increment;
jl x3 ; if outside passinterval then return
; else goto test line;
h1 = d1 - j1 ; comment : see d3, where j1: rx. w1 f8. is modif;
; procedure message;
; the routine prints the string: <linehead>line<linecounter><text>;
; call: w1 := address of <text>; jl. w3 e4. ;
; exit: w0,w1,w2 unchanged ;
; procedure alarm;
; the routine works as message, but terminates the translation;
; call: w1 := address of <text>; jl. e5. ;
c5: ;
e5: al w3 1 ; alarm:
rs. w3 f9. ; sorry := 1;
al w3 2 ; set
rs. w3 e87. ; warning.yes
al. w3 d0. ; set return(end translation);
c4: ;
e4: rs. w3 b0. ; message: save(return);
jl. w3 d5. ; print line;
jl. w3 c13. ; writetext;
jl. (b0.) ; return;
b0: 0 ; saved return ;
; procedure repeat input byte;
; the routine decreases current inaddress by increment;
; call: jl. w3 e11. ;
; exit: w0,w1,w2 unchanged;
c11: ;
e11: rx. w3 f2. ; repeat input byte:
bs. w3 h0. ; current inaddress :=
rx. w3 f2. ; current inaddress - increment;
jl x3 ; return;
\f
; fgs 1983.06.20 fortran, pass 0, page 14
; procedure outbyte;
; the routine outputs the rightmost byte of w0 to work; if pass infor-
; mation (survey) is wanted, then sum and double sum of all bytes
; are calculated; if pass no belongs to pass interval and linecounter
; belongs to lineinterval, then the byte is printed also;
; call: w0 := byte to be output; jl. w3 e3. ;
; exit: w0,w1,w2 unchanged;
e3: c3: ;
j0: rx. w2 f0. ; outbyte: if passinf then goto byte sums
; jl. d2. ; else swap(w2,current outaddress);
d16: sn. w2 (f1.) ; test outaddress:
e8:c8:jl. w2 d4. ; if current outaddress = last outaddress then
h0 = k+1 ; increment ; output segment: next segment; comment see below;
al w2 x2+1 ; w2 := w2 + increment;
hs w0 x2 ; return from next segment: byte(w2) := right(w0);
rx. w2 f0. ; swap(w2,current outaddress);
jl x3 ; return;
f0: 0 ; e20-4 ; current outaddress;
f1: 0 ; e20-2 ; last outaddress; warning: next segment uses x2+10;
e20:c20:0; ; output description; warning: - - - x2+12;
h3 = d2 - j0 ;
; procedure inbyte;
; the routine supplies the next byte from work;
; call: jl. w2 e2. ;
; exit: w2 = inputbyte; left(w2) = 0; w0,w1 unchanged;
c2: ;
e2: rl. w2 f2. ; inbyte:
sn. w2 (f3.) ; if current inaddress = last inaddress then
e90:
d9: jl. w2 d4. ; input segment: next segment; comment: see below;
ba. w2 h0. ; current inaddress := current inaddress + increment;
rs. w2 f2. ; return from next segment:
bz w2 x2 ; w2 := byte zeroes(current inaddress);
j2: jl x3 ; return;
; jl. d30. ; (if inbyte-details wanted then print inbyte)
f2: 0 ; e21-4 ; current inaddress;
f3: 0 ; e21-2 ; last inaddress; warning: next segment uses x2+10;
e21:c21:0; ; input description; warning: - - - x2+12;
; procedure print linecount;
; the routine prints the integer linecount;
; call: jl. w3 e27. ;
; exit: w0,w1,w2 unchanged;
c27: ;
e27: ds. w0 b2. ; print linecount:
rl. w0 f8. ; save(w0,w3);
jl. w3 c14. ; w0 := linecounter;
32<12+5 ; writeinteger(<:ddddd:>,w0);
rl. w0 b2. ; restore(w0);
jl. (b1.) ; return;
b1: 0 ; saved w3 ;
b2: 0 ; saved w0 ;
e. ; end block: carret, alarm, message, repeat input byte,
; outbyte, inbyte, print linecount;
\f
; fgs 1983.12.28 fortran, pass 0, page 15
h2 = k - j1 ;
e6: f8: 0 ; linecount;
e7: jl. c7. ; end pass: goto next pass;
f4: 0 ; e9-4 used segments;
f5: 0 ; e9-2 available segments;
e9: c9: 0 ; e9 inf 1 (pass information);
f16: 0 ; e9+2 inf 2 (pass information);
f26: 0 ; e9+4 last work for pass;
e10: <:process too small<0>:> ; alarm text;
e12: jl. c12. ; writechar: goto printchar;
e13: jl. c13. ; writetext: goto printtext;
e14: jl. c14. ; writeinteger: goto printinteger;
e16: jl. c16. ; print byte: goto print w0;
e17:
c17:
1<13+1<12+1<8+1<3+1<1; modebits1: fp.yes + connect.yes + note suppl by fp.yes +
; index.yes + message.yes
e29: 1<5+1<1+1<0 ; modebits2: fortran.yes + warning.yes+truncate.yes
0 ; e19-6 lower pass no in passinterval;
c18: 0 ; e19-4 upper pass no in passinterval;
1 ; e19-2 lower line no in lineinterval;
e19:c19: 1<22 ; e19 upper line no in lineinterval;
jl. d8. ; e19+2 goto print linehead;
e23:c23: 0 ; fileprocessor base;
e24: 0 ; fileprocessor result note;
e26: jl. d0. ; terminate translation: goto end translation;
e36: jl. c36. ; interrupt from passes: goto interrupt service;
e40:f9: 0 ; sorry (answer to fileprocessor);
e41: 1<21 ; interrupt mask (pass 7, object code);
e42:f15: 0 ; printcount;
e46: 0 ; start source name list (pass 1);
e47: 0 ; start branch interval list(pass 1.1);
e59: jl. c59. ; wait segment: goto wait segment;
e62:d13: 0 ; abs address of entry inblock (fileprocessor entry);
e87: 0 ; warning
e102 = f11 ; double (sum1, sum2);
e0 = k, c0 = k ; the current pass will be loaded here:
d11 = c0 - 1 ;
d10 = c0 + 2 ;
d6 = c0 + 3 ;
; first free core:
\f
; fgs 1983.05.17 fortran, pass 0, page 16
b. a35, b40 ; begin block: initialize translator;
w. ;
b0: -2 ;
b1: 0 ; top command (address of the command ftn. );
d22: rs. w1 c23. ; initialize translator:
la. w3 b0. ; fpbase := w1;
rs. w3 b1. ; top command := w3 and -2; comment: even address;
rl. w0 e41. ; w0 := interrupt mask (1 shift 21);
al. w3 d29. ; w3 := interrupt address (pass 0);
jd 1<11 ; set interrupt;
rl. w3 b1. ; restore w3;
bz w0 x3 ;
al. w2 f22. ; w2 := address of zero name in input descr;
se w0 6 ; if command ftn. not preceded by <=> then
jl. a1. ; goto no result area;
am. (c23.) ;
al w1 e55 ; w1 := addr of fp lookup area;
al w3 x3-8 ; w3 := addr of result name in command stack;
rs. w3 c60. ; save addr of area name;
jd 1<11+42 ; lookup entry (outfile);
se w0 0 ; if found then
jl. a33. ; begin
rl w2 x1 ;
sl w2 0 ; if modekind < 0 and
jl. a34. ;
bz w2 x1+1 ;
se w2 4 ; modekind <> bs then
jl. a4. ; goto error;
a34: rs w0 x1+12 ; clear tail (12:18);
rs w0 x1+14 ;
rs w0 x1+16 ;
rs w0 x1+18 ;
jd 1<11+44 ; change entry (result name);
a33: ; end;
al w2 x3 ; w2 := address of result area name in cmnd stack;
c. e77 < 2 ; if system 2 then begin
rl w0 x2 ; w0 := first word of name;
al w3 x1+e60+4 ; w3 := address of document name(first fp note);
a0: sn w0 (x3-4) ; may be next note:
jl. a2. ; if w0 = name of current note then
; goto get work area;
al w3 x3+22 ; current note := current note + 1; w3 := w3 + 22;
sh w3 x1+e61 ; if current note <= last fp note then
jl. a0. ; goto may be next note;
z. ; end system 2;
\f
; fgs 1983.05.17 fortran, pass 0, page 16a
a1: al w0 -1-1<8 ; no result area:
la. w0 c17. ;
rs. w0 c17. ; note supplied by fp := false;
al w3 x2 ; w3 := w2;
a2: al w0 x3-4 ; get work area:
rs. w0 e24. ; save address(result note);
al w2 x3 ; w2 := addr of name;
rl w0 x2 ; w0 := first part of name;
se w0 0 ; if w0 = 0 then
jl. a3. ; begin
al w0 1<7 ; work area created by pass 0 := true;
lo. w0 c17. ;
rs. w0 c17. ;
c. e77 < 2 ; if system 2 then begin
al. w1 d25. ; w1 := tail address;
jd 1<11+40 ; create entry (work name);
se w0 0 ; if result <> 0 then goto error;
jl. a4. ; end;
z. ; end system 2;
a3: al w1 0 ; comment: no zone;
al w0 e80 ; comment: take standard actions for workarea;
am. (c23.) ;
jl w3 +e78 ; connect output;
se w0 0 ; if connect trouble then
jl. a4. ; goto error;
dl w1 x2+4 ; move name of workarea to
ds. w1 f22.+2 ; name parts of
ds. w1 f23.+2 ; byte i-o descriptions;
dl w1 x2+8 ;
ds. w1 f22.+6 ;
ds. w1 f23.+6 ;
\f
; fgs 1983.05.17 fortran, pass 0, page 17
al w3 x2+2 ; process description(work area);
rs. w3 c60. ; save addr of area name;
jd 1<11+8 ; reserve process(workarea);
jd 1<11+4 ;
se w0 0 ; if process does not exist then
jl. a5. ; begin
a4: al w2 1 ; error: w2 := error, other reason;
al. w3 d14. ; set return (break);
jl. w1 c13. ; outtext (<:***fortran object area:>);
<:***fortran object area<10><0>:> ;
; end;
a5: am (0) ; comment: find number of segments
rl w1 +18 ; in area process;
rs. w1 f5. ; available segments := number of segments;
am. (b1.) ; w2 := other last core(output) :=
al w2 -8 ; top command - 8;
al w1 x2-510 ; w1 := other first core(output) := w2-510;
ds. w2 f21. ;
al w1 x1-512 ; w1 := w1-512;
al w2 x1+510 ; w2 := w1+510;
ds. w2 f19. ; first core(output) := w1;
al w2 x2+1 ; last core(output) := w2;
ds. w2 f1. ; current outaddress := w1;
al w1 x1-512 ; last outaddress := w2 + 1;
al w2 x1+510 ; w1 := w1-512; w2 := w1+510;
ds. w2 f17. ; other first core(input) := w1;
al w1 x1-512 ; other last core(input) := w2;
al w2 x1+510 ; w1 := w1-512; w2 := w1+510;
ds. w2 f7. ; first core(input) := w1;
al w2 x2+1 ; last core(input) := w2;
ds. w2 f3. ; current inaddress := w1;
al w1 x1-2 ; last inaddress := w2+1;
rs. w1 c9.+4 ; last work for pass := w1-2;
sl. w1 c0.+512 ; if last work for pass < first free core + 512 then
jl. a31. ; begin
al. w3 d14. ; set return(break);
al w2 1 ; w2 := 1;
jl. w1 c13. ; writetext(<:***pass trouble:>);
<:<10>***pass trouble<0>:> ;
; end;
a31: al. w0 f23. ;
rs. w0 c20. ; set address of byte output description;
al. w0 f22. ;
rs. w0 c21. ; set address of byte input description;
rl. w2 b1. ; command point := top command;
al w2 x2-4 ; top source list :=
rs. w2 b6. ; start source name list :=
rs. w2 e46. ; top command -4;
al w2 x2-2 ; top branch interval list :=
rs. w2 b7. ; top command :=
rx. w2 b1. ; top command - 6;
a6: am. (c23.) ; scan parameter list:
rs w2 e63 ; fp current command := command point;
jl. w3 a21. ; next param;
bl w1 x2 ;
sh w1 3 ; if preceding delimiter < 4 then
jl. a22. ; goto end parameters;
rl w1 x2 ;
sn. w1 (b12.) ; if parameter = (space, name) then
jl. a26. ; goto test name;
\f
; rc 78.04.18 fortran, pass 0, page 18
b2 = k+1 ; alarm state ; alarm next:
a27: se w3 x3 ; if alarm state then
jl. a25. ; goto list parameter;
al w1 10 ;
hs. w1 b2. ; alarm state := true;
hs. w1 b20. ; alarmchar := newline;
al. w1 b8. ;
jl. w3 c13. ; writetext(<:ftn. param:>);
a25: bz w1 x2 ; list parameter:
al. w1 x1+b13. ;
jl. w3 c13. ; writetext(delimiter table(delimiter));
al. w3 a6. ; set return(scan parameter list);
bz w0 x2+1 ;
al w1 x2+2 ; w1 := address(param);
se w0 4 ; if param is name then
jl. c13. ; goto writetext;
rl w0 x2+2 ; w0 := param;
jl. w3 c14. ; writeinteger(<space>,1);
32<12+1 ;
jl. a6. ; goto scan parameter list;
a26: al w1 0 ; test name:
hs. w1 b2. ; alarm state := false;
bz w1 6 ;
sn w1 4 ; if following delimiter = <space> then
jl. a19. ; goto source list;
se w1 8 ; if following delimiter <> point then
jl. a27. ; goto alarm next;
a7: al. w1 b14. ; search option table: entry := base option table;
a8: sl. w1 b15. ; next option:
jl. a27. ; if entry >= last of options then
al w1 x1+14 ; goto alarm next;
dl w0 x1+2 ; entry := entry + 14
sn w0 (x2+4) ; comment: an entry in the option
se w3 (x2+2) ; table consists of:
jl. a8. ; 0 - 7 : name of option.
dl w0 x1+6 ; 8 - 9 : action on integer, action on name
sn w0 (x2+8) ; 10 - 11: modebits to set;
se w3 (x2+6) ; if param <> option name(entry) then
jl. a8. ; goto next option;
jl. w3 a21. ; next param;
bz w0 x2+1 ;
se w0 4 ; if parameter = <name> then
jl. a10. ; goto yes or no;
bl w0 x1+8 ; integer:
hs. w0 b3. ; action := action on integer(entry);
a9: am (x1+12) ; set modebits:
rl. w0 c17. ;
lo w0 x1+10 ; w0 := modebits or bits(entry);
jl. a11. ; goto call action;
\f
; fgs 1983.05.17 fortran, pass 0, page 19
a10: bl w0 x1+9 ; yes or no:
hs. w0 b3. ; action := action on name(entry);
sz w0 1 ; if addr uneven then
jl. a9. ; goto any name, set modebits;
rl w0 x2+4 ;
se w0 0 ; if name word 2(param) <> 0 then
jl. a27. ; goto alarm next;
rl w0 x2+2 ;
sn. w0 (b4.) ; if name word 1(param) = <:yes:> then
jl. a9. ; goto set modebits;
se. w0 (b5.) ; may be no:
jl. a27. ; if name word 1(entry) <> <:no:> then
ac w0 (x1+10) ; goto alarm next;
bs. w0 1 ;
am (x1+12) ;
la. w0 c17. ; w0 := -,bits(entry) and modebits;
a11: am (x1+12) ; call action:
rs. w0 c17. ;
rl w0 x2+2 ; modebits := w0;
b3 = k+1; action ; w0 := parameter;
a12: jl. 0 ; goto modifier(action);
b4: <:yes:> ;
b5: <:no:> ;
b8: <:<10>***fortran param<32><0>:>;
\f
; fgs 1983.05.17 fortran, pass 0, page 19a
a30: se. w0 (b4.) ; details name:
jl. a6. ; if parameter = <:yes:> then
al w0 1 ; begin
al w1 11 ; lower pass no := 1;
ds. w1 c18. ; upper pass no := 11;
jl. a6. ; end; goto scan parameter list;
a35: dl w0 x2+4 ; rts name:
ds. w0 e107.+2 ; move
dl w0 x2+8 ; parameter name
ds. w0 e107.+6 ; to
jl. a6. ; name of runtime system;
a13: al w1 -6 ; details: bound := -6;
a14: rs. w0 x1+e19. ; next interval:
sn. w3 (b10.) ; interval bound(bound) := parameter;
jl. w3 a21. ; if next item head = (point,integer) then
; next param;
rs. w0 x1+e19.+2 ; interval bound(bound+2) := parameter;
al w1 x1+4 ; bound := bound + 4;
sh w1 0 ; if bound > 0
se. w3 (b10.) ; or next item <> (point,integer) then
jl. a6. ; goto scan parameter list;
jl. w3 a21. ; next param;
jl. a14. ; goto next interval;
a15: rs. w0 d7. ; stop integer: stop pass := parameter;
a16: al w0 1 ; stop name:
rs. w0 f9. ; sorry := 1;
jl. a6. ; goto scan parameter list;
a28: rl. w1 b1. ; branch name:
rs. w1 b7. ; top branch interval list := top command;
jl. a6. ; goto scan parameter list;
\f
; rc 19.3.1969 fortran, pass 0, page 20
a17: rl. w1 b7. ; branch integer: w1 := top branch interval list;
a18: al w1 x1-4 ; next branch interval:
rs. w1 b7. ; w1 := top branch interval list := w1 - 4;
sh. w1 d26. ; if w1 <= last of pass 0 then
jl. a6. ; goto scan parameter list;
rs w0 x1+2 ; branch interval list(w1) := parameter;
sn. w3 (b10.) ; if next item = (point,integer) then
jl. w3 a21. ; next param;
rs w0 x1+4 ; branch interval list(w1 - 2) := parameter;
se. w3 (b11.) ; if next item <> (space,integer) then
jl. a6. ; goto scan parameter list;
jl. w3 a21. ; next param;
jl. a18. ; goto next branch interval;
b7: 0 ; top branch interval list;
a19: rl. w1 b6. ; source list: w1 := top source list;
dl w0 x2+4 ;
ds w0 x1+2 ; move parameter to
dl w0 x2+8 ; top source list and on;
ds w0 x1+6 ;
al w1 x1+8 ; top source list := top source list + 8;
rs. w1 b6. ;
jl. a6. ; goto scan parameter list;
a20: rl. w1 b1. ; source yes or no:
al w1 x1+2 ; top source list :=
rs. w1 b6. ; top command + 2;
se. w0 (b5.) ; if param <> <:no:> then
jl. a27. ; goto alarm next;
jl. a6. ; goto scan parameter list;
b6: 0 ; top source list;
a21: rs. w3 b9. ; next param:
ba w2 x2+1 ; save return;
al w3 x2 ; command point :=
ba w3 x2+1 ; command point + bits(12,23,item head);
rl w3 x3 ; w3 := next item head;
bl w0 6 ;
sh w0 3 ; if next delimiter < 4 then
rl. w3 b12. ; w3 := (space,name);
rl w0 x2+2 ; w0 := parameter;
jl. (b9.) ; return;
b9: 0 ; saved return;
a22: rl. w2 b6. ; end parameters:
al w2 x2+2 ; start branch interval list := w2 :=
rs. w2 e47. ; top source list + 2;
rl. w1 b1. ; w1 := top command;
\f
; fgs 1983.05.17 fortran, pass 0, page 21
a23: sn. w1 (b7.) ; move intervals:
jl. a24. ; if w1 = top branch interval list then
dl w0 x1 ; goto set ends;
sh w0 1 ; (w3,w0) := interval(w1);
al w0 1 ; if w0 <= 1 then
sh w3 1 ; w0 := 1;
al w3 1 ; if w3 <= 1 then w3 := 1;
ds w0 x2+2 ; double word(w2) := (w3,w0);
al w2 x2+4 ; w2 := w2 + 4;
al w1 x1-4 ; w1 := w1 - 4;
jl. a23. ; goto move intervals;
a24: al w0 0 ; set ends:
rs w0 x2 ; end branch interval list := 0;
rs. w0 (b6.) ; end source list := 0;
b20 = k+1 ; alarmchar (initially=0, else =10 (newline)
al w0 0 ; w0 := alarmchar;
se w0 0 ; if any alarms then
jl. w3 c12. ; outchar(newline);
rl. w0 c17. ; w0 := modebits;
am e70-e68 ;
rl. w1 e38. ;
lo. w0 b34. ; if fp mode.listing then
sz w1 1<8 ; modebits := modebits or
rs. w0 c17. ; list.yes;
so w0 1<2 ; if pass information wanted then
jl. a32. ; begin
dl. w2 b17. ;
rs. w2 j0. ;
rl. w2 e29. ;
sz w2 1<2 ; if inbyte-details then
rs. w1 j2. ; modify procedure inbyte;
c. (:e15 a. 1:) - 1 ; if special testoutput pass 0 then
jl. w3 d8. ; begin print linehead;
al. w1 f22. ; writetext(string name of object area);
jl. w3 c13. ;
rl. w0 c23. ; write4(fp base);
jl. w2 d20. ;
al. w0 c0. ; write4(first of pass);
jl. w2 d20. ;
rl. w0 f26. ; write4(last work for pass);
jl. w2 d20. ;
rl. w0 c17. ; end;
z. ; end;
a32: rl. w1 e41. ;
sz w0 1<6 ; if integer overflow wanted then
wa. w1 b18. ; set bit 1 in interrupt mask;
rs. w1 e41. ;
rl. w1 c23. ;
al w3 x1+e25 ; set abs address of
rs. w3 d24. ; current program zone descriptor;
rl w2 x3+e48+6 ; w2 := address(program share descriptor);
al w0 x2+10 ; set abs address of
rs. w0 d23. ; last core(program share descriptor(10));
al w0 x3+e49+16 ; set abs address of
rs. w0 d21. ; segment(program process description(16));
al w0 x2+2 ; set abs address of
rs. w0 d27. ; first core(program share descriptor(2));
bz w0 x3+e49+1 ;
se w0 18 ; if process kind(program) = 18 then
jl. a29. ; begin comment: translator on magnetic tape;
rl. w0 b19. ; set bit 4 in give up mask;
lo w0 x3+e50 ; comment: inblock will always return by the
rs w0 x3+e50 ; give up action, because last core = last work;
al. w0 d28. ; set give up action to point to the first
rs w0 x3+e50+2 ; instruction after the call of inblock;
; end;
a29: al w1 x1+e28 ; set abs address of
rs. w1 e62. ; inblock (fp entry);
\f
; fgs 1983.05.17 fortran, pass 0, page 22
b. f10, b2 w. ; compute date and time
jd 1<11+36 ; w0-1:=get clock;
nd w1 3 ; w0-1:=secs:=
fd. w1 f8. ; fix(float(clock)/10 000);
bl w2 3 ;
ad w1 x2-47 ;
wd. w1 f6. ; w1:=day:=secs//(60*60*24);
al w3 0 ; w3-0:=secs:=secs mod (60*60*24);
wd. w0 f1. ; w3-0:=minutes:=secs//60;
ld w3 24 ; w2:=second:=secs mod 60;
wd. w0 f1. ; w0:=hour:=minutes//60;
rs. w3 b0. ; work0:=minute:=minutes mod 60;
wm. w0 f2. ;
wa. w0 b0. ;
wm. w0 f2. ;
wa w0 4 ; w0:=clock:=(hour*100+minute)*100+second;
rs. w0 e74. ; time:=clock;
ld w1 26 ;
wa. w0 f7. ;
al w3 0 ; w0:=year:=(days*4+99111)//1461;
wd. w0 f4. ; w3:=days:=((days*4+99111)mod 1461)//4;
as w3 -2 ;
wm. w3 f0. ;
al w3 x3+461 ;
wd. w3 f3. ; w3:=month:=(days*5+461)//153;
al w1 x2+5 ; w1:=day:=(days*5+461)mod 153 +5;
sl w3 13 ; if month > 13 then
al w3 x3+88 ; month := month - twelwemonth + oneyear;
wm. w3 f2. ; month := month * 100;
rx w2 0 ;
wd. w1 f0. ; day := day//5;
wa w3 2 ; date := day + month;
wm. w2 f5. ; year := year * 1000;
wa w3 4 ; date := date + year;
rs. w3 e74.-2 ;
jl. c7. ; goto next pass;
f0: 5 ;
f1: 60 ;
f2: 100 ;
f3: 153 ;
f4: 1461 ;
f5: 10000 ;
f6: 86400 ; 60*60*24
f7: 99111 ; to adjust for 1.1.68 being start date
10000<9 ;
f8: 4096+ 14-47 ; 10000*2**(-47) as floating point numb
b0: 0 ; work0,saved minute
e. ; end block date and time
\f
; fgs 1983.06.20 fortran, pass 0, page 23
jl. d30-j2 ;b17-2: modifier to procedure inbyte
b17: jl. h3 ; modifier to procedure outbyte;
b18: 1<22 ; modifier to interrupt mask;
b19: 1<19 ; bit 4 to give up mask (block length error;
b34: 1< 0 ; list bit
b10: 8<12 + 4 ; (point,integer);
b11: 4<12 + 4 ; (space,integer);
b12: 4<12 + 10 ; (space,name);
b13 = k - 4 ; delimiter table:
<: :> ; space;
<:=:> ; equal;
<:.:> ; point;
b14 = k - 14 ; option table:
; option name action on action on modebits modebit
; integer name to change word
<:rts:>, 0, 0, 0, h. a27-a12, 1+a35-a12, w. 0 ,c17-c17
<:details:>, 0, h. a13-a12, a30-a12, w. 1<2 ,c17-c17
<:index:> , 0, 0, h. a27-a12, a6 -a12, w. 1<3 ,c17-c17
<:survey:> , 0, 0, h. a27-a12, a6 -a12, w. 1<2 ,c17-c17
<:stop:> , 0, 0, h. a15-a12, a16-a12, w. 1<4 ,c17-c17
<:list:> , 0, 0, h. a27-a12, a6 -a12, w. 1<0 ,c17-c17
<:message:> , 0, h. a27-a12, a6 -a12, w. 1<1 ,c17-c17
<:spill:> , 0, 0, h. a27-a12, a6 -a12, w. 1<6 ,c17-c17
<:branch:> , 0, 0, h. a17-a12, a28-a12, w. 1<9 ,c17-c17
<:source:> , 0, 0, h. a27-a12, a20-a12, w. 0 ,c17-c17
<:cond:> , 0, 0, h. a27-a12, a6 -a12, w. 1<10 ,c17-c17
<:cardmode:>, 0, h. a27-a12, a6 -a12, w. 1<11 ,c17-c17
<:connect:>, 0, h. a27-a12, a6 -a12, w. 1<12 ,c17-c17
<:fp:>, 0, 0, 0, h. a27-a12, a6 -a12, w. 1<13 ,c17-c17
<:test:> , 0, 0, h. a27-a12, a6 -a12, w. 2047<13,e29-c17
<:testa:> , 0, 0, h. a27-a12, a6- a12, w. 1<13 ,e29-c17
<:testb:> , 0, 0, h. a27-a12, a6 -a12, w. 1<14 ,e29-c17
<:testc:> , 0, 0, h. a27-a12, a6 -a12, w. 1<15 ,e29-c17
<:testd:> , 0, 0, h. a27-a12, a6 -a12, w. 1<16 ,e29-c17
<:teste:> , 0, 0, h. a27-a12, a6 -a12, w. 1<17 ,e29-c17
<:testf:> , 0, 0, h. a27-a12, a6 -a12, w. 1<18 ,e29-c17
<:testg:> , 0, 0, h. a27-a12, a6 -a12, w. 1<19 ,e29-c17
<:testh:> , 0, 0, h. a27-a12, a6 -a12, w. 1<20 ,e29-c17
<:testi:> , 0, 0, h. a27-a12, a6 -a12, w. 1<21 ,e29-c17
<:testj:> , 0, 0, h. a27-a12, a6 -a12, w. 1<22 ,e29-c17
<:testk:> , 0, 0, h. a27-a12, a6 -a12, w. 1<23 ,e29-c17
<:trunc:> , 0, 0, h. a27-a12, a6 -a12, w. 1<0 ,e29-c17
<:warning:> , 0, h. a27-a12, a6 -a12, w. 1<1 ,e29-c17
<:testin:> , 0, 0, h. a27-a12, a6 -a12, w. 1<2 ,e29-c17
<:names:> , 0, 0, h. a27-a12, a6 -a12, w. 1<3 ,e29-c17
<:stack:> , 0, 0, h. a27-a12, a6 -a12, w. 1<4 ,e29-c17
b15 = k - 12 ; last of options;
d25: 100 ; tail for look up entry and create entry;
d26: 0,r.9 ; segments = 100, dummy entry
\f
; fgs.jz 1983.06.20 fortran, pass 0, page 24
h5 = k - e38 ; length of entire pass 0;
e89 = h5 ; loadlength for insertproc
e30 = h5 ; accumulated length of passes for insertproc
i. ; id list;
e. ; end block: initialize translator;
i. ; id list;
e. ; end block: pass 0 segment;
m. rc 85.09.26 fortran, pass 0
\f
▶EOF◀