fpdebug.pas 100 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998-2000 by Pierre Muller
  4. Debugger call routines for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPDebug;
  12. {$ifdef NODEBUG}
  13. interface
  14. implementation
  15. end.
  16. {$else}
  17. interface
  18. {$i globdir.inc}
  19. uses
  20. {$ifdef Windows}
  21. Windows,
  22. {$endif Windows}
  23. Objects,Dialogs,Drivers,Views,
  24. {$ifndef NODEBUG}
  25. GDBCon,GDBInt,
  26. {$endif NODEBUG}
  27. Menus,
  28. WViews,WEditor,
  29. FPViews;
  30. type
  31. {$ifndef NODEBUG}
  32. PDebugController=^TDebugController;
  33. TDebugController=object(TGDBController)
  34. InvalidSourceLine : boolean;
  35. { if true the current debugger raw will stay in middle of
  36. editor window when debugging PM }
  37. CenterDebuggerRow : TCentre;
  38. Disableallinvalidbreakpoints : boolean;
  39. OrigPwd, { pwd at startup }
  40. LastFileName : string;
  41. LastSource : PView; {PsourceWindow !! }
  42. HiddenStepsCount : longint;
  43. { no need to switch if using another terminal }
  44. NoSwitch : boolean;
  45. HasExe : boolean;
  46. RunCount : longint;
  47. WindowWidth : longint;
  48. TBreakNumber : longint;
  49. FPCBreakErrorNumber : longint;
  50. {$ifdef SUPPORT_REMOTE}
  51. isRemoteDebugging:boolean;
  52. {$endif SUPPORT_REMOTE}
  53. constructor Init;
  54. procedure SetExe(const exefn:string);
  55. procedure SetTBreak(tbreakstring : string);
  56. procedure SetWidth(AWidth : longint);
  57. procedure SetSourceDirs;
  58. destructor Done;
  59. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  60. { procedure DoStartSession;virtual;
  61. procedure DoBreakSession;virtual;}
  62. procedure DoEndSession(code:longint);virtual;
  63. procedure DoUserSignal;virtual;
  64. procedure FlushAll; virtual;
  65. function Query(question : pchar; args : pchar) : longint; virtual;
  66. procedure AnnotateError;
  67. procedure InsertBreakpoints;
  68. procedure RemoveBreakpoints;
  69. procedure ReadWatches;
  70. procedure RereadWatches;
  71. procedure ResetBreakpointsValues;
  72. procedure DoDebuggerScreen;virtual;
  73. procedure DoUserScreen;virtual;
  74. procedure Reset;virtual;
  75. procedure ResetDebuggerRows;
  76. procedure Run;virtual;
  77. procedure Continue;virtual;
  78. procedure UntilReturn;virtual;
  79. procedure CommandBegin(const s:string);virtual;
  80. procedure CommandEnd(const s:string);virtual;
  81. function IsRunning : boolean;
  82. function AllowQuit : boolean;virtual;
  83. function GetValue(Const expr : string) : pchar;
  84. function GetFramePointer : CORE_ADDR;
  85. function GetLongintAt(addr : CORE_ADDR) : longint;
  86. function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  87. end;
  88. {$endif NODEBUG}
  89. BreakpointType = (bt_function,bt_file_line,bt_watch,
  90. bt_awatch,bt_rwatch,bt_address,bt_invalid);
  91. BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after);
  92. PBreakpointCollection=^TBreakpointCollection;
  93. PBreakpoint=^TBreakpoint;
  94. TBreakpoint=object(TObject)
  95. typ : BreakpointType;
  96. state : BreakpointState;
  97. owner : PBreakpointCollection;
  98. Name : PString; { either function name or expr to watch }
  99. FileName : PString;
  100. OldValue,CurrentValue : Pstring;
  101. Line : Longint; { only used for bt_file_line type }
  102. Conditions : PString; { conditions relative to that breakpoint }
  103. IgnoreCount : Longint; { how many counts should be ignored }
  104. Commands : pchar; { commands that should be executed on breakpoint }
  105. GDBIndex : longint;
  106. GDBState : BreakpointState;
  107. constructor Init_function(Const AFunc : String);
  108. constructor Init_Address(Const AAddress : String);
  109. constructor Init_Empty;
  110. constructor Init_file_line(AFile : String; ALine : longint);
  111. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  112. constructor Load(var S: TStream);
  113. procedure Store(var S: TStream);
  114. procedure Insert;
  115. procedure Remove;
  116. procedure Enable;
  117. procedure Disable;
  118. procedure UpdateSource;
  119. procedure ResetValues;
  120. destructor Done;virtual;
  121. end;
  122. TBreakpointCollection=object(TCollection)
  123. function At(Index: Integer): PBreakpoint;
  124. function GetGDB(index : longint) : PBreakpoint;
  125. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  126. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  127. procedure Update;
  128. procedure ShowBreakpoints(W : PFPWindow);
  129. function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  130. procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  131. procedure ShowAllBreakpoints;
  132. end;
  133. PBreakpointItem = ^TBreakpointItem;
  134. TBreakpointItem = object(TObject)
  135. Breakpoint : PBreakpoint;
  136. constructor Init(ABreakpoint : PBreakpoint);
  137. function GetText(MaxLen: Sw_integer): string; virtual;
  138. procedure Selected; virtual;
  139. function GetModuleName: string; virtual;
  140. end;
  141. PBreakpointsListBox = ^TBreakpointsListBox;
  142. TBreakpointsListBox = object(THSListBox)
  143. Transparent : boolean;
  144. NoSelection : boolean;
  145. MaxWidth : Sw_integer;
  146. (* ModuleNames : PStoreCollection; *)
  147. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  148. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  149. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  150. function GetLocalMenu: PMenu;virtual;
  151. procedure Clear; virtual;
  152. procedure TrackSource; virtual;
  153. procedure EditNew; virtual;
  154. procedure EditCurrent; virtual;
  155. procedure DeleteCurrent; virtual;
  156. procedure ToggleCurrent;
  157. procedure Draw; virtual;
  158. procedure HandleEvent(var Event: TEvent); virtual;
  159. constructor Load(var S: TStream);
  160. procedure Store(var S: TStream);
  161. destructor Done; virtual;
  162. end;
  163. PBreakpointsWindow = ^TBreakpointsWindow;
  164. TBreakpointsWindow = object(TFPDlgWindow)
  165. BreakLB : PBreakpointsListBox;
  166. constructor Init;
  167. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  168. procedure ClearBreakpoints;
  169. procedure ReloadBreakpoints;
  170. procedure Close; virtual;
  171. procedure SizeLimits(var Min, Max: TPoint);virtual;
  172. procedure HandleEvent(var Event: TEvent); virtual;
  173. procedure Update; virtual;
  174. constructor Load(var S: TStream);
  175. procedure Store(var S: TStream);
  176. destructor Done; virtual;
  177. end;
  178. PBreakpointItemDialog = ^TBreakpointItemDialog;
  179. TBreakpointItemDialog = object(TCenterDialog)
  180. constructor Init(ABreakpoint: PBreakpoint);
  181. function Execute: Word; virtual;
  182. private
  183. Breakpoint : PBreakpoint;
  184. TypeRB : PRadioButtons;
  185. NameIL : PEditorInputLine;
  186. ConditionsIL: PEditorInputLine;
  187. LineIL : PEditorInputLine;
  188. IgnoreIL : PEditorInputLine;
  189. end;
  190. PWatch = ^TWatch;
  191. TWatch = Object(TObject)
  192. expr : pstring;
  193. last_value,current_value : pchar;
  194. constructor Init(s : string);
  195. constructor Load(var S: TStream);
  196. procedure Store(var S: TStream);
  197. procedure rename(s : string);
  198. procedure Get_new_value;
  199. procedure Force_new_value;
  200. destructor done;virtual;
  201. private
  202. GDBRunCount : longint;
  203. end;
  204. PWatchesCollection = ^TWatchesCollection;
  205. TWatchesCollection = Object(TCollection)
  206. constructor Init;
  207. procedure Insert(Item: Pointer); virtual;
  208. function At(Index: Integer): PWatch;
  209. procedure Update;
  210. private
  211. MaxW : integer;
  212. end;
  213. PWatchesListBox = ^TWatchesListBox;
  214. TWatchesListBox = object(THSListBox)
  215. Transparent : boolean;
  216. MaxWidth : Sw_integer;
  217. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  218. (* procedure AddWatch(P: PWatch); virtual; *)
  219. procedure Update(AMaxWidth : integer);
  220. function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  221. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
  222. function GetLocalMenu: PMenu;virtual;
  223. (* procedure Clear; virtual;
  224. procedure TrackSource; virtual;*)
  225. procedure EditNew; virtual;
  226. procedure EditCurrent; virtual;
  227. procedure DeleteCurrent; virtual;
  228. (*procedure ToggleCurrent; *)
  229. procedure Draw; virtual;
  230. procedure HandleEvent(var Event: TEvent); virtual;
  231. constructor Load(var S: TStream);
  232. procedure Store(var S: TStream);
  233. destructor Done; virtual;
  234. end;
  235. PWatchItemDialog = ^TWatchItemDialog;
  236. TWatchItemDialog = object(TCenterDialog)
  237. constructor Init(AWatch: PWatch);
  238. function Execute: Word; virtual;
  239. private
  240. Watch : PWatch;
  241. NameIL : PEditorInputLine;
  242. TextST : PAdvancedStaticText;
  243. end;
  244. PWatchesWindow = ^TWatchesWindow;
  245. TWatchesWindow = Object(TFPDlgWindow)
  246. WLB : PWatchesListBox;
  247. Constructor Init;
  248. constructor Load(var S: TStream);
  249. procedure Store(var S: TStream);
  250. procedure Update; virtual;
  251. destructor Done; virtual;
  252. end;
  253. PFramesListBox = ^TFramesListBox;
  254. TFramesListBox = object(TMessageListBox)
  255. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  256. procedure Update;
  257. function GetLocalMenu: PMenu;virtual;
  258. procedure GotoSource; virtual;
  259. procedure GotoAssembly; virtual;
  260. procedure HandleEvent(var Event: TEvent); virtual;
  261. destructor Done; virtual;
  262. end;
  263. PStackWindow = ^TStackWindow;
  264. TStackWindow = Object(TFPDlgWindow)
  265. FLB : PFramesListBox;
  266. Constructor Init;
  267. constructor Load(var S: TStream);
  268. procedure Store(var S: TStream);
  269. procedure Update; virtual;
  270. destructor Done; virtual;
  271. end;
  272. procedure InitStackWindow;
  273. procedure DoneStackWindow;
  274. function ActiveBreakpoints : boolean;
  275. function GDBFileName(st : string) : string;
  276. function OSFileName(st : string) : string;
  277. const
  278. BreakpointTypeStr : Array[BreakpointType] of String[9]
  279. = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
  280. BreakpointStateStr : Array[BreakpointState] of String[8]
  281. = ( 'enabled','disabled','invalid',''{'to be deleted' should never be used});
  282. var
  283. {$ifndef NODEBUG}
  284. Debugger : PDebugController;
  285. {$endif NODEBUG}
  286. BreakpointsCollection : PBreakpointCollection;
  287. WatchesCollection : PwatchesCollection;
  288. procedure InitDebugger;
  289. procedure DoneDebugger;
  290. procedure InitGDBWindow;
  291. procedure DoneGDBWindow;
  292. procedure InitDisassemblyWindow;
  293. procedure DoneDisassemblyWindow;
  294. procedure InitBreakpoints;
  295. procedure DoneBreakpoints;
  296. procedure InitWatches;
  297. procedure DoneWatches;
  298. procedure RegisterFPDebugViews;
  299. procedure UpdateDebugViews;
  300. implementation
  301. uses
  302. Dos,
  303. Video,
  304. {$ifdef DOS}
  305. fpusrscr,
  306. {$endif DOS}
  307. App,Strings,
  308. FVConsts,
  309. MsgBox,
  310. {$ifdef Windows}
  311. Windebug,
  312. {$endif Windows}
  313. {$ifdef Unix}
  314. termio,
  315. {$endif Unix}
  316. Systems,Globals,
  317. FPRegs,
  318. FPVars,FPUtils,FPConst,FPSwitch,
  319. FPIntf,FPCompil,FPIde,FPHelp,
  320. Validate,WUtils,Wconsts;
  321. const
  322. RBreakpointsWindow: TStreamRec = (
  323. ObjType: 1701;
  324. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  325. Load: @TBreakpointsWindow.Load;
  326. Store: @TBreakpointsWindow.Store
  327. );
  328. RBreakpointsListBox : TStreamRec = (
  329. ObjType: 1702;
  330. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  331. Load: @TBreakpointsListBox.Load;
  332. Store: @TBreakpointsListBox.Store
  333. );
  334. RWatchesWindow: TStreamRec = (
  335. ObjType: 1703;
  336. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  337. Load: @TWatchesWindow.Load;
  338. Store: @TWatchesWindow.Store
  339. );
  340. RWatchesListBox: TStreamRec = (
  341. ObjType: 1704;
  342. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  343. Load: @TWatchesListBox.Load;
  344. Store: @TWatchesListBox.Store
  345. );
  346. RStackWindow: TStreamRec = (
  347. ObjType: 1705;
  348. VmtLink: Ofs(TypeOf(TStackWindow)^);
  349. Load: @TStackWindow.Load;
  350. Store: @TStackWindow.Store
  351. );
  352. RFramesListBox: TStreamRec = (
  353. ObjType: 1706;
  354. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  355. Load: @TFramesListBox.Load;
  356. Store: @TFramesListBox.Store
  357. );
  358. RBreakpoint: TStreamRec = (
  359. ObjType: 1707;
  360. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  361. Load: @TBreakpoint.Load;
  362. Store: @TBreakpoint.Store
  363. );
  364. RWatch: TStreamRec = (
  365. ObjType: 1708;
  366. VmtLink: Ofs(TypeOf(TWatch)^);
  367. Load: @TWatch.Load;
  368. Store: @TWatch.Store
  369. );
  370. RBreakpointCollection: TStreamRec = (
  371. ObjType: 1709;
  372. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  373. Load: @TBreakpointCollection.Load;
  374. Store: @TBreakpointCollection.Store
  375. );
  376. RWatchesCollection: TStreamRec = (
  377. ObjType: 1710;
  378. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  379. Load: @TWatchesCollection.Load;
  380. Store: @TWatchesCollection.Store
  381. );
  382. {$ifdef USERESSTRINGS}
  383. resourcestring
  384. {$else}
  385. const
  386. {$endif}
  387. button_OK = 'O~K~';
  388. button_Cancel = 'Cancel';
  389. button_New = '~N~ew';
  390. button_Edit = '~E~dit';
  391. button_Delete = '~D~elete';
  392. button_Close = '~C~lose';
  393. button_ToggleButton = '~T~oggle';
  394. { Watches local menu items }
  395. menu_watchlocal_edit = '~E~dit watch';
  396. menu_watchlocal_new = '~N~ew watch';
  397. menu_watchlocal_delete = '~D~elete watch';
  398. { Breakpoints window local menu items }
  399. menu_bplocal_gotosource = '~G~oto source';
  400. menu_bplocal_editbreakpoint = '~E~dit breakpoint';
  401. menu_bplocal_newbreakpoint = '~N~ew breakpoint';
  402. menu_bplocal_deletebreakpoint = '~D~elete breakpoint';
  403. menu_bplocal_togglestate = '~T~oggle state';
  404. { Debugger messages and status hints }
  405. msg_programexitedwithcodeandsteps = #3'Program exited with '#13+
  406. #3'exitcode = %d'#13+
  407. #3'hidden steps = %d';
  408. msg_programexitedwithexitcode = #3'Program exited with '#13+
  409. #3'exitcode = %d';
  410. msg_programsignal = #3'Program recieved signal %s'#13+
  411. #3'%s';
  412. msg_runningprogram = 'Running...';
  413. msg_runningremotely = 'Executable running remotely on ';
  414. msg_connectingto = 'Connecting to ';
  415. msg_getting_info_on = 'Getting infos from ';
  416. msg_runninginanotherwindow = 'Executable running in another window..';
  417. msg_couldnotsetbreakpointat = #3'Could not set Breakpoint'#13+
  418. #3+'%s:%d';
  419. msg_couldnotsetbreakpointtype = #3'Could not set Breakpoint'#13+
  420. #3+'%s %s';
  421. button_DisableAllBreakpoints = 'Dis. ~a~ll invalid';
  422. { Breakpoints window }
  423. dialog_breakpointlist = 'Breakpoint list';
  424. label_breakpointpropheader = ' Type | State | Position | Path | Ignore | Conditions ';
  425. dialog_modifynewbreakpoint = 'Modify/New Breakpoint';
  426. label_breakpoint_name = '~N~ame';
  427. label_breakpoint_line = '~L~ine';
  428. label_breakpoint_conditions = '~C~onditions';
  429. label_breakpoint_ignorecount = '~I~gnore count';
  430. label_breakpoint_type = '~T~ype';
  431. { Watches window }
  432. dialog_watches = 'Watches';
  433. label_watch_expressiontowatch = '~E~xpression to watch';
  434. label_watch_values = 'Watch values';
  435. msg_watch_currentvalue = 'Current value: '+#13+
  436. '%s';
  437. msg_watch_currentandpreviousvalue = 'Current value: '+#13+
  438. '%s'+#13+
  439. 'Previous value: '+#13+
  440. '%s';
  441. dialog_callstack = 'Call Stack';
  442. menu_msglocal_saveas = 'Save ~a~s';
  443. msg_cantdebugchangetargetto = #3'Sorry, can not debug'#13+
  444. #3'programs compiled for %s.'#13+
  445. #3'Change target to %s?';
  446. msg_compiledwithoutdebuginforecompile =
  447. #3'Warning, the program'#13+
  448. #3'was compiled without'#13+
  449. #3'debugging info.'#13+
  450. #3'Recompile it?';
  451. msg_nothingtodebug = 'Oooops, nothing to debug.';
  452. msg_startingdebugger = 'Starting debugger';
  453. {$ifdef I386}
  454. const
  455. FrameName = '$ebp';
  456. {$define FrameNameKnown}
  457. {$endif i386}
  458. {$ifdef m68k}
  459. const
  460. FrameName = '$fp';
  461. {$define FrameNameKnown}
  462. {$endif m68k}
  463. {$ifdef powerpc}
  464. { stack and frame registers are the same on powerpc,
  465. so I am not sure that this will work PM }
  466. const
  467. FrameName = '$r1';
  468. {$define FrameNameKnown}
  469. {$endif powerpc}
  470. function GDBFileName(st : string) : string;
  471. {$ifndef Unix}
  472. var i : longint;
  473. {$endif Unix}
  474. begin
  475. {$ifdef NODEBUG}
  476. GDBFileName:=st;
  477. {$else NODEBUG}
  478. {$ifdef Unix}
  479. GDBFileName:=st;
  480. {$else}
  481. { should we also use / chars ? }
  482. for i:=1 to Length(st) do
  483. if st[i]='\' then
  484. {$ifdef Windows}
  485. { Don't touch at '\ ' used to escapes spaces in windows file names PM }
  486. if (i=length(st)) or (st[i+1]<>' ') then
  487. {$endif Windows}
  488. st[i]:='/';
  489. {$ifdef Windows}
  490. {$ifndef USE_MINGW_GDB} // see mantis 11968 because of mingw build. MvdV
  491. { for Windows we should convert e:\ into //e/ PM }
  492. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  493. st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
  494. {$endif}
  495. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  496. for i:=Length(st) downto 1 do
  497. if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
  498. st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
  499. {$endif Windows}
  500. {$ifdef go32v2}
  501. { for go32v2 we should convert //e/ back into e:/ PM }
  502. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  503. st:=st[3]+':/'+copy(st,5,length(st));
  504. {$endif go32v2}
  505. GDBFileName:=LowerCaseStr(st);
  506. {$endif}
  507. {$endif NODEBUG}
  508. end;
  509. function OSFileName(st : string) : string;
  510. {$ifndef Unix}
  511. var i : longint;
  512. {$endif Unix}
  513. begin
  514. {$ifdef Unix}
  515. OSFileName:=st;
  516. {$else}
  517. {$ifdef Windows}
  518. {$ifndef NODEBUG}
  519. { for Windows we should convert /cygdrive/e/ into e:\ PM }
  520. if pos(CygDrivePrefix+'/',st)=1 then
  521. st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
  522. {$endif NODEBUG}
  523. {$endif Windows}
  524. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  525. for i:=Length(st) downto 2 do
  526. if (st[i]=' ') and (st[i-1]='\') then
  527. st:=copy(st,1,i-2)+copy(st,i,length(st));
  528. {$ifdef go32v2}
  529. { for go32v2 we should convert //e/ back into e:/ PM }
  530. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  531. st:=st[3]+':\'+copy(st,5,length(st));
  532. {$endif go32v2}
  533. { should we also use / chars ? }
  534. for i:=1 to Length(st) do
  535. if st[i]='/' then
  536. st[i]:='\';
  537. OSFileName:=LowerCaseStr(st);
  538. {$endif}
  539. end;
  540. {****************************************************************************
  541. TDebugController
  542. ****************************************************************************}
  543. procedure UpdateDebugViews;
  544. begin
  545. {$ifdef SUPPORT_REMOTE}
  546. if isRemoteDebugging then
  547. PushStatus(msg_getting_info_on+RemoteMachine);
  548. {$endif SUPPORT_REMOTE}
  549. DeskTop^.Lock;
  550. If assigned(StackWindow) then
  551. StackWindow^.Update;
  552. If assigned(RegistersWindow) then
  553. RegistersWindow^.Update;
  554. {$ifndef NODEBUG}
  555. If assigned(Debugger) then
  556. Debugger^.ReadWatches;
  557. {$endif NODEBUG}
  558. If assigned(FPUWindow) then
  559. FPUWindow^.Update;
  560. If assigned(VectorWindow) then
  561. VectorWindow^.Update;
  562. DeskTop^.UnLock;
  563. {$ifdef SUPPORT_REMOTE}
  564. if isRemoteDebugging then
  565. PopStatus;
  566. {$endif SUPPORT_REMOTE}
  567. end;
  568. {$ifndef NODEBUG}
  569. constructor TDebugController.Init;
  570. begin
  571. inherited Init;
  572. CenterDebuggerRow:=IniCenterDebuggerRow;
  573. Disableallinvalidbreakpoints:=false;
  574. NoSwitch:=False;
  575. HasExe:=false;
  576. Debugger:=@self;
  577. WindowWidth:=-1;
  578. switch_to_user:=true;
  579. GetDir(0,OrigPwd);
  580. Command('set print object off');
  581. end;
  582. procedure TDebugController.SetExe(const exefn:string);
  583. var f : string;
  584. begin
  585. f := GDBFileName(GetShortName(exefn));
  586. if (f<>'') and ExistsFile(exefn) then
  587. begin
  588. LoadFile(f);
  589. HasExe:=true;
  590. { Procedure HandleErrorAddrFrame
  591. (Errno : longint;addr,frame : longint);
  592. [public,alias:'FPC_BREAK_ERROR'];
  593. Command('b HANDLEERRORADDRFRAME'); }
  594. Command('b FPC_BREAK_ERROR');
  595. FPCBreakErrorNumber:=last_breakpoint_number;
  596. {$ifdef FrameNameKnown}
  597. { this fails in GDB 5.1 because
  598. GDB replies that there is an attempt to dereference
  599. a generic pointer...
  600. test delayed in DoSourceLine... PM
  601. Command('cond '+IntToStr(FPCBreakErrorNumber)+
  602. ' (('+FrameName+' + 8)^ <> 0) or'+
  603. ' (('+FrameName+' + 12)^ <> 0)'); }
  604. {$endif FrameNameKnown}
  605. SetArgs(GetRunParameters);
  606. SetSourceDirs;
  607. InsertBreakpoints;
  608. ReadWatches;
  609. end
  610. else
  611. begin
  612. HasExe:=false;
  613. Command('file');
  614. end;
  615. end;
  616. procedure TDebugController.SetTBreak(tbreakstring : string);
  617. begin
  618. Command('tbreak '+tbreakstring);
  619. TBreakNumber:=Last_breakpoint_number;
  620. end;
  621. procedure TDebugController.SetWidth(AWidth : longint);
  622. begin
  623. WindowWidth:=AWidth;
  624. Command('set width '+inttostr(WindowWidth));
  625. end;
  626. procedure TDebugController.SetSourceDirs;
  627. var f,s: ansistring;
  628. i : longint;
  629. Dir : SearchRec;
  630. begin
  631. f:=GetSourceDirectories+';'+OrigPwd;
  632. repeat
  633. i:=pos(';',f);
  634. if i=0 then
  635. s:=f
  636. else
  637. begin
  638. s:=copy(f,1,i-1);
  639. system.delete(f,1,i);
  640. end;
  641. DefaultReplacements(s);
  642. if (pos('*',s)=0) and ExistsDir(s) then
  643. Command('dir '+GDBFileName(GetShortName(s)))
  644. { we should also handle the /* cases of -Fu option }
  645. else if pos('*',s)>0 then
  646. begin
  647. Dos.FindFirst(s,Directory,Dir);
  648. { the '*' can only be in the last dir level }
  649. s:=DirOf(s);
  650. while Dos.DosError=0 do
  651. begin
  652. if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
  653. Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
  654. Dos.FindNext(Dir);
  655. end;
  656. Dos.FindClose(Dir);
  657. end;
  658. until i=0;
  659. end;
  660. procedure TDebugController.InsertBreakpoints;
  661. procedure DoInsert(PB : PBreakpoint);
  662. begin
  663. PB^.Insert;
  664. end;
  665. begin
  666. BreakpointsCollection^.ForEach(@DoInsert);
  667. Disableallinvalidbreakpoints:=false;
  668. end;
  669. procedure TDebugController.ReadWatches;
  670. procedure DoRead(PB : PWatch);
  671. begin
  672. PB^.Get_new_value;
  673. end;
  674. begin
  675. WatchesCollection^.ForEach(@DoRead);
  676. If Assigned(WatchesWindow) then
  677. WatchesWindow^.Update;
  678. end;
  679. procedure TDebugController.RereadWatches;
  680. procedure DoRead(PB : PWatch);
  681. begin
  682. PB^.Force_new_value;
  683. end;
  684. begin
  685. WatchesCollection^.ForEach(@DoRead);
  686. If Assigned(WatchesWindow) then
  687. WatchesWindow^.Update;
  688. end;
  689. procedure TDebugController.RemoveBreakpoints;
  690. procedure DoDelete(PB : PBreakpoint);
  691. begin
  692. PB^.Remove;
  693. end;
  694. begin
  695. BreakpointsCollection^.ForEach(@DoDelete);
  696. end;
  697. procedure TDebugController.ResetBreakpointsValues;
  698. procedure DoResetVal(PB : PBreakpoint);
  699. begin
  700. PB^.ResetValues;
  701. end;
  702. begin
  703. BreakpointsCollection^.ForEach(@DoResetVal);
  704. end;
  705. destructor TDebugController.Done;
  706. begin
  707. { kill the program if running }
  708. Reset;
  709. RemoveBreakpoints;
  710. inherited Done;
  711. end;
  712. procedure TDebugController.Run;
  713. {$ifdef Unix}
  714. var
  715. Debuggeefile : text;
  716. ResetOK, TTYUsed : boolean;
  717. {$endif Unix}
  718. {$ifdef PALMOSGDB}
  719. const
  720. TargetProtocol = 'palmos';
  721. {$else}
  722. const
  723. TargetProtocol = 'remote';
  724. {$endif PALMOSGDB}
  725. {$ifdef SUPPORT_REMOTE}
  726. var
  727. S,ErrorStr : string;
  728. {$endif SUPPORT_REMOTE}
  729. begin
  730. ResetBreakpointsValues;
  731. {$ifdef SUPPORT_REMOTE}
  732. NoSwitch:=true;
  733. isRemoteDebugging:=false;
  734. {$ifndef CROSSGDB}
  735. If (RemoteMachine<>'') and (RemotePort<>'') then
  736. {$else CROSSGDB}
  737. if true then
  738. {$endif CROSSGDB}
  739. begin
  740. isRemoteDebugging:=true;
  741. S:=RemoteMachine;
  742. If pos('@',S)>0 then
  743. S:=copy(S,pos('@',S)+1,High(S));
  744. If RemotePort<>'' then
  745. S:=S+':'+RemotePort;
  746. {$ifdef PALMOSGDB}
  747. { set the default value for PalmOS }
  748. If S='' then
  749. S:='localhost:2000';
  750. {$endif PALMOSGDB}
  751. PushStatus(msg_connectingto+S);
  752. Command('target '+TargetProtocol+' '+S);
  753. if Error then
  754. begin
  755. ErrorStr:=strpas(GetError);
  756. ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil);
  757. PopStatus;
  758. exit;
  759. end;
  760. s:=IDEApp.GetRemoteExecString;
  761. MessageBox(#3'Start in remote'#13#3+s,nil,mfOKbutton);
  762. PopStatus;
  763. end
  764. else
  765. begin
  766. {$endif SUPPORT_REMOTE}
  767. {$ifdef Windows}
  768. { Run the debugge in another console }
  769. if DebuggeeTTY<>'' then
  770. Command('set new-console on')
  771. else
  772. Command('set new-console off');
  773. NoSwitch:=DebuggeeTTY<>'';
  774. {$endif Windows}
  775. {$ifdef Unix}
  776. { Run the debuggee in another tty }
  777. if DebuggeeTTY <> '' then
  778. begin
  779. {$I-}
  780. Assign(Debuggeefile,DebuggeeTTY);
  781. system.Reset(Debuggeefile);
  782. ResetOK:=IOResult=0;
  783. If ResetOK and (IsATTY(textrec(Debuggeefile).handle)<>-1) then
  784. begin
  785. Command('tty '+DebuggeeTTY);
  786. TTYUsed:=true;
  787. end
  788. else
  789. begin
  790. Command('tty ');
  791. TTYUsed:=false;
  792. end;
  793. if ResetOK then
  794. close(Debuggeefile);
  795. if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
  796. NoSwitch:= true
  797. else
  798. NoSwitch:=false;
  799. end
  800. else
  801. begin
  802. if TTYName(input)<>'' then
  803. Command('tty '+TTYName(input));
  804. NoSwitch := false;
  805. end;
  806. {$endif Unix}
  807. {$ifdef SUPPORT_REMOTE}
  808. end;
  809. {$endif SUPPORT_REMOTE}
  810. { Switch to user screen to get correct handles }
  811. UserScreen;
  812. { Don't try to print GDB messages while in User Screen mode }
  813. If assigned(GDBWindow) then
  814. GDBWindow^.Editor^.Lock;
  815. {$ifdef SUPPORT_REMOTE}
  816. if isRemoteDebugging then
  817. begin
  818. inc(init_count);
  819. { pass the stop in start code }
  820. Command('continue');
  821. end else
  822. {$endif SUPPORT_REMOTE}
  823. { Set cwd for debuggee }
  824. SetDir(GetRunDir);
  825. inherited Run;
  826. { Restore cwd for IDE }
  827. SetDir(StartupDir);
  828. DebuggerScreen;
  829. If assigned(GDBWindow) then
  830. GDBWindow^.Editor^.UnLock;
  831. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  832. IDEApp.UpdateRunMenu(true);
  833. UpdateDebugViews;
  834. end;
  835. function TDebugController.IsRunning : boolean;
  836. begin
  837. IsRunning:=debuggee_started;
  838. end;
  839. procedure TDebugController.Continue;
  840. begin
  841. {$ifdef NODEBUG}
  842. NoDebugger;
  843. {$else}
  844. if not debuggee_started then
  845. Run
  846. else
  847. inherited Continue;
  848. UpdateDebugViews;
  849. {$endif NODEBUG}
  850. end;
  851. procedure TDebugController.UntilReturn;
  852. begin
  853. Command('finish');
  854. UpdateDebugViews;
  855. { We could try to get the return value !
  856. Not done yet }
  857. end;
  858. procedure TDebugController.CommandBegin(const s:string);
  859. begin
  860. if assigned(GDBWindow) and (in_command>1) then
  861. begin
  862. { We should do something special for errors !! }
  863. If StrLen(GetError)>0 then
  864. GDBWindow^.WriteErrorText(GetError);
  865. GDBWindow^.WriteOutputText(GetOutput);
  866. end;
  867. if assigned(GDBWindow) then
  868. GDBWindow^.WriteString(S);
  869. end;
  870. function TDebugController.Query(question : pchar; args : pchar) : longint;
  871. var
  872. c : char;
  873. WasModal : boolean;
  874. ModalView : PView;
  875. res : longint;
  876. begin
  877. if not assigned(Application) then
  878. begin
  879. system.Write(question);
  880. repeat
  881. system.write('(y or n)');
  882. system.read(c);
  883. system.writeln(c);
  884. until (lowercase(c)='y') or (lowercase(c)='n');
  885. if lowercase(c)='y' then
  886. query:=1
  887. else
  888. query:=0;
  889. exit;
  890. end;
  891. if assigned(Application^.Current) and
  892. ((Application^.Current^.State and sfModal)<>0) then
  893. begin
  894. WasModal:=true;
  895. ModalView:=Application^.Current;
  896. ModalView^.SetState(sfModal, false);
  897. ModalView^.Hide;
  898. end
  899. else
  900. WasModal:=false;
  901. PushStatus(Question);
  902. res:=MessageBox(Question,nil,mfyesbutton+mfnobutton);
  903. PopStatus;
  904. if res=cmYes then
  905. Query:=1
  906. else
  907. Query:=0;
  908. if WasModal then
  909. begin
  910. ModalView^.Show;
  911. ModalView^.SetState(sfModal, true);
  912. ModalView^.Draw;
  913. end;
  914. end;
  915. procedure TDebugController.FlushAll;
  916. begin
  917. if assigned(GDBWindow) then
  918. begin
  919. If StrLen(GetError)>0 then
  920. begin
  921. GDBWindow^.WriteErrorText(GetError);
  922. if in_command=0 then
  923. gdberrorbuf.reset;
  924. end;
  925. If StrLen(GetOutput)>0 then
  926. begin
  927. GDBWindow^.WriteOutputText(GetOutput);
  928. { Keep output for command results }
  929. if in_command=0 then
  930. gdboutputbuf.reset;
  931. end;
  932. end
  933. else
  934. Inherited FlushAll;
  935. end;
  936. procedure TDebugController.CommandEnd(const s:string);
  937. begin
  938. if assigned(GDBWindow) and (in_command<=1) then
  939. begin
  940. { We should do something special for errors !! }
  941. If StrLen(GetError)>0 then
  942. GDBWindow^.WriteErrorText(GetError);
  943. GDBWindow^.WriteOutputText(GetOutput);
  944. GDBWindow^.Editor^.TextEnd;
  945. end;
  946. end;
  947. function TDebugController.AllowQuit : boolean;
  948. begin
  949. if IsRunning then
  950. begin
  951. if ConfirmBox('Really quit GDB window'#13+
  952. 'and kill running program?',nil,true)=cmYes then
  953. begin
  954. Reset;
  955. DoneGDBWindow;
  956. {AllowQuit:=true;}
  957. AllowQuit:=false;
  958. end
  959. else
  960. AllowQuit:=false;
  961. end
  962. else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
  963. begin
  964. DoneGDBWindow;
  965. {AllowQuit:=true;}
  966. AllowQuit:=false;
  967. end
  968. else
  969. AllowQuit:=false;
  970. end;
  971. procedure TDebugController.ResetDebuggerRows;
  972. procedure ResetDebuggerRow(P: PView);
  973. begin
  974. if assigned(P) and
  975. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  976. PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  977. end;
  978. begin
  979. Desktop^.ForEach(@ResetDebuggerRow);
  980. end;
  981. procedure TDebugController.Reset;
  982. begin
  983. inherited Reset;
  984. { we need to free the executable
  985. if we want to recompile it }
  986. SetExe('');
  987. NoSwitch:=false;
  988. { In case we have something that the compiler touched }
  989. If IDEApp.IsRunning then
  990. begin
  991. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  992. IDEApp.UpdateRunMenu(false);
  993. AskToReloadAllModifiedFiles;
  994. ResetDebuggerRows;
  995. end;
  996. end;
  997. procedure TDebugController.AnnotateError;
  998. var errornb : longint;
  999. begin
  1000. if error then
  1001. begin
  1002. errornb:=error_num;
  1003. UpdateDebugViews;
  1004. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  1005. end;
  1006. end;
  1007. function TDebugController.GetValue(Const expr : string) : pchar;
  1008. var
  1009. p,p2,p3 : pchar;
  1010. begin
  1011. if WindowWidth<>-1 then
  1012. Command('set width 0xffffffff');
  1013. Command('p '+expr);
  1014. p:=GetOutput;
  1015. p3:=nil;
  1016. if assigned(p) and (p[strlen(p)-1]=#10) then
  1017. begin
  1018. p3:=p+strlen(p)-1;
  1019. p3^:=#0;
  1020. end;
  1021. if assigned(p) then
  1022. p2:=strpos(p,'=')
  1023. else
  1024. p2:=nil;
  1025. if assigned(p2) then
  1026. p:=p2+1;
  1027. while p^ in [' ',TAB] do
  1028. inc(p);
  1029. { get rid of type }
  1030. if p^ = '(' then
  1031. p:=strpos(p,')')+1;
  1032. while p^ in [' ',TAB] do
  1033. inc(p);
  1034. if assigned(p) then
  1035. GetValue:=StrNew(p)
  1036. else
  1037. GetValue:=StrNew(GetError);
  1038. if assigned(p3) then
  1039. p3^:=#10;
  1040. got_error:=false;
  1041. if WindowWidth<>-1 then
  1042. Command('set width '+IntToStr(WindowWidth));
  1043. end;
  1044. function TDebugController.GetFramePointer : CORE_ADDR;
  1045. var
  1046. st : string;
  1047. p : longint;
  1048. begin
  1049. {$ifdef FrameNameKnown}
  1050. Command('p /d '+FrameName);
  1051. st:=strpas(GetOutput);
  1052. p:=pos('=',st);
  1053. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1054. inc(p);
  1055. Delete(st,1,p);
  1056. p:=1;
  1057. while (st[p] in ['0'..'9']) do
  1058. inc(p);
  1059. Delete(st,p,High(st));
  1060. GetFramePointer:=StrToCard(st);
  1061. {$else not FrameNameKnown}
  1062. GetFramePointer:=0;
  1063. {$endif not FrameNameKnown}
  1064. end;
  1065. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  1066. var
  1067. st : string;
  1068. p : longint;
  1069. begin
  1070. Command('x /wd 0x'+hexstr(longint(addr),8));
  1071. st:=strpas(GetOutput);
  1072. p:=pos(':',st);
  1073. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1074. inc(p);
  1075. Delete(st,1,p);
  1076. p:=1;
  1077. while (st[p] in ['0'..'9']) do
  1078. inc(p);
  1079. Delete(st,p,High(st));
  1080. GetLongintAt:=StrToInt(st);
  1081. end;
  1082. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  1083. var
  1084. st : string;
  1085. p : longint;
  1086. code : integer;
  1087. begin
  1088. Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
  1089. st:=strpas(GetOutput);
  1090. p:=pos(':',st);
  1091. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1092. inc(p);
  1093. if (p<length(st)) and (st[p+1]='$') then
  1094. inc(p);
  1095. Delete(st,1,p);
  1096. p:=1;
  1097. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  1098. inc(p);
  1099. Delete(st,p,High(st));
  1100. Val('$'+st,GetPointerAt,code);
  1101. end;
  1102. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  1103. var
  1104. W: PSourceWindow;
  1105. Found : boolean;
  1106. PB : PBreakpoint;
  1107. S : String;
  1108. BreakIndex : longint;
  1109. stop_addr : CORE_ADDR;
  1110. i,ExitCode : longint;
  1111. ExitAddr,ExitFrame : CORE_ADDR;
  1112. const
  1113. { try to find the parameters }
  1114. FirstArgOffset = -sizeof(pointer);
  1115. SecondArgOffset = 2*-sizeof(pointer);
  1116. ThirdArgOffset = 3*-sizeof(pointer);
  1117. begin
  1118. BreakIndex:=stop_breakpoint_number;
  1119. Desktop^.Lock;
  1120. { 0 based line count in Editor }
  1121. if Line>0 then
  1122. dec(Line);
  1123. S:=fn;
  1124. stop_addr:=current_pc;
  1125. if (BreakIndex=FPCBreakErrorNumber) then
  1126. begin
  1127. { Procedure HandleErrorAddrFrame
  1128. (Errno : longint;addr,frame : longint);
  1129. [public,alias:'FPC_BREAK_ERROR']; }
  1130. {$ifdef FrameNameKnown}
  1131. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  1132. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  1133. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  1134. if (ExitCode=0) and (ExitAddr=0) then
  1135. begin
  1136. Desktop^.Unlock;
  1137. Command('continue');
  1138. exit;
  1139. end;
  1140. { forget all old frames }
  1141. clear_frames;
  1142. { record new frames }
  1143. Command('backtrace');
  1144. for i:=0 to frame_count-1 do
  1145. begin
  1146. with frames[i]^ do
  1147. begin
  1148. if ExitAddr=address then
  1149. begin
  1150. Command('f '+IntToStr(i));
  1151. if assigned(file_name) then
  1152. begin
  1153. s:=strpas(file_name);
  1154. line:=line_number;
  1155. stop_addr:=address;
  1156. end;
  1157. break;
  1158. end;
  1159. end;
  1160. end;
  1161. {$endif FrameNameKnown}
  1162. end;
  1163. { Update Disassembly position }
  1164. if Assigned(DisassemblyWindow) then
  1165. DisassemblyWindow^.SetCurAddress(stop_addr);
  1166. if (fn=LastFileName) then
  1167. begin
  1168. W:=PSourceWindow(LastSource);
  1169. if assigned(W) then
  1170. begin
  1171. W^.Editor^.SetCurPtr(0,Line);
  1172. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1173. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1174. UpdateDebugViews;
  1175. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1176. handled by SelectInDebugSession}
  1177. W^.SelectInDebugSession;
  1178. InvalidSourceLine:=false;
  1179. end
  1180. else
  1181. InvalidSourceLine:=true;
  1182. end
  1183. else
  1184. begin
  1185. if s='' then
  1186. W:=nil
  1187. else
  1188. W:=TryToOpenFile(nil,s,0,Line,false);
  1189. if assigned(W) then
  1190. begin
  1191. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1192. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1193. UpdateDebugViews;
  1194. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1195. handled by SelectInDebugSession}
  1196. W^.SelectInDebugSession;
  1197. LastSource:=W;
  1198. InvalidSourceLine:=false;
  1199. end
  1200. { only search a file once }
  1201. else
  1202. begin
  1203. Desktop^.UnLock;
  1204. if s='' then
  1205. Found:=false
  1206. else
  1207. { it is easier to handle with a * at the end }
  1208. Found:=IDEApp.OpenSearch(s+'*');
  1209. Desktop^.Lock;
  1210. if not Found then
  1211. begin
  1212. InvalidSourceLine:=true;
  1213. LastSource:=Nil;
  1214. { Show the stack in that case }
  1215. InitStackWindow;
  1216. UpdateDebugViews;
  1217. StackWindow^.MakeFirst;
  1218. end
  1219. else
  1220. begin
  1221. { should now be open }
  1222. W:=TryToOpenFile(nil,s,0,Line,true);
  1223. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1224. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1225. UpdateDebugViews;
  1226. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1227. handled by SelectInDebugSession}
  1228. W^.SelectInDebugSession;
  1229. LastSource:=W;
  1230. InvalidSourceLine:=false;
  1231. end;
  1232. end;
  1233. end;
  1234. LastFileName:=s;
  1235. Desktop^.UnLock;
  1236. if BreakIndex>0 then
  1237. begin
  1238. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1239. if (BreakIndex=FPCBreakErrorNumber) then
  1240. begin
  1241. if (ExitCode<>0) or (ExitAddr<>0) then
  1242. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1243. #3'Error address $'+HexStr(ExitAddr,8),nil)
  1244. else
  1245. WarningBox(#3'Run Time Error',nil);
  1246. end
  1247. else if not assigned(PB) then
  1248. begin
  1249. if (BreakIndex<>start_break_number) and
  1250. (BreakIndex<>TbreakNumber) then
  1251. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1252. if BreakIndex=start_break_number then
  1253. start_break_number:=0;
  1254. if BreakIndex=TbreakNumber then
  1255. TbreakNumber:=0;
  1256. end
  1257. { For watch we should get old and new value !! }
  1258. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1259. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1260. (PB^.typ<>bt_address) then
  1261. begin
  1262. Command('p '+GetStr(PB^.Name));
  1263. S:=GetPChar(GetOutput);
  1264. got_error:=false;
  1265. If Pos('=',S)>0 then
  1266. S:=Copy(S,Pos('=',S)+1,255);
  1267. If S[Length(S)]=#10 then
  1268. Delete(S,Length(S),1);
  1269. if Assigned(PB^.OldValue) then
  1270. DisposeStr(PB^.OldValue);
  1271. PB^.OldValue:=PB^.CurrentValue;
  1272. PB^.CurrentValue:=NewStr(S);
  1273. If PB^.typ=bt_function then
  1274. WarningBox(#3'GDB stopped due to'#13+
  1275. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1276. else if (GetStr(PB^.OldValue)<>S) then
  1277. WarningBox(#3'GDB stopped due to'#13+
  1278. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1279. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1280. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1281. else
  1282. WarningBox(#3'GDB stopped due to'#13+
  1283. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1284. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1285. end;
  1286. end;
  1287. end;
  1288. procedure TDebugController.DoUserSignal;
  1289. var P :Array[1..2] of pstring;
  1290. S1, S2 : string;
  1291. begin
  1292. S1:=strpas(signal_name);
  1293. S2:=strpas(signal_string);
  1294. P[1]:=@S1;
  1295. P[2]:=@S2;
  1296. WarningBox(msg_programsignal,@P);
  1297. end;
  1298. procedure TDebugController.DoEndSession(code:longint);
  1299. var P :Array[1..2] of longint;
  1300. begin
  1301. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1302. IDEApp.UpdateRunMenu(false);
  1303. ResetDebuggerRows;
  1304. LastExitCode:=Code;
  1305. If HiddenStepsCount=0 then
  1306. InformationBox(msg_programexitedwithexitcode,@code)
  1307. else
  1308. begin
  1309. P[1]:=code;
  1310. P[2]:=HiddenStepsCount;
  1311. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1312. end;
  1313. { In case we have something that the compiler touched }
  1314. AskToReloadAllModifiedFiles;
  1315. {$ifdef Windows}
  1316. main_pid_valid:=false;
  1317. {$endif Windows}
  1318. end;
  1319. procedure TDebugController.DoDebuggerScreen;
  1320. {$ifdef Windows}
  1321. var
  1322. IdeMode : DWord;
  1323. {$endif Windows}
  1324. begin
  1325. if NoSwitch then
  1326. begin
  1327. PopStatus;
  1328. end
  1329. else
  1330. begin
  1331. IDEApp.ShowIDEScreen;
  1332. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1333. PopStatus;
  1334. end;
  1335. {$ifdef Windows}
  1336. if NoSwitch then
  1337. begin
  1338. { Ctrl-C as normal char }
  1339. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1340. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1341. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1342. end;
  1343. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1344. {$endif Windows}
  1345. end;
  1346. procedure TDebugController.DoUserScreen;
  1347. {$ifdef Windows}
  1348. var
  1349. IdeMode : DWord;
  1350. {$endif Windows}
  1351. begin
  1352. Inc(RunCount);
  1353. if NoSwitch then
  1354. begin
  1355. {$ifdef SUPPORT_REMOTE}
  1356. if isRemoteDebugging then
  1357. PushStatus(msg_runningremotely+RemoteMachine)
  1358. else
  1359. {$endif SUPPORT_REMOTE}
  1360. {$ifdef Unix}
  1361. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1362. {$else not Unix}
  1363. PushStatus(msg_runninginanotherwindow);
  1364. {$endif Unix}
  1365. end
  1366. else
  1367. begin
  1368. PushStatus(msg_runningprogram);
  1369. IDEApp.ShowUserScreen;
  1370. end;
  1371. {$ifdef Windows}
  1372. if NoSwitch then
  1373. begin
  1374. { Ctrl-C as interrupt }
  1375. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1376. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1377. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1378. end;
  1379. ChangeDebuggeeWindowTitleTo(Running_State);
  1380. {$endif Windows}
  1381. end;
  1382. {$endif NODEBUG}
  1383. {****************************************************************************
  1384. TBreakpoint
  1385. ****************************************************************************}
  1386. function ActiveBreakpoints : boolean;
  1387. var
  1388. IsActive : boolean;
  1389. procedure TestActive(PB : PBreakpoint);
  1390. begin
  1391. If PB^.state=bs_enabled then
  1392. IsActive:=true;
  1393. end;
  1394. begin
  1395. IsActive:=false;
  1396. If assigned(BreakpointsCollection) then
  1397. BreakpointsCollection^.ForEach(@TestActive);
  1398. ActiveBreakpoints:=IsActive;
  1399. end;
  1400. constructor TBreakpoint.Init_function(Const AFunc : String);
  1401. begin
  1402. typ:=bt_function;
  1403. state:=bs_enabled;
  1404. GDBState:=bs_deleted;
  1405. Name:=NewStr(AFunc);
  1406. FileName:=nil;
  1407. Line:=0;
  1408. IgnoreCount:=0;
  1409. Commands:=nil;
  1410. Conditions:=nil;
  1411. OldValue:=nil;
  1412. CurrentValue:=nil;
  1413. end;
  1414. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1415. begin
  1416. typ:=bt_address;
  1417. state:=bs_enabled;
  1418. GDBState:=bs_deleted;
  1419. Name:=NewStr(AAddress);
  1420. FileName:=nil;
  1421. Line:=0;
  1422. IgnoreCount:=0;
  1423. Commands:=nil;
  1424. Conditions:=nil;
  1425. OldValue:=nil;
  1426. CurrentValue:=nil;
  1427. end;
  1428. constructor TBreakpoint.Init_Empty;
  1429. begin
  1430. typ:=bt_function;
  1431. state:=bs_enabled;
  1432. GDBState:=bs_deleted;
  1433. Name:=Nil;
  1434. FileName:=nil;
  1435. Line:=0;
  1436. IgnoreCount:=0;
  1437. Commands:=nil;
  1438. Conditions:=nil;
  1439. OldValue:=nil;
  1440. CurrentValue:=nil;
  1441. end;
  1442. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1443. begin
  1444. typ:=atyp;
  1445. state:=bs_enabled;
  1446. GDBState:=bs_deleted;
  1447. Name:=NewStr(AnExpr);
  1448. IgnoreCount:=0;
  1449. Commands:=nil;
  1450. Conditions:=nil;
  1451. OldValue:=nil;
  1452. CurrentValue:=nil;
  1453. end;
  1454. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1455. var
  1456. CurDir : String;
  1457. begin
  1458. typ:=bt_file_line;
  1459. state:=bs_enabled;
  1460. GDBState:=bs_deleted;
  1461. AFile:=FEXpand(AFile);
  1462. (*
  1463. { d:test.pas:12 does not work !! }
  1464. { I do not know how to solve this if
  1465. if (Length(AFile)>1) and (AFile[2]=':') then
  1466. AFile:=Copy(AFile,3,255); }
  1467. {$ifdef Unix}
  1468. CurDir:=GetCurDir;
  1469. {$else}
  1470. CurDir:=LowerCaseStr(GetCurDir);
  1471. {$endif Unix}
  1472. if Pos(CurDir,OSFileName(AFile))=1 then
  1473. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1474. else
  1475. *)
  1476. FileName:=NewStr(OSFileName(AFile));
  1477. Name:=nil;
  1478. Line:=ALine;
  1479. IgnoreCount:=0;
  1480. Commands:=nil;
  1481. Conditions:=nil;
  1482. OldValue:=nil;
  1483. CurrentValue:=nil;
  1484. end;
  1485. constructor TBreakpoint.Load(var S: TStream);
  1486. var
  1487. FName : PString;
  1488. begin
  1489. S.Read(typ,SizeOf(BreakpointType));
  1490. S.Read(state,SizeOf(BreakpointState));
  1491. GDBState:=bs_deleted;
  1492. case typ of
  1493. bt_file_line :
  1494. begin
  1495. { convert to current target }
  1496. FName:=S.ReadStr;
  1497. FileName:=NewStr(OSFileName(GetStr(FName)));
  1498. If Assigned(FName) then
  1499. DisposeStr(FName);
  1500. S.Read(Line,SizeOf(Line));
  1501. Name:=nil;
  1502. end;
  1503. else
  1504. begin
  1505. Name:=S.ReadStr;
  1506. Line:=0;
  1507. FileName:=nil;
  1508. end;
  1509. end;
  1510. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1511. Commands:=S.StrRead;
  1512. Conditions:=S.ReadStr;
  1513. OldValue:=nil;
  1514. CurrentValue:=nil;
  1515. end;
  1516. procedure TBreakpoint.Store(var S: TStream);
  1517. var
  1518. St : String;
  1519. begin
  1520. S.Write(typ,SizeOf(BreakpointType));
  1521. S.Write(state,SizeOf(BreakpointState));
  1522. case typ of
  1523. bt_file_line :
  1524. begin
  1525. st:=OSFileName(GetStr(FileName));
  1526. S.WriteStr(@St);
  1527. S.Write(Line,SizeOf(Line));
  1528. end;
  1529. else
  1530. begin
  1531. S.WriteStr(Name);
  1532. end;
  1533. end;
  1534. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1535. S.StrWrite(Commands);
  1536. S.WriteStr(Conditions);
  1537. end;
  1538. procedure TBreakpoint.Insert;
  1539. var
  1540. p,p2 : pchar;
  1541. st : string;
  1542. begin
  1543. {$ifndef NODEBUG}
  1544. If not assigned(Debugger) then Exit;
  1545. Remove;
  1546. Debugger^.last_breakpoint_number:=0;
  1547. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1548. begin
  1549. if (typ=bt_file_line) and assigned(FileName) then
  1550. Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
  1551. else if (typ=bt_function) and assigned(name) then
  1552. Debugger^.Command('break '+name^)
  1553. else if (typ=bt_address) and assigned(name) then
  1554. Debugger^.Command('break *0x'+name^)
  1555. else if (typ=bt_watch) and assigned(name) then
  1556. Debugger^.Command('watch '+name^)
  1557. else if (typ=bt_awatch) and assigned(name) then
  1558. Debugger^.Command('awatch '+name^)
  1559. else if (typ=bt_rwatch) and assigned(name) then
  1560. Debugger^.Command('rwatch '+name^);
  1561. if Debugger^.last_breakpoint_number<>0 then
  1562. begin
  1563. GDBIndex:=Debugger^.last_breakpoint_number;
  1564. GDBState:=bs_enabled;
  1565. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1566. If IgnoreCount>0 then
  1567. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1568. If Assigned(Commands) then
  1569. begin
  1570. {Commands are not handled yet }
  1571. Debugger^.Command('command '+IntToStr(GDBIndex));
  1572. p:=commands;
  1573. while assigned(p) do
  1574. begin
  1575. p2:=strscan(p,#10);
  1576. if assigned(p2) then
  1577. p2^:=#0;
  1578. st:=strpas(p);
  1579. Debugger^.command(st);
  1580. if assigned(p2) then
  1581. p2^:=#10;
  1582. p:=p2;
  1583. if assigned(p) then
  1584. inc(p);
  1585. end;
  1586. Debugger^.Command('end');
  1587. end;
  1588. end
  1589. else
  1590. { Here there was a problem !! }
  1591. begin
  1592. GDBIndex:=0;
  1593. if not Debugger^.Disableallinvalidbreakpoints then
  1594. begin
  1595. if (typ=bt_file_line) and assigned(FileName) then
  1596. begin
  1597. ClearFormatParams;
  1598. AddFormatParamStr(NameAndExtOf(FileName^));
  1599. AddFormatParamInt(Line);
  1600. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1601. Debugger^.Disableallinvalidbreakpoints:=true;
  1602. end
  1603. else
  1604. begin
  1605. ClearFormatParams;
  1606. AddFormatParamStr(BreakpointTypeStr[typ]);
  1607. AddFormatParamStr(GetStr(Name));
  1608. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1609. Debugger^.Disableallinvalidbreakpoints:=true;
  1610. end;
  1611. end;
  1612. state:=bs_disabled;
  1613. UpdateSource;
  1614. end;
  1615. end
  1616. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1617. Enable
  1618. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1619. Disable;
  1620. {$endif NODEBUG}
  1621. end;
  1622. procedure TBreakpoint.Remove;
  1623. begin
  1624. {$ifndef NODEBUG}
  1625. If not assigned(Debugger) then Exit;
  1626. if GDBIndex>0 then
  1627. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1628. GDBIndex:=0;
  1629. GDBState:=bs_deleted;
  1630. {$endif NODEBUG}
  1631. end;
  1632. procedure TBreakpoint.Enable;
  1633. begin
  1634. {$ifndef NODEBUG}
  1635. If not assigned(Debugger) then Exit;
  1636. if GDBIndex>0 then
  1637. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1638. else
  1639. Insert;
  1640. GDBState:=bs_disabled;
  1641. {$endif NODEBUG}
  1642. end;
  1643. procedure TBreakpoint.Disable;
  1644. begin
  1645. {$ifndef NODEBUG}
  1646. If not assigned(Debugger) then Exit;
  1647. if GDBIndex>0 then
  1648. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1649. GDBState:=bs_disabled;
  1650. {$endif NODEBUG}
  1651. end;
  1652. procedure TBreakpoint.ResetValues;
  1653. begin
  1654. if assigned(OldValue) then
  1655. DisposeStr(OldValue);
  1656. OldValue:=nil;
  1657. if assigned(CurrentValue) then
  1658. DisposeStr(CurrentValue);
  1659. CurrentValue:=nil;
  1660. end;
  1661. procedure TBreakpoint.UpdateSource;
  1662. var W: PSourceWindow;
  1663. b : boolean;
  1664. begin
  1665. if typ=bt_file_line then
  1666. begin
  1667. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1668. If assigned(W) then
  1669. begin
  1670. if state=bs_enabled then
  1671. b:=true
  1672. else
  1673. b:=false;
  1674. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1675. end;
  1676. end;
  1677. end;
  1678. destructor TBreakpoint.Done;
  1679. begin
  1680. Remove;
  1681. ResetValues;
  1682. if assigned(Name) then
  1683. DisposeStr(Name);
  1684. if assigned(FileName) then
  1685. DisposeStr(FileName);
  1686. if assigned(Conditions) then
  1687. DisposeStr(Conditions);
  1688. if assigned(Commands) then
  1689. StrDispose(Commands);
  1690. inherited Done;
  1691. end;
  1692. {****************************************************************************
  1693. TBreakpointCollection
  1694. ****************************************************************************}
  1695. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1696. begin
  1697. At:=inherited At(Index);
  1698. end;
  1699. procedure TBreakpointCollection.Update;
  1700. begin
  1701. {$ifndef NODEBUG}
  1702. if assigned(Debugger) then
  1703. begin
  1704. Debugger^.RemoveBreakpoints;
  1705. Debugger^.InsertBreakpoints;
  1706. end;
  1707. {$endif NODEBUG}
  1708. if assigned(BreakpointsWindow) then
  1709. BreakpointsWindow^.Update;
  1710. end;
  1711. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1712. function IsNum(P : PBreakpoint) : boolean;
  1713. begin
  1714. IsNum:=P^.GDBIndex=index;
  1715. end;
  1716. begin
  1717. if index=0 then
  1718. GetGDB:=nil
  1719. else
  1720. GetGDB:=FirstThat(@IsNum);
  1721. end;
  1722. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1723. procedure SetInSource(P : PBreakpoint);
  1724. begin
  1725. If assigned(P^.FileName) and
  1726. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1727. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1728. end;
  1729. procedure SetInDisassembly(P : PBreakpoint);
  1730. var
  1731. PDL : PDisasLine;
  1732. S : string;
  1733. ps,qs,i : longint;
  1734. HAddr : PtrInt;
  1735. code : integer;
  1736. begin
  1737. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1738. begin
  1739. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1740. if PDL^.Address=0 then
  1741. begin
  1742. if (P^.typ=bt_file_line) then
  1743. begin
  1744. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1745. ps:=pos(':',S);
  1746. qs:=pos(' ',copy(S,ps+1,High(S)));
  1747. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1748. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1749. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1750. end;
  1751. end
  1752. else
  1753. begin
  1754. if assigned(P^.Name) then
  1755. begin
  1756. Val('$'+P^.Name^,HAddr,code);
  1757. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1758. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1759. end;
  1760. end;
  1761. end;
  1762. end;
  1763. begin
  1764. if W=PFPWindow(DisassemblyWindow) then
  1765. ForEach(@SetInDisassembly)
  1766. else
  1767. ForEach(@SetInSource);
  1768. end;
  1769. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1770. procedure AdaptInSource(P : PBreakpoint);
  1771. begin
  1772. If assigned(P^.FileName) and
  1773. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1774. begin
  1775. if P^.state=bs_enabled then
  1776. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1777. if P^.Line-1>=Pos then
  1778. begin
  1779. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1780. P^.line:=P^.Line+Change
  1781. else
  1782. begin
  1783. { removing inside a ForEach call leads to problems }
  1784. { so we do that after PM }
  1785. P^.state:=bs_delete_after;
  1786. end;
  1787. end;
  1788. if P^.state=bs_enabled then
  1789. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1790. end;
  1791. end;
  1792. var
  1793. I : longint;
  1794. begin
  1795. ForEach(@AdaptInSource);
  1796. I:=Count-1;
  1797. While (I>=0) do
  1798. begin
  1799. if At(I)^.state=bs_delete_after then
  1800. AtFree(I);
  1801. Dec(I);
  1802. end;
  1803. end;
  1804. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1805. function IsAtLine(P : PBreakpoint) : boolean;
  1806. begin
  1807. If assigned(P^.FileName) and
  1808. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1809. (Line=P^.Line) then
  1810. IsAtLine:=true
  1811. else
  1812. IsAtLine:=false;
  1813. end;
  1814. begin
  1815. FindBreakpointAt:=FirstThat(@IsAtLine);
  1816. end;
  1817. procedure TBreakpointCollection.ShowAllBreakpoints;
  1818. procedure SetInSource(P : PBreakpoint);
  1819. var
  1820. W : PSourceWindow;
  1821. begin
  1822. If assigned(P^.FileName) then
  1823. begin
  1824. W:=SearchOnDesktop(P^.FileName^,false);
  1825. if assigned(W) then
  1826. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1827. end;
  1828. end;
  1829. begin
  1830. ForEach(@SetInSource);
  1831. end;
  1832. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1833. function IsThis(P : PBreakpoint) : boolean;
  1834. begin
  1835. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1836. end;
  1837. begin
  1838. GetType:=FirstThat(@IsThis);
  1839. end;
  1840. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1841. function IsThere(P : PBreakpoint) : boolean;
  1842. begin
  1843. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1844. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1845. end;
  1846. var
  1847. PB : PBreakpoint;
  1848. begin
  1849. ToggleFileLine:=false;
  1850. FileName:=OSFileName(FExpand(FileName));
  1851. PB:=FirstThat(@IsThere);
  1852. If Assigned(PB) then
  1853. begin
  1854. { delete it form source window }
  1855. PB^.state:=bs_disabled;
  1856. PB^.UpdateSource;
  1857. { remove from collection }
  1858. BreakpointsCollection^.free(PB);
  1859. end
  1860. else
  1861. begin
  1862. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1863. if assigned(PB) then
  1864. Begin
  1865. Insert(PB);
  1866. PB^.UpdateSource;
  1867. ToggleFileLine:=true;
  1868. End;
  1869. end;
  1870. Update;
  1871. end;
  1872. {****************************************************************************
  1873. TBreakpointItem
  1874. ****************************************************************************}
  1875. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1876. begin
  1877. inherited Init;
  1878. Breakpoint:=ABreakpoint;
  1879. end;
  1880. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1881. var S: string;
  1882. begin
  1883. with Breakpoint^ do
  1884. begin
  1885. S:=BreakpointTypeStr[typ];
  1886. While Length(S)<10 do
  1887. S:=S+' ';
  1888. S:=S+'|';
  1889. S:=S+BreakpointStateStr[state]+' ';
  1890. While Length(S)<20 do
  1891. S:=S+' ';
  1892. S:=S+'|';
  1893. if (typ=bt_file_line) then
  1894. begin
  1895. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
  1896. While Length(S)<40 do
  1897. S:=S+' ';
  1898. S:=S+'|';
  1899. S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
  1900. end
  1901. else
  1902. S:=S+GetStr(name);
  1903. While Length(S)<70 do
  1904. S:=S+' ';
  1905. S:=S+'|';
  1906. if IgnoreCount>0 then
  1907. S:=S+IntToStr(IgnoreCount);
  1908. While Length(S)<79 do
  1909. S:=S+' ';
  1910. S:=S+'|';
  1911. if assigned(Conditions) then
  1912. S:=S+' '+GetStr(Conditions);
  1913. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1914. GetText:=S;
  1915. end;
  1916. end;
  1917. procedure TBreakpointItem.Selected;
  1918. begin
  1919. end;
  1920. function TBreakpointItem.GetModuleName: string;
  1921. begin
  1922. if breakpoint^.typ=bt_file_line then
  1923. GetModuleName:=GetStr(breakpoint^.FileName)
  1924. else
  1925. GetModuleName:='';
  1926. end;
  1927. {****************************************************************************
  1928. TBreakpointsListBox
  1929. ****************************************************************************}
  1930. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1931. begin
  1932. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1933. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1934. NoSelection:=true;
  1935. end;
  1936. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1937. var M: PMenu;
  1938. begin
  1939. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1940. M:=NewMenu(
  1941. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1942. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1943. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1944. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1945. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1946. nil))))));
  1947. GetLocalMenu:=M;
  1948. end;
  1949. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1950. var DontClear: boolean;
  1951. begin
  1952. case Event.What of
  1953. evKeyDown :
  1954. begin
  1955. DontClear:=false;
  1956. case Event.KeyCode of
  1957. kbEnd :
  1958. FocusItem(List^.Count-1);
  1959. kbHome :
  1960. FocusItem(0);
  1961. kbEnter :
  1962. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1963. kbIns :
  1964. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1965. kbDel :
  1966. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1967. else
  1968. DontClear:=true;
  1969. end;
  1970. if not DontClear then
  1971. ClearEvent(Event);
  1972. end;
  1973. evBroadcast :
  1974. case Event.Command of
  1975. cmListItemSelected :
  1976. if Event.InfoPtr=@Self then
  1977. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1978. end;
  1979. evCommand :
  1980. begin
  1981. DontClear:=false;
  1982. case Event.Command of
  1983. cmMsgTrackSource :
  1984. if Range>0 then
  1985. TrackSource;
  1986. cmEditBreakpoint :
  1987. EditCurrent;
  1988. cmToggleBreakpoint :
  1989. ToggleCurrent;
  1990. cmDeleteBreakpoint :
  1991. DeleteCurrent;
  1992. cmNewBreakpoint :
  1993. EditNew;
  1994. cmMsgClear :
  1995. Clear;
  1996. else
  1997. DontClear:=true;
  1998. end;
  1999. if not DontClear then
  2000. ClearEvent(Event);
  2001. end;
  2002. end;
  2003. inherited HandleEvent(Event);
  2004. end;
  2005. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  2006. var W : integer;
  2007. begin
  2008. if List=nil then New(List, Init(20,20));
  2009. W:=length(P^.GetText(255));
  2010. if W>MaxWidth then
  2011. begin
  2012. MaxWidth:=W;
  2013. if HScrollBar<>nil then
  2014. HScrollBar^.SetRange(0,MaxWidth);
  2015. end;
  2016. List^.Insert(P);
  2017. SetRange(List^.Count);
  2018. if Focused=List^.Count-1-1 then
  2019. FocusItem(List^.Count-1);
  2020. P^.Breakpoint^.UpdateSource;
  2021. DrawView;
  2022. end;
  2023. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  2024. var P: PBreakpointItem;
  2025. S: string;
  2026. begin
  2027. P:=List^.At(Item);
  2028. S:=P^.GetText(MaxLen);
  2029. GetText:=copy(S,1,MaxLen);
  2030. end;
  2031. procedure TBreakpointsListBox.Clear;
  2032. begin
  2033. if assigned(List) then
  2034. Dispose(List, Done);
  2035. List:=nil;
  2036. MaxWidth:=0;
  2037. SetRange(0); DrawView;
  2038. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2039. end;
  2040. procedure TBreakpointsListBox.TrackSource;
  2041. var W: PSourceWindow;
  2042. P: PBreakpointItem;
  2043. R: TRect;
  2044. begin
  2045. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2046. if Range=0 then Exit;*)
  2047. P:=List^.At(Focused);
  2048. if P^.GetModuleName='' then Exit;
  2049. Desktop^.Lock;
  2050. GetNextEditorBounds(R);
  2051. R.B.Y:=Owner^.Origin.Y;
  2052. W:=EditorWindowFile(P^.GetModuleName);
  2053. if assigned(W) then
  2054. begin
  2055. W^.GetExtent(R);
  2056. R.B.Y:=Owner^.Origin.Y;
  2057. W^.ChangeBounds(R);
  2058. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  2059. end
  2060. else
  2061. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  2062. if W<>nil then
  2063. begin
  2064. W^.Select;
  2065. W^.Editor^.TrackCursor(do_centre);
  2066. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  2067. end;
  2068. if Assigned(Owner) then
  2069. Owner^.Select;
  2070. Desktop^.UnLock;
  2071. end;
  2072. procedure TBreakpointsListBox.ToggleCurrent;
  2073. var
  2074. P: PBreakpointItem;
  2075. begin
  2076. if Range=0 then Exit;
  2077. P:=List^.At(Focused);
  2078. if P=nil then Exit;
  2079. if P^.Breakpoint^.state=bs_enabled then
  2080. P^.Breakpoint^.state:=bs_disabled
  2081. else if P^.Breakpoint^.state=bs_disabled then
  2082. P^.Breakpoint^.state:=bs_enabled;
  2083. P^.Breakpoint^.UpdateSource;
  2084. BreakpointsCollection^.Update;
  2085. end;
  2086. procedure TBreakpointsListBox.EditCurrent;
  2087. var
  2088. P: PBreakpointItem;
  2089. begin
  2090. if Range=0 then Exit;
  2091. P:=List^.At(Focused);
  2092. if P=nil then Exit;
  2093. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  2094. P^.Breakpoint^.UpdateSource;
  2095. BreakpointsCollection^.Update;
  2096. end;
  2097. procedure TBreakpointsListBox.DeleteCurrent;
  2098. var
  2099. P: PBreakpointItem;
  2100. begin
  2101. if Range=0 then Exit;
  2102. P:=List^.At(Focused);
  2103. if P=nil then Exit;
  2104. { delete it form source window }
  2105. P^.Breakpoint^.state:=bs_disabled;
  2106. P^.Breakpoint^.UpdateSource;
  2107. BreakpointsCollection^.free(P^.Breakpoint);
  2108. List^.free(P);
  2109. BreakpointsCollection^.Update;
  2110. end;
  2111. procedure TBreakpointsListBox.EditNew;
  2112. var
  2113. P: PBreakpoint;
  2114. begin
  2115. P:=New(PBreakpoint,Init_Empty);
  2116. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  2117. begin
  2118. P^.UpdateSource;
  2119. BreakpointsCollection^.Insert(P);
  2120. BreakpointsCollection^.Update;
  2121. end
  2122. else
  2123. dispose(P,Done);
  2124. end;
  2125. procedure TBreakpointsListBox.Draw;
  2126. var
  2127. I, J, Item: Sw_Integer;
  2128. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2129. ColWidth, CurCol, Indent: Integer;
  2130. B: TDrawBuffer;
  2131. Text: String;
  2132. SCOff: Byte;
  2133. TC: byte;
  2134. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2135. begin
  2136. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2137. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2138. begin
  2139. NormalColor := GetColor(1);
  2140. FocusedColor := GetColor(3);
  2141. SelectedColor := GetColor(4);
  2142. end else
  2143. begin
  2144. NormalColor := GetColor(2);
  2145. SelectedColor := GetColor(4);
  2146. end;
  2147. if Transparent then
  2148. begin MT(NormalColor); MT(SelectedColor); end;
  2149. if NoSelection then
  2150. SelectedColor:=NormalColor;
  2151. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2152. else Indent := 0;
  2153. ColWidth := Size.X div NumCols + 1;
  2154. for I := 0 to Size.Y - 1 do
  2155. begin
  2156. for J := 0 to NumCols-1 do
  2157. begin
  2158. Item := J*Size.Y + I + TopItem;
  2159. CurCol := J*ColWidth;
  2160. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2161. (Focused = Item) and (Range > 0) then
  2162. begin
  2163. Color := FocusedColor;
  2164. SetCursor(CurCol+1,I);
  2165. SCOff := 0;
  2166. end
  2167. else if (Item < Range) and IsSelected(Item) then
  2168. begin
  2169. Color := SelectedColor;
  2170. SCOff := 2;
  2171. end
  2172. else
  2173. begin
  2174. Color := NormalColor;
  2175. SCOff := 4;
  2176. end;
  2177. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2178. if Item < Range then
  2179. begin
  2180. Text := GetText(Item, ColWidth + Indent);
  2181. Text := Copy(Text,Indent,ColWidth);
  2182. MoveStr(B[CurCol+1], Text, Color);
  2183. if ShowMarkers then
  2184. begin
  2185. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2186. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2187. end;
  2188. end;
  2189. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2190. end;
  2191. WriteLine(0, I, Size.X, 1, B);
  2192. end;
  2193. end;
  2194. constructor TBreakpointsListBox.Load(var S: TStream);
  2195. begin
  2196. inherited Load(S);
  2197. end;
  2198. procedure TBreakpointsListBox.Store(var S: TStream);
  2199. var OL: PCollection;
  2200. OldR : integer;
  2201. begin
  2202. OL:=List;
  2203. OldR:=Range;
  2204. Range:=0;
  2205. New(List, Init(1,1));
  2206. inherited Store(S);
  2207. Dispose(List, Done);
  2208. Range:=OldR;
  2209. List:=OL;
  2210. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2211. collection? Pasting here a modified version of TListBox.Store+
  2212. TAdvancedListBox.Store isn't a better solution, since by eventually
  2213. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2214. end;
  2215. destructor TBreakpointsListBox.Done;
  2216. begin
  2217. inherited Done;
  2218. if List<>nil then Dispose(List, Done);
  2219. end;
  2220. {****************************************************************************
  2221. TBreakpointsWindow
  2222. ****************************************************************************}
  2223. constructor TBreakpointsWindow.Init;
  2224. var R,R2: TRect;
  2225. HSB,VSB: PScrollBar;
  2226. ST: PStaticText;
  2227. S: String;
  2228. X,X1 : Sw_integer;
  2229. Btn: PButton;
  2230. const
  2231. NumButtons = 5;
  2232. begin
  2233. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2234. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2235. HelpCtx:=hcBreakpointListWindow;
  2236. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2237. S:=label_breakpointpropheader;
  2238. New(ST, Init(R,S));
  2239. ST^.GrowMode:=gfGrowHiX;
  2240. Insert(ST);
  2241. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2242. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2243. ST^.GrowMode:=gfGrowHiX;
  2244. Insert(ST);
  2245. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2246. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2247. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2248. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2249. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2250. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2251. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2252. New(BreakLB, Init(R,HSB,VSB));
  2253. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2254. BreakLB^.Transparent:=true;
  2255. Insert(BreakLB);
  2256. GetExtent(R);R.Grow(-1,-1);
  2257. Dec(R.B.Y);
  2258. R.A.Y:=R.B.Y-2;
  2259. X:=(R.B.X-R.A.X) div NumButtons;
  2260. X1:=R.A.X+(X div 2);
  2261. R.A.X:=X1-3;R.B.X:=X1+7;
  2262. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2263. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2264. Insert(Btn);
  2265. X1:=X1+X;
  2266. R.A.X:=X1-3;R.B.X:=X1+7;
  2267. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2268. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2269. Insert(Btn);
  2270. X1:=X1+X;
  2271. R.A.X:=X1-3;R.B.X:=X1+7;
  2272. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2273. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2274. Insert(Btn);
  2275. X1:=X1+X;
  2276. R.A.X:=X1-3;R.B.X:=X1+7;
  2277. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2278. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2279. Insert(Btn);
  2280. X1:=X1+X;
  2281. R.A.X:=X1-3;R.B.X:=X1+7;
  2282. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2283. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2284. Insert(Btn);
  2285. BreakLB^.Select;
  2286. Update;
  2287. BreakpointsWindow:=@self;
  2288. end;
  2289. constructor TBreakpointsWindow.Load(var S: TStream);
  2290. begin
  2291. inherited Load(S);
  2292. GetSubViewPtr(S,BreakLB);
  2293. end;
  2294. procedure TBreakpointsWindow.Store(var S: TStream);
  2295. begin
  2296. inherited Store(S);
  2297. PutSubViewPtr(S,BreakLB);
  2298. end;
  2299. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2300. begin
  2301. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2302. end;
  2303. procedure TBreakpointsWindow.ClearBreakpoints;
  2304. begin
  2305. BreakLB^.Clear;
  2306. ReDraw;
  2307. end;
  2308. procedure TBreakpointsWindow.ReloadBreakpoints;
  2309. procedure InsertInBreakLB(P : PBreakpoint);
  2310. begin
  2311. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2312. end;
  2313. begin
  2314. If not assigned(BreakpointsCollection) then
  2315. exit;
  2316. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2317. ReDraw;
  2318. end;
  2319. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2320. begin
  2321. inherited SizeLimits(Min,Max);
  2322. Min.X:=40; Min.Y:=18;
  2323. end;
  2324. procedure TBreakpointsWindow.Close;
  2325. begin
  2326. Hide;
  2327. end;
  2328. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2329. var DontClear : boolean;
  2330. begin
  2331. case Event.What of
  2332. evKeyDown :
  2333. begin
  2334. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2335. begin
  2336. ClearEvent(Event);
  2337. Hide;
  2338. end;
  2339. end;
  2340. evCommand :
  2341. begin
  2342. DontClear:=False;
  2343. case Event.Command of
  2344. cmNewBreakpoint :
  2345. BreakLB^.EditNew;
  2346. cmEditBreakpoint :
  2347. BreakLB^.EditCurrent;
  2348. cmDeleteBreakpoint :
  2349. BreakLB^.DeleteCurrent;
  2350. cmToggleBreakInList :
  2351. BreakLB^.ToggleCurrent;
  2352. cmClose :
  2353. Hide;
  2354. else
  2355. DontClear:=true;
  2356. end;
  2357. if not DontClear then
  2358. ClearEvent(Event);
  2359. end;
  2360. evBroadcast :
  2361. case Event.Command of
  2362. cmUpdate :
  2363. Update;
  2364. end;
  2365. end;
  2366. inherited HandleEvent(Event);
  2367. end;
  2368. procedure TBreakpointsWindow.Update;
  2369. var
  2370. StoreFocus : longint;
  2371. begin
  2372. StoreFocus:=BreakLB^.Focused;
  2373. ClearBreakpoints;
  2374. ReloadBreakpoints;
  2375. If StoreFocus<BreakLB^.Range then
  2376. BreakLB^.FocusItem(StoreFocus);
  2377. end;
  2378. destructor TBreakpointsWindow.Done;
  2379. begin
  2380. inherited Done;
  2381. BreakpointsWindow:=nil;
  2382. end;
  2383. {****************************************************************************
  2384. TBreakpointItemDialog
  2385. ****************************************************************************}
  2386. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2387. var R,R2,R3: TRect;
  2388. Items: PSItem;
  2389. I : BreakpointType;
  2390. KeyCount: sw_integer;
  2391. begin
  2392. KeyCount:=longint(high(BreakpointType));
  2393. R.Assign(0,0,60,Max(9+KeyCount,18));
  2394. inherited Init(R,dialog_modifynewbreakpoint);
  2395. Breakpoint:=ABreakpoint;
  2396. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2397. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2398. New(NameIL, Init(R, 255)); Insert(NameIL);
  2399. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2400. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2401. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2402. R2.Copy(R); R2.Move(-1,-1);
  2403. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2404. R.Move(0,3);
  2405. R.B.X:=R.B.X-3;
  2406. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2407. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2408. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2409. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2410. R.Move(0,3); R.B.X:=R.A.X+36;
  2411. New(LineIL, Init(R, 128)); Insert(LineIL);
  2412. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2413. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2414. R.Move(0,3);
  2415. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2416. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2417. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2418. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2419. Items:=nil;
  2420. { don't use invalid type }
  2421. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2422. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2423. New(TypeRB, Init(R, Items));
  2424. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2425. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2426. Insert(TypeRB);
  2427. InsertButtons(@Self);
  2428. NameIL^.Select;
  2429. end;
  2430. function TBreakpointItemDialog.Execute: Word;
  2431. var R: sw_word;
  2432. S1: string;
  2433. err: word;
  2434. L: longint;
  2435. begin
  2436. R:=sw_word(Breakpoint^.typ);
  2437. TypeRB^.SetData(R);
  2438. If Breakpoint^.typ=bt_file_line then
  2439. S1:=GetStr(Breakpoint^.FileName)
  2440. else
  2441. S1:=GetStr(Breakpoint^.name);
  2442. NameIL^.SetData(S1);
  2443. If Breakpoint^.typ=bt_file_line then
  2444. S1:=IntToStr(Breakpoint^.Line)
  2445. else
  2446. S1:='0';
  2447. LineIL^.SetData(S1);
  2448. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2449. IgnoreIL^.SetData(S1);
  2450. S1:=GetStr(Breakpoint^.Conditions);
  2451. ConditionsIL^.SetData(S1);
  2452. if assigned(FirstEditorWindow) then
  2453. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2454. R:=inherited Execute;
  2455. FindReplaceEditor:=nil;
  2456. if R=cmOK then
  2457. begin
  2458. TypeRB^.GetData(R);
  2459. L:=R;
  2460. Breakpoint^.typ:=BreakpointType(L);
  2461. NameIL^.GetData(S1);
  2462. If Breakpoint^.typ=bt_file_line then
  2463. begin
  2464. If assigned(Breakpoint^.FileName) then
  2465. DisposeStr(Breakpoint^.FileName);
  2466. Breakpoint^.FileName:=NewStr(S1);
  2467. end
  2468. else
  2469. begin
  2470. If assigned(Breakpoint^.Name) then
  2471. DisposeStr(Breakpoint^.Name);
  2472. Breakpoint^.name:=NewStr(S1);
  2473. end;
  2474. If Breakpoint^.typ=bt_file_line then
  2475. begin
  2476. LineIL^.GetData(S1);
  2477. Val(S1,L,err);
  2478. Breakpoint^.Line:=L;
  2479. end;
  2480. IgnoreIL^.GetData(S1);
  2481. Val(S1,L,err);
  2482. Breakpoint^.IgnoreCount:=L;
  2483. ConditionsIL^.GetData(S1);
  2484. If assigned(Breakpoint^.Conditions) then
  2485. DisposeStr(Breakpoint^.Conditions);
  2486. Breakpoint^.Conditions:=NewStr(S1);
  2487. end;
  2488. Execute:=R;
  2489. end;
  2490. {****************************************************************************
  2491. TWatch
  2492. ****************************************************************************}
  2493. constructor TWatch.Init(s : string);
  2494. begin
  2495. expr:=NewStr(s);
  2496. last_value:=nil;
  2497. current_value:=nil;
  2498. Get_new_value;
  2499. GDBRunCount:=-1;
  2500. end;
  2501. constructor TWatch.Load(var S: TStream);
  2502. begin
  2503. expr:=S.ReadStr;
  2504. last_value:=nil;
  2505. current_value:=nil;
  2506. Get_new_value;
  2507. GDBRunCount:=-1;
  2508. end;
  2509. procedure TWatch.Store(var S: TStream);
  2510. begin
  2511. S.WriteStr(expr);
  2512. end;
  2513. procedure TWatch.rename(s : string);
  2514. begin
  2515. if assigned(expr) then
  2516. begin
  2517. if GetStr(expr)=S then
  2518. exit;
  2519. DisposeStr(expr);
  2520. end;
  2521. expr:=NewStr(s);
  2522. if assigned(last_value) then
  2523. StrDispose(last_value);
  2524. last_value:=nil;
  2525. if assigned(current_value) then
  2526. StrDispose(current_value);
  2527. current_value:=nil;
  2528. GDBRunCount:=-1;
  2529. Get_new_value;
  2530. end;
  2531. procedure TWatch.Get_new_value;
  2532. {$ifndef NODEBUG}
  2533. var p, q : pchar;
  2534. i, j, curframe, startframe : longint;
  2535. s,s2 : string;
  2536. loop_higher, found : boolean;
  2537. last_removed : char;
  2538. function GetValue(var s : string) : boolean;
  2539. begin
  2540. Debugger^.command('p '+s);
  2541. if not Debugger^.Error then
  2542. begin
  2543. s:=StrPas(Debugger^.GetOutput);
  2544. GetValue:=true;
  2545. end
  2546. else
  2547. begin
  2548. s:=StrPas(Debugger^.GetError);
  2549. GetValue:=false;
  2550. { do not open a messagebox for such errors }
  2551. Debugger^.got_error:=false;
  2552. end;
  2553. end;
  2554. begin
  2555. If not assigned(Debugger) or Not Debugger^.HasExe or
  2556. (GDBRunCount=Debugger^.RunCount) then
  2557. exit;
  2558. GDBRunCount:=Debugger^.RunCount;
  2559. if assigned(last_value) then
  2560. strdispose(last_value);
  2561. last_value:=current_value;
  2562. s:=GetStr(expr);
  2563. { Fix 2d array indexing, change [x,x] to [x][x] }
  2564. i:=pos('[',s);
  2565. if i>0 then
  2566. begin
  2567. while i<length(s) do
  2568. begin
  2569. if s[i]=',' then
  2570. begin
  2571. s[i]:='[';
  2572. insert(']',s,i);
  2573. inc(i);
  2574. end;
  2575. inc(i);
  2576. end;
  2577. end;
  2578. found:=GetValue(s);
  2579. Debugger^.got_error:=false;
  2580. loop_higher:=not found;
  2581. if not found then
  2582. begin
  2583. curframe:=Debugger^.get_current_frame;
  2584. startframe:=curframe;
  2585. end
  2586. else
  2587. begin
  2588. curframe:=0;
  2589. startframe:=0;
  2590. end;
  2591. while loop_higher do
  2592. begin
  2593. s:='parentfp';
  2594. if GetValue(s) then
  2595. begin
  2596. repeat
  2597. inc(curframe);
  2598. if not Debugger^.set_current_frame(curframe) then
  2599. loop_higher:=false;
  2600. {$ifdef FrameNameKnown}
  2601. s2:='/x '+FrameName;
  2602. {$else not FrameNameKnown}
  2603. s2:='/x $ebp';
  2604. {$endif FrameNameKnown}
  2605. getValue(s2);
  2606. j:=pos('=',s2);
  2607. if j>0 then
  2608. s2:=copy(s2,j+1,length(s2));
  2609. while s2[1] in [' ',TAB] do
  2610. delete(s2,1,1);
  2611. if pos(s2,s)>0 then
  2612. loop_higher :=false;
  2613. until not loop_higher;
  2614. { try again at that level }
  2615. s:=GetStr(expr);
  2616. found:=GetValue(s);
  2617. loop_higher:=not found;
  2618. end
  2619. else
  2620. loop_higher:=false;
  2621. end;
  2622. if found then
  2623. p:=StrNew(Debugger^.GetOutput)
  2624. else
  2625. begin
  2626. { get a reasonable output at least }
  2627. s:=GetStr(expr);
  2628. GetValue(s);
  2629. p:=StrNew(Debugger^.GetError);
  2630. end;
  2631. Debugger^.got_error:=false;
  2632. { We should try here to find the expr in parent
  2633. procedure if there are
  2634. I will implement this as I added a
  2635. parent_ebp pseudo local var to local procedure
  2636. in stabs debug info PM }
  2637. { But there are some pitfalls like
  2638. locals redefined in other sublocals that call the function }
  2639. if curframe<>startframe then
  2640. Debugger^.set_current_frame(startframe);
  2641. q:=nil;
  2642. if assigned(p) and (p[0]='$') then
  2643. q:=StrPos(p,'=');
  2644. if not assigned(q) then
  2645. q:=p;
  2646. if assigned(q) then
  2647. i:=strlen(q)
  2648. else
  2649. i:=0;
  2650. if (i>0) and (q[i-1]=#10) then
  2651. begin
  2652. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2653. dec(i);
  2654. last_removed:=q[i-1];
  2655. q[i-1]:=#0;
  2656. end
  2657. else
  2658. last_removed:=#0;
  2659. if assigned(q) then
  2660. current_value:=strnew(q)
  2661. else
  2662. current_value:=strnew('');
  2663. if last_removed<>#0 then
  2664. q[i-1]:=last_removed;
  2665. strdispose(p);
  2666. GDBRunCount:=Debugger^.RunCount;
  2667. end;
  2668. {$else NODEBUG}
  2669. begin
  2670. end;
  2671. {$endif NODEBUG}
  2672. procedure TWatch.Force_new_value;
  2673. begin
  2674. GDBRunCount:=-1;
  2675. Get_new_value;
  2676. end;
  2677. destructor TWatch.Done;
  2678. begin
  2679. if assigned(expr) then
  2680. disposestr(expr);
  2681. if assigned(last_value) then
  2682. strdispose(last_value);
  2683. if assigned(current_value) then
  2684. strdispose(current_value);
  2685. inherited done;
  2686. end;
  2687. {****************************************************************************
  2688. TWatchesCollection
  2689. ****************************************************************************}
  2690. constructor TWatchesCollection.Init;
  2691. begin
  2692. inherited Init(10,10);
  2693. end;
  2694. procedure TWatchesCollection.Insert(Item: Pointer);
  2695. begin
  2696. PWatch(Item)^.Get_new_value;
  2697. Inherited Insert(Item);
  2698. Update;
  2699. end;
  2700. procedure TWatchesCollection.Update;
  2701. var
  2702. W,W1 : integer;
  2703. procedure GetMax(P : PWatch);
  2704. begin
  2705. if assigned(P^.Current_value) then
  2706. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2707. else
  2708. W1:=2+Length(GetStr(P^.expr));
  2709. if W1>W then
  2710. W:=W1;
  2711. end;
  2712. begin
  2713. W:=0;
  2714. ForEach(@GetMax);
  2715. MaxW:=W;
  2716. If assigned(WatchesWindow) then
  2717. WatchesWindow^.WLB^.Update(MaxW);
  2718. end;
  2719. function TWatchesCollection.At(Index: Integer): PWatch;
  2720. begin
  2721. At:=Inherited At(Index);
  2722. end;
  2723. {****************************************************************************
  2724. TWatchesListBox
  2725. ****************************************************************************}
  2726. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2727. begin
  2728. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2729. If assigned(List) then
  2730. dispose(list,done);
  2731. List:=WatchesCollection;
  2732. end;
  2733. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2734. var R : TRect;
  2735. begin
  2736. GetExtent(R);
  2737. MaxWidth:=AMaxWidth;
  2738. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2739. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2740. else
  2741. HScrollBar^.SetRange(0,0);
  2742. if R.B.X-R.A.X>MaxWidth then
  2743. HScrollBar^.Hide
  2744. else
  2745. HScrollBar^.Show;
  2746. SetRange(List^.Count+1);
  2747. if R.B.Y-R.A.Y>Range then
  2748. VScrollBar^.Hide
  2749. else
  2750. VScrollBar^.Show;
  2751. {if Focused=List^.Count-1-1 then
  2752. FocusItem(List^.Count-1);
  2753. What was that for ?? PM }
  2754. DrawView;
  2755. end;
  2756. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2757. var
  2758. PW : PWatch;
  2759. ValOffset : Sw_integer;
  2760. S : String;
  2761. begin
  2762. Modified:=false;
  2763. if Item>=WatchesCollection^.Count then
  2764. begin
  2765. GetIndentedText:='';
  2766. exit;
  2767. end;
  2768. PW:=WatchesCollection^.At(Item);
  2769. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2770. if not assigned(PW^.expr) then
  2771. GetIndentedText:=''
  2772. else if Indent<ValOffset then
  2773. begin
  2774. S:=GetStr(PW^.Expr);
  2775. if Indent=0 then
  2776. S:=' '+S
  2777. else
  2778. S:=Copy(S,Indent,High(S));
  2779. if not assigned(PW^.current_value) then
  2780. S:=S+' <Unknown value>'
  2781. else
  2782. S:=S+' '+GetPChar(PW^.Current_value);
  2783. GetIndentedText:=Copy(S,1,MaxLen);
  2784. end
  2785. else
  2786. begin
  2787. if not assigned(PW^.Current_value) or
  2788. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2789. S:=''
  2790. else
  2791. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2792. GetIndentedText:=Copy(S,1,MaxLen);
  2793. end;
  2794. if assigned(PW^.current_value) and
  2795. assigned(PW^.last_value) and
  2796. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2797. Modified:=true;
  2798. end;
  2799. procedure TWatchesListBox.EditCurrent;
  2800. var
  2801. P: PWatch;
  2802. begin
  2803. if Range=0 then Exit;
  2804. if Focused<WatchesCollection^.Count then
  2805. P:=WatchesCollection^.At(Focused)
  2806. else
  2807. P:=New(PWatch,Init(''));
  2808. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2809. WatchesCollection^.Update;
  2810. end;
  2811. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2812. var
  2813. Dummy_Modified : boolean;
  2814. begin
  2815. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2816. end;
  2817. procedure TWatchesListBox.DeleteCurrent;
  2818. var
  2819. P: PWatch;
  2820. begin
  2821. if (Range=0) or
  2822. (Focused>=WatchesCollection^.Count) then
  2823. exit;
  2824. P:=WatchesCollection^.At(Focused);
  2825. WatchesCollection^.free(P);
  2826. WatchesCollection^.Update;
  2827. end;
  2828. procedure TWatchesListBox.EditNew;
  2829. var
  2830. P: PWatch;
  2831. S : string;
  2832. begin
  2833. if Focused<WatchesCollection^.Count then
  2834. begin
  2835. P:=WatchesCollection^.At(Focused);
  2836. S:=GetStr(P^.expr);
  2837. end
  2838. else
  2839. S:='';
  2840. P:=New(PWatch,Init(S));
  2841. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2842. begin
  2843. WatchesCollection^.AtInsert(Focused,P);
  2844. WatchesCollection^.Update;
  2845. end
  2846. else
  2847. dispose(P,Done);
  2848. end;
  2849. procedure TWatchesListBox.Draw;
  2850. var
  2851. I, J, Item: Sw_Integer;
  2852. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2853. ColWidth, CurCol, Indent: Integer;
  2854. B: TDrawBuffer;
  2855. Modified : boolean;
  2856. Text: String;
  2857. SCOff: Byte;
  2858. TC: byte;
  2859. procedure MT(var C: word);
  2860. begin
  2861. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2862. end;
  2863. begin
  2864. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2865. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2866. begin
  2867. NormalColor := GetColor(1);
  2868. FocusedColor := GetColor(3);
  2869. SelectedColor := GetColor(4);
  2870. end else
  2871. begin
  2872. NormalColor := GetColor(2);
  2873. SelectedColor := GetColor(4);
  2874. end;
  2875. if Transparent then
  2876. begin MT(NormalColor); MT(SelectedColor); end;
  2877. (* if NoSelection then
  2878. SelectedColor:=NormalColor;*)
  2879. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2880. else Indent := 0;
  2881. ColWidth := Size.X div NumCols + 1;
  2882. for I := 0 to Size.Y - 1 do
  2883. begin
  2884. for J := 0 to NumCols-1 do
  2885. begin
  2886. Item := J*Size.Y + I + TopItem;
  2887. CurCol := J*ColWidth;
  2888. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2889. (Focused = Item) and (Range > 0) then
  2890. begin
  2891. Color := FocusedColor;
  2892. SetCursor(CurCol+1,I);
  2893. SCOff := 0;
  2894. end
  2895. else if (Item < Range) and IsSelected(Item) then
  2896. begin
  2897. Color := SelectedColor;
  2898. SCOff := 2;
  2899. end
  2900. else
  2901. begin
  2902. Color := NormalColor;
  2903. SCOff := 4;
  2904. end;
  2905. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2906. if Item < Range then
  2907. begin
  2908. (* Text := GetText(Item, ColWidth + Indent);
  2909. Text := Copy(Text,Indent,ColWidth); *)
  2910. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2911. if modified then
  2912. begin
  2913. SCOff:=0;
  2914. Color:=(Color and $fff0) or Red;
  2915. end;
  2916. MoveStr(B[CurCol], Text, Color);
  2917. if {ShowMarkers or } Modified then
  2918. begin
  2919. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2920. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2921. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2922. end;
  2923. end;
  2924. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2925. end;
  2926. WriteLine(0, I, Size.X, 1, B);
  2927. end;
  2928. end;
  2929. function TWatchesListBox.GetLocalMenu: PMenu;
  2930. var M: PMenu;
  2931. begin
  2932. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2933. M:=NewMenu(
  2934. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2935. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2936. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2937. NewLine(
  2938. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2939. nil))))));
  2940. GetLocalMenu:=M;
  2941. end;
  2942. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2943. var DontClear: boolean;
  2944. begin
  2945. case Event.What of
  2946. evKeyDown :
  2947. begin
  2948. DontClear:=false;
  2949. case Event.KeyCode of
  2950. kbEnter :
  2951. Message(@Self,evCommand,cmEdit,nil);
  2952. kbIns :
  2953. Message(@Self,evCommand,cmNew,nil);
  2954. kbDel :
  2955. Message(@Self,evCommand,cmDelete,nil);
  2956. else
  2957. DontClear:=true;
  2958. end;
  2959. if not DontClear then
  2960. ClearEvent(Event);
  2961. end;
  2962. evBroadcast :
  2963. case Event.Command of
  2964. cmListItemSelected :
  2965. if Event.InfoPtr=@Self then
  2966. Message(@Self,evCommand,cmEdit,nil);
  2967. end;
  2968. evCommand :
  2969. begin
  2970. DontClear:=false;
  2971. case Event.Command of
  2972. cmEdit :
  2973. EditCurrent;
  2974. cmDelete :
  2975. DeleteCurrent;
  2976. cmNew :
  2977. EditNew;
  2978. else
  2979. DontClear:=true;
  2980. end;
  2981. if not DontClear then
  2982. ClearEvent(Event);
  2983. end;
  2984. end;
  2985. inherited HandleEvent(Event);
  2986. end;
  2987. constructor TWatchesListBox.Load(var S: TStream);
  2988. begin
  2989. inherited Load(S);
  2990. If assigned(List) then
  2991. dispose(list,done);
  2992. List:=WatchesCollection;
  2993. { we must set Range PM }
  2994. SetRange(List^.count+1);
  2995. end;
  2996. procedure TWatchesListBox.Store(var S: TStream);
  2997. var OL: PCollection;
  2998. OldRange : Sw_integer;
  2999. begin
  3000. OL:=List;
  3001. OldRange:=Range;
  3002. Range:=0;
  3003. New(List, Init(1,1));
  3004. inherited Store(S);
  3005. Dispose(List, Done);
  3006. List:=OL;
  3007. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  3008. collection? Pasting here a modified version of TListBox.Store+
  3009. TAdvancedListBox.Store isn't a better solution, since by eventually
  3010. changing the obj-hierarchy you'll always have to modify this, too - BG }
  3011. SetRange(OldRange);
  3012. end;
  3013. destructor TWatchesListBox.Done;
  3014. begin
  3015. List:=nil;
  3016. inherited Done;
  3017. end;
  3018. {****************************************************************************
  3019. TWatchesWindow
  3020. ****************************************************************************}
  3021. Constructor TWatchesWindow.Init;
  3022. var
  3023. HSB,VSB: PScrollBar;
  3024. R,R2 : trect;
  3025. begin
  3026. Desktop^.GetExtent(R);
  3027. R.A.Y:=R.B.Y-7;
  3028. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  3029. Palette:=wpCyanWindow;
  3030. GetExtent(R);
  3031. HelpCtx:=hcWatchesWindow;
  3032. R.Grow(-1,-1);
  3033. R2.Copy(R);
  3034. Inc(R2.B.Y);
  3035. R2.A.Y:=R2.B.Y-1;
  3036. New(HSB, Init(R2));
  3037. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3038. HSB^.SetStep(R.B.X-R.A.X,1);
  3039. Insert(HSB);
  3040. R2.Copy(R);
  3041. Inc(R2.B.X);
  3042. R2.A.X:=R2.B.X-1;
  3043. New(VSB, Init(R2));
  3044. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3045. Insert(VSB);
  3046. New(WLB,Init(R,HSB,VSB));
  3047. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3048. WLB^.Transparent:=true;
  3049. Insert(WLB);
  3050. If assigned(WatchesWindow) then
  3051. dispose(WatchesWindow,done);
  3052. WatchesWindow:=@Self;
  3053. Update;
  3054. end;
  3055. procedure TWatchesWindow.Update;
  3056. begin
  3057. WatchesCollection^.Update;
  3058. Draw;
  3059. end;
  3060. constructor TWatchesWindow.Load(var S: TStream);
  3061. begin
  3062. inherited Load(S);
  3063. GetSubViewPtr(S,WLB);
  3064. If assigned(WatchesWindow) then
  3065. dispose(WatchesWindow,done);
  3066. WatchesWindow:=@Self;
  3067. end;
  3068. procedure TWatchesWindow.Store(var S: TStream);
  3069. begin
  3070. inherited Store(S);
  3071. PutSubViewPtr(S,WLB);
  3072. end;
  3073. Destructor TWatchesWindow.Done;
  3074. begin
  3075. WatchesWindow:=nil;
  3076. Dispose(WLB,done);
  3077. inherited done;
  3078. end;
  3079. {****************************************************************************
  3080. TWatchItemDialog
  3081. ****************************************************************************}
  3082. constructor TWatchItemDialog.Init(AWatch: PWatch);
  3083. var R,R2: TRect;
  3084. begin
  3085. R.Assign(0,0,50,10);
  3086. inherited Init(R,'Edit Watch');
  3087. Watch:=AWatch;
  3088. GetExtent(R); R.Grow(-3,-2);
  3089. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  3090. New(NameIL, Init(R, 255)); Insert(NameIL);
  3091. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  3092. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  3093. R2.Copy(R); R2.Move(-1,-1);
  3094. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  3095. GetExtent(R);
  3096. R.Grow(-3,-1);
  3097. R.A.Y:=R.A.Y+3;
  3098. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  3099. Insert(TextST);
  3100. InsertButtons(@Self);
  3101. NameIL^.Select;
  3102. end;
  3103. function TWatchItemDialog.Execute: Word;
  3104. var R: word;
  3105. S1,S2: string;
  3106. begin
  3107. S1:=GetStr(Watch^.expr);
  3108. NameIL^.SetData(S1);
  3109. S1:=GetPChar(Watch^.Current_value);
  3110. S2:=GetPChar(Watch^.Last_value);
  3111. ClearFormatParams;
  3112. AddFormatParamStr(S1);
  3113. AddFormatParamStr(S2);
  3114. if assigned(Watch^.Last_value) and
  3115. assigned(Watch^.Current_value) and
  3116. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  3117. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  3118. else
  3119. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  3120. TextST^.SetText(S1);
  3121. if assigned(FirstEditorWindow) then
  3122. FindReplaceEditor:=FirstEditorWindow^.Editor;
  3123. R:=inherited Execute;
  3124. FindReplaceEditor:=nil;
  3125. if R=cmOK then
  3126. begin
  3127. NameIL^.GetData(S1);
  3128. Watch^.Rename(S1);
  3129. {$ifndef NODEBUG}
  3130. If assigned(Debugger) then
  3131. Debugger^.ReadWatches;
  3132. {$endif NODEBUG}
  3133. end;
  3134. Execute:=R;
  3135. end;
  3136. {****************************************************************************
  3137. TStackWindow
  3138. ****************************************************************************}
  3139. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3140. begin
  3141. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3142. end;
  3143. procedure TFramesListBox.Update;
  3144. var i : longint;
  3145. W : PSourceWindow;
  3146. begin
  3147. {$ifndef NODEBUG}
  3148. { call backtrace command }
  3149. If not assigned(Debugger) then
  3150. exit;
  3151. DeskTop^.Lock;
  3152. Clear;
  3153. { forget all old frames }
  3154. Debugger^.clear_frames;
  3155. if Debugger^.WindowWidth<>-1 then
  3156. Debugger^.Command('set width 0xffffffff');
  3157. Debugger^.Command('backtrace');
  3158. { generate list }
  3159. { all is in tframeentry }
  3160. for i:=0 to Debugger^.frame_count-1 do
  3161. begin
  3162. with Debugger^.frames[i]^ do
  3163. begin
  3164. if assigned(file_name) then
  3165. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3166. AddModuleName(GetPChar(file_name)),line_number,1)))
  3167. else
  3168. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3169. AddModuleName(''),line_number,1)));
  3170. W:=SearchOnDesktop(GetPChar(file_name),false);
  3171. { First reset all Debugger rows }
  3172. If assigned(W) then
  3173. begin
  3174. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3175. W^.Editor^.DebuggerRow:=-1;
  3176. end;
  3177. end;
  3178. end;
  3179. { Now set all Debugger rows }
  3180. for i:=0 to Debugger^.frame_count-1 do
  3181. begin
  3182. with Debugger^.frames[i]^ do
  3183. begin
  3184. W:=SearchOnDesktop(GetPChar(file_name),false);
  3185. If assigned(W) then
  3186. begin
  3187. If W^.Editor^.DebuggerRow=-1 then
  3188. begin
  3189. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3190. W^.Editor^.DebuggerRow:=line_number-1;
  3191. end;
  3192. end;
  3193. end;
  3194. end;
  3195. if Assigned(list) and (List^.Count > 0) then
  3196. FocusItem(0);
  3197. if Debugger^.WindowWidth<>-1 then
  3198. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3199. DeskTop^.Unlock;
  3200. {$endif NODEBUG}
  3201. end;
  3202. function TFramesListBox.GetLocalMenu: PMenu;
  3203. begin
  3204. GetLocalMenu:=Inherited GetLocalMenu;
  3205. end;
  3206. procedure TFramesListBox.GotoSource;
  3207. begin
  3208. {$ifndef NODEBUG}
  3209. { select frame for watches }
  3210. If not assigned(Debugger) then
  3211. exit;
  3212. Debugger^.Command('f '+IntToStr(Focused));
  3213. { for local vars }
  3214. Debugger^.RereadWatches;
  3215. {$endif NODEBUG}
  3216. { goto source }
  3217. inherited GotoSource;
  3218. end;
  3219. procedure TFramesListBox.GotoAssembly;
  3220. begin
  3221. {$ifndef NODEBUG}
  3222. { select frame for watches }
  3223. If not assigned(Debugger) then
  3224. exit;
  3225. Debugger^.Command('f '+IntToStr(Focused));
  3226. { for local vars }
  3227. Debugger^.RereadWatches;
  3228. {$endif}
  3229. { goto source/assembly mixture }
  3230. InitDisassemblyWindow;
  3231. DisassemblyWindow^.LoadFunction('');
  3232. {$ifndef NODEBUG}
  3233. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3234. DisassemblyWindow^.SelectInDebugSession;
  3235. {$endif NODEBUG}
  3236. end;
  3237. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3238. begin
  3239. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3240. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3241. GotoAssembly;
  3242. inherited HandleEvent(Event);
  3243. end;
  3244. destructor TFramesListBox.Done;
  3245. begin
  3246. Inherited Done;
  3247. end;
  3248. Constructor TStackWindow.Init;
  3249. var
  3250. HSB,VSB: PScrollBar;
  3251. R,R2 : trect;
  3252. begin
  3253. Desktop^.GetExtent(R);
  3254. R.A.Y:=R.B.Y-5;
  3255. inherited Init(R, dialog_callstack, wnNoNumber);
  3256. Palette:=wpCyanWindow;
  3257. GetExtent(R);
  3258. HelpCtx:=hcStackWindow;
  3259. R.Grow(-1,-1);
  3260. R2.Copy(R);
  3261. Inc(R2.B.Y);
  3262. R2.A.Y:=R2.B.Y-1;
  3263. New(HSB, Init(R2));
  3264. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3265. Insert(HSB);
  3266. R2.Copy(R);
  3267. Inc(R2.B.X);
  3268. R2.A.X:=R2.B.X-1;
  3269. New(VSB, Init(R2));
  3270. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3271. Insert(VSB);
  3272. New(FLB,Init(R,HSB,VSB));
  3273. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3274. Insert(FLB);
  3275. If assigned(StackWindow) then
  3276. dispose(StackWindow,done);
  3277. StackWindow:=@Self;
  3278. Update;
  3279. end;
  3280. procedure TStackWindow.Update;
  3281. begin
  3282. FLB^.Update;
  3283. DrawView;
  3284. end;
  3285. constructor TStackWindow.Load(var S: TStream);
  3286. begin
  3287. inherited Load(S);
  3288. GetSubViewPtr(S,FLB);
  3289. If assigned(StackWindow) then
  3290. dispose(StackWindow,done);
  3291. StackWindow:=@Self;
  3292. end;
  3293. procedure TStackWindow.Store(var S: TStream);
  3294. begin
  3295. inherited Store(S);
  3296. PutSubViewPtr(S,FLB);
  3297. end;
  3298. Destructor TStackWindow.Done;
  3299. begin
  3300. StackWindow:=nil;
  3301. Dispose(FLB,done);
  3302. inherited done;
  3303. end;
  3304. {****************************************************************************
  3305. Init/Final
  3306. ****************************************************************************}
  3307. function GetGDBTargetShortName : string;
  3308. begin
  3309. {$ifndef CROSSGDB}
  3310. GetGDBTargetShortName:=source_info.shortname;
  3311. {$else CROSSGDB}
  3312. {$ifdef SUPPORT_REMOTE}
  3313. {$ifdef PALMOSGDB}
  3314. GetGDBTargetShortName:='palmos';
  3315. {$else}
  3316. GetGDBTargetShortName:='linux';
  3317. {$endif PALMOSGDB}
  3318. {$endif not SUPPORT_REMOTE}
  3319. {$endif CROSSGDB}
  3320. end;
  3321. procedure InitDebugger;
  3322. {$ifdef DEBUG}
  3323. var s : string;
  3324. i,p : longint;
  3325. {$endif DEBUG}
  3326. var
  3327. NeedRecompileExe : boolean;
  3328. cm : longint;
  3329. begin
  3330. {$ifdef DEBUG}
  3331. if not use_gdb_file then
  3332. begin
  3333. Assign(gdb_file,GDBOutFileName);
  3334. {$I-}
  3335. Rewrite(gdb_file);
  3336. if InOutRes<>0 then
  3337. begin
  3338. s:=GDBOutFileName;
  3339. p:=pos('.',s);
  3340. if p>1 then
  3341. for i:=0 to 9 do
  3342. begin
  3343. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3344. InOutRes:=0;
  3345. Assign(gdb_file,s);
  3346. rewrite(gdb_file);
  3347. if InOutRes=0 then
  3348. break;
  3349. end;
  3350. end;
  3351. if IOResult=0 then
  3352. Use_gdb_file:=true;
  3353. end;
  3354. {$I+}
  3355. {$endif}
  3356. NeedRecompileExe:=false;
  3357. {$ifndef SUPPORT_REMOTE}
  3358. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3359. begin
  3360. ClearFormatParams;
  3361. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3362. AddFormatParamStr(GetGDBTargetShortName);
  3363. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3364. if cm=cmCancel then
  3365. Exit;
  3366. if cm=cmYes then
  3367. begin
  3368. { force recompilation }
  3369. PrevMainFile:='';
  3370. NeedRecompileExe:=true;
  3371. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3372. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3373. DebugInfoSwitches^.SetCurrSelParam('l');
  3374. IDEApp.UpdateTarget;
  3375. end;
  3376. end;
  3377. {$endif ndef SUPPORT_REMOTE}
  3378. if not NeedRecompileExe then
  3379. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3380. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3381. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3382. begin
  3383. ClearFormatParams;
  3384. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3385. if cm=cmCancel then
  3386. Exit;
  3387. if cm=cmYes then
  3388. begin
  3389. { force recompilation }
  3390. PrevMainFile:='';
  3391. NeedRecompileExe:=true;
  3392. DebugInfoSwitches^.SetCurrSelParam('l');
  3393. end;
  3394. end;
  3395. if NeedRecompileExe then
  3396. DoCompile(cRun);
  3397. if CompilationPhase<>cpDone then
  3398. Exit;
  3399. if (EXEFile='') then
  3400. begin
  3401. ErrorBox(msg_nothingtodebug,nil);
  3402. Exit;
  3403. end;
  3404. { init debugcontroller }
  3405. {$ifndef NODEBUG}
  3406. if not assigned(Debugger) then
  3407. begin
  3408. PushStatus(msg_startingdebugger);
  3409. new(Debugger,Init);
  3410. PopStatus;
  3411. end;
  3412. Debugger^.SetExe(ExeFile);
  3413. {$endif NODEBUG}
  3414. {$ifdef GDBWINDOW}
  3415. InitGDBWindow;
  3416. {$endif def GDBWINDOW}
  3417. end;
  3418. procedure DoneDebugger;
  3419. begin
  3420. {$ifdef DEBUG}
  3421. If IDEApp.IsRunning then
  3422. PushStatus('Closing debugger');
  3423. {$endif}
  3424. {$ifndef NODEBUG}
  3425. if assigned(Debugger) then
  3426. dispose(Debugger,Done);
  3427. Debugger:=nil;
  3428. {$endif NODEBUG}
  3429. {$ifdef DOS}
  3430. If assigned(UserScreen) then
  3431. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3432. {$endif DOS}
  3433. {$ifdef DEBUG}
  3434. If Use_gdb_file then
  3435. begin
  3436. Use_gdb_file:=false;
  3437. Close(GDB_file);
  3438. end;
  3439. If IDEApp.IsRunning then
  3440. PopStatus;
  3441. {$endif DEBUG}
  3442. end;
  3443. procedure InitGDBWindow;
  3444. var
  3445. R : TRect;
  3446. begin
  3447. if GDBWindow=nil then
  3448. begin
  3449. DeskTop^.GetExtent(R);
  3450. new(GDBWindow,init(R));
  3451. DeskTop^.Insert(GDBWindow);
  3452. end;
  3453. end;
  3454. procedure DoneGDBWindow;
  3455. begin
  3456. If IDEApp.IsRunning and
  3457. assigned(GDBWindow) then
  3458. begin
  3459. DeskTop^.Delete(GDBWindow);
  3460. end;
  3461. GDBWindow:=nil;
  3462. end;
  3463. procedure InitDisassemblyWindow;
  3464. var
  3465. R : TRect;
  3466. begin
  3467. if DisassemblyWindow=nil then
  3468. begin
  3469. DeskTop^.GetExtent(R);
  3470. new(DisassemblyWindow,init(R));
  3471. DeskTop^.Insert(DisassemblyWindow);
  3472. end;
  3473. end;
  3474. procedure DoneDisassemblyWindow;
  3475. begin
  3476. if assigned(DisassemblyWindow) then
  3477. begin
  3478. DeskTop^.Delete(DisassemblyWindow);
  3479. Dispose(DisassemblyWindow,Done);
  3480. DisassemblyWindow:=nil;
  3481. end;
  3482. end;
  3483. procedure InitStackWindow;
  3484. begin
  3485. if StackWindow=nil then
  3486. begin
  3487. new(StackWindow,init);
  3488. DeskTop^.Insert(StackWindow);
  3489. end;
  3490. end;
  3491. procedure DoneStackWindow;
  3492. begin
  3493. if assigned(StackWindow) then
  3494. begin
  3495. DeskTop^.Delete(StackWindow);
  3496. StackWindow:=nil;
  3497. end;
  3498. end;
  3499. procedure InitBreakpoints;
  3500. begin
  3501. New(BreakpointsCollection,init(10,10));
  3502. end;
  3503. procedure DoneBreakpoints;
  3504. begin
  3505. Dispose(BreakpointsCollection,Done);
  3506. BreakpointsCollection:=nil;
  3507. end;
  3508. procedure InitWatches;
  3509. begin
  3510. New(WatchesCollection,init);
  3511. end;
  3512. procedure DoneWatches;
  3513. begin
  3514. Dispose(WatchesCollection,Done);
  3515. WatchesCollection:=nil;
  3516. end;
  3517. procedure RegisterFPDebugViews;
  3518. begin
  3519. RegisterType(RWatchesWindow);
  3520. RegisterType(RBreakpointsWindow);
  3521. RegisterType(RWatchesListBox);
  3522. RegisterType(RBreakpointsListBox);
  3523. RegisterType(RStackWindow);
  3524. RegisterType(RFramesListBox);
  3525. RegisterType(RBreakpoint);
  3526. RegisterType(RWatch);
  3527. RegisterType(RBreakpointCollection);
  3528. RegisterType(RWatchesCollection);
  3529. end;
  3530. end.
  3531. {$endif NODEBUG}