program compiler;

uses crt;

TYPE OpCode = (add,sub,mult,divi,load,stor,get);
{Symbolische Bezeichner fr Maschinencode: lesbarerer Code als bei Zahlen!
 Addition, Subtraktion, Multiplikation, Division, Laden vom Stack/Keller,
 Speichern auf diesen und auf den Stack-holen einer Konstanten.}

VAR i    : INTEGER;
    next : CHAR;
    s    : STRING;
    erg  : REAL;
    vars : ARRAY ['a'..'z'] OF REAL;
    Fehl : BOOLEAN;

FUNCTION Faktor:REAL; FORWARD;

PROCEDURE Ausgabe(n:OpCode ; c:STRING);
BEGIN
   CASE n OF
      add : Write('ADD');
      sub : Write('SUB');
      mult: Write('MULT');
      divi: Write('DIV');
      load: BEGIN Write('LOAD ');Write(c) END;
      stor: BEGIN Write('STORE ');Write(c) END;
      get : BEGIN Write('GET ');Write(c) END
   END;
   WriteLn
END;

PROCEDURE Lese;
BEGIN
   INC(i);
   if i<=length(s)
      then next:=s[i]
      else next:='#' {Die Raute wird als String-Ende Kennung benutzt!}
END;

PROCEDURE Fehler;
BEGIN
   WriteLn;
   Write('Fehler in Position ');
   Write(i);
   writeln;write('Bitte Return drcken');
   Fehl:=TRUE; {Fehler-Flag setzen}
   readln; {Auf Taste warten!}
END;

FUNCTION Term:REAL;
var Fakt,Ter: REAL;
BEGIN
   Ter:=Faktor;
   REPEAT
      CASE next OF
         '#','+','-',')': break;
         '*'            : BEGIN
                               Lese;
                               Ter:=Ter*Faktor;
                               IF Fehl THEN exit;
                               Ausgabe(mult,'')
                          END;
         '/'            : BEGIN
                               Lese;
                               fakt:=Faktor;
                               IF Fehl THEN exit;
                               IF fakt=0 THEN BEGIN
                                    Write('Division durch Null!');
                                    Fehler;
                                    exit
                               END ELSE BEGIN
                                    Ter:=Ter/fakt;
                                    Ausgabe(divi,'')
                               END
                          END;
         ELSE BEGIN Fehler;exit END;
      END;
   UNTIL false;
   Term:=Ter;
END;

FUNCTION Ausdruck:REAL;
var Aus:REAL;
BEGIN
   Aus:=Term;
   REPEAT
      CASE next OF
         '#',')' : break;
         '+'     : BEGIN
                        Lese;
                        Aus:=Aus+Term;
                        IF Fehl THEN exit;
                        Ausgabe(add,'')
                   END;
         '-'     : BEGIN
                        Lese;
                        Aus:=Aus-Term;
                        IF Fehl THEN exit;
                        Ausgabe(sub,'')
                   END;
         ELSE BEGIN Fehler;exit END;
      END;
   UNTIL false;
   Ausdruck:=Aus
END;

FUNCTION Faktor:REAL;
BEGIN
   CASE next OF
      'a'..'z': BEGIN Ausgabe(load,next);
                      Faktor:=vars[next];
                      Lese
                END;
      '('     : BEGIN Lese; Faktor:=Ausdruck;
                      IF Fehl THEN exit;
                   IF next<>')'
                      THEN BEGIN Fehler;exit END
                      ELSE Lese
                END;
      '0'..'9': BEGIN Ausgabe(get,next);
                      Faktor:=ord(next)-ord('0');
                      Lese
                END;

      ELSE      IF Fehl THEN exit ELSE Fehler;
   END
END;

PROCEDURE Wertzuweisung;
VAR ch   :CHAR;
    wert :REAL;
BEGIN
   CASE next OF
      'a'..'z': BEGIN ch:=next;
                   Lese;
                   IF next <> ':'
                      THEN BEGIN Fehler;exit END;

                   Lese;
                   IF next <> '='
                      THEN BEGIN Fehler;exit END;

                   Lese;
                   Wert:=Ausdruck;
                   IF Fehl THEN exit;

                   Ausgabe(stor,ch);
                   vars[ch]    :=Wert;
                   WriteLn(ch,':=',Wert);
                END
      ELSE Fehler
   END
END;

BEGIN (* Hauptprogramm *)
   ClrScr;
   writeLn('Wertzuweisungen eingeben, . zum Beenden: ');
   WHILE TRUE DO BEGIN
       Fehl:=FALSE;
       ReadLn(s);

       IF s='.' THEN BREAK;
       IF s<>'' THEN BEGIN
          i:=0;
          Lese;
          WriteLn;
          Wertzuweisung;
          IF (next <> '#') and NOT Fehl
             THEN Fehler;
       END

   END
END.


