|
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: 222720 (0x36600)
Types: TextFile
Names: »algftnrtst7 «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algftnrtst7 «
;************************************************************************
;* *
;* R C 4 0 0 0 / R C 8 0 0 0 / R C 9 0 0 0 *
;* *
;* *
;* C O M M O N R U N T I M E S Y S T E M *
;* *
;* F O R *
;* *
;* A L G O L A N D F O R T R A N *
;* *
;* J Z A N D F G S 1 9 8 3 . 0 6 . 0 6 *
;* *
;* R E L E A S E 0.0 1 9 8 3 . 0 6 . 0 6 *
;* *
;* R E L E A S E 1.0 1 9 8 3 . 0 9 . 0 1 *
;* *
;* R E L E A S E 2.0 1 9 8 5 . 1 1 . 0 1 *
;* *
;* R E L E A S E 3.0 1 9 8 6 . 0 5 . 0 1 *
;* *
;* R E L E A S E 4.0 1 9 8 7 . 0 3 . 0 1 *
;* *
;* R E L E A S E 5.0 1 9 8 7 . 1 0 . 0 1 *
;* *
;* R E L E A S E 6.0 1 9 8 9 . 0 2 . 0 1 *
;* *
;************************************************************************
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...1...
; contents:
; page 4- 61 rs resident part. permanently in core during execution.
; page 62- 72 rs initialisation. entered from fp when execution starts.
; page 73- 80 alarm segment 0: adjusts variables before alarm printing,
; jumps to alarm segment 1 for printing, else (or after return)
; exit to program or jump to alarm segm 1 for exit from program
; <:alarm segm0:>
; page 81- 89 alarm segment 1. alarm printing, unwinding of stack, back
; to alarm segment 0, after return from alarm segment 0 exit
; from program,
; <:alarm segm1:>
; page 90- 97 init zones, init data and init zone common
; <:zone declar:>
; page 98-111 algol check: operations with long operands, call of users block
; procedure, stderror, path to program entry
; <:algolcheck:>
; page 112-124 block segment. inblock, outblock, check.
; <:check:>
; page 125-134 error segment. special error actions for check,
; <:check spec:>
; page 135-141 power function: a**x
; <:power func.:>
; page 142-147 extend area segment. extend area and parent message, label alarm
; <:extend area:>
; page 148-151 list of rs-entries.
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...2...
; b. h99 ; block for fpnames
b. e110, g10, p4 ; block for insertproc
w.
k = 0
d.
p. <:fpnames:>
l.
;*******************************************
;* *
;* Remember : *
;* *
;* update e103, e104 and e105 : *
;* *
;* rts version, release and releasedate *
;* *
;*******************************************
e39 = 512 ; segment length for runtime segments
e77 = h57 ; system 2/system 3
e100= h76 ;
e103= 2; rts version
e104= 6<12+ 0; rts release <12 + rts subrelease
e105=1989<12+0201; rts release year <12 + rts release date
s. c99, d115, f61, g48, j20, q7 ;
w.
k = h55
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...3...
; usage of names:
; a-names: local addresses in the blocks.
; b-names: local variables in the blocks.
; c-names: various internal entries in rs.
; d-names: d0 is the core base load value. d1 ... corresponds to the rs
; entries 1 ... a d-name corresponding to an entry in rs resident
; part is the load address of that entry. a d-name corresponding
; to an entry to rs segments is the final point:
; segment no.<12 + rel within segment
; f-names: important variables in rs resident part (see page 7-8).
; g-names: a few late defined addresses. most of them used only by alarm
; segment 0 and defined on page 35.
; h-names: corresponds to the h-names of fp.
; j-names: segment numbers for rs segments (defined below).
; 0 rs resident
; 1 -
; 2 -
; 3 -
; 4 -
; 5 -
; 6 -
; 7 -
; j9 : 8 alarm segm0 , j0 = -1<22 + j9<1, j12 = j9<1
; j3 : 9 alarm segm1 , j4 = -1<22 + j3<1
; 10 zone declar
; j7 : 11 algol check , j8 = -1<22 + j7<1
; j2 : 12 check , j6 = -1<22 + j2<1
; j1 : 13 check spec , j5 = -1<22 + j1<1
; j15: 14 power func. , j16= -1<22 + j15<1
; j17: 15 extend area , j18= -1<22 + j17<1
\f
; jz.fgs 1986.05.20 algol/fortran runtime system page ...4...
c20: ; define base of segment 0.
e0:
b. a43, b20 w. ; begin of rs resident part
; working locations and constants
c7=k ; first of rs, load addr.
d0=c7-h55 ; core base, load addr, includes resident fp.
f2: 0 ; victim: core base for next segm to transfer
f3: 1<23 ;
f4: 511 ; mask: physical segm length - 1.
f5: 0 ; saved point, working location for take expr
; and goto computed.
f8: ; check x3 mark in instr exception.
f9: 3<12 ; message: input
0 ; +2 first addr
0 ; +4 last address;
0 ; +6 segment number
f7: 0,0,0,0 ,0,0,0,0 ; answer: 8 words;
f10: 0 ; core base (= first of process)
f11: 0 ; base of segm table+1<22-core base : (1<22 + first of segtable + first of process)
d77:
f13: 0,0,0,0,0 ; program name, name address: 5 words.
f14: 0 ; stack bottom:
; f15: see alarm in rs resident part.
f16: 0 ; d38-6 spare mess buf: used by segment transfer.
f17: 0 ; parent process addr:
f18: 0 ; end action: determines how the run is terminated:
d38: ; 0 normal, 1 finis job, >1 break.
f19: 0 ; console process addr:
f21: 0 ; own process descr address
d12=k+3, 0, 0 ; uv: holds the result of procedure calls, name
; expressions, and rs operators. parameters to rs operators are trans-
; mitted in uv.
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...5...
d13: 0 ; last used in stack.
d14: 0 ; last of program segments in core.
d15: 0 ; first of program segments in core, = top of
; segm table.
f6: ; first in segment table:
f12: ; segment table address for alarm segm 0:
d16: 0 ; segment table base:
d37: -1 ;-2 overflows:
d22: 0 ; underflows: <0 causes alarm, other-
; wise increase the cell.
d23: 1<22 ; youngest zone: abs address of latest zone declared.
d24: 0 ; blocks read: increased by one each time a program
; segment is read to core.
d26=d0+h20 ; in: load addr of current input zone descr.
d27=d0+h21 ; out: load addr of current output zone descr.
0 ; saved sref: holds initial w2 during execution of
; rs operators and code procs.
d30: f61 ; saved w3: holds initial w3 during execution of
; rs operators. initially: path to progr entry.
w.
0 ; -2, end prog. conditions: hold w1 and w2
d31: 1 ; at return to fp. initially: unsuccesful execu-
; tion, other reasons.
f20: 0 ; first of process area
f22: 0 ; share, work for release zones, instr exception
d49=k+3, 0, 0 ; dr1: first doubleword of doubleprecision register
d50=k+3, 0, 0 ; dr2: second - - - -
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...6...
; variables used in context, activity, trap and segmentation:
f23: 0 ; top program segment table
f36: 0 ; last of segment table
f24: 0 ; first of segments
f25: 1 ; program mode (init: locking passive)
f26: 0 ; blocksout
0 ; f52-2: segment displacement
f52: 0,0,0,0,0; name of datafile (virtual storage)
f48: 0 ; f27-2: old size
f27: 0, r.10 ; cattail for lookup entry(datafile name)
f28: 0 ; (incarnation-1)*2
f38: 0 ; victim1
f39: 0 ; f40-2: csr
f40: 1<22 ; cza
f41: 0 ; oldcsr
f42: d9 ; (seg<12+rel) for entry init zone
d76 ; f43 - 2: virtual address of own segment 0,
; used by procedures: getowns and saveowns
f43: 0 ; program size (no of segments)
f45: 0 ; address of current blocktable entry
f46: 0 ; d64-2: current mode param;
d64: 0 ; dummy variable used in while constructs;
d79: 0 ; trapmode
0 ; d78-2: alarmcause(0)
d78: 0 ; alarmcause(1)
d81: 0 ; max last used
d82: 0 ; limit last used
d83: 0 ; temp last used
d84: 0 ; current activity (table entry address)
d92: 0 ; current activity (1 <= current activity <= no of activ.)
\f
; jz.fgs 1987.07.03 algol/fortran runtime system page ...7...
d85: 0 ; no of activities
d86: 0 ; base of activity table
0 ; d87-2: azone
d87: 0 ; aref = sref for activity block
d88: 0 ; abs addr of top program (last used or temp last used);
d93: 0 ; current stack bottom;
d95: 0 ; d96 - 2: entry point: disable activity ; algol coroutine system adds 1 as mode bit
d96: 0 ; : entry point: enable activity
d97: 0 ; trapchain
f58: 0 ; program segment offset
f59: 0 ; common base + 3<21 - corebase
f60: 3<21 ; constant used by absword modifications
f15: 0, r.15 ; working locations for alarm, 30 halfs
d65=f25, d66=f26, d67=f27, d68=f36, d69=f40, d70=f43, d72=f52, d80=f24
; relative addresses in context zone in stack:
g25 = h2 + 2 ; csr , cza
g26 = h2 + 4 ; block table address
g27 = h2 + 6 ; dest
g28 = h3 + 0 ; next
g29 = h3 + 4 ; appetite , first var
g30 = h4 + 4 ; chain to elder
g31 = h4 + 0 ; last array
g32 = h3 + 6 ; mode parameter
g33 = h4 + 2 ; context label
g35 = h1 + 16 ; first array
p3 = k - c20 ; start external list:
0,0,s3,s4; empty, date, time
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...8...
; the following working locations hold initially the code for initiali-
; sation of the segment table.
f1: 0 ; save return ;
rl. w1 f6. ; call sref ; w1:=first in segm table;
f0: al w0 x1 ; call addr ; rep:
; interrupt addr: ; ; w0:=
c0: wa. w0 f3. ;+0 w0 dump ; core(segm table addr):=
rs w0 x1 ;+2 w1 dump ; segm table addr + 1<23;
al w1 x1+2 ;+4 w2 dump ; w1:=segm table addr:=w1+2;
se. w1 (d15.) ;+6 w3 dump ; if w1 <> first of program then
jl. f0. ;+8 ex dump ; goto rep;
rl. w1 d30. ;+10 w1 := path to program entry
jl. d5. ;+12 goto gotopoint;
c.e100-16
jl. 2 , r.(:c0.+h76+2:)>1
z.
dl. w2 c0.+12 ;+h76 trap routine: w2:=cause; w1:=cont addr;
sl. w1 c0. ; if cont addr >= interrupt addr
sl. w1 a10. ; and cont addr<end of trap routine then
jl. a11. ; begin
rs. w1 a17. ; save cont addr;
al. w1 a3. ; cont addr:=break; the break takes place
rs. w1 c0.+10 ; when the trap routine is left. notice that
dl. w1 c0.+2 ; exit may take place to cont addr - 2.
dl. w3 c0.+6 ; reestablish registers, continue in
jl. (a17.) ; trap routine. register dump from first entry
a17: 0 ; is spoiled now. only latest call addr and
; call sref is saved.
; end;
\f
; jz.fgs 1987.07.05 algol/fortran runtime system page ...9...
a11: rl. w0 c0.+4 ; w0:=w2 dump;
am 2047 ;
sl. w1 a24. ; if cont addr > end rs then
ds. w1 f0. ; (call addr:=cont addr; call sref:=w2 dump);
; the call address gives the segment place to be saved in case of segment
; transfer, the continue address gives the instruction to execute after
; the trap. they differ only when the instr.exception routine is entered
; from rs.
sl w2 9 ; if cause > 8 then
al w2 8 ; cause := 8;
jl. x2+2 ; case cause of
d39: ; trap base: some of the following instructions
; may be exchanged by standard procedures.
jl. c3. ; 0: goto instr exception;
jl. c4. ; 2: goto integer fault;
jl. c5. ; 4: goto floating fault;
jl. 2 ; 6: monitor fault:
a3: rl. w3 f20. ; 8: break: modified after first break
al. w2 c0. ; move registers
rl w0 x2 ;
rs w0 x3+2 ;
al w3 x3+2 ;
al w2 x2+2 ;
se. w2 c0.+h76 ;
jl. a3.+4 ;
c. e77<3 ; if system3 then begin
am. (c0.+10) ; if break instruction = ks then
bl w0 -2 ; enter fp break routine ;
h. sn w0, ks w. ; comment if fp is not present
jl. d0.+h10+h76; a break will happen;
z. ; end system3;
la. w0 a4. ;
h. sn w0, ix w. ; if ix instruction then
jl. c80. ; goto emulate ix instruction;
c21: am -3 ; cause:=-9;
c4: al w0 -6 ; integer fault: cause:= -6;
jl. a2. ; goto trap alarm; <*via stepping stone*>
a4: 8.77777700 ; mask for instruction field
\f
; jz.fgs 1988.10.07 algol/fortran runtime system page ...10...
b. b0 ; begin block floating fault
w.
c5: bl. w0 c0.+3 ; floating fault:
al. w1 d22.-2 ; w1 := overflow address;
bl. w3 c0.+9 ; w3 := exception reg. dump;
f54=k+1; rc8000 ;
se w3 x3+0 ; if rc8000 and
so w0 3 ; overflow and underflow then
jl. a1. ; begin <*ix index alarm*>
am. (c0.+10) ; w0 := cause :=
el w1 -1 ; if dopereltype.type >= 0 then
sl w1 0 ; -16 <*index*>
am -4 ; else
al w0 -12 ; -12 <*field*>;
am. (c0.+10) ;
el w1 -4 ; w1 := ix instr.w-field *
la. w1 b0. ; 2;
ls w1 -3 ;
rl. w1 x1+c0. ; w1 := saved w-reg; <*index*>
jl. a2. ; goto trap alarm;
a1: ; end <*ix index alarm*>;
sz w3 1 ; if bit23(except. dump) = 1 then
al. w1 d22. ; w1 := underflow address;
al w0 -7 ; w0:=cause:=-7;
rl w2 x1 ;
sh w2 -1 ; if ouflow < 0 then
a2: jl. c83. ; goto trap alarm; <*also stepping stone*>
al w2 x2+1 ; ouflow:=ouflow+1;
rs w2 x1 ;
al w0 1024 ;
ld w1 -23 ; w0-1:= 0.0;
dl. w3 c0.+6 ; reestablish w2-3;
xl. c0.+9 ; reestablish ex;
jl. (c0.+10); continue
b0: 3<4 ; mask for w-field;
i. ; id list
e. ; end floating fault;
\f
; jz.fgs 1987.07.05 algol/fortran runtime system page ...11...
; read segment : jl. w3 c10.
; write segment: jl. w3 c46.
; from rs init : jl. w3 c17.
; output segment: jl. w3 c65. (called from check save (c64))
b. a7, b4 w. ; begin block segment transfer
f53:
b1: 0 ; address of name of area
b0: 0 ; saved return
0 ; saved w0 (c65)
b2: 0 ; saved w1 (c65)
0 ; saved w2 (c65)
b3: 0 ; saved w3 (c65)
c65: ds. w3 b3. ; output segment:
ds. w1 b2. ; save all registers;
al w1 x2-510 ; first storage address := last of segment - 510;
ds. w2 f9.+4 ; last storage address := last of segment;
rl w0 x2-510 ; segment :=
rs. w0 f9.+6 ; first word of segment;
jl. w3 c46. ; write segment;
dl. w3 b3. ; restore
dl. w1 b2. ; all registers;
jl x3 ; return;
a0: jd 1<11+52 ; area process: create area process;
bz. w2 f9. ;
sn w2 5 ; if output operation then
jd 1<11+8 ; reserve process;
se w0 0 ; if result <> ok then
a7: jl. w3 h7+d0. ; call fp-end program; <*also stepping stone*>
jl. a3. ; goto repeat transfer;
c17: rs. w3 b0. ; entry from rs initialization: save return;
jl. a5. ; goto transfer (segno in w2, name addr =prog. name);
\f
; jz.fgs 1987.07.03 algol/fortran runtime system page ...12...
c46: rl. w2 f9.+2 ; write segment:
rl w2 x2+2 ; w2 := segment(2);
sn w2 0 ; if -,segment updated
jl x3 ; then return;
am 1 ; clear_update := true; skip next;
c74: al w2 0 ; write block:
hs. w2 b4. ; clear_update := false;
al w2 5 ; operation := output;
jl. a4. ; goto prepare transfer;
c10: am 1 ; read segment: clear_update := true; skip next;
c75: al w2 0 ; read block:
hs. w2 b4. ; clear_update := false;
al w2 3 ; operation := input;
a4: hs. w2 f9. ; prepare transfer;
al. w1 d24. ; counter :=
se w2 3 ; if operation = input then blocksread
al. w1 f26. ; else blocksout;
rl w2 x1 ;
al w2 x2+1 ; counter :=
rs w2 x1 ; counter + 1;
rs. w3 b0. ; save return;
rl. w2 f9.+6 ; name address :=
al. w0 f13. ; if data segment
sl. w2 (f23.) ; then name of data file
al. w0 f52. ; else name of program file;
rs. w0 b1. ; segment no :=
ws. w2 d16. ; (segtable addr - segtable base);
a2: ls w2 -1 ; segment no := segment no / 2;
sn. w0 f13. ; if name addr <> program name addr then
jl. a5. ; segment no :=
ws. w2 f52.-2 ; segment no - displacement;
jl. a6. ; else
a5: zl. w0 f9. ; begin <*name adr = program name addr*>
am. (f58.) ; if program segment offset <> 0 and
se w3 x3 ; operation = 5 then
se w0 5 ; begin
jl. a6. ; w2, w3 ;= saved sref, w3;
dl. w3 f0. ; goto offset alarm;
jl. c39. ; end;
a6: wa. w2 f58. ; end;
rs. w2 f9.+6 ; segment no := segment no + program segment offset;
\f
; jz.fgs 1987.07.05 algol/fortran runtime system page ...13...
rl. w2 f16. ; w2 := spare mess buff addr;
al. w1 f7. ; w1 := answer addr;
se w2 0 ; if spare mess buf addr <> 0 then
jd 1<11 + 18 ; w0 := wait answer;
a3: ; repeat transfer:
al. w1 f9. ; w1 := mess addr;
rl. w3 b1. ; w3 := addr of area name;
jd 1<11 + 16 ; w2 := send message;
al. w1 f7. ; w1 := answer address;
jd 1<11 + 18 ; w0 := wait answer;
al w2 1 ;
ls w2 (0) ; w2 := logical status;
sn w2 2 ;
lo. w2 f7. ;
rl. w1 b1. ; w1 := saved name addr;
sz w2 1<5+1<2 ; if not exist or rejected
jl. a0. ; then goto area process;
se w2 2 ; if logical status <> 2 then
jl. w3 a7. ; call fp-end program; <*via stepping stone*>
sl. w2 (f7.+2) ; if bytes transferred <= 2 then
jl. a3. ; goto repeat transfer;
al. w1 f3. ; w1 := addr of nonsens message;
jd 1<11 + 16 ; w2 := spare mess buf addr;
rs. w2 f16. ; save w2;
al w2 0 ;
rl. w3 f9.+2 ; w3 := first of segment;
rl. w1 b1. ;
b4 = k + 1; clear_update
sn w3 x3+0 ; if -,clear_update then
jl. (b0.) ; then return;
se. w1 f13. ; if name address <> program name address
rs w2 x3+2 ; then segment(2) := 0; (updated:=false);
jl. (b0.) ; return;
i. ; id list
e. ; end read/write segment
\f
; jz.fgs 1987.02.25 algol/fortran runtime system page ...14...
b. a10 w. ; entry: jl. c3.
c3: rl. w3 c0.+6 ; instr exception:
lx. w3 f3. ; w3 := segment table address := w3dump - 1<23;
rl. w2 f36. ; w2 := last in segment table;
sl. w3 (f6.) ; if w3 < first in segment table
sl w3 x2+2 ; or w3 >= last in segment table+2
jl. d39.+8 ; then goto break;
rs. w3 f22. ; segm table addr := w2;
rs. w3 f9.+6 ; segment no := w3;
rl. w0 f0. ; w0 := call address;
rl. w1 (d88.) ; w1 := rts.top of program;
; current partition index supposed to be lower index
rl. w2 f25. ; w2 := pagestate;
sh w2 0 ; if pagestate <= 0 then
jl. a1. ; goto release;
sz w2 1<0 ; if passive then
jl. a2. ; goto advance victim;
rl. w3 f22. ; w3 := seg table addr;
sl. w3 (f23.) ; if segment is data segment then
am 4 ; bits := databit + allbit else
al w3 6 ; bits := programbit + allbit;
la w2 6 ; pagestate := pagestate and bits;
sn w2 0 ; if pagestate = 0 then
jl. a2. ; goto advance victim;
a0: jl. w3 c77. ; active: try high partition first;
jl. w3 c45. ;
al w3 x2 ; w3 := advance program;
sh w0 x3 ; if call address
sh w0 x3-510 ; outside reserved segment
jl. a4. ; then goto update segment allocation;
jl. a0. ; goto active;
\f
; fgs 1987.02.05 algol/fortran runtime system page ...14a...
a1: ls w2 9 ; release:
al w1 1 ; w2 := - no of halfs to release;
sn w2 0 ; if w2 = 0 then
ld w2 -1 ; w2 := - max integer;
a8: rl. w3 d15. ; w3 := no of halfs locked in the partition -
ws. w3 f24. ; no of halfs to release;
wa w3 4 ; <*i.e. no of halfs to release in next partition*>
wa. w2 d15. ; new := first of program - no of halfs to release;
sh. w2 (f24.) ; if new <= first of segments then
rl. w2 f24. ; new := first of segments;
rs. w2 d15. ; first of program := new;
rl. w2 d110. ;
se. w2 d112. ; if current index = lower index and
sl w3 0 ; halfs to release in next partition < 0 then
jl. a9. ; begin
al w2 x3 ; w2 := no of halfs to release in next partition;
jl. w3 c77. ; switch to high end;
jl. a8. ; goto next partition;
a9: jl. w3 c78. ; end;
rl. w1 (d88.) ; switch to low end; w1 := rts.top of program;
\f
; jz.fgs 1987.02.27 algol/fortran runtime system page ...15...
; call : jl. w3 a2.
;
; w0 : call address
; w1 : top of program (d88)
; w2 : progmode
; w3 : -
a10: jl. w3 c79. ; switch to other and get new victim:
rl. w1 (d88.) ; w1 := rts.top of program;
rl. w3 d15. ; w3 := victim := rts.first of program;
jl. a7. ; goto try victim;
; advance victim:
a2: ; get victim and partition:
sh. w1 (f2.) ; if victim >= rts.top of program then
jl. w3 c77. ; switch to high end partition;
rl. w1 (d88.) ; w1 := := rts.top of program;
rl. w3 f2. ; w3 := victim := rts.victim;
a7: ; try victim:
sl. w3 (d15.) ; if victim < rts.first of program
sh w1 x3+510 ; or victim.last >= rts.top of program then
jl. a10. ; goto switch to other and get new victim;
al w3 x3+512 ; victim := victim + 512;
sl w0 x3+2 ; if call address <= victim and
jl. a3. ;
sl w0 x3-510 ; call address > victim - 512 then
jl. a7. ; goto try victim;
a3: rs. w3 f2. ; rts.victim := victim;
a4: rs. w3 f38. ; update segment allocation: save(victim1);
al w2 x3-2 ; last := last on segment before victim1;
sh. w2 (d14.) ; if last of program >= last then
jl. w3 c27. ; release segment;
sl. w2 (d14.) ; if last of program <= last
rs. w2 d14. ; then last of program := last;
al w1 x2-510 ; first storage address := last - 510;
ds. w2 f9.+4 ; last storage address := last;
jl. w3 c10. ; read segment;
rl. w1 f38. ; adjust abs addresses: w1:=victim1;
al w3 x1-512 ; w3 := final segment base := first on victim1;
ba w1 x3+1 ; w1 := victim1 + rel of last abs word;
rl. w0 f22. ;
sl. w0 (f23.) ; if data segment then
jl. a6. ; goto return
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...16...
; next abs word:
a5: rl w0 x1-512 ; absword := core(w1-512);
sz. w0 (f3.) ; if core address then
wa. w0 f11. ; absword := absword + base segmentable base
sz. w0 (f60.) ; + 1<22 - corebase;
wa. w0 f59. ; if common reference then
wa. w0 f10. ; absword := absword + common base;
rs w0 x1-512 ; absword := absword + corebase;
al w1 x1-2 ; w1 := w1 - 2;
sl w1 x3+514 ; if w1 > final segment base + 512
jl. a5. ; then goto next abs word;
; return:
; notice: first word on victim 1 segment
a6: rl. w1 f22. ; destroyed if rel of last abs word = 0;
rs w1 x3 ; first on victim1 segment := segtable addr;
rs w3 x1 ; segmtable(victim1) := segment base;
jl. w3 c78. ; switch to low end;
rl w3 x1 ; restore w3;
dl. w1 c0.+2 ; restore(w0,w1);
rl. w2 c0.+4 ; restore(w2);
xl. c0.+9 ; restore(exception);
am. (c0.+10) ;
jl -2 ; goto call address - 2;
i. ; id list
e. ; end instr exception
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...17...
; call : w2 = addr of segment + 510; jl. w3 c27.
; return: w0, w1, w2 unchanged
b. a1, b2 w. ;
0 ; saved w0
b0: 0 ; saved w1
0 ; saved w2
b1: 0 ; saved w3
b2: 0 ; saved segment no;
c27: ds. w3 b1. ; release segment:
; save(w2,w3);
rl w3 (x2-510) ; w3 := segtable(segment);
se w3 x2-510 ; if w3 <> first of segment then
jl. (b1.) ; return;
rl w3 x2-510 ; w3 := addr(segtable(segment));
sl. w3 (f23.) ; if w3 >= top table program then
jl. a1. ; goto write data segment;
a0: wa. w3 f3. ; kill segment:
rs w3 (x2-510) ; segment table(segment) :=
jl. (b1.) ; w3 + 1 < 23; return;
a1: rx. w3 f9.+6 ; write data segment:
rs. w3 b2. ; swap(w3,segn0); saved seg no := segno;
ds. w1 b0. ; save(w0,w1);
al w1 x2-510 ; first storage address := first of segment;
ds. w2 f9.+4 ; last storage address := last of segment;
jl. w3 c46. ; write segment;
rl. w3 b2. ;
rs. w3 f9.+6 ; restore(seg no);
dl. w1 b0. ; restore(w0,w1);
rl. w2 b1.-2 ; restore(w2);
rl w3 x2-510 ; w3 := addr of segment table(segment);
jl. a0. ; goto kill segment;
i. ; id list
e. ; end release segment;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...18...
; call return
;
; w0 : - unchanged
; w1 : - unchanged
; w2 : - new first of program (d15)
; w3 : link undefined
b. a2, b3 ;
w. ;
b3: 0 ; saved w3;
c45: ; advance first of program:
rs. w3 b3. ; save return;
a1: rl. w2 d15. ; new first of program :=
al w2 x2+512 ; first of program + 512;
rl. w3 (d88.) ;
sh w3 x2+1022 ; if top of program <= new first of program + 1022
jl. a2. ; then goto try low end;
rs. w2 d15. ; first of program := new first of program;
jl. (b3.) ; return;
a2: al w3 x2 ; try low end:
rl. w2 d110. ; save new first of program;
sn. w2 d111. ; if current index <> low index then
jl. a0. ; begin
jl. w3 c78. ; switch to low end;
jl. a1. ; goto try again;
a0: al w1 x3 ; end else
dl. w3 f0. ; begin
jl. c11. ; w2, w3 := call sref, call addr;
; w1 := new first of program;
; goto stack alarm;
; end;
i. ; id list
e. ; end advance first of program
\f
; fgs 1988.05.18 algol/fortran runtime system page ...18a...
d110: 0 ; curr partition index
0 ; -2: last of program in core
d111: 0 ; low partition index+0: first of program in core
0 ; +2: first of segments
0 ; +4: addr top of program
0 ; +6: max last used
0 ; +8: limit last used
0 ; +10: temp last used
0 ; +12: last used
0 ; +14: temp stack bottom
0 ; -2: last of program in core
d112: 0 ; high partition index+0: first of program in core
0 ; +2: first of segments
0 ; +4: addr top of program
0 ; +6: max last used
0 ; +8: limit last used
0 ; +10: temp last used
0 ; +12: last used
0 ; +14: temp stack bottom
\f
; fgs 1988.05.18 algol/fortran runtime system page ...18b...
; procedures :
; switch to high end
; switch to low end
; switch to other end
; call return
;
; w0 : - unchanged
; w1 : - unchanged
; w2 : - unchanged
; w3 : link undefined
b. a0, b3 ;
w. ;
b0: 0 ; saved w0
b1: 0 ; saved w1
b3: 0 ; saved w3
d115:
c77: rs. w3 b3. ; switch to high end:
al. w3 d111. ; index := low partition index;
jl. a0. ; goto common;
d114:
c78: rs. w3 b3. ; switch to low end:
al. w3 d112. ; index := high partition index;
jl. a0. ; goto common;
d113:
c79: rs. w3 b3. ; switch to other end:
rl. w3 d110. ; index := current index;
jl. a0. ; goto common;
\f
; fgs 1988.05.18 algol/fortran runtime system page ...18c...
a0: se. w3 (d110.) ; common:
jl. (b3.) ; if index <> current index then
; return;
ds. w1 b1. ; save (w0, w1);
dl. w1 d15. ; index(.first of segments
ds w1 x3 ; .first of program
rl. w0 f24. ; .last of program
rl. w1 d88. ; .addr top program
ds w1 x3+4 ;
dl. w1 d82. ; .max last used
ds w1 x3+8 ; .limit last used
rl. w0 d83. ; .temp last used
rl. w1 d13. ; . last used
ds w1 x3+12 ;
rl. w1 f14. ; .temp stack bottom) :=
rs w1 x3+14 ; rts (.-do- ) ;
se. w3 d111. ; index :=
am d111-d112 ; other
al. w3 d112.; index;
rs. w3 d110. ; current index := index;
dl w1 x3 ; rts (.first of segments
ds. w1 d15. ; .first of program
dl w1 x3+4 ; .last of program
rs. w0 f24. ; .addr top program
rs. w1 d88. ;
dl w1 x3+8 ; .max last used
ds. w1 d82. ; .limit last used
dl w1 x3+12 ; .temp last used
rs. w0 d83. ; . last used
rs. w1 d13. ;
rl w1 x3+14 ; .temp stack bottom :=
rs. w1 f14. ; index(.-do- ) ;
dl. w1 b1. ; restore (w0, w1);
jl. (b3.) ; return;
i. ; id list
e. ; end switch procedures
a10 = k + 2 ; end of trap routine;
\f
; jz.fgs 1987.06.02 algol/fortran runtime system page ...19...
; call : w0 = appetite (-no of bytes); jl. w3 c44.
; return: w3 = virtuel address of reserved area (first byte);
b. a6, b7 w. ;
0 ; saved w0 , b0 - 2
b0: 0 ; saved w1
0 ; saved w2 , b1 - 2
b1: 0 ; saved w3
b2: 0 ; new first free
b3: 254 ; segment length
b7: 0 ; segments
c44: ds. w1 b0. ; reserve bs:
ds. w3 b1. ; save all registers;
sh w0 0 ; if appetite <= 0 then
jl. a5. ; goto word by word;
am +2047 ;
rl. w3 a25. ; blockwise: <*a25 = f37-2047*>
al w3 x3+252 ;
al w2 0 ; segno := (first free + 252)//254;
wd. w3 b3. ;
wm. w3 b3. ; first free :=
al w3 x3+1 ; segno*254 + 1;
am +2047 ;
rs. w3 a25. ; <*a25 = f37-2047*>
rl w3 0 ;
al w3 x3+510 ;
ls w3 -9 ; app1 := (appetite+510)//512
wm. w3 b3. ; *254;
jl. a6. ; skip 2;
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...20...
a5: as w0 -1 ; word by word:
ac w3 (0) ; appetite := -appetite//2;
a6: am +2047 ; first := first free + appetite;
wa. w3 a25. ;
sh w3 0 ; if first > 2**24 -1 then
jl. c48. ; goto wrk alarm;
rs. w3 b2. ; new first free := first;
al w2 0 ;
al w3 x3+252 ; segments :=
wd. w3 b3. ; (first + 252)//254 +
wa. w3 f43. ; program size
ws. w3 f52.-2 ; - segment displacement;
rs. w3 b7. ;
rl. w1 f48. ;
sh w1 x3-1 ; if segments > old size
jl. a1. ; then goto extend;
a0: jl. w3 c78. ; reservation ok:
rl. w3 b2. ; switch to low end;
am +2047 ;
rx. w3 a25. ; first free := new first free; w3 := oldff;
dl. w2 b1.-2 ; restore(w1,w2);
rl. w0 b0.-2 ; restore(w0);
jl. (b1.) ; return;
a1: sh. w3 (f27.) ; extend: if segments <= size then
jl. a2. ; goto extend segment table;
rx. w3 f27. ; swap(segments,size);
al. w1 f27. ; w1 := taill address;
al. w3 f52. ; w3 := name address;
jd 1<11 + 44 ; change entry;
sn w0 0 ; if result = 0 then
jl. a2. ; goto extend segment table;
c48: rl w1 0 ; bs file alarm:
al. w0 b6. ; w1 := result; w0 := text address;
dl. w3 f0. ; (w2,w3) := call inf for prog.;
c83: jl. c9. ; goto trap alarm;
b6: <:<10>c.expand<0>:>
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...21...
a2: rl. w1 f36. ; extend segment table:
al w1 x1+2 ; new last := last of segment table + 2;
sl. w1 (f24.) ; if new last >= first of segment
jl. a3. ; then goto rearrange segments;
rs. w1 f36. ; last of segment table := new last;
wa. w1 f3. ; segment table(new last) :=
rs. w1 (f36.) ; new last + 1<23;
rl. w2 f48. ;
al w2 x2+1 ; old size :=
rs. w2 f48. ; old size + 1;
se. w2 (b7.) ; if oldsize <> segments then
jl. a2. ; goto extend segment table;
jl. a0. ; goto reservation ok;
a3: jl. w3 c45. ; rearrange segments:
al w2 x2-2 ; advance first of program (only low end);
sh. w2 (d14.) ; last := first of program - 2; w2 := last;
jl. w3 c27. ; if last <= last of program then
rl. w3 f24. ; release segment;
al w3 x3+512 ; first segment := first :=
rs. w3 f24. ; first segment + 512;
sn w2 x3-2 ; if last = first segment - 2 then
jl. a2. ; goto extend segment table;
sl. w2 (d14.) ; move segment:
rs. w2 d14. ; if last >= last of program
al w2 x2-510 ; then last of program := last;
rs w2 (x3-512) ; last := last - 510;
; segment table(first-512) := last;
a4: dl w1 x3-510 ; move:
ds w1 x2+2 ; segment(last+2) := segment(first-510);
al w2 x2+4 ; last := last + 4;
al w3 x3+4 ; first := first + 4;
se. w2 (d15.) ; if last <> first of program
jl. a4. ; then goto move;
jl. a2. ; goto extend segment table;
i. ; id list
e. ; end reserve bs
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...22...
; in core code proc: init context(l,incarnation,n,mode);
; own long l; address integer incarnation,n,mode;
b. a0,b0 w.;
d61: 0 ; abs address of entry init context
c61: rl. w1 d13. ; entry init context:
rl w3 (x1+3) ; w1 := last used;
ba w3 x1+5 ; call address := segment(call) + rel(call);
rl w2 x1 ; saved w3 := call address;
ds. w3 d30. ;
rx. w2 f39. ; swap(w2,csr);
rs. w2 f41. ; oldcsr := w2;
rl. w2 d13. ; w2 := last used;
rl w3 x2+8 ; address of blocktable :=
rs. w3 f45. ; parameter 1;
rl w3 (x2+20) ; mode :=
rs. w3 f46. ; mode parameter;
ld w1 65 ; (w0,w1) := zero := (0,0);
sz w3 1<3 ; if newblockbit(mode) = 1 then
ds. w1 (f45.) ; blocktable(block) := zero;
rl. w3 f45. ; w3 := blocktable entry address;
rl w0 (x2+16) ; w0 := n;
rl w1 x3 ; w1 := blocktable(inc addr);
sn w1 0 ; if w1 = 0 then
rs w0 x3-2 ; blocktable(inc addr) := n;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...23...
rl w1 (x2+12) ;
sh w1 (x3-2) ; if incarnation > n
sh w1 0 ; or incarnation <= 0
jl. a0. ; then goto alarm;
al w1 x1-1 ; w1 :=
rs. w1 f28. ; (incarnation - 1);
jl. d7. ; goto end uv expression;
a0: dl. w3 d30. ; alarm: (w2,w3) := (saved sref,saved w3);
rl w0 x2-2 ; last used :=
rs. w0 d13. ; block(sref).last used;
al. w0 b0. ; w0 := text address;
jl. d21. ; goto general alarm;
b0: <:<10>c.incarn<0>:>
i. ; id list
e. ; end core code proc init context
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...24...
b. a1, b1 w. ;
d4: ds. w3 f0. ; take expression: save(call addr,stack ref);
jl. w3 c68. ; adjust call address;
sn. w1 (f42.) ; if point <> init zone
se. w2 (f39.) ; or sref <> csr then
jl. c57. ; goto continue expression;
; init context zone: uv1 := zone addr - h5
rl. w1 d12. ; init context zone:
al w1 x1+h5 ; w1 := w3 := zone addr;
al w3 x1 ; oldcza := cza;
rx. w1 f40. ; cza := zone addr;
rl. w0 f41. ; zone.csr := oldcsr;
ds w1 x3+g25 ; zone.cza := oldcza;
rx. w3 d23. ; chain := youngest zone;
rl. w1 f40. ; youngest zone := zone address;
rs. w3 b0. ; saved chain := chain;
al w3 x1+g33 ; zone.first var :=
rs w3 x1+g29 ; addr of first variable;
ws w3 4 ; zone.appetite :=
ws w3 x2-4 ; first var - sref - display length
al w3 x3-2 ; -2;
rs w3 x1+g29-2 ; display contains absolute addresses;
rl. w3 d13. ; zone.last array :=
rs w3 x1+g31 ; last used;
rs w3 x1+g35 ; zone.first array := last used;
rl. w2 f45. ; zone.block := w2 :=
rs w2 x1+g26 ; address of block table entry;
rl. w0 f46. ; zone.mode :=
rs w0 x1+g32 ; value(mode param);
al w0 1 ;
hs. w0 j11. ; save := true;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...25...
ac w0 (x2-2) ; w0 := -no of bytes in inctable;
as w0 1 ;
rl w2 x2 ; w2 := virtual address of inctable;
se w2 0 ; if w2 = 0 then
jl. a1. ; begin <*reserve inctable *>
rl. w3 f37. ; blocktable(block,incbase) := first free bs;
rs w3 (x1+g26) ; store words ; (reservation)
jl. w3 c51. ;
jl. w3 c64. ; check save;
jl. w3 c69. ; save first free;
rl. w1 f40. ; w1 := zone address;
al w0 -4 ; appetite := -4;
rl w1 x1+g26 ; w1 := address
al w1 x1-3 ; of first byte of blocktable entry;
jl. w3 c59. ; store owns;
jl. w3 c64. ; check save;
rl. w1 f40. ; w1 := zone address; w2 := blocktable entry;
rl w2 (x1+g26) ; end;
a1: wa. w2 f28. ; w2 := inctable base + (incarnation-1);
jl. w3 c58. ; w0 := load word(inctable entry);
rl w3 x1+g32 ; w3 := mode bits;
sz w3 1<4 ; if newincbit(modebits) = 1 then
al w0 0 ; w0 := 0;
sn w0 0 ; if w0 = 0 then
ac w0 x2 ; w0 := -addr of inctable(incarnation);
rs w0 x1+g27 ; zone.dest := w0;
ac w3 (x1+g29-2) ; znext :=
as w3 -1 ; zone.dest
wa w3 0 ; - appetite//2;
sh w0 -1 ; if zone.dest < 0
al w3 0 ; then znext := 0;
rs w3 x1+g28 ; zone.next := znext;
rl w3 x1+g32 ; w3 := zone.mode;
so w3 1<0 ; if read bit = 0
al w0 0 ; then w0 := 0;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...26...
rl w2 0 ; w2 := w0; (inctable entry);
sh w2 -1 ; if w2 <= -1 then
al w2 0 ; then w2 := 0;
dl w1 x1+g29 ; (w0,w1) :=zone.(appetite,first var);
jl. w3 c50. ; load words (local variables and dopes);
rl. w1 d12. ; restore(w1);
rl. w2 f0.-2 ; w2 := sref;
am (x2-4) ;
al w3 x2 ; w3 := addr of traplabel;
rl. w0 d97. ; w0 := trapchain;
rs w0 x3-2 ; block(sref).chain := trapchain;
rl w0 x3 ;
se w0 0 ; if block(sref).traplabel <> 0 then
rs. w2 d97. ; trapchain := sref;
rl. w0 b0. ; zone.chain to elder :=
rs w0 x1+h4+4+h5; saved chain;
jl. c53. ; goto program return;
b0: 0 ; saved chain
i. ; id list
e. ; end take expr/init context zone
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...27...
b. a9, b4, w. ;
b2: 0 ; saved w3
c52: rs. w3 b2. ; reserve core: w1 = appetite; w3 = return;
sz w1 1 ; if appetite odd then
al w1 x1-1 ; appetite := appetite -1;
ds. w1 b0. ; save(w0,appetite);
a9: wa. w1 d13. ; new := appetite + last used;
rl. w3 d15. ; w3 := first of program;
sl. w1 (d81.) ; if new < max last used
sh w1 x3+1022 ; or new <= first of program + 1022 then
jl. a8 . ; goto low partition or stack alarm;
sh. w1 (d14.) ; if new <= last of program
jl. w3 c1. ; then program release;
rs. w1 d13. ; last used := new; return;
sh. w1 (d82.) ; if last used <= limit last used then
rs. w1 d82. ; limit last used := last used;
jl. (b2.) ; note: last used may not be changed until
; the reservation is accepted;
a8: rl. w3 d110. ;
sn. w3 d111. ; if current partition index = lower index then
jl. c11. ; goto stack alarm;
rl. w1 b0. ; restore appetite;
jl. w3 d114. ; switch to low partition;
jl. a9. ; goto try again;
\f
; fgs 1988.05.19 algol/fortran runtime system page ...27a...
; program release: w1 = attempted last used; w0,w1,w2 saved;
; w3 = return.
c1: rs. w3 f1. ; program release:
rl. w3 f2. ;
sh w1 x3+510 ; if attempted last used <= last on victim segment and
sl. w3 (d112.+2) ; high.first of segments > victim then
jl. a7. ; begin
rl. w3 d112. ; victim := high.first of program;
a7: rs. w3 f2. ; end;
rx. w2 d14. ; swap(stack ref, last of program);
a1: jl. w3 c27. ; segment release: release segment;
al w2 x2-512 ; last of program := last of program - 512;
sh w1 x2 ; if attempted last used <= last of program
jl. a1. ; then goto segment release;
rx. w2 d14. ; swap(stack ref, last of program);
jl. (f1.) ; return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...28...
a2: rl. w3 (f50.) ; array alarm(context):
se w3 (x3) ; w3 := segment base of call; may load segment;
ba. w3 f51. ; w3 := segment base + call rel;
rl. w2 f0.-2 ; w2 := call sref;
rl w1 x2-2 ; last used :=
rs. w1 d13. ; block.last used;
ac w1 (0) ; w1 := -w0;
al. w0 b4. ; w0 := address of <:c.array:>;
jl. d21. ; goto general alarm;
b4: <:<10>c.array <0>:>
d3: wa. w1 d13. ; reserve:
sl. w1 (d81.) ; last used := last used + appetite;
sh. w1 (d14.) ; if last used < max last used
jl. a5. ; or last used <= last of program
rs. w1 d13. ; then goto check last used;
sh. w1 (d82.) ; if last used <= limit last used then
rs. w1 d82. ; limit last used := last used;
jl x3 ; return;
; check last used:
a5: ws. w1 d13. ; last used := last used - appetite;
jl. a6. ; goto reserve1;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...29...
0 ; b0 - 2 : saved w0
b0: 0 ; : saved appetite
0 ; b0 + 2 : saved load appetite
d28: sl w1 0 ; reserve array: w1 = appetite, w3 = return;
jl. c2. ; if appetite >= 0 then stack alarm;
sn. w2 (f39.) ; if sref = csr then
jl. a0. ; goto context array;
a6: ds. w3 f0. ; reserve1: save(call addr, sref);
jl. w3 c68. ; adjust call address;
jl. w3 c52. ; reserve core(appetite);
jl. c53. ; goto program return;
a0: al w1 x1-4 ; context array:
ds. w3 f0. ; save(call addr,sref);
jl. w3 c68. ; adjust call address;
jl. w3 c52. ; reserve core(appetite);
rl. w2 f40. ; init array:
rl. w0 b0. ; w0 := saved appetite (= array length);
rl w2 x2+g28 ; w2 := zone.next;
sn w2 0 ; if zone.next = 0 then
jl. a3. ; goto load;
jl. w3 c58. ; load word; (w0 := load appetite);
sh. w0 (b0.) ; if loaded appetite <= appetite
jl. a4. ; then goto load1;
jl. a2. ; goto array alarm;
\f
; jz.fgs 1988.04.15 algol/fortran runtime system page ...30...
a4: ac w2 (0) ; load1:
as w2 -1 ; znext := zone.next;
rl. w3 f40. ; zone.next := zone.next +
wa w2 x3+g28 ; (-load appetite//2)
al w2 x2-1 ; - 1;
rx w2 x3+g28 ;
rl w3 x3+g32 ;
so w3 1<0 ; if zone.mode.readbit = 0 then
al w2 -1 ; w2 := znext := 0
al w2 x2+1 ; else w2 := znext := znext + 1;
a3: rs. w0 b0.+2 ; load: save load appetite := w0;
rl. w3 b0. ; w0 :=
al w0 x3+4 ; appetite + 4;
jl. w3 c50. ; load words; (clear or load array)
dl. w0 b0.+2 ; (w3,w0) := (appetite,save load appetite);
ds w0 x1+2 ; array(last-1:last):=(appetite,max appetite);
rl. w0 b0.-2 ; restore(w0);
rl. w1 d13. ; w1 := last used;
am. (f40.) ;
rs w1 g31 ; zone.last array := last used;
jl. c53. ; goto program return;
i. ; id list
e. ; end reserve/reserve array
\f
; jz.fgs 1988.05.20 algol/fortran runtime system page ...31...
; release zones: releases all shares in zones below last used.
; if zone is context zone local variables of block are saved
; at destination. w2 saved. w3 = return.
b. a15,b7 w. ;
b0: 0 ; saved return;
b5: j8 ; segno(call block proc)*2 + 1<22
b6: 1<22 ;
0 ; b7-2: saved w0
b7: 0 ; saved w1
c56: rs. w3 b0. ; release zones: save return;
ds. w1 b7. ; save (w0,w1);
a0: rl. w1 d23. ; next zone: w1 := zone addr := youngest zone;
rl. w2 f0.-2 ; restore(w2);
rl. w3 d13. ; w3 := last used;
se. w3 (f14.) ; if (last used <> stackbottom
sl. w1 (d15.) ; and zoneaddr < first of program)
sl. w1 (d13.) ; or zoneaddr >= last used then
jl. a15. ; goto end release;
a14: sn. w1 (f40.) ; if zone addr = cza then
jl. a5. ; goto context zone;
se. w1 (d87.-2) ; if zone addr = azone then
jl. a13. ; begin
am. (d87.) ;
rl w0 -2 ; temp last used := aref.last used;
rs. w0 d83. ;
al. w0 d83. ; top of program :=
rs. w0 d88. ; addr of temp last used;
rl w1 x1+h4+2 ; w1 := zone.blockproc;
jl. w2 c8. ; goto goto point in w1 (w2=return);
jl. a0. ; goto next zone;
; end;
a13: rl w3 x1+h0+8 ; w3 := zone.last shared +
al w3 x3+h6 ; share descriptor length;
sl. w3 (d112.+12) ; if w3 >= high end partition.last used then
rs. w3 d112.+12 ; high end partition.last used := w3;
rl w3 x1+h2+0 ;
rl w0 x1+h2+6 ;
se w0 4 ; if zone.state = 4 <*after declaration*>
so w3 1<10 ; or zone.give_up_mask shift (-10) extract 1 = 0
jl. a1. ; then goto next share;
rl. w3 g39. ;
ls w3 -14 ;
sz w3 1 ; if -,modebit word 1.zonetest
sn w0 9 ; or zone.state = 9 <*in sort*>
jl. a1. ; then goto next share;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...32...
al w0 x2 ; call block proc:
ds. w1 d30. ; save(sref, zone addr);
rl w0 x2-2 ; oldlastused := lastused;
rx. w0 d13. ; last used := block(sref).last used;
al w2 1<10 ; mask := zone.give_up_mask;
lx w2 x1+h2+0 ; zone.give_up_mask := mask exor (1 shift 10);
rx w2 x1+h2+0 ;
al w1 -16 ;
jl. w3 c52. ; reserve core(-16);
rs w0 x1+14 ;
dl. w0 f0. ;
rs w3 x1 ; save(
rs w0 x1+6 ; oldlastused,
rl. w3 f50. ; sref,
al w0 16 ; call w3,
ls w0 12 ; appetite <* = 16 *>,
ba. w0 f51. ; return rel,
ds w0 x1+4 ; return rel addr,
dl. w0 b7. ; saved w0,
ds w0 x1+12 ; saved w1,
rl. w0 b0. ; local return
rs w0 x1+8 ; );
rl. w3 d16. ;
wa. w3 b5. ; w3 := (2*segno(call block proc segment) + 1<22
lx. w3 b6. ; + segtable base) exor (1<22);
al w0 x2 ; w0 := mask;
jl w2 x3+c15 ; call block proc; <* w2=lastused on exit *>
rl w3 x2 ; restore(
rl w0 x2+6 ; sref,
ds. w0 f0. ; vall w3,
dl w0 x2+4 ; return segtable addr,
hs. w0 f51. ; return rel addr,
rs. w3 f50. ; local return,
dl w0 x2+12 ; saved w0,
ds. w0 b7. ; saved w1,
rl w0 x2+14 ; oldlastused,
rs. w0 d13. ;
rl w0 x2+8 ; );
rs. w0 b0. ; last used := sref;
jl. a0. ; goto next zone;
\f
; jz.fgs 1985.09.13 algol/fortran runtime system page ...33...
a1: rl w3 x1+h0+6 ; next share:
a2: am (x1+h0+8) ; w3 := first share;
sl w3 1 ; if first share > last share then
jl. a9. ; goto chain to next;
rl w2 x3 ; w2 := share state (share);
al w3 x3+h6 ; share := first share + share descr length;
sz w2 -2 ; if share state = free or ready
jl. a3. ; then goto next share
jl. a2. ; else goto stop or wait;
a15: dl. w1 b7. ; end release:
jl. (b0.) ; restore(w0,w1); return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...34...
a3: rs. w3 f22. ; stop or wait: save share;
sl w2 0 ; if share = process running then
jl. a4. ; begin
ac w2 x2 ; w2 := process descr address;
dl w0 x2+4 ;
ds. w0 f7.+2 ; move process name to work
dl w0 x2+8 ; for answer;
ds. w0 f7.+6 ;
al. w3 f7. ; w3 := name addr;
jd 1<11 + 60 ; stop process;
; w0 = result, w2 = buffer addr;
; end;
a4: al. w1 f7. ; message address := work for answer;
jd 1<11 + 18 ; wait answer;
rl. w1 d23. ; restore zone address;
rl. w3 f22. ; w3 := saved share;
al w0 0 ; share state (share) :=
rs w0 x3 ; free;
jl. a2. ; goto next share;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...35...
b1: 0 ; save last used
0 ; b2-2: saved w1
b2: 0 ; saved w2
b3: 4 ; mask for isolating save bit
b4: 0 ; first reserved
a5: rl w0 x1+g32 ; context zone:
so w0 1<1 ; if writebit = 0 then
jl. a8. ; goto unstack;
la. w0 b3. ; save :=
hs. w0 j11. ; bit(1<2,mode param);
rl. w0 f37. ; load inctable entry:
rs. w0 b4. ; first reserved := first free;
rl w2 x1+g27 ; w2 := zone.dest;
; store context values:
a6: rl. w3 f40. ; w3 := zone address;
rl w0 x3+g31 ; save last used :=
rx. w0 d13. ; last used;
rs. w0 b1. ; last used := last array;
dl w1 x3+g29 ; (w0,w1) := (appetite,first addr) of fixed part;
jl. w3 c51. ; store words; (move fixed pasrt of block)
am. (f40.) ; w1 :=
rl w1 g35 ; zone.first array;
; next array:
a7: sh. w1 (d13.) ; if w1 <= last used then
jl. a10. ; goto update inctable entry;
sl w2 1 ; if w2 > 0 then
jl. a12. ; goto move;
al w1 x1-2 ; w1 := address of length;
al w0 -2 ; appetite := -2;
jl. w3 c51. ; store words;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...36...
a12: rl w3 x1-4 ; move:
wa w1 x1-4 ; w1 := start of array;
ds. w2 b2. ; save(w2,w1);
al w0 x3+4 ; w0 := appetite + 4;
sl w2 1 ; if w2 > 0 then
al w2 x2+1 ; w2 := w2 + 1;
jl. w3 c51. ; store words;
ac w0 (x1+2) ; w0 := max appetite;
dl. w2 b2. ; restore(w1,w2);
as w0 -1 ;
bs. w0 1 ;
sl w2 1 ; if w2 > 0 then
wa w2 0 ; w2 := w2 - max appetite//2 - 1;
jl. a7. ; goto next array;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...37...
a10: jl. w3 c64. ; update inctable entry:
sl w2 0 ; check save(last segment);
jl. a11. ; if w2 < 0 then
jl. w3 c69. ; begin
rl. w0 b4. ; save first free;
rl. w1 f40. ; w0 := first reserved;
ac w2 (x1+g27) ; w2 := -zone.dest;
jl. w3 c54. ; store word; save segment;
jl. w3 c66. ; end;
a11: rl. w0 b1. ; last used :=
rs. w0 d13. ; save last used;
a8: rl. w1 f40. ; unstack: w1 := zone address;
dl w0 x1+g25 ; (csr,cza) :=
ds. w0 f40. ; zone.(csr,cza);
a9: rl w3 x1+h4+4 ; chain to next:
rs. w3 d23. ; youngest zone := zone.chain to elder;
jl. a0. ; goto next zone;
i. ; id list
e. ; end release zones
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...38...
; release zones, goto computed, stop ftn; called from program
d10: rl. w1 d23. ; release zones from program:
sl. w1 (d13.) ; if youngest zone >= last used then
jl x3 ; return;
ds. w3 f0. ;
jl. w3 c68. ; adjust call address;
jl. w3 c56. ; release zones;
jl. c53. ; goto program return;
d11: am. (d93.) ; goto computed:
sl w0 2 ; if sref > current stack bottom then
jl. c72. ; goto goto alarm;
ds. w3 f0. ; save(sref,call addr);
rl w3 0 ; w3 := newsref;
rl w3 x3-2 ; last used :=
rs. w3 d13. ; block(newsref).last used;
jl. w3 c68. ; adjust call address;
jl. w3 c56. ; release zones;
rl w2 0 ; w2 := newsref;
rs. w2 d97. ; trapchain := newsref;
am (x2-4) ;
dl w0 x2 ; if block(newsref).traplabel = 0
sn w0 0 ; then
rs. w3 d97. ; trapchain := block(newsref).trapchain;
jl. c8. ; goto point in w1;
d45: rl. w0 d93. ; stop ftn: (entry 45)
rs. w0 d13. ; last used := current stack bottom;
ds. w3 f0. ; save sref, call address;
jl. w3 c56. ; release zones;
dl. w3 f0. ; restore sref, call address;
al w0 -10 ;
jl. d21. ; goto alarm(end);
\f
; jz.fgs 1988.05.18 algol/fortran runtime system page ...39...
b. b4 w. ;
f50: 0 ; segmentable address for call address
0 ; c68-2 ; saved return;
c68: rs. w3 c68.-2 ; adjust call address: save return;
rl. w3 f0. ; w3 := saved return from call;
ws. w3 f24. ; w3 := rel part of call :=
la. w3 b4. ; (call addr - first of program)
hs. w3 b1. ; extract 9;
ac w3 x3 ; w3 := segment base of continue :=
wa. w3 f0. ; call address - rel part of call;
rl w3 x3 ;
rs. w3 f50. ; save segment base of call;
jl. (c68.-2) ; return;
c53: rl. w3 (f50.) ; program return: w3 := segment base of call;
se w3 (x3) ; segment reference, may provoke seg transfers;
b1 = k + 1; rel part of call
f51 = b1 ;
al w3 x3+0 ; w3 := segment base + rel part of call;
rl. w2 f0.-2 ; restore callw2;
jl x3 ; return to program(call address);
b4: 511 ; mask for extract 9
i. ; id list
e. ; end program return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...40...
; in core code proc: exit(label expr);
; in core code proc: continue;
b. a1,b2 w.;
d62: 0 ; abs address of entry exit
c62: rl. w2 d13. ; entry exit: w2 := last used;
rl w1 x2+2 ; w1 := segm table addr of call;
ws. w1 d16. ; context label(cza) :=
ls w1 11 ;
ba w1 x2+5 ; (segm table addr of return
am. (f40.) ; - base of segm table ) shift 11
rs w1 g33 ; + relative of return;
dl w1 x2+8 ; (w0,w1) := label expr;
sz w0 16 ; if -,expression then
jl. a1. ; then goto take label value;
al w1 -6 ; take label expression:
jl. w3 c52. ; reserve core(3 words);
rs w2 x1 ; stack(last used) := stack ref);
al. w2 b1. ; stack(last used+2) := addr of return;
al w3 0 ; stack(last used +4) := relative := 0;
ds w3 x1+4 ;
dl w1 x1+14 ; (w0,w1) := label expression;
al. w2 a1. ; return :=
rs. w2 b1. ; addr of <take label value>;
jl. d5. ; goto gotopoint;
a1: dl w1 x1 ; take label value: (w0,w1) := point(label expr);
jl. d11. ; goto gotocomputed;
b1: 0 ; return
\f
; jz.fgs 1988.05.16 algol/fortran runtime system page ...41...
d63: 0 ; abs address of entry continue
c63: rl. w2 f40. ; entry continue:
sl. w2 (b0.) ; if cza >= init youngest zone
jl. d7. ; then goto end uv expression;
rl w1 x2+g33 ; w1 :=context label(cza);
sn w1 0 ; if label = 0 then
jl. d7. ; goto end uv expression;
rl. w0 f39. ; w0 := csr;
jl. d11. ; goto gotocomputed;
b0: 1<22 ; init youngest zone
i. ; id list
e. ; end continue/exit
\f
; fgs 1988.05.18 algol/fortran runtime system page ...41a...
; release program segments in both storage partitions
;
; call : jl. w3 c81.
;
; call return
;
; w0 : - unchanged
; w1 : - first of program segments in low end partition
; w2 : sref unchanged
; w3 : link undefined
b. a0, b3 ;
w. ;
b0: 0 ; saved return
c81: rs. w3 b0. ; release partitions:
a0: jl. w3 c79. ; switch to other partition;
al. w3 c0. ;
rl w1 x3+f24-c0 ; first of program :=
rs w1 x3+d15-c0 ; first of segments;
sh w1 (x3+d14-c0); if first of program <= last of program then
jl. w3 c1. ; goto program release;
rl. w3 d110. ;
se. w3 d111. ; if current index <> lower partition index then
jl. a0. ; goto next partition;
jl. (b0.) ; return;
i. ; id list
e. ; end release both partitions
\f
; fgs 1987.02.05 algol/fortran runtime system page ...41b...
c82: ds. w3 f0. ; prog entry: release both storage partitions:
jl. w3 c68. ; adjust call address;
jl. w3 c81. ; release partitions;
jl. c53. ; goto program return;
d73: ds. w3 f0. ; prog entry: load words:
jl. w3 c68. ; adjust call address;
jl. w3 c50. ; load words;
jl. c53. ; goto program return;
d74: ds. w3 f0. ; prog entry: store words:
jl. w3 c68. ; adjust call address;
jl. w3 c51. ; store words;
al w1 x3 ; w1 := virt address of reserved area,
; if w1 <= 0 at call;
jl. c53. ; goto program return;
\f
; jz.fgs 1987.06.11 algol/fortran runtime system page ...42...
d48: al w3 x3+1 ; take expr ftn:
ds. w3 f0. ; set return uneven;
jl. w3 c68. ; adjust call address;
am -2000 ;
rs. w1 f5. +2000 ; save point;
am -2000 ;
rl. w1 d13.+2000 ;
jl. a32. ; goto form return point;
c57: am -2000 ; continue expression:
rs. w1 f5.+2000 ;
al w1 -6 ; save point := w1; (point)
jl. w3 c52. ; reserve core(3 words);
a32: rl. w2 f0.-2 ; form return point:
rl. w3 f50. ; stack(top) := sref;
ds w3 x1+2 ; stack(top+2) := segtable address of return;
bz. w3 f51. ; stack(top+3) := 0; (appetite);
rs w3 x1+4 ; stack(top+4) := relative of return;
am -2047 ;
rl. w1 f5.+2047 ; w1 := saved point;
d5: ls w0 -4 ; goto point: w0 - 1 = formal cells;
rl w2 0 ; w2 := stackref of point;
d53 = k ; goto point in fortran:
c8: hs. w1 b2. ; goto point in w1: save relative of point;
bz w3 2 ; w3 := segment number * 2
ls w3 1 ;
am -2047 ;
wa. w3 d16.+2047 ; + segment table base;
rl w3 x3 ; w3 := segment table(point segment);
b2 = k + 1; relative of point
jl x3+0 ; segment jump to point
\f
; jz.fgs 1987.06.02 algol/fortran runtime system page ...43...
d6: am -2047 ; end register expression:
ds. w1 d12.+2047 ; uv := value;
d7: am -2047 ; end uv expression:
al. w1 d12.+2047 ; w1 := address uv;
d8: am -2047 ; end address expression:
rl. w2 d13.+2047 ; w2 := old last used;
rl w0 x2+4 ; if not ftn-call then
sz w0 1 ; begin comment see d48, take expr ftn;
jl. a33. ;
al w0 x2+6 ; w2 := old last used;
ba w0 x2+4 ; last used := last used + 6 + appetite;
am -2047 ;
rs. w0 d13.+2047 ; end;
a33: dl w0 x2+4 ; w3 := segment table address := old top 2;
hs. w0 b3. ; relative of return := old top 4;
rl w2 x2 ; stack reference := old top;
rl w3 x3 ; w3 := segment table(return segment);
b3 = k + 1; relative of return
jl x3+0 ; segment jump to return;
; d9: init zones, see rs segments
\f
; fgs 1988.05.18 algol/fortran runtime system page ...43a...
b. a10, b5 ; begin block emulate ix instruction
w.
c80: al. w3 c83. ; ix emulation: w3 := interrupt address;
al w3 x3+c0-c83;
rs. w3 b4. ; save interrupt address;
rl w2 x3+10 ; ix emulation:
al w2 x2+2 ; continue address :=
rs w2 x3+10 ; continue address + 2;
el w1 x2-4 ; w1 := ix instr.w-field *
la. w1 b0. ; 2;
ls w1 -3 ; w-register addr :=
wa w1 6 ; dump area.w1;
rs. w1 b2. ;
rl w3 x3+14 ; dope addr :=
ea w3 x2-2 ; dump area.sb + doperel;
rl w0 x1 ; ix field := word (w register addr);
el w1 x2-1 ; type := hwd (type);
sh w1 -1 ; if type >= 0 then
jl. a1. ; begin <*index*>
ls w0 x1 ; index value := index shift type;
sh w0 (x3-2) ; if index value > upper index value
sh w0 (x3 ) ; or index value <= lower index value - k then
jl. a8. ; goto index alarm;
jl. a2. ; end else
a1: ac w1 x1 ; begin <*field*>
al w2 1 ; lower field value :=
ls w2 x1 ; lower field value +
wa w2 x3 ; 1 shift (-type) - <*typelength*>
al w1 x2-1 ; 1;
sh w0 (x3-2) ; if field value > upper field value
sh w0 x1 ; field value <= lower field value then
jl. a8. ; goto field alarm;
a2: ; end <*field*>;
rl. w3 b4. ; w3 := interrupt address;
wa w0 (x3+14) ; field address := w-register :=
rs. w0 (b2.) ; field value + dump area.base word;
rl w1 x3+10 ; return :=
rs. w1 b4. ; dump area.ic;
dl w1 x3+2 ; restore registers;
dl w3 x3+6 ;
jl. (b4.) ; goto (return);
\f
; fgs 1988.05.18 algol/fortran runtime system page ...43b...
a8: rl. w1 b4. ; w1 := interrupt address;
rl w0 x1+8 ; index alarm: field alarm:
lo. w0 b3. ; dump area.exception reg :=
rs w0 x1+8 ; dump area.exception reg or (under- and overflow);
sz. w0 (b1.) ; if dump area.exception reg.floating excpt = active then
jl x1+c5-c0 ; goto floating exception;
rl w0 x3-2 ; field value := upper index;
jl. a2. ; goto exit;
b0: 3<4 ; w-register mask
b1: 1<18 ; floating point exception active bit
b2: 0 ; w-register address, w-register value
b3: 3 ; underflow, overflow mask
b4: 0 ; saved interrupt address, saved return
i. ; id list
e. ; end block emulate ix instruction
\f
; jz.fgs 1988.05.18 algol/fortran runtime system page ...44...
c39: al. w0 b4. ; program offset alarm:
jl. w3 d21. ; goto general alarm;
; current partition index is supposed to be low index
c11: am -2047 ; stack alarm: called from advance first of prog/reserve core:
rl. w3 f0. +2047 ;
am -2047 ;
ws. w1 d13.+2047 ; w3 := call address;
c2: al w0 1 ; w1 := appetite;
am -2047 ;
rs. w0 f25.+2047 ; stack alarm: called from reserve array;
am 1 ; pagestate := passive; cause := -1;
d17: am 1 ; index alarm: cause := -2;
d18: am 1 ; zone alarm: cause := -3;
d19: am 1 ; case alarm: cause := -4;
d20: am 1 ; syntax alarm:cause := -5;
d25: am 2 ; mult alarm: cause := -6;
d29: am 4 ; param alarm: cause := -8;
d54: am 2 ; field alarm: cause := -12;
c72: am 2 ; goto alarm: cause := -14;
d51: al w0 -16 ; ix alarm: cause := -16;
d21: am -2047 ; alarm : call addr := w3; call sref := w2;
ds. w3 f0. +2047 ;
\f
; jz.fgs 1987.06.03 algol/fortran runtime system page ...45...
c9: jl. w3 c79. ; trap alarm: at first entry try high end;
am -2047 ; switch to other end;
al. w3 c0. +2047 ; w3 := interrupt addr;
ds w1 x3+2 ; w0w1dump := w0w1;
; w2 is dumped on alarm segment 0;
rl w1 x3+f0 -c0 ; w1 := call addr;
al w0 x1-2 ; w0 := call addr - 2;
sl w0 (x3+f24-c0); if call addr >= rts.first of segm
sl w0 (x3+d14-c0); or call addr < rts.last of segm then
jl. a27. ; begin <*call addr inside partition => prog segment*>
ws w1 x3+f24-c0 ; w1 := (call addr - first of segments)
lo w1 x3+f4 -c0 ; or 9 last bits
wa w1 x3+f24-c0 ; + first of segments;
rl w1 x1 ; w1 := last word on segment;
so w1 3 ; if segment type <> 3 then
jl. a21. ; goto code or algol segment
jl. a23. ; else
; goto not code or algol segment;
; end else
a27: rl. w1 d110. ; if current index = upper index then
se. w1 d112. ; begin <*try next partition*>
jl. a23. ; restore w0, w1;
dl w1 x3+2 ; goto trap alarm;
jl. c9. ; end;
a23: dl w1 x3+d30-c0 ; not code or algol segment: (rs or code in stack)
ds w1 x3+f0 -c0 ; call sref := saved sref; call addr := saved w3;
a21: jl. w3 c78. ; code or algol segment:
am -2047 ; switch to low end;
al. w3 c0.+2047 ; restore w3;
dl w1 x3+2 ;
rl w3 x3+f12-c0 ; w0w1 := w0w1dump; dumped at page fault;
rl w3 x3+j12 ; w3 := segtable addr (0) +2*segm no alarm segm 0;
jl x3+c6 ; jump to alarm segm 0;
\f
; jz.fgs 1988.06.15 algol/fortran runtime system page ...46...
a40: am -2047 ; return:
jl. (f0.+2047) ; (stepping stone);
0 ; d89-2: sref of call: activate or init_activity
d89: 0 ; : segtable address of return - - - - - - -
d90: 0 ; : relative address of return - - - - - - -
0 ; d91-2: entry point (passivate2)
d91: am -2047 ; check passivate:
rs. w3 f0.+2047 ;
rs w1 x2+h0+4 ; used share := w1;
rl. w1 d104. ; w1 := saved parity counter;
am -2047 ; save return;
ds. w1 d12.+2047 ; uv := (w0,w1);
rl w1 x2+h0+4 ; w1 := used share(zone);
dl w0 x1+4 ;
al w3 x3-1 ; record base := first shared - 1;
ba. w0 1 ; last byte := last shared + 1;
ds w0 x2+h3+2 ;
ws w0 6 ; record lengrh :=
rs w0 x2+h3+4 ; last byte - record base;
rl w3 x1 ;
sh w3 1 ; if share state was <= 1
jl. a38. ; then goto return;
jl. a39. ; goto prepare wait;
d94=k+1 ; ****** just to avoid the rts address 4096 (pass9) ***
am -2047 ; call passivate2:
rs. w3 f0. +2047 ;
am -2047 ; save return;
ds. w1 d12.+2047 ; uv := (w0,w1);
a39: rl w0 x2+h2+0 ; prepare wait:
am -2047 ;
rl. w1 d92.+2047 ; if not activity mode
sl w1 1 ; or
so w0 1<9 ; zone is not activity zone
jl. a40. ; then goto return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...47...
jl. w3 c68. ; prepare call of passivate2:
al w1 -10 ; adjust call address;
jl. w3 c52. ; reserve core(5 words);
rl. w3 f50. ; save return information:
ds w3 x1+2 ; save sref (=zone address),
al w0 4 ; segtable address,
bz. w3 f51. ; appetite (=4),
hs w0 6 ; relative of return
rs w3 x1+4 ; in stacktop(0:5);
am -2047 ;
dl. w0 d12.+2047 ; save (w0,w1)
ds w0 x1+8 ; in stacktop(6:8);
rl. w1 d91.-2 ; w1 := entry point of passivate2;
jl. c8. ; goto gotopoint in w1;
a38: al w0 0 ; return:
sn w3 1 ; if share state = 1 then
rs w0 x1 ; share state := 0; (free)
am -2047 ;
rl. w3 f0.+2047 ; restore return;
jl x3+c71 ; goto exit(check segment);
\f
; jz.fgs 1988.05.18 algol/fortran runtime system page ...48...
b4: <:non zero offset in virtual program file<0>:>
d98: 0, r.11 ; alarm record(1:11):
; alarm record(1 ): alarm param
; alarm cause (2 ): cause (-15:-1, or >0)
; alarm record(3:6 ): alarm text
; alarm record(7 ): zone.status word (stderror)
; alarm record(8:11): zone.documentname (stderror)
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...49...
b. a6, b9, j0, g8 w. ;
0 ; b0-2
b0: 1<10 ;
f. ;
b7: 0.5 ;
w. ;
b8: 48<12;
a0: fa. w1 b7. ; real to long:
hs. w1 b1. ;
ad w1 -12 ; value := value + 0.5;
b1=k+1; ;
am 0 ; value := long (value);
ad w1 -35 ;
jl x3 ; return;
a1: nd. w1 b2. ; long to real:
ad w1 -1 ;
aa. w1 b0. ;
nd. w1 b9. ; normalize and round;
hl. w1 b8. ;
b2=k+1; ;
am 0 ; set exponent;
b9=k+1; ;
al w1 x1+0 ;
jl x3 ; return;
a2: ci w1 0 ; integer to real:
jl x3 ; return;
a3: cf w1 0 ; real to integer:
jl x3 ; return;
a4: bl w0 2 ; integer to long:
bl w0 0 ;
jl x3 ; return;
a5: ad w1 24 ; long to integer:
rl w1 0 ;
a6: jl x3 ; dummy: return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...50...
; take value real, integer or long:
; call: w0 = type of value to be converted:
; 0: long, 2: integer, 3: real
; w1 = address of value to be converted
; w2 = sref
; w3 = return
; return: (w0,w1) = converted value
; (w2,w3) unchanged
h.; long boolean integer real
b3: g6 , g7 , g4 , g0 ; long
b4: g1 , g8 , g2 , g6 ; real
b5: g5 , 0 , g6 , g3 ; integer
w.
g7 = b4 - b3, g8 = b5 - b3 ;
d100: am b3-b4 ; take value real:
d99: ba. w0 b4.+1 ; take value integer:
d101: am (0) ; take value long:
bl. w0 b3. ;
hs. w0 b6. ; calculate switch index;
dl w1 x1 ; (w0,w1) := value;
am -2047 ;
ds. w3 f0.+2047; save(w2,w3), to ensure correct alarm address
b6=k+1 ;
j0: jl. 0 ; switch to conversion action:
; (a0,a1,a2,a3,a4,a5,a6);
g0=a0-j0, g1=a1-j0, g2=a2-j0, g3=a3-j0, g4=a4-j0
g5=a5-j0, g6=a6-j0
e. ; end take value
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...51...
b. a26,b6 w. ;
b5: 0 ; saved w2
0 ; a20-2: saved return
a20: rs. w3 a20.-2 ; init move:
al w3 x1-2 ; save return;
ws w3 0 ; last core :=
rs. w3 b1. ; first core - appetite - 2;
ac w3 (0) ; w3 := -appetite;
as w3 -1 ; words := w3//2;
wa w3 4 ; new virt := virtual address + words;
sh w2 0 ; if w2 <= 0 then
al w3 x2 ; new virt := w2;
rs. w3 b5. ; save w2 := new virt;
jl. (a20.-2) ; return;
a23: sh. w2 (b2.) ; return from store words:
jl. a19. ; if w2 > last of segment then
jl. w3 c64. ; check save;
a19: rl. w2 b5. ; return:
sn. w1 (b1.) ; if core address = last core then
al w1 x1+2 ; core address := core address + 2;
jl. (b0.) ; w2 := save w2; return;
0 ; c64 - 2: saved return
c64: j11 = k + 1 ; check save:
d75 = c64
sn w3 x3 ; if -,save then
jl x3 ; return;
c66: rx. w2 b2. ; save segment:
rs. w3 c64.-2 ; swap(last of segment,w2); save return;
am -2047 ;
jl. w3 c65.+2047 ; output segment;
rx. w2 b2. ; swap(last of segment,w2);
jl. (c64.-2) ; return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...52...
0 ; c69-4 : saved w2
0 ; c69-2 : saved return
c69: ds. w3 c69.-2 ; save first free:
al w2 1 ; w2 := virt addr of first free;
rl. w0 f37. ; w0 := first free;
jl. w3 c54. ; store word;
jl. w3 c66. ; save segment;
dl. w3 c69.-2 ; restore(w2,w3);
jl x3 ; return;
b6: 0 ; saved return;
a24: rs. w3 b6. ; prepare block io:
rl w3 0 ; save return;
al w3 x3+510 ; size :=
ls w3 -9 ; (appetite+510)//512
ls w3 9 ; * 512;
ws w0 6 ; extra := appetite - size;
wa w1 0 ; first core :=
am -2047 ;
rs. w1 f9.+2+2047; first core + extra;
wa w1 6 ; last core := first core + size - 2;
al w1 x1-2 ;
am -2047 ;
rs. w1 f9.+4+2047;
al w2 x2-1 ; compute segment no:
ld w3 -24 ;
wd. w3 b4. ; segment no :=
ld w3 1 ; (virtual address - 1)//254 * 2
am -2047 ;
wa. w3 f23.+2047 ;
am -2047 ;
rs. w3 f9.+6+2047;
jl. (b6.) ; return;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...53...
b0: 0 ; saved return (c58,c54,c59,c50 and c51)
b1: 0 ; last core
b2: 0 ; last of segment
c50: rs. w3 b0. ; load words: save return;
sh w0 0 ; if appetite > 0 then
jl. a25. ; begin
jl. w3 a24. ; prepare block io;
am -2047 ;
jl. w3 c75.+2047 ; read block;
jl. (b0.) ; return;
a25: ; end;
jl. w3 a20. ; init move;
sl w2 1 ; if virtual address > 0 then
jl. a2. ; goto load;
ld w0 65 ; clear core: zero := long(0);
a0: sl. w1 (b1.) ; rep clear core:
jl. a1. ; if core address >= last core then
ds w0 x1+2 ; goto end core;
al w1 x1+4 ; core(core address + 2) := zero;
jl. a0. ; core address := core address + 4;
a1: sn. w1 (b1.) ; goto rep clear core;
rs w0 x1 ; end core: if core address = last core
jl. a19. ; then core(core address) := w0; return;
a2: jl. w3 c60. ; load: load virtual address input;
a3: sl. w1 (b1.) ; rep load: return from a18 if w2=lastsegm:
jl. a4. ; if core address >= last core then
sl. w2 (b2.) ; goto end load;
jl. w3 a18. ; if virt addr >= last of segment then insegment;
dl w0 x2+2 ; return if w2>lastseg:
ds w0 x1+2 ; core(core address):=segment(virtual address);
al w1 x1+4 ; core address := core address + 4;
al w2 x2+4 ; virtual address := virtual address + 4;
jl. a3. ; goto rep load;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...54...
a4: se. w1 (b1.) ; end load: return if w2=lastseg:
jl. a19. ; if core address <> last core then return;
sl. w2 (b2.) ; if virtual address >= last of segment
jl. w3 a18. ; then insegment;
rl w0 x2 ; return if w2>lastseg:
rs w0 x1 ; core(core address):=segment(virtual address);
jl. a19. ; return;
0 ; c58-4: saved w2
0 ; c58-2: saved return
c58: ds. w3 c58.-2 ; load word:
jl. w3 c60. ; save(w2,return); load virtual address input;
rl w0 x2 ; w0 := segment(virtual address);
dl. w3 c58.-2 ; restore(w2,return);
jl x3 ; return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...55...
c59: ac. w2 f49. ; store owns:
wa w2 2 ; virt address :=
ls w2 -1 ; (own address - rs own 1 address + 2)//2;
c51: sh w1 0 ; store words:
jl. c44. ; if w1 <= 0 then goto reserve bs;
rs. w3 b0. ; save return;
sh w0 0 ; if appetite > 0 then
jl. a26. ; begin
jl. w3 a24. ; prepare block io;
am -2047 ;
jl. w3 c74.+2047 ; write block;
jl. (b0.) ; return;
a26: ; end;
jl. w3 a20. ; init move;
sl w2 1 ; if virtual address > 0 then
jl. a9. ; goto store;
jl. w3 c44. ; reserve: w3 := reserve bs;
se w2 0 ; if virtual address(call)<>0
jl. a8. ; then goto store1;
al w2 x3 ; clear virtual:
jl. w3 c67. ; virtual address := first of reserved;
; load virtual address output;
al w0 0 ; w0 := 0;
a6: sl. w1 (b1.) ; rep clear virtual: return from a14 if w2=lastsegm:
jl. a7. ; if core address >= last core then
sl. w2 (b2.) ; goto end clear virt;
jl. w3 a14. ; if virt. addr. >= last segm. then outsegment1;
ld w0 65 ; return if w2>lastsegm:
ds w0 x2+2 ; segment(virtual address) := long(0);
al w1 x1+4 ; core address := core address + 4;
al w2 x2+4 ; virtual address := virtual address + 4;
jl. a6. ; goto rep clear virt;
a7: al w0 0 ; end clear virt:
jl. a12. ; w0 := 0; goto end store;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...56...
a8: al w2 x3 ; store1: virtual address := w3;
a9: jl. w3 c67. ; store: load virtual address output;
a10: sl. w1 (b1.) ; rep store: return from a13 if w2=lastsegm:
jl. a11. ; if core address >= last core then
sl. w2 (b2.) ; goto end store1;
jl. w3 a13. ; if virt. addr. >= last of seg. then outsegment;
dl w0 x1+2 ; return if w2>lastsegm:
ds w0 x2+2 ; segment(virtual address) := core(core address);
al w1 x1+4 ; core address := core address + 4;
al w2 x2+4 ; virtual address := virtual address + 4;
jl. a10. ; goto rep store;
a11: rl w0 x1 ; end store1: w0 := core(core address);
a12: se. w1 (b1.) ; end store: return if w2=lastseg:
jl. a23. ; if core address <> last core then return;
sl. w2 (b2.) ; if virtual address >= last of segment
jl. w3 a14. ; then outsegment1;
rs w0 x2 ; return if w2>lastseg:
jl. a23. ; segment(virt. adddr.):=w0; return;
0 ; c54-4: saved w2
0 ; c54-2: saved return
c54: ds. w3 c54.-2 ; store word: save(w2,return);
jl. w3 c67. ; load virtual address output;
rs w0 x2 ; segment(virtual address) := w0;
dl. w3 c54.-2 ; restore(w2,return);
jl x3 ; return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...57...
0 ; b3-2: saved return
b3: 0 ; saved w0
b4: 254 ; no of words on a segment
a13: rl w0 x1 ; outsegment: w0 := core(core address);
a14: ds. w0 b3. ; outsegment1: save(return,w0);
se. w2 (b2.) ; if virtual address <> last of segment
jl. a15. ; then goto check segment;
rs w0 x2 ; segment(virtual address) := w0;
al w1 x1+2 ; core address := core address + 2;
al w2 x2+2 ; virtual address := virtual address + 2;
jl. w3 c64. ; check save;
a21: dl. w0 b3. ; return8: restore w0;
al w3 x3-8 ; return := return - 8;
jl x3 ; return;
a15: jl. w3 c64. ; check segment: check save;
am 1 ; output := true else
a16: al w0 0 ; next segment: output := false;
rl w3 x2-512 ; w3 := segtable :=
rl w3 x3+2 ; current segment table address + 2;
al w2 0 ; first of segment := core(segtable); rel := 0;
a17: se w3 (x3) ; load segment: segment reference, may transfer;
wa w2 6 ; last of segment := w3 :=
al w3 x3+510 ; first of segment + 510;
rs. w3 b2. ; virtual address :=
al w2 x2+4 ; first of segment + rel + 4;
se w0 0 ; if output then
rs w0 x3-508 ; segment(2) := 1;
dl. w0 b3. ; restore(w0);
jl x3 ; return;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...58...
a18: ds. w0 b3. ; insegment: save(return,w0);
se. w2 (b2.) ; if virtual address <> last of segment
jl. a16. ; then goto next segment;
rl w0 x2 ; core(core address) :=
rs w0 x1 ; segment(virtual address);
al w1 x1+2 ; core address := core address + 2;
al w2 x2+2 ; virtual address := virtual address + 2;
jl. a21. ; goto return8;
c67: ds. w0 b3. ; load virtual address output:
al w0 1 ; save(w0,w3);
jl. a22. ; output := true else
c60: ds. w0 b3. ; load virtual address input:
al w0 0 ; save(w0,w3); output := false;
a22: al w2 x2-1 ; virt. addr. := w2-1;
ld w3 -24 ; save return;
wd. w3 b4. ; segment := w3 := (virt. addr.//254)*2;
ld w3 1 ; relative := w2 := (virt. addr. mod 254)*2;
am -2047 ;
wa. w3 f23.+2047 ; virtual address :=
rl w3 x3 ; segment table(segment+top program table);
jl. a17. ; goto load segment;
i. ; id list
e. ; end load/store virtual
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...59...
; fp absent:
; call: w3 = return
; return: w0 = 1 if fp absent, 0 if fp present
; w1, w2, w3 unchanged
d102:
c73 = k + 1 ; set true by rs init;
al w0 0 ; fp absent := false;
jl x3 ;
; save parity count, zone address, and latest answer
; used by block segment (check), and error segment (check spec)
d104: 0 ; saved parity count
d105: 0 ; saved zone address ***must stay together***
d106: 0, r.11 ; latest answer
; no of rs resident segments and rs segments
g46 ; no of resident rs segments (defined on page 40)
d107: c18 ; no of rs segments (defined on page 76)
; errorbits, moved from d31 (end program conditions) - 2
d109: 0 ; errorbits
\f
; jz.fgs 1986.05.20 algol/fortran runtime system page ...60...
g47 = (:k-c20:) a. 511 ;
c. g47 + 28 - 510 , ; ensure that program descriptor is indivisible:
jl-1,r.(:512-g47:)>1;
z. ;
j13 = (:k - c20:) > 9; segm no entry 0
j14 = (:k - c20:) a. 511; rel addr entry 0
p4 = k - c20 ; program descriptor - used for communication of
; values between pass 9 and the runtime system:
g39: 0 ; 0 modebit word 1
q7: 0 ; 2 modebit word 2
d108: 0 ; 4 compiler version
0 ; 6 compiler release < 12 + compiler subrelease
d103: 0 ; 8 compiler release year < 12 + compiler release date
e103 ; 10 rts version
e104 ; 12 rts release < 12 + rts subrelease
e105 ; 14 rts release year < 12 + rts release date
q1: 0 ; 16 interrupt mask
q0: 0 ; 18 entry point to main program
q2: 0 ; 20 length of own area
q4: 0 ; 22 length of data table (fortran)
q5: 0 ; 24 length of zone common table (fortran)
q3: 0 ; 26 segment no for first own segment
q6: 0 ; 28 length of common area
d76 = j13*254 + (:j14 + q3 - g39 - 2:)>1; virtual address entry q3
\f
; jz.fgs 1987.06.02 algol/fortran runtime system page ...61...
a25 = k - 2047 ; alias for f37 : rs own 1: first free bs
a24 = k + 2 - 2047 ; end rs
c13 = k - c7 ; length of rs resident part
; end rs resident
f37: 0 ; rs own 1: first free bs
d71:
f44: 0 ; rs own 2: size of own + data init tables
g34 = k - f37; no of rs owns
f49 = f37 - 2 ; see c59, store owns
f57 = (:g34>1:) + 1
e70 = f37 - d0 ; define own base
\f
; jz.fgs 1985.09.13 algol/fortran runtime system page ...62...
; begin of rs initialization. overread by own variables.
; this code is entered directly from fp as an fp-dependent program.
; fp supplies:
; w1 = absolute address of fp basis,
; w2 = absolute address of command stack top
; w3 = absolute address of program name in command stack
; pass 9 has supplied the relevant information in the program descriptor.
; after the initialization, the resident part of rs is stored either as
; a program loaded by fp, or in the the start of the process area.
; entry to rs initialisation:
c14=k-c20 ;
am -2000 ;
al. w0 c7.+2000 ; rs base :=
rs. w0 b18. ; first of rs resident - c7;
am -2047 ;
rs. w1 f20.+2047 ; first of process area := fp base;
ds. w2 b5. ; first of rs:= fp base; last used := command stack top;
rs. w3 b12. ; save (program name addr in command stack);
rl w2 x1+h16 ; rs.own proc :=
am -2047 ; contents (
rs. w2 f21.+2047 ; fp base + fp own proc);
rl. w2 b18. ; w2 := rs base;
bz w0 x1+h19+h1+1;
sn w0 4 ; if program kind <> bs then
jl. a35. ; init alarm (<:not bs:>);
jl. w3 c16. ;
<:not bs<10><0>:> ;
a35: dl w0 x1+h19+h1+4;
ds w0 x2-c7+f13+2; copy program name;
ds w0 x2-c7+f52+2;
dl w0 x1+h19+h1+8;
ds w0 x2-c7+f13+6;
ds w0 x2-c7+f52+6;
al w3 x2-c7+f13 ;
rl w0 x1+h17 ; copy parent process address;
rs w0 x2-c7+f17 ;
rl w0 x1+h15 ; copy console process address;
rs w0 x2-c7+f19 ;
jd 1<11+52 ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...63...
al w0 0 ; modif := 0;
rl w3 x1+h21+h0 ;
ws w3 x1+h20+h0 ;
se w3 x3+h53 ; if h53 <> 0
se w3 512+h53 ; and out.base buf - in.base buf = 512+h53 then
jl. a42. ; begin
rl w3 x1+h20+h0 ; <* init char conversion table description
rl w2 x1+h21+h0 ; for in and out zones *>
a41: rs w0 x3 ; for i:= 0 step -2 until -h53+2 do
rs w0 x2 ; begin
al w3 x3-2 ; in(base buf).i := 0;
al w2 x2-2 ; out(base buf).i := 0;
am (x1+h20+h0) ; end;
se w3 -h53 ;
jl. a41. ;
al w0 1 ; modif := 1;
; end;
a42: rl. w2 b12. ; restore w2; (command pointer)
wa. w0 b8. ; stderror entry := stdentry + modif;
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...64...
am h53 ; initialize in and out:
se w3 x3-18 ; if h53 <> 18 then
rl. w0 b8. ; stderror entry := stderror entry - modif;
rs w0 x1+h20+h4+2; block proc of in and out:= std error;
rs w0 x1+h21+h4+2;
al w0 1 ;
rs w0 x1+h20+h2+6; state of in:= char input;
al w0 3 ;
rs w0 x1+h21+h2+6; state of out:= char output;
ld w0 48 ; clear w3 - 0;
ds w0 x1+h20+h3+6; record length and lower index of in and out:=0;
ds w0 x1+h21+h3+6;
dl. w0 q5. ; uv :=
am -2000 ; (length of datatable,
ds. w0 d12.+2000 ; length of zone common table);
wa. w0 q4. ; length of tables := length of datatable +
; length of zone common table;
sl. w0 (q6.) ; if length of tables >= length of common area then
rs. w0 q6. ; length of common area := length of tables;
; length of common area := max (length of tables,
; length of common area) ensures that tables can be
; loaded within common area so that segment table
; is not damaged
wa. w0 q2. ; size of own + data init tables :=
rs. w0 f44. ; length of tables + length of own area;
ba w2 x2+1 ; scan parameter list: w2:= addr of next param;
bl w0 x2 ;
sh w0 2 ; if delim is end command then
jl. a22. ; goto end scan;
\f
; jz.fgs 1985.09.13 algol/fortran runtime system page ...65...
bl w3 x2+1 ; <prog.name><s> scanned;
wa w3 4 ; w3:= addr of next param;
bl w0 x3 ;
sl w0 6 ; if delim is not end command or space then
jl. a22. ; goto end scan;
sl w3 x2+10 ; if <prog.name> <s> <integer> <end command or space> then
jl. a18. ; begin
bl. w0 g39. ;
sz w0 1<1 ; if fp.yes then
jl. a22. ; goto end scan;
al w0 1 ; end action:= finis job;
am -2000 ;
rs. w0 f18.+2000 ;
hs. w0 c73. ; fp absent := true;
am (x1+h16) ;
rl w2 +24 ; last used := top of process;
al w1 x1+e100+2 ; first of rs := first of proc area + dumparea+2;
ds. w2 b5. ;
jl. a20. ; goto end scan; end;
b18: 0 ; rs base
a18: ; <prog.name> <s> <name> <end command or space> scanned
bl. w0 g39. ;
so w0 1<0 ; if connect.no then
jl. a22. ; goto end scan;
jl w3 x1+h29-4 ; stack current input;
dl. w2 b5. ; w1:= fp base;
rl. w2 b12. ;
al w2 x2+12 ; w2:=address of file name:= program name addr+12;
jl w3 x1+h27-2 ; connect current input;
sn w0 0 ; if hard error then
jl. a16. ; init alarm (<:connect in:>);
jl. w3 c16. ;
<:connect in<10><0>:>;
a16: rs w0 x1+h2+6 ; z.state(in):=after open;
bz w0 x2+16 ;
sh w0 1 ; if contents is not text or card text then
jl. a22. ; init alarm (<:infile not text:>);
jl. w3 c16. ;
<:infile not text<10><0>:>;
\f
; jz.fgs 1987.02.25 algol/fortran runtime system page ...66...
a22: am -2000 ; end scan:
al. w0 c20.+2000 ; first of rs := base of segm 0;
rs. w0 b9. ;
a20: ; end scan:
rl. w2 b5. ; w2 := last used; <*command stack top/top of process*>
sl. w2 (b11.) ; if w2 >= 1<20-2 then
rl. w2 b11. ; w2 := 1<20-2;
rl. w3 b18. ; w3 := rs base;
rs w2 x3-c7+f14 ; stack bottom :=
rs w2 x3-c7+d13 ; last used := w2;
rl. w0 q7. ; trapchain :=
sz w0 1<5 ; if fortran mainprogram
al w2 0 ; then 0
rs w2 x3-c7+d97 ; else stack bottom;
sn w3 x3+h53 ; if h53 <> 0 then
rl w1 x3-c7+f20 ; w1 := first of process area;
rl w0 x1+h21+h0 ;
ws w0 x1+h20+h0 ;
se w3 x3+h53 ; if h53 <> 0
se w0 512+h53 ; and out.base buf - in.base buf = 512+h53 then
jl. a43. ; begin
am (x1+h20+h0) ; zone in. srefpart :=
rs w2 -h53+2 ; last used;
am (x1+h21+h0) ; zone out. srefpart :=
rs w2 -h53+2 ; last used;
a43: dl. w2 b5. ; end;
am 2000 ;
al w2 x1+c13-2000;
am 2000 ;
wa w2 x3-c7+q2-2000; first of common:= first of rs +
rs w2 x3-c7+f59 ; length of rs resident + length of own area;
am 2000 ; first in segment table :=
wa w2 x3-c7+q6-2000; first of common +
rs w2 x3-c7+f6 ; length of common area (=max(length of tables,common));
\f
; jz.fgs 1985.09.13 algol/fortran runtime system page ...67...
am 2000 ;
wa w2 x3-c7+q3-2000;
am 2000 ;
wa w2 x3-c7+q3-2000; first of program:= victim:= segment table
rs w2 x3-c7+d15 ; base + 2 * segment number for own segments;
rs w2 x3-c7+f2 ;
al w2 x2-2 ; last of program:= first of program - 2;
rs w2 x3-c7+d14 ;
al w2 x1+d0-c7 ; core base:= first of rs + core base load addr
rs w2 x3-c7+f10 ; - first of rs load addr;
rl w2 x3-c7+d16 ;
ws w2 x3-c7+f10 ; f11:= segment table base - core base + 1 < 22;
wa w2 x3-c7+d23 ;
rs w2 x3-c7+f11 ;
rl w0 x3-c7+f59 ; compute commonbase - core base + 5<21:
ws w0 x3-c7+f10 ; commonbase := commonbase - corebase
wa w0 x3-c7+f60 ; + 3<21
wa w0 x3-c7+d23 ; + 1<22;
rs w0 x3-c7+f59 ;
rl w0 x3-c7+d15 ;
rl w2 x3-c7+d13 ; if first of program >= last used
sh w0 x2-1535 ; - 3 * segment length then
jl. a19. ; init alarm (<:process too small:>);
jl. w3 c16. ;
<:process too small<10><0>:>;
\f
; jz.fgs 1988.10.05 algol/fortran runtime system page ...68...
a19: am -2000 ; move:
al. w2 c7.+2000 ; w2 := first of rs now;
rl. w1 b9. ; w1:= first of rs;
a26: dl w0 x2+2 ; for w2:= first of rs now step 4 until
ds w0 x1+2 ; entry to rs init do
al w2 x2+4 ; begin core(w1):= core(w2);
al w1 x1+4 ; w1:= w1 + 4
sh. w2 c13.+c7 ;
jl. a26. ; end;
; resident rs is now moved to its final place. if fp is not present,
; 16 bytes are left at first of process area for register dumps.
rl. w2 b9. ; w2 := first of rs;
al w3 x2+c0-c7 ; w3 := rs interrupt address;
al w0 0 ; clear interrupt(over/underflows)
jd 1<11+0 ; clear interrupt(over/underflows);
dl. w1 b19. ; provoke underflow:
xl. 0 ; clear exception reg.;
fm. w1 b20. ; (w0,w1) := epsilon*epsilon;
xs 1 ; rc8000 :=
sz w0 2.10 ; if ex.22 = 1 <*overflow*> then
am 1 ; 0 <*false*>
al w0 -1 ; else
hs w0 x2+f54-c7 ; -1 <*true*>;
am 2000 ;
rl w0 x2+q1-c7-2000; w0:= interrupt mask;
jd 1<11+0 ; set interrupt;
al w1 x2+f27-c7 ; w1 := addr lookup area;
rl. w3 b12. ; w3 := addr program name in command stack;
al w3 x3+2 ;
jd 1<11+42 ; lookup entry;
rl w3 x2+f27-c7+14;
am (x2+f27-c7) ; if tail.size < 0 then
sl w3 x3+1 ; program segment offset :=
rs w3 x2+f58-c7 ; entry tail.block count; <*else 0*>
; zl w3 x2+d30-c7 ; entry to rts.segment part :=
; wa w3 x2+f58-c7 ; entry to rts.segment part +
; hs w3 x2+d30-c7 ; program segment offset;
al. w3 b16. ;
al w0 x3+510 ; first addr(message) := first free;
ds w0 x2+f9+4-c7 ; last addr(message) := first free + 510;
am 2000 ;
rl w1 x2+q3-c7-2000; program size :=
rs w1 x2+f43-c7 ; segmen count(message) :=
rs w1 x2+f9+6-c7 ; segment no for first own segment;
al w3 x2+f13-c7 ; name address :=
rs w3 x2+f53-c7 ; program name address;
rx w1 4 ; swop (w1, w2);
jl w3 x1+c17-c7 ; input segment (first own segment);
\f
; jz.fgs 1985.10.07 algol/fortran runtime system page ...69...
rl. w2 b9. ; w2 := first of rs;
am (x2+f9+2-c7) ;
rl w1 4 ; w1 := rsown 1 (first free bs)
se w1 0 ; if w1 <> 0 then
jl. a36. ; goto continue; <*restart*>
am 2000 ; init:
rl w1 x2+f44-c7-2000;
as w1 -1 ; w1 := (size of own area + size of common area)//
al w1 x1+1 ; 2 + 1;
a36: am 2000 ; continue:
rs w1 x2+f37-c7-2000;
al w1 x2+f27-c7 ; first free bs := w1;
al w3 x2+f13-c7 ; w1 := tail addr; w3 := addr(program name);
jd 1<11 + 42 ; lookup entry;
am 2000 ;
rl w1 x2+f37-c7-2000 ;
al w0 0 ; oldsize := (first free bs + 252)//254
al w1 x1+252 ;
wd. w1 b17. ;
wa w1 x2+f43-c7 ; + program size;
rs w1 x2+f48-c7 ;
sh w1 (x2+f27-c7) ; if oldsize > size(program area)
jl. a37. ;
jl. w3 c16. ; then init alarm (<:at restart wrong size:>);
<:at restart wrong size<10><0>:>;
\f
; jz.fgs 1988.10.05 algol/fortran runtime system page ...70...
a37: ls w1 1 ; w1 :=
wa w1 x2+f6-c7 ; size*2 + segtable base;
rs w1 x2+f2-c7 ; victim := first of segments := w1;
rs w1 x2+f24-c7 ;
al w1 x1-2 ; last of program :=
rs w1 x2+d14-c7 ; last of segm table := w1-2;
rs w1 x2+f36-c7 ;
al w1 x1+2 ;
rx w1 x2+d15-c7 ; swap(w1,first of program);
rs w1 x2+f23-c7 ; top program segm table := w1;
al w1 x2+c61-c7 ; set absolute addresses for specialentries:
rs w1 x2+d61-c7 ; init context,
am +2000;
al w1 x2+c62-c7-2000;
am +2000;
rs w1 x2+d62-c7-2000;
am +2000;
al w1 x2+c63-c7-2000;
am +2000
rs w1 x2+d63-c7-2000; continue,
al w1 x2+d64-c7 ;
rs w1 x2+d64-c7 ; and dummy variable in while statem.
al w1 x2+d13-c7 ; abs addr(top of program) :=
rs w1 x2+d88-c7 ; abs addr of last used;
rl w1 x2+f14-c7 ; current stackbottom :=
rs w1 x2+d93-c7 ; temp stack bottom;
\f
; fgs 1988.05.18 algol/fortran runtime system page ...70a...
al w1 x2+d112-c7 ; index := high index;
rl w3 x2+f14 -c7 ; w3 :=
ws w3 x2+f24 -c7 ; ((stack bottom -
al w3 x3+511 ; first of segm)+
ls w3 -9 ; 511) // 512 *
ls w3 9 ; 512 +
wa w3 x2+f24 -c7 ; rts.first of segments;
rs w3 x1 ; high index.first of program :=
rs w3 x1+2 ; high index.first of segments := w3;
al w3 x3-2 ;
rs w3 x1-2 ; high index.last of program := w3 - 2;
rl. w0 b5. ; top :=
al w3 x3+2 ; stack bottom;
sh w0 x3+1022 ; if top < high index.first of segments + 1024 then
al w0 x3 ; top := high index.first of segments;
rs w0 x1+8 ; high index.limit last used :=
rs w0 x1+10 ; .temp last used :=
rs w0 x1+12 ; . last used :=
rs w0 x1+14 ; .temp stack bottom := top;
al w1 x2+d111-c7 ; current index :=
rs w1 x2+d110-c7 ; low index;
jl w3 x2+c77 -c7 ; switch to high end; <*low := rts; rts := high*>
al w3 x2+d13- c7 ; rts .addr top program :=
rs w3 x2+d88- c7 ; addr (rts. last used);
jl w3 x2+c78 -c7 ; switch to low end; <*high := rts; rts := low *>
jl x2+f0-2-c7 ; goto init segment table;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...71...
c16: rs. w3 b6. ; init alarm:
am -2000 ; save text addr;
rl. w1 f20.+2000 ; w1 := fp basis;
al. w0 b10. ;
jl w3 x1+h31-2 ; print( *** );
am -2000 ;
rl. w1 f20.+2000 ; w1 := fp basis;
al w0 x1+h19+h1+2; w0:= abs address of program name;
jl w3 x1+h31-2 ; print program name;
am -2000 ;
rl. w1 f20.+2000 ;
al. w0 b7. ;
jl w3 x1+h31-2 ; print(<:init:>);
am -2000 ;
rl. w1 f20.+2000 ;
rl. w0 b6. ;
jl w3 x1+h31-2 ; print (text);
al w2 1 ;
am -2000 ;
rl. w3 f20.+2000 ;
jl w3 x3+h7 ; end program other error;
b6: 0 ; text address
b7: <: init : <0>:>
b10: <:***<0>:> ;
b11: (:1<20-2:) ; top allowed address in stack
b8: d32 ; std error
b17: 254 ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...72...
f.
b19=k+2, b20=b19
1.0'-600
w.
g41 = k - c20 ; no of bytes to be transferred by fp at call
g46 = (:k-c20+511:) > 9 ; no of resident rs segments
r. 257-(:g41-g41>9<9:)>1; fill up current segment
b9 = k ; saved first of rs
b5 = b9+2 ; +2 , saved last used
b12 = k+4 ; addr of programname in command stack
b16 = b9 + 6 ; first free:
i. ; id list
e. ; end block rs resident
w.
\f
; jz.fgs 1987.06.03 algol/fortran runtime system page ...73...
; rs segment 7, alarm segment 0 : is entered from rs alarm, page 35, and
; prepares alarm text and cause before a jump to alarm segment 1, provided
; that fp's presense, endaction and trapmode together allow the alarm to
; be printed. If not, or after return from alarm segment 1, the end action
; is decided to be either goto traplabel, return to activity, enable act-
; ivity after disable, finis action, break action or normal return to fp.
; In case of exit from program, possible data segments are squeezed out
; of core before exit.
j9 = (:k-c20:) > 9 ; define segment number
j0 = -1<22 + j9<1 ;
j12 = j9<1 ; offset in segment table for alarm segment 0
f15 = f15 - c0 ; offset alarm record for use in alarm segm 0 and 1
g0=f24-c0, g1 =f4 -c0, g2=f15+ 4, g3 =f15+ 2 ; define addresses for
g4=d16-c0, g5 =f15+5 , g6=d30-c0, g7 =d30-2-c0; alarm segment 0
g8=d13-c0, g9 =f15+6 ,g10=f15+ 8, g11=f0 - c0 ;
g12=c0-d0, g13=f15+12,g14=f15+16, g15=f15+10 ;
g16=d31-c0,g17=f20-c0,g18=f18-c0, g22=d24-c0 ;
g36=d78-c0, g37=g36-2, g38=g16-2, g44=d109-c0-2047
g45=f14-c0
b. a30, b53 w. ; begin of segment part
b10: b14 ; rel of last abs word
b0 : c0 -d0 ; interrupt addr
b48: d102-d0 ; fp absent
b51: d98 -d0 ; alarm record (1:11)
b13: j4 ; alarm segm 1
b14=k-2-b10 ; last abs word
b1: 3 ; mask
0 ; default end program conditions (1)
b2: 1 ; default end program conditions (2)
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...74...
; entry from rs resident part: the following code adjusts the locations
; of rs resident part described on alarm segment 1.
; when the alarm routine is entered, the situation is as follows:
; w0 dump = cause (>0 signals general alarm), w1 dump = w1 at alarm time,
; call addr = abs addr af alarm call or (in case of alarm from rs segments)
; saved w3, w2 dump = sref or saved sref = sref (in case of alarm from a
; code segment).
c6=k-b10 ; compute call point and current alarm addr:
; note: next 2 instructions make the segment independent of
; if it was transferred from bs or resident core.
rl. w1 b0. ; w1 := interrupt address;
rs w2 x1+4 ; w2dump := w2; w0w1 are dumped on page ...45...;
rl w3 x1+g11 ; core part.
ws w3 x1+g0 ; w3:=current alarm rel:=
la w3 x1+g1 ; (call address-first of program)extract 9;
rs w3 x1+g2 ;
dl w3 x1+g11 ; w2:=call sref; w3:=segment base:=
ws w3 x1+g2 ; call address-current alarm rel;
rl w0 x3 ;
rs w0 x1+g3 ; w0:=current alarm segm:=core(segment base);
ws w0 x1+g4 ;
ls w0 11 ; w0:=call point:=(current alarm segm-segm table
hl w0 x1+g5 ; base)<11 + current alarm rel;
rs w0 x1+g6 ;
rl w0 x3+e39-2 ; adjust sref:
la. w0 b1. ; w0:=segm type;
sh w0 2 ; if segm type = algol segments then
sh w0 0 ; w2 is call sref else w2:= saved sref;
rl w2 x1+g7 ;
rs w2 x1+g7 ; saved sref:=
rs w2 x1+f15 ; current sref:=w2;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...75...
rl w0 x1+g8 ;
rs w0 x1+g9 ; current last used:=last used;
al w0 0 ;
rs w0 x1+g10 ; line count:=0;
rl w2 x1 ; w2:=cause:=w0 dump;
rs w2 x1+g36 ; alarmcause(1) := cause := w0dump;
sh w2 0 ; if cause > 0 then
jl. a14. ; begin
rl. w3 b0. ; general alarm:
al w1 x2 ; w1 := text address;
al w2 0 ;
rs w2 x3+g36 ; alarm cause(1) := 0;
rl w2 x3+2 ; w2 := w1dump;
jl. a30. ; goto move text;
; end cause > 0;
a14: bl. w3 x2+b11. ; w3:=cause table(cause);
rl w2 x1+2 ; w2:=w1 dump;
b12: jl. x3 ; switch to cause action;
a1: ac w2 (x1+2) ;-1, stack alarm:
; w2:=attempted claim:= -w1 dump;
al w1 0 ; w1:=text 0, integer
jl. a12. ; goto alarm segm 1;
a2: rl w3 x1+g11 ;-2, index alarm:
bz w3 x3-7 ; w3:= -byte(call address-7);
ac w3 x3 ;
as w2 x3 ; w2:=index:=w1 dump shift w3;
a3: am -6 ;-3, zone index:
a4: am -7 ;-4, case:
a5: am -6 ;-5, syntax:
a6: am -6 ;-6, integer:
a7: am -6 ;-7, real:
a8: am 37-60 ;-8, param:
a15: al w1 60 ;-12, field alarm:
jl. a12. ;
\f
; jz.fgs 1988.05.18 algol/fortran runtime system page ...76...
a29: am 6 ;-15: killed alarm(activate kill)
a28: al w1 73 ;-14: goto alarm:
al w2 0 ;
jl. a12. ; goto alarm segment 1;
a9: am (x1+g17) ; -9, break: w2 := process area (14);
rl w2 +14 ; w2 = saved cause
al w1 42 ; w1:=text 42, integer;
jl. a12. ; goto alarm segm 1;
a10: al w0 100 ;-10, end:
rs w0 x1+g10 ; line count:=great;
rl w2 x1+g45 ; w2 := temp stackbottom;
al w3 0 ;
rs w3 x2-6 ; traplabel(outermost block) := 0;
rs w3 x1+d92-c0; current act no := 0; <*no passivate of phony act*>
am 2047 ;
rl w2 x1+g44 ; end program conditions :=
al w3 2.11 ; errorbits extract 2;
la w2 6 ; (i.e. warning + ok bits)
rs w2 x1+g16 ;
rl w2 x1+g22 ; w2:=blocks read;
al w1 48 ; w1 := text(<:end:>);
jl. a12. ; goto alarm segm 1;
a11: dl w0 x1+g16 ;-11, give up:
; w0 := zone.status; w3 := zone.docname;
rl. w2 b51. ; w2 := address of alarm record (1);
rs w0 x2+12 ; alarm record (7) := zone.status;
dl w1 x3+ 2 ;
ds w1 x2+16 ;
dl w1 x3+ 6 ; alarm record (8:11) :=
ds w1 x2+20 ; zone.docname;
rl. w1 b0. ;
rl w2 x1+2 ; restore w2 (w1 dump);
am -12 ;
a27: al w1 66 ;-13 trap:
; jl. a12. ; goto alarm segm 1;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...77...
a12: rl. w3 b0. ; alarm segm 1:
al. w1 x1+b21. ; w1 := text address;
a30: rs w2 x3+g37 ; move text: alarmcause(0) := w2;
rl. w2 b51. ; w2 := address(alarm record);
dl w0 x1+2 ;
ds w0 x2+6 ; alarmrecord(3:6) :=
rl w3 x1+4 ; alarmtext;
al w0 0 ; terminate with 3 null characters;
ds w0 x2+10 ;
sz w1 1 ; preserve parity of w1;
am 1 ;
al w1 x2+4 ; w1 := address(alarm record(3));
rl. w3 b0. ;
dl w0 x3+g36 ; alarm record(1:2) :=
ds w0 x2+2 ; param, cause;
al w2 x3 ; w2 := alarm param;
jl. w3 (b48.) ; call fp absent;
sn w0 1 ; if fp absent then
jl. a16. ; goto end alarm;
rl. w3 b0. ;
rl w0 x3+d79-c0; w0 := trapmode;
rl w3 x3+d78-c0; w3 := alarmcause;
ls w0 (6) ; w0 := trapmode shift alarmcause;
sz w0 1 ; if no output then
jl. a16. ; then goto end alarm;
rl. w3 ( b13.) ; fp present and output;
jl x3+c29 ; goto print alarm cause, alarm segm 1, text prep.;
\f
; jz.fgs 1987.06.02 algol/fortran runtime system page ...78...
c12 = k - b10 ; return point from alarm segment 1;
a16: rl. w3 b0. ;
rl w2 x3+d97-c0 ; end alarm:
sn w2 0 ; if trapchain = 0 then
jl. a17. ; goto check activity;
wa w2 x2-4 ; check traplabel:
rl w1 x2 ; traplabel.point := block(trapchain).label;
rl w0 x3+d93-c0 ; w0 := current stackbottom;
sh w2 (0) ; if trapchain <= current stackbottom
sn w1 0 ; and traplabel.point<>0 then
jl. a17. ; begin
al w0 0
rs w0 x2 ; block (trapchain) . label := 0;
rs w0 x3+d31-c0-2; end program conditions (1) := 0;
al w0 1 ;
rs w0 x3+d31-c0 ; end program conditions (2) := 1;
rl w0 x3+d97-c0 ; trappoint.sref := trapchain;
jl x3+d11-c0 ; goto computed (trappoint);
; end;
a17: rl w2 x3+d92-c0 ; check activity:
sh w2 0 ; if activity mode then
jl. a18. ; begin
dl. w1 b2. ; end program conditions := default;
ds w1 x3+d31-c0 ;
rl w2 x3+d93-c0 ; last used :=
rs w2 x3+d13-c0 ; current stack bottom;
jl w3 x3+d10-c0 ; release zones;
rl. w3 b0. ;
am x3+d91-c0-2000; point :=
rl w1 -2+2000 ; entry point(passivate2);
al w1 x1+6 ; point:=point+6; <*passivate(-1)*>
jl w3 x3+d4 -c0 ; take expression(point);
; end;
; check disable mode:
a18: sl w2 0 ; if disable mode then
jl. a19. ; begin
dl. w1 b2. ; end program conditions := default;
ds w1 x3+d31-c0 ;
al w0 1<4 ; w0:=1 shift 4 (sref at call=1);
rl w1 x3+d96-c0 ; w1 := entry point(enable activity);
jl w3 x3+d4 -c0 ; take expression;
; end;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...79...
a19: jl. w3 (b48.) ; set end action:
rl. w3 b0. ; w3 := rs base;
sn w0 1 ; if fp_present then
jl. a20. ; begin
rl w0 x3+d78-c0 ; if alarmcause (1) = break then
sn w0 -9 ; end_action := break;
a20: rs w0 x3+f18-c0 ; end else end_action := finis;
; check end_action:
rl w0 x3+f18-c0 ;
se w0 0 ; if end_action = fp end program
sn w0 1 ; or end_action = finis mess then
jl. a21. ; goto release;
rl. w3 (b13.) ; goto alarm segment 1, exit,
jl x3 + c38 ; perform end action;
a21: al w0 1 ; release:
rs w0 x3+d65-c0 ; progmode := passive;
jl w3 x3+c82-c0 ; release program segments from both partitions;
; and write out data segments with update mark ;
rl. w3 (b13.) ; goto to alarm segment 1, exit program
jl x3+c28 ; unstack and release zones;
\f
; jz.fgs 1987.06.02 algol/fortran runtime system page ...80...
b21:<:<10>stack :> ; standard alarm texts:
<:<10>index :> ;
<:<10>case :> ;
<:<10>syntax :> ;
<:<10>integer :> ;
<:<10>real :> ;
<:<10>param :> ;
<:<10>break :> ;
<:<10>end :> ;
<:<10>giveup :> ;
<:<10>field :> ;
<:<10>trap :> ;
<:<10>goto :> ;
<:<10>killed :> ;
h. a3 -b12, a29-b12 ; cause table(-16:1);
a28-b12, a27-b12 ;
a15-b12, a11-b12 ;
a10-b12, a9-b12 ;
a8-b12 , a7-b12 ;
a6-b12 , a5-b12 ;
a4-b12 , a3-b12 ;
a2-b12 , a1-b12 ;
b11: ; address of cause table
w.
0, r. 252+b10>1-k>1+1 ; fill segment
<:alarm segm0<0>:> ;
i. e. ; end of segment
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...81...
; rs segment 8, alarm segment 1: prints the alarm cause, the alarm address,
; and possible call addresses. the segment uses the printing routines
; of fp.
; the following cells in rs core part are used:
; c0+f15: current sref (during unwinding of stack)
; - 2: current alarm segm ( - )
; - +4: current alarm rel ( - )
; - +6: current last used ( - )
; - +8: line count (a maximum of 5 call addresses are printed)
; - +10 to 16: saved text (contains text after general alarm)
; - +18 to +20: working, text addr, lower line, upper line
; - +22: saved segment type.
j3 = (:k-c20:) > 9 ; define segmentnumber;
j4 = -1 < 22 + j3<1
b. a43, b53 w. ;
b10: b24 ; rel of last abs word
b0 : c0 -d0 ; interrupt addr
b12: h21 +h2 + 6 ; zone state current output
b13: h32 -2 ; fp outinteger, out
b9 : h31 -2 ; fp outtext, out
b48: d102-d0 ; fp absent
b49: h95 -2 ; fp close up text output, current out
b51: d98 -d0 ; alarm record (1:11)
b52: h65 ; fp break
b53: h7 ; fp end program
b39: d92 -d0 ; activity no
b11: j0 ; alarm segment 0
b24=k-2-b10 ; define rel of last abs word
b41: 0 ; act
b1 : 3 ; mask
b2 : 2<12 + 1<5 + 1 ; parent message : finis, layout, wait;
b15: <: :> ; 8 spaces
b17: 0 ; line, pattern
b19: 31 ; mask
b20: <:ext <0>:> ;
b21: <:line<0>:> ;
b23: <:<10>called from :>;
b32: <:<10>:> ;
b16: 0 ; upper line
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...82...
; alarm printing, entered from alarm segment 0. working locations
; are explained on page 49. entry: w1=index of alarm text. w1 is
; even if the alarm cause consists of the text and the value of w2.
; w1 is odd if only the text is to be printed.
c29 = k - b10 ; alarm segment 1, text prepared:
al w3 0 ;
rs. w3 b41. ; act := 0;
a2: ; print alarm cause:
al w0 x1 ;
jl. w3 (b9.) ; outtext(alarm text); parity of w0
sz w0 1 ; is preserved
jl. a3. ; if text addr even then
al w0 x2 ; begin
jl. w3 (b13.) ; outinteger(w2,sign,6 pos)
1<23 + 32<12 + 6 ; spaces := 2;
am 4 ; end
a3: al. w0 b15. ; else spaces := 8;
jl. w3 (b9.) ; outtext(spaces);
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...83...
; print alarm address:
a17: rl. w2 b0. ; w2:= interrupt addr;
rl w1 x2+f15+8 ;
sl w1 10 ; if line count >= 10 then
jl. a18. ; goto end program;
al w1 x1+1 ;
rs w1 x2+f15+8 ; line count:= line count + 1;
dl w0 x2+f15+4 ; w3:=base of current alarm segm;
rl w3 x3 ;
hs. w0 b18. ; alarm rel:= current alarm rel;
rl w1 x3+e39-2 ;
la. w1 b1. ; w1:= saved segment type:= last on segment
rs w1 x2+f15+22 ; extract 2;
sh w1 2 ;
sh w1 0 ; if segment type -< code segments then
jl. a19. ; goto text information;
al. w0 b20. ; further:=
sn w1 2 ; if segment type = 2 then addr of <:ext:>
al. w0 b21. ; else addr of <:line:>;
rs w0 x2+f15+20 ;
rl w1 x3+e39-8 ; compute line interval:
ls w1 -6 ; upper line:= first line inf shift (-6);
rs. w1 b16. ;
dl w1 x3+e39-2 ;
al w2 e39+2 ; w2:= rel on segment;
ld w1 -3 ; w0-1:= last two line inf > 3;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...84...
a20: rs. w1 b17. ; rep: save line pattern;
la. w1 b19. ; w1:= line change;
sn w1 31 ; if line change = 31 then
jl. a21. ; goto lower on previous segment;
ac w1 x1 ;
wa. w1 b16. ; w1:= upper line - line change;
al w2 x2-34 ; w2:= rel on segment:= w2 - 34;
b18=k+1; alarm rel ;
sh w2 0 ; if rel on segment <= alarm rel then
jl. a22. ; goto lower found;
rs. w1 b16. ; upper line:= upper line - line change;
rl. w1 b17. ; get line pattern;
ld w1 -5 ; shift to next line change;
sn w2 e39+2-306 ; if relonsegment = limit for last two line inf
dl w1 x3+e39-6 ; then w0-1:= first two line inf;
jl. a20. ; goto rep;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...85...
a21: rl w0 x3+e39-2 ; lower on previous segment:
al w1 1 ; lower line:= 1;
sz w0 4 ; if segment type = first segment then
jl. a22. ; goto lower found;
am. (b0.) ;
rl w3 +f15+2 ; w3:= current alarm segm;
rl w3 x3-2 ; w3:= base of preceding segment;
rl w1 x3+e39-8 ;
ls w1 -6 ; w1:= lower line:= first line inf > 6
a22: rl. w2 b0. ; lower found: w2:= interrupt addr;
ac. w0 (b16.) ;
rs w1 x2+f15+18 ; further:= -upper line, lower line;
rx w0 x2+f15+20 ; w0:= addr of <:ext:> or <:line:>;
jl. w3 (b9.) ; outtext
am. (b0.) ;
rl w0 +f15+18 ; w0:=lower line
jl. w3 (b13.) ; outinteger(3 pos)
32<12 + 4 + 1<23 ;
am. (b0.) ;
rl w0 +f15+20 ; w0:= -upper line
jl. w3 (b13.) ; outinteger(0 pos)
32<12 + 1 + 1<23 ;
jl. a24. ; goto unwind;
a19: dl w1 x3+e39-6 ; text information:
ds w1 x2+f15+12 ;
dl w1 x3+e39-2 ; move byte(504:510,segment)
ws w1 x2+f15+22 ; extract segment type
ds w1 x2+f15+16 ; to work area;
al w0 x2+f15+10 ; w0 := new text address;
jl. w3 (b9.) ; outtext(segment text)
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...86...
a24: rl. w0 (b39.) ; unwind:
sh. w0 (b41.) ; if activityno>act then
jl. a40. ; begin
al. w0 b40. ;
jl. w3 (b9.) ; outtext(<: activity no:>);
rl. w0 (b39.) ;
rs. w0 b41. ; act := activity no;
jl. w3 (b13.) ;
32<12 + 1 + 1<23 ; outinteger(activity no);
a40: rl. w2 b0. ; unwind stack: w2:= interrupt addr;
rl w1 x2+f15+22 ; w1:= saved segment type;
sh w1 2 ;
sh w1 0 ; if segment type <> algol then
jl. a25. ; goto unwind call;
rl w1 x2+f15 ; w1:= current sref;
a27: sh w1 (x2+d93-c0) ; rep: if current sref > current stack bottom or
sh w1 (x2+d15-c0) ; current sref <= first of program then
jl. a26. ; goto unwind thunk; stack alarm in ext proc.
rl w0 x1-2 ;
am (x2+f15+6) ;
sl w0 1 ; if last used in block > current last used then
jl. a26. ; goto unwind thunk;
a39: rs w1 x2+f15+6 ; unwind block: current last used:=current sref;
sl w1 (x2+f14-c0) ; if current sref >= stack bottom then
jl. a18. ; goto end program;
; notice: algol-units have in sref-4: display-rel
; ftn -units have in sref-4: entry-no or function-value-address
rl w3 x1-4 ; if fortran unit then
sl w3 0 ;
jl. a26. ; goto unwind thunk;
am (x1-4) ;
rl w1 x1+2 ; w1:= current sref:= display(block no. + 2);
jl. a27. ; goto rep;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...87...
a26: am 6 ; unwind thunk: w1:=current sref:=current last used;
a25: rl w1 x2+f15 ; unwind call: w1:= current sref;
sl w1 (x2+d15-c0) ; if current sref < first of program
sl w1 (x2+f14-c0) ; or current sref >= stack bottom then
jl. a18. ; goto end program; <*alarm in alarm with empty stack*>
bl w3 x1+4 ;
al w3 x3+6 ; current last used:= w1 +
wa w3 2 ; return appetite + 6;
rs w3 x2+f15+6 ;
dl w0 x1+4 ; current alarm addr:= return point;
ds w0 x2+f15+4 ;
rl w1 x1 ; current sref:= sref of return point;
rs w1 x2+f15 ;
sh w1 (x2+d93-c0) ; if current sref > current stack bottom
sh w1 (x2+d81-c0) ; or current sref <= max last used then
jl. a18. ; goto end program;
al. w0 b23. ;
jl. w3 (b9.) ; outtext(<:called from:>)
jl. a17. ; goto print alarm address;
a18: al. w0 b32. ; end program:
jl. w3 (b9.) ; outtext (<:<10>:>);
al w3 3 ; zone state current ourput :=
rs. w3 (b12.) ; after char output;
rl. w3 (b11.) ;
jl x3+c12 ; goto end alarm, alarm segment 0;
b40: <: activity no<0>:>;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...88...
c28 = k- b10 ; alarm segment 1, exit program:
rl. w3 b0. ; unstack and release zones:
rl w2 x3+d93-c0 ; last_used :=
rs w2 x3+d13-c0 ; current_stack_bottom;
jl w3 x3+d10-c0 ; release zones;
c38 = k - b10 ; alarm segment 1, exit program:
rl. w3 b0. ; check end action: w3 := rs base;
rl w2 x3+f16-c0 ; w2 := spare mess buf;
al w1 x3+f7- c0 ; w1:= answer addr;
se w2 0 ; if spare mess buf not waited for then
jd 1<11+18 ; wait answer;
al w2 0 ;
rs w2 x3+f16-c0 ; spare mess buf waited for;
rl w2 x3+f18-c0 ; w2 := end action;
se w2 1 ; if w2 = finis job then
jl. a1. ; begin
jl. w3 (b48.) ; call fp absent;
se w0 1 ; if fp present then
jl. w3 (b49.) ; close up text output (current out, 'em');
rl. w3 b0. ;
rl w2 x3+f17-c0 ; w2 := address of parent process;
al w3 x3+f15 ; w3 := address of parent message area;
dl w1 x2+4 ;
ds w1 x3+2 ;
dl w1 x2+8 ;
ds w1 x3+6 ; move parent name to message area;
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...89...
rl. w0 b2. ;
rs w0 x3+10 ; move head of finis message;
rl. w2 b51. ; w2 := address of alarm record (1:11);
rl w0 x2 ;
rs w0 x3+24 ; move alarm record (1); <*param*>
dl w1 x2+6 ;
ds w1 x3+14 ;
dl w1 x2+10 ;
ds w1 x3+18 ; move alarm record (3:6); <*text (1:4)*>
ld w1 49 ;
ds w1 x3+22 ; zeroes;
al w1 x3+10 ; w1 := address of parent message;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer; closed loop;
jl. 0 ; end;
a1: se w2 0 ; if end action <> normal then
jl. w3 (b52.) ; goto fp break;
dl w2 x3+d31-c0 ; w1, w2 := end program conditions;
jl. w3 (b53.) ; goto fp end program;
0, r. 252+b10>1-k>1+1 ; fill segment
<:alarm segm1<0>:> ; code segment, stderror entered in normal way
i. e. ; end segment
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...90...
; rs segment 9, init zones , init common and init data(ftn) .
b. a8, b115, i12 w. ;
b10:i10: b11 ; rel of last abs word
i0: f10-d0 ; corebase
i1: f59-d0 ; commonbase
i3: d3-d0 ; reserve
i4: d48-d0 ; take expression ftn
i5: q7-d0 ; modebit word 2
i6: q0-d0 ; entry point to main program
i8: d5-d0 ; goto point
b0:i2: d12-d0 ; uv
b1 : d28-d0 ; reserve array
b6 : d23-d0 ; youngest zone
b7:i7:d13-d0 ; last used
b8 : d30-d0 ; saved sref, w3
b9 : d8 -d0 ; end addr expr
i9 : f44-d0 ; size of own/data/common area
i11: c50-d0 ; load owns
i12: f37-d0+g34 ; first core for owns at runtime
b77: d84 -d0 ; current activity table entry
b78: d85 -d0 ; no of activities
b85: d92 -d0 ; current activity no
b106: d110-d0 ; curr partition index
b107: d111-d0 ; low partition address
b110: d114-d0 ; switch to low end partition
b111: d115-d0 ; switch to high end partition
b11=k-2-b10 ; define rel of last abs word
b2 : 0 ; old top, work
b3 : 0, 0 ; buffer length, work. zone claim, work
0, h53 ; double word: no of bytes reserved for
b4 = k - 2 ; char conversion table descr.
b12: 0 ; saved call sref;
0, 0 ; block proc, work.
b5=k-2 ;
; init zones: return point in stack top, no. of zones in uv0, address of
; zone 0 in uv1. zone 1 contains no. of shares in h0, total buffer
; length in h0+2, and block procedure in h4, h4+2.
d9=(:k-c20:)>9<12+k-b10 ; define entry to rs segments
rl. w0 (b7.) ; init zones: prepare alarms
al. w1 0 ; w0:= saved sref:= last used;
ds. w1 (b8.) ; w1:= saved w3:= addr on this segment;
rl. w2 (b0.) ; w2:= address of zone 0:= uv1;
\f
; jz.fgs 1988.12.12 algol/fortran runtime system page ...91...
al w1 h6 ;
wm w1 x2+h0+h5 ; (w0, w1) := share claim := share descr length *
al w3 0 ; no of shares;
rl w2 x2+h0+2+h5 ; save given buffer length;
rs. w2 b2. ; buffer length := long
ls w2 1 ; long (given buffer length extract 23 *
ad w3 -23 ; 4;
sn w2 0 ; or share claim <0 or share claim >= 2**24
se w0 0 ; then stack(-2) alarm;
jl. a1. ; (w2, w3) := zone claim := buffer length
aa. w3 b4. ; + char conversion table descr. length;
aa w1 6 ; zone claim :=
rl. w2 (b0.) ; zone claim + share claim;
rs w1 x2+h0+4+h5 ; comment w0 indicates overflow now;
rl. w3 b0. ; w3 := address of uv;
sn w0 0 ; if w0 = 0 <* not overflow *> then
wm w1 x3-2 ; total claim := zone claim*no of zones;
rl. w3 (b7.) ;
rl w3 x3+4 ; w3 := rel part of return;
so w3 1 ; if fortran call then
jl. a4. ; begin
al w3 x1 ; w3 := total claim;
al w1 h5 ; w1 := h5
am. (b0.) ;
wm w1 -2 ; * no of zones
al w1 x1+h5+h0 ; + h5
wa w1 4 ; + addr(zone(0));
wa w3 2 ; w3 := oldtop :=
rs. w3 b2. ; first of zone area;
jl. a5. ; end else
\f
; jz.fgs 1988.12.12 algol/fortran runtime system page ...92...
a4: ; begin <*algol*>
se w0 0 ; w1 negative tested in reserve; if overflow then
a1: al w1 -2 ; init alarm: total claim:= illegal;
ac w1 x1 ; appetite:= -total claim;
rl. w0 b2. ;
sh w0 0 ; if given buffer length > 0 then
jl. a0. ; begin
rl. w0 (b78.) ;
rl. w3 (b85.) ;
sh w0 -1 ; if no_of_activities >= 0 <*not activity mode*>
sh w3 0 ; or current act. no <= 0 <*disabled*> then
jl. w3 (b111.) ; switch to high end partition;
a0: rl. w3 (b7. ) ; end <*given buffer length > 0;
rs. w3 b2. ; old top := rts.last used; <*high end partition*>
dl. w0 (b8.) ; w3 := saved sref;
rl w0 x3 ; w0 := call sref;
rs. w0 b12. ; save call sref;
jl. w3 (b1.) ; reserve array; w1 := rts.last used;
rl. w3 (b106.) ;
se. w3 (b107.) ; if current index = low end partition index then
jl. a6. ; begin <*move old stack top to new stack top*>
dl. w0 (b8.) ; w3 := old top :=
rs. w3 b2. ; saved sref;
al w1 x1+6 ; w1 := last used in block :=
am (x3) ; core (sref of return point - 2):=
rs w1 -2 ; last used + 6;
rl w0 x3 ;
rs w0 x1-6 ; move return point from old top to new top;
dl w0 x3+4 ;
ds w0 x1-2 ; end <*move old stack top*>;
a6: jl. w3 (b110.) ; switch to lower end partition;
a5: ; end <*algol*>;
dl w0 x2+h0+4+h5 ; move buffer length, zone claim to local var;
ds. w0 b3.+2 ;
dl w0 x2+h4+2+h5 ; move block proc to local var;
ds. w0 b5. ;
; rep: w1 = base buffer + 1, w2 = zone address.
a3: al w2 x2+h5 ; w2:= address of next zone;
al w3 x1-1+h53 ; w3 := base buffer := w1 - 1 + char conv. claim;
rl. w0 b3. ;
ls w0 2 ; record length:= 4 * buffer length;
rs w0 x2+h3+4 ;
wa w0 6 ; base buffer:= record base:= w3;
ds w0 x2+h0+2 ;
ds w0 x2+h3+2 ; w0:= last buffer:= last byte:= base buffer +
wa. w3 b3.+2 ; buffer length;
al w3 x3-h6+1-h53; w3 := last share := base buffer + zone claim
rs w3 x2+h0+8 ; - share descr length + 1 - h53;
ba. w0 1 ;
rs w0 x2+h0+6 ; w0:=first share:=used share:= last buffer + 1;
rs w0 x2+h0+4 ;
\f
; jz.fgs 1988.05.19 algol/fortran runtime system page ...93...
al w0 4 ;
rs w0 x2+h2+6 ; state:= 4;
al w0 0 ;
rs w0 x2+h3+6 ; record lower:=0;
rs w0 x2+h1+0 ; kind:=0;
rs w0 x2+h2+2 ; free param:=0;
sn w3 x3+h53 ; if h53 <> 0 then
jl. a8. ;
al w3 x1-1+h53 ;
a7: rs w0 x3 ; for i := base buffer
al w3 x3-2 ; step -2 until w1+2
sl w3 x1+2 ; do core(i) := 0;
jl. a7. ; comment clear char conv. table descr.;
am h53 ;
sn w3 x3-18 ; if h53 = 18 then
rl. w0 b12. ; core (last) :=
rs w0 x3 ; call sref in zone;
a8: dl. w0 b5. ;
se w3 x3+h53 ; if h53 <> 0 then
ba. w0 1 ; make rel entry of block proc odd;
ds w0 x2+h4+2 ; block proc:= saved block proc;
rl. w0 (b6.) ;
rs w0 x2+h4+4 ; chain to elder:= youngest zone;
rs. w2 (b6.) ; youngest zone:= zone address;
rl w3 x2+h0+8 ; w3:=last shared;
al w1 x1+h53 ;
a2: rl w0 x2+h0+2 ; init share: last shared:= last buffer;
rs w0 x3+4 ; w1 = base buffer + 1, w2 = zone, w3 = share.
al w0 0 ; share state:= 0;
ds w1 x3+2 ; first shared:= base buffer + 1;
rs w0 x3+6 ; operation,mode:=0;
rs w1 x3+22 ; top transferred:=first shared;
al w3 x3-h6 ; share:= share - share descr length;
sl w3 (x2+h0+6) ; if share >= first share then
jl. a2. ; goto init share;
al w1 x1-h53 ;
wa. w1 b3.+2 ; w1:= w1+zone claim; base buffer+1 for next zone
sl. w1 (b2.) ; if w1 >= old top then
jl. (b9.) ; goto end addr expr;
jl. a3. ; goto rep;
\f
; jz.fgs 1986.03.07 algol/fortran runtime system page ...94...
; path to main program, init zonecommon, init data(ftn)
b. a40, b20 w. ;
b0=i0, b1=i1, b2=i2, b3=i3
b4=i4, b6=i6, b7=i7, b8=i8
b14: d9 ; point, init zones
b12: 5<21
; symbolic names for field s in zonecommon table record
a30= 0 ; zone descriptor address
a32= 2 ; no of zones, buflngth part 1
a33= 4 ; buflngth part2, no of shares
a34= 6 ; block procedure point
a35= 8 ; length of record in zc table
; entry: uv= length of datab,length of zctab
; working cells in stack:
; x2+... contains:
a20 = -12 ; end of data-table
a21 = -10 ; entry to main program
a22 = - 8 ; a:first in common
a23 = - 6 ; length of data-table, later a:last of do.
a24 = - 4 ; length of zc-table , later a:last of do.
a25 = - 2 ; a:first in table in stack, later pointer
a29 = 10 ; size of variables in stack
f61 = (:k-c20:)>9<12+k-i10 ; path to main program:
al w0 g34 ; path to main program:
ws. w0 (i9.) ; w0 := appetite := length of rts own area
al w2 f57 ; - length of own/data/common area;
rl. w1 i12. ; w1 := first core address of owns;
sh w0 -1 ; w2 := virtual address of first own;
jl. w3 (i11.) ; if appetite<0 then load owns;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...95...
; initiate commons by activating data code
; and initiate zone commons according to zc table from pass9
; the tables data table and zonecommon table has been
; transferred to core together with own core and areat entry
; situated just after own core. the routine starts by moving
; the tables to the stack in order to free the area for
; commons zcommons and safter this the data table is
; interpreted setting initial values in commons.
; then the zonecommon table is interpreted initiating
; zone commons by callin rs entry init zones with parameters
; according to zctable
al w1 -a29 ; common init:
jl. w3 (b3.) ; reserve work cells w1:= lastused
al w2 x1+a29 ; w2 := sref;
rl. w0 (b6. ;
rs w0 x2+a21 ; save entry to main progr,f5 is used
rl. w1 (b0.) ;
wa. w1 (b1.) ;
ws. w1 b12. ;
rs w1 x2+a22 ; save table start
dl. w1 (b2.) ; save length of zc table
ds w1 x2+a24 ; and data table
wa w1 x2+a23 ; w1 := total table length
ac w1 x1+6 ;
jl. w3 (b3.) ; reserve for table in stack
al w1 x1+ 6 ; for call area
rs w1 x2+a25 ; save stack table start
rl w3 x2+a22 ; w3:= core table start
a6: sl w1 x2+a20+2 ;
jl. a12. ;
rl w0 x3 ; move table fromcommon core to stack
rs w0 x1 ;
al w1 x1+ 2 ;
al w3 x3+ 2 ;
sh w1 x2+a20 ; stop when w1= last of data-table
jl. a6. ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...96...
a12: rl w3 x2+a25 ; first in zctable:=
wa w3 x2+a23 ; first in table+ length of datatable
rs w3 x2+a23 ;
a11: rl w3 x2+a25 ; if current address lt
sl w3 (x2+a23) ; first in zctable then
jl. a7. ; begin
rl w1 x3 ; w1:= data entry point
al w3 x3+ 2 ; increase and save table index
rs w3 x2+a25 ;
jl. w3 (b4.) ; take expr ftn
jl. a11. ;
a7: rl w3 x2+a25 ; termination addr for zctable:=
wa w3 x2+a24 ; start of zctable+ length of zctable
rs w3 x2+a24 ;
a10: rl w3 x2+a25 ; if end of zctable goto end zc initiation
sl w3 (x2+a24) ;
jl. a8. ;
rl w1 x3+ a30 ; a:zdescr:= c:zdescr+ a:start of commons
wa w1 x2+a22 ;
al w1 x1-h0-h5 ; -h0 -h5
bl w0 x3+ a32 ; w0:= no of zones
se w0 0 ; if simple zone setup as zonearray
jl. a9. ; with one element
al w0 1 ;
a9: ds .w1 (b2.) ; store params in uv
bl w0 x3+a33+1 ; no of shares
rs w0 x1+h5+h0 ;
rl w0 x3+a32 ; assemble buflength
ls w0 12 ;
hl w0 x3+a33 ;
rs w0 x1+h5+h0+2;
al w0 0 ;
rs w0 x1+h5+h4 ;
rl w0 x3+ a34 ; block proc point
rs w0 x1+h5+h4+2;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...97...
al w3 x3+ a35 ; increase sctable address
rs w3 x2+a25 ; and save
rl. w1 b14. ; w1:= point for initzones
jl .w3 (b4.) ; take expr ftn
jl. a10. ; fgoto take next in table
a8: rl w1 x2+a21 ; w1:= entry to main program
rs. w2 (b7.) ; release stack
jl. w3 (b8.) ; goto rs gotopoint
i. e. ; end path to main program and init zonecommon/data
r. 252+b10>1-k>1+1
<:zone declar<3>:>
i. e. ; end init zone
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...98...
; rs algol check segment, operations with long operands, call of users
; block procedure, stderror, path to program entry
; rs entry 43,rcl 47,rclf 46,ldr 52,labelalarm
; 44,mod 55,mul 56,div
j7 = (:k - c20:) > 9 ; define segmentnumber
j8 = -1 < 22 + j7<1 ;
b. a40, b26
w.
j10:
b10: b9
b1 : j6 ; block segment
b2 : d12-d0 ; uv
b5 : d21-d0 ; general alarm
b7 : d13-d0 ; last used
b8 : g39-d0 ; program descriptor vector
b11: d3 -d0 ; reserve
b16: d30-d0 ; saved w2 w3
b19: d4 -d0 ; take expression
b20: d17-d0 ; index alarm
b24: d31-d0 ; end prog. conditions
b26: d105-d0 ; saved zone address
b9= k-b10-2 ; rel of last abswd
b21: 6<12+23 ; first formal of zone parameter
b22: 1<16 ; tapemark
\f
; jz.fgs 1983.08.16 algol/fortran runtime system page ...99...
; rcl, convert real to long integer
; entry : w0w1 = real, w2= sref, w3= return
; exit : w01= long, w2 w3 unchanged
d43=(:k -c20:)>9<12 + k-b10 ; algol-entry: the number is rounded;
d47=(:k -c20:)>9<12 + k-b10+4; ftn-entry : if trunc.yes then
; the number is truncated
; else
; the number is rounded;
ds. w3 (b16.) ; entry algol : save w2w3;
jl. a0. ; goto round;
ds. w3 (b16.) ; entry fortran: save (w2, w3);
am. (b8.) ;
rl w3 +2 ; w3 := modebitword (2);
so w3 1<0 ; if trunc.yes then
jl. a0. ; begin <*only possible for fortran*>
sl w0 0 ; if w0w1 < 0 then
jl. a1. ; w0w1 := w0w1 + 1.0;
fa. w1 b17. ; goto entier;
; end else
; goto round ;
a0: fa. w1 b17. ; round: w0w1 := w0w1 + 0.5;
a1: bl w2 3 ; entier:
ad w1 -12 ;
ad w1 x2-35 ;
dl. w3 (b16.) ;
jl x3 ; return;
f.
b17: 0.5 ;
w.
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...100...
; lcr, convert long integer to real
; entry: w01= long, w2= sref, w3= return
; exit : w01= real, w2 w3 unchanged
d46= (:k- c20:)>9<12+k-b10; define point
ds. w3 (b16.) ; save w2 w3
ld w2 -1 ; w2(23)= bit 0 of long
ls w2 -23 ; w2= bit 0
hs. w2 b18.
rs w0 6 ; w3= first 24 bits
ci w1 1 ; convert last part
ci w3 24 ; convert first part
fa w1 6 ; add parts converted
b18= k+1
al w3 0 ; w3= last bit of long
ci w3 0 ; convert
fa w1 6 ; add to sum
dl. w3 (b16.) ; restore w2 w3
jl x3
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...101...
b. a9,c3,f9 ; block for type long procs;
; procedures for multiplication and division of two double-
; length integers a and b:
; format: a=a1*2**24 + a2
; b=b1*2**24 + b2
; multiplication: a1 or b1 must be zero,or the erroraction
; creating an integer owerflow is executed.
; for b1=0 the product is calculated as:
; sign(a1*b1)*(a1*b2*2**24+a2*b2)
; division: the definition follows the algol 60 report:
; a//b=sign(a/b)*entier(abs(a/b))
;
; if the divisor is absolute less than 2**22, then
; the division is performed by use of two integer
; divisions,otherwise a floating point division is
; used and the division is followed by a correction.
; modulus: the definition is:
; a mod b = a - (a//b)*b
; conventions:entry: addr. of a in uv1,addr of b in uv0
; exit: value in uv
; registers: entry:w2=stackref,w3=return address
; exit: w2,w3 unchanged,others undefined
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...102...
w. f0: 0 ; entry address
f1: 0 ; sign1
f2: 0 ; sign2
0 ; u1
f3: 0 ; u2
0 ; v1
f4: 0 ; v2
0 ;
f5: 0 ; kv2
0 ;
f6: 1 ; one
f7: 3<22 ; short divisor mask
f8: 0 ; return address from division and modulus
0 ; double constant, word 1 : 0
f9: 0 ; - - , - 2 : 0
d44 = (:k-c20:)>9<12 + k-b10; long mod entry:
am c3 ; return := mod-return;
d56 = (:k-c20:)>9<12 + k-b10; long div entry:
al. w0 a2. ; return := signtest;
rs. w0 f8. ;
am c2 ; entry := division;
d55 = (:k-c20:)>9<12 + k-b10; long mul entry:
al. w1 c0. ; entry multiplication:entry:=2;
rs. w1 f0. ; save entry;
ds. w3 (b16.); save sref,return addr.;
dl. w3 (b2.) ; w2:=a:2.opnd;w3:=a:1.opnd;
dl w1 x3 ; w0w1:=operand a;
rs. w0 f1. ; save sign;
sl w0 0 ; if a<0 then
jl. a0. ; w0w1:=-a;
dl. w1 f9. ;
ss w1 x3 ;
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...103...
a0: ds. w1 f3. ; u1u2:=w0w1:=abs(a);
rs. w2 f4. ; save w2;
dl w3 x2 ; w2w3:=operand b;
rs. w2 f2. ; save sign;
sl w2 0 ; if b<0 then
jl. (f0.) ;
dl. w3 f9. ;
ss. w3 (f4.) ;
jl. (f0.) ; goto case entry of(
; multiply,divide);
c0: sn w2 0 ; multiply:if b is short then
jl. a1. ; goto short multiplier;
se w0 0 ; if a>2**24 then
jl. a4. ; goto error;
ds. w3 f3. ; u1u2:=multiplicand;
rx w0 4 ; exchange w0,w2 and w1,w3;
rx w1 6 ;
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...104...
a1: rs. w3 f4. ; short multiplier: comment
ls w3 -1 ; multiplier in w2w3 and w2=0;
rs. w3 f5. ; comment assume that b is the
rx w0 6 ; short one,then the multipli-
wm. w1 f5. ; cation is done as:
sh w0 -1 ; a*b=a*(b//2)*2+(b mod 2)*a;
al w3 x3 +1 ;
wm. w3 f5. ;
ad w3 24 ;
aa w1 6 ;
ad w1 1 ;
rl. w2 f4. ;
sz w2 1 ;
aa. w1 f3. ; result in w0w1;
a2: rl. w2 f1. ; signtest:
lx. w2 f2. ; w2:=sign(a)*sign(b);
a9: sl w2 0 ;
jl. a3. ; if w2<0 then
dl. w3 f9. ;
ss w3 2 ; w0w1:=-w0w1;
ds w3 2 ;
a3: ds. w1 (b2.) ; out: uv:=w0w1;
dl. w3 (b16.); reestablish w2,w3;
jl x3 ; return;
a4: as w2 24 ; error: provoke integer ower-
jl. a3. ; flow; goto out;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...105...
c1: ds. w3 f4. ; divide:w2w3:=v1v2:=abs(b);
c2=c1-c0
sn w2 0 ; if w2w3>=2**22 then
sz. w3 (f7.) ;
jl. a6. ; goto long division;
; short division:
; w0 w1 w2 w3
; a=( u1 , u2 ) b=( 0 , v2 )
a5: ld w3 24 ; - - v2 0
wd w0 4 ; u1//v2 - - u1 mod v2
rx w3 0 ; u1 mod v2 - - u1 // v2
ls w2 1 ; a3=( - , - ) d=2*v2 -
wd w1 4 ; a3 mod d a3//d - -
ls w2 -1 ; - - v2 -
ls w1 1 ; - 2*(a3//d) - -
rx w3 0 ; u1//v2 - - a3 mod d
sl w3 x2 ; if >= v2 then
al w1 x1 +1 ; - a3//v2 - -
sl w3 x2 ; if >= v2 then
ws w3 4 ; - - - a3 mod v2
al w2 0 ; u1//v2 a3//v2 0 a mod v2
jl. (f8.) ; goto return (division, modulus);
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...106...
a6: nd w1 3 ; long division:w0w1:=uf:=
nd w3 7 ; float(u);w2w3:=vf:=
; float(v);
fd w1 6 ; w0w1:=kvf:=uf/vf;
bz w1 3 ; prevent rounding overflow
cf w1 -2 ;
al w0 0 ;
sl w1 2 ;
al w1 x1 -1 ;
ds. w1 f5. ; w0w1:=kv:=entier(kvf-0.5);
dl. w0 f4. ;
rl w2 0 ; w0w1:=kv*(v2//2)*2+
ls w0 -1 ; kv*(v2 mod 2);
wm w1 0 ; comment the multiplication
ld w1 1 ; is done in this way because
sz w2 1 ; bit 0 of v2 may be 1;
aa. w1 f5. ;
wm. w3 f5. ; w2w3:=kv*v1;
ad w3 24 ;
aa w1 6 ; w0w1:=kv*v1v2:=
ad w1 2 ;
dl. w3 f3. ; w2w3*2**24+w0w1;
ss w3 2 ; w2w3:=remainder:=u1u2-w0w1;
dl. w1 f5. ; w0w1:=kv;
ad w1 2 ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...107...
; correction of long division
a7: sh w2 -1 ; while remainder >=0 do
jl. a8. ; begin
ss. w3 f4. ; remainder:=remainder-v1v2;
aa. w1 f6. ; kv:=kv+1
jl. a7. ; end;
a8: sl w2 0 ; while remainder<0 do
jl. (f8.) ; begin comment exit to return (div,mod)
aa. w3 f4. ; remainder:=remainder+v1v2;
ss. w1 f6. ; kv:=kv-1
jl. a8. ; end; goto return (div, mod);
c3=k-a2
dl w1 6 ; mod-return: w0w1 := remainder;
rl. w2 f1. ; w2 := sign(a);
jl. a9. ; goto signtest;
i.
e.
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...108...
b. a5
w.
c15=k-b10 ; call block procedure:
rx. w3 (b16.) ; w3 := saved zone; savedw3 := w3;
rs. w3 (b26.) ; save zone in rs resident;
al w1 -20 ;
jl. w3 (b11.) ; reserve 20 bytes;
sh w2 510 ; if return address <= 510 then
al w2 x2+c70 ;
rs w2 x1+16 ; stack(16):=return from wait transfer;
rl. w2 (b26.) ; w2:=saved zone;
rl w3 x2+h2+6 ;
rs w3 x1+18 ; save zone state;
rl w3 x2+h0+4 ;
rl w3 x3+22 ; w3:=top transferred(used share);
al w3 x3-1 ;
ws w3 x2+h3+0 ; stack(12):=total bytes transferred:=
; (top transferred-1-record base);
ds w0 x1+14 ; stack(14):=logical status;
sn w3 0 ; notice: the following is only needed
so. w0 (b22.) ; on cdc-tape-stations...
jl. a1. ; if bytes transferred = 0 and tapemark
am (x2+h0+4) ;
bz w0 +6 ; and operation = input then
al w3 2 ;
sn w0 3 ; bytes transferred :=
rs w3 x1+12 ; stack(12) := 2;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...109...
a1: al w3 26 ;
al w0 x1+15 ;
ds w0 x1+6 ; stack(4-6):=descr of logical status;
al w0 x1+13 ;
ds w0 x1+10 ; stack(8-10):=descr of bytes transferred;
al w3 x2 ; w3:=zone;
rl. w2 b21. ; w2 := first formal of zone parameter;
ds w3 x1+2 ; stack(0-2):=descr of zone;
al w2 x1+20 ; w2:=sref;
dl w1 x3+h4+2 ;
ls w0 4 ; w0-1:=block procedure;
jl. w3 (b19.) ; take expression;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...110...
; at return from the block procedure, the parameters are not released yet,
; because the appetite is 0. this is used to reestablish zone, etc.
rs. w2 (b7.) ; last used:=sref; all parameters released.
ds. w3 (b16.) ; saved sref:=sref;
dl w0 x2-2 ; w0,w3:=sav.z.state,return fr.wait trnsf.
sl w3 512 ; if rel of return >= 512 then
jl x3 ; abs return;
hs. w3 a0. ; save segment relative in the return-jump ;
rl. w3 (b1.) ; w3:= block segment start address ;
rl w1 x2-8 ; w1:=bytes transferred;
rl w2 x2-18 ; w2:=zone;
rs. w2 (b26.) ; save zone in rs resident
rs w0 x2+h2+6 ; reestablish zone state;
al w0 x1 ; w0:=bytes transferred + record base;
wa w0 x2+0 ; note: address 0 used in index alarm
sh w0 (x2+h3+2) ; if w0 > last byte
sh w1 -1 ; or bytes transferred < 0 then
jl. w3 (b20.) ; index alarm;
ba. w0 1 ; w0:=top transferred:=w0+1;
rl w1 x2+h0+4 ; w1:=used share;
rs w0 x1+22 ;
a0=k+1 ;
jl x3+0 ; goto return from wait transfer;
i.
e. ; end call of user's block procedure
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...111...
d32=(:k-c20:)>9<12+k-b10; stderror(z,status,bytes). entered from
rl. w2 (b7.) ; in and out, or from procedure stderror.
ds. w3 (b16.) ; saved sref:=last used;
dl w1 x2+12 ;
so w0 16 ; get status
jl. w3 (b19.) ;
rl w1 x1 ; w1:=status
am (x2+8) ;
al w0 +h1+2 ; w0:=address of document name
ds. w1 (b24.) ; end prog conditions:= w0-1
dl w1 x2+16 ;
so w0 16 ; get bytes
jl. w3 (b19.) ; take expression cannot cause <:stack:>
rl w1 x1 ; w1:=bytes
al w0 x2+6 ; simulate return from stderror
ba w0 x2+4 ;
rs. w0 (b7.) ; last used:=last used + 6 + app
dl w0 x2+4 ; w3:=segm table addr:=old top 2
hs. w0 b23. ; relative of return := old top 4
rl w2 x2 ; sref:=old top
rl w3 x3 ;
rl w0 x3 ; get segment, w3:=segment base
b23=k+1 ;
al w3 x3+0 ; w3:=abs address of return
ds. w3 (b16.) ; set saved w3, sref, prepare alarm
al w0 -11 ; from check; w0:=bytes error
jl. (b5.) ; goto general alarm
i.
e.
; end segment part of rs segment 9
r.252+j10>1-k>1+1 ; fill up segment 9
<:algolcheck<0><3>:> ; rs segment;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...112...
; rs block segment contains the main parts of inblock, outblock, and check.
; only when transfer arrors require special treating, the error segment is
; called. the transfer checking may involve call of the block procedure of
; the zone.
j2 = (:k-c20:) > 9 ; define segmentnumber;
j6 = -1 < 22 + j2<1
b. a32, b35 w. ;
b10: b20 ; rel of last abs word
b5 : j5 ; check spec segment
b19: j8 ; algol check segment;
b14: j18 ; extend area segment : extend area
b6 : d8 -d0 ; end addr expr
b7 : d13 -d0 ; last used
b8 : d30 -d0 ; saved sref, saved w3
b31: d12 -d0 ; uv
b32: d92 -d0 ; current activity no
b33: d91 -d0 ; check passivate
b23: d104-d0 ; saved parity count
b0 : d105-d0 ; saved zone address
b3 : d106-d0 ; latest answer
b20=k-2-b10 ; define rel of last abs word
; variables and constants
b1: 0 ; users bits; used as work by extend area
b34: 0 ; saved return from start transfer;
b17: 1<18 ; test end document
b24: 1<16 ; test tape mark
b25: <:<25><25><25>:> ; 3 em characters
b26: 1<7 ; word defect
b27: 1<8 ; stopped
b28: 2047 ; mask for extract 11 in op.mode
b29: -4-1<23-1<17-1<15-1<14-1<8-1<6; prevents stopped action: all
; except intervention,load point, write enable,
; high density, stopped, position, normal.
b30: -1 -1<8 ; mask for removal of stopped
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...113...
; procedure check(w2=zone); the stack top must contain the return point.
; the entry conditions are easily obtained with this call code:
; w0:= zone descr addr shift 4; w1:=entry point
; jl. w3 (take expression)
; the procedure waits for and checks the used share according to the
; standard conventions for hard and soft errors (the block procedure of
; the zone may be called). if used share does not describe a pending
; transfer, no checking is performed.
; procedure inblock and outblock(w2=zone). entry like check.
; the next block of the zone is made available for input or output.
d33=(:k-c20:)>9<12+k-b10 ; check:
d34=(:k-c20:)>9<12+k-b10+2; inblock:
d35=(:k-c20:)>9<12+k-b10+4; outblock:
am c34 ; entry:=check;
am c31 ; entry:=inblock;
al. w3 c30. ; entry:=w3:=outblock;
rs. w2 (b0.) ; saved zone:=w2;
rl w1 x2+h0+4 ; w1:=used share;
jl w3 x3 ; switch to entry;
jl. (b6.) ; return from check: goto end addr expr;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...114...
; the routine inblock and outblock handles the basic n-buffer administra-
; tion. they wait for and start a transfer by means of wait transfer
; and start transfer which only are concerned with one share, that given
; as a parameter.
; wait move: a pending move operation is completed.
a26: jl. w3 c33. ; wait transfer(w1=share, w2=zone);
c30: al w0 5 ; outblock: w0:=operation:=output;
jl. w3 c32. ; start transfer(w0=operation,w1=share,w2=zone);
jl. a26. ; if not started then goto wait move;
; w1=next share.
jl. w3 c33. ; wait transfer(w1=share, w2=zone);
jl. (b6.) ; goto end addr expr;
c31=k-c30 ; inblock: w1=used share, w2=zone.
a3: al w0 3 ; rep: operation:=input;
jl. w3 c32. ; if start transfer(w0=operation,w1=share,
jl. a2. ; w2=zone) then
; begin w1=next share. goto rep
jl. a3. ; end;
; first not free share:
a2: jl. w3 c33. ; wait transfer(w1=share, w2=zone);
bs. w0 1 ;
rs w0 x2+h3+2 ; w0:=last byte:=top transferred - 1;
jl. (b6.) ; goto end addr expr;
\f
; jz.fgs 1988.12.09 algol/fortran runtime system page ...115...
; start transfer: entry: w0 = operation, w1 = share, w2 = zone, w3 = return
; normal exit to w3+2, transfer started: w1=next share, w2 unchanged.
; exit to w3, share busy or ready: w1, w2 unchanged.
c32: rs. w3 b34. ; start transfer: save return;
rl w3 x1 ; w3:= share state;
se w3 0 ; if share not free then
jl. (b34.) ; return to w3;
hs w0 x1+6 ; mess op:= w0;
rl w0 x1+2 ;
rs w0 x1+8 ; first addr of message:= first shared;
rl w0 x2+h1+16 ; segment number of message:= segment count;
rs w0 x1+12 ; only significant for bs and imc
zl w3 x2+h1+1 ;
sn w3 20 ; if zone.kind <> imc then
jl. a0. ; begin
rl w3 x1+10 ;
ws w3 x1+8 ; segment count:= segment count
al w3 x3+2 ;
ls w3 -9 ; + (last addr - first addr + 2) // 512;
wa w3 0 ;
rs w3 x2+h1+16 ;
jl. a4. ; end else
a0: zl w3 x2+h1+0 ; begin <*imc*>
la. w3 b28. ; share.mode :=
hs w3 x1+7 ; zone.mode extract 11;
zl w0 x1+6 ; <*lead, trail, hdr*>
sn w0 5 ; if share.op = send and
so w3 2.10 ; mode.hdr = 2 then
jl. a4. ; share.header :=
rl w3 x2+h1+14 ; zone.block count;
rs w3 x1+14 ;
a4: ; end;
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...115a...
al w3 x2+h1+2 ; w3:= name address;
al w1 x1+6 ; w1:= message address;
rl. w2 (b32.) ; w2 := current activity no;
jd 1<11+16 ; w2:= send message(w1, w3);
sn w2 0 ; if buffer claim exceeded then provoke internal
jd 1<11+18 ; interrupt cause 6;
al w1 x1-6+h6 ; w1:= share address+share descr length;
rs w2 x1-h6 ; share state:= message buffer address;
al w2 x3-h1-2 ; w2:= zone address;
sh w1 (x2+h0+8) ;
jl. a1. ; if w1>last share then
rl w1 x2+h0+6 ; w1:=first share;
a1: am. (b34.) ;
jl +2 ; return to w3 + 2;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...116...
; wait transfer: entry w1 = share, w2 = zone, w3 = return, b0 = saved zone.
; the routine may execute passivate2.
; exit to w3: w1, w2 unchanged, w0 = top transferred.
; the routine may call the block procedure of the zone, in which case b0
; is reestablished before the routine returns in the normal way.
a5: rl. w2 (b0.) ; exit:
rl w1 x2+h0+4 ; w1 := used share;
a31: rl w0 x1+22 ; exit1: w0 := top transferred;
b2=k+1; relative of return
jl. 0 ; normal return;
c70=b2-1-b10 ; used by give up segment;
c34=k-c31-c30
c33: ac w3 x3 ; wait transfer:
ac. w3 x3+b2.-1 ; relative of return :=
hs. w3 b2. ; abs return - b2;
al w0 0 ; parity count := 0;
rs. w0 (b23.) ;
c26=k-b10 ; wait transfer return saved:
bl. w0 b2. ; w0 := relative of return;
jl. w3 (b33.) ; check passivate;
c71 = a31 - k ; used by check passivate;
dl. w1 (b31.) ; (w0,w1) := uv; <*saved w0,w1*>
ds. w2 (b0.) ; restore zone address and parity count;
hs. w0 b2. ; restore relative of return;
rl w2 (x2+h0+4) ; w2 := share state(used share);
sn w2 0 ; if share state = free
jl. a5. ; then goto exit;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...117...
; common status bits
al. w1 (b3.) ; wait: w1:=answer address;
jd 1<11+18 ; w0:= wait answer(w1,w2);
rl. w2 (b0.) ; w2:=zone:=saved zone;
al w3 1 ;
ls w3 (0) ; w3:=1 shift result;
al w0 0 ;
rs w0 (x2+h0+4) ; share state(used share) := free;
sn w3 2 ; if not normal answer then
jl. a32. ; begin
rs w0 x1+0 ; answer.status :=
rs w0 x1+2 ; answer.halfs xferred :=
rs w0 x1+4 ; answer.chars xferred := 0;
; end;
a32: lo. w3 (b3.) ; w3 := w3 or status;
rl w1 x2+h0+4 ; w1:=used share;
bz w0 x1+6 ; w0:=operation;
sz w0 1 ; w0:=if operation=io then
am 6 ; first addr in message
rl w0 x1+2 ; else first shared;
am. (b3.) ;
wa w0 2 ; w0:=top transferred:=
rs w0 x1+22 ; w0 + bytes transferred;
; when the logical status is generated after an unnormal answer, some
; superfluous logical bits may be set. top transferred is correct,
; however.
sh w0 (x1+10) ; if top transferred <= last addr of mess
bz w0 x1+6 ; then w0:=operation else w0=nonsense;
bz w1 x2+h1+1 ; w1:=process kind;
sn w1 6 ; if kind = disc process then
al w1 4 ; kind := area process;
am. (b3.) ;
rl w2 2 ; w2 := bytes transferred;
sn w2 0 ; if bytes transferred = 0
se w1 4 ; and process kind = bs
sn w0 5 ; or less than wanted was output
lo. w3 b27. ; then or stop bit;
rl. w2 (b0.) ; w2 := saved zone address;
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...117a...
se w1 20 ; if zone.kind = imc then
jl. a30. ; begin
am. (b3.) ; zone.file count :=
rl w1 +4 ; answer.chars xferred;
rs w1 x2+h1+12 ;
rl w1 x2+h0+4 ; share := zone.used share;
zl w0 x1+6 ; op := share.operation;
zl w1 x1+7 ; hdr := share.mode.hdr ;
sn w0 3 ; if op = receive and
so w1 2.10 ; hdr = 2 then
jl. a29. ; zone.block count :=
am. (b3.) ; answer.header;
rl w1 +8 ;
rs w1 x2+h1+14 ; w1 := zone.kind;
a29: zl w1 x2+h1+1 ; end;
a30: bz. w1 x1+b21. ; w1:=mask index(w1);
se w1 0 ; if index <> 0 then
jl. a10. ; goto determine action;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...118...
; mag tape status bits
am. (b3.) ;
rl w1 2 ;
sh w1 0 ; if bytes transferred > 0 then
jl. a8. ; begin
al w0 0 ;
am. (b3.) ;
rl w1 4 ;
ls w1 1 ;
am. (b3.) ;
wd w1 2 ; if number of characters*2
se w0 0 ; mod bytes transferred <> 0 then
lo. w3 b26. ; or word defect;
; end;
a8: sz. w3 (b24.) ; if status.tape mark sensed then
jl. a24. ; goto skip;
am. (b3.) ;
rl w0 +2 ;
wa w0 6 ; if hwds xferred > 0
sn w0 0 ; or status > 0 then
jl. a24. ; begin <*update position in zone*>
am. (b3.) ; zone.file, block :=
dl w1 +8 ; answer.file, block;
ds w1 x2+h1+14 ; end;
a24: al w1 0 ; w1 := mask index := 0;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...119...
; determine action: return, give up, or special.
a10: al w0 x3 ; determine action:
rs. w0 (b3.) ; save logical status;
la w3 x2+h2+0 ;
rs. w3 b1. ; users bits:=logical status and give up mask;
ws. w0 b1. ; remaining:=logical status - users bits;
sz. w3 (b29.) ; if users bits and prevents repeat <>0 then
la. w0 b30. ; remaining:=remaining remove stopped;
sz. w0 (x1+b4.) ; if remaining and hard (mask indes) <>0
jl. a7. ; then goto give up;
sz. w0 (x1+b15.) ; if remaining and special (mask index) <>0
jl. a11. ; then goto special action;
c25=k-b10 ;
a17: rl. w0 b1. ; normal: w2=zone;
sn w0 0 ; if users bits=0 then
jl. a5. ; goto exit;
am -1 ; give up:=false;
c24=k-b10 ;
a7: al w0 1 ; give up: give up:=true;
rl. w1 (b7.) ; call block proc : w2=zone.
ds. w2 (b8.) ; saved sref:=last used; saved w3:=zone;
lo. w0 (b3.) ; w0:=logical status+give up;
bl. w2 b2. ; w2 := relative of return;
rl. w3 (b19.) ; call give_up_segment;
jl x3+c15 ;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...120...
a11: bz w1 x2+h1+1 ; special action: w2=zone, w0=remaining.
bz. w1 x1+b22. ; w1:=special action(process kind);
rl. w3 (b5.) ; w3:=segment table(error segment);
jl. x1+b10. ; switch to special action;
a12: sz w0 1<5+1<2 ; bs: if not exist or rejected then
jl x3+c36 ; goto get area process, error segm;
a13: so. w0 (b17.) ; cr:tr:ip: if not end medium then
jl x3+c35 ; goto repeat transfer, error segm;
rl. w3 (b14.) ; goto extend area segment,
jl x3+c47 ; extend area;
c42=k-b10 ; return from end of doc, extend area segment:
rl. w3 (b5.) ; w3 := error segment;
se w1 3 ; if not input then
jl. a7. ; goto give up
am. (b3.) ;
rl w0 2 ;
se w0 0 ; if bytes transferred <> 0 then
jl. a17. ; goto exit ;
c41=k-b10 ; physical eom:
rl w1 x2+h0+4 ; w1 := used share;
rl. w0 b25. ; zone.buffer area.first addr :=
rs w0 (x1+8) ; <:<25><25><25>:>;
al w0 2 ;
wa w0 x1+8 ; zone.top xferred :=
rs w0 x1+22 ; zone.first addr + 2;
jl. a17. ; goto normal return;
a14: jl x3+c40 ; tw: goto error segm ;
a15: jl x3+c22 ; tp,lp,pl: goto error segm ;
a16: jl x3+c23 ; mt: goto error segm ;
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...123...
; masks for hard errors and special actions. a one signals that the
; action will be performed.
; 1<23-1<20 1<19-1<10 1<9-1<0
; 3210 9876543210 9876543210
; 0 mag tape
b12= 2.0010 0100001111 1000011001;
b4: c.e77<2, b12 z. ; hard: timer,eot,5*nonsense,
c.e77<3, b12+1<14 z. ; if system3 then mode error,
; disconnected,unintell,nonsense
b15: 2.0101 1001000000 0111100100; special: parity,overrun,blocklength,tapemark,
; stopped,word defect,position,
; not exist,rejected
; 4 ip, clock
2.1111 1011011111 1011111101; hard: all except writeenable,normal, and special
2.0000 0100000000 0100000000; special: end doc, stopped
; 8 backing storage, area process, disc process
2.1111 1011111111 1011011001; hard: all except normal and special
2.0000 0100000000 0100100100; special: end doc,stopped,not exist,
; rejected
; 12 typewriter
2.0101 1110111111 1011111101; hard: all except interv,timer,attent,
; stopped,normal
2.0010 0000000000 0100000000; special: timer,stopped
; 16 tape reader, card reader
2.0011 1000110011 1011111101; hard: all except intervention, parity,end doc,
; tray full, eof pattern, read error,
; reject, stopped,normal
2.0000 0100000000 0000000000; special: end doc
; 20 tape punch, line printer, plotter
2.0111 1011111111 1011111101; hard: all except interv,end doc,
; stopped,normal
2.0000 0100000000 0100000000; special: end doc,stopped
; 22 imc, pl
2.1111 11111111 111011111101; hard: all except stopped and normal answer
2.0000 00000000 000100000000; special: stopped
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...124...
; device table containing mask index and addr of special action.
b21=k, b22=k+1 ;
4<12 + a13-b10 ; ip
4<12 + a7 -b10 ; interval clock process: special action is give up.
8<12 + a12-b10 ; area process
8<12 + a12-b10 ; disc process.
12<12+ a14-b10 ; tw
16<12+ a13-b10 ; tr
20<12+ a15-b10 ; tp
20<12+ a15-b10 ; lp
16<12+ a13-b10 ; cr
0<12 + a16-b10 ; mt
; 20<12+ a15-b10 ; pl , substituted by imc, pl
; 4<12 + a7 -b10 ; imc, special action is give up
24<12+ a15-b10 ; imc , shared with pl
b35: c. b35-b10-506
m. code too long, check segment
z.
c. 502-b35+b10, jl-1, r. 252 - (:b35-b10:) > 1 z.
<:check<0>:>,0,0 ; code segment
i. e. ; end block segment
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...125...
; rs error segm is called by check when special handling of the
; status bits is required. the routines of the error segment will
; alway return to the blosk segment, without calling other segments.
; in principle, the check routine is concerned with one share only, but
; when a transfer is repeated on a mag tape, all later shares must be
; started again.
j1 = (:k-c20:) > 9 ; define segmentnumber;
j5 = -1 < 22 + j1<1
b. a50,b35, g10 w. ;
b10: b20 ; rel of last abs word
b0 : j6 ; check segm
b18: j18 ; extend area segment, parent message
b32: d92-d0 ; current activity no;
b33:d104-d0 ; saved parity count
b34:d106-d0 ; latest answer
b20=k-2-b10 ; define rel of last abs word
b1 : 0 ; spool count
b2 : 0 ; erase count
b3 : 0,0,0,0, 0,0,0,0 ; position area, answer area
b4 : 0 ; work :save share, save position
b5 : 1<22+1<20+1<19+1<7 ; test parity, dataoverrun, blocklength, or word defect
b6 : 1<18 ; test end document
b7 : 13<13+1,<:change :>;
b8 : 1<16 ; test tape mark
b9 : 1<15 ; test write-enable
b11: 9<13+1, <: enable <0>:>
b12: 7<13+1, <: mount <0>:>
b14: 1<23-1<19+1<14-1<9+1<4+1<3; hard errors for move operation:
b17: 1<21 ; test timer
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...126...
c36=k-b10 ; backing storage
al w3 x2+h1+ 2 ; area or disc process: w3:= addr of name;
bz w1 x2+h1+ 1 ; w1 := kind;
so w0 1<2 ; if process does not exist then
al w1 4 ; kind := 4;
se w1 4 ; if kind <> 4 then
jl. a25. ; goto maybe reserve;
rs w1 x3+8 ; clear name table address;
jd 1<11 + 52 ; create area process;
a25: jd 1<11 + 6 ; maybe reserve: initialize process ;
sl w0 2 ; if process does not exist or not user then
jl. a1. ; goto give up;
rl w1 x2+h0+ 4 ; w1 := used share;
bl w0 x1+6 ; w0 := operation ;
se w0 3 ; if op = input
sn w0 0 ; or op = sense then
jl. a3. ; goto repeat;
sl w0 8 ; if op = position or extract statistics then
jl. a3. ; goto repeat;
; now op = output, initiallize or clean track;
jd 1<11 + 8 ; reserve process;
sn w0 0 ; if reserved then
jl. a3. ; goto repeat;
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...127...
a1: am c24-c25 ; give up: w2= zone.
a2: al w3 c25 ; return: w3:=rel on block segm;
hs. w3 b31. ;
rl. w3 (b0.) ; goto(
b31 = k + 1 ; rel
jl x3+0 ; base of block segment + rel) ;
c35=k-b10 ;
a3: rl w1 x2+h0+4 ; repeat transfer: w2=zone. w1:=used share;
zl w3 x2+h1+1 ;
rl w0 x1+22 ; first addr of transfer := top transferred;
rx w0 x1+8 ; takes care of stopping on character devices.
sn w3 20 ; if zone.kind <> imc then
jl. a20. ; begin
ac w0 (0) ;
wa w0 x1+22 ; w0:=top transferred - old first addr;
ls w0 -9 ; segm number in mess := segm number in mess
wa w0 x1+12 ; + w0//512;
rs w0 x1+12 ; only used in bs-output, end document
a20: ; end;
; repeat after parity starts the used share again, waits for all other
; pending shares in the zone, and starts them again.
a8: al w3 x2+h1+2 ; repeat after parity: w2:=zone, w1:=used share.
a7: al w1 x1+6 ; w3:=addr of name; w1:=message address;
rl. w2 (b32.) ; w2 := current activity no;
jd 1<11+16 ; w2:=send message (w1,w3);
al w1 x1-6 ;
rs w2 x1 ; share state:=w2;
a6: al w1 x1+h6 ; rep: w1:=share:=mess addr-6+share length;
sh w1 (x3+h0-h1+6);
jl. a4. ; if share>last share then
rl w1 x3+h0-h1+4 ; w1:=share:=first share;
a4: sn w1 (x3+h0-h1+2 ; if share=used share then
jl. a5. ; goto check again;
rl w2 x1 ; w2:=share state;
sh w2 1 ; if -, pending then
jl. a6. ; goto rep;
rs. w1 b4. ; save share;
al. w1 b3. ; w1:=answer address;
jd 1<11+18 ; wait answer (w1,w2);
rl. w1 b4. ; w1:=saved share;
jl. a7. ; goto repeat after parity;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...128...
a5: al w2 x3-h1-2 ; check again: w1=share. w2=zone;
rl. w3 (b0.) ;
jl x3+c26 ; goto wait transfer, return saved;
c22=k-b10 ; tp: lp: w2=zone, w0=remaining bits.
al. w1 b7. ; w1:=text addr;
sz. w0 (b6.) ; if end document then
jl. w3 a9. ; parent message(<:change paper:>);
sz w0 1<8 ; if stopped then
jl. a3. ; goto repeat transfer;
jl. a2. ; goto return;
a40: ; update position:
se w3 10 ; if operation = input
sn w3 3 ; or operation = out mark then
jl. a41. ; goto test tapemark;
sn w3 8 ; if operation = move then
jl. a41. ; goto check position;
sz w0 1<6 ; no update: if pos error then
jl. a12. ; goto complete positioning;
jl. a2. ; else return;
a41: am. (b34.) ; check position:
dl w1 +8 ;
se w3 8 ; if operation <> move then
ds w1 x2+h1+14 ; zone.file, block := answer.file, block;
sn w0 (x2+h1+12) ; if answer.file count <> zone.filecount
se w1 (x2+h1+14) ; or answer.block count <> zone.blockcount then
jl. a42. ; goto add position error bit;
se w3 3 ; if operation <> input then
jl. a2. ; goto return else
rl. w3 (b0.) ; goto physical eom
jl x3+c41 ; on previous segment;
a42: rl. w3 b34. ; add position error bit:
al w0 1<6 ;
lo w0 x3 ; status :=
rs w0 x3 ; status or pos bit;
jl. a12. ; goto complete positioning;
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...129...
c23=k-b10 ; mag tape: w2=zone, w0=remaining bits.
a23: rl w1 x2+h0+4 ; w1:=used share;
bl w3 x1+6 ; w3:=operation ;
sz w0 1<5+1<2 ; if not exist or rejected then
jl. a11. ; goto mount tape;
sz. w0 (b8.) ; check transfer: if tape mark sensed then
jl. a40. ; goto update position;
se w3 0 ; if operation = sense
sl w3 8 ; or operation = move or setmode then
jl. a12. ; goto complete positioning;
sz. w0 (b5.) ; if overrun, blocklength, parity or word defect then
jl. a13. ; goto parity;
; stopped:
a19: sn w3 3 ; if input <*not (output or erase)*> then
jl. a2. ; goto return;
sz. w0 (b9.) ; if not write enable then
jl. a26. ; begin
al. w1 b11. ; parent message (
jl. w3 a9. ; <:enable:> );
jl. a14. ; goto reserve process;
; end;
a26: se w1 0 ; short block out or pos err empty xfer:
jl. a13. ; if bytes transferred <> 0 then
jl. a28. ; goto parity else goto position and repeat;
a11: sz w3 2.111 ; mount tape: w3=operation, w2=zone.
jl. 4 ;
jl. a2. ; if sense or move then goto return; unload ok
so w0 1<5 ; the positioning is completed at next transfer.
jl. a14. ; if not exist then
a15: al. w1 b12. ; mount message:
jl. w3 a9. ; parent message(<:mount:>);
a14: al w3 x2+h1+2 ; reserve process: w3:=addr of name;
jd 1<11+6 ; initialise process;
sl w0 2 ; if not exist or not user then
jl. a15. ; goto mount message;
se w0 0 ; if not reserved then
jl. a1. ; goto give up;
\f
; jz.fgs 1988.12.08 algol/fortran runtime system page ...130...
a28: ; position and repeat: w0:=message;
c. e77<2 ; if system2 then
al w0 0 ; message:=sense;
z.
c. e77<3 ; else if system3 then
al w0 14 ; message:=set mode;
z.
al w1 g0 ; move action :=repeat after parity;
hs. w1 b13. ;
jl. a16. ; goto send and wait;
a12: al w1 g1 ; complete positioning:
hs. w1 b13. ; move action:=return;
al w1 0 ; spool count :=
rs. w1 b1. ; 0;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...131...
; the following action implements the strategy for tape positioning. the
; routine will loop until the tape position matches the posion count in
; the zone. when this is done, the switch -move action- determines
; what happens.
c. e77<2 ; if system 2 then
a31:
a17: rl w1 x2+h0+4 ; after move operation: w2=zone. w1:=used share;
am (b34.) ;
rl w0 6 ; w0 := file number in answer;
sh w0 -1 ; if file number undefined then
jl. a27. ; w1:=rewind tape else
sn w0 (x2+h1+12) ; if file number=file count then
jl. a18. ; goto position block;
sh w0 (x2+h1+12) ; if file number <= file count then
jl. a19. ; w1:=upspace file else
a21: am (b34.) ; spool back:
rl w0 6 ; w0 := file number in answer;
ls w0 -1 ; if file number//2 <= file count
sh w0 (x2+h1+12) ; then
am -2 ; w1:=backspace file else
a27: am 4 ; w1:=rewind tape;
a19: al w1 0 ;
jl. a20. ; goto spool;
a18: am (b34.) ; position block:
rl w0 8 ; w0 := block number in answer;
sh w0 -1 ; if block number undefined then
jl. a21. ; goto spool back else
sn w0 (x2+h1+14) ; if block numfer = block count then
b13=k+1; move action ;
jl. 0 ; switch to move action else
sh w0 (x2+h1+14) ; if block number <= block count then
jl. a22. ; w1:=upspace block else
ls w0 -1 ; if block number//2 >= block count
sl w0 (x2+h1+14) ; then
jl. a21. ; goto spool back else
am 2 ; w1:= backspace block;
a22: al w1 1 ;
z. ; end system 2 else
\f
; jz.fgs 1989.01.02 algol/fortran runtime system page ...132...
c. e77<3 ; if system 3 then
a17:
a31: dl w0 x2+h1+14 ; w3w0 := file and block in zone;
rl. w1 b34. ; w1 := addr of answer area;
sh w3 -1 ; if w3 <= -1 then
dl w0 x1+8 ; w3w0 := file and block in answer;
sn w3 (x1+6) ; if file no in zone <> file no in answer
se w0 (x1+8) ; or block no in zone <> block no in answer then
jl. a18. ; goto prepare spool;
rl w1 x2+h0+4 ; restore w1 to used share;
b13=k+1 ; move action
jl. 0 ; switch to move action;
a18: ; prepare spool:
rl. w1 b1. ; spoolcount :=
al w1 x1+1 ; spoolcount +
rs. w1 b1. ; 1;
sl w1 6 ; if spoolcount >= 6 then
jl. a1. ; goto give up;
al w1 6 ; w1 := position operation;
ds. w0 b3.+6 ; set file and block into message;
z. ; end system 3;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...133...
al w0 8 ; spool: w0:=move operation;
a16: ls w0 12 ; send and wait: w0=operation, w1=move.
ds. w1 b3.+2 ; store operation, move;
al. w1 b3. ; w1:=message address;
al w3 x2+h1+2 ; w3:= addr of name;
jd 1<11+16 ; w2:= send message(w1.w3);
al. w1 (b34.) ; w1 := addr of answer area;
jd 1<11+18 ; w0:= wait answer(w1,w2);
al w2 x3-h1-2 ; w2:=zone;
al w3 1 ;
ls w3 (0) ;
al w0 x3 ; w0:=logical status:=1 shift result of wait;
sz w0 1<5+1<2 ; if not exist or rejected then
jl. a23. ; goto mag tape;
lo w0 x1+0 ; w0:=logical status:=
rs w0 x1+0 ; logical status or status in answer;
sz. w0 (b14.) ; if hard errors then
jl. a1. ; goto give up;
jl. a31. ; goto after move operation;
\f
; jz.fgs 1989.02.01 algol/fortran runtime system page ...134...
a13: rl. w0 (b33.) ; parity: w0 := parity count;
sl w0 15 ; if parity count >= 15 then
jl. a1. ; goto give up;
ba. w0 1 ;
rs. w0 (b33.) ;
al w1 0 ; parity count:=parity count+1;
rs. w1 b2. ; erase count:=0;
al w1 g2 ;
hs. w1 b13. ; move action:=prepare repeat;
am. (b34.) ;
rl w0 8 ; w0 := block no in answer;
bs. w0 1 ; w0:=save position:=block count in answer - 1;
rs. w0 b4. ;
sl w0 1 ; block count:=if block count>1 then
bs. w0 1 ; block count-2 else block count-1;
sh w0 0 ; if blockcount <= 0 then
al w0 0 ; blockcount := 0;
rs w0 x2+h1+14 ;
jl. a17. ; goto after move operation;
g2=k-b13+1 ; prepare repeat:
rl w1 x2+h0+4 ; w1:=used share;
bl w0 x1+6 ; w0:=operation;
al w1 g3 ; move action :=
se w0 5 ; if operation<>output then
al w1 g0 ; repeat after parity else erase;
hs. w1 b13. ; erase after output mark also;
rl. w1 b4. ; block count:=saved position;
rs w1 x2+h1+14 ;
jl. a17. ; goto after move operation;
g3=k-b13+1 ; erase:
rl. w0 b2. ; w0:= erase count;
rl. w3 (b33.) ; w3 := parity count;
sl w0 x3 ; if erase count >= parity count then
jl. a8. ; goto repeat after parity;
ba. w0 1 ;
rs. w0 b2. ; erase count:=erase count+1;
al w0 6 ; w0:= operation:=erase;
jl. a16. ; goto send and wait;
g0=a8-b13+1 ; define repeat after parity
g1=a2-b13+1 ; define return
\f
; jz.fgs 1989.01.31 algol/fortran runtime system page ...135...
c40=k-b10 ; tw:
so. w0 (b17.) ; if not timer then
jl. a3. ; goto repeat transfer
rl w1 x2+h0+4 ; w1:=used share
bl w0 x1+6 ;
sn w0 5 ; if operation = output then
jl. a1. ; goto give up;
jl. a2. ; goto return;
a9: rs. w3 b3. ; parent message: save return;
rl. w3 (b18.) ; goto extend area segment,
jl x3+c55 ; parent message;
c49=k-b10 ; return from parent message:
jl. (b3.) ; return;
b35: c. b35-b10-506
m.code too long, runtime system, check spec segment
z.
c. 502-b35+b10
jl -1, r.252-(:b35-b10:) > 1
z.
<:check spec:>
i.e. ; end error segment
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...136...
; calculation of power function: a**x
j15 = (:k-c20:) >9; define segment number
j16 = -1<22 + j15<1; - absword
b. a30, b30, g10 w. ;
b10: b11 ; rel of last absword
b0: d12-d0 ; uv
b8: d30-d0 ; saved (sref,w3)
b12: d21-d0 ; general alarm
b13: d37-d0 ; overflows
b11 = k - 2 - b10 ; define rel of last absword
g0: 0 ; working locations:
g1: 0, 0 ; for power
g2: 0, 0 ; functions
g3: 0, 0 ;
g4: 0, 0 ;
g5: 0 ;
g6: 0 ;
g7 = c20 ; define fpbase
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...137...
b. c20 ;
f. ; floating-point constants:
c0: 0.0 ; 0.0
c1: 1.0 ; 1.0
c4: 0.6931471805599 ; ln 2
c5: 0.7071067811865 ; sqrt2/2
c6: 0.5 ; 0.5
; constants for rational approximation of ln
c7: -1.394065145176 ; d=-1.394065145176
c8: -1.121427054464 ; c= -1-121427054464
c9: 0.1573675743943; b = .1573675743943
c10: 2.885390081044 ; a = 2.885390081044
; constants for rational approximation of exp
c11: 42.01353289504 ; d= 42.01353289504
c12: 4.903154798969 ; c = 4.903154798969
c13: 0.04996248913645; b = 0.04996248913645
c14: 2.000000000001 ; a = 2.000000000001
w. ; integer constants:
c15: 2048 ;
c16: -2049 ;
c18: -1<23 ; -2 ** 23
c19: 4095 ; mask for partition of v
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...138...
; calculation of power function: real ** integer
d2=(:k-g7:)>9<12+k-b10 ; u = radicand, i = exponent.
ds. w3 (b8.) ; save stack reference, w3;
dl. w1 (b0.) ;
ds. w1 g1. ; g0:= address of u; g1:= address of i;
rl. w2 (g1.) ;
sl w2 0 ; bool:= if i >= 0 or i = -2 ** 23 then
jl. a6. ; i
se. w2 (c18.) ; else
ac w2 x2+0 ; -i;
a6: dl. w1 c1. ;
ds. w1 g2. ; sx:= 1;
dl. w1 (g0.) ; mx:= u;
a7: ld w3 -1 ; a7: mult:= bool mod 2; bool:= bool//2;
sl w3 0 ;
jl. a8. ;
ds. w1 g3. ; if mult = 1 then sx:= sx * mx;
fm. w1 g2. ;
ds. w1 g2. ;
dl. w1 g3. ;
a8: sn w2 0 ; if bool <> 0 then
jl. a9. ; begin
fm w1 2 ; mx:= mx * mx; goto a7;
jl. a7. ; end;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...139...
a9: rl. w2 (g1.) ; w0w1:=
sl w2 0 ; if i < 0 then
jl. a10. ;
dl. w1 c1. ;
fd. w1 g2. ; 1/sx
jl. a11. ; else
a10: dl. w1 g2. ; sx;
a11: ds. w1 (b0.) ; uv:= w0w1
dl. w3 (b8.) ; w2w2:= sref;
jl x3+0 ; return;
; calculation of power function: real ** real
d1=(:k-g7:)>9<12+k-b10 ; u = radicand, v = exponent.
ds. w3 (b8.) ; save stack reference, w3;
dl. w1 (b0.) ;
ds. w1 g1. ; g0:= address of u; g1:= address of v;
dl. w1 (g0.) ; if u <= 0
sh w0 0 ; then goto a12;
jl. a12. ;
; comment: computation of log2(u);
hs. w1 g6. ; n:= exponent(u);
hl. w1 -5 ; x:= fraction(u);
dl w3 2 ;
fs. w1 c5. ; x1:= x - sqrt2/2;
fa. w3 c5. ; x2:= x + sqrt2/2;
fd w1 6 ; t:= x1/x2;
ds. w1 g2. ;
fm w1 2 ; t2:= t * t;
ds. w1 g3. ;
fa. w1 c7. ;
dl. w3 c8. ;
fd w3 2 ;
fa. w3 c9. ;
fm. w3 g3. ;
fa. w3 c10. ;
fm. w3 g2. ; s:= t * (a + t2 * (b + c/(d + t2)));
ds. w3 g4. ;
bl. w1 g6. ;
ci w1 0 ;
ds. w1 g2. ;
fs. w1 c6. ;
fa w1 6 ; log2:= n - 0.5 + s;
ds. w1 g5. ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...140...
; comment: check for overflow or underflow
dl. w3 (g1.) ; in result;
bl w3 7 ;
ba w3 3 ; r:= exponent(log2) + exponent(v);
sh w3 16 ;
jl. a13. ; if r > 16 then
al w3 0 ; begin
fm w3 2 ;
sl w2 1 ; if log2 * v > 0
jl. a14. ; then goto f0;
a15: dl. w1 c0. ; w0w1:= 0 goto exit, a11;
jl. a11. ; end else
a13: sh w3 -36 ; if r < -35
jl. a16. ; then goto b23 else
fm. w1 (g1.) ; begin
cf w1 0 ; x:= log 2 * b;
rs. w1 g0. ; n:= round(x);
ci w1 0 ;
dl. w3 (g1.) ;
la. w3 c19. ;
ds. w3 g3. ; v1:= fraction(v,bit(0:23))* 2**exponent(v);
fm. w3 g2. ;
fs w3 2 ;
dl. w1 (g1.) ;
fs. w1 g3. ; v2:= v - v1;
fm. w1 g2. ;
fa w1 6 ;
dl. w3 g4. ;
fs. w3 c6. ;
fm. w3 (g1.) ;
fa w1 6 ;
fm. w1 c4. ; x:= (n*v1 - n + n*v2 + (s-0.5)*v) * ln2;
ds. w1 g2. ;
fm w1 2 ;
ds. w1 g3. ; x2:= x * x;
fa. w1 c11. ;
dl. w3 c12. ; comment: computation of r = exp(x);
fd w3 2 ;
fa. w3 c13. ;
fm. w3 g3. ;
fa. w3 c14. ;
ds. w3 g4. ; a + x2 * (b + c / (x2 + d));
\f
; jz.fgs 1988.03.01 algol/fortran runtime system page ...141...
fs. w3 g2. ;
dl. w1 g2. ;
fd. w1 c6. ;
fd w1 6 ;
fa. w1 c1. ; r:= 1 + 2 * x / (s - x);
rl. w2 g0. ;
ba w2 3 ; v:= n + exponent(r);
hl w1 5 ; r:= r * 2 ** n;
sl. w2 (c15.) ; if v >= 2048
jl. a14. ; then goto a14;
sh. w2 (c16.) ; if v <= -2049;
a17: dl. w1 c0. ; then resultzero: r:= 0;
jl. a11. ; w0w1:= r; goto exit, a11;
a12: se w0 0 ; a12: if u < 0
jl. a14. ; then goto a14
dl. w1 (g1.) ; else
sh w0 0 ; if v < 0
jl. a14. ; then goto f0
jl. a15. ; else goto b20;
a16: dl. w1 c1. ; a16: w0w1:= 1;
jl. a11. ; goto exit, a11;
; alarm message:
a14: al w0 -7 ; w0:= real alarm:= -7;
rl. w1 (b13.) ;
sh w1 -1 ; if overflows < 0 then
jl. w3 (b12.) ; goto general alarm
al w1 x1+1 ; else overflows := overflows + 1;
rs. w1 (b13.) ;
jl. a17. ; goto resultzero;
i. e. ; end **
r. 252+b10>1-k>1+1 ; fill segment
<:power func.<3>:> ;
i.e. ;
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...142...
; end of doc from check and
; parent message from check spec
; label alarm
j17 = (:k-c20:) >9; define segment number
j18 = -1<22 + j17<1; - absword
b. a30, b102, g10 w.;
b10: b11 ; rel of last absword
b5: j5 ; check spec segment
b6: j6 ; check segment
b8: d30 -d0 ; saved (sref,w3)
b18: f17 -d0 ; parent process address
b21: d21 -d0 ; general alarm
b26: d26 -d0 ; fp current in zone addr
b102: d102-d0 ; boolean procedure fp present
b11 = k - 2 - b10 ; define rel of last absword
; working locations:
b1: 0 ; new size
b2: ; fnc area:
44<12 +2.0000011<5 +1; fnc<12+pattern<5+wait
<:bs :> ; <:bs :>
0, r.4 ; docname of area process
0 ; segments
0 ; 0 entries
b3: 0, r.8 ; parent message area and
; answer area and
; tail for extend area
0, r.4 ; parent process name and
0 ; name table address
b4: 0 ; addr area process
b15: 0, r.4 ; saved registers in parent message
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...143...
c47=k-b10 ; end of doc:
ds. w3 (b8.) ; save sref, w3;
rl w1 x2+h0+4 ; w1 :=
zl w1 x1+6 ; zone.share.operation;
rl. w3 (b6.) ; w3 := check segment;
bz w0 x2+h1+1 ; w0 := process kind;
sn w0 4 ; if process kind = <bs> then
se w1 5 ; and output then
jl x3+c42 ; begin
al w3 x2+h1+2 ; extend area:
jd 1<11+4 ; process description;
rs. w0 b4. ; save area proc addr in b4.;
am (0) ;
rl w0 +18 ; old size := no of segments(area process);
rl w1 x2+h0+4 ;
rl w3 x1+10 ; new size :=
ws w3 x1+8 ; (last transfer - first transfer + 2) // 512
al w3 x3+2 ;
ls w3 -9 ;
wa w3 x1+12 ; + segment(used share);
sl w0 x3 ; if old size >= new size then
jl. a26. ; goto repeat transfer, error segm.;
; the area may have been extended by a previous transfer...
ld w0 -24 ; w3 :=0; w0 := new size;
am. (b4.) ;
rl w1 10 ; w1 := proc descr addr of peripheral process;
sn w1 0 ; if -, (just created or after intervention) then
jl. a19. ; begin
wd w0 x1+26 ; w0 := new size // slicelength; w3 := new size mod slicel;
se w3 0 ; if w3 <> 0 then w0 := w0 + 1;
ba. w0 1 ; w0 := w0 * slicelength;
wm w0 x1+26 ; end;
a19: rs. w0 b1. ; save new no of segments in b1;
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...144...
a14: al w3 x2+h1+2 ; w3 := addr of procname;
al. w1 b3. ; w1 := addr tail area;
jd 1<11+42 ; lookup entry(area) ;
rl. w0 b1. ; w0 := new size ;
rs w0 x1 ; size := saved new size ;
jd 1<11+44 ; change entry ;
se w0 6 ; if claims exceeded then
jl. a13. ; begin <*extend area*>
rl. w0 b2.+12 ;
se w0 0 ; if fnc area.segm <> 0 then
jl. a27. ; goto give up;
jl. w3 (b102.) ;
se w0 0 ; if fp present then
jl. a12. ; begin
rl. w1 b26. ;
rl w1 x1-h20+h51 ; w1 := fp mode bits;
sz w1 1<10 ; if mode.bswait = false then
jl. a12. ; begin
rl. w0 b2. ; fnc area.fnc :=
ls w0 -1 ; fnc area.fnc - wait bit;
ls w0 1 ; end;
rs. w0 b2. ; end;
a12: rl. w1 b4. ; claim :=
rl. w0 b1. ; new size -
ws w0 x1+18 ; old size ;
rs. w0 b2.+12 ; fnc area.segm := claim;
dl w0 x1+22 ; move
ds. w0 b2.+6 ; area process.docname
dl w0 x1+26 ; to
ds. w0 b2.+10 ; fnc area.docname;
al. w1 b2. ; w1 := addr fnc area;
jl. w3 a28. ; parent message special (w1=fnc area);
jl. a14. ; goto change entry;
; end else
a13: se w0 0 ; if result <> 0 then
jl. a27. ; goto give up
; else
a26: al w0 0 ; begin
rs. w0 b2.+12 ; fnc area.segm := 0;
rl. w3 (b5.) ; goto repeat transfer, error segm;
jl x3+c35 ; end;
a27: al w0 0 ; give up:
rs. w0 b2.+12 ; fnc area.segm := 0;
rl. w3 (b6.) ; goto check segment,
jl x3+c24 ; give up;
; parent message special:
a28: ds. w1 b15.+2 ; w1 = addr fnc area;
ds. w3 b15.+6 ; save registers;
al. w2 b3. ; w2 := addr parent message area;
a24: dl w0 x1+2 ; repeat
ds w0 x2+2 ; move double word
al w1 x1+4 ; from x1+2 to x2+2;
al w2 x2+4 ; increment w1 and w2 by 4 each;
sh. w1 b2.+14 ; until w1 exceeds last word of fnc area;
jl. a24. ;
jl. a30. ; goto finish parent message;
\f
; jz.fgs 1988.11.21 algol/fortran runtime system page ...145...
c55=k-b10 ; parent message:
jl. w3 a29. ; goto parent message;
rl. w3 (b5.) ; return to check spec segment;
jl x3+c49 ;
d36=(:k-c20:)>9<12+k-b10; parent message:
; w1 points to pattern word and 3 text words, w2=zone, w3=return
a29: ds. w1 b15.+2 ; save registers
ds. w3 b15.+6 ;
dl w0 x1+2 ; copy pattern part
ds. w0 b3.+2 ; and 3 text words
dl w0 x1+6 ;
ds. w0 b3.+6 ;
dl w0 x2+h1+4 ; copy process name
ds. w0 b3.+10 ; from zone descriptor
dl w0 x2+h1+8 ;
ds. w0 b3.+14 ;
a30: ; finish parent message:
rl. w2 (b18.) ; w2 := addr parent process;
dl w0 x2+4 ;
ds. w0 b3.+18 ;
dl w0 x2+8 ; copy name of parent process
ds. w0 b3.+22 ;
al. w1 b3. ; w1:=message addr
al. w3 b3.+16 ; w3:=name addr
jd 1<11+16 ; w2:=send message
jd 1<11+18 ; wait answer
dl. w1 b15.+2 ; reestablish registers
rl. w2 b15.+4 ;
al. w3 b3. ; w3:=answer address;
jl. (b15.+6) ; return
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...146...
; label alarm
d52 = (:k-c20:)>9<12 + k-b10; define point
al. w0 b13. ; w0 := addr alarm text;
jl. w3 (b21.) ; goto general alarm;
b13: <:<10>label<0>:> ;
r. 252+b10>1-k>1+1 ; fill segment
<:extend area<3>:> ;
i.e. ;
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...147...
; rs, last page, list of rs entries
w.
c18 = (:k-c20+511:) > 9 ;
e56 = c18 ; no of rs segments;
c37: ;
d1 ; ** real
d2 ; ** integer
d3 -d0 ; reserve
d4 -d0 ; take expression
d5 -d0 ; goto point
d6 -d0 ; end reg expr
d7 -d0 ; end uv expr
d8 -d0 ; end addr expr
d9 ; init zones
d10-d0 ; release zones
d11-d0 ; goto computed
d12-d0 ; uv
d13-d0 ; last used
d14-d0 ; last of progr
d15-d0 ; first of progr
d16-d0 ; segm table base
d17-d0 ; index alarm
d18-d0 ; zone index
d19-d0 ; case alarm
d20-d0 ; syntax stop
d21-d0 ; general alarm
d22-d0 ; underflows
d23-d0 ; youngest zone
d24-d0 ; blocks read
d25-d0 ; mult alarm
d26-d0 ; in
d27-d0 ; out
d28-d0 ; reserve array
d29-d0 ; param alarm
d30-d0 ; saved sref, saved w3
d31-d0 ; end program conditions
\f
; jz.fgs 1983.05.27 algol/fortran runtime system page ...148...
d32 ; std error
d33 ; check
d34 ; inblock
d35 ; outblock
d36 ; parent message
d37-d0 ; overflows
d38-d0 ; console process addr
d39-d0 ; trap base
f13-d0 ;40: name of program document
f17-d0 ;41: parent process addr
f2 -d0 ;42: victim
d43 ; rcl long round
d44 ; ldla long mod
d45- d0 ; stop ftn
d46 ; lcr convert long to real
d47 ; rclf cut real
d48- d0 ; take expr ftn
d49- d0 ; dr1
d50- d0 ; dr2
d12-d0-2 ; 51, uv0
d52 ; label alarm
d53- d0 ; goto point ftn
d54-d0 ; field alarm
d55 ; lml long mul
d56 ; ldlf long div
\f
; jz.fgs 1985.09.13 algol/fortran runtime system page ...149...
f54 - d0 ; entry 57: rc8000
d109- d0 ; entry 58: errorbits
d67 - d0 ; entry 59: cattail for lookup/change entry (data file)
d68 - d0 ; entry 60: last of segment table
d69 - d0 ; entry 61: csr, cza
d70 - d0 ; entry 62: program size
d71 - d0 ; entry 63: no of own + common area halfs
d72 - d0 ; entry 64: name of virtual storage (data file)
d73 - d0 ; entry 65: load words from virtual storage
d74 - d0 ; entry 66: store words at virtual storage
d75 - d0 ; entry 67: check save (saving segments at store virt)
d77 - d0 ; entry 68: name of program
d78 - d0 ; entry 69: alarmcause
d79 - d0 ; entry 70: trapmode
d65 - d0 ; entry 71: progmode
d66 - d0 ; entry 72: blocksout
d80 - d0 ; entry 73: first of segments
d81 - d0 ; entry 74: max last used
d82 - d0 ; entry 75: limit last used
d83 - d0 ; entry 76: temp last used
d84 - d0 ; entry 77: current activity
d85 - d0 ; entry 78: no of activities
d86 - d0 ; entry 79: base of activity table
d87 - d0 ; entry 80: aref = sref for activity block
d88 - d0 ; entry 81: abs address(top of program)
d89 - d0 ; entry 82: (sref,segtable addr) for return activate/init act.
d90 - d0 ; entry 83: relative of return - - -
d91 - d0 ; entry 84: entry point check passivate (rs)
d92 - d0 ; entry 85: current activity no
d93 - d0 ; entry 86: current stack bottom
f14 - d0 ; entry 87: temp stack bottom
d94 - d0 ; entry 88: call passivate2
d95 - d0 ; entry 89: disable activity
d96 - d0 ; entry 90: enable activity
\f
; jz.fgs 1987.02.05 algol/fortran runtime system page ...150...
d97 - d0 ; entry 91: trapchain
d98 - d0 ; entry 92: alarm record(1:11)
f18 - d0 ; entry 93: end action
d99 - d0 ; entry 94: take value integer
d100- d0 ; entry 95: take value real
d101- d0 ; entry 96: take value long
d102- d0 ; entry 97: fp absent
d103- d0 ; entry 98: compiler release and release date (part of 105)
d105- d0 ; entry 99: saved parity count
d105- d0 ; entry 100: saved zone address
d106- d0 ; entry 101: latest answer
d107- d0 ; entry 102: no of resident rs segments and rs segments
d108- d0 ; entry 103: compiler version no (part of 105)
f21 - d0 ; entry 104: own process description address
g39 - d0 ; entry 105: program descriptor vector
d110- d0 ; entry 106: current partition index
d111- d0 ; entry 107: lower partition index
d112- d0 ; entry 108: higher partition index
d113- d0 ; entry 109: switch to other partition
d114- d0 ; entry 110: switch to lower partition
d115 -d0 ; entry 111: switch to higher partition
g43= (:k-c37:) > 1 ; no of standard rs entries
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...151...
; special rs entries:
d63 - d0 ; -6 continue
d62 - d0 ; -5 exit
0 ; -4 reserved for dummy boolean in repeat statements
(:d64-d0:) o. 1; -3 dummy integer used in while statements
0 ; -2 dummy zone proc (context zones)
d61 - d0 ; -1 init context (core code proc)
g40 = p4>9
e104 ; -18 rts release<12 + rts subrelease
e105 ; -16 rts release year<12 + rts release date
h. 2 , c14 ; -14 fp program call inf (2<12 + entry point)
w. g41 ; -12 fp program call inf (load length)
g43 ; -10 no of std rts entries
g34 ; - 8 no of rts own bytes
c19 ; - 6 no of rts entries
e56 ; - 4 no of rts segments
h. g40 , p4 - (:g40<9:); - 2 segment<12 + rel addr for program descriptor
w. e70 ; - 0 own base
c19 = k - c37 , e55 = c19
p0 = c14 , p1 = g34 , p2 = c19
i. ;
e. ;
m. jz.fgs 1989.02.01 algol/fortran runtime system
; tail for insertproc:
g0:g1: e56+1, 0,0,0,0 ; no of rts segments + 1, docname 0, 0, 0,
1<23 + p0 ; 1<23 + rel adddr of rts init
15<18+ p2, 0 ; kind<18 + size of rts table, 0
4<12 + p3 ; 4<12 + start external list
e56<12 + p1 ; no of rts segments < 12 + size of rts own area
d.
p. <:insertproc:>
l.
▶EOF◀