{ 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} interface implementation end. {$else} interface {$i globdir.inc} uses {$ifdef win32} Windows, {$endif win32} Objects,Dialogs,Drivers,Views, {$ifndef NODEBUG} GDBCon,GDBInt, {$endif NODEBUG} Menus, WViews,WEditor, FPViews; type {$ifndef NODEBUG} PDebugController=^TDebugController; TDebugController=object(TGDBController) InvalidSourceLine : boolean; { if true the current debugger raw will stay in middle of editor window when debugging PM } CenterDebuggerRow : boolean; 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; WindowWidth : longint; FPCBreakErrorNumber : longint; {$ifdef SUPPORT_REMOTE} isRemoteDebugging:boolean; {$endif SUPPORT_REMOTE} constructor Init; procedure SetExe(const exefn:string); procedure SetWidth(AWidth : longint); procedure SetSourceDirs; destructor Done; procedure DoSelectSourceline(const fn:string;line:longint);virtual; { procedure DoStartSession;virtual; procedure DoBreakSession;virtual;} procedure DoEndSession(code:longint);virtual; procedure DoUserSignal;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) : pchar; 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 : pchar; { 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) 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; expr : pstring; private GDBRunCount : longint; last_value,current_value : pchar; 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; implementation uses Dos, {$ifdef fpc} Video, {$endif fpc} {$ifdef DOS} fpusrscr, {$endif DOS} App,Strings, FVConsts, {$ifdef win32} Windebug, {$endif win32} {$ifdef Unix} {$ifdef VER1_0} Linux, {$else} termio, {$endif} {$endif Unix} Systems,Globals, FPRegs, FPString,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 I386} const FrameName = '$ebp'; {$define FrameNameKnown} {$endif i386} {$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} {$ifdef TP} function HexStr(Value: longint; Len: byte): string; begin HexStr:=IntToHex(Value,Len); end; {$endif} 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 win32} { Don't touch at '\ ' used to escapes spaces in windows file names PM } if (i=length(st)) or (st[i+1]<>' ') then {$endif win32} st[i]:='/'; {$ifdef win32} { for win32 we should convert e:\ into //e/ PM } if (length(st)>2) and (st[2]=':') and (st[3]='/') then st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st)); { 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 win32} {$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 win32} {$ifndef NODEBUG} { for win32 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 win32} { 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} 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} PopStatus; {$endif SUPPORT_REMOTE} end; {$ifndef NODEBUG} constructor TDebugController.Init; begin inherited Init; CenterDebuggerRow:=IniCenterDebuggerRow; Disableallinvalidbreakpoints:=false; NoSwitch:=False; HasExe:=false; Debugger:=@self; WindowWidth:=-1; switch_to_user:=true; GetDir(0,OrigPwd); Command('set print object off'); end; procedure TDebugController.SetExe(const exefn:string); var f : string; begin f := GDBFileName(GetShortName(exefn)); if (f<>'') and ExistsFile(exefn) then begin LoadFile(f); HasExe:=true; Command('b FPC_BREAK_ERROR'); FPCBreakErrorNumber:=last_breakpoint_number; {$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; Command('file'); end; end; procedure TDebugController.SetWidth(AWidth : longint); begin WindowWidth:=AWidth; Command('set width '+inttostr(WindowWidth)); end; procedure TDebugController.SetSourceDirs; var f,s: string; 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('dir '+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('dir '+GDBFileName(GetShortName(s+Dir.Name))); Dos.FindNext(Dir); end; {$ifdef FPC} Dos.FindClose(Dir); {$endif def FPC} end; until i=0; end; procedure TDebugController.InsertBreakpoints; procedure DoInsert(PB : PBreakpoint); begin PB^.Insert; end; begin BreakpointsCollection^.ForEach(@DoInsert); Disableallinvalidbreakpoints:=false; end; procedure TDebugController.ReadWatches; procedure DoRead(PB : PWatch); begin PB^.Get_new_value; end; begin WatchesCollection^.ForEach(@DoRead); If Assigned(WatchesWindow) then WatchesWindow^.Update; end; procedure TDebugController.RereadWatches; procedure DoRead(PB : PWatch); begin PB^.Force_new_value; end; begin WatchesCollection^.ForEach(@DoRead); If Assigned(WatchesWindow) then WatchesWindow^.Update; end; procedure TDebugController.RemoveBreakpoints; procedure DoDelete(PB : PBreakpoint); begin PB^.Remove; end; begin BreakpointsCollection^.ForEach(@DoDelete); end; procedure TDebugController.ResetBreakpointsValues; procedure DoResetVal(PB : PBreakpoint); begin PB^.ResetValues; end; begin BreakpointsCollection^.ForEach(@DoResetVal); end; destructor TDebugController.Done; begin { kill the program if running } Reset; RemoveBreakpoints; inherited Done; end; procedure TDebugController.Run; {$ifdef Unix} var Debuggeefile : text; ResetOK, TTYUsed : boolean; {$endif Unix} {$ifdef PALMOSGDB} const TargetProtocol = 'palmos'; {$else} const TargetProtocol = 'remote'; {$endif PALMOSGDB} {$ifdef SUPPORT_REMOTE} var S,ErrorStr : string; {$endif SUPPORT_REMOTE} begin ResetBreakpointsValues; {$ifdef SUPPORT_REMOTE} NoSwitch:=true; isRemoteDebugging:=false; {$ifndef CROSSGDB} If (RemoteMachine<>'') and (RemotePort<>'') then {$else CROSSGDB} if true then {$endif CROSSGDB} begin isRemoteDebugging:=true; 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); Command('target '+TargetProtocol+' '+S); if Error then begin ErrorStr:=strpas(GetError); ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil); PopStatus; exit; end; PopStatus; end else begin {$endif SUPPORT_REMOTE} {$ifdef win32} { Run the debugge in another console } if DebuggeeTTY<>'' then Command('set new-console on') else Command('set new-console off'); NoSwitch:=DebuggeeTTY<>''; {$endif win32} {$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 {$ifdef ver1_0}IsATTY(textrec(Debuggeefile).handle){$else}(IsATTY(textrec(Debuggeefile).handle)<>-1){$endif} then begin Command('tty '+DebuggeeTTY); TTYUsed:=true; end else begin Command('tty '); 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('tty '+TTYName(input)); NoSwitch := false; end; {$endif Unix} {$ifdef SUPPORT_REMOTE} end; {$endif SUPPORT_REMOTE} { Switch to user screen to get correct handles } UserScreen; { Don't try to print GDB messages while in User Screen mode } If assigned(GDBWindow) then GDBWindow^.Editor^.Lock; {$ifdef SUPPORT_REMOTE} if isRemoteDebugging then begin inc(init_count); { pass the stop in start code } Command('continue'); end else {$endif SUPPORT_REMOTE} { Set cwd for debuggee } SetDir(GetRunDir); inherited Run; { Restore cwd for IDE } SetDir(StartupDir); DebuggerScreen; If assigned(GDBWindow) then GDBWindow^.Editor^.UnLock; 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 Command('finish'); 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; 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); 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); {$ifndef FPC}far;{$endif} begin if assigned(P) and (TypeOf(P^)=TypeOf(TSourceWindow)) then PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1); end; begin Desktop^.ForEach(@ResetDebuggerRow); end; procedure TDebugController.Reset; begin inherited Reset; { we need to free the executable if we want to recompile it } SetExe(''); 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) : pchar; var p,p2,p3 : pchar; begin if WindowWidth<>-1 then Command('set width 0xffffffff'); Command('p '+expr); p:=GetOutput; p3:=nil; if assigned(p) and (p[strlen(p)-1]=#10) then begin p3:=p+strlen(p)-1; p3^:=#0; end; if assigned(p) then p2:=strpos(p,'=') else p2:=nil; if assigned(p2) then p:=p2+1; while p^ in [' ',TAB] do inc(p); { get rid of type } if p^ = '(' then p:=strpos(p,')')+1; while p^ in [' ',TAB] do inc(p); if assigned(p) then GetValue:=StrNew(p) else GetValue:=StrNew(GetError); if assigned(p3) then p3^:=#10; got_error:=false; if WindowWidth<>-1 then Command('set width '+IntToStr(WindowWidth)); end; function TDebugController.GetFramePointer : CORE_ADDR; var st : string; p : longint; begin {$ifdef FrameNameKnown} Command('p /d '+FrameName); st:=strpas(GetOutput); p:=pos('=',st); while (p0 then dec(Line); S:=fn; stop_addr:=current_pc; if (BreakIndex=FPCBreakErrorNumber) then begin { Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : longint); [public,alias:'FPC_BREAK_ERROR']; } {$ifdef FrameNameKnown} ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset); ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset); ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset); if (ExitCode=0) and (ExitAddr=0) then begin Desktop^.Unlock; Command('continue'); exit; end; { forget all old frames } clear_frames; { record new frames } Command('backtrace'); for i:=0 to frame_count-1 do begin with frames[i]^ do begin if ExitAddr=address then begin Command('f '+IntToStr(i)); if assigned(file_name) then begin s:=strpas(file_name); line:=line_number; stop_addr:=address; end; break; end; end; end; {$endif FrameNameKnown} 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 $'+IntToHex(ExitAddr,8),nil) else WarningBox(#3'Run Time Error',nil); end else if not assigned(PB) then begin WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil); 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 Command('p '+GetStr(PB^.Name)); S:=GetPChar(GetOutput); got_error:=false; If Pos('=',S)>0 then S:=Copy(S,Pos('=',S)+1,255); If S[Length(S)]=#10 then Delete(S,Length(S),1); 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; 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 win32} main_pid_valid:=false; {$endif win32} end; procedure TDebugController.DoDebuggerScreen; {$ifdef win32} var IdeMode : DWord; {$endif win32} begin if NoSwitch then begin PopStatus; end else begin IDEApp.ShowIDEScreen; Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount))); PopStatus; end; {$ifdef win32} if NoSwitch then begin { Ctrl-C as normal char } 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 win32} end; procedure TDebugController.DoUserScreen; {$ifdef win32} var IdeMode : DWord; {$endif win32} begin Inc(RunCount); if NoSwitch then begin {$ifdef SUPPORT_REMOTE} PushStatus(msg_runningremotely+RemoteMachine); {$else not SUPPORT_REMOTE} {$ifdef Unix} PushStatus(msg_runninginanotherwindow+DebuggeeTTY); {$else not Unix} PushStatus(msg_runninginanotherwindow); {$endif Unix} {$endif not SUPPORT_REMOTE} end else begin PushStatus(msg_runningprogram); IDEApp.ShowUserScreen; end; {$ifdef win32} 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 win32} 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(@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 : pchar; st : string; begin {$ifndef NODEBUG} If not assigned(Debugger) then Exit; Remove; Debugger^.last_breakpoint_number:=0; if (GDBState=bs_deleted) and (state=bs_enabled) then begin if (typ=bt_file_line) and assigned(FileName) then Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line)) else if (typ=bt_function) and assigned(name) then Debugger^.Command('break '+name^) else if (typ=bt_address) and assigned(name) then Debugger^.Command('break *0x'+name^) else if (typ=bt_watch) and assigned(name) then Debugger^.Command('watch '+name^) else if (typ=bt_awatch) and assigned(name) then Debugger^.Command('awatch '+name^) else if (typ=bt_rwatch) and assigned(name) then Debugger^.Command('rwatch '+name^); if Debugger^.last_breakpoint_number<>0 then begin GDBIndex:=Debugger^.last_breakpoint_number; GDBState:=bs_enabled; Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions)); If IgnoreCount>0 then Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(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^.Command('delete '+IntToStr(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^.Command('enable '+IntToStr(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^.Command('disable '+IntToStr(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;{$ifndef FPC}far;{$endif} begin IsNum:=P^.GDBIndex=index; end; begin if index=0 then GetGDB:=nil else GetGDB:=FirstThat(@IsNum); end; procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow); procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif} 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);{$ifndef FPC}far;{$endif} var PDL : PDisasLine; S : string; ps,qs,i : longint; 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 (P^.typ=bt_address) and (PDL^.Address=HexToCard(P^.Name^)) then PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled); end; end; end; begin if W=PFPWindow(DisassemblyWindow) then ForEach(@SetInDisassembly) else ForEach(@SetInSource); end; procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint); procedure AdaptInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif} 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(@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;{$ifndef FPC}far;{$endif} 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(@IsAtLine); end; procedure TBreakpointCollection.ShowAllBreakpoints; procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif} 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(@SetInSource); end; function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint; function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif} begin IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S); end; begin GetType:=FirstThat(@IsThis); end; function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean; function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif} 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(@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 S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line) else S:=S+GetStr(name); While Length(S)<40 do S:=S+' '; S:=S+'|'; if IgnoreCount>0 then S:=S+IntToStr(IgnoreCount); While Length(S)<49 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(true); 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('Ä', 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(@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 s2:=copy(s2,j+1,length(s2)); while s2[1] in [' ',TAB] do delete(s2,1,1); if pos(s2,s)>0 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 p:=StrNew(Debugger^.GetOutput) else begin { get a reasonable output at least } s:=GetStr(expr); GetValue(s); p:=StrNew(Debugger^.GetError); end; 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); q:=nil; if assigned(p) and (p[0]='$') then q:=StrPos(p,'='); if not assigned(q) then q:=p; if assigned(q) then i:=strlen(q) else i:=0; if (i>0) and (q[i-1]=#10) then begin while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do dec(i); last_removed:=q[i-1]; q[i-1]:=#0; end else last_removed:=#0; if assigned(q) then current_value:=strnew(q) else current_value:=strnew(''); if last_removed<>#0 then q[i-1]:=last_removed; strdispose(p); 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(@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; 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 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,'Edit 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; { forget all old frames } Debugger^.clear_frames; if Debugger^.WindowWidth<>-1 then Debugger^.Command('set width 0xffffffff'); Debugger^.Command('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,8)+' '+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); if Debugger^.WindowWidth<>-1 then Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth)); 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^.Command('f '+IntToStr(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^.Command('f '+IntToStr(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; {**************************************************************************** Init/Final ****************************************************************************} function GetGDBTargetShortName : string; begin {$ifdef SUPPORT_REMOTE} {$ifdef PALMOSGDB} GetGDBTargetShortName:='palmos'; {$else} GetGDBTargetShortName:='linux'; {$endif PALMOSGDB} {$else not SUPPORT_REMOTE} GetGDBTargetShortName:=source_info.shortname {$endif not SUPPORT_REMOTE} 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; 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; 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; 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; Close(GDB_file); 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}