PACKET spool manager DEFINES (* Autor: J. Liedtke *)
(* R. Nolting *)
(* R. Ruland *)
(* Stand: 22.07.86 *)
spool manager ,
server channel ,
spool duty,
station only,
spool control task :
LET que size = 101 ,
ack = 0 ,
nak = 1 ,
error nak = 2 ,
message ack = 3 ,
question ack = 4 ,
second phase ack = 5 ,
false code = 6 ,
fetch code = 11 ,
save code = 12 ,
exists code = 13 ,
erase code = 14 ,
list code = 15 ,
all code = 17 ,
param fetch code = 21 ,
file save code = 22 ,
entry line code = 23 ,
killer code = 24 ,
first code = 25 ,
start code = 26 ,
stop code = 27 ,
halt code = 28 ,
wait for halt code = 29 ,
continue code = 100 ,
file type = 1003 ;
LET begin char = ""0"",
end char = ""1"";
LET PARAMS = STRUCT (TEXT name, userid, password, sendername, INT station),
ENTRY = STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space);
ROW que size ENTRY VAR que ;
PARAMS CONST empty params := PARAMS : ("", "", "", "", -1);
PARAMS VAR save params, file save params;
ENTRY VAR fetch entry;
FILE VAR file;
INT VAR order, last order, phase, reply, old heap size, first, last, list index,
begin pos, end pos, order task station, sp channel, counter;
TEXT VAR order task name, buffer, sp duty, start time;
BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry;
TASK VAR order task, last order task, server, calling parent, task in control;
INITFLAG VAR in this task := FALSE;
DATASPACE VAR ds;
BOUND STRUCT (TEXT name, userid, password) VAR msg;
BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
BOUND PARAMS VAR fetch msg;
BOUND THESAURUS VAR all msg;
BOUND TEXT VAR error msg ;
. first entry : que (first)
. list entry : que (list index)
. last entry : que (last)
. que is empty : first = last
. que is full : first = next (last)
.;
sp channel := 0;
sp duty := "";
stat only := FALSE;
task in control := myself;
PROC server channel (INT CONST channel nr) :
IF channel nr <= 0 OR channel nr >= 33
THEN errorstop ("falsche Kanalangabe") FI;
sp channel := channel nr;
END PROC server channel;
INT PROC server channel :
sp channel
END PROC server channel;
PROC station only (BOOL CONST flag) :
stat only := flag
END PROC station only;
BOOL PROC station only :
stat only
END PROC station only;
PROC spool duty (TEXT CONST duty) :
sp duty := duty;
END PROC spool duty;
TEXT PROC spool duty :
sp duty
END PROC spool duty;
PROC spool control task (TASK CONST task id):
task in control := task id;
END PROC spool control task;
TASK PROC spool control task :
task in control
END PROC spool control task;
PROC spool manager (PROC server start) :
spool manager (PROC server start, TRUE)
END PROC spool manager;
PROC spool manager (PROC server start, BOOL CONST with start) :
set autonom ;
break ;
disable stop ;
initialize spool manager ;
REP forget (ds) ;
wait (ds, order, order task) ;
IF order <> second phase ack
THEN prepare first phase ;
spool (PROC server start);
ELIF order task = last order task
THEN prepare second phase ;
spool (PROC server start);
ELSE send nak
FI ;
send error if necessary ;
collect heap garbage if necessary
PER
. initialize spool manager :
initialize if necessary;
stop;
erase fetch entry;
IF with start THEN start (PROC server start) FI;
. initialize if necessary :
IF NOT initialized (in this task)
THEN FOR list index FROM 1 UPTO que size
REP list entry. space := nilspace PER;
fetch entry. space := nilspace;
ds := nilspace;
last order task := niltask;
server := niltask;
calling parent := niltask;
server is waiting := FALSE;
stop command pending := FALSE;
old heap size := 0;
clear spool;
FI;
. prepare first phase :
IF order = save code OR order = erase code OR order = stop code
THEN phase := 1 ;
last order := order ;
last order task := order task ;
FI;
. prepare second phase :
phase INCR 1 ;
order := last order
. send nak :
forget (ds) ;
ds := nilspace ;
send (order task, nak, ds);
. send error if necessary :
IF is error
THEN forget (ds) ;
ds := nilspace ;
error msg := ds ;
CONCR (error msg) := error message;
clear error;
send (order task, error nak, ds)
FI;
. collect heap garbage if necessary :
IF heap size > old heap size + 2
THEN collect heap garbage;
old heap size := heap size;
FI;
END PROC spool manager;
PROC spool (PROC server start):
command dialogue (FALSE);
enable stop;
IF station only CAND station (ordertask) <> station (myself)
THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself))
+ "/""" + name(myself) + """")
FI;
SELECT order OF
CASE fetch code : out of que
CASE param fetch code : send fetch params
CASE save code : new que entry
CASE file save code : new file que entry
CASE exists code : exists que entry
CASE erase code : erase que entry
CASE list code : send spool list
CASE all code : send owners ds names
OTHERWISE :
IF order >= continue code AND order task = supervisor
THEN forget (ds);
spool command (PROC server start)
ELIF spool control allowed by order task
THEN SELECT order OF
CASE entry line code : send next entry line
CASE killer code : kill entry
CASE first code : make to first
CASE start code : start server
CASE stop code : stop server
CASE halt code : halt server
CASE wait for halt code : wait for halt
OTHERWISE : errorstop ("falscher Auftrag fuer Task """
+ name(myself) + """")
END SELECT
ELSE errorstop ("falscher Auftrag fuer Task """
+ name(myself) + """")
FI;
END SELECT;
. spool control allowed by order task :
(order task = spool control task OR order task < spool control task
OR spool control task = supervisor)
AND station (order task) = station (myself)
.
out of que :
IF NOT (order task = server)
THEN errorstop ("keine Servertask")
ELIF stop command pending
THEN forget (ds);
stop;
erase fetch entry;
ELIF que is empty
THEN forget (ds) ;
erase fetch entry;
server is waiting := TRUE;
ELSE send first entry;
FI;
.
send fetch params :
IF order task = server
THEN send params
ELSE errorstop ("keine Servertask")
FI;
. send params :
forget(ds); ds := nilspace; fetch msg := ds;
fetch msg := fetch entry. ds params;
send (order task, ack, ds);
.
new que entry :
IF phase = 1
THEN prepare into que
ELSE into que
FI;
.
prepare into que :
msg := ds ;
save params. name := msg.name;
save params. userid := msg.userid;
save params. password := msg.password;
save params. sendername := name (order task);
save params. station := station (order task);
forget (ds); ds := nilspace;
send (order task, second phase ack, ds);
.
new file que entry :
IF type (ds) <> file type
THEN errorstop ("Datenraum hat falschen Typ");
ELSE get file params;
into que;
FI;
. get file params :
file := sequential file (input, ds);
end pos := 0;
next headline information (file save params. name);
next headline information (file save params. userid);
next headline information (file save params. password);
next headline information (file save params. sendername);
next headline information (buffer);
file save params. station := int (buffer);
IF NOT last conversion ok
THEN file save params. station := station (order task) FI;
IF file save params. sendername = ""
THEN file save params. sendername := name (order task) FI;
IF file save params. name = ""
THEN IF headline (file) <> ""
THEN file save params. name := headline (file);
ELSE errorstop ("Name unzulaessig")
FI;
ELSE headline (file, file save params. name);
FI;
.
exists que entry :
msg := ds ;
order task name := name (order task);
order task station := station (order task);
to first que entry;
WHILE next que entry found
REP IF is entry from order task (msg. name)
THEN send ack;
LEAVE exists que entry
FI;
PER ;
forget (ds); ds := nilspace;
send (order task, false code, ds)
.
erase que entry :
msg := ds ;
order task name := name (order task);
order task station := station (order task);
IF phase = 1
THEN ask for erase
ELSE erase entry from order task
FI;
. ask for erase :
to first que entry;
WHILE next que entry found
REP IF is entry from order task (msg. name)
THEN manager question ("""" + msg.name + """ loeschen");
LEAVE erase que entry
FI;
PER ;
manager message ("""" + msg.name + """ existiert nicht");
. erase entry from order task :
IF is entry from order task (msg. name)
THEN delete que entry;
LEAVE erase que entry
ELSE to first que entry;
WHILE next que entry found
REP IF is entry from order task (msg. name)
THEN delete que entry;
LEAVE erase que entry
FI ;
PER ;
manager message ("""" + msg.name + """ existiert nicht");
FI;
. delete que entry :
erase entry (list index) ;
send ack;
.
send owners ds names:
order task name := name (order task);
order task station := station (order task);
forget (ds); ds := nilspace; all msg := ds;
all msg := empty thesaurus;
to first que entry;
WHILE next que entry found
REP IF is entry from order task ("")
THEN insert (all msg, list entry. ds params. name)
FI;
PER;
send (order task, ack, ds)
.
send spool list :
list spool;
send (order task, ack, ds);
.
send next entry line :
control msg := ds;
get next entry line (control msg. entry line, control msg. index);
send (order task, ack, ds);
.
kill entry :
control msg := ds;
list index := control msg. index;
IF is valid que entry (list index)
THEN erase entry (list index)
FI;
send (order task, ack, ds);
.
make to first :
control msg := ds;
list index := control msg. index;
IF is valid que entry (list index)
THEN new first (list entry);
erase entry (list index);
FI;
send (order task, ack, ds);
.
start server :
IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI;
start (PROC server start);
IF server channel <= 0 OR server channel >= 33
THEN manager message ("WARNUNG : Serverkanal nicht eingestellt");
ELSE send ack
FI;
.
stop server:
IF phase = 1
THEN stop;
IF valid fetch entry
THEN valid fetch entry := FALSE;
manager question (""13""10"" +
fetch entry. entry line + " neu eintragen");
ELSE erase fetch entry;
send ack;
FI;
ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI;
erase fetch entry;
send ack;
FI;
.
halt server :
stop command pending := TRUE;
IF NOT exists (server) OR server is waiting
THEN stop;
erase fetch entry;
FI;
send ack;
.
wait for halt :
IF exists (calling parent)
THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt")
ELSE calling parent := order task;
stop command pending := TRUE;
forget (ds);
IF NOT exists (server) OR server is waiting
THEN stop;
erase fetch entry;
FI;
FI;
END PROC spool;
PROC send first entry :
forget (ds); ds := first entry. space;
send (server, ack, ds, reply) ;
IF reply = ack
THEN server is waiting := FALSE;
start time := time of day;
start time CAT " am ";
start time CAT date;
erase fetch entry;
fetch entry := first entry;
erase entry (first);
valid fetch entry := TRUE;
ELSE forget (ds);
FI;
END PROC send first entry;
PROC into que :
IF que is full
THEN errorstop ("Spool ist voll")
ELSE make new entry;
send ack;
awake server if necessary
FI;
. make new entry :
IF order = save code
THEN last entry. ds params := save params;
save params := empty params;
ELSE last entry. ds params := file save params;
file save params := empty params;
FI;
last entry. space := ds;
counter INCR 1;
build entry line;
last := next (last) ;
. build entry line :
IF LENGTH last entry. ds params. sender name > 16
THEN buffer := subtext (last entry. ds params. sender name, 1, 13);
buffer CAT "...""";
ELSE buffer := last entry. ds params. sender name;
buffer CAT """";
buffer := text (buffer, 17);
FI;
last entry. entry line := entry station text;
last entry. entry line CAT "/""";
last entry. entry line CAT buffer;
last entry. entry line CAT " : """ ;
last entry. entry line CAT last entry. ds params. name;
last entry. entry line CAT """ (" ;
last entry. entry line CAT text (storage (last entry. space));
last entry. entry line CAT " K)";
. entry station text :
IF last entry. ds params. station = 0
THEN " "
ELSE text (last entry. ds params. station, 3)
FI
. awake server if necessary :
IF server is waiting THEN send first entry FI;
END PROC into que;
PROC list spool :
forget (ds); ds := nilspace;
file := sequential file (output, ds) ;
max line length (file, 1000);
headline(file, station text + "/""" + name (myself) + """");
put spool duty;
put current job;
put spool que;
. station text :
IF station(myself) = 0
THEN ""
ELSE text (station(myself))
FI
. put spool duty :
IF spool duty <> ""
THEN write (file, "Aufgabe: ");
write (file, spool duty );
line (file, 2);
FI;
. put current job :
IF valid fetch entry AND exists (server)
THEN write (file, "In Bearbeitung seit ");
write (file, start time);
write (file, ":");
line (file, 2);
putline (file, fetch entry. entry line);
IF stop command pending
THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert");
FI;
line (file);
ELSE write (file, "kein Auftrag in Bearbeitung");
IF NOT exists (server)
THEN write (file, ", da Spool deaktiviert");
ELIF que is empty
THEN write (file, ", da Warteschlange leer");
LEAVE list spool;
FI;
line (file, 2);
FI;
. put spool que :
IF que is empty
THEN putline (file, "Warteschlange ist leer");
ELSE write (file, "Warteschlange (");
write (file, text (counter));
write (file, " Auftraege):");
line (file, 2);
to first que entry ;
WHILE next que entry found
REP putline (file, list entry. entry line) PER;
FI;
END PROC list spool ;
PROC clear spool :
first := 1;
last := 1;
counter := 0;
FOR list index FROM 1 UPTO que size
REP list entry. ds params := empty params;
list entry. entry line := "";
forget (list entry. space)
PER;
END PROC clear spool;
(*********************************************************************)
(* Hilfsprozeduren zum Spoolmanager *)
BOOL PROC is valid que entry (INT CONST index) :
que (index). entry line <> ""
END PROC is valid que entry;
INT PROC next (INT CONST index) :
IF index < que size
THEN index + 1
ELSE 1
FI
END PROC next;
PROC to first que entry :
list index := first - 1;
ENDPROC to first que entry ;
BOOL PROC next que entry found :
list index := next (list index);
WHILE is not last que entry
REP IF is valid que entry (list index)
THEN LEAVE next que entry found WITH TRUE FI;
list index := next (list index);
PER;
FALSE
. is not last que entry :
list index <> last
ENDPROC next que entry found ;
PROC get next entry line (TEXT VAR entry line, INT VAR index) :
IF index = 0
THEN list index := first - 1
ELSE list index := index
FI;
IF next que entry found
THEN entry line := list entry. entry line;
index := list index;
ELSE entry line := "";
index := 0;
FI;
END PROC get next entry line;
PROC new first (ENTRY VAR new first entry) :
IF que is full
THEN errorstop ("Spool ist voll")
ELSE first DECR 1 ;
IF first = 0 THEN first := que size FI;
first entry := new first entry;
counter INCR 1;
FI;
END PROC new first;
PROC erase entry (INT CONST index) :
entry. ds params := empty params;
entry. entry line := "";
forget (entry.space) ;
counter DECR 1;
IF index = first
THEN inc first
FI ;
. entry : que (index)
. inc first :
REP first := next (first)
UNTIL que is empty OR is valid que entry (first) PER
END PROC erase entry;
PROC erase fetch entry :
fetch entry. ds params := empty params;
fetch entry. entry line := "";
forget (fetch entry. space);
valid fetch entry := FALSE;
END PROC erase fetch entry;
BOOL PROC is entry from order task (TEXT CONST file name) :
correct order task CAND correct filename
. correct order task :
order task name = list entry. ds params. sendername
AND order task station = list entry. ds params. station
. correct file name :
file name = "" OR file name = list entry. ds params. name
END PROC is entry from order task;
PROC start (PROC server start):
begin (PROC server start, server);
END PROC start;
PROC stop :
stop server;
send calling parent reply if necessary;
. stop server:
IF exists (server) THEN end (server) FI;
server := niltask;
server is waiting := FALSE;
stop command pending := FALSE;
. send calling parent reply if necessary :
IF exists (calling parent)
THEN forget (ds); ds := nilspace;
send (calling parent, ack, ds);
calling parent := niltask;
FI;
END PROC stop;
PROC next headline information (TEXT VAR t):
begin pos := pos (headline (file), begin char, end pos + 1);
IF begin pos = 0
THEN begin pos := LENGTH headline (file) + 1;
t := "";
ELSE end pos := pos (headline (file), end char, begin pos + 1);
IF end pos = 0
THEN end pos := LENGTH headline (file) + 1;
t := "";
ELSE t := subtext (headline (file), begin pos+1, end pos-1)
FI
FI
END PROC next headline information;
PROC send ack :
forget (ds); ds := nilspace;
send (order task, ack, ds)
END PROC send ack;
PROC manager question (TEXT CONST question) :
forget (ds); ds := nilspace; error msg := ds ;
error msg := question ;
send (order task, question ack, ds)
ENDPROC manager question ;
PROC manager message (TEXT CONST message) :
forget (ds); ds := nilspace; error msg := ds ;
error msg := message ;
send (order task, message ack, ds)
ENDPROC manager message ;
(*********************************************************************)
(* Spool - Kommandos *)
INT VAR command index , params ;
TEXT VAR command line, param 1, param 2 ;
LET spool command list =
"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0
clearspool:9.0spoolcontrolby:10.1";
PROC spool command (PROC server start) :
enable stop ;
continue (order - continue code) ;
disable stop ;
REP command dialogue (TRUE) ;
get command ("gib Spool-Kommando:", command line);
analyze command (spool command list, command line, 3, command index,
params, param1, param2);
execute command (PROC server start);
UNTIL NOT online PER;
command dialogue (FALSE);
break (quiet);
set autonom;
END PROC spool command;
PROC execute command (PROC server start) :
enable stop;
SELECT command index OF
CASE 1 : break
CASE 2 : start server
CASE 3 : start server with new channel
CASE 4 : stop server
CASE 5 : halt server
CASE 6 : first cmd
CASE 7 : killer cmd
CASE 8 : show spool list
CASE 9 : clear spool
CASE 10 : spool control task (task (param1))
OTHERWISE do (command line)
END SELECT;
. start server :
IF server channel <= 0 OR server channel >= 33
THEN line;
putline ("WARNUNG : Serverkanal nicht eingestellt");
FI;
stop server;
start (PROC server start);
. start server with new channel:
INT VAR i := int (param1);
IF last conversion ok
THEN server channel (i);
start server;
ELSE errorstop ("falsche Kanalangabe")
FI;
. stop server :
disable stop;
stop;
IF valid fetch entry CAND
yes (""13""10"" + fetch entry. entry line + " neu eintragen")
THEN new first (fetch entry) FI;
erase fetch entry;
enable stop;
. halt server :
stop command pending := TRUE;
IF NOT exists (server) OR server is waiting
THEN stop server;
erase fetch entry;
FI;
. first cmd :
line ;
to first que entry ;
WHILE next que entry found
REP say (list entry. entry line) ;
IF yes (" als erstes")
THEN new first (list entry);
erase entry (list index);
LEAVE first cmd
FI ;
PER;
. killer cmd :
line ;
to first que entry ;
WHILE next que entry found
REP say (list entry. entry line) ;
IF yes (" loeschen") THEN erase entry (list index) FI ;
PER;
. show spool list :
list spool;
disable stop;
show (file);
forget (ds);
ENDPROC execute command ;
ENDPACKET spool manager;