⟦efc34d2f1⟧

TextFileVerbose

distmon_envir;

const
max_gateno = 50;  (* upper limit for number of connections in any gate *)

(* function-codes for messages to 'distmon' *)
open_gate = 0;
close_gate = 1;

(* function-codes for messages via send/waitg etc *)
gate_op = 255;

(* event-codes for messages via send/waitg etc *)
event_msg    = 0;
event_conn   = 1;
event_discon = 2;
event_other  = 3;

type

gate_events = event_msg .. event_other;

connect_results = (connect_ok, connect_unknown, connect_no_room, connect_no_room_receiver);

gate_inx = 1 .. max_gateno;  (* range of legal indices in connections *)

gate = record
gatenext  : ^ gate;  (* points to next in chain *)
gatefirst : ^ gate;  (* points to head of gate-chain *)
gatename  : alfa;    (* identifies this gate *)
gatepool  : ^ pool 1;(* points to pool for this gate *)
gatesem   : semaphore; (* all events are signalled to this semaphore *)
gatemax   : gate_inx;(* defines max number of connections in this gate *)
connections:         (* contains the actual links *)
array (gate_inx) of
record
receiver_gate  : ^ gate;
receiver_index : gate_inx;
end;
end;

function refgate (var g: ! gate): ^ gate; external;

procedure opengate (var g: gate; name: alfa; no: gate_inx; var poo: pool 1); external;

procedure closegate (var g: gate); external;

function connect (var g: gate; var i: integer; name: alfa): connect_results; external;

procedure disconnect (var g: gate; i: gate_inx); external;

procedure send (var g: ! gate; i: gate_inx; var msg: reference); external;

procedure waitg (var g: gate; var i: integer; var msg: reference; var ge: gate_events); external;

.

(* ***** *)

prefix opengate;
procedure opengate (var g: gate; name: alfa; no: gate_inx; var poo: pool 1);
var
msg : reference;
nilsem: ! ^ semaphore;
distmonsem : ^ semaphore;
begin
with g do
if nil(gatefirst) then
begin (* not opened before *)
gatefirst := refgate (g);  (* point - temporarily - at the gate itself *)
gatename  := name;
gatemax   := no;
gatepool  := refpool (poo);
alloc (msg, gatepool^, nilsem^ (* just some semaphore... *) );
msg^.u1 := open_gate;
msg^.start := addrptr (gatefirst);
(* distmonsem := own.secret_pointer^(...) *)
signal (msg, distmonsem^);
end;
end;

(* ***** *)
prefix closegate;
procedure closegate (var g: gate);
var
i: integer;
msg: reference;
distmonsem: ^ semaphore;
nilsem : ! ^ semaphore;
nilgate: ! ^ gate;
begin
with g do
if not nil(gatefirst) then
begin (* gate was open before *)
gatefirst := nilgate;
for i := 1 to gatemax do
disconnect (g, i);
alloc (msg, gatepool^, nilsem^ (* just some semaphore *) );
msg^.u1 := close_gate;
msg^.start := addrptr (refgate (g) );
(* distmonsem := own.secret_pointer^(...) *)
signal (msg, distmonsem^);
end;
end;

(* ***** *)
prefix connect;
function connect (var g: gate; var i: integer; name: alfa): connect_results;
var
j: integer;
cur_g: ^ gate;
result : connect_results;
msg : reference;
nilsem  : ! ^ semaphore;
nilgate : ! ^ gate;
label
endlabel;
begin
with g do
begin
cur_g := gatefirst^.gatenext;  (* point at first 'real' gate *)

for j := 1 to gatemax do (* scan all connections on 'own' gate *)
with connections(j) do
if nil(receiver_gate) then
begin
repeat (* scan all gates in gate-chain *)
with cur_g^ do
if (gatename = name) and not nil(gatefirst) then
begin
i := j; (* assign the entry found *)
receiver_gate := cur_g;
for j := 1 to gatemax do (* scan all connections of 'receiver' gate *)
if nil(connections(j).receiver_gate) then
begin
receiver_index (* of 'own' connection *) := j;
with connections(j) do
begin
receiver_index (* of 'receiver' connection *) := i;
receiver_gate := refgate(g);
end;
alloc (msg, gatepool^, nilsem^ (* just some semaphore *) );
msg^.u1 := gate_op;
msg^.u3 := event_conn;
msg^.u4 := i;
signal (msg, gatesem);
result := connect_ok;
goto endlabel;
end;
(* no empty connections were found at 'receiver' *)
receiver_gate := nilgate;
result := connect_no_room_receiver;
goto endlabel;
end
else (* not correct gatename *)
cur_g := gatenext;
until nil(cur_g);
(* no gate were found with the correct gatename *)
result := connect_unknown;
goto endlabel;
end;
(* no empty connections were found in 'own' gate *)
result := connect_no_room;
end;

endlabel:
connect := result;
end;

(* ***** *)

prefix disconnect;
procedure disconnect (var g: gate; i: gate_inx);
var
msg: reference;
nilsem  : ! ^ semaphore;
nilgate : ! ^ gate;
begin
with g do
with connections(i) do
if not nil(receiver_gate) then
begin
alloc (msg, gatepool^, nilsem^ (* just some semaphore *) );
msg^.u1 := gate_op;
msg^.u3 := event_discon;
msg^.u4 := receiver_index;
receiver_gate^.connections(receiver_index).receiver_gate := nilgate;
signal (msg, receiver_gate^.gatesem);
receiver_gate := nilgate;
end;
end;

(* ***** *)

prefix send;
procedure send (var g: ! gate; i: gate_inx; var msg: reference);
begin
with g.connections(i) do
begin
msg^.u1 := gate_op;
msg^.u3 := event_msg;
msg^.u4 := receiver_index;
signal (msg, receiver_gate^.gatesem);
end;
end;

(* ***** *)

prefix waitg;
procedure waitg (var g: gate; var i: integer; var msg: reference; var ge: gate_events);
begin
with g do
begin
wait (msg, gatesem);
i  := msg^.u4;
if (i > gatemax) or (msg^.u1 <> gate_op) or (msg^.u3 > event_other) then
ge := event_other
else
ge := msg^.u3;
end;
end;

(* ***** *)

process distmon;
var
owng: gate;
cur_g: ^ gate;
prev_g: ^ gate;
msg: reference;
distsem : semaphore;
fnc : integer;
begin
(* initialize head of gate-chain *)
with owng do
gatename := '            ';

(* initialize global pointer to distsem *)
(* own.secret_pointer^(...) := ref(distsem); *)

repeat
wait (msg, distsem);
fnc := msg^.u1;
cur_g := ptraddr (msg^.start);
release(msg);
case fnc of
open_gate:
with cur_g^ do
begin (* insert gate in front of gate-chain *)
gatenext := owng.gatenext;
owng.gatenext := cur_g;
gatefirst := refgate(owng);
end;
close_gate:
begin (* remove gate from gate-chain *)
prev_g := refgate(owng);
while not equalptr(prev_g^.gatenext, cur_g) do
prev_g := prev_g^.gatenext;
prev_g^.gatenext := cur_g^.gatenext;
end;
end; (* case fnc *)
until false;
end;
«eof»
DataMuseum.dk

RC3500

⟦efc34d2f1⟧ TextFileVerbose

Derivation

TextFileVerbose
