Move spooler into its own package

I *think* these parts belong together.

4 files changed, 0 insertions, 1499 deletions

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;
-