fpdebug.pas 99 KB

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