|
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: 11520 (0x2d00)
Types: TextFile
Names: »tcmoned «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
└─⟦6a563b143⟧
└─⟦this⟧ »tcmoned «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »tcmoned «
job httest 0 190147
(lookup htmon
if ok.no
(htmon=entry 1 tcmon d.0.0 tcmon tcmon tcmon tcmon
scope user htmon)
htmon=edit tcmon
end)
m e,m n #, v n
l./begin/,r/begin/begin algol list.off;/
l./:1:/,i$
algol list.on;
$
l./:1:/,l 1,i$
#12#
algol list.off;
; message coroutinemonitor - 2 ;;
$
l./:2:/,i$
algol list.on;
$
l./:3:/,l 1,i$
#12#
algol list.off;
; message coroutinemonitor - 3 ;;
$
l./<*-1*>/,l 1,i$
#12#
; message coroutinemonitor - 4 ;;
$
l./********** initialization procedures **********/,i$
#12#
; message coroutinemonitor - 5 ;;
$
l./***** nextsem *****/,i$
#12#
; message coroutinemonitor - 6 ;;
$
l./***** nextcoru *****/,i$
#12#
; message coroutinemonitor - 7 ;;
$
l./***** nextop *****/,i$
#12#
; message coroutinemonitor - 8 ;;
$
l./***** nextprocext *****/,i$
#12#
; message coroutinemonitor - 9 ;;
$
l./***** initerror *****/,i$
#12#
; message coroutinemonitor - 10 ;;
$
l./:4:/,i$
algol list.on;
$
l./:4:/,l 1,i$
#12#
algol list.off;
; message coroutinemonitor - 11 ;;
$
l./***** pass *****/,i$
#12#
; message coroutinemonitor - 12 ;;
$
l./***** wait *****/,i$
#12#
; message coroutinemonitor - 13 ;;
$
l./***** inspect ****/,r/inspect ****/inspect *****/,i$
#12#
; message coroutinemonitor - 14 ;;
$
l./***** signalch *****/,i$
#12#
; message coroutinemonitor - 15 ;;
$
l./queue./,r/./, at the end of the queue
if operation is positive and at the beginning if operation is negative./
l./op;/,r/;/,currop;/
l./op:=/,r/=/= abs /
l./semaphore + semop/,r/semaphore + semop/currop/,i$
currop:=semaphore + semop;
if operation < 0 then currop:=d.currop.next;
$
l./***** waitch *****/,i$
#12#
; message coroutinemonitor - 16 ;;
$
l./linkprio(current/,i$
#12#
; message coroutinemonitor - 17 ;;
$
l./***** inspectch *****/,i$
#12#
; message coroutinemonitor - 18 ;;
$
l./the semaphore/,i$
if no operations are found the number of coroutines waiting
for operations of the typeset are counted and delivered as
negative value in 'elements'.
$
l./currop;/,r/;/,firstcoru,currcoru;/
l./elements:=/,i$
if counter=0 then
begin
firstcoru:=semaphore + sem_coru;
curr_coru:=d.firstcoru.next;
while curr_coru<>first_coru do
begin
if (operationtypeset and d.curr_coru.corutypeset) extract 12 <>0 then
counter:=counter - 1;
curr_coru:=d.curr_coru.next;
end;
end;
$
l./***** csendmessage *****/,i$
#12#
; message coroutinemonitor - 19 ;;
$
l./***** cwaitanswer *****/,i$
#12#
; message coroutinemonitor - 20 ;;
$
l./***** cwaitmessage *****/,i$
#12#
; message coroutinemonitor - 21 ;;
$
l./***** cregretmessage *****/,i$
#12#
; message coroutinemonitor - 22 ;;
$
l./***** semsendmessage *****/,i$
#12#
; message coroutinemonitor - 23 ;;
$
l./***** semwaitmessage *****/,i$
#12#
; message coroutinemonitor - 24 ;;
$
l./***** semregretmessage *****/,i$
#12#
; message coroutinemonitor - 25 ;;
$
l./***** link *****/,i$
#12#
; message coroutinemonitor - 26 ;;
$
l./***** linkprio *****/,i$
#12#
; message coroutinemonitor - 27 ;;
$
l./<*+1*>/,i$
#12#
; message coroutinemonitor - 28 ;;
$
l./procedure test_arr (key/,l-1,i$
#12#
; message coroutinemonitor - 29 ;;
$
l./procedure test_rec_val (key/,l-1,i$
#12#
; message coroutinemonitor - 30 ;;
$
l./activity(maxcoru);/,i$
#12#
; message coroutinemonitor - 30a ;;
<*************** extention to coroutine monitor procedures **********>
<***** signalbin *****
this procedure simulates a binary semaphore on a simple semaphore
by testing the value of the semaphore before signaling the
semaphore. if the value of the semaphore is one (=open) nothing is
done, otherwise a normal signal is carried out. *>
procedure signalbin(semaphore);
value semaphore;
integer semaphore;
begin
integer array field sem;
integer val;
sem:= semaphore;
inspect(sem,val);
if val<1 then signal(sem);
end;
#12#
; message coroutinemonitor - 30b ;;
<***** coruno *****
delivers the coroutinenumber for a give coroutine id.
if the coroutine does not exists the value 0 is delivered *>
integer procedure coru_no(coru_id);
value coru_id;
integer coru_id;
begin
integer array field cor;
coru_no:= 0;
for cor:= firstcoru step corusize until (coruref-1) do
if d.cor.coruident//1000 = coru_id then
coru_no:= d.cor.coruident mod 1000;
end;
#12#
; message coroutinemonitor - 30c ;;
<***** coroutine *****
delivers the referencebyte for the coroutinedescriptor for
a coroutine identified by coroutinenumber *>
integer procedure coroutine(cor_no);
value cor_no;
integer cor_no;
coroutine:= if cor_no <= 0 or maxcoru < cor_no then -1 else
firstcoru + (cor_no-1)*corusize;
\f
; message coroutinemonitor - 30d ;;
<***** curr_coruno *****
delivers number of calling coroutine
curr_coruno:
< 0 = -current_coroutine_number in disabled mode
= 0 = procedure not called from coroutine
> 0 = current_coroutine_number in enabled mode *>
integer procedure curr_coruno;
begin
integer i;
integer array ia(1:12);
i:= system(12,0,ia);
if i > 0 then
begin
i:= system(12,1,ia);
curr_coruno:= ia(3);
end else curr_coruno:= 0;
end curr_coruno;
\f
; message coroutinemonitor - 30e ;;
<***** curr_coruid *****
delivers coruident of calling coroutine :
curr_coruid:
> 0 = coruident of calling coroutine
= 0 = procedure not called from coroutine *>
integer procedure curr_coruid;
begin
integer cor_no;
integer array field cor;
cor_no:= abs curr_coruno;
if cor_no <> 0 then
begin
cor:= coroutine(cor_no);
curr_coruid:= d.cor.coruident // 1000;
end
else curr_coruid:= 0;
end curr_coruid;
\f
; message coroutinemonitor - 30f.1 ;;
<**** getch *****
this procedure searches the queue of operations waiting at 'semaphore'
to find an operation that matches the operationstypeset and a set of
select-values. each select value is specified by type and fieldvalue
in integer array 'type' and by the value in integer array 'val'.
0: eq 0: not used
1: lt 1: boolean
2: le 2: integer
3: gt 3: long
4: ge 4: real
5: ne
*>
procedure getch(semaphore,operation,operationtypeset,type,val);
value semaphore,operationtypeset;
integer semaphore,operation;
boolean operationtypeset;
integer array type,val;
begin
integer array field firstop,currop;
integer ø,n,i,f,t,rel,i1,i2;
boolean field bf,bfval;
integer field intf;
long field lf,lfval; long l1,l2;
real field rf,rfval; real r1,r2;
boolean match;
operation:= 0;
n:= system(3,ø,type);
match:= false;
firstop:= semaphore + semop;
currop:= d.firstop.next;
while currop <> firstop and -,match do
begin
if (operationtypeset and d.currop.optype) extract 12 <> 0 then
begin
i:= n;
match:= true;
\f
; message coroutinemonitor - 30f.2 ;;
while match and (if i <= ø then type(i) >= 0 else false) do
begin
rel:= type(i) shift(-18);
t:= type(i) shift(-12) extract 6;
f:= type(i) extract 12;
if f > 2047 then f:= f -4096;
case t+1 of
begin
; <* not used *>
begin <*boolean or signed short integer*>
bf:= f;
bfval:= 2*i;
i1:= d.currop.bf extract 12;
if i1 > 2047 then i1:= i1-4096;
i2:= val.bfval extract 12;
if i2 > 2047 then i2:= i2-4096;
match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
end;
begin <*integer*>
intf:= f;
i1:= d.currop.intf;
i2:= val(i);
match:= case rel+1 of (i1=i2,i1<i2,i1<=i2,i1>i2,i1>=i2,i1<>i2);
end;
begin <*long*>
lf:= f;
lfval:= i*2;
l1:= d.currop.lf;
l2:= val.lfval;
match:= case rel+1 of (l1=l2,l1<l2,l1<=l2,l1>l2,l1>=l2,l1<>l2);
end;
begin <*real*>
rf:= f;
rfval:= i*2;
r1:= d.currop.rf;
r2:= val.rfval;
match:= case rel+1 of (r1=r2,r1<r2,r1<=r2,r1>r2,r1>=r2,r1<>r2);
end;
end;<*case t+1*>
i:= i+1;
end; <*while match and i<=ø and t>=0 *>
\f
; message coroutinemonitor - 30f.3 ;;
end; <* if operationtypeset and ---*>
if -,match then currop:= d.currop.next;
end; <*while currop <> firstop and -,match*>
if match then
begin
link(currop,0);
d.current.coruop:= currop;
operation:= currop;
end;
end getch;
#12#
; message coroutinemonitor - 31 ;;
$
l./if cmi = 0/,l./receiver/,i$
#12#
; message coroutinemonitor - 32 ;;
$
l./if cmi = -1/,l./currevent/,i$
#12#
; message coroutinemonitor - 33 ;;
$
l./answer arrived after semsendmessage/,i$
#12#
; message coroutinemonitor - 34 ;;
$
l./********** coroutine activation **********/,i$
#12#
; message coroutinemonitor - 35 ;;
$
l./corustate:=/,i$
<*+2*> if testbit30 and d.current.corutestmask shift(-11) then
<**> begin
<**> systime(5,0,r);
<**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
<**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
<**> d.current.coruident//1000,<: aktiveres:>);
<**> end;
<*-2*>
$
l./if cmi = 1/,i$
<*+2*> if testbit30 and d.current.corutestmask shift(-11) then
<**> begin
<**> systime(5,0,r);
<**> write(out,"nl",1,<<zd dd dd>,r,<: coroutine: :>,<<dd>,
<**> d.current.coruident mod 1000,<: ident: :>,<<ddd>,
<**> d.current.coruident//1000,<: afbrudt, årsag=:>,cmi);
<**> end;
<*-2*>
$
l./* coroutine termination/,i$
#12#
; message coroutinemonitor - 36 ;;
$
l./<*-1*>/,l 1,i$
<* aktioner ved normal og unormal coroutineterminering insættes her *>
coru_term:
begin
if false and alarmcause extract 24 = (-9) <* break *> and
alarmcause shift (-24) extract 24 = 0 then
begin
endaction:= 2;
goto program_slut;
end;
if alarmcause extract 24 = (-9) <* break *> and
alarmcause shift (-24) = 8 <* parent *>
then sæt_bit_i(trapmode,15<*killed activities*>,0<*normal output*>);
if alarmcause shift (-24) extract 24 <> -2 or
alarmcause extract 24 <> -13 then
begin
write(zbillede,"nl",1,<:alarmcause(param,cause)=:>,<<d>,
alarmcause shift (-24),<:,:>,
alarmcause extract 24);
for i:=1 step 1 until max_coru do
j:=activate(-i); <* kill *>
<* skriv billede *>
end
else
begin
errorbits:= 0; <* ok.yes warning.no *>
goto finale;
end;
end;
goto dump;
$
l./initialization:/,i$
#12#
; message coroutinemonitor - 37 ;;
$
l./<* operation *>/,i$
#12#
; message coroutinemonitor - 38 ;;
$
l./trap(dump)/,i$
#12#
; message coroutinemonitor - 39 ;;
$
l./:5:/,i$
algol list.on;
$
l./:5:/,l 1,i$
#12#
algol list.off;
; message coroutinemonitor - 40 ;;
$
l./dump:/,l 1,i$
op:= op;
<* :6: trap-aktioner 1 *>
$
l./<*-1*>/,l 1,i$
<* :7: trap-aktioner 2 *>
$
l b,l-1,i$
algol list.on;
program_slut:
$
g t/; message/message/
g t/;;/;/
f
▶EOF◀