|
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: »kkmonret2«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦f874557f7⟧ »kkmon2filer«
└─⟦this⟧
(
message monchange release 7.0 to 7.12
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.kkmon2filer 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=set 1 disc3
mcentral=edit 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=set 1 disc3
mhost=edit monhost
skip 36.1
c=copy mess.no 1
mfpasub=set 1 disc3
mfpasub=edit 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=assign mons2
skip 36.1
c=copy mess.no 1
mcatinit=set 1 disc3
mcatinit=edit moncatinit
head cpu
end)
$def
;********************
l./a111=3/,r/3/2/,
l./; format of area process/,
l 1,d./format of pseudo process/,d./a50=/,i!
a401=(:a3+23:)/24 ; number of words in user bittable
a403=a401*2 ; number of bytes in bit table
b.j0, j0=0
a349= j0 ; <start of process>
a250= j0 , j0=j0+2 ; <driver proc descr address>
a402= j0 , j0=j0+a403 ; <user bit table>
a48 = j0 , j0=j0+2 ; <lower limit>
a49 = j0 , j0=j0+2 ; <upper limit>
a10 = 0 ; <kind>
a11 = 2 ; <name>
a50 = 10, a51 = 11 ; <process descr addr of bs device>
a52 = 12 ; <reserved>
a53 = 14 ;******** <users>
a60 = 16 ; <first slice>
a61 = 18 ; <number of segments>
a62 = 20 ; <document name>
a411= 28 ; number of times written
a412= 30 ; number of times read
a349=a349-j0, a250=a250-j0 , a402=a402-j0, a48=a48-j0, a49=a49-j0
e.
a2 = a412+2-a349 ; size of area process
; format of pseudo process
a48 = -4 ; <lower limit>
a49 = -2 ; <upper limit>
a10 = 0 ; <kind>
a11 = 2 ; <name>
a50 = 10 ; <main process>
!,
l./; format of device description/,
l./a250=j0/,l1,i/
a410=j0, j0=j0+a403 ; <user bit table>
/,
l./a250=a250-j0/,r/a250=a250-j0/a250=a250-j0, a410=a410-j0/,
l./; format of peripheral/,l 1,i/
; a402 start of user table
/,
f
$central
;********************
l./d123:/,d./jlx3/,i/
d123:
ba w2 x1+a14 ; w2:=addr of rel. halfword;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
sz w0 (x1+a14) ; if userbit.curr.intproc is on then
bs w0 x1+a14+1 ; remove userbit.curr.intproc;
hs w0 x2+a402 ; return userbits;
bs w2 x1+a14 ; reset w2 to addr(extproc)
d124:rl w0 x2+a52 ; w0:=reserver.proc;
sn w0 (x1+a14) ; if intproc is reserver then
al w0 0 ; remove intproc as reserver
rs w0 x2+a52 ; clear reserver;
jl x3 ; return;
/,l./d125:/,d./jlx3/,i/
d125:
rl w0 x1+a14 ; w0:=idbit.intproc;
rs w0 x2+a52 ; extproc.reserver:=idbit.intproc;
d126:
ba w2 x1+a14 ;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
lo w0 x1+a14 ; set curr.intproc as user of extproc;
hs w0 x2+a402 ;
bs w2 x1+a14 ; reset w2;
jl x3 ; return
/,l./d102:/,d./jlx3 /,i/
d102: ;
ba w2 x1+a14 ;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
bs w2 x1+a14 ; reset w2;
sz w0 (x1+a14) ; if curr.intproc is user then
jl x3+2 ; return to link+2: i.e. user
jl x3 ; return to link: not user
/,l./g17:/,l./procedurecheckuser/,
l./b.i24/,d./jlx3+0/,i/
b. i5 w.
g14: ; check user;
sn w1 (b1) ; if curr.intproc=sender then
jl x3 ; return (sender=driverproc)
ds w3 i3 ; save w2 w3;
rl w2 b19 ; w2:= extproc;
jl w3 d113 ; check reserver;
jl g6 ; return 0 other reservers goto result 2 else
jl i0 ; return 2 intproc is reserver goto nornal return else
; return 4 no reservers
jl w3 d102 ; check user
jl g6 ; if not user then result 2 else
i0:
rl w2 i2 ;
jl (i3) ; normal return;
i2: 0 ; save w2;
i3: 0 ; save w3;
/,l./g15:/,d./jlx3+0/,i/
w.
g15: ; check reserver;
sn w1 (b1) ; if curr.intproc= sender then
jl x3 ; return (sender=driverproc);
am (b19) ;
rl w0 a52 ; w0:=reserver.extproc;
sn w0 (x1+a14) ; if intproc is reserver then
jl x3 ; normal return else
jl g6 ; result 2;
/,f
$procs
;********************
l./c99;28/,r/c99/e14/,
l./proceduregetclock/,i/
; procedure privileged operation
b. i5 w.
i0: 1<23 ; monitor mode
e14: ;
rl w1 b1 ; w1:= current
rl w0 x1+a24 ; w0:=mode
se w0 0 ; if mode<>0 then
jl r28 ; return (monitor mode not set)
rl w0 x1+a32 ;
lo. w0 i0. ; status:=status add monitor mode
rs w0 x1+a32 ;
al w0 0 ; result=0
jl r28 ; return (monitor mode set)
e.
/,f
$disc
;********************
$fpaline
;********************
$host
;********************
l./h90:/,
l./j4:/,
;l./rsw0g20/, i/
;c.-p103
; rs w0 x2+8 ; status:=0
; ds w0 x2+12 ; bytes, chars trf:= 0,0;
;z.
;c.p103-1
;/,
;l./jlg7/, i/
;z.
;/,
l./q1:/,
l./m0:/,
;l./c.p103-1/, d, l./z./, d3,
l./q4:/,
l./m0:/,
l./c.-p103/,
;d./c.p103-1/, l./z./, d,
l./j6:/,
l./rl w0 x1+a53/,d 2,i/
al w3 0 ;
j7: am x1+a402 ;
rl w0 x3 ;
am x2+a402 ;
rs w0 x3 ;
al w3 x3+2 ; users(proc):=proc func;
sh w3 a403-2 ;
jl. j7. ;
rl w0 g49 ;
rs w0 x2+a402 ;
/,
;l./c.-p103/,d./c.p103-1/,
;l./z./,d,
l./m6:/,
l./rl w3 x3+a14/,d 3,i/
rl. w1 r31. ;
ba w1 x3+a14 ;
bz w0 x1+a402 ;
lo w0 x3+a14 ; users(proc):=id-bit(sender(mess));
hs w0 x1+a402 ;
rl w1 b19 ;
jl. j1. ;
z.
/,
l./m7:/,
l./x3+a14/,d./j8:/,i/
j7: bz w1 x3+a14 ; get half word no
am x1 ;
bz w0 x2+a402 ;
lo w0 x3+a14 ;
am x1 ;
hs w0 x2+a402 ; users(sub):=proc+all ancestors(proc)
rl w3 x3+a34 ;
se w3 0 ;
jl. j7. ;
rl w1 b19 ;
z.
/,
l./n24:/,
l-2,r/i2/i2,j2/,
l./ds w0 x2+a53/,d,i/
rs w0 x2+a52 ; reserver:=0
j0: am x3 ;
rs w0 x2+a402 ; users:=0
al w3 x3+2 ;
sh w3 a403-2 ;
jl. j0. ;
/,
f
$fpasub
;****************
l./q14:/,
l./i2:/,d 6,
i/
i2: rl. w3 (j1.) ;
rl w1 x1+a50 ; rec:=receiver(att-message);
al w1 x1+p202 ; subhost:=subhost(main(proc));
bz w2 x3+a14 ;
am x2 ;
bz w0 x1+a402 ; mask:=user bits(bit displacement(rec),subhost);
la w0 x3+a14+1 ; mask:=mask and id-bit(rec);
rl w1 b19 ;
bz w0 1 ;
sn w0 0 ; if mask<>0 (i.e. receiver user of subhost) then
jl. i5. ;
am x2 ;
bz w3 x1+a402 ;
lo w3 0 ;
am x2 ;
hs w3 x1+a402 ; include receiver as user(proc);
rl w0 x1+a402 ; exclude proc func as user;
la w0 g65 ;
rs w0 x1+a402 ;
i5: ;
z.
/,
f
$tabinit
;********************
l./; external processes/,
l./h4:/,l-1,r/0/0,r.a401,0/,
l./h22:/,l-1,r/0/0,r.a401,0/,
l./h23:/,l-1,r/0/0,r.a401,0/,
l./h24:/,l-1,r/0/0,r.a401,0/,
l./;segment5:/,
l./g4:/,
l./g5:/,l-2,d./jl.g5./,i/
rl w3 x2 ; proc:=name table(entry);
; internal process:
al w0 0 ; halfword:=0;
bz. w1 g9. ; id-bit:=2.1000 0000 0000
g5: rs w3 x2 ; name table(entry):=proc;
hs w0 x3+a14 ; id-bit(proc):=id-bit;
hs w1 x3+a14+1 ; halfword(proc):=halfword;
ls w1 -1 ; id-bit:=id-bit shift (-1);
se w1 0 ; if id-bit.halfword<>0 then
jl. g14. ; goto g14
ba. w0 1 ; else halfword:=next halfword;
bz. w1 g9. ; id-bit:=2.1000 0000 0000
; set queue:
g14: al w3 x3+a15 ; next(event q(proc) ):=
rs w3 x3 ; last(event q(proc) ):=
rs w3 x3+2 ; event q(proc);
al w3 x3+a4-a15 ; proc:=next proc;
al w2 x2+2 ;
se w2 (b7) ; if if entry<> name table end then
jl. g5. ; goto internal process;
/,
f
$procfnc1
;********************
l./e17:/,
l./ds. w3 d14./,d,i/
b. i1 w.
rs. w3 d14. ;
al w0 0 ;
i0: rs. w0 x2+d13. ; childrensbits:=0
al w2 x2+2 ;
sh w2 a403-2 ;
jl. i0. ;
e.
/,
l./e18:/,l-2,r/g0/g3/,l./e19:/,
l./dl./,d./jl.(d12.)/,i/
al w0 0 ;
al w1 a403 ;
g3: al w1 x1-2 ;
lo. w0 x1+d13. ; w0:=id bits
se w1 0 ;
jl. g3. ;
rl w3 b6 ; w3:=addr(first proc in nametable);
g0: rl w2 x3 ; for w3 through nametable do
rl. w1 d14. ; w1:=proc addr;
se w1 (x2+a34) ; if parent.nametable(w3)=
jl. g1. ; procaddr then
bz w1 x2+a14 ; include identbit.nametable(w3)
bz. w0 x1+d13. ; nametable(w3));
lo w0 x2+a14 ;
hs. w0 x1+d13. ;
g1: al w3 x3+2 ;
se w3 (b7) ;
jl. g0. ;
jl. (d12.) ; return;
/,
l./procedure nextproc(result:procaddr,newstate);/,
l./b.g0/,r/0/5/,
l./z.rl. w1 d13./,
r/z./z.
/,l./rl.w1/,d./jd.(d12.)/,i/
rs. w3 d12. ; save(link) ;
rl w3 b6 ; w3:=first internal in nametable ;
al w1 0 ;
g2: bz. w0 x1+d13. ; for all children bits do
se w0 0 ; if childrenbits(w1)=0 then
jl. g1. ; goto L;
al w1 x1+1 ;
se w1 a403 ;
jl. g2. ;
rl. w3 d12. ;
jd x3+2 ; return 2;
g1: hs w1 0 ; w0:=relative addr<12 ;
g0: rl w2 x3 ; w2:=nametable(w3) ;
al w3 x3+2 ; w3:=next in nametable ;
so w0 (x2+a14) ; if userbit.curr.intproc is not on then
jl. g0. ; goto g0 else
bz w3 0 ; w3:=relative addr
lx w0 x2+a14 ; remove userbits.curr.intproc
hs. w0 x3+d13. ;
rs. w2 d14. ; proc addr:=w2;
al w3 x2 ;
al w2 f50 ; new state:=wait stop by ancestor;
jd. (d12.) ;
/,
l./e25:/,d./jex2+0;en/,i/
e25: ; remove area process;
ds. w2 h1. ; save(link);
jl. w2 e53. ; test user and reserver(intproc,extproc);
rs. w2 h2. ; h2:=result;
so w2 2.1 ; if intproc is not user then
je. (h1.) ; enable return else
jl. w2 e52. ; exclude intproc as user;
rl. w0 h2. ; w0:=result of test user and reserver;
al w2 0 ;
sz w0 2.10 ; if intproc is reserver then
rs w2 x3+a52 ; remove intproc as reserver;
al w2 1 ;
ba w2 x1+a20 ; areaclaim.intproc:=
hs w2 x1+a20 ; areaclaim.intproc+1;
sz w0 2.100 ; if other users then
je. (h1.) ; enable return
al w0 0 ;
/,l./jex2+0/,r/jex2+0 /je. (h1.)/,
l./g1:/,r/:/:
/,d,l./e50:/,l./e32./,l1,i/
; procedure include user(intproc,extproc);
; reg call return
; w0 undef
; w1 intproc unchanged
; w2 link -
; w3 extproc -
; the process intproc is included as user of the external process extproc
e51: ;
ba w3 x1+a14 ;
bz w0 x3+a402 ; w0:=userbits.intproc;
lo w0 x1+a14 ; include intproc;
hs w0 x3+a402 ;
bs w3 x1+a14 ; reset w3
jl x2 ; return
; procedure exclude user(intproc,extproc);
; reg call return
; w0 undef
; w1 intproc unchanged
; w2 link -
; w3 extproc -
; the procedure will exclude the process addresed by intproc as user
; of the external process addressed by extproc
e52: ba w3 x1+a14 ;
bz w0 x3+a402 ; w0:=users.intproc;
sz w0 (x1+a14) ; if intproc is user then
lx w0 x1+a14 ; exclude intproc as user;
hs w0 x3+a402 ;
bs w3 x1+a14 ; reset w3
jl x2 ;
; procedure test users and reserver(intproc,extproc);
; reg call return
; w0 undef
; w1 intproc unchanged
; w2 link result
; w3 extproc unchanged
; the procedure set result = 2.0001 if intproc is user
; = 2.0011 if intproc is reserver (and user)
; = 2.0101 if intproc and other ip are users
; = 2.0100 if there only are other users
; = 2.1100 if another ip is reserver (and user)
; of extproc else result is set to zero
b. f5,g5 w.
e53: ds. w3 g1. ; save(link,w3);
rl w0 x3+a52 ; w0:=reserver.extproc;
al w2 2.10 ;
sn w0 (x1+a14) ; if intproc is reserver then
jl. f3. ; goto test other users;
al w2 0 ;
se w0 0 ; if there is another reserver then
al w2 2.1000 ; set other-reserver bit;
ba w3 x1+a14 ; w3:=addr(bitpattern.intproc);
bz w0 x3+a402 ; w0:=bitpattern.intproc;
sz w0 (x1+a14) ; if userbit.intproc is on then
f3: al w2 x2+1 ; result:=result add 1;
al w3 0 ;
f0: am. (g1.) ;
bz w0 x3+a402 ; w0:=next pattern.userbittable;
sn w0 0 ; if no users then
jl. f1. ; goto f1;
hs w3 0 ;
sn w0 (x1+a14) ; if only intproc is user then
jl. f1. ; goto f1 else
al w2 x2+2.0100 ; result:=result add 2.0100;
jl. f2. ; goto f2 else
f1: al w3 x3+1 ; w3:=next rel-addr
se w3 a403 ; if not end bittable then
jl. f0. ; goto f0;
f2: rl. w3 g1. ;
jl. (g0.) ; return;
g0: 0
g1: 0
e.
/,
f
$procfnc2
;****************
l./m1:/,l./j6./,l1,i/
j6=k-2
/,
l./m9:/,l./rl w0 x3+a53/,d 1,i/
ba w3 x1+a14 ;
bz w3 x3+a402 ; w3:=userbits.intproc;
bz w1 x1+a14+1 ; w1:=idbit.intproc;
so w3 x1 ; if idbit.intproc is not on then
/,l./nouser=a53/,r/a53/2.0100/,r/a52/2.1000/,l./m11:/,
l./jl.w3n10./,d./snw00/,i/
rl w3 x2 ; w3:=addr(area process description);
rl. w1 d2. ; w1:=intproc;
jl. w2 e53. ; test user and reserver;
jl. w3 n10. ; w0:=2.100 test other users
; 2.1100 test other reservers;
so w2 (0) ; if no other users-reservers then
/,
l./m14:/,l./;test/,i/
jl. e1., e1 = k-2
/,
l./m22:/,
l./h4:/,l 1,i/
; common variables:
d16: 0, r.8 ; answer area
c. 4 * (:a110+1:)+d16.-1; and
0, r. 2*(:a110+1:)+d16.>1; claim change array (set bs claims)
z. ;
d4: 0 ; curdoc: address of current document (chaintable)
d5: d9 ; maincat pseudochain
; description of current entry
d29: 0 ; -2 curr entry segment number
d3: 0 ; curr entry address in catalog
; record work:
; (format as a catalog entry)
d1: 0,r.f0>1 ; work
d30: 0, r.4 ; stat area.work
; format of chainhead format of catalog entry
v1 = d1 + f1 ; lower base of catalog lower base of entry
v2 = d1 + f2 ; upper base of catalog upper base of entry
v3 = d1 + f3 ; chainkink*8 + permkey namekey*8 + permkey
v4 = d1 + f4 ; first slice of auxcat first slice
v5 = d1 + f5 ; name of auxcat entry name
v6 = d1 + f6 ; start of tail
v7 = d1 + f7 ; size of auxcat size of entry
v11= d1 + f11 ; document name name
v12= d1 + f12 ; name table addr of write access counter,
; auxcat area process read acces counter
v13= d1 + f5 + 2 ;
v14= d1 + f5 + 6 ;
v15= d1 + f5 + 7 ;
v26= d1 + f66 + f0 ; last slice in chaintable
v27= d1 + f67 + f0 ; first slice in
; chaintable-chain
v30= d1 + f11 + 2 ;
v31= d1 + f11 + 6 ;
v32= d1 + f12 + 2 ;
d2: 0 ; sender: process description address of sender
d11: 0 ; cur proc name table address
d13: 0,r.a401 ; children bits
d14: 0 ; d13+2 ; address of a process description
d15: 0 ; d13+4 ; end chain
; stepping stones
jl. e5., e5 = k-2
jl. e7., e7 = k-2
jl. e8., e8 = k-2
jl. e9., e9 = k-2
jl. e10., e10=k-2
jl. e12., e12= k-2
jl. e50., e50= k-2
/,
l./m24:/,
l./d3:/,d-2,d./d5:/,l1,d./e10./,
i/
jl. e17., e17= k-2
jl. e31., e31= k-2
jl. e32., e32= k-2
jl. e33., e33= k-2
/,l./m34:/,l./n1./,l1,i/
n1=k-2
/,l./n5./,l1,i/
n5=k-2
/,l./d2:/,d./d15:/,
l./jl.j5./,l1,i/
j5=k-2
/,
l./stepping stones/,l1,d1,
l./e20-/,r/6/4/,
l 1,i/
am e24-e26 , e24=k-2
/,l./e31/,r/31/43/,l1,d2,l./e60/,i/
jl. e52., e52=k-2
jl. e53., e53=k-2
/,
l./m40:/,l./am(b1)/,d./rsw0x3+a53/,i/
rl w1 b1 ; w1:=addr(procfunc process description);
rl w0 x1+a14 ; w0:=idbit.procfunc;
rs w0 x3+a52 ; discprocess.reserver:=idbit.procfunc;
jl. w2 e51. ; include procfunc as user of discprocess;
/,l./m41:/,l./rlw2x2/,d./x2+a72/,i/
rl w3 x2 ; w3:=addr(discprocess);
rl w1 b1 ; w1:=addr(procfunc process description);
jl. w2 e52. ; exclude procfunc as user of discprocess;
ld w1 -100 ;
rs w0 x3+a11 ; name(0):=0; (this will prevent further user of the discprocess)
rs w0 x3+a52 ; exclude procfunc as reserver;
ds w1 x3+a72 ; chaintable.discproc:=slicelength.discproc:=0;
/,l./m46:/,l./g5:/,l./rl.w2h1./,d./rsw1x3+a53/,i/
rl. w1 h1. ; w1:=intproc;
rl. w3 (d11.) ; w3:=extproc;
jl. w2 e53. ; test users and reserver;
sz w2 2.1 ; if intproc already user then
jl. n0. ; goto next instruction else
al w0 -1 ;
ba w0 x1+a20 ;
sn w0 -1 ; if areaclaim.sender=0 then
jl. j1. ; goto result 1 else
j1=k-2
hs w0 x1+a20 ; else decrease areaclaim.sender;
jl. w2 e51. ; include intproc as user of areaproc;
/,l./m50:/,l-1,r/g10/g10,h5/,
l./ldw2-100/,d./jl.n0./,i/
al w2 0 ;
rs w2 x3+a52 ; clear reserver.extproc;
rs w2 x3+a11 ; name(0).
rs w2 x3+a50 ; docaddr.
; scan all internal processes and maybe increase their area-claim
rl w2 b6 ; w2:=first intproc in nametable;
g1: rl w1 x2 ; w1:=next intproc in nametable;
rs. w2 h0. ;
jl. w2 e53. ; test users and reserver;
rs. w2 h1. ; :=user and reserver mask;
jl. w2 e52. ; exclude intproc as user;
rl. w2 h1. ; w2:=user and reserver mask;
al w0 1 ;
ba w0 x1+a20 ;
sz w2 2.1 ; if intproc is user then
hs w0 x1+a20 ; increase areaclaim.intproc;
so w2 2.0100 ; if no other users then
jl. n0. ; next instruction else
rl. w2 h0.
al w2 x2+2 ; next in name table;
jl. g1. ; (no check of upper limit in nametable,
; because of the test on other users)
h0: 0
h1: 0
/,l./delete aux entry/,i/
d21: d16
d22: d16+2
d24: d14
d33: d15
d34: d1+f6
;stepping stones:
jl. e31. , e31=k-2
jl. e90. , e90=k-2
jl. e92. , e92=k-2
/,
l./m59:/,
l./stepping stones/,d./n5./,
l./m89:/,l./j6./,l1,i/
j6=k-2
/,l./m115:/,l-1,d./jl.g2./,i/
b. g10,h5 w.
m115: ; check any area process;
rl w2 b5 ; w2:=first addr in nametable;
jl. g0. ;
g1:
g2: rl. w2 h0. ;
al w2 x2+2 ; w2:=next in nametable
g0: sn w2 (b6) ; if upper limit in namtable is exceeded
jl. n0. ; then goto next instruction;
rs. w2 h0. ;
rl w3 x2 ; w3:=addr(next extproc);
rl w1 b1 ; w1:=addr(procfunc process description);
jl. w2 e53. ; test users and reserver;
sn w2 0 ; if no users then
jl. g2. ; goto next extproc;
rs. w2 h1. ; store result of test users and reserver;
al w1 x3 ; NB w1<->w3 g1<->g2
/,l./rlw3b1/,d 2,i/
rl. w0 h1. ; w0:=result of test users and reserver;
so w0 2.0100 ; if not any other users then
/,l./g3:/,l./j5./,l1,i/
h0: 0 ; addr in name table;
h1: 0 ; result af test users and reserver;
/,l./m149:/,l./rlw2x2+0/,d./sow0(x2+a52)/,i/
rl w3 x2 ; w3:=addr(extproc);
jl. w2 e53. ; test users and reserver;
so w2 2.0001 ; if calling process is not user then
jl. j2. ; result 2;
j2=k-2
sz w2 2.1000 ; if other reserver then
/,l./m152:/,l./d13.+4/,r/d13.+4/(d33.)/,
l./m153:/,
l./d16./,r/d16.+2/(d22.)/,
l./d16./,r/d16.+2/(d22.)/,
l./d16./,r/d16./(d21.)/,
l./d16./,r/d16.+2/(d22.)/,
l./d16./,r/d16./(d21.)/,
l./m154:/,
l./d14./,r/d14. /(d24.)/,
l./d2./,r/ d2. /(d20.)/,
l./m155:/,
l./d2./,r/d2./(d20.)/,
l./rl w0 x1+a14/,d./je.j5./,i/
jl. w2 e53. ; test users and reserver;
so w2 2.1 ; if sender is not user then
je. j2. ; enable goto result 2;
sz w2 2.1000 ; if other reserver then
je. j5. ; enable goto result 5
j5=k-2
/,l./g0:/,l./j3./,l1,i/
j3=k-2
/,l./d2./,r/ d2. /(d20.)/,
l./d2./,r/ d2. /(d20.)/,
l./d15./,r/d15./(d33.)/,
l./d14./,r/d14./(d24.)/,
l./d14./,r/d14./(d24.)/,
l./g15:/,l./rl w2 x1+a14/,d./jl.w2g7./,i/
jl. w2 e52. ; exclude intproc as user;
jl. w2 e53. ; test users and reserver;
al w0 0 ;
sz w2 2.10 ; if inproc is reserver then
rs w0 x3+a52 ; exclude inproc as reserver;
sz w2 2.0100 ; if no other users then
jl. w2 g7. ; release extprocess;
/,l./d13./,d,i/
rl. w0 (d24.) ;
sn w2 (0) ;
/,
l./d13./,d,i/
sn w3 (0) ;
/,
l./d14./,r/d14. /(d24.)/,
l./d14./,r/d14. /(d24.)/,
l./g7:/,l./i4./,r/i4. /d21./,l./i4:/,d,
l./m158:/,l./p22:/,l./m11,a52/,r/a52 /2.1000/,
l./p23:/,l./m11,a53/,r/a53 /2.0100/,
l./p24:/,l./m11,a53/,r/a53 /2.0100/,
l./p25:/,l./m11,a52/,r/a52 /2.1000/,
l./p45:/,l./m11,a52/,r/a52 /2.1000/,
l./p37:/,l./m11,a53/,r/a53 /2.0100/,
f
$s1
l./d23=k-2/,l1,i/
jl. d24.
d24=k-2
/,f
$s2
;********************
$catinit
;********************
l./f19:/,l./jl(10)/,i/
al. w3 i2. ; clear core
sh. w3 (i6.) ; if start addr < 200000 then
rl. w3 i6. ; start addr:=200000
rl w1 b12 ; w1:=max addr
al w1 x1-4
al w0 0 ;
i5: al w3 x3+2 ;
rs w0 x3 ;
sh w3 x1 ;
jl. i5. ;
/,l./i3:/,i/
i6: 200000
/,
f
▶EOF◀