fpdebug.pas 96 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998-2000 by Pierre Muller
  5. Debugger call routines for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit FPDebug;
  13. interface
  14. uses
  15. Objects,Dialogs,Drivers,Views,
  16. GDBCon,GDBInt,Menus,
  17. WViews,
  18. FPViews;
  19. type
  20. PDebugController=^TDebugController;
  21. TDebugController=object(TGDBController)
  22. InvalidSourceLine : boolean;
  23. { if true the current debugger raw will stay in middle of
  24. editor window when debugging PM }
  25. CenterDebuggerRow : boolean;
  26. LastFileName : string;
  27. LastSource : PView; {PsourceWindow !! }
  28. HiddenStepsCount : longint;
  29. { no need to switch if using another terminal }
  30. NoSwitch : boolean;
  31. IsRunning : boolean;
  32. RunCount : longint;
  33. constructor Init(const exefn:string);
  34. destructor Done;
  35. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  36. { procedure DoStartSession;virtual;
  37. procedure DoBreakSession;virtual;}
  38. procedure DoEndSession(code:longint);virtual;
  39. procedure AnnotateError;
  40. procedure InsertBreakpoints;
  41. procedure RemoveBreakpoints;
  42. procedure ReadWatches;
  43. procedure ResetBreakpointsValues;
  44. procedure DoDebuggerScreen;virtual;
  45. procedure DoUserScreen;virtual;
  46. procedure Reset;virtual;
  47. procedure ResetDebuggerRows;
  48. procedure Run;virtual;
  49. procedure Continue;virtual;
  50. procedure UntilReturn;virtual;
  51. procedure CommandBegin(const s:string);virtual;
  52. procedure CommandEnd(const s:string);virtual;
  53. function AllowQuit : boolean;virtual;
  54. function GetValue(Const expr : string) : pchar;
  55. end;
  56. BreakpointType = (bt_function,bt_file_line,bt_watch,bt_awatch,bt_rwatch,bt_invalid);
  57. BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
  58. PBreakpointCollection=^TBreakpointCollection;
  59. PBreakpoint=^TBreakpoint;
  60. TBreakpoint=object(TObject)
  61. typ : BreakpointType;
  62. state : BreakpointState;
  63. owner : PBreakpointCollection;
  64. Name : PString; { either function name or expr to watch }
  65. FileName : PString;
  66. OldValue,CurrentValue : Pstring;
  67. Line : Longint; { only used for bt_file_line type }
  68. Conditions : PString; { conditions relative to that breakpoint }
  69. IgnoreCount : Longint; { how many counts should be ignored }
  70. Commands : pchar; { commands that should be executed on breakpoint }
  71. GDBIndex : longint;
  72. GDBState : BreakpointState;
  73. constructor Init_function(Const AFunc : String);
  74. constructor Init_Empty;
  75. constructor Init_file_line(AFile : String; ALine : longint);
  76. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  77. constructor Load(var S: TStream);
  78. procedure Store(var S: TStream);
  79. procedure Insert;
  80. procedure Remove;
  81. procedure Enable;
  82. procedure Disable;
  83. procedure UpdateSource;
  84. procedure ResetValues;
  85. destructor Done;virtual;
  86. end;
  87. TBreakpointCollection=object(TCollection)
  88. function At(Index: Integer): PBreakpoint;
  89. function GetGDB(index : longint) : PBreakpoint;
  90. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  91. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  92. procedure Update;
  93. procedure ShowBreakpoints(W : PSourceWindow);
  94. procedure ShowAllBreakpoints;
  95. end;
  96. PBreakpointItem = ^TBreakpointItem;
  97. TBreakpointItem = object(TObject)
  98. Breakpoint : PBreakpoint;
  99. constructor Init(ABreakpoint : PBreakpoint);
  100. function GetText(MaxLen: Sw_integer): string; virtual;
  101. procedure Selected; virtual;
  102. function GetModuleName: string; virtual;
  103. end;
  104. PBreakpointsListBox = ^TBreakpointsListBox;
  105. TBreakpointsListBox = object(THSListBox)
  106. Transparent : boolean;
  107. NoSelection : boolean;
  108. MaxWidth : Sw_integer;
  109. (* ModuleNames : PStoreCollection; *)
  110. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  111. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  112. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  113. function GetLocalMenu: PMenu;virtual;
  114. procedure Clear; virtual;
  115. procedure TrackSource; virtual;
  116. procedure EditNew; virtual;
  117. procedure EditCurrent; virtual;
  118. procedure DeleteCurrent; virtual;
  119. procedure ToggleCurrent;
  120. procedure Draw; virtual;
  121. procedure HandleEvent(var Event: TEvent); virtual;
  122. constructor Load(var S: TStream);
  123. procedure Store(var S: TStream);
  124. destructor Done; virtual;
  125. end;
  126. PBreakpointsWindow = ^TBreakpointsWindow;
  127. TBreakpointsWindow = object(TDlgWindow)
  128. BreakLB : PBreakpointsListBox;
  129. constructor Init;
  130. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  131. procedure ClearBreakpoints;
  132. procedure ReloadBreakpoints;
  133. procedure Close; virtual;
  134. procedure SizeLimits(var Min, Max: TPoint);virtual;
  135. procedure HandleEvent(var Event: TEvent); virtual;
  136. procedure Update; virtual;
  137. constructor Load(var S: TStream);
  138. procedure Store(var S: TStream);
  139. destructor Done; virtual;
  140. end;
  141. PBreakpointItemDialog = ^TBreakpointItemDialog;
  142. TBreakpointItemDialog = object(TCenterDialog)
  143. constructor Init(ABreakpoint: PBreakpoint);
  144. function Execute: Word; virtual;
  145. private
  146. Breakpoint : PBreakpoint;
  147. TypeRB : PRadioButtons;
  148. NameIL : PInputLine;
  149. ConditionsIL: PInputLine;
  150. LineIL : PInputLine;
  151. IgnoreIL : PInputLine;
  152. end;
  153. PWatch = ^TWatch;
  154. TWatch = Object(TObject)
  155. constructor Init(s : string);
  156. constructor Load(var S: TStream);
  157. procedure Store(var S: TStream);
  158. procedure rename(s : string);
  159. procedure Get_new_value;
  160. destructor done;virtual;
  161. private
  162. expr : pstring;
  163. last_value,current_value : pchar;
  164. end;
  165. PWatchesCollection = ^TWatchesCollection;
  166. TWatchesCollection = Object(TCollection)
  167. constructor Init;
  168. procedure Insert(Item: Pointer); virtual;
  169. function At(Index: Integer): PWatch;
  170. procedure Update;
  171. private
  172. MaxW : integer;
  173. end;
  174. PWatchesListBox = ^TWatchesListBox;
  175. TWatchesListBox = object(THSListBox)
  176. Transparent : boolean;
  177. MaxWidth : Sw_integer;
  178. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  179. (* procedure AddWatch(P: PWatch); virtual; *)
  180. procedure Update(AMaxWidth : integer);
  181. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String; virtual;
  182. function GetLocalMenu: PMenu;virtual;
  183. (* procedure Clear; virtual;
  184. procedure TrackSource; virtual;*)
  185. procedure EditNew; virtual;
  186. procedure EditCurrent; virtual;
  187. procedure DeleteCurrent; virtual;
  188. (*procedure ToggleCurrent; *)
  189. procedure Draw; virtual;
  190. procedure HandleEvent(var Event: TEvent); virtual;
  191. constructor Load(var S: TStream);
  192. procedure Store(var S: TStream);
  193. destructor Done; virtual;
  194. end;
  195. PWatchItemDialog = ^TWatchItemDialog;
  196. TWatchItemDialog = object(TCenterDialog)
  197. constructor Init(AWatch: PWatch);
  198. function Execute: Word; virtual;
  199. private
  200. Watch : PWatch;
  201. NameIL : PInputLine;
  202. TextST : PAdvancedStaticText;
  203. end;
  204. PWatchesWindow = ^TWatchesWindow;
  205. TWatchesWindow = Object(TDlgWindow)
  206. WLB : PWatchesListBox;
  207. Constructor Init;
  208. constructor Load(var S: TStream);
  209. procedure Store(var S: TStream);
  210. procedure Update; virtual;
  211. destructor Done; virtual;
  212. end;
  213. PFramesListBox = ^TFramesListBox;
  214. TFramesListBox = object(TMessageListBox)
  215. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  216. procedure Update;
  217. function GetLocalMenu: PMenu;virtual;
  218. procedure GotoSource; virtual;
  219. procedure HandleEvent(var Event: TEvent); virtual;
  220. destructor Done; virtual;
  221. end;
  222. PStackWindow = ^TStackWindow;
  223. TStackWindow = Object(TDlgWindow)
  224. FLB : PFramesListBox;
  225. Constructor Init;
  226. constructor Load(var S: TStream);
  227. procedure Store(var S: TStream);
  228. procedure Update; virtual;
  229. destructor Done; virtual;
  230. end;
  231. {$ifdef TP} dword = longint; {$endif}
  232. TIntRegs = record
  233. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  234. cs,ds,es,ss,fs,gs : word;
  235. eflags : dword;
  236. end;
  237. PRegistersView = ^TRegistersView;
  238. TRegistersView = object(TView)
  239. OldReg : TIntRegs;
  240. constructor Init(var Bounds: TRect);
  241. procedure Draw;virtual;
  242. destructor Done; virtual;
  243. end;
  244. PRegistersWindow = ^TRegistersWindow;
  245. TRegistersWindow = Object(TDlgWindow)
  246. RV : PRegistersView;
  247. Constructor Init;
  248. constructor Load(var S: TStream);
  249. procedure Store(var S: TStream);
  250. procedure Update; virtual;
  251. destructor Done; virtual;
  252. end;
  253. TFPURegs = record
  254. end;
  255. PFPUView = ^TFPUView;
  256. TFPUView = object(TView)
  257. OldReg : TFPURegs;
  258. constructor Init(var Bounds: TRect);
  259. procedure Draw;virtual;
  260. destructor Done; virtual;
  261. end;
  262. PFPUWindow = ^TFPUWindow;
  263. TFPUWindow = Object(TDlgWindow)
  264. RV : PFPUView;
  265. Constructor Init;
  266. constructor Load(var S: TStream);
  267. procedure Store(var S: TStream);
  268. procedure Update; virtual;
  269. destructor Done; virtual;
  270. end;
  271. const
  272. StackWindow : PStackWindow = nil;
  273. RegistersWindow : PRegistersWindow = nil;
  274. FPUWindow : PFPUWindow = nil;
  275. procedure InitStackWindow;
  276. procedure DoneStackWindow;
  277. procedure InitRegistersWindow;
  278. procedure DoneRegistersWindow;
  279. function ActiveBreakpoints : boolean;
  280. function GDBFileName(st : string) : string;
  281. const
  282. BreakpointTypeStr : Array[BreakpointType] of String[9]
  283. = ( 'function','file-line','watch','awatch','rwatch','invalid' );
  284. BreakpointStateStr : Array[BreakpointState] of String[8]
  285. = ( 'enabled','disabled','invalid' );
  286. DebuggeeTTY : string = '';
  287. var
  288. Debugger : PDebugController;
  289. BreakpointsCollection : PBreakpointCollection;
  290. WatchesCollection : PwatchesCollection;
  291. procedure InitDebugger;
  292. procedure DoneDebugger;
  293. procedure InitGDBWindow;
  294. procedure DoneGDBWindow;
  295. procedure InitBreakpoints;
  296. procedure DoneBreakpoints;
  297. procedure InitWatches;
  298. procedure DoneWatches;
  299. procedure RegisterFPDebugViews;
  300. procedure UpdateDebugViews;
  301. implementation
  302. uses
  303. Dos,Mouse,Video,
  304. App,Commands,Strings,
  305. {$ifdef win32}
  306. Windebug,
  307. {$endif win32}
  308. Systems,
  309. FPVars,FPUtils,FPConst,FPSwitch,
  310. FPIntf,FPCompile,FPIde,FPHelp,
  311. Validate,WEditor,WUtils;
  312. const
  313. RBreakpointsWindow: TStreamRec = (
  314. ObjType: 1701;
  315. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  316. Load: @TBreakpointsWindow.Load;
  317. Store: @TBreakpointsWindow.Store
  318. );
  319. RBreakpointsListBox : TStreamRec = (
  320. ObjType: 1702;
  321. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  322. Load: @TBreakpointsListBox.Load;
  323. Store: @TBreakpointsListBox.Store
  324. );
  325. RWatchesWindow: TStreamRec = (
  326. ObjType: 1703;
  327. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  328. Load: @TWatchesWindow.Load;
  329. Store: @TWatchesWindow.Store
  330. );
  331. RWatchesListBox: TStreamRec = (
  332. ObjType: 1704;
  333. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  334. Load: @TWatchesListBox.Load;
  335. Store: @TWatchesListBox.Store
  336. );
  337. RStackWindow: TStreamRec = (
  338. ObjType: 1705;
  339. VmtLink: Ofs(TypeOf(TStackWindow)^);
  340. Load: @TStackWindow.Load;
  341. Store: @TStackWindow.Store
  342. );
  343. RFramesListBox: TStreamRec = (
  344. ObjType: 1706;
  345. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  346. Load: @TFramesListBox.Load;
  347. Store: @TFramesListBox.Store
  348. );
  349. RBreakpoint: TStreamRec = (
  350. ObjType: 1707;
  351. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  352. Load: @TBreakpoint.Load;
  353. Store: @TBreakpoint.Store
  354. );
  355. RWatch: TStreamRec = (
  356. ObjType: 1708;
  357. VmtLink: Ofs(TypeOf(TWatch)^);
  358. Load: @TWatch.Load;
  359. Store: @TWatch.Store
  360. );
  361. RBreakpointCollection: TStreamRec = (
  362. ObjType: 1709;
  363. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  364. Load: @TBreakpointCollection.Load;
  365. Store: @TBreakpointCollection.Store
  366. );
  367. RWatchesCollection: TStreamRec = (
  368. ObjType: 1710;
  369. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  370. Load: @TWatchesCollection.Load;
  371. Store: @TWatchesCollection.Store
  372. );
  373. RRegistersWindow: TStreamRec = (
  374. ObjType: 1711;
  375. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  376. Load: @TRegistersWindow.Load;
  377. Store: @TRegistersWindow.Store
  378. );
  379. RRegistersView: TStreamRec = (
  380. ObjType: 1712;
  381. VmtLink: Ofs(TypeOf(TRegistersView)^);
  382. Load: @TRegistersView.Load;
  383. Store: @TRegistersView.Store
  384. );
  385. RFPUWindow: TStreamRec = (
  386. ObjType: 1713;
  387. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  388. Load: @TFPUWindow.Load;
  389. Store: @TFPUWindow.Store
  390. );
  391. RFPUView: TStreamRec = (
  392. ObjType: 1714;
  393. VmtLink: Ofs(TypeOf(TFPUView)^);
  394. Load: @TFPUView.Load;
  395. Store: @TFPUView.Store
  396. );
  397. {$ifdef TP}
  398. function HexStr(Value: longint; Len: byte): string;
  399. begin
  400. HexStr:=IntToHexL(Value,Len);
  401. end;
  402. {$endif}
  403. function GDBFileName(st : string) : string;
  404. {$ifndef Linux}
  405. var i : longint;
  406. {$endif Linux}
  407. begin
  408. {$ifdef Linux}
  409. GDBFileName:=st;
  410. {$else}
  411. { should we also use / chars ? }
  412. for i:=1 to Length(st) do
  413. if st[i]='\' then
  414. st[i]:='/';
  415. {$ifdef win32}
  416. { for win32 we should convert e:\ into //e/ PM }
  417. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  418. st:='//'+st[1]+copy(st,3,length(st));
  419. {$endif win32}
  420. {$ifdef go32v2}
  421. { for go32v2 we should convert //e/ back into e:/ PM }
  422. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  423. st:=st[3]+':/'+copy(st,5,length(st));
  424. {$endif go32v2}
  425. GDBFileName:=LowerCaseStr(st);
  426. {$endif}
  427. end;
  428. {****************************************************************************
  429. TDebugController
  430. ****************************************************************************}
  431. procedure UpdateDebugViews;
  432. begin
  433. If assigned(StackWindow) then
  434. StackWindow^.Update;
  435. If assigned(RegistersWindow) then
  436. RegistersWindow^.Update;
  437. If assigned(Debugger) then
  438. Debugger^.ReadWatches;
  439. If assigned(FPUWindow) then
  440. FPUWindow^.Update;
  441. end;
  442. constructor TDebugController.Init(const exefn:string);
  443. var f: string;
  444. begin
  445. inherited Init;
  446. CenterDebuggerRow:=IniCenterDebuggerRow;
  447. f := GetShortName(GDBFileName(exefn));
  448. NoSwitch:=False;
  449. LoadFile(f);
  450. SetArgs(GetRunParameters);
  451. Debugger:=@self;
  452. {$ifndef GABOR}
  453. switch_to_user:=true;
  454. {$endif}
  455. InsertBreakpoints;
  456. ReadWatches;
  457. end;
  458. procedure TDebugController.InsertBreakpoints;
  459. procedure DoInsert(PB : PBreakpoint);
  460. begin
  461. PB^.Insert;
  462. end;
  463. begin
  464. BreakpointsCollection^.ForEach(@DoInsert);
  465. end;
  466. procedure TDebugController.ReadWatches;
  467. procedure DoRead(PB : PWatch);
  468. begin
  469. PB^.Get_new_value;
  470. end;
  471. begin
  472. WatchesCollection^.ForEach(@DoRead);
  473. If Assigned(WatchesWindow) then
  474. WatchesWindow^.Update;
  475. end;
  476. procedure TDebugController.RemoveBreakpoints;
  477. procedure DoDelete(PB : PBreakpoint);
  478. begin
  479. PB^.Remove;
  480. end;
  481. begin
  482. BreakpointsCollection^.ForEach(@DoDelete);
  483. end;
  484. procedure TDebugController.ResetBreakpointsValues;
  485. procedure DoResetVal(PB : PBreakpoint);
  486. begin
  487. PB^.ResetValues;
  488. end;
  489. begin
  490. BreakpointsCollection^.ForEach(@DoResetVal);
  491. end;
  492. function ActiveBreakpoints : boolean;
  493. var
  494. IsActive : boolean;
  495. procedure TestActive(PB : PBreakpoint);
  496. begin
  497. If PB^.state=bs_enabled then
  498. IsActive:=true;
  499. end;
  500. begin
  501. IsActive:=false;
  502. If assigned(BreakpointsCollection) then
  503. BreakpointsCollection^.ForEach(@TestActive);
  504. ActiveBreakpoints:=IsActive;
  505. end;
  506. destructor TDebugController.Done;
  507. begin
  508. { kill the program if running }
  509. Reset;
  510. RemoveBreakpoints;
  511. inherited Done;
  512. end;
  513. procedure TDebugController.Run;
  514. begin
  515. ResetBreakpointsValues;
  516. {$ifdef win32}
  517. { Run the debugge in another console }
  518. if DebuggeeTTY<>'' then
  519. Command('set new-console on')
  520. else
  521. Command('set new-console off');
  522. NoSwitch:=DebuggeeTTY<>'';
  523. {$endif win32}
  524. {$ifdef linux}
  525. { Run the debugge in another tty }
  526. Command('set tty '+DebuggeeTTY);
  527. NoSwitch:=DebuggeeTTY<>'';
  528. {$endif win32}
  529. { Switch to user screen to get correct handles }
  530. UserScreen;
  531. inherited Run;
  532. IsRunning:=true;
  533. DebuggerScreen;
  534. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  535. UpdateDebugViews;
  536. end;
  537. procedure TDebugController.Continue;
  538. begin
  539. {$ifdef NODEBUG}
  540. NoDebugger;
  541. {$else}
  542. if not debuggee_started then
  543. Run
  544. else
  545. inherited Continue;
  546. UpdateDebugViews;
  547. {$endif NODEBUG}
  548. end;
  549. procedure TDebugController.UntilReturn;
  550. begin
  551. Command('finish');
  552. UpdateDebugViews;
  553. { We could try to get the return value !
  554. Not done yet }
  555. end;
  556. procedure TDebugController.CommandBegin(const s:string);
  557. begin
  558. if assigned(GDBWindow) and (in_command>1) then
  559. begin
  560. { We should do something special for errors !! }
  561. If StrLen(GetError)>0 then
  562. GDBWindow^.WriteErrorText(GetError);
  563. GDBWindow^.WriteOutputText(GetOutput);
  564. end;
  565. if assigned(GDBWindow) then
  566. GDBWindow^.WriteString(S);
  567. end;
  568. procedure TDebugController.CommandEnd(const s:string);
  569. begin
  570. if assigned(GDBWindow) and (in_command=0) then
  571. begin
  572. { We should do something special for errors !! }
  573. If StrLen(GetError)>0 then
  574. GDBWindow^.WriteErrorText(GetError);
  575. GDBWindow^.WriteOutputText(GetOutput);
  576. GDBWindow^.Editor^.TextEnd;
  577. end;
  578. end;
  579. function TDebugController.AllowQuit : boolean;
  580. begin
  581. if ConfirmBox('Really quit editor?',nil,true)=cmOK then
  582. begin
  583. Message(@IDEApp,evCommand,cmQuit,nil);
  584. end
  585. else
  586. AllowQuit:=false;
  587. end;
  588. procedure TDebugController.ResetDebuggerRows;
  589. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  590. begin
  591. if assigned(P) and
  592. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  593. PSourceWindow(P)^.Editor^.SetDebuggerRow(-1);
  594. end;
  595. begin
  596. Desktop^.ForEach(@ResetDebuggerRow);
  597. end;
  598. procedure TDebugController.Reset;
  599. begin
  600. inherited Reset;
  601. NoSwitch:=false;
  602. IsRunning:=false;
  603. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  604. ResetDebuggerRows;
  605. end;
  606. procedure TDebugController.AnnotateError;
  607. var errornb : longint;
  608. begin
  609. if error then
  610. begin
  611. errornb:=error_num;
  612. UpdateDebugViews;
  613. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  614. end;
  615. end;
  616. function TDebugController.GetValue(Const expr : string) : pchar;
  617. var
  618. p,p2,p3 : pchar;
  619. begin
  620. Command('p '+expr);
  621. p:=GetOutput;
  622. p3:=nil;
  623. if assigned(p) and (p[strlen(p)-1]=#10) then
  624. begin
  625. p3:=p+strlen(p)-1;
  626. p3^:=#0;
  627. end;
  628. if assigned(p) then
  629. p2:=strpos(p,'=')
  630. else
  631. p2:=nil;
  632. if assigned(p2) then
  633. p:=p2+1;
  634. while p^ in [' ',TAB] do
  635. inc(p);
  636. { get rid of type }
  637. if p^ = '(' then
  638. p:=strpos(p,')')+1;
  639. while p^ in [' ',TAB] do
  640. inc(p);
  641. if assigned(p) then
  642. GetValue:=StrNew(p)
  643. else
  644. GetValue:=StrNew(GetError);
  645. if assigned(p3) then
  646. p3^:=#10;
  647. got_error:=false;
  648. end;
  649. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  650. var
  651. W: PSourceWindow;
  652. Found : boolean;
  653. PB : PBreakpoint;
  654. S : String;
  655. BreakIndex : longint;
  656. begin
  657. BreakIndex:=stop_breakpoint_number;
  658. Desktop^.Lock;
  659. { 0 based line count in Editor }
  660. if Line>0 then
  661. dec(Line);
  662. if (fn=LastFileName) then
  663. begin
  664. W:=PSourceWindow(LastSource);
  665. if assigned(W) then
  666. begin
  667. W^.Editor^.SetCurPtr(0,Line);
  668. W^.Editor^.TrackCursor(CenterDebuggerRow);
  669. W^.Editor^.SetDebuggerRow(Line);
  670. UpdateDebugViews;
  671. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  672. handled by SelectInDebugSession}
  673. W^.SelectInDebugSession;
  674. InvalidSourceLine:=false;
  675. end
  676. else
  677. InvalidSourceLine:=true;
  678. end
  679. else
  680. begin
  681. W:=TryToOpenFile(nil,fn,0,Line,false);
  682. if assigned(W) then
  683. begin
  684. W^.Editor^.SetDebuggerRow(Line);
  685. W^.Editor^.TrackCursor(CenterDebuggerRow);
  686. UpdateDebugViews;
  687. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  688. handled by SelectInDebugSession}
  689. W^.SelectInDebugSession;
  690. LastSource:=W;
  691. InvalidSourceLine:=false;
  692. end
  693. { only search a file once }
  694. else
  695. begin
  696. Desktop^.UnLock;
  697. Found:=IDEApp.OpenSearch(fn);
  698. Desktop^.Lock;
  699. if not Found then
  700. begin
  701. InvalidSourceLine:=true;
  702. LastSource:=Nil;
  703. end
  704. else
  705. begin
  706. { should now be open }
  707. W:=TryToOpenFile(nil,fn,0,Line,true);
  708. W^.Editor^.SetDebuggerRow(Line);
  709. W^.Editor^.TrackCursor(CenterDebuggerRow);
  710. UpdateDebugViews;
  711. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  712. handled by SelectInDebugSession}
  713. W^.SelectInDebugSession;
  714. LastSource:=W;
  715. InvalidSourceLine:=false;
  716. end;
  717. end;
  718. end;
  719. LastFileName:=fn;
  720. Desktop^.UnLock;
  721. if BreakIndex>0 then
  722. begin
  723. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  724. { For watch we should get old and new value !! }
  725. if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  726. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) then
  727. begin
  728. Command('p '+GetStr(PB^.Name));
  729. S:=GetPChar(GetOutput);
  730. got_error:=false;
  731. If Pos('=',S)>0 then
  732. S:=Copy(S,Pos('=',S)+1,255);
  733. If S[Length(S)]=#10 then
  734. Delete(S,Length(S),1);
  735. if Assigned(PB^.OldValue) then
  736. DisposeStr(PB^.OldValue);
  737. PB^.OldValue:=PB^.CurrentValue;
  738. PB^.CurrentValue:=NewStr(S);
  739. If PB^.typ=bt_function then
  740. WarningBox(#3'GDB stopped due to'#13+
  741. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  742. else if (GetStr(PB^.OldValue)<>S) then
  743. WarningBox(#3'GDB stopped due to'#13+
  744. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  745. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  746. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  747. else
  748. WarningBox(#3'GDB stopped due to'#13+
  749. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  750. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  751. end;
  752. end;
  753. end;
  754. procedure TDebugController.DoEndSession(code:longint);
  755. var P :Array[1..2] of longint;
  756. begin
  757. IDEApp.SetCmdState([cmResetDebugger],false);
  758. ResetDebuggerRows;
  759. LastExitCode:=Code;
  760. If HiddenStepsCount=0 then
  761. InformationBox(#3'Program exited with '#13#3'exitcode = %d',@code)
  762. else
  763. begin
  764. P[1]:=code;
  765. P[2]:=HiddenStepsCount;
  766. WarningBox(#3'Program exited with '#13+
  767. #3'exitcode = %d'#13+
  768. #3'hidden steps = %d',@P);
  769. end;
  770. IsRunning:=false;
  771. end;
  772. procedure TDebugController.DoDebuggerScreen;
  773. begin
  774. if NoSwitch then
  775. begin
  776. PopStatus;
  777. end
  778. else
  779. IDEApp.ShowIDEScreen;
  780. {$ifdef win32}
  781. ChangeDebuggeeWindowTitleTo(Stopped_State);
  782. {$endif win32}
  783. end;
  784. procedure TDebugController.DoUserScreen;
  785. begin
  786. Inc(RunCount);
  787. if NoSwitch then
  788. begin
  789. PushStatus('Executable running in another window..');
  790. end
  791. else
  792. IDEApp.ShowUserScreen;
  793. {$ifdef win32}
  794. ChangeDebuggeeWindowTitleTo(Running_State);
  795. {$endif win32}
  796. end;
  797. {****************************************************************************
  798. TBreakpoint
  799. ****************************************************************************}
  800. constructor TBreakpoint.Init_function(Const AFunc : String);
  801. begin
  802. typ:=bt_function;
  803. state:=bs_enabled;
  804. GDBState:=bs_deleted;
  805. Name:=NewStr(AFunc);
  806. FileName:=nil;
  807. Line:=0;
  808. IgnoreCount:=0;
  809. Commands:=nil;
  810. Conditions:=nil;
  811. OldValue:=nil;
  812. CurrentValue:=nil;
  813. end;
  814. constructor TBreakpoint.Init_Empty;
  815. begin
  816. typ:=bt_function;
  817. state:=bs_enabled;
  818. GDBState:=bs_deleted;
  819. Name:=Nil;
  820. FileName:=nil;
  821. Line:=0;
  822. IgnoreCount:=0;
  823. Commands:=nil;
  824. Conditions:=nil;
  825. OldValue:=nil;
  826. CurrentValue:=nil;
  827. end;
  828. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  829. begin
  830. typ:=atyp;
  831. state:=bs_enabled;
  832. GDBState:=bs_deleted;
  833. Name:=NewStr(AnExpr);
  834. IgnoreCount:=0;
  835. Commands:=nil;
  836. Conditions:=nil;
  837. OldValue:=nil;
  838. CurrentValue:=nil;
  839. end;
  840. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  841. begin
  842. typ:=bt_file_line;
  843. state:=bs_enabled;
  844. GDBState:=bs_deleted;
  845. { d:test.pas:12 does not work !! }
  846. { I do not know how to solve this if
  847. if (Length(AFile)>1) and (AFile[2]=':') then
  848. AFile:=Copy(AFile,3,255); }
  849. FileName:=NewStr(GDBFileName(AFile));
  850. Name:=nil;
  851. Line:=ALine;
  852. IgnoreCount:=0;
  853. Commands:=nil;
  854. Conditions:=nil;
  855. OldValue:=nil;
  856. CurrentValue:=nil;
  857. end;
  858. constructor TBreakpoint.Load(var S: TStream);
  859. var
  860. FName : PString;
  861. begin
  862. S.Read(typ,SizeOf(BreakpointType));
  863. S.Read(state,SizeOf(BreakpointState));
  864. GDBState:=bs_deleted;
  865. case typ of
  866. bt_file_line :
  867. begin
  868. { convert to current target }
  869. FName:=S.ReadStr;
  870. FileName:=NewStr(GDBFileName(GetStr(FName)));
  871. If Assigned(FName) then
  872. DisposeStr(FName);
  873. S.Read(Line,SizeOf(Line));
  874. Name:=nil;
  875. end;
  876. else
  877. begin
  878. Name:=S.ReadStr;
  879. Line:=0;
  880. FileName:=nil;
  881. end;
  882. end;
  883. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  884. Commands:=S.StrRead;
  885. Conditions:=S.ReadStr;
  886. OldValue:=nil;
  887. CurrentValue:=nil;
  888. end;
  889. procedure TBreakpoint.Store(var S: TStream);
  890. begin
  891. S.Write(typ,SizeOf(BreakpointType));
  892. S.Write(state,SizeOf(BreakpointState));
  893. case typ of
  894. bt_file_line :
  895. begin
  896. S.WriteStr(FileName);
  897. S.Write(Line,SizeOf(Line));
  898. end;
  899. else
  900. begin
  901. S.WriteStr(Name);
  902. end;
  903. end;
  904. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  905. S.StrWrite(Commands);
  906. S.WriteStr(Conditions);
  907. end;
  908. procedure TBreakpoint.Insert;
  909. begin
  910. If not assigned(Debugger) then Exit;
  911. Remove;
  912. Debugger^.last_breakpoint_number:=0;
  913. if (GDBState=bs_deleted) and (state=bs_enabled) then
  914. begin
  915. if (typ=bt_file_line) and assigned(FileName) then
  916. Debugger^.Command('break '+NameAndExtOf(FileName^)+':'+IntToStr(Line))
  917. else if (typ=bt_function) and assigned(name) then
  918. Debugger^.Command('break '+name^)
  919. else if (typ=bt_watch) and assigned(name) then
  920. Debugger^.Command('watch '+name^)
  921. else if (typ=bt_awatch) and assigned(name) then
  922. Debugger^.Command('awatch '+name^)
  923. else if (typ=bt_rwatch) and assigned(name) then
  924. Debugger^.Command('rwatch '+name^);
  925. if Debugger^.last_breakpoint_number<>0 then
  926. begin
  927. GDBIndex:=Debugger^.last_breakpoint_number;
  928. GDBState:=bs_enabled;
  929. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  930. If IgnoreCount>0 then
  931. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  932. If Assigned(Commands) then
  933. begin
  934. {Commands are not handled yet }
  935. end;
  936. end
  937. else
  938. { Here there was a problem !! }
  939. begin
  940. GDBIndex:=0;
  941. if (typ=bt_file_line) and assigned(FileName) then
  942. ErrorBox(#3'Could not set Breakpoint'#13+
  943. #3+NameAndExtOf(FileName^)+':'+IntToStr(Line),nil)
  944. else
  945. ErrorBox(#3'Could not set Breakpoint'#13+
  946. #3+BreakpointTypeStr[typ]+' '+GetStr(Name),nil);
  947. state:=bs_disabled;
  948. end;
  949. end
  950. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  951. Enable
  952. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  953. Disable;
  954. end;
  955. procedure TBreakpoint.Remove;
  956. begin
  957. If not assigned(Debugger) then Exit;
  958. if GDBIndex>0 then
  959. Debugger^.Command('delete '+IntToStr(GDBIndex));
  960. GDBIndex:=0;
  961. GDBState:=bs_deleted;
  962. end;
  963. procedure TBreakpoint.Enable;
  964. begin
  965. If not assigned(Debugger) then Exit;
  966. if GDBIndex>0 then
  967. Debugger^.Command('enable '+IntToStr(GDBIndex))
  968. else
  969. Insert;
  970. GDBState:=bs_enabled;
  971. end;
  972. procedure TBreakpoint.Disable;
  973. begin
  974. If not assigned(Debugger) then Exit;
  975. if GDBIndex>0 then
  976. Debugger^.Command('disable '+IntToStr(GDBIndex));
  977. GDBState:=bs_disabled;
  978. end;
  979. procedure TBreakpoint.ResetValues;
  980. begin
  981. if assigned(OldValue) then
  982. DisposeStr(OldValue);
  983. OldValue:=nil;
  984. if assigned(CurrentValue) then
  985. DisposeStr(CurrentValue);
  986. CurrentValue:=nil;
  987. end;
  988. procedure TBreakpoint.UpdateSource;
  989. var W: PSourceWindow;
  990. b : boolean;
  991. begin
  992. if typ=bt_file_line then
  993. begin
  994. W:=SearchOnDesktop(GetStr(FileName),false);
  995. If assigned(W) then
  996. begin
  997. if state=bs_enabled then
  998. b:=true
  999. else
  1000. b:=false;
  1001. W^.Editor^.SetLineBreakState(Line,b);
  1002. end;
  1003. end;
  1004. end;
  1005. destructor TBreakpoint.Done;
  1006. begin
  1007. Remove;
  1008. ResetValues;
  1009. if assigned(Name) then
  1010. DisposeStr(Name);
  1011. if assigned(FileName) then
  1012. DisposeStr(FileName);
  1013. if assigned(Conditions) then
  1014. DisposeStr(Conditions);
  1015. if assigned(Commands) then
  1016. StrDispose(Commands);
  1017. inherited Done;
  1018. end;
  1019. {****************************************************************************
  1020. TBreakpointCollection
  1021. ****************************************************************************}
  1022. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1023. begin
  1024. At:=inherited At(Index);
  1025. end;
  1026. procedure TBreakpointCollection.Update;
  1027. begin
  1028. if assigned(Debugger) then
  1029. begin
  1030. Debugger^.RemoveBreakpoints;
  1031. Debugger^.InsertBreakpoints;
  1032. end;
  1033. if assigned(BreakpointsWindow) then
  1034. BreakpointsWindow^.Update;
  1035. end;
  1036. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1037. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1038. begin
  1039. IsNum:=P^.GDBIndex=index;
  1040. end;
  1041. begin
  1042. if index=0 then
  1043. GetGDB:=nil
  1044. else
  1045. GetGDB:=FirstThat(@IsNum);
  1046. end;
  1047. procedure TBreakpointCollection.ShowBreakpoints(W : PSourceWindow);
  1048. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1049. begin
  1050. If assigned(P^.FileName) and
  1051. (GDBFileName(FExpand(P^.FileName^))=GDBFileName(FExpand(W^.Editor^.FileName))) then
  1052. W^.Editor^.SetLineBreakState(P^.Line,P^.state=bs_enabled);
  1053. end;
  1054. begin
  1055. ForEach(@SetInSource);
  1056. end;
  1057. procedure TBreakpointCollection.ShowAllBreakpoints;
  1058. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1059. var
  1060. W : PSourceWindow;
  1061. begin
  1062. If assigned(P^.FileName) then
  1063. begin
  1064. W:=SearchOnDesktop(P^.FileName^,false);
  1065. if assigned(W) then
  1066. W^.Editor^.SetLineBreakState(P^.Line,P^.state=bs_enabled);
  1067. end;
  1068. end;
  1069. begin
  1070. ForEach(@SetInSource);
  1071. end;
  1072. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1073. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1074. begin
  1075. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1076. end;
  1077. begin
  1078. GetType:=FirstThat(@IsThis);
  1079. end;
  1080. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1081. var PB : PBreakpoint;
  1082. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1083. begin
  1084. IsThere:=(P^.typ=bt_file_line) and (P^.FileName^=FileName) and (P^.Line=LineNr);
  1085. end;
  1086. begin
  1087. FileName:=GDBFileName(FileName);
  1088. PB:=FirstThat(@IsThere);
  1089. ToggleFileLine:=false;
  1090. If Assigned(PB) then
  1091. if PB^.state=bs_disabled then
  1092. begin
  1093. PB^.state:=bs_enabled;
  1094. ToggleFileLine:=true;
  1095. end
  1096. else if PB^.state=bs_enabled then
  1097. PB^.state:=bs_disabled;
  1098. If not assigned(PB) then
  1099. begin
  1100. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1101. if assigned(PB) then
  1102. Begin
  1103. Insert(PB);
  1104. ToggleFileLine:=true;
  1105. End;
  1106. end;
  1107. if assigned(PB) then
  1108. PB^.UpdateSource;
  1109. Update;
  1110. end;
  1111. {****************************************************************************
  1112. TBreakpointItem
  1113. ****************************************************************************}
  1114. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1115. begin
  1116. inherited Init;
  1117. Breakpoint:=ABreakpoint;
  1118. end;
  1119. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1120. var S: string;
  1121. begin
  1122. with Breakpoint^ do
  1123. begin
  1124. S:=BreakpointTypeStr[typ];
  1125. While Length(S)<10 do
  1126. S:=S+' ';
  1127. S:=S+'|';
  1128. S:=S+BreakpointStateStr[state]+' ';
  1129. While Length(S)<20 do
  1130. S:=S+' ';
  1131. S:=S+'|';
  1132. if (typ=bt_file_line) then
  1133. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
  1134. else
  1135. S:=S+GetStr(name);
  1136. While Length(S)<40 do
  1137. S:=S+' ';
  1138. S:=S+'|';
  1139. if IgnoreCount>0 then
  1140. S:=S+IntToStr(IgnoreCount);
  1141. While Length(S)<49 do
  1142. S:=S+' ';
  1143. S:=S+'|';
  1144. if assigned(Conditions) then
  1145. S:=S+' '+GetStr(Conditions);
  1146. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1147. GetText:=S;
  1148. end;
  1149. end;
  1150. procedure TBreakpointItem.Selected;
  1151. begin
  1152. end;
  1153. function TBreakpointItem.GetModuleName: string;
  1154. begin
  1155. if breakpoint^.typ=bt_file_line then
  1156. GetModuleName:=GetStr(breakpoint^.FileName)
  1157. else
  1158. GetModuleName:='';
  1159. end;
  1160. {****************************************************************************
  1161. TBreakpointsListBox
  1162. ****************************************************************************}
  1163. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1164. begin
  1165. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1166. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1167. NoSelection:=true;
  1168. end;
  1169. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1170. var M: PMenu;
  1171. begin
  1172. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1173. M:=NewMenu(
  1174. NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1175. NewItem('~E~dit breakpoint','',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1176. NewItem('~N~ew breakpoint','',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1177. NewItem('~D~elete breakpoint','',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1178. NewItem('~T~oggle state','',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1179. nil))))));
  1180. GetLocalMenu:=M;
  1181. end;
  1182. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1183. var DontClear: boolean;
  1184. begin
  1185. case Event.What of
  1186. evKeyDown :
  1187. begin
  1188. DontClear:=false;
  1189. case Event.KeyCode of
  1190. kbEnter :
  1191. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1192. kbIns :
  1193. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1194. kbDel :
  1195. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1196. else
  1197. DontClear:=true;
  1198. end;
  1199. if not DontClear then
  1200. ClearEvent(Event);
  1201. end;
  1202. evBroadcast :
  1203. case Event.Command of
  1204. cmListItemSelected :
  1205. if Event.InfoPtr=@Self then
  1206. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1207. end;
  1208. evCommand :
  1209. begin
  1210. DontClear:=false;
  1211. case Event.Command of
  1212. cmMsgTrackSource :
  1213. if Range>0 then
  1214. TrackSource;
  1215. cmEditBreakpoint :
  1216. EditCurrent;
  1217. cmToggleBreakpoint :
  1218. ToggleCurrent;
  1219. cmDeleteBreakpoint :
  1220. DeleteCurrent;
  1221. cmNewBreakpoint :
  1222. EditNew;
  1223. cmMsgClear :
  1224. Clear;
  1225. else
  1226. DontClear:=true;
  1227. end;
  1228. if not DontClear then
  1229. ClearEvent(Event);
  1230. end;
  1231. end;
  1232. inherited HandleEvent(Event);
  1233. end;
  1234. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1235. var W : integer;
  1236. begin
  1237. if List=nil then New(List, Init(20,20));
  1238. W:=length(P^.GetText(255));
  1239. if W>MaxWidth then
  1240. begin
  1241. MaxWidth:=W;
  1242. if HScrollBar<>nil then
  1243. HScrollBar^.SetRange(0,MaxWidth);
  1244. end;
  1245. List^.Insert(P);
  1246. SetRange(List^.Count);
  1247. if Focused=List^.Count-1-1 then
  1248. FocusItem(List^.Count-1);
  1249. P^.Breakpoint^.UpdateSource;
  1250. DrawView;
  1251. end;
  1252. (* function TBreakpointsListBox.AddModuleName(const Name: string): PString;
  1253. var P: PString;
  1254. begin
  1255. if ModuleNames<>nil then
  1256. P:=ModuleNames^.Add(Name)
  1257. else
  1258. P:=nil;
  1259. AddModuleName:=P;
  1260. end; *)
  1261. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1262. var P: PBreakpointItem;
  1263. S: string;
  1264. begin
  1265. P:=List^.At(Item);
  1266. S:=P^.GetText(MaxLen);
  1267. GetText:=copy(S,1,MaxLen);
  1268. end;
  1269. procedure TBreakpointsListBox.Clear;
  1270. begin
  1271. if assigned(List) then
  1272. Dispose(List, Done);
  1273. List:=nil;
  1274. MaxWidth:=0;
  1275. (* if assigned(ModuleNames) then
  1276. ModuleNames^.FreeAll; *)
  1277. SetRange(0); DrawView;
  1278. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1279. end;
  1280. procedure TBreakpointsListBox.TrackSource;
  1281. var W: PSourceWindow;
  1282. P: PBreakpointItem;
  1283. R: TRect;
  1284. (* Row,Col: sw_integer; *)
  1285. begin
  1286. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1287. if Range=0 then Exit;*)
  1288. P:=List^.At(Focused);
  1289. if P^.GetModuleName='' then Exit;
  1290. Desktop^.Lock;
  1291. GetNextEditorBounds(R);
  1292. R.B.Y:=Owner^.Origin.Y;
  1293. W:=EditorWindowFile(P^.GetModuleName);
  1294. if assigned(W) then
  1295. begin
  1296. W^.GetExtent(R);
  1297. R.B.Y:=Owner^.Origin.Y;
  1298. W^.ChangeBounds(R);
  1299. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1300. end
  1301. else
  1302. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1303. if W<>nil then
  1304. begin
  1305. W^.Select;
  1306. W^.Editor^.TrackCursor(true);
  1307. W^.Editor^.SetHighlightRow(P^.Breakpoint^.Line);
  1308. end;
  1309. if Assigned(Owner) then
  1310. Owner^.Select;
  1311. Desktop^.UnLock;
  1312. end;
  1313. procedure TBreakpointsListBox.ToggleCurrent;
  1314. var
  1315. P: PBreakpointItem;
  1316. begin
  1317. if Range=0 then Exit;
  1318. P:=List^.At(Focused);
  1319. if P=nil then Exit;
  1320. if P^.Breakpoint^.state=bs_enabled then
  1321. P^.Breakpoint^.state:=bs_disabled
  1322. else if P^.Breakpoint^.state=bs_disabled then
  1323. P^.Breakpoint^.state:=bs_enabled;
  1324. P^.Breakpoint^.UpdateSource;
  1325. BreakpointsCollection^.Update;
  1326. end;
  1327. procedure TBreakpointsListBox.EditCurrent;
  1328. var
  1329. P: PBreakpointItem;
  1330. begin
  1331. if Range=0 then Exit;
  1332. P:=List^.At(Focused);
  1333. if P=nil then Exit;
  1334. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  1335. P^.Breakpoint^.UpdateSource;
  1336. BreakpointsCollection^.Update;
  1337. end;
  1338. procedure TBreakpointsListBox.DeleteCurrent;
  1339. var
  1340. P: PBreakpointItem;
  1341. begin
  1342. if Range=0 then Exit;
  1343. P:=List^.At(Focused);
  1344. if P=nil then Exit;
  1345. { delete it form source window }
  1346. P^.Breakpoint^.state:=bs_disabled;
  1347. P^.Breakpoint^.UpdateSource;
  1348. BreakpointsCollection^.free(P^.Breakpoint);
  1349. List^.free(P);
  1350. BreakpointsCollection^.Update;
  1351. end;
  1352. procedure TBreakpointsListBox.EditNew;
  1353. var
  1354. P: PBreakpoint;
  1355. begin
  1356. P:=New(PBreakpoint,Init_Empty);
  1357. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  1358. begin
  1359. P^.UpdateSource;
  1360. BreakpointsCollection^.Insert(P);
  1361. BreakpointsCollection^.Update;
  1362. end
  1363. else
  1364. dispose(P,Done);
  1365. end;
  1366. procedure TBreakpointsListBox.Draw;
  1367. var
  1368. I, J, Item: Sw_Integer;
  1369. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1370. ColWidth, CurCol, Indent: Integer;
  1371. B: TDrawBuffer;
  1372. Text: String;
  1373. SCOff: Byte;
  1374. TC: byte;
  1375. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1376. begin
  1377. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1378. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1379. begin
  1380. NormalColor := GetColor(1);
  1381. FocusedColor := GetColor(3);
  1382. SelectedColor := GetColor(4);
  1383. end else
  1384. begin
  1385. NormalColor := GetColor(2);
  1386. SelectedColor := GetColor(4);
  1387. end;
  1388. if Transparent then
  1389. begin MT(NormalColor); MT(SelectedColor); end;
  1390. if NoSelection then
  1391. SelectedColor:=NormalColor;
  1392. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1393. else Indent := 0;
  1394. ColWidth := Size.X div NumCols + 1;
  1395. for I := 0 to Size.Y - 1 do
  1396. begin
  1397. for J := 0 to NumCols-1 do
  1398. begin
  1399. Item := J*Size.Y + I + TopItem;
  1400. CurCol := J*ColWidth;
  1401. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1402. (Focused = Item) and (Range > 0) then
  1403. begin
  1404. Color := FocusedColor;
  1405. SetCursor(CurCol+1,I);
  1406. SCOff := 0;
  1407. end
  1408. else if (Item < Range) and IsSelected(Item) then
  1409. begin
  1410. Color := SelectedColor;
  1411. SCOff := 2;
  1412. end
  1413. else
  1414. begin
  1415. Color := NormalColor;
  1416. SCOff := 4;
  1417. end;
  1418. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1419. if Item < Range then
  1420. begin
  1421. Text := GetText(Item, ColWidth + Indent);
  1422. Text := Copy(Text,Indent,ColWidth);
  1423. MoveStr(B[CurCol+1], Text, Color);
  1424. if ShowMarkers then
  1425. begin
  1426. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1427. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1428. end;
  1429. end;
  1430. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1431. end;
  1432. WriteLine(0, I, Size.X, 1, B);
  1433. end;
  1434. end;
  1435. constructor TBreakpointsListBox.Load(var S: TStream);
  1436. begin
  1437. inherited Load(S);
  1438. end;
  1439. procedure TBreakpointsListBox.Store(var S: TStream);
  1440. var OL: PCollection;
  1441. OldR : integer;
  1442. begin
  1443. OL:=List;
  1444. OldR:=Range;
  1445. Range:=0;
  1446. New(List, Init(1,1));
  1447. inherited Store(S);
  1448. Dispose(List, Done);
  1449. Range:=OldR;
  1450. List:=OL;
  1451. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1452. collection? Pasting here a modified version of TListBox.Store+
  1453. TAdvancedListBox.Store isn't a better solution, since by eventually
  1454. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1455. end;
  1456. destructor TBreakpointsListBox.Done;
  1457. begin
  1458. inherited Done;
  1459. if List<>nil then Dispose(List, Done);
  1460. (* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
  1461. end;
  1462. {****************************************************************************
  1463. TBreakpointsWindow
  1464. ****************************************************************************}
  1465. constructor TBreakpointsWindow.Init;
  1466. var R,R2: TRect;
  1467. HSB,VSB: PScrollBar;
  1468. ST: PStaticText;
  1469. S: String;
  1470. X,X1 : Sw_integer;
  1471. const White = 15;
  1472. begin
  1473. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  1474. inherited Init(R, 'Breakpoint list', wnNoNumber);
  1475. HelpCtx:=hcBreakpointListWindow;
  1476. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1477. S:=' Type | State | Position | Ignore | Conditions ';
  1478. New(ST, Init(R,S));
  1479. ST^.GrowMode:=gfGrowHiX;
  1480. Insert(ST);
  1481. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  1482. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  1483. ST^.GrowMode:=gfGrowHiX;
  1484. Insert(ST);
  1485. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  1486. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1487. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1488. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1489. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1490. New(BreakLB, Init(R,HSB,VSB));
  1491. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1492. BreakLB^.Transparent:=true;
  1493. Insert(BreakLB);
  1494. GetExtent(R);R.Grow(-1,-1);
  1495. Dec(R.B.Y);
  1496. R.A.Y:=R.B.Y-2;
  1497. X:=(R.B.X-R.A.X) div 4;
  1498. X1:=R.A.X+(X div 2);
  1499. R.A.X:=X1-3;R.B.X:=X1+7;
  1500. Insert(New(PButton, Init(R, '~C~lose', cmClose, bfDefault)));
  1501. X1:=X1+X;
  1502. R.A.X:=X1-3;R.B.X:=X1+7;
  1503. Insert(New(PButton, Init(R, '~N~ew', cmNewBreakpoint, bfNormal)));
  1504. X1:=X1+X;
  1505. R.A.X:=X1-3;R.B.X:=X1+7;
  1506. Insert(New(PButton, Init(R, '~E~dit', cmEditBreakpoint, bfNormal)));
  1507. X1:=X1+X;
  1508. R.A.X:=X1-3;R.B.X:=X1+7;
  1509. Insert(New(PButton, Init(R, '~D~elete', cmDeleteBreakpoint, bfNormal)));
  1510. BreakLB^.Select;
  1511. Update;
  1512. BreakpointsWindow:=@self;
  1513. end;
  1514. constructor TBreakpointsWindow.Load(var S: TStream);
  1515. begin
  1516. inherited Load(S);
  1517. GetSubViewPtr(S,BreakLB);
  1518. end;
  1519. procedure TBreakpointsWindow.Store(var S: TStream);
  1520. begin
  1521. inherited Store(S);
  1522. PutSubViewPtr(S,BreakLB);
  1523. end;
  1524. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  1525. begin
  1526. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  1527. end;
  1528. procedure TBreakpointsWindow.ClearBreakpoints;
  1529. begin
  1530. BreakLB^.Clear;
  1531. ReDraw;
  1532. end;
  1533. procedure TBreakpointsWindow.ReloadBreakpoints;
  1534. procedure InsertInBreakLB(P : PBreakpoint);
  1535. begin
  1536. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  1537. end;
  1538. begin
  1539. If not assigned(BreakpointsCollection) then
  1540. exit;
  1541. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  1542. ReDraw;
  1543. end;
  1544. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  1545. begin
  1546. inherited SizeLimits(Min,Max);
  1547. Min.X:=40; Min.Y:=18;
  1548. end;
  1549. procedure TBreakpointsWindow.Close;
  1550. begin
  1551. Hide;
  1552. end;
  1553. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  1554. var DontClear : boolean;
  1555. begin
  1556. case Event.What of
  1557. evKeyDown :
  1558. begin
  1559. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  1560. begin
  1561. ClearEvent(Event);
  1562. Hide;
  1563. end;
  1564. end;
  1565. evCommand :
  1566. begin
  1567. DontClear:=False;
  1568. case Event.Command of
  1569. cmNewBreakpoint :
  1570. BreakLB^.EditNew;
  1571. cmEditBreakpoint :
  1572. BreakLB^.EditCurrent;
  1573. cmDeleteBreakpoint :
  1574. BreakLB^.DeleteCurrent;
  1575. cmClose :
  1576. Hide;
  1577. else
  1578. DontClear:=true;
  1579. end;
  1580. if not DontClear then
  1581. ClearEvent(Event);
  1582. end;
  1583. evBroadcast :
  1584. case Event.Command of
  1585. cmUpdate :
  1586. Update;
  1587. end;
  1588. end;
  1589. inherited HandleEvent(Event);
  1590. end;
  1591. procedure TBreakpointsWindow.Update;
  1592. begin
  1593. ClearBreakpoints;
  1594. ReloadBreakpoints;
  1595. end;
  1596. destructor TBreakpointsWindow.Done;
  1597. begin
  1598. inherited Done;
  1599. BreakpointsWindow:=nil;
  1600. end;
  1601. {****************************************************************************
  1602. TBreakpointItemDialog
  1603. ****************************************************************************}
  1604. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  1605. var R,R2,R3: TRect;
  1606. Items: PSItem;
  1607. I : BreakpointType;
  1608. KeyCount: sw_integer;
  1609. begin
  1610. KeyCount:=longint(high(BreakpointType));
  1611. R.Assign(0,0,60,Max(3+KeyCount,18));
  1612. inherited Init(R,'Modify/New Breakpoint');
  1613. Breakpoint:=ABreakpoint;
  1614. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  1615. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  1616. New(NameIL, Init(R, 128)); Insert(NameIL);
  1617. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~N~ame', NameIL)));
  1618. R.Move(0,3);
  1619. New(LineIL, Init(R, 128)); Insert(LineIL);
  1620. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1621. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~L~ine', LineIL)));
  1622. R.Move(0,3);
  1623. New(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
  1624. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, 'Conditions', ConditionsIL)));
  1625. R.Move(0,3);
  1626. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  1627. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1628. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~I~gnore count', IgnoreIL)));
  1629. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  1630. Items:=nil;
  1631. for I:=high(BreakpointType) downto low(BreakpointType) do
  1632. Items:=NewSItem(BreakpointTypeStr[I], Items);
  1633. New(TypeRB, Init(R, Items));
  1634. Insert(TypeRB);
  1635. InsertButtons(@Self);
  1636. NameIL^.Select;
  1637. end;
  1638. function TBreakpointItemDialog.Execute: Word;
  1639. var R: word;
  1640. S1: string;
  1641. err: word;
  1642. L: longint;
  1643. begin
  1644. R:=longint(Breakpoint^.typ);
  1645. TypeRB^.SetData(R);
  1646. If Breakpoint^.typ=bt_file_line then
  1647. S1:=GetStr(Breakpoint^.FileName)
  1648. else
  1649. S1:=GetStr(Breakpoint^.name);
  1650. NameIL^.SetData(S1);
  1651. If Breakpoint^.typ=bt_file_line then
  1652. S1:=IntToStr(Breakpoint^.Line)
  1653. else
  1654. S1:='0';
  1655. LineIL^.SetData(S1);
  1656. S1:=IntToStr(Breakpoint^.IgnoreCount);
  1657. IgnoreIL^.SetData(S1);
  1658. S1:=GetStr(Breakpoint^.Conditions);
  1659. ConditionsIL^.SetData(S1);
  1660. R:=inherited Execute;
  1661. if R=cmOK then
  1662. begin
  1663. TypeRB^.GetData(R);
  1664. L:=R;
  1665. Breakpoint^.typ:=BreakpointType(L);
  1666. NameIL^.GetData(S1);
  1667. If Breakpoint^.typ=bt_file_line then
  1668. begin
  1669. If assigned(Breakpoint^.FileName) then
  1670. DisposeStr(Breakpoint^.FileName);
  1671. Breakpoint^.FileName:=NewStr(S1);
  1672. end
  1673. else
  1674. begin
  1675. If assigned(Breakpoint^.Name) then
  1676. DisposeStr(Breakpoint^.Name);
  1677. Breakpoint^.name:=NewStr(S1);
  1678. end;
  1679. If Breakpoint^.typ=bt_file_line then
  1680. begin
  1681. LineIL^.GetData(S1);
  1682. Val(S1,L,err);
  1683. Breakpoint^.Line:=L;
  1684. end;
  1685. IgnoreIL^.GetData(S1);
  1686. Val(S1,L,err);
  1687. Breakpoint^.IgnoreCount:=L;
  1688. ConditionsIL^.GetData(S1);
  1689. If assigned(Breakpoint^.Conditions) then
  1690. DisposeStr(Breakpoint^.Conditions);
  1691. Breakpoint^.Conditions:=NewStr(S1);
  1692. end;
  1693. Execute:=R;
  1694. end;
  1695. {****************************************************************************
  1696. TWatch
  1697. ****************************************************************************}
  1698. constructor TWatch.Init(s : string);
  1699. begin
  1700. expr:=NewStr(s);
  1701. last_value:=nil;
  1702. current_value:=nil;
  1703. Get_new_value;
  1704. end;
  1705. constructor TWatch.Load(var S: TStream);
  1706. begin
  1707. expr:=S.ReadStr;
  1708. last_value:=nil;
  1709. current_value:=nil;
  1710. Get_new_value;
  1711. end;
  1712. procedure TWatch.Store(var S: TStream);
  1713. begin
  1714. S.WriteStr(expr);
  1715. end;
  1716. procedure TWatch.rename(s : string);
  1717. begin
  1718. if assigned(expr) then
  1719. begin
  1720. if GetStr(expr)=S then
  1721. exit;
  1722. DisposeStr(expr);
  1723. end;
  1724. expr:=NewStr(s);
  1725. if assigned(last_value) then
  1726. StrDispose(last_value);
  1727. last_value:=nil;
  1728. if assigned(current_value) then
  1729. StrDispose(current_value);
  1730. current_value:=nil;
  1731. Get_new_value;
  1732. end;
  1733. procedure TWatch.Get_new_value;
  1734. var p, q : pchar;
  1735. i, j, curframe, startframe : longint;
  1736. error : integer;
  1737. c : char;
  1738. s,s2 : string;
  1739. loop_higher, found, last_removed : boolean;
  1740. function GetValue(var s : string) : boolean;
  1741. begin
  1742. Debugger^.command('p '+s);
  1743. if not Debugger^.Error then
  1744. begin
  1745. s:=StrPas(Debugger^.GetOutput);
  1746. GetValue:=true;
  1747. end
  1748. else
  1749. begin
  1750. s:=StrPas(Debugger^.GetError);
  1751. GetValue:=false;
  1752. { do not open a messagebox for such errors }
  1753. Debugger^.got_error:=false;
  1754. end;
  1755. end;
  1756. begin
  1757. If not assigned(Debugger) then
  1758. exit;
  1759. if assigned(last_value) then
  1760. strdispose(last_value);
  1761. last_value:=current_value;
  1762. s:=GetStr(expr);
  1763. found:=GetValue(s);
  1764. Debugger^.got_error:=false;
  1765. loop_higher:=not found;
  1766. curframe:=Debugger^.get_current_frame;
  1767. startframe:=curframe;
  1768. while loop_higher do
  1769. begin
  1770. s:='parent_ebp';
  1771. if GetValue(s) then
  1772. begin
  1773. repeat
  1774. inc(curframe);
  1775. if not Debugger^.set_current_frame(curframe) then
  1776. loop_higher:=false;
  1777. s2:='/x $ebp';
  1778. getValue(s2);
  1779. j:=pos('=',s2);
  1780. if j>0 then
  1781. s2:=copy(s2,j+1,length(s2));
  1782. while s2[1] in [' ',TAB] do
  1783. delete(s2,1,1);
  1784. if pos(s2,s)>0 then
  1785. loop_higher :=false;
  1786. until not loop_higher;
  1787. { try again at that level }
  1788. s:=GetStr(expr);
  1789. loop_higher:=not GetValue(s);
  1790. end
  1791. else
  1792. loop_higher:=false;
  1793. end;
  1794. s:=GetStr(expr);
  1795. if GetValue(s) then
  1796. p:=StrNew(Debugger^.GetOutput)
  1797. else
  1798. p:=StrNew(Debugger^.GetError);
  1799. Debugger^.got_error:=false;
  1800. { We should try here to find the expr in parent
  1801. procedure if there are
  1802. I will implement this as I added a
  1803. parent_ebp pseudo local var to local procedure
  1804. in stabs debug info PM }
  1805. { But there are some pitfalls like
  1806. locals redefined in other sublocals that call the function }
  1807. Debugger^.set_current_frame(startframe);
  1808. q:=nil;
  1809. if assigned(p) and (p[0]='$') then
  1810. q:=StrPos(p,'=');
  1811. if not assigned(q) then
  1812. q:=p;
  1813. if assigned(q) then
  1814. i:=strlen(q)
  1815. else
  1816. i:=0;
  1817. if (i>0) and (q[i-1]=#10) then
  1818. begin
  1819. q[i-1]:=#0;
  1820. last_removed:=true;
  1821. end
  1822. else
  1823. last_removed:=false;
  1824. if assigned(q) then
  1825. current_value:=strnew(q)
  1826. else
  1827. current_value:=strnew('');
  1828. if last_removed then
  1829. q[i-1]:=#10;
  1830. strdispose(p);
  1831. end;
  1832. destructor TWatch.Done;
  1833. begin
  1834. if assigned(expr) then
  1835. disposestr(expr);
  1836. if assigned(last_value) then
  1837. strdispose(last_value);
  1838. if assigned(current_value) then
  1839. strdispose(current_value);
  1840. inherited done;
  1841. end;
  1842. {****************************************************************************
  1843. TWatchesCollection
  1844. ****************************************************************************}
  1845. constructor TWatchesCollection.Init;
  1846. begin
  1847. inherited Init(10,10);
  1848. end;
  1849. procedure TWatchesCollection.Insert(Item: Pointer);
  1850. begin
  1851. PWatch(Item)^.Get_new_value;
  1852. Inherited Insert(Item);
  1853. Update;
  1854. end;
  1855. procedure TWatchesCollection.Update;
  1856. var
  1857. W,W1 : integer;
  1858. procedure GetMax(P : PWatch);
  1859. begin
  1860. if assigned(P^.Current_value) then
  1861. begin
  1862. W1:=StrLen(P^.Current_value)+2+Length(GetStr(P^.expr));
  1863. if W1>W then
  1864. W:=W1;
  1865. end;
  1866. end;
  1867. begin
  1868. W:=0;
  1869. ForEach(@GetMax);
  1870. MaxW:=W;
  1871. If assigned(WatchesWindow) then
  1872. WatchesWindow^.WLB^.Update(MaxW);
  1873. end;
  1874. function TWatchesCollection.At(Index: Integer): PWatch;
  1875. begin
  1876. At:=Inherited At(Index);
  1877. end;
  1878. {****************************************************************************
  1879. TWatchesListBox
  1880. ****************************************************************************}
  1881. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1882. begin
  1883. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  1884. If assigned(List) then
  1885. dispose(list,done);
  1886. List:=WatchesCollection;
  1887. end;
  1888. procedure TWatchesListBox.Update(AMaxWidth : integer);
  1889. var R : TRect;
  1890. begin
  1891. GetExtent(R);
  1892. MaxWidth:=AMaxWidth;
  1893. if HScrollBar<>nil then
  1894. HScrollBar^.SetRange(0,MaxWidth);
  1895. if R.B.X-R.A.X>MaxWidth then
  1896. HScrollBar^.Hide
  1897. else
  1898. HScrollBar^.Show;
  1899. SetRange(List^.Count);
  1900. if R.B.Y-R.A.Y>Range then
  1901. VScrollBar^.Hide
  1902. else
  1903. VScrollBar^.Show;
  1904. if Focused=List^.Count-1-1 then
  1905. FocusItem(List^.Count-1);
  1906. DrawView;
  1907. end;
  1908. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String;
  1909. var
  1910. PW : PWatch;
  1911. ValOffset : Sw_integer;
  1912. S : String;
  1913. begin
  1914. PW:=WatchesCollection^.At(Item);
  1915. ValOffset:=Length(GetStr(PW^.Expr))+2;
  1916. if Indent<ValOffset then
  1917. begin
  1918. if not assigned(PW^.current_value) then
  1919. S:=' '+GetStr(PW^.Expr)+' <Unknown value>'
  1920. else if not assigned(PW^.last_value) or
  1921. (strcomp(PW^.Last_value,PW^.Current_value)=0) then
  1922. S:=' '+GetStr(PW^.Expr)+' '+GetPChar(PW^.Current_value)
  1923. else
  1924. S:='!'+GetStr(PW^.Expr)+'!'+GetPchar(PW^.Current_value);
  1925. GetIndentedText:=Copy(S,Indent,MaxLen);
  1926. end
  1927. else
  1928. begin
  1929. if not assigned(PW^.Current_value) or
  1930. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  1931. S:=''
  1932. else
  1933. S:=GetStr(@(PW^.Current_Value[Indent-Valoffset]));
  1934. GetIndentedText:=Copy(S,1,MaxLen);
  1935. end;
  1936. end;
  1937. procedure TWatchesListBox.EditCurrent;
  1938. var
  1939. P: PWatch;
  1940. begin
  1941. if Range=0 then Exit;
  1942. P:=WatchesCollection^.At(Focused);
  1943. if P=nil then Exit;
  1944. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  1945. WatchesCollection^.Update;
  1946. end;
  1947. procedure TWatchesListBox.DeleteCurrent;
  1948. var
  1949. P: PWatch;
  1950. begin
  1951. if Range=0 then Exit;
  1952. P:=WatchesCollection^.At(Focused);
  1953. if P=nil then Exit;
  1954. WatchesCollection^.free(P);
  1955. WatchesCollection^.Update;
  1956. end;
  1957. procedure TWatchesListBox.EditNew;
  1958. var
  1959. P: PWatch;
  1960. begin
  1961. P:=New(PWatch,Init(''));
  1962. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  1963. begin
  1964. WatchesCollection^.Insert(P);
  1965. WatchesCollection^.Update;
  1966. end
  1967. else
  1968. dispose(P,Done);
  1969. end;
  1970. procedure TWatchesListBox.Draw;
  1971. var
  1972. I, J, Item: Sw_Integer;
  1973. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1974. ColWidth, CurCol, Indent: Integer;
  1975. B: TDrawBuffer;
  1976. Text: String;
  1977. SCOff: Byte;
  1978. TC: byte;
  1979. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1980. begin
  1981. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1982. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1983. begin
  1984. NormalColor := GetColor(1);
  1985. FocusedColor := GetColor(3);
  1986. SelectedColor := GetColor(4);
  1987. end else
  1988. begin
  1989. NormalColor := GetColor(2);
  1990. SelectedColor := GetColor(4);
  1991. end;
  1992. if Transparent then
  1993. begin MT(NormalColor); MT(SelectedColor); end;
  1994. (* if NoSelection then
  1995. SelectedColor:=NormalColor;*)
  1996. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1997. else Indent := 0;
  1998. ColWidth := Size.X div NumCols + 1;
  1999. for I := 0 to Size.Y - 1 do
  2000. begin
  2001. for J := 0 to NumCols-1 do
  2002. begin
  2003. Item := J*Size.Y + I + TopItem;
  2004. CurCol := J*ColWidth;
  2005. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2006. (Focused = Item) and (Range > 0) then
  2007. begin
  2008. Color := FocusedColor;
  2009. SetCursor(CurCol+1,I);
  2010. SCOff := 0;
  2011. end
  2012. else if (Item < Range) and IsSelected(Item) then
  2013. begin
  2014. Color := SelectedColor;
  2015. SCOff := 2;
  2016. end
  2017. else
  2018. begin
  2019. Color := NormalColor;
  2020. SCOff := 4;
  2021. end;
  2022. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2023. if Item < Range then
  2024. begin
  2025. (* Text := GetText(Item, ColWidth + Indent);
  2026. Text := Copy(Text,Indent,ColWidth); *)
  2027. Text:=GetIndentedText(Item,Indent,ColWidth);
  2028. MoveStr(B[CurCol+1], Text, Color);
  2029. if ShowMarkers then
  2030. begin
  2031. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2032. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2033. end;
  2034. end;
  2035. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2036. end;
  2037. WriteLine(0, I, Size.X, 1, B);
  2038. end;
  2039. end;
  2040. function TWatchesListBox.GetLocalMenu: PMenu;
  2041. var M: PMenu;
  2042. begin
  2043. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2044. M:=NewMenu(
  2045. NewItem('~E~dit watch','',kbNoKey,cmEdit,hcNoContext,
  2046. NewItem('~N~ew watch','',kbNoKey,cmNew,hcNoContext,
  2047. NewItem('~D~elete watch','',kbNoKey,cmDelete,hcNoContext,
  2048. nil))));
  2049. GetLocalMenu:=M;
  2050. end;
  2051. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2052. var DontClear: boolean;
  2053. begin
  2054. case Event.What of
  2055. evKeyDown :
  2056. begin
  2057. DontClear:=false;
  2058. case Event.KeyCode of
  2059. kbEnter :
  2060. Message(@Self,evCommand,cmEdit,nil);
  2061. kbIns :
  2062. Message(@Self,evCommand,cmNew,nil);
  2063. kbDel :
  2064. Message(@Self,evCommand,cmDelete,nil);
  2065. else
  2066. DontClear:=true;
  2067. end;
  2068. if not DontClear then
  2069. ClearEvent(Event);
  2070. end;
  2071. evBroadcast :
  2072. case Event.Command of
  2073. cmListItemSelected :
  2074. if Event.InfoPtr=@Self then
  2075. Message(@Self,evCommand,cmEdit,nil);
  2076. end;
  2077. evCommand :
  2078. begin
  2079. DontClear:=false;
  2080. case Event.Command of
  2081. cmEdit :
  2082. EditCurrent;
  2083. cmDelete :
  2084. DeleteCurrent;
  2085. cmNew :
  2086. EditNew;
  2087. else
  2088. DontClear:=true;
  2089. end;
  2090. if not DontClear then
  2091. ClearEvent(Event);
  2092. end;
  2093. end;
  2094. inherited HandleEvent(Event);
  2095. end;
  2096. constructor TWatchesListBox.Load(var S: TStream);
  2097. begin
  2098. inherited Load(S);
  2099. If assigned(List) then
  2100. dispose(list,done);
  2101. List:=WatchesCollection;
  2102. { we must set Range PM }
  2103. SetRange(List^.count);
  2104. end;
  2105. procedure TWatchesListBox.Store(var S: TStream);
  2106. var OL: PCollection;
  2107. OldRange : Sw_integer;
  2108. begin
  2109. OL:=List;
  2110. OldRange:=Range;
  2111. Range:=0;
  2112. New(List, Init(1,1));
  2113. inherited Store(S);
  2114. Dispose(List, Done);
  2115. List:=OL;
  2116. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2117. collection? Pasting here a modified version of TListBox.Store+
  2118. TAdvancedListBox.Store isn't a better solution, since by eventually
  2119. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2120. SetRange(OldRange);
  2121. end;
  2122. destructor TWatchesListBox.Done;
  2123. begin
  2124. List:=nil;
  2125. inherited Done;
  2126. end;
  2127. {****************************************************************************
  2128. TWatchesWindow
  2129. ****************************************************************************}
  2130. Constructor TWatchesWindow.Init;
  2131. var
  2132. HSB,VSB: PScrollBar;
  2133. R,R2 : trect;
  2134. begin
  2135. Desktop^.GetExtent(R);
  2136. R.A.Y:=R.B.Y-5;
  2137. inherited Init(R, 'Watches', wnNoNumber);
  2138. Palette:=wpCyanWindow;
  2139. GetExtent(R);
  2140. HelpCtx:=hcWatches;
  2141. R.Grow(-1,-1);
  2142. R2.Copy(R);
  2143. Inc(R2.B.Y);
  2144. R2.A.Y:=R2.B.Y-1;
  2145. New(HSB, Init(R2));
  2146. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2147. Insert(HSB);
  2148. R2.Copy(R);
  2149. Inc(R2.B.X);
  2150. R2.A.X:=R2.B.X-1;
  2151. New(VSB, Init(R2));
  2152. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2153. Insert(VSB);
  2154. New(WLB,Init(R,HSB,VSB));
  2155. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2156. WLB^.Transparent:=true;
  2157. Insert(WLB);
  2158. If assigned(WatchesWindow) then
  2159. dispose(WatchesWindow,done);
  2160. WatchesWindow:=@Self;
  2161. Update;
  2162. end;
  2163. procedure TWatchesWindow.Update;
  2164. begin
  2165. WatchesCollection^.Update;
  2166. Draw;
  2167. end;
  2168. constructor TWatchesWindow.Load(var S: TStream);
  2169. begin
  2170. inherited Load(S);
  2171. GetSubViewPtr(S,WLB);
  2172. If assigned(WatchesWindow) then
  2173. dispose(WatchesWindow,done);
  2174. WatchesWindow:=@Self;
  2175. end;
  2176. procedure TWatchesWindow.Store(var S: TStream);
  2177. begin
  2178. inherited Store(S);
  2179. PutSubViewPtr(S,WLB);
  2180. end;
  2181. Destructor TWatchesWindow.Done;
  2182. begin
  2183. WatchesWindow:=nil;
  2184. Dispose(WLB,done);
  2185. inherited done;
  2186. end;
  2187. {****************************************************************************
  2188. TWatchItemDialog
  2189. ****************************************************************************}
  2190. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2191. var R,R2: TRect;
  2192. begin
  2193. R.Assign(0,0,50,10);
  2194. inherited Init(R,'Edit Watch');
  2195. Watch:=AWatch;
  2196. GetExtent(R); R.Grow(-3,-2);
  2197. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2198. New(NameIL, Init(R, 255)); Insert(NameIL);
  2199. R2.Copy(R); R2.Move(-1,-1);
  2200. Insert(New(PLabel, Init(R2, '~E~xpression to watch', NameIL)));
  2201. GetExtent(R);
  2202. R.Grow(-1,-1);
  2203. R.A.Y:=R.A.Y+3;
  2204. R.B.X:=R.A.X+36;
  2205. TextST:=New(PAdvancedStaticText, Init(R, 'Watch values'));
  2206. Insert(TextST);
  2207. InsertButtons(@Self);
  2208. NameIL^.Select;
  2209. end;
  2210. function TWatchItemDialog.Execute: Word;
  2211. var R: word;
  2212. S1,S2: string;
  2213. begin
  2214. S1:=GetStr(Watch^.expr);
  2215. NameIL^.SetData(S1);
  2216. if assigned(Watch^.Current_value) then
  2217. S1:=GetPChar(Watch^.Current_value)
  2218. else
  2219. S1:='';
  2220. if assigned(Watch^.Last_value) then
  2221. S2:=GetPChar(Watch^.Last_value)
  2222. else
  2223. S2:='';
  2224. if assigned(Watch^.Last_value) and
  2225. assigned(Watch^.Current_value) and
  2226. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2227. S1:='Current value: '+#13+S1
  2228. else
  2229. S1:='Current value: '+#13+S1+#13+
  2230. 'Previous value: '+#13+S2;
  2231. TextST^.SetText(S1);
  2232. R:=inherited Execute;
  2233. if R=cmOK then
  2234. begin
  2235. NameIL^.GetData(S1);
  2236. Watch^.Rename(S1);
  2237. If assigned(Debugger) then
  2238. Debugger^.ReadWatches;
  2239. end;
  2240. Execute:=R;
  2241. end;
  2242. {****************************************************************************
  2243. TRegistersView
  2244. ****************************************************************************}
  2245. function GetIntRegs(var rs : TIntRegs) : boolean;
  2246. var
  2247. p,po : pchar;
  2248. p1 : pchar;
  2249. reg,value : string;
  2250. buffer : array[0..255] of char;
  2251. v : dword;
  2252. code : word;
  2253. begin
  2254. GetIntRegs:=false;
  2255. {$ifndef NODEBUG}
  2256. Debugger^.Command('info registers');
  2257. if Debugger^.Error then
  2258. exit
  2259. else
  2260. begin
  2261. po:=StrNew(Debugger^.GetOutput);
  2262. p:=po;
  2263. if assigned(p) then
  2264. begin
  2265. fillchar(rs,sizeof(rs),0);
  2266. p1:=strscan(p,' ');
  2267. while assigned(p1) do
  2268. begin
  2269. strlcopy(buffer,p,p1-p);
  2270. reg:=strpas(buffer);
  2271. p:=strscan(p,'$');
  2272. p1:=strscan(p,#9);
  2273. strlcopy(buffer,p,p1-p);
  2274. value:=strpas(buffer);
  2275. val(value,v,code);
  2276. if reg='eax' then
  2277. rs.eax:=v
  2278. else if reg='ebx' then
  2279. rs.ebx:=v
  2280. else if reg='ecx' then
  2281. rs.ecx:=v
  2282. else if reg='edx' then
  2283. rs.edx:=v
  2284. else if reg='eip' then
  2285. rs.eip:=v
  2286. else if reg='esi' then
  2287. rs.esi:=v
  2288. else if reg='edi' then
  2289. rs.edi:=v
  2290. else if reg='esp' then
  2291. rs.esp:=v
  2292. else if reg='ebp' then
  2293. rs.ebp:=v
  2294. { under win32 flags are on a register named ps !! PM }
  2295. else if (reg='eflags') or (reg='ps') then
  2296. rs.eflags:=v
  2297. else if reg='cs' then
  2298. rs.cs:=v
  2299. else if reg='ds' then
  2300. rs.ds:=v
  2301. else if reg='es' then
  2302. rs.es:=v
  2303. else if reg='fs' then
  2304. rs.fs:=v
  2305. else if reg='gs' then
  2306. rs.gs:=v
  2307. else if reg='ss' then
  2308. rs.ss:=v;
  2309. p:=strscan(p1,#10);
  2310. if assigned(p) then
  2311. begin
  2312. p1:=strscan(p,' ');
  2313. inc(p);
  2314. end
  2315. else
  2316. break;
  2317. end;
  2318. { free allocated memory }
  2319. strdispose(po);
  2320. end
  2321. else
  2322. exit;
  2323. end;
  2324. { do not open a messagebox for such errors }
  2325. Debugger^.got_error:=false;
  2326. GetIntRegs:=true;
  2327. {$endif}
  2328. end;
  2329. constructor TRegistersView.Init(var Bounds: TRect);
  2330. begin
  2331. inherited init(Bounds);
  2332. end;
  2333. procedure TRegistersView.Draw;
  2334. var
  2335. rs : tintregs;
  2336. color :byte;
  2337. procedure SetColor(x,y : longint);
  2338. begin
  2339. if x=y then
  2340. color:=7
  2341. else
  2342. color:=8;
  2343. end;
  2344. begin
  2345. inherited draw;
  2346. If not assigned(Debugger) then
  2347. begin
  2348. WriteStr(1,0,'<no values available>',7);
  2349. exit;
  2350. end;
  2351. if GetIntRegs(rs) then
  2352. begin
  2353. SetColor(rs.eax,OldReg.eax);
  2354. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2355. SetColor(rs.ebx,OldReg.ebx);
  2356. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2357. SetColor(rs.ecx,OldReg.ecx);
  2358. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2359. SetColor(rs.edx,OldReg.edx);
  2360. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2361. SetColor(rs.eip,OldReg.eip);
  2362. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2363. SetColor(rs.esi,OldReg.esi);
  2364. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2365. SetColor(rs.edi,OldReg.edi);
  2366. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2367. SetColor(rs.esp,OldReg.esp);
  2368. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2369. SetColor(rs.ebp,OldReg.ebp);
  2370. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2371. SetColor(rs.cs,OldReg.cs);
  2372. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2373. SetColor(rs.ds,OldReg.ds);
  2374. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2375. SetColor(rs.es,OldReg.es);
  2376. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2377. SetColor(rs.fs,OldReg.fs);
  2378. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2379. SetColor(rs.gs,OldReg.gs);
  2380. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2381. SetColor(rs.ss,OldReg.ss);
  2382. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2383. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2384. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2385. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2386. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2387. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2388. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2389. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2390. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2391. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2392. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2393. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2394. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2395. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2396. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2397. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2398. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2399. OldReg:=rs;
  2400. end
  2401. else
  2402. WriteStr(0,0,'<debugger error>',7);
  2403. end;
  2404. destructor TRegistersView.Done;
  2405. begin
  2406. inherited done;
  2407. end;
  2408. {****************************************************************************
  2409. TRegistersWindow
  2410. ****************************************************************************}
  2411. constructor TRegistersWindow.Init;
  2412. var
  2413. R : TRect;
  2414. begin
  2415. Desktop^.GetExtent(R);
  2416. R.A.X:=R.B.X-28;
  2417. R.B.Y:=R.A.Y+11;
  2418. inherited Init(R,'Register View', wnNoNumber);
  2419. Flags:=wfClose or wfMove;
  2420. Palette:=wpCyanWindow;
  2421. HelpCtx:=hcRegisters;
  2422. R.Assign(1,1,26,10);
  2423. RV:=new(PRegistersView,init(R));
  2424. Insert(RV);
  2425. If assigned(RegistersWindow) then
  2426. dispose(RegistersWindow,done);
  2427. RegistersWindow:=@Self;
  2428. Update;
  2429. end;
  2430. constructor TRegistersWindow.Load(var S: TStream);
  2431. begin
  2432. inherited load(S);
  2433. GetSubViewPtr(S,RV);
  2434. If assigned(RegistersWindow) then
  2435. dispose(RegistersWindow,done);
  2436. RegistersWindow:=@Self;
  2437. end;
  2438. procedure TRegistersWindow.Store(var S: TStream);
  2439. begin
  2440. inherited Store(s);
  2441. PutSubViewPtr(S,RV);
  2442. end;
  2443. procedure TRegistersWindow.Update;
  2444. begin
  2445. ReDraw;
  2446. end;
  2447. destructor TRegistersWindow.Done;
  2448. begin
  2449. RegistersWindow:=nil;
  2450. inherited done;
  2451. end;
  2452. {****************************************************************************
  2453. TFPUView
  2454. ****************************************************************************}
  2455. function GetFPURegs(var rs : TFPURegs) : boolean;
  2456. var
  2457. p,po : pchar;
  2458. p1 : pchar;
  2459. reg,value : string;
  2460. buffer : array[0..255] of char;
  2461. v : dword;
  2462. code : word;
  2463. begin
  2464. GetFPURegs:=false;
  2465. {$ifndef NODEBUG}
  2466. Debugger^.Command('info registers');
  2467. if Debugger^.Error then
  2468. exit
  2469. else
  2470. begin
  2471. po:=StrNew(Debugger^.GetOutput);
  2472. p:=po;
  2473. if assigned(p) then
  2474. begin
  2475. fillchar(rs,sizeof(rs),0);
  2476. p1:=strscan(p,' ');
  2477. while assigned(p1) do
  2478. begin
  2479. {
  2480. strlcopy(buffer,p,p1-p);
  2481. reg:=strpas(buffer);
  2482. p:=strscan(p,'$');
  2483. p1:=strscan(p,#9);
  2484. strlcopy(buffer,p,p1-p);
  2485. value:=strpas(buffer);
  2486. val(value,v,code);
  2487. if reg='eax' then
  2488. rs.eax:=v
  2489. else if reg='ebx' then
  2490. rs.ebx:=v
  2491. else if reg='ecx' then
  2492. rs.ecx:=v
  2493. else if reg='edx' then
  2494. rs.edx:=v
  2495. else if reg='eip' then
  2496. rs.eip:=v
  2497. else if reg='esi' then
  2498. rs.esi:=v
  2499. else if reg='edi' then
  2500. rs.edi:=v
  2501. else if reg='esp' then
  2502. rs.esp:=v
  2503. else if reg='ebp' then
  2504. rs.ebp:=v
  2505. under win32 flags are on a register named ps !! PM
  2506. else if (reg='eflags') or (reg='ps') then
  2507. rs.eflags:=v
  2508. else if reg='cs' then
  2509. rs.cs:=v
  2510. else if reg='ds' then
  2511. rs.ds:=v
  2512. else if reg='es' then
  2513. rs.es:=v
  2514. else if reg='fs' then
  2515. rs.fs:=v
  2516. else if reg='gs' then
  2517. rs.gs:=v
  2518. else if reg='ss' then
  2519. rs.ss:=v;
  2520. p:=strscan(p1,#10);
  2521. if assigned(p) then
  2522. begin
  2523. p1:=strscan(p,' ');
  2524. inc(p);
  2525. end
  2526. else
  2527. break;
  2528. }
  2529. end;
  2530. { free allocated memory }
  2531. strdispose(po);
  2532. end
  2533. else
  2534. exit;
  2535. end;
  2536. { do not open a messagebox for such errors }
  2537. Debugger^.got_error:=false;
  2538. GetFPURegs:=true;
  2539. {$endif}
  2540. end;
  2541. constructor TFPUView.Init(var Bounds: TRect);
  2542. begin
  2543. inherited init(Bounds);
  2544. end;
  2545. procedure TFPUView.Draw;
  2546. var
  2547. rs : tfpuregs;
  2548. color :byte;
  2549. procedure SetColor(x,y : longint);
  2550. begin
  2551. if x=y then
  2552. color:=7
  2553. else
  2554. color:=8;
  2555. end;
  2556. begin
  2557. inherited draw;
  2558. If not assigned(Debugger) then
  2559. begin
  2560. WriteStr(1,0,'<no values available>',7);
  2561. exit;
  2562. end;
  2563. if GetFPURegs(rs) then
  2564. begin
  2565. {
  2566. SetColor(rs.eax,OldReg.eax);
  2567. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2568. SetColor(rs.ebx,OldReg.ebx);
  2569. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2570. SetColor(rs.ecx,OldReg.ecx);
  2571. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2572. SetColor(rs.edx,OldReg.edx);
  2573. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2574. SetColor(rs.eip,OldReg.eip);
  2575. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2576. SetColor(rs.esi,OldReg.esi);
  2577. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2578. SetColor(rs.edi,OldReg.edi);
  2579. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2580. SetColor(rs.esp,OldReg.esp);
  2581. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2582. SetColor(rs.ebp,OldReg.ebp);
  2583. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2584. SetColor(rs.cs,OldReg.cs);
  2585. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2586. SetColor(rs.ds,OldReg.ds);
  2587. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2588. SetColor(rs.es,OldReg.es);
  2589. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2590. SetColor(rs.fs,OldReg.fs);
  2591. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2592. SetColor(rs.gs,OldReg.gs);
  2593. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2594. SetColor(rs.ss,OldReg.ss);
  2595. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2596. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2597. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2598. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2599. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2600. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2601. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2602. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2603. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2604. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2605. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2606. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2607. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2608. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2609. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2610. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2611. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2612. OldReg:=rs;
  2613. }
  2614. end
  2615. else
  2616. WriteStr(0,0,'<debugger error>',7);
  2617. end;
  2618. destructor TFPUView.Done;
  2619. begin
  2620. inherited done;
  2621. end;
  2622. {****************************************************************************
  2623. TFPUWindow
  2624. ****************************************************************************}
  2625. constructor TFPUWindow.Init;
  2626. var
  2627. R : TRect;
  2628. begin
  2629. Desktop^.GetExtent(R);
  2630. R.A.X:=R.B.X-28;
  2631. R.B.Y:=R.A.Y+11;
  2632. inherited Init(R,'FPU View', wnNoNumber);
  2633. Flags:=wfClose or wfMove;
  2634. Palette:=wpCyanWindow;
  2635. HelpCtx:=hcRegisters;
  2636. R.Assign(1,1,26,10);
  2637. RV:=new(PFPUView,init(R));
  2638. Insert(RV);
  2639. If assigned(FPUWindow) then
  2640. dispose(FPUWindow,done);
  2641. FPUWindow:=@Self;
  2642. Update;
  2643. end;
  2644. constructor TFPUWindow.Load(var S: TStream);
  2645. begin
  2646. inherited load(S);
  2647. GetSubViewPtr(S,RV);
  2648. If assigned(FPUWindow) then
  2649. dispose(FPUWindow,done);
  2650. FPUWindow:=@Self;
  2651. end;
  2652. procedure TFPUWindow.Store(var S: TStream);
  2653. begin
  2654. inherited Store(s);
  2655. PutSubViewPtr(S,RV);
  2656. end;
  2657. procedure TFPUWindow.Update;
  2658. begin
  2659. ReDraw;
  2660. end;
  2661. destructor TFPUWindow.Done;
  2662. begin
  2663. FPUWindow:=nil;
  2664. inherited done;
  2665. end;
  2666. {****************************************************************************
  2667. TStackWindow
  2668. ****************************************************************************}
  2669. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2670. begin
  2671. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2672. end;
  2673. procedure TFramesListBox.Update;
  2674. var i : longint;
  2675. W : PSourceWindow;
  2676. begin
  2677. { call backtrace command }
  2678. If not assigned(Debugger) then
  2679. exit;
  2680. {$ifndef NODEBUG}
  2681. Clear;
  2682. { forget all old frames }
  2683. Debugger^.clear_frames;
  2684. Debugger^.Command('backtrace');
  2685. { generate list }
  2686. { all is in tframeentry }
  2687. for i:=0 to Debugger^.frame_count-1 do
  2688. begin
  2689. with Debugger^.frames[i]^ do
  2690. begin
  2691. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  2692. AddModuleName(GetPChar(file_name)),line_number,1)));
  2693. W:=SearchOnDesktop(GetPChar(file_name),false);
  2694. If assigned(W) then
  2695. begin
  2696. W^.editor^.SetDebuggerRow(line_number);
  2697. end;
  2698. end;
  2699. end;
  2700. if List^.Count > 0 then
  2701. FocusItem(0);
  2702. {$endif}
  2703. end;
  2704. function TFramesListBox.GetLocalMenu: PMenu;
  2705. begin
  2706. GetLocalMenu:=Inherited GetLocalMenu;
  2707. end;
  2708. procedure TFramesListBox.GotoSource;
  2709. begin
  2710. { select frame for watches }
  2711. If not assigned(Debugger) then
  2712. exit;
  2713. {$ifndef NODEBUG}
  2714. Debugger^.Command('f '+IntToStr(Focused));
  2715. { for local vars }
  2716. Debugger^.ReadWatches;
  2717. {$endif}
  2718. { goto source }
  2719. inherited GotoSource;
  2720. end;
  2721. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  2722. begin
  2723. inherited HandleEvent(Event);
  2724. end;
  2725. destructor TFramesListBox.Done;
  2726. begin
  2727. Inherited Done;
  2728. end;
  2729. Constructor TStackWindow.Init;
  2730. var
  2731. HSB,VSB: PScrollBar;
  2732. R,R2 : trect;
  2733. begin
  2734. Desktop^.GetExtent(R);
  2735. R.A.Y:=R.B.Y-5;
  2736. inherited Init(R, 'Call Stack', wnNoNumber);
  2737. Palette:=wpCyanWindow;
  2738. GetExtent(R);
  2739. HelpCtx:=hcStack;
  2740. R.Grow(-1,-1);
  2741. R2.Copy(R);
  2742. Inc(R2.B.Y);
  2743. R2.A.Y:=R2.B.Y-1;
  2744. New(HSB, Init(R2));
  2745. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2746. Insert(HSB);
  2747. R2.Copy(R);
  2748. Inc(R2.B.X);
  2749. R2.A.X:=R2.B.X-1;
  2750. New(VSB, Init(R2));
  2751. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2752. Insert(VSB);
  2753. New(FLB,Init(R,HSB,VSB));
  2754. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2755. Insert(FLB);
  2756. If assigned(StackWindow) then
  2757. dispose(StackWindow,done);
  2758. StackWindow:=@Self;
  2759. Update;
  2760. end;
  2761. procedure TStackWindow.Update;
  2762. begin
  2763. FLB^.Update;
  2764. DrawView;
  2765. end;
  2766. constructor TStackWindow.Load(var S: TStream);
  2767. begin
  2768. inherited Load(S);
  2769. GetSubViewPtr(S,FLB);
  2770. If assigned(StackWindow) then
  2771. dispose(StackWindow,done);
  2772. StackWindow:=@Self;
  2773. end;
  2774. procedure TStackWindow.Store(var S: TStream);
  2775. begin
  2776. inherited Store(S);
  2777. PutSubViewPtr(S,FLB);
  2778. end;
  2779. Destructor TStackWindow.Done;
  2780. begin
  2781. StackWindow:=nil;
  2782. Dispose(FLB,done);
  2783. inherited done;
  2784. end;
  2785. {****************************************************************************
  2786. Init/Final
  2787. ****************************************************************************}
  2788. procedure InitDebugger;
  2789. {$ifdef DEBUG}
  2790. var s : string;
  2791. i,p : longint;
  2792. {$endif DEBUG}
  2793. var
  2794. cm : longint;
  2795. begin
  2796. {$ifdef DEBUG}
  2797. Assign(gdb_file,GDBOutFileName);
  2798. {$I-}
  2799. Rewrite(gdb_file);
  2800. if InOutRes<>0 then
  2801. begin
  2802. s:=GDBOutFileName;
  2803. p:=pos('.',s);
  2804. if p>1 then
  2805. for i:=0 to 9 do
  2806. begin
  2807. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  2808. InOutRes:=0;
  2809. Assign(gdb_file,s);
  2810. rewrite(gdb_file);
  2811. if InOutRes=0 then
  2812. break;
  2813. end;
  2814. end;
  2815. if IOResult=0 then
  2816. Use_gdb_file:=true;
  2817. {$I+}
  2818. {$endif}
  2819. if TargetSwitches^.GetCurrSelParam<>source_os.shortname then
  2820. begin
  2821. cm:=ConfirmBox(#3'Sorry, can not debug'#13#3'programs compiled for '
  2822. +TargetSwitches^.GetCurrSelParam+'.'#13#3
  2823. +'Change target to '
  2824. +source_os.shortname+'?',nil,true);
  2825. if cm=cmCancel then
  2826. Exit;
  2827. if cm=cmYes then
  2828. begin
  2829. { force recompilation }
  2830. PrevMainFile:='';
  2831. TargetSwitches^.SetCurrSelParam(source_os.shortname);
  2832. end;
  2833. end;
  2834. if (not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  2835. (PrevMainFile<>MainFile) then
  2836. DoCompile(cRun);
  2837. if CompilationPhase<>cpDone then
  2838. Exit;
  2839. if (EXEFile='') then
  2840. begin
  2841. ErrorBox('Oooops, nothing to debug.',nil);
  2842. Exit;
  2843. end;
  2844. {$ifdef DEBUG}
  2845. PushStatus('Starting debugger');
  2846. {$endif DEBUG}
  2847. { init debugcontroller }
  2848. if assigned(Debugger) then
  2849. dispose(Debugger,Done);
  2850. new(Debugger,Init(ExeFile));
  2851. {$ifdef GDBWINDOW}
  2852. InitGDBWindow;
  2853. {$endif def GDBWINDOW}
  2854. {$ifdef DEBUG}
  2855. PopStatus;
  2856. {$endif DEBUG}
  2857. end;
  2858. procedure DoneDebugger;
  2859. begin
  2860. {$ifdef DEBUG}
  2861. { PushStatus('Closing debugger');
  2862. No its called after App.Done !! }
  2863. {$endif}
  2864. if assigned(Debugger) then
  2865. dispose(Debugger,Done);
  2866. Debugger:=nil;
  2867. {$ifdef DEBUG}
  2868. If Use_gdb_file then
  2869. Close(GDB_file);
  2870. Use_gdb_file:=false;
  2871. {PopStatus;}
  2872. {$endif DEBUG}
  2873. {DoneGDBWindow;}
  2874. end;
  2875. procedure InitGDBWindow;
  2876. var
  2877. R : TRect;
  2878. begin
  2879. if GDBWindow=nil then
  2880. begin
  2881. DeskTop^.GetExtent(R);
  2882. new(GDBWindow,init(R));
  2883. DeskTop^.Insert(GDBWindow);
  2884. end;
  2885. end;
  2886. procedure DoneGDBWindow;
  2887. begin
  2888. if assigned(GDBWindow) then
  2889. begin
  2890. DeskTop^.Delete(GDBWindow);
  2891. GDBWindow:=nil;
  2892. end;
  2893. end;
  2894. procedure InitStackWindow;
  2895. begin
  2896. if StackWindow=nil then
  2897. begin
  2898. new(StackWindow,init);
  2899. DeskTop^.Insert(StackWindow);
  2900. end;
  2901. end;
  2902. procedure DoneStackWindow;
  2903. begin
  2904. if assigned(StackWindow) then
  2905. begin
  2906. DeskTop^.Delete(StackWindow);
  2907. StackWindow:=nil;
  2908. end;
  2909. end;
  2910. procedure InitRegistersWindow;
  2911. begin
  2912. if RegistersWindow=nil then
  2913. begin
  2914. new(RegistersWindow,init);
  2915. DeskTop^.Insert(RegistersWindow);
  2916. end;
  2917. end;
  2918. procedure DoneRegistersWindow;
  2919. begin
  2920. if assigned(RegistersWindow) then
  2921. begin
  2922. DeskTop^.Delete(RegistersWindow);
  2923. RegistersWindow:=nil;
  2924. end;
  2925. end;
  2926. procedure InitBreakpoints;
  2927. begin
  2928. New(BreakpointsCollection,init(10,10));
  2929. end;
  2930. procedure DoneBreakpoints;
  2931. begin
  2932. Dispose(BreakpointsCollection,Done);
  2933. BreakpointsCollection:=nil;
  2934. end;
  2935. procedure InitWatches;
  2936. begin
  2937. New(WatchesCollection,init);
  2938. end;
  2939. procedure DoneWatches;
  2940. begin
  2941. Dispose(WatchesCollection,Done);
  2942. WatchesCollection:=nil;
  2943. end;
  2944. procedure RegisterFPDebugViews;
  2945. begin
  2946. RegisterType(RWatchesWindow);
  2947. RegisterType(RBreakpointsWindow);
  2948. RegisterType(RWatchesListBox);
  2949. RegisterType(RBreakpointsListBox);
  2950. RegisterType(RStackWindow);
  2951. RegisterType(RFramesListBox);
  2952. RegisterType(RBreakpoint);
  2953. RegisterType(RWatch);
  2954. RegisterType(RBreakpointCollection);
  2955. RegisterType(RWatchesCollection);
  2956. RegisterType(RRegistersWindow);
  2957. RegisterType(RRegistersView);
  2958. RegisterType(RFPUWindow);
  2959. RegisterType(RFPUView);
  2960. end;
  2961. end.
  2962. {
  2963. $Log$
  2964. Revision 1.55 2000-03-07 21:52:54 pierre
  2965. + TDebugController.GetValue
  2966. Revision 1.54 2000/03/06 11:34:25 pierre
  2967. + windebug unit for Window Title change when debugging
  2968. Revision 1.53 2000/02/07 12:51:32 pierre
  2969. * typo fix
  2970. Revision 1.52 2000/02/07 11:50:30 pierre
  2971. Gabor changes for TP
  2972. Revision 1.51 2000/02/06 23:43:57 pierre
  2973. * breakpoint path problems fixes
  2974. Revision 1.50 2000/02/05 01:27:58 pierre
  2975. * bug with Toggle Break fixed, hopefully
  2976. + search for local vars in parent procs avoiding
  2977. wrong results (see test.pas source)
  2978. Revision 1.49 2000/02/04 23:18:05 pierre
  2979. * no pushstatus in DoneDebugger because its called after App.done
  2980. Revision 1.48 2000/02/04 14:34:46 pierre
  2981. readme.txt
  2982. Revision 1.47 2000/02/04 00:10:58 pierre
  2983. * Breakpoint line in Source Window better handled
  2984. Revision 1.46 2000/02/01 10:59:58 pierre
  2985. * allow FP to debug itself
  2986. Revision 1.45 2000/01/28 22:38:21 pierre
  2987. * CrtlF9 starts debugger if there are active breakpoints
  2988. Revision 1.44 2000/01/27 22:30:38 florian
  2989. * start of FPU window
  2990. * current executed line color has a higher priority then a breakpoint now
  2991. Revision 1.43 2000/01/20 00:31:53 pierre
  2992. * uses ShortName of exe to start GDB
  2993. Revision 1.42 2000/01/10 17:49:40 pierre
  2994. * Get RegisterView to Update correctly
  2995. * Write in white changed regs (keeping a copy of previous values)
  2996. Revision 1.41 2000/01/10 16:20:50 florian
  2997. * working register window
  2998. Revision 1.40 2000/01/10 13:20:57 pierre
  2999. + debug only possible on source target
  3000. Revision 1.39 2000/01/10 00:25:06 pierre
  3001. * RegisterWindow problem fixed
  3002. Revision 1.38 2000/01/09 21:05:51 florian
  3003. * some fixes for register view
  3004. Revision 1.37 2000/01/08 18:26:20 florian
  3005. + added a register window, doesn't work yet
  3006. Revision 1.36 1999/12/20 14:23:16 pierre
  3007. * MyApp renamed IDEApp
  3008. * TDebugController.ResetDebuggerRows added to
  3009. get resetting of debugger rows
  3010. Revision 1.35 1999/11/24 14:03:16 pierre
  3011. + Executing... in status line if in another window
  3012. Revision 1.34 1999/11/10 17:19:58 pierre
  3013. + Other window for Debuggee code
  3014. Revision 1.33 1999/10/25 16:39:03 pierre
  3015. + GetPChar to avoid nil pointer problems
  3016. Revision 1.32 1999/09/16 14:34:57 pierre
  3017. + TBreakpoint and TWatch registering
  3018. + WatchesCollection and BreakpointsCollection stored in desk file
  3019. * Syntax highlighting was broken
  3020. Revision 1.31 1999/09/13 16:24:43 peter
  3021. + clock
  3022. * backspace unident like tp7
  3023. Revision 1.30 1999/09/09 16:36:30 pierre
  3024. * Breakpoint storage problem corrected
  3025. Revision 1.29 1999/09/09 16:31:45 pierre
  3026. * some breakpoint related fixes and Help contexts
  3027. Revision 1.28 1999/09/09 14:20:05 pierre
  3028. + Stack Window
  3029. Revision 1.27 1999/08/24 22:04:33 pierre
  3030. + TCodeEditor.SetDebuggerRow
  3031. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  3032. so the current stop point in debugging is not lost if
  3033. we move the cursor
  3034. Revision 1.26 1999/08/22 22:26:48 pierre
  3035. + Registration of Breakpoint/Watches windows
  3036. Revision 1.25 1999/08/16 18:25:15 peter
  3037. * Adjusting the selection when the editor didn't contain any line.
  3038. * Reserved word recognition redesigned, but this didn't affect the overall
  3039. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  3040. The syntax scanner loop is a bit slow but the main problem is the
  3041. recognition of special symbols. Switching off symbol processing boosts
  3042. the performance up to ca. 200%...
  3043. * The editor didn't allow copying (for ex to clipboard) of a single character
  3044. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  3045. * Compiler Messages window (actually the whole desktop) did not act on any
  3046. keypress when compilation failed and thus the window remained visible
  3047. + Message windows are now closed upon pressing Esc
  3048. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  3049. only when neccessary
  3050. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  3051. + LineSelect (Ctrl+K+L) implemented
  3052. * The IDE had problems closing help windows before saving the desktop
  3053. Revision 1.24 1999/08/03 20:22:28 peter
  3054. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  3055. + Desktop saving should work now
  3056. - History saved
  3057. - Clipboard content saved
  3058. - Desktop saved
  3059. - Symbol info saved
  3060. * syntax-highlight bug fixed, which compared special keywords case sensitive
  3061. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  3062. * with 'whole words only' set, the editor didn't found occourences of the
  3063. searched text, if the text appeared previously in the same line, but didn't
  3064. satisfied the 'whole-word' condition
  3065. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  3066. (ie. the beginning of the selection)
  3067. * when started typing in a new line, but not at the start (X=0) of it,
  3068. the editor inserted the text one character more to left as it should...
  3069. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  3070. * Shift shouldn't cause so much trouble in TCodeEditor now...
  3071. * Syntax highlight had problems recognizing a special symbol if it was
  3072. prefixed by another symbol character in the source text
  3073. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  3074. Revision 1.23 1999/07/28 23:11:17 peter
  3075. * fixes from gabor
  3076. Revision 1.22 1999/07/12 13:14:15 pierre
  3077. * LineEnd bug corrected, now goes end of text even if selected
  3078. + Until Return for debugger
  3079. + Code for Quit inside GDB Window
  3080. Revision 1.21 1999/07/11 00:35:14 pierre
  3081. * fix problems for wrong watches
  3082. Revision 1.20 1999/07/10 01:24:14 pierre
  3083. + First implementation of watches window
  3084. Revision 1.19 1999/06/30 23:58:12 pierre
  3085. + BreakpointsList Window implemented
  3086. with Edit/New/Delete functions
  3087. + Individual breakpoint dialog with support for all types
  3088. ignorecount and conditions
  3089. (commands are not yet implemented, don't know if this wolud be useful)
  3090. awatch and rwatch have problems because GDB does not annotate them
  3091. I fixed v4.16 for this
  3092. Revision 1.18 1999/03/16 00:44:42 peter
  3093. * forgotten in last commit :(
  3094. Revision 1.17 1999/03/02 13:48:28 peter
  3095. * fixed far problem is fpdebug
  3096. * tile/cascading with message window
  3097. * grep fixes
  3098. Revision 1.16 1999/03/01 15:41:52 peter
  3099. + Added dummy entries for functions not yet implemented
  3100. * MenuBar didn't update itself automatically on command-set changes
  3101. * Fixed Debugging/Profiling options dialog
  3102. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  3103. set
  3104. * efBackSpaceUnindents works correctly
  3105. + 'Messages' window implemented
  3106. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  3107. + Added TP message-filter support (for ex. you can call GREP thru
  3108. GREP2MSG and view the result in the messages window - just like in TP)
  3109. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  3110. so topic search didn't work...
  3111. * In FPHELP.PAS there were still context-variables defined as word instead
  3112. of THelpCtx
  3113. * StdStatusKeys() was missing from the statusdef for help windows
  3114. + Topic-title for index-table can be specified when adding a HTML-files
  3115. Revision 1.15 1999/02/20 15:18:29 peter
  3116. + ctrl-c capture with confirm dialog
  3117. + ascii table in the tools menu
  3118. + heapviewer
  3119. * empty file fixed
  3120. * fixed callback routines in fpdebug to have far for tp7
  3121. Revision 1.14 1999/02/16 12:47:36 pierre
  3122. * GDBWindow does not popup on F7 or F8 anymore
  3123. Revision 1.13 1999/02/16 10:43:54 peter
  3124. * use -dGDB for the compiler
  3125. * only use gdb_file when -dDEBUG is used
  3126. * profiler switch is now a toggle instead of radiobutton
  3127. Revision 1.12 1999/02/11 19:07:20 pierre
  3128. * GDBWindow redesigned :
  3129. normal editor apart from
  3130. that any kbEnter will send the line (for begin to cursor)
  3131. to GDB command !
  3132. GDBWindow opened in Debugger Menu
  3133. still buggy :
  3134. -echo should not be present if at end of text
  3135. -GDBWindow becomes First after each step (I don't know why !)
  3136. Revision 1.11 1999/02/11 13:10:03 pierre
  3137. + GDBWindow only with -dGDBWindow for now : still buggy !!
  3138. Revision 1.10 1999/02/10 09:55:07 pierre
  3139. + added OldValue and CurrentValue field for watchpoints
  3140. + InitBreakpoints and DoneBreakpoints
  3141. + MessageBox if GDB stops bacause of a watchpoint !
  3142. Revision 1.9 1999/02/08 17:43:43 pierre
  3143. * RestDebugger or multiple running of debugged program now works
  3144. + added DoContToCursor(F4)
  3145. * Breakpoints are now inserted correctly (was mainlyy a problem
  3146. of directories)
  3147. Revision 1.8 1999/02/05 17:21:52 pierre
  3148. Invalid_line renamed InvalidSourceLine
  3149. Revision 1.7 1999/02/05 13:08:41 pierre
  3150. + new breakpoint types added
  3151. Revision 1.6 1999/02/05 12:11:53 pierre
  3152. + SourceDir that stores directories for sources that the
  3153. compiler should not know about
  3154. Automatically asked for addition when a new file that
  3155. needed filedialog to be found is in an unknown directory
  3156. Stored and retrieved from INIFile
  3157. + Breakpoints conditions added to INIFile
  3158. * Breakpoints insterted and removed at debin and end of debug session
  3159. Revision 1.5 1999/02/04 17:54:22 pierre
  3160. + several commands added
  3161. Revision 1.4 1999/02/04 13:32:02 pierre
  3162. * Several things added (I cannot commit them independently !)
  3163. + added TBreakpoint and TBreakpointCollection
  3164. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  3165. + Breakpoint list in INIFile
  3166. * Select items now also depend of SwitchMode
  3167. * Reading of option '-g' was not possible !
  3168. + added search for -Fu args pathes in TryToOpen
  3169. + added code for automatic opening of FileDialog
  3170. if source not found
  3171. Revision 1.3 1999/02/02 16:41:38 peter
  3172. + automatic .pas/.pp adding by opening of file
  3173. * better debuggerscreen changes
  3174. Revision 1.2 1999/01/22 18:14:09 pierre
  3175. * adaptd to changes in gdbint and gdbcon for to /
  3176. Revision 1.1 1999/01/22 10:24:03 peter
  3177. * first debugger things
  3178. }