source: branches/CpuSingleSize/Assembler.pas

unit Assembler;

interface

uses
  Classes, SysUtils, Instructions, Cpu, Generics.Collections,
  Memory, Message, Parser;

type
  { TLabelRef }

  TLabelRef = record
    LabelName: string;
    RefPos: Integer;
    TextPos: TPoint;
    class function Create(LabelName: string; RefPos: Integer): TLabelRef; static;
  end;

  { TAssembler }

  TAssembler = class
  private
    FOnError: TErrorEvent;
    Parser: TParser;
    function ParseVar: Boolean;
    function ParseDb: Boolean;
    function ParseOrg: Boolean;
    function ParseInstruction: Boolean;
    function ParseLabel: Boolean;
    procedure UpdateLabelRefs;
    procedure ParseNumParam(Token: TToken);
  public
    InstructionSet: TInstructionSet;
    Memory: TMemory;
    Labels: TDictionary<string, Integer>;
    LabelRefs: TList<TLabelRef>;
    Variables: TDictionary<string, Integer>;
    Message: TMessages;
    procedure Error(Text: string; Pos: TPoint);
    procedure Compile(Source: string);
    procedure LoadFromFile(FileName: string);
    function ParseStr(var Text: string; Separator: string): string;
    constructor Create;
    destructor Destroy; override;
    property OnError: TErrorEvent read FOnError write FOnError;
  end;


implementation

{ TLabelRef }

class function TLabelRef.Create(LabelName: string; RefPos: Integer): TLabelRef;
begin
  Result.LabelName := LabelName;
  Result.RefPos := RefPos;
end;

{ TAssembler }

procedure TAssembler.UpdateLabelRefs;
var
  I: Integer;
  Addr: Integer;
begin
  for I := 0 to LabelRefs.Count - 1 do begin
    if Labels.TryGetValue(LabelRefs[I].LabelName, Addr) then
      Memory[LabelRefs[I].RefPos] := Addr
      else Error('Label ' + LabelRefs[I].LabelName + ' referenced but not defined.', LabelRefs[I].TextPos);
  end;
end;

procedure TAssembler.ParseNumParam(Token: TToken);
var
  Addr: TInteger;
begin
  if Token.Kind = tkNumber then begin
    if TryStrToInt(Token.Value, Addr) then begin
      Memory.Write(Addr);
    end;
  end else
  if Token.Kind = tkIdentifier then begin;
    if Variables.TryGetValue(Token.Value, Addr) then begin
      Memory.Write(Addr);
    end else
    if Labels.TryGetValue(Token.Value, Addr) then begin
      Memory.Write(Addr);
    end else begin
      LabelRefs.Add(TLabelRef.Create(Token.Value, Memory.Position));
      Memory.Write(0);
    end;
  end else Error('Unexpected token ' + Token.Value + '.', Token.Pos);
end;

procedure TAssembler.Error(Text: string; Pos: TPoint);
begin
  Message.AddMessage(Text, Pos);
  if Assigned(FOnError) then
    FOnError(Text, Pos);
end;

procedure TAssembler.Compile(Source: string);
begin
  Message.Clear;
  Memory.Size := 0;
  Labels.Clear;
  LabelRefs.Clear;
  Parser.Reset;
  Parser.Source := Source;
  while not Parser.CheckNextKind(tkEof) do begin
    ParseLabel;
    if ParseVar then begin
    end else
    if ParseDb then begin
    end else
    if ParseOrg then begin
    end else
    if ParseInstruction then begin
    end;
    if Parser.CheckNextKind(tkEof) then begin
    end else Parser.Expect(tkEol);
  end;
  Parser.Expect(tkEof);
  UpdateLabelRefs;
  Error('Compilation finished.', Point(0, 0));
end;

function TAssembler.ParseVar: Boolean;
var
  TokenName: TToken;
  TokenValue: TToken;
  Number: TInteger;
begin
  Result := False;
  if Parser.CheckNextAndRead(tkIdentifier, 'VAR') then begin
    Result := True;
    while True do begin
      TokenName := Parser.ReadNext;
      if TokenName.Kind = tkIdentifier then begin
        TokenValue := Parser.ReadNext;
        if TokenValue.Kind = tkNumber then begin
          if not Labels.ContainsKey(TokenName.Value) and not Variables.ContainsKey(TokenName.Value) then begin
            if TryStrToInt(TokenValue.Value, Number) then
              Variables.Add(TokenName.Value, Number)
            else Error('Expected number', TokenValue.Pos);
          end else Error('Duplicate variable name ' + TokenName.Value, TokenName.Pos);
        end else Error('Expected variable value.', TokenValue.Pos);
      end else Error('Expected variable name.', TokenName.Pos);
      if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
        Continue;
      end;
      Break;
    end;
  end;
end;

function TAssembler.ParseDb: Boolean;
var
  Token: TToken;
begin
  Result := False;
  if Parser.CheckNextAndRead(tkIdentifier, 'DB') then begin
    Result := True;
    while True do begin
      Token := Parser.ReadNext;
      if Token.Kind = tkString then begin
        Memory.WriteString(Token.Value);
      end else
        ParseNumParam(Token);
      if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
        Continue;
      end;
      Break;
    end;
  end;
end;

function TAssembler.ParseOrg: Boolean;
var
  Token: TToken;
begin
  Result := False;
  if Parser.CheckNextAndRead(tkIdentifier, 'ORG') then begin
    Result := True;
    Token := Parser.ReadNext;
    if Token.Kind = tkNumber then begin
      Memory.Position := StrToInt(Token.Value);
    end else Error('Expected number but ' + Token.Value + ' found.', Token.Pos);
  end;
end;

function TAssembler.ParseInstruction: Boolean;
var
  InstructionInfo: TInstructionInfo;
  I: Integer;
  Token: TToken;
  LastPos: TParserPos;
  Number: Integer;
begin
  Result := False;
  LastPos := Parser.Pos;
  Token := Parser.ReadNext;
  InstructionInfo := InstructionSet.SearchName(Token.Value);
  if Assigned(InstructionInfo) then begin
    Result := True;
    Memory.Write(Integer(InstructionInfo.Instruction));
    for I := 0 to Length(InstructionInfo.Params) - 1 do begin
      if I > 0 then
        Parser.Expect(tkSpecialSymbol, ',');
      if InstructionInfo.Params[I] = ptNumber then begin
        Token := Parser.ReadNext;
        ParseNumParam(Token);
      end else
      if InstructionInfo.Params[I] = ptReg then begin
        Token := Parser.ReadNext;
        if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
          Token.Value := Copy(Token.Value, 2, MaxInt);
          if TryStrToInt(Token.Value, Number) then
            Memory.Write(Number)
            else Error('Expected numeric register index error', Token.Pos);
        end else Error('Expected register name starting with R character.', Token.Pos);
      end else
      if InstructionInfo.Params[I] = ptRegIndirect then begin
        Parser.Expect(tkSpecialSymbol, '(');
        Token := Parser.ReadNext;
        if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
          Token.Value := Copy(Token.Value, 2, MaxInt);
          if TryStrToInt(Token.Value, Number) then
            Memory.Write(Number)
            else Error('Expected numeric register index error', Token.Pos);
        end else Error('Expected register name starting with R character.', Token.Pos);
        Parser.Expect(tkSpecialSymbol, ')');
      end else
      if InstructionInfo.Params[I] = ptRegIndirectIndex then begin
        Parser.Expect(tkSpecialSymbol, '(');
        Token := Parser.ReadNext;
        if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
          Token.Value := Copy(Token.Value, 2, MaxInt);
          if TryStrToInt(Token.Value, Number) then begin
            Memory.Write(Number);
            Parser.Expect(tkSpecialSymbol, '+');
            Token := Parser.ReadNext;
            ParseNumParam(Token);
          end else Error('Expected numeric register index error', Token.Pos);
        end else Error('Expected register name starting with R character.', Token.Pos);
        Parser.Expect(tkSpecialSymbol, ')');
      end else
      if InstructionInfo.Params[I] = ptRegIndirectGroup then begin
        Parser.Expect(tkSpecialSymbol, '(');
        Token := Parser.ReadNext;
        if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
          Token.Value := Copy(Token.Value, 2, MaxInt);
          if TryStrToInt(Token.Value, Number) then begin
            Memory.Write(Number);
            Parser.Expect(tkSpecialSymbol, ':');
            Token := Parser.ReadNext;
            if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
              Token.Value := Copy(Token.Value, 2, MaxInt);
              if TryStrToInt(Token.Value, Number) then begin
                Memory.Write(Number);
              end else Error('Expected numeric register index error', Token.Pos);
            end else Error('Expected register name starting with R character.', Token.Pos);
          end else Error('Expected numeric register index error', Token.Pos);
        end else Error('Expected register name starting with R character.', Token.Pos);
        Parser.Expect(tkSpecialSymbol, ')');
      end else
    end;
  end;
  if not Result then Parser.Pos := LastPos;
end;

function TAssembler.ParseLabel: Boolean;
var
  LastPos: TParserPos;
  Token: TToken;
  Addr: Integer;
begin
  Result := False;
  LastPos := Parser.Pos;
  Token := Parser.ReadNext;
  if Parser.CheckNextAndRead(tkSpecialSymbol, ':') then begin
    Result := True;
    if not Labels.TryGetValue(Token.Value, Addr) then begin
      Labels.Add(Token.Value, Memory.Position);
    end else Error('Duplicate label ' + Token.Value + '.', Token.Pos);
  end;
  if not Result then Parser.Pos := LastPos;
end;

procedure TAssembler.LoadFromFile(FileName: string);
var
  Lines: TStringList;
begin
  Lines := TStringList.Create;
  try
    Lines.LoadFromFile(FileName);
    Compile(Lines.Text);
  finally
    Lines.Free;
  end;
end;

function TAssembler.ParseStr(var Text: string; Separator: string): string;
var
  P: Integer;
begin
  P := Pos(Separator, Text);
  if P > 0 then begin
    Result := Trim(Copy(Text, 1, P - 1));
    Text := Trim(Copy(Text, P + 1, MaxInt));
  end else begin
    Result := Trim(Text);
    Text := '';
  end;
end;

constructor TAssembler.Create;
begin
  Parser := TParser.Create;
  Parser.OnError := Error;
  Message := TMessages.Create;
  Memory := TMemory.Create;
  InstructionSet := TInstructionSet.Create;
  Labels := TDictionary<string, Integer>.Create;
  LabelRefs := TList<TLabelRef>.Create;
  Variables := TDictionary<string, Integer>.Create;
end;

destructor TAssembler.Destroy;
begin
  FreeAndNil(Variables);
  FreeAndNil(Labels);
  FreeAndNil(LabelRefs);
  FreeAndNil(InstructionSet);
  FreeAndNil(Memory);
  FreeAndNil(Message);
  FreeAndNil(Parser);
  inherited;
end;

end.