DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFileVerbose
    Names: »tadam«

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

TextFileVerbose

job bbl 3 600 time 11 0 perm mini 100 1 size 92000
(
  platonenv = set bs bblenv
; o adamout
  head 1 cpu
  pascal80 codesize.12000 spacing.12000 ,
    short.yes,
    stack.436,
    codelist.no
; o c
; convert adamout
  badam = set 1 mini
  badam = move pass6code
  if ok.yes
  scope project badam
  finis
)


process adam(var operator_sem : semaphore);

const

default_size     = 0;
spriority        = -1;
maxprocs         = 6; (* max number of process descriptors *)
maxchildren      = 10;(* max number of incarnations        *)

(* states *)
unlinked         = 0;

(* commands *)
unknown          = 0;
adam_link        = 1;
adam_create      = 2;
adam_start       = 3;
adam_stop        = 4;
adam_remove      = 5;
adam_unlink      = 6;
adam_break       = 7;

(* results *)
ok                             =  0;


opsysname       = 'opsys       ';
operatorname    = 'operator    ';
sname           = 's           ';

integerlength   = 2;
adamtype_length = 2 * alfalength + 1 * integerlength;

type
adamtype = record
name1 : alfa; (* processname *)
name2 : alfa; (* incarnationname *)
aux : integer (* size, priority or excode *)
end;

search_modes = (getprocess,getchild);

indextype = packed array (unknown..adam_break) of 0..31;

tabletype = packed array (0..23) of 0..15;

const

index = indextype(0,2,9,13,15,17,19,22);

table = tabletype(1,15,0,4,3,5,2,?,4,0,6,7,8,0,9,0,10,0,11,0,12,13,0,14);

var
sem_vector      : adamvector;
proc            : array(1..maxprocs) of process_descriptor;
child           : array(1..maxchildren) of shadow;
adam_sem        : semaphore;
msg             : reference;
processname     ,
childname       : alfa;
param           : integer;
command         : integer;
result          : integer;
i               : integer; 
j               : integer;
max             : integer;

procedure initproc(var dest,source : process_descriptor);
begin
dest := source
end; (* initproc *)

procedure setmax(mode : search_modes);
begin
case mode of
getprocess: max := maxprocs;
getchild  : max := maxchildren
end
end; (* setmax *)

function getindex(var index : integer; mode : search_modes) : boolean;
var
found : boolean := false;
begin
setmax(mode);
index := 0;
repeat
index := index + 1;
case mode of
getprocess:
with proc(index) do
if (name = processname) and (link_state <> unlinked) then
found := true;
getchild:
if not nil(child(index)) then
lock child(index).r as inc : ext_incarnation_descriptor do
if inc.incname = childname then
found := true
end
until found or (index = max);
getindex := found
end; (* getindex *)

function getfree(var index : integer; mode : search_modes) : boolean;
var
found : boolean := false;
begin
setmax(mode);
index := 0;
repeat
index := index + 1;
case mode of
getprocess:
if proc(index).link_state = unlinked then
found := true;
getchild:
if nil(child(index)) then
found := true
end
until found or (index = max);
getfree := found
end; (* getfree *)

function adamcreate(i,j : integer; var name : alfa;
p : processrec; size : integer) : integer;
begin
p.processref := ptraddr(addr_of_proc(proc(i)));
adamcreate   := create(name,p,child(j),size)
end; (* adamcreate *)

procedure run(index : integer; name : alfa; p : processrec);
var
i : integer;
begin
i := link(name,proc(index));
i := adamcreate(index,index,name,p,default_size);
if i = ok then
start(child(index),spriority)
else
i := unlink(proc(index))
end;

process s(var sem_vector : system_vector);
external;

(********************************************************************)
(*                                                                  *)
(*          adam main program                                       *)
(*                                                                  *)
(********************************************************************)
begin
own.secret_pointer^(adamstack)^.chain := addr_of(own.chain);
sem_vector(allocatorsem)              := own.secret_pointer^(allocsem);
sem_vector(adamsem)                   := ref(adam_sem);
sem_vector(operatorsem)               := ref(operator_sem);

(* move contents of process_descriptor of s to array *)
for i := 1 to maxprocs do
initproc(proc(i),s);

run(1,operatorname,s(sem_vector));
run(2,opsysname   ,s(sem_vector));
run(3,sname       ,s(sem_vector));

while true do
begin

wait(msg,adam_sem);

command := unknown;
result  := 0;

(* check size of databuffer *)
if msg^.size >= (adamtype_length div integerlength) then
begin

(* unpack parameters *)
lock msg as p : adamtype do
begin
processname := p.name1;
childname   := p.name2;
param       := p.aux
end;

command := msg^.u1;

case command of
adam_link:
if not getindex(i,getprocess) then
begin
if getfree(i,getprocess) then
result := link(processname,proc(i))
else
result := 2
end
else
result := 4;

adam_create:
if getindex(i,getprocess) then
begin
if not getindex(j,getchild) then
begin
if getfree(j,getchild) then
result := adamcreate(i,j,childname,s(sem_vector),param)
else
result := 1
end
else
result := 1
end
else
result := 2;

adam_unlink:
if getindex(i,getprocess) then
result := unlink(proc(i))
else
result := 1;

adam_start,
adam_stop,
adam_remove,
adam_break:
if getindex(i,getchild) then
case command of
adam_start : start(child(i),param);
adam_stop  : stop(child(i));
adam_remove: remove(child(i));
adam_break : break(child(i),param)
end
else
result := 1;

otherwise
command := unknown;
result := 1
end;
end;

msg^.u2 := table(index(command) + result);
return(msg)
end (* while *)
end (* adam *)
.
«eof»