|
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: 13056 (0x3300)
Types: TextFile
Names: »getclaimtx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »getclaimtx «
mode list.yes
(
if listing.yes
(
listgetcl=set 50
if ok.no
end
o listgetcl
(getclaim=slang xref.yes list.yes
getclaim)
if ok.no
c=message ok.no
o c
convert listgetcl lp
)
if listing.no
(getclaim=slang
getclaim)
mode listing.no
)
\f
; fgs 1988.04.25 algol 8, get claims page ...1...
b. ; block fpnames
d.
p. <:fpnames:>
l.
b. g1, i6 ; block for insertproc
w.
i4 = 0 ; segment count := 0;
i5 = 0 ; own byte count := 0;
s. g4 ; slang segment
w.
b. c3, j110 ; block for segment
w.
g0 = 0 ; no of externals := 0;
k = 1000 ; k assignment to catch missing relatives
h.
c1 : c2 , c3 ; rel last point, tel last abs word
j4 : g0 + 4, 0 ; rs entry 4, take expression
j6 : g0 + 6, 0 ; rs entry 6, end register expression
j13: g0 + 13, 0 ; rs entry 13, last used
j17: g0 + 17, 0 ; rs entry 17, index alarm
j21: g0 + 21, 0 ; rs entry 21, general alarm
j30: g0 + 30, 0 ; rs entry 30, saved sref, w3
j94: g0 + 94, 0 ; rs entry 94, take value integer
j104: g0 + 104, 0 ; rs entry104, own process description address
c3 = k-2-c1 ; rel last abs word
c2 = k-2-c1 ; rel last point
w.
i2 = k-c1 ; start external list
0 ; no of globals, no of externals
0 ; no of bytes to copy to own core
s3 ; date
s4 ; time
\f
; fgs 1988.04.25 algol 8, get claims page ...2...
b. a40, b60, d20 ; block for local names in copyarea
w.
; constants :
d0: <:perm key:> ; alarm text
; variables :
b1: 0 ; first device
b10: 0, r.7 ; saved w1
;+2: ; - w2
;+4: ; - w3
;+6: ; slicelength
;+8: ; max slices
;10: ; min slices
;12: ; device.key0 claims
b54: 0, r.10 ; filedescriptor tail
; fgs 1988.04.26 file processor connect output, page ...7c...
; segment 1
i0 = k-c1 ; entry get claim:
rl. w2 (j13.) ; get sref;
ds. w3 (j30.) ; save sref, w3;
zl w3 x2+10 ; dope := dope rel +
wa w3 x2+12 ; base word addr;
al w1 2 ; index := 4;
as w1 2 ;
sh w1 (x3-2) ;
sh w1 (x3 ) ;
jl. w3 (j17.) ;
al w1 1 ; index := 1;
as w1 2 ;
sh w1 (x3-2) ;
sh w1 (x3 ) ;
jl. w3 (j17.) ;
wa w1 (x2+12) ;
rs w1 x2+10 ; second formal1 := addr la (1);
al w3 x1 ;
dl w1 x3 ; move
ds. w1 b54.+4 ; la
dl w1 x3+4 ; to
ds. w1 b54.+8 ; filedescriptor.docname
dl w1 x2+8 ; take first formal;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref. w3;
rl w1 x1 ; take value i;
al. w3 d0. ;
sl w1 0 ; if i < 0
sl w1 4 ; or i > 3 then
jl. w3 (j21.) ; general alarm (<:perm key:>, i);
al w0 x1 ; w0 := i; <*permkey*>
jl. w1 a8. ; getclaims;
rl w3 x2+10 ;
dl. w2 b54.+4 ; move
ds w2 x3 ; filedescriptor.docname
dl. w2 b54.+8 ; to
ds w2 x3+4 ; ia;
rl w1 0 ; result := w0;
jl. w3 (j6.) ; goto end reg expression;
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7d...
; segment 1
; procedure get claims (key, filedescriptor);
;
; call: return:
;
; w0 key claim
; w1 link link
; w2 - unchanged
; w3 - unchanged
;
; filedescriptor.docname entry.docname or docname of disc
; 0, ..., 3 with claims
;
; The procedure finds the disc with the largest claims for the
; given key and returns the claims in w0 and the docname of the
; disc in filedescriptor.docname.
; If docname given in filedescriptor.docname is 0, all discs are
; searched for the one with the greatest claims of that particular
; permkey. The search goes on backwards from last disc to first disc
; or drum.
; If, however, the docname given is a document name for a disc
; included in the bs system, the procedure returns the claims
; for the given key for that disc.
;
;
a8: ds. w3 b10.+4 ; get claims: (fp exception routine dump area used)
rs. w1 b10.+0 ; save (w2, w3); save return;
zl w2 64 ;
sl w2 9 ; if monitor release > 8 then
am 1 ; key := key * 4 else
ls w0 1 ; key := key * 2 ;
hs. w0 b2. ;
al w0 -2 ;
sh w2 8 ; if monitor <= 8 then
hs. w0 b12. ; decr := -2;
rl w0 92 ; w0 := first drum;
rl w1 96 ; last device :=
al w1 x1-2 ; top discs - 2;
rs. w0 b1. ; first device := first drum;
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7e...
; segment 1
rl. w2 b54.+2 ; w2 := first word of docname;
sh w2 3 ; if docname (1) <> (0, 1, 2, 3) then
jl. a12. ; begin <*docname specified*>
al. w3 b54.+2 ;
jd 1<11 + 4 ; w0 := proc descr addr (docname);
sn w0 0 ; if process exists then
jl. a12. ; begin
am (0) ; w0 :=
rl w0 24 ; chaintable addr (docname);
a25: rl w2 x1 ; loop: w2 := device.chaintable address;
sn w2 (0) ; if device.chaintable address <>
jl. a39. ; doc .chaintable address then
; begin
al w1 x1-2 ; device := device -2;
jl. a25. ; goto loop;
; end;
a39: rs. w1 b1. ; first device := last device := device found;
; end process exists;
; end docname specified;
a12: al w0 0 ;
rs. w0 b10.+8 ; max slices := 0;
a9: rl w2 x1 ; next device:
rl. w3 (j104.) ; w2 := device.chaintable address;
wa w3 x2-36 ; w3 := device.key zero claims;
rs. w3 b10.+12 ; save device.key zero claims;
al w0 2047 ; min slices :=
jl. w2 a3. ; convert to segments (
rs. w0 b10.+10 ; + infinity);
b2 = k + 1 ; key * (if mon rel < 9 then 2 else 4);
al w3 x3+0 ; w3 := device.slice claims.key
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7f...
; segment 1
a10: zl w0 64 ; next key:
sl w0 9 ; if monitor release <= 8 then
jl. a36. ; begin <*halfwords*>
rl w0 6 ; device key :=
ws. w0 b10.+12 ; (device.key claims -
ls w0 -1 ; device.key0 claims) > 1;
zl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
zl w0 x3+1 ; w0 := slice claims;
jl. a37. ; end else
a36: rl w0 6 ; begin
ws. w0 b10.+12 ; device key :=
ls w0 -2 ; (device key claims - device.key0 claims) > 2;
rl w2 x3 ; w2 := entry claims;
sh w0 1 ; if device key <= 2 then
al w2 1 ; w2 := 1;
rl w0 x3+2 ; w0 := slice claims;
a37: ; end;
sh w2 0 ; if entry claim = 0 then
al w0 0 ; slice claim := 0;
jl. w2 a3. ; convert to segments (slice claim);
sh. w0 (b10.+10) ; if slice claim <= min slices then
rs. w0 b10.+10 ; min slices := slice claim;
b12=k+1 ; decr:
a29: al w3 x3-4 ; decrease sliceclaim key address by decr;
sl. w3 (b10.+12) ;
jl. a10. ;
; if claim key addr >= claim key 0 address then
; goto next key;
rl w2 x1 ; device := chaintable;
rl. w0 b10.+10 ;
sl. w0 (b10.+8) ; if min slices >= max slices then
jl. a11. ;
jl. a38. ; begin
a11: rs. w0 b10.+8 ; max slices := min slices;
rs. w2 b10.+14 ; best device := device;
rl w0 x2-8 ; slice length := slice length (device);
rs. w0 b10.+6 ; end;
a38: al w1 x1-2 ; device := device - 2;
sl. w1 (b1.) ; if device <> first device then
jl. a9. ; goto next device;
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7g...
; segment 1
rl. w2 b10.+14 ; get best device;
dl w0 x2-16 ; move
ds. w0 b54.+4 ; chaintable.docname
dl w0 x2-12 ; to
ds. w0 b54.+8 ; filedescriptor.docname;
rl. w0 b10.+8 ; w0 := max slices;
dl. w3 b10.+4 ; restore (w2, w3);
jl. (b10.) ; return;
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7h...
; segment 1
; procedure convert to segments (slices);
;
; call : return :
;
; w0 : slices slices * slicelength
; w1 : name table entry unchanged
; w2 : link address chaintable
; w3 : device.slice claims.key unchanged
b. b3 ; begin block
w.
a3: rs. w2 b2. ; save return;
rl w2 x1 ; w2 := chain table entry;
rs. w3 b3. ; save w3;
wm w0 x2-8 ; slices := slices * slicelength;
rl. w3 b3. ; restore w3;
jl. (b2.) ; return;
b2: 0 ; saved return
b3: 0 ; saved w3;
i.
e. ; end block
\f
; fgs 1988.04.26 fileprocessor connect output, page ...7i...
; segment 1
; procedure convert to slices (w3, slicelength);
;
; call : return :
;
; w0 : - unchanged
; w1 : - destroyed
; w2 : link destroyed
; w3 : value (value - sign)//slicelength + sign
; b10.+6 : slicelength slicelength
;
a4: rs. w2 b10.+0 ; entry: save return;
sh w3 0 ; i :=
am +2 ; sign (value);
al w1 -1 ;
sn w3 0 ;
al w1 0 ;
wa w3 2 ; extend sign (w3);
el w2 6 ; value := ((value + i)//
el w2 4 ; slicelength - i) *
wd. w3 b10.+6 ; slicelength ;
ws w3 2 ;
jl. (b10.) ; return;
\f
; fgs 1988.04.25 algol 8, get claims page ...3...
i.
e. ; end block for local names in get claims
c0 = k-c1
c. c0 - 506
m. code on segment 1 too long
z.
c. 502 - c0
0, r. (:504 - c0:) > 1 ; fill segment with zeroes
z.
<:get claim <0>:> ; alarm text
m. segment 1
i.
e. ; end block segment 1
i4 = i4 + 1 ; increase segment count
i.
e. ; end block for segment
\f
; fgs 1988.04.25 algol 8, get claims page ...4...
; tails for insertproc
h.
g0:g1: ; first and last tail
0 , i4 ; size
0 , r.8 ; name
1<11+0 , i0 ; entry point
w. 3<18+27<12+13<6 ; integer proc (value integer, long array)
0 ;
h. 4 , i2 ; kind<12 + start external list
i4 , i5 ; code segments<12 + own bytes
m. fgs 1988.04.26 get claims
d.
p. <:insertproc:>
l.
i.
e. ; end slang segment
end
▶EOF◀