PACKET io handling DEFINES error listing, err, message, errors, init errors,
                           text, kill, trunc, hash, no errors :
(* Autor : R. Keil, Version vom 22.07.83, Änderung: C. Szymanski, 21.07.88 *)

LET errmax        = 67,
    max hash size = 300;
 
ROW errmax TEXT VAR error;
FILE VAR listfile;                    (* -> VERSION 3.2  *)
BOOL VAR list;
INT VAR errorno, i;
 
PROC init errors (TEXT CONST fname) :
 FILE VAR errorfile := sequential file (input, fname);
 TEXT VAR buffer;
 FOR i FROM 1 UPTO errmax WHILE NOT eof (errorfile) REP
  getline (errorfile, buffer);
  error (i) := buffer
 END REP
END PROC init errors;
 
PROC init errors :
  errorno := 0
END PROC init errors;
 
PROC error listing (TEXT CONST listname) :
 list := listname <> "nolist";
 IF list
  THEN kill (listname);
       listfile := sequential file (output, listname)
 FI
END PROC error listing;
 
INT PROC errors :
 error no
END PROC errors;
 
PROC err (TEXT CONST s, INT CONST m, line no) :
 message ("Fehler in Zeile " + text (line no) + " bei >>" + s + "<< : "
          + error (m));
 errorno INCR 1
END PROC err;
 
BOOL PROC no errors :
 IF errors = 0
  THEN TRUE
  ELSE display (text (error no) + " Fehler gefunden"13""10""); FALSE
 FI
END PROC no errors;

PROC message (TEXT CONST m) :
 IF list
  THEN putline (list file, m);
 FI;
 note (m);                             (* C.S. 21.07.88 *)
 note line;
 display (m);
 display (""13""10"")
END PROC message;
 
TEXT PROC text (BOOL CONST b) :
 IF b
  THEN "TRUE"
  ELSE "FALSE"
 FI
END PROC text;
 
PROC kill (TEXT CONST file name) :
 command dialogue (FALSE);
 forget (file name);
 command dialogue (TRUE)
END PROC kill;
 
TEXT PROC trunc (TEXT CONST t) :
 text (t, length (t) - 2)
END PROC trunc;
 
INT PROC hash (TEXT CONST word) :
 INT VAR qs := 0;
 FOR i FROM 1 UPTO length (word) REP
  qs INCR code (word SUB i)
 END REP;
 (qs MOD max hash size) + 1.
END PROC hash
 
END PACKET io handling;
 
 
(************************* S C A N N E R **************************)
 
PACKET scan DEFINES next sym, scanner, scanpos :
 
 
LET bold      = 1,          (* Autor : R. Keil, T. Froehlich *)
    number    = 2,          (* Version vom 04.07.83 *)
    delimiter = 3,
    eol       = 4;
 
TEXT VAR main buf, sym;
INT  VAR position, type, cc, begin pos;
 
PROC nextsym (TEXT CONST buf, TEXT VAR scan sym,
              INT VAR scan type, pos) :
 TEXT VAR char := buf SUB pos;
 cc := code (char);
 IF (cc >= 97 AND cc <= 122)
  THEN process lower case
 ELIF cc = 46 OR is int
  THEN process real
 ELIF (cc >= 65 AND cc <= 90)
  THEN process upper case
  ELSE process delimiter
 FI.
 
 process upper case :
  scan type := bold;
  scan sym  := low;
  next char;
  WHILE (cc >= 65 AND cc <= 90) OR is int REP
   scan sym CAT low;
   next char
  END REP.
 
 process lower case :
  scan type := bold;
  begin pos := pos;
  REP
   next char
  UNTIL lower case char AND NOT is int END REP;
  scan sym := subtext (buf, begin pos, pos - 1).
 
 lower case char :
  cc < 97 OR cc > 122.

 process real :
  process base;
  process exponent;
  scan type := number.
 
 process base :
  IF cc = 46
   THEN next char;
        IF is int
         THEN scan sym := "0.";
              process int
         ELSE scan type := delimiter;
              scan sym := ".";
              LEAVE process real
        FI
   ELSE scan sym := "";
        process int;
        IF cc = 46
         THEN scan sym CAT char;
              next char;
              IF is int
               THEN process int
               ELSE scan sym CAT "0"
              FI
         ELSE scan sym CAT ".0"
        FI
  FI.
 
 process exponent :
  IF cc = 69 OR cc = 101
   THEN scan sym CAT "e";
        next char;
        IF cc = 43 OR cc = 45
         THEN scan sym CAT char; next char
        FI;
        IF is int
         THEN process int
         ELSE err (char, 63, 0)
        FI
  FI.
 
 process int :
  WHILE is int REP
   scan sym CAT char;
   next char
  END REP.
 
is int :
 cc >= 48 AND cc <= 57.
 
 process delimiter :
  IF cc = -1
   THEN scan sym := "EOL"; scan type := eol
   ELSE scan type := delimiter;
        scan sym := char
  FI;
  pos INCR 1.
 
 next char :
  pos INCR 1; char := buf SUB pos; cc := code (char).
 
 low :
  IF cc >= 65 AND cc <= 90
   THEN code (cc + 32)
   ELSE char
  FI.
END PROC next sym;
 
PROC scanner (TEXT CONST buf) :
  main buf := buf; position := 1
END PROC scanner;
 
PROC next sym (TEXT VAR sym, INT VAR type) :
  next sym (main buf, sym, type, position)
END PROC next sym;
 
INT PROC scanpos :
 position
END PROC scanpos
 
END PACKET scan