source: branches/easy compiler/UTargetCode.pas

unit UTargetCode;

{$mode delphi}

interface

uses
  Classes, SysUtils, Contnrs;

type
  TTargetInstructionKind = (tiNop, tiFunction);
  TTargetInstruction = class
    Kind: TTargetInstructionKind;
    Name: string;
    Param1: string;
    Param2: string;
  end;

  TTargetInstructions = class(TObjectList)
  end;

  TTargetInstructionFunction = class(TTargetInstruction)

  end;

  { TTargetCode }

  TTargetCode = class
    Instructions: TTargetInstructions;
    constructor Create;
    destructor Destroy; override;
  end;

  TOutputEvent = procedure (Text: string) of object;

  { TTargetExecutor }

  TTargetExecutor = class
  private
    FOnOutput: TOutputEvent;
    Variables: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute(TargetCode: TTargetCode);
    property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
  end;



implementation

{ TTargetExecutor }

constructor TTargetExecutor.Create;
begin
  Variables := TStringList.Create;
end;

destructor TTargetExecutor.Destroy;
begin
  Variables.Free;
  inherited Destroy;
end;

procedure TTargetExecutor.Execute(TargetCode: TTargetCode);
var
  IP: Integer;
  Instruction: TTargetInstruction;
begin
{  IP := 0;
  while IP < TargetCode.Instructions.Count do begin
    Instruction := TTargetInstruction(Targetcode.Instructions[IP]);
    if Instruction.Kind = tiNop then
    else if Instruction.Kind = tiFunction then begin
      if Instruction.Name = 'print' then begin
        if Assigned(FOnOutput) then begin
          if TTargetInstructionFunction(Instruction).;
          FOnOutput(Variables[Instruction.Param1] + LineEnding);
        end;
      end else
      if Instruction.Name = 'assign' then begin
        // Variables.Add(Instruction.Param1 + Variables.Delimited + Instruction.Param2);
      end else raise Exception.Create('Unsupported function');
    end else raise Exception.Create('Unsupported instruction');
    Inc(IP);
  end;
}
end;

{ TTargetCode }

constructor TTargetCode.Create;
begin
  Instructions := TTargetInstructions.Create;
end;

destructor TTargetCode.Destroy;
begin
  Instructions.Free;
  inherited Destroy;
end;

end.