source: tags/1.0.0/Target/UTargetDelphi.pas

unit UTargetDelphi;

{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, UTarget, UBFTarget;

type

  { TTargetDelphi }

  TTargetDelphi = class(TBFTarget)
  private
    function GetMemoryCell: string;
  public
    constructor Create; override;
    procedure Compile; override;
    procedure Run; override;
  end;

implementation

{ TTargetDelphi }

constructor TTargetDelphi.Create;
begin
  inherited Create;
  Name := 'Delphi';
  SourceExtension := '.pas';
  ImageIndex := 22;
  Capabilities := [tcCompile, tcRun];
  {$IFDEF Windows}
  CompilerPath := 'c:\Program Files\Embarcadero\RAD Studio\9.0\bin\DCC32.EXE';
  CompiledExtension := '.exe';
  RunExtension := '';
  {$ENDIF}
end;

function TTargetDelphi.GetMemoryCell: string;
begin
  Result := 'Memory[Pos';
  if FProgram[FProgramIndex].RelIndex > 0 then
    Result := Result + ' + ' + IntToStr(FProgram[FProgramIndex].RelIndex)
  else if FProgram[FProgramIndex].RelIndex < 0 then
    Result := Result + ' - ' + IntToStr(Abs(FProgram[FProgramIndex].RelIndex));
  Result := Result + ']';
end;

procedure TTargetDelphi.Compile;
begin
  inherited;
  Indent := 0;
  FTargetCode := '';

  AddLine('program ' + ProgramName + ';');
  AddLine('');
  AddLine('{$APPTYPE CONSOLE}');
  AddLine('');
  AddLine('var');
  AddLine('  Memory: array[0..' + IntToStr(MemorySize) + '] of Byte;');
  AddLine('  Pos: Integer;');
  AddLine('  ReadChar: Char;');
  AddLine('begin');
  Inc(Indent);
  AddLine('Pos := 0;');
  FProgramIndex := 0;
  while (FProgramIndex < Length(FProgram)) do begin
    case FProgram[FProgramIndex].Command of
      cmPointerInc: AddLine('Inc(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
      cmPointerDec: AddLine('Dec(Pos, ' + IntToStr(FProgram[FProgramIndex].Parameter) + ');');
      cmInc: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmDec: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmSet: AddLine(GetMemoryCell + ' := ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmMultipy: AddLine(GetMemoryCell + ' := ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmOutput: AddLine('Write(Chr(' + GetMemoryCell + '));');
      cmInput: AddLine('Read(ReadChar); ' + GetMemoryCell + ' := Ord(ReadChar);');
      cmLoopStart: begin
        AddLine('while ' + GetMemoryCell + ' <> 0 do begin');
        Inc(Indent);
      end;
      cmLoopEnd: begin
        Dec(Indent);
        AddLine('end;');
      end;
    end;
    Inc(FProgramIndex);
  end;
  Dec(Indent);
  AddLine('end.');

  CompileToFile;
end;

procedure TTargetDelphi.Run;
begin
  inherited Run;
  RunFromFile;
end;

end.