fpdebug.pas 99 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638
  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,Mouse,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. const White = 15;
  1499. begin
  1500. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  1501. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  1502. HelpCtx:=hcBreakpointListWindow;
  1503. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1504. S:=label_breakpointpropheader;
  1505. New(ST, Init(R,S));
  1506. ST^.GrowMode:=gfGrowHiX;
  1507. Insert(ST);
  1508. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  1509. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  1510. ST^.GrowMode:=gfGrowHiX;
  1511. Insert(ST);
  1512. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  1513. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1514. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1515. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1516. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1517. New(BreakLB, Init(R,HSB,VSB));
  1518. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1519. BreakLB^.Transparent:=true;
  1520. Insert(BreakLB);
  1521. GetExtent(R);R.Grow(-1,-1);
  1522. Dec(R.B.Y);
  1523. R.A.Y:=R.B.Y-2;
  1524. X:=(R.B.X-R.A.X) div 4;
  1525. X1:=R.A.X+(X div 2);
  1526. R.A.X:=X1-3;R.B.X:=X1+7;
  1527. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  1528. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1529. Insert(Btn);
  1530. X1:=X1+X;
  1531. R.A.X:=X1-3;R.B.X:=X1+7;
  1532. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  1533. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1534. Insert(Btn);
  1535. X1:=X1+X;
  1536. R.A.X:=X1-3;R.B.X:=X1+7;
  1537. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  1538. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1539. Insert(Btn);
  1540. X1:=X1+X;
  1541. R.A.X:=X1-3;R.B.X:=X1+7;
  1542. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  1543. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1544. Insert(Btn);
  1545. BreakLB^.Select;
  1546. Update;
  1547. BreakpointsWindow:=@self;
  1548. end;
  1549. constructor TBreakpointsWindow.Load(var S: TStream);
  1550. begin
  1551. inherited Load(S);
  1552. GetSubViewPtr(S,BreakLB);
  1553. end;
  1554. procedure TBreakpointsWindow.Store(var S: TStream);
  1555. begin
  1556. inherited Store(S);
  1557. PutSubViewPtr(S,BreakLB);
  1558. end;
  1559. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  1560. begin
  1561. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  1562. end;
  1563. procedure TBreakpointsWindow.ClearBreakpoints;
  1564. begin
  1565. BreakLB^.Clear;
  1566. ReDraw;
  1567. end;
  1568. procedure TBreakpointsWindow.ReloadBreakpoints;
  1569. procedure InsertInBreakLB(P : PBreakpoint);
  1570. begin
  1571. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  1572. end;
  1573. begin
  1574. If not assigned(BreakpointsCollection) then
  1575. exit;
  1576. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  1577. ReDraw;
  1578. end;
  1579. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  1580. begin
  1581. inherited SizeLimits(Min,Max);
  1582. Min.X:=40; Min.Y:=18;
  1583. end;
  1584. procedure TBreakpointsWindow.Close;
  1585. begin
  1586. Hide;
  1587. end;
  1588. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  1589. var DontClear : boolean;
  1590. begin
  1591. case Event.What of
  1592. evKeyDown :
  1593. begin
  1594. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  1595. begin
  1596. ClearEvent(Event);
  1597. Hide;
  1598. end;
  1599. end;
  1600. evCommand :
  1601. begin
  1602. DontClear:=False;
  1603. case Event.Command of
  1604. cmNewBreakpoint :
  1605. BreakLB^.EditNew;
  1606. cmEditBreakpoint :
  1607. BreakLB^.EditCurrent;
  1608. cmDeleteBreakpoint :
  1609. BreakLB^.DeleteCurrent;
  1610. cmClose :
  1611. Hide;
  1612. else
  1613. DontClear:=true;
  1614. end;
  1615. if not DontClear then
  1616. ClearEvent(Event);
  1617. end;
  1618. evBroadcast :
  1619. case Event.Command of
  1620. cmUpdate :
  1621. Update;
  1622. end;
  1623. end;
  1624. inherited HandleEvent(Event);
  1625. end;
  1626. procedure TBreakpointsWindow.Update;
  1627. begin
  1628. ClearBreakpoints;
  1629. ReloadBreakpoints;
  1630. end;
  1631. destructor TBreakpointsWindow.Done;
  1632. begin
  1633. inherited Done;
  1634. BreakpointsWindow:=nil;
  1635. end;
  1636. {****************************************************************************
  1637. TBreakpointItemDialog
  1638. ****************************************************************************}
  1639. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  1640. var R,R2,R3: TRect;
  1641. Items: PSItem;
  1642. I : BreakpointType;
  1643. KeyCount: sw_integer;
  1644. begin
  1645. KeyCount:=longint(high(BreakpointType));
  1646. R.Assign(0,0,60,Max(3+KeyCount,18));
  1647. inherited Init(R,dialog_modifynewbreakpoint);
  1648. Breakpoint:=ABreakpoint;
  1649. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  1650. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  1651. New(NameIL, Init(R, 128)); Insert(NameIL);
  1652. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  1653. R.Move(0,3);
  1654. New(LineIL, Init(R, 128)); Insert(LineIL);
  1655. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1656. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  1657. R.Move(0,3);
  1658. New(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
  1659. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  1660. R.Move(0,3);
  1661. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  1662. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1663. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  1664. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  1665. Items:=nil;
  1666. for I:=high(BreakpointType) downto low(BreakpointType) do
  1667. Items:=NewSItem(BreakpointTypeStr[I], Items);
  1668. New(TypeRB, Init(R, Items));
  1669. Insert(TypeRB);
  1670. InsertButtons(@Self);
  1671. NameIL^.Select;
  1672. end;
  1673. function TBreakpointItemDialog.Execute: Word;
  1674. var R: word;
  1675. S1: string;
  1676. err: word;
  1677. L: longint;
  1678. begin
  1679. R:=longint(Breakpoint^.typ);
  1680. TypeRB^.SetData(R);
  1681. If Breakpoint^.typ=bt_file_line then
  1682. S1:=GetStr(Breakpoint^.FileName)
  1683. else
  1684. S1:=GetStr(Breakpoint^.name);
  1685. NameIL^.SetData(S1);
  1686. If Breakpoint^.typ=bt_file_line then
  1687. S1:=IntToStr(Breakpoint^.Line)
  1688. else
  1689. S1:='0';
  1690. LineIL^.SetData(S1);
  1691. S1:=IntToStr(Breakpoint^.IgnoreCount);
  1692. IgnoreIL^.SetData(S1);
  1693. S1:=GetStr(Breakpoint^.Conditions);
  1694. ConditionsIL^.SetData(S1);
  1695. R:=inherited Execute;
  1696. if R=cmOK then
  1697. begin
  1698. TypeRB^.GetData(R);
  1699. L:=R;
  1700. Breakpoint^.typ:=BreakpointType(L);
  1701. NameIL^.GetData(S1);
  1702. If Breakpoint^.typ=bt_file_line then
  1703. begin
  1704. If assigned(Breakpoint^.FileName) then
  1705. DisposeStr(Breakpoint^.FileName);
  1706. Breakpoint^.FileName:=NewStr(S1);
  1707. end
  1708. else
  1709. begin
  1710. If assigned(Breakpoint^.Name) then
  1711. DisposeStr(Breakpoint^.Name);
  1712. Breakpoint^.name:=NewStr(S1);
  1713. end;
  1714. If Breakpoint^.typ=bt_file_line then
  1715. begin
  1716. LineIL^.GetData(S1);
  1717. Val(S1,L,err);
  1718. Breakpoint^.Line:=L;
  1719. end;
  1720. IgnoreIL^.GetData(S1);
  1721. Val(S1,L,err);
  1722. Breakpoint^.IgnoreCount:=L;
  1723. ConditionsIL^.GetData(S1);
  1724. If assigned(Breakpoint^.Conditions) then
  1725. DisposeStr(Breakpoint^.Conditions);
  1726. Breakpoint^.Conditions:=NewStr(S1);
  1727. end;
  1728. Execute:=R;
  1729. end;
  1730. {****************************************************************************
  1731. TWatch
  1732. ****************************************************************************}
  1733. constructor TWatch.Init(s : string);
  1734. begin
  1735. expr:=NewStr(s);
  1736. last_value:=nil;
  1737. current_value:=nil;
  1738. Get_new_value;
  1739. end;
  1740. constructor TWatch.Load(var S: TStream);
  1741. begin
  1742. expr:=S.ReadStr;
  1743. last_value:=nil;
  1744. current_value:=nil;
  1745. Get_new_value;
  1746. end;
  1747. procedure TWatch.Store(var S: TStream);
  1748. begin
  1749. S.WriteStr(expr);
  1750. end;
  1751. procedure TWatch.rename(s : string);
  1752. begin
  1753. if assigned(expr) then
  1754. begin
  1755. if GetStr(expr)=S then
  1756. exit;
  1757. DisposeStr(expr);
  1758. end;
  1759. expr:=NewStr(s);
  1760. if assigned(last_value) then
  1761. StrDispose(last_value);
  1762. last_value:=nil;
  1763. if assigned(current_value) then
  1764. StrDispose(current_value);
  1765. current_value:=nil;
  1766. Get_new_value;
  1767. end;
  1768. procedure TWatch.Get_new_value;
  1769. var p, q : pchar;
  1770. i, j, curframe, startframe : longint;
  1771. s,s2 : string;
  1772. loop_higher, found, last_removed : boolean;
  1773. function GetValue(var s : string) : boolean;
  1774. begin
  1775. Debugger^.command('p '+s);
  1776. if not Debugger^.Error then
  1777. begin
  1778. s:=StrPas(Debugger^.GetOutput);
  1779. GetValue:=true;
  1780. end
  1781. else
  1782. begin
  1783. s:=StrPas(Debugger^.GetError);
  1784. GetValue:=false;
  1785. { do not open a messagebox for such errors }
  1786. Debugger^.got_error:=false;
  1787. end;
  1788. end;
  1789. begin
  1790. If not assigned(Debugger) then
  1791. exit;
  1792. if assigned(last_value) then
  1793. strdispose(last_value);
  1794. last_value:=current_value;
  1795. s:=GetStr(expr);
  1796. found:=GetValue(s);
  1797. Debugger^.got_error:=false;
  1798. loop_higher:=not found;
  1799. curframe:=Debugger^.get_current_frame;
  1800. startframe:=curframe;
  1801. while loop_higher do
  1802. begin
  1803. s:='parent_ebp';
  1804. if GetValue(s) then
  1805. begin
  1806. repeat
  1807. inc(curframe);
  1808. if not Debugger^.set_current_frame(curframe) then
  1809. loop_higher:=false;
  1810. s2:='/x $ebp';
  1811. getValue(s2);
  1812. j:=pos('=',s2);
  1813. if j>0 then
  1814. s2:=copy(s2,j+1,length(s2));
  1815. while s2[1] in [' ',TAB] do
  1816. delete(s2,1,1);
  1817. if pos(s2,s)>0 then
  1818. loop_higher :=false;
  1819. until not loop_higher;
  1820. { try again at that level }
  1821. s:=GetStr(expr);
  1822. loop_higher:=not GetValue(s);
  1823. end
  1824. else
  1825. loop_higher:=false;
  1826. end;
  1827. s:=GetStr(expr);
  1828. if GetValue(s) then
  1829. p:=StrNew(Debugger^.GetOutput)
  1830. else
  1831. p:=StrNew(Debugger^.GetError);
  1832. Debugger^.got_error:=false;
  1833. { We should try here to find the expr in parent
  1834. procedure if there are
  1835. I will implement this as I added a
  1836. parent_ebp pseudo local var to local procedure
  1837. in stabs debug info PM }
  1838. { But there are some pitfalls like
  1839. locals redefined in other sublocals that call the function }
  1840. Debugger^.set_current_frame(startframe);
  1841. q:=nil;
  1842. if assigned(p) and (p[0]='$') then
  1843. q:=StrPos(p,'=');
  1844. if not assigned(q) then
  1845. q:=p;
  1846. if assigned(q) then
  1847. i:=strlen(q)
  1848. else
  1849. i:=0;
  1850. if (i>0) and (q[i-1]=#10) then
  1851. begin
  1852. q[i-1]:=#0;
  1853. last_removed:=true;
  1854. end
  1855. else
  1856. last_removed:=false;
  1857. if assigned(q) then
  1858. current_value:=strnew(q)
  1859. else
  1860. current_value:=strnew('');
  1861. if last_removed then
  1862. q[i-1]:=#10;
  1863. strdispose(p);
  1864. end;
  1865. destructor TWatch.Done;
  1866. begin
  1867. if assigned(expr) then
  1868. disposestr(expr);
  1869. if assigned(last_value) then
  1870. strdispose(last_value);
  1871. if assigned(current_value) then
  1872. strdispose(current_value);
  1873. inherited done;
  1874. end;
  1875. {****************************************************************************
  1876. TWatchesCollection
  1877. ****************************************************************************}
  1878. constructor TWatchesCollection.Init;
  1879. begin
  1880. inherited Init(10,10);
  1881. end;
  1882. procedure TWatchesCollection.Insert(Item: Pointer);
  1883. begin
  1884. PWatch(Item)^.Get_new_value;
  1885. Inherited Insert(Item);
  1886. Update;
  1887. end;
  1888. procedure TWatchesCollection.Update;
  1889. var
  1890. W,W1 : integer;
  1891. procedure GetMax(P : PWatch);
  1892. begin
  1893. if assigned(P^.Current_value) then
  1894. begin
  1895. W1:=StrLen(P^.Current_value)+2+Length(GetStr(P^.expr));
  1896. if W1>W then
  1897. W:=W1;
  1898. end;
  1899. end;
  1900. begin
  1901. W:=0;
  1902. ForEach(@GetMax);
  1903. MaxW:=W;
  1904. If assigned(WatchesWindow) then
  1905. WatchesWindow^.WLB^.Update(MaxW);
  1906. end;
  1907. function TWatchesCollection.At(Index: Integer): PWatch;
  1908. begin
  1909. At:=Inherited At(Index);
  1910. end;
  1911. {****************************************************************************
  1912. TWatchesListBox
  1913. ****************************************************************************}
  1914. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1915. begin
  1916. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  1917. If assigned(List) then
  1918. dispose(list,done);
  1919. List:=WatchesCollection;
  1920. end;
  1921. procedure TWatchesListBox.Update(AMaxWidth : integer);
  1922. var R : TRect;
  1923. begin
  1924. GetExtent(R);
  1925. MaxWidth:=AMaxWidth;
  1926. if HScrollBar<>nil then
  1927. HScrollBar^.SetRange(0,MaxWidth);
  1928. if R.B.X-R.A.X>MaxWidth then
  1929. HScrollBar^.Hide
  1930. else
  1931. HScrollBar^.Show;
  1932. SetRange(List^.Count);
  1933. if R.B.Y-R.A.Y>Range then
  1934. VScrollBar^.Hide
  1935. else
  1936. VScrollBar^.Show;
  1937. if Focused=List^.Count-1-1 then
  1938. FocusItem(List^.Count-1);
  1939. DrawView;
  1940. end;
  1941. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String;
  1942. var
  1943. PW : PWatch;
  1944. ValOffset : Sw_integer;
  1945. S : String;
  1946. begin
  1947. PW:=WatchesCollection^.At(Item);
  1948. ValOffset:=Length(GetStr(PW^.Expr))+2;
  1949. if Indent<ValOffset then
  1950. begin
  1951. if not assigned(PW^.current_value) then
  1952. S:=' '+GetStr(PW^.Expr)+' <Unknown value>'
  1953. else if not assigned(PW^.last_value) or
  1954. (strcomp(PW^.Last_value,PW^.Current_value)=0) then
  1955. S:=' '+GetStr(PW^.Expr)+' '+GetPChar(PW^.Current_value)
  1956. else
  1957. S:='!'+GetStr(PW^.Expr)+'!'+GetPchar(PW^.Current_value);
  1958. GetIndentedText:=Copy(S,Indent,MaxLen);
  1959. end
  1960. else
  1961. begin
  1962. if not assigned(PW^.Current_value) or
  1963. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  1964. S:=''
  1965. else
  1966. S:=GetStr(@(PW^.Current_Value[Indent-Valoffset]));
  1967. GetIndentedText:=Copy(S,1,MaxLen);
  1968. end;
  1969. end;
  1970. procedure TWatchesListBox.EditCurrent;
  1971. var
  1972. P: PWatch;
  1973. begin
  1974. if Range=0 then Exit;
  1975. P:=WatchesCollection^.At(Focused);
  1976. if P=nil then Exit;
  1977. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  1978. WatchesCollection^.Update;
  1979. end;
  1980. procedure TWatchesListBox.DeleteCurrent;
  1981. var
  1982. P: PWatch;
  1983. begin
  1984. if Range=0 then Exit;
  1985. P:=WatchesCollection^.At(Focused);
  1986. if P=nil then Exit;
  1987. WatchesCollection^.free(P);
  1988. WatchesCollection^.Update;
  1989. end;
  1990. procedure TWatchesListBox.EditNew;
  1991. var
  1992. P: PWatch;
  1993. begin
  1994. P:=New(PWatch,Init(''));
  1995. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  1996. begin
  1997. WatchesCollection^.Insert(P);
  1998. WatchesCollection^.Update;
  1999. end
  2000. else
  2001. dispose(P,Done);
  2002. end;
  2003. procedure TWatchesListBox.Draw;
  2004. var
  2005. I, J, Item: Sw_Integer;
  2006. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2007. ColWidth, CurCol, Indent: Integer;
  2008. B: TDrawBuffer;
  2009. Text: String;
  2010. SCOff: Byte;
  2011. TC: byte;
  2012. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2013. begin
  2014. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2015. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2016. begin
  2017. NormalColor := GetColor(1);
  2018. FocusedColor := GetColor(3);
  2019. SelectedColor := GetColor(4);
  2020. end else
  2021. begin
  2022. NormalColor := GetColor(2);
  2023. SelectedColor := GetColor(4);
  2024. end;
  2025. if Transparent then
  2026. begin MT(NormalColor); MT(SelectedColor); end;
  2027. (* if NoSelection then
  2028. SelectedColor:=NormalColor;*)
  2029. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2030. else Indent := 0;
  2031. ColWidth := Size.X div NumCols + 1;
  2032. for I := 0 to Size.Y - 1 do
  2033. begin
  2034. for J := 0 to NumCols-1 do
  2035. begin
  2036. Item := J*Size.Y + I + TopItem;
  2037. CurCol := J*ColWidth;
  2038. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2039. (Focused = Item) and (Range > 0) then
  2040. begin
  2041. Color := FocusedColor;
  2042. SetCursor(CurCol+1,I);
  2043. SCOff := 0;
  2044. end
  2045. else if (Item < Range) and IsSelected(Item) then
  2046. begin
  2047. Color := SelectedColor;
  2048. SCOff := 2;
  2049. end
  2050. else
  2051. begin
  2052. Color := NormalColor;
  2053. SCOff := 4;
  2054. end;
  2055. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2056. if Item < Range then
  2057. begin
  2058. (* Text := GetText(Item, ColWidth + Indent);
  2059. Text := Copy(Text,Indent,ColWidth); *)
  2060. Text:=GetIndentedText(Item,Indent,ColWidth);
  2061. MoveStr(B[CurCol+1], Text, Color);
  2062. if ShowMarkers then
  2063. begin
  2064. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2065. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2066. end;
  2067. end;
  2068. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2069. end;
  2070. WriteLine(0, I, Size.X, 1, B);
  2071. end;
  2072. end;
  2073. function TWatchesListBox.GetLocalMenu: PMenu;
  2074. var M: PMenu;
  2075. begin
  2076. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2077. M:=NewMenu(
  2078. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2079. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2080. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2081. nil))));
  2082. GetLocalMenu:=M;
  2083. end;
  2084. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2085. var DontClear: boolean;
  2086. begin
  2087. case Event.What of
  2088. evKeyDown :
  2089. begin
  2090. DontClear:=false;
  2091. case Event.KeyCode of
  2092. kbEnter :
  2093. Message(@Self,evCommand,cmEdit,nil);
  2094. kbIns :
  2095. Message(@Self,evCommand,cmNew,nil);
  2096. kbDel :
  2097. Message(@Self,evCommand,cmDelete,nil);
  2098. else
  2099. DontClear:=true;
  2100. end;
  2101. if not DontClear then
  2102. ClearEvent(Event);
  2103. end;
  2104. evBroadcast :
  2105. case Event.Command of
  2106. cmListItemSelected :
  2107. if Event.InfoPtr=@Self then
  2108. Message(@Self,evCommand,cmEdit,nil);
  2109. end;
  2110. evCommand :
  2111. begin
  2112. DontClear:=false;
  2113. case Event.Command of
  2114. cmEdit :
  2115. EditCurrent;
  2116. cmDelete :
  2117. DeleteCurrent;
  2118. cmNew :
  2119. EditNew;
  2120. else
  2121. DontClear:=true;
  2122. end;
  2123. if not DontClear then
  2124. ClearEvent(Event);
  2125. end;
  2126. end;
  2127. inherited HandleEvent(Event);
  2128. end;
  2129. constructor TWatchesListBox.Load(var S: TStream);
  2130. begin
  2131. inherited Load(S);
  2132. If assigned(List) then
  2133. dispose(list,done);
  2134. List:=WatchesCollection;
  2135. { we must set Range PM }
  2136. SetRange(List^.count);
  2137. end;
  2138. procedure TWatchesListBox.Store(var S: TStream);
  2139. var OL: PCollection;
  2140. OldRange : Sw_integer;
  2141. begin
  2142. OL:=List;
  2143. OldRange:=Range;
  2144. Range:=0;
  2145. New(List, Init(1,1));
  2146. inherited Store(S);
  2147. Dispose(List, Done);
  2148. List:=OL;
  2149. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2150. collection? Pasting here a modified version of TListBox.Store+
  2151. TAdvancedListBox.Store isn't a better solution, since by eventually
  2152. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2153. SetRange(OldRange);
  2154. end;
  2155. destructor TWatchesListBox.Done;
  2156. begin
  2157. List:=nil;
  2158. inherited Done;
  2159. end;
  2160. {****************************************************************************
  2161. TWatchesWindow
  2162. ****************************************************************************}
  2163. Constructor TWatchesWindow.Init;
  2164. var
  2165. HSB,VSB: PScrollBar;
  2166. R,R2 : trect;
  2167. begin
  2168. Desktop^.GetExtent(R);
  2169. R.A.Y:=R.B.Y-5;
  2170. inherited Init(R, dialog_watches, wnNoNumber);
  2171. Palette:=wpCyanWindow;
  2172. GetExtent(R);
  2173. HelpCtx:=hcWatches;
  2174. R.Grow(-1,-1);
  2175. R2.Copy(R);
  2176. Inc(R2.B.Y);
  2177. R2.A.Y:=R2.B.Y-1;
  2178. New(HSB, Init(R2));
  2179. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2180. Insert(HSB);
  2181. R2.Copy(R);
  2182. Inc(R2.B.X);
  2183. R2.A.X:=R2.B.X-1;
  2184. New(VSB, Init(R2));
  2185. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2186. Insert(VSB);
  2187. New(WLB,Init(R,HSB,VSB));
  2188. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2189. WLB^.Transparent:=true;
  2190. Insert(WLB);
  2191. If assigned(WatchesWindow) then
  2192. dispose(WatchesWindow,done);
  2193. WatchesWindow:=@Self;
  2194. Update;
  2195. end;
  2196. procedure TWatchesWindow.Update;
  2197. begin
  2198. WatchesCollection^.Update;
  2199. Draw;
  2200. end;
  2201. constructor TWatchesWindow.Load(var S: TStream);
  2202. begin
  2203. inherited Load(S);
  2204. GetSubViewPtr(S,WLB);
  2205. If assigned(WatchesWindow) then
  2206. dispose(WatchesWindow,done);
  2207. WatchesWindow:=@Self;
  2208. end;
  2209. procedure TWatchesWindow.Store(var S: TStream);
  2210. begin
  2211. inherited Store(S);
  2212. PutSubViewPtr(S,WLB);
  2213. end;
  2214. Destructor TWatchesWindow.Done;
  2215. begin
  2216. WatchesWindow:=nil;
  2217. Dispose(WLB,done);
  2218. inherited done;
  2219. end;
  2220. {****************************************************************************
  2221. TWatchItemDialog
  2222. ****************************************************************************}
  2223. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2224. var R,R2: TRect;
  2225. begin
  2226. R.Assign(0,0,50,10);
  2227. inherited Init(R,'Edit Watch');
  2228. Watch:=AWatch;
  2229. GetExtent(R); R.Grow(-3,-2);
  2230. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2231. New(NameIL, Init(R, 255)); Insert(NameIL);
  2232. R2.Copy(R); R2.Move(-1,-1);
  2233. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  2234. GetExtent(R);
  2235. R.Grow(-1,-1);
  2236. R.A.Y:=R.A.Y+3;
  2237. R.B.X:=R.A.X+36;
  2238. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  2239. Insert(TextST);
  2240. InsertButtons(@Self);
  2241. NameIL^.Select;
  2242. end;
  2243. function TWatchItemDialog.Execute: Word;
  2244. var R: word;
  2245. S1,S2: string;
  2246. begin
  2247. S1:=GetStr(Watch^.expr);
  2248. NameIL^.SetData(S1);
  2249. if assigned(Watch^.Current_value) then
  2250. S1:=GetPChar(Watch^.Current_value)
  2251. else
  2252. S1:='';
  2253. if assigned(Watch^.Last_value) then
  2254. S2:=GetPChar(Watch^.Last_value)
  2255. else
  2256. S2:='';
  2257. ClearFormatParams;
  2258. AddFormatParamStr(S1);
  2259. AddFormatParamStr(S2);
  2260. if assigned(Watch^.Last_value) and
  2261. assigned(Watch^.Current_value) and
  2262. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2263. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  2264. else
  2265. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  2266. TextST^.SetText(S1);
  2267. R:=inherited Execute;
  2268. if R=cmOK then
  2269. begin
  2270. NameIL^.GetData(S1);
  2271. Watch^.Rename(S1);
  2272. If assigned(Debugger) then
  2273. Debugger^.ReadWatches;
  2274. end;
  2275. Execute:=R;
  2276. end;
  2277. {****************************************************************************
  2278. TRegistersView
  2279. ****************************************************************************}
  2280. function GetIntRegs(var rs : TIntRegs) : boolean;
  2281. var
  2282. p,po : pchar;
  2283. p1 : pchar;
  2284. reg,value : string;
  2285. buffer : array[0..255] of char;
  2286. v : dword;
  2287. code : word;
  2288. begin
  2289. GetIntRegs:=false;
  2290. {$ifndef NODEBUG}
  2291. Debugger^.Command('info registers');
  2292. if Debugger^.Error then
  2293. exit
  2294. else
  2295. begin
  2296. po:=StrNew(Debugger^.GetOutput);
  2297. p:=po;
  2298. if assigned(p) then
  2299. begin
  2300. fillchar(rs,sizeof(rs),0);
  2301. p1:=strscan(p,' ');
  2302. while assigned(p1) do
  2303. begin
  2304. strlcopy(buffer,p,p1-p);
  2305. reg:=strpas(buffer);
  2306. p:=strscan(p,'$');
  2307. p1:=strscan(p,#9);
  2308. strlcopy(buffer,p,p1-p);
  2309. value:=strpas(buffer);
  2310. val(value,v,code);
  2311. if reg='eax' then
  2312. rs.eax:=v
  2313. else if reg='ebx' then
  2314. rs.ebx:=v
  2315. else if reg='ecx' then
  2316. rs.ecx:=v
  2317. else if reg='edx' then
  2318. rs.edx:=v
  2319. else if reg='eip' then
  2320. rs.eip:=v
  2321. else if reg='esi' then
  2322. rs.esi:=v
  2323. else if reg='edi' then
  2324. rs.edi:=v
  2325. else if reg='esp' then
  2326. rs.esp:=v
  2327. else if reg='ebp' then
  2328. rs.ebp:=v
  2329. { under win32 flags are on a register named ps !! PM }
  2330. else if (reg='eflags') or (reg='ps') then
  2331. rs.eflags:=v
  2332. else if reg='cs' then
  2333. rs.cs:=v
  2334. else if reg='ds' then
  2335. rs.ds:=v
  2336. else if reg='es' then
  2337. rs.es:=v
  2338. else if reg='fs' then
  2339. rs.fs:=v
  2340. else if reg='gs' then
  2341. rs.gs:=v
  2342. else if reg='ss' then
  2343. rs.ss:=v;
  2344. p:=strscan(p1,#10);
  2345. if assigned(p) then
  2346. begin
  2347. p1:=strscan(p,' ');
  2348. inc(p);
  2349. end
  2350. else
  2351. break;
  2352. end;
  2353. { free allocated memory }
  2354. strdispose(po);
  2355. end
  2356. else
  2357. exit;
  2358. end;
  2359. { do not open a messagebox for such errors }
  2360. Debugger^.got_error:=false;
  2361. GetIntRegs:=true;
  2362. {$endif}
  2363. end;
  2364. constructor TRegistersView.Init(var Bounds: TRect);
  2365. begin
  2366. inherited init(Bounds);
  2367. end;
  2368. procedure TRegistersView.Draw;
  2369. var
  2370. rs : tintregs;
  2371. color :byte;
  2372. procedure SetColor(x,y : longint);
  2373. begin
  2374. if x=y then
  2375. color:=7
  2376. else
  2377. color:=8;
  2378. end;
  2379. begin
  2380. inherited draw;
  2381. If not assigned(Debugger) then
  2382. begin
  2383. WriteStr(1,0,'<no values available>',7);
  2384. exit;
  2385. end;
  2386. if GetIntRegs(rs) then
  2387. begin
  2388. SetColor(rs.eax,OldReg.eax);
  2389. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2390. SetColor(rs.ebx,OldReg.ebx);
  2391. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2392. SetColor(rs.ecx,OldReg.ecx);
  2393. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2394. SetColor(rs.edx,OldReg.edx);
  2395. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2396. SetColor(rs.eip,OldReg.eip);
  2397. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2398. SetColor(rs.esi,OldReg.esi);
  2399. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2400. SetColor(rs.edi,OldReg.edi);
  2401. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2402. SetColor(rs.esp,OldReg.esp);
  2403. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2404. SetColor(rs.ebp,OldReg.ebp);
  2405. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2406. SetColor(rs.cs,OldReg.cs);
  2407. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2408. SetColor(rs.ds,OldReg.ds);
  2409. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2410. SetColor(rs.es,OldReg.es);
  2411. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2412. SetColor(rs.fs,OldReg.fs);
  2413. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2414. SetColor(rs.gs,OldReg.gs);
  2415. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2416. SetColor(rs.ss,OldReg.ss);
  2417. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2418. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2419. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2420. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2421. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2422. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2423. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2424. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2425. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2426. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2427. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2428. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2429. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2430. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2431. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2432. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2433. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2434. OldReg:=rs;
  2435. end
  2436. else
  2437. WriteStr(0,0,'<debugger error>',7);
  2438. end;
  2439. destructor TRegistersView.Done;
  2440. begin
  2441. inherited done;
  2442. end;
  2443. {****************************************************************************
  2444. TRegistersWindow
  2445. ****************************************************************************}
  2446. constructor TRegistersWindow.Init;
  2447. var
  2448. R : TRect;
  2449. begin
  2450. Desktop^.GetExtent(R);
  2451. R.A.X:=R.B.X-28;
  2452. R.B.Y:=R.A.Y+11;
  2453. inherited Init(R,dialog_registers, wnNoNumber);
  2454. Flags:=wfClose or wfMove;
  2455. Palette:=wpCyanWindow;
  2456. HelpCtx:=hcRegisters;
  2457. R.Assign(1,1,26,10);
  2458. RV:=new(PRegistersView,init(R));
  2459. Insert(RV);
  2460. If assigned(RegistersWindow) then
  2461. dispose(RegistersWindow,done);
  2462. RegistersWindow:=@Self;
  2463. Update;
  2464. end;
  2465. constructor TRegistersWindow.Load(var S: TStream);
  2466. begin
  2467. inherited load(S);
  2468. GetSubViewPtr(S,RV);
  2469. If assigned(RegistersWindow) then
  2470. dispose(RegistersWindow,done);
  2471. RegistersWindow:=@Self;
  2472. end;
  2473. procedure TRegistersWindow.Store(var S: TStream);
  2474. begin
  2475. inherited Store(s);
  2476. PutSubViewPtr(S,RV);
  2477. end;
  2478. procedure TRegistersWindow.Update;
  2479. begin
  2480. ReDraw;
  2481. end;
  2482. destructor TRegistersWindow.Done;
  2483. begin
  2484. RegistersWindow:=nil;
  2485. inherited done;
  2486. end;
  2487. {****************************************************************************
  2488. TFPUView
  2489. ****************************************************************************}
  2490. function GetFPURegs(var rs : TFPURegs) : boolean;
  2491. var
  2492. p,po : pchar;
  2493. p1 : pchar;
  2494. {$ifndef NODEBUG}
  2495. { reg,value : string;
  2496. buffer : array[0..255] of char;
  2497. v : dword;
  2498. code : word;}
  2499. {$endif}
  2500. begin
  2501. GetFPURegs:=false;
  2502. {$ifndef NODEBUG}
  2503. Debugger^.Command('info registers');
  2504. if Debugger^.Error then
  2505. exit
  2506. else
  2507. begin
  2508. po:=StrNew(Debugger^.GetOutput);
  2509. p:=po;
  2510. if assigned(p) then
  2511. begin
  2512. fillchar(rs,sizeof(rs),0);
  2513. p1:=strscan(p,' ');
  2514. while assigned(p1) do
  2515. begin
  2516. {
  2517. strlcopy(buffer,p,p1-p);
  2518. reg:=strpas(buffer);
  2519. p:=strscan(p,'$');
  2520. p1:=strscan(p,#9);
  2521. strlcopy(buffer,p,p1-p);
  2522. value:=strpas(buffer);
  2523. val(value,v,code);
  2524. if reg='eax' then
  2525. rs.eax:=v
  2526. else if reg='ebx' then
  2527. rs.ebx:=v
  2528. else if reg='ecx' then
  2529. rs.ecx:=v
  2530. else if reg='edx' then
  2531. rs.edx:=v
  2532. else if reg='eip' then
  2533. rs.eip:=v
  2534. else if reg='esi' then
  2535. rs.esi:=v
  2536. else if reg='edi' then
  2537. rs.edi:=v
  2538. else if reg='esp' then
  2539. rs.esp:=v
  2540. else if reg='ebp' then
  2541. rs.ebp:=v
  2542. under win32 flags are on a register named ps !! PM
  2543. else if (reg='eflags') or (reg='ps') then
  2544. rs.eflags:=v
  2545. else if reg='cs' then
  2546. rs.cs:=v
  2547. else if reg='ds' then
  2548. rs.ds:=v
  2549. else if reg='es' then
  2550. rs.es:=v
  2551. else if reg='fs' then
  2552. rs.fs:=v
  2553. else if reg='gs' then
  2554. rs.gs:=v
  2555. else if reg='ss' then
  2556. rs.ss:=v;
  2557. p:=strscan(p1,#10);
  2558. if assigned(p) then
  2559. begin
  2560. p1:=strscan(p,' ');
  2561. inc(p);
  2562. end
  2563. else
  2564. break;
  2565. }
  2566. end;
  2567. { free allocated memory }
  2568. strdispose(po);
  2569. end
  2570. else
  2571. exit;
  2572. end;
  2573. { do not open a messagebox for such errors }
  2574. Debugger^.got_error:=false;
  2575. GetFPURegs:=true;
  2576. {$endif}
  2577. end;
  2578. constructor TFPUView.Init(var Bounds: TRect);
  2579. begin
  2580. inherited init(Bounds);
  2581. end;
  2582. procedure TFPUView.Draw;
  2583. var
  2584. rs : tfpuregs;
  2585. { color :byte;
  2586. procedure SetColor(x,y : longint);
  2587. begin
  2588. if x=y then
  2589. color:=7
  2590. else
  2591. color:=8;
  2592. end;}
  2593. begin
  2594. inherited draw;
  2595. If not assigned(Debugger) then
  2596. begin
  2597. WriteStr(1,0,'<no values available>',7);
  2598. exit;
  2599. end;
  2600. if GetFPURegs(rs) then
  2601. begin
  2602. {
  2603. SetColor(rs.eax,OldReg.eax);
  2604. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2605. SetColor(rs.ebx,OldReg.ebx);
  2606. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2607. SetColor(rs.ecx,OldReg.ecx);
  2608. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2609. SetColor(rs.edx,OldReg.edx);
  2610. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2611. SetColor(rs.eip,OldReg.eip);
  2612. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2613. SetColor(rs.esi,OldReg.esi);
  2614. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2615. SetColor(rs.edi,OldReg.edi);
  2616. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2617. SetColor(rs.esp,OldReg.esp);
  2618. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2619. SetColor(rs.ebp,OldReg.ebp);
  2620. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2621. SetColor(rs.cs,OldReg.cs);
  2622. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2623. SetColor(rs.ds,OldReg.ds);
  2624. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2625. SetColor(rs.es,OldReg.es);
  2626. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2627. SetColor(rs.fs,OldReg.fs);
  2628. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2629. SetColor(rs.gs,OldReg.gs);
  2630. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2631. SetColor(rs.ss,OldReg.ss);
  2632. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2633. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2634. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2635. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2636. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2637. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2638. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2639. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2640. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2641. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2642. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2643. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2644. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2645. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2646. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2647. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2648. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2649. OldReg:=rs;
  2650. }
  2651. end
  2652. else
  2653. WriteStr(0,0,'<debugger error>',7);
  2654. end;
  2655. destructor TFPUView.Done;
  2656. begin
  2657. inherited done;
  2658. end;
  2659. {****************************************************************************
  2660. TFPUWindow
  2661. ****************************************************************************}
  2662. constructor TFPUWindow.Init;
  2663. var
  2664. R : TRect;
  2665. begin
  2666. Desktop^.GetExtent(R);
  2667. R.A.X:=R.B.X-28;
  2668. R.B.Y:=R.A.Y+11;
  2669. inherited Init(R,dialog_fpu, wnNoNumber);
  2670. Flags:=wfClose or wfMove;
  2671. Palette:=wpCyanWindow;
  2672. HelpCtx:=hcRegisters;
  2673. R.Assign(1,1,26,10);
  2674. RV:=new(PFPUView,init(R));
  2675. Insert(RV);
  2676. If assigned(FPUWindow) then
  2677. dispose(FPUWindow,done);
  2678. FPUWindow:=@Self;
  2679. Update;
  2680. end;
  2681. constructor TFPUWindow.Load(var S: TStream);
  2682. begin
  2683. inherited load(S);
  2684. GetSubViewPtr(S,RV);
  2685. If assigned(FPUWindow) then
  2686. dispose(FPUWindow,done);
  2687. FPUWindow:=@Self;
  2688. end;
  2689. procedure TFPUWindow.Store(var S: TStream);
  2690. begin
  2691. inherited Store(s);
  2692. PutSubViewPtr(S,RV);
  2693. end;
  2694. procedure TFPUWindow.Update;
  2695. begin
  2696. ReDraw;
  2697. end;
  2698. destructor TFPUWindow.Done;
  2699. begin
  2700. FPUWindow:=nil;
  2701. inherited done;
  2702. end;
  2703. {****************************************************************************
  2704. TStackWindow
  2705. ****************************************************************************}
  2706. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2707. begin
  2708. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2709. end;
  2710. procedure TFramesListBox.Update;
  2711. var i : longint;
  2712. W : PSourceWindow;
  2713. begin
  2714. { call backtrace command }
  2715. If not assigned(Debugger) then
  2716. exit;
  2717. {$ifndef NODEBUG}
  2718. DeskTop^.Lock;
  2719. Clear;
  2720. { forget all old frames }
  2721. Debugger^.clear_frames;
  2722. Debugger^.Command('backtrace');
  2723. { generate list }
  2724. { all is in tframeentry }
  2725. for i:=0 to Debugger^.frame_count-1 do
  2726. begin
  2727. with Debugger^.frames[i]^ do
  2728. begin
  2729. if assigned(file_name) then
  2730. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  2731. AddModuleName(GetPChar(file_name)),line_number,1)))
  2732. else
  2733. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  2734. AddModuleName(''),line_number,1)));
  2735. W:=SearchOnDesktop(GetPChar(file_name),false);
  2736. { First reset all Debugger rows }
  2737. If assigned(W) then
  2738. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  2739. end;
  2740. end;
  2741. { Now set all Debugger rows }
  2742. for i:=0 to Debugger^.frame_count-1 do
  2743. begin
  2744. with Debugger^.frames[i]^ do
  2745. begin
  2746. W:=SearchOnDesktop(GetPChar(file_name),false);
  2747. If assigned(W) then
  2748. begin
  2749. If W^.Editor^.DebuggerRow=-1 then
  2750. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,line_number-1);
  2751. end;
  2752. end;
  2753. end;
  2754. if List^.Count > 0 then
  2755. FocusItem(0);
  2756. DeskTop^.Unlock;
  2757. {$endif}
  2758. end;
  2759. function TFramesListBox.GetLocalMenu: PMenu;
  2760. begin
  2761. GetLocalMenu:=Inherited GetLocalMenu;
  2762. end;
  2763. procedure TFramesListBox.GotoSource;
  2764. begin
  2765. { select frame for watches }
  2766. If not assigned(Debugger) then
  2767. exit;
  2768. {$ifndef NODEBUG}
  2769. Debugger^.Command('f '+IntToStr(Focused));
  2770. { for local vars }
  2771. Debugger^.ReadWatches;
  2772. {$endif}
  2773. { goto source }
  2774. inherited GotoSource;
  2775. end;
  2776. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  2777. begin
  2778. inherited HandleEvent(Event);
  2779. end;
  2780. destructor TFramesListBox.Done;
  2781. begin
  2782. Inherited Done;
  2783. end;
  2784. Constructor TStackWindow.Init;
  2785. var
  2786. HSB,VSB: PScrollBar;
  2787. R,R2 : trect;
  2788. begin
  2789. Desktop^.GetExtent(R);
  2790. R.A.Y:=R.B.Y-5;
  2791. inherited Init(R, dialog_callstack, wnNoNumber);
  2792. Palette:=wpCyanWindow;
  2793. GetExtent(R);
  2794. HelpCtx:=hcStack;
  2795. R.Grow(-1,-1);
  2796. R2.Copy(R);
  2797. Inc(R2.B.Y);
  2798. R2.A.Y:=R2.B.Y-1;
  2799. New(HSB, Init(R2));
  2800. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2801. Insert(HSB);
  2802. R2.Copy(R);
  2803. Inc(R2.B.X);
  2804. R2.A.X:=R2.B.X-1;
  2805. New(VSB, Init(R2));
  2806. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2807. Insert(VSB);
  2808. New(FLB,Init(R,HSB,VSB));
  2809. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2810. Insert(FLB);
  2811. If assigned(StackWindow) then
  2812. dispose(StackWindow,done);
  2813. StackWindow:=@Self;
  2814. Update;
  2815. end;
  2816. procedure TStackWindow.Update;
  2817. begin
  2818. FLB^.Update;
  2819. DrawView;
  2820. end;
  2821. constructor TStackWindow.Load(var S: TStream);
  2822. begin
  2823. inherited Load(S);
  2824. GetSubViewPtr(S,FLB);
  2825. If assigned(StackWindow) then
  2826. dispose(StackWindow,done);
  2827. StackWindow:=@Self;
  2828. end;
  2829. procedure TStackWindow.Store(var S: TStream);
  2830. begin
  2831. inherited Store(S);
  2832. PutSubViewPtr(S,FLB);
  2833. end;
  2834. Destructor TStackWindow.Done;
  2835. begin
  2836. StackWindow:=nil;
  2837. Dispose(FLB,done);
  2838. inherited done;
  2839. end;
  2840. {****************************************************************************
  2841. Init/Final
  2842. ****************************************************************************}
  2843. procedure InitDebugger;
  2844. {$ifdef DEBUG}
  2845. var s : string;
  2846. i,p : longint;
  2847. {$endif DEBUG}
  2848. var
  2849. NeedRecompileExe : boolean;
  2850. cm : longint;
  2851. begin
  2852. {$ifdef DEBUG}
  2853. Assign(gdb_file,GDBOutFileName);
  2854. {$I-}
  2855. Rewrite(gdb_file);
  2856. if InOutRes<>0 then
  2857. begin
  2858. s:=GDBOutFileName;
  2859. p:=pos('.',s);
  2860. if p>1 then
  2861. for i:=0 to 9 do
  2862. begin
  2863. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  2864. InOutRes:=0;
  2865. Assign(gdb_file,s);
  2866. rewrite(gdb_file);
  2867. if InOutRes=0 then
  2868. break;
  2869. end;
  2870. end;
  2871. if IOResult=0 then
  2872. Use_gdb_file:=true;
  2873. {$I+}
  2874. {$endif}
  2875. NeedRecompileExe:=false;
  2876. if TargetSwitches^.GetCurrSelParam<>source_os.shortname then
  2877. begin
  2878. ClearFormatParams;
  2879. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  2880. AddFormatParamStr(source_os.shortname);
  2881. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  2882. if cm=cmCancel then
  2883. Exit;
  2884. if cm=cmYes then
  2885. begin
  2886. { force recompilation }
  2887. PrevMainFile:='';
  2888. NeedRecompileExe:=true;
  2889. TargetSwitches^.SetCurrSelParam(source_os.shortname);
  2890. If DebugInfoSwitches^.GetCurrSelParam='-' then
  2891. DebugInfoSwitches^.SetCurrSelParam('l');
  2892. end;
  2893. end;
  2894. if not NeedRecompileExe then
  2895. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  2896. (PrevMainFile<>MainFile) or NeedRecompile(false);
  2897. if Not NeedRecompileExe and Not MainHasDebugInfo then
  2898. begin
  2899. ClearFormatParams;
  2900. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  2901. if cm=cmCancel then
  2902. Exit;
  2903. if cm=cmYes then
  2904. begin
  2905. { force recompilation }
  2906. PrevMainFile:='';
  2907. NeedRecompileExe:=true;
  2908. DebugInfoSwitches^.SetCurrSelParam('l');
  2909. end;
  2910. end;
  2911. if NeedRecompileExe then
  2912. DoCompile(cRun);
  2913. if CompilationPhase<>cpDone then
  2914. Exit;
  2915. if (EXEFile='') then
  2916. begin
  2917. ErrorBox(msg_nothingtodebug,nil);
  2918. Exit;
  2919. end;
  2920. {$ifdef DEBUG}
  2921. PushStatus(msg_startingdebugger);
  2922. {$endif DEBUG}
  2923. { init debugcontroller }
  2924. if assigned(Debugger) then
  2925. dispose(Debugger,Done);
  2926. new(Debugger,Init(ExeFile));
  2927. {$ifdef GDBWINDOW}
  2928. InitGDBWindow;
  2929. {$endif def GDBWINDOW}
  2930. {$ifdef DEBUG}
  2931. PopStatus;
  2932. {$endif DEBUG}
  2933. end;
  2934. procedure DoneDebugger;
  2935. begin
  2936. {$ifdef DEBUG}
  2937. { PushStatus('Closing debugger');
  2938. No its called after App.Done !! }
  2939. {$endif}
  2940. if assigned(Debugger) then
  2941. dispose(Debugger,Done);
  2942. Debugger:=nil;
  2943. {$ifdef DEBUG}
  2944. If Use_gdb_file then
  2945. Close(GDB_file);
  2946. Use_gdb_file:=false;
  2947. {PopStatus;}
  2948. {$endif DEBUG}
  2949. {DoneGDBWindow;}
  2950. end;
  2951. procedure InitGDBWindow;
  2952. var
  2953. R : TRect;
  2954. begin
  2955. if GDBWindow=nil then
  2956. begin
  2957. DeskTop^.GetExtent(R);
  2958. new(GDBWindow,init(R));
  2959. DeskTop^.Insert(GDBWindow);
  2960. end;
  2961. end;
  2962. procedure DoneGDBWindow;
  2963. begin
  2964. if assigned(GDBWindow) then
  2965. begin
  2966. DeskTop^.Delete(GDBWindow);
  2967. GDBWindow:=nil;
  2968. end;
  2969. end;
  2970. procedure InitStackWindow;
  2971. begin
  2972. if StackWindow=nil then
  2973. begin
  2974. new(StackWindow,init);
  2975. DeskTop^.Insert(StackWindow);
  2976. end;
  2977. end;
  2978. procedure DoneStackWindow;
  2979. begin
  2980. if assigned(StackWindow) then
  2981. begin
  2982. DeskTop^.Delete(StackWindow);
  2983. StackWindow:=nil;
  2984. end;
  2985. end;
  2986. procedure InitRegistersWindow;
  2987. begin
  2988. if RegistersWindow=nil then
  2989. begin
  2990. new(RegistersWindow,init);
  2991. DeskTop^.Insert(RegistersWindow);
  2992. end;
  2993. end;
  2994. procedure DoneRegistersWindow;
  2995. begin
  2996. if assigned(RegistersWindow) then
  2997. begin
  2998. DeskTop^.Delete(RegistersWindow);
  2999. RegistersWindow:=nil;
  3000. end;
  3001. end;
  3002. procedure InitBreakpoints;
  3003. begin
  3004. New(BreakpointsCollection,init(10,10));
  3005. end;
  3006. procedure DoneBreakpoints;
  3007. begin
  3008. Dispose(BreakpointsCollection,Done);
  3009. BreakpointsCollection:=nil;
  3010. end;
  3011. procedure InitWatches;
  3012. begin
  3013. New(WatchesCollection,init);
  3014. end;
  3015. procedure DoneWatches;
  3016. begin
  3017. Dispose(WatchesCollection,Done);
  3018. WatchesCollection:=nil;
  3019. end;
  3020. procedure RegisterFPDebugViews;
  3021. begin
  3022. RegisterType(RWatchesWindow);
  3023. RegisterType(RBreakpointsWindow);
  3024. RegisterType(RWatchesListBox);
  3025. RegisterType(RBreakpointsListBox);
  3026. RegisterType(RStackWindow);
  3027. RegisterType(RFramesListBox);
  3028. RegisterType(RBreakpoint);
  3029. RegisterType(RWatch);
  3030. RegisterType(RBreakpointCollection);
  3031. RegisterType(RWatchesCollection);
  3032. RegisterType(RRegistersWindow);
  3033. RegisterType(RRegistersView);
  3034. RegisterType(RFPUWindow);
  3035. RegisterType(RFPUView);
  3036. end;
  3037. end.
  3038. {
  3039. $Log$
  3040. Revision 1.61 2000-05-02 08:42:27 pierre
  3041. * new set of Gabor changes: see fixes.txt
  3042. Revision 1.60 2000/04/18 21:45:35 pierre
  3043. * Red line for breakpoint was off by one line
  3044. Revision 1.59 2000/04/18 11:42:36 pierre
  3045. lot of Gabor changes : see fixes.txt
  3046. Revision 1.58 2000/03/21 23:32:38 pierre
  3047. adapted to wcedit addition by Gabor
  3048. Revision 1.57 2000/03/14 14:22:30 pierre
  3049. + generate cmDebuggerStopped broadcast
  3050. Revision 1.56 2000/03/08 16:57:01 pierre
  3051. * Wrong highlighted line while debugging fixed
  3052. + Check if exe has debugging info
  3053. Revision 1.55 2000/03/07 21:52:54 pierre
  3054. + TDebugController.GetValue
  3055. Revision 1.54 2000/03/06 11:34:25 pierre
  3056. + windebug unit for Window Title change when debugging
  3057. Revision 1.53 2000/02/07 12:51:32 pierre
  3058. * typo fix
  3059. Revision 1.52 2000/02/07 11:50:30 pierre
  3060. Gabor changes for TP
  3061. Revision 1.51 2000/02/06 23:43:57 pierre
  3062. * breakpoint path problems fixes
  3063. Revision 1.50 2000/02/05 01:27:58 pierre
  3064. * bug with Toggle Break fixed, hopefully
  3065. + search for local vars in parent procs avoiding
  3066. wrong results (see test.pas source)
  3067. Revision 1.49 2000/02/04 23:18:05 pierre
  3068. * no pushstatus in DoneDebugger because its called after App.done
  3069. Revision 1.48 2000/02/04 14:34:46 pierre
  3070. readme.txt
  3071. Revision 1.47 2000/02/04 00:10:58 pierre
  3072. * Breakpoint line in Source Window better handled
  3073. Revision 1.46 2000/02/01 10:59:58 pierre
  3074. * allow FP to debug itself
  3075. Revision 1.45 2000/01/28 22:38:21 pierre
  3076. * CrtlF9 starts debugger if there are active breakpoints
  3077. Revision 1.44 2000/01/27 22:30:38 florian
  3078. * start of FPU window
  3079. * current executed line color has a higher priority then a breakpoint now
  3080. Revision 1.43 2000/01/20 00:31:53 pierre
  3081. * uses ShortName of exe to start GDB
  3082. Revision 1.42 2000/01/10 17:49:40 pierre
  3083. * Get RegisterView to Update correctly
  3084. * Write in white changed regs (keeping a copy of previous values)
  3085. Revision 1.41 2000/01/10 16:20:50 florian
  3086. * working register window
  3087. Revision 1.40 2000/01/10 13:20:57 pierre
  3088. + debug only possible on source target
  3089. Revision 1.39 2000/01/10 00:25:06 pierre
  3090. * RegisterWindow problem fixed
  3091. Revision 1.38 2000/01/09 21:05:51 florian
  3092. * some fixes for register view
  3093. Revision 1.37 2000/01/08 18:26:20 florian
  3094. + added a register window, doesn't work yet
  3095. Revision 1.36 1999/12/20 14:23:16 pierre
  3096. * MyApp renamed IDEApp
  3097. * TDebugController.ResetDebuggerRows added to
  3098. get resetting of debugger rows
  3099. Revision 1.35 1999/11/24 14:03:16 pierre
  3100. + Executing... in status line if in another window
  3101. Revision 1.34 1999/11/10 17:19:58 pierre
  3102. + Other window for Debuggee code
  3103. Revision 1.33 1999/10/25 16:39:03 pierre
  3104. + GetPChar to avoid nil pointer problems
  3105. Revision 1.32 1999/09/16 14:34:57 pierre
  3106. + TBreakpoint and TWatch registering
  3107. + WatchesCollection and BreakpointsCollection stored in desk file
  3108. * Syntax highlighting was broken
  3109. Revision 1.31 1999/09/13 16:24:43 peter
  3110. + clock
  3111. * backspace unident like tp7
  3112. Revision 1.30 1999/09/09 16:36:30 pierre
  3113. * Breakpoint storage problem corrected
  3114. Revision 1.29 1999/09/09 16:31:45 pierre
  3115. * some breakpoint related fixes and Help contexts
  3116. Revision 1.28 1999/09/09 14:20:05 pierre
  3117. + Stack Window
  3118. Revision 1.27 1999/08/24 22:04:33 pierre
  3119. + TCodeEditor.SetDebuggerRow
  3120. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  3121. so the current stop point in debugging is not lost if
  3122. we move the cursor
  3123. Revision 1.26 1999/08/22 22:26:48 pierre
  3124. + Registration of Breakpoint/Watches windows
  3125. Revision 1.25 1999/08/16 18:25:15 peter
  3126. * Adjusting the selection when the editor didn't contain any line.
  3127. * Reserved word recognition redesigned, but this didn't affect the overall
  3128. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  3129. The syntax scanner loop is a bit slow but the main problem is the
  3130. recognition of special symbols. Switching off symbol processing boosts
  3131. the performance up to ca. 200%...
  3132. * The editor didn't allow copying (for ex to clipboard) of a single character
  3133. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  3134. * Compiler Messages window (actually the whole desktop) did not act on any
  3135. keypress when compilation failed and thus the window remained visible
  3136. + Message windows are now closed upon pressing Esc
  3137. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  3138. only when neccessary
  3139. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  3140. + LineSelect (Ctrl+K+L) implemented
  3141. * The IDE had problems closing help windows before saving the desktop
  3142. Revision 1.24 1999/08/03 20:22:28 peter
  3143. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  3144. + Desktop saving should work now
  3145. - History saved
  3146. - Clipboard content saved
  3147. - Desktop saved
  3148. - Symbol info saved
  3149. * syntax-highlight bug fixed, which compared special keywords case sensitive
  3150. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  3151. * with 'whole words only' set, the editor didn't found occourences of the
  3152. searched text, if the text appeared previously in the same line, but didn't
  3153. satisfied the 'whole-word' condition
  3154. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  3155. (ie. the beginning of the selection)
  3156. * when started typing in a new line, but not at the start (X=0) of it,
  3157. the editor inserted the text one character more to left as it should...
  3158. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  3159. * Shift shouldn't cause so much trouble in TCodeEditor now...
  3160. * Syntax highlight had problems recognizing a special symbol if it was
  3161. prefixed by another symbol character in the source text
  3162. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  3163. Revision 1.23 1999/07/28 23:11:17 peter
  3164. * fixes from gabor
  3165. Revision 1.22 1999/07/12 13:14:15 pierre
  3166. * LineEnd bug corrected, now goes end of text even if selected
  3167. + Until Return for debugger
  3168. + Code for Quit inside GDB Window
  3169. Revision 1.21 1999/07/11 00:35:14 pierre
  3170. * fix problems for wrong watches
  3171. Revision 1.20 1999/07/10 01:24:14 pierre
  3172. + First implementation of watches window
  3173. Revision 1.19 1999/06/30 23:58:12 pierre
  3174. + BreakpointsList Window implemented
  3175. with Edit/New/Delete functions
  3176. + Individual breakpoint dialog with support for all types
  3177. ignorecount and conditions
  3178. (commands are not yet implemented, don't know if this wolud be useful)
  3179. awatch and rwatch have problems because GDB does not annotate them
  3180. I fixed v4.16 for this
  3181. Revision 1.18 1999/03/16 00:44:42 peter
  3182. * forgotten in last commit :(
  3183. Revision 1.17 1999/03/02 13:48:28 peter
  3184. * fixed far problem is fpdebug
  3185. * tile/cascading with message window
  3186. * grep fixes
  3187. Revision 1.16 1999/03/01 15:41:52 peter
  3188. + Added dummy entries for functions not yet implemented
  3189. * MenuBar didn't update itself automatically on command-set changes
  3190. * Fixed Debugging/Profiling options dialog
  3191. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  3192. set
  3193. * efBackSpaceUnindents works correctly
  3194. + 'Messages' window implemented
  3195. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  3196. + Added TP message-filter support (for ex. you can call GREP thru
  3197. GREP2MSG and view the result in the messages window - just like in TP)
  3198. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  3199. so topic search didn't work...
  3200. * In FPHELP.PAS there were still context-variables defined as word instead
  3201. of THelpCtx
  3202. * StdStatusKeys() was missing from the statusdef for help windows
  3203. + Topic-title for index-table can be specified when adding a HTML-files
  3204. Revision 1.15 1999/02/20 15:18:29 peter
  3205. + ctrl-c capture with confirm dialog
  3206. + ascii table in the tools menu
  3207. + heapviewer
  3208. * empty file fixed
  3209. * fixed callback routines in fpdebug to have far for tp7
  3210. Revision 1.14 1999/02/16 12:47:36 pierre
  3211. * GDBWindow does not popup on F7 or F8 anymore
  3212. Revision 1.13 1999/02/16 10:43:54 peter
  3213. * use -dGDB for the compiler
  3214. * only use gdb_file when -dDEBUG is used
  3215. * profiler switch is now a toggle instead of radiobutton
  3216. Revision 1.12 1999/02/11 19:07:20 pierre
  3217. * GDBWindow redesigned :
  3218. normal editor apart from
  3219. that any kbEnter will send the line (for begin to cursor)
  3220. to GDB command !
  3221. GDBWindow opened in Debugger Menu
  3222. still buggy :
  3223. -echo should not be present if at end of text
  3224. -GDBWindow becomes First after each step (I don't know why !)
  3225. Revision 1.11 1999/02/11 13:10:03 pierre
  3226. + GDBWindow only with -dGDBWindow for now : still buggy !!
  3227. Revision 1.10 1999/02/10 09:55:07 pierre
  3228. + added OldValue and CurrentValue field for watchpoints
  3229. + InitBreakpoints and DoneBreakpoints
  3230. + MessageBox if GDB stops bacause of a watchpoint !
  3231. Revision 1.9 1999/02/08 17:43:43 pierre
  3232. * RestDebugger or multiple running of debugged program now works
  3233. + added DoContToCursor(F4)
  3234. * Breakpoints are now inserted correctly (was mainlyy a problem
  3235. of directories)
  3236. Revision 1.8 1999/02/05 17:21:52 pierre
  3237. Invalid_line renamed InvalidSourceLine
  3238. Revision 1.7 1999/02/05 13:08:41 pierre
  3239. + new breakpoint types added
  3240. Revision 1.6 1999/02/05 12:11:53 pierre
  3241. + SourceDir that stores directories for sources that the
  3242. compiler should not know about
  3243. Automatically asked for addition when a new file that
  3244. needed filedialog to be found is in an unknown directory
  3245. Stored and retrieved from INIFile
  3246. + Breakpoints conditions added to INIFile
  3247. * Breakpoints insterted and removed at debin and end of debug session
  3248. Revision 1.5 1999/02/04 17:54:22 pierre
  3249. + several commands added
  3250. Revision 1.4 1999/02/04 13:32:02 pierre
  3251. * Several things added (I cannot commit them independently !)
  3252. + added TBreakpoint and TBreakpointCollection
  3253. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  3254. + Breakpoint list in INIFile
  3255. * Select items now also depend of SwitchMode
  3256. * Reading of option '-g' was not possible !
  3257. + added search for -Fu args pathes in TryToOpen
  3258. + added code for automatic opening of FileDialog
  3259. if source not found
  3260. Revision 1.3 1999/02/02 16:41:38 peter
  3261. + automatic .pas/.pp adding by opening of file
  3262. * better debuggerscreen changes
  3263. Revision 1.2 1999/01/22 18:14:09 pierre
  3264. * adaptd to changes in gdbint and gdbcon for to /
  3265. Revision 1.1 1999/01/22 10:24:03 peter
  3266. * first debugger things
  3267. }