source: tags/1.1.0/Target/UTargetC.pas

unit UTargetC;

{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, UTarget, UBFTarget, Process, Dialogs,
  LazFileUtils;

type

  { TTargetC }

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


implementation

{ TTargetC }

constructor TTargetC.Create;
begin
  inherited Create;
  Name := 'C';
  SourceExtension := '.c';
  ImageIndex := 23;
  Capabilities := [tcCompile, tcRun];
  {$IFDEF Windows}
  CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe';
  CompiledExtension := '.exe';
  RunExtension := '';
  {$ENDIF}
  {$IFDEF Linux}
  CompilerPath := '/usr/bin/gcc';
  CompiledExtension := '';
  RunExtension := '';
  {$ENDIF}
end;

function TTargetC.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 TTargetC.Compile;
begin
  inherited;
  Indent := 0;
  FTargetCode := '';

  AddLine('#include <stdio.h>');
  AddLine('');
  AddLine('int main()');
  AddLine('{');
  Inc(Indent);
  AddLine('char Memory[' + IntToStr(MemorySize) + '];');
  AddLine('int Pos;');
  AddLine('char ReadChar;');
  AddLine('');
  AddLine('Pos = 0;');
  FProgramIndex := 0;
  while (FProgramIndex < Length(FProgram)) do begin
    case FProgram[FProgramIndex].Command of
      cmPointerInc: AddLine('Pos = Pos + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmPointerDec: AddLine('Pos = Pos - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmInc: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmDec: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' - ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmOutput: AddLine('putchar(' + GetMemoryCell + ');');
      cmInput: AddLine(GetMemoryCell + ' = getchar();');
      cmSet: AddLine(GetMemoryCell + ' = ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmMultipy: AddLine(GetMemoryCell + ' = ' + GetMemoryCell + ' + Memory[Pos] * ' + IntToStr(FProgram[FProgramIndex].Parameter) + ';');
      cmLoopStart: begin
        AddLine('while(' + GetMemoryCell + ' != 0)');
        AddLine('{');
        Inc(Indent);
      end;
      cmLoopEnd: begin
        Dec(Indent);
        AddLine('}');
      end;
    end;
    Inc(FProgramIndex);
  end;
  AddLine('return 0;');
  Dec(Indent);
  AddLine('}');

  CompileToFile;
end;

procedure TTargetC.CompileToFile;
var
  Process: TProcess;
  CompiledFile: string;
begin
  CompiledFile := ExtractFilePath(ProjectFileName) +
    'compiled' + DirectorySeparator + Name + DirectorySeparator +
    ExtractFileNameOnly(ProjectFileName) + SourceExtension;
  ForceDirectoriesUTF8(ExtractFilePath(CompiledFile));
  with TStringList.Create do
  try
    Text := FTargetCode;
    SaveToFile(CompiledFile);
  finally
    Free;
  end;
  if FileExistsUTF8(CompilerPath) then
  try
    Process := TProcess.Create(nil);
    Process.CurrentDirectory := ExtractFilePath(CompilerPath);
    Process.Executable := LongFileName(CompilerPath);
    Process.Parameters.Add(LongFileName(CompiledFile));
    Process.Parameters.Add('-o');
    Process.Parameters.Add(LongFileName(ExtractFilePath(CompiledFile) + ExtractFileNameOnly(CompiledFile) + CompiledExtension));
    Process.Options := [poWaitOnExit];
    Process.Execute;
  finally
    Process.Free;
  end else raise Exception.Create(Format(SCompilerNotFound, [CompilerPath]));
end;

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

end.