⟦ac2015708⟧

TextFileVerbose

job pm 2 600 time 11 0 perm mini 100 1  size 110000
platonenv = set bs bblenv
(
; o timerout
  head 1 cpu
  pascal80 codesize.12000 spacing.12000 ,
    stack.200,
    codelist.no,
    ioenvir
; o c
; convert timerout
  btimer = set 1 mini
  btimer = move pass6code
  if ok.yes
    scope project btimer
  finis
)


process timer (var timersem, dummysem: semaphore);

label
put_in_queue,
insert,
endloop,
get_time,
hangup,
insert2;

(* definitions for global time *)
type
daytype = array (1..12) of byte;
const
maxdays = daytype (31,28,31,30,31,30,30,31,30,31,30,31);
var
global_date : coded_date := coded_date (81, 6, 1);
global_time : coded_time := coded_time (?, 11, 40);
global_msec : integer := 0;   (* unit is milli seconds *)
one_minute  : integer;

(* definitions for timer interrupts *)
const
level = 2;
clock_level_index = 0;
timer_index1      = 4;
timer_index2      = 3;
timeperiod = 50; (* milli seconds, must be a multiple of 5 msec *)
ticks_per_sec = 1000 div timeperiod;
ticks_per_slice = 200 div timeperiod;
monreg = 992;

type
activetype = array (minpriority..maxpriority) of addr;
const
delaysize = 5; (* words *)

type
mess_hdr = record
chain : ^ mess_hdr;
?     : integer;
size  : integer;
start : ^ delaytype;
?,?,?,?: addr;
?,?   : byte;
u3u4  : integer;
end;

var
msg, dev: reference;
iotimerptr: ^ semaphore;
timerhead : ^ mess_hdr;
msgptr    : ^ mess_hdr;
prevmsg   : ^ mess_hdr;
curmsg    : ^ mess_hdr;
nill      : ! ^ niltype;
a         : addr;
longdelay : ^ mess_hdr;
prevdelay : ^ mess_hdr;
curdelay  : ^ mess_hdr;

delay     : integer;
power     : integer;
i         : integer;

dummy     : integer;
mask      : integer;

io_tick   : integer;
slice_tick: integer;

pri       : integer;
priobits  : integer;
activequeue: ^ activetype;

(* variables for iotimer *)
delayhead : addr; (* points to first process in timer-chain, or nil *)
proc, newproc: ^ ext_incarnation_descriptor;
insertion, searching : boolean;

procedure clearlevel; external;
procedure writeram (value, index: integer); external;
procedure setregister (value, index: integer); external;
procedure requeue (var q: addr); external;
procedure startschedule; external;
procedure timestep (p: addr); external;

function maxday (year, month: integer): integer;
begin
maxday := maxdays(month)
 + ord(((year mod 4)=0) and (month=2));
end;

begin
own.secret_pointer^(timerstack)^.chain := addr_of (own.chain);
activequeue := ptraddr (own.secret_pointer^(activebase)^.chain);
iotimerptr := own.secret_pointer^(iotimersem);

delayhead.base.nill := 1;

dummy := reservech (dev, level, 0);
writeram (clock_level_index, level);
io_tick := timeperiod div 5 * 2; (* interrupt unit is 2.5 msec *)
writeram (timer_index1, io_tick div 256);
writeram (timer_index2, io_tick mod 256);

one_minute := umul (60, 1000);

slice_tick := 0;
pri := -1;
priobits := 0;

repeat
io_tick := 0;
channel dev do
repeat
clearlevel;  (* wait interrupt *)

(* get timer messages *)
while open (timersem) do
begin
wait (msg, timersem);
delay := msg^.u3;
power := msg^.u4;
asgnaddrref (a, msg);
msgptr := ptraddr (a);
asgnrefaddr (msg, addrptr (nill));

if delay <> 0 then
begin (* delay is: delay * 2**power *)
while power <> 0 do
begin
delay := uadd (delay, delay);
if delay < 0 then
power := 0
else
power := power - 1;
end;

put_in_queue:
prevmsg := nill;
curmsg  := timerhead;

while not nil (curmsg) do
begin
if ult (delay, curmsg^.u3u4) then 
begin
with curmsg^ do
u3u4 := usub(u3u4,delay);
goto insert
end;
delay   := usub (delay, curmsg^.u3u4);
prevmsg := curmsg;
curmsg  := curmsg^.chain;
end;
insert:;
msgptr^.u3u4 := delay;
msgptr^.chain:= curmsg;
if nil(prevmsg) then
timerhead := msgptr
else
prevmsg^.chain := msgptr;
end (* simple delay *)
else
if ult(msgptr^.size, delaysize) or nil(msgptr^.start) then
begin
delay := 0;
goto put_in_queue;
end
else
with msgptr^.start^ do
begin (* databuffer has delay_format *)
if power = 0 then
begin (* absolute delay *)
(* add increment to previous time *)
i              := prev_secs.msec + inc.msecs;
prev_secs.msec :=                              i mod 1000;
i              := prev_secs.sec  + inc.secs  + i div 1000;
prev_secs.sec  :=                              i mod 60;
i              := prev_time.minute+inc.mins  + i div 60;
prev_time.minute:=                             i mod 60;
i              := prev_time.hour + inc.hours + i div 60;
prev_time.hour :=                              i mod 24;
i              :=                  inc.days  + i div 24;
if i > 0 then
begin
i            := prev_date.day              + i;
while i > maxday(prev_date.year_after_1900, prev_date.month) do
begin
i := i - maxday(prev_date.year_after_1900, prev_date.month);
if prev_date.month < 11 then
prev_date.month := succ (prev_date.month)
else
begin
prev_date.month := 1;
prev_date.year_after_1900 := (prev_date.year_after_1900 + 1) mod 128;
end;
end; (* while *)
prev_date.day := i;
end;

(* insert in simple chain if prev(year..min) = global_time(year..min) *)
if prev_date.year_after_1900 = global_date.year_after_1900 then
begin
if prev_date.month = global_date.month then
begin
if prev_date.day = global_date.day then
begin
if prev_time.hour = global_time.hour then
begin
if prev_time.minute = global_time.minute then
begin (* insert in simple queue *)
delay := uadd (umul(prev_secs.sec, 1000), prev_secs.msec);
if ult (global_msec, delay) then
begin
delay := usub (delay, global_msec);
goto put_in_queue;
end;
end
else
if prev_time.minute > global_time.minute then goto hangup;
end
else
if prev_time.hour > global_time.hour then goto hangup;
end
else
if prev_date.day > global_date.day then goto hangup;
end
else
if prev_date.month > global_date.month then goto hangup;
end
else
if prev_date.year_after_1900 > global_date.year_after_1900 then goto hangup;

(* prev <= global_time, return message as soon as possible *)
get_time:
begin
prev_date := global_date;
prev_time := global_time;
prev_secs.sec  := udiv (global_msec, 1000);
prev_secs.msec := umod (global_msec, 1000);
end;
delay := 0;
goto put_in_queue;

(* prev > global_time(year..min), insert in delaylist *)
hangup:
msgptr^.chain := longdelay;
longdelay := msgptr;
end (* power = 0 *)
else
begin
if power = 1 then
begin
global_date := prev_date;
global_time := prev_time;
global_msec := uadd (umul (prev_secs.sec, 1000), prev_secs.msec);
end;
goto get_time;
end;
end;
end; (* while open (timersem) *)

(* define-timer messages *)
while open (iotimerptr^) do
begin
wait (msg, iotimerptr^);
insertion := msg^.u2 = ord(true);
proc := ptraddr (delayhead);  (* proc points at first process *)
if delayhead = msg^.start then
begin (* process was in front of chain *)
if not insertion then
delayhead := proc^.delaychain;
end
else
begin (* process was not in front of chain, try to find it *)
searching := true;
while not nil(proc) and searching do
begin
newproc := ptraddr(proc^.delaychain);
if proc^.delaychain = msg^.start then
begin (* process was found in chain *)
if not insertion then
proc^.delaychain := newproc^.delaychain;
searching := false;
end
else
proc := newproc;
end;
if searching and insertion then
begin (* insert, if not found already *)
proc := ptraddr (msg^.start);
proc^.delaychain := delayhead;
delayhead := msg^.start;
end;
end;
return (msg);
end; (* while open (iotimerptr) *)

(* time slicing *)
slice_tick := slice_tick + 1;
if slice_tick >= ticks_per_slice then
begin
slice_tick := 0;
requeue (activequeue^(pri));
pri := -1;
mask := 1;
(* find rightmost zero-bit *)
while (priobits and mask) <> 0 do
begin
pri := pri - 1;
mask := uadd (mask, mask);
end;
if pri = minpriority then
priobits := 0
else
priobits := uadd (priobits, 1);
setregister (pri, monreg+4);
startschedule;
end;

(* update global time *)
begin
global_msec := uadd (global_msec, timeperiod);
if not ult (global_msec, one_minute) then
begin
global_msec := usub (global_msec, one_minute);
with global_date, global_time do
if minute < 59 then
minute := succ (minute)
else
begin
minute := 0;
if hour < 23 then
hour := succ (hour)
else
begin
hour := 0;
if day < maxday(year_after_1900, month) then
day := succ (day)
else
begin
day := 1;
if month < 11 then
month := succ (month)
else
begin
month := 1;
year_after_1900 := (year_after_1900 + 1) mod 128;
end;
end;
end;
end;
(* minute has changed, scan delaylist and transfer to simple delay list *)
prevdelay := nill;
curdelay  := longdelay;
while not nil(curdelay) do
with curdelay^.start^ do
begin
if (prev_date.year_after_1900 <= global_date.year_after_1900) and
(prev_date.month            <= global_date.month          ) and
(prev_date.day              <= global_date.day            ) and
(prev_time.hour             <= global_time.hour           ) and
(prev_time.minute           <= global_time.minute         )     then
begin
msgptr := curdelay;
curdelay := curdelay^.chain;
if nil(prevdelay) then
longdelay := curdelay
else
prevdelay^.chain := curdelay;
delay := uadd (umul (prev_secs.sec, 1000), prev_secs.msec);
if ult (global_msec, delay) then
delay := usub (delay, global_msec)
else
delay := 0;

(* put in simple delay list *)
prevmsg := nill;
curmsg  := timerhead;

while not nil(curmsg) do
begin
if ult (delay, curmsg^.u3u4) then goto insert2;
delay   := usub (delay, curmsg^.u3u4);
prevmsg := curmsg;
curmsg  := curmsg^.chain;
end;
insert2:;
msgptr^.u3u4 := delay;
msgptr^.chain:= curmsg;
if nil(prevmsg) then
timerhead := msgptr
else
prevmsg^.chain := msgptr;
end
else
begin
prevdelay := curdelay;
curdelay  := curdelay^.chain;
end;
end;

end;
end;

(* return messages *)
if nil(timerhead) then goto endloop;
while not ult (timeperiod, timerhead^.u3u4) do
begin
delay := timerhead^.u3u4;
timerhead^.u3u4 := 0;
asgnrefaddr (msg, addrptr (timerhead));
timerhead := timerhead^.chain;
return (msg);
if nil(timerhead) then goto endloop;
timerhead^.u3u4 := uadd (timerhead^.u3u4, delay);
end;
timerhead^.u3u4 := usub (timerhead^.u3u4, timeperiod);
endloop:;

io_tick := io_tick + 1;
until io_tick = ticks_per_sec;

(* handle iotimer counting at level 0 *)
timestep (delayhead);

until false;
end (* timer *);
.
«eof»
DataMuseum.dk

RC3500

⟦ac2015708⟧ TextFileVerbose

Derivation

TextFileVerbose
