fpdebug.pas 92 KB

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