Ignore:
Timestamp:
Apr 25, 2019, 4:20:43 PM (6 years ago)
Author:
chronos
Message:
  • Added: Basic assembler window.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/virtualcpu4/UAssembler.pas

    r181 r184  
    66
    77uses
    8   Classes, SysUtils;
     8  Classes, SysUtils, fgl, UCpu, UOpcode, UInstructionWriter;
    99
    1010type
     11  TErrorEvent = procedure (Text: string) of object;
     12
     13  { TParser }
     14
     15  TParser = class
     16  private
     17    FOnError: TErrorEvent;
     18    procedure Error(Text: string);
     19  public
     20    Text: string;
     21    procedure Expect(Text: string);
     22    function ReadNext: string;
     23    function EndOfText: Boolean;
     24    property OnError: TErrorEvent read FOnError write FOnError;
     25  end;
     26
     27  TLabel = class
     28    Name: string;
     29    Address: QWord;
     30  end;
     31
     32  TLabels = class(TFPGObjecTList<TLabel>)
     33
     34  end;
     35
    1136  { TAssembler }
    1237
    1338  TAssembler = class
     39  private
     40    FOnError: TErrorEvent;
     41    OpcodeDefs: TOpcodeDefs;
     42    procedure Error(Text: string);
     43    procedure ParseParam(Param: TOpcodeParam);
     44  public
     45    Parser: TParser;
     46    Labels: TLabels;
    1447    Source: TStringList;
    15     Dest: array of Byte;
     48    InstructionWriter: TInstructionWriter;
    1649    procedure Compile;
     50    constructor Create;
     51    destructor Destroy; override;
     52    property OnError: TErrorEvent read FOnError write FOnError;
    1753  end;
    1854
     
    2056implementation
    2157
     58{ TParser }
     59
     60procedure TParser.Error(Text: string);
     61begin
     62  if Assigned(FOnError) then FOnError(Text);
     63end;
     64
     65procedure TParser.Expect(Text: string);
     66var
     67  Next: string;
     68begin
     69  Next := ReadNext;
     70  if Next <> Text then
     71    Error('Expected ' + Text + ' but ' + Next + ' found');
     72end;
     73
     74function TParser.ReadNext: string;
     75var
     76  P: Integer;
     77begin
     78  Text := Trim(Text);
     79  P := 1;
     80  if (Length(Text) > 0) and (Text[P] = ',') then begin
     81    Result := Text[P];
     82    Delete(Text, 1, 1);
     83  end else begin
     84    while (P <= Length(Text)) and (Text[P] <> ' ') and (Text[P] <> ',') do Inc(P);
     85    Result := Copy(Text, 1, P - 1);
     86    Delete(Text, 1, P - 1);
     87  end;
     88end;
     89
     90function TParser.EndOfText: Boolean;
     91begin
     92  Result := Text = '';
     93end;
     94
    2295{ TAssembler }
    2396
     97procedure TAssembler.Error(Text: string);
     98begin
     99  if Assigned(FOnError) then FOnError(Text);
     100end;
     101
     102procedure TAssembler.ParseParam(Param: TOpcodeParam);
     103var
     104  Reg: TRegIndex;
     105  Addr: QWord;
     106  Next: string;
     107begin
     108  if Param = prReg then begin
     109    Next := Parser.ReadNext;
     110    if (Length(Next) > 1) and (Next[1] = 'R') then
     111      Reg := StrToInt(Copy(Next, 2, Length(Next)))
     112    else Error('Expected register name but found ' + Next);
     113    InstructionWriter.Write8(Reg);
     114  end else
     115  if Param = prData then begin
     116    Next := Parser.ReadNext;
     117    InstructionWriter.WriteData(StrToInt(Next));
     118  end else
     119  if Param = prAddr then begin
     120    Next := Parser.ReadNext;
     121    InstructionWriter.WriteAddress(StrToInt(Next));
     122  end else
     123  if Param = prAddrRel then begin
     124    Next := Parser.ReadNext;
     125    InstructionWriter.WriteAddress(StrToInt(Next));
     126  end;
     127end;
     128
    24129procedure TAssembler.Compile;
     130var
     131  I: Integer;
     132  NewLabel: TLabel;
     133  Next: string;
     134  OpcodeDef: TOpcodeDef;
    25135begin
     136  InstructionWriter.Init;
     137  Labels.Clear;
     138  for I := 0 to Source.Count - 1 do begin
     139    Parser.Text := Source[I];
     140    Next := Parser.ReadNext;
     141    if (Length(Next) > 0) and (Next[Length(Next)] = ':') then begin
     142      NewLabel := TLabel.Create;
     143      NewLabel.Name := Copy(Next, 1, Length(Next) - 1);
     144      //NewLabel.Address := ;
     145      Labels.Add(NewLabel);
     146      Next := Parser.ReadNext;
     147    end;
     148    OpcodeDef := OpcodeDefs.SearchByName(Next);
     149    if Assigned(OpcodeDef) then begin
     150      InstructionWriter.Write8(Byte(OpcodeDef.Opcode));
     151      ParseParam(OpcodeDef.Param1);
     152      if OpcodeDef.Param2 <> prNone then begin
     153        Parser.Expect(',');
     154        ParseParam(OpcodeDef.Param2);
     155        if OpcodeDef.Param3 <> prNone then begin
     156          Parser.Expect(',');
     157          ParseParam(OpcodeDef.Param3);
     158        end;
     159      end;
     160    end else Error('Unknown instruction ' + Next);
     161  end;
     162end;
    26163
     164constructor TAssembler.Create;
     165begin
     166  OpcodeDefs := TOpcodeDefs.Create;
     167  Source := TStringList.Create;
     168  Labels := TLabels.Create;
     169  Parser := TParser.Create;
     170  Parser.OnError := Error;
     171  InstructionWriter := TInstructionWriter.Create;
     172end;
     173
     174destructor TAssembler.Destroy;
     175begin
     176  FreeAndNil(InstructionWriter);
     177  FreeAndNil(Parser);
     178  FreeAndNil(Labels);
     179  FreeAndNil(Source);
     180  FreeAndNil(OpcodeDefs);
     181  inherited Destroy;
    27182end;
    28183
Note: See TracChangeset for help on using the changeset viewer.