DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFileVerbose
    Names: »tlistlib«

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

TextFileVerbose

 
prefix list;
procedure list(var z : zone; name : alfa);

const
procincsize = maxint;
maxlevel = 10;    (* the tree searched cannot be deeper *)
findappetite = maxlevel*50;

procedure initref(var x : reference; var y : message_header); 
external;

function asgnptradr(a : addr) : ^shadow; external;

function refshadow(var sh : shadow) : ^shadow;
external;

procedure checkstack(appetite : integer);
external;

var
foundcandidate : boolean;

nilp : !^shadow;

adammsgheader : message_header;
adamshadow : shadow;
adamaddr : addr;
adamsh : ^shadow;

monitormsgheader : message_header;
monitorshadow : shadow;
monitoraddr : addr;
monitorsh : ^shadow;

timermsgheader : message_header;
timershadow : shadow;
timeraddr : addr;
timersh : ^shadow;

allocmsgheader : message_header;
allocshadow : shadow;
allocaddr : addr;
allocsh : ^shadow;

linkermsgheader : message_header;
linkershadow : shadow;
linkeraddr : addr;
linkersh : ^shadow;

procedure initheader(var msg : message_header;
kind,msize : integer; mstart : addr);

(*initialises the message header*)

begin
with msg do
begin
owner := ref(own.exit_semaphore);
answer := owner;
messagekind := kind;
size := msize;
start := mstart;
end
end;  (* initheader *)
 
procedure findprocinc(candidate : alfa;from : ^shadow;var res : ^shadow;
 level,number : integer);

(*the procedure scans the subtree with root : from, for occourance of
a process incarnation with the name : candidate. the scanning is
performed to the leaves from left to right . level will hold the tree depth
and number will hold the local branch number -number in shadow-chain *)

var
sha : addr;
sh : ^shadow;
finis : boolean ; 

begin
if not nil(from^.r) then
begin
level := level+1;
lock from^.r as p : ext_incarnation_descriptor do
begin
if p.incname <> candidate then 
begin
sha := p.shadowchain;
sh := asgnptradr(sha);  (* transform an addr to ^shadow *)
if (nil(sh)) or ( level >= maxlevel) then
begin
if level >= maxlevel then
begin
outtext(z,'**deptherror');
outchar(z,nl);
end
end
else
findprocinc(candidate,sh,res,level,1);
if not foundcandidate then
begin
finis := false;
if not nil(sh) then
repeat
sh := sh^.next;
if not nil(sh^.r) then
number := number +1;
if not nil(sh) then
begin
findprocinc(candidate,sh,res,level,number);
if foundcandidate then finis := true;
end
else
finis := true;
until finis;
end
end
else
begin
foundcandidate := true;
res := from;
end;
end;
end
end;     (*findprocinc*)


procedure listall(res : ^shadow; level,number : integer);

(* the process incarnation names in the subtree from the process
incarnation pointed out by res are written with depth, branchno *)

var
sha : addr;
sh : ^shadow;
finis : boolean;
shmem,shdisp : integer;

begin
if not nil(res^.r) then
begin

level := level+1;
shdisp := res^.r^.start.disp;
shmem := res^.r^.start.base.mem_no;
lock res^.r as p : ext_incarnation_descriptor do
begin
outtext(z,p.incname);
outtext(z," depth");
outnumber(z,level,5);
outtext(z,"   branchno:");
outnumber(z,number,5);
outchar(z,nl);
sha := p.shadowchain;
sh := asgnptradr(sha);    (* transform an addr to ^shadow *)
if (nil(sh)) or (level >= maxlevel) then
begin
if level >= maxlevel then
begin
outtext(z,'**deptherror');
outchar(z,nl);
end
end
else
listall(sh,level,number);
if not nil(sh) then
repeat
sh := sh^.next;
if not nil(sh) then
begin
if not nil(sh^.r) then
number := number+1;
listall(sh,level,number);
end
else
begin
number := 1;
level := level-1;
finis := true;
end
until finis;
end;
end
end; (*listall*)


procedure listfrom(candidate : alfa);

(* finds candidate and lists the subtree from this point in tree *)

var
res : ^shadow;
xlevel,xnumber : integer;

begin
xlevel := 0;
xnumber := 1;
checkstack(findappetite);
wait(own.exitref,own.secret_pointer^(stopsem)^);
if candidate = "monitor     " then res := monitorsh
else if candidate = "timer       " then res := timersh
else if candidate = "allocator   " then res := allocsh
else if candidate = "linker      " then res := linkersh
else
begin
foundcandidate := false;
findprocinc(candidate,adamsh,res,xlevel,xnumber);
end;
release(own.exitref);
if foundcandidate then
begin
xnumber := 1;
xlevel := 0;
checkstack(findappetite);
wait(own.exitref,own.secret_pointer^(stopsem)^);
listall(res,xlevel,xnumber);
release(own.exitref);
end
end;   (* listfrom *)

begin
adamaddr := own.secret_pointer^(adamstack)^.chain;
initref(adamshadow.r,adammsgheader);
initheader(adammsgheader,16384,procincsize,adamaddr);
adamsh := refshadow(adamshadow);

monitoraddr := own.secret_pointer^(monitorstack)^.chain;
initref(monitorshadow.r,monitormsgheader);
initheader(monitormsgheader,16384,procincsize,monitoraddr);
monitorsh := refshadow(monitorshadow);

timeraddr := own.secret_pointer^(timerstack)^.chain;
initref(timershadow.r,timermsgheader);
initheader(timermsgheader,16384,procincsize,timeraddr);
timersh := refshadow(timershadow);

allocaddr := own.secret_pointer^(allocatorstack)^.chain;
initref(allocshadow.r,allocmsgheader);
initheader(allocmsgheader,16384,procincsize,allocaddr);
allocsh := refshadow(allocshadow);

linkeraddr := own.secret_pointer^(linkerstack)^.chain;
initref(linkershadow.r,linkermsgheader);
initheader(linkermsgheader,16384,procincsize,linkeraddr);
linkersh := refshadow(linkershadow);

own.shadowchain := nilp; (* det skal der ses paa igen *)

listfrom(name);
end;
.
«eof»