PROGRAM Scanner (Input,Output,Source,List);

(* --------------------------------------------------------- *)
(*      Konstante des Scanners                               *)
(* --------------------------------------------------------- *)

CONST
     Identifierlaenge      = 28;
     AnzahlSchluesselworte = 18;
     esc          : CHAR = #$18;
     CR           : CHAR = #$0D;
     CtrlC        : CHAR = #$03;
     CPMeof       : CHAR = #$1A;
     liston       : BOOLEAN = FALSE;
     OnLine       : BOOLEAN = TRUE;
     idcharacters : SET OF CHAR = ['0'..'9','A'..'Z','_'];
     Characterset : SET OF CHAR = [#$1B, ' '..'z'];
     HexCharacter : SET OF CHAR = ['0'..'9','A'..'F'];

(* --------------------------------------------------------- *)
(*      Typen des Scanners                                   *)
(* --------------------------------------------------------- *)

TYPE
(*      Aufzaehlungstyp mit den Grundsymbolen.               *)
(*      Die RESERVIERTEN Worte sind GRO~ geschrieben.        *)

        symbol = (

(*                Symbole fuer Sonderzeichen, Operatoren und *)
(*                Ausdruecke:                                *)
                  null,       odd,        times,     divsy,
                  modsy,      plus,       minus,
                  eql,        neq,        lss,       leq,
                  gtr,        geq,
                  comma,      rparent,    THENsy,    lparent,
                  becomes,
(*                Symbole fuer die Konstanten:               *)
                  CharCon,    IntCon,     HexCon,
(*                Symbole, die am Ende eines Statements oder *)
(*                einer Deklaration stehen k|nnen:           *)
                  ELSEsy,     ENDsy,      FIsy,
                  ODsy,       INTsy,      CHARsy,    semicolon,
                  period,     eofsy,
(*                Symbole, die am Anfang eines Statements    *)
(*                oder einer Deklaration stehen k|nnen:      *)
                  MODULEsy,   Identifier, BEGINsy,   CONSTsy,
                  VARsy,      PROCsy,     DOsy,      IFsy,
                  EXITsy,     USEsy,      READsy,    WRITEsy);

        T_Name = STRING[Identifierlaenge];
                 (* Typ der Variablen- (Identifier-) Namen *)

        STR255 = STRING[255];
        Cardinal = 0..MAXINT;

(* --------------------------------------------------------- *)
(*      Variable des Scanners                                *)
(* --------------------------------------------------------- *)

VAR
    SwT           : ARRAY [1..AnzahlSchluesselworte] OF
                      RECORD
                        s  : T_Name;
                        Nr : INTEGER;
                      END;
                    (* Schluesselworttabelle *)

    sym           : Symbol;
                    (* sym gibt das Ergebnis der lexicali-
                       schen Analyse an den Parser           *)

    idname        : T_Name;
                    (* Name des Identifiers                  *)

    source, list  : TEXT;
                    (* Quell- und Listdatei                  *)

    intval,         (* Wert einer vorgefundenen Integer-
                       konstante                             *)

    ichar,          (* Zaehler fuer die Arbeitsposition
                       im Eingabepuffers                     *)

    SatzEnde,       (* Zeiger auf das letzte Zeichen des
                       Eingabepuffers                        *)

    errcount        (* Anzahl der Fehler                     *)
                  : INTEGER;

    Charval,        (* Wert einer vorgefundenen Character-
                       konstante                             *)

    ch,             (* zu bearbeitendes Zeichen              *)
    ctrl            (* Controlcharacter                      *)
                  : CHAR;

    Satz          : STRING[255];  (* Eingabepuffer           *)

    lesen, Nochmal, noerr, NoCode, LiesCrt, Neu
                  : BOOLEAN;

(* --------------------------------------------------------- *)
(*      Prozeduren und Funktionen des Scanners               *)
(* --------------------------------------------------------- *)

PROCEDURE Markiere(n:Cardinal);
(* Markiert Fehler im Quelltext                              *)
VAR i : INTEGER;
BEGIN
  WRITELN(Satz);
  FOR i := 1 TO ichar - 1 DO WRITE ('.');
  WRITELN('^');
END (* Markiere *);

PROCEDURE Error(n:Cardinal;x:STR255);
(* Meldet erkannte Fehler und sperrt die Flags NOERR         *)
(* und NOCODE.                                               *)
BEGIN
  noerr  := FALSE;
  NoCode := TRUE;
  Markiere(n);
  WRITELN(x);
  WRITELN('Fehler Nummer ',n:3);
  errcount := errcount + 1;
  IF errcount > 38 THEN BEGIN
     WRITELN('mehr als 38 B|cke - Notbremse');
     HALT;
  END;
END (* Error *);

PROCEDURE ZeigeSatz;
(* Schreibt den von Diskette gelesenen Satz auf Bildschirm   *)
(* und evtl. auf die Listdatei.                              *)
BEGIN
  WRITELN; WRITELN(Satz); WRITELN;
  WRITELN('--------------------------------');
  IF liston THEN
     BEGIN
       WRITELN(List); WRITELN(List,Satz); WRITELN(List);
       WRITELN(List,'--------------------------------');
     END;
END (* ZeigeSatz *);

PROCEDURE LesCRT;
(* Fuellt Puffer vom Terminal                                *)
VAR ch : CHAR;
BEGIN
  WRITELN;
  WRITELN('Satz eingeben - Ende durch (ESC)');
  WRITELN;
  Satz := '';
  REPEAT
    READ (KBD,ch); WRITE(ch);
    IF ch IN Characterset THEN Satz := Satz + ch;
  UNTIL (ch = CR) OR (ch = Esc);
  WRITELN;
  WRITELN(' -------------------------------');
END (* LesCRT *);

PROCEDURE FuellePuffer;
(* Fuellt den Zeichenpuffer "Satz" mit einer Zeile des       *)
(* Sourcetextes                                              *)
BEGIN
  IF NOT (LiesCrt) AND EOF(Source) THEN
     BEGIN
       Satz[1] := CPMeof ;
       Satz[0] := CHR (1);
       ichar := 1;
     END
  ELSE
    BEGIN
      IF LiesCrt THEN LesCRT ELSE READLN (Source,Satz);
      Satz := Satz + ' ';
      IF NOT (LiesCrt) AND (Online) THEN ZeigeSatz;
      SatzEnde := Length(Satz);
      ichar := 1;
    END;
END (* FuellePuffer *);

PROCEDURE HoleZeichen;
(* Holt gueltiges Zeichen aus dem Puffer "Satz" ab           *)
BEGIN
  REPEAT
    IF ichar > SatzEnde THEN FuellePuffer;
    ch := Satz[ichar];
    ichar := ichar + 1;
  UNTIL (ORD(ch) > 31) OR (ch = CPMeof) OR (ch = Esc);
  ch := UpCase(ch);
(*WRITELN('Holezeichen : ORD(ch) = ',ORD(ch));               *)
END (* HoleZeichen *);

PROCEDURE GetCh;
(* liest n{chstes Zeichen aus dem Quelltext                  *)
VAR i : INTEGER;
BEGIN
  IF lesen THEN
     BEGIN
       HoleZeichen;
(*     WRITELN('Getch : ch = ',ch, ' ORD(ch) = ',ORD(ch));   *)
     END
   ELSE
     (* lesen = false :                                      *)
     (* Wird ben|tigt, wenn das naechste Zeichen schon       *)
     (* im Scanner gelesen wurde. (Operatoren <=, etc).      *)
     lesen := TRUE;
END (* GetCh *);

PROCEDURE GetIdentifier;
(* Liest Identifier und tr{gt ihn in die Symboltabelle ein   *)
VAR i, j, k : INTEGER;
BEGIN
  (* Identifiername einlesen *)
  i := 0;
  idname := '';
  WHILE ch IN idcharacters DO
    BEGIN
      (* Der Identifier wird ganz gelesen, aber nur
          <Identifierlaenge> Zeichen werden gespeichert *)
      IF i < IdentifierLaenge + 1 THEN
         BEGIN
           i:=i+1;
           idname := Concat(idname,ch);
         END;
      getch;
    END;
    Writeln('GetIdentifier : Name = ',idname);
    lesen := FALSE;
    (* Identifier in der Schluesselwort Tabelle suchen       *)
    (* Suchverfahren nicht sequenziell (binaer)              *)
    i := 1;
    j := AnzahlSchluesselworte;
    REPEAT
      k := (i + j) DIV 2;
      IF idname <= SwT[k].s THEN j := k - 1;
      IF idname >= SwT[k].s THEN i := k + 1;
    UNTIL i > j;
    IF (i - 1) > j THEN
       BEGIN
         (* hier : explizite Typzuweisung    *)
         (* der Integerzahl SwT[k].Nr        *)
         (* nach dem Aufzaehlungstyp Symbol. *)
         (* (kein Standart-Pascal)           *)
         sym := SYMBOL (SwT[k].Nr);
       END
    ELSE
       sym := identifier;  (* Symbol festlegen *)
END (* GetIdentifier *);

PROCEDURE GetNumber;
(* liest Integerzahl als Ziffernfolge (max. 5 Ziffern) ein,  *)
(* gibt ihren Zahlenwert in INTVAL zurueck oder bemaengelt   *)
(* Fehler                                                    *)
VAR st : STRING[5];
    i  : INTEGER;
BEGIN
  sym := intcon;
  intval := 0;
  i := 0;
  REPEAT
    i := i + 1;
    IF i < 6 THEN st[i] := ch;
    GetCh;
  UNTIL NOT (ch IN ['0'..'9']);
  lesen := FALSE;
  IF i > 5 THEN
     BEGIN
       i := 5;
       Error(51,'Fehler in IntegerKonstante : mehr als 5 Ziffern');
     END;
  st[0] := CHR(i);
  VAL(st,intval,i);
  IF i <> 0 THEN Error(52,'Illegales Zeichen in Integerzahl');
END (* GetNumber *);

PROCEDURE CharacterKonstante;
(* Liest genau 1 Zeichen als CharacterKonstante ein und     *)
(* gibt den Wert (das Zeichen) in CHARVAL zurueck oder      *)
(* maengelt Fehler.                                         *)
(* Die Konstante darf nicht laenger als die Zeile sein.     *)
BEGIN
  sym := Charcon;
  GetCh;
  IF ch IN CharacterSet THEN
     Charval := ch
  ELSE
     Error(53,'Fehler in Characterkonstante');
  GetCh;
  IF ch <> '''' THEN BEGIN
     Error(54,'Hochkomma erwartet');
     (* "Falsches Zeilenende (Blank)" verwerfen,
         charval loeschen *)
     IF charval = ' ' THEN charval := CHR(0);
     lesen := FALSE;
  END;
END (* CharacterKonstante *);

FUNCTION HexWert(ch:CHAR;VAR Wert:INTEGER):BOOLEAN;
(* Pr}ft, ob das Zeichen ch eine hexadezimal Zahl ist       *)
(* (d.h.: in 0,..,9,A,..,F liegt) und gibt ggf. den Wert    *)
(* in WERT zur}ck.                                          *)
VAR i : INTEGER;
BEGIN
  Wert := 0;
  HexWert := FALSE;
  IF ch IN Hexcharacter THEN BEGIN
     HexWert := TRUE;
     i := ORD(ch);
     IF (47 < i) AND (i < 57) THEN
        Wert := i - 48
     ELSE IF (64 < i) AND (i < 71) THEN
        Wert := i - 55;
  END;
END (* HexWert *);

PROCEDURE HexaWerte;
(* Liest eine Zwei-Byte-Hexzahl ein und wandelt sie in einen *)
(* Character um.                                             *)
VAR HighByte, LowByte : INTEGER;
BEGIN
  sym      := Hexcon;
  Charval  := CHR(0);
  HighByte := 0;
  LowByte  := 0;
  GetCh;
  IF NOT HexWert(ch,HighByte) THEN BEGIN
     Error(55,'Fehler in Hexzahl : High Byte falsch');
  END;
  GetCh;
  IF HexWert(ch,LowByte) THEN
     Charval := CHR(HighByte * 16 + LowByte)
  ELSE BEGIN
     Error(56,'Fehler in Hexkonstante : Low Byte falsch');
     lesen := FALSE;
  END;
END (* HexaWerte *);

PROCEDURE Kommentar;
(* Verarbeitet Kommentare, indem er sie ueberliest.         *)
VAR exit : BOOLEAN;
BEGIN
  exit := FALSE;
  REPEAT
    REPEAT
      GetCh;
    UNTIL ch = '*';
    GetCh;
    exit := ch = ')';
  UNTIL exit;
  IF OnLine THEN WRITELN('***** Kommentar *****');
  Nochmal := TRUE;
END (* Kommentar *);

PROCEDURE KlammerAuf;
(* Entscheidet, ob Symbol LPARENT oder Kommentar vorliegt    *)
BEGIN
  GetCh;
  IF ch = '*' THEN
     Kommentar
  ELSE BEGIN
         sym := lparent;
         lesen := FALSE;
       END;
END (* KlammerAuf *);

PROCEDURE Groesser;
(* Entscheidet, ob der Operator ">" oder ">=" vorliegt       *)
BEGIN
  GetCh;
  IF ch = '=' THEN
     sym := geq
  ELSE BEGIN
         sym := gtr;
         lesen := FALSE;
       END;
END (* Groesser *);

PROCEDURE Kleiner;
(* Entscheidet, ob der Operator "<", "<>" oder "<=" ist      *)
BEGIN
  GetCh;
    IF ch = '=' THEN
       sym := leq
    ELSE IF ch = '>' THEN
            sym := neq
         ELSE BEGIN
                sym := lss;
                lesen := FALSE;
              END;
END (* Kleiner *);

PROCEDURE SonderZeichen;
(* Bearbeitet die Sonderzeichen.                             *)
(* Die explizite Zuweisung des Sonderzeichens an sym:        *)
(*      sym := Null                                          *)
(* kann entfallen, da bei Eintritt in den Scanner sym mit    *)
(*      Null initialisiert wird.                             *)
BEGIN
  IF OnLine THEN
     WRITELN('Sonderzeichen      ORD(ch) = ',INTEGER(ch):2);
     IF liston THEN
        WRITELN(List,'Sonderzeichen      ORD(ch) = ',ORD(ch):2);
END (* SonderZeichen *);

PROCEDURE DoppelPunkt;
(* Entscheidet, ob eine Zuweisung oder ein Doppelpunkt vor-  *)
(* vorliegt                                                  *)
VAR ch2, ch3 : CHAR;
BEGIN
   ch2 := ch;
   GetCh;
   IF ch = '=' THEN
      sym := becomes
   ELSE BEGIN
          lesen := FALSE;
          ch3 := ch;
          ch  := ch2;
          Sonderzeichen;
          ch  := ch3;
         END;
END (* DoppelPunkt *);

PROCEDURE InitScanner;
(* Initialisierung des Scanners, seiner Tabellen, der vari-  *)
(* ablen und Dateien                                         *)

   FUNCTION ParamCount:integer ;
   (* nur bei Turbo-Pascal 2.0 und 1.0 n|tig                 *)
   VAR b : byte absolute $80;
   BEGIN
     ParamCount:=0;
     IF b>0 THEN ParamCount:=1;
   END (* ParamCount *);

   FUNCTION ParamStr(i:integer):str255;
   (* nur bei Turbo-Pascal 2.0 und 3.0 n|tig                 *)
   VAR s : str255 absolute $80;
   BEGIN
     delete(s,1,1);
     ParamStr := s;
   END (* ParamStr *);

BEGIN (* InitScanner *)
  ch       := ' ';
  Ctrl     := ' ';
  sym      := Null;
  intval   := 0;
  Charval  := ' ';
  errcount := 0;
  Satz     := '';
  lesen    := TRUE;
  NoCode   := FALSE;
  LiesCrt  := FALSE;
  IF (ParamCount = 9) OR (Neu) THEN
     BEGIN
       (* Eingabemedium festlegen:                           *)
       WRITELN('Eingabe von Terminal (T) oder Datei (D)?');
       READ(KBD,ch);
       ch := UpCase(ch);
       LiesCrt := ch = 'T';
       IF LiesCrt THEN
          BEGIN
            WRITELN('Eingabe per Terminal.');
            WRITELN('Bearbeitung der Zeile nach <CR)');
            WRITELN;
          END
       ELSE BEGIN
          WRITELN('Eingabe von Datei.');
          WRITELN('Bitte Dateiname eingeben (Grossbuchstaben)');
          WRITELN('<CR> = TEST.SRC');
          READLN(Satz);
          IF Satz = '' THEN satz := 'TEST.SRC'
             ELSE satz := satz + '.SRC';
          ASSIGN(Source,Satz);
          RESET (Source);
       END (* IF LiesCrt *)
     END (* IF ParamCount = 8 *)
  ELSE BEGIN
     Satz := ParamStr(1) + '.SRC';
     ASSIGN(Source,Satz);
     RESET (Source);
  END;
  Satz := '';
  WRITELN('Nach jeder Analyse bitte Taste dr}cken');
  IF liston THEN BEGIN
     ASSIGN(list,'TEST.LST');
     REWRITE(list);
  END;
  Fuellepuffer;
  IF NOT (LiesCrt) AND (OnLine) THEN ZeigeSatz;
  SwT[ 1].s := 'BEGIN';   SwT[ 1].NR := 32;
  SwT[ 2].s := 'CHAR';    SwT[ 2].NR := 26;
  SwT[ 3].s := 'CONST';   SwT[ 3].NR := 33;
  SwT[ 4].s := 'DO';      SwT[ 4].NR := 36;
  SwT[ 5].s := 'ELSE';    SwT[ 5].NR := 21;
  SwT[ 6].s := 'END';     SwT[ 6].NR := 22;
  SwT[ 7].s := 'EXIT';    SwT[ 7].NR := 38;
  SwT[ 8].s := 'FI';      SwT[ 8].NR := 23;
  SwT[ 9].s := 'IF';      SwT[ 9].NR := 37;
  SwT[10].s := 'INT';     SwT[10].NR := 25;
  SwT[11].s := 'MODULE';  SwT[11].NR := 38;
  SwT[12].s := 'OD';      SwT[12].NR := 24;
  SwT[13].s := 'PROC';    SwT[13].NR := 35;
  SwT[14].s := 'READ';    SwT[14].NR := 48;
  SwT[15].s := 'THEN';    SwT[15].NR := 15;
  SwT[16].s := 'USE';     SwT[16].NR := 39;
  SwT[17].s := 'VAR';     SwT[17].NR := 34;
  SwT[18].s := 'WRITE';   SwT[18].NR := 41;
END (* InitScanner *);

PROCEDURE SymName(i:INTEGER);
(*      Diese Prozedur dient nur Testzwecken.                *)
(* Sie wird von PROMPT mit der Number des Symbols aufgeru-   *)
(* fen und schreibt den Namen des Symbols auf den Bild-      *)
(* schirm. Spaeter kann sie und PROMPT entfernt werden.      *)
CONST AnzKw = 41;
      kw : ARRAY[0..AnzKw] OF STRING[10] =
           ('null      ', 'odd       ', 'times    ',
            'divsy     ', 'modsy     ', 'plus     ',
            'minus     ', 'eql       ', 'neq      ',
            'lss       ', 'leg       ', 'gtr      ',
            'geq       ', 'comma     ', 'rparent  ',
            'THENsy    ', 'lparent   ', 'becomes  ',
            'CharCon   ', 'IntCon    ', 'HexCon   ',
            'ELSEsy    ', 'ENDsy     ', 'FIsy     ',
            'ODsy      ', 'INTsy     ', 'CHARsy   ',
            'semicolon ', 'period    ', 'eofsy    ',
            'MODULEsy  ', 'Identifier', 'BEGINsy  ',
            'CONSTsy   ', 'VARsy     ', 'PROCsy   ',
            'DOsy      ', 'IFsy      ', 'EXITsy   ',
            'USEsy     ', 'READsy    ', 'WRITEsy  ');
BEGIN
  WRITE ('sym = ');
    IF liston THEN
       BEGIN
         WRITELN(List);
         WRITE (List,'sym = ');
       END;
    IF i <= AnzKw THEN
       WRITE(kw[i])
    ELSE
       BEGIN
         WRITE ('**** Symnam : ORD(sy*) zu gro~ : Wert = ',i);
           IF liston THEN WRITE(list,'**** Symname : ORD(sy*) zu gro~ : Wert
= ',i);
       END;
    WRITE('   ORD(sy*) = ',i:2,'   ');
    IF liston THEN
       BEGIN
         WRITE(list,'   ORD(sy*) = ',i:2,'   ');
       END;
END (* SymName *);

PROCEDURE Display;
(* Begrue~ung                                                *)
BEGIN
  ClrScr;
  WRITELN('+---------------------------------------------------+');
  WRITELN('!                                                   !');
  WRITELN('!       Scanner gestartet - Text eingeben!          !');
  WRITELN('!             Ende durch <ESC>                      !');
  WRITELN('!                                                   !');
  WRITELN('+---------------------------------------------------+');
  WRITELN;
END (* Display *);

PROCEDURE ByeBye;
BEGIN
  ClrScr;
  WRITELN('------------------------------');
  WRITELN('>   EOF (Source) erreicht.   <');
  WRITELN('>                            <');
  WRITELN('>   Programm Scanner normal  <');
  WRITELN('>          beendet           <');
  WRITELN('------------------------------');
END (* ByeBye *);

PROCEDURE Prompt;
(*      Diese Prozedur dient nur Testzwecken.                *)
(* Sie wird vom vorlaeufigen Hauptprogramm des Scanners auf- *)
(* gerufen. Sie dient zur Verfolgung des Analyseprozesses..  *)
(* Spaeter kann sie entfernt werden.                         *)
BEGIN
  Symname(ORD(sym));
  IF sym = identifier THEN
     BEGIN
       WRITELN ('Name = ',idname);
       IF liston THEN WRITELN (list,'Name = ',idname)
     END
  ELSE IF (sym = intcon) THEN
     BEGIN
       WRITELN ('Wert = ',intval);
       IF liston THEN WRITELN (LIST,'Wert = ',intval);
     END
  ELSE IF sym = Charcon THEN
     BEGIN
       WRITELN('Wert = ',Charval:2,'   ASCII : ',ORD(Charval):2);
       IF liston THEN WRITELN (LIST,'Wert = ',Charval:2,'   ASCII :
',ORD(Charval):2);
     END
  ELSE IF sym = Hexcon THEN
     BEGIN
       WRITELN('Zeichen = ',Charval,'   Wert = ',ORD(Charval));
       IF liston THEN WRITELN (LIST,'Wert = ',Charval);
     END
  ELSE
     WRITELN;
     WRITELN ('--------------------------------');
     IF liston THEN
        BEGIN
          WRITELN(List);
          WRITELN(List,'--------------------------------');
        END;
END (* Prompt *);

PROCEDURE Scanner;
(* Dies ist der eigentliche Teil, in dem die lexikalische    *)
(* Analyse ablaeuft.                                         *)
VAR ch2            : CHAR;
    exit,bool,incl : BOOLEAN;
    chval,ch2val   : INTEGER;
    i,j,k          : INTEGER;
    istringval     : INTEGER;
BEGIN
  REPEAT
    sym := Null;
    Nochmal := FALSE;
    GetCh;
    WHILE ch = ' ' DO getch;
    CASE ch OF
         'A'..'Z' : GetIdentifier;
         '0'..'9' : getnumber;
         ''''     : CharacterKonstante;
         '$'      : HexaWerte;
         '('      : KlammerAuf;
         '>'      : Groesser;
         '<'      : Kleiner;
         ':'      : DoppelPunkt;
         '!'      : sym := WRITEsy;
         '?'      : sym := READsy;
         ')'      : sym := rparent;
         ';'      : sym := semicolon;
         '.'      : sym := period;
         ','      : sym := comma;
         '='      : sym := eql;
         '/'      : sym := divsy;
         '#'      : sym := modsy;
         '@'      : sym := odd;
         '*'      : sym := times;
         '+'      : sym := plus;
         '-'      : sym := minus;
         #$1A     : sym := eofsy;
    ELSE SonderZeichen;
    END (* Case *);
  UNTIL NOT Nochmal;
END (* Scanner *);

PROCEDURE GetSym;
(* Steuerroutine fuer die Prozedur SCANNER mit Dialogteil.   *)
(* Kann spaeter nach dem Einbau als Parserunterprogramm      *)
(* bei einer ent sprechenden Umbenennung von SCANNER weg-    *)
(* fallen.                                                   *)
BEGIN
  Scanner;
  IF OnLine THEN BEGIN
     Prompt;
     IF NOT LiesCrt THEN BEGIN
        READ (KBD,ctrl);
     END;
  END;
END (* Getsym *);

PROCEDURE Analyse;
(* Analyse erlaubt den mehrfachen Ansto~ des Scanners.       *)
(* Dies ist in der Testphase sehr brauchbar.                 *)
(* Kann nach der Testphase fuer den Scanner entfallen.       *)
BEGIN
  InitScanner;
  REPEAT
    GetSym;
  UNTIL (ch = CPMeof) OR (ch = Esc) OR (ctrl = Esc);
  WRITELN('Weitere Analyse (j/n)?');
  READ(KBD,Ch) ;
    Ch  := UpCase (Ch);
    neu := (ch <> 'N');
END (* Analyse *);

(* --------------------------------------------------------- *)
(*      Hauptprogramm des Scanners fuer den Testlauf.        *)
(* --------------------------------------------------------- *)

BEGIN
  neu := FALSE;
  REPEAT
    Display;
    Analyse;
  UNTIL ch IN ['N','n'];
  ByeBye;
END.