DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFileVerbose
    Names: »mon«

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

TextFileVerbose

process monitor(var monitorsem : semaphore);

const version ='800911 stop ';
     (***********************)
monitorpriority = 1;
monreg = 992;
niladdr=addr(base_type(0,1,0,0,0),?);

stopfunction = 0;
startfunction = 1;
setpriorityfunction = 2;
timeslicing = 3;

ok = 1;
stoperror = 3;
starterror = 3;
setpriorityerror = 3;
paramerror = 3;

stopstate = -1;
runstate = 0;

type
(* priority >=0  => class II  : coroutine scheduling  *)
(* priority < 0  => class III : timesliced scheduling *)
activetype=array(minpriority..maxpriority) of addr;

kind = (stop,start,mes);
const kindall = (.stop..mes.);

var
mask : set of kind:=kindall;
msg : reference;

t: set of 1..-minpriority :=(..);
pri:integer:=-1;

pr : ^ ext_incarnation_descriptor;
activequeue:activetype := activetype(maxpriority-minpriority+1***niladdr);
result : integer;
r : integer;

procedure setregister(value,index : integer); external;
procedure selectlevel(level : integer); external;
procedure linklast(queueaddr: addr; elemptr: ^ext_incarnation_descriptor);
external;
procedure unlinkfirst(var p: ^ext_incarnation_descriptor;var q: addr);
external;
function addr_of(var a: addr): addr; external;
procedure setqueueptr(var queueptr : addr; var queue : addr); external;
procedure getincpntr(var pr: ^ ext_incarnation_descriptor;
var p: ext_incarnation_descriptor); external;
procedure setregcouble(index: integer; var a: addr); external;
procedure scheduler; external;
procedure stopprocess(var p: ext_incarnation_descriptor); external;
procedure startdriver(var p: ext_incarnation_descriptor); external;



procedure asgnaddrinc(var a:addr; var p:ext_incarnation_descriptor);
external;

procedure print(k: kind;txt: alfa; var p: ext_incarnation_descriptor);
var a: addr;

begin
if k in mask then begin
printnl; printtext(txt);
asgnaddrinc(a,p);
if a.base.nill=0 then
printtext(' lev=#      '); printhex(p.level);
printtext(', ic=#      ');
printaddr(p.entry_point);
printtext(' gf= #      '); printaddr(a);

end
end;


procedure setactivequeue(var q:addr;var m:reference);
begin
with m^ do
begin
r:=u3-128;
if (r<minpriority) or (r>maxpriority) then
result :=setpriorityerror
else setqueueptr(q,activequeue(r))
end
end;



(***********************************************************************)
(*                                                                     *)
(*          monitor main loop                                          *)
(*                                                                     *)
(*                                                                     *)
(***********************************************************************)

begin
printnl; printtext('start monito'); printtext('r version:  ');
printtext(version); printnl;

setqueueptr(own.activequeue,activequeue(monitorpriority));
setregcouble(monreg,activequeue(0));
setregister(maxpriority,monreg+2);
setregister(minpriority,monreg+3);
setregister(-1         ,monreg+4);
setregister(maxpriority,monreg+5);
selectlevel(0);
scheduler;

repeat
wait(msg,monitorsem);
result:=ok;
if msg^.u1 = timeslicing then begin
unlinkfirst(pr,activequeue(pri));
if not nil(pr) then linklast(addr_of(activequeue(pri)),pr);
pri:=-1;
while -pri in t do pri:=pri-1;
if pri > minpriority then t:=t-(.1..-pri.)+(.-pri.) else t:=(..);
setregister(pri,monreg+4);
end else
lock msg as p : ext_incarnation_descriptor do begin
case msg^.u1 of
stopfunction: begin
if p.incstate <> stopstate then begin
stopprocess(p);
if (p.chainhead.base.nill = 0) and (p.chainhead.disp mod 2 = 0) then
p.entry_point.disp := p.entry_point.disp-1; (* repeat wait *)
print(stop,'stopprocess ',p);
p.incstate := stopstate
end (* p.regsetbase <> stopstate *)
else
result := stoperror; (* end of stopfunction *)
end;
startfunction: begin
if (p.incstate = stopstate) then begin
setactivequeue(p.activequeue,msg);
if result = ok then begin
getincpntr(pr,p); p.incstate := runstate;
print(start,'startproc   ',p);
if p.level > 0 then startdriver(p) else begin
setqueueptr(p.chainhead,activequeue(r));
linklast(p.activequeue,pr);
end;
end
end
else
result := starterror
end;
setpriorityfunction:
setactivequeue(p.activequeue,msg)
otherwise
result := paramerror
end; (* case *)
end; (*lock *)

msg^.u2 := result;
if result <> ok then print(mes,'dummyrequest',pr^);
return(msg);
until false;
end (* monitor main loop *)
.
«eof»