Tutorial Scriptsprachen Teil 2

Aus DGL Wiki
Version vom 22. März 2007, 09:57 Uhr von Frase (Diskussion | Beiträge) (Ein ''Emulator'' für unseren Prozessor: Typo: "us" zu "Aus")

Wechseln zu: Navigation, Suche

Definition eines eigenen Prozessors

Bevor wir weitermachen können, müssen wir einen Zielcomputer für die Übersetzung festlegen. Da wir eine Skriptsprache schreiben, ist es sinnvoll, nicht in den Befehlscode einer echten Maschiene zu übersetzen, sondern in eine von uns selbst entworfene. Nebenbei können wir dann den Computer auf unsere Sprache zuschneiden, was die Codeerzeugung stark vereinfacht. Ich halte mich hier an ein Beispiel von Niklaus Wirth, da der von ihm beschriebene Computer auch gut für unsere eigene Sprache geeigent ist(damit niemand behaupten kann, ich würde geistiges Eigentum stehlen: Ein Teil dieses Textes ist abgeschrieben, mit Änderungen, versteht sich):

Der Computer besteht aus 2 Speichern, einem Befehlsregister und 3 Adressregistern. Der Programmspeicher wird vor der Ausführung des Programs geladen und bleibt üblicherweise während der Ausführung unverändert. Daneben gibt es noch den Datenspeicher S, der als Stack verwendet wird. Arithmetische Operatoren verwenden die zuoberst auf dem Stack liegenden Werte und ersetzen sie durch das Ergebnis. Das oberste Element des Stacks wird durch das Indexregister T gekennzeichnet. Das Befehlsregister I enthält enthält den derzeit interpretierten Befehl und der Programmzähler P enthält die Adresse des nächsten Befehls.

Jede Prozedur in unserer Sprache kann lokale Variablen besitzen. Da rekursiver Aufruf der Prozeduren möglich ist, ist es unmöglich, lokalen Variablen bereits bei der Compilierung feste Speicherplätze zuzuweisen. Stattdessen wird während der Ausführung beim Aufruf der Prozedur Speicher reserviert und nach Ausführung der Prozedur wieder freigegeben. Weil jede Prozedur Q, die nach einer Prozedur P aufgerufen wurde, beendet wird, bevor P beendet ist, ist eine Speicherverwaltung nach dem Stapelprinzip die naheliegenste Lösung. Beim Aufruf wird der Prozedur zuoberst im Stapel ein Platz zugewiesen; er wird Prozedur Segment genannt. Jede Prozedur speichert darin die Programmadresse des Aufrufs("return address") und die Segment Adresse ("dynamic link") der aufrufenden Prozedur ab. Diese Daten werden benötigt, um nach Beendigung der Prozedur den vor der Ausführung geltenden Zustand wiederherzustellen. Der Anfang dieser Kette befindet sich im Basis Adress Register B.

Da die eigentliche Speicherplatzzuweisung erst während der Interpretation des compilierten Programmes stattfindet, kann der Compiler keine endgültigen Adressen in die Befehle einbauen. Er kann lediglich den Platz einer Variable innerhalb eines Segments bestimmen. Diese realtive Adresse wird Offset genannt. Der Interpreter muss sodann, um die absolute Adresse zu erhalten, der Basis Adresse des des betreffenden Segemnts zum Offset hinzuzählen. Wenn eine Variable lokal zur gegenwärtig ausgeführten Prozedur ist, so kann diese Basis Adresse dem Register B entnommen werden. Ansonsten muss sie ermittelt werden, indem die Adresskette DL bis zum entsprechenden Segment durchlaufen wird. Der Compiler kennt jedoch nur die Tiefe der statischen Verschachtelung, während DL die dynamische Folge von Aufrufen festhält. Leider sind Beide folgen nicht notwendigerweise identisch. Folglich ist eine zweite Verkettung notwendig, welche den Zugriffspfad zu Variablen korrekt wiederspiegelt. Wir nennen diese zweite Kette SL(static link).

Adressen werden deshalb vom Compiler als Zahlenpaare dargestellt. Die erste Zahl bezeichnet die Niveau Differenz zwischen dem Aufrufer und der zugegriffenen Variablen und bestimmt die Anzahl der in der SL Kette zu durchlaufenden Glieder. Die zwite Zahl ist das Offset der Variable.

Der Befehlssatz des Computers ist direkt auf die Erfordernisse der Sprache zugeschnitten. Er enthält folgende Befehle:

  1. Ein Befehl LIT, um Zahlen (literals) in den Stapel zu bringen.
  2. Ein Befehl LOD, um Variablenwerte in den Stapel zu laden.
  3. Ein Befehl STO, um Werte aus dem Stapel abzuspeichern(store).
  4. Ein Befehl CAL, um eine Prozedur aufzurufen(call).
  5. Ein Befehl INT, um Speicher zu reservieren (inrement T).
  6. Ein Befehl JMP und JPC, um im Program zu springen(jump).
  7. Ein Satz von arithmetischen und relationalen Operatoren OPR.
  8. Ein Befehl WRI, um einen Wert auf dem Bildschirm auszugeben.

Das Befehlsformat wird durch die Notwendigkeit 3er Komponenten bestimmt. Jeder Befehl enthält einen Befehlscode, der die Art des Befehls kennzeichent, sowie einen oder zwei Parameter. Im Fall der Operatoren gibt der Parameter die Identität des Operators an, da der Befehlscode lediglich eine Befehlsklasse bezeichnet. Bei LIT und INT ist der Parameter eine Zahl, bei JMP, JPC und CAL eine Programmadresse, bei LOD und STO eine Datenadresse.

Ein Emulator für unseren Prozessor

Aus der obigen Beschreibung kann man nun einen Emulator ableiten. Dieser wird auch häufig Virtuelle Maschiene genannt. In ihr wird der vom Compiler übersetzte Code ausgeführt. Da wir bereits genau wissen, wie unser Computer funktioniert, können wir unsere VM relativ leicht erstellen. Die Funktionen, die OPR ausführen kann, sind dem Quellcode zu entnehmen, eine einzelne Aufführung ist denke ich nicht nötig.

interpreter.dpr

program interpreter;
{$APPTYPE CONSOLE}
uses
  sysutils;

type
  TOpCode = (lit, opr, lod, sto, cal, int, jmp, jpc, wri);
  Instruction = packed record
                  f : TOpCode; //Befehl
                  l : Byte;    //Parameter 1
                  a : Integer; //Parameter 2
                end;

  TInstructions = Array[0..0] of Instruction;
  PInstructions = ^TInstructions;


var
  Instructions : PInstructions;

  procedure Emulate;
  const
    StackSize = 1024;

  var
    p,b,t : Integer;
    i : Instruction;
    s : Array[1..StackSize] of Integer;

    function Base(I : Integer): Integer;
    var
      b1 : Integer;
    begin
      b1 := b;
      while I > 0 do
      begin
        b1 := s[b1];
        Dec(I)
      end;
      base := b1
    end;

  begin
    WriteLn('Interpreting Code');
    t := 0;
    b := 1;
    p := 0;
    s[1] := 0;
    s[2] := 0;
    s[3] := 0;
    repeat
      //bereichsprüfung ist wegen dem Array[0..] nicht angebracht
      {$R-}
      i := Instructions^[p];
      {$R+}
      Inc(p);
      with i do
        case f of
          lit : begin
                  Inc(t);
                  s[t] := a
                end;
          lod : begin
                  Inc(t);
                  s[t] := s[base(l)+a]
                end;
          sto : begin
                  s[base(l)+a] := s[t];
                  Dec(t);
                end;
          cal : begin
                  (*generate new block mark*)
                  s[t + 1] := base(l);
                  s[t +2] := b;
                  s[t+3] := p;
                  b := t + 1;
                  p := a
                end;
          int : t := t + a;
          jmp : p := a;
          jpc : begin
                  if s[t] = 0 then p := a;
                  Dec(t);
                end;
          wri: begin
                 WriteLn('wri: ' + IntToStr(s[t]));
                 Dec(t)
               end;
          opr : case a of (*operator*)
                  0: begin //return
                       t := b - 1;
                       p := s[t+3];
                       b := s[t+2]
                     end;
                  1: s[t] := -s[t]; //negation
                  2: begin
                       //Addition
                       Dec(t);
                       s[t] := s[t] + s[t+1]
                     end;
                  3: begin
                       //Subtraktion
                       Dec(t);
                       s[t] := s[t] - s[t+1]
                     end;
                  4: begin
                       //mul
                       Dec(t);
                       s[t] := s[t] * s[t+1]
                     end;
                  5: begin
                       //div
                       Dec(t);
                       s[t] := s[t] div s[t+1]
                     end;
                     //6 und 7 aus dem PL/0 interpreter von N.Wirth werden NICHT benötigt
                  8: begin
                       //Equal
                       Dec(t);
                       s[t] := ord(s[t] = s[t+1])
                     end;
                  9: begin
                       //unequal
                       Dec(t);
                       s[t] := ord(s[t] <> s[t+1])
                     end;
                  10:begin
                       //smaller
                       Dec(t);
                       s[t] := ord(s[t] < s[t+1])
                     end;
                  11:begin
                       //Bigger
                       Dec(t);
                       s[t] := ord(s[t] > s[t+1]);
                     end;
                  12:begin
                       //Bigerequal
                       Dec(t);
                       s[t] := ord(s[t] >= s[t+1]);
                     end;
                  13:begin
                       //Smallerequal
                       Dec(t);
                       s[t] := ord(s[t] <= s[t+1]);
                     end;
                else
                  WriteLn('Unknown Operand!');
                  p := 0;
                end;
        else
          WriteLn('Unknown opcode');
          p := 0;
        end
    until p = 0;
    WriteLn('Done...');
  end;

var
  F : File;
  FSize : Integer;

  procedure ShowInstructions;
  const
    OpCodeText : Array[TOpCode] of ShortString = ('lit', 'opr', 'lod', 'sto', 'cal', 'int', 'jmp', 'jpc', 'wri');
  var
    I : Integer;
  begin
    WriteLn('Instructions:');
    I := 0;
    while (I+1) * SizeOf(Instruction)<= FSize do
    begin
      {$R-}
      with Instructions^[I] do
        WriteLn(Format('%d: %s %d,%d', [i, OpCodeText[f], l, a]));
      {$R+}
      Inc(i)
    end
  end;

begin
  if not FileExists(ParamStr(1)) then Halt(0);

  AssignFile(F, ParamStr(1));
  FileMode := 0;
  Reset(F, 1);
  FSize := FileSize(F);
  GetMem(Instructions, FSize);
  BlockRead(F, Instructions^[0], FSize);
  if ParamStr(2) = '+i' then
    ShowInstructions;
  Emulate;
  FreeMem(Instructions, FSize);
  ReadLn;

  CloseFile(F)
end.

Codeerzeugung

Variablen, Konstanten und Prozeduren

Um mit Variablen und Konstanten arbeiten zu können, müssen wir unsere Tabelle, die wir für den Zweck der Überprüfung der Bezeichner eingeführt haben, erweitern. Bei Konstanten müssen wir den Wert den sie darstellen uns merken. Variablen benötigen eine Datenadresse. Bei Prozeduren benötigen wir die Schachtelungstiefe und eine Programmadresse:

  TIdent = record
             Name : ShortString;
             case Kind : TIdentType of
               itConstant: (val:integer);
               itVariable,itProcedure:(level,adr,size:Integer)
           end;

Ausdrücke und Bindungsregeln

In der Schule haben wir gelernt, dass Rechenzeichen in die Mitte von zwei Zahlen gehören. Seit einiger Zeit halte ich das für unsinnig, denn das zwingt einen dazu, Klammern einzuführen. Nachdem unsere VM von Klammern keine Ahnung hat und wir sie dahingegen nicht verändern wollen, müssen wir uns etwas besseres einfallen lassen: die postfix Notation. Statt das Rechenzeichen zwischen die Operanden einzubetten, werden sie dahinter geschreiben, z.B.:

Infix Postfix
x+y x y +
(x-y)+z x y - z +
x-(y+z) x y z + -
(x+y)/(z-w) x y + z w - /

Ich empfehle darüber jetzt ein wenig nachzudenken und sich klar zu machen, dass diese Notation Klammern unnötig macht.

Was bedeutet das für unseren Compiler? Die Aufgabe der Prozeduren zur Übersetzung von Ausdrücken beschränkt sich darauf, die Übermittlung der Operatoren zu verzögern.

If und While Anweisungen

Uns fehlt jetzt nur noch eine Möglichkeit, Bedingte und wiederholte Anweisungen auszuführen. Das Problem besteht darin, dass an vielen Stellen nach vorne gesprungen wird. Nur ist dann leider noch nicht bekannt, wohin gesprungen werden muss. Hier haben sich zwei Methoden besonders etabliert. 2 Phasencompiler markieren beim ersten Übersetzen einfach die Sprungstellen und merken sich die Zieladresse, wenn diese Übersetzt wird. Bei einem zweiten Durchgang, werden dann die Sprungadressen korrekt eingefügt. Die andere Variante besteht darin, die Befehle in einem Array zu halten. Sobald dann die Sprungadressen bekannt sind, werden sie einfach eingesetzt. Dieses Verfahren wird Fixup genannt.

compiler.dpr

program compiler;
{$APPTYPE CONSOLE}
uses
  sysutils,
  symbols in '..\parser\symbols.pas',
  scanner in '..\parser\scanner.pas',
  errors in '..\parser\errors.pas';

type
  TIdentType = (itConstant, itVariable, itProcedure);
  TIdent = record
             Name : ShortString;
             case Kind : TIdentType of
               itConstant: (val:integer);
               itVariable,itProcedure:(level,adr,size:Integer)
           end;

  TIdentList = Array of TIdent;

  TOpCode = (lit, opr, lod, sto, cal, int, jmp, jpc, wri);
  Instruction = packed record
                  f : TOpCode; //Befehl
                  l : Byte;    //Level
                  a:  Integer; //Adresse
                end;

  TInstructions = Array of Instruction;

var
  Table : TIdentList;
  Code : TInstructions;

  //Code Position
  cx : Integer;

  procedure Expect(Expected : TSymbol);
  begin
    if Symbol <> Expected then
      ErrorExpected([Expected], Symbol)
  end;

  procedure GenCode(f : TOpCode; l, a : Integer);
  begin (*GenCode*)
    if cx > Length(Code) - 1 then
      SetLength(Code, Length(Code) + 64);
    Code[cx].f := f;
    Code[cx].a := a;
    Code[cx].l := l;
    Inc(cx)
  end; (*GenCode*)

  procedure Module;

    function Position(ID : ShortString; TablePosition : Integer) : Integer;
    var
      I : Integer;
    begin
      Table[0].Name := ID;
      I := TablePosition;
      while Table[I].Name <> ID do
        Dec(I);
      Result := I
    end;

    procedure StatementSequence(TablePosition, lev : Integer);
    (*  StatementSeq  = [Statement {";" Statement}]*)
      procedure Statement;
      (*Statement     = ( Ident ":=" (Ident | Expression) |
                  Ident | (WRITE Expression) |
                  ( BEGIN StatementSeq END ) |
                  ( IF Condition THEN StatementSeq END
                    {ELSEIF Condition THEN StatementSeq END }
                    [ELSE StatementSeq END] ) |
                  ( WHILE Condition DO StatementSeq END ) | ";". *)
        procedure Expression;
        (*Expression      = [Vorzeichen] Term {Vorzeichen Term}.*)
          procedure Term;
          (*Term            = Factor {"*"|"/" Factor}.*)
            procedure Factor;
            (*Factor          = Ident | Zahl | ("(" Expression ")").*)
            var
              IdentPos : Integer;
            begin (*Factor*)
              if (Symbol = sIdent) then
              begin
                IdentPos := Position(ID, TablePosition);
                if (IdentPos = 0) then
                  Error(ERR_PARSE_UNKNOWN_IDENT);
                if Table[IdentPos].Kind = itProcedure then
                  Error(ERR_PARSE_VAR_CONSTANT_EXPECTED);

                case Table[IdentPos].Kind of
                  itConstant: GenCode(lit, 0, Table[IdentPos].val);
                  itVariable: GenCode(lod, lev-Table[IdentPos].Level, Table[IdentPos].adr);
                end;

                GetSym
              end
              else if (Symbol = sInteger) then
              begin
                GenCode(lit, 0, num);
                GetSym
              end
              else if (Symbol = sOpenBracket) then
              begin
                GetSym;
                Expression;
                Expect(sCloseBracket);
                GetSym
              end
              else
                ErrorExpected([sIdent, sInteger, sOpenBracket], Symbol)
            end;  (*Factor*)

          var
            Operation : TSymbol;
          begin(*Term*)
            Factor;
            while Symbol in [sStar, sSlash] do
            begin
              Operation := Symbol;
              GetSym;
              Factor;
              case Operation of
                sStar: GenCode(opr, 0, 4);
                sSlash: GenCode(opr, 0, 5);
              end
            end
          end;(*Term*)

        var
          Operation : TSymbol;
        begin (*Expresion*)
          if (Symbol in[sPlus, sMinus]) then
          begin
            Operation := Symbol;
            GetSym;
            Term;
            if Operation = sMinus then
              GenCode(opr, 0, 1)
          end
          else Term;
          while (Symbol in[sPlus, sMinus]) do
          begin
            Operation := Symbol;
            GetSym;
            Term;
            case Operation of
              sPlus: GenCode(opr, 0, 2);
              sMinus: GenCode(opr, 0, 3);
            end
          end
        end; (*Expression*)

        procedure Condition;
        (*Condition       = Expression ("="|"<"|">"|">="|"<="|"#") Expression.*)
        var
          Operation : TSymbol;
        begin (*Condition*)
          Expression;
          Operation := Symbol;
          GetSym;
          Expression;
          case Operation of
            sEqual : GenCode(opr, 0, 8);
            sSmaller : GenCode(opr, 0, 10);
            sBigger : GenCode(opr, 0, 11);
            sBiggerEqual : GenCode(opr, 0, 12);
            sSmallerEqual : GenCode(opr, 0, 13);
            sUnEqual : GEnCode(opr, 0, 9);
          else
            ErrorExpected([sEqual, sSmaller, sBigger, sBiggerEqual, sSmallerEqual, sUnequal], Symbol)
          end
        end; (*Condition*)

      var
        IdentPos : Integer;
        Ident : ShortString;

        CodePosition1, CodePosition2 : Integer;

      begin (*Statement*)
        case Symbol of
          sIdent: begin
                    Ident := Id;
                    IdentPos := Position(ID, TablePosition);
                    if (IdentPos = 0) then
                      Error(ERR_PARSE_UNKNOWN_IDENT);
                    if Table[IdentPos].Kind = itProcedure then
                    begin
                      //Prozeduraufruf
                      GenCode(cal, lev - Table[IdentPos].level, Table[IdentPos].adr);
                      GetSym
                    end else if Table[IdentPos].Kind = itVariable then
                    begin
                      GetSym;
                      Expect(sBecomes);
                      GetSym;
                      Expression;
                      GenCode(sto, lev- Table[IdentPos].level, Table[IdentPos].Adr)
                    end
                    else
                      Error(ERR_PARSE_NO_CONST_ALLOWED)
                  end;
          sWrite: begin
                    GetSym;
                    Expression;
                    GenCode(wri, 0, 0)
                  end;
          sIf :   begin
                    GetSym;
                    Condition;
                    Expect(sThen);
                    GetSym;

                    CodePosition1 := cx;
                    GenCode(jpc, 0, 0);

                    StatementSequence(TablePosition, lev);
                    Expect(sEnd);
                    GetSym;
                    CodePosition2 := cx;
                    GenCode(jmp, 0,0);

                    Code[CodePosition1].a := cx;

                    while Symbol = sElseIf do
                    begin
                      GetSym;
                      Condition;
                      Expect(sThen);
                      GetSym;

                      CodePosition1 := cx;
                      GenCode(jpc, 0, 0);

                      StatementSequence(TablePosition, lev);
                      Expect(sEnd);
                      GetSym;

                      Code[CodePosition2].a := cx;
                      CodePosition2 := cx;
                      GenCode(jmp, 0,0);

                      Code[CodePosition1].a := cx
                    end;
                    if Symbol = sElse then
                    begin
                      GetSym;
                      StatementSequence(TablePosition, lev);
                      Expect(sEnd);
                      GetSym
                    end;
                    Code[CodePosition2].a := cx
                  end;
          sWhile :
                  begin
                    GetSym;
                    CodePosition2 := cx;
                    Condition;
                    Expect(sDo);
                    GetSym;

                    CodePosition1 := cx;
                    GenCode(jpc, 0, 0);

                    StatementSequence(TablePosition, lev);
                    Expect(sEnd);
                    GenCode(jmp, 0, CodePosition2);

                    GetSym;

                    Code[CodePosition1].a := cx
                  end;
          sBegin :
                  begin
                    GetSym;
                    StatementSequence(TablePosition, lev);
                    Expect(sEnd);
                    GetSym
                  end;

        else
          (*Der Fehler darf getrost ignoriert werden*)
          //Error(ERR_PARSE_UNALLOWED_STATEMENT)
        end
      end; (*Statement*)

    begin (*Statement Sequence*)
      Statement;
      while Symbol = sSemiColon do
      begin
        GetSym;
        Statement
      end
    end; (*Statement Sequence*)

    function Declarations(TablePosition : Integer; lev : Integer): Integer;
    var
      DataPos : Integer;
      InitTablePos : Integer;
      InitCodePos : Integer;

    (*
      VarSeq          = VAR VarDecl {";" VarDecl}";".
      ConstSeq        = CONST ConstDecl {";" ConstDecl}";".
      DeclSeq         = {VarSeq | ConstSeq | ProcedureDecl}.

    *)
      procedure Enter(Typ : TIdentType);
      begin
        Inc(TablePosition);
        if TablePosition > Length(Table) - 1 then
          SetLength(Table, Length(Table)+16);
        with Table[TablePosition] do
        begin
          Name := ID;
          Kind := Typ;
          case Kind of
            itConstant: val := num;
            itVariable: begin
                          level := lev;
                          adr := DataPos;
                          Inc(DataPos)
                        end;
            itProcedure: level := lev
          end
        end
      end; (*Enter*)


      procedure ProcedureDecl;
      (*ProcedureDecl   = PROCEDURE Ident";"
                          DeclSeq BEGIN StatementSeq END Ident ";".*)
      var
        ProcedureName : String;
        ProcTablePos : Integer;
      begin
        Expect(sProcedure);
        GetSym;
        Expect(sIdent);
        Enter(itProcedure);
        ProcedureName := ID;

        GetSym;
        Expect(sSemiColon);
        GetSym;
        ProcTablePos := Declarations(TablePosition, lev+1);
        Expect(sBegin);
        GetSym;
        StatementSequence(ProcTablePos, lev +1);
        Expect(sEnd);
        GetSym;
        Expect(sIdent);
        if ProcedureName <> ID then
          Error(Format(ERR_PARSE_WRONG_PROCEDURE_ENDED, [ProcedureName, ID]));
        GetSym;
        Expect(sSemiColon);
        //rücksprung
        GenCode(Opr, 0,0);
        GetSym
      end;

      procedure ConstDecl;
      (*ConstDecl       = Ident "=" Zahl.*)
      begin (*ConstDecl*)
        Expect(sIdent);
        GetSym;
        Expect(sEqual);
        GetSym;
        Expect(sInteger);
        Enter(itConstant);
        GetSym
      end; (*ConstDecl*)

      procedure VarDecl;
      (*VarDecl         = Ident {"," Ident}.*)
      begin (*VarDecl*)
        Expect(sIdent);
        Enter(itVariable);
        GetSym;
        while Symbol = sComma do
        begin
          GetSym;
          Expect(sIdent);
          Enter(itVariable);
          GetSym
        end
      end; (*VarDecl*)

    begin (*Declarations*)
      DataPos := 3;
      InitTablePos := TablePosition;
      InitCodePos := cx;
      Table[TablePosition].adr := cx;

      GenCode(jmp, 0,0);
      while Symbol in [sVar, sConst, sProcedure] do
        case Symbol of
          sVar   : begin
                     GetSym;
                     VarDecl;
                     Expect(sSemiColon);
                     GetSym;
                     while Symbol = sIdent do
                     begin
                       VarDecl;
                       Expect(sSemiColon);
                       GetSym
                     end
                   end;
         sConst  : begin
                     GetSym;
                     ConstDecl;
                     Expect(sSemiColon);
                     GetSym;
                     while Symbol = sIdent do
                     begin
                       ConstDecl;
                       Expect(sSemiColon);
                       GetSym
                     end
                   end;
          sProcedure : ProcedureDecl;
        end;
      Code[table[InitTablePos].adr].a := cx;
      with Table[InitTablePos] do
      begin
        adr := cx;
        size := DataPos
      end;
      //Speicher reservieren
      GenCode(int, 0, DataPos);
      Result := TablePosition
    end; (*Declarations*)

  (*Module        = MODULE Ident ";"
                    DeclSeq
                    BEGIN
                      StatementSeq
                    END Ident ".".*)
  var
    TablePosition : Integer;
    ModuleName : ShortString;

  begin (*Module*)
    Expect(sModule);
    GetSym;
    Expect(sIdent);
    ModuleName := Id;
    GetSym;
    Expect(sSemiColon);
    GetSym;
    TablePosition := Declarations(0,0);
    //Code[0].a := cx;
    Expect(sBegin);
    GetSym;
    StatementSequence(TablePosition, 0);
    Expect(sEnd);

    //Und Ende...
    GenCode(jmp, 0,0);

    GetSym;
    Expect(sIdent);
    if ModuleName <> Id then
      Writeln(Format('%d: Warning: Module ID <> End ID. Code already generated', [Line]));
    GetSym;
    Expect(sSemiColon);
    GetSym;
    if Symbol <> sNone then
      WriteLn(Format('%d: Code after Module END is ignored!', [Line]))
  end (*Module*);

var
  F : File of Instruction;
  I : Integer;
begin
  AssignFile(InFile, ParamStr(1));
  Reset(InFile, 1);
  //Ch mit leerzeichen initialisieren
  Ch := ' ';
  Line := 1;
  cx := 0;
  SetLength(Table, 1);
  GetSym;
  Module;
  AssignFile(F, ParamStr(1)+'.bin');
  ReWrite(F);
  i := 0;
  while i < cx do
  begin
    Write(F, Code[i]);
    Inc(i)
  end;
  CloseFile(F);
  WriteLn('Done, no syntax errors detected... Code successfully generated');
  WriteLn(Format('# Instructions: %d Codesize: %d', [cx, (cx) * SizeOf(Instruction)]));
  ReadLn;
  CloseFile(InFile)
end.

Zum testen noch ein kleines Script:

module test;
(* Testscript
Ausgabe ist die folgende, wenn Compiler und Interpreter korrekt funktionieren:
Zahlen von 1 bis 10
0
10
100
-1
-10000
*)

  procedure TestWhile;
  var
    i;
  begin
    i := 0;
    while i < 10 do
      i := i + 1;
      write i
    end
  end TestWhile;

var
  a;

  procedure TestIf;
  begin
    if a < 10 then
      write 0
    end
    elseif a < 100 then
      write 10
    end
    elseif a < 1000 then
      write 100
    end
    else
      write -1
    end
  end TestIf;

begin
  (*Zahlen von 1 bis 10*)
  TestWhile;

  (* Ausgabe 0 *)
  a := 0;
  TestIf;

  (* Ausgabe 10 *)
  a := 11;
  TestIf;

  (* Ausgabe 100 *)
  a := 111;
  TestIf;

  (* Ausgabe -1 *)
  a := 10000;
  TestIf;

  (* Ausgabe -10000 *)
  Write -10000
end Test;

Wenn jemand das Bedürfnis hat, sich den erzeugten Code einmal näher anzuschauen, empfehle ich, das Script zu Compilieren und dann den Interpreter mit dem zusätzlichen Parameter "+i" zu starten.

Abschluss

Erledigt. Wir haben eine einfache Skriptsprache Implementiert. Sie benötigt allerdings noch einige Erweiterungen, um sie wirklich sinnvoll einsetzen zu können. Ich denke aber, dass jeder, der das Tutorial bis hier verstanden hat, keine größeren Probleme haben sollte diese einzubauen:

  1. Erweiterung der Sprache um den Typ Boolean. Damit verbunden sind z.B. Operatoren wie and, or und not. Ensprechende EBNF könnte so aussehehn:
     ...
     BoolExpression  = BoolImplication {"=" BoolImplication}.
     BoolImplication = BoolProduct["=>"|"<=" BoolProduct].
     BoolProduct     = BoolFactor {"AND"|"OR" BoolFactor}.
     BoolFactor      = {"NOT"} BoolAtomic.
     BoolAtomic      = ("(" BoolExpression ")") |
                       TRUE | FALSE |
                       Ident | Condition.
     ...
Möglicherweise sind, um Probleme zu vermeiden, bestimmte Symbole durch andere zu ersetzen. Wie "=" durch "==", etc.
  1. Erweitern der Sprache um den Typ Float
  2. Erweitern der Sprache um den Typ Array(1-Dimensionale sollten erstmal langen)
  3. (Erweitern der Sprache um den Typ String)
  4. Erweitern der Sprache um Funktionen und Prozeduren mit Parametern

Wenn das geschehen ist, hat man ein sehr mächtiges Werkzeug entstehen lassen. Es fehlt dann nur noch, dass man dem Compiler ein paar Funktionen bereits mit auf den Weg gibt, die das interpretierende Programm in echtem Maschienencode bereitstellt(z.B. zur Steuerung). Im übrigen ist davon auszugehen, dass bei den genannten Erweiterungen auch verschiedene Änderungen an der VM sinnvoll sind.

...have a lot of fun! Delphic



Vorhergehendes Tutorial:
Tutorial Scriptsprachen Teil 1
Nächstes Tutorial:
-

Schreibt was ihr zu diesem Tutorial denkt ins Feedbackforum von DelphiGL.com.
Lob, Verbesserungsvorschläge, Hinweise und Tutorialwünsche sind stets willkommen.