(*==========================================================================*)
(* Muster-Compiler fuer eine PASCAL-aehnliche Trivialsprache                *)
(*                                                                          *)
(* Lexikalische Analyse (Scanner)                                           *)
(*                                                                          *)
(*==========================================================================*)

unit SCANNER;

interface

  type
        STRING8     = STRING[8];                              (* fuer Namen *)

(****************************************************************************)
(*                        Token-Verschluesselungen                          *)
(****************************************************************************)

        SYMBOL = (

            DOPPELP,    (* :  *)
            MINUS,      (* -  *)
            PLUS,       (* +  *)
            MAL,        (* *  *)
            GETEILT,    (* /  *)
            KLEINER,    (* <  *)
            GROESSER,   (* >  *)
            GLEICH,     (* =  *)
            UNGLEICH,   (* !  *)
            DOPPGLEICH, (* := *)
            KL_AUF,     (* (  *)
            KL_ZU,      (* (  *)
            ECK_AUF,    (* [  *)
            ECK_ZU,     (* ]  *)
            SEMIKOLON,  (* ;  *)

            (* Schluesselwoerter *)

            PROGRAM_SYM,(* PROGRAM *)
            BEGIN_SYM,  (* BEGIN   *)
            END_SYM,    (* END     *)
            VAR_SYM,    (* VAR     *)
            INTEGER_SYM,(* INTEGER *)
            BOOLEAN_SYM,(* BOOLEAN *)
            OR_SYM,     (* OR      *)
            AND_SYM,    (* AND     *)
            IF_SYM,     (* IF      *)
            THEN_SYM,   (* THEN    *)
            ELSE_SYM,   (* ELSE    *)
            WHILE_SYM,  (* WHILE   *)
            DO_SYM,     (* DO      *)

        (* Pseudo-Terminalsymbole - erzeugt von lexikalischer und   *)
        (* syntaktischer Analyse                                    *)

            NEGATIV,    (* monadisches Minus       *)
            FALSCH,     (* falsches TOKEN          *)
            DATEI_ENDE, (* Dateiende               *)
            END_IF,     (* Ende der IF-Anweisung   *)
            END_WHILE,  (* Ende der WHILE-Anweisg. *)
            INDEX_SYM,  (* Zugriff auf Feldelement *)
            NAME,
            ZAHL
        );

(****************************************************************************)
(*        lesbare Token-Bezeichnungen (fr Fehlermeldungen)                 *)
(****************************************************************************)

  const
    LESBAR : array[DOPPELP..DO_SYM] OF STRING[7] = (
      '":"','"-"','"+"','"*"','"/"','"<"','">"','"="',
      '!"','":="','"("','"("','"["','"]"','";"',
      'PROGRAM','BEGIN','END','VAR','INTEGER','BOOLEAN','OR','AND',
      'IF','THEN','ELSE','WHILE','DO');

(****************************************************************************)
(*                        Namensbuch                                        *)
(****************************************************************************)

  const MAX_NAME = 100; (* maximal 100 verschiedene Namen *)

  type  NAMEN = 1..MAX_NAME;

  var

        NB          : array[NAMEN] of
                        record
                          NAME: STRING8;        (* lesbare Darstellung      *)
                          TYP: SYMBOL;          (* INTEGER | BOOLEAN        *)
                          DIMENSION: INTEGER    (* -1...nicht deklariert
                                                    0...einf. Variable
                                                    n...Feld der Laenge n   *)
                        end;

        LETZTER_NAME: INTEGER;     (* Index des Letzten Namens im NB *)

(****************************************************************************)
(*                        Token-Verschlsselung                             *)
(****************************************************************************)

  var   TOKEN : record                        (* aktuelles Terminalsymbol   *)
                  KEY      : SYMBOL;          (* Verschlsselung            *)
                  ATTR     : INTEGER;         (* Attribut:                  *)
                end;                          (*   Namensnummer bzw.        *)
                                              (*   Zahlenwert               *)
        QUELLE      : TEXT;                   (* Quellfile                  *)
        DATEINAME   : STRING[16];             (* Name der Quelldatei        *)

(****************************************************************************)
(*                        Scanner-Prozedur                                  *)
(****************************************************************************)

  procedure LEXIKALISCHE_ANALYSE;

(****************************************************************************)
(****************************************************************************)

implementation

(*                        Schluesselworttabelle                             *)

  const SW          : array[PROGRAM_SYM..DO_SYM] of STRING8 =
                      ('PROGRAM','BEGIN','END','VAR','INTEGER','BOOLEAN',
                       'OR','AND','IF','THEN','ELSE','WHILE','DO');

  var   ZEICHEN     : CHAR;           (* aktuelles Zeichen        *)
        ZEILE       : INTEGER;        (* Zeilennummer             *)

  procedure HOLE_ZEICHEN; forward;    (* nchstes Zeichen holen   *)
  procedure KONSTANTE;    forward;    (* Zahl analysieren         *)
  procedure NAME_ODER_SCHLUESSELWORT; (* Name oder SW analysieren *)
               forward;

(*--------------------------------------------------------------------------*)
(*--------------------------------------------------------------------------*)

  procedure LEXIKALISCHE_ANALYSE;
    begin
      TOKEN.ATTR:=1;                       (* Attribut vorbesetzen *)
      while ZEICHEN=' ' do HOLE_ZEICHEN;   (* Blanks ueberlesen    *)
      if ZEICHEN in ['A'..'Z']             (* wenn Buchstabe       *)
      then NAME_ODER_SCHLUESSELWORT
      else
        if ZEICHEN in ['0'..'9']           (* wenn Ziffer          *)
        then KONSTANTE
        else                               (* Sonderzeichen        *)
          begin
            case ZEICHEN of
              ':'     : begin
                          HOLE_ZEICHEN;
                          if ZEICHEN='='
                          then TOKEN.KEY:=DOPPGLEICH
                          else TOKEN.KEY:=DOPPELP
                        end;
              '-'     : TOKEN.KEY:=MINUS;
              '+'     : TOKEN.KEY:=PLUS;
              '*'     : TOKEN.KEY:=MAL;
              '/'     : TOKEN.KEY:=GETEILT;
              ';'     : TOKEN.KEY:=SEMIKOLON;
              '<'     : TOKEN.KEY:=KLEINER;
              '>'     : TOKEN.KEY:=GROESSER;
              '='     : TOKEN.KEY:=GLEICH;
              '!'     : TOKEN.KEY:=UNGLEICH;
              '('     : TOKEN.KEY:=KL_AUF;
              ')'     : TOKEN.KEY:=KL_ZU;
              '['     : TOKEN.KEY:=ECK_AUF;
              ']'     : TOKEN.KEY:=ECK_ZU;
              ^Z      : TOKEN.KEY:=DATEI_ENDE;
              else      TOKEN.KEY:=FALSCH;
            end;
            if TOKEN.KEY<>DOPPELP  (* im Fall ':' ist erstes Zeichen des    *)
                                   (* nchsten Tokens bereits eingelesen    *)
            then HOLE_ZEICHEN;     (* andernfalls naechstes Zeichen holen   *)
          end;
    end;

(*--------------------------------------------------------------------------*)
(*             naechstes Zeichen vom Eingabemedium lesen                    *)
(*             und auf Protokollmedium ausgeben                             *)
(*--------------------------------------------------------------------------*)

  procedure HOLE_ZEICHEN;
    begin
      if TOKEN.KEY<>DATEI_ENDE then
        begin
          if EOLN(QUELLE) then            (* wenn Zeilenende              *)
            begin
              ZEILE:=ZEILE+1;
              if EOF(QUELLE) then
                ZEICHEN:=^Z               (* ctrl-Z entspricht EOF        *)
              else
                begin
                  READLN(QUELLE);         (* Zeilenendezeichen berlesen  *)
                  ZEICHEN:=' ';           (* und als Blank abliefern      *)
                  WRITELN;
                  WRITE(ZEILE:3,'  ');    (* Zeilennummer fuer Listing    *)
                end;
            end
          else
            begin
              READ(QUELLE,ZEICHEN);       (* nchstes Zeichen lesen und   *)
              WRITE(ZEICHEN);             (* fr Listing ausgeben         *)
            end
        end
    end;

(*--------------------------------------------------------------------------*)
(*             Konstante analysieren und verschluesseln                     *)
(*--------------------------------------------------------------------------*)

  procedure KONSTANTE;
    begin
      with TOKEN do
        begin
          ATTR:=0;
          while ZEICHEN in ['0'..'9'] do   (* Zahlenwert durch wiederholte  *)
            begin                          (* Multiplikation mit 10 und     *)
                                           (* Addition der aktuellen Ziffer *)
              ATTR:=10*ATTR+ORD(ZEICHEN)-ORD('0');
              HOLE_ZEICHEN;
            end;
          KEY:=ZAHL;
        end
    end;

(*--------------------------------------------------------------------------*)
(*             Name oder Schluesselwort erkennen und verschluesseln         *)
(*--------------------------------------------------------------------------*)

  procedure NAME_ODER_SCHLUESSELWORT;    (* Name oder Schluesselwort        *)
    var
        KETTE      : STRING8;
        ZIFFERN    : BOOLEAN;

(*--------------------------------------------------------------------------*)
(*             Pruefung ob Schluesselwort, wenn ja -> verschluesseln        *)
(*--------------------------------------------------------------------------*)

(* Schluesselwoerter werden durch ihren Index in der Schluesselworttabelle  *)
(* verschluesselt                                                           *)

  procedure TEST_SCHLUESSELWORT;
    var INDEX: SYMBOL;
    begin
      TOKEN.KEY:=NAME;                          (* Annahme: es ist ein Name *)
      INDEX:=PRED(PROGRAM_SYM);
      repeat                                    (* Schluesselwort suchen    *)
        INDEX:=SUCC(INDEX);
        if SW[INDEX]=KETTE
        then TOKEN.KEY:=INDEX;                  (* Schluesselwort gefunden  *)
      until (TOKEN.KEY<>NAME) or (INDEX=DO_SYM);
    end;

(*--------------------------------------------------------------------------*)
(*             Name im Namensbuch suchen bzw. eintragen                     *)
(*--------------------------------------------------------------------------*)

  procedure TEST_NAME;
    var GEFUNDEN: BOOLEAN;
        NUMMER: NAMEN;
    begin
      with TOKEN do
        begin
          ATTR:=1;
          GEFUNDEN:=FALSE;
          (* Name im Namensbuch suchen *)
          while (not GEFUNDEN) and (ATTR<=LETZTER_NAME) do
            begin
              GEFUNDEN:=KETTE=NB[ATTR].NAME;
              if not GEFUNDEN
              then ATTR:=ATTR+1;
            end;
          if not GEFUNDEN                     (* Name nicht gefunden ->     *)
          then                                (* ins Namensbuch eintragen   *)
            begin
              if ATTR>MAX_NAME then
                begin
                  writeln('fataler Fehler: mehr als ',MAX_NAME,' Namen!');
                  halt;
                end;
              LETZTER_NAME:=ATTR;
              NB[ATTR].NAME:=KETTE;
              NB[ATTR].DIMENSION:=-1;       (* Kennung: noch nicht deklar.  *)
            end;
        end
    end;

(*--------------------------------------------------------------------------*)

  begin (* NAME_ODER_SCHLUESSELWORT *)
      KETTE:='';
      ZIFFERN:=FALSE;
      while ZEICHEN in ['A'..'Z','0'..'9'] do
        begin
          if ZEICHEN in ['0'..'9']
          then ZIFFERN:=TRUE;                  (* Name enthaelt Ziffern     *)
          if LENGTH(KETTE)<8
          then KETTE:=CONCAT(KETTE,ZEICHEN);   (* Zeichen anhaengen         *)
          HOLE_ZEICHEN;
        end;
      (* Schluesselwortpruefung:   Schluesselwoerter sind kuerzer als 8
                                   Zeichen und enthalten keine Ziffern !    *)
      if (LENGTH(KETTE)<8) and (not ZIFFERN)   (* Schluesselwort moeglich ? *)
      then TEST_SCHLUESSELWORT
      else TOKEN.KEY:=NAME;
      if TOKEN.KEY=NAME                        (* kein Schluesselwort ?     *)
      then TEST_NAME;
  end;


begin

    WRITELN;
    WRITELN('Mini-PASCAL-8086-Compiler');
    WRITE('Name der Quelldatei angeben! '#13#10'Datei muss Endung ''.pas'' haben');
    WRITE(' - diese aber bitte NICHT eingeben:'); READLN(DATEINAME);
    ASSIGN(QUELLE,CONCAT(DATEINAME,'.PAS'));
    RESET(QUELLE);
    WRITE('  1  ');           (* Ausgabe der Zeilennummer 1 fuer Liste *)
    ZEICHEN:=' ';             (* Initialisierung der Variablen ZEICHEN *)
    TOKEN.KEY:=FALSCH;        (* Initialisierung der Variablen TOKEN   *)
    ZEILE:=1;                 (* Initialisierung der Zeilennummer      *)
                              (* freie Register initialisieren         *)
    LETZTER_NAME:=0;          (* Initialisierung des Namensbuches      *)

end.