|
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: 13824 (0x3600)
Types: TextFile
Names: »kkmonret0«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »kkmonret0«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »kkmonret0«
(
message monchange release 7.0 to 7.1
clear temp mondef moncentral monprocs mondisc monfpaline monhost monfpasub,
montabinit monprocfnc1 monprocfnc2 mons1 mons2 moncatinit,
mdef mcentral mprocs mdisc mfpaline mhost mfpasub,
mtabinit mprocfnc1 mprocfnc2 ms1 ms2 mcatinit
contract entry.kkmon0filer mondef moncentral monprocs mondisc monfpaline,
monhost monfpasub montabinit monprocfnc1 monprocfnc2 mons1 mons2 moncatinit
skip 36.1
c=copy mess.no 1
mdef=set 1 disc3
mdef=edit mondef
skip 36.1
c=copy mess.no 1
mcentral=assign moncentral
skip 36.1
c=copy mess.no 1
mprocs=set 1 disc3
mprocs=edit monprocs
skip 36.1
c=copy mess.no 1
mdisc=assign mondisc
skip 36.1
c=copy mess.no 1
mfpaline=assign monfpaline
skip 36.1
c=copy mess.no 1
mhost=assign monhost
skip 36.1
c=copy mess.no 1
mfpasub=assign monfpasub
skip 36.1
c=copy mess.no 1
mtabinit=set 1 disc3
mtabinit=edit montabinit
skip 36.1
c=copy mess.no 1
mprocfnc1=set 1 disc3
mprocfnc1=edit monprocfnc1
skip 36.1
c=copy mess.no 1
mprocfnc2=set 1 disc3
mprocfnc2=edit monprocfnc2
skip 36.1
c=copy mess.no 1
ms1=set 1 disc3
ms1=edit mons1
skip 36.1
c=copy mess.no 1
ms2=set 1 disc3
ms2=edit mons2
skip 36.1
c=copy mess.no 1
mcatinit=assign moncatinit
head cpu
end)
;$
;************mondef************
l./j0=j0+(:a110/,d,
i/
j0=j0+(:a110<2+4:)*a112 ;KK top of bs-claims list
/,
f
;$
;************moncentral************
f
;$
;************monprocs************
l./b16:/,l./c29;118/,d,
i/
e59 ; 118 : lookup bs claims
/,
l./e39:/,l1,
i/
e59: ; lookup bs claims
/,
f
;$
;************mondisc************
f
;$
;************monfpaline************
f
;$
;************monhost************
f
;$
;************monfpasub************
f
;$
;************montabit************
l./a110*2+2/,d,
i/
al w1 x1+a110*4+4; bs_claims rel addr:=bs_claims rel addr +(max key+1)*4
/,l./a110*2+2/,d,
i/
al w1 x1+a110*4+4; bs_claims rel addr:=bs_claims rel addr +(max key+1)*4
/,
f
;$
;************monprocfnc1************
l./e80:/,l1,
i/
e83: ; bs-claims.cur.proc to sender area
/,
f
;$
;************monprocfnc2************
l./m25:/,l-3,l./h4:/,d,
i/
h4: 0, r.a109*2 ; pseudo main cat bs_claims
/,l./g0:/,l./a109/,l-1,d1,
i/
rs. w1 h4. ; save entries
r. a109*2 ;
/,l./g10:/,l./sow22/,
i/
ls w1 1 ; half word addr changed to integer addr
/,l./bzw0x1+2/,d,
i/
rl w0 x1+4 ; w0:=current claim(claim addr);
/,l./hsw0x1+2/,d,
i/
rs w0 x1+4 ; current claim(claim addr):=rest
/,l./m32:/,l./g8:/,l2,d,
i/
rl w0 x1 ; remainder:= claim(key).sender
/,l./hsw0/,d,
i/
rs w0 x1 ; claim(key).sender:= remainder
/,l./bz/,d,
i/
rl w0 x2 ; newclaim:= claim(key).child
/,l./hsw0/,d,
i/
rs w0 x2 ; claim(key).child:=newclaim
/,l./x1+1/,d1,
i/
al w1 x1+2 ; increase (sender claimaddr);
al w2 x2+2 ; increase (child claimaddr);
/,l./m35:/,l./bzw1x1+1/,d,
i/
rl w1 x1+2 ; w1:= slice claim (key 0)
/,l./m39:/,l./wmw0/,l1,d2,
l./alw3/,d1,
i/
al w1 x3+1 ;
/,l./rs.w0/,d,
i/
; w3=max entry claims
; w0=max slice claims
ds. w1 h3. ;
/,l./g10:/,d./x1+f60/,
i/
jl. g13. ; test more internals
g10:
rl w2 x2 ; proc:=nametable(entry)
ld w0 -100 ; clear w3-w0
sn. w2 (d2.) ; claim:= if
dl. w0 h3. ; proc= sender then maxclaim else 0
rl. w1 d4. ; w1 := curdoc
wa w2 x1+f60 ; claim addr:=proc +claimrel.curdoc
/,l./g11:/,l-1,d./alw2x2+2/,
i/
al w1 x2 ;
g11: ; init next key:
; w3 = entry claim
; w0 = slice claim
rs w0 x2+2 ; init slice claim from slice
sl w2 x1+a109*4 ; if key >=min aux key then
rs w3 x2 ; init entry claim
al w2 x2+4 ; increase(key)
sh w2 x1+a110*4 ; if key <= max cat key then
jl. g11. ; goto init next key
g12: ; test more internal
rl. w2 h4. ; load nametable entry
al w2 x2+2 ; increase(entry)
g13: rs. w2 h4. ; store next entry
/,l./g15:/,l1,d./a109*2/,
i/
al w1 x2 ;
g16: ; init maincat key:
rs w3 x2 ; init entry claim(key)
al w2 x2+4 ; increase(key)
sh w2 x1+a109*4-1; if key < min aux key then
/,l./h2:/,l1,i/
h3: 0 ; slice claim
h4: 0 ; name table entry
/,l./m50:/,l./e. /,l./;find/,
i/
; find process and move bs-claims from process to sender area
; call : m51
b. g10 w.
m51: jl. w3 e47. ; find best process
b6 ; first internal in name table
b7 ; last in name table
jl. j3. ; process non exist: result 3
am. (d4.) ;
wa w2 f60 ; w2:= bs-claim address in curr proc
al w1 x2 ;
al w0 a110*4+4; bs-claims length
jl. w3 e83. ; move
jl. w2 e60. ; w2:=addr(w1.sender);
al w1 x2+a110*4 ; w1:=last key;
g0: rl w0 x2+2 ; w0:=slice;
am. (d4.) ;
wm w0 f64 ; w0:=segments;
rs w0 x2+2 ; :=segment;
al w2 x2+4 ; w2:=next key;
sh w2 x1 ; if w2<=last key then
jl. g0. ; goto next key;
jl. j0. ; goto result ok
e.
/,l./m91:/,l./h0:/,d,
i/
h0: (:a110+1:)<1 ; number of keys * 2 (=max cat key +1 *2)
/,l./m50=m50-n50/,
r/, /, m51 = m51-n50/,
l./p57:/,l./;createauxentry/,i/
; lookup bs claims
; call:
; w1.sender : claim list address
; w2.sender : document name address
; w3.sender : name address
; return:
; w0.sender : result = 0 : bs claims looked up
; result = 2 : document not found
; result = 3 : process does not exist
; result = 6 : name format illegal
p59: ; lookup bs claims
m104 ; move docname.sender to docname.work
m84 ; size.work:=0
m36,t22 ; search chain, state = allowed for normal use
m65 ; move catbase,name to work;
m51 ; find best internal process and move bs claims
/,l./n49:/,l./p57./,
r/r7.,r7./r7.,p59./,
f
;$
;************mons1************
l./d35:/,
l./i12./,l-1,d1,
l./i6:/,l-4,d./jl.i6./,i/
al. w2 e20. ; w2:=addr(device);
jl. w1 d84. ; lookup bs claims
rs. w1 i0. ; := base of bs claims store;
al. w2 e51. ;
i6: dl w0 x1+2 ; w0:=segments; w3:=entries;
ds w0 x2+2 ; :=entries,segments;
al w2 x2+4 ;
al w1 x1+4 ; w1:=next key;
am. (i0.) ;
sh w1 a110*4 ; if key<= max key then
jl. i6. ; goto next key;
/,l./i9:/,d,
l./i2:/,i/
i0: e86 ; addr of bs claims store
/,l./d78:/,l./e.z./,l1,i/
; procedure lookup bs claims(device,process);
; comment the bs-claims for the process is looked up on the given device;
; call: return:
;w0 - result
;w1 return addr. of bs-claims
;w2 device unchanged
;w3 process -
b. i2 w.
d84: al. w3 i2. ; entry0: w3:=addr('s');
d85: rs. w1 i0. ; entry2: store(w1);
rl. w1 i1. ; w1:= addr(bs claim store);
jd 1<11+118 ; lookup bs-claims
jl. (i0.) ; return;
i0: 0 ;
i1: e86 ; addr of bs claims
i2: <:s:>,0,0,0 ; current process
e.
/,l./d77=/,l-1,i/
jl. d70. ;
d70=k-2
jl. d71. ;
d71=k-2
/,l./d79=/,l1,i/
jl. d84. ;
d84=k-2
jl. d85. ;
/,f
;$
;************mons2************
l./g76=k;max:/,l./jl.g35./,l1,i/
g35=k-2
/,l./d16=k-2/,l-1,i/
jl. g2. ;
g2=k-2
jl. d2. ;
d2=k-2
jl. d19. ;
d19=k-2
jl. d20. ;
d20=k-2
jl. d21. ;
d21=k-2
jl. d23. ;
d23=k-2
/,l./b./,i/
jl. d70. ;
d70=k-2
jl. d71. ;
d71=k-2
jl. d84. ;
d84=k-2
jl. d85. ;
d85=k-2
jl. g9. ;
g9=k-2
/,l./jl.g16./,l1,
i/
g16=k-2
/,l./d76:/,l./e20./,l1,i/
rs. w3 i13. ; :=addr(curr. process);
/,l./jl.g9./,r/+2046/ /,r/jl./jl. /,l-1,d,l-2,r/;/; if error then/,
l./a88-2/,d./rsw0x1+2/,i/
rl. w2 i4. ; w2:=addr(curr device);
rl. w3 i13. ; w3:= addr(curr process);
jl. w1 d85. ; lookup bs claims(device,process);
rl. w2 i3. ; addr(perm claim.curr process);
dl w0 x1+14 ; w0:=segments; w3:=entries;
ds w0 x2+2 ;
/,l./i11:/,l1,i/
i12: 0 ; slice length;
i13: 0 ; addr of current process;
/,l./;char/,i/
; s command lookup bs claims
; name: lookbs
; call: lookbs <process> !
; lookbs <process><sp><device><sp>...<sp><device>
; print the bs claims for the given process and device,
; in the first case it is printed for all devices
b. i10,j11
w.
g101:jl. w3 d2. ; next param
se w0 1 ; if type<>name then
jl. g2. ; goto end line;
rs. w0 i0. ; i0:=1;
rl. w3 i1. ; w3:=addr(name);
al. w2 i2. ;
dl w1 x3+2 ;
ds w1 x2+2 ;
dl w1 x3+6 ;
ds w1 x2+6 ; move name;
rl w2 92 ; print all devices:
jl. j3. ; w2:=addr(first in device list);
j1: rl. w3 i0. ;
se w3 1 ; if not first time then
jl. j4. ; goto next device else
rs. w1 i0. ; i1:=addr(bs claim store);
al. w1 i2. ; w1:=addr(process);
jl. w3 d19. ; init write;
jl. w3 d21. ; write(process name);
jl. w3 j9. ; print space;
al. w1 i4. ;
jl. w3 d21. ; write(head);
al w0 10 ;
jl. w3 d20. ; print new line;
jl. w3 d23. ; outline;
jl. w3 d42. ; save(work.buff);
jl. g2. ; return-2 else
j4: rl. w1 i1. ; w1:=addr(device);
jl. w3 d19. ; init write;
jl. w3 d21. ; write(device name);
jl. w3 j9. ; print fill;
rl. w2 i0. ; w2:=addr(bs claim store);
j2: rl w1 x2+2 ; w1:=next segment-claim;
al w0 6 ;
jl. w3 d71. ; write(segment-claim);
al w0 44 ;
jl. w3 d20. ; write(<:,:>);
al w0 4 ;
rl w1 x2 ; w1:=next entry claim;
jl. w3 d71. ; write(entry claim);
al w2 x2+4 ; w2:=addr(next claim);
am. (i0.) ;
sh w2 a110*4+2 ; if claim addr<= last claim then
jl. j2. ; goto j2;
al w0 10 ;
jl. w3 d20. ; print new line;
jl. w3 d23. ; outline;
jl. w3 d42. ; save(work.buff);
jl. g2. ; return-2 else
rl. w2 i3. ; w2:=param type or next addr in device list;
j5: al w2 x2+2 ; next device;
sl w2 101 ; if addr in device list then
jl. j6. ; goto test next device;
j3: jl. w3 d2. ; else next param;
rs. w0 i3. ; set param type;
sn w0 1 ; if type=name then
jl. j0. ; goto next device else
se w0 0 ; else if type<>empty then
jl. g2. ; goto end line else
sh w2 100 ; if param list then
jl. g35. ; goto next command else
j6: rs. w2 i3. ; :=next addr in device list
sn w2 (96) ; if w2=last in name table then
jl. g35. ; goto next command else
rl w3 x2 ; w3:=addr(next device table head);
rl w0 x3-18 ; w0:=first word in name;
sn w0 0 ; if device=idle then
jl. j5. ; goto next device
rl. w2 i1. ; w2:=addr(name store);
dl w1 x3-16 ;
ds w1 x2+2 ;
dl w1 x3-12 ;
ds w1 x2+6 ; move device name;
j0: al. w3 i2. ; w3:=addr(process);
rl. w2 i1. ; w2:=addr(device name);
jl. w1 d85. ; lookupbsclaims(device,process);
sn w0 0 ; if result=ok then
jl. j1. ; goto print else
sn w0 2 ; if result=2 then
jl. g16. ; goto write(device not exist);
sn w0 3 ; if result=3 then
jl. g9. ; goto write(process not exist);
jl. g2. ; else goto end line;
j9: al w1 x1-11 ; procedure write 12-w1 space
ac w1 x1 ;
jl. d70. ; return via d70
i0: 0 ; addr(bs claim store);
i1: e20 ; addr(name parameter);
i2: 0,r.4 ; process name;
i3: 0 ; param type or next addr in device list
i4: <: temp perm-key1 login user<0>:>; head;
e.
e86: 0,r.(:a110+1:)*2 ; bs claim store;
/,l./g81-g45/,i/
<:lookbs:> ,1<17+g101-g45
/,f
;$
************moncatinit************
f
;$
head 1
▶EOF◀