DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦a24586986⟧ TextFile

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »timertest«

Derivation

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »timertest« 

TextFile

process timertest(navn: alfa; sem: system_vector);
const
version=' 800717 1415';
  (*      ***********)
const scale=4; pu=0;  level=30;
var delay: semaphore;

const
ok = 1;
tomorrow = false;
maxpool = 27;
clockdriversize = 500;
clockdriverpriority = -1; (* class II *)

type
range = 0..maxpool;
timetype = array (0..(maxpool+7) div 8) of integer;

var
clock_sh : shadow;
clock : semaphore;
answer : semaphore;
msg : reference;
delaypool : array(range) of semaphore;
isem: semaphore;
a, b, i, j, count : integer;
timebits : set of 0..maxpool := (.0..maxpool-1.);
t: timetype;
messages : pool 1;

const t0=timetype((maxpool+7) div 8 + 1 *** 0);

(*********************************************************************)
process clocktest(var clock,delay: semaphore; sem: system_vector);
external;


(*********************************************************************)
procedure advancetime;
var
i, j : integer;
begin
count:=msg^.u2;
signal(msg,clock);
repeat
while open(delaypool(0)) do
begin
wait(msg,delaypool(0));
msg^.u2 := ok; 
return(msg)
end;
i := 0;
while i in timebits do
begin
i := i + 1;
delaypool(i - 1).chain := delaypool(i).chain
end;
delaypool(i).chain.base.nill:=1;
if i = maxpool then begin
t:=t0; timebits := (..)
end else
begin
timebits := timebits - (.0..i.) + (.i.);
while open(delaypool(i + 1)) do
begin
wait(msg,delaypool(i + 1));
if msg^.u3 < 64 then
begin
msg^.u3 := msg^.u3 * 2;
signal(msg,delaypool(i))
end
else
begin
msg^.u3 := msg^.u3 * 2 - 128;
signal(msg,isem)
end
end;
delaypool(i+1).chain:=isem.chain;
isem.chain.base.nill:=1;
j := i div 8;
if i mod 8 > 0 then
t(j + 1) := t(j + 1) + 1;
if j > 0 then
begin
t(j) := t(j) + 1;
for i := 0 to j - 1 do
t(i):=0;
end
else
t(0) := t(0) + 128;
end;
count:=count-1;
until count<0
end; (* advancetime *)

(**********************************************************************)
begin
platoninit;
printnl; printtext('timertest   '); printtext(version); printnl;
alloc(msg,messages,answer);

(* a:= 2**scale *)
a:=1;  for i:=1 to scale do a:=a*2;

link('clocktest   ',clocktest);
i:=create(clocktest(clock,delay,sem),clock_sh,clockdriversize,pu);
start(clock_sh,clockdriverpriority);

msg^.u2:=0;
repeat
advancetime;
sensesem(msg,delay);
while not nil(msg) do
begin
a := msg^.u3;
b := msg^.u4 - scale + 7;
if a <> 0 then
while a < 128 do
begin
a := a * 2;
b := b - 1
end
else
b := -1;

if b < 0 then
begin
msg^.u2 := ok;
return(msg)
end
else begin
if b <= maxpool then
begin
j := t(b div 8);
for i := 1 to b mod 8 do
j := j div 2;
a := a - 128 + j mod 128;
if b>7 then if not(timebits <= (.b-7..maxpool.)) then
a := a + 1;
if a > 127 then
begin
a := a div 2 - 64;
b := b + 1
end
end;
if b > maxpool then
begin
b := maxpool;
a := 127
end;
if b>0 then if b-1 in timebits then
a := a*2 mod 128;
msg^.u3 := a;
signal(msg,delaypool(b));
end;
sensesem(msg,answer);
if not nil(msg) then
advancetime;
sensesem(msg,delay)
end;

wait(msg,answer)
until tomorrow
end (* timer *)
.
▶EOF◀