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