source: branches/virt simple/UCompiler.pas

unit UCompiler;

{$mode delphi}

interface

uses
  Classes, SysUtils, UMachine;

type
  { TCompiler }

  TCompiler = class
  private
    Labels: TStringList;
    function GetPart(var Text: string; Separator: string): string;
    procedure ParseLine(Line: string; Instructions: TInstructions);
    function GetOpcodeFromName(Name: string): Integer;
  public
    Lines: TStringList;
    procedure Compile(Instructions: TInstructions);
    constructor Create;
    destructor Destroy; override;
  end;


implementation

{ TCompiler }

function TCompiler.GetPart(var Text: string; Separator: string): string;
begin
  if Pos(Separator, Text) > 0 then begin
    Result := Copy(Text, 1, Pos(Separator, Text) - 1);
    Delete(Text, 1, Length(Result) + Length(Separator));
  end else begin
    Result := Text;
    Text := '';
  end;
end;

procedure TCompiler.ParseLine(Line: string; Instructions: TInstructions);
var
  Name: string;
  OpcodeIndex: Integer;
  Param1: string;
  Param2: string;
  ParamType1: TParamType;
  Indirect1: TMemoryType;
  Value1: Integer;
  ParamType2: TParamType;
  Indirect2: TMemoryType;
  Value2: Integer;
  OutValue: Integer;
  LineLabel: string;
  I: Integer;
begin
  Line := Trim(Line);
  // Strip comments
  if Pos(';', Line) > 0 then begin
    Line := Trim(Copy(Line, 1, Pos(';', Line) - 1));
  end;
  if Pos(':', Line) > 0 then begin
    LineLabel := Trim(GetPart(Line, ':'));
    if Labels.IndexOf(LineLabel) <> -1 then raise Exception.Create('Label ' + LineLabel + ' already defined');
    Labels.AddObject(LineLabel, TObject(Instructions.Count));
  end;
  if Line = '' then Exit;
  Name := Trim(GetPart(Line, ' '));
  OpcodeIndex := GetOpcodeFromName(Name);
  if OpcodeIndex = -1 then raise Exception.Create('Unsupported instruction name: ' + Name)
  else begin
    Param1 := Trim(GetPart(Line, ','));
    if Param1 <> '' then begin
    if (Copy(Param1, 1, 1) = '[') and (Copy(Param1, Length(Param1), 1) = ']') then begin
      Indirect1 := mtData;
      Param1 := Trim(Copy(Param1, 2, Length(Param1) - 2));
    end else Indirect1 := mtNone;
    if Copy(Param1, 1, 1) = 'R' then begin
      ParamType1 := ptRegister;
      Value1 := StrToInt(Copy(Param1, 2, Length(Param1)));
    end else
    if Param1 = 'IP' then begin
      ParamType1 := ptSpecialRegister;
      Value1 := 0;
    end else
    if Param1 = 'SP' then begin
      ParamType1 := ptSpecialRegister;
      Value1 := 1;
    end else begin
      ParamType1 := ptConst;
      if TryStrToInt(Param1, OutValue) then begin
        Value1 := OutValue;
      end else begin
        I := Labels.IndexOf(Param1);
        if I <> -1 then Value1 := Integer(Labels.Objects[I])
          else raise Exception.Create('Unsupported parameter value ' + Param1);
      end;
    end;
    end else ParamType1 := ptNone;

    Param2 := Trim(GetPart(Line, ','));
    if Param2 <> '' then begin
    if (Copy(Param2, 1, 1) = '[') and (Copy(Param2, Length(Param2), 1) = ']') then begin
      Indirect2 := mtData;
      Param2 := Trim(Copy(Param2, 2, Length(Param2) - 2));
    end else Indirect2 := mtNone;
    if Copy(Param2, 1, 1) = 'R' then begin
      ParamType2 := ptRegister;
      Value2 := StrToInt(Copy(Param2, 2, Length(Param2)));
    end else
    if Param2 = 'IP' then begin
      ParamType2 := ptSpecialRegister;
      Value2 := 0;
    end else
    if Param2 = 'SP' then begin
      ParamType2 := ptSpecialRegister;
      Value2 := 1;
    end else begin
      ParamType2 := ptConst;
      if TryStrToInt(Param2, OutValue) then begin
        Value2 := OutValue;
      end else begin
        I := Labels.IndexOf(Param2);
        if I <> -1 then Value2 := Integer(Labels.Objects[I])
          else raise Exception.Create('Unsupported parameter value ' + Param2);
      end;
    end;
    end else ParamType2 := ptNone;

    Instructions.AddInst(TOpcode(OpcodeIndex), ParamType1, Indirect1, Value1,
      ParamType2, Indirect2, Value2);
  end;
end;

function TCompiler.GetOpcodeFromName(Name: string): Integer;
var
  I: Integer;
begin
  I := 0;
  while (I < Length(OpcodeString)) and (OpcodeString[TOpcode(I)] <> Name) do Inc(I);
  if I < Length(OpcodeString) then Result := I
    else Result := -1;
end;

procedure TCompiler.Compile(Instructions: TInstructions);
var
  I: Integer;
begin
  Labels.Clear;
  Instructions.Clear;
  for I := 0 to Lines.Count - 1 do begin
    ParseLine(Lines[I], Instructions);
  end;
end;

constructor TCompiler.Create;
begin
  Lines := TStringList.Create;
  Labels := TStringList.Create;
end;

destructor TCompiler.Destroy;
begin
  FreeAndNil(Labels);
  FreeAndNil(Lines);
  inherited Destroy;
end;

end.