fpdebug.pas 98 KB

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