path: root/system/std.zusatz/1.8.7/src/spool manager

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;