unit ce_gdb;

{$I ce_defines.inc}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
  PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
  StdCtrls, process, fpjson, typinfo, Unix, ListViewFilterEdit, SynEdit,
  ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
  ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf,
  ce_ddemangle, ce_writableComponent, EditBtn, strutils, ObjectInspector;

type

  TAsmSyntax = (intel, att);

  {$IFDEF CPU64}
  TCpuRegister = (rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp, r8, r9, r10, r11, r12, r13,
    r14, r15, rip);

  const stOffset = 24;
type
  TFpuRegister = (st0, st1, st2, st3, st4, st5, st6, st7);
  {$ENDIF}

  {$IFDEF CPU32}
  TCpuRegister = (eax, ebx, ecx, edx, esi, edi, ebp, esp, eip);

  const stOffset = 16;
type
  TFpuRegister = (st0, st1, st2, st3, st4, st5, st6, st7);
  {$ENDIF}


  TFLAG = (CF, PF, AF, ZF, SF, TF, &IF, DF, &OF);

  const FlagValues: array[TFlag] of word = (1, 4, 16, 64, 128, 256, 512, 1024, 2048);

type

  TFLAGS = set of TFLAG;

  TSegRegister = (CS, SS, DS, ES, FS, GS);
  {$IFDEF CPU64}
  const segOffset = 18;
  const flagOffset = 17;
  {$ELSE}
  const segOffset = 10;
  const flagOffset = 9;
  {$ENDIF}

type

  // aliased to get hex display in object inspector.
  TCpuGprValue = type PtrUInt;

  // aliased to get hex display in object inspector.
  TCPUSegValue = type word;

  // displays a TCpuRegValue in hex
  TCpuRegValueEditor = class(TIntegerProperty)
  public
    function GetValue: ansistring; override;
    procedure SetValue(const NewValue: ansistring); override;
  end;

  // displays a TCPUSegValue in hex
  TCpuSegValueEditor = class(TIntegerProperty)
  public
    function GetValue: ansistring; override;
    procedure SetValue(const NewValue: ansistring); override;
  end;

  TSetGprEvent = procedure(reg: TCpuRegister; val: TCpuGprValue) of object;

  // Makes a category for the general purpose registers in a object inspector
  TInspectableGPR = class(TPersistent)
  private
    fRegisters: array[TCpuRegister] of TCpuGprValue;
    fSetGprEvent: TSetGprEvent;
    procedure setRegister(index: TCpuRegister; value: TCpuGprValue);
  published
    {$IFDEF CPU64}
    property RAX: TCpuGprValue index TCpuRegister.rax read fRegisters[TCpuRegister.rax] write setRegister;
    property RBX: TCpuGprValue index TCpuRegister.rbx read fRegisters[TCpuRegister.rbx] write setRegister;
    property RCX: TCpuGprValue index TCpuRegister.rcx read fRegisters[TCpuRegister.rcx] write setRegister;
    property RDX: TCpuGprValue index TCpuRegister.rdx read fRegisters[TCpuRegister.rdx] write setRegister;
    property RSI: TCpuGprValue index TCpuRegister.rsi read fRegisters[TCpuRegister.rsi] write setRegister;
    property RDI: TCpuGprValue index TCpuRegister.rdi read fRegisters[TCpuRegister.rdi] write setRegister;
    property RBP: TCpuGprValue index TCpuRegister.rbp read fRegisters[TCpuRegister.rbp] write setRegister;
    property RSP: TCpuGprValue index TCpuRegister.rsp read fRegisters[TCpuRegister.rsp] write setRegister;
    property R8:  TCpuGprValue index TCpuRegister.r8  read fRegisters[TCpuRegister.r8] write setRegister;
    property R9:  TCpuGprValue index TCpuRegister.r9  read fRegisters[TCpuRegister.r9] write setRegister;
    property R10: TCpuGprValue index TCpuRegister.r10 read fRegisters[TCpuRegister.r10] write setRegister;
    property R11: TCpuGprValue index TCpuRegister.r11 read fRegisters[TCpuRegister.r11] write setRegister;
    property R12: TCpuGprValue index TCpuRegister.r12 read fRegisters[TCpuRegister.r12] write setRegister;
    property R13: TCpuGprValue index TCpuRegister.r13 read fRegisters[TCpuRegister.r13] write setRegister;
    property R14: TCpuGprValue index TCpuRegister.r14 read fRegisters[TCpuRegister.r14] write setRegister;
    property R15: TCpuGprValue index TCpuRegister.r15 read fRegisters[TCpuRegister.r15] write setRegister;
    property RIP: TCpuGprValue index TCpuRegister.rip read fRegisters[TCpuRegister.rip] write setRegister;
    {$ELSE}
    property EAX: TCpuGprValue index TCpuRegister.eax read fRegisters[TCpuRegister.eax] write setRegister;
    property EBX: TCpuGprValue index TCpuRegister.ebx read fRegisters[TCpuRegister.ebx] write setRegister;
    property ECX: TCpuGprValue index TCpuRegister.ecx read fRegisters[TCpuRegister.ecx] write setRegister;
    property EDX: TCpuGprValue index TCpuRegister.edx read fRegisters[TCpuRegister.edx] write setRegister;
    property ESI: TCpuGprValue index TCpuRegister.esi read fRegisters[TCpuRegister.esi] write setRegister;
    property EDI: TCpuGprValue index TCpuRegister.edi read fRegisters[TCpuRegister.edi] write setRegister;
    property EBP: TCpuGprValue index TCpuRegister.ebp read fRegisters[TCpuRegister.ebp] write setRegister;
    property ESP: TCpuGprValue index TCpuRegister.esp read fRegisters[TCpuRegister.esp] write setRegister;
    property EIP: TCpuGprValue index TCpuRegister.eip read fRegisters[TCpuRegister.eip] write setRegister;
    {$ENDIF}
  public
    constructor create(eventGPR: TSetGprEvent);
    procedure setInspectableRegister(index: TCpuRegister; value: PtrUInt);
  end;

  TSetSsrEvent = procedure(reg: TSegRegister; val: TCPUSegValue) of object;

  // Makes a category for the segment registers in a object inspector
  TInspectableSSR = class(TPersistent)
  private
    fRegisters: array[TSegRegister] of TCPUSegValue;
    fSetSsrEvent: TSetSsrEvent;
    procedure setRegister(index: TSegRegister; value: TCPUSegValue);
  published
    property CS: TCPUSegValue index TSegRegister.CS read fRegisters[TSegRegister.CS] write setRegister;
    property SS: TCPUSegValue index TSegRegister.SS read fRegisters[TSegRegister.SS] write setRegister;
    property DS: TCPUSegValue index TSegRegister.DS read fRegisters[TSegRegister.DS] write setRegister;
    property ES: TCPUSegValue index TSegRegister.ES read fRegisters[TSegRegister.ES] write setRegister;
    property FS: TCPUSegValue index TSegRegister.FS read fRegisters[TSegRegister.FS] write setRegister;
    property GS: TCPUSegValue index TSegRegister.GS read fRegisters[TSegRegister.GS] write setRegister;
  public
    constructor create(eventSSR: TSetSsrEvent);
    procedure setInspectableRegister(index: TSegRegister; value: TCPUSegValue);
  end;

  TSetFlagEvent = procedure(val: PtrUint) of object;

  TSetFprEvent = procedure(reg: TFpuRegister; val: extended) of object;

  // Makes a category for the floating point unit registers in a object inspector
  TInspectableFPR = class(TPersistent)
  private
    fRegisters: array[TFpuRegister] of extended;
    fSetFprEvent: TSetFprEvent;
    procedure setRegister(index: TFpuRegister; value: extended);
  published
    property ST0: extended index TFpuRegister.st0 read fRegisters[TFpuRegister.st0] write setRegister;
    property ST1: extended index TFpuRegister.st1 read fRegisters[TFpuRegister.st1] write setRegister;
    property ST2: extended index TFpuRegister.st2 read fRegisters[TFpuRegister.st2] write setRegister;
    property ST3: extended index TFpuRegister.st3 read fRegisters[TFpuRegister.st3] write setRegister;
    property ST4: extended index TFpuRegister.st4 read fRegisters[TFpuRegister.st4] write setRegister;
    property ST5: extended index TFpuRegister.st5 read fRegisters[TFpuRegister.st5] write setRegister;
    property ST6: extended index TFpuRegister.st6 read fRegisters[TFpuRegister.st6] write setRegister;
    property ST7: extended index TFpuRegister.st7 read fRegisters[TFpuRegister.st7] write setRegister;
  public
    constructor create(event: TSetFprEvent);
    procedure setInspectableRegister(index: TFpuRegister; value: extended);
  end;

  // Makes a category for the SSE registers in a object inspector
  TInspectableSSE = class(TPersistent)
    // interpretation is a problem:
    // 4 int ? 2 double ? 4 single ? ...
  end;

  // Stores the registers content, to be displayable in an object inspector.
  TInspectableCPU = class(TPersistent)
  private
    fFullFlags: PtrUint;
    fFlags: TFlags;
    fSetFlagEvent: TSetFlagEvent;
    fGpr: TInspectableGPR;
    fFpr: TInspectableFPR;
    fSsr: TInspectableSSR;
    procedure setFlag(value: TFlags);
  published
    property CPU: TInspectableGPR read fGpr;
    property FPU: TInspectableFPR read fFpr;
    property SSR: TInspectableSSR read fSsr;
    property FLAGS: TFlags read fFlags write setFlag;
  public
    constructor create(setGprEvent: TSetGprEvent; setSsrEvent: TSetSsrEvent;
      setFlagEvent: TSetFlagEvent; setFprEvent: TSetFprEvent);
    destructor destroy; override;
    procedure setInspectableFlags(value: PtrUint);
  end;

  // Represents an item in the call stack
  TStackItem = class(TCollectionItem)
  strict private
    fFilename: string;
    fFname: string;
    fAddress: PtrUInt;
    fLine: integer;
  public
    procedure setProperties(addr: PtrUint; fname, nme: string; lne: integer);
    property address: ptruint read fAddress;
    property filename: string read fFilename;
    property line: integer read fLine;
    property name: string read fFname;
  end;

  // The call stack
  TStackItems = class
  strict private
    fItems: TCollection;
  public
    constructor create;
    destructor destroy; override;
    procedure assignToList(list: TListView);
    procedure addItem(addr: PtrUint; fname, nme: string; lne: integer);
    procedure clear;
  end;

  // serializable breakpoint
  TPersistentBreakPoint = class(TCollectionItem)
  strict private
    fFilename: string;
    fLine: integer;
    fKind: TBreakPointKind;
  published
    property filename: string read fFilename write fFilename;
    property line: integer read fLine write fLine;
    property kind: TBreakPointKind read fKind write fKind;
  end;

  // allow to retrieve the breakpoints even if source is not openened.
  TPersistentBreakPoints = class(TWritableLfmTextComponent)
  strict private
    fItems: TCollection;
    procedure setItems(value: TCollection);
    function getItem(index: integer): TPersistentBreakPoint;
    function find(const fname: string; line: integer; kind: TBreakPointKind): boolean;
  published
    property items: TCollection read fItems write setItems;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    function count: integer;
    procedure clearFile(const fname: string);
    procedure deleteItem(const fname: string; line: integer; kind: TBreakPointKind);
    procedure addItem(const fname: string; line: integer; kind: TBreakPointKind);
    property item[index: integer]: TPersistentBreakPoint read getItem; default;
  end;

  // Makes a category for the shortcuts in the option editor.
  TCEDebugShortcuts = class(TPersistent)
  private
    fStart, fStop, fPause, fContinue, fStep, fStepOver, fStack, fRegs,
      fVariables: TShortCut;
  published
    property start: TShortCut read fStart write fStart;
    property stop: TShortCut read fStop write fStop;
    property pause: TShortCut read fPause write fPause;
    property continue: TShortcut read fContinue write fContinue;
    property step: TShortCut read fStep write fStep;
    property stepOver: TShortCut read fStepOver write fStepOver;
    property updateStack: TShortCut read fStack write fStack;
    property updateRegisters: TShortCut read fRegs write fRegs;
    property updateVariables: TShortCut read fVariables write fVariables;
  public
    procedure assign(source: TPersistent); override;
  end;

  TCEDebugOptionsBase = class(TWritableLfmTextComponent)
  private
    fAutoDisassemble: boolean;
    fAutoGetThreads: boolean;
    fAutoDemangle: boolean;
    fAutoGetCallStack: boolean;
    fAutoGetRegisters: boolean;
    fAutoGetVariables: boolean;
    fCommandsHistory: TStringList;
    fIgnoredSignals: TStringList;
    fShowGdbOutput: boolean;
    fShowOutput: boolean;
    fShowRawMiOutput: boolean;
    fShortcuts: TCEDebugShortcuts;
    fAsmSyntax: TAsmSyntax;
    fStopAllThreadsOnBreak: boolean;
    procedure setIgnoredSignals(value: TStringList);
    procedure setCommandsHistory(value: TStringList);
    procedure setShortcuts(value: TCEDebugShortcuts);
  published
    property asmSyntax: TAsmSyntax read fAsmSyntax write fAsmSyntax;
    property autoDisassemble: boolean read fAutoDisassemble write fAutoDisassemble;
    property autoDemangle: boolean read fAutoDemangle write fAutoDemangle;
    property autoGetCallStack: boolean read fAutoGetCallStack write fAutoGetCallStack;
    property autoGetRegisters: boolean read fAutoGetRegisters write fAutoGetRegisters;
    property autoGetVariables: boolean read fAutoGetVariables write fAutoGetVariables;
    property autoGetThreads: boolean read fAutoGetThreads write fAutoGetThreads;
    property commandsHistory: TStringList read fCommandsHistory write setCommandsHistory;
    property ignoredSignals: TStringList read fIgnoredSignals write setIgnoredSignals;
    property shortcuts: TCEDebugShortcuts read fShortcuts write setShortcuts;
    property showGdbOutput: boolean read fShowGdbOutput write fShowGdbOutput;
    property showRawMiOutput: boolean read fShowRawMiOutput write fShowRawMiOutput;
    property showOutput: boolean read fShowOutput write fShowOutput;
    property stopAllThreadsOnBreak: boolean read fStopAllThreadsOnBreak write fStopAllThreadsOnBreak;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    procedure assign(source: TPersistent); override;
  end;

  TCEDebugOptions = class(TCEDebugOptionsBase, ICEEditableOptions)
  private
    FonChangesApplied: TNotifyEvent;
    fBackup: TCEDebugOptionsBase;
    function optionedWantCategory(): string;
    function optionedWantEditorKind: TOptionEditorKind;
    function optionedWantContainer: TPersistent;
    procedure optionedEvent(event: TOptionEditorEvent);
    function optionedOptionsModified: boolean;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    property onChangesApplied: TNotifyEvent read FonChangesApplied write FonChangesApplied;
  end;

  TGdbState = (gsNone, gsRunning, gsPaused);

  TAddWatchPointKind = (wpkRead, wpkWrite, wpkReadWrite);

  // Persistent command line & environment of the inferior.
  TCEDebugeeOption = class(TCollectionItem)
  strict private
    fQueryArguments: boolean;
    fFname: string;
    fWorkingDir: TCEPathname;
    fAgruments: TStringList;
    fEnvPaths: TStringList;
    procedure setOptions(value: TStringList);
    procedure setEnvPaths(value: TStringList);
  published
    property environmentPaths: TStringList read fEnvPaths write fEnvPaths;
    property filename: string read fFname write fFname;
    property arguments: TStringList read fAgruments write setOptions;
    property queryArguments: boolean read fQueryArguments write fQueryArguments default false;
    property target: string read fFname;
    property workingDirectory: TCEPathname read fWorkingDir write fWorkingDir;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
  end;

  // Store for the command line & environment of the inferior.
  TCEDebugeeOptions = class(TWritableLfmTextComponent)
  strict private
    fProjects: TCollection;
    procedure setProjects(value: TCollection);
    function getProjectByIndex(index: integer): TCEDebugeeOption;
    function getProjectByFile(const fname: string): TCEDebugeeOption;
    procedure cleanup;
  protected
    procedure beforeSave; override;
  published
    property projects: TCollection read fProjects write setProjects;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property projectByIndex[index: integer]: TCEDebugeeOption read getProjectByIndex;
    property projectByFile[const fname: string]: TCEDebugeeOption read getProjectByFile; default;
  end;

  { TCEGdbWidget }
  TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger)
    btnContinue: TCEToolButton;
    btnVariables: TCEToolButton;
    btnNext: TCEToolButton;
    btnOver: TCEToolButton;
    btnPause: TCEToolButton;
    btnReg: TCEToolButton;
    btnStack: TCEToolButton;
    btnStop: TCEToolButton;
    btnStart: TCEToolButton;
    btnWatch: TCEToolButton;
    button4: TCEToolButton;
    Edit1: TComboBox;
    GroupBox3: TGroupBox;
    lstThreads: TListView;
    mnuNextMachine: TMenuItem;
    mnuStepMachine: TMenuItem;
    mnuStep: TPopupMenu;
    PageControl1: TPageControl;
    PageControl2: TPageControl;
    mnuNext: TPopupMenu;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    lstVariables: TListView;
    lstCallStack: TListView;
    mnuReadW: TMenuItem;
    mnuWriteW: TMenuItem;
    mnuReadWriteW: TMenuItem;
    mnuSelProj: TMenuItem;
    mnuSelRunnable: TMenuItem;
    Panel1: TPanel;
    Panel3: TPanel;
    btnSendCom: TSpeedButton;
    cpuViewer: TTIPropertyGrid;
    mnuProjRunnable: TPopupMenu;
    mnuWatch: TPopupMenu;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Splitter4: TSplitter;
    lstAsm: TListView;
    TabSheet5: TTabSheet;
    dbgeeOptsEd: TTIPropertyGrid;
    varListFlt: TListViewFilterEdit;
    procedure btnContClick(Sender: TObject);
    procedure btnVariablesClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnOverClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnRegClick(Sender: TObject);
    procedure btnSendComClick(Sender: TObject);
    procedure btnStackClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnWatchClick(Sender: TObject);
    procedure dbgeeOptsEdEditorFilter(Sender: TObject;
      aEditor: TPropertyEditor; var aShow: boolean);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure lstCallStackDblClick(Sender: TObject);
    procedure lstThreadsDblClick(Sender: TObject);
    procedure mnuReadWClick(Sender: TObject);
    procedure mnuReadWriteWClick(Sender: TObject);
    procedure mnuSelProjClick(Sender: TObject);
    procedure mnuSelRunnableClick(Sender: TObject);
    procedure mnuWriteWClick(Sender: TObject);
    procedure PageControl2Change(Sender: TObject);
    procedure varListFltChange(Sender: TObject);
  protected
    procedure setToolBarFlat(value: boolean); override;
  private
    fSyms: ICESymStringExpander;
    fExe: string;
    fOutputName: string;
    fInputName: string;
    fShowFromCustomCommand: boolean;
    fGdbState: TGdbState;
    fSubj: TCEDebugObserverSubject;
    fDoc: TCESynMemo;
    fDbgRunnable: boolean;
    fProj: ICECommonProject;
    fJson: TJsonObject;
    fLog: TStringList;
    fDocHandler: ICEMultiDocHandler;
    fMsg: ICEMessagesDisplay;
    fGdb: TCEProcess;
    fOutput: TFileStream;
    fInput: TFileStream;
    fInspState: TInspectableCPU;
    fStackItems: TStackItems;
    fCatchPause: boolean;
    fSilentPause: boolean;
    fOptions: TCEDebugOptions;
    fAddWatchPointKind: TAddWatchPointKind;
    fBreakPoints: TPersistentBreakPoints;
    fMenu: TMenuItem;
    fLastFilename: string;
    fLastFunction: string;
    fLastOffset: string;
    fLastLine: string;
    fCommandProcessed: boolean;
    fDebugeeOptions: TCEDebugeeOptions;
    procedure waitCommandProcessed;
    procedure clearDisplays;
    procedure updateMenu;
    procedure optionsChangesApplied(sender: TObject);
    procedure disableEditor;
    procedure setState(value: TGdbState);
    procedure updateButtonsState;
    procedure startDebugging;
    procedure killGdb;
    procedure storeObserversBreakpoints;
    procedure updateDebugeeOptionsEditor;
    // GDB output processors
    procedure gdboutQuiet(sender: TObject);
    procedure gdboutJsonize(sender: TObject);
    procedure interpretJson;
    // GDB commands & actions
    procedure gdbCommand(aCommand: string; gdbOutProcessor: TNotifyEvent = nil);
    procedure infoRegs;
    procedure infoStack;
    procedure infoVariables;
    procedure infoThreads;
    procedure infoAsm(const fname: string);
    procedure sendCustomCommand;
    procedure setGpr(reg: TCpuRegister; val: TCpuGprValue);
    procedure setFpr(reg: TFpuRegister; val: extended);
    procedure setSsr(reg: TSegRegister; val: TCPUSegValue);
    procedure setFlag(val: PtrUint);
    procedure readOutput;
    //
    procedure projNew(project: ICECommonProject);
    procedure projChanged(project: ICECommonProject);
    procedure projClosing(project: ICECommonProject);
    procedure projFocused(project: ICECommonProject);
    procedure projCompiling(project: ICECommonProject);
    procedure projCompiled(project: ICECommonProject; success: boolean);
    //
    procedure docNew(document: TCESynMemo);
    procedure docFocused(document: TCESynMemo);
    procedure docChanged(document: TCESynMemo);
    procedure docClosing(document: TCESynMemo);
    //
    function running: boolean;
    function singleServiceName: string;
    procedure addBreakPoint(const fname: string; line: integer;
      kind: TBreakPointKind = bpkBReak);
    procedure removeBreakPoint(const fname: string; line: integer;
      kind: TBreakPointKind = bpkBreak);
    procedure executeFromShortcut(sender: TObject);
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
  end;

  // Perfect static hash-set that detect a GDB stop reason
  stopReasons = record
  public
  private
    const fWords: array [0..15] of string =
    (
      'exec', 'access-watchpoint-trigger', 'location-reached', 'syscall-return',
      'vfork', 'syscall-entry', 'watchpoint-trigger', '', 'read-watchpoint-trigger',
      'breakpoint-hit', 'end-stepping-range', 'function-finished', '', 'fork',
      'solib-event', ''
    );
    const fHasEntry: array [0..15] of boolean =
    (
      true, true, true, true, true, true, true, false, true, true, true, true,
      false, true, true, false);
    const fCoeffs: array[0..255] of Byte =
    (
      3, 89, 191, 109, 130, 168, 79, 148, 40, 57, 142, 200, 143, 109, 144, 128,
      90, 119, 44, 16, 170, 160, 252, 48, 142, 79, 188, 18, 124, 157, 218, 14,
      108, 236, 45, 97, 190, 119, 37, 44, 103, 121, 20, 36, 149, 200, 122, 188,
      222, 195, 201, 15, 30, 183, 145, 110, 21, 186, 66, 71, 229, 247, 179, 169,
      169, 212, 55, 0, 44, 189, 223, 250, 253, 23, 140, 204, 155, 114, 139, 39,
      189, 35, 218, 30, 222, 168, 40, 203, 20, 208, 146, 226, 122, 200, 28, 223,
      116, 208, 151, 27, 16, 253, 107, 207, 71, 102, 215, 69, 202, 175, 103, 240,
      179, 198, 173, 120, 47, 48, 199, 52, 203, 207, 21, 80, 103, 33, 254, 46,
      218, 25, 47, 131, 221, 239, 44, 33, 165, 73, 143, 121, 73, 23, 76, 159, 199,
      172, 144, 236, 161, 249, 178, 45, 49, 157, 246, 43, 227, 145, 139, 161, 185,
      15, 68, 254, 112, 132, 133, 5, 41, 149, 116, 82, 57, 156, 193, 250, 73, 108,
      126, 1, 44, 151, 211, 197, 23, 225, 119, 247, 59, 20, 225, 241, 232, 192,
      241, 1, 7, 12, 73, 160, 157, 14, 203, 109, 9, 17, 43, 20, 14, 174, 233, 108,
      254, 204, 78, 224, 16, 15, 133, 251, 254, 204, 191, 12, 0, 131, 19, 252,
      104, 178, 231, 176, 22, 234, 104, 181, 167, 17, 103, 23, 156, 197, 249, 237,
      109, 53, 170, 237, 57, 126, 48, 119, 175, 238, 141, 188
    );
    class function hash(const w: string): Byte; static; {$IFNDEF DEBUG}inline;{$ENDIF}
  public
    class function match(const w: string): PString; static; {$IFNDEF DEBUG}inline;{$ENDIF}
  end;

implementation
{$R *.lfm}

const optFname = 'gdbcommander.txt';
const bpFname = 'breakpoints.txt';
const prjFname = 'projectsgdboptions.txt';

{$REGION TCEDebugOption --------------------------------------------------------}
procedure TCEDebugShortcuts.assign(source: TPersistent);
var
  src: TCEDebugShortcuts;
begin
  if source is TCEDebugShortcuts then
  begin
    src := TCEDebugShortcuts(source);
    fStart    := src.fStart;
    fStop     := src.fStop;
    fPause    := src.fPause;
    fContinue := src.fContinue;
    fStep     := src.fStep;
    fStepOver := src.fStepOver;
    fStack    := src.fStack;
    fRegs     := src.fRegs;
    fVariables:= src.fVariables;
  end
  else inherited;
end;

constructor TCEDebugOptionsBase.create(aOwner: TComponent);
begin
  inherited;
  fAutoDemangle := true;
  fAutoGetCallStack:= true;
  fAutoGetRegisters:= true;
  fAutoGetVariables:= true;
  fAutoDisassemble:= true;
  fAutoGetThreads:=true;
  fShowGdbOutput:=true;
  fStopAllThreadsOnBreak:= true;
  fIgnoredSignals := TStringList.Create;
  fIgnoredSignals.Duplicates:= dupIgnore;
  fIgnoredSignals.Sorted:=true;
  fCommandsHistory := TStringList.Create;
  fCommandsHistory.Duplicates:= dupIgnore;
  fCommandsHistory.Sorted:=true;
  fShortcuts := TCEDebugShortcuts.Create;
end;

destructor TCEDebugOptionsBase.destroy;
begin
  fIgnoredSignals.Free;
  fCommandsHistory.Free;
  fShortcuts.Free;
  inherited;
end;

procedure TCEDebugOptionsBase.setIgnoredSignals(value: TStringList);
begin
  fIgnoredSignals.Assign(value);
end;

procedure TCEDebugOptionsBase.setCommandsHistory(value: TStringList);
begin
  fCommandsHistory.Assign(value);
end;

procedure TCEDebugOptionsBase.setShortcuts(value: TCEDebugShortcuts);
begin
  fShortcuts.assign(value);
end;

procedure TCEDebugOptionsBase.assign(source: TPersistent);
var
  src: TCEDebugOptionsBase;
begin
  if source is TCEDebugOptionsBase then
  begin
    src := TCEDebugOptionsBase(source);
    fAsmSyntax:=src.fAsmSyntax;
    fAutoDemangle:=src.fAutoDemangle;
    fAutoDisassemble:=src.fAutoDisassemble;
    fAutoGetThreads:=src.fAutoGetThreads;
    fAutoGetCallStack:=src.fAutoGetCallStack;
    fAutoGetRegisters:=src.fAutoGetRegisters;
    fAutoGetVariables:=src.autoGetVariables;
    fShowGdbOutput:=src.fShowGdbOutput;
    fShowOutput:=src.fShowOutput;
    fShowRawMiOutput:=src.fShowRawMiOutput;
    fStopAllThreadsOnBreak:= src.fStopAllThreadsOnBreak;
    fIgnoredSignals.Assign(src.fIgnoredSignals);
    fCommandsHistory.Assign(src.fCommandsHistory);
    fShortcuts.assign(src.fShortcuts);
  end
  else inherited;
end;

constructor TCEDebugOptions.create(aOwner: TComponent);
var
  fname: string;
begin
  inherited;
  fBackup := TCEDebugOptionsBase.create(self);
  EntitiesConnector.addObserver(self);
  fShowGdbOutput:=false;
  fShowOutput:= true;
  fAutoDemangle:= true;
  fAutoGetCallStack:= true;
  fAutoGetRegisters:= true;
  fAutoGetVariables:= true;
  fname := getCoeditDocPath + optFname;
  if fname.fileExists then
    loadFromFile(fname);
end;

destructor TCEDebugOptions.destroy;
begin
  saveToFile(getCoeditDocPath + optFname);
  EntitiesConnector.removeObserver(self);
  inherited;
end;

function TCEDebugOptions.optionedWantCategory(): string;
begin
  exit('Debugger');
end;

function TCEDebugOptions.optionedWantEditorKind: TOptionEditorKind;
begin
  exit(oekGeneric);
end;

function TCEDebugOptions.optionedWantContainer: TPersistent;
begin
  exit(self);
end;

procedure TCEDebugOptions.optionedEvent(event: TOptionEditorEvent);
begin
  case event of
    oeeSelectCat: fBackup.assign(self);
    oeeCancel: assign(fBackup);
    oeeAccept:
    begin
      fBackup.assign(self);
      if assigned(FonChangesApplied) then
        FonChangesApplied(self);
    end;
  end;
end;

function TCEDebugOptions.optionedOptionsModified: boolean;
begin
  exit(false);
end;
{$ENDREGION}

{$REGION TPersistentBreakpoints ------------------------------------------------}
constructor TPersistentBreakPoints.create(aOwner: TComponent);
var
  fname: string;
begin
  Inherited;
  fItems := TCollection.Create(TPersistentBreakPoint);
  fname := getCoeditDocPath + bpFname;
  if fname.fileExists then
    loadFromFile(fname);
end;

destructor TPersistentBreakPoints.destroy;
begin
  if fItems.Count > 0 then
    saveToFile(getCoeditDocPath + bpFname);
  fItems.Free;
  inherited;
end;

procedure TPersistentBreakPoints.setItems(value: TCollection);
begin
  fItems.Assign(value);
end;

function TPersistentBreakPoints.getItem(index: integer): TPersistentBreakPoint;
begin
  exit(TPersistentBreakPoint(fItems.Items[index]));
end;

function TPersistentBreakPoints.count: integer;
begin
  exit(fItems.Count);
end;

function TPersistentBreakPoints.find(const fname: string; line: integer; kind: TBreakPointKind): boolean;
var
  i: integer;
  b: TPersistentBreakPoint;
begin
  result := false;
  for i := 0 to fItems.Count-1 do
  begin
    b := item[i];
    if (b.filename = fname) and (b.line = line) and (b.kind = kind) then
      exit(true);
  end;
end;

procedure TPersistentBreakPoints.addItem(const fname: string; line: integer; kind: TBreakPointKind);
var
  b: TPersistentBreakPoint;
begin
  if not find(fname, line, kind) then
  begin
    b := TPersistentBreakPoint(fItems.Add);
    b.filename:=fname;
    b.line:=line;
    b.kind:=kind;
  end;
end;

procedure TPersistentBreakPoints.deleteItem(const fname: string; line: integer; kind: TBreakPointKind);
var
  i: integer;
  b: TPersistentBreakPoint;
begin
  for i := fItems.Count-1 downto 0 do
  begin
    b := item[i];
    if (b.filename = fname) and (b.line = line) and (b.kind = kind) then
    begin
      fItems.Delete(i);
      break;
    end;
  end;
end;

procedure TPersistentBreakPoints.clearFile(const fname: string);
var
  i: integer;
  b: TPersistentBreakPoint;
begin
  for i:= fItems.Count-1 downto 0 do
  begin
    b := item[i];
    if b.filename = fname then
      fItems.Delete(i);
  end;
end;
{$ENDREGION}

{$REGION TStackItem/TStackItems ------------------------------------------------}
procedure TStackItem.setProperties(addr: PtrUint; fname, nme: string; lne: integer);
begin
  fAddress:=addr;
  fLine:=lne;
  fFilename:=fname;
  fFname:= nme;
end;

constructor TStackItems.create;
begin
  fItems := TCollection.Create(TStackItem);
end;

destructor TStackItems.destroy;
begin
  fItems.Free;
  inherited;
end;

procedure TStackItems.assignToList(list: TListView);
var
  i: integer;
  litm: TListItem;
  sitm: TStackItem;
begin
  list.Clear;
  for i:= 0 to fItems.Count-1 do
  begin
    litm := list.Items.Add;
    sitm := TStackItem(fItems.Items[i]);
    litm.Caption := sitm.name;
    {$IFDEF CPU64}
    litm.SubItems.Add(format('0x%.16X', [sitm.address]));
    {$ELSE}
    litm.SubItems.Add(format('0x%.8X', [sitm.address]));
    {$ENDIF}
    litm.SubItems.Add(shortenPath(sitm.filename));
    litm.Data:=sitm;
  end;
end;

procedure TStackItems.addItem(addr: PtrUint; fname, nme: string; lne: integer);
begin
  TStackItem(fItems.Add).setProperties(addr, fname, nme, lne);
end;

procedure TStackItems.clear;
begin
  fItems.Clear;
end;
{$ENDREGION}

{$REGION TInspectableCPU -------------------------------------------------------}
function TCpuRegValueEditor.GetValue: ansistring;
begin
  {$IFDEF CPU64}
  result := '0x' + IntToHex(GetInt64Value, 16);
  {$ELSE}
  result := '0x' + IntToHex(GetOrdValue, 8);
  {$ENDIF}
end;

procedure TCpuRegValueEditor.SetValue(const NewValue: ansistring);
begin
  try
    {$IFDEF CPU64}
    SetInt64Value(StrToQWord(NewValue));
    {$ELSE}
    SetOrdValue(StrToInt(NewValue));
    {$ENDIF}
  except
  end;
end;

function TCpuSegValueEditor.GetValue: ansistring;
begin
  result := '0x' + IntToHex(GetOrdValue, 4);
end;

procedure TCpuSegValueEditor.SetValue(const NewValue: ansistring);
begin
  try
    SetOrdValue(StrToInt(NewValue));
  except
  end;
end;

constructor TInspectableGPR.create(eventGPR: TSetGprEvent);
begin
  fSetGprEvent:=eventGPR;
end;

procedure TInspectableGPR.setInspectableRegister(index: TCpuRegister; value: PtrUInt);
begin
  fRegisters[index] := value;
end;

procedure TInspectableGPR.setRegister(index: TCpuRegister; value: TCpuGprValue);
begin
  fSetGprEvent(index, value);
  fRegisters[index] := value;
end;

constructor TInspectableSSR.create(eventSSR: TSetSsrEvent);
begin
  fSetSsrEvent:=eventSSR;
end;

procedure TInspectableSSR.setInspectableRegister(index: TSegRegister; value: TCPUSegValue);
begin
  fRegisters[index] := value;
end;

procedure TInspectableSSR.setRegister(index: TSegRegister; value: TCPUSegValue);
begin
  fSetSsrEvent(index, value);
  fRegisters[index] := value;
end;

constructor TInspectableFPR.create(event: TSetFprEvent);
begin
  fSetFprEvent:=event;
end;

procedure TInspectableFPR.setInspectableRegister(index: TFpuRegister; value: extended);
begin
  fRegisters[index] := value;
end;

procedure TInspectableFPR.setRegister(index: TFpuRegister; value: extended);
begin
  fSetFprEvent(index, value);
  fRegisters[index] := value;
end;

constructor TInspectableCPU.create(setGprEvent: TSetGprEvent; setSsrEvent: TSetSsrEvent;
  setFlagEvent: TSetFlagEvent; setFprEvent: TSetFprEvent);
begin
  fSetFlagEvent:=setFlagEvent;
  fGpr := TInspectableGPR.create(setGprEvent);
  fSsr := TInspectableSSR.create(setSsrEvent);
  fFpr := TInspectableFPR.create(setFprEvent);
end;

destructor TInspectableCPU.destroy;
begin
  fGpr.Free;
  fFPr.Free;
  fSSr.Free;
  inherited;
end;

procedure TInspectableCPU.setInspectableFlags(value: PtrUint);
var
  flg: TFlag;
begin
  if fFullFlags = value then
    exit;
  fFullFlags:=value;
  fFlags:= [];
  for flg in TFlag do
    if (value and FlagValues[flg]) >= FlagValues[flg] then
      fFlags += [flg];
end;

procedure TInspectableCPU.setFlag(value: TFlags);
var
  flg: TFlag;
begin
  if fFlags = value then
    exit;
  for flg in TFlag do
    if (flg in value) <> (flg in fFlags) then
      fFullFlags:= fFullFlags xor FlagValues[flg];
  fFlags := value;
  fSetFlagEvent(fFullFlags);
end;
{$ENDREGION}

{$REGION StopReasons -----------------------------------------------------------}
{$IFDEF DEBUG}{$PUSH}{$R-}{$ENDIF}
class function stopReasons.hash(const w: string): Byte;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to length(w) do
    Result += fCoeffs[Byte(w[i])];
  Result := Result and $F;
end;
{$IFDEF DEBUG}{$POP}{$ENDIF}

class function stopReasons.match(const w: string): PString;
var
  h: Byte;
begin
  result := nil;
  if (length(w) < 4) or (length(w) > 25) then
    exit;
  h := hash(w);
  if fHasEntry[h] and (fWords[h] = w) then
    result := @fWords[h];
end;
{$ENDREGION}

{$REGION TCEDebugeeOption ------------------------------------------------------}
constructor TCEDebugeeOption.Create(ACollection: TCollection);
begin
  inherited create(ACollection);
  fAgruments := TStringList.Create;
  fEnvPaths := TStringList.Create;
  fAgruments.Delimiter:= ' ';
end;

destructor TCEDebugeeOption.Destroy;
begin
  fAgruments.Free;
  fEnvPaths.Free;
  inherited;
end;

procedure TCEDebugeeOption.setOptions(value: TStringList);
begin
  fAgruments.Assign(value);
end;

procedure TCEDebugeeOption.setEnvPaths(value: TStringList);
begin
  fEnvPaths.Assign(value);
end;

constructor TCEDebugeeOptions.Create(AOwner: TComponent);
var
  fname: string;
begin
  inherited create(AOwner);
  fProjects := TCollection.Create(TCEDebugeeOption);
  fname := getCoeditDocPath + prjFname;
  if fname.fileExists then
    loadFromFile(fname);
end;

destructor TCEDebugeeOptions.Destroy;
begin
  saveToFile(getCoeditDocPath + prjFname);
  fProjects.Free;
  inherited;
end;

procedure TCEDebugeeOptions.cleanup;
var
  i: integer;
  p: TCEDebugeeOption;
begin
  for i:= fProjects.Count-1 downto 0 do
  begin
    p := projectByIndex[i];
    if not p.filename.fileExists or p.filename.isEmpty then
      fProjects.Delete(i)
    else if (p.arguments.Count = 0) and (p.environmentPaths.Count = 0) and
      (p.workingDirectory = '') and (p.queryArguments = false) then
        fProjects.Delete(i);
  end;
end;

procedure TCEDebugeeOptions.beforeSave;
begin
  cleanup;
end;

procedure TCEDebugeeOptions.setProjects(value: TCollection);
begin
  fProjects.Assign(value);
end;

function TCEDebugeeOptions.getProjectByIndex(index: integer): TCEDebugeeOption;
begin
  exit(TCEDebugeeOption(fProjects.Items[index]));
end;

function TCEDebugeeOptions.getProjectByFile(const fname: string): TCEDebugeeOption;
var
  i: integer;
begin
  for i := 0 to fProjects.Count-1 do
  begin
    result := projectByIndex[i];
    if result.filename = fname then
      exit;
  end;
  result := TCEDebugeeOption(fProjects.Add);
  result.filename:=fname;
end;
{$ENDREGION}

{$REGION Common/standard comp --------------------------------------------------}
constructor TCEGdbWidget.create(aOwner: TComponent);
begin
  inherited;
  EntitiesConnector.addObserver(self);
  EntitiesConnector.addSingleService(self);
  fSyms := getSymStringExpander;
  fDocHandler:= getMultiDocHandler;
  fMsg:= getMessageDisplay;
  fLog := TStringList.Create;
  fInspState := TInspectableCPU.Create(@setGpr, @setSsr, @setFlag, @setFpr);
  fJson := TJsonObject.Create;
  fStackItems := TStackItems.create;
  fSubj:= TCEDebugObserverSubject.Create;
  fOptions:= TCEDebugOptions.create(self);
  fOptions.onChangesApplied:=@optionsChangesApplied;
  fDebugeeOptions:= TCEDebugeeOptions.Create(self);
  Edit1.Items.Assign(fOptions.commandsHistory);
  fAddWatchPointKind := wpkWrite;
  fBreakPoints := TPersistentBreakPoints.create(self);
  //
  updateMenu;
  AssignPng(btnSendCom, 'ACCEPT');
  updateButtonsState;
end;

destructor TCEGdbWidget.destroy;
begin
  fInput.free;
  fOutput.Free;
  fOptions.commandsHistory.Assign(edit1.Items);
  fOptions.Free;
  fLog.Free;
  killGdb;
  fInspState.Free;
  fJson.Free;
  fStackItems.Free;
  EntitiesConnector.removeObserver(self);
  fSubj.free;
  inherited;
end;

procedure TCEGdbWidget.setToolBarFlat(value: boolean);
begin
  inherited setToolBarFlat(value);
  btnSendCom.Flat:=value;
  varListFlt.flat := value;
end;

procedure TCEGdbWidget.updateMenu;
var
  mnu: ICEMainMenu;
  itm: TMenuItem;
  bmp: TBitmap;
  i: integer;
begin
  mnu := getMainMenu;
  if not assigned(mnu) then
    exit;

  if fMenu.isNil then
  begin
    fMenu := mnu.mnuAdd;
    fMenu.Caption:='Debugger';
  end;
  fMenu.Clear;

  bmp := TBitmap.Create;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.start;
  itm.Caption:='Start';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=0;
  fMenu.Add(itm);
  btnStart.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.stop;
  itm.Caption:='Stop';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=1;
  fMenu.Add(itm);
  btnStop.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.pause;
  itm.Caption:='Pause';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=2;
  fMenu.Add(itm);
  btnPause.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.continue;
  itm.Caption:='Continue';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=3;
  fMenu.Add(itm);
  btnContinue.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.step;
  itm.Caption:='Step';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=4;
  fMenu.Add(itm);
  btnNext.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.stepOver;
  itm.Caption:='Step over';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=5;
  fMenu.Add(itm);
  btnOver.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.Caption:= '-';
  itm.Tag:=-1;
  fMenu.Add(itm);

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.updateRegisters;
  itm.Caption:='Update registers';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=6;
  fMenu.Add(itm);
  btnReg.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.updateStack;
  itm.Caption:='Update call stack';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=7;
  fMenu.Add(itm);
  btnStack.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  itm := TMenuItem.Create(fMenu);
  itm.ShortCut:=fOptions.shortcuts.updateVariables;
  itm.Caption:='Update the variables';
  itm.OnClick:= @executeFromShortcut;
  itm.Tag:=8;
  fMenu.Add(itm);
  btnVariables.toBitmap(bmp);
  itm.Bitmap.Assign(bmp);
  i := fMenu.GetImageList.Add(bmp, nil);
  itm.ImageIndex:= i;

  bmp.Free;
end;

procedure TCEGdbWidget.clearDisplays;
begin
  lstVariables.Clear;
  lstCallStack.Clear;
  lstThreads.Clear;
  lstAsm.Clear;
  cpuViewer.Clear;
  cpuViewer.TIObject := nil;
end;

procedure TCEGdbWidget.optionsChangesApplied(sender: TObject);
begin
  updateMenu;
end;

procedure TCEGdbWidget.executeFromShortcut(sender: TObject);
begin
  case TMenuItem(sender).Tag of
    0: begin showWidget; btnStart.Click; end;
    1: btnStop.Click;
    2: btnPause.Click;
    3: btnContinue.Click;
    4: btnNext.Click;
    5: btnOver.Click;
    6: begin showWidget; btnReg.Click; end;
    7: begin showWidget; btnStack.Click; end;
    8: begin showWidget; btnVariables.Click; end;
  end;
end;
{$ENDREGION}

{$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCEGdbWidget.projNew(project: ICECommonProject);
begin
  fProj := project;
end;

procedure TCEGdbWidget.projChanged(project: ICECommonProject);
begin
  if fProj <> project then
    exit;
end;

procedure TCEGdbWidget.projClosing(project: ICECommonProject);
begin
  if fProj <> project then
    exit;
  fProj := nil;
  updateDebugeeOptionsEditor;
  if not fDbgRunnable then
  begin
    if fOutputName.fileExists then
      deleteFile(fOutputName);
    if fInputName.fileExists then
      deleteFile(fInputName);
  end;
end;

procedure TCEGdbWidget.projFocused(project: ICECommonProject);
begin
  fProj := project;
  updateDebugeeOptionsEditor;
end;

procedure TCEGdbWidget.projCompiling(project: ICECommonProject);
begin
end;

procedure TCEGdbWidget.projCompiled(project: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}

{$REGION ICEDocumentObserver ---------------------------------------------------}
procedure TCEGdbWidget.docNew(document: TCESynMemo);
begin
end;

procedure TCEGdbWidget.docFocused(document: TCESynMemo);
begin
  fDoc := document;
  updateDebugeeOptionsEditor;
end;

procedure TCEGdbWidget.docChanged(document: TCESynMemo);
begin
end;

procedure TCEGdbWidget.docClosing(document: TCESynMemo);
begin
  if fDoc <> document then
    exit;
  fDoc := nil;
  updateDebugeeOptionsEditor;
  if fDbgRunnable then
  begin
    if fOutputName.fileExists then
      deleteFile(fOutputName);
    if fInputName.fileExists then
      deleteFile(fInputName);
  end;
end;
{$ENDREGION}

{$REGION Unsorted Debugging things ---------------------------------------------}
function TCEGdbWidget.running: boolean;
begin
  if assigned(fGdb) then
    exit(fGdb.Running)
  else
    exit(false);
end;

function TCEGdbWidget.singleServiceName: string;
begin
  exit('ICEDebugger');
end;

procedure TCEGdbWidget.killGdb;
begin
  if not assigned(fGdb) then
    exit;
  if fGdb.Running then
    fGdb.Terminate(0);
  FreeAndNil(fGdb);
end;

procedure TCEGdbWidget.storeObserversBreakpoints;
var
  i,j: integer;
  obs: ICEDebugObserver;
  nme: string;
  lne: integer;
  knd: TBreakPointKind;
begin
  for i:= 0 to fSubj.observersCount-1 do
  begin
    obs := fSubj.observers[i] as ICEDebugObserver;
    for j := 0 to obs.debugQueryBpCount-1 do
    begin
      obs.debugQueryBreakPoint(j, nme, lne, knd);
      fBreakPoints.addItem(nme, lne, knd);
    end;
  end;
end;

procedure TCEGdbWidget.waitCommandProcessed;
var
  i: integer = 0;
begin
  while not fCommandProcessed do
  begin
    application.ProcessMessages;
    i += 1;
    if i = high(integer) then
      i := 0;
  end;
end;

procedure TCEGdbWidget.addBreakPoint(const fname: string; line: integer;
  kind: TBreakPointKind = bpkBreak);
var
  r: boolean;
begin
  if assigned(fBreakPoints) then
    fBreakPoints.addItem(fname, line, kind);
  if fGdb.isNil or not fGdb.Running then
    exit;
  r := fGdbState = gsRunning;
  if r then
  begin
    fSilentPause := true;
    gdbCommand('-exec-interrupt --all', @gdboutJsonize);
    waitCommandProcessed;
    fSilentPause := false;
  end;
  gdbCommand('break ' + fname + ':' + intToStr(line));
  if r then
  begin
    fSilentPause := true;
    gdbCommand('-exec-continue --all', @gdboutJsonize);
    fSilentPause := false;
  end;
end;

procedure TCEGdbWidget.removeBreakPoint(const fname: string; line: integer;
  kind: TBreakPointKind = bpkBreak);
var
  r: boolean;
begin
  if assigned(fBreakPoints) then
    fBreakPoints.deleteItem(fname, line, kind);
  if fGdb.isNil or not fGdb.Running then
    exit;
  r := fGdbState = gsRunning;
  if r then
  begin
    fSilentPause := true;
    gdbCommand('-exec-interrupt --all', @gdboutJsonize);
    waitCommandProcessed;
    fSilentPause := false;
  end;
  gdbCommand('clear ' + fname + ':' + intToStr(line));
  if r then
  begin
    fSilentPause := true;
    gdbCommand('-exec-continue --all', @gdboutJsonize);
    fSilentPause := false;
  end;
end;

procedure TCEGdbWidget.setState(value: TGdbState);
begin
  if fGdbState = value then
    exit;
  fGdbState:=value;
  updateButtonsState;
end;

procedure TCEGdbWidget.updateButtonsState;
begin
  case fGdbState of
    gsNone:
    begin
      btnStart.Enabled:=true;
      btnStop.Enabled:=false;
      btnPause.Enabled:=false;
      btnContinue.Enabled:=false;
      btnNext.Enabled:=false;
      btnOver.Enabled:=false;
      btnReg.Enabled:=false;
      btnVariables.Enabled:=false;
      btnStack.Enabled:=false;
      btnWatch.Enabled:=false;
      clearDisplays;
    end;
    gsPaused:
    begin
      btnStart.Enabled:=false;
      btnStop.Enabled:=true;
      btnPause.Enabled:=false;
      btnContinue.Enabled:=true;
      btnNext.Enabled:=true;
      btnOver.Enabled:=true;
      btnReg.Enabled:=true;
      btnVariables.Enabled:=true;
      btnStack.Enabled:=true;
      btnWatch.Enabled:=true;
    end;
    gsRunning:
    begin
      btnStart.Enabled:=false;
      btnStop.Enabled:=true;
      btnPause.Enabled:=true;
      btnContinue.Enabled:=false;
      btnNext.Enabled:=false;
      btnOver.Enabled:=false;
      btnReg.Enabled:=false;
      btnVariables.Enabled:=false;
      btnStack.Enabled:=false;
      btnWatch.Enabled:=false;
    end;
  end;
end;

procedure TCEGdbWidget.mnuSelProjClick(Sender: TObject);
begin
  fDbgRunnable := false;
  mnuSelRunnable.Checked:=false;
  updateDebugeeOptionsEditor;
end;

procedure TCEGdbWidget.mnuSelRunnableClick(Sender: TObject);
begin
  fDbgRunnable := true;
  mnuSelProj.Checked:=false;
  updateDebugeeOptionsEditor;
end;

procedure TCEGdbWidget.mnuWriteWClick(Sender: TObject);
begin
  fAddWatchPointKind := wpkWrite;
  mnuReadW.Checked:=false;
  mnuReadWriteW.Checked:=false;
end;

procedure TCEGdbWidget.PageControl2Change(Sender: TObject);
begin
  // workaround LCL bug, "cannot focus..." due to caret in filter
  varListFlt.Enabled := PageControl2.PageIndex = 0
end;

procedure TCEGdbWidget.varListFltChange(Sender: TObject);
var
  i: integer;
begin
  if varListFlt.Filter = '' then
    exit;
  for i:= 0 to lstVariables.Items.Count-1 do
    if AnsiContainsText(lstVariables.Items[i].Caption, varListFlt.Filter) then
    begin
      lstVariables.ItemIndex:=i;
      lstVariables.Selected.MakeVisible(false);
      break;
    end;
end;

procedure TCEGdbWidget.disableEditor;
begin
  cpuViewer.ItemIndex:=-1;
end;

procedure TCEGdbWidget.startDebugging;
var
  str: string;
  gdb: string;
  i: integer;
  b: TPersistentBreakPoint;
  o: TCEDebugeeOption;
const
  asmFlavorStr: array[TAsmSyntax] of string = ('intel','att');
begin
  clearDisplays;
  if not fDbgRunnable and (fProj = nil) then
  begin
    dlgOkInfo('No project to debug', 'GDB commander');
    exit;
  end;
  if fDbgRunnable and fDoc.isNil then
  begin
    dlgOkInfo('No runnable to debug', 'GDB commander');
    exit;
  end;
  if not fDbgRunnable and (fProj.binaryKind <> executable) then
  begin
    dlgOkInfo('The project cannot be debugged because it does not output an executable', 'GDB commander');
    exit;
  end;
  if not fDbgRunnable then
    fExe := fProj.outputFilename
  else
    fExe := fDoc.fileName.stripFileExt + exeExt;
  //
  if (fExe = '/') or not fExe.fileExists then
  begin
    if fDbgRunnable then
      dlgOkInfo('Either the runnable is not compiled or it cannot be found' +
        LineEnding + 'Note that the runnable option "outputFolder" is not supported by this widget.' +
        LineEnding + LineEnding + 'Expected target: ' + fExe, 'GDB commander')
    else
      dlgOkInfo('The project binary is missing, cannot debug.' +
        LineEnding + LineEnding + 'Expected target: ' + fExe, 'GDB commander');
    exit;
  end;
  //
  fOutputName := fExe + '.inferiorout';
  fInputName  := fExe + '.inferiorin';
  FreeAndNil(fInput);
  FreeAndNil(fOutput);
  //
  gdb := exeFullName('gdb');
  if not gdb.fileExists then
  begin
    dlgOkInfo('Cannot debug, GDB is missing', 'GDB commander');
    exit;
  end;
  //
  if fInputName.fileExists then
    deletefile(fInputName);
  fInput:= TFileStream.Create(fInputName, fmCreate or fmShareExclusive);
  subjDebugStart(fSubj, self as ICEDebugger);
  case fDbgRunnable of
    true: o := fDebugeeOptions.projectByFile[fDoc.fileName];
    false:o := fDebugeeOptions.projectByFile[fProj.fileName];
  end;
  // gdb process
  killGdb;
  fGdb := TCEProcess.create(nil);
  fGdb.Executable:= gdb;
  fgdb.Options:= [poUsePipes, poStderrToOutPut];
  fgdb.Parameters.Add(fExe);
  fgdb.Parameters.Add('--interpreter=mi');
  fGdb.OnReadData:= @gdboutQuiet;
  fGdb.OnTerminate:= @gdboutJsonize;
  fgdb.execute;
  // file:line breakpoints
  storeObserversBreakpoints;
  for i:= 0 to fBreakPoints.Count-1 do
  begin
    b := fBreakPoints[i];
    case b.kind of
      bpkBreak: str := 'break ' + b.filename + ':' + intToStr(b.line) + #10;
      bpkWatch: {TODO-cGDB: put watchpoint from persistent};
    end;
    fGdb.Input.Write(str[1], str.length);
  end;
  gdbCommand('set disassembly-flavor ' + asmFlavorStr[fOptions.asmSyntax]);
  // break on druntime exceptions + any throw'
  gdbCommand('break onAssertError');
  gdbCommand('break onAssertErrorMsg');
  gdbCommand('break onUnittestErrorMsg');
  gdbCommand('break onRangeError');
  gdbCommand('break onFinalizeError');
  gdbCommand('break onHiddenFuncError');
  gdbCommand('break onOutOfMemoryError');
  gdbCommand('break onInvalidMemoryOperationError');
  gdbCommand('break onSwitchError');
  gdbCommand('break onUnicodeError');
  gdbCommand('break _d_throwc');
  gdbCommand('break _d_throwdwarf');
  gdbCommand('break _d_assertm');
  gdbCommand('break _d_assert');
  gdbCommand('break _d_assert_msg');
  gdbCommand('break _d_array_bounds');
  gdbCommand('break _d_arraybounds');
  gdbCommand('break _d_switch_error');
  gdbCommand('-gdb-set mi-async on');
  if not fOptions.stopAllThreadsOnBreak then
    gdbCommand('-gdb-set non-stop on')
  else
    gdbCommand('-gdb-set non-stop off');
  fGdb.OnReadData := @gdboutJsonize;
  cpuViewer.TIObject := fInspState;
  cpuViewer.RefreshPropertyValues;
  // inferior options
  if o.environmentPaths.Count <> 0 then
  begin
    str := '';
    for i:= 0 to o.environmentPaths.Count-1 do
      str += o.environmentPaths[i] + ' ';
    str := fSyms.expand(str[1..str.length-1]);
    gdbCommand('-environment-path ' + str);
  end;
  if DirectoryExists(o.workingDirectory) then
    gdbCommand('-environment-cd ' + fSyms.expand(o.workingDirectory));
  if (o.arguments.Count <> 0) or (o.queryArguments) then
  begin
    str := '';
    if o.queryArguments and not InputQuery('Command line arguments', 'GDB commander', str) then
      str := ''
    else
      str += ' ';
    for i := 0 to o.arguments.Count-1 do
      str += o.arguments[i] + ' ';
    str := fSyms.expand(str);
  end;
  gdbCommand('set args '+ str + '> ' + fOutputName + '< ' + fInputName);
  // non-MI command "run" has the same problem as https://sourceware.org/bugzilla/show_bug.cgi?id=18077
  gdbCommand('-exec-run');
  setState(gsRunning);
end;

procedure TCEGdbWidget.updateDebugeeOptionsEditor;
var
  nme: string = '';
  opt: TCEDebugeeOption;
begin
  dbgeeOptsEd.ItemIndex:=-1;
  dbgeeOptsEd.TIObject := nil;
  if not fDbgRunnable then
  begin
    if fProj = nil then
      exit
    else nme := fProj.filename;
    if not nme.fileExists then
      exit;
  end
  else
  begin
    if fDoc = nil then
      exit
    else nme := fDoc.filename;
    if not nme.fileExists then
      exit;
  end;
  opt := fDebugeeOptions.projectByFile[nme];
  dbgeeOptsEd.TIObject := opt;
end;
{$ENDREGION}

{$REGION GDB output processors -------------------------------------------------}
procedure parseGdbout(const str: string; var json: TJSONObject);

  procedure parseProperty(node: TJSONObject; r: PStringRange); forward;
  procedure parseProperty(node: TJSONArray; r: PStringRange); forward;

  procedure parseCLI(node: TJSONObject; r: PStringRange);
  var
    lne: TStringRange;
    msg: string = '';
  begin
    if r^.front = '"' then
      r^.popFront;
    while true do
    begin
      lne := r^.takeUntil(['\', '"']);
      if (r^.empty) then
        break
      else if r^.front = '\' then
      begin
        r^.popFront;
        if r^.front = 'n' then
        begin
          r^.popFront;
          node.Arrays['CLI'].Add(msg + lne.yield);
          msg := '';
        end else
          msg += lne.yield;
      end
      else if r^.front = '"' then
      begin
        r^.popFront;
        if r^.front = #10 then
        begin
          r^.popFront;
          break;
        end;
      end;
    end;
  end;

  procedure parseProperty(node: TJSONArray; r: PStringRange);
  var
    c: char;
  begin
    while true do
    begin
      if r^.empty then
        exit;
      c := r^.front;
      case c of
        'a'..'z':
        begin
          r^.takeUntil('=').yield;
          r^.popFront;
        end;
        '"':
        begin
          r^.popFront;
          node.Strings[node.Count] := r^.takeUntil('"').yield;
          r^.popFront;
        end;
        '{':
        begin
          r^.popFront;
          node.Objects[node.Count] := TJSONObject.Create;
          parseProperty(node.Objects[node.Count-1], r);
        end;
        ']':
        begin
          r^.popFront;
          exit;
        end;
        ',': r^.popFront;
        #10:
        begin
          r^.popFront;
          exit;
        end;
      end;
    end;
  end;

  procedure parseProperty(node: TJSONObject; r: PStringRange);
  var
    idt,v: string;
    c: char;
  begin
    while true do
    begin
      if r^.empty then
        exit;
      c := r^.front;
      case c of
        ',':
        begin
          r^.popFront;
        end;
        'a'..'z':
        begin
          idt := r^.takeUntil('=').yield;
          r^.popFront;
        end;
        '"':
        begin
          v := '';
          r^.popFront;
          while true do
          begin
            v += r^.takeUntil(['"','\']).yield;
            if r^.front = '\' then
            begin
              v += '\';
              r^.popFront;
              if r^.front = '"' then
              begin
                r^.popFront;
                v += '"';
              end;
            end else
              break;
          end;
          node.Strings[idt] := v;
          r^.popFront;
        end;
        '{':
        begin
          r^.popFront;
          node.Objects[idt] := TJSONObject.Create;
          parseProperty(node.Objects[idt], r);
        end;
        '[':
        begin
          r^.popFront;
          node.Arrays[idt] := TJSONArray.Create;
          parseProperty(node.Arrays[idt], r);
        end;
        '}', ']':
        begin
          r^.popFront;
          exit;
        end;
        ' ', #9:
          r^.popFront;
        #10:
        begin
          r^.popFront;
          exit;
        end;
      end;
    end;
  end;

var
  rng: TStringRange = (ptr: nil; pos: 0; len: 0);
begin
  json.Clear;
  if str.length = 0 then
    exit;
  rng.init(str);
  json.Arrays['OUT'] := TJSONArray.Create;
  json.Arrays['CLI'] := TJSONArray.Create;
  while true do
  begin
    if rng.empty then
      exit;
    case rng.front of
      // event
      '*':
      begin
        parseProperty(json, rng.popUntil(',')^.popFront);
      end;
      // command answer (can be a simple '^done')
      '^':
      begin
        parseProperty(json, rng.popUntil([',', #10]));
      end;
      // what would be output in a console by gdb
      '~':
      begin
        parseCLI(json, rng.popFront);
      end;
      // internal gdb messages
      '&':
      begin
        rng.popUntil(#10);
        if not rng.empty then
          rng.popFront;
      end;
      // async notify / status / out stream when remote (@)
      '=', '+','@':
      begin
        rng.popUntil(#10);
        if not rng.empty then
          rng.popFront;
      end
      else
      begin
        rng.popUntil(#10);
        if not rng.empty then
          rng.popFront;
      end;
    end;
  end;
end;

procedure TCEGdbWidget.interpretJson;

  procedure selectAsmInstr;
  var
    itm: TListItem = nil;
  begin
    if lstAsm.items.findCaption(fLastOffset, itm) then
    begin
      itm.Selected:=true;
      itm.MakeVisible(false);
    end;
  end;

  procedure autoGetStuff;
  begin
    if fOptions.autoGetCallStack then
      infoStack;
    if fOptions.autoGetRegisters then
      infoRegs;
    if fOptions.autoGetVariables then
      infoVariables;
    if fOptions.autoGetThreads then
      infoThreads;
    selectAsmInstr;
  end;

var
  r: PString;
  i,j: integer;
  val: TJSONData;
  obj: TJSONObject;
  arr: TJSONArray;
  k: TListItem;
  // common data
  nme: string;
  reason: string;
  addr: PtrUint = 0;
  func:string = '';
  line: integer = -1;
  // registers data
  number: integer = 0;
  // signal data
  sigmean: string;
  signame: string;
  brkreason: TCEDebugBreakReason;
  // FPU
  fFpuExtended: extended;
  fFpuRaw: array[0..9] of Byte absolute fFpuExtended;
begin

  if fJson.findAny('reason', val) then
  begin
    reason := val.AsString;
    r := stopReasons.match(reason);
    if assigned(r) then
    begin
      case r^ of
        'breakpoint-hit': brkreason := dbBreakPoint;
        'watchpoint-trigger', 'access-watchpoint-trigger', 'read-watchpoint-trigger':
          brkreason:= dbWatch;
        else brkreason := dbStep;
      end;
      if brkreason = dbWatch then
      begin
        if fJson.findObject('wpt', obj) and obj.findAny('exp', val) then
        begin
          if lstVariables.items.findCaption(val.AsString, k) then
          begin
            lstVariables.ItemIndex:=k.index;
            k.MakeVisible(false);
          end;
        end;
      end;
      if fJson.findObject('frame', obj) then
      begin
        if obj.FindAny('addr', val) then
          fLastOffset:=val.AsString;
        if obj.FindANy('fullname', val) then
          fLastFilename := val.AsString;
        if obj.findAny('line', val) then
        begin
          line := val.AsInteger;
          fLastLine := val.AsString;
        end;
        if obj.findAny('func', val) then
        begin
          if fOptions.autoDisassemble and (val.AsString <> fLastFunction) then
            infoAsm(fLastFilename);
          fLastFunction := val.AsString;
        end;
        if fDocHandler.findDocument(fLastFilename).isNil and fLastFilename.fileExists then
          fDocHandler.openDocument(fLastFilename);
        setState(gsPaused);
        autoGetStuff;
        readOutput;
        application.BringToFront;
        subjDebugBreak(fSubj, fLastFilename, line, brkreason);
      end;
    end

    else if reason = 'watchpoint-scope' then
    begin
      gdbCommand('continue', @gdboutJsonize);
    end

    else if reason = 'signal-received' then
    begin
      signame := 'unknown signal';
      sigmean := 'unknown meaning';
      if fJson.findAny('signal-name', val) then
        signame := val.AsString;
      if (fOptions.ignoredSignals.Count <> 0) and
        (fOptions.ignoredSignals.IndexOf(signame) <> -1) then
          exit;
      if fJson.findAny('signal-meaning', val) then
        sigmean := val.AsString;
      if fJson.findObject('frame', obj) then
      begin
        if obj.findAny('addr', val) then
          fLastOffset:=val.AsString;
        if obj.findAny('fullname', val) then
          fLastFilename := val.AsString;
        if obj.findAny('line', val) then
          line := val.AsInteger;
        if obj.findAny('func', val) then
        begin
          if fOptions.autoDisassemble and (val.AsString <> fLastFunction) then
            infoAsm(fLastFilename);
          fLastFunction := val.AsString;
        end;
      end;
      if fCatchPause then
      begin
        fCatchPause := false;
        if  fDocHandler.findDocument(fLastFilename).isNil and fLastFilename.fileExists then
          fDocHandler.openDocument(fLastFilename);
        autoGetStuff;
        setState(gsPaused);
        readOutput;
        subjDebugBreak(fSubj, fLastFilename, line, dbSignal);
      end
      else if not fSilentPause then
      begin
        if dlgYesNo(format('The signal %s (%s) was received on line %d of file %s .'
        + LineEnding + 'Do you wish to pause execution ?', [signame, sigmean, line, fLastFilename]),
        'Unexpected signal received') = mrNo then
        begin
          gdbCommand('continue', @gdboutJsonize);
          setState(gsRunning);
        end
        else
        begin
          if not fDocHandler.findDocument(fLastFilename).isNil and fLastFilename.fileExists then
            fDocHandler.openDocument(fLastFilename);
          autoGetStuff;
          setState(gsPaused);
          readOutput;
          subjDebugBreak(fSubj, fLastFilename, line, dbSignal);
        end;
      end;
    end

    else if (reason = 'exited-normally') or (reason = 'exited-signalled')
      or (reason = 'exited')
    then
    begin
      application.BringToFront;
      readOutput;
      if not fOptions.showGdbOutput then
        fMsg.message('debugging terminated: ' + reason, nil, amcMisc, amkInf);
      setState(gsNone);
      subjDebugStop(fSubj);
    end;
  end;

  if fJson.findAny('msg', val) then
    fMsg.message(val.AsString, nil, amcMisc, amkAuto);

  if fJson.findArray('register-values', arr) then
  begin
    for i := 0 to arr.Count-1 do
    begin
      obj := TJSONObject(arr.Objects[i]);
      if obj.isNil then
        break;
      if obj.findAny('number', val) then
        number := val.AsInteger;
      if obj.findAny('value', val) then
      case number of
        0..integer(high(TCpuRegister)):
        begin
          fInspState.CPU.setInspectableRegister
            (TCpuRegister(number), {$IFDEF CPU64}val.AsQWord{$ELSE}val.AsInteger{$ENDIF});
        end;
        flagOffset:
        begin
          fInspState.setInspectableFlags({$IFDEF CPU64}val.AsInt64{$ELSE}val.AsInteger{$ENDIF});
        end;
        segOffset..segOffset+5:
        begin
          fInspState.SSR.setInspectableRegister
            (TSegRegister(number - segOffset), val.AsInteger);
        end;
        stOffset..stOffset+7:
        begin
          fFpuRaw[9] := StrToInt('$' + val.AsString[3..4]);
          fFpuRaw[8] := StrToInt('$' + val.AsString[5..6]);
          fFpuRaw[7] := StrToInt('$' + val.AsString[7..8]);
          fFpuRaw[6] := StrToInt('$' + val.AsString[9..10]);
          fFpuRaw[5] := StrToInt('$' + val.AsString[11..12]);
          fFpuRaw[4] := StrToInt('$' + val.AsString[13..14]);
          fFpuRaw[3] := StrToInt('$' + val.AsString[15..16]);
          fFpuRaw[2] := StrToInt('$' + val.AsString[17..18]);
          fFpuRaw[1] := StrToInt('$' + val.AsString[19..20]);
          fFpuRaw[0] := StrToInt('$' + val.AsString[21..22]);
          fInspState.FPU.setInspectableRegister
            (TFpuRegister(number - stOffset), fFpuExtended);
        end;
      end;
      // TODO-cGDB: get SSE registers
    end;
    cpuViewer.RefreshPropertyValues;
  end;

  if fJson.findArray('stack', arr) then
  begin
    fStackItems.clear;
    lstCallStack.Clear;
    for i := 0 to arr.Count-1 do
    begin
      obj := arr.Objects[i];
      if obj.isNil then
        break;
      val := obj.Find('fullname');
      if val.isNotNil then
        fLastFilename:= val.AsString;
      val := obj.Find('func');
      if val.isNotNil then
      begin
        if fOptions.autoDemangle then
          func:= demangle(val.AsString)
        else
          func := val.AsString;
      end;
      val := obj.Find('addr');
      if val.isNotNil then
        addr := val.AsInt64;
      val := obj.Find('line');
      if val.isNotNil then
        line := val.AsInteger;
      fStackItems.addItem(addr, fLastFilename, func, line);
    end;
    fStackItems.assignToList(lstCallStack);
  end;

  val := fJson.Find('variables');
  if val.isNil then
    val := fJson.Find('locals');
  if val.isNotNil and (val.JSONType = jtArray) then
  begin
    j := lstVariables.ItemIndex;
    lstVariables.BeginUpdate;
    lstVariables.Clear;
    arr := TJSONArray(val);
    for i := 0 to arr.Count-1 do
    begin
      val := arr.Items[i];
      if val.JSONType <> jtObject then
        continue;
      obj := TJSONObject(val);
      val := obj.Find('name');
      if val.isNil then
        continue;
      nme := val.AsString;
      val := obj.Find('value');
      if val.isNil then
        continue;
      lstVariables.AddItem(nme, nil);
      with lstVariables.Items[lstVariables.Items.Count-1] do
        SubItems.Add(val.AsString);
    end;
    if (j <> -1) and (j < lstVariables.Items.Count) then
      lstVariables.ItemIndex := j;
    lstVariables.EndUpdate;
  end;

  if fJson.findArray('asm_insns', arr) then
  begin
    lstAsm.BeginUpdate;
    lstAsm.Clear;
    for i := 0 to arr.Count-1 do
    begin
      obj := arr.Objects[i];
      val := obj.Find('address');
      if val.isNotNil then
        nme := val.AsString;
      //val := obj.Find('func-name');
      //val := obj.Find('offset');
      val := obj.Find('inst');
      if val.isNotNil then
      begin
        lstAsm.AddItem(nme, nil);
        if nme = fLastOffset then
          lstAsm.Selected := lstAsm.Items[lstAsm.Items.Count-1];
        if fOptions.autoDemangle then
          lstAsm.Items[lstAsm.Items.Count-1].SubItems.Add(demangle(val.AsString))
        else
          lstAsm.Items[lstAsm.Items.Count-1].SubItems.Add(val.AsString);
      end;
    end;
    if lstAsm.Selected.isNotNil then
      lstAsm.Selected.MakeVisible(false);
    lstAsm.EndUpdate;
    selectAsmInstr;
  end;

  if fJson.findArray('threads', arr) then
  begin
    lstThreads.BeginUpdate;
    lstThreads.Clear;
    for i := 0 to arr.Count-1 do
    begin
      obj := arr.Objects[i];
      if obj.findAny('id', val) then
      begin
        lstThreads.AddItem(val.AsString, nil);
        k := lstThreads.Items[lstThreads.Items.Count-1];
        if obj.findAny('state', val) then
          k.SubItems.Add(val.AsString);
        if obj.findAny('core', val) then
          k.SubItems.Add(val.AsString);
        val := obj.Find('frame');
        if val.isNotNil and (val.JSONType = jtObject) then
        begin
          obj := TJSONObject(val);
          if obj.findAny('func', val) then
            if fOptions.autoDemangle then
              k.SubItems.Add(demangle(val.AsString))
            else
              k.SubItems.Add(demangle(val.AsString));
          if obj.findAny('addr', val) then
            k.SubItems.Add(val.AsString);
          if obj.findAny('fullname', val) then
            k.SubItems.Add(val.AsString);
          if obj.findAny('line', val) then
            k.SubItems.Add(val.AsString);
        end;
      end;
    end;
    lstThreads.EndUpdate;
  end;

  if fOptions.showGdbOutput or fShowFromCustomCommand then
  begin
    fShowFromCustomCommand := false;
    if fJson.findArray('CLI', arr) then
      for i := 0 to arr.Count-1 do
        fMsg.message(arr.Strings[i], nil, amcMisc, amkBub);
  end;

end;

procedure TCEGdbWidget.gdboutJsonize(sender: TObject);
var
  str: string;
begin
  fCommandProcessed := true;
  if fMsg = nil then
    exit;

  fLog.Clear;
  fGdb.getFullLines(fLog);
  if fOptions.showRawMiOutput then
    for str in fLog do
      fMsg.message(str, nil, amcMisc, amkAuto);

  if flog.Text.isEmpty then
    exit;

  parseGdbout(fLog.Text, fJson);
  interpretJson;
end;

procedure TCEGdbWidget.readOutput;
var
  str: TMemoryStream;
  lst: TStringList;
  lne: string;
begin
  if (fGdbState = gsNone) or not fOptions.showOutput then
    exit;
  if fOutput.isNil and fOutputName.fileExists then
  try
    fOutput := TFileStream.Create(fOutputName, 0);
  except
    if fOutput.isNotNil then
      FreeAndNil(fOutput);
  end;
  if fOutput.isNil then
    exit;
  str := TMemoryStream.Create;
  lst := TStringList.Create;
  try
    str.size := fOutput.Size - fOutput.Position;
    fOutput.Read(str.Memory^, str.Size);
    lst.LoadFromStream(str);
    for lne in lst do
      fMsg.message(lne, nil, amcMisc, amkBub);
  finally
    lst.Free;
    str.Free;
  end;
end;

procedure TCEGdbWidget.gdboutQuiet(sender: TObject);
begin
  fCommandProcessed := true;
  fGdb.OutputStack.Clear;
  fGdb.OnReadData:=@gdboutJsonize;
end;
{$ENDREGION}

{$REGION GDB commands & actions ------------------------------------------------}
procedure TCEGdbWidget.gdbCommand(aCommand: string; gdbOutProcessor: TNotifyEvent = nil);
begin
  if fGdb.isNil or not fGdb.Running then
    exit;
  fCommandProcessed := false;
  aCommand += #10;
  if assigned(gdbOutProcessor) then
    fGdb.OnReadData := gdbOutProcessor;
  fGdb.Input.Write(aCommand[1], aCommand.length);
end;

procedure TCEGdbWidget.infoRegs;
begin
  disableEditor;
  gdbCommand('-data-list-register-values r', @gdboutJsonize);
end;

procedure TCEGdbWidget.infoStack;
begin
  gdbCommand('-stack-list-frames', @gdboutJsonize);
end;

procedure TCEGdbWidget.infoVariables;
begin
  gdbCommand('-stack-list-variables --skip-unavailable --simple-values');
end;

procedure TCEGdbWidget.infoThreads;
begin
  gdbCommand('-thread-info');
end;

procedure TCEGdbWidget.infoAsm(const fname: string);
var
  cmd: string;
begin
  if not fname.fileExists or (fLastLine = '-1') or (fLastLine = '0') then
    exit;
  cmd := format('-data-disassemble -f %s -l %s -n -1 -- 0', [fname, fLastLine]);
  //cmd := format('-data-disassemble -s %s -e $pc -- 0', [fLastOffset]);
  gdbCommand(cmd, @gdboutJsonize);
end;

procedure TCEGdbWidget.btnStartClick(Sender: TObject);
begin
  startDebugging;
end;

procedure TCEGdbWidget.btnContClick(Sender: TObject);
begin
  gdbCommand('-exec-continue --all', @gdboutJsonize);
  if assigned(fGdb) and fgdb.Running then
  begin
    setState(gsRunning);
    subjDebugContinue(fSubj);
  end;
end;

procedure TCEGdbWidget.btnVariablesClick(Sender: TObject);
begin
  infoVariables;
end;

procedure TCEGdbWidget.btnNextClick(Sender: TObject);
const
  cmd: array[boolean] of string = ('-exec-step','-exec-step-instruction');
begin
  gdbCommand(cmd[mnuNextMachine.Checked], @gdboutJsonize);
  if assigned(fGdb) and fgdb.Running then
    setState(gsRunning);
end;

procedure TCEGdbWidget.btnOverClick(Sender: TObject);
const
  cmd: array[boolean] of string = ('-exec-next','-exec-next-instruction');
begin
  gdbCommand(cmd[mnuStepMachine.Checked], @gdboutJsonize);
  if assigned(fGdb) and fgdb.Running then
    setState(gsRunning);
end;

procedure TCEGdbWidget.btnPauseClick(Sender: TObject);
begin
  if assigned(fGdb) and fGdb.Running then
    fCatchPause:=true;
  gdbCommand('-exec-interrupt --all', @gdboutJsonize);
end;

procedure TCEGdbWidget.btnRegClick(Sender: TObject);
begin
  infoRegs;
end;

procedure TCEGdbWidget.btnStackClick(Sender: TObject);
begin
  infoStack;
end;

procedure TCEGdbWidget.btnStopClick(Sender: TObject);
begin
  gdbCommand('kill', @gdboutJsonize);
  subjDebugStop(fSubj);
  setState(gsNone);
end;

procedure TCEGdbWidget.btnWatchClick(Sender: TObject);
const
  cmd: array[TAddWatchPointKind] of string = (
    '-break-watch -r ','-break-watch ','-break-watch -a ');
var
  nme: string;
begin
  if lstVariables.ItemIndex = -1 then
    exit;
  nme := lstVariables.Items[lstVariables.ItemIndex].Caption;
  gdbCommand(cmd[fAddWatchPointKind] + nme);
end;

procedure TCEGdbWidget.dbgeeOptsEdEditorFilter(Sender: TObject;
  aEditor: TPropertyEditor; var aShow: boolean);
begin
  aShow := aEditor.GetName <> 'filename';
end;

procedure TCEGdbWidget.btnSendComClick(Sender: TObject);
begin
  sendCustomCommand;
end;

procedure TCEGdbWidget.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = byte(#13) then
    sendCustomCommand;
end;

procedure TCEGdbWidget.lstCallStackDblClick(Sender: TObject);
var
  itm: TStackItem;
  nme: string;
  doc: TCESynMemo;
begin
  if lstCallStack.Selected.isNil or lstCallStack.Selected.Data.isNil then
    exit;
  itm := TStackItem(lstCallStack.Selected.Data);
  nme := itm.filename;
  if not nme.fileExists then
    exit;
  fDocHandler.openDocument(nme);
  doc := fDocHandler.findDocument(nme);
  if doc.isNotNil then
    doc.CaretY:= itm.line;
  {gdbCommand('-stack-select-frame ' + intToStr(lstCallStack.ItemIndex));
  if fOptions.autoGetVariables then
    infoVariables;
  if fOptions.autoGetRegisters then
    infoRegs;}
end;

procedure TCEGdbWidget.lstThreadsDblClick(Sender: TObject);
var
  lne: integer;
  nme: string;
  doc: TCESynMemo = nil;
begin
  if (lstThreads.Selected.isNil) or (lstThreads.Selected.SubItems.Count < 6) then
    exit;
  lne := StrToIntDef(lstThreads.Selected.SubItems[5], -1);
  nme := lstThreads.Selected.SubItems[4];
  if not nme.fileExists or (lne = -1) then
    exit;
  fDocHandler.openDocument(nme);
  doc := fDocHandler.findDocument(nme);
  if doc.isNotNil then
    doc.CaretY:= lne;
end;

procedure TCEGdbWidget.mnuReadWClick(Sender: TObject);
begin
  fAddWatchPointKind := wpkRead;
  mnuWriteW.Checked:=false;
  mnuReadWriteW.Checked:=false;
end;

procedure TCEGdbWidget.mnuReadWriteWClick(Sender: TObject);
begin
  fAddWatchPointKind := wpkReadWrite;
  mnuReadW.Checked:=false;
  mnuWriteW.Checked:=false;
end;

procedure TCEGdbWidget.sendCustomCommand;
var
  cmd: string;
begin
  cmd := edit1.Text;
  if cmd.isEmpty then
    exit;
  if edit1.Items.IndexOf(cmd) = -1 then
    edit1.Items.Add(cmd);
  cmd := fSyms.expand(cmd);
  if (cmd.length > 1) and (cmd[1] = '>') and assigned(fInput) then
  begin
    cmd := cmd[2..cmd.length] + #10;
    fInput.Write(cmd[1], cmd.length);
    {$IFDEF UNIX}
    fpfsync(fInput.Handle);
    {$ELSE}
    FlushFileBuffers(fInput.Handle);
    {$ENDIF}
    sleep(100);
    readOutput;
  end
  else
  begin
    fShowFromCustomCommand := true;
    gdbCommand(cmd, @gdboutJsonize);
  end;
  edit1.Text := '';
end;


//TODO-cGDB: copy from the lists: value, instructions, etc.

procedure TCEGdbWidget.setGpr(reg: TCpuRegister; val: TCpuGprValue);
const
  spec = 'set $%s = 0x%X';
var
  cmd : string;
begin
  cmd := format(spec, [GetEnumName(typeinfo(TCpuRegister),integer(reg)), val]);
  gdbCommand(cmd);
end;

procedure TCEGdbWidget.setSsr(reg: TSegRegister; val: TCPUSegValue);
const
  spec = 'set $%s = 0x%X';
var
  cmd : string;
begin
  cmd := format(spec, [GetEnumName(typeinfo(TSegRegister),integer(reg)), val]);
  gdbCommand(cmd);
end;

procedure TCEGdbWidget.setFlag(val: PtrUint);
const
  spec = 'set $eflags = 0x%X';
var
  cmd: string;
begin
  cmd := format(spec, [val]);
  gdbCommand(cmd);
end;

procedure TCEGdbWidget.setFpr(reg: TFpuRegister; val: extended);
const
  spec = 'set $%s = %.18g';
var
  cmd : string;
begin
  cmd := format(spec, [GetEnumName(typeinfo(TFpuRegister),integer(reg)), val]);
  gdbCommand(cmd);
end;
{$ENDREGION}

initialization
  RegisterPropertyEditor(TypeInfo(TCpuGprValue), nil, '', TCpuRegValueEditor);
  RegisterPropertyEditor(TypeInfo(TCpuSegValue), nil, '', TCpuSegValueEditor);
end.

