lazarus/components/fpdebug/fpdbgdisasavr.pp

1580 lines
57 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{ $Id$ }
{
---------------------------------------------------------------------------
fpdbgdisasavr.pp - Native Freepascal debugger - avr Disassembler
---------------------------------------------------------------------------
This unit contains an avr disassembler for the Native Freepascal debugger
---------------------------------------------------------------------------
@created(Mon Oct 18th 2019)
@lastmod($Date$)
@author()
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit FpDbgDisasAvr;
{$mode objfpc}{$H+}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}
interface
uses
SysUtils,
FpDbgUtil, FpDbgInfo, DbgIntfBaseTypes, FpdMemoryTools, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif},
FpDbgClasses;
type
//The function Disassemble decodes the instruction at the given address.
//Unrecognized instructions are assumed to be data statements [dw XXXX]
TAvrAsmDecoder = class;
TAVROpCode = (
A_ADC, A_ADD, A_ADIW, A_AND, A_ANDI, A_ASR, A_BLD, A_BR, A_BREAK, A_BST,
A_CALL, A_CBI, A_CL, A_COM, A_CP, A_CPC, A_CPI, A_CPSE, A_DEC, A_DES,
A_EICALL, A_EIJMP, A_ELPM, A_EOR, A_FMUL, A_FMULS, A_FMULSU, A_ICALL, A_IJMP, A_IN,
A_INC, A_JMP, A_LAC, A_LAS, A_LAT, A_LD, A_LDD, A_LDI, A_LDS, A_LPM,
A_LSL, A_LSR, A_MOV, A_MOVW, A_MUL, A_MULS, A_MULSU, A_NEG, A_NOP, A_OR,
A_ORI, A_OUT, A_POP, A_PUSH, A_RCALL, A_RET, A_RETI, A_RJMP, A_ROL, A_ROR,
A_SBC, A_SBCI, A_SBI, A_SBIC, A_SBIS, A_SBIW, A_SBR, A_SBRC, A_SBRS, A_SE,
A_SER, A_SLEEP, A_SPM, A_ST, A_STD, A_STS, A_SUB, A_SUBI, A_SWAP, A_WDR,
A_XCH, A_INVALID);
TAVRInstruction = record
OpCode: TAVROpCode;
OpCodeMod: integer; // Use as index to general opcode modifiers, typically in range 0..7
Size: integer;
Oper: array[1..2] of integer;
end;
TOperandFormat = (ofNone, ofDecimal, ofHex8, ofHex16, ofHex32, ofReg, ofIndex, ofIndexOffset, ofRelAddr);
// Information mostly for formatting
TAvrInstructionInfo = record
OpName: string;
OperCount: integer;
OperandFormats: array[1..2] of TOperandFormat;
end;
{ TAvrDisassembler }
TAvrDisassembler = object
private
function InvalidOpCode(instr: word): TAVRInstruction;
function SetInstructionInfo(AOpCode: TAVROpCode; AOpcodeMod: integer;
ASize: integer; AOper: array of integer): TAVRInstruction;
public
procedure Disassemble(var AAddress: Pointer; out AnInstruction: TAVRInstruction);
end;
{ TAvrAsmInstruction }
TAvrAsmInstruction = class(TDbgAsmInstruction)
private const
INSTR_CODEBIN_LEN = 4;
private
FProcess: TDbgProcess;
FAddress: TDBGPtr;
FCodeBin: array[0..INSTR_CODEBIN_LEN-1] of byte;
FAvrInstruction: TAVRInstruction;
FFlags: set of (diCodeRead, diCodeReadError, diDisAss);
protected
procedure ReadCode; inline;
procedure Disassemble; inline;
public
constructor Create(AProcess: TDbgProcess);
procedure SetAddress(AnAddress: TDBGPtr);
function IsCallInstruction: boolean; override;
function IsReturnInstruction: boolean; override;
function IsLeaveStackFrame: boolean; override;
function InstructionLength: Integer; override;
end;
{ TAvrAsmDecoder }
TAvrAsmDecoder = class(TDbgAsmDecoder)
private const
MaxPrologueSize = 64; // Bytes, so ~32 instructions
MaxEpilogueSize = MaxPrologueSize; // Perhaps a bit smaller, since the locals/parameters do not have to be initialized
MAX_CODEBIN_LEN = MaxPrologueSize; // About 32 instructions
// Opcodes for prologue / epilogue parsing
OpCodeNOP = $0000;
OpCodeLoadSPL = $B7CD; // in r28, 0x3d
OpCodeLoadSPH = $B7DE; // in r29, 0x3e
OpCodeLoadSRegR0 = $B60F; // in r0, 0x3f
OpCodeLoadSRegR16 = $B70F; // in r16, 0x3f, avrtiny subarch
OpCodeCli = $94F8; // cli
OpCodeSetSPH = $BFDE; // out 0x3e, r29
OpCodeSetSPL = $BFCD; // out 0x3d, r28
OpCodeSetSregR0 = $BE0F; // out 0x3f, r0
OpCodeSetSregR16 = $BF0F; // out 0x3f, r16
OpCodeRet = $9508; // ret
OpCodeReti = $9518; // reti
// Zero register gets zeroed at start of interrupt
OpCodeZeroR1 = $2411; // eor r1, r1
OpCodeZeroR16 = $2700; // eor r16, r16
OpCodePushMask = $920F; // PUSH 1001 001d dddd 1111
OpCodePopMask = $900F; // POP 1001 000d dddd 1111
// Frame pointer is r28:r29, so fix register index in opcode
OpCodeAdjustFrameLMask = $50C0; // subi r28, k, 0101 kkkk dddd kkkk, rd = 16 + d
OpCodeAdjustFrameHMask = $40D0; // sbci r28, k, 0100 kkkk dddd kkkk, rd = 16 + d
// Not yet implemented in FPC, but more compact option to set frame pointer
OpCodeAdjustFrameMask = $9720; // sbiw r28, k, 1001 0111 kkdd kkkk, rd = 24 + d*2
OpCodeStoreOnStackMask = $8208; // std Y+2, r24 10q0 qq1r rrrr 1qqq
private
FProcess: TDbgProcess;
FLastErrWasMem: Boolean;
FCodeBin: array[0..MAX_CODEBIN_LEN-1] of byte;
FLastInstr: TAvrAsmInstruction;
function FParsePrologue(AnAddress, AStartPC, AEndPC: TDBGPtr; out
returnAddressOffset: word; out AnIsOutsideFrame: Boolean): Boolean;
function FParseEpilogue(AnAddress, AStartPC, AEndPC: TDBGPtr; out
returnAddressOffset: word; out AnIsOutsideFrame: Boolean): Boolean;
function FormatInstruction(instr: TAVRInstruction): string;
protected
function GetLastErrorWasMemReadErr: Boolean; override;
function GetMaxInstrSize: integer; override;
function GetMinInstrSize: integer; override;
function GetCanReverseDisassemble: boolean; override;
function ReadCodeAt(AnAddress: TDBGPtr; var ALen: Cardinal): Boolean; inline;
public
procedure Disassemble(var AAddress: Pointer; out ACodeBytes: String; out ACode: String; out AnInfo: TDbgInstInfo); override; overload;
procedure Disassemble(var AAddress: Pointer; out ACodeBytes: String; out ACode: String); override; overload;
function GetInstructionInfo(AnAddress: TDBGPtr): TDbgAsmInstruction; override;
// Don't use, not really suited to AVR ABI
function GetFunctionFrameInfo(AnAddress: TDBGPtr; out
AnIsOutsideFrame: Boolean): Boolean; override;
// Rather use the next function to locate the call return address.
// AStartPC & AEndPC indicates proc limits to help with scanning for prologue/epilogue
// returnAddressOffset gives the offset to return address relative to Y pointer (r28:r29) inside frame
// else returnAddressOffset gives the offset to return address relative to SP
function GetFunctionFrameReturnAddress(AnAddress, AStartPC, AEndPC: TDBGPtr; out
returnAddressOffset: word; out AnIsOutsideFrame: Boolean): Boolean;
constructor Create(AProcess: TDbgProcess); override;
destructor Destroy;
end;
{ TDbgStackUnwinderAVR }
TDbgStackUnwinderAVR = class(TDbgStackUnwinder)
private
FThread: TDbgThread;
FProcess: TDbgProcess;
FAddressSize: Integer;
FLastFrameBaseIncreased: Boolean;
FCodeReadErrCnt: integer;
protected
property Process: TDbgProcess read FProcess;
property Thread: TDbgThread read FThread;
property AddressSize: Integer read FAddressSize;
public
constructor Create(AProcess: TDbgProcess);
procedure InitForThread(AThread: TDbgThread); override;
procedure InitForFrame(ACurrentFrame: TDbgCallstackEntry; out CodePointer,
StackPointer, FrameBasePointer: TDBGPtr); override;
procedure GetTopFrame(out CodePointer, StackPointer, FrameBasePointer: TDBGPtr;
out ANewFrame: TDbgCallstackEntry); override;
function Unwind(AFrameIndex: integer; var CodePointer, StackPointer,
FrameBasePointer: TDBGPtr; ACurrentFrame: TDbgCallstackEntry; out
ANewFrame: TDbgCallstackEntry): TTDbgStackUnwindResult; override;
end;
implementation
uses
StrUtils, LazClasses, Math,
FpDbgAvrClasses;
var
DBG_WARNINGS: PLazLoggerLogGroup;
const
statusFlagNames: array[0..7] of char = ('c', 'z', 'n', 'v', 's', 'h', 't', 'i');
branchConditionStr: array[0..15] of string = (
'cs', 'eq', 'mi', 'vs', 'lt', 'hs', 'ts', 'ie',
'cc', 'ne', 'pl', 'vc', 'ge', 'hc', 'tc', 'id');
OpCodeInfo: array[A_ADC..A_INVALID] of TAvrInstructionInfo = (
(OpName: 'adc'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'add'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'adiw'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'and'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'andi'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'asr'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'bld'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'br'; OperCount: 1; OperandFormats: (ofRelAddr, ofNone)),
(OpName: 'break'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'bst'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'call'; OperCount: 1; OperandFormats: (ofHex32, ofNone)),
(OpName: 'cbi'; OperCount: 2; OperandFormats: (ofHex8, ofDecimal)),
(OpName: 'cl'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'com'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'cp'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'cpc'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'cpi'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'cpse'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'dec'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'des'; OperCount: 1; OperandFormats: (ofHex8, ofNone)),
(OpName: 'eicall'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'eijmp'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'elpm'; OperCount: 2; OperandFormats: (ofReg, ofIndex)),
(OpName: 'eor'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'fmul'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'fmuls'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'fmulsu'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'icall'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'ijmp'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'in'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'inc'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'jmp'; OperCount: 1; OperandFormats: (ofHex32, ofNone)),
(OpName: 'lac'; OperCount: 2; OperandFormats: (ofIndex, ofReg)),
(OpName: 'las'; OperCount: 2; OperandFormats: (ofIndex, ofReg)),
(OpName: 'lat'; OperCount: 2; OperandFormats: (ofIndex, ofReg)),
(OpName: 'ld'; OperCount: 2; OperandFormats: (ofReg, ofIndex)),
(OpName: 'ldd'; OperCount: 2; OperandFormats: (ofReg, ofIndexOffset)),
(OpName: 'ldi'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'lds'; OperCount: 2; OperandFormats: (ofReg, ofHex16)),
(OpName: 'lpm'; OperCount: 2; OperandFormats: (ofReg, ofIndex)),
(OpName: 'lsl'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'lsr'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'mov'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'movw'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'mul'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'muls'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'mulsu'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'neg'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'nop'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'or'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'ori'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'out'; OperCount: 2; OperandFormats: (ofHex8, ofReg)),
(OpName: 'pop'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'push'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'rcall'; OperCount: 1; OperandFormats: (ofRelAddr, ofNone)),
(OpName: 'ret'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'reti'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'rjmp'; OperCount: 1; OperandFormats: (ofRelAddr, ofNone)),
(OpName: 'rol'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'ror'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'sbc'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'sbci'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'sbi'; OperCount: 2; OperandFormats: (ofHex8, ofDecimal)),
(OpName: 'sbic'; OperCount: 2; OperandFormats: (ofHex8, ofDecimal)),
(OpName: 'sbis'; OperCount: 2; OperandFormats: (ofHex8, ofDecimal)),
(OpName: 'sbiw'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'sbr'; OperCount: 2; OperandFormats: (ofReg, ofHex8)),
(OpName: 'sbrc'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'sbrs'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'se'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'ser'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'sleep'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'spm'; OperCount: 1; OperandFormats: (ofIndex, ofNone)),
(OpName: 'st'; OperCount: 2; OperandFormats: (ofIndex, ofReg)),
(OpName: 'std'; OperCount: 2; OperandFormats: (ofIndexOffset, ofReg)),
(OpName: 'sts'; OperCount: 2; OperandFormats: (ofHex16, ofReg)),
(OpName: 'sub'; OperCount: 2; OperandFormats: (ofReg, ofReg)),
(OpName: 'subi'; OperCount: 2; OperandFormats: (ofReg, ofDecimal)),
(OpName: 'swap'; OperCount: 1; OperandFormats: (ofReg, ofNone)),
(OpName: 'wdr'; OperCount: 0; OperandFormats: (ofNone, ofNone)),
(OpName: 'xch'; OperCount: 2; OperandFormats: (ofIndex, ofReg)),
(OpName: '.dw'; OperCount: 1; OperandFormats: (ofHex16, ofNone))
);
// Constants for describing index registers of LD, LDD, ST, STS, LP, SPM
operandNoIndex = 0;
operandX = 1;
operandXInc = 2;
operandDecrX = 3;
operandY = 4;
operandYInc = 5;
operandDecrY = 6;
operandZ = 7;
operandZInc = 8;
operandDecrZ = 9;
OperandIndexStr: array [operandX..operandDecrZ] of string = (
'X', 'X+', '-X', 'Y', 'Y+', '-Y', 'Z', 'Z+', '-Z');
procedure get_r_d_10(o: word; out r, d: byte);
begin
r := ((o shr 5) and $10) or (o and $f);
d := (o shr 4) and $1f;
end;
procedure get_k_r16(o: word; out r, k: byte);
begin
r := 16 + ((o shr 4) and $f);
k := byte((o and $0f00) shr 4) or (o and $f);
end;
{ TAvrAsmInstruction }
procedure TAvrAsmInstruction.ReadCode;
begin
if not (diCodeRead in FFlags) then begin
if not FProcess.ReadData(FAddress, INSTR_CODEBIN_LEN, FCodeBin) then
Include(FFlags, diCodeReadError);
Include(FFlags, diCodeRead);
end;
end;
procedure TAvrAsmInstruction.Disassemble;
var
a: PByte;
Disassembler: TAvrDisassembler;
begin
if not (diDisAss in FFlags) then begin
ReadCode;
if diCodeReadError in FFlags then
exit;
a := @FCodeBin[0];
Disassembler.Disassemble(a, FAvrInstruction);
Include(FFlags, diDisAss);
end;
end;
constructor TAvrAsmInstruction.Create(AProcess: TDbgProcess);
begin
FProcess := AProcess;
inherited Create;
AddReference;
end;
procedure TAvrAsmInstruction.SetAddress(AnAddress: TDBGPtr);
begin
FAddress := AnAddress;
FFlags := [];
end;
function TAvrAsmInstruction.IsCallInstruction: boolean;
begin
Result := False;
ReadCode;
if diCodeReadError in FFlags then
exit;
Disassemble;
Result := FAvrInstruction.OpCode in [A_CALL, A_RCALL, A_ICALL, A_EICALL];
end;
function TAvrAsmInstruction.IsReturnInstruction: boolean;
begin
Result := False;
ReadCode;
if diCodeReadError in FFlags then
exit;
Disassemble;
Result := FAvrInstruction.OpCode in [A_RET, A_RETI];
end;
function TAvrAsmInstruction.IsLeaveStackFrame: boolean;
begin
Result := false;
end;
function TAvrAsmInstruction.InstructionLength: Integer;
begin
Result := 2;
ReadCode;
if diCodeReadError in FFlags then
exit;
Disassemble;
Result := FAvrInstruction.Size;
end;
type
TPrologueState = (psStart, psPush, psLoadSPL, psLoadSPH, psLoadSreg,
psModifySPL, psModifySPH, psWriteSPH, psWriteSreg, psWriteSPL, psCopyParams);
function TAvrAsmDecoder.FParsePrologue(AnAddress, AStartPC, AEndPC: TDBGPtr;
out returnAddressOffset: word; out AnIsOutsideFrame: Boolean): Boolean;
var
ADataLen: Cardinal;
AData: PByte;
opcode, frameOffset: word;
d, k: byte;
stackState: TPrologueState;
begin
{ AVR function entry example
3e: df 93 push r29
40: cf 93 push r28
42: 3f 92 push r3
44: 2f 92 push r2
// Load SP and calculate BP
46: cd b7 in r28, 0x3d ; 61 // SPL
48: de b7 in r29, 0x3e ; 62 // SPH
4a: c6 50 subi r28, 0x06 ; 6
4c: d0 40 sbci r29, 0x00 ; 0
// Disable interrupts
4e: 0f b6 in r0, 0x3f ; 63
50: f8 94 cli
// Then write out new SP
52: de bf out 0x3e, r29 ; 62
// Interleaved with restoring SREG
54: 0f be out 0x3f, r0 ; 63
56: cd bf out 0x3d, r28 ; 61
// Copy param to stack
58: 8a 83 std Y+2, r24 ; 0x02
5a: 9b 83 std Y+3, r25 ; 0x03
}
// Also read next instruction, for simple procs/interrupts it may not be easy to spot the end of prologue
// so the next instruction could tie break
ADataLen := Min(MaxPrologueSize, AnAddress - AStartPC + 2);
Result := ReadCodeAt(AStartPC, ADataLen);
if not Result then
exit;
AData := @FCodeBin[0];
// SP points to next empty slot, previous data is before current SP
returnAddressOffset := 1;
AnIsOutsideFrame := true;
stackState := psStart;
frameOffset := 0;
// Loop until prologue buffer is empty, or stepped inside stack frame
while (ADataLen > 1) and AnIsOutsideFrame do
begin
opcode := AData[0] or (AData[1] shl 8);
inc(AData, 2);
dec(ADataLen, 2);
case opcode of
OpCodeNOP: ;
OpCodeLoadSPL: stackState := psLoadSPL;
OpCodeLoadSPH: stackState := psLoadSPH;
OpCodeLoadSRegR0, OpCodeLoadSRegR16: stackState := psLoadSreg;
OpCodeCli: ;
OpCodeSetSPH: stackState := psWriteSPH;
OpCodeSetSregR0, OpCodeSetSregR16: stackState := psWriteSreg;
OpCodeSetSPL: stackState := psWriteSPL;
OpCodeZeroR1, OpCodeZeroR16: ;
else
// Push stack
if (opcode and OpCodePushMask) = OpCodePushMask then
begin
if (stackState <= psPush) or (stackState = psLoadSreg) then
begin
inc(returnAddressOffset);
if stackstate < psPush then
stackState := psPush;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for PUSH opcode: ', stackState]);
end
else if (opcode and OpCodeAdjustFrameLMask) = OpCodeAdjustFrameLMask then
begin
if stackState >= psLoadSPH then
begin
stackState := psModifySPL;
// Decode register and constant
get_k_r16(opcode, d, k);
frameOffset := frameOffset + k;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeAdjustFrameLMask opcode: ', stackState]);
end
else if (opcode and OpCodeAdjustFrameHMask) = OpCodeAdjustFrameHMask then
begin
if stackState >= psLoadSPH then
begin
stackState := psModifySPH;
// Decode register and constant
get_k_r16(opcode, d, k);
frameOffset := frameOffset + (k shl 8);
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeAdjustFrameHMask opcode: ', stackState]);
end
else if (opcode and OpCodeAdjustFrameMask) = OpCodeAdjustFrameMask then
begin
if stackState >= psLoadSPH then
begin
stackState := psModifySPH;
// Decode constant in SBIW opcode
k := ((opcode and $00c0) shr 2) or (opcode and $f);
frameOffset := frameOffset + k;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeAdjustFrameMask opcode: ', stackState]);
end
else if (opcode and OpCodeStoreOnStackMask) = OpCodeStoreOnStackMask then
begin
if stackState >= psWriteSPL then
begin
stackState := psCopyParams;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeStoreOnStackMask opcode: ', stackState]);
end
else // Any other opcode isn't part of prologue
begin
AnIsOutsideFrame := false;
end;
end;
end;
// Check if frame pointer was updated
if (stackState >= psWriteSPL) and (frameOffset > 0) then
begin
AnIsOutsideFrame := false;
returnAddressOffset := returnAddressOffset + frameOffset;
end
else
AnIsOutsideFrame := true;
end;
type
// State sequence runs in reverse direction
TEpilogueState = (esStart, esRet, esPop, esWriteSPH, esWriteSreg, esWriteSPL,
esLoadSreg, esModifyFPH, esModifyFPL);
function TAvrAsmDecoder.FParseEpilogue(AnAddress, AStartPC, AEndPC: TDBGPtr;
out returnAddressOffset: word; out AnIsOutsideFrame: Boolean): Boolean;
var
ADataLen: Cardinal;
AData: PByte;
opcode, frameOffset: word;
d, k: byte;
stackState: TEpilogueState;
begin
{ AVR function epilogue example
// Move FP to previous frame
ba: cd 5f subi r28, 0xFD ; 253
bc: df 4f sbci r29, 0xFF ; 255
// Update SP
be: 0f b6 in r0, 0x3f ; 63
c0: f8 94 cli
c2: de bf out 0x3e, r29 ; 62
c4: 0f be out 0x3f, r0 ; 63
c6: cd bf out 0x3d, r28 ; 61
// Restore saved regs
c8: cf 91 pop r28
ca: df 91 pop r29
cc: 08 95 ret
}
ADataLen := Min(MaxEpilogueSize, AEndPC - AnAddress);
Result := ReadCodeAt(AEndPC - ADataLen, ADataLen);
if not Result then
exit;
AData := @FCodeBin[ADataLen - 2];
// SP points to next empty slot, previous data is before current SP
returnAddressOffset := 1;
AnIsOutsideFrame := true;
stackState := esStart;
frameOffset := 0;
// Loop until epilogue buffer is empty, or stepped inside stack frame
while (ADataLen > 1) and AnIsOutsideFrame do
begin
opcode := AData[0] or (AData[1] shl 8);
dec(AData, 2);
dec(ADataLen, 2);
case opcode of
OpCodeNOP: ;
OpCodeLoadSRegR0, OpCodeLoadSRegR16: stackState := esLoadSreg;
OpCodeCli: ;
OpCodeSetSPH: stackState := esWriteSPH;
OpCodeSetSregR0, OpCodeSetSregR16: stackState := esWriteSreg;
OpCodeSetSPL: stackState := esWriteSPL;
OpCodeRet, OpCodeReti: stackState := esRet;
else
// Pop stack
if (opcode and OpCodePopMask) = OpCodePopMask then
begin
if (stackState <= esPop) or (stackState = esWriteSreg) then
begin
inc(returnAddressOffset);
if stackState < esPop then
stackState := esPop;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for POP opcode: ', stackState]);
end
else if (opcode and OpCodeAdjustFrameLMask) = OpCodeAdjustFrameLMask then
begin
if stackState < esModifyFPL then
begin
stackState := esModifyFPL;
// Decode register and constant
get_k_r16(opcode, d, k);
// Normally subtract negative values to increase FP
k := (256 - word(k));
frameOffset := frameOffset + k;
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeAdjustFrameLMask opcode: ', stackState]);
end
else if (opcode and OpCodeAdjustFrameHMask) = OpCodeAdjustFrameHMask then
begin
if stackState < esModifyFPH then
begin
stackState := esModifyFPH;
// Decode register and constant
get_k_r16(opcode, d, k);
// Normally subtract negative values to increase FP, + carry bit
k := (256 - word(k) - 1);
frameOffset := frameOffset + (k shl 8);
end
else
DebugLn(DBG_WARNINGS, ['Invalid stack state for OpCodeAdjustFrameHMask opcode: ', stackState]);
end
else // Any other opcode isn't part of prologue
begin
AnIsOutsideFrame := false;
end;
end;
end;
// Check before frame pointer gets adjusted
if (stackState >= esModifyFPL) and (frameOffset > 0) then
begin
AnIsOutsideFrame := false;
returnAddressOffset := returnAddressOffset + frameOffset;
end
// Frame pointer inconsistent, so work relative to SP
// Unreliable, SP can be adjusted inside frame
//else if (stackState = esModifyFPH) then
//begin
// AnIsOutsideFrame := true;
// returnAddressOffset := returnAddressOffset + frameOffset;
//end
//else if (stackState > esPop) then
//begin
//
//end
else
AnIsOutsideFrame := true;
end;
function TAvrAsmDecoder.FormatInstruction(instr: TAVRInstruction): string;
const
OutputFormats: array[0..2] of string = (
'%s',
'%:-7s %s',
'%:-7s %s, %s');
var
OpName: string;
ops: array[1..2] of string;
info: TAvrInstructionInfo;
i: integer;
begin
info := OpCodeInfo[instr.OpCode];
OpName := info.OpName;
// Special cases first
case instr.OpCode of
A_BR: OpName := OpName + branchConditionStr[instr.OpCodeMod];
A_CL, A_SE: OpName := OpName + statusFlagNames[instr.OpCodeMod];
end;
// Instructions with variable number of operands
if ((instr.OpCode in [A_ELPM, A_LPM]) and (instr.Oper[2] = operandNoIndex)) or
((instr.OpCode = A_SPM) and (instr.Oper[1] = operandNoIndex)) then
info.OperCount := 0;
if info.OperCount > 0 then
begin
for i := 1 to info.OperCount do
begin
case info.OperandFormats[i] of
ofDecimal: ops[i] := IntToStr(instr.Oper[i]);
ofHex8: ops[i] := '$'+IntToHex(instr.Oper[i], 2);
ofHex16: ops[i] := '$'+IntToHex(instr.Oper[i], 4);
ofHex32: ops[i] := '$'+IntToHex(instr.Oper[i], 8);
ofReg: ops[i] := 'r' + IntToStr(instr.Oper[i]);
ofIndex: ops[i] := OperandIndexStr[instr.Oper[i]];
ofIndexOffset:
begin
// IndexOffset should be either Y+ or Z+
if not(instr.OpCodeMod in [operandYInc, operandZInc]) then
writeln('ERROR');
ops[i] := OperandIndexStr[instr.OpCodeMod] + IntToStr(instr.Oper[i]);
end;
ofRelAddr:
begin
if instr.Oper[i] >= 0 then
ops[i] := '.+' + IntToStr(instr.Oper[i])
else
ops[i] := '.' + IntToStr(instr.Oper[i]);
end;
else
writeln('ERROR');
end;
end;
if info.OperCount = 1 then
Result := Format(OutputFormats[1], [OpName, ops[1]])
else
Result := Format(OutputFormats[2], [OpName, ops[1], ops[2]]);
end
else
Result := Format(OutputFormats[0], [OpName]);
end;
function TAvrAsmDecoder.GetLastErrorWasMemReadErr: Boolean;
begin
Result := FLastErrWasMem;
end;
function TAvrAsmDecoder.GetMaxInstrSize: integer;
begin
Result := 4;
end;
function TAvrAsmDecoder.GetMinInstrSize: integer;
begin
Result := 2;
end;
function TAvrAsmDecoder.GetCanReverseDisassemble: boolean;
begin
Result := true;
end;
function TAvrAsmDecoder.ReadCodeAt(AnAddress: TDBGPtr; var ALen: Cardinal
): Boolean;
begin
Result := FProcess.ReadData(AnAddress, ALen, FCodeBin[0], ALen);
FLastErrWasMem := not Result;
end;
procedure TAvrAsmDecoder.Disassemble(var AAddress: Pointer; out
ACodeBytes: String; out ACode: String; out AnInfo: TDbgInstInfo);
var
decoder: TAvrDisassembler;
k: byte;
pcode: PByte;
instr: TAVRInstruction;
begin
AnInfo := default(TDbgInstInfo);
pcode := AAddress;
decoder.Disassemble(AAddress, instr);
Inc(AAddress, instr.Size);
ACodeBytes := '';
for k := 0 to instr.Size-1 do
ACodeBytes := ACodeBytes + HexStr(pcode[k], 2) + ' ';
Delete(ACodeBytes, length(ACodeBytes), 1);
ACode := FormatInstruction(instr);
// Todo: Indicate whether currrent instruction has a destination code address
// call jump branch(?)
// Return information in AnInfo
end;
procedure TAvrAsmDecoder.Disassemble(var AAddress: Pointer; out
ACodeBytes: String; out ACode: String);
var
AnInfo: TDbgInstInfo;
begin
Disassemble(AAddress, ACodeBytes, ACode, AnInfo);
end;
function TAvrAsmDecoder.GetInstructionInfo(AnAddress: TDBGPtr
): TDbgAsmInstruction;
begin
if (FLastInstr = nil) or (FLastInstr.RefCount > 1) then begin
ReleaseRefAndNil(FLastInstr);
FLastInstr := TAvrAsmInstruction.Create(FProcess);
end;
FLastInstr.SetAddress(AnAddress);
Result := FLastInstr;
end;
function TAvrAsmDecoder.GetFunctionFrameInfo(AnAddress: TDBGPtr; out
AnIsOutsideFrame: Boolean): Boolean;
begin
Result := False;
end;
function TAvrAsmDecoder.GetFunctionFrameReturnAddress(AnAddress, AStartPC,
AEndPC: TDBGPtr; out returnAddressOffset: word; out AnIsOutsideFrame: Boolean
): Boolean;
begin
{ Cases to consider:
A - if (AStartPC + MaxPrologueSize < AnAddress) and (AnAddress + MaxEpilogueSize < AEndPC)
then currently inside stack frame. Parse prologue to figure out
offset from frame pointer to return address.
B - if (AStartPC + MaxPrologueSize < AnAddress)
then possibly before final stack frame. Need to parse prologue up to AnAddress
to figure out how far the stack has moved since entry to calculate offset
from SP to return address. If frame pointer has been configured before
AnAddress, assume inside frame and return offset relative to frame pointer.
C - if (AnAddress + MaxEpilogueSize < AEndPC)
then possibly inside frame teardown. Need to reverse parse epilogue up to AnAddress
to figure out how much frame will unwind to calculate offset to return address.
If frame pointer has been restored before AnAddress then ouside frame.
}
if (AnAddress = AStartPC) or (AnAddress = AEndPC) then
begin
// Frame not yet constructed, so return address is located via SP + offset
returnAddressOffset := 1;
AnIsOutsideFrame := true;
exit;
end
//else if (AStartPC + MaxPrologueSize > AnAddress) then
else if (AnAddress - AStartPC) < (AEndPC - AnAddress) then
result := FParsePrologue(AnAddress, AStartPC, AEndPC, returnAddressOffset, AnIsOutsideFrame)
else
result := FParseEpilogue(AnAddress, AStartPC, AEndPC, returnAddressOffset, AnIsOutsideFrame);
end;
constructor TAvrAsmDecoder.Create(AProcess: TDbgProcess);
begin
FProcess := AProcess;
end;
destructor TAvrAsmDecoder.Destroy;
begin
ReleaseRefAndNil(FLastInstr);
inherited Destroy;
end;
{ TAvrDisassembler }
function TAvrDisassembler.InvalidOpCode(instr: word): TAVRInstruction;
begin
result.OpCode := A_INVALID;
result.Size := 2;
result.Oper[1] := instr;
end;
function TAvrDisassembler.SetInstructionInfo(AOpCode: TAVROpCode;
AOpcodeMod: integer; ASize: integer; AOper: array of
integer): TAVRInstruction;
var
i: integer;
begin
Result.OpCode := AOpCode;
Result.OpCodeMod := AOpcodeMod;
Result.Size := ASize;
for i := 1 to 2 do
begin
if i <= OpCodeInfo[AOpCode].OperCount then
Result.Oper[i] := AOper[i-1]
else
Result.Oper[i] := 0;
end;
end;
procedure TAvrDisassembler.Disassemble(var AAddress: Pointer; out
AnInstruction: TAVRInstruction);
var
CodeIdx, r, d, k, q: byte;
a: SmallInt;
pcode: PByte;
code, addr16: word;
_set: boolean;
instr: TAVRInstruction absolute AnInstruction;
begin
pcode := AAddress;
CodeIdx := 0;
code := pcode[CodeIdx];
inc(CodeIdx);
code := code or (pcode[CodeIdx] shl 8);
inc(CodeIdx);
case (code and $f000) of
$0000:
begin
case (code) of
$0000: instr := SetInstructionInfo(A_NOP, 0, 2, []);
else
case (code and $fc00) of
$0400:
begin // CPC compare with carry 0000 01rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_CPC, 0, 2, [d, r]);
end;
$0c00:
begin // ADD without carry 0000 11 rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_ADD, 0, 2, [d, r]);
end;
$0800:
begin // SBC subtract with carry 0000 10rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_SBC, 0, 2, [d, r]);
end;
else
case (code and $ff00) of
$0100:
begin // MOVW Copy Register Word 0000 0001 dddd rrrr
d := ((code shr 4) and $f) shl 1;
r := ((code) and $f) shl 1;
instr := SetInstructionInfo(A_MOVW, 0, 2, [d, r]);
end;
$0200:
begin // MULS Multiply Signed 0000 0010 dddd rrrr
r := 16 + (code and $f);
d := 16 + ((code shr 4) and $f);
instr := SetInstructionInfo(A_MULS, 0, 2, [d, r]);
end;
$0300:
begin // MUL Multiply 0000 0011 fddd frrr
r := 16 + (code and $7);
d := 16 + ((code shr 4) and $7);
case (code and $88) of
$00: instr := SetInstructionInfo(A_MULSU, 0, 2, [d, r]);
$08: instr := SetInstructionInfo(A_FMUL, 0, 2, [d, r]);
$80: instr := SetInstructionInfo(A_FMULS, 0, 2, [d, r]);
$88: instr := SetInstructionInfo(A_FMULSU, 0, 2, [d, r]);
end;
end;
else
instr := InvalidOpCode(code);
end; // case (code and $ff00)
end; // case (code and $fc00)
end; // case code of
end;
$1000:
begin
case (code and $fc00) of
$1800:
begin // SUB without carry 0000 10 rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_SUB, 0, 2, [d, r]);
end;
$1000:
begin // CPSE Compare, skip if equal 0000 00 rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_CPSE, 0, 2, [d, r]);
end;
$1400:
begin // CP Compare 0000 01 rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_CP, 0, 2, [d, r]);
end;
$1c00:
begin // ADD with carry 0001 11 rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_ADC, 0, 2, [d, r]);
end;
else
instr := InvalidOpCode(code);
end;
end;
$2000:
begin
case (code and $fc00) of
$2000:
begin // AND 0010 00rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_AND, 0, 2, [d, r]);
end;
$2400:
begin // EOR 0010 01rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_EOR, 0, 2, [d, r]);
end;
$2800:
begin // OR Logical OR 0010 10rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_OR, 0, 2, [d, r]);
end;
$2c00:
begin // MOV 0010 11rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_MOV, 0, 2, [d, r]);
end;
else
instr := InvalidOpCode(code);
end;
end;
$3000:
begin // CPI 0011 KKKK rrrr KKKK
get_k_r16(code, d, k);
instr := SetInstructionInfo(A_CPI, 0, 2, [d, k]);
end;
$4000:
begin // SBCI Subtract Immediate With Carry 0100 kkkk dddd kkkk
get_k_r16(code, d, k);
instr := SetInstructionInfo(A_SBCI, 0, 2, [d, k]);
end;
$5000:
begin // SUB Subtract Immediate 0101 kkkk dddd kkkk
get_k_r16(code, d, k);
instr := SetInstructionInfo(A_SUBI, 0, 2, [d, k]);
end;
$6000:
begin // ORI aka SBR Logical AND with Immediate 0110 kkkk dddd kkkk
get_k_r16(code, d, k);
instr := SetInstructionInfo(A_ORI, 0, 2, [d, k]);
end;
$7000:
begin // ANDI Logical AND with Immediate 0111 kkkk dddd kkkk
get_k_r16(code, d, k);
instr := SetInstructionInfo(A_ANDI, 0, 2, [d, k]);
end;
$a000,
$8000:
begin
case (code and $d008) of
$a000,
$8000:
begin // LD (LDD) Load Indirect using Z 10q0 qq0r rrrr 0qqq
// ST (STD) - Store Indirect with Z 10q0 qq1r rrrr 0qqq
// This check overlaps with the 16 bit LDS/STS instructions of reduced core tiny
// Todo: only activate this check if debugging a tiny
if false and ((code and $A000) = $A000) then
begin
r := 16 + ((code shr 4) and $0F);
k := ((code shr 5) and $30) or (code and $0F);
if (code and $0100) = 0 then
k := k or $80
else
k := k or $40;
if (code and $800) = 0 then
instr := SetInstructionInfo(A_LDS, 0, 2, [r, k])
else
instr := SetInstructionInfo(A_STS, 0, 2, [k, r]);
end
else
begin
d := (code shr 4) and $1f;
q := ((code and $2000) shr 8) or ((code and $0c00) shr 7) or (code and $7);
if (code and $0200) <> 0 then // store
begin
if q > 0 then
instr := SetInstructionInfo(A_STD, operandZInc, 2, [q, d])
else
begin
q := OperandZ + (code and 3);
instr := SetInstructionInfo(A_ST, 0, 2, [q, d]);
end;
end
else // load
begin
if q > 0 then
instr := SetInstructionInfo(A_LDD, operandZInc, 2, [d, q])
else
instr := SetInstructionInfo(A_LD, 0, 2, [d, operandZ + (code and 3)]);
end;
end;
end;
$a008,
$8008:
begin // LD (LDD) Load Indirect using Y 10q0 qq0r rrrr 1qqq
d := (code shr 4) and $1f;
q := ((code and $2000) shr 8) or ((code and $0c00) shr 7) or (code and $7);
if (code and $0200) <> 0 then // store
begin
if q > 0 then
instr := SetInstructionInfo(A_STD, operandYInc, 2, [q, d])
else
instr := SetInstructionInfo(A_ST, 0, 2, [operandY + (code and 3), d]);
end
else // load
begin
if q > 0 then
instr := SetInstructionInfo(A_LDD, operandYInc, 2, [d, q])
else
instr := SetInstructionInfo(A_LD, 0, 2, [d, operandY + (code and 3)]);
end;
end;
else
instr := InvalidOpCode(code);
end;
end;
$9000:
begin
if ((code and $ff0f) = $9408) then // clear/set SREG flags
begin
k := (code shr 4) and 7;
if ((code and $0080) = 0) then
instr := SetInstructionInfo(A_SE, k, 2, [])
else
instr := SetInstructionInfo(A_CL, k, 2, []);
end
else
case (code) of
$9409: instr := SetInstructionInfo(A_IJMP, 0, 2, []);
$9419: instr := SetInstructionInfo(A_EIJMP, 0, 2, []);
$9508: instr := SetInstructionInfo(A_RET, 0, 2, []);
$9509: instr := SetInstructionInfo(A_ICALL, 0, 2, []);
$9519: instr := SetInstructionInfo(A_EICALL, 0, 2, []);
$9518: instr := SetInstructionInfo(A_RETI, 0, 2, []);
$9588: instr := SetInstructionInfo(A_SLEEP, 0, 2, []);
$9598: instr := SetInstructionInfo(A_BREAK, 0, 2, []);
$95a8: instr := SetInstructionInfo(A_WDR, 0, 2, []);
$95c8: instr := SetInstructionInfo(A_LPM, 0, 2, [0, operandNoIndex]);
$95d8: instr := SetInstructionInfo(A_ELPM, 0, 2, [0, operandNoIndex]);
$95e8: instr := SetInstructionInfo(A_SPM, 0, 2, [operandNoIndex]);
$95f8: instr := SetInstructionInfo(A_SPM, 0, 2, [operandZInc]);
else
begin
case (code and $fe0f) of
$9000:
begin // LDS Load Direct from fData Space, 32 bits
r := (code shr 4) and $1f;
addr16 := pcode[CodeIdx];
inc(CodeIdx);
addr16 := addr16 or (pcode[CodeIdx] shl 8);
inc(CodeIdx);
instr := SetInstructionInfo(A_LDS, 0, 4, [r, addr16]);
end;
$9005,
$9004:
begin // LPM Load Program Memory 1001 000d dddd 01oo
r := (code shr 4) and $1f;
if (code and 1 = 1) then
instr := SetInstructionInfo(A_LPM, 0, 2, [r, operandZInc])
else
instr := SetInstructionInfo(A_LPM, 0, 2, [r, operandZ]);
end;
$9006,
$9007:
begin // ELPM Extended Load Program Memory 1001 000d dddd 01oo
r := (code shr 4) and $1f;
if (code and 1 = 1) then
instr := SetInstructionInfo(A_ELPM, 0, 2, [r, operandZInc])
else
instr := SetInstructionInfo(A_ELPM, 0, 2, [r, operandZ]);
end;
$900c,
$900d,
$900e:
begin // LD Load Indirect from fData using X 1001 000r rrrr 11oo
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_LD, 0, 2, [r, operandX + (code and 3)]);
end;
$920c,
$920d,
$920e:
begin // ST Store Indirect fData Space X 1001 001r rrrr 11oo
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_ST, 0, 2, [operandX + (code and 3), r])
end;
$9009,
$900a:
begin // LD Load Indirect from fData using Y 1001 000r rrrr 10oo
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_LD, 0, 2, [r, operandY + (code and 3)])
end;
$9209,
$920a:
begin // ST Store Indirect fData Space Y 1001 001r rrrr 10oo
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_ST, 0, 2, [operandY + (code and 3), r])
end;
$9200:
begin // STS Store Direct to Data Space, 32 bits
r := (code shr 4) and $1f;
addr16 := pcode[CodeIdx];
inc(CodeIdx);
addr16 := addr16 or (pcode[CodeIdx] shl 8);
inc(CodeIdx);
instr := SetInstructionInfo(A_STS, 0, 4, [addr16, r])
end;
$9001,
$9002:
begin // LD Load Indirect from Data using Z 1001 001r rrrr 00oo
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_LD, 0, 2, [r, operandZ + (code and 3)])
end;
$9201,
$9202:
begin // ST Store Indirect Data Space Z 1001 001r rrrr 0Xoo X=0 or XMega instructions X=1
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_ST, 0, 2, [operandZ + (code and 3), r])
end;
$9204..$9207:
begin // AVR8X instructions
r := (code shr 4) and $1f;
case (code and 3) of
0: instr := SetInstructionInfo(A_XCH, 0, 2, [operandZ, r]);
1: instr := SetInstructionInfo(A_LAS, 0, 2, [operandZ, r]);
2: instr := SetInstructionInfo(A_LAC, 0, 2, [operandZ, r]);
3: instr := SetInstructionInfo(A_LAT, 0, 2, [operandZ, r]);
end;
end;
$900f:
begin // POP 1001 000d dddd 1111
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_POP, 0, 2, [r])
end;
$920f:
begin // PUSH 1001 001d dddd 1111
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_PUSH, 0, 2, [r])
end;
$9400:
begin // COM Ones Complement
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_COM, 0, 2, [r])
end;
$9401:
begin // NEG Twos Complement
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_NEG, 0, 2, [r])
end;
$9402:
begin // SWAP Swap Nibbles
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_SWAP, 0, 2, [r])
end;
$9403:
begin // INC Increment
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_INC, 0, 2, [r])
end;
$9405:
begin // ASR Arithmetic Shift Right 1001 010d dddd 0101
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_ASR, 0, 2, [r])
end;
$9406:
begin // LSR 1001 010d dddd 0110
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_LSR, 0, 2, [r])
end;
$9407:
begin // ROR 1001 010d dddd 0111
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_ROR, 0, 2, [r])
end;
$940a:
begin // DEC Decrement
r := (code shr 4) and $1f;
instr := SetInstructionInfo(A_DEC, 0, 2, [r])
end;
$940c,
$940d:
begin // JMP Long Call to sub, 32 bits
k := ((code and $01f0) shr 3) or (code and 1);
addr16 := pcode[CodeIdx];
inc(CodeIdx);
addr16 := addr16 or (pcode[CodeIdx] shl 8);
inc(CodeIdx);
instr := SetInstructionInfo(A_JMP, 0, 4, [dword(k shl 16) or (dword(addr16) shl 1)]);
end;
$940e,
$940f:
begin // CALL Long Call to sub, 32 bits
k := ((code and $01f0) shr 3) or (code and 1);
addr16 := pcode[CodeIdx];
inc(CodeIdx);
addr16 := addr16 or (pcode[CodeIdx] shl 8);
inc(CodeIdx);
instr := SetInstructionInfo(A_CALL, 0, 4, [dword(k shl 16) or (dword(addr16) shl 1)]);
end;
else
begin
case (code and $ff00) of
$9600:
begin // ADIW - Add Immediate to Word 1001 0110 KKdd KKKK
r := 24 + ((code shr 3) and $6);
k := ((code and $00c0) shr 2) or (code and $f);
instr := SetInstructionInfo(A_ADIW, 0, 2, [r, k]);
end;
$9700:
begin // SBIW - Subtract Immediate from Word 1001 0110 KKdd KKKK
r := 24 + ((code shr 3) and $6);
k := ((code and $00c0) shr 2) or (code and $f);
instr := SetInstructionInfo(A_SBIW, 0, 2, [r, k]);
end;
$9800:
begin // CBI - Clear Bit in I/O Register 1001 1000 AAAA Abbb
d := (code shr 3) and $1f;
k := code and $7;
instr := SetInstructionInfo(A_CBI, 0, 2, [d, k]);
end;
$9900:
begin // SBIC - Skip if Bit in I/O Register is Cleared 1001 0111 AAAA Abbb
d := (code shr 3) and $1f;
k := code and $7;
instr := SetInstructionInfo(A_SBIC, 0, 2, [d, k]);
end;
$9a00:
begin // SBI - Set Bit in I/O Register 1001 1000 AAAA Abbb
d := (code shr 3) and $1f;
k := code and $7;
instr := SetInstructionInfo(A_SBI, 0, 2, [d, k]);
end;
$9b00:
begin // SBIS - Skip if Bit in I/O Register is Set 1001 1011 AAAA Abbb
d := (code shr 3) and $1f;
k := code and $7;
instr := SetInstructionInfo(A_SBIS, 0, 2, [d, k]);
end;
else
case (code and $fc00) of
$9c00:
begin // MUL - Multiply Unsigned 1001 11rd dddd rrrr
get_r_d_10(code, r, d);
instr := SetInstructionInfo(A_MUL, 0, 2, [d, k]);
end;
else
instr := InvalidOpCode(code);
end;
end;
end;
end;
end;
end;
end;
$b000:
begin
case (code and $f800) of
$b800:
begin // OUT A,Rr 1011 1AAr rrrr AAAA
r := (code shr 4) and $1f;
d := ((((code shr 9) and 3) shl 4) or ((code) and $f));
instr := SetInstructionInfo(A_OUT, 0, 2, [d, r]);
end;
$b000:
begin // IN Rd,A 1011 0AAr rrrr AAAA
r := (code shr 4) and $1f;
d := ((((code shr 9) and 3) shl 4) or ((code) and $f));
instr := SetInstructionInfo(A_IN, 0, 2, [r, d]);
end;
else
instr := InvalidOpCode(code);
end;
end;
$c000:
begin // RJMP 1100 kkkk kkkk kkkk
a := smallint((word(code) shl 4) and $ffff) div 16;
instr := SetInstructionInfo(A_RJMP, 0, 2, [a shl 1]);
end;
$d000:
begin // RCALL 1100 kkkk kkkk kkkk
a := smallint((word(code) shl 4) and $ffff) div 16;
instr := SetInstructionInfo(A_RCALL, 0, 2, [a shl 1]);
end;
$e000:
begin // LDI Rd, K 1110 KKKK RRRR KKKK -- aka SER (LDI r, $ff)
d := 16 + ((code shr 4) and $f);
k := ((code and $0f00) shr 4) or (code and $f);
instr := SetInstructionInfo(A_LDI, 0, 2, [d, k]);
end;
$f000:
begin
case (code and $fe00) of
$f000,
$f200,
$f400,
$f600:
begin // All the fSREG branches
a := smallint(smallint(code shl 6) shr 9) * 2; // offset
k := code and 7;
_set := (code and $0400) = 0; // this bit means BRXC otherwise BRXS
if not _set then
k := k + 8;
instr := SetInstructionInfo(A_BR, k, 2, [a]);
end;
$f800,
$f900:
begin // BLD Bit Load from T into a Bit in Register 1111 100r rrrr 0bbb
d := (code shr 4) and $1f; // register index
k := code and 7;
instr := SetInstructionInfo(A_BLD, 0, 2, [d, k]);
end;
$fa00,
$fb00:
begin // BST Bit Store into T from bit in Register 1111 100r rrrr 0bbb
r := (code shr 4) and $1f; // register index
k := code and 7;
instr := SetInstructionInfo(A_BST, 0, 2, [r, k]);
end;
$fc00,
$fe00:
begin // SBRS/SBRC Skip if Bit in Register is Set/Clear 1111 11sr rrrr 0bbb
r := (code shr 4) and $1f; // register index
k := code and 7;
_set := (code and $0200) <> 0;
if _set then
instr := SetInstructionInfo(A_SBRS, 0, 2, [r, k])
else
instr := SetInstructionInfo(A_SBRC, 0, 2, [r, k]);
end;
else
instr := InvalidOpCode(code);
end;
end;
else
instr := InvalidOpCode(code);
end;
end;
{ TDbgStackUnwinderAVR }
constructor TDbgStackUnwinderAVR.Create(AProcess: TDbgProcess);
begin
FProcess := AProcess;
FAddressSize := 2;
FCodeReadErrCnt := 0;
end;
procedure TDbgStackUnwinderAVR.InitForThread(AThread: TDbgThread);
begin
FThread := AThread;
end;
procedure TDbgStackUnwinderAVR.InitForFrame(ACurrentFrame: TDbgCallstackEntry;
out CodePointer, StackPointer, FrameBasePointer: TDBGPtr);
var
R: TDbgRegisterValue;
begin
CodePointer := ACurrentFrame.AnAddress;
// Frame pointer is r29:r28 (if used)
FrameBasePointer := ACurrentFrame.FrameAdress;
//Could update using GetStackBasePointerRegisterValue
//R := ACurrentFrame.RegisterValueList.FindRegisterByDwarfIndex(FDwarfNumBP);
//if R <> nil then
// FrameBasePointer := R.NumValue;
StackPointer := 0;
R := ACurrentFrame.RegisterValueList.FindRegisterByDwarfIndex(SPindex);
if R = nil then exit;
StackPointer := R.NumValue;
end;
procedure TDbgStackUnwinderAVR.GetTopFrame(out CodePointer, StackPointer,
FrameBasePointer: TDBGPtr; out ANewFrame: TDbgCallstackEntry);
var
i: Integer;
R: TDbgRegisterValue;
begin
FLastFrameBaseIncreased := True;
CodePointer := Thread.GetInstructionPointerRegisterValue;
StackPointer := Thread.GetStackPointerRegisterValue;
FrameBasePointer := Thread.GetStackBasePointerRegisterValue;
ANewFrame := TDbgCallstackEntry.create(Thread, 0, FrameBasePointer, CodePointer);
// Frame pointer may not have been updated yet
if FrameBasePointer > StackPointer then
FrameBasePointer := StackPointer;
i := Thread.RegisterValueList.Count;
while i > 0 do begin
dec(i);
R := Thread.RegisterValueList[i];
ANewFrame.RegisterValueList.DbgRegisterAutoCreate[R.Name].SetValue(R.NumValue, R.StrValue, R.Size, R.DwarfIdx);
end;
end;
function TDbgStackUnwinderAVR.Unwind(AFrameIndex: integer; var CodePointer,
StackPointer, FrameBasePointer: TDBGPtr; ACurrentFrame: TDbgCallstackEntry;
out ANewFrame: TDbgCallstackEntry): TTDbgStackUnwindResult;
const
MAX_FRAMES = 50000; // safety net
// To read RAM, add data space offset to address
DataOffset = $800000;
Size = 2;
var
LastFrameBase: TDBGPtr;
OutSideFrame: Boolean;
startPC, endPC: TDBGPtr;
returnAddrStackOffset: word;
b: byte;
begin
ANewFrame := nil;
Result := suFailed;
if StackPointer = 0 then
exit;
if not FLastFrameBaseIncreased then
exit;
OutSideFrame := False;
LastFrameBase := FrameBasePointer;
// Get start/end PC of proc from debug info
if not Self.Process.FindProcStartEndPC(CodePointer, startPC, endPC) then
begin
{ Assume we are at beginning of proc. GetFunctionFrameReturnAddress should then
assume we are outside the stack frame (or no stack frame exists).
}
endPC := CodePointer;
end;
if not TAvrAsmDecoder(Process.Disassembler).GetFunctionFrameReturnAddress(CodePointer, startPC, endPC, returnAddrStackOffset, OutSideFrame) then
begin
OutSideFrame := False;
end;
if OutSideFrame then begin
// Before adjustment of frame pointer, or after restoration of frame pointer,
// return PC should be located by offset from SP
if not Process.ReadData(DataOffset or (StackPointer + returnAddrStackOffset), Size, CodePointer) or
(CodePointer = 0) then
exit;
{$PUSH}{$R-}{$Q-}
StackPointer := StackPointer + returnAddrStackOffset + 1;
FrameBasePointer := StackPointer; // After popping return-addr from "StackPtr"
{$POP}
end
else begin
// Inside stack frame, return PC should be located by offset from FP
if not Process.ReadData(DataOffset or (FrameBasePointer + returnAddrStackOffset), Size, CodePointer) or (CodePointer = 0) then exit;
{$PUSH}{$R-}{$Q-}
FrameBasePointer := StackPointer + returnAddrStackOffset + Size - 1; // After popping return-addr from stack
// An estimate of SP, needed when attempting unwinding of next frame
// If registers are spilled to stack this will be wrong.
StackPointer := FrameBasePointer;
{$POP}
end;
// Convert return address from BE to LE, shl 1 to get byte address
CodePointer := BEtoN(word(CodePointer)) shl 1;
FLastFrameBaseIncreased := (FrameBasePointer <> 0) and (FrameBasePointer > LastFrameBase);
ANewFrame:= TDbgCallstackEntry.create(Thread, AFrameIndex, FrameBasePointer, CodePointer);
ANewFrame.RegisterValueList.DbgRegisterAutoCreate[nPC].SetValue(CodePointer, IntToStr(CodePointer),Size, PCindex);
ANewFrame.RegisterValueList.DbgRegisterAutoCreate[nSP].SetValue(StackPointer, IntToStr(StackPointer),Size, SPindex);
ANewFrame.RegisterValueList.DbgRegisterAutoCreate['r28'].SetValue(byte(FrameBasePointer), IntToStr(byte(FrameBasePointer)),Size, 28);
b := byte(FrameBasePointer shr 8);
ANewFrame.RegisterValueList.DbgRegisterAutoCreate['r29'].SetValue(b, IntToStr(b), Size, 29);
FCodeReadErrCnt := 0;
Result := suSuccess;
end;
initialization
DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
end.