{ This file is part of the Free Pascal Integrated Development Environment Copyright (c) 1998-2000 by Pierre Muller Debugger call routines for the IDE See the file COPYING.FPC, included in this distribution, for details about the copyright. This program 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. **********************************************************************} unit FPDebug; {$ifdef NODEBUG} {$H-} interface implementation end. {$else} {$i globdir.inc} interface uses {$ifdef Windows} Windows, {$endif Windows} Objects,Dialogs,Drivers,Views, {$ifndef NODEBUG} {$ifdef GDBMI} GDBMICon,GDBMIInt, {$else GDBMI} GDBCon,GDBInt, {$endif GDBMI} {$endif NODEBUG} Menus, WViews,WEditor, FPViews; type {$ifndef NODEBUG} PDebugController=^TDebugController; TDebugController=object(TGDBController) private function GetFPCBreakErrorParameters(var ExitCode: LongInt; var ExitAddr, ExitFrame: CORE_ADDR): Boolean; public InvalidSourceLine : boolean; { if true the current debugger raw will stay in middle of editor window when debugging PM } CenterDebuggerRow : TCentre; Disableallinvalidbreakpoints : boolean; OrigPwd, { pwd at startup } LastFileName : string; LastSource : PView; {PsourceWindow !! } HiddenStepsCount : longint; { no need to switch if using another terminal } NoSwitch : boolean; HasExe : boolean; RunCount : longint; FPCBreakErrorNumber : longint; {$ifdef SUPPORT_REMOTE} isRemoteDebugging, isFirstRemote, isConnectedToRemote, usessh :boolean; {$endif SUPPORT_REMOTE} constructor Init; procedure SetExe(const exefn:string); procedure SetSourceDirs; destructor Done; function DoSelectSourceline(const fn:string;line,BreakIndex:longint): Boolean;virtual; { procedure DoStartSession;virtual; procedure DoBreakSession;virtual;} procedure DoEndSession(code:longint);virtual; procedure DoUserSignal;virtual; procedure FlushAll; virtual; function Query(question : PAnsiChar; args : PAnsiChar) : longint; virtual; procedure AnnotateError; procedure InsertBreakpoints; procedure RemoveBreakpoints; procedure ReadWatches; procedure RereadWatches; procedure ResetBreakpointsValues; procedure DoDebuggerScreen;virtual; procedure DoUserScreen;virtual; procedure Reset;virtual; procedure ResetDebuggerRows; procedure Run;virtual; procedure Continue;virtual; procedure UntilReturn;virtual; procedure CommandBegin(const s:string);virtual; procedure CommandEnd(const s:string);virtual; function IsRunning : boolean; function AllowQuit : boolean;virtual; function GetValue(Const expr : string) : PAnsiChar; function GetFramePointer : CORE_ADDR; function GetLongintAt(addr : CORE_ADDR) : longint; function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR; end; {$endif NODEBUG} BreakpointType = (bt_function,bt_file_line,bt_watch, bt_awatch,bt_rwatch,bt_address,bt_invalid); BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after); PBreakpointCollection=^TBreakpointCollection; PBreakpoint=^TBreakpoint; TBreakpoint=object(TObject) typ : BreakpointType; state : BreakpointState; owner : PBreakpointCollection; Name : PString; { either function name or expr to watch } FileName : PString; OldValue,CurrentValue : Pstring; Line : Longint; { only used for bt_file_line type } Conditions : PString; { conditions relative to that breakpoint } IgnoreCount : Longint; { how many counts should be ignored } Commands : PAnsiChar; { commands that should be executed on breakpoint } GDBIndex : longint; GDBState : BreakpointState; constructor Init_function(Const AFunc : String); constructor Init_Address(Const AAddress : String); constructor Init_Empty; constructor Init_file_line(AFile : String; ALine : longint); constructor Init_type(atyp : BreakpointType;Const AnExpr : String); constructor Load(var S: TStream); procedure Store(var S: TStream); procedure Insert; procedure Remove; procedure Enable; procedure Disable; procedure UpdateSource; procedure ResetValues; destructor Done;virtual; end; TBreakpointCollection=object(TCollection) function At(Index: Integer): PBreakpoint; function GetGDB(index : longint) : PBreakpoint; function GetType(typ : BreakpointType;Const s : String) : PBreakpoint; function ToggleFileLine(FileName: String;LineNr : Longint) : boolean; procedure Update; procedure ShowBreakpoints(W : PFPWindow); function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint; procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint); procedure ShowAllBreakpoints; end; PBreakpointItem = ^TBreakpointItem; TBreakpointItem = object(TObject) Breakpoint : PBreakpoint; constructor Init(ABreakpoint : PBreakpoint); function GetText(MaxLen: Sw_integer): string; virtual; procedure Selected; virtual; function GetModuleName: string; virtual; end; PBreakpointsListBox = ^TBreakpointsListBox; TBreakpointsListBox = object(THSListBox) Transparent : boolean; NoSelection : boolean; MaxWidth : Sw_integer; (* ModuleNames : PStoreCollection; *) constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); procedure AddBreakpoint(P: PBreakpointItem); virtual; function GetText(Item,MaxLen: Sw_Integer): String; virtual; function GetLocalMenu: PMenu;virtual; procedure Clear; virtual; procedure TrackSource; virtual; procedure EditNew; virtual; procedure EditCurrent; virtual; procedure DeleteCurrent; virtual; procedure ToggleCurrent; procedure Draw; virtual; procedure HandleEvent(var Event: TEvent); virtual; constructor Load(var S: TStream); procedure Store(var S: TStream); destructor Done; virtual; end; PBreakpointsWindow = ^TBreakpointsWindow; TBreakpointsWindow = object(TFPDlgWindow) BreakLB : PBreakpointsListBox; constructor Init; procedure AddBreakpoint(ABreakpoint : PBreakpoint); procedure ClearBreakpoints; procedure ReloadBreakpoints; procedure Close; virtual; procedure SizeLimits(var Min, Max: TPoint);virtual; procedure HandleEvent(var Event: TEvent); virtual; procedure Update; virtual; constructor Load(var S: TStream); procedure Store(var S: TStream); destructor Done; virtual; end; PBreakpointItemDialog = ^TBreakpointItemDialog; TBreakpointItemDialog = object(TCenterDialog) constructor Init(ABreakpoint: PBreakpoint); function Execute: Word; virtual; private Breakpoint : PBreakpoint; TypeRB : PRadioButtons; NameIL : PEditorInputLine; ConditionsIL: PEditorInputLine; LineIL : PEditorInputLine; IgnoreIL : PEditorInputLine; end; PWatch = ^TWatch; TWatch = Object(TObject) expr : pstring; last_value,current_value : PAnsiChar; constructor Init(s : string); constructor Load(var S: TStream); procedure Store(var S: TStream); procedure rename(s : string); procedure Get_new_value; procedure Force_new_value; destructor done;virtual; private GDBRunCount : longint; end; PWatchesCollection = ^TWatchesCollection; TWatchesCollection = Object(TCollection) constructor Init; procedure Insert(Item: Pointer); virtual; function At(Index: Integer): PWatch; procedure Update; private MaxW : integer; end; PWatchesListBox = ^TWatchesListBox; TWatchesListBox = object(THSListBox) Transparent : boolean; MaxWidth : Sw_integer; constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); (* procedure AddWatch(P: PWatch); virtual; *) procedure Update(AMaxWidth : integer); function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual; function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual; function GetLocalMenu: PMenu;virtual; (* procedure Clear; virtual; procedure TrackSource; virtual;*) procedure EditNew; virtual; procedure EditCurrent; virtual; procedure DeleteCurrent; virtual; (*procedure ToggleCurrent; *) procedure Draw; virtual; procedure HandleEvent(var Event: TEvent); virtual; constructor Load(var S: TStream); procedure Store(var S: TStream); destructor Done; virtual; end; PWatchItemDialog = ^TWatchItemDialog; TWatchItemDialog = object(TCenterDialog) constructor Init(AWatch: PWatch); function Execute: Word; virtual; private Watch : PWatch; NameIL : PEditorInputLine; TextST : PAdvancedStaticText; end; PWatchesWindow = ^TWatchesWindow; TWatchesWindow = Object(TFPDlgWindow) WLB : PWatchesListBox; Constructor Init; constructor Load(var S: TStream); procedure Store(var S: TStream); procedure Update; virtual; destructor Done; virtual; end; PFramesListBox = ^TFramesListBox; TFramesListBox = object(TMessageListBox) constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); procedure Update; function GetLocalMenu: PMenu;virtual; procedure GotoSource; virtual; procedure GotoAssembly; virtual; procedure HandleEvent(var Event: TEvent); virtual; destructor Done; virtual; end; PStackWindow = ^TStackWindow; TStackWindow = Object(TFPDlgWindow) FLB : PFramesListBox; Constructor Init; constructor Load(var S: TStream); procedure Store(var S: TStream); procedure Update; virtual; destructor Done; virtual; end; procedure InitStackWindow; procedure DoneStackWindow; function ActiveBreakpoints : boolean; function GDBFileName(st : string) : string; function OSFileName(st : string) : string; const BreakpointTypeStr : Array[BreakpointType] of String[9] = ( 'function','file-line','watch','awatch','rwatch','address','invalid'); BreakpointStateStr : Array[BreakpointState] of String[8] = ( 'enabled','disabled','invalid',''{'to be deleted' should never be used}); var {$ifndef NODEBUG} Debugger : PDebugController; {$endif NODEBUG} BreakpointsCollection : PBreakpointCollection; WatchesCollection : PwatchesCollection; procedure InitDebugger; procedure DoneDebugger; procedure InitGDBWindow; procedure DoneGDBWindow; procedure InitDisassemblyWindow; procedure DoneDisassemblyWindow; procedure InitBreakpoints; procedure DoneBreakpoints; procedure InitWatches; procedure DoneWatches; procedure RegisterFPDebugViews; procedure UpdateDebugViews; {$ifdef SUPPORT_REMOTE} function TransformRemoteString(st : string) : string; {$endif SUPPORT_REMOTE} implementation uses Dos, Video, {$ifdef DOS} fpusrscr, {$endif DOS} fpredir, App,Strings, FVConsts, MsgBox, {$ifdef Windows} Windebug, {$endif Windows} {$ifdef Unix} baseunix, unix, termio, {$endif Unix} Systems,Globals, FPRegs,FPTools, FPVars,FPUtils,FPConst,FPSwitch, FPIntf,FPCompil,FPIde,FPHelp, Validate,WUtils,Wconsts; const RBreakpointsWindow: TStreamRec = ( ObjType: 1701; VmtLink: Ofs(TypeOf(TBreakpointsWindow)^); Load: @TBreakpointsWindow.Load; Store: @TBreakpointsWindow.Store ); RBreakpointsListBox : TStreamRec = ( ObjType: 1702; VmtLink: Ofs(TypeOf(TBreakpointsListBox)^); Load: @TBreakpointsListBox.Load; Store: @TBreakpointsListBox.Store ); RWatchesWindow: TStreamRec = ( ObjType: 1703; VmtLink: Ofs(TypeOf(TWatchesWindow)^); Load: @TWatchesWindow.Load; Store: @TWatchesWindow.Store ); RWatchesListBox: TStreamRec = ( ObjType: 1704; VmtLink: Ofs(TypeOf(TWatchesListBox)^); Load: @TWatchesListBox.Load; Store: @TWatchesListBox.Store ); RStackWindow: TStreamRec = ( ObjType: 1705; VmtLink: Ofs(TypeOf(TStackWindow)^); Load: @TStackWindow.Load; Store: @TStackWindow.Store ); RFramesListBox: TStreamRec = ( ObjType: 1706; VmtLink: Ofs(TypeOf(TFramesListBox)^); Load: @TFramesListBox.Load; Store: @TFramesListBox.Store ); RBreakpoint: TStreamRec = ( ObjType: 1707; VmtLink: Ofs(TypeOf(TBreakpoint)^); Load: @TBreakpoint.Load; Store: @TBreakpoint.Store ); RWatch: TStreamRec = ( ObjType: 1708; VmtLink: Ofs(TypeOf(TWatch)^); Load: @TWatch.Load; Store: @TWatch.Store ); RBreakpointCollection: TStreamRec = ( ObjType: 1709; VmtLink: Ofs(TypeOf(TBreakpointCollection)^); Load: @TBreakpointCollection.Load; Store: @TBreakpointCollection.Store ); RWatchesCollection: TStreamRec = ( ObjType: 1710; VmtLink: Ofs(TypeOf(TWatchesCollection)^); Load: @TWatchesCollection.Load; Store: @TWatchesCollection.Store ); {$ifdef USERESSTRINGS} resourcestring {$else} const {$endif} button_OK = 'O~K~'; button_Cancel = 'Cancel'; button_New = '~N~ew'; button_Edit = '~E~dit'; button_Delete = '~D~elete'; button_Close = '~C~lose'; button_ToggleButton = '~T~oggle'; { Watches local menu items } menu_watchlocal_edit = '~E~dit watch'; menu_watchlocal_new = '~N~ew watch'; menu_watchlocal_delete = '~D~elete watch'; { Breakpoints window local menu items } menu_bplocal_gotosource = '~G~oto source'; menu_bplocal_editbreakpoint = '~E~dit breakpoint'; menu_bplocal_newbreakpoint = '~N~ew breakpoint'; menu_bplocal_deletebreakpoint = '~D~elete breakpoint'; menu_bplocal_togglestate = '~T~oggle state'; { Debugger messages and status hints } msg_programexitedwithcodeandsteps = #3'Program exited with '#13+ #3'exitcode = %d'#13+ #3'hidden steps = %d'; msg_programexitedwithexitcode = #3'Program exited with '#13+ #3'exitcode = %d'; msg_programsignal = #3'Program received signal %s'#13+ #3'%s'; msg_runningprogram = 'Running...'; msg_runningremotely = 'Executable running remotely on '; msg_connectingto = 'Connecting to '; msg_getting_info_on = 'Getting info from '; msg_runninginanotherwindow = 'Executable running in another window..'; msg_couldnotsetbreakpointat = #3'Could not set Breakpoint'#13+ #3+'%s:%d'; msg_couldnotsetbreakpointtype = #3'Could not set Breakpoint'#13+ #3+'%s %s'; button_DisableAllBreakpoints = 'Dis. ~a~ll invalid'; { Breakpoints window } dialog_breakpointlist = 'Breakpoint list'; label_breakpointpropheader = ' Type | State | Position | Path | Ignore | Conditions '; dialog_modifynewbreakpoint = 'Modify/New Breakpoint'; label_breakpoint_name = '~N~ame'; label_breakpoint_line = '~L~ine'; label_breakpoint_conditions = '~C~onditions'; label_breakpoint_ignorecount = '~I~gnore count'; label_breakpoint_type = '~T~ype'; { Watches window } dialog_watches = 'Watches'; label_watch_expressiontowatch = '~E~xpression to watch'; label_watch_values = 'Watch values'; msg_watch_currentvalue = 'Current value: '+#13+ '%s'; msg_watch_currentandpreviousvalue = 'Current value: '+#13+ '%s'+#13+ 'Previous value: '+#13+ '%s'; dialog_callstack = 'Call Stack'; menu_msglocal_saveas = 'Save ~a~s'; msg_cantdebugchangetargetto = #3'Sorry, can not debug'#13+ #3'programs compiled for %s.'#13+ #3'Change target to %s?'; msg_compiledwithoutdebuginforecompile = #3'Warning, the program'#13+ #3'was compiled without'#13+ #3'debugging info.'#13+ #3'Recompile it?'; msg_nothingtodebug = 'Oooops, nothing to debug.'; msg_startingdebugger = 'Starting debugger'; {$ifdef I386} const FrameName = '$ebp'; {$define FrameNameKnown} {$endif i386} {$ifdef x86_64} const FrameName = '$rbp'; {$define FrameNameKnown} {$endif x86_64} {$ifdef m68k} const FrameName = '$fp'; {$define FrameNameKnown} {$endif m68k} {$ifdef powerpc} { stack and frame registers are the same on powerpc, so I am not sure that this will work PM } const FrameName = '$r1'; {$define FrameNameKnown} {$endif powerpc} function GDBFileName(st : string) : string; {$ifndef Unix} var i : longint; {$endif Unix} begin {$ifdef NODEBUG} GDBFileName:=st; {$else NODEBUG} {$ifdef Unix} GDBFileName:=st; {$else} { should we also use / chars ? } for i:=1 to Length(st) do if st[i]='\' then {$ifdef Windows} { Don't touch at '\ ' used to escapes spaces in windows file names PM } if (i=length(st)) or (st[i+1]<>' ') then {$endif Windows} st[i]:='/'; {$ifdef Windows} {$ifndef USE_MINGW_GDB} // see mantis 11968 because of mingw build. MvdV { for Windows we should convert e:\ into //e/ PM } if {$ifdef GDBMI} using_cygwin_gdb and {$endif} (length(st)>2) and (st[2]=':') and (st[3]='/') then st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st)); {$endif} { support spaces in the name by escaping them but without changing '\ ' into '\\ ' } for i:=Length(st) downto 1 do if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then st:=copy(st,1,i-1)+'\'+copy(st,i,length(st)); {$endif Windows} {$ifdef go32v2} { for go32v2 we should convert //e/ back into e:/ PM } if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then st:=st[3]+':/'+copy(st,5,length(st)); {$endif go32v2} GDBFileName:=LowerCaseStr(st); {$endif} {$endif NODEBUG} end; function OSFileName(st : string) : string; {$ifndef Unix} var i : longint; {$endif Unix} begin {$ifdef Unix} OSFileName:=st; {$else} {$ifdef Windows} {$ifndef NODEBUG} { for Windows we should convert /cygdrive/e/ into e:\ PM } if pos(CygDrivePrefix+'/',st)=1 then st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st)); {$endif NODEBUG} {$endif Windows} { support spaces in the name by escaping them but without changing '\ ' into '\\ ' } for i:=Length(st) downto 2 do if (st[i]=' ') and (st[i-1]='\') then st:=copy(st,1,i-2)+copy(st,i,length(st)); {$ifdef go32v2} { for go32v2 we should convert //e/ back into e:/ PM } if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then st:=st[3]+':\'+copy(st,5,length(st)); {$endif go32v2} { should we also use / chars ? } for i:=1 to Length(st) do if st[i]='/' then st[i]:='\'; OSFileName:=LowerCaseStr(st); {$endif} end; {**************************************************************************** TDebugController ****************************************************************************} procedure UpdateDebugViews; begin {$ifdef SUPPORT_REMOTE} if assigned(Debugger) and Debugger^.isRemoteDebugging then PushStatus(msg_getting_info_on+RemoteMachine); {$endif SUPPORT_REMOTE} DeskTop^.Lock; If assigned(StackWindow) then StackWindow^.Update; If assigned(RegistersWindow) then RegistersWindow^.Update; {$ifndef NODEBUG} If assigned(Debugger) then Debugger^.ReadWatches; {$endif NODEBUG} If assigned(FPUWindow) then FPUWindow^.Update; If assigned(VectorWindow) then VectorWindow^.Update; DeskTop^.UnLock; {$ifdef SUPPORT_REMOTE} if assigned(Debugger) and Debugger^.isRemoteDebugging then PopStatus; {$endif SUPPORT_REMOTE} end; {$ifndef NODEBUG} constructor TDebugController.Init; begin inherited Init; CenterDebuggerRow:=IniCenterDebuggerRow; Disableallinvalidbreakpoints:=false; NoSwitch:=False; HasExe:=false; Debugger:=@self; switch_to_user:=true; GetDir(0,OrigPwd); SetCommand('print object off'); {$ifdef SUPPORT_REMOTE} isFirstRemote:=true; {$ifdef FPC_ARMEL32} { GDB needs advice on exact file type } SetCommand('gnutarget elf32-littlearm'); {$endif FPC_ARMEL32} {$endif SUPPORT_REMOTE} end; procedure TDebugController.SetExe(const exefn:string); var f : string; begin f := GDBFileName(GetShortName(exefn)); if (f<>'') and ExistsFile(exefn) then begin if not LoadFile(f) then begin HasExe:=false; if GetError<>'' then f:=GetError; MessageBox(#3'Failed to load file '#13#3+f,nil,mfOKbutton); exit; end; HasExe:=true; { Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : longint); [public,alias:'FPC_BREAK_ERROR'];} FPCBreakErrorNumber:=BreakpointInsert('FPC_BREAK_ERROR', []); {$ifdef FrameNameKnown} { this fails in GDB 5.1 because GDB replies that there is an attempt to dereference a generic pointer... test delayed in DoSourceLine... PM Command('cond '+IntToStr(FPCBreakErrorNumber)+ ' (('+FrameName+' + 8)^ <> 0) or'+ ' (('+FrameName+' + 12)^ <> 0)'); } {$endif FrameNameKnown} SetArgs(GetRunParameters); SetSourceDirs; InsertBreakpoints; ReadWatches; end else begin HasExe:=false; reset_command:=true; {$ifdef GDBMI} Command('-file-exec-and-symbols'); {$else GDBMI} Command('file'); {$endif GDBMI} reset_command:=false; end; end; procedure TDebugController.SetSourceDirs; const {$ifdef GDBMI} AddSourceDirCommand = '-environment-directory'; {$else GDBMI} AddSourceDirCommand = 'dir'; {$endif GDBMI} var f,s: ansistring; i : longint; Dir : SearchRec; begin f:=GetSourceDirectories+';'+OrigPwd; repeat i:=pos(';',f); if i=0 then s:=f else begin s:=copy(f,1,i-1); system.delete(f,1,i); end; DefaultReplacements(s); if (pos('*',s)=0) and ExistsDir(s) then Command(AddSourceDirCommand+' '+GDBFileName(GetShortName(s))) { we should also handle the /* cases of -Fu option } else if pos('*',s)>0 then begin Dos.FindFirst(s,Directory,Dir); { the '*' can only be in the last dir level } s:=DirOf(s); while Dos.DosError=0 do begin if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then Command(AddSourceDirCommand+' '+GDBFileName(GetShortName(s+Dir.Name))); Dos.FindNext(Dir); end; Dos.FindClose(Dir); end; until i=0; end; procedure TDebugController.InsertBreakpoints; procedure DoInsert(PB : PBreakpoint); begin PB^.Insert; end; begin BreakpointsCollection^.ForEach(TCallbackProcParam(@DoInsert)); Disableallinvalidbreakpoints:=false; end; procedure TDebugController.ReadWatches; procedure DoRead(PB : PWatch); begin PB^.Get_new_value; end; begin WatchesCollection^.ForEach(TCallbackProcParam(@DoRead)); If Assigned(WatchesWindow) then WatchesWindow^.Update; end; procedure TDebugController.RereadWatches; procedure DoRead(PB : PWatch); begin PB^.Force_new_value; end; begin WatchesCollection^.ForEach(TCallbackProcParam(@DoRead)); If Assigned(WatchesWindow) then WatchesWindow^.Update; end; procedure TDebugController.RemoveBreakpoints; procedure DoDelete(PB : PBreakpoint); begin PB^.Remove; end; begin BreakpointsCollection^.ForEach(TCallbackProcParam(@DoDelete)); end; procedure TDebugController.ResetBreakpointsValues; procedure DoResetVal(PB : PBreakpoint); begin PB^.ResetValues; end; begin BreakpointsCollection^.ForEach(TCallbackProcParam(@DoResetVal)); end; destructor TDebugController.Done; begin { kill the program if running } Reset; RemoveBreakpoints; inherited Done; end; procedure TDebugController.Run; const {$ifdef GDBMI} SetTTYCommand = '-inferior-tty-set'; {$else GDBMI} SetTTYCommand = 'tty'; {$endif GDBMI} {$ifdef Unix} var Debuggeefile : text; ResetOK, TTYUsed : boolean; {$endif Unix} {$ifdef PALMOSGDB} const TargetProtocol = 'palmos'; {$else} const TargetProtocol = 'extended-remote'; {$endif PALMOSGDB} {$ifdef SUPPORT_REMOTE} var S,ErrorStr : string; ErrorVal : longint; {$endif SUPPORT_REMOTE} begin ResetBreakpointsValues; {$ifdef SUPPORT_REMOTE} NoSwitch:=true; isRemoteDebugging:=false; if TargetProtocol<>'extended-remote' then isConnectedToRemote:=false; usessh:=true; {$ifndef CROSSGDB} If (RemoteMachine<>'') and (RemotePort<>'') then {$else CROSSGDB} if true then {$endif CROSSGDB} begin isRemoteDebugging:=true; if UseSsh and not isConnectedToRemote then begin s:=TransformRemoteString(RemoteSshExecCommand); PushStatus(S); {$ifdef Unix} ErrorVal:=0; { return without waiting for the function to end } s:= s+' &'; If fpsystem(s)=-1 Then ErrorVal:=fpgeterrno; {$else} IDEApp.DoExecute(GetEnv('COMSPEC'),'/C '+s,'','ssh__.out','ssh___.err',exNormal); ErrorVal:=DosError; {$endif} PopStatus; // if errorval <> 0 then // AdvMessageBoxRect(var R: TRect; const Msg: String; Params: Pointer; AOptions: longint): Word; AddToolMessage('',#3'Start'#13#3+s+#13#3'returned '+ IntToStr(Errorval),0,0); end else if not UseSsh then begin s:=TransformRemoteString(RemoteExecCommand); MessageBox(#3'Start in remote'#13#3+s,nil,mfOKbutton); end; if usessh then { we use ssh port redirection } S:='localhost' //S:=TransformRemoteString('$REMOTEMACHINE') else S:=RemoteMachine; If pos('@',S)>0 then S:=copy(S,pos('@',S)+1,High(S)); If RemotePort<>'' then S:=S+':'+RemotePort; {$ifdef PALMOSGDB} { set the default value for PalmOS } If S='' then S:='localhost:2000'; {$endif PALMOSGDB} PushStatus(msg_connectingto+S); AddToolMessage('',msg_connectingto+S,0,0); UpdateToolMessages; if not isConnectedToRemote then Command('target '+TargetProtocol+' '+S); if Error then begin ErrorStr:=strpas(GetError); ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil); PopStatus; exit; end else isConnectedToRemote:=true; PopStatus; end else begin {$endif SUPPORT_REMOTE} {$ifdef Windows} { Run the debugge in another console } if DebuggeeTTY<>'' then SetCommand('new-console on') else SetCommand('new-console off'); NoSwitch:=DebuggeeTTY<>''; {$endif Windows} {$ifdef Unix} { Run the debuggee in another tty } if DebuggeeTTY <> '' then begin {$I-} Assign(Debuggeefile,DebuggeeTTY); system.Reset(Debuggeefile); ResetOK:=IOResult=0; If ResetOK and (IsATTY(textrec(Debuggeefile).handle)<>-1) then begin Command(SetTTYCommand+' '+DebuggeeTTY); TTYUsed:=true; end else begin Command(SetTTYCommand+' '); TTYUsed:=false; end; if ResetOK then close(Debuggeefile); if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then NoSwitch:= true else NoSwitch:=false; end else begin if TTYName(input)<>'' then Command(SetTTYCommand+' '+TTYName(input)); NoSwitch := false; end; {$endif Unix} {$ifdef SUPPORT_REMOTE} end; {$endif SUPPORT_REMOTE} { Switch to user screen to get correct handles } UserScreen; {$ifdef SUPPORT_REMOTE} if isRemoteDebugging then begin inc(init_count); { pass the stop in start code } if isFirstRemote then Command('continue') else Command ('start'); isFirstRemote:=false; end else {$endif SUPPORT_REMOTE} begin { Set cwd for debuggee } SetDir(GetRunDir); inherited Run; { Restore cwd for IDE } SetDir(StartupDir); end; DebuggerScreen; IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true); IDEApp.UpdateRunMenu(true); UpdateDebugViews; end; function TDebugController.IsRunning : boolean; begin IsRunning:=debuggee_started; end; procedure TDebugController.Continue; begin {$ifdef NODEBUG} NoDebugger; {$else} if not debuggee_started then Run else inherited Continue; UpdateDebugViews; {$endif NODEBUG} end; procedure TDebugController.UntilReturn; begin inherited UntilReturn; UpdateDebugViews; { We could try to get the return value ! Not done yet } end; procedure TDebugController.CommandBegin(const s:string); begin if assigned(GDBWindow) and (in_command>1) then begin { We should do something special for errors !! } If StrLen(GetError)>0 then GDBWindow^.WriteErrorText(GetError); GDBWindow^.WriteOutputText(GetOutput); end; if assigned(GDBWindow) then GDBWindow^.WriteString(S); end; function TDebugController.Query(question : PAnsiChar; args : PAnsiChar) : longint; var c : AnsiChar; WasModal : boolean; ModalView : PView; res : longint; begin if not assigned(Application) then begin system.Write(question); repeat system.write('(y or n)'); system.read(c); system.writeln(c); until (lowercase(c)='y') or (lowercase(c)='n'); if lowercase(c)='y' then query:=1 else query:=0; exit; end; if assigned(Application^.Current) and ((Application^.Current^.State and sfModal)<>0) then begin WasModal:=true; ModalView:=Application^.Current; ModalView^.SetState(sfModal, false); ModalView^.Hide; end else WasModal:=false; PushStatus(Question); res:=MessageBox(Question,nil,mfyesbutton+mfnobutton); PopStatus; if res=cmYes then Query:=1 else Query:=0; if WasModal then begin ModalView^.Show; ModalView^.SetState(sfModal, true); ModalView^.Draw; end; end; procedure TDebugController.FlushAll; begin if assigned(GDBWindow) then begin If StrLen(GetError)>0 then begin GDBWindow^.WriteErrorText(GetError); if in_command=0 then gdberrorbuf.reset; end; {$ifdef GDB_RAW_OUTPUT} If StrLen(GetRaw)>0 then begin GDBWindow^.WriteOutputText(GetRaw); if in_command=0 then gdbrawbuf.reset; end; {$endif GDB_RAW_OUTPUT} If StrLen(GetOutput)>0 then begin GDBWindow^.WriteOutputText(GetOutput); { Keep output for command results } if in_command=0 then gdboutputbuf.reset; end; end else Inherited FlushAll; end; procedure TDebugController.CommandEnd(const s:string); begin if assigned(GDBWindow) and (in_command<=1) then begin { We should do something special for errors !! } If StrLen(GetError)>0 then GDBWindow^.WriteErrorText(GetError); {$ifdef GDB_RAW_OUTPUT} If StrLen(GetRaw)>0 then GDBWindow^.WriteOutputText(GetRaw); {$endif GDB_RAW_OUTPUT} GDBWindow^.WriteOutputText(GetOutput); GDBWindow^.Editor^.TextEnd; end; end; function TDebugController.AllowQuit : boolean; begin if IsRunning then begin if ConfirmBox('Really quit GDB window'#13+ 'and kill running program?',nil,true)=cmYes then begin Reset; DoneGDBWindow; {AllowQuit:=true;} AllowQuit:=false; end else AllowQuit:=false; end else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then begin DoneGDBWindow; {AllowQuit:=true;} AllowQuit:=false; end else AllowQuit:=false; end; procedure TDebugController.ResetDebuggerRows; procedure ResetDebuggerRow(P: PView); begin if assigned(P) and (TypeOf(P^)=TypeOf(TSourceWindow)) then PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1); end; begin Desktop^.ForEach(TCallbackProcParam(@ResetDebuggerRow)); end; procedure TDebugController.Reset; var old_reset : boolean; begin {$ifdef SUPPORT_REMOTE} if isConnectedToRemote then begin Command('monitor exit'); Command('disconnect'); isConnectedToRemote:=false; isFirstRemote:=true; end; {$endif SUPPORT_REMOTE} inherited Reset; { we need to free the executable if we want to recompile it } old_reset:=reset_command; reset_command:=true; SetExe(''); reset_command:=old_reset; NoSwitch:=false; { In case we have something that the compiler touched } If IDEApp.IsRunning then begin IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false); IDEApp.UpdateRunMenu(false); AskToReloadAllModifiedFiles; ResetDebuggerRows; end; end; procedure TDebugController.AnnotateError; var errornb : longint; begin if error then begin errornb:=error_num; UpdateDebugViews; ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb); end; end; function TDebugController.GetValue(Const expr : string) : PAnsiChar; begin GetValue:=StrNew(PAnsiChar(PrintCommand(expr))); end; function TDebugController.GetFramePointer : CORE_ADDR; var st : string; p : longint; begin {$ifdef FrameNameKnown} st:=PrintFormattedCommand(FrameName,pfdecimal); p:=pos('=',st); while (p0 then dec(Line); S:=fn; stop_addr:=current_pc; if (BreakIndex=FPCBreakErrorNumber) then begin if GetFPCBreakErrorParameters(ExitCode, ExitAddr, ExitFrame) then begin Backtrace; for i:=0 to frame_count-1 do begin with frames[i]^ do begin if ExitAddr=address then begin if SelectFrameCommand(i) and assigned(file_name) then begin s:=strpas(file_name); line:=line_number; stop_addr:=address; end; break; end; end; end; end else begin Desktop^.Unlock; DoSelectSourceLine := False; exit; end; end; { Update Disassembly position } if Assigned(DisassemblyWindow) then DisassemblyWindow^.SetCurAddress(stop_addr); if (fn=LastFileName) then begin W:=PSourceWindow(LastSource); if assigned(W) then begin W^.Editor^.SetCurPtr(0,Line); W^.Editor^.TrackCursor(CenterDebuggerRow); W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line); UpdateDebugViews; {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then handled by SelectInDebugSession} W^.SelectInDebugSession; InvalidSourceLine:=false; end else InvalidSourceLine:=true; end else begin if s='' then W:=nil else W:=TryToOpenFile(nil,s,0,Line,false); if assigned(W) then begin W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line); W^.Editor^.TrackCursor(CenterDebuggerRow); UpdateDebugViews; {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then handled by SelectInDebugSession} W^.SelectInDebugSession; LastSource:=W; InvalidSourceLine:=false; end { only search a file once } else begin Desktop^.UnLock; if s='' then Found:=false else { it is easier to handle with a * at the end } Found:=IDEApp.OpenSearch(s+'*'); Desktop^.Lock; if not Found then begin InvalidSourceLine:=true; LastSource:=Nil; { Show the stack in that case } InitStackWindow; UpdateDebugViews; StackWindow^.MakeFirst; end else begin { should now be open } W:=TryToOpenFile(nil,s,0,Line,true); W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line); W^.Editor^.TrackCursor(CenterDebuggerRow); UpdateDebugViews; {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then handled by SelectInDebugSession} W^.SelectInDebugSession; LastSource:=W; InvalidSourceLine:=false; end; end; end; LastFileName:=s; Desktop^.UnLock; if BreakIndex>0 then begin PB:=BreakpointsCollection^.GetGDB(BreakIndex); if (BreakIndex=FPCBreakErrorNumber) then begin if (ExitCode<>0) or (ExitAddr<>0) then WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+ #3'Error address $'+HexStr(ExitAddr,8),nil) else WarningBox(#3'Run Time Error',nil); end else if not assigned(PB) then begin if (BreakIndex<>start_break_number) and (BreakIndex<>TbreakNumber) then WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil); if BreakIndex=start_break_number then start_break_number:=0; if BreakIndex=TbreakNumber then TbreakNumber:=0; end { For watch we should get old and new value !! } else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and (PB^.typ<>bt_address) then begin S:=PrintCommand(GetStr(PB^.Name)); got_error:=false; if Assigned(PB^.OldValue) then DisposeStr(PB^.OldValue); PB^.OldValue:=PB^.CurrentValue; PB^.CurrentValue:=NewStr(S); If PB^.typ=bt_function then WarningBox(#3'GDB stopped due to'#13+ #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil) else if (GetStr(PB^.OldValue)<>S) then WarningBox(#3'GDB stopped due to'#13+ #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+ #3+'Old value = '+GetStr(PB^.OldValue)+#13+ #3+'New value = '+GetStr(PB^.CurrentValue),nil) else WarningBox(#3'GDB stopped due to'#13+ #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+ #3+' value = '+GetStr(PB^.CurrentValue),nil); end; end; DoSelectSourceLine := True; end; procedure TDebugController.DoUserSignal; var P :Array[1..2] of pstring; S1, S2 : string; begin S1:=strpas(signal_name); S2:=strpas(signal_string); P[1]:=@S1; P[2]:=@S2; WarningBox(msg_programsignal,@P); end; procedure TDebugController.DoEndSession(code:longint); var P :Array[1..2] of longint; begin IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false); IDEApp.UpdateRunMenu(false); ResetDebuggerRows; LastExitCode:=Code; If HiddenStepsCount=0 then InformationBox(msg_programexitedwithexitcode,@code) else begin P[1]:=code; P[2]:=HiddenStepsCount; WarningBox(msg_programexitedwithcodeandsteps,@P); end; { In case we have something that the compiler touched } AskToReloadAllModifiedFiles; {$ifdef Windows} main_pid_valid:=false; {$endif Windows} end; procedure TDebugController.DoDebuggerScreen; {$ifdef Windows} var IdeMode : DWord; {$endif Windows} begin if NoSwitch then begin PopStatus; end else begin IDEApp.ShowIDEScreen; Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount))); PopStatus; end; {$ifdef Windows} if NoSwitch then begin { Ctrl-C as normal AnsiChar } GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode); IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT; SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode); end; ChangeDebuggeeWindowTitleTo(Stopped_State); {$endif Windows} If assigned(GDBWindow) then GDBWindow^.Editor^.UnLock; end; procedure TDebugController.DoUserScreen; {$ifdef Windows} var IdeMode : DWord; {$endif Windows} begin Inc(RunCount); if NoSwitch then begin {$ifdef SUPPORT_REMOTE} if isRemoteDebugging then PushStatus(msg_runningremotely+RemoteMachine) else {$endif SUPPORT_REMOTE} {$ifdef Unix} PushStatus(msg_runninginanotherwindow+DebuggeeTTY); {$else not Unix} PushStatus(msg_runninginanotherwindow); {$endif Unix} end else begin PushStatus(msg_runningprogram); IDEApp.ShowUserScreen; end; {$ifdef Windows} if NoSwitch then begin { Ctrl-C as interrupt } GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode); IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT); SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode); end; ChangeDebuggeeWindowTitleTo(Running_State); {$endif Windows} { Don't try to print GDB messages while in User Screen mode } If assigned(GDBWindow) then GDBWindow^.Editor^.Lock; end; {$endif NODEBUG} {**************************************************************************** TBreakpoint ****************************************************************************} function ActiveBreakpoints : boolean; var IsActive : boolean; procedure TestActive(PB : PBreakpoint); begin If PB^.state=bs_enabled then IsActive:=true; end; begin IsActive:=false; If assigned(BreakpointsCollection) then BreakpointsCollection^.ForEach(TCallbackProcParam(@TestActive)); ActiveBreakpoints:=IsActive; end; constructor TBreakpoint.Init_function(Const AFunc : String); begin typ:=bt_function; state:=bs_enabled; GDBState:=bs_deleted; Name:=NewStr(AFunc); FileName:=nil; Line:=0; IgnoreCount:=0; Commands:=nil; Conditions:=nil; OldValue:=nil; CurrentValue:=nil; end; constructor TBreakpoint.Init_Address(Const AAddress : String); begin typ:=bt_address; state:=bs_enabled; GDBState:=bs_deleted; Name:=NewStr(AAddress); FileName:=nil; Line:=0; IgnoreCount:=0; Commands:=nil; Conditions:=nil; OldValue:=nil; CurrentValue:=nil; end; constructor TBreakpoint.Init_Empty; begin typ:=bt_function; state:=bs_enabled; GDBState:=bs_deleted; Name:=Nil; FileName:=nil; Line:=0; IgnoreCount:=0; Commands:=nil; Conditions:=nil; OldValue:=nil; CurrentValue:=nil; end; constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String); begin typ:=atyp; state:=bs_enabled; GDBState:=bs_deleted; Name:=NewStr(AnExpr); IgnoreCount:=0; Commands:=nil; Conditions:=nil; OldValue:=nil; CurrentValue:=nil; end; constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint); var CurDir : String; begin typ:=bt_file_line; state:=bs_enabled; GDBState:=bs_deleted; AFile:=FEXpand(AFile); (* { d:test.pas:12 does not work !! } { I do not know how to solve this if if (Length(AFile)>1) and (AFile[2]=':') then AFile:=Copy(AFile,3,255); } {$ifdef Unix} CurDir:=GetCurDir; {$else} CurDir:=LowerCaseStr(GetCurDir); {$endif Unix} if Pos(CurDir,OSFileName(AFile))=1 then FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255)) else *) FileName:=NewStr(OSFileName(AFile)); Name:=nil; Line:=ALine; IgnoreCount:=0; Commands:=nil; Conditions:=nil; OldValue:=nil; CurrentValue:=nil; end; constructor TBreakpoint.Load(var S: TStream); var FName : PString; begin S.Read(typ,SizeOf(BreakpointType)); S.Read(state,SizeOf(BreakpointState)); GDBState:=bs_deleted; case typ of bt_file_line : begin { convert to current target } FName:=S.ReadStr; FileName:=NewStr(OSFileName(GetStr(FName))); If Assigned(FName) then DisposeStr(FName); S.Read(Line,SizeOf(Line)); Name:=nil; end; else begin Name:=S.ReadStr; Line:=0; FileName:=nil; end; end; S.Read(IgnoreCount,SizeOf(IgnoreCount)); Commands:=S.StrRead; Conditions:=S.ReadStr; OldValue:=nil; CurrentValue:=nil; end; procedure TBreakpoint.Store(var S: TStream); var St : String; begin S.Write(typ,SizeOf(BreakpointType)); S.Write(state,SizeOf(BreakpointState)); case typ of bt_file_line : begin st:=OSFileName(GetStr(FileName)); S.WriteStr(@St); S.Write(Line,SizeOf(Line)); end; else begin S.WriteStr(Name); end; end; S.Write(IgnoreCount,SizeOf(IgnoreCount)); S.StrWrite(Commands); S.WriteStr(Conditions); end; procedure TBreakpoint.Insert; var p,p2 : PAnsiChar; st : string; bkpt_no: LongInt = 0; begin {$ifndef NODEBUG} If not assigned(Debugger) then Exit; Remove; if (GDBState=bs_deleted) and (state=bs_enabled) then begin if (typ=bt_file_line) and assigned(FileName) then bkpt_no := Debugger^.BreakpointInsert(GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line), []) else if (typ=bt_function) and assigned(name) then bkpt_no := Debugger^.BreakpointInsert(name^, []) else if (typ=bt_address) and assigned(name) then bkpt_no := Debugger^.BreakpointInsert('*0x'+name^, []) else if (typ=bt_watch) and assigned(name) then bkpt_no := Debugger^.WatchpointInsert(name^, wtWrite) else if (typ=bt_awatch) and assigned(name) then bkpt_no := Debugger^.WatchpointInsert(name^, wtReadWrite) else if (typ=bt_rwatch) and assigned(name) then bkpt_no := Debugger^.WatchpointInsert(name^, wtRead); if bkpt_no<>0 then begin GDBIndex:=bkpt_no; GDBState:=bs_enabled; Debugger^.BreakpointCondition(GDBIndex, GetStr(Conditions)); If IgnoreCount>0 then Debugger^.BreakpointSetIgnoreCount(GDBIndex, IgnoreCount); If Assigned(Commands) then begin {Commands are not handled yet } Debugger^.Command('command '+IntToStr(GDBIndex)); p:=commands; while assigned(p) do begin p2:=strscan(p,#10); if assigned(p2) then p2^:=#0; st:=strpas(p); Debugger^.command(st); if assigned(p2) then p2^:=#10; p:=p2; if assigned(p) then inc(p); end; Debugger^.Command('end'); end; end else { Here there was a problem !! } begin GDBIndex:=0; if not Debugger^.Disableallinvalidbreakpoints then begin if (typ=bt_file_line) and assigned(FileName) then begin ClearFormatParams; AddFormatParamStr(NameAndExtOf(FileName^)); AddFormatParamInt(Line); if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then Debugger^.Disableallinvalidbreakpoints:=true; end else begin ClearFormatParams; AddFormatParamStr(BreakpointTypeStr[typ]); AddFormatParamStr(GetStr(Name)); if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then Debugger^.Disableallinvalidbreakpoints:=true; end; end; state:=bs_disabled; UpdateSource; end; end else if (GDBState=bs_disabled) and (state=bs_enabled) then Enable else if (GDBState=bs_enabled) and (state=bs_disabled) then Disable; {$endif NODEBUG} end; procedure TBreakpoint.Remove; begin {$ifndef NODEBUG} If not assigned(Debugger) then Exit; if GDBIndex>0 then Debugger^.BreakpointDelete(GDBIndex); GDBIndex:=0; GDBState:=bs_deleted; {$endif NODEBUG} end; procedure TBreakpoint.Enable; begin {$ifndef NODEBUG} If not assigned(Debugger) then Exit; if GDBIndex>0 then Debugger^.BreakpointEnable(GDBIndex) else Insert; GDBState:=bs_disabled; {$endif NODEBUG} end; procedure TBreakpoint.Disable; begin {$ifndef NODEBUG} If not assigned(Debugger) then Exit; if GDBIndex>0 then Debugger^.BreakpointDisable(GDBIndex); GDBState:=bs_disabled; {$endif NODEBUG} end; procedure TBreakpoint.ResetValues; begin if assigned(OldValue) then DisposeStr(OldValue); OldValue:=nil; if assigned(CurrentValue) then DisposeStr(CurrentValue); CurrentValue:=nil; end; procedure TBreakpoint.UpdateSource; var W: PSourceWindow; b : boolean; begin if typ=bt_file_line then begin W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false); If assigned(W) then begin if state=bs_enabled then b:=true else b:=false; W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b); end; end; end; destructor TBreakpoint.Done; begin Remove; ResetValues; if assigned(Name) then DisposeStr(Name); if assigned(FileName) then DisposeStr(FileName); if assigned(Conditions) then DisposeStr(Conditions); if assigned(Commands) then StrDispose(Commands); inherited Done; end; {**************************************************************************** TBreakpointCollection ****************************************************************************} function TBreakpointCollection.At(Index: Integer): PBreakpoint; begin At:=inherited At(Index); end; procedure TBreakpointCollection.Update; begin {$ifndef NODEBUG} if assigned(Debugger) then begin Debugger^.RemoveBreakpoints; Debugger^.InsertBreakpoints; end; {$endif NODEBUG} if assigned(BreakpointsWindow) then BreakpointsWindow^.Update; end; function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint; function IsNum(P : PBreakpoint) : boolean; begin IsNum:=P^.GDBIndex=index; end; begin if index=0 then GetGDB:=nil else GetGDB:=FirstThat(TCallbackFunBoolParam(@IsNum)); end; procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow); procedure SetInSource(P : PBreakpoint); begin If assigned(P^.FileName) and (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled); end; procedure SetInDisassembly(P : PBreakpoint); var PDL : PDisasLine; S : string; ps,qs,i : longint; HAddr : PtrInt; code : integer; begin for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do begin PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i)); if PDL^.Address=0 then begin if (P^.typ=bt_file_line) then begin S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i); ps:=pos(':',S); qs:=pos(' ',copy(S,ps+1,High(S))); if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and (StrToInt(copy(S,ps+1,qs-1))=P^.line) then PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled); end; end else begin if assigned(P^.Name) then begin Val('$'+P^.Name^,HAddr,code); If (P^.typ=bt_address) and (PDL^.Address=HAddr) then PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled); end; end; end; end; begin if W=PFPWindow(DisassemblyWindow) then ForEach(TCallbackProcParam(@SetInDisassembly)) else ForEach(TCallbackProcParam(@SetInSource)); end; procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint); procedure AdaptInSource(P : PBreakpoint); begin If assigned(P^.FileName) and (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then begin if P^.state=bs_enabled then Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false); if P^.Line-1>=Pos then begin if (Change>0) or (P^.Line-1>=Pos-Change) then P^.line:=P^.Line+Change else begin { removing inside a ForEach call leads to problems } { so we do that after PM } P^.state:=bs_delete_after; end; end; if P^.state=bs_enabled then Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true); end; end; var I : longint; begin ForEach(TCallbackProcParam(@AdaptInSource)); I:=Count-1; While (I>=0) do begin if At(I)^.state=bs_delete_after then AtFree(I); Dec(I); end; end; function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint; function IsAtLine(P : PBreakpoint) : boolean; begin If assigned(P^.FileName) and (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and (Line=P^.Line) then IsAtLine:=true else IsAtLine:=false; end; begin FindBreakpointAt:=FirstThat(TCallbackFunBoolParam(@IsAtLine)); end; procedure TBreakpointCollection.ShowAllBreakpoints; procedure SetInSource(P : PBreakpoint); var W : PSourceWindow; begin If assigned(P^.FileName) then begin W:=SearchOnDesktop(P^.FileName^,false); if assigned(W) then W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled); end; end; begin ForEach(TCallbackProcParam(@SetInSource)); end; function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint; function IsThis(P : PBreakpoint) : boolean; begin IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S); end; begin GetType:=FirstThat(TCallbackFunBoolParam(@IsThis)); end; function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean; function IsThere(P : PBreakpoint) : boolean; begin IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr); end; var PB : PBreakpoint; begin ToggleFileLine:=false; FileName:=OSFileName(FExpand(FileName)); PB:=FirstThat(TCallbackFunBoolParam(@IsThere)); If Assigned(PB) then begin { delete it form source window } PB^.state:=bs_disabled; PB^.UpdateSource; { remove from collection } BreakpointsCollection^.free(PB); end else begin PB:= New(PBreakpoint,Init_file_line(FileName,LineNr)); if assigned(PB) then Begin Insert(PB); PB^.UpdateSource; ToggleFileLine:=true; End; end; Update; end; {**************************************************************************** TBreakpointItem ****************************************************************************} constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint); begin inherited Init; Breakpoint:=ABreakpoint; end; function TBreakpointItem.GetText(MaxLen: Sw_integer): string; var S: string; begin with Breakpoint^ do begin S:=BreakpointTypeStr[typ]; While Length(S)<10 do S:=S+' '; S:=S+'|'; S:=S+BreakpointStateStr[state]+' '; While Length(S)<20 do S:=S+' '; S:=S+'|'; if (typ=bt_file_line) then begin S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line); While Length(S)<40 do S:=S+' '; S:=S+'|'; S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29)); end else S:=S+GetStr(name); While Length(S)<70 do S:=S+' '; S:=S+'|'; if IgnoreCount>0 then S:=S+IntToStr(IgnoreCount); While Length(S)<79 do S:=S+' '; S:=S+'|'; if assigned(Conditions) then S:=S+' '+GetStr(Conditions); if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..'; GetText:=S; end; end; procedure TBreakpointItem.Selected; begin end; function TBreakpointItem.GetModuleName: string; begin if breakpoint^.typ=bt_file_line then GetModuleName:=GetStr(breakpoint^.FileName) else GetModuleName:=''; end; {**************************************************************************** TBreakpointsListBox ****************************************************************************} constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); begin inherited Init(Bounds,1,AHScrollBar, AVScrollBar); GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; NoSelection:=true; end; function TBreakpointsListBox.GetLocalMenu: PMenu; var M: PMenu; begin if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else M:=NewMenu( NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource, NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint, NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint, NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint, NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint, nil)))))); GetLocalMenu:=M; end; procedure TBreakpointsListBox.HandleEvent(var Event: TEvent); var DontClear: boolean; begin case Event.What of evKeyDown : begin DontClear:=false; case Event.KeyCode of kbEnd : FocusItem(List^.Count-1); kbHome : FocusItem(0); kbEnter : Message(@Self,evCommand,cmMsgGotoSource,nil); kbIns : Message(@Self,evCommand,cmNewBreakpoint,nil); kbDel : Message(@Self,evCommand,cmDeleteBreakpoint,nil); else DontClear:=true; end; if not DontClear then ClearEvent(Event); end; evBroadcast : case Event.Command of cmListItemSelected : if Event.InfoPtr=@Self then Message(@Self,evCommand,cmEditBreakpoint,nil); end; evCommand : begin DontClear:=false; case Event.Command of cmMsgTrackSource : if Range>0 then TrackSource; cmEditBreakpoint : EditCurrent; cmToggleBreakpoint : ToggleCurrent; cmDeleteBreakpoint : DeleteCurrent; cmNewBreakpoint : EditNew; cmMsgClear : Clear; else DontClear:=true; end; if not DontClear then ClearEvent(Event); end; end; inherited HandleEvent(Event); end; procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem); var W : integer; begin if List=nil then New(List, Init(20,20)); W:=length(P^.GetText(255)); if W>MaxWidth then begin MaxWidth:=W; if HScrollBar<>nil then HScrollBar^.SetRange(0,MaxWidth); end; List^.Insert(P); SetRange(List^.Count); if Focused=List^.Count-1-1 then FocusItem(List^.Count-1); P^.Breakpoint^.UpdateSource; DrawView; end; function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String; var P: PBreakpointItem; S: string; begin P:=List^.At(Item); S:=P^.GetText(MaxLen); GetText:=copy(S,1,MaxLen); end; procedure TBreakpointsListBox.Clear; begin if assigned(List) then Dispose(List, Done); List:=nil; MaxWidth:=0; SetRange(0); DrawView; Message(Application,evBroadcast,cmClearLineHighlights,@Self); end; procedure TBreakpointsListBox.TrackSource; var W: PSourceWindow; P: PBreakpointItem; R: TRect; begin (*Message(Application,evBroadcast,cmClearLineHighlights,@Self); if Range=0 then Exit;*) P:=List^.At(Focused); if P^.GetModuleName='' then Exit; Desktop^.Lock; GetNextEditorBounds(R); R.B.Y:=Owner^.Origin.Y; W:=EditorWindowFile(P^.GetModuleName); if assigned(W) then begin W^.GetExtent(R); R.B.Y:=Owner^.Origin.Y; W^.ChangeBounds(R); W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line); end else W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true); if W<>nil then begin W^.Select; W^.Editor^.TrackCursor(do_centre); W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line); end; if Assigned(Owner) then Owner^.Select; Desktop^.UnLock; end; procedure TBreakpointsListBox.ToggleCurrent; var P: PBreakpointItem; begin if Range=0 then Exit; P:=List^.At(Focused); if P=nil then Exit; if P^.Breakpoint^.state=bs_enabled then P^.Breakpoint^.state:=bs_disabled else if P^.Breakpoint^.state=bs_disabled then P^.Breakpoint^.state:=bs_enabled; P^.Breakpoint^.UpdateSource; BreakpointsCollection^.Update; end; procedure TBreakpointsListBox.EditCurrent; var P: PBreakpointItem; begin if Range=0 then Exit; P:=List^.At(Focused); if P=nil then Exit; Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil); P^.Breakpoint^.UpdateSource; BreakpointsCollection^.Update; end; procedure TBreakpointsListBox.DeleteCurrent; var P: PBreakpointItem; begin if Range=0 then Exit; P:=List^.At(Focused); if P=nil then Exit; { delete it form source window } P^.Breakpoint^.state:=bs_disabled; P^.Breakpoint^.UpdateSource; BreakpointsCollection^.free(P^.Breakpoint); List^.free(P); BreakpointsCollection^.Update; end; procedure TBreakpointsListBox.EditNew; var P: PBreakpoint; begin P:=New(PBreakpoint,Init_Empty); if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then begin P^.UpdateSource; BreakpointsCollection^.Insert(P); BreakpointsCollection^.Update; end else dispose(P,Done); end; procedure TBreakpointsListBox.Draw; var I, J, Item: Sw_Integer; NormalColor, SelectedColor, FocusedColor, Color: Word; ColWidth, CurCol, Indent: Integer; B: TDrawBuffer; Text: String; SCOff: Byte; TC: byte; procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end; begin if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0; if State and (sfSelected + sfActive) = (sfSelected + sfActive) then begin NormalColor := GetColor(1); FocusedColor := GetColor(3); SelectedColor := GetColor(4); end else begin NormalColor := GetColor(2); SelectedColor := GetColor(4); end; if Transparent then begin MT(NormalColor); MT(SelectedColor); end; if NoSelection then SelectedColor:=NormalColor; if HScrollBar <> nil then Indent := HScrollBar^.Value else Indent := 0; ColWidth := Size.X div NumCols + 1; for I := 0 to Size.Y - 1 do begin for J := 0 to NumCols-1 do begin Item := J*Size.Y + I + TopItem; CurCol := J*ColWidth; if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and (Focused = Item) and (Range > 0) then begin Color := FocusedColor; SetCursor(CurCol+1,I); SCOff := 0; end else if (Item < Range) and IsSelected(Item) then begin Color := SelectedColor; SCOff := 2; end else begin Color := NormalColor; SCOff := 4; end; MoveChar(B[CurCol], ' ', Color, ColWidth); if Item < Range then begin Text := GetText(Item, ColWidth + Indent); Text := Copy(Text,Indent,ColWidth); MoveStr(B[CurCol+1], Text, Color); if ShowMarkers then begin WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]); WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]); end; end; MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1); end; WriteLine(0, I, Size.X, 1, B); end; end; constructor TBreakpointsListBox.Load(var S: TStream); begin inherited Load(S); end; procedure TBreakpointsListBox.Store(var S: TStream); var OL: PCollection; OldR : integer; begin OL:=List; OldR:=Range; Range:=0; New(List, Init(1,1)); inherited Store(S); Dispose(List, Done); Range:=OldR; List:=OL; { ^^^ nasty trick - has anyone a better idea how to avoid storing the collection? Pasting here a modified version of TListBox.Store+ TAdvancedListBox.Store isn't a better solution, since by eventually changing the obj-hierarchy you'll always have to modify this, too - BG } end; destructor TBreakpointsListBox.Done; begin inherited Done; if List<>nil then Dispose(List, Done); end; {**************************************************************************** TBreakpointsWindow ****************************************************************************} constructor TBreakpointsWindow.Init; var R,R2: TRect; HSB,VSB: PScrollBar; ST: PStaticText; S: String; X,X1 : Sw_integer; Btn: PButton; const NumButtons = 5; begin Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18; inherited Init(R, dialog_breakpointlist, wnNoNumber); HelpCtx:=hcBreakpointListWindow; GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1; S:=label_breakpointpropheader; New(ST, Init(R,S)); ST^.GrowMode:=gfGrowHiX; Insert(ST); GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1; New(ST, Init(R, CharStr(''#$C4'', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST); GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5); R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1; New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB); HSB^.SetStep(R.B.X-R.A.X-2,1); R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1; New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB); VSB^.SetStep(R.B.Y-R.A.Y-2,1); New(BreakLB, Init(R,HSB,VSB)); BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY; BreakLB^.Transparent:=true; Insert(BreakLB); GetExtent(R);R.Grow(-1,-1); Dec(R.B.Y); R.A.Y:=R.B.Y-2; X:=(R.B.X-R.A.X) div NumButtons; X1:=R.A.X+(X div 2); R.A.X:=X1-3;R.B.X:=X1+7; New(Btn, Init(R, button_Close, cmClose, bfDefault)); Btn^.GrowMode:=gfGrowLoY+gfGrowHiY; Insert(Btn); X1:=X1+X; R.A.X:=X1-3;R.B.X:=X1+7; New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal)); Btn^.GrowMode:=gfGrowLoY+gfGrowHiY; Insert(Btn); X1:=X1+X; R.A.X:=X1-3;R.B.X:=X1+7; New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal)); Btn^.GrowMode:=gfGrowLoY+gfGrowHiY; Insert(Btn); X1:=X1+X; R.A.X:=X1-3;R.B.X:=X1+7; New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal)); Btn^.GrowMode:=gfGrowLoY+gfGrowHiY; Insert(Btn); X1:=X1+X; R.A.X:=X1-3;R.B.X:=X1+7; New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal)); Btn^.GrowMode:=gfGrowLoY+gfGrowHiY; Insert(Btn); BreakLB^.Select; Update; BreakpointsWindow:=@self; end; constructor TBreakpointsWindow.Load(var S: TStream); begin inherited Load(S); GetSubViewPtr(S,BreakLB); end; procedure TBreakpointsWindow.Store(var S: TStream); begin inherited Store(S); PutSubViewPtr(S,BreakLB); end; procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint); begin BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint))); end; procedure TBreakpointsWindow.ClearBreakpoints; begin BreakLB^.Clear; ReDraw; end; procedure TBreakpointsWindow.ReloadBreakpoints; procedure InsertInBreakLB(P : PBreakpoint); begin BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P))); end; begin If not assigned(BreakpointsCollection) then exit; BreakpointsCollection^.ForEach(TCallbackProcParam(@InsertInBreakLB)); ReDraw; end; procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint); begin inherited SizeLimits(Min,Max); Min.X:=40; Min.Y:=18; end; procedure TBreakpointsWindow.Close; begin Hide; end; procedure TBreakpointsWindow.HandleEvent(var Event: TEvent); var DontClear : boolean; begin case Event.What of evKeyDown : begin if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then begin ClearEvent(Event); Hide; end; end; evCommand : begin DontClear:=False; case Event.Command of cmNewBreakpoint : BreakLB^.EditNew; cmEditBreakpoint : BreakLB^.EditCurrent; cmDeleteBreakpoint : BreakLB^.DeleteCurrent; cmToggleBreakInList : BreakLB^.ToggleCurrent; cmClose : Hide; else DontClear:=true; end; if not DontClear then ClearEvent(Event); end; evBroadcast : case Event.Command of cmUpdate : Update; end; end; inherited HandleEvent(Event); end; procedure TBreakpointsWindow.Update; var StoreFocus : longint; begin StoreFocus:=BreakLB^.Focused; ClearBreakpoints; ReloadBreakpoints; If StoreFocus0 then begin while i0 then loop_higher :=false; until not loop_higher; { try again at that level } s:=GetStr(expr); found:=GetValue(s); loop_higher:=not found; end else loop_higher:=false; end; if found then current_value:=StrNew(PAnsiChar('= ' + s)) else current_value:=StrNew(PAnsiChar(orig_s_result)); Debugger^.got_error:=false; { We should try here to find the expr in parent procedure if there are I will implement this as I added a parent_ebp pseudo local var to local procedure in stabs debug info PM } { But there are some pitfalls like locals redefined in other sublocals that call the function } if curframe<>startframe then Debugger^.set_current_frame(startframe); GDBRunCount:=Debugger^.RunCount; end; {$else NODEBUG} begin end; {$endif NODEBUG} procedure TWatch.Force_new_value; begin GDBRunCount:=-1; Get_new_value; end; destructor TWatch.Done; begin if assigned(expr) then disposestr(expr); if assigned(last_value) then strdispose(last_value); if assigned(current_value) then strdispose(current_value); inherited done; end; {**************************************************************************** TWatchesCollection ****************************************************************************} constructor TWatchesCollection.Init; begin inherited Init(10,10); end; procedure TWatchesCollection.Insert(Item: Pointer); begin PWatch(Item)^.Get_new_value; Inherited Insert(Item); Update; end; procedure TWatchesCollection.Update; var W,W1 : integer; procedure GetMax(P : PWatch); begin if assigned(P^.Current_value) then W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr)) else W1:=2+Length(GetStr(P^.expr)); if W1>W then W:=W1; end; begin W:=0; ForEach(TCallbackProcParam(@GetMax)); MaxW:=W; If assigned(WatchesWindow) then WatchesWindow^.WLB^.Update(MaxW); end; function TWatchesCollection.At(Index: Integer): PWatch; begin At:=Inherited At(Index); end; {**************************************************************************** TWatchesListBox ****************************************************************************} constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); begin inherited Init(Bounds,1,AHScrollBar,AVScrollBar); If assigned(List) then dispose(list,done); List:=WatchesCollection; end; procedure TWatchesListBox.Update(AMaxWidth : integer); var R : TRect; begin GetExtent(R); MaxWidth:=AMaxWidth; if (HScrollBar<>nil) and (R.B.X-R.A.XMaxWidth then HScrollBar^.Hide else HScrollBar^.Show; SetRange(List^.Count+1); if R.B.Y-R.A.Y>Range then VScrollBar^.Hide else VScrollBar^.Show; {if Focused=List^.Count-1-1 then FocusItem(List^.Count-1); What was that for ?? PM } DrawView; end; function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; var PW : PWatch; ValOffset : Sw_integer; S : String; begin Modified:=false; if Item>=WatchesCollection^.Count then begin GetIndentedText:=''; exit; end; PW:=WatchesCollection^.At(Item); ValOffset:=Length(GetStr(PW^.Expr))+2; if not assigned(PW^.expr) then GetIndentedText:='' else if Indent' else S:=S+' '+GetPChar(PW^.Current_value); GetIndentedText:=Copy(S,1,MaxLen); end else begin if not assigned(PW^.Current_value) or (StrLen(PW^.Current_value)0) then Modified:=true; end; procedure TWatchesListBox.EditCurrent; var P: PWatch; D: PWatchItemDialog; begin if Range=0 then Exit; if Focused=WatchesCollection^.Count) then exit; P:=WatchesCollection^.At(Focused); WatchesCollection^.free(P); WatchesCollection^.Update; end; procedure TWatchesListBox.EditNew; var P: PWatch; S : string; begin if FocusedcmCancel then begin WatchesCollection^.AtInsert(Focused,P); WatchesCollection^.Update; end else dispose(P,Done); end; procedure TWatchesListBox.Draw; var I, J, Item: Sw_Integer; NormalColor, SelectedColor, FocusedColor, Color: Word; ColWidth, CurCol, Indent: Integer; B: TDrawBuffer; Modified : boolean; Text: String; SCOff: Byte; TC: byte; procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end; begin if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0; if State and (sfSelected + sfActive) = (sfSelected + sfActive) then begin NormalColor := GetColor(1); FocusedColor := GetColor(3); SelectedColor := GetColor(4); end else begin NormalColor := GetColor(2); SelectedColor := GetColor(4); end; if Transparent then begin MT(NormalColor); MT(SelectedColor); end; (* if NoSelection then SelectedColor:=NormalColor;*) if HScrollBar <> nil then Indent := HScrollBar^.Value else Indent := 0; ColWidth := Size.X div NumCols + 1; for I := 0 to Size.Y - 1 do begin for J := 0 to NumCols-1 do begin Item := J*Size.Y + I + TopItem; CurCol := J*ColWidth; if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and (Focused = Item) and (Range > 0) then begin Color := FocusedColor; SetCursor(CurCol+1,I); SCOff := 0; end else if (Item < Range) and IsSelected(Item) then begin Color := SelectedColor; SCOff := 2; end else begin Color := NormalColor; SCOff := 4; end; MoveChar(B[CurCol], ' ', Color, ColWidth); if Item < Range then begin (* Text := GetText(Item, ColWidth + Indent); Text := Copy(Text,Indent,ColWidth); *) Text:=GetIndentedText(Item,Indent,ColWidth,Modified); if modified then begin SCOff:=0; Color:=(Color and $fff0) or Red; end; MoveStr(B[CurCol], Text, Color); if {ShowMarkers or } Modified then begin WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]); WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]); WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff; end; end; MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1); end; WriteLine(0, I, Size.X, 1, B); end; end; function TWatchesListBox.GetLocalMenu: PMenu; var M: PMenu; begin if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else M:=NewMenu( NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext, NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext, NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext, NewLine( NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs, nil)))))); GetLocalMenu:=M; end; procedure TWatchesListBox.HandleEvent(var Event: TEvent); var DontClear: boolean; begin case Event.What of evMouseDown : if Event.Double then begin Message(@Self,evCommand,cmEdit,nil); ClearEvent(Event); end; evKeyDown : begin DontClear:=false; case Event.KeyCode of kbEnter : Message(@Self,evCommand,cmEdit,nil); kbIns : Message(@Self,evCommand,cmNew,nil); kbDel : Message(@Self,evCommand,cmDelete,nil); else DontClear:=true; end; if not DontClear then ClearEvent(Event); end; evBroadcast : case Event.Command of cmListItemSelected : if Event.InfoPtr=@Self then Message(@Self,evCommand,cmEdit,nil); end; evCommand : begin DontClear:=false; case Event.Command of cmEdit : EditCurrent; cmDelete : DeleteCurrent; cmNew : EditNew; else DontClear:=true; end; if not DontClear then ClearEvent(Event); end; end; inherited HandleEvent(Event); end; constructor TWatchesListBox.Load(var S: TStream); begin inherited Load(S); If assigned(List) then dispose(list,done); List:=WatchesCollection; { we must set Range PM } SetRange(List^.count+1); end; procedure TWatchesListBox.Store(var S: TStream); var OL: PCollection; OldRange : Sw_integer; begin OL:=List; OldRange:=Range; Range:=0; New(List, Init(1,1)); inherited Store(S); Dispose(List, Done); List:=OL; { ^^^ nasty trick - has anyone a better idea how to avoid storing the collection? Pasting here a modified version of TListBox.Store+ TAdvancedListBox.Store isn't a better solution, since by eventually changing the obj-hierarchy you'll always have to modify this, too - BG } SetRange(OldRange); end; destructor TWatchesListBox.Done; begin List:=nil; inherited Done; end; {**************************************************************************** TWatchesWindow ****************************************************************************} Constructor TWatchesWindow.Init; var HSB,VSB: PScrollBar; R,R2 : trect; begin Desktop^.GetExtent(R); R.A.Y:=R.B.Y-7; inherited Init(R, dialog_watches,SearchFreeWindowNo); Palette:=wpCyanWindow; GetExtent(R); HelpCtx:=hcWatchesWindow; R.Grow(-1,-1); R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1; New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; HSB^.SetStep(R.B.X-R.A.X,1); Insert(HSB); R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1; New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB); New(WLB,Init(R,HSB,VSB)); WLB^.GrowMode:=gfGrowHiX+gfGrowHiY; WLB^.Transparent:=true; Insert(WLB); If assigned(WatchesWindow) then dispose(WatchesWindow,done); WatchesWindow:=@Self; Update; end; procedure TWatchesWindow.Update; begin WatchesCollection^.Update; Draw; end; constructor TWatchesWindow.Load(var S: TStream); begin inherited Load(S); GetSubViewPtr(S,WLB); If assigned(WatchesWindow) then dispose(WatchesWindow,done); WatchesWindow:=@Self; end; procedure TWatchesWindow.Store(var S: TStream); begin inherited Store(S); PutSubViewPtr(S,WLB); end; Destructor TWatchesWindow.Done; begin WatchesWindow:=nil; Dispose(WLB,done); inherited done; end; {**************************************************************************** TWatchItemDialog ****************************************************************************} constructor TWatchItemDialog.Init(AWatch: PWatch); var R,R2: TRect; begin R.Assign(0,0,50,10); inherited Init(R,'Add Watch'); Watch:=AWatch; GetExtent(R); R.Grow(-3,-2); Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36; New(NameIL, Init(R, 255)); Insert(NameIL); R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3; Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog))); R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL))); GetExtent(R); R.Grow(-3,-1); R.A.Y:=R.A.Y+3; TextST:=New(PAdvancedStaticText, Init(R, label_watch_values)); Insert(TextST); InsertButtons(@Self); NameIL^.Select; end; function TWatchItemDialog.Execute: Word; var R: word; S1,S2: string; begin S1:=GetStr(Watch^.expr); NameIL^.SetData(S1); S1:=GetPChar(Watch^.Current_value); S2:=GetPChar(Watch^.Last_value); ClearFormatParams; AddFormatParamStr(S1); AddFormatParamStr(S2); if assigned(Watch^.Last_value) and assigned(Watch^.Current_value) and (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then S1:=FormatStrF(msg_watch_currentvalue,FormatParams) else S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams); TextST^.SetText(S1); if assigned(FirstEditorWindow) then FindReplaceEditor:=FirstEditorWindow^.Editor; R:=inherited Execute; FindReplaceEditor:=nil; if R=cmOK then begin NameIL^.GetData(S1); Watch^.Rename(S1); {$ifndef NODEBUG} If assigned(Debugger) then Debugger^.ReadWatches; {$endif NODEBUG} end; Execute:=R; end; {**************************************************************************** TStackWindow ****************************************************************************} constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); begin Inherited Init(Bounds,AHScrollBar,AVScrollBar); end; procedure TFramesListBox.Update; var i : longint; W : PSourceWindow; begin {$ifndef NODEBUG} { call backtrace command } If not assigned(Debugger) then exit; DeskTop^.Lock; Clear; Debugger^.Backtrace; { generate list } { all is in tframeentry } for i:=0 to Debugger^.frame_count-1 do begin with Debugger^.frames[i]^ do begin if assigned(file_name) then AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args), AddModuleName(GetPChar(file_name)),line_number,1))) else AddItem(new(PMessageItem,init(0,HexStr(address,SizeOf(address)*2)+' '+GetPChar(function_name)+GetPChar(args), AddModuleName(''),line_number,1))); W:=SearchOnDesktop(GetPChar(file_name),false); { First reset all Debugger rows } If assigned(W) then begin W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1); W^.Editor^.DebuggerRow:=-1; end; end; end; { Now set all Debugger rows } for i:=0 to Debugger^.frame_count-1 do begin with Debugger^.frames[i]^ do begin W:=SearchOnDesktop(GetPChar(file_name),false); If assigned(W) then begin If W^.Editor^.DebuggerRow=-1 then begin W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true); W^.Editor^.DebuggerRow:=line_number-1; end; end; end; end; if Assigned(list) and (List^.Count > 0) then FocusItem(0); DeskTop^.Unlock; {$endif NODEBUG} end; function TFramesListBox.GetLocalMenu: PMenu; begin GetLocalMenu:=Inherited GetLocalMenu; end; procedure TFramesListBox.GotoSource; begin {$ifndef NODEBUG} { select frame for watches } If not assigned(Debugger) then exit; Debugger^.SelectFrameCommand(Focused); { for local vars } Debugger^.RereadWatches; {$endif NODEBUG} { goto source } inherited GotoSource; end; procedure TFramesListBox.GotoAssembly; begin {$ifndef NODEBUG} { select frame for watches } If not assigned(Debugger) then exit; Debugger^.SelectFrameCommand(Focused); { for local vars } Debugger^.RereadWatches; {$endif} { goto source/assembly mixture } InitDisassemblyWindow; DisassemblyWindow^.LoadFunction(''); {$ifndef NODEBUG} DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address); DisassemblyWindow^.SelectInDebugSession; {$endif NODEBUG} end; procedure TFramesListBox.HandleEvent(var Event: TEvent); begin if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then GotoAssembly; inherited HandleEvent(Event); end; destructor TFramesListBox.Done; begin Inherited Done; end; Constructor TStackWindow.Init; var HSB,VSB: PScrollBar; R,R2 : trect; begin Desktop^.GetExtent(R); R.A.Y:=R.B.Y-5; inherited Init(R, dialog_callstack, wnNoNumber); Palette:=wpCyanWindow; GetExtent(R); HelpCtx:=hcStackWindow; R.Grow(-1,-1); R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1; New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB); R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1; New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB); New(FLB,Init(R,HSB,VSB)); FLB^.GrowMode:=gfGrowHiX+gfGrowHiY; Insert(FLB); If assigned(StackWindow) then dispose(StackWindow,done); StackWindow:=@Self; Update; end; procedure TStackWindow.Update; begin FLB^.Update; DrawView; end; constructor TStackWindow.Load(var S: TStream); begin inherited Load(S); GetSubViewPtr(S,FLB); If assigned(StackWindow) then dispose(StackWindow,done); StackWindow:=@Self; end; procedure TStackWindow.Store(var S: TStream); begin inherited Store(S); PutSubViewPtr(S,FLB); end; Destructor TStackWindow.Done; begin StackWindow:=nil; Dispose(FLB,done); inherited done; end; {$ifdef SUPPORT_REMOTE} {**************************************************************************** TransformRemoteString ****************************************************************************} function TransformRemoteString(st : string) : string; begin If RemoteConfig<>'' then ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig) else ReplaceStrI(St,'$CONFIG',''); If RemoteIdent<>'' then ReplaceStrI(St,'$IDENT','-i '+RemoteIdent) else ReplaceStrI(St,'$IDENT',''); If RemotePuttySession<>'' then ReplaceStrI(St,'$PUTTYSESSION','-load '+RemotePuttySession) else ReplaceStrI(St,'$PUTTYSESSION',''); ReplaceStrI(St,'$LOCALFILENAME',NameAndExtOf(ExeFile)); ReplaceStrI(St,'$LOCALFILE',ExeFile); ReplaceStrI(St,'$REMOTEDIR',RemoteDir); ReplaceStrI(St,'$REMOTEPORT',RemotePort); ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine); ReplaceStrI(St,'$REMOTEGDBSERVER',maybequoted(remotegdbserver)); ReplaceStrI(St,'$REMOTECOPY',maybequoted(RemoteCopy)); ReplaceStrI(St,'$REMOTESHELL',maybequoted(RemoteShell)); { avoid infinite recursion here !!! } if Pos('$REMOTEEXECCOMMAND',UpcaseSTr(St))>0 then ReplaceStrI(St,'$REMOTEEXECCOMMAND',TransformRemoteString(RemoteExecCommand)); {$ifdef WINDOWS} ReplaceStrI(St,'$START','start "Shell to remote"'); ReplaceStrI(St,'$DOITINBACKGROUND',''); {$else} ReplaceStrI(St,'$START',''); ReplaceStrI(St,'$DOITINBACKGROUND',' &'); {$endif} TransformRemoteString:=st; end; {$endif SUPPORT_REMOTE} {**************************************************************************** Init/Final ****************************************************************************} function GetGDBTargetShortName : string; begin {$ifndef CROSSGDB} GetGDBTargetShortName:=source_info.shortname; {$else CROSSGDB} {$ifdef SUPPORT_REMOTE} {$ifdef PALMOSGDB} GetGDBTargetShortName:='palmos'; {$else} GetGDBTargetShortName:='linux'; {$endif PALMOSGDB} {$endif not SUPPORT_REMOTE} {$endif CROSSGDB} end; procedure InitDebugger; {$ifdef DEBUG} var s : string; i,p : longint; {$endif DEBUG} var NeedRecompileExe : boolean; cm : longint; begin {$ifdef DEBUG} if not use_gdb_file then begin Assign(gdb_file,GDBOutFileName); {$I-} Rewrite(gdb_file); if InOutRes<>0 then begin s:=GDBOutFileName; p:=pos('.',s); if p>1 then for i:=0 to 9 do begin s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s)); InOutRes:=0; Assign(gdb_file,s); rewrite(gdb_file); if InOutRes=0 then break; end; end; if IOResult=0 then Use_gdb_file:=true; end; {$I+} {$endif} NeedRecompileExe:=false; {$ifndef SUPPORT_REMOTE} if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then begin ClearFormatParams; AddFormatParamStr(TargetSwitches^.GetCurrSelParam); AddFormatParamStr(GetGDBTargetShortName); cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true); if cm=cmCancel then Exit; if cm=cmYes then begin { force recompilation } PrevMainFile:=''; NeedRecompileExe:=true; TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName); If DebugInfoSwitches^.GetCurrSelParam='-' then DebugInfoSwitches^.SetCurrSelParam('l'); IDEApp.UpdateTarget; end; end; {$endif ndef SUPPORT_REMOTE} if not NeedRecompileExe then NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or (PrevMainFile<>MainFile) or NeedRecompile(cRun,false); if Not NeedRecompileExe and Not MainHasDebugInfo then begin ClearFormatParams; cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true); if cm=cmCancel then Exit; if cm=cmYes then begin { force recompilation } PrevMainFile:=''; NeedRecompileExe:=true; DebugInfoSwitches^.SetCurrSelParam('l'); end; end; if NeedRecompileExe then DoCompile(cRun); if CompilationPhase<>cpDone then Exit; if (EXEFile='') then begin ErrorBox(msg_nothingtodebug,nil); Exit; end; { init debugcontroller } {$ifndef NODEBUG} if not assigned(Debugger) then begin PushStatus(msg_startingdebugger); new(Debugger,Init); PopStatus; end; Debugger^.SetExe(ExeFile); {$endif NODEBUG} {$ifdef GDBWINDOW} InitGDBWindow; {$endif def GDBWINDOW} end; const Invalid_gdb_file_handle: boolean = false; procedure DoneDebugger; begin {$ifdef DEBUG} If IDEApp.IsRunning then PushStatus('Closing debugger'); {$endif} {$ifndef NODEBUG} if assigned(Debugger) then dispose(Debugger,Done); Debugger:=nil; {$endif NODEBUG} {$ifdef DOS} If assigned(UserScreen) then PDosScreen(UserScreen)^.FreeGraphBuffer; {$endif DOS} {$ifdef DEBUG} If Use_gdb_file then begin Use_gdb_file:=false; {$IFOPT I+} {$I-} {$DEFINE REENABLE_I} {$ENDIF} Close(GDB_file); if ioresult<>0 then begin { This handle seems to get lost for DJGPP don't bother too much about this. } Invalid_gdb_file_handle:=true; end; {$IFDEF REENABLE_I} {$I+} {$ENDIF} end; If IDEApp.IsRunning then PopStatus; {$endif DEBUG} end; procedure InitGDBWindow; var R : TRect; begin if GDBWindow=nil then begin DeskTop^.GetExtent(R); new(GDBWindow,init(R)); DeskTop^.Insert(GDBWindow); end; end; procedure DoneGDBWindow; begin If IDEApp.IsRunning and assigned(GDBWindow) then begin DeskTop^.Delete(GDBWindow); end; GDBWindow:=nil; end; procedure InitDisassemblyWindow; var R : TRect; begin if DisassemblyWindow=nil then begin DeskTop^.GetExtent(R); new(DisassemblyWindow,init(R)); DeskTop^.Insert(DisassemblyWindow); end; end; procedure DoneDisassemblyWindow; begin if assigned(DisassemblyWindow) then begin DeskTop^.Delete(DisassemblyWindow); Dispose(DisassemblyWindow,Done); DisassemblyWindow:=nil; end; end; procedure InitStackWindow; begin if StackWindow=nil then begin new(StackWindow,init); DeskTop^.Insert(StackWindow); end; end; procedure DoneStackWindow; begin if assigned(StackWindow) then begin DeskTop^.Delete(StackWindow); StackWindow:=nil; end; end; procedure InitBreakpoints; begin New(BreakpointsCollection,init(10,10)); end; procedure DoneBreakpoints; begin Dispose(BreakpointsCollection,Done); BreakpointsCollection:=nil; end; procedure InitWatches; begin New(WatchesCollection,init); end; procedure DoneWatches; begin Dispose(WatchesCollection,Done); WatchesCollection:=nil; end; procedure RegisterFPDebugViews; begin RegisterType(RWatchesWindow); RegisterType(RBreakpointsWindow); RegisterType(RWatchesListBox); RegisterType(RBreakpointsListBox); RegisterType(RStackWindow); RegisterType(RFramesListBox); RegisterType(RBreakpoint); RegisterType(RWatch); RegisterType(RBreakpointCollection); RegisterType(RWatchesCollection); end; end. {$endif NODEBUG}