|
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: 24576 (0x6000)
Types: TextFile
Names: »glrafrtst63 «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »glrafrtst63 «
mode list.yes
algftnrtst7=edit algftnrtst6
; overflytning af extend area og parent message fra
; power fnc segmentet til et nyt segment
;
; overflytning af label alarm (fortran) fra
; algolcheck segmentet til det samme nye segment
;
; extend area sender parent message hvis change entry gir
; result 6 og (fp er ikke i processen eller fp mode.bswait er true)
;
; zone bufre og share descriptors i high end partition undtagen for
; fortran, activity i ikke-disablet kode og zoner hvis length < 0
;
; fyns telefon : break 0 i pager fordi program release kaldes overflødigt
; for et segment i high end partition altid
;
; i rc9000-10 giver underflow både overflow og underflow, så ix-index alarm
; ved både overflow og underflow gælder kun for rc8000
;
; i magtape check gives op hvis position operation mislykkes mere end 5 gange
; (position error), og det sikres, at blockcount aldrig kan blive negativ
;
; i magtape check sikres at setposition (z, -f, b), som jo bliver til en unload
; operation, ikke fører til reposition til -f, b
;
l./page ...1/, r/88.03.01/88.04.21/
l./page 125-136/, r/136/134/, r/, parent message//
l./page 137-142/, r/137/135/, r/142/141/, r/, extend area and parent message//
l2, i/
; page 142-147 extend area segment. extend area and parent message, label alarm
; <:extend area:>
/, p-3
l./page 143-147/, r/143-147/148-151/
l./page ...2/, r/88.03.01/88.05.19/
l./s. c82/, r/c82/c99/
l./page ...3/, r/88.03.01/88.04.21/
l./; j15:/, l1, i/
; j17: 15 extend area , j18= -1<22 + j17<1
/, p-1
l./page ...10/, r/87.07.03/88.10.07/
l./c5:/, l./so w3 3/, d1, i/
f54=k+1; rc8000 ;
se w3 x3+0 ; if rc8000 and
so w0 3 ; overflow and underflow then
jl. a1. ; begin <*ix index alarm*>
/, p-4
l./f54=k+1/, l-1, d3, i/
jl. a2. ; goto trap alarm;
a1: ; end <*ix index alarm*>;
/, p-1
l./a2:/, r/c9. /c83./
l./page ...18a/, d./a10 = k + 2/, i#
\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;
#, p1
l./page ...20/, r/87.06.22/88.05.19/
l./c48:/, l./jl. c9./, r/ /c83: /
l./page ...27/, r/87.02.28/88.05.19/
l./b. a7/, r/a7/a9/
l./wa. w1 d13./, r/ /a9: /
l./jl. c11./, l-1, r/+ 1022/+ 1022 then/
l./jl. c11./, r/c11/a8 /, r/then goto/ goto low partition or/
l./; program release/, i#
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...
#, p1
l./page ...31/, r/87.05.13/88.05.20/
l./a13:/, i/
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;
/, p-4
l./a13:/, r/a13:/ /
l./page ...38/, r/86.04.02/88.12.08/
l./f29:/, d
l./page ...39/, r/83.05.27/88.05.18/
l./b. b1/, r/b1/b4/
l./la. w3 f4./, r/f4/b4/
l./i. ; id list/, i/
b4: 511 ; mask for extract 9
/, p1
l./page ...41/, r/87.02.05/88.05.16/
l./; release program segments/, i#
\f
; fgs 1988.05.18 algol/fortran runtime system page ...41a...
#, p1
l./a0:/, l1, d2, i/
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;
/, p1
l./page ...41a/, r/41a/41b/
l./page ...43a/, d./e. ; end block emulate ix instruction/, i#
\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
#, p1
l./page ...44/, r/87.07.03/88.05.18/
l./b4:/, d
l./page ...46/, r/87.06.02/88.06.15/
l./d94:/, r/d94:/ /, i/
d94=k+1 ; ****** just to avoid the rts address 4096 (pass9) ***
/, p1
l./page ...48/, r/83.05.27/88.05.18/
l./d98:/, r/d98:/b4: <:non zero offset in virtual program file<0>:>
d98:/, p-1
l./page ...64/, r/85.09.13/88.05.19/
l./rl. w0 b8./, d, i/
am h53 ; initialize in and out:
se w3 x3-18 ; if h53 <> 18 then
rl. w0 b8. ; stderror entry := stderror entry - modif;
/, p1
l./page ...68/, r/87.07.05/88.10.05/
l./xs 1/, d3, i/
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*>;
/, p-5
l./page ...70/, r/87.07.04/88.10.05/
l./al w1 x2+c62-c7/, d1, i/
am +2000;
al w1 x2+c62-c7-2000;
am +2000;
rs w1 x2+d62-c7-2000;
/, p1
l./al w1 x2+d112-c7/, i#
\f
; fgs 1988.05.18 algol/fortran runtime system page ...70a...
#, p1
l./rs w0 x2+c76 -c7/, d2, i/
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;
/, p1
l./jl w3 x2+c78 -c7/, i/
al w3 x2+d13- c7 ; rts .addr top program :=
rs w3 x2+d88- c7 ; addr (rts. last used);
/, p1
l./page ...76/, r/83.05.27/88.05.18/
l./a10:/, l2, r/current/temp/
l./la w2 4/, r/4/6/
l./page ...90/, r/83.06.06/88.05.19/
l./b. a8/, r/b12, /b115,/
l./b11=/, i/
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
/, p-1
l./shares in w0/, r/w0/h0/
l./page ...91/, r/83.05.27/88.12.12/
l./rl w2 x2+h0+2+h5/, d1, i/
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;
/, p1
l./a4:/, d./a5:/, i#
\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*>;
#, p1
l./page ...93/, r/87.08.17/88.05.19/
l./a7:/, l./; rl. w0 b12./, d1, i/
am h53 ;
sn w3 x3-18 ; if h53 = 18 then
rl. w0 b12. ; core (last) :=
rs w0 x3 ; call sref in zone;
/, p-4
l./page ...98/, r/83.08.16/88.12.08/
l./b13:/, d
l./page ...100/, r/83.05.27/88.12.08/
l./d52=/, l-1, d3
l./page ...101/, r/83.05.27/88.12.08/
l./b. a9,c3,f8/, r/f8/f9/
l./page ...102/, r/83.05.27/88.12.08/
l./f8:/, l1, i/
0 ; double constant, word 1 : 0
f9: 0 ; - - , - 2 : 0
/, p-2
l./ld w1 -65/, d, i/
dl. w1 f9. ;
/, p-1
l./page ...103/, r/83.05.27/88.12.08/
l./ld w3 -65/, d, i/
dl. w3 f9. ;
/, p-1
l./page ...104/, r/83.05.27/88.12.08/
l./ld w3 -65/, d, i/
dl. w3 f9. ;
/, p-1
l./page ...112/, r/88.03.01/88.12.13/
l./b14/, r/j16/j18/, r/power fnc/extend area/
l./page ...120/, r/88.03.01/88.04.21/
l./rl w1 x2+h0+4/, d2
l./rl. w3 (b14.) ; goto power fnc segment,/, r/power fnc/extend area/
l./c42=/, r/b10 /b10/, r/power func/extend area/
l1, r/b5.) /b5.)/
l./z./, d
l , r/3 /3/
l1, r/a7. /a7./
l1, r/b3.) /b3.)/
l1, r/2 /2/
l1, r/w0 0 /w0 0/
l1, r/a17. /a17./
l1, r/b10 /b10/
l1, r/c43 /c43/
l1, r/c40 /c40/
l1, r/c22 /c22/
l1, r/c23 /c23/
l./page ...125/, r/88.03.01/88.04.21/
l./b18:/, r/j16/j18/, r/power fnc/extend area/
l./b2:/, r/b2:/b1 : 0 ; spool count
b2 :/, r/ 0/ 0 /, p-1
l./b15:/, d
l./page ...130/, r/83.05.27/88.12.08/
l./a12:/, l2, i/
al w1 0 ; spool count :=
rs. w1 b1. ; 0;
/, p-3
l./page ...132/, r/83.05.27/89.01.02/
l./sn w3 (x1+6)/, i/
sh w3 -1 ; if w3 <= -1 then
dl w0 x1+8 ; w3w0 := file and block in answer;
/, p-2
l./a18:/, d, i/
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;
/, p-5
l./z.;end system 3;/, r/;/ ;/
l./page ...134/, r/87.02.05/88.04.21/
l./rs w0 x2+h1+14/, i/
sh w0 0 ; if blockcount <= 0 then
al w0 0 ; blockcount := 0;
/, p-2
l./page ...135/, r/88.03.01/88.04.21/
l./rl. w3 (b18.) ; goto power fnc segment,/, r/power fnc/extend area/
l./page ...137/, r/88.03.01/88.04.21/, r/137/136/
l./; calculation of power/, d./b15:/, i/
; 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 ;
/, p-20
l./...138/, r/138/137/
l./...139/, r/139/138/
l./...140/, r/140/139/
l./...141/, r/141/140/
l./...142/, r/142/141/
l./page ...142a/, d./page ...142b/, d./jl. (b15.+6) ;/
l./...143/, s 1, d./page ...142/, d./end **/
l0, i#
\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
#, p-3
l./...142a/, r/142a/143/, r/88.03.01/88.04.21/
l./c47/, l1, d, i/
ds. w3 (b8.) ; save sref, w3;
rl w1 x2+h0+4 ; w1 :=
zl w1 x1+6 ; zone.share.operation;
/, p-3
l./rs. w0 b1. ; save proc descr addr in b1;/, d, i/
rs. w0 b4. ; save area proc addr in b4.;
/
l./; the area/, r/the/ the/
l./am. (b1.)/, d, i/
am. (b4.) ;
/, p-1
l./al w3 x2+h1+2/, i#
\f
; jz.fgs 1988.04.21 algol/fortran runtime system page ...144...
#
l./al w3 x2+h1+2/, r/ al/a14: al/
l./al. w1 b3./, r/w1 :=/ w1 :=/
l./se w0 0/, d./a27:/, d, i/
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;
/, p-16
l./page ...142b/, r/88.03.01/88.11.21/, r/142b/145/
;l./a29:/, d, i/
;
;a29: ds. w3 (b8.) ; save sref, w3;
; ds. w1 b15.+2 ; save registers;
;/, p-2
l./rl. w2 (b18.) ; w2:=addr of parent process/, d, i/
a30: ; finish parent message:
rl. w2 (b18.) ; w2 := addr parent process;
/
l./r. 252/, i#
\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>:> ;
#
l./power func.<3>/, r/power func.<3>/extend area<3>/
l./...143/, r/143/147/
l./...144/, r/144/148/
l./...145/, r/145/149/
l./...146/, r/146/150/
l./...147/, r/147/151/, r/88.03.01/88.04.21/
l./m.jz/, r/88.04.15/89.01.19/
f
end
▶EOF◀