PACKET spool manager DEFINES                         (* Autor: J. Liedtke *)
    spool manager, server channel:                   (* 21.05.84          *)
 
 
LET que size       = 100 ,

    ack            = 0 ,
    nak            = 1 ,
    error nak      = 2 ,
    second phase ack = 5 ,

    fetch code     = 11 ,
    save code      = 12 ,
    erase code     = 14 ,
    list code      = 15 ,
    all code       = 17 ,
    continue code  = 100,

    empty          = 0 ,
    used           = 1 ;

TASK VAR order task , waiting server , from task , server ;
INT VAR order code , reply , first , last , list index ;

DATASPACE VAR ds ;

TEXT VAR from title ;

BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
BOUND TEXT VAR error msg ;
BOUND STRUCT (TEXT tname, tpass, TASK task) VAR sv msg ;

FILE VAR list file ;
TEXT VAR entry name, entry task;

INT VAR command index , params ;
TEXT VAR command line, param 1, param 2 ;
 
LET spool command list =
"break:1.0start:2.01stop:4.0first:5.0killer:6.0 " ;


LET ENTRY = STRUCT (TEXT title, TASK origin, DATASPACE space, INT status) ;

ROW que size ENTRY VAR que ;


INT VAR server chan := 0; 
 
PROC server channel (INT CONST ch): 
  server chan := ch 
 
END PROC server channel; 
 
INT PROC server channel: 
  server chan 
 
END PROC server channel; 
 
PROC spool manager (PROC server start) :
  INT VAR old heap size := heap size;
  begin (PROC server start, server) ;
  set autonom ;
  break ;
  disable stop ;
  first := 1 ;
  last  := 1 ;
  from task := niltask ;
  waiting server := niltask ;
  spool ;
  clear error ;
  forget all dataspaces.

forget all dataspaces :
  INT VAR i ;
  FOR i FROM 1 UPTO que size REP
    forget (que (i).space)
  PER .

spool:
  REP
    wait (ds, order code, order task) ;
    IF   order code = fetch code    THEN out of que
    ELIF order code = save code     THEN prepare into que
    ELIF order code = second phase ack THEN into que
    ELIF order code = erase code    THEN delete que entry
    ELIF order code = list code     THEN list spool
    ELIF order code = all code      THEN y all
    ELIF order code >= continue code
       AND order task = supervisor  THEN spool command (PROC server start)
    FI;
    clear error
  PER;
  collect heap garbage if necessary. 
 
collect heap garbage if necessary: 
  IF heap size > old heap size + 2 
  THEN collect heap garbage; 
       old heap size := heap size 
  FI.

ENDPROC spool manager ;

PROC out of que :

  forget (ds) ;
  IF NOT (order task < myself)
    THEN error ("not parent")
  ELIF que empty
    THEN waiting server := order task
    ELSE send (order task, ack, que (first).space) ;
         inc first
  FI .

que empty :   first = last .

ENDPROC out of que ;

PROC inc first :

  que (first).status := empty ;
  REP
    first := first MOD que size + 1 ;
  UNTIL first = last OR que (first).status <> empty PER

ENDPROC inc first ;

PROC dec first :

  first DECR 1 ;
  IF first = 0
    THEN first := que size
  FI

ENDPROC dec first ;

PROC prepare into que :

  msg := ds ;
  from task := order task ;
  from title := CONCR (msg).name ;
  send (order task,  second phase ack, ds) .

ENDPROC prepare into que ;

PROC into que :

  IF order task = from task
    THEN try entry into spool
    ELSE send (order task, nak, ds)
  FI .

try entry into spool :
  IF que full
    THEN error ("spool overflow")
    ELSE entry (que (last)) ;
         last := next (last) ;
         send (order task, ack, ds) ;
         awake server if necessary
  FI .
 
awake server if necessary :
  IF NOT is niltask (waiting server)
    THEN send (waiting server, ack, que (first).space , reply) ;
         IF reply = ack
           THEN waiting server := niltask ;
                inc first
         FI
  FI .

que full  :   first = next (last) .

ENDPROC into que ;

PROC entry (ENTRY VAR que entry) :

  que entry.title   := from title ;
  que entry.origin  := from task ;
  que entry.space   := ds ;
  que entry.status  := used ;

ENDPROC entry ;

INT PROC next (INT CONST index) :

  index MOD que size + 1 

ENDPROC next ;


PROC delete que entry :

  msg := ds ;
  INT VAR index := first ;
  WHILE index <> last REP
    IF entry found
      THEN erase entry (index) ;
           send (order task, ack, ds) ;
           LEAVE delete que entry
    FI ;
    index := next (index)
  PER ;
  error ("your file does not exist") .

entry found :
  entry.status = used CAND entry.origin = order task
  CAND entry.title = CONCR (msg).name .

entry :  que (index) .

ENDPROC delete que entry ;

PROC erase entry (INT CONST index) :

  entry.status := empty ;
  forget (entry.space) ;
  IF index = first
    THEN inc first
  FI .

entry : que (index) .

ENDPROC erase entry ;

PROC list spool :

  forget (ds) ;
  ds := nilspace ;
  list file := sequential file (output, ds) ;
  to first que entry ; 
  get next que entry (entry name, entry task) ; 
  WHILE entry name <> "" REP 
    putline (list file, text (entry task, 15) + " : " + entry name);
    get next que entry (entry name, entry task)
  PER;
  send (order task, ack, ds) .

ENDPROC list spool ;

BOUND THESAURUS VAR all thesaurus;
 
PROC y all:
  forget (ds); 
  ds := nilspace;
  all thesaurus := ds; 
  all thesaurus := empty thesaurus; 
  to first que entry; 
  get next que entry (entry name, entry task);   (* hier erster Eintrag *) 
  WHILE entryname <> "" REP 
    IF entry task = name (order task) 
      AND NOT (all thesaurus CONTAINS entry name)
      THEN insert (all thesaurus, entry name) 
    FI; 
    get next que entry (entry name, entry task) 
  PER;
  send (order task, ack, ds) 
 
END PROC y all; 
 
PROC to first que entry :

  list index := first - 1

ENDPROC to first que entry ;

PROC get next que entry (TEXT VAR entry name, origin task name): 
 
  WHILE list index <> last REP
    list index := next (list index)
  UNTIL que (list index).status <> empty PER ;
  IF que (list index).status = used
    THEN origin task name := name (que (list index).origin) ;
         entry name := que (list index).title
    ELSE entry name := ""; 
         origin task name := ""
  FI .

ENDPROC get next que entry ;

PROC error (TEXT CONST error text) :

  forget (ds) ;
  ds := nilspace ;
  error msg := ds ;
  CONCR (error msg) := error text ;
  send (order task, error nak, ds)

ENDPROC error ;

PROC spool command (PROC server start) :

  enable stop ;
  continue (order code - continue code) ;
  command dialogue (TRUE) ;
  disable stop ;
  REP 
    get command ("gib spoolkommando :", command line);
    analyze command (spool command list, command line, 3,
                     command index, params, param1, param2);
    execute command
  PER .

execute command :
  SELECT command index OF 
    CASE 1 : break cmd 
    CASE 2 : start cmd
    CASE 3 : start channel cmd
    CASE 4 : stop cmd
    CASE 5 : first cmd
    CASE 6 : killer cmd
  OTHERWISE  do (command line) END SELECT .

start channel cmd: 
  server channel (int (param1)); 
  start cmd; 
  break cmd. 
 
break cmd: 
  break; set autonom  ; LEAVE spool command. 

start cmd :
  IF is niltask (server)
    THEN begin (PROC server start, server)
  FI .

stop cmd :
  IF NOT is niltask (server)
    THEN command dialogue (FALSE) ;
         end (server) ;
         server := niltask 
  FI .

first cmd :
  line ;
  to first que entry ;
  get next que entry (entry name, entry task);
  IF entry name = ""
    THEN LEAVE first cmd
  FI ;
  REP
    get next que entry (entry name, entry task) ;
    IF entry name = ""
      THEN LEAVE first cmd
    FI;
    say (text (entry task, 15) + " : " + entry name) ;
    IF yes ("   als erstes")
      THEN make to first entry ;
           LEAVE first cmd
    FI 
  PER .

make to first entry :
  IF first = next (last)
    THEN errorstop ("spool overflow")
    ELSE dec first ;
         que (first) := que (list index) ;
         erase entry (list index)
  FI .


killer cmd :
  line ;
  to first que entry ;
  REP
    get next que entry (entry name, entry task) ;
    IF entry name = "" 
      THEN LEAVE killer cmd
    FI ;
    say (text (entry task, 15) + " : " + entry name) ;
    IF yes ("   loeschen")
      THEN erase entry (list index)
    FI 
  PER .
 
ENDPROC spool command ;

ENDPACKET spool manager ;