source: branches/AVR/UMainForm.pas

unit UMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UInstructionDefinition, StdCtrls, UIntelHexFile;

type
  TStringArray = array of string;

  TOperandType = (otNone, otRegister, otConstant, otIOAddress, otDisplacement,
    otIndirectAddressRegister, otBit, otAddress);

  TOperand = class
  public
    OperandType: TOperandType;
    Mask: Word;
    procedure Init(AOperandType: TOperandType; AMask: Word);
  end;

  TInstruction = class
  private
    procedure AddOperand(OperandType: TOperandType; Mask: Word);
  public
    ShortName: string;
    FullName: string;
    Cycles: Byte;
    Opcode: Word;
    OpcodeMask: Word;
    Operands: TList; // TList<TOperand>;
    constructor Create;
    procedure Init(AShortName: string; AOpcode: Word; AOpcodeMask: Word;
      AFullName: string);
    destructor Destroy;
  end;

  TFlags = record
    Carry: Boolean;
    Zero: Boolean;
    Negative: Boolean;
    TwosComplementOverflow: Boolean;
    HalfCarray: Boolean;
    GlobalInterruptEnable: Boolean;
  end;

  TRegisters = record
    R: array[0..31] of Byte;
    SP: Word;
    PC: Word;
    SREG: Byte;
  end;

  TAVRCore = class
  private
    Instructions: TList; // TList<TInstruction>
    function BitSubRange(Value: Cardinal; Start, Count: Byte): Cardinal;
    procedure OpcodeAdd(Operand1, Operand2: Word);
    procedure OpcodeAdc(Operand1, Operand2: Word);
  public
    Registers: TRegisters;
    Flags: TFlags;
    ProgramMemory: array [0..12800] of Byte;
    Memory: array [0..65535] of Byte;

    constructor Create;
    procedure ExecuteInstruction;
    procedure Init;
    procedure Run;
    destructor Destroy;
  end;


  TMainForm = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    AVRCore: TAVRCore;
    BinaryCode: TIntelHexFile;
    procedure Analyze;
    function ParseString(var Text: string; Separator: string): string;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TAVRCore }

function TAVRCore.BitSubRange(Value: Cardinal; Start, Count: Byte): Cardinal;
begin
  if Start + Count > 31 then raise ERangeError.Create('BitSubRange range overflow.');
  Result := (Value shr Start) and ((1 shl Count) - 1);
end;

constructor TAVRCore.Create;
begin
  Instructions := TList.Create;
end;

destructor TAVRCore.Destroy;
var
  I: Integer;
begin
  for I := 0 to Instructions.Count - 1 do
    TInstruction(Instructions[I]).Destroy;
  Instructions.Destroy;
end;

procedure TAVRCore.ExecuteInstruction;
var
  Instruction: Word;
  Source: Word;
  Destination: Word;
  I: Integer;
begin
  Instruction := ProgramMemory[Registers.PC];
  Inc(Registers.PC);                                 
  I := 0;
  while (I < Instructions.Count) and
    ((Instruction and TInstruction(Instructions[I]).OpcodeMask) <>
    TInstruction(Instructions[I]).Opcode) do
      Inc(I);
  if I < Instructions.Count then with TInstruction(Instructions[I]) do begin
    MainForm.Memo2.Lines.Add(ShortName);

  end else raise Exception.Create('Neznámá instrukce');
end;

procedure TAVRCore.Init;
begin
  with Instructions do begin
    with TInstruction(Items[Add(TInstruction.Create)]) do begin
      Init('ADC', $1c00, $fc00, 'Add with Carry');
      with Operands do begin
        with TOperand(Items[Add(TOperand.Create)]) do Init(otRegister, $01f0);
        with TOperand(Items[Add(TOperand.Create)]) do Init(otRegister, $01f0);
      end;
    end;
    with TInstruction(Items[Add(TInstruction.Create)]) do begin
      Init('ADD', $0c00, $fc00, 'Add without Carry');
      with Operands do begin
        with TOperand(Items[Add(TOperand.Create)]) do Init(otRegister, $01f0);
        with TOperand(Items[Add(TOperand.Create)]) do Init(otRegister, $01f0);
      end;
    end;
    with TInstruction(Items[Add(TInstruction.Create)]) do begin
      Init('ADIW', $9600, $ff00, 'Add immediate to Word');
    end;
  end;
end;

procedure TAVRCore.OpcodeAdc(Operand1, Operand2: Word);
begin
  Registers.R[Operand1] := Registers.R[Operand1] + Registers.R[Operand2];
  //  Registers.;
end;

procedure TAVRCore.OpcodeAdd(Operand1, Operand2: Word);
begin
  Registers.R[Operand1] := Registers.R[Operand1] + Registers.R[Operand2];
end;

procedure TAVRCore.Run;
begin
  repeat
    ExecuteInstruction;
  until False;
end;

procedure TMainForm.Analyze;
var
  I: Integer;
  Row: string;
  RowParts: TStringArray;
  LabelPart: string;
  InstructionPart: string;
  Operand1: string;
  Operand2: string;
begin
  for I := 0 to Memo1.Lines.Count - 1 do begin
    Row := Memo1.Lines[I];
    Row := StringReplace(Row, #9, ' ', [rfReplaceAll]);
    LabelPart := Trim(ParseString(Row, ':'));
    InstructionPart := Trim(ParseString(Row, ' '));
    Operand1 := Trim(ParseString(Row, ','));
    Operand2 := Trim(ParseString(Row, ''));
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  Analyze;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Memo1.Lines.SaveToFile('sample.asm');
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  AVRCore := TAVRCore.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  AVRCore.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  Buffer: TArrayOfByte;
  I: Integer;
begin
  Memo1.Lines.LoadFromFile('sample.asm');
  BinaryCode := TIntelHexFile.Create('tester_E291.hex', fmOpenRead);
  Buffer := BinaryCode.ReadContent;
  for I := 0 to (Length(Buffer) - 1) div 2 do
    AVRCore.ProgramMemory[I] := Buffer[I * 2] or (Buffer[I * 2 + 1] shl 8);
  AVRCore.Run;
end;

function TMainForm.ParseString(var Text: string; Separator: string): string;
begin
  Result := Copy(Text, 1, Pos(Separator, Text) - 1);
  Delete(Text, 1, Length(Result) + 1);
end;

{ TInstruction }

procedure TInstruction.AddOperand(OperandType: TOperandType; Mask: Word);
begin

end;

constructor TInstruction.Create;
begin
  Operands := TList.Create;
end;

destructor TInstruction.Destroy;
var
  I: Integer;
begin
  for I := 0 to Operands.Count - 1 do
    TOperand(Operands[I]).Free;
  Operands.Destroy;
end;

procedure TInstruction.Init(AShortName: string; AOpcode, AOpcodeMask: Word;
  AFullName: string);
begin
  ShortName := AShortName;
  Opcode := AOpcode;
  OpcodeMask := AOpcodeMask;
  FullName := AFullName;
end;

{ TOperand }

procedure TOperand.Init(AOperandType: TOperandType; AMask: Word);
begin
  OperandType := AOperandType;
  Mask := AMask;
end;

end.