path: root/system/base/unknown/src/SPOLMAN5.ELA

PACKET queue handler DEFINES enter into que,
                             exists in que,
                             all in que,
                             erase from que, 
                             erase last top of que,
                             get top of que, 
                             restore ,
                             list que, 
                             info, killer,first, 
                             que status, 
                             que empty,
                             set entry types,
                             change entry types,
                             initialize que:
 
 
LET que size    = 100, 
 
    empty       =   0, 
    used        =   1,
    blocked     =   2, 
    nil         =   0,
    user  error =  99,
    unused char =   ""0"", 
    used char   =   ""1"", 
    blocked char=   ""2"", 
    ENTRY       = STRUCT(TEXT title, TASK origin, TEXT origin name, 
                         DATASPACE space, INT storage,    acc code ) ; 
 
ROW que size ENTRY VAR que ; 
 
TEXT VAR status list; 
BOOL VAR n ok := FALSE; 
INT  VAR top of que,
         first que entry, 
         last que entry,
         index ;
 
.entry: que[index]. ;
 
PROC initialize que : 
  FOR index FROM 1 UPTO que size REP 
    forget( entry.space ); 
    entry.acc code := empty
  END REP ; 
  first que entry := nil;
  last que entry  := nil; 
  top of que      := nil;
  index           := nil; 
  status list     := que size * unused char; 
END PROC initialize que ; 
 
initialize que ; 

(****************** Interne Queue-Zugriffsoperationen **********************)
 
INT PROC next (INT CONST pre) : 
  pre MOD que size + 1 
END PROC next ; 
 
PROC block (INT CONST entry number) : 
  que [entry number].acc code := blocked; 
  replace (status list,entry number,blocked char); 
ENDPROC block; 
 
PROC unblock (INT CONST entry number) : 
  que [entry number].acc code := used; 
  replace (status list,entry number,used char); 
ENDPROC unblock; 
 
PROC to next que entry: 
  REP 
    IF index = last que entry OR index = nil
      THEN index := nil ; LEAVE to next que entry 
    FI ;
    index := next(index)
  UNTIL entry.acc code <> empty PER 
END PROC to next que entry ; 
 
PROC to first que entry : 
  index := first que entry 
END PROC to first que entry ; 
 
PROC search que entry (TEXT CONST title, TASK CONST origin) : 
 
  check if index identifies entry ;
  IF last que entry = nil 
    THEN index := nil 
    ELSE index := last que entry ; 
         REPEAT 
           IF is wanted entry 
             THEN LEAVE search que entry 
           FI ; 
           IF index = first que entry 
             THEN index := nil 
             ELSE index DECR 1 ; 
                  IF index = 0 
                    THEN index := que size 
                  FI 
           FI 
         UNTIL index = nil PER 
  FI. 
 
is wanted entry: 
 
  entry.acc code <> empty CAND 
  entry.title    =  title CAND 
 (entry.origin   =  origin OR 
  origin = niltask ).
 
check if index identifies entry: 
 
  IF index <> nil CAND is wanted entry 
    THEN LEAVE search que entry 
  FI 
 
END PROC search que entry ; 
 
PROC exec erase :
 
    forget (entry.space) ; entry.acc code := empty ; 
    replace (status list,index,unused char); 
    try to cut off queue ends. 
 
try to cut off queue ends: 
 
  WHILE first entry is not valid REP 
    check if que empty ; 
    first que entry := next(first que entry) 
  END REP ; 
  WHILE last entry is not valid REP 
    make index invalid if necessary ; 
    last que entry DECR 1 ; 
    IF last que entry = 0 
      THEN last que entry := que size 
    FI 
  END REP . 
 
first entry is not valid: 
     que [first que entry].acc code = empty. 
 
last entry is not valid: 
     que [last que entry].acc code = empty. 
 
check if que empty: 
     IF first que entry = last que entry 
       THEN first que entry := nil ;
            last que entry  := nil ; 
            index := nil ; 
            LEAVE try to cut off queue ends
     FI.

make index invalid if necessary: 
     IF index = last que entry 
       THEN index := nil 
     FI. 
 
END PROC exec erase ;
 
PROC exec first: 
  IF next (last que entry) = first que entry 
    THEN errorstop ("Queue ist voll - vorziehen unmoeglich") 
  ELIF index = top of que 
    THEN errorstop ("Auftrag wird bereits bearbeitet") 
  ELIF entry.acc code = empty 
    THEN errorstop ("undefinierter Queue-Eintrag. /exec first") 
    ELSE first que entry DECR 1 ; 
         IF first que entry = 0 
           THEN first que entry := que size 
         FI ; 
         que[first que entry] := que[index] ; 
         replace (status list,first que entry,code (entry.acc code)); 
         exec erase 
  FI 
END PROC exec first ; 
 
PROC erase last top of que: 
  IF top of que <> nil 
    THEN index := top of que; exec erase;
         top of que := nil 
  FI 
END PROC erase last top of que;
 
 
(******************  Behandlung von DATASPACE-typen  ***********************)
 
LET semicolon = ";" , 
    colon     = ":" , 
    quote     = """"; 
TEXT VAR entry types ::   ""   ; 
 
BOOL PROC no permitted type (DATASPACE CONST ds) : 
  TEXT CONST type nr :: semicolon + text(type(ds)) + colon; 
  INT  CONST t pos   :: pos (entry types,type nr) ; 
  entry types <> "" CAND t pos = 0 
END PROC no permitted type ; 
 
TEXT PROC record of que entry: 
  IF entry.acc code = empty 
    THEN errorstop ("undefinierter Queue-Eintrag. /record");"" 
    ELSE TEXT VAR record :: "" ; 
         record CAT storage in k ; 
         record CAT type of entry ; 
         record CAT name of entry ; 
         record CAT origin of entry ; 
         IF entry.acc code = blocked THEN record CAT "- blocked -" FI;
         record
  FI. 
 
storage in k: 
 
  text (entry.storage,3) + " K  ". 
 
type of entry: 
 
  IF entry types = "" 
    THEN 12 * "?" 
    ELSE TEXT CONST type nr :: semicolon + text(type(entry.space)) + colon ; 
         INT CONST semi colon pos :: pos (entry types, type nr), 
                   start type     :: semi colon pos + LENGTH type nr , 
                   end type       :: pos(entrytypes,semicolon,starttype)-1; 
         IF semi colon pos = 0 
           THEN 12 * "?" 
           ELSE text( subtext(entry types, starttype, endtype),12)
         FI 
  FI. 
 
name of entry: 
 
  text (quote+ entry.title +quote, 20) .
 
origin of entry: 
 
  IF entry.origin = niltask 
    THEN 20 * " "
    ELSE text (" TASK: "+entry.origin name,20) 
  FI 
 
END PROC record of que entry ;
 
PROC set entry types (TEXT CONST t) : 
  check if void ;
  IF first char is no semicolon
    THEN entry types := semicolon
    ELSE entry types := "" 
  FI;
  entry types CAT t ; 
  IF last char is no semicolon
    THEN entry types CAT semicolon 
  FI.

check if void: 
  IF t = "" 
    THEN entry types := ""; 
         LEAVE set entry types 
  FI. 
 
first char is no semicolon: 
  (t SUB 1) <> semicolon. 
 
last char is no semicolon: 
  (t SUB length(t)) <> semicolon 
 
END PROC set entry types ; 
 
PROC change entry types: 
  TEXT VAR t :: entry types;
  line;putline("Entrytypes :");
  editget(t); 
  set entry types (t) 
END PROC change entry types; 
 
 
(************************ Std Zugriffe auf Queue ***************************)
 
 
PROC erase from que (TEXT CONST title, TASK CONST origin) : 
  search que entry (title, origin) ; 
  IF index = nil 
    THEN errorstop ("Auftrag existiert nicht. /erase")
  ELIF index = top of que 
    THEN errorstop (user error, "Dieser Auftrag wird bereits bearbeitet") 
    ELSE exec erase 
  FI 
END PROC erase from que ; 
 
BOOL PROC exists in que (TEXT CONST title, TASK CONST origin) : 
  search que entry (title, origin) ; 
  index <> nil 
END PROC exists in que ; 
 
PROC info (BOOL CONST b) : n ok := b ENDPROC info; 
 
THESAURUS PROC all in que (TASK CONST origin) : 
 
  THESAURUS VAR result := empty thesaurus ; 
  to first que entry ; 
  WHILE index <> 0 REP 
    IF entry.origin = origin OR origin = niltask 
      THEN insert (result, entry.title)
    FI ; 
    to next que entry
  END REP ; 
  result 
 
END PROC all in que ; 
 
PROC enter into que (TEXT CONST title, TASK CONST origin, 
                     DATASPACE CONST space ):
 
  IF next(last que entry) = first que entry 
    THEN errorstop ("Queue zu voll")
  ELIF no permitted type (space)  OR title = ""
    THEN errorstop (user error, "Auftrag wird nicht angenommen")
    ELSE last que entry := next(last que entry); 
         index := last que entry;
         entry := ENTRY: 
            ( title, origin,task name, space, storage(space), used ) ; 
         IF first que entry = nil 
           THEN first que entry := 1 
         FI ; 
         replace (status list,last que entry,used char); 
  FI. 
 
task name : 
  TEXT VAR name of task :: name (origin); 
  IF name of task = "stemmer" AND n ok THEN "stemmi" ELSE name of task FI. 
 
END PROC enter into que ; 
 
PROC get top of que (DATASPACE VAR top space) : 
  forget (top space) ;
  IF que empty 
    THEN errorstop ("kein Auftrag vorhanden. /get") 
    ELSE erase last top of que; 
         top of que := first que entry; 
         IF que [top of que].acc code = blocked THEN 
            wrap around if necessary
         ELSE top space := que [first que entry].space ; FI; 
  FI . 
 
wrap around if necessary : 
 
  IF entry is allowed to be printed THEN 
     give it to spool manager 
  ELSE enter into end of queue FI. 
 
entry is allowed to be printed : 
  pos (status list,used char) = nil. 
 
give it to spool manager : 
  top space := que [first que entry].space; 
  que [first que entry].acc code := used. 
 
enter into end of queue : 
  top space := que [first que entry].space; 
  enter into que (que [first que entry].title,que [first que entry].origin 
                  ,top space); 
  index := first que entry; 
  IF entry.acc code = blocked THEN block (index) FI; 
  get top of que (top space). 
 
END PROC get top of que ; 
 
PROC restore:
  top of que := nil 
END PROC restore ; 
 
BOOL PROC que empty:                         (* 'top of que' gilt nicht *)
  first que entry = last que entry AND 
  top of que      = last que entry. 
END PROC que empty ; 
 
PROC que status (INT VAR size, TEXT VAR top title, 
                 TASK VAR top origin, TEXT VAR top origin name ): 
 
  size := last que entry - first que entry ;  (* geloeschte Eintraege *)
  IF size < 0                                 (* zaehlen mit !!       *)
    THEN size INCR que size                   (* (aber nicht 'top' )  *)
  FI ; 
  IF top of que <> nil 
    THEN top title       := que [top of que].title ; 
         top origin      := que [top of que].origin ; 
         top origin name := que [top of que].origin name
    ELSE size INCR 1 ; 
         top title       := "" ; 
         top origin      := niltask ;
         top origin name := "" 
  FI 
END PROC que status ;

TEXT VAR sep :: 79 * "_", record :: "", 
         ask :: "editieren (e),kopieren (k),loeschen (l)," + 
                "vorziehen (v),duplizieren (d),"13""10"" + 
                "print --> quickprint (q),blockieren (b),freigeben (f)," + 
                "weiter (w) ? "; 
 
PROC info : 
 
     to first que entry; 
     WHILE index <> nil REP 
       record := record of que entry; 
       WHILE index <> top of que REPEAT 
         ask user what to do; 
         out (input char); 
         exec command
       UNTIL command index = 1 PER; 
       to next que entry; 
     PER. 
 
ask user what to do : 
 
     out (""13""10"");out (sep);out (""13""10""13""10""); 
     out (record); 
     out (""13""10""10"");out (ask); 
     INT VAR command index; TEXT VAR input char; 
     REPEAT 
       inchar (input char); 
       command index := pos ("w eklvdqbf",input char); 
     UNTIL command index > 0 PER. 
 
exec command : 
 
     SELECT command index OF 
      CASE 3 : INT VAR old dataspace type := type (entry.space); 
               type (entry.space,1003); 
               FILE VAR f :: sequentialfile (modify,entry.space); 
               edit (f); line (2); 
               type (entry.space,old dataspace type) 
      CASE 4 : forget (entry.title,quiet); 
               copy (entry.space,entry.title); 
               type (old (entry.title),1003) 
      CASE 5 : exec erase ;command index := 1 
      CASE 6 : exec first ;command index := 1
      CASE 7 : INT VAR dummy no := index; 
               enter into que (que [dummy no].title,que [dummy no].origin, 
                               que [dummy no].space) 
      CASE 8 : type (entry.space,1103) ;record := record of que entry; 
      CASE 9 : block (index) ;record := record of que entry;
      CASE 10: unblock (index); record := record of que entry; 
     ENDSELECT. 
 
ENDPROC info; 
 
PROC list que (FILE VAR f, DATASPACE VAR ds) : 
  open listfile ;
  to first que entry ; 
  WHILE index <> nil REP 
    TEXT VAR record :: record of que entry ; 
    IF index = top of que 
      THEN record := text(record,60) ; 
           record CAT ""15"wird bearbeitet"14""
    FI ;
    putline (f,record) ;
    to next que entry
  END REP.
 
open listfile:
 
  forget (ds) ; 
  ds := nilspace ; 
  f := sequentialfile (output,ds) ; 
  headline (f, name(myself) + " - Queue") ; 
  line (f)

END PROC list que ; 
 
PROC killer : info ENDPROC killer; 
PROC first  : info ENDPROC first; 
 
END PACKET queue handler ; 
 
(***************************************************************************)
(*   Programm zur Verwaltung einer Servertask                              *)
(*        (benutzt 'queue handler')                                        *)
(*        Autor: A.Vox                                                     *)
(*        Stand: 3.6.85                                                    *)
(*                                                                         *)
(***************************************************************************)
PACKET spool manager DEFINES server status, 
                             server modus, 
                             server task, 
                             server channel, 
                             server routine, 
                             server fail msg, 
 
                             log edit, 
                             logline, 
                             logfilename,
                             check, 
                             feed server if hungry, 
                             check if server vanished, 
 
                             spool manager, 
                             get title and origin, 

                             start, 
                             stop, 
                             pause, 
                             spool info, 
                             list, 
                             spool maintenance: 
 
 
     LET user error = 99;
 
     LET { Status: }       { Modus: }
         init = 0,         active  = 0,
         work = 1,         paused  = 1, 
         wait = 2,         stopped = 2,
         dead = 3;
 
     LET cmd form feed             = ""12""; 
 
INT VAR status :: init,
        modus  :: stopped;
 
TASK VAR server  :: niltask; 
TEXT VAR routine :: "", 
         fail msg:: ""; 
INT VAR channel  :: 0;
(************ Globale Variablen fuer alle 'que status'-Aufrufe ************) 
 
INT  VAR que size; 
TEXT VAR actual title, 
         actual origin name; 
TASK VAR actual origin; 
 
 
(*********** Zugriffsoperationen auf wichtige Paketvariablen **************)
 
TASK PROC  servertask    : server       END PROC servertask; 
INT  PROC  serverstatus  : status       END PROC serverstatus; 
INT  PROC  servermodus   : modus        END PROC servermodus; 
TEXT PROC  serverroutine : routine      END PROC serverroutine; 
TEXT PROC  serverfailmsg : fail msg     END PROC serverfailmsg;
INT  PROC  serverchannel : channel      END PROC serverchannel; 
 
PROC serverroutine (TEXT CONST neu): 
  routine := neu 
END PROC serverroutine; 
 
PROC serverfailmsg (TEXT CONST neu): 
  failmsg := neu 
END PROC serverfailmsg; 
 
PROC serverchannel (INT CONST neu): 
  channel := neu 
END PROC serverchannel; 
 
(************************* Basic Spool Routines ***************************) 
 
TEXT CONST logfilename :: "Vorkommnisse"; 
FILE VAR logfile; 
 
TEXT VAR fail title  :: "" ;
TASK VAR fail origin :: niltask ; 
REAL VAR fail time   :: 0.0 ; 
 
PROC logline (TEXT CONST mess): 
  logfile := sequential file(output, logfilename) ; 
  clear file if too large ; 
  put(logfile, date);
  put(logfile, time of day); 
  put(logfile, " : ");
  putline(logfile, mess) 
END PROC logline ; 
 
PROC log edit: 
  enable stop ; 
  IF NOT exists(logfilename) 
    THEN errorstop ("keine Eintragungen vorhanden") 
    ELSE logfile := sequentialfile(modify,logfilename) ; 
         position to actual page; 
         edit(logfile);
         line (2); 
         forget (logfilename); 
  FI. 
 
position to actual page: 
 
  INT CONST begin of last page :: lines(logfile)-22 ; 
  logfile := sequential file(modify,logfilename); 
  IF begin of last page < 1 
    THEN toline(logfile,1) 
    ELSE toline(logfile,begin of last page) 
  FI
 
END PROC logedit; 
 
PROC clear file if too large: 
  IF lines(logfile) > 1000 
    THEN modify (logfile) ; 
         toline (logfile, 900) ; 
         remove (logfile, 900) ; 
         clear removed (logfile) ;
         output (logfile) 
  FI 
END PROC clear file if too large ; 
 
PROC end server (TEXT CONST mess): 
  access catalogue; 
  IF exists (server) CAND son(myself) = server 
    THEN end(server) 
  FI; 
  failtime := clock(1); 
  que status (que size, fail title, fail origin, actual origin name) ; 
  logline (mess) ; 
  IF fail title <> "" 
    THEN logline(""""+fail title+""" von Task: "+actual origin name) 
    ELSE logline("kein Auftrag betroffen") 
  FI ; 
  status := dead ; 
  server := niltask 
END PROC end server; 
 
PROC check (TEXT CONST title, TASK CONST origin): 
  check if server vanished ; 
  IF less than 3 days ago AND 
     was failure          AND 
     title matches        AND 
     origin matches 
    THEN fail origin := myself ; 
         errorstop (user error, """"+fail title+""" abgebrochen")
  FI. 
 
less than 3 days ago: 
  clock(1) < fail time + 3.0 * day. 
 
origin matches: 
  (origin = fail origin OR origin = niltask). 
 
title matches: 
  (title  = fail title  OR title  = ""). 
 
was failure: 
  fail title <> ""
 
END PROC check ; 
 
PROC start server: 
  begin (PROC server start,server) ; 
  status := init 
END PROC start server; 
 
PROC server start: 
  disable stop ; 
  IF channel <> 0 
    THEN continue (channel) ; 
  FI ;
  command dialogue (FALSE) ; 
  out (cmd form feed); 
  do (routine) ; 
  IF is error 
    THEN call(logline code, "Server-Fehler :",father); 
         call(logline code, error message, father) ; 
         call(logline code, "Zeile: " + text(errorline) +
                            " Code: " + text(errorcode)  ,father) 
    ELSE call(logline code, "Ende des Server-Programms erreicht",father) 
  FI ; 
  IF online 
    THEN out (fail msg) 
  FI ; 
  call (terminate code,fail msg, father) ;
  end (myself) 
END PROC server start ;
 
PROC check if server vanished: 
  IF NOT (server = nil task) CAND NOT exists (server) 
    THEN end server ("Server gestorben :") ; 
         start server 
  FI 
END PROC check if server vanished; 
 
 
(*************************** Manager Routines *****************************)
 
   LET ack              = 0,
       second phase ack = 5,
       not existing nak = 6,
 
       begin code       = 4, 
       fetch code       = 11, 
       save code        = 12,
       exists code      = 13, 
       erase code       = 14, 
       list code        = 15, 
       all code         = 17, 
       clear code       = 18, 
       release code     = 20, 
       check code       = 22, 
 
       terminate code   = 25, 
       logline code     = 26, 
       get title code   = 27, 
 
       continue code    = 100; 
 
 
DATASPACE VAR packet space ; 
INT VAR reply ; 
BOUND STRUCT(TEXT f name,a,b) VAR msg ; 
.f name: msg.f name. ; 
 
TEXT VAR save title :: "";
FILE VAR listfile; 
 
PROC get title and origin (TEXT VAR title, origin): 
  forget (packet space) ; 
  packet space := nilspace ; 
  call (father, get title code, packet space, reply) ;
  IF reply = ack 
    THEN msg := packet space ; 
         title := msg.f name ; 
         origin := msg.a ; 
         forget (packet space)
    ELSE forget (packet space) ; 
         errorstop ("'get title' nicht erfolgreich. Antwort="+text(reply)) 
  FI 
END PROC get title and origin; 
 
PROC feed server if hungry:
  check if server vanished ; 
  IF status = wait AND NOT que empty 
    THEN get top of que (packet space) ; 
         send (server, ack, packet space, reply) ; 
         forget (packet space) ;
         IF reply = ack 
           THEN status := work 
           ELSE restore ; 
                end server ("Server nimmt keinen Auftrag an") ; 
                start server 
         FI 
  FI 
ENDPROC feed server if hungry;
 
PROC server request (DATASPACE VAR ds, INT CONST order, phase) : 
 
  enable stop ; 
  msg := ds ; 
  SELECT order OF 
    CASE terminate code: terminate 
    CASE logline code:   logline (f name)   ;send(server, ack, ds)
    CASE get title code: send title 
    OTHERWISE 
      IF order = fetch code CAND f name = "-" 
        THEN send top of que 
        ELSE freemanager (ds,order,phase,server) 
      FI 
  END SELECT ; 
  forget(ds). 
 
terminate: 
  end server ("Server terminiert :") ; 
  start server.
 
send title: 
  forget (ds) ; 
  ds := nilspace ; 
  msg := ds ; 
  que status (que size, msg.f name, actual origin, msg.a) ; 
  send (server, ack, ds).
 
send top of que: 
  status := wait ; 
  erase last top of que ;
  IF modus = active 
    THEN feed server if hungry
  FI 
 
END PROC server request; 
 
PROC spool manager(DATASPACE VAR ds, INT CONST order, phase, 
                   TASK CONST order task) : 
 
  IF ordertask < myself 
    THEN server request (ds,order,phase) 
  ELIF ordertask = supervisor
    THEN system request 
  ELSE spool command (ds,order,phase,order task) 
  FI; 
  check storage; 
  error protocol. 
 
check storage: 
  INT VAR size, used; 
  storage(size,used); 
  IF used > size 
    THEN logline("Speicher-Engpass :"); 
         initialize que; 
         logline("Queue geloescht !!"); 
         stop 
  FI. 
 
error protocol: 
  IF is error AND error code <> user error 
    THEN logline ("Spool-Fehler :") ; 
         logline (errormessage) ; 
         logline ("   Zeile: " + text(errorline) + 
                  "   Code: "  + text(errorcode) ) 
  FI. 
 
system request: 
  IF order > continue code 
    THEN call (supervisor,order,ds,reply) ; 
         forget(ds) ; 
         IF reply = ack 
           THEN spool maintenance 
         FI 
  FI 
 
END PROC spool manager; 
 
PROC spool command (DATASPACE VAR ds, INT CONST order, phase, 
                    TASK CONST order task): 
 
  enable stop ; 
  check if server vanished ;
  msg := ds ; 
  SELECT order OF 
    CASE begin code : special begin 
    CASE fetch code:  y get logfile 
    CASE save code :  y save 
    CASE exists code: y exists 
    CASE erase code:  y erase 
    CASE list code:   y list 
    CASE all code:    y all 
    CASE release code, 
         clear code:  y restart 
    CASE check code:  y check 
    OTHERWISE errorstop (user error, "Kein Kommando fuer SPOOLER") 
  END SELECT. 
 
special begin : 
   INT VAR dummy; 
   call (public,begin code,ds,dummy); 
   send (order task,ack,ds). 
 
y get logfile: 
  forget(ds) ; 
  ds := old(logfilename) ; 
  send (ordertask, ack, ds). 
 
y erase: 
  IF NOT exists in que (f name,ordertask) 
    THEN manager message(""""+f name+""" steht nicht in der Queue")
  ELIF phase = 1 
    THEN manager question (""""+f name+""" aus der Queue loeschen") 
    ELSE erase from que (f name,ordertask) ; 
         send (ordertask, ack, ds) 
  FI. 
 
y save: 
  IF phase = 1 
    THEN save title := f name ; 
         send (order task,second phase ack,ds); 
    ELSE enter into que (save title, ordertask, ds) ; 
         IF modus = active 
           THEN feed server if hungry
         FI ; 
         send (order task,ack,ds); 
  FI. 
 
y list: 
  list que (listfile,ds) ; 
  send (ordertask, ack, ds). 
 
y all: 
  forget(ds) ; 
  ds := nilspace ; 
  BOUND THESAURUS VAR all names := ds ; 
  all names := all in que (ordertask) ; 
  send (ordertask, ack, ds). 
 
y exists: 
  IF exists in que (f name,ordertask) 
    THEN send (ordertask, ack, ds) 
    ELSE send (ordertask, not existing nak, ds) 
  FI. 
 
y check: 
  check (f name,ordertask) ; 
  questatus (que size, actual title, actual origin, actual origin name) ; 
  IF there is a title   AND
     is actual origin   AND 
     is actual title 
    THEN manager message (""""+f name+""" wird soeben bearbeitet") 
  ELIF exists in que (f name,ordertask) 
    THEN manager message (""""+f name+""" steht noch in der Queue") 
    ELSE errorstop (usererror, """"+f name+""" steht nicht in der Queue") 
  FI. 
 
  there is a title:  actual title <> "" .
  is actual origin:  ordertask = actual origin .
  is actual title : (f name = "" OR f name = actual title) . 
 
y restart: 
  questatus (que size, actual title, actual origin, actual origin name) ;
  IF actual origin = ordertask 
    THEN IF phase = 1 
           THEN manager question (""""+actual title+""" unterbrechen") 
           ELSE end server ("unterbrochen durch Auftraggeber :") ; 
                start server ; 
                IF order = clear code 
                  THEN restore 
                  ELSE erase last top of que
                FI ; 
                manager message ("Auftrag unterbrochen") 
         FI
    ELSE errorstop (usererror, "kein eigener Auftrag") 
  FI

END PROC spool command ; 
 
PROC start: 
  IF modus = stopped 
    THEN start server ; 
         modus := active; 
         message ("Server aktiviert") 
  ELIF modus = paused 
    THEN modus := active ; 
         message ("'Pause'-Modus zurueckgesetzt") ; 
         feed server if hungry
    ELSE message ("Server bereits aktiv") 
  FI 
END PROC start; 
 
PROC stop: 
  IF modus <> stopped 
    THEN end server ("Gestoppt :"); 
         modus := stopped ;
         status := init ; 
         message ("Server gestoppt") 
    ELSE message ("Server bereits gestoppt") 
  FI 
END PROC stop; 
 
PROC pause: 
  IF modus = active 
    THEN modus := paused ; 
         message ("'Pause'-Modus gesetzt")
  ELIF modus = paused 
    THEN message ("'Pause'-Modus bereits gesetzt")
    ELSE errorstop ("Server ist gestoppt") 
  FI 
END PROC pause; 
 
PROC message (TEXT CONST mess): 
  say(""13""10"") ; 
  say(mess) ; 
  say(""13""10"") 
END PROC message ; 
 
PROC list: 
  list que(listfile,packet space) ; 
  show(listfile) 
END PROC list; 
 
PROC spool maintenance: 
  command dialogue (TRUE);
  IF exists(logfilename) 
    THEN logedit 
  FI; 
  WHILE online REP
    get command ("gib spool kommando :") ;
    do command 
  END REP ; 
  command dialogue (FALSE) ; 
  break ; 
  set autonom 
END PROC spool maintenance ;
 
PROC spoolinfo: 
  check if server vanished ;
  que status (que size, actual title, actual origin, actual origin name) ; 
  line(2) ; 
  putline("Queue :") ; 
  put("Auslastung :");put(que size); line;
  IF actual title <> "" 
    THEN put("Aktueller Auftrag :");putline(actual title); 
         put("         von Task :");putline(actual origin name) 
  FI ; 
  line ; 
  putline("Server :"); 
  put("Status :"); 
  SELECT status OF 
    CASE init : putline("initialisiert") 
    CASE work : putline("arbeitet") 
    CASE wait : putline("wartet")
    OTHERWISE   putline("gestorben")
  END SELECT ;
  put("Modus  :"); 
  SELECT modus OF 
    CASE active : putline("aktiv") 
    CASE paused : putline("pausierend") 
    OTHERWISE     putline("gestoppt") 
  END SELECT ; 
  put("Kanal  :");put(pcb(server,4));
  line(2) 
END PROC spool info 
 
END PACKET spool manager;