⟦0819f41b2⟧

TextFile

job wib 1 200,
time 10 0,
output 400000,
size 20000,
buf 7,
perm disc1 600 10
message start compile phoenix
phoenixbin= set 400 disc1
if ok.no
finis
scope user phoenixbin
if ok.no
finis
phoenixbin= algol list.no xref.no
\f

 
begin

<*
the program structure of phoenix is:

begin
_  declaration of installation parameters
_
_  procedure program;
_  begin
_     declarations;
_     procedures in alphabetical order
_     monitor procedures (signal and wait)
_     coroutine procedures
_
_     initialisations
_
_     central logic
_  end;
_
_  initialisation of installation parameters
_
_  repeat
_     program;
_  until phoenix_finished;
_
end;
*>

\f


<****  external procedures  ****
*>

\f


<********** declaration of installation parameters *********>

integer
<*****>

buf_array_length,          <* the length of the array 'buf' *>
last_restart_time,
max_task_inc_no,
no_of_mhs,
no_of_sems,
no_of_restarts,
start_up_time,
version;



boolean
<*****>

phoenix_finished,
test,
test_on_bs,               <* true if output is sent to a bs_area *>
test_cl;                  <* true if test on central logic *>
 
<* algol copy.subnames; *>

\f


procedure program;
begin

integer
<*****>

a,                        <* auxiliary *>
buf_base,                 <* used when initialising the buffers *>
buffer_addr,              <* used by the central logic *>
buffer_head_length,
cause,                    <* used in central logic *>
c_corout_no,              <* the no of the current coroutine *>
first_free_task_inc_no,
last_free_task_inc_no,
i,                        <* auxiliary variabel *>
incarnation,              <* used during start of the coroutines *>
mask;                     <* used by testout *>
  
 
 
integer array field
<*****************>

c_corout,                 <* used in coroutine descriptions *>
data,                     <* used in buffers *>
lab_data,                 <* used in alarm-messages *>
ready_q_first,
ready_q_last,
iaf;                      <* used in zones *>



boolean
<*****>

request_to_restart;


integer field
<***********>

<***** fields used in buffer headers *****>
next,                     <* also used in coroutine descriptions *>
home_pool,
length,
operation,


<***** fields used in coroutine descriptions *****>
corout_no,
incarn,
bf,

 
<***** fields used in alarm_messages *****>
lab_no_of_by,
lab_rec_macro,
lab_rec_micro,
lab_send_macro,
lab_send_micro,
lab_opc_upd,
lab_hour,
lab_min_sec;



<***** global semaphores *****>

integer
<*****>

tick_sem_no,
timer_sem_no;

integer field
<***********>
tick_sem,
timer_sem;



integer array
<***********>
 
buf(1:buf_array_length),
corout(1:(no_of_mhs + 2<*timer*>) * 4<*coroutsize*> + 1),
free_task_inc_no_list(1 : max_task_inc_no),
sem(1:no_of_sems),
table(0:255);             <* used for input conversion *>
 
 
\f

 
procedure decode_message;
begin <* used by the central logic to determine what
to do when a message is received *>
end decode message;
\f

 
procedure empty (zout);
zone zout;
begin <* empties the buffer to the screen *>
outchar(zout,27);
setposition(zout,0,0);
end empty;


\f


procedure free_core;
if test then
disable
begin <* displays on primary output the no of
free segments in core *>
real array prog(1:2);
integer i;

write(out,<:free core: :>,system(2,i,prog)//512,
_    <: segments:>,"nl",1);
if -,test_on_bs then setposition(out,0,0);
end free core;
\f


integer procedure get_buf(bsize);
value bsize;
integer bsize;
begin <* gets a buffer of the wanted size. used during initialisation *>
getbuf:=bufbase;
bufbase:=bufbase + 2*bsize + 2*buffer_head_length;
end get buf;

\f


integer procedure get_task_inc_no;
begin

<* Yields a free task incarnation number from the free_task_inc_no_list.
_  If there are no numbers left, the value will be zero.
*>

integer next;

next := free_task_inc_no_list(first_free_task_inc_no);
if next < 0 then
get_task_inc_no := 0
else
begin
get_task_inc_no := first_free_task_inc_no;
free_task_inc_no_list(first_free_task_inc_no) := 0;
first_free_task_inc_no := next;
end;
end get_task_inc_no;
\f


procedure init_buffer_pool(sem_no,nb,bsize);
value nb,bsize,sem_no;
integer nb,bsize,sem_no;
begin <* the buffer_pool with no 'sem_no' is initialised with 'nb' buffers
each of length 'bsize' words *>

integer i;
integer array field j;

integer field s;

s:=2 * sem_no;
sem.s:=0;
 
for i:=1 step 1 until nb do
begin <* note that the buffers are put in first in the queue *>
j:=getbuf(bsize);
buf.j.next:=sem.s;        <* link to the next buffer *>
buf.j.home_pool:=s;       <* home semaphore *>
buf.j.length:=bsize;      <* length *>
sem.s:=j;
end;
end init buffer pool;



\f


procedure init_corout_descr(act_no,incarnation);
value act_no,incarnation;
integer act_no,incarnation;
begin <* initialises a coroutine description *>
c_corout:=8*act_no - 8+2;

corout.c_corout.next:=0;  <* chain *>
corout.c_corout.corout_no:=act_no;
corout.c_corout.incarn:=incarnation;
corout.c_corout.bf:=0;

c_corout_no:=act_no;
end init corout descr;

\f


procedure init_task_incarnations;
begin

<* The procedure initialises the task incarnation semaphores (one
_  task descriptor with type = 0 on each semaphore) and the list
_  of free task incarnation numbers.
*>

integer i;

<* initialise the task incarnation semaphores *>

<* Initialise the free_task_inc_no_list : *>

first_free_task_inc_no := 1;
last_free_task_inc_no := max_task_inc_no;
for i := 1 step 1 until last_free_task_inc_no - 1 do
free_task_inc_no_list(i) := i + 1;

free_task_inc_no_list(last_free_task_inc_no) := - 1;
end init_task_incarnations;
\f


procedure out_alarm_cause(zout);
zone zout;
begin <* prints the cause of the latest occurred alarm *>
integer cause,param;
long array text(1:4);

cause:=alarm_cause extract 24;
param:=alarm_cause shift (-24);
get_alarm(text);

if cause>=0 then write(zout,<: (:>,text,<:):>)
else
begin <* cause < 0 *>
write(zout, <: (:>, case -cause of (
_  <:stack:>,
_  <:index:>,
_  <:z.index:>,
_  <:case:>,
_  <:syntax:>,
_  <:integer:>,
_  <:real:>,
_  <:param:>,
_  <:break:>,
_  <:end:>,
_  <:giveup:>,
_  <:field:>,
_  <:trap:>),  param,<:):>);

if cause=-11 then  <* device status alarm *>
write(zout,text  <* the name of the document *>);
end cause < 0 ;


empty(zout);
end out alarm cause;



\f


procedure out_shortclock(zout,shortclock);
value shortclock;  integer shortclock;
zone zout;
begin <* prints a shortclock in the format
yy.mm.dd hh.mm

if you want 'current_time' then set
shortclock = systime(7,0,0.0)
*>
integer old_sp,old_dec_point;
real r;

old_sp:=replace_char(1 <* space in number *>,'.');
old_dec_point:=replace_char(4 <* decimal point *>,'sp');

write(zout,<<zd dd dd.dd dd>,
_     systime(6,shortclock,r)+r/1000000);

replace_char(1,old_sp);
replace_char(4,old_dec_point);
end out short clock;
\f

 
procedure pack_mess (mess);
real array mess;
begin
   integer lower,upper,pack_index,part_one,part_two,part,
   _       count,no_of_bytes,i;

   lower := system(3,upper,mess);
   no_of_bytes := mess(lower) shift (-24) extract 16 + 2;
   if no_of_bytes <= 2 * (upper - lower + 1) and no_of_bytes >= 16 then
   upper := lower + no_of_bytes // 4 - (if no_of_bytes mod 4 = 0 then 1 else 0);
   count := lower;
   i := 1;

   for pack_index := lower step 1 until upper do
   begin
      part_one := mess(pack_index) shift (-24) extract 16;
      part_two := mess(pack_index) extract 16;

      for part := part_one,part_two do
      begin
         mess(count) := mess(count) shift 16 add part;
         i := i + 1;
         if i > 3 then
         begin
            count := count + 1;
            i := 1;
         end;
      end;
   end;

   mess(count) := mess(count) shift (case i of (48,32,16));
end pack_mess;


\f


integer procedure read_ch (z, ch_no);
value ch_no;
zone z;
integer ch_no;
begin <* gets a character from the zone z *>
   read_ch:= z ((ch_no+5)//6) shift (8*((ch_no-1)mod 6 - 5)) extract 8;
end read ch;
\f

 
integer procedure read_int (z, start_no);
value start_no;
zone z;
integer start_no;
begin
   read_int:= (read_ch(z,start_no) shift 8) + read_ch (z,start_no+1);
end read int;
\f


procedure release_task_inc_no(no);
value no;
integer no;
begin

<* The procedure releases the given task incarnation number
_  to the free_task_inc_no_list.
*>

if free_task_inc_no_list(no) <> 0 then
<* the task_inc_no is not reserved *>
else
begin
free_task_inc_no_list(last_free_task_inc_no) := no;
free_task_inc_no_list(no) := - 1;
end;
end release_task_inc_no;
\f


procedure return_buf(bf);
integer array field bf;
<* the buffer is returned to its home_pool *>
signal(buf.bf.home_pool,bf);




\f


integer procedure sem_to_field(sem_no);
value sem_no; integer sem_no;
<* converts a semaphore number so that it can be used
as integer field pointing to the semaphore *>
sem_to_field:= 2 * sem_no;



\f


procedure set_table;
begin <* defines an in_table with all characters
having class = 'text' *>
integer i;

for i:=0 step 1 until 255 do
table(i):=6 shift 12 + i;

intable(table);
end set table;



\f


procedure testout(text,int);
value int; integer int;
string text;
if test or test_cl then
disable
begin <* used during debugging for test_output *>
real rctime,date,clock,millisecs;
long secs;
if (mask shift (-c_corout_no)) extract 1 = 1 or test_cl then
begin
systime(1,0,rctime);
secs:=rctime-0.5;
millisecs:=rctime-secs;
date:=systime(4,rctime,clock);
clock:=clock+millisecs;

write(out,<<dd dd dd>,date,"-",1,<<dd dd dd.ddd>,clock,
"sp",2,<<ddd>,
text,"sp",2,int,<:  (coroutine no :>,c_corout_no,<:):>,"nl",1);
if -,test_on_bs then setposition(out,0,0);
end;
end test out;
\f

 
procedure unpack_mess (mess);
real array mess;
begin
   integer lower,upper,pack_index,part_one,part_two,no_of_bytes,
   _       no_of_int,rel_start,rel_extra,start_index,i;

   lower := system(3,upper,mess);
   no_of_bytes := mess(lower) shift (-32) extract 16 + 2;
   no_of_int := (upper - lower + 1) * 2;

   if no_of_bytes < no_of_int * 2 and no_of_bytes >= 16 then
   no_of_int := no_of_bytes // 2;
   no_of_int := no_of_int + no_of_int mod 2;

   upper := lower + no_of_int // 2 - 1;
   rel_start := no_of_int // 3;
   rel_extra := no_of_int mod 3;

   start_index := lower + rel_start - (if rel_extra = 0 then 1 else 0);
   i := case rel_extra + 1 of (1,3,2);

   for pack_index := upper step -1 until lower do
   begin
      part_one := mess(start_index) shift ((-16) * (i - 1)) extract 16;
      i := i + 1;
      if i > 3 then
      begin
         start_index := start_index - 1;
         i := 1;
      end;
      
      part_two := mess(start_index) shift ((-16) * (i - 1)) extract 16;
      i := i + 1;
      if i > 3 then
      begin
         start_index := start_index - 1;
         i := 1;
      end;

      mess(pack_index) := real (extend part_two shift 24) add part_one;
   end;
end unpack_mess;


\f


procedure utility (taskincarn, timeout, mess);
integer taskincarn;
boolean timeout;
real array mess;
begin
end utility;
\f


<********** monitor procedures **********>

procedure signal(s,b);
integer field s;
integer array field b;
begin <* the buffer 'b' is signalled on the semaphore 's' *>
integer array field i;

if test or test_cl then testout(<:before signal,sem:>,s);
if test or test_cl then testout(<:before signal,buf:>,b);
buf.b.next:=0;

buf.b.length:= buf.b.length extract 12;
if sem.s>0 then
begin <* the semaphore is open *>
i:=sem.s;

while buf.i.next > 0 do i:=buf.i.next;

buf.i.next:=b;
end open
else
if sem.s=0 then <* neutral *> sem.s:=b
else
begin <* the semaphore is closed. we will hang
the first of the waiting coroutines on the ready_q *>
i:=-sem.s;
sem.s:=-corout.i.next;
corout.i.bf:=b;
buf.b.length:=
corout.i.corout_no shift 12 + buf.b.length;
corout.i.next:=0;

if ready_q_first<>0 then
corout.ready_q_last.next:=i
else
ready_q_first:=i;

ready_q_last:=i;
end closed;

end signal;
\f


integer procedure wait(s);
integer field s;
begin <* passivates the coroutine until something arrives
on the semaphore 's' *>
integer array field i;

if test or test_cl then testout(<:before wait, sem:>,s);
if sem.s>0 then
begin <* a buffer is ready, the semaphore is open *>
corout.c_corout.bf:=sem.s;
i:=sem.s;
sem.s:=buf.i.next;
buf.i.length:=corout.c_corout.corout_no shift 12+buf.i.length extract 12;
end open
else
begin <* hang the coroutine on the semaphore *>
corout.c_corout.next:=0;

if sem.s=0 then <* neutral *> sem.s:=-c_corout
else
begin <* the semaphore is closed *>
i:=-sem.s;

while corout.i.next <> 0 do
i:=corout.i.next;

corout.i.next:=c_corout;
end closed;

passivate;
end hang;

wait:=corout.c_corout.bf;
if test or test_cl then testout(<:after wait, buf:>,corout.ccorout.bf);
end wait;

\f


<********** coroutine procedures **********>

<* procedure log; *>
<* algol copy.log; *>
 
procedure message_handler;
begin
 
integer no_of_hwords, streamno, ch_no, no_of_by, rec_macro,
_       rec_micro, task_incarn, send_macro, send_micro, upd_res,
_       op_code, hour, min_sec;
 
zone zin(20,1,dastderror), <* input from the screen *>
_    zout(30,1,dastderror); <* output to the screen *>

long array inprocname, outprocname (1:2);
 
procedure unpack_label;
begin
no_of_by:=   read_int (zin,1);
rec_macro:=  read_int (zin,3);
task_incarn:= (read_int (zin,5)) shift (-8);
rec_micro:=  read_int(zin,5) extract 8;
send_macro:= read_int (zin,7);
send_micro:= read_int (zin,9);
upd_res:=    read_ch (zin,12);
hour:=       read_int (zin,13);
min_sec:=    read_int (zin,15);
end unpack label;

procedure group_0;
begin
integer i;
 
unpack_label;

<* write a log on current output *>
write (out, <:log:>, <<  dddd>, no_of_by, rec_macro, rec_micro,
send_macro, send_micro, op_code, upd_res, hour, min_sec, "nl",1);

if no_of_by>40 then no_of_by:=40;

for i:= 17 step 1 until no_of_by do
write (out, read_ch(zin,i));
write (out, "nl", 1);
setposition (out,0,0);
 
 
end group_0;
 
procedure group_1;
begin end;
 
procedure group_2;
begin end;
 
procedure group_3;
begin end;
 
procedure group_4;
begin end;

procedure group_5;
begin end;

procedure group_6;
begin end;

procedure group_7;
begin end;

procedure group_8;
begin end;

procedure group_9;
begin end;

procedure group_10;
begin end;

procedure group_11;
begin end;

procedure group_12;
begin end;

procedure group_13;
begin end;

procedure group_14;
begin end;

procedure group_15;
begin end;
 
 
<**  message handler  **>

inprocname(1):= long <:strea:>+'m';
inprocname(2):= long <:in:>;
 
initzone (zin, 0, inprocname, 0, 3 shift 12+streamno, 0);
 

repeat
 
sendbuffer (zin, 80);
no_of_hwords:= getbuffer (zin);
 
if no_of_hwords < 1 then
else

task_incarn:= (read_int (zin,5)) shift (-8);

if task_incarn>0 then
begin
unpack_mess (zin);
utility (task_incarn, false, zin);
end

else if task_incarn= 0 then
begin
op_code:= read_ch (zin,11);
 
case op_code shift (-4) + 1 of
begin
group_0;
group_1;
group_2;
group_3;
group_4;
group_5;
group_6;
group_7;
group_8;
group_9;
group_10;
group_11;
group_12;
group_13;
group_14;
group_15
end
end
 
else <* task_incarn<0 ! *>
 
until false
 
end message handler;
\f


<* procedure al_opt; *>
<* algol copy.alopt; *>
 
<* procedure exph; *>
<* algol copy.exph; *>

<* procedure dmh; *>
<* algol copy.dmh; *>

<* procedure dov_opt; *>
<* algol copy.dov_opt; *>
procedure tick_generator;
begin

<* The tick generator communicates with the RC8000 clock driver
_  and sends a tickbuffer to the timer module evry 10 secs.
*>

long current_time, next_time;
integer array clock_mess(1:12),answer(1:8);
integer array field buffer;
zone clock(1,1,stderror);

open(clock,2,<:clock:>,1 shift 9);
getshare6(clock,clock_mess,1);
clock_mess(4) := 0;

repeat
current_time := getclock // 10000;
next_time := current_time // 10 * 10 + 15;
clock_mess(5) := next_time - current_time;
setshare6(clock,clock_mess,1);
write(out,"nl",1,<:TEST TICK:>,<<  zd dd dd>,convtime(getclock) extract 24,"nl",1);
setposition(out,0,0);
monitor(16) send message:(clock,1,answer);
monitor(18) wait answer:(clock,1,answer);
buffer := wait(tick_sem);
buf.buffer.operation := 1;
signal(timer_sem,buffer)
until false;
end tick_generator;

\f


procedure timer;
begin

integer array field timer_buf,buffer,previous_buffer,waiting_q;

real field time;

real current_time, last_time, buffer_time;

boolean found, adjust;

procedure dump_wq(text);
string text;
begin <* dumps the waiting q on current output *>
integer array field iaf1;
real r;

write(out,<:waiting queue dump from timer :>,text,"nl",1);
iaf1:=waitingq;

if waitingq=0 then write(out,<:waiting q empty:>,"nl",1)
else
while iaf1<>0 do
begin
write(out,iaf1,<<   dd dd dd>,systime(2,buf.iaf1.data.time,r),
_    r,"nl",1);
iaf1:=buf.iaf1.next;
end;
if -,test_on_bs then setposition(out,0,0);
end dump wq;


begin integer array dummy(1:100);
end;



time:=4;
waiting_q:=0;
systime(1,0,last_time);

repeat

if test then dumpwq(<:before wait on timersem:>);
timer_buf:=wait(timer_sem);

case buf.timer_buf.operation of
begin

<* 1 *>
begin <* clock pulse *>
write(out,"nl",1,<:TIMER TEST:>,<<  zd dd dd>,
convtime(getclock) extract 24,"nl",1);
setposition(out,0,0);
if waiting_q<>0 then
begin <* the waiting q is not empty.
search the queue for buffers with expired waiting time *>

systime(1,0,current_time);
adjust := current_time < last_time - 10;
previous_buffer:=0;
buffer:=waiting_q;
found:=false;

repeat
if adjust  then  buf.buffer.data.time :=
   buf.buffer.data.time - last_time + current_time;

if buf.buffer.data.time<=current_time then
begin <* the waiting time for this buffer (and the rest
of the q) has expired *>
found:=true;
end
else
begin <* look at the next buffer *>
previous_buffer:=buffer;
buffer:=buf.buffer.next;
end;
until found or (buffer=0);

last_time := current_time;

if found then
begin <* signal the buffers fron 'buffer' and out
to their respective semaphores *>
<* first we remove the tail of expired buffers from
the waiting q *>

if previous_buffer=0 then
waiting_q:=0  <* remove the entire q *>
else
buf.previous_buffer.next:=0;

repeat <* signal the buffers *>
previous_buffer:=buffer;
buffer:=buf.buffer.next;
signal(buf.previous_buffer.data(3),previous_buffer);
until buffer=0;

end found;
end waiting q not empty;

returnbuf(timer_buf);
end clock pulse;

<* 2 *>
begin <* waiting_request. the buffer is inserted in the waiting q
at the proper place *>

systime(1,0,current_time);
buf.timer_buf.operation:=buf.timer_buf.data(2);
buffer_time:=buf.timer_buf.data(1) <* waiting time in secs *>
_       + current_time;

buf.timer_buf.data.time:=buffer_time;
if test then dump_wq(<: after new buffer time= :>);

if waiting_q=0 then
begin <* the q is empty *>
waiting_q:=timer_buf;
buf.timer_buf.next:=0;
end
else
begin <* search for the 
proper place to insert it *>
previous_buffer:=0;
buffer:=waiting_q;
found:=false;

repeat
if buffer_time>buf.buffer.data.time then found:=true 
else
begin <* try the next *>
previous_buffer:=buffer;
buffer:=buf.buffer.next;
end;
until found or (buffer=0);

if previous_buffer=0 then
begin <* insert in front of the waiting q *>
buf.timer_buf.next:=waiting_q;
waiting_q:=timer_buf;
end
else
begin <* insert between previous_buffer and buffer *>
buf.timer_buf.next:=buffer;
buf.previous_buffer.next:=timer_buf;
end;
end insert;
end request waiting;
end case;
until false;
end timer;

\f


<********** initialise constants **********>

testout (<:phoenix started:>,0);
trap(traplab);
mask:=2**20-1;
free_core;
set_table;

iaf:=0;
buffer_head_length:=4;


<* field variables *>
next:=2;
homepool:=4;
length:=6;
operation:=8;

corout_no:=4;
incarn:=6;
bf:=8;
data:=2*buffer_head_length;
 
lab_no_of_by:= 2;
lab_rec_macro:= length+2;
lab_rec_micro:= lab_rec_macro+2;
lab_send_macro:= lab_rec_micro+2;
lab_send_micro:= lab_send_macro+2;
lab_opc_upd:= lab_send_micro+2;
lab_hour:= lab_opc_upd+2;
lab_min_sec:= lab_hour+2;
lab_data:= lab_min_sec;

<*semaphores and pools *>

tick_sem_no := 1;
timer_sem_no := 2;


tick_sem := sem_to_field(tick_sem_no);
timer_sem := sem_to_field(timer_sem_no);

<********** initialise variables **********>
  
phoenix_finished:=false;
ready_q_first:=0;
bufbase:=2;
buffer_addr:=0;
request_to_restart:=false;

\f


<*********** initialise buffer pools **********>

init_buffer_pool(tick_sem_no,1,0);
init_buffer_pool(timer_sem_no,0,0);

<********** start the coroutines **********>
 
 
 
 
activity(no_of_mhs + 2);

<* message handler *>
<*******************>
 
a:= 1;
incarnation:= 0;
init_corout_descr(a,0);
<*new_activity (a,0,message_handler);*>

<* tick generator *>
<******************>

a := a + 1;
incarnation := 0;
init_corout_descr(a,incarnation);
new_activity(a,0,tick_generator);


<* timer *>
<*********>

a:= a+1;
incarnation:=0;
init_corout_descr(a,0);
new_activity(a,0,timer);
 
 
free_core;






\f


<********** central logic **********>

begin
integer array answer(1:8);
zone z1(1,1,stderror);


repeat
c_corout_no:=0;

if ready_q_first<>0 then
i:=monitor(66,z1,buffer_addr,answer) else
i:=monitor(24,z1,buffer_addr,answer);
if test then testout(<:central logic, i=:>,i);
if test then testout(<:ready_q_first=:>,ready_q_first);

if i>0 then
begin
begin <* answer to a coroutine recived *>
c_corout_no:=answer(1);
c_corout:=8*c_corout_no-8+2;
end
end
else

if i=0 then
begin <* message received *>
<* receive the message and link it on a semaphore.
alarm messages and timer_messages are copyed to internal
buffers and answered immediately.
Other messages are answered by the relevant coroutine *>
decode_message;
end message 
else

begin <* event-que empty *>
<* no external event. If there are any coroutines in the
event-que then start the first *>


if ready_q_first<>0 then
begin
<* start the first coroutine in the ready_que *>
c_corout:=ready_q_first;
c_corout_no:=corout.c_corout.corout_no;
ready_q_first:=corout.c_corout.next;
corout.c_corout.next:=0;
if ready_q_first=0 then ready_q_last:=0;
end;
end event_que empty;






if c_corout_no>0 then
begin
if test or test_cl then testout(<:start coroutine no:>,c_corout_no);

cause:=activate(c_corout_no);

if cause<1 then
begin <* restart phoenix *>
if test then testout(<:central logic, activate-value:>,cause);
request_to_restart:=true;
end;

buffer_addr:=0;
end;


until phoenix_finished or request_to_restart;
end;


traplab:
end program;

\f


<*********** installation parameters **********>

start_up_time:=systime(7,0,0.0);
version:=0 shift 8 + 4;
no_of_restarts:=0;
no_of_sems:= 2;
no_of_mhs:= 1;
test:=true;
test_cl:=true;
test_on_bs:=false;

buf_array_length:= 100;
max_task_inc_no := 20;

repeat
last_restart_time:=systime(7,0,0.0);
program;
no_of_restarts:=no_of_restarts+1;
until phoenix_finished;

end
if warning.yes
(message warning compilation of phoenix not ok
finis)
message compilation of phoenix ok

finis

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦0819f41b2⟧ TextFile

Derivation

TextFile
