summaryrefslogtreecommitdiff
path: root/system/multiuser/1.7.5/src/spool manager
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
committerLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
commit04e68443040c7abad84d66477e98f93bed701760 (patch)
tree2b6202afae659e773bf6916157d23e83edfa44e3 /system/multiuser/1.7.5/src/spool manager
downloadeumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz
eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2
eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip
Initial import
Diffstat (limited to 'system/multiuser/1.7.5/src/spool manager')
-rw-r--r--system/multiuser/1.7.5/src/spool manager887
1 files changed, 887 insertions, 0 deletions
diff --git a/system/multiuser/1.7.5/src/spool manager b/system/multiuser/1.7.5/src/spool manager
new file mode 100644
index 0000000..ac0295a
--- /dev/null
+++ b/system/multiuser/1.7.5/src/spool manager
@@ -0,0 +1,887 @@
+PACKET spool manager DEFINES (* Autor: J. Liedtke *)
+ (* R. Nolting *)
+ (* R. Ruland *)
+ (* Stand: 25.04.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 ,
+
+ fetch code = 11 ,
+ save code = 12 ,
+ file save code old = 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, file save code old :
+ new file 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;
+
+.
+ 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 := text (last entry. ds params. station, 2);
+ 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)";
+
+ . 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, text (station(myself)) + "/""" + name (myself) + """");
+ put spool duty;
+ put current job;
+ put spool que;
+
+ . 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;
+