app/flint/0.4/src/eudas.manager

PACKET eudas manager                         (* Autor: Thomas Berlage *)
                                             (* Stand: 20.01.88       *)
  DEFINES

  eudas manager,
  setze partner,
  abhaengige task,
  end partner :


LET
  code dateien        = 190,
  code felder         = 191,
  code positioniere   = 192,
  code satz           = 193,
  end myself code     = 197,
  set controlled code = 198,
  ask partner code    = 200;

LET
  ack   = 0;

LET
  COM = STRUCT (INT int info,
                BOOL bool info,
                TEXT text info,
                SATZ satz info);

BOUND COM VAR p;

ROW 4 TEXT VAR partner vater;
  partner vater (1) := "";
  partner vater (2) := "";
  partner vater (3) := "";
  partner vater (4) := "";

TEXT VAR puffer;

LET
  kein partner =
    "Kein Partner";


PROC setze partner (INT CONST nr, TEXT CONST name des vaters) :

  partner vater (nr) := name des vaters

END PROC setze partner;

PROC eudas manager (DATASPACE VAR ds, INT CONST order, phase,
                    TASK CONST order task) :

  enable stop;
  SELECT order OF
  CASE code dateien      : code dateien ausfuehren
  CASE code felder       : code felder ausfuehren
  CASE code positioniere : code positioniere ausfuehren
  CASE code satz         : code satz ausfuehren
  OTHERWISE andere codes
  END SELECT .

andere codes :
  IF order > ask partner code AND order < ask partner code + 4 THEN
    ask partner code ausfuehren
  ELSE
    menue manager (ds, order, phase, order task)
  END IF .

code dateien ausfuehren :
  p := ds;
  p. int info := dateiversion;
  dateinamen anlegen;
  send (order task, ack, ds) .

dateinamen anlegen :
  satz initialisieren (p. satz info);
  FOR i FROM 1 UPTO anzahl dateien REP
    feld aendern (p. satz info, i, eudas dateiname (i))
  END REP .

code felder ausfuehren :
  p := ds;
  feldinfo anlegen;
  feldnamen anlegen;
  send (order task, ack, ds) .

feldinfo anlegen :
  INT VAR i;
  TEXT VAR rep := "  ";
  p. text info := "";
  FOR i FROM 1 UPTO anzahl felder REP
    replace (rep, 1, feldinfo (i));
    p. text info CAT rep
  END REP .

feldnamen anlegen :
  satz initialisieren (p. satz info, anzahl felder);
  FOR i FROM 1 UPTO anzahl felder REP
    feldnamen lesen (i, puffer);
    feld aendern (p. satz info, i, puffer)
  END REP .

code positioniere ausfuehren :
  p := ds;
  positionieren;
  ergebnis ablegen;
  send (order task, ack, ds) .

positionieren :
  IF p. bool info THEN
    relativ positionieren
  ELSE
    auf satz (p. int info)
  END IF .

relativ positionieren :
  IF p. int info > 0 THEN
    weiter (p. int info)
  ELIF p. int info < 0 THEN
    zurueck (- p. int info)
  END IF .

ergebnis ablegen :
  p. int info := satznummer;
  p. bool info := dateiende .

code satz ausfuehren :
  p := ds;
  p. int info := satzkombination;
  p. bool info := satz ausgewaehlt;
  satz aufbauen;
  send (order task, ack, ds) .

satz aufbauen :
  satz initialisieren (p. satz info, anzahl felder);
  FOR i FROM 1 UPTO anzahl felder REP
    feld lesen (i, puffer);
    feld aendern (p. satz info, i, puffer)
  END REP .

ask partner code ausfuehren :
  INT VAR p nr := order - ask partner code;
  forget (ds); ds := nilspace;
  BOUND TASK VAR c task := ds;
  CONCR (c task) := partner mit einrichten (p nr, task index);
  send (order task, ack, ds) .

task index :
  FOR i FROM 2 UPTO 4 REP
    IF partner task (i) = order task THEN
      LEAVE task index WITH i
    END IF
  END REP;
  errorstop (kein partner);
  1 .

END PROC eudas manager;

TASK PROC abhaengige task (INT CONST p nr) :

  partner mit einrichten (p nr, 1)

END PROC abhaengige task;

TASK PROC partner mit einrichten (INT CONST p nr, p von) :

  enable stop;
  IF NOT exists (partner task (p nr)) THEN
    partner einrichten
  END IF;
  partner task (p nr) .

partner einrichten :
  TEXT CONST neuer name := name (myself) + "-p" + text (p nr - 1);
  begin (neuer name, partner vater (p nr));
  partner task (p nr, task (neuer name));
  abhaengig setzen .

abhaengig setzen :
  DATASPACE VAR send ds := nilspace;
  BOUND STRUCT (INT von, TASK pt) VAR m := send ds;
  m. von := p von;
  m. pt := partner task (p von);
  INT VAR i, reply;
  FOR i FROM 1 UPTO 5 REP
    pingpong (partner task (p nr), set controlled code, send ds, reply);
    IF reply = -2 THEN pause (5) END IF
  UNTIL reply <> -2 END REP;
  forget (send ds) .

END PROC partner mit einrichten;

PROC end partner (INT CONST p nr) :

  IF exists (partner task (p nr)) THEN
    end code senden
  END IF .

end code senden :
  DATASPACE VAR send ds := nilspace;
  INT VAR i, reply;
  FOR i FROM 1 UPTO 10 REP
    send (partner task (p nr), end myself code, send ds, reply);
    IF reply = ack THEN
      LEAVE end code senden
    END IF;
    pause (3)
  END REP;
  forget (send ds);
  errorstop ("END nicht angenommen") .

END PROC end partner;


END PACKET eudas manager;