fpdebug.pas 94 KB

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