From 71e2b36ccd05ea678e62e32ee6245df2b8d6ac17 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Thu, 7 Feb 2019 10:05:49 +0100 Subject: Move spooler into its own package I *think* these parts belong together. --- system/multiuser/1.7.5/src/spool manager | 887 ---------------- system/net/1.8.7/src/port server | 164 --- system/net/1.8.7/src/printer server | 99 -- system/net/1.8.7/src/spool cmd | 112 --- system/net/1.8.7/src/spool manager | 915 ----------------- system/spooler/1.7.5/source-disk | 2 + system/spooler/1.7.5/src/spool manager | 887 ++++++++++++++++ system/spooler/1.8.7-net/source-disk | 1 + system/spooler/1.8.7-net/src/port server | 164 +++ system/spooler/1.8.7-net/src/printer server | 99 ++ system/spooler/1.8.7-net/src/spool cmd | 112 +++ system/spooler/1.8.7-net/src/spool manager | 915 +++++++++++++++++ system/spooler/1.8.7-std.zusatz/source-disk | 1 + system/spooler/1.8.7-std.zusatz/src/port server | 164 +++ system/spooler/1.8.7-std.zusatz/src/printer server | 99 ++ system/spooler/1.8.7-std.zusatz/src/spool cmd | 178 ++++ system/spooler/1.8.7-std.zusatz/src/spool manager | 1058 ++++++++++++++++++++ system/std.zusatz/1.8.7/src/port server | 164 --- system/std.zusatz/1.8.7/src/printer server | 99 -- system/std.zusatz/1.8.7/src/spool cmd | 178 ---- system/std.zusatz/1.8.7/src/spool manager | 1058 -------------------- 21 files changed, 3680 insertions(+), 3676 deletions(-) delete mode 100644 system/multiuser/1.7.5/src/spool manager delete mode 100644 system/net/1.8.7/src/port server delete mode 100644 system/net/1.8.7/src/printer server delete mode 100644 system/net/1.8.7/src/spool cmd delete mode 100644 system/net/1.8.7/src/spool manager create mode 100644 system/spooler/1.7.5/source-disk create mode 100644 system/spooler/1.7.5/src/spool manager create mode 100644 system/spooler/1.8.7-net/source-disk create mode 100644 system/spooler/1.8.7-net/src/port server create mode 100644 system/spooler/1.8.7-net/src/printer server create mode 100644 system/spooler/1.8.7-net/src/spool cmd create mode 100644 system/spooler/1.8.7-net/src/spool manager create mode 100644 system/spooler/1.8.7-std.zusatz/source-disk create mode 100644 system/spooler/1.8.7-std.zusatz/src/port server create mode 100644 system/spooler/1.8.7-std.zusatz/src/printer server create mode 100644 system/spooler/1.8.7-std.zusatz/src/spool cmd create mode 100644 system/spooler/1.8.7-std.zusatz/src/spool manager delete mode 100644 system/std.zusatz/1.8.7/src/port server delete mode 100644 system/std.zusatz/1.8.7/src/printer server delete mode 100644 system/std.zusatz/1.8.7/src/spool cmd delete mode 100644 system/std.zusatz/1.8.7/src/spool manager (limited to 'system') diff --git a/system/multiuser/1.7.5/src/spool manager b/system/multiuser/1.7.5/src/spool manager deleted file mode 100644 index ac0295a..0000000 --- a/system/multiuser/1.7.5/src/spool manager +++ /dev/null @@ -1,887 +0,0 @@ -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; - diff --git a/system/net/1.8.7/src/port server b/system/net/1.8.7/src/port server deleted file mode 100644 index 46c647f..0000000 --- a/system/net/1.8.7/src/port server +++ /dev/null @@ -1,164 +0,0 @@ -PACKET port server: (* Autor : R. Ruland *) - (* Stand : 21.03.86 *) - -INT VAR port station; -TEXT VAR port := "PRINTER"; - -put ("gib Name des Zielspools : "); editget (port); line; -put ("gib Stationsnummer des Zielspools : "); get (port station); - -server channel (15); -spool duty ("Verwalter fuer Task """ + port + - """ auf Station " + text (port station)); - -LET max counter = 10 , - time slice = 300 , - - ack = 0 , - fetch code = 11 , - param fetch code = 21 , - file save code = 22 , - file type = 1003 , - - begin char = ""0"", - end char = ""1""; - - -INT VAR reply, old heap size; -TEXT VAR file name, write pass, read pass, sendername, buffer; -FILE VAR file; - -DATASPACE VAR ds, file ds, send ds; - -BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; -BOUND TEXT VAR error msg ; - -spool manager (PROC save file); - -PROC save file : - - disable stop ; - command dialogue (FALSE); - ds := nilspace; file ds := nilspace; send ds := nil space; - old heap size := heap size; - - REP - execute save file; - - IF is error THEN save error (error message) FI; - - IF heap size > old heap size + 4 - THEN collect heap garbage ; - old heap size := heap size - FI; - - PER - -ENDPROC save file; - - -PROC execute save file : - -enable stop; -forget (file ds) ; file ds := nilspace; -call (father, fetch code, file ds, reply); -IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE save file ds -FI; - -. save file ds : - IF type (file ds) = file type - THEN get file params; - insert file params; - call station (port station, port, file save code, file ds); - ELSE errorstop ("Datenraum hat falschen Typ") - FI; - -. get file params : - forget (ds); ds := nilspace; - call (father, param fetch code, ds, reply); - IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE msg := ds; - file name := msg. file name; - write pass := msg. write pass; - read pass := msg. read pass; - sendername := msg. sender name; - FI; - -. insert file params : - buffer := ""; - in headline (filename); - in headline (write pass); - in headline (read pass); - in headline (sendername); - file := sequential file (input, file ds) ; - headline (file, buffer); - -END PROC execute save file; - - -PROC call station (INT CONST order task station, TEXT CONST order task name, - INT CONST order code, DATASPACE VAR order ds) : - - INT VAR counter := 0; - TASK VAR order task; - disable stop; - REP order task := order task station // order task name; - IF is error CAND pos (error message, "antwortet nicht") > 0 - THEN clear error; - counter := min (max counter, counter + 1); - pause (counter * time slice); - ELSE enable stop; - forget (send ds); send ds := order ds; - call (order task, order code, send ds, reply); - disable stop; - IF reply = ack - THEN forget (order ds); order ds := send ds; - forget (send ds); - LEAVE call station - ELSE error msg := send ds; - errorstop (error msg); - FI; - FI; - PER; - -END PROC call station; - - -TASK OP // (INT CONST station, TEXT CONST name) : - - enable stop; - station / name - -END OP //; - - -PROC in headline (TEXT CONST information) : - IF pos (information, begin char) <> 0 - OR pos (information, end char) <> 0 - THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; - buffer CAT begin char; - buffer CAT information; - buffer CAT end char; -END PROC in headline; - - -PROC save error (TEXT CONST message) : - clear error; - file name CAT "."; - file name CAT sender name; - file name CAT ".ERROR"; - file := sequential file (output, file name); - putline (file, " "); - putline (file, "Uebertragung nicht korrekt beendet "); - putline (file, " "); - put (file, "ERROR :"); put (file, message); - save (file name, public); - clear error; - forget(file name, quiet); -END PROC save error; - -ENDPACKET port server; - diff --git a/system/net/1.8.7/src/printer server b/system/net/1.8.7/src/printer server deleted file mode 100644 index b1a30bc..0000000 --- a/system/net/1.8.7/src/printer server +++ /dev/null @@ -1,99 +0,0 @@ -PACKET multi user printer : (* Autor : Rudolf Ruland *) - (* Stand : 24.03.86 *) - -INT VAR c; -put ("gib Druckerkanal : "); get (c); - - server channel (c); - station only (FALSE) ; - spool duty ("Ausgabe mit dem Drucker"); - spool control task (myself); - -LET ack = 0 , - - fetch code = 11 , - param fetch code = 21 , - file type = 1003 ; - -INT VAR reply, old heap size, sender station; -TEXT VAR file name, userid, password, sendername; -FILE VAR file ; - -DATASPACE VAR ds, file ds; - -BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; -BOUND TEXT VAR error msg ; - -spool manager (PROC printer); - -PROC printer : - - disable stop ; - command dialogue (FALSE); - ds := nilspace; file ds := nilspace; - continue (server channel) ; - check error ("Kanal belegt"); - - old heap size := heap size ; - REP - execute print ; - - IF is error - THEN put error; - clear error; - FI ; - - IF heap size > old heap size + 4 - THEN collect heap garbage ; - old heap size := heap size - FI - PER - -ENDPROC printer ; - - -PROC execute print : - - enable stop ; - forget (file ds) ; file ds := nilspace ; - call (father, fetch code, file ds, reply) ; - IF reply = ack CAND type (file ds) = file type - THEN get file params; - print file - FI ; - -. get file params : - forget (ds); ds := nilspace; - call (father, param fetch code, ds, reply); - IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE msg := ds; - file name := msg. file name; - userid := msg. userid; - password := msg. password; - sendername := msg. sender name; - sender station := msg. station; - FI; - -. print file : - file := sequential file (input, file ds); - print (file, - PROC (INT CONST, INT VAR, INT VAR) open, - PROC (INT CONST, INT CONST) close, - PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); - -ENDPROC execute print ; - - -PROC check error (TEXT CONST message) : - IF is error - THEN clear error; - rename myself (message); - IF is error THEN clear error; end (myself) FI; - pause (18000); - end (myself); - FI; -END PROC check error; - -ENDPACKET multi user printer ; - diff --git a/system/net/1.8.7/src/spool cmd b/system/net/1.8.7/src/spool cmd deleted file mode 100644 index b44e799..0000000 --- a/system/net/1.8.7/src/spool cmd +++ /dev/null @@ -1,112 +0,0 @@ -PACKET spool cmd (* Autor: R. Ruland *) - (* Stand: 01.04.86 *) - DEFINES killer, - first, - start, - stop, - halt, - wait for halt : - -LET error nak = 2 , - - entry line code = 23 , - killer code = 24 , - first code = 25 , - start code = 26 , - stop code = 27 , - halt code = 28 , - wait for halt code = 29 ; - -DATASPACE VAR ds; - -BOUND STRUCT (TEXT entry line, INT index) VAR control msg; -BOUND TEXT VAR error msg ; - -INT VAR reply; - -INITFLAG VAR in this task := FALSE; - - -PROC control spool (TASK CONST spool, INT CONST control code, - TEXT CONST question, BOOL CONST leave) : - - enable stop; - initialize control msg; - WHILE valid spool entry - REP IF control question THEN control spool entry FI PER; - - . initialize control msg : - IF NOT initialized (in this task) THEN ds := nilspace FI; - forget (ds); ds := nilspace; control msg := ds; - control msg. entry line := ""; - control msg. index := 0; - say (""13""10""); - - . valid spool entry : - call (spool, entry line code, ds, reply); - IF reply = error nak - THEN error msg := ds; - errorstop (error msg); - FI; - control msg. index <> 0 - - . control question : - say (control msg. entry line); - yes (question) - - . control spool entry : - call (spool, control code, ds, reply); - IF reply = error nak - THEN error msg := ds; - errorstop (error msg); - FI; - IF leave THEN LEAVE control spool FI; - -END PROC control spool; - - -PROC killer (TASK CONST spool) : - - control spool (spool, killer code, " loeschen", FALSE) - -END PROC killer; - - -PROC first (TASK CONST spool) : - - control spool (spool, first code, " als erstes", TRUE) - -END PROC first; - - -PROC start (TASK CONST spool) : - - call (stop code, "", spool); - call (start code, "", spool); - -END PROC start; - - -PROC stop (TASK CONST spool) : - - call (stop code, "", spool); - -END PROC stop; - - -PROC halt (TASK CONST spool) : - - call (halt code, "", spool); - -END PROC halt; - - -PROC wait for halt (TASK CONST spool) : - - call (wait for halt code, "", spool); - -END PROC wait for halt; - - -END PACKET spool cmd; - diff --git a/system/net/1.8.7/src/spool manager b/system/net/1.8.7/src/spool manager deleted file mode 100644 index e711ab4..0000000 --- a/system/net/1.8.7/src/spool manager +++ /dev/null @@ -1,915 +0,0 @@ -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; - diff --git a/system/spooler/1.7.5/source-disk b/system/spooler/1.7.5/source-disk new file mode 100644 index 0000000..e24344a --- /dev/null +++ b/system/spooler/1.7.5/source-disk @@ -0,0 +1,2 @@ +175_src/source-code-1.7.5m_0.img +175_src/source-code-1.7.5m_1.img diff --git a/system/spooler/1.7.5/src/spool manager b/system/spooler/1.7.5/src/spool manager new file mode 100644 index 0000000..ac0295a --- /dev/null +++ b/system/spooler/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; + diff --git a/system/spooler/1.8.7-net/source-disk b/system/spooler/1.8.7-net/source-disk new file mode 100644 index 0000000..5a39f6c --- /dev/null +++ b/system/spooler/1.8.7-net/source-disk @@ -0,0 +1 @@ +grundpaket/11_austausch.img diff --git a/system/spooler/1.8.7-net/src/port server b/system/spooler/1.8.7-net/src/port server new file mode 100644 index 0000000..46c647f --- /dev/null +++ b/system/spooler/1.8.7-net/src/port server @@ -0,0 +1,164 @@ +PACKET port server: (* Autor : R. Ruland *) + (* Stand : 21.03.86 *) + +INT VAR port station; +TEXT VAR port := "PRINTER"; + +put ("gib Name des Zielspools : "); editget (port); line; +put ("gib Stationsnummer des Zielspools : "); get (port station); + +server channel (15); +spool duty ("Verwalter fuer Task """ + port + + """ auf Station " + text (port station)); + +LET max counter = 10 , + time slice = 300 , + + ack = 0 , + fetch code = 11 , + param fetch code = 21 , + file save code = 22 , + file type = 1003 , + + begin char = ""0"", + end char = ""1""; + + +INT VAR reply, old heap size; +TEXT VAR file name, write pass, read pass, sendername, buffer; +FILE VAR file; + +DATASPACE VAR ds, file ds, send ds; + +BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC save file); + +PROC save file : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; send ds := nil space; + old heap size := heap size; + + REP + execute save file; + + IF is error THEN save error (error message) FI; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI; + + PER + +ENDPROC save file; + + +PROC execute save file : + +enable stop; +forget (file ds) ; file ds := nilspace; +call (father, fetch code, file ds, reply); +IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE save file ds +FI; + +. save file ds : + IF type (file ds) = file type + THEN get file params; + insert file params; + call station (port station, port, file save code, file ds); + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + write pass := msg. write pass; + read pass := msg. read pass; + sendername := msg. sender name; + FI; + +. insert file params : + buffer := ""; + in headline (filename); + in headline (write pass); + in headline (read pass); + in headline (sendername); + file := sequential file (input, file ds) ; + headline (file, buffer); + +END PROC execute save file; + + +PROC call station (INT CONST order task station, TEXT CONST order task name, + INT CONST order code, DATASPACE VAR order ds) : + + INT VAR counter := 0; + TASK VAR order task; + disable stop; + REP order task := order task station // order task name; + IF is error CAND pos (error message, "antwortet nicht") > 0 + THEN clear error; + counter := min (max counter, counter + 1); + pause (counter * time slice); + ELSE enable stop; + forget (send ds); send ds := order ds; + call (order task, order code, send ds, reply); + disable stop; + IF reply = ack + THEN forget (order ds); order ds := send ds; + forget (send ds); + LEAVE call station + ELSE error msg := send ds; + errorstop (error msg); + FI; + FI; + PER; + +END PROC call station; + + +TASK OP // (INT CONST station, TEXT CONST name) : + + enable stop; + station / name + +END OP //; + + +PROC in headline (TEXT CONST information) : + IF pos (information, begin char) <> 0 + OR pos (information, end char) <> 0 + THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; + buffer CAT begin char; + buffer CAT information; + buffer CAT end char; +END PROC in headline; + + +PROC save error (TEXT CONST message) : + clear error; + file name CAT "."; + file name CAT sender name; + file name CAT ".ERROR"; + file := sequential file (output, file name); + putline (file, " "); + putline (file, "Uebertragung nicht korrekt beendet "); + putline (file, " "); + put (file, "ERROR :"); put (file, message); + save (file name, public); + clear error; + forget(file name, quiet); +END PROC save error; + +ENDPACKET port server; + diff --git a/system/spooler/1.8.7-net/src/printer server b/system/spooler/1.8.7-net/src/printer server new file mode 100644 index 0000000..b1a30bc --- /dev/null +++ b/system/spooler/1.8.7-net/src/printer server @@ -0,0 +1,99 @@ +PACKET multi user printer : (* Autor : Rudolf Ruland *) + (* Stand : 24.03.86 *) + +INT VAR c; +put ("gib Druckerkanal : "); get (c); + + server channel (c); + station only (FALSE) ; + spool duty ("Ausgabe mit dem Drucker"); + spool control task (myself); + +LET ack = 0 , + + fetch code = 11 , + param fetch code = 21 , + file type = 1003 ; + +INT VAR reply, old heap size, sender station; +TEXT VAR file name, userid, password, sendername; +FILE VAR file ; + +DATASPACE VAR ds, file ds; + +BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC printer); + +PROC printer : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; + continue (server channel) ; + check error ("Kanal belegt"); + + old heap size := heap size ; + REP + execute print ; + + IF is error + THEN put error; + clear error; + FI ; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC printer ; + + +PROC execute print : + + enable stop ; + forget (file ds) ; file ds := nilspace ; + call (father, fetch code, file ds, reply) ; + IF reply = ack CAND type (file ds) = file type + THEN get file params; + print file + FI ; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + userid := msg. userid; + password := msg. password; + sendername := msg. sender name; + sender station := msg. station; + FI; + +. print file : + file := sequential file (input, file ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + + +PROC check error (TEXT CONST message) : + IF is error + THEN clear error; + rename myself (message); + IF is error THEN clear error; end (myself) FI; + pause (18000); + end (myself); + FI; +END PROC check error; + +ENDPACKET multi user printer ; + diff --git a/system/spooler/1.8.7-net/src/spool cmd b/system/spooler/1.8.7-net/src/spool cmd new file mode 100644 index 0000000..b44e799 --- /dev/null +++ b/system/spooler/1.8.7-net/src/spool cmd @@ -0,0 +1,112 @@ +PACKET spool cmd (* Autor: R. Ruland *) + (* Stand: 01.04.86 *) + DEFINES killer, + first, + start, + stop, + halt, + wait for halt : + +LET error nak = 2 , + + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 ; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT entry line, INT index) VAR control msg; +BOUND TEXT VAR error msg ; + +INT VAR reply; + +INITFLAG VAR in this task := FALSE; + + +PROC control spool (TASK CONST spool, INT CONST control code, + TEXT CONST question, BOOL CONST leave) : + + enable stop; + initialize control msg; + WHILE valid spool entry + REP IF control question THEN control spool entry FI PER; + + . initialize control msg : + IF NOT initialized (in this task) THEN ds := nilspace FI; + forget (ds); ds := nilspace; control msg := ds; + control msg. entry line := ""; + control msg. index := 0; + say (""13""10""); + + . valid spool entry : + call (spool, entry line code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + control msg. index <> 0 + + . control question : + say (control msg. entry line); + yes (question) + + . control spool entry : + call (spool, control code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + IF leave THEN LEAVE control spool FI; + +END PROC control spool; + + +PROC killer (TASK CONST spool) : + + control spool (spool, killer code, " loeschen", FALSE) + +END PROC killer; + + +PROC first (TASK CONST spool) : + + control spool (spool, first code, " als erstes", TRUE) + +END PROC first; + + +PROC start (TASK CONST spool) : + + call (stop code, "", spool); + call (start code, "", spool); + +END PROC start; + + +PROC stop (TASK CONST spool) : + + call (stop code, "", spool); + +END PROC stop; + + +PROC halt (TASK CONST spool) : + + call (halt code, "", spool); + +END PROC halt; + + +PROC wait for halt (TASK CONST spool) : + + call (wait for halt code, "", spool); + +END PROC wait for halt; + + +END PACKET spool cmd; + diff --git a/system/spooler/1.8.7-net/src/spool manager b/system/spooler/1.8.7-net/src/spool manager new file mode 100644 index 0000000..e711ab4 --- /dev/null +++ b/system/spooler/1.8.7-net/src/spool manager @@ -0,0 +1,915 @@ +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; + diff --git a/system/spooler/1.8.7-std.zusatz/source-disk b/system/spooler/1.8.7-std.zusatz/source-disk new file mode 100644 index 0000000..085c0a7 --- /dev/null +++ b/system/spooler/1.8.7-std.zusatz/source-disk @@ -0,0 +1 @@ +grundpaket/04_std.zusatz.img diff --git a/system/spooler/1.8.7-std.zusatz/src/port server b/system/spooler/1.8.7-std.zusatz/src/port server new file mode 100644 index 0000000..46c647f --- /dev/null +++ b/system/spooler/1.8.7-std.zusatz/src/port server @@ -0,0 +1,164 @@ +PACKET port server: (* Autor : R. Ruland *) + (* Stand : 21.03.86 *) + +INT VAR port station; +TEXT VAR port := "PRINTER"; + +put ("gib Name des Zielspools : "); editget (port); line; +put ("gib Stationsnummer des Zielspools : "); get (port station); + +server channel (15); +spool duty ("Verwalter fuer Task """ + port + + """ auf Station " + text (port station)); + +LET max counter = 10 , + time slice = 300 , + + ack = 0 , + fetch code = 11 , + param fetch code = 21 , + file save code = 22 , + file type = 1003 , + + begin char = ""0"", + end char = ""1""; + + +INT VAR reply, old heap size; +TEXT VAR file name, write pass, read pass, sendername, buffer; +FILE VAR file; + +DATASPACE VAR ds, file ds, send ds; + +BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC save file); + +PROC save file : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; send ds := nil space; + old heap size := heap size; + + REP + execute save file; + + IF is error THEN save error (error message) FI; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI; + + PER + +ENDPROC save file; + + +PROC execute save file : + +enable stop; +forget (file ds) ; file ds := nilspace; +call (father, fetch code, file ds, reply); +IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE save file ds +FI; + +. save file ds : + IF type (file ds) = file type + THEN get file params; + insert file params; + call station (port station, port, file save code, file ds); + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + write pass := msg. write pass; + read pass := msg. read pass; + sendername := msg. sender name; + FI; + +. insert file params : + buffer := ""; + in headline (filename); + in headline (write pass); + in headline (read pass); + in headline (sendername); + file := sequential file (input, file ds) ; + headline (file, buffer); + +END PROC execute save file; + + +PROC call station (INT CONST order task station, TEXT CONST order task name, + INT CONST order code, DATASPACE VAR order ds) : + + INT VAR counter := 0; + TASK VAR order task; + disable stop; + REP order task := order task station // order task name; + IF is error CAND pos (error message, "antwortet nicht") > 0 + THEN clear error; + counter := min (max counter, counter + 1); + pause (counter * time slice); + ELSE enable stop; + forget (send ds); send ds := order ds; + call (order task, order code, send ds, reply); + disable stop; + IF reply = ack + THEN forget (order ds); order ds := send ds; + forget (send ds); + LEAVE call station + ELSE error msg := send ds; + errorstop (error msg); + FI; + FI; + PER; + +END PROC call station; + + +TASK OP // (INT CONST station, TEXT CONST name) : + + enable stop; + station / name + +END OP //; + + +PROC in headline (TEXT CONST information) : + IF pos (information, begin char) <> 0 + OR pos (information, end char) <> 0 + THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; + buffer CAT begin char; + buffer CAT information; + buffer CAT end char; +END PROC in headline; + + +PROC save error (TEXT CONST message) : + clear error; + file name CAT "."; + file name CAT sender name; + file name CAT ".ERROR"; + file := sequential file (output, file name); + putline (file, " "); + putline (file, "Uebertragung nicht korrekt beendet "); + putline (file, " "); + put (file, "ERROR :"); put (file, message); + save (file name, public); + clear error; + forget(file name, quiet); +END PROC save error; + +ENDPACKET port server; + diff --git a/system/spooler/1.8.7-std.zusatz/src/printer server b/system/spooler/1.8.7-std.zusatz/src/printer server new file mode 100644 index 0000000..b1a30bc --- /dev/null +++ b/system/spooler/1.8.7-std.zusatz/src/printer server @@ -0,0 +1,99 @@ +PACKET multi user printer : (* Autor : Rudolf Ruland *) + (* Stand : 24.03.86 *) + +INT VAR c; +put ("gib Druckerkanal : "); get (c); + + server channel (c); + station only (FALSE) ; + spool duty ("Ausgabe mit dem Drucker"); + spool control task (myself); + +LET ack = 0 , + + fetch code = 11 , + param fetch code = 21 , + file type = 1003 ; + +INT VAR reply, old heap size, sender station; +TEXT VAR file name, userid, password, sendername; +FILE VAR file ; + +DATASPACE VAR ds, file ds; + +BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC printer); + +PROC printer : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; + continue (server channel) ; + check error ("Kanal belegt"); + + old heap size := heap size ; + REP + execute print ; + + IF is error + THEN put error; + clear error; + FI ; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC printer ; + + +PROC execute print : + + enable stop ; + forget (file ds) ; file ds := nilspace ; + call (father, fetch code, file ds, reply) ; + IF reply = ack CAND type (file ds) = file type + THEN get file params; + print file + FI ; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + userid := msg. userid; + password := msg. password; + sendername := msg. sender name; + sender station := msg. station; + FI; + +. print file : + file := sequential file (input, file ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + + +PROC check error (TEXT CONST message) : + IF is error + THEN clear error; + rename myself (message); + IF is error THEN clear error; end (myself) FI; + pause (18000); + end (myself); + FI; +END PROC check error; + +ENDPACKET multi user printer ; + diff --git a/system/spooler/1.8.7-std.zusatz/src/spool cmd b/system/spooler/1.8.7-std.zusatz/src/spool cmd new file mode 100644 index 0000000..9b43d36 --- /dev/null +++ b/system/spooler/1.8.7-std.zusatz/src/spool cmd @@ -0,0 +1,178 @@ +PACKET spool cmd (* Autor : R. Ruland *) + (* Stand : 13.08.87 *) + DEFINES + spool control password, + + kill spool, + first spool, + start spool, + stop spool, + halt spool, + wait for halt : + +LET error nak = 2 , + + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 ; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT entry line, INT index, TEXT actual entries, password) VAR control msg; +BOUND TEXT VAR error msg; +INT VAR reply; + +INITFLAG VAR in this task := FALSE; +BOOL VAR dialogue; +TEXT VAR control password, password; + +control password := ""; + +PROC spool control password (TEXT CONST new password): + + IF on line THEN say (""3""13""5"") FI; + disable stop; + do ("enter spool control password (""" + new password + """)"); + clear error; + no do again; + cover tracks; + cover tracks (control password); + control password := new password; + +END PROC spool control password; + + +PROC call spool (INT CONST op code, TEXT CONST name, TASK CONST spool) : + + dialogue := command dialogue; + password := write password; + password CAT "/"; + password CAT read password; + disable stop; + command dialogue (FALSE); + enter password (control password); + command dialogue (dialogue); + call (op code, name, spool); + command dialogue (FALSE); + enter password (password); + command dialogue (dialogue); + +END PROC call spool; + + +PROC start spool (TASK CONST spool) : + + enable stop; + call spool (halt code, "", spool); + call spool (start code, "", spool); + +END PROC start spool; + + +PROC start spool (TASK CONST spool, INT CONST new channel) : + + enable stop; + call spool (halt code, "", spool); + call spool (start code, text (new channel), spool); + +END PROC start spool; + + +PROC stop spool (TASK CONST spool) : + + call spool (stop code, "", spool); + +END PROC stop spool; + +PROC stop spool (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (stop code, deactive msg, spool); + +END PROC stop spool; + + +PROC halt spool (TASK CONST spool) : + + call spool (halt code, "", spool); + +END PROC halt spool; + +PROC halt spool (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (halt code, deactive msg, spool); + +END PROC halt spool; + + +PROC wait for halt (TASK CONST spool) : + + call spool (wait for halt code, "", spool); + +END PROC wait for halt; + +PROC wait for halt (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (wait for halt code, deactive msg, spool); + +END PROC wait for halt; + + +PROC control spool (TASK CONST spool, INT CONST control code, + TEXT CONST question, BOOL CONST leave) : + + enable stop; + initialize control msg; + WHILE valid spool entry + REP IF control question THEN control spool entry FI PER; + + . initialize control msg : + IF NOT initialized (in this task) THEN ds := nilspace FI; + forget (ds); ds := nilspace; control msg := ds; + control msg. entry line := ""; + control msg. password := control password; + control msg. index := 0; + say (""13""10""); + + . valid spool entry : + call (spool, entry line code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + control msg. index <> 0 + + . control question : + say (control msg. entry line); + yes (question) + + . control spool entry : + call (spool, control code, ds, reply); + IF reply = error nak + THEN error msg := ds; + errorstop (error msg); + FI; + IF leave THEN LEAVE control spool FI; + +END PROC control spool; + + +PROC kill spool (TASK CONST spool) : + + control spool (spool, killer code, " loeschen", FALSE) + +END PROC kill spool; + + +PROC first spool (TASK CONST spool) : + + control spool (spool, first code, " als erstes", TRUE) + +END PROC first spool; + + +END PACKET spool cmd; + diff --git a/system/spooler/1.8.7-std.zusatz/src/spool manager b/system/spooler/1.8.7-std.zusatz/src/spool manager new file mode 100644 index 0000000..6b4fe55 --- /dev/null +++ b/system/spooler/1.8.7-std.zusatz/src/spool manager @@ -0,0 +1,1058 @@ +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; + diff --git a/system/std.zusatz/1.8.7/src/port server b/system/std.zusatz/1.8.7/src/port server deleted file mode 100644 index 46c647f..0000000 --- a/system/std.zusatz/1.8.7/src/port server +++ /dev/null @@ -1,164 +0,0 @@ -PACKET port server: (* Autor : R. Ruland *) - (* Stand : 21.03.86 *) - -INT VAR port station; -TEXT VAR port := "PRINTER"; - -put ("gib Name des Zielspools : "); editget (port); line; -put ("gib Stationsnummer des Zielspools : "); get (port station); - -server channel (15); -spool duty ("Verwalter fuer Task """ + port + - """ auf Station " + text (port station)); - -LET max counter = 10 , - time slice = 300 , - - ack = 0 , - fetch code = 11 , - param fetch code = 21 , - file save code = 22 , - file type = 1003 , - - begin char = ""0"", - end char = ""1""; - - -INT VAR reply, old heap size; -TEXT VAR file name, write pass, read pass, sendername, buffer; -FILE VAR file; - -DATASPACE VAR ds, file ds, send ds; - -BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; -BOUND TEXT VAR error msg ; - -spool manager (PROC save file); - -PROC save file : - - disable stop ; - command dialogue (FALSE); - ds := nilspace; file ds := nilspace; send ds := nil space; - old heap size := heap size; - - REP - execute save file; - - IF is error THEN save error (error message) FI; - - IF heap size > old heap size + 4 - THEN collect heap garbage ; - old heap size := heap size - FI; - - PER - -ENDPROC save file; - - -PROC execute save file : - -enable stop; -forget (file ds) ; file ds := nilspace; -call (father, fetch code, file ds, reply); -IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE save file ds -FI; - -. save file ds : - IF type (file ds) = file type - THEN get file params; - insert file params; - call station (port station, port, file save code, file ds); - ELSE errorstop ("Datenraum hat falschen Typ") - FI; - -. get file params : - forget (ds); ds := nilspace; - call (father, param fetch code, ds, reply); - IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE msg := ds; - file name := msg. file name; - write pass := msg. write pass; - read pass := msg. read pass; - sendername := msg. sender name; - FI; - -. insert file params : - buffer := ""; - in headline (filename); - in headline (write pass); - in headline (read pass); - in headline (sendername); - file := sequential file (input, file ds) ; - headline (file, buffer); - -END PROC execute save file; - - -PROC call station (INT CONST order task station, TEXT CONST order task name, - INT CONST order code, DATASPACE VAR order ds) : - - INT VAR counter := 0; - TASK VAR order task; - disable stop; - REP order task := order task station // order task name; - IF is error CAND pos (error message, "antwortet nicht") > 0 - THEN clear error; - counter := min (max counter, counter + 1); - pause (counter * time slice); - ELSE enable stop; - forget (send ds); send ds := order ds; - call (order task, order code, send ds, reply); - disable stop; - IF reply = ack - THEN forget (order ds); order ds := send ds; - forget (send ds); - LEAVE call station - ELSE error msg := send ds; - errorstop (error msg); - FI; - FI; - PER; - -END PROC call station; - - -TASK OP // (INT CONST station, TEXT CONST name) : - - enable stop; - station / name - -END OP //; - - -PROC in headline (TEXT CONST information) : - IF pos (information, begin char) <> 0 - OR pos (information, end char) <> 0 - THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; - buffer CAT begin char; - buffer CAT information; - buffer CAT end char; -END PROC in headline; - - -PROC save error (TEXT CONST message) : - clear error; - file name CAT "."; - file name CAT sender name; - file name CAT ".ERROR"; - file := sequential file (output, file name); - putline (file, " "); - putline (file, "Uebertragung nicht korrekt beendet "); - putline (file, " "); - put (file, "ERROR :"); put (file, message); - save (file name, public); - clear error; - forget(file name, quiet); -END PROC save error; - -ENDPACKET port server; - diff --git a/system/std.zusatz/1.8.7/src/printer server b/system/std.zusatz/1.8.7/src/printer server deleted file mode 100644 index b1a30bc..0000000 --- a/system/std.zusatz/1.8.7/src/printer server +++ /dev/null @@ -1,99 +0,0 @@ -PACKET multi user printer : (* Autor : Rudolf Ruland *) - (* Stand : 24.03.86 *) - -INT VAR c; -put ("gib Druckerkanal : "); get (c); - - server channel (c); - station only (FALSE) ; - spool duty ("Ausgabe mit dem Drucker"); - spool control task (myself); - -LET ack = 0 , - - fetch code = 11 , - param fetch code = 21 , - file type = 1003 ; - -INT VAR reply, old heap size, sender station; -TEXT VAR file name, userid, password, sendername; -FILE VAR file ; - -DATASPACE VAR ds, file ds; - -BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; -BOUND TEXT VAR error msg ; - -spool manager (PROC printer); - -PROC printer : - - disable stop ; - command dialogue (FALSE); - ds := nilspace; file ds := nilspace; - continue (server channel) ; - check error ("Kanal belegt"); - - old heap size := heap size ; - REP - execute print ; - - IF is error - THEN put error; - clear error; - FI ; - - IF heap size > old heap size + 4 - THEN collect heap garbage ; - old heap size := heap size - FI - PER - -ENDPROC printer ; - - -PROC execute print : - - enable stop ; - forget (file ds) ; file ds := nilspace ; - call (father, fetch code, file ds, reply) ; - IF reply = ack CAND type (file ds) = file type - THEN get file params; - print file - FI ; - -. get file params : - forget (ds); ds := nilspace; - call (father, param fetch code, ds, reply); - IF reply <> ack - THEN error msg := ds; errorstop (error msg); - ELSE msg := ds; - file name := msg. file name; - userid := msg. userid; - password := msg. password; - sendername := msg. sender name; - sender station := msg. station; - FI; - -. print file : - file := sequential file (input, file ds); - print (file, - PROC (INT CONST, INT VAR, INT VAR) open, - PROC (INT CONST, INT CONST) close, - PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); - -ENDPROC execute print ; - - -PROC check error (TEXT CONST message) : - IF is error - THEN clear error; - rename myself (message); - IF is error THEN clear error; end (myself) FI; - pause (18000); - end (myself); - FI; -END PROC check error; - -ENDPACKET multi user printer ; - diff --git a/system/std.zusatz/1.8.7/src/spool cmd b/system/std.zusatz/1.8.7/src/spool cmd deleted file mode 100644 index 9b43d36..0000000 --- a/system/std.zusatz/1.8.7/src/spool cmd +++ /dev/null @@ -1,178 +0,0 @@ -PACKET spool cmd (* Autor : R. Ruland *) - (* Stand : 13.08.87 *) - DEFINES - spool control password, - - kill spool, - first spool, - start spool, - stop spool, - halt spool, - wait for halt : - -LET error nak = 2 , - - entry line code = 23 , - killer code = 24 , - first code = 25 , - start code = 26 , - stop code = 27 , - halt code = 28 , - wait for halt code = 29 ; - -DATASPACE VAR ds; - -BOUND STRUCT (TEXT entry line, INT index, TEXT actual entries, password) VAR control msg; -BOUND TEXT VAR error msg; -INT VAR reply; - -INITFLAG VAR in this task := FALSE; -BOOL VAR dialogue; -TEXT VAR control password, password; - -control password := ""; - -PROC spool control password (TEXT CONST new password): - - IF on line THEN say (""3""13""5"") FI; - disable stop; - do ("enter spool control password (""" + new password + """)"); - clear error; - no do again; - cover tracks; - cover tracks (control password); - control password := new password; - -END PROC spool control password; - - -PROC call spool (INT CONST op code, TEXT CONST name, TASK CONST spool) : - - dialogue := command dialogue; - password := write password; - password CAT "/"; - password CAT read password; - disable stop; - command dialogue (FALSE); - enter password (control password); - command dialogue (dialogue); - call (op code, name, spool); - command dialogue (FALSE); - enter password (password); - command dialogue (dialogue); - -END PROC call spool; - - -PROC start spool (TASK CONST spool) : - - enable stop; - call spool (halt code, "", spool); - call spool (start code, "", spool); - -END PROC start spool; - - -PROC start spool (TASK CONST spool, INT CONST new channel) : - - enable stop; - call spool (halt code, "", spool); - call spool (start code, text (new channel), spool); - -END PROC start spool; - - -PROC stop spool (TASK CONST spool) : - - call spool (stop code, "", spool); - -END PROC stop spool; - -PROC stop spool (TASK CONST spool, TEXT CONST deactive msg) : - - call spool (stop code, deactive msg, spool); - -END PROC stop spool; - - -PROC halt spool (TASK CONST spool) : - - call spool (halt code, "", spool); - -END PROC halt spool; - -PROC halt spool (TASK CONST spool, TEXT CONST deactive msg) : - - call spool (halt code, deactive msg, spool); - -END PROC halt spool; - - -PROC wait for halt (TASK CONST spool) : - - call spool (wait for halt code, "", spool); - -END PROC wait for halt; - -PROC wait for halt (TASK CONST spool, TEXT CONST deactive msg) : - - call spool (wait for halt code, deactive msg, spool); - -END PROC wait for halt; - - -PROC control spool (TASK CONST spool, INT CONST control code, - TEXT CONST question, BOOL CONST leave) : - - enable stop; - initialize control msg; - WHILE valid spool entry - REP IF control question THEN control spool entry FI PER; - - . initialize control msg : - IF NOT initialized (in this task) THEN ds := nilspace FI; - forget (ds); ds := nilspace; control msg := ds; - control msg. entry line := ""; - control msg. password := control password; - control msg. index := 0; - say (""13""10""); - - . valid spool entry : - call (spool, entry line code, ds, reply); - IF reply = error nak - THEN error msg := ds; - errorstop (error msg); - FI; - control msg. index <> 0 - - . control question : - say (control msg. entry line); - yes (question) - - . control spool entry : - call (spool, control code, ds, reply); - IF reply = error nak - THEN error msg := ds; - errorstop (error msg); - FI; - IF leave THEN LEAVE control spool FI; - -END PROC control spool; - - -PROC kill spool (TASK CONST spool) : - - control spool (spool, killer code, " loeschen", FALSE) - -END PROC kill spool; - - -PROC first spool (TASK CONST spool) : - - control spool (spool, first code, " als erstes", TRUE) - -END PROC first spool; - - -END PACKET spool cmd; - 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; - -- cgit v1.2.3