Compiler selbstgeschneidert

Teil 2: Der Scanner

Helmut Richter

Bescheidenheit ist nicht gerade eine Zier dieser Serie. Immerhin wird hier ein Compiler für die Programmiersprache DOIT beschrieben, und zwar in allen Einzelheiten. Dadurch kann man nicht nur die Arbeitsweise des Compilers verstehen, sondern ihn auch in weiten Grenzen an eigene Wünsche anpassen. Sie kennen DOIT nicht? Dann haben Sie den ersten Teil dieser SErie nicht gelesen. Diesmal geht es bereits um den Scanner des DOIT-Compilers, der als Turbo-Pascal-Programm auch ohne die übrigen Compiler-Teile funktioniert und mit dem DOIT-Programme analysiert werden können — und zwar lexikalisch.

Der DOIT-Compiler arbeitet nach dem Prinzip der syntaxgesteuerten Einphasenübersetzung, was nichts anderes bedeutet, als daß der Übersetzungsvorgang in einem Rutsch erfolgt und vom Parser gesteuert wird. Aber das stand ja bereits alles im ersten Teil. Jedenfalls kommt dieses Konzept sehr dem Ziel entgegen, den Scanner als weitgehend selbstständiges Unterprogramm zu schreiben, das auch 'stand alone' lauffähig ist und später einfach mit dem Parser kombiniert werden kann.

Der Scanner mit Namen GETSYM besitzt zudem in der hier beschriebenen Fassung zusätzliche Prozeduren, um ihn mit Programmen füttern und testen zu können. Sie können entweder als Datei von der Diskette eingelesen werden oder vom Terminal aus zeilenweise eingegeben werden. In beiden Fällen gibt der 'stand-alone-Scanner' alle erkannten Informationen, die er später an den Parser weiterreicht, auf dem Schurm aus. Diese Funktion ist natürlich auch zum Austesten des kompletten Compilers nützlich und läßt aich danach leicht entfernen. Doch nun zum Scanner selbst.

Seine Aufgabe ist es, den Quelltext in einen Strom von Grundsymbolen (Token) der Sprache DOIT zu zerlegen und die erkannten Token an den Parser hinaufzureichen. Dazu liest er den Quelltext sequentiell, also Zeichen für Zeichen, und verzweigt entsprechend den angetroffenen Zeichen. Es gibt Grundsymnole für Identifier, Integer-, Hex- und Character-Konstanten, Operatoren und Sonderzeichen. Die Menge der Grundsymbole wird im Aufzählungstyp symbol festgelegt, und das erkannte Token speichert die Variable SYM vom Typ symbol.

Wurde ein Identifier erkannt, muß zusätzlich geprüft werden, ob es sich um ein reserviertes Wort handelt (BEGIN, DO, OD, EXIT,...) oder ob der Identifier eine Konstante ist. Im ersten Fall gibt GETSYM das entsprechende Symbol zurück (BEGINsy, DOsy, ODsy,...). Es ist kein spezielles Symbol für Prozedurnamen vorgesehen. Somit kann erst der Parser anhand der Symboltabelle entscheiden, ob ein Identifier vielleicht einen Prozeduraufruf darstellt. Ebenso gibt es bei den Operatoren verschiedene Fälle, (:=. >, <,...), die gesondert untersucht werden (becomes, gtr, lss,...).

Symbole mit einer Länge von einem Zeichen können sofort identifiziert werden, bei mehrstelligen Symbolen wird erst einmal in Unterprogramme verzweigt. Findet GETSYM am Anfang eines Symbol-Holzyklus einen Buchstaben (etwa 'A'), so kann das Token nur ein Identifier sein. Ist das erste neue Symbol ein '<'. so kann es ein Kleinerzeichen (lss), ein Kleinergleichzeichen (leq) oder ein Ungleichheitszeichen (neq) sein. Der Scanner kann auch bereits eine erste Fehlererkennung (-behandlung) vornehmen, beispielsweise die Erkennung einer falschen Characterkonstanten oder einer zu großen Zahl. Falls gewünscht kann er außerdem das Erzeugen einer List-Datei übernehmen.

Im Detail

Das Scanner-Modul besteht aus drei Teilen, die wiederum von folgenden Unterprogrammen gebildet werden:

1. FUELLEPUFFER, HOLEZEICHEN, GETCH.
Diese Routinen lesen den Quelltext und stellen das nächste gültige Zeichen bereit.

2. GETIDENTIFIER, GETNUMBER, HEXAWERTE, KOMMENTAR.
Diese Prozeduren identifizieren und bearbeiten Symbole, die länger als ein Zeichen sind, wie zum Beispiel Identifier, Konstanten und Kommentare.

3. ZEIGESATZ, SYMNAME, PROMPT, DISPLAY.
Sie können später aus dem Scanner entfernt werden, um die Compiler-Größe zu reduzieren, da sie lediglich Testoptionen wie Ausdrucke und Dialoge bereitstellen.

   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)

Dies ist die Menge der Grundsymbole der Sprache DOIT, die vom Scanner erkannt werden müssen. Die Reihenfolge, in der sie in der Definition als Aufzählungstyps symbol aufgeführt sind, erleichtert die Fehlerbehandlung.

Besondere Sorgfalt ist dem Bindeglied zwischen dem Quelltext (dem Programm) und der eigentlichen Symbolerkennung zu widmen, der Prozedur GETCH. Sie liefert das nächste Zeichen des zu analysierenden Textes mit Hilfe von HOLEZEICHEN in der Variablen CH. Das Flag LESEN hat dabei die Aufgabe, das Überlesen von Zeichen zu verhindern. Bei der Bearbeitung von Symbolen, die länger als ein Zeichen sind, kann nämlich der Fall auftreten, daß CH bereits das nächste Zeichen enthält und HOLEZEICHEN deswegen nicht aufgerufen werden darf, wie folgendes Beispiel zeigt.

Bei der Zuweisung 'XB1 := 6;' erkennt die Prozedur SCANNER den Identifier XB1 am Anfangszeichen 'X' und ruft die Prozedur GETIDENTIFIER auf. Sie addiert nun so lange die folgenden Zeichen zum Namen des Bezeichners, bis CH die Menge der in Identifier erlaubten Zeichen (IdCharacter) verläßt. CH=':' zeigt also das Ende des Namens and und SYM=identifier wird gemeldet. Beim nächsten Aufruf verzweigt der Scanner zunächst wieder zu GETCH. Würde nun tatsächlich ein weiteres Zeichen gelesen, so enthielte CH ein '=' statt des ':', und statt der Zuweisung würde ein Vergleich erkannt.

Um nicht ständig zeichenweise auf den Quelltext zugreifen zu müssen, benutzt GETCH einen Zeichenpuffer mit Namen SATZ, der eine ganze Programmzeile enthält. Es könnten auch zwei oder zehn Zeilen sein, reine Willkür. Jedesmal, wenn GETCH ein Zeichen dem Puffer entnimmt, wird der Zählindex ICHAR des Puffers erhöht. Ist das Pufferende erreicht, erkennbar durch ICHAR = SATZENDE (=LENGTH(Satz)), lädt FUELLEPUFFER einen neuen Satz.

Die Prüfung der Gültigkeit des neuen Zeichens in HOLEZEICHEN geschieht mit

(ORD(CH) > 31) OR
(CH = CPMeof);

Es werden also alle nicht druckbaren Steuerzeichen unterhalb des Blanks, das den Dezimalwert 32 hat, überlesen, mit Ausnahme des Zeichens für das Textende. Zu den überlesenen Zeichen gehören also auch LF und CR.

Groß und klein

Als letzte Aktion vewandelt GETCH alle Buchstaben mittels der Standardprozedur UPCase in Großbuchstaben. Somit wird es gleichgültig, ob Identifier groß oder klein geschrieben werden. Wünscht man eine Unterscheidung zwischen Groß- und Kleinschrift (etwa wie in Modula-2 oder ELAN), so braucht nir dieses eine Konvertierungsstament weggelassen zu werden. Dies ist einerseits eine syntaktische Einschränkung: reservierte Wörter können nur erkannt werden, wenn sie groß geschrieben sind. Andererseits entsteht auch eine syntaktische Erweiterung. 'Begin' ist kein reserviertes Wort mehr, sondern ein Identifier. Es ist ein Charakteristikum solcher Entwurfsentscheidungen, daß einfache Programmänderungen weitreichende syntaktische Auswirkungen nach sich ziehen können. Es ist jedem selbst überlassen, wie er sich entscheidet. Wählt man die Kleinschreibung, sollte man bereits beim Schreiben von Testprogrammen daran denken.

Wenn der Quelltext als fortlaufender Zeichenstrom verstanden wird, dürfen die Zeilenendezeichen CR und LF nicht als Trennzeichen beachtet werden. Das kann aber bei folgendem Programmteil zu fehlerhaftem Verhalten führen:

BEGIN <CR> <LF>
X:=X+6;<CR> <LF>

Der Scanner liest 'BEGIN', was für ihn zunächst einmal einen Identifier darstellt, überliest das Zeilenende und findet ein weiteres Zeichen. Somit erkennt er den Identifier BEGINX statt des reservierten Wortes BEGIN. Das unsichtbare Trennzeichen 'Zeilenende' muß also erkannt werden.

Eine Lösung wäre die Verwendung einer logischen Variablen, beispielsweise EOLN2, die bei jedem Aufruf von FUELLEPUFFER auf true gesetzt wird und so das erreichte Zeilenende anzeigt. Die hier benutzte Lösung ist, in FUELLEPUFFER an die gelesene Zeile (SATZ) ein Blank anzuhängen. Die damit verbundene semantische Einschränkung, daß kein Symbol über das Zeilenende hinausgehen darf, stört in der Praxis wegen der Zeilenlänge von 254 Zeichen nicht und befreit uns von diesem lästigen Problem.

In der Case-Anweisung der Prozedur Scanner ist erkennbar, daß füe alle Symbole, die länger als ein Zeichen sind, eigene Unterprogramme vorhanden sind. Sie werden nun der Reihe nach vorgestellt.

PROCEDURE Scanner;
   ... lokale Deklarationen ...
BEGIN
  REPEAT
    sym := Null;
    Nochmal := FALSE;
    GetCh;
(* an dieser Stelle alle Blanks ueberlesen *)
    WHILE ch = ' ' DO getch;
    CASE ch OF
(* Symbole, die laenger als ein Byte sein koennen: *)
      'A'..'Z' : GetIdentifier;
      '0'..'9' : getnumber;
      ''''     : CharacterKonstante;
      '$'      : HexaWerte;
      '('      : KlammerAuf;
      '>'      : Groesser;
      '<'      : Kleiner;
      ':'      : DoppelPunkt;
(* Symbole mit einem Byte sein Laenge: *)
      '!'      : 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 *);

Der Scanner besteht fast ausschließlich aus einem Case-Statement, in dem entsprechend zum gelesenen Zeichen zu bestimmten Unterprogrammen verzweigt wird. Nur bei Symbolen, die nur aus einem Zeichen bestehen, kann SYM sofort belegt werden.

Blick von oben in den Scanner

Ist das erste Zeichen eines neuen Symbols ein Buchstabe, so überprüft GETIDENTIFIER ob es sich um ein reserviertes Wort (Schlüsselwort) oder einen Identifier handelt. Dazu wird die Schlüsselworttabelle (SWT) des Scanners durchsucht und im Falle des Erfolges die Symbolvariable SYM durch eine explizite Typzuweisung (kein Standard-Pascal) belegt. Dazu enthält die Schlüsselworttabelle in SWT[k].NR die Position des Symbols im Aufzählungstyp symbol. Ist die Suche in der Schlüsselworttabelle erfolglos, handelt es sich um einen Identifier.

  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;
  ... usw ... (siehe INITSCANNER)


TYPE symbol = ( ...
       CHARsy, semicolon, period, eofsy,
       MODULEsy, Identifier, BEGINsy, CONSTsy,
       VARsy, PROCsy, DOsy, IFsy, EXITsy, ...);

Die Schlüsselworttabelle enthält in der Komponente SWT[k].NR die Position des Schlüsselwortes im Aufzählungstyp symbol.

Ist das erste Zeichen eines neuen Symbols eine Ziffer, überprüft GETNUMBER, ob es sich um eine maximal fünfstellige Zahl handelt und ob sie in eine gültige Integerzahl umgewandelt werden kann.

Die Prozedur HexaWert und HexWert wandeln eine Ein-Byte-Hexzahl in einen Character um, belegen SYM mit HexCon und behandeln eventuelle Fehler. Sie geben den errechneten Wert der Konstanten in CharVal zurück.

Liegt eine '(' vor, kann es sich um einen Kommentar handeln, der ignoriert wird, oder um eine 'Klammer auf' handeln. Dies tritt zunächst nur in Rechenausdrücken (Expressions) auf. Untersucht wird dies in KLAMMERAUF. Ähnliche Unterscheidungen bei arithmetischen Operatoren geschehen in den Unterprogrammen GROESSER, KLEINER und GLEICH.

Wählt man für die Zuweisungen ':=' statt '=', so läßt sich stets schon auf Scanner-Ebene eindeutig entscheiden, ob Zuweisungen oder Vergleiche gemeint sind. Im Gegensatz zu Pascal und DOIT ist das in BASIC und FORTRAN nicht möglich. Das Unterprogramm DOPPELPUNKT erfüllt diese Aufgabe.

Die Bearbeitung all dieser 'Problemchen' in eigenen Prozeduren ist vielleicht übertrieben, erhöht jedoch die Lesbarkeit des Scanners.

Conditional Compiling

Mit der Bearbeitung aller im Scanner nicht ausdrücklich geprüfter Zeichen ('null'-Symbole) in der Prozedur SONDERZEICHEN kann man sich auf einfache Weise eine Hintertür aufhalten. Bis auf ':' landen hier alle Nullsymbole. Somit besteht die Möglichkeit, Compiler-Optionen nach Art der Pseudo-Ops bei Assemblern zu realisieren:

&G- : keinen Code generieren
&L- : Listing aus
&L+ : Listing ein
&IF <Konstante:Character>
... Codegenerierung abhängig von der logischen Konstanten
...
&ENDIF
und so weiter...

Die letzte Anweisung erlaubt es, im Quelltext Testoptionen durch Belegung einer einzigen Konstanten zu aktivieren oder auszuschalten. Dadurch wird der Objektcode des ferigen Programms nicht mit Testhilfen belastet. Andererseits ist es möglich, mit einer einzigen neuen Übersetzung alle zusätzlichen Hilfen zur Verfügung zu haben. Conditional Compiling läßt sich leicht in den Scanner einfügen, kann aber erst funktionieren, wenn der Parser schon die Symboltabelle aufgebaut hat.

PROCEDUR Sonderzeichen;

VAR TabellenPos : ObjPtr;
BEGIN
  IF ch = '&' THEN BEGIN

(*  Feststellen, welche Option vorliegt, d.h.
    einen "Identifier" lesen *)

    GetCh;
    GetIdentifier;

(*  hier enth{lt ch = Blank oder (+/-), je nach
    obiger Optionenliste!  *

    IF idname = 'IF' THEN BEGIN

(*    Conditional Compiling *)
(*    Konstantenname lesen   *)

      WHILE ch = ' ' DO GetCh;
      GetIdentifier;

(*    Leider steht in DOIT noch kein Typ BOOLEAN
      zur Verf}gung, er mu~ daher mit einer
      Characterkonstanten simuliert werden.
      Der Wert der Characterkonstanten mu~ nun
      ermittelt werden. Dies geschieht, indem wir
      in der Symboltabelle den eingetragenen Wert
      nachschauen und pr}fen, ob er $FF (= FALSE)
      oder $00 (=TRUE) ist.                     *)

      TabellenPos := Find(idname);

(*    FIND liefert einen Zeiger auf den Eintrag
      in der Symboltabelle, falls der Identifier
      eingetragen ist, NIL sonst. Der Programmtext
      folgt sp{ter im PARSER                    *)

      IF TabellenPos = NIL THEN
        {{ Fehlermeldung}}
      ELSE BEGIN

(*      Pr}fen, ob Characterkonstante vorliegt. *)

        IF TabellenPos^.kind = Character THEN

(*        Wert der Schalterkonstanten suchen    *)

          IF TabellenPos^.CWert = CHR(255) THEN

(*          Schalterkonstante = FALSE           *)
(*          Ueberlese den Conditional-Teil      *)

            REPEAT
              REPEAT
                getch;
              UNTIL ch = '&';
              WHILE ch = ' ' DO Getch;
              Getidentifier;
            UNTIL idname = 'ENDIF';

(*        ein ELSE zu diesem Fall wird nicht
          ben|tigt. Der dem Conditional folgende
          Text soll ja mitverarbeitet werden    *)

        ELSE BEGIN

(*        der dem &IF folgende Identifier war
          keine Characterkonstante.             *)

          {{ Fehlermeldung }}
        END;
      END;
    ELSE IF Name = 'ENDIF' THEN BEGIN
      Nochmal := TRUE;
(*    Wort "einfach }bergehen".                 *)
    END;
  END (* IF ch = '&' *);
  idname := '';
END (* Sonderzeichen *);

[Listing]

Compiler nach Maß — falls Conditional Compiling, ähnlich wie bei größeren Assemblern, gewünscht ist, braucht nur diese Prozedur an Stelle des Unterprogramms SONDERZEICHEN im Listing des Scanners eingesetzt zu werden.

Die Prozeduren SYMNAME, PROMPT, DISPLAY, BYEBYE und ANALYSE dienen nur dem Zweck, den Vorgang der Analyse in der Testphase des Moduls SCANNER haarklein verfolgen zu können. Sie fliegen später genau wie das Hauptprogramm aus dem Compiler heraus.

Hat man das Testprogramm nach fingerverschleißendem Tippen auf Diskette, füge man noch das kleine Testprogramm dazu, lehne sich zurück und lasse den Scanner das DOIT-Programm im 'Single-Step' (Leertaste drücken) in seine Grundsymbole zerpflücken.

module test;
(* Testmodul für DOIT *)
VAR x  : INT;
VAR ch : CHAR;
(* Kleiner Operatorentest *)
       /#*+-=<>=<=>=
(* ganz schön haarig, nicht? *)
BEGIN
  IF i <> 6 THEN i = 6;
  x := y + 6;
  ? x;
  DO
    i := i + 1;
    IF i >= 10 THEN EXIT; FI;
  OD;
  ! x;
(* Kann er auch
   zwei-Zeilen-Kommentare? *)
END.

Diese kleine DOIT-Programm kann zum Testen des Scanners benutzt werden.

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.

[Listing]

Der Scanner ist in dieser Version 'stand alone' lauffähig und kann mit beliebigen DOIT-Programmen gefüttert werden. Alle erkannten Informationen, die er später an den Prser weiterreicht, werden auf dem Bildschirm ausgegeben.