Compiler für arithmetische Ausdrücke in PASCAL

Ein Beipiel für rekursive Prozeduren.


PROGRAM Compiler;
(* Uebersetzt einen eingegebenen arithmetischen Ausdruck *)
(* in Assembler zur Abarbeitung auf einem Stack.         *)

VAR s : String[80];  (* Ausdruck wird in s gespeichert und ist *)
    i : INTEGER;     (* bis zur Position s[i] abgearbeitet.    *)
                     (* i und s sind globale Variablen die     *)
                     (* in allen Prozeduren veraendert werden, *)
                     (* ohne Parameteruebergabe!               *)

PROCEDURE Fehler;
BEGIN
   WriteLn('Fehler an Position ',i);
   HALT
END; (* Fehler *)

PROCEDURE Ausdruck;
(* Ein Ausdruck ist ein Term, evtl. gefolgt von weiteren *)
(* Termen, die durch '+' oder '-' verknuepft sind.       *)
   VAR c : CHAR;

   PROCEDURE Term;
   (* Ein Term ist ein Faktor, evtl. gefolgt von weiteren *)
   (* Faktoren, die durch '*' oder '/' verknuepft sind.   *)
      VAR c : CHAR;

      PROCEDURE Faktor;
      (* Ein Faktor ist eine Variable oder *) 
      (* ein geklammerter Ausdruck.        *)
      BEGIN
	 CASE s[i] OF
	   'a'..'z': BEGIN  (* Variable *)
	                WriteLn('Push ',s[i]);
	                i := i+1
	             END;
	   '('	   : BEGIN  (* geklammerter Ausdruck *)
	                i := i+1;
	                Ausdruck;
	                IF s[i] = ')' THEN i := i+1
			ELSE Fehler
	            END;
           ELSE Fehler
	 END; (* CASE *)
      END; (* Faktor *)

   BEGIN (* Term *)
      Faktor;
      WHILE (i <= length(s)) AND (s[i] IN ['*','/']) DO
      BEGIN  (* weiterer Faktor *)
	 c := s[i];
	 i := i+1;
	 Faktor;
 	 IF c = '*' THEN WriteLn('MULT')
	 ELSE WriteLn('DIV')
      END; (* WHILE *)
   END; (* Term *)

BEGIN (* Ausdruck *)
   Term;
   WHILE (i <= length(s)) AND (s[i] IN ['+','-']) DO
   BEGIN  (* weiterer Term *)
      c := s[i];
      i := i+1;
      Term;
      IF c = '+' THEN WriteLn('ADD')
      ELSE WriteLn('SUB')
   END; (* WHILE *)
END; (* Ausdruck *)

BEGIN (* Hauptprogramm *)
   Write('Gebe Ausdruck ein: '); ReadLn(s); WriteLn;
   i := 1;
   
   Ausdruck;
   IF i <= length(s) THEN Fehler
END.