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/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 ---------------------------- 4 files changed, 1499 deletions(-) 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/std.zusatz') 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