|
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: 29184 (0x7200)
Types: TextFile
Names: »lmitxt075«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »lmitxt075«
;;
;; begin lmitxt075
;;
;;
;; usage of registers in process synchronizing instructions
;;
;; generally z means base, and r means disp
;;
;; w2=level
;; w1=pu
;;
;; w21 and w65 are used as addr and data in the read procedures
;; ra=rawork
;; ir=0300: w=01, x=10
;;
;; z/rd0: lbd b
;; z/rd1= z/rdw: shptr
;; z/rd2= z/rdx: lbd a
;; z/rd3= z/rd: share
;; w43: nbd
;; w87: hbd a
;; w109: hbd b
;; w11: share + semrel
;; w0:
;;
.p ;
cget2: ;;
,,cjs readluc ;
w0:=bd,h w s,cjs readluct ;
w1:=bd,h w s,cjs terror ;
;
setrair: ;
ir:=300,,, ;
ra:=rawork,,,crtn ;
;;
;; procedure cget4
;;
;; entry: -
;; exit : w10= w87= op1, w32= zrdw= op2, ra= rawork, ir= 300, w0=undef;
;;
cget4: ;;
,,cjs setrair ;
,,cjs readlucq ;
w7:=q,,cjs readlucq ; w87:=hbd:=semaphore
w0:=q,,cjs readlucq ;
rdw:=q,,cjs readlucq ; shptr
w8:=w0,, ;
zdw:=q,,crtn ;
;
cfin4: ;cfin4:
ir:=,,cjs setslice ; setslice must not update stat
slu:=slu-8,, ; sync itr; slu:= slu-8;
sic:=sic++,,cjp fetch ; sic:= sic+1; goto fetch;
;
cfin22: ;cfin22:
,,cjs setslice ; setslice must not update stat
ir:=4,slu:=slu-4,, ; sync itr; slu:= slu-4;
sic:=sic+2,, ; sic:= sic+2;
,,cjp fetch ; goto fetch;
;
cfin0: ;cfin0:
ir:=,,cjs setslice ; setslice must not update stat
sic:=sic++,,cjp fetch ; sic:= sic+1; goto fetch;
.p ;
;;
;; procedure getshare
;;
;; entry: rzdw= shptraddr;
;; exit : zrd= w21= mem(shptraddr); stat(w2) set;
;;
getshare: ;;
w6:=zdw,s,ldct nillerr ; if nill(refadr) then goto nillerror
w5:=rdw,,jsrp not b1 cread21; else ref:= cread(refadr);
zd:=w2,s, ; ref
rd:=w1,,crtn not b0 ; if -,locked(ref) then return;
,,cjp lockerr ; goto lockerror;
;;
;; procedure reservea
;;
;; entry: w87= hbd a; ra,ir= work;
;; exit : w87= w65= hbd a; zrdx= w21= lbd a; stat(lb a) set;
;;
;
reservea: ; return: zrdx= w21= lbd a; stat(lb a) set;
w6:=w8,s,ldct nillerr ; if nill(hbd a) then goto nillerror
w5:=w7,,jsrp not b1 cread21; else lbd a:= cread(hbd a);
zdx:=w2,s, ; lbd a
rdx:=w1,,crtn ;
;;
;; procedure reserveb
;;
;; entry: w109= hbd b; ra,ir= work;
;; exit : w109= w65= hbd b; zrd0= w21= lbd b; stat(lb b) set;
;;
;
reserveb: ; return: zrd0= w21= ldb b; stat(lb b) set;
w6:=w10,s,ldct nillerr ; if nill(hbd b) then goto nillerr
w5:=w9,,jsrp not b1 cread21; else lbd b:= cread(hbd b);
zd0:=w2,s, ; lbd b
rd0:=w1,,crtn ;
.p ;
setrefshwt: ;; sets ref (share waited) of receiver (=nbd)
w5:=w3+shwt,, ;
w6:=w4,,cjs cread21 ; w21:=ref
w5:=rd,, ; w65:=share
w6:=zd,,cjp cwrite65 ; ref(share waited):=share
;
setchhead: ;; mem(nbd.chainhead):=hbd b
w5:=w3+chainhead,, ;
w6:=w4,, ;
w1:=w9,, ; chainhead:=hbd b
w2:=w10,,cjp cwrite21 ;
;;
;; procedure unchain
;; hbd a -> lbd a -> nbd -> fbd a (* nbd to be unchained *)
;;
;; entry: w43=nbd; w87= hbd a; zrdx= lbd a; ra,ir= work;
;; exit : w43= w87= zrdx= ra,ir= unch;
;;
unchain: ;proc unchain;
rdx-w3,s, ; test lbd a - nbd
zdx-w4,s,cjp not zro unchain2;
bus:=40,,, ;
w6:=swp,,cjp zro unchain3 ;
;
unchain2: ;;
w5:=w3,, ;
w6:=w4,,cjs cread21 ; w21:=fbd
w5:=rdx,, ; w65:=lbd a
w6:=zdx,,cjp cwrite21 ;mem(lbd a):=fbd; return;
unchain3: ;;
w2:=w8,, ; w21:=hbd a
w1:=w7,,cjp cwrite6 ; sem:= nill; return;
;
changeab: ;;
rdx,w9:=w7,, ; hbd b:=hbd a
swp,w10:=w8,, ;
rd0:=swp,,, ; lbd b:=lbd a
q:=zdx,, ;
zd0:=q,,crtn ;
.p ;
;; procedure chain
;;
;; entry: w43= nbd; w109= hbd b; zrd0= lbd b; cry= setlevel(monitor);
;; chain nbd to hbd b, lbd b
;; if cry and lbd b was nill then setlevel(membyte(nbd+puno),1)
;;
chain: ;proc chain;
w6:=zd0,s, ; w65:=lbd b
w5:=rd0,, ;
w2:=w4,, ; w21:=nbd
w1:=w3,,cjp b1 chain3 ;
,,cjs cexch21 ; w21:=:mem(lbd b)
w6:=w4,, ; w65:=nbd
w5:=w3,,cjs cwrite21 ; mem(nbd):=w21
;
chain2: ;;
w2:=w10,, ; w21:=hbd b
w1:=w9,,cjp cwrite65 ; mem(hbd b):=nbd
;
chain3: ;; sem=nill
w6:=w4,, ;
w5:=w3,,cjs cwrite21 ; mem(nbd):=nbd
,,cjp not cry chain2 ;
; setlevel(monitor);
w0:=monitrlev,, ;
,,cjs setlint ;
ra:=rawork,,, ;
w5:=w3,,cjp chain2 ;
;
chainfirst: ;
w6:=zd0,s, ;
w2:=w4,,cjp b1 chain ; if nil(lbd b) then goto chain
w5:=rd0,, ; w65:=lbd b; w21:=nbd
w1:=w3,,cjs cexch21 ; w21:=:mem(lbd b)
w6:=w4,, ;
w5:=w3,,cjp cwrite21 ; mem(nbd):=w21; return;
;
putelemptr: ;; mem(elemptr):=nbd
w5:=rdw,, ; w65:=elemptr
w6:=zdw,, ;
w1:=w3,, ; w21:=nbd
w2:=w4,,cjp cwrite21 ; mem(elemptr):=nbd
.p ;
signal: ;;
,,cjs reservea ; lbd a:=w21:=mem(hbd a)
rdx,,s,cjp b1 sig5 ; jump if passive
;
,,cjp not b15 sig5 ; jump if open
,,cjs cread65 ; w21=lbd a
w3:=w5,, ; w43=nbd
w5:=w5+level,, ;
w4:=w6,,cjs creadbyte1 ;
w2:=w1,s, ; w2:=level
,,cjp not zro sig4 ; jump if level>0
w5:=w3+actq,, ;
,,cjs cread21 ;
w9:=w1,, ; w109:=hbd b:=active queue
w10:=w2,,cjs reserveb ;
,,cjs setrefshwt ; ref(nbd.shwt):=share
,,cjs setchhead ; mem(nbd.chainhead):=hbd b
,,cjs unchain ; unchain nbd from hbd a, lbd a
c:w0-w0,,cjs chain ; cry means setlevel
,,cjp sig6 ;
sig4: ; signal to receiver on level>0
w10:=w2,,cjs setrefshwt ; save level; ref(nbd.share waited):=share
w0:=w10,,cjs setlint ;
w5:=w3+chainhead,, ;
w6:=w4,,cjs nill ;
w1:=swp,,cjs cwrite1 ; mem(nbd.chainhead):=nill
,,cjs unchain ;
,,cjp sig6 ;
sig5: ; signal to an empty or an open semaphore
,,cjs changeab ;
w4:=c:zd,, ; c=0 means no setlevel
w3:=rd,,cjs chain ; nbd:=share
sig6: ;
w5:=rdw,,cjs nill ;
w1:=swp,, ;
w6:=zdw,,cjp cwrite1 ; shptr:=nill
.p ;
;; entry: cry= multible wait, exception iff sem locked.
;; exit: w0<>0 = proc descheduled
wait0: ;;
,,cjs getshare ; share:=mem(shptr)
,,cjpp not b1 waitxept ; if shptr not nill then goto waitxept
,,cjs reservea ; lbd a:=w21:=mem(hbd a)
rdx,,s,cjp b1 wait2 ; jump if passive
,,cjp b15 wait2a ; jump if locked
wait1a: ; sem open
,,cjs cread65 ; w21=lbdfrom
w3:=w5,, ; w43:=nbd
w4:=w6,,cjs unchain ;
w0:=,,cjp putelemptr ; mem(shptr):=share; return;
wait2a: ;lockedsem:
,,cjp not cry wait2 ; if mwait then
q:=mwse1,, ; exception(mtse1);
,,cjp xept ;
wait2: ; nill
ra:=reg,, ;
w4:=zd2,, ; w43:=nbd:=this process
w3:=rd1,, ;
ra:=rawork,w6:=w4,, ;
w5:=w3+shwt,, ;
w1:=rdw,,cjs changeab ; w21:=shptr
w2:=zdw,,cjs cwrite21 ; mem(nbd.shwt):=shptr
reg xor 7,s, ;
,,cjp zro wait3 ; jump if lev=0
,,cjs clear ; clear level
,,cjp wait5 ; goto wait5
;
wait3: ; lev=0
w5:=w3+chainhead,, ;
,,cjs cread21 ;
,,cjs desched10 ; deschedule10;
wait5: ;; chain process to sem
w0:=w0--w0,,cjs setchhead ; mem(nbd.chainhead):=hbd b
c:=,,cjp chain ; return;
waitxept: ;
q:=waite,, ;
,,cjp xept ; exception(waite);
.p ;
.instruction csign ;
,,cjs cget4 ;
,,cjs getshare ; share:=mem(shptr)
,,cjp b1 csign1 ;
,,cjs signal ;
,,cjp cfin4 ;
;
csign1: ;;
q:=csigne,, ;
,,cjp xept ;
;
.instruction crele ;
,,cjs readbcont ; w4:=semrel
,,cjs cget2 ;
rdw:=w0,, ; z/rdw := shptr
zdw:=w1,,cjs getshare ; z/rd := share
w7:=rd+w4,,cjp b1 csign1 ; hbd a := share + semrel; jump if shptr=nill
w8:=zd,,cjs reservea ; reserve pointer to sem
w7:=rdx,, ;
w8:=zdx,,cjs signal ; hbd a:=sem
,,cjp cfin22 ;
.instruction cwait ;
,,cjs cget4 ;
c:=,,cjs wait0 ; wait0(normal wait);
,,cjp cfin0 ;
;
.instruction csens ;
,,cjs cget4 ;
,,cjs getshare ;
,,cjp not b1 waitxept ; if shptr<>nill then goto waitxept
,,cjs reservea ;
rdx,,s,cjp b1 csens3 ;
,,cjp b15 csens3 ; jump if not open
,,cjs wait1a ;
,,cjp cfin4 ;
;
.p ;
.instruction cwtac ;
,,cjs cget4 ;
w6:=zdw,, ; w65:=shptr
w5:=rdw,,cjs cread1 ;
w6:=w8,h ,cjp not b1 cfin4 ; jump if not nill
,h ,cjs clear ;
,,cjp sfetch ;
;
.instruction cllst ;
,,cjs cget4 ;
w10:=w8,, ; hbdb:=hbda
w9:=w7,,cjs reserveb ;
,,cjs getshare ;
w3:=rd,, ; nbd:=share
w4:=c:zd,,cjs chain ; cry:=false
,,cjp cfin4 ;
;
csens3: ;
bus:=40,,, ;
w4:=swp,,cjs putelemptr ; mem(elemptr):=nbd
,,cjp cfin4 ;
.p ;
.instruction csell ;
,,cjs readluc ; newlevel:=unstack
w11:=bd,h w s,cjs terror ;
w3:=rd1,, ; nbd:= (spb, pr)
w4:=spb,, ;
w5:=w3+actq,, ;
w6:=w4,,cjs cread21 ; hbd a:=mem2(nbdü.actq);
w7:=w1,,cjs setrair ;
w8:=w2,,cjs reservea ; reserve a
w0:=lev,,cjs clear ; clear(lev)
w11,s, ;
,,cjp not zro csell3 ; jump if newlevel<>0
reg xor 7,s, ;
,,cjp zro csell4 ; jump if lev=0
; newlevel=0, lev<>0
,,cjs changeab ; change a b
,,cjs setchhead ; setchhead
c:=,,cjs chainfirst ; chainfirst(false)
,,cjp csell4 ;
csell3: ; newlevel<>0
w0:=w11,,cjs setlint ; setlint(newlevel)
reg xor 7,s, ;
,,cjp not zro csell4 ; jump if lev<>0
bus:=40,,, ;
; newlevel<>0, lev=0
w10:=swp,,cjs setchhead ; hbd b.base:=nill; setchhead
,,cjs unchain ; unchain
w0:=monitrlev,, ;
,,cjs setlint ; setlint(monitrlev)
.p ;
csell4: ;
w2:=w4,, ;
levelm1= level - 1 ;
w1:=w3+levelm1,, ;
w3:=w11,,cjs writebnext ; membyte(nbdü.level):=newlevel
w3:=w1-level,, ;
ra:=reg,,cjs dumpregs ; dumpregs(reg)
,,cjs loadregs ; loadregs(nbd); w7:=nbdü.level
reg:=w11,,push 2 ;
ra:=reg:=reg++reg,,rfct ; reg:= newlevel * 8 + 7;
w0:=4,, ;
,,cjs clearbits ; to:=false
lev:=w11,,cjs setslice ; lev:=newlevel
slu:=slu-2,, ;
sic:=sic++,,cjp fetch ; goto fetch
;;
.instruction cskip ;
;;
;; param:: none;
;; stack:: headadr: addr-> ;
;;
,,cjs readlucq ;
w1:=q,,cjs readlucq ;
bus:=w2:=q,s,ldct nillerr ; h:= w21:= (readlucq,readlucq);
w4:=w2,,jsrp not b1 cread65; if nill(h) then exception(nilade)
bus:=w6,s,ldct cskip10 ; else l:= w65:= cread(h);
w3:=w1,,jsrp not b1 cread21; if -,nill(l) then
w6:=w4,, ;
w5:=w3,,cjs cwrite21 ; cwrite(h,cread(l));
cskip10: ;
,,cjpp fetch ; goto fetch;
.p ;
.instruction cstop ;
,,cjs cget4 ; hbda:=addr; shptr:=process descr
w5:=rdw,, ;
w5:=w5+chainhead,, ;
w6:=zdw,,cjs cread21 ;
w10:=w2,s, ; hbdb:=shptr.chainhead
,,cjp b1 cupro20 ; jump if chainhead nill
w9:=w1,,cjs reserveb ;
w8,s, ;
,,cjp not b1 cupro3 ; jump if not nill
cupro4: ; first loop
w7:=rd0,, ; hbda:=lbdb
w8:=zd0,, ;
,,cjp cupro5 ;
cupro3: ; not first loop
w5:=w7,, ; test if the process 'hbda' has been moved
w5:=w5+chainhead,, ; away from the semaphore
w6:=w8,,cjs cread21 ;
w10-w2,s, ;
w9-w1,s,cjp not zro cupro4 ; the process has been moved
,,cjp not zro cupro4 ;
cupro5: ;;
w6:=w8,, ;
w5:=w7,, ;
cupro6: ;;
,,cjs cread21 ;
w1-rdw,s, ;
w2-zdw,s,cjp not zro cupro7;
,,cjp zro cupro8 ;
cupro7: ; the process has not been found yet
int,w5:=w1,h ,cjs testint1 ;
ir:=300,w6:=w2,, ; sync intrp;
,,cjp zro cupro6 ; goto cupro6 if no higher interrupts
;
;; higher interrupts pending
;
w4:=w6,,cjs setslice ;
slu:=slu-4,, ; rewrite workp on stack
w3:=w5,,cjp wr34fetch ;
.p ;
cupro8: ;; the process has been found
;; w65= process just before this process
;; w21= z/rdw= this process
;; w109= the semaphore
;; z/rd0= last
w5-w1,s, ;
w6-w2,s,cjp not zro cupro9 ;
,,cjp not zro cupro9 ;
;; only this process in the queue
bus:=40,w6:=w10,, ;
w2:=swp,,cjp cupro11 ; last:=nill
cupro9: ;;
w4:=w6,, ; w43:=the process just before this process
w3:=w5,,cjs cread65 ; w65:= process after this process
w2:=w4,, ;
w1:=w3,,cjs cwrite65 ; unchain
q:=rd0,, ; last process
q-rdw,s, ; this process
q:=zd0,, ;
q-zdw,s,cjp not zro cupro20;
w6:=w10,,cjp not zro cupro20;
cupro11: ;;
w6:=w10,, ; w65:= head
w5:=w9,,cjs cwrite21 ;
.p ;
cupro20: ;; chainhead=nill
w5:=rdw,, ;
w5:=w5+level,, ;
w6:=zdw,,cjs creadbyte1 ; w1:=level
w1,s,push 2 ;
ra:=w1:=w1++w1,,rfct ;
,,cjs not zro dumpregs ; dumpregs(level * 8 + 7)
;;
;; clear p.dumpps.wait
;;
,,cjs setrair ; setrair;
w5:=rdw,, ;
w5:=w5+dumpps,, ;
w6:=zdw,,cjs cread1 ; ps:= cread1(p.dumpps);
w1:=w1 clr pswait,, ; ps:= ps and -,pswait;
,,cjs cwrite1 ; cwrite1(p.dumpps,ps);
,,cjp cfin4 ;
;;
.instruction cexch ;
;;
;; param:: none;
;; stack:: ad1, ad2: addr -> ;
;;
,,cjs cget4 ; ad1, ad2:= cget4;
,,cjs getshare ; ref:= getshare(ad2);
w6:=w8,s,ldct nillerr ; if nill(ad1) then goto nillerror
w5:=w7,,jsrp not b1 cexch21; else ref :=: exch(ad1);
w2,s,ldct xept ; if locked(w21) then
w6:=zdw,,cjp b0 cexch10 ; goto cexchxept;
w5:=rdw,,cjs cwrite21 ; cwrite(ad2,ref);
,,cjp cfin4 ; goto cfin4;
cexch10: ;cexchxept:
w6:=w8,,cjs cwrite21 ; cwrite21(ad1,ref); (* reestablish ref *)
,,cjp lockerr ; goto lockerror;
.p ;
;;
;; procedure setpswait
;;
;; entry: w0= wcause; ra= reg;
;; exit : q= undf; w0= ra= unch;
;;
setpswait: ;proc setpswait;
q:=zd1,, ; reg.ps.wait:=
q:=q clr pswait,, ; (reg.ps.wait and -,wait) or wcause;
zd1:=q ior w0,,crtn ; return;
;;
;; procedure deschedule
;;
;; entry: ra= reg;
;; exit : w0-w8,ra,q,ir= undf;
;;
deschedule: ;proc deschedule;
reg xor 7,s, ; if reg <> 7 then
w6:=slb,,cjp not zro clear ; begin clear; return; end;
w3:=rd1,, ; (* deschedule level 0 proc *)
w5:=w3+chainhead,, ; nbd a:= own;
40,w4:=w6,, ; hbd a:= nill
w2:=swp,,cjs cexch21 ; own.chainhead :=: hbd a;
,,cjs setrair ; setrair;
;;
;; proc desched10
;;
;; entry: w21= hbd a= actqueue, w43= nbd= proc; ra,ir= work;
;; exit : w43= w109= w0= unch, ra,ir= work;
;;
desched10: ;proc deschedule10;
w7:=w1,, ;
w8:=w2,,cjs reservea ; lbd a:= reservea(hbd a);
,,cjs unchain ; unchain(own,hbd a,lbd a);
w0:=monitrlev,, ; setinterrupt(monitor);
,,cjp setlint ; return;
;;
;; proc testtimer
;;
;; entry: ra= reg; spb def;
;; exit : w1= own.timer; stat(w1) set; w65= undf;
;;
testtimer: ;proc testtimer;
w5:=rd1,, ;
w5:=w5+timer,, ;
w6:=spb,,cjp cread1 ; t:= cread1(own.timer); return;
;
setpsw: ;
3fe,w0:=<w0+w0,, ; w0:=wcause from the instruction code
w0:=w0 clr swp,,cjs setpswait;
,,jmap not 8 ; switch to the instruction
.p ;
;;
.instruction mwi , setpsw ;; (* at level 0 = suicide *)
;;
;; param:: none;
;; stack:: -> ;
;;
,,cjs deschedule ; deschedule;
,,cjp cfin0 ; goto cfin0;
;;
.instruction mwt , setpsw ;
;;
;; param:: none;
;; stack:: -> ;
;;
mwt10: ;
,,cjs testtimer ; if own.timer>0 then
,,cjp b0 mwt20 ;
,,cjs not zro deschedule ; deschedule;
mwt20: ;
ra:=reg,,cjp mwc ; goto sendcontrol;
;;
.instruction mwis , setpsw ;
;;
;; param:: none;
;; stack:: semadr, refadr: addr -> semadr, refadr: addr;
;;
mwis10: ;
w0 and pst,s, ; if timer in wcause
,,cjp zro mwis20 ; and own.timer<=0 then
,,cjs testtimer ; goto sendcontrol;
,,cjp zro mwc ;
,,cjp b0 mwc ;
mwis20: ;
,,cjs cget4 ; semadr,refadr:= cget4;
c:w0-w0,,cjs wait0 ; wait0(mwait,semadr,refadr);
ra:=reg,,cjp mwc ; goto sendcontrol;
.p ;
;;
.instruction mwit , setpsw , mwt10 ;
;;
;; param:: none;
;; stack:: -> ;
;;
;;
.instruction mwst , setpsw , mwis10 ;
;;
;; param:: none;
;; stack:: semadr,refadr: addr -> semadr,refadr: addr;
;;
;;
.instruction mwist , setpsw , mwis10 ;
;;
;; param:: none;
;; stack:: semadr,refadr: addr -> semadr,refadr: addr;
;;
.p ;
;;
;; sendcontrol
;;
;; entry: ra= reg;
;; exit : to cfin0;
;;
mwc: ;sendcontrol:
q:=zd1,, ;
q and psc,s, ; if control in reg.ps.wait then
slu:=zd,,cjp zro cfin0 ; begin
q and pss,s, ; if sem in reg.ps.wait then
,,cjp zro mwc10 ; slu:= slu-8; (* unstack sem,ref *)
slu:=slu-8,, ;
mwc10: ;
slb:=zd2,, ;
,,cjs readluc ; (spb,slu):= (pb,lu); readluc;
c:=w4:=0c0,h , ; func:= control;
w3:=bd,h w s,cjs terror ; control:= waitmem; terror;
w0:=reg,,push 2 ;
w0:=>w0,,rfct ; dev:= reg shift (-3);
,,cjs xmitword ; xmitword(dev,func,control);
,,cjp cfin0 ; end; goto cfin0;
;;
.instruction mcis , setpsw , mwis10 ;
;;
;; param:: none;
;; stack:: semadr, refadr: addr; control: word ->
;; semadr, refadr: addr; control: word;
;;
.p ;
;;
.instruction mcit , setpsw , mwt10 ;
;;
;; param:: none;
;; stack:: -> ;
;;
;;
.instruction mcist , setpsw , mwis10 ;
;;
;; param:: none;
;; stack:: semadr, refadr: addr; control: word ->
;; semadr, refadr: addr; control: word;
;;
.p ;
;;
.instruction mwtac ;
;;
;; param:: none;
;; stack:: semadr,refadr: addr or empty -> caseval: word;
;; caseval: 0: interrupt
;; 1: message
;; 2: timer
;;
w4:=zd1,, ;
w4 and pss,s, ; if -,(sem in reg.ps.wait)
w2:=spb,,cjp zro mwtac20 ; then goto testtimer;
w1:=slu-7,, ;
,,cjs cread65 ; refadr:= cread65(slu-3);
,,cjs cread1 ; ref.b:= cread1(refadr);
ra:=reg,,cjp b1 mwtac20 ; if nill(ref.b) then goto testtimer;
w3:=1,, ; caseval:= msgcase;
mwtac10: ;pfetch: (*w3= caseval *)
ra:=reg,,cjs setslice1 ; setslice;
w4:=zd1,, ;
w4 and pss,s, ; if sem in reg.ps.wait then slu:= slu - 8;
,,cjp zro mwtac15 ;
slu:=slu-8,, ;
mwtac15: ;
w4 and psc,s, ;
,,cjp zro mwtac16 ; if control in reg.ps.wait then
slu:=slu-2,, ; slu:= slu - 2;
mwtac16: ;
w0:=,,cjs setpswait ; setpswait((..));
sic:=sic++,,cjp wrfetch ; goto wrfetch(caseval);
mwtac20: ;testtimer:(*ra=reg,w4=reg.ps.wait,w6=spb*)
w4 and pst,s, ; if -,(timer in reg.ps.wait)
,,cjp zro mwtac30 ; then goto inttest;
w5:=rd1,, ;
w5:=w5+timer,, ; (* mtime already removed p from sem *)
,,cjs cread1 ; t:= cread1(own.timer);
w3:=2,, ; if t > 0 then goto inttest;
,,cjp zro mwtac10 ; caseval:= timercase; goto pfetch;
,,cjp b0 mwtac10 ;
.p ;
mwtac30: ;inttest:
w4 and psi,s, ; if -,(intrp in reg.ps.wait)
,,cjp zro mwtac40 ; then goto repeatins;
w4 and pss,s, ; if sem in reg.ps.wait then
w3:=,,cjp zro mwtac10 ; begin (* unlink own from sem *)
w4:=zd2,, ;
w10:=rd1,, ; w43:= nbd:= own;
,,cjs cget4 ; refadr,semadr:= cget4;
w3:=w10,,cjs reservea ; lbd a:= reservea(hbd a=semadr);;
,,cjs unchain ; unchain(mbd,hbd a,lbd a);
,,cjs nill ; setchainhead(nill);
w10:=swp,,cjs setchhead ; end; (* unlink own from sem *)
w3:=,,cjp mwtac10 ; caseval:= intrpcase; goto pfetch;
;;
;; no criteria fullfilled.
;; repeat instruction at next activation.
;;
mwtac40: ;repeatins:
ra:=reg,,cjs deschedule ; deschedule;
,,cjp sfetch ; goto sfetch;
.p ;
;;
.instruction mtime ;
;;
;; (* must execute on level 0 with system-sem locked *)
;; param:: none;
;; stack:: p: addr -> ;
;;
,,cjs readluc ; readluc;
w3:=bd,h w s,cjs readluct ; p.d:= waitmem; readluct;
w4:=bd,h w s,cjs rterror ; p.b:= waitmem; therror;
mctc10: ;rep: (*w43=p, stat(p.b) set *)
w3:=w3++,,cjp b1 fetch ; if nill(p) then goto fetch;
w5:=w3+timer,, ;
w6:=w4,,cjs cread1 ; t:= cread1(p.timer);
,,cjp zro mctc70 ; if t<=0 then goto nextp;
w1:=w1--,s,cjs not b0 cwrite1; cwrite1(p.timer,t-1);
,,cjp not zro mctc70 ; if t-1<>0 then goto nextp;
w5:=w3+level,, ;
,,cjs creadbyte1 ; l:= creadbyte1(p.level);
w11:=w1,,cjp zro mctc20 ; if l<>0 then
,,push 2 ; begin (* driver timeout *)
ra:=w1:=w1++w1,,rfct ; ra:= l*8+7;
rd2,,s, ; if p.reg.ib.dummyreg then
,,cjp b1 mctc50 ; goto alreadyscheduled;
w1:=zd1,, ; ps:= p.reg.ps;
w1:=w1 ior 4,, ; p.reg.ps:= ps ior to;
zd1:=w1,, ;
w0:=w11,,cjs setlint ; setinterrupt(l);
ra:=reg,,cjp mctc30 ; end (* driver timeout *)
mctc20: ; else (* level 0 proc timeout *)
w5:=w3+dumpps,, ;
,,cjs cread1 ; ps:= cread1(p.dumpps);
mctc30: ;
w1 and pst,s, ; if not(timer in ps) then
,,cjp zro mctc50 ; goto alreadyscheduled;
w10:=w1,,cjs setrair ; setrair;
w5:=w3+chainhead,, ;
,,cjs cread21 ; w21:= cread21(p.chainhead);
w10 and pss,s, ; if sem in ps
w2,s,cjp zro mctc40 ; and -,nill(p.chainhead)
w1,s,cjp b1 mctc40 ; and semtype(p.chainhead) then
w8:=w2,,cjp b15 mctc40 ; begin (* unlink(p.chainhead) *)
w7:=w1,,cjs reservea ; lbd a:= reservea(hbd a=p.chainhead);
,,cjs unchain ; unchain(p,hbd a,lbd a);
w6:=w4,,cjs nill ; p.chainhead:= nill;
w2:=swp,, ;
w5:=w3+chainhead,, ;
w1:=w2,,cjs cwrite1 ; mem(p.chainhead):= nill;
mctc40: ; end; (* unlink p from sem *)
;;
;; schedule p
;;
w11,s, ; if p.level=0 then
w2,s,cjp not zro mctc50 ; begin (* linklast p to p.actqueue *)
w1,s,cjp b1 mctc45 ; if -,nill(p.chainhead) and
,,cjp b15 mctc50 ; -,semtype(p.chainhead)
mctc45: ; then goto alreadyscheduled;
w1:=w3+actq,, ;
w2:=w4,,cjs cread65 ; hbd b:= cread65(p.actqueue);
w9:=w5,, ;
w10:=w6,,cjs reserveb ; lbd b:= reserveb(hbd b);
,,cjs setchhead ; setchainhead(p.actqueue);
c:w0-w0,,cjs chain ; chain(p,hbd b,lbd b,true);
mctc50: ; end else (* startdriver *) ;
ra:=reg,,cjs setslice1 ;alreadyscheduled:
slu:=slu-4,, ; setslice; slu:= slu-4;
sic:=sic++,, ; sic:= sic+1;
mctc70: ;nextp:
w1:=w3+tchain,, ;
ir:=w2:=w4,,cjs cread65 ; sync itr; p:= cread65(p.tchain);
int,w3:=w5,h ,cjs testint1 ;
w4:=w6,s,cjp zro mctc10 ; if -,testint then goto rep;
sic:=sic--,,cjp wr34fetch ; sic:= sic-1; goto wr34fetch(p);
;;
;; end of lmitxt075
;;
.p ;
▶EOF◀