fpdebug.pas 98 KB

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