summaryrefslogtreecommitdiff
path: root/system/std.zusatz/1.8.7/src/spool manager
diff options
context:
space:
mode:
Diffstat (limited to 'system/std.zusatz/1.8.7/src/spool manager')
-rw-r--r--system/std.zusatz/1.8.7/src/spool manager1058
1 files changed, 0 insertions, 1058 deletions
diff --git a/system/std.zusatz/1.8.7/src/spool manager b/system/std.zusatz/1.8.7/src/spool manager
deleted file mode 100644
index 6b4fe55..0000000
--- a/system/std.zusatz/1.8.7/src/spool manager
+++ /dev/null
@@ -1,1058 +0,0 @@
-PACKET spool manager DEFINES (* Autor : R. Ruland *)
- (* Stand : 23.02.88 *)
-
- spool manager ,
-
- server channel ,
- spool duty,
- station only,
- auto stop,
- enter spool control password,
- spool control password,
-
- start spool,
- stop spool,
- halt spool,
- kill spool,
- first spool,
- spool entry line,
- number spool entries,
- spool status,
- server task,
- clear spool,
- list spool,
- :
-
-LET que size = 200 ,
-
- ack = 0 ,
- nak = 1 ,
- error nak = 2 ,
- 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 ,
- help code = 49 ,
- continue code = 100 ,
-
- control codes = ""23""24""25""26""27""28""29"" ,
-
- file type = 1003 ,
- help file name = "help";
-
-LET begin char = ""0"",
- end char = ""1"";
-
-LET PARAMS = STRUCT (TEXT name, userid, password, sendername, INT station);
-
-BOUND ROW que size STRUCT (PARAMS ds params, TEXT entry line) VAR que;
-
- ROW que size DATASPACE VAR que space;
-
-PARAMS VAR save params;
-
-DATASPACE VAR que ds, global ds;
-
-FILE VAR file;
-
-INT VAR last order, reply, old heap size, que index, fetch index,
- station by start, begin pos, end pos, order task station, sp channel;
-
-TEXT VAR que entries, free entries, order task name, buffer, deactive message,
- error message buffer, sp duty, start time, control password;
-
-BOOL VAR server is waiting, stop cmd pending, start cmd pending,
- auto stop pending, stat only;
-
-TASK VAR last order task, server, calling parent, task in control;
-
-INITFLAG VAR in this task := FALSE, init que space := FALSE;
-
-BOUND STRUCT (TEXT name, userid, password) VAR msg;
-BOUND STRUCT (TEXT entry line, INT index, TEXT actual entries, password) VAR control msg;
-BOUND PARAMS VAR fetch msg;
-BOUND THESAURUS VAR all msg;
-BOUND TEXT VAR error msg;
-
-
-. que is empty : que entries = ""
-. que is full : free entries = ""
-. number entries : LENGTH que entries
-
-. first index : code (que entries SUB 1)
-. list index : code (que entries SUB que index)
-. last index : code (que entries SUB number entries)
-
-. fetch entry : que (fetch index)
-. list entry : que (list index)
-. last entry : que (last index)
-
-. was define station : station by start <> station (myself)
-. is valid fetch entry : fetch index > 0
-.;
-
-INT VAR command index , params ;
-TEXT VAR param 1, param 2 ;
-LET spool command list = "start:1.01stop:3.0halt:4.0first:5.0killer:6.0";
-
-sp channel := 0;
-sp duty := "";
-deactive message := "";
-stat only := FALSE;
-auto stop pending := FALSE;
-task in control := supervisor;
-control password := "-";
-
-
-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 auto stop (BOOL CONST flag) :
- auto stop pending := flag
-END PROC auto stop;
-
-BOOL PROC auto stop : auto stop pending END PROC auto stop;
-
-
-PROC spool duty (TEXT CONST duty) :
- sp duty := duty;
-END PROC spool duty;
-
-TEXT PROC spool duty : sp duty END PROC spool duty;
-
-
-PROC enter spool control password (TEXT CONST new password):
- disable stop;
- cover tracks;
- cover tracks (control password);
- control password := new password;
-END PROC enter spool control password;
-
-PROC spool control password (TEXT CONST new password):
- IF on line THEN say (""3""13""5"") FI;
- enter spool control password (new password);
-END PROC spool control password;
-
-
-PROC spool manager (PROC server start) :
- spool manager (PROC (DATASPACE VAR, INT CONST,
- INT CONST, TASK CONST) spool manager,
- PROC server start, TRUE)
-END PROC spool manager;
-
-
-PROC spool manager (PROC server start, BOOL CONST initial start) :
- spool manager (PROC (DATASPACE VAR, INT CONST,
- INT CONST, TASK CONST) spool manager,
- PROC server start, initial start)
-END PROC spool manager;
-
-
-PROC spool manager (PROC (DATASPACE VAR, INT CONST,
- INT CONST, TASK CONST) spool,
- PROC server start,
- BOOL CONST initial start) :
-
- set autonom;
- break;
- disable stop;
- command dialogue (FALSE);
- initialize spool manager;
- REP start spool if necessary;
- wait for next order;
- IF order not allowed THEN reject order
- ELIF is first phase THEN first phase
- ELIF is second phase THEN second phase
- ELSE send nak
- FI;
- send error if necessary;
- collect heap garbage if necessary;
- PER
-
- . initialize spool manager :
- initialize if necessary;
- stop server;
- erase fetch entry;
- start cmd pending := initial start;
- stop cmd pending := FALSE;
- last order task := niltask;
-
- . initialize if necessary :
- IF NOT initialized (in this task)
- THEN clear spool;
- global ds := nilspace;
- que ds := nilspace;
- que := que ds;
- server := niltask;
- calling parent := niltask;
- server is waiting := FALSE;
- station by start := station (myself);
- old heap size := 0;
- error message buffer := "";
- FI;
-
- . start spool if necessary :
- IF start cmd pending AND NOT stop cmd pending
- THEN start server (PROC server start) FI;
-
- . wait for next order :
- INT VAR order, phase;
- TASK VAR order task;
- forget (global ds);
- wait (global ds, order, order task);
-
- . order not allowed :
- station only CAND station (ordertask) <> station (myself) CAND
- ( order > 255 COR pos (control codes, code (order)) = 0 )
-
- . reject order :
- errorstop ("kein Zugriffsrecht auf Task " + text (station(myself))
- + "/""" + name(myself) + """")
-
- . is first phase :
- order <> second phase ack
-
- . first phase :
- phase := 1;
- last order := order;
- last order task := order task;
- spool (global ds, order, phase, order task);
-
- . is second phase :
- order task = last order task
-
- . second phase :
- phase INCR 1 ;
- order := last order;
- spool (global ds, order, phase, order task);
-
- . send nak :
- forget (global ds);
- global ds := nilspace;
- send (order task, nak, global ds);
-
- . send error if necessary :
- IF is error
- THEN forget (global ds);
- global ds := nilspace;
- error msg := global ds;
- CONCR (error msg) := error message;
- clear error;
- send (order task, error nak, global 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 manager (DATASPACE VAR order ds,
- INT CONST order, phase,
- TASK CONST order task ):
-
- enable stop;
- SELECT order OF
- CASE fetch code, help code : out of que or help
- 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
-
- CASE entry line code : send next entry line
- CASE killer code : kill entry
- CASE first code : make to first
- CASE start code : start server task
- CASE stop code : stop server task
- CASE halt code, wait for halt code
- : halt server task
-
- OTHERWISE :
-
- IF order >= continue code AND order task = supervisor
- THEN spool monitor
- ELSE wrong operation
- FI;
-
- END SELECT;
-
-. wrong operation :
- IF order > error nak
- THEN errorstop ("falscher Auftrag fuer Task " + text (station(myself))
- + "/""" + name(myself) + """")
- FI;
-
-.
- out of que or help :
- IF order task = server
- THEN out of que
- ELSE send help file
- FI;
-
- . out of que :
- erase fetch entry;
- IF stop cmd pending
- THEN stop server
- ELIF que is empty
- THEN IF auto stop pending
- THEN stop server
- ELSE server is waiting := TRUE
- FI;
- ELSE send first entry;
- FI;
-
- . send help file :
- check server (TRUE);
- IF order = fetch code
- THEN msg := order ds;
- IF msg. name <> help file name
- THEN errorstop ("keine Servertask") FI;
- FI;
- forget (order ds);
- order ds := old (help file name);
- send (order task, ack, order ds);
-
-.
- send fetch params :
- IF order task = server
- THEN send params
- ELSE errorstop ("keine Servertask")
- FI;
-
- . send params :
- forget(order ds); order ds := nilspace;
- fetch msg := order ds;
- fetch msg := fetch entry. ds params;
- send (order task, ack, order ds);
-
-.
- new que entry :
- IF phase = 1
- THEN prepare into que
- ELSE into que (order ds, order task)
- FI;
-
-.
- prepare into que :
- msg := order 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 (order ds); order ds := nilspace;
- send (order task, second phase ack, order ds);
-
-.
- new file que entry :
- IF type (order ds) <> file type
- THEN errorstop ("Datenraum hat falschen Typ");
- ELSE get file params;
- into que (order ds, order task);
- FI;
-
- . get file params :
- file := sequential file (input, order ds);
- end pos := 0;
- next headline information (save params. name);
- next headline information (save params. userid);
- next headline information (save params. password);
- next headline information (save params. sendername);
- next headline information (buffer);
- save params. station := int (buffer);
- IF NOT last conversion ok
- THEN save params. station := station (order task) FI;
- IF save params. sendername = ""
- THEN save params. sendername := name (order task) FI;
- IF save params. name = ""
- THEN IF headline (file) <> ""
- THEN save params. name := headline (file);
- ELSE errorstop ("Name unzulaessig")
- FI;
- ELSE headline (file, save params. name);
- FI;
-
-.
- exists que entry :
- msg := order ds ;
- order task name := name (order task);
- order task station := station (order task);
- FOR que index FROM 1 UPTO number entries
- REP IF is entry from order task (msg. name)
- THEN send ack;
- LEAVE exists que entry
- FI;
- PER ;
- forget (order ds); order ds := nilspace;
- send (order task, false code, order ds)
-
-.
- erase que entry :
- msg := order 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 :
- FOR que index FROM 1 UPTO number entries
- REP IF is entry from order task (msg. name)
- THEN manager question ("""" + msg.name + """ loeschen", order task);
- LEAVE erase que entry
- FI;
- PER ;
- manager message ("""" + msg.name + """ existiert nicht", order task);
-
- . erase entry from order task :
- IF is valid que index (que index) CAND is entry from order task (msg. name)
- THEN delete que entry;
- LEAVE erase que entry
- ELSE FOR que index FROM 1 UPTO number entries
- 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", order task);
- FI;
-
- . delete que entry :
- kill spool (que index);
- send ack;
-
-.
- send owners ds names:
- order task name := name (order task);
- order task station := station (order task);
- forget (order ds); order ds := nilspace; all msg := order ds;
- all msg := empty thesaurus;
- FOR que index FROM 1 UPTO number entries
- REP IF is entry from order task ("")
- THEN insert (all msg, list entry. ds params. name)
- FI;
- PER;
- send (order task, ack, order ds)
-
-.
- send spool list :
- forget (global ds); global ds := nilspace;
- file := sequential file (output, global ds);
- list spool (file);
- send (order task, ack, global ds);
-
-.
- send next entry line :
- control msg := order ds; check control password (control msg. password);
- IF control msg. index = 0 THEN control msg. actual entries := que entries FI;
- get next entry line;
- send (order task, ack, order ds);
-
- . get next entry line :
- REP control msg. index INCR 1;
- IF control msg. index > LENGTH control msg. actual entries
- THEN control msg. index := 0;
- control msg. entry line := "";
- LEAVE get next entry line;
- FI;
- que index := control que index;
- UNTIL is valid que index (que index) PER;
- control msg. entry line := list entry. entry line;
-
- . control que index :
- pos (que entries, control msg. actual entries SUB control msg. index)
-
-.
- kill entry :
- control msg := order ds; check control password (control msg. password);
- kill spool (control que index);
- send (order task, ack, order ds);
-
-.
- make to first :
- control msg := order ds; check control password (control msg. password);
- first spool (control que index);
- send (order task, ack, order ds);
-
-.
- start server task :
- msg := order ds; check control password (msg. password);
- IF exists (server) AND NOT stop cmd pending
- THEN errorstop ("Spool muß zuerst gestoppt werden") FI;
- new server channel is necessary;
- start cmd pending := TRUE;
- IF server channel <= 0 OR server channel >= 33
- THEN manager message ("WARNUNG : Serverkanal nicht eingestellt", order task);
- ELSE send ack
- FI;
-
- . new server channel is necessary :
- INT CONST new channel := int (msg. name);
- IF last conversion ok THEN server channel (new channel) FI;
-
-.
- stop server task :
- msg := order ds; check control password (msg. password);
- IF phase = 1
- THEN start cmd pending := FALSE;
- deactive message := msg. name;
- stop server;
- check fetch entry;
- ELSE reinsert fetch entry;
- send ack;
- FI;
-
-.
- halt server task :
- msg := order ds; check control password (msg. password);
- IF phase = 1
- THEN stop cmd pending := TRUE;
- start cmd pending := FALSE;
- deactive message := msg. name;
- IF NOT exists (server) OR server is waiting
- THEN stop server;
- check fetch entry;
- ELIF order = wait for halt code
- THEN calling parent := order task;
- ELSE send ack;
- FI;
- ELSE reinsert fetch entry;
- send ack;
- FI;
-
- . check fetch entry :
- IF is valid fetch entry
- THEN manager question (""13""10"" +
- fetch entry. entry line + " neu eintragen", order task);
- fetch index := -fetch index;
- ELSE send ack;
- FI;
-
-.
- send ack :
- forget (order ds); order ds := nilspace;
- send (order task, ack, order ds)
-
-.
- spool monitor :
- continue (order - continue code);
- disable stop;
- put error message if there is one;
- WHILE online
- REP command dialogue (TRUE);
- sysout ("");
- sysin ("");
- get command ("gib Spool-Kommando:");
- analyze command (spool command list, 3, command index, params, param1, param2);
- reset editor;
- SELECT command index OF
- CASE 1 : start spool
- CASE 2 : start spool (int (param1))
- CASE 3 : stop spool
- CASE 4 : halt spool
- CASE 5 : first spool
- CASE 6 : kill spool
- OTHERWISE : do command
- END SELECT;
- PER;
- save error message if there is one;
- command dialogue (FALSE);
- break (quiet);
- set autonom;
-
- . put error message if there is one :
- IF error message buffer <> ""
- THEN errorstop (error message buffer); FI;
-
- . save error message if there is one :
- IF is error
- THEN error message buffer := error message;
- clear error;
- ELSE error message buffer := "";
- FI;
-
- . reset editor :
- WHILE aktueller editor > 0 REP quit PER;
- clear error;
-
-END PROC spool manager;
-
-
-PROC send first entry :
-
- forget (global ds);
- global ds := que space (first index);
- send (server, ack, global ds, reply) ;
- IF reply = ack
- THEN fetch index := first index;
- que entries := subtext (que entries, 2);
- server is waiting := FALSE;
- start time := time of day;
- start time CAT " am ";
- start time CAT date;
- FI;
-
-END PROC send first entry;
-
-
-PROC into que (DATASPACE VAR order ds, TASK CONST order task) :
-
- IF que is full
- THEN errorstop ("Spool ist voll")
- ELSE make new entry;
- send ack;
- awake server if necessary
- FI;
-
- . make new entry :
- que entries CAT (free entries SUB 1);
- free entries := subtext (free entries, 2);
- que space (last index) := order ds;
- last entry. ds params := save params;
- build entry line;
-
- . 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 (order ds));
- 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
-
- . send ack :
- forget (order ds); order ds := nilspace;
- send (order task, ack, order ds)
-
- . awake server if necessary :
- IF server is waiting THEN send first entry FI;
-
-END PROC into que;
-
-
-(*********************************************************************)
-(* Hilfsprozeduren zum Spoolmanager *)
-(*********************************************************************)
-
-
-PROC reinsert fetch entry :
-
- IF fetch index <> 0
- THEN insert char (que entries, code (abs (fetch index)), 1);
- fetch index := 0;
- FI;
-
-END PROC reinsert fetch entry;
-
-
-PROC erase fetch entry :
-
- IF fetch index <> 0
- THEN free entries CAT code (abs (fetch index));
- forget (que space (abs (fetch index)));
- fetch index := 0;
- FI;
-
-END PROC erase fetch entry;
-
-
-PROC start server (PROC server start):
-
- stop server;
- begin (PROC server start, server);
- station by start := station (myself);
- start cmd pending := FALSE;
- deactive message := "";
-
-END PROC start server;
-
-
-PROC stop server :
-
- IF exists (server) THEN end (server) ELSE check server (FALSE) FI;
- server := niltask;
- server is waiting := FALSE;
- stop cmd pending := FALSE;
- send calling parent reply if necessary;
-
- . send calling parent reply if necessary :
- IF exists (calling parent)
- THEN forget (global ds); global ds := nilspace;
- send (calling parent, ack, global ds);
- calling parent := niltask;
- FI;
-
-END PROC stop server;
-
-
-PROC check server (BOOL CONST with stop) :
-
- IF was define station CAND NOT is niltask (server)
- THEN stop old server if necessary FI;
-
- . stop old server if necessary :
- access catalogue;
- TASK VAR old server := son (myself);
- WHILE NOT is niltask (old server)
- REP IF index (old server) = index (server) THEN old server found FI;
- old server := brother (old server);
- PER;
-
- . old server found :
- IF name (old server) = "-" THEN end (old server) FI;
- IF with stop THEN stop server FI;
- LEAVE stop old server if necessary;
-
-END PROC check server;
-
-
-BOOL PROC is valid que index (INT CONST index) :
-
- 1 <= index AND index <= number entries
-
-END PROC is valid que index;
-
-
-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 check control password (TEXT CONST password) :
-
- IF control password = "-"
- THEN errorstop ("Kontrolle des Spools nicht erlaubt")
- ELIF control password <> "" CAND control password <> password
- THEN errorstop ("Passwort falsch")
- FI;
-
-END PROC check control password;
-
-
-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;
-
-(*********************************************************************)
-(* Prozeduren zur Verwaltung der Warteschlange *)
-(*********************************************************************)
-
-PROC start spool :
-
- enable stop;
- IF server channel <= 0 OR server channel >= 33
- THEN display (""13""10"WARNUNG : Serverkanal nicht eingestellt"13""10"")
- FI;
- halt spool;
- start cmd pending := TRUE;
-
-END PROC start spool;
-
-PROC start spool (INT CONST new channel) :
-
- enable stop;
- server channel (new channel);
- start spool;
-
-END PROC start spool;
-
-PROC stop spool (TEXT CONST deactive msg) :
-
- disable stop;
- deactive message := deactive msg;
- start cmd pending := FALSE;
- stop server;
- IF is valid fetch entry CAND on line CAND
- yes (""13""10"" + fetch entry. entry line + " neu eintragen")
- THEN reinsert fetch entry
- ELSE erase fetch entry;
- FI;
-
-END PROC stop spool;
-
-PROC stop spool : stop spool ("") END PROC stop spool;
-
-PROC halt spool (TEXT CONST deactive msg) :
-
- enable stop;
- deactive message := deactive msg;
- stop cmd pending := TRUE;
- start cmd pending := FALSE;
- IF NOT exists (server) OR server is waiting THEN stop spool FI;
-
-END PROC halt spool;
-
-PROC halt spool : halt spool ("") END PROC halt spool;
-
-
-PROC kill spool :
-
- enable stop;
- say (""13""10"");
- que index := 1;
- WHILE que index <= number entries
- REP IF yes (list entry. entry line + " loeschen")
- THEN kill spool (que index)
- ELSE que index INCR 1
- FI;
- PER;
-
-END PROC kill spool;
-
-PROC kill spool (INT CONST index) :
-
- IF is valid que index (index)
- THEN forget (que space (code (que entries SUB index)));
- free entries CAT (que entries SUB index);
- delete char (que entries, index);
- FI;
-
-END PROC kill spool;
-
-
-PROC first spool :
-
- enable stop;
- say (""13""10"");
- FOR que index FROM 1 UPTO number entries
- REP IF yes (list entry. entry line + " als erstes")
- THEN first spool (que index);
- LEAVE first spool
- FI;
- PER;
-
-END PROC first spool;
-
-PROC first spool (INT CONST index) :
-
- IF is valid que index (index)
- THEN insert char (que entries, que entries SUB index, 1);
- delete char (que entries, index + 1);
- FI;
-
-END PROC first spool;
-
-
-TEXT PROC spool entry line (INT CONST index) :
-
- IF index = 0 CAND is valid fetch entry
- THEN fetch entry. entry line
- ELIF is valid que index (index)
- THEN entry. entry line
- ELSE ""
- FI
-
- . entry : que (code (que entries SUB index))
-
-END PROC spool entry line;
-
-
-INT PROC number spool entries : number entries END PROC number spool entries;
-
-INT PROC spool status :
-
- IF exists (server)
- THEN IF stop cmd pending
- THEN IF start cmd pending
- THEN 3 (* aktiviert (neu start) *)
- ELSE 2 (* aktiviert (warten auf halt) *)
- FI
- ELSE IF server is waiting
- THEN 0 (* kein Auftrag in Bearbeitung *)
- ELSE 1 (* aktiviert *)
- FI
- FI
- ELIF start cmd pending
- THEN 0 (* wird aktiviert *)
- ELIF is valid fetch entry
- THEN IF was define station
- THEN -3 (* deaktiviert (define station) *)
- ELSE -2 (* deaktiviert (server gelöcht) *)
- FI
- ELSE -1 (* deaktiviert *)
- FI
-
-END PROC spool status;
-
-TASK PROC server task : server END PROC server task;
-
-
-PROC clear spool :
-
- disable stop;
- IF NOT initialized (init que space)
- THEN FOR que index FROM 1 UPTO que size
- REP que space (que index) := nilspace PER;
- FI;
- que entries := "";
- free entries := "";
- fetch index := 0;
- stop server;
- FOR que index FROM 1 UPTO que size
- REP forget (que space (que index));
- free entries CAT code (que index);
- PER;
-
-END PROC clear spool;
-
-
-PROC list spool :
-
- disable stop;
- DATASPACE VAR list ds := nilspace;
- FILE VAR list file := sequential file (output, list ds);
- list spool (list file);
- show (list file);
- forget (list ds);
-
-END PROC list spool;
-
-
-PROC list spool (FILE VAR f) :
-
- enable stop;
- output (f);
- max line length (f, 1000);
- headline (f, 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 (f, "Aufgabe: ");
- write (f, spool duty );
- line (f, 2);
- FI;
-
- . put current job :
- IF is valid fetch entry
- THEN write (f, "In Bearbeitung seit ");
- write (f, start time);
- write (f, ":");
- line (f, 2);
- putline (f, fetch entry. entry line);
- IF NOT exists (server)
- THEN IF was define station
- THEN putline (f, "Spool ist deaktiviert, da Stationsnummer geaendert wurde")
- ELSE putline (f, "Spool ist deaktiviert, da der Server gelöscht wurde")
- FI;
- ELIF stop cmd pending
- THEN IF start cmd pending
- THEN putline (f, "Spool wird nach diesem Auftrag neu aktiviert");
- ELSE putline (f, "Spool wird nach diesem Auftrag deaktiviert");
- FI;
- FI;
- line (f);
- ELSE write (f, "kein Auftrag in Bearbeitung");
- IF NOT exists (server)
- THEN write (f, ", da Spool deaktiviert");
- IF start cmd pending
- THEN line (f);
- write (f, "Spool wird nach Verlassen der Task aktiviert");
- FI;
- IF deactive message <> ""
- THEN line (f);
- write (f, deactive message);
- FI;
- ELIF que is empty
- THEN write (f, ", da Warteschlange leer");
- LEAVE list spool;
- FI;
- line (f, 2);
- FI;
-
- . put spool que :
- IF que is empty
- THEN putline (f, "Warteschlange ist leer");
- ELSE write (f, "Warteschlange (");
- write (f, text (number entries));
- IF number entries = 1
- THEN write (f, " Auftrag):");
- ELSE write (f, " Auftraege):");
- FI;
- line (f, 2);
- FOR que index FROM 1 UPTO number entries
- REP putline (f, list entry. entry line) PER;
- FI;
-
-END PROC list spool;
-
-
-ENDPACKET spool manager;
-