(* ------------------- VERSION 13 vom 28.05.86 -------------------- *)
PACKET macro store DEFINES macro command and then process parameters,
                           get macro line,
                           number macro lines,
                           load macros,
                           list macros:

(* Programm zur Behandlung von Textkosemtik-Macros
   Autor: Rainer Hahn
   Stand: 1.7.1 (Febr. 1984)
*)

INITFLAG VAR this packet :: FALSE;

DATASPACE VAR ds;

BOUND MACROTABLE VAR macro table;

FILE VAR f;

LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store,
                         ROW max macro zeilen TEXT macro zeilen,
                         ROW max macros TEXT macro namen,
                         ROW max macros INT  anz parameter,
                         ROW max macros INT  macro start);

 
LET tag              = 1, 
    number           = 3,
    delimiter        = 6, 
    end of scan      = 7,
    max macro zeilen = 1000,
    max macros       = 200;

INT VAR index aktuelle macro zeile,
        type,
        anz zeilen in macro,
        anz macro zeilen,
        anz macros :: 0;

TEXT VAR symbol,
         fehlertext, 
         dummy,
         kommando,
         zeile;

BOOL VAR with parameters,
         macro end gewesen;

PROC init macros:
  IF NOT initialized (this packet)
    THEN ds := nilspace;
         macro table := ds;
         macros leeren
  FI.

macros leeren:
  anz macro zeilen := 0;
  anz macros := 0.
END PROC init macros;

PROC load macros (TEXT CONST fname):
  init macros;
  line;
  IF exists (fname)
    THEN f := sequential file (input, fname);
         forget (ds);
         ds := nilspace;
         macro table := ds;
         macros einlesen
    ELSE errorstop ("Datei existiert nicht")
  FI.

macros einlesen:
  macro end gewesen := TRUE;
  anz macros        := 0;
  anz macro zeilen  := 0;
  WHILE NOT eof (f) REP
    anz macro zeilen INCR 1;
    IF anz macro zeilen > max macro zeilen
      THEN errorstop ("Zu viele Zeilen (max.1000)") 
    FI;
    cout (anz macro zeilen);
    getline (f, zeile);
    IF zeile = ""
      THEN zeile := " "
    ELIF pos (zeile, "#*") > 0
      THEN macro name oder end vermerken
    FI;
    IF macro end gewesen AND zeile = " "
      THEN anz macro zeilen DECR 1
      ELSE macro table . macro zeilen [anz macro zeilen] := zeile
    FI
  END REP;
  anz macro zeilen INCR 1;
  macro table . macro zeilen [anz macro zeilen] := " "; 
  IF anz macros = 0
    THEN putline  ("Macros geleert")
  FI.

macro name oder end vermerken:
  INT CONST komm anfang :: pos (zeile, "#*") + 2,
            komm ende   :: pos (zeile, "#", komm anfang);
  IF komm anfang <> 3 OR hinter dem kommando steht noch was
    THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile");
  FI;
  kommando := subtext (zeile, komm anfang, komm ende -1); 
  scan (kommando); 
  next symbol (symbol, type); 
  IF type = tag 
    THEN macro namen aufnehmen
    ELSE errorstop ("kein Macroname nach #*") 
  FI; 
  next symbol (symbol, type);
  IF type >= end of scan 
    THEN macro table . anz parameter [anz macros] := 0; 
         LEAVE macro name oder end vermerken 
  ELIF symbol = "(" 
    THEN parameter aufsammeln;
    ELSE errorstop ("keine ( nach Macro-Name") 
  FI.
 
macro namen aufnehmen:
  IF symbol = "macroend"
    THEN put ("mit"); put (macro table . anz parameter [anz macros]);
         put ("Parameter(n) geladen"); 
         macro end gewesen := TRUE;
         line;
         LEAVE macro name oder end vermerken
  ELIF NOT macro end gewesen
    THEN errorstop ("macro end fehlt")
    ELSE macro end gewesen := FALSE;
         anz macros INCR 1; 
         IF anz macros > max macros 
           THEN errorstop ("Zu viele Macros (max. 200") 
         FI;
         macro table . macro namen [anz macros] := symbol;
         macro table . macro start [anz macros] := anz macro zeilen;
         line;
         put (symbol);
  FI.

hinter dem kommando steht noch was:
  NOT (komm ende = length (zeile) COR
    (komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")).
 
parameter aufsammeln: 
  INT VAR parameter number :: 1;
  next symbol (symbol, type); 
  WHILE symbol = "$" REP 
    next symbol (symbol, type); 
    IF type = number CAND int (symbol) = parameter number 
      THEN IF parameter number > 9
             THEN errorstop ("Anzahl Parameter > 9")
           FI;
           macro table . anz parameter [anz macros] := parameter number; 
           parameter number INCR 1; 
      ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol)
    FI;  
    next symbol (symbol, type); 
    IF symbol = ")" 
      THEN LEAVE parameter aufsammeln 
    ELIF symbol = "," 
      THEN next symbol (symbol, type) 
      ELSE errorstop (", oder ) erwartet:" + symbol) 
    FI 
  END REP;
  errorstop ("Parameterliste inkorrekt bei" + symbol).
END PROC load macros;

PROC load macros: 
  load macros (last param)
END PROC load macros;

PROC list macros:
  init macros;
  note ("");
  INT VAR i := 1;
  WHILE i <= anz macro zeilen REP
    cout (i);
    note (macro table . macro zeilen [i]);
    note line;
    i INCR 1
  END REP;
  note edit
END PROC list macros;

BOOL PROC macro exists (TEXT CONST name, INT VAR anz params):
  INT VAR i;
  FOR i FROM 1 UPTO anz macros REP
    IF macro table . macro namen [i] = name
      THEN anz params := macro table . anz parameter [i]; 
           index aktuelle macro zeile := macro table . macro start [i] + 1;
           berechne anzahl zeilen in macro;
           IF anz params = 0 
             THEN with parameters := FALSE 
             ELSE with parameters := TRUE;
                  lade macro in replacement store;
                  index aktuelle macro zeile := 1;
           FI;
           LEAVE macro exists WITH TRUE
    FI
  END REP;
  FALSE.
 
berechne anzahl zeilen in macro: 
  IF i = anz macros 
    THEN anz zeilen in macro := 
           anz macro zeilen - index aktuelle macro zeile; 
    ELSE anz zeilen in macro := 
           macro table . macro start [i + 1] - index aktuelle macro zeile 
  FI.
 
lade macro in replacement store: 
  INT VAR k; 
  FOR k FROM 1 UPTO anz zeilen in macro REP 
    macro table . replacement store [k] := 
          macro table . macro zeilen [index aktuelle macro zeile +k-1]
  END REP. 
END PROC macro exists;

PROC replace macro parameter (INT CONST number, TEXT CONST param): 
  TEXT VAR param text := "$" + text (number); 
  INT VAR k; 
  FOR k FROM 1 UPTO anz zeilen in macro - 1 REP 
    change all (macro table . replacement store [k], param text, param); 
  END REP 
END PROC replace macro parameter; 
 
BOOL PROC macro command and then process parameters (TEXT VAR komm):
  init macros;
  LET tag = 1;
  scan (komm); 
  next symbol (symbol, type); 
  IF type = tag  
    THEN untersuche ob deklariertes macro 
    ELSE FALSE 
  FI. 
 
untersuche ob deklariertes macro: 
  INT VAR anz macro params; 
  IF macro exists (symbol, anz macro params) 
    THEN fehlertext := "in Makro: "; fehlertext CAT symbol;
         IF anz macro params > 0 
           THEN macro parameter ersetzen
         FI;
         TRUE 
    ELSE FALSE 
  FI. 
 
macro parameter ersetzen:
  next symbol (symbol, type); 
  IF symbol = "(" 
    THEN ersetze 
    ELSE report text processing error (34, 0, dummy, symbol + fehlertext); 
         LEAVE macro command and then process parameters WITH FALSE 
  FI.
 
ersetze: 
  LET text type = 4,
      end of scan = 7;
  INT VAR number parameter :: 1;
  REP  
    next symbol (symbol, type);  
    IF type = texttype 
      THEN replace macro parameter (number parameter, symbol);
      ELSE report text processing error (35, 0, dummy, fehlertext + symbol); 
           LEAVE macro command and then process parameters WITH FALSE 
    FI; 
    number parameter INCR 1; 
    IF number parameter > anz macro params 
      THEN LEAVE macro command and then process parameters WITH TRUE 
    FI; 
    next symbol (symbol, type); 
    IF symbol <> "," OR type >= end of scan
      THEN report text processing error (36, 0, dummy, fehlertext + symbol); 
           LEAVE macro command and then process parameters WITH FALSE 
    FI 
  END REP.
END PROC macro command and then process parameters;
 
PROC get macro line (TEXT VAR macro zeile):
  IF index aktuelle macro zeile > anz zeilen in macro
    THEN macro zeile := "#### "
  ELIF with parameters 
    THEN macro zeile :=
           macro table . replacement store [index aktuelle macro zeile]
    ELSE macro zeile := 
           macro table . macro zeilen [index aktuelle macro zeile] 
  FI; 
  index aktuelle macro zeile INCR 1; 
END PROC get macro line;
 
INT PROC number macro lines: 
  anz zeilen in macro
END PROC number macro lines; 
END PACKET macro store;