Move spooler into its own package

I *think* these parts belong together.

4 files changed, 0 insertions, 1290 deletions

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