|
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: 36864 (0x9000)
Types: TextFile
Names: »corout4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »corout4tx «
b. f50, e21, g1 w.
; Modes in activity and coroutines system:
; no name rs77 rs78 rs85 rs90 mode_group
; 8 neutral ? 0 0 0
; 17 monitor ? + 0 addr (even) )
; 18 activity + - + addr (even) ) act_modes
; 20 disable + - - addr (even) )
; 33 sem_monitor ? + 0 addr+1 (odd) )
; 34 sem_activity + - + addr+1 (odd) ) sem_modes
; 36 sem_disable + - - addr+1 (odd) )
; when used as wordaddr: addr (even) == addr+1 (odd)
; rs77 : current activity (table entry addr)
; rs78 : no of activity
; rs85 : current activity no
; rs90 : enable entry point
\f
d.
p.<:fpnames:>
l.
; Following letters are used in address and variabels:
; a : declared in local block
; b : declared on segment, reference to other segment
; c : declared on segment, absword for own variabels
; d : declared on segment, address and variabels
; e : declared commen for all segment, entries and counters
; f : trim parameters
; j : declared on segment, reference to rs entries and headword
e0= 0
f0 = 10 ; number of system coroutiness
f1 = 3 ; log2(coroutines element size in hw)
f2 =f0<f1 ; room for system coroutiness
f3 = 4 ; log2(coroutine element size in hw)
f4 = 1<f3 ; coroutine element size in hw
f5 =-64 ; offset i/o coroutines
f6 =-72 ; offset ready coroutines
f7 =-48 ; offset free coroutines
f9 = -4 ; message queue offset inside coroutines
f10= 0 ; parametercheck
f11= 42 ; no of hw in own core
; offset in: coroutine descr: message head:
f19 = 10 ; message head size
f18 = -8 ; referencevariabel dopeaddr
f16 = -6 ; priority priority
f14 = -4 ; message addr message size
; -2 forward chain forward chain
; 0 backward chain backward chain
; 2 wait_select (1) message ident (1) & message (1)
f24 = 4 ; wait_select (2) message ident (2) & message (2)
f26 = 6 ; time to timeout (message (3))
f28 = 8 ; coroutine no (message (4))
\f
s. j0 w. ; start head segment
k=0
j0: 0 ; headword
f20=3
h. ks,r.494+j0. - (:f20*12:) w.
e1: f20 ; no of externals
0; no of byte to permanent core
<:passivate:>,0,1<18,0
<:activate:>,0,5<18 + 19<12,0 ; long procedure(int addr);
<:outrec6:>,0,3<18 + 13<12 + 8<6 , 0 ; integer procedure(zone,int val)
s3
s4
0,r.5
e0=e0+1
e2=e0
\f
b. b9, j90, c41 , g3 , d6 w.
k=10000
g0=f20
h.
j0 : g1 , g2 ; rel of last point, rel of last absword
j3 : g0 + 3, 0 ; rs entry 3: reserve
j4 : g0 + 4, 0 ; rs entry 4: take expression
j8 : g0 + 8, 0 ; rs entry 8: end address expression
j13: g0 + 13, 0 ; rs entry 13: last used
j18: g0 + 18, 0 ; rs entry 18: zone index alarm
j21: g0 + 21, 0 ; rs entry 21: general alarm
j30: g0 + 30, 0 ; rs entry 30: saved sref, saved w3
j78: g0 + 78, 0 ; rs entry 78: no of activities
j80: g0 + 80, 0 ; rs entry 80: aref (sref for activity decl block)
j85: g0 + 85, 0 ; rs entry 85: current activity no
j89: g0 + 89, 0 ; rs entry 89: disable point.
j90: g0 + 90, 0 ; rs 90: enable entry point. odd in coroutines modes!
b3: 1<11 o. (:3-e0:),0 ; absword for segment 3
b6 : 3, b5 ; absword for outrec6
w.
c1 : 1 ; own integer max_sem
c3 : 3 ; own integer sem_basis
c5 : 5 ; own integer cor_last
c7 : 7 ; own integer cor_basis
c15: 15 ; own long basis_time
c29: 29 ; own long zone formal
c33: 33 ; own integer test record testtype
c37: 37 ; own integer test record messsize/key
c41: 41 ; own integer test record semaphore
g2 = -2-j0.
g1 = -2-j0.
d3: 0 ; return addr in act_reserve
d4: 0 ; modemask in check mode
\f
b. a10 w.
a0:<:<10>p-mode :>
d0: al w1 63 ;
d1: rs. w1 d4. ; store mode check mask
rl. w2 (j13.) ;
ds. w3 (j30.) ;
al w1 8 ; neutral:=8;
rl. w0 (j85.) ; w0:=current activity no
sl w0 1 ;
al w1 9 ;
sh w0 -1 ;
al w1 11 ;
rl. w0 (j90.) ; w0:=enable entry point + if sem_modes then 1 else 0;
se w0 0 ;
al w1 x1+9 ;
sz w0 1 ;
al w1 x1+16 ;
al. w0 a0. ; load errortext.addr
sz. w1 (d4.) ;
jl. (j21.) ; general alarm
jl. a1. ;
d5: rl. w2 (j13.) ; commen start for procedurer in sem_monitor mode
ds. w3 (j30.) ;
rl. w0 (j85.) ;
rl. w1 (j90.) ;
sn w0 0 ; if programmode=disable or activity or
so w1 1 ; programmodegroup<>sem_group
jl. d0. ; call modealarm
a1: dl w1 x2+8 ; load first formal
jl x3 ; return
e.
\f
; intern procedure act_reserve(size)
; reg call return
; w0 - first word
; w1 size last word
; w2 old staktop new staktop
; w3 return address
b. a3 w.
a0: <:<10>c-level :>
a1: al. w0 a0.+1 ; level error (excl number)
jl. (j21.) ; call general alarm
d2: ac w1 x1 ; w1:=-size
ea w1 x2+4 ; +appetite;
al w0 x3 ;
ws. w0 (j0.) ; w0:=return addr rel to segm start
rl. w3 (j80.) ; w3 := aref (sref for activity decl block);
se w3 (x2) ; if aref <> call sref then
jl. w3 a1. ; level_alarm
jl. w3 (j3.) ; call rs reserve
ds. w3 (j30.) ;
rs. w0 d3. ; store rel return
rl w0 x2+4 ; new return inf:= old return inf;
dl w3 x2+2 ;
rs w0 x1+4 ;
ds w3 x1+2 ;
dl. w3 (j30.) ;
rx w2 2 ; w2:=:w1
ds. w3 (j30.) ; store newstacktop
ea w1 0 ; w1:=old stacktop + old appetite
al w1 x1+4 ;
al w3 x1 ;
al w0 0 ; w0 := 0;
hs w0 x2+4 ; new appetite:=0;
; zeroset
a2: rs w0 x3 ;
al w3 x3-2 ;
se w3 x2+4 ; reset until return inf
jl. a2. ;
al w0 x2+6 ; first word:=staktop - 6;
rl. w3 (j80.) ;
rs w0 x3-2 ; block(aref).last_used:=first word
rl. w3 d3. ; w3:=return rel to segmstart
jl. w3 x3+j0. ; return
e.
\f
b. a2 w.
e3 = 1<23 + e0<12 - e2<12 - j0. ; procedure coroutines(sem_no);
rl. w1 c1. ; addr of first own
al w2 x1+f11-2 ; addr of last own
al w0 0 ;
a2: rs w0 x2 ; 'owns':=0;
al w2 x2-2 ;
se w2 x1
jl. a2. ;
rs w1 x1+22 ; "c23:=addr of first core"
al w1 63-17 ; programmode must be act_monitor
jl. w3 d1. ; get stackref and first formal, check programmode
so w0 16 ; if kind < 16 then
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
rl w1 x1 ; w1:=sem_no
c.f10
sh w1 -1 ; if sem_no<0 then
jl. w3 (j18.) ; then alarm(<:index:>);
z.
dl w0 x2+12 ; load testzone formal
ds. w0 (c29.) ; store testzone formal in own core
rs. w1 (c1.) ; max_sem:=sem_no;
ls w1 f1 ; coroutines table size:=sem_no*8
al w1 x1+f2 ; + system coroutines table size;
jl. w3 d2. ; call act_reserve(size);
\f
;insert dummy chain
a0: rs w1 x1 ; backward chain:=own
rs w1 x1-2 ; forward chain :=own element
al w1 x1-4 ; next element
sl w1 (0) ; if w1>=w0 then goto a0
jl. a0. ;
al w1 x1+f2 ; w1:=sembasis:=first_word-2
rs. w1 (c3.) ; + system coroutines table size
rl. w1 (j90.) ;
al w1 x1+1 ;
rs. w1 (j90.) ; mode:=sem_monitor; modegroup:=sem_modes;
rl. w1 (j78.) ; get activity no
al w1 x1+1 ; add room fo cor(0)
ls w1 f3 ; coroutine_descr_size:=coroutine no*16;
jl. w3 d2. ; call act_reserve(size);
rl. w0 (j78.) ; w0:=coroutine_no;
al w1 x1-f28 ; last coroutine descr:=last_word-last field
rs. w1 (c5.) ;
rl. w3 (c3.) ; w3:=sem_basis
al w3 x3+f7 ; + free sem offset
a1: rs w0 x1+f28 ; cordescr.corno:=no;
rl w2 x3-2 ; w2:=first cor;
rs w1 x2 ;
rs w1 x3-2 ;
ds w3 x1 ;
bs. w0 1 ; no:=w0:=w0-1;
al w1 x1-f4 ; w1:=prior coroutine
se w0 0 ; if no>0 then goto a1
jl. a1. ;
rs. w1 (c7.) ; store cordescr basis
rl w3 108 ; w3:=clock(0:23)
ds. w0 (c15.) ; basis_time := clock(0:23),0;
rl. w3 (b3.) ; get absword for 3. segment
jl x3+e17 ; goto compute activity descr size
e.
\f
b. a3 w.
e4 = 1<23 + e0<12 - e2<12 - j0. ; procedure allocate(sem, size, prio);
jl. w3 d5. ; call commen start in sem_monitor mode
al w3 x2+8 ; load addr(first formal)
a0: dl w1 x3 ; load formal
sn w0 26 ; if value then goto next
jl. a1. ;
rs w3 x2+6 ; store addr(this formal)
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
rl w3 x2+6 ; load addr(this formal)
rs w1 x1 ; store addr(value)
a1: al w3 x3+4 ; next formal
sh w3 x2+16 ; if formal<= last formal
jl. a0. ;
rl w1 (x2+8) ; load sem
c.f10
rl. w3 (c1.) ;
sh w1 x3 ; if sem > maxsem
sh w1 -1 ; or sem < 0 then
jl. w3 (j18.) ; then alarm(<:index:>);
z.
\f
ls w1 f1 ; semaddr:=sem*8
al w3 x1 ;
wa. w3 (c3.) ; + sem_basis;
el w0 (x2+16) ; load prio (-2048<=prio<=2047)
ds. w0 (c41.) ; store temp in next_timeout
rl w1 (x2+12) ; load messagesize
sh w1 5 ; if messagesize<6
al w1 6 ; then messagesize:=6;
rs. w1 (c37.) ; store in own temp
al w1 x1+f19 ; add messageheadsize
jl. w3 d2. ; call act_reserve
al w1 x2+4+f19; messageaddr:=stacktop + size(retur inf) + messageheadsize -2;
dl. w0 (c41.) ; w0:=prio; w3:=semaddr;
rs w0 x1+f16 ; store prio
rl. w0 (c37.) ; load messagesize
rs w0 x1+f14 ; store size
rs w0 x1+f24 ; store messagesize in message ident(2)
al w2 x1+1 ; w2:=element addr
al w1 x3 ; w1:=coroutines coroutine chain
rl. w3 (b3.) ;
jl w3 x3+e21 ; call signal
e.
\f
;intern procedure create_test_record
; the procedure perform following:
; disable outrec6(testzone,16);
; testzone(4):=clock;
; testzone(3):=rs85; <* current coroutine *>
b. a4 w.
e12 = 1<23 + e0<12 - e2<12 - j0. ; prepare_test
rl. w1 (j90.) ;
so w1 1 ; if not sem_modes
jl. w3 d0. ; mode alarm
al w0 1<10 ; user testrecord
rs. w0 (c33.) ;
ld w0 -100 ;
ds. w0 (c37.) ;
ds. w0 (c41.) ;
e20= -j0.
a0:
rl. w2 (j13.) ;
ds. w3 (j30.) ;
al w0 0 ; disable
rl. w1 (j89.) ;
jl. w3 (j4.) ;
al w1 -16 ; reserve 16 hw
jl. w3 (j3.) ;
rl. w3 j0. ; get own segment segmenttable addr.
ds w3 x1+2 ; store stackref,return segment segmenttable addr.
rl. w3 a1. ; load appetite + rel return
rs w3 x1+4 ; store
dl. w0 (c29.) ; load testzone formal
ds w0 x1+8 ;
al w3 26 ; kind=26 (integer value)
al w0 x1+14 ; addr of second parameter
ds w0 x1+12 ;
al w3 16 ; value=16
rs w3 x1+14 ;
rl. w3 (b6.) ; call outrec6
jl w3 x3+0 ;
b5 = -j0. -1
\f
al w0 0
rl. w1 (j90.) ; enable
jl. w3 (j4.) ;
rl. w1 (c29.) ; testzone basisaddr
rl w1 x1 ; w1=addr(testzone(0))
rl. w0 (c33.) ;
dl. w3 (c37.) ;
rs w0 x1+2 ;
sh w0 3 ; if testvalue < 4 then
jl. a3. ; goto insert message
la. w0 a2. ; change testvalue
rs. w0 (c33.) ;
ds w3 x1+6 ;
dl. w3 (c41.) ;
ds w3 x1+10 ;
dl w3 110 ;
ds w3 x1+16 ; testzone(4):=clock;
rl. w3 (j85.) ; get current coroutineno
rs w3 x1+12 ;
se w0 0 ; if testvalue > 0 then
jl. a0. ; testoutrec6(testzone,message);
jl. (j8.) ; return
a1: 10<12 + b5 + 1 ; appetite + rel return from outrec6 call
a2: 3
a3: dl w0 x2+4 ; copy message (messageaddr in c35) to testzone:
ds w0 x1+6 ;
dl w0 x2+8 ;
ds w0 x1+10;
dl w0 x2+12;
ds w0 x1+14;
rl w0 x2+14;
rs w0 x1+16;
jl. (j8.) ; return
e.
\f
c. -j0. - 506
m.code too long on segment 1
z.
c. j0. + 502
h. 0,r.504 + j0. w.
z.
<:coroutines:>
e0=e0+1
e.
\f
b. b5, j90, c41 , g3 , d8 w.
k=10000
g0=f20
h.
j0 : g1 , g2 ; rel of last point, rel of last absword
j4 : g0 + 4, 0 ; rs entry 4: take expression
j6 : g0 + 6, 0 ; rs entry 6: end register expression
j8 : g0 + 8, 0 ; rs entry 8: end address expression
j13: g0 + 13, 0 ; rs entry 13: last used
j18: g0 + 18, 0 ; rs entry 18: zone index alarm
j21: g0 + 21, 0 ; rs entry 21: general alarm
j29: g0 + 29, 0 ; rs entry 29: param
j30: g0 + 30, 0 ; rs entry 30: saved sref, saved w3
j38: g0 + 38, 0 ; rs entry 38: spare message buf
j78: g0 + 78, 0 ; rs entry 78: no of activities
j79: g0 + 79, 0 ; rs entry 79: activity table basis
j85: g0 + 85, 0 ; rs entry 85: current activity no
j90: g0 + 90, 0 ; rs entry 90: enable entry point. odd in coroutines modes!
b1: 1,b0 ; absword for passivate
b2: -1,0 ; absword segment 1
b4: 2,b3 ; absword for activate
w.
c3 : 3 ; own integer sem_basis
c7 : 7 ; own integer cor_basis
c9 : 9 ; own integer sem_ext_mess
c11: 11 ; own integer timeout_time
c15: 15 ; own long basis_time
c25: 25 ; own integer activity descr size
c31: 31 ; own integer corout_test
c33: 33 ; own integer test record testtype
c35: 35 ; own integer test record 1. word
c39: 39 ; own integer test record 3. word
c41: 41 ; own integer test record sem word
g2 = -2-j0.
h.
b5: -1,e20 ; point testoutrec6
w.
g1 = -2-j0.
d8 : 0 ; used in modecheck and schedule
\f
b. a10 w.
a0:<:<10>p-mode :>
d0: al w1 63 ;
d1: rs. w1 d8. ; store mode check mask
rl. w2 (j13.) ;
ds. w3 (j30.) ;
al w1 8 ; neutral:=8;
rl. w0 (j85.) ; w0:=current activity no
sl w0 1 ;
al w1 9 ;
sh w0 -1 ;
al w1 11 ;
rl. w0 (j90.) ; w0:=enable entry point + if sem_modes then 1 else 0;
se w0 0 ;
al w1 x1+9 ;
sz w0 1 ;
al w1 x1+16 ;
al. w0 a0. ; load errortext.addr
sz. w1 (d8.) ;
jl. (j21.) ; general alarm
jl. a1. ;
d2: rl. w2 (j13.) ; commen start for procedurer in sem_monitor mode
ds. w3 (j30.) ;
rl. w0 (j85.) ;
rl. w1 (j90.) ;
sn w0 0 ; if programmode=disable or activity or
so w1 1 ; programmodegroup<>sem_group
jl. d0. ; call modealarm
a1: dl w1 x2+8 ; load first formal
jl x3 ; return
e.
\f
; intern procedure timeout check
; reg call return
; w0 - first cor on readysem
; w1 - undefined
; w2 - undefined
; w3 return addr.
b. a15 w.
a0: 0 ; temp last coroutine in timeout test. return addr in testevent
a1: 0 ; dif in timeout test. messagebuf. addr in testevent.
a2: 1<19 ; stddif
a4: 0 ; return addr
a14: (:-1:)>1; Max. integer for timeout
a13: rl. w1 a14.
rs. w1 a1.
dl w1 110
jl. a15.
e19 = -j0.
d6: rs. w3 a4. ; store returnaddr
dl w1 110 ;
ss. w1 (c15.) ; dif:=(kl-basistime) shift -10;
ld w1 -10 ;
se w0 0 ; Check overflow of clock at clock change
jl. a13.
rl. w2 (c11.) ; w2:=timeout_time;
sh w1 x2-1 ; if dif>=timeout_time then test for timeout
jl. a8.
rs. w1 a1. ;
ld w1 10 ;
aa. w1 (c15.) ;
a15: ds. w1 (c15.) ; basis_time:=basis_time+extend dif shift 10
rl. w1 a2. ;
rs. w1 (c11.) ; timeout_time:=stddif;
dl. w1 (c7.) ; w0:= cor last; w1:= cor_basis;
rs. w0 a0. ; store lastcoroutine in a0
\f
a5: al. w3 0 ; w3 := a5; return point from linkprio
a6: sl. w1 (a0.) ; if last cor then goto a8
jl. a8. ;
al w1 x1+f4 ; next coroutine descr.
rl w2 x1+f26 ;
sh w2 0 ; if timeout<=0 goto next
jl. a6. ;
ws. w2 a1. ; timeout:=timeout-dif;
sh w2 0 ; if timeout then
jl. d3. ; call unlink linkprio readysem. return to a5
rs w2 x1+f26 ; store new time to timeout
am. (c11.) ;
sh w2 (+0) ; if time_to_timeout(cor) < timeout_time
rs. w2 (c11.) ; then timeout_time:=time_to_timeout(cor)
jl. a6. ;
; check for call of test event:
a8: rl. w3 (c3.) ; get sembasis
rl w1 x3+f6-2 ; w1:=first of ready chain
sn w1 x3+f6 ; if ready chain empty
jl. a7. ; goto testevent
rl w0 x1+f16 ; get prio of first cor on ready_sem
rl w1 x3+f5-2 ; w1:=first of i/o chain
se w1 x3+f5 ; if i/o sem empty
sh w0 (x1+f16) ; or prio(ready) > prio(i/o) then
jl. a9. ; nocheck
a7: jl. w3 d7. ; call test event
rl. w3 (c3.) ; get sembasis
a9 : rl w2 x3+f6-2 ; get first of ready sem
al w0 0 ; result := 0;
se w2 x3+f6 ; if ready sem not empty
rl w0 x2+f28 ; then get number of first coroutine
jl. (a4.) ; return
\f
d7: al w2 0 ;
rs. w2 (c9.) ; sem_ext_mess:=0;
rs. w3 a0. ; store return addr
a10:
a12: jd 1<11+66 ; call monitor testevent
sn w0 -1 ; if empty
jl. (a0.) ; return
am. (j38.) ;
sn w2 (-6) ; if spare mess buf
jl. a12. ; then skip
se w0 1 ; if message
jl. a11. ; then count message
rl w1 x2-2 ; get corno
sh w1 -1 ;
ac w1 x1 ;
am. (j78.) ;
sh w1 (+0) ; if actno>no of activities or
sh w1 0 ; actno<=0
jl. a11. ; then skip answer;
wm. w1 (c25.) ; activity descr addr:= corno*18
wa. w1 (j79.) ; + activity basis
al w0 2 ;
se w0 (x1+8) ;
jl. a11. ;
rl w3 (x1+4) ; see w_activity
rl w3 x3+h0+4 ;
se w2 (x3+0) ;
jl. a11. ;
rl w1 x2-2 ; get corno
sh w1 -1
ac w1 x1
ls w1 f3 ; coraddr:=corno*18
wa. w1 (c7.) ; + corbasis
rs. w2 (c39.) ; store messagebuf addr
jl. w3 d3. ; unlink linkprio readysem
rl. w2 (c39.) ; get messagebuf addr
jl. a10.
a11: al w3 1 ; co_8000_event:=1;
rs. w3 (c9.) ;
jl. a10. ;
e.
\f
; intern procedure unlink linkprio
; reg call return
; w0 semaddr * prio
; w1 element element
; w2 - after element
; w3 return addr before element
; *) not used in entry d3!
b. a2 w.
a0:0
d3: rl. w2 (c3.) ;
al w0 x2+f6 ; w0:=ready sem
al w2 0 ;
rs w2 x1+f26 ; time_to_timeout:=0;
d5: rs. w3 a0. ; store returnaddr
dl w3 x1 ; unlink element
rs w3 x2 ;
rs w2 x3-2 ;
a1: rl w3 0 ;
rl w2 x1+f16 ; get element.prio
al w0 x2-1 ;
a2: rl w3 x3 ; next element
sl w0 (x3+f16) ;
jl. a2. ;
rl w2 x3-2 ;
rs w1 x2 ; link
rs w1 x3-2 ;
ds w3 x1 ;
jl. (a0.) ; return
e.
\f
b. a0 w.
a0: 4<12 + 17
e7 = 1<23 + e0<12 - e2<12 -j0. ; entry initref(ref);
al w1 24 ; not allowed in neutral and activity mode
jl. w3 d1. ;
ws. w0 a0. ;
sl w1 (x1) ; if addr.field > addr.dope or
sz w0 -4 ; then param not( integer or boolean or long or real ) array
jl. w3 (j29.) ;
ld w0 -100 ; w3,w0:=0;
ds w0 x1+4 ; ref.maxfield:=ref.minfield:=0;
rs w1 x1 ; insert nilma
jl. (j8.) ;
e.
\f
e8 = 1<23 + e0<12 - e2<12 - j0. ; entry cor_to_sem(sem,cor);
jl. w3 d2. ; call commen start for procedurer in sem_monitor mode
se w0 26 ; if not int addr
jl. w3 (j29.) ; then param
rl w1 x1 ; get sem
c.f10
sh w1 -1 ; if sem>=0 or
sh w1 -1-f0 ; or sem< f0
jl. w3 (j18.) ; then alarm(<:index:>,index);
z.
rs. w1 (c41.) ; store sem in testrecord sem
dl w1 x2+12 ; get cor formal
c.f10
se w0 26 ; if parameter not integer value
jl. w3 (j29.) ; then param
z.
rl w1 x1 ; get cor
c.f10
rl. w3 (j78.) ;
sh w1 x3 ; if cor>no of activities or mode<>sem_monitor or
sh w1 0 ; cor<=0 then
jl. w3 (j18.) ; alarm(<:index:>,index);
z.
rs. w1 (c35.) ; store corno
ls w1 f3 ; coraddr:= corno*16
wa. w1 (c7.) ; + cor_basis;
rl. w0 (c41.) ; w0:=sem
as w0 f1 ; semaddr:=(sem*8)
wa. w0 (c3.) ; + sembasis;
jl. w3 d5. ; call unlink linkprio(sem)
al w0 64 ; testtype=c_to_s
la. w0 (c31.) ;
sn w0 0 ; if no test
jl. (j8.) ; return
rs. w0 (c33.) ; store testtype
rl. w3 (b2.) ; get absword testoutrec6
jl x3+e20 ; goto testoutrec6, return direct.
\f
e9 = 1<23 + e0<12 - e2<12 - j0. ; long procedure schedule(cor);
jl. w3 d2. ; call commen start for procedurer in sem_monitor mode
c.f10
zl w3 x2+4 ; load appetite
sh w3 4 ; if param(1) is constant or expression or
se w0 26 ; if not integer addr
jl. w3 (j29.) ; then param
z.
rs. w1 d8. ; store address of parameter cor
jl. w3 d6. ; call time/event test
rs. w0 (d8.) ; store corno
al w1 0 ;
sn w0 0 ; if no coroutine found
jl. (j6.) ; return. result:=(w0,w1) (=0)
al w3 128 ; testtype=activ
la. w3 (c31.) ;
ds. w0 (c35.) ; store testtype and corno in testrecord
rl. w1 b5. ; get testoutrec6 point
se w3 0 ; if test then
jl. w3 (j4.) ; call testoutrec6
rl. w3 (b4.) ; get activate segmentaddr
jl x3+0 ; call activate, use startcor returninf;
b3 = -1-j0.
\f
e11 = 1<23 + e0<12 - e2<12 - j0. ; procedure set_priority(prio);
al w1 63-34 ; only allowed in sem_activity
jl. w3 d1. ; get stackref and first formal, check programmode
so w0 16 ; if expression
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
el w2 x1 ; get prio( -2048<=prio<=2047 )
rl. w1 (j85.) ; get corno
ls w1 f3 ; coraddr:=corno*16
wa. w1 (c7.) ; + corbasis;
rs w2 x1+f16 ; store new prio
jl. w3 d3. ; call unlink linkprio readysem
rl. w3 (b1.) ; get segmentaddr of passivate
jl w3 x3+0 ; call passivate( return inf := return inf of corprio)
b0 = -1-j0.
c. -j0. - 506
m.code too long on segment 2
z.
c. j0. + 502
h. 0,r.504 + j0. w.
z.
<:schedule:>,0
e0=e0+1
e.
\f
b. b2, j90, c41 , g3 , d10 w.
k=10000
g0=f20
h.
j0 : g1 , g2 ; rel of last point, rel of last absword
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
j18: g0 + 18, 0 ; rs entry 18: zone index alarm
j21: g0 + 21, 0 ; rs entry 21: general alarm
j29: g0 + 29, 0 ; rs entry 29: param
j30: g0 + 30, 0 ; rs entry 30: saved sref, saved w3
j78: g0 + 78, 0 ; rs entry 78: no_of_activities
j79: g0 + 79, 0 ; rs entry 79: activity table basis
j80: g0 + 80, 0 ; rs entry 80: aref (sref for activity decl. block)
j85: g0 + 85, 0 ; rs entry 85: current activity no
j90: g0 + 90, 0 ; rs entry 90: enable entry point. odd in coroutines modes!
b2 : -1, 0 ; absword for segment 2
w.
c1 : 1 ; own integer max_sem
c3 : 3 ; own integer sem_basis
c7 : 7 ; own integer cor_basis
c11: 11 ; own integer timeout_time
c15: 15 ; own long basis_time
c17: 17 ; own integer max_waittime
c21: 21 ; own long wait_select
c25: 25 ; own integer activity descr size
c31: 31 ; own integer corout_test
c33: 33 ; own integer test record testtype
c35: 35 ; own integer test record messaddr/key(1)
c37: 37 ; own integer test record messsize/key(2)
c39: 39 ; own integer test record semno
c41: 41 ; own integer test record sem
g2 = -2-j0.
h.
b0: -2, e20 ; testoutrec6 point
w.
b1 : 1<12 ; passivate point
g1 = -2-j0.
d9: 0 ; used in unlink/link and signal/wait
\f
; intern procedure compare
; reg call return
; w0 - undefined
; w1 coroutine_descr.
; w2 message_descr.
; w3 addr*
; *) found: returnaddr=w3+2, not found: returnaddr=w3-6;
b. a0 w.
d2: rl w0 x1+4 ; get wait_select(2)
sn w0 0 ; if wait_select(2)=0 then
jl. a0. ; goto check(1)
sn w0 (x2+4) ; if wait_select(2)=messageident(2)
jl. a0. ; then goto check(1)
sl w0 0 ; if wait_select>=0 then
jl x3-6 ; return (not found)
la w0 x2+4 ;
sn w0 0 ; if wait_select(2) and messageident(2) = 0
jl x3-6 ; then return (not found)
a0: rl w0 x1+2 ; entry check(1) (equal check(2))
sn w0 0 ;
jl x3+2 ; return (found)
sn w0 (x2+2) ;
jl x3+2 ; return (found)
sl w0 0 ;
jl x3-6 ; return (not found)
la w0 x2+2 ;
sn w0 0 ;
jl x3-6 ; return (not found)
jl x3+2 ; return (found)
e.
; intern procedure comp semnr/call testoutrec6
d0: rs. w0 (c33.) ; store type
d1: rl. w2 (j13.) ; get stackref
rl w1 x2+8 ;
rs. w1 (c41.) ; store sem in testrecord sem
rl. w1 b0. ; get testoutrec6 point
jl. (j4.) ; call testoutrec6
\f
; intern procedure unlink linkprio
; reg call return
; w0 semaddr * prio
; w1 element element
; w2 - after element
; w3 return addr before element
; *) not used in entry d3!
b. a2 w.
d4: rs. w3 d9. ; entry linkprio
jl. a1. ; goto linkprio
d3: rl. w2 (c3.) ;
al w0 x2+f6 ; w0:=ready sem
al w2 0 ;
rs w2 x1+f26 ; time_to_timeout:=0;
d5: rs. w3 d9. ; store returnaddr
dl w3 x1 ; unlink element
rs w3 x2 ;
rs w2 x3-2 ;
a1: rl w3 0 ;
rl w2 x1+f16 ; get element.prio
al w0 x2-1 ;
a2: rl w3 x3 ; next element
sl w0 (x3+f16) ;
jl. a2. ;
rl w2 x3-2 ;
rs w1 x2 ; link
rs w1 x3-2 ;
ds w3 x1 ;
jl. (d9.) ; return
e.
\f
b. a40 w.
a1: 4<12 + 17 ; used for param check
e5 = 1<23 + e0<12 - e2<12 -j0. ; integer procedure wait(sem,ref);
am a5 ; entry wait
e6 = 1<23 + e0<12 -e2<12 - j0. ; procedure signal(sem,ref);
al w1 a6 ; entry signal
rs. w1 (c35.) ; store reladdr
rl. w2 (j13.) ;
ds. w3 (j30.) ;
c.f10
rl. w0 (j90.) ; check mode
so w0 1 ; if not sem_modes
jl. w3 (j29.) ; param (may be changed)
z.
dl w1 x2+8 ; load sem formal
so w0 16 ; if expression
jl. w3 (j4.) ; take expression
ds. w3 (j30.) ;
rl w1 x1 ; get sem
c.f10
rl. w3 (c1.) ; get maxsem
sh w1 x3 ; if sem>maxsem or
sh w1 -6 ; sem< -5 then
jl. w3 (j18.) ; indexalarm
z.
rs w1 x2+8 ; store semno
ls w1 f1 ; sem.addr:=sem*8
wa. w1 (c3.) ; + sem_basis;
rs w1 x2+6 ; store semaddr in stack
dl w1 x2+12 ; load ref formal
c.f10
ws. w0 a1. ; if first of formal < (4 shift 12 + 17) or
sz w0 -4 ; first of formal > (4 shift 12 + 20) then
jl. w3 a35. ; alarm(<:not ref.:>);
z.
al w0 0 ;
rl. w3 (c35.) ; get reladdr
jl. w3 x3+j0. ;
\f
a6 = -j0.
c.f10
rl w3 x1 ; get ref.basisaddr
sn w1 x3 ; if ref.basisaddr = ref.dopeaddr
jl. w3 a36. ; then alarm(<:ref.nil:>);
se w1 (x3+f18) ; if message.checkfield <> ref.dopeaddr
jl. w3 a35. ; then alarm(<:not ref.:>);
z.
rs w0 x1+2 ; ref.max_field:=0;
al w0 5 ; testvalue= s_data and signal
la. w0 (c31.) ;
sn w0 0 ;
jl. a3.
rl w1 x1 ; get messageaddr
rl w2 x1+f14 ; get messagesize
rl w3 x1+f16 ; get message prio
ds. w3 (c39.) ;
ds. w1 (c35.) ; store in testrecord in own core
jl. w3 d1. ; call testoutrec6
rl. w2 (j13.) ; restore w2
a3: rl w1 x2+6 ; get semaddr
rl w2 x2+12 ; get ref.dopeaddr
rx w2 x2 ; nilmark ref.dope; w2:=messageaddr;
e21 = -j0.
rs. w1 d9. ; store semaddr
; return from compare ( w3-6 ) : NOT FOUND
rl w1 x1-2 ; get next on coroutines
se. w1 (d9.) ; if next<>coroutines then
jl. w3 d2. ; compare
jl. a2. ; end of chain, (not found at all)
; return from compare ( w3+2 ) : FOUND
rs w2 x1+f14 ; store message addr
jl. w3 d3. ; call unlink linkprio ready_sem
al w1 -1 ; signal := true;
jl. (j6.) ; return
a2: al w0 x1+f9 ; change form cor_chain to mess_chain
al w1 x2 ; w1:=messageaddr
jl. w3 d4. ; linkprio (w0=sem)
al w1 0 ; signal := false;
jl. (j6.) ; return
\f
a5 =-j0. - a6
c.f10
se w1 (x1) ; if dope without nilmark
jl. w3 a37. ; alarm(<:-,nilref:>);
z.
rx. w0 (c17.) ;w0:=maxwaittime; maxwaittime:=0;
rl. w1 (j85.) ; get current activity no
sl w1 1 ; if current activity no>0 then (mode=sem_activity)
jl. a11. ;
al w0 -1 ; else maxwaittime:=-1 (no wait)
ac w1 x1 ; now 0<=w1<=no of activity
a11: ls w1 f3 ; cor_descr.addr := actno*16
wa. w1 (c7.) ; + cor_basis;
rs. w0 (c39.) ; store waittime in testrecord
rs w0 x1+f26 ; store maxwaittime in cordescr
rs w1 x2+10 ; store cor_descr.addr in stack
dl. w0 (c21.) ; cor.wait_select
ds w0 x1+f24 ; := wait_select
ds. w0 (c37.) ; store wait_select in testrecord in own core
al w0 0 ;
al w3 0 ; w3,w0:=0
ds. w0 (c21.) ; wait_select:=0;
rs w0 x1+f14 ; cor.messageaddr:=0;
al w0 8 ; testvalue=wait
la. w0 (c31.) ;
sn w0 0 ; if test
jl. a12. ;
jl. w3 d0. ; call testoutrec6
rl. w2 (j13.) ; restore w2=stackref
rl w1 x2+10 ; restore w1=cor_descr_addr
a12:
rl w2 x2+6 ; w2:=cor_chain(sem);
al w2 x2+f9 ; w2:=mess_chain(sem);
rs. w2 d9. ; store semaddr
\f
; return from compare ( x3-6 ) : NOT FOUND
rl w2 x2-2 ; get next on coroutines
se. w2 (d9.) ; if next<>coroutines then
jl. w3 d2. ; compare
jl. a21. ; end of chain
; return from compare ( x3+2 ) : FOUND
rs w2 x1+f14 ; insert message addr
dl w3 x2 ; unlink message
rs w3 x2 ;
rs w2 x3-2 ;
al w3 0 ;
rx w3 x1+f26 ; w3:=cor.wait_time; cor.wait_time:=0;
sh w3 -1 ; if maxwaittime < 0 then goto immidiate return
jl. a15. ;
a13: ; commen check of timeout
rl. w3 (b2.) ; get segmentaddr of time/event test segment
jl w3 x3+e19 ; call time/event test
rl. w2 (j85.) ; get current
rl. w1 b1. ; get passivate point
se w2 (0) ; if first on readysem <> current then
jl. w3 (j4.) ; call passivate;
a15: rl. w2 (j13.) ;
dl w3 x2+12 ; w2:=addr(cor); w3:=addr(ref.basisaddr);
rl w1 x2+f14 ; get messageaddr
sn w1 0 ; if no message
jl. a16. ;
rs w3 x1+f18 ; message.checkfield := ref.dopeaddr;
rs w1 x3 ; ref.basisaddr:= messageaddr else 0
rl w1 x1+f14 ; w1:= message size
am 18-16 ; testvalue:= if message then 18
a16: al w0 16 ; else 16;
rs w1 x3+2 ; ref.max_field:=message size or if no message 0
la. w0 (c31.) ;
sn w0 0 ;
jl. (j6.) ; return
rl w2 x2+f16 ; get cor prio
ds. w2 (c39.) ; store mess size
rl w1 x3 ; get messaddr
rs. w1 (c35.) ;
jl. w3 d0. ;
rl. w1 (c37.) ; get messsize
jl. (j6.) ;
\f
; not found:
a21: ; w1=cor , w2=sem
rl w0 x1+f26 ; get maxwaittime
sn w0 0 ;
jl. a22. ;
sh w0 0 ; if maxwaittime < 0 then
jl. a15. ; answer and return (without message)
dl w0 110 ; get clock
ss. w0 (c15.) ; get basis_time
ld w0 -10 ; max_waittime(periode of 0.1 sec):=
wa w0 x1+f26 ; (clock - basistime) shift (-10) + max_waittime;
rs w0 x1+f26 ;
am. (c11.) ;
sh w0 (+0) ; if time_to_timeout(cor) < timeout_time
rs. w0 (c11.) ; then timeout_time:=time_to_timeout(cor);
a22: al w0 x2-f9 ; w0:=cor_chain(sem);
al. w3 a13. ; returnaddr:=a13
jl. d5. ; unlink linkprio (sem)
e17 = -j0. ; entry compute activity descr. size
am. (j80.) ;
rl w1 -2 ;
al w1 x1+h4 ;
ws. w1 (j79.) ; see system entry 12!
rl. w3 (j78.) ;
sh w3 0 ;
ac w3 x3 ;
al w3 x3+1 ;
al w0 0 ;
wd w1 6 ;
rs. w1 (c25.) ;
jl. (j6.) ;
\f
a30:<:<10>not ref.:>
a31:<:<10>ref.nil :>
a32:<:<10>-,nilref:>
a35: am a30-a31
a36: am a31-a32
a37: al. w0 a32.+1
jl. (j21.)
e.
c. -j0. - 506
m.code too long on segment 3
z.
c. j0. + 502
h. 0,r.504 + j0. w.
z.
<:signal/wait:>
e0=e0+1
e.
e. ; all segment
\f
b. a21 w.
a0=e0<12 + f11 - e2<12 ; segments + owns
a1= 1<23 + 4 ;
a2= 4<12 + e1 ;
a10 = 1<18 + 19<12 ; notype procedure(int addr)
a11 = 1<18 + 19<12 + 19<6 + 19 ; notype procedure(int addr,int addr,int addr)
a12 = 2<18 + 41<12 + 19<6 ; boolean procedure(int addr,reference var)
a13 = 3<18 + 41<12 + 19<6 ; integer procedure(int addr, reference var)
a14 = 1<18 + 41<12 ; notype procedure(reference var)
a15 = 1<18 + 19<12 + 19<6 ; notype procedure( int addr,int addr);
a16 = 1<18 + 8<12 + 19<6 ; notype procedure(int addr,zone)
a18 = 5<18 + 19<12 ; long procedure(int addr);
a19 = 1<18 ; notype procedure;
a20 = 9<18 ; integer
a21 =11<18 ; long
g0: e0, 0,r.4, e3, a16, 0, a2, a0 ; procedure coroutines(maxsem:integer,testzone)
a1, 0,r.4, e4, a11, 0, a2, a0 ; procedure allocate(sem,messagesize,prio)
a1, 0,r.4, e5, a13, 0, a2, a0 ; integer procedure wait(sem,ref)
a1, 0,r.4, e6, a12, 0, a2, a0 ; boolean procedure signal(sem,ref)
a1, 0,r.4, e7, a14, 0, a2, a0 ; procedure initref(ref);
a1, 0,r.4, e8, a15, 0, a2, a0 ; procedure cor_to_sem(sem,cor);
a1, 0,r.4, e9, a18, 0, a2, a0 ; long procedure schedule(cor);
a1, 0,r.4,e11, a10, 0, a2, a0 ; procedure set_priority(prio);
a1, 0,r.4,e12, a19, 0, a2, a0 ; procedure prepare_test
a1, 0,r.4, 17, a20, 0, a2, a0 ; wait_time
a1, 0,r.4, 11, a20, 0, a2, a0 ; co_time
a1, 0,r.4, 9, a20, 0, a2, a0 ; co_8000_event
a1, 0,r.4, 23, a20, 0, a2, a0 ; co_own_base
a1, 0,r.4, 31, a20, 0, a2, a0 ; select_test
a1, 0,r.4, 15, a21, 0, a2, a0 ; co_time_base
a1, 0,r.4, 21, a21, 0, a2, a0 ; waitselect
g1=k - 20 ; last entry
d. p.<:insertproc:>
e.
▶EOF◀