fpdebug.pas 98 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998-2000 by Pierre Muller
  4. Debugger call routines for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPDebug;
  12. {$ifdef NODEBUG}
  13. interface
  14. implementation
  15. end.
  16. {$else}
  17. interface
  18. {$i globdir.inc}
  19. uses
  20. {$ifdef Windows}
  21. Windows,
  22. {$endif Windows}
  23. Objects,Dialogs,Drivers,Views,
  24. {$ifndef NODEBUG}
  25. GDBCon,GDBInt,
  26. {$endif NODEBUG}
  27. Menus,
  28. WViews,WEditor,
  29. FPViews;
  30. type
  31. {$ifndef NODEBUG}
  32. PDebugController=^TDebugController;
  33. TDebugController=object(TGDBController)
  34. InvalidSourceLine : boolean;
  35. { if true the current debugger raw will stay in middle of
  36. editor window when debugging PM }
  37. CenterDebuggerRow : TCentre;
  38. Disableallinvalidbreakpoints : boolean;
  39. OrigPwd, { pwd at startup }
  40. LastFileName : string;
  41. LastSource : PView; {PsourceWindow !! }
  42. HiddenStepsCount : longint;
  43. { no need to switch if using another terminal }
  44. NoSwitch : boolean;
  45. HasExe : boolean;
  46. RunCount : longint;
  47. WindowWidth : longint;
  48. FPCBreakErrorNumber : longint;
  49. {$ifdef SUPPORT_REMOTE}
  50. isRemoteDebugging:boolean;
  51. {$endif SUPPORT_REMOTE}
  52. constructor Init;
  53. procedure SetExe(const exefn:string);
  54. procedure SetWidth(AWidth : longint);
  55. procedure SetSourceDirs;
  56. destructor Done;
  57. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  58. { procedure DoStartSession;virtual;
  59. procedure DoBreakSession;virtual;}
  60. procedure DoEndSession(code:longint);virtual;
  61. procedure DoUserSignal;virtual;
  62. procedure AnnotateError;
  63. procedure InsertBreakpoints;
  64. procedure RemoveBreakpoints;
  65. procedure ReadWatches;
  66. procedure RereadWatches;
  67. procedure ResetBreakpointsValues;
  68. procedure DoDebuggerScreen;virtual;
  69. procedure DoUserScreen;virtual;
  70. procedure Reset;virtual;
  71. procedure ResetDebuggerRows;
  72. procedure Run;virtual;
  73. procedure Continue;virtual;
  74. procedure UntilReturn;virtual;
  75. procedure CommandBegin(const s:string);virtual;
  76. procedure CommandEnd(const s:string);virtual;
  77. function IsRunning : boolean;
  78. function AllowQuit : boolean;virtual;
  79. function GetValue(Const expr : string) : pchar;
  80. function GetFramePointer : CORE_ADDR;
  81. function GetLongintAt(addr : CORE_ADDR) : longint;
  82. function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  83. end;
  84. {$endif NODEBUG}
  85. BreakpointType = (bt_function,bt_file_line,bt_watch,
  86. bt_awatch,bt_rwatch,bt_address,bt_invalid);
  87. BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after);
  88. PBreakpointCollection=^TBreakpointCollection;
  89. PBreakpoint=^TBreakpoint;
  90. TBreakpoint=object(TObject)
  91. typ : BreakpointType;
  92. state : BreakpointState;
  93. owner : PBreakpointCollection;
  94. Name : PString; { either function name or expr to watch }
  95. FileName : PString;
  96. OldValue,CurrentValue : Pstring;
  97. Line : Longint; { only used for bt_file_line type }
  98. Conditions : PString; { conditions relative to that breakpoint }
  99. IgnoreCount : Longint; { how many counts should be ignored }
  100. Commands : pchar; { commands that should be executed on breakpoint }
  101. GDBIndex : longint;
  102. GDBState : BreakpointState;
  103. constructor Init_function(Const AFunc : String);
  104. constructor Init_Address(Const AAddress : String);
  105. constructor Init_Empty;
  106. constructor Init_file_line(AFile : String; ALine : longint);
  107. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  108. constructor Load(var S: TStream);
  109. procedure Store(var S: TStream);
  110. procedure Insert;
  111. procedure Remove;
  112. procedure Enable;
  113. procedure Disable;
  114. procedure UpdateSource;
  115. procedure ResetValues;
  116. destructor Done;virtual;
  117. end;
  118. TBreakpointCollection=object(TCollection)
  119. function At(Index: Integer): PBreakpoint;
  120. function GetGDB(index : longint) : PBreakpoint;
  121. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  122. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  123. procedure Update;
  124. procedure ShowBreakpoints(W : PFPWindow);
  125. function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  126. procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  127. procedure ShowAllBreakpoints;
  128. end;
  129. PBreakpointItem = ^TBreakpointItem;
  130. TBreakpointItem = object(TObject)
  131. Breakpoint : PBreakpoint;
  132. constructor Init(ABreakpoint : PBreakpoint);
  133. function GetText(MaxLen: Sw_integer): string; virtual;
  134. procedure Selected; virtual;
  135. function GetModuleName: string; virtual;
  136. end;
  137. PBreakpointsListBox = ^TBreakpointsListBox;
  138. TBreakpointsListBox = object(THSListBox)
  139. Transparent : boolean;
  140. NoSelection : boolean;
  141. MaxWidth : Sw_integer;
  142. (* ModuleNames : PStoreCollection; *)
  143. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  144. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  145. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  146. function GetLocalMenu: PMenu;virtual;
  147. procedure Clear; virtual;
  148. procedure TrackSource; virtual;
  149. procedure EditNew; virtual;
  150. procedure EditCurrent; virtual;
  151. procedure DeleteCurrent; virtual;
  152. procedure ToggleCurrent;
  153. procedure Draw; virtual;
  154. procedure HandleEvent(var Event: TEvent); virtual;
  155. constructor Load(var S: TStream);
  156. procedure Store(var S: TStream);
  157. destructor Done; virtual;
  158. end;
  159. PBreakpointsWindow = ^TBreakpointsWindow;
  160. TBreakpointsWindow = object(TFPDlgWindow)
  161. BreakLB : PBreakpointsListBox;
  162. constructor Init;
  163. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  164. procedure ClearBreakpoints;
  165. procedure ReloadBreakpoints;
  166. procedure Close; virtual;
  167. procedure SizeLimits(var Min, Max: TPoint);virtual;
  168. procedure HandleEvent(var Event: TEvent); virtual;
  169. procedure Update; virtual;
  170. constructor Load(var S: TStream);
  171. procedure Store(var S: TStream);
  172. destructor Done; virtual;
  173. end;
  174. PBreakpointItemDialog = ^TBreakpointItemDialog;
  175. TBreakpointItemDialog = object(TCenterDialog)
  176. constructor Init(ABreakpoint: PBreakpoint);
  177. function Execute: Word; virtual;
  178. private
  179. Breakpoint : PBreakpoint;
  180. TypeRB : PRadioButtons;
  181. NameIL : PEditorInputLine;
  182. ConditionsIL: PEditorInputLine;
  183. LineIL : PEditorInputLine;
  184. IgnoreIL : PEditorInputLine;
  185. end;
  186. PWatch = ^TWatch;
  187. TWatch = Object(TObject)
  188. constructor Init(s : string);
  189. constructor Load(var S: TStream);
  190. procedure Store(var S: TStream);
  191. procedure rename(s : string);
  192. procedure Get_new_value;
  193. procedure Force_new_value;
  194. destructor done;virtual;
  195. expr : pstring;
  196. last_value,current_value : pchar;
  197. private
  198. GDBRunCount : longint;
  199. end;
  200. PWatchesCollection = ^TWatchesCollection;
  201. TWatchesCollection = Object(TCollection)
  202. constructor Init;
  203. procedure Insert(Item: Pointer); virtual;
  204. function At(Index: Integer): PWatch;
  205. procedure Update;
  206. private
  207. MaxW : integer;
  208. end;
  209. PWatchesListBox = ^TWatchesListBox;
  210. TWatchesListBox = object(THSListBox)
  211. Transparent : boolean;
  212. MaxWidth : Sw_integer;
  213. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  214. (* procedure AddWatch(P: PWatch); virtual; *)
  215. procedure Update(AMaxWidth : integer);
  216. function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  217. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
  218. function GetLocalMenu: PMenu;virtual;
  219. (* procedure Clear; virtual;
  220. procedure TrackSource; virtual;*)
  221. procedure EditNew; virtual;
  222. procedure EditCurrent; virtual;
  223. procedure DeleteCurrent; virtual;
  224. (*procedure ToggleCurrent; *)
  225. procedure Draw; virtual;
  226. procedure HandleEvent(var Event: TEvent); virtual;
  227. constructor Load(var S: TStream);
  228. procedure Store(var S: TStream);
  229. destructor Done; virtual;
  230. end;
  231. PWatchItemDialog = ^TWatchItemDialog;
  232. TWatchItemDialog = object(TCenterDialog)
  233. constructor Init(AWatch: PWatch);
  234. function Execute: Word; virtual;
  235. private
  236. Watch : PWatch;
  237. NameIL : PEditorInputLine;
  238. TextST : PAdvancedStaticText;
  239. end;
  240. PWatchesWindow = ^TWatchesWindow;
  241. TWatchesWindow = Object(TFPDlgWindow)
  242. WLB : PWatchesListBox;
  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. PFramesListBox = ^TFramesListBox;
  250. TFramesListBox = object(TMessageListBox)
  251. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  252. procedure Update;
  253. function GetLocalMenu: PMenu;virtual;
  254. procedure GotoSource; virtual;
  255. procedure GotoAssembly; virtual;
  256. procedure HandleEvent(var Event: TEvent); virtual;
  257. destructor Done; virtual;
  258. end;
  259. PStackWindow = ^TStackWindow;
  260. TStackWindow = Object(TFPDlgWindow)
  261. FLB : PFramesListBox;
  262. Constructor Init;
  263. constructor Load(var S: TStream);
  264. procedure Store(var S: TStream);
  265. procedure Update; virtual;
  266. destructor Done; virtual;
  267. end;
  268. procedure InitStackWindow;
  269. procedure DoneStackWindow;
  270. function ActiveBreakpoints : boolean;
  271. function GDBFileName(st : string) : string;
  272. function OSFileName(st : string) : string;
  273. const
  274. BreakpointTypeStr : Array[BreakpointType] of String[9]
  275. = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
  276. BreakpointStateStr : Array[BreakpointState] of String[8]
  277. = ( 'enabled','disabled','invalid',''{'to be deleted' should never be used});
  278. var
  279. {$ifndef NODEBUG}
  280. Debugger : PDebugController;
  281. {$endif NODEBUG}
  282. BreakpointsCollection : PBreakpointCollection;
  283. WatchesCollection : PwatchesCollection;
  284. procedure InitDebugger;
  285. procedure DoneDebugger;
  286. procedure InitGDBWindow;
  287. procedure DoneGDBWindow;
  288. procedure InitDisassemblyWindow;
  289. procedure DoneDisassemblyWindow;
  290. procedure InitBreakpoints;
  291. procedure DoneBreakpoints;
  292. procedure InitWatches;
  293. procedure DoneWatches;
  294. procedure RegisterFPDebugViews;
  295. procedure UpdateDebugViews;
  296. implementation
  297. uses
  298. Dos,
  299. {$ifdef fpc}
  300. Video,
  301. {$endif fpc}
  302. {$ifdef DOS}
  303. fpusrscr,
  304. {$endif DOS}
  305. App,Strings,
  306. FVConsts,
  307. {$ifdef Windows}
  308. Windebug,
  309. {$endif Windows}
  310. {$ifdef Unix}
  311. {$ifdef VER1_0}
  312. Linux,
  313. {$else}
  314. termio,
  315. {$endif}
  316. {$endif Unix}
  317. Systems,Globals,
  318. FPRegs,
  319. FPVars,FPUtils,FPConst,FPSwitch,
  320. FPIntf,FPCompil,FPIde,FPHelp,
  321. Validate,WUtils,Wconsts;
  322. const
  323. RBreakpointsWindow: TStreamRec = (
  324. ObjType: 1701;
  325. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  326. Load: @TBreakpointsWindow.Load;
  327. Store: @TBreakpointsWindow.Store
  328. );
  329. RBreakpointsListBox : TStreamRec = (
  330. ObjType: 1702;
  331. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  332. Load: @TBreakpointsListBox.Load;
  333. Store: @TBreakpointsListBox.Store
  334. );
  335. RWatchesWindow: TStreamRec = (
  336. ObjType: 1703;
  337. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  338. Load: @TWatchesWindow.Load;
  339. Store: @TWatchesWindow.Store
  340. );
  341. RWatchesListBox: TStreamRec = (
  342. ObjType: 1704;
  343. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  344. Load: @TWatchesListBox.Load;
  345. Store: @TWatchesListBox.Store
  346. );
  347. RStackWindow: TStreamRec = (
  348. ObjType: 1705;
  349. VmtLink: Ofs(TypeOf(TStackWindow)^);
  350. Load: @TStackWindow.Load;
  351. Store: @TStackWindow.Store
  352. );
  353. RFramesListBox: TStreamRec = (
  354. ObjType: 1706;
  355. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  356. Load: @TFramesListBox.Load;
  357. Store: @TFramesListBox.Store
  358. );
  359. RBreakpoint: TStreamRec = (
  360. ObjType: 1707;
  361. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  362. Load: @TBreakpoint.Load;
  363. Store: @TBreakpoint.Store
  364. );
  365. RWatch: TStreamRec = (
  366. ObjType: 1708;
  367. VmtLink: Ofs(TypeOf(TWatch)^);
  368. Load: @TWatch.Load;
  369. Store: @TWatch.Store
  370. );
  371. RBreakpointCollection: TStreamRec = (
  372. ObjType: 1709;
  373. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  374. Load: @TBreakpointCollection.Load;
  375. Store: @TBreakpointCollection.Store
  376. );
  377. RWatchesCollection: TStreamRec = (
  378. ObjType: 1710;
  379. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  380. Load: @TWatchesCollection.Load;
  381. Store: @TWatchesCollection.Store
  382. );
  383. {$ifdef USERESSTRINGS}
  384. resourcestring
  385. {$else}
  386. const
  387. {$endif}
  388. button_OK = 'O~K~';
  389. button_Cancel = 'Cancel';
  390. button_New = '~N~ew';
  391. button_Edit = '~E~dit';
  392. button_Delete = '~D~elete';
  393. button_Close = '~C~lose';
  394. button_ToggleButton = '~T~oggle';
  395. { Watches local menu items }
  396. menu_watchlocal_edit = '~E~dit watch';
  397. menu_watchlocal_new = '~N~ew watch';
  398. menu_watchlocal_delete = '~D~elete watch';
  399. { Breakpoints window local menu items }
  400. menu_bplocal_gotosource = '~G~oto source';
  401. menu_bplocal_editbreakpoint = '~E~dit breakpoint';
  402. menu_bplocal_newbreakpoint = '~N~ew breakpoint';
  403. menu_bplocal_deletebreakpoint = '~D~elete breakpoint';
  404. menu_bplocal_togglestate = '~T~oggle state';
  405. { Debugger messages and status hints }
  406. msg_programexitedwithcodeandsteps = #3'Program exited with '#13+
  407. #3'exitcode = %d'#13+
  408. #3'hidden steps = %d';
  409. msg_programexitedwithexitcode = #3'Program exited with '#13+
  410. #3'exitcode = %d';
  411. msg_programsignal = #3'Program recieved signal %s'#13+
  412. #3'%s';
  413. msg_runningprogram = 'Running...';
  414. msg_runningremotely = 'Executable running remotely on ';
  415. msg_connectingto = 'Connecting to ';
  416. msg_getting_info_on = 'Getting infos from ';
  417. msg_runninginanotherwindow = 'Executable running in another window..';
  418. msg_couldnotsetbreakpointat = #3'Could not set Breakpoint'#13+
  419. #3+'%s:%d';
  420. msg_couldnotsetbreakpointtype = #3'Could not set Breakpoint'#13+
  421. #3+'%s %s';
  422. button_DisableAllBreakpoints = 'Dis. ~a~ll invalid';
  423. { Breakpoints window }
  424. dialog_breakpointlist = 'Breakpoint list';
  425. label_breakpointpropheader = ' Type | State | Position | Path | Ignore | Conditions ';
  426. dialog_modifynewbreakpoint = 'Modify/New Breakpoint';
  427. label_breakpoint_name = '~N~ame';
  428. label_breakpoint_line = '~L~ine';
  429. label_breakpoint_conditions = '~C~onditions';
  430. label_breakpoint_ignorecount = '~I~gnore count';
  431. label_breakpoint_type = '~T~ype';
  432. { Watches window }
  433. dialog_watches = 'Watches';
  434. label_watch_expressiontowatch = '~E~xpression to watch';
  435. label_watch_values = 'Watch values';
  436. msg_watch_currentvalue = 'Current value: '+#13+
  437. '%s';
  438. msg_watch_currentandpreviousvalue = 'Current value: '+#13+
  439. '%s'+#13+
  440. 'Previous value: '+#13+
  441. '%s';
  442. dialog_callstack = 'Call Stack';
  443. menu_msglocal_saveas = 'Save ~a~s';
  444. msg_cantdebugchangetargetto = #3'Sorry, can not debug'#13+
  445. #3'programs compiled for %s.'#13+
  446. #3'Change target to %s?';
  447. msg_compiledwithoutdebuginforecompile =
  448. #3'Warning, the program'#13+
  449. #3'was compiled without'#13+
  450. #3'debugging info.'#13+
  451. #3'Recompile it?';
  452. msg_nothingtodebug = 'Oooops, nothing to debug.';
  453. msg_startingdebugger = 'Starting debugger';
  454. {$ifdef I386}
  455. const
  456. FrameName = '$ebp';
  457. {$define FrameNameKnown}
  458. {$endif i386}
  459. {$ifdef m68k}
  460. const
  461. FrameName = '$fp';
  462. {$define FrameNameKnown}
  463. {$endif m68k}
  464. {$ifdef powerpc}
  465. { stack and frame registers are the same on powerpc,
  466. so I am not sure that this will work PM }
  467. const
  468. FrameName = '$r1';
  469. {$define FrameNameKnown}
  470. {$endif powerpc}
  471. {$ifdef TP}
  472. function HexStr(Value: longint; Len: byte): string;
  473. begin
  474. HexStr:=IntToHex(Value,Len);
  475. end;
  476. {$endif}
  477. function GDBFileName(st : string) : string;
  478. {$ifndef Unix}
  479. var i : longint;
  480. {$endif Unix}
  481. begin
  482. {$ifdef NODEBUG}
  483. GDBFileName:=st;
  484. {$else NODEBUG}
  485. {$ifdef Unix}
  486. GDBFileName:=st;
  487. {$else}
  488. { should we also use / chars ? }
  489. for i:=1 to Length(st) do
  490. if st[i]='\' then
  491. {$ifdef Windows}
  492. { Don't touch at '\ ' used to escapes spaces in windows file names PM }
  493. if (i=length(st)) or (st[i+1]<>' ') then
  494. {$endif Windows}
  495. st[i]:='/';
  496. {$ifdef Windows}
  497. { for Windows we should convert e:\ into //e/ PM }
  498. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  499. st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
  500. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  501. for i:=Length(st) downto 1 do
  502. if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
  503. st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
  504. {$endif Windows}
  505. {$ifdef go32v2}
  506. { for go32v2 we should convert //e/ back into e:/ PM }
  507. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  508. st:=st[3]+':/'+copy(st,5,length(st));
  509. {$endif go32v2}
  510. GDBFileName:=LowerCaseStr(st);
  511. {$endif}
  512. {$endif NODEBUG}
  513. end;
  514. function OSFileName(st : string) : string;
  515. {$ifndef Unix}
  516. var i : longint;
  517. {$endif Unix}
  518. begin
  519. {$ifdef Unix}
  520. OSFileName:=st;
  521. {$else}
  522. {$ifdef Windows}
  523. {$ifndef NODEBUG}
  524. { for Windows we should convert /cygdrive/e/ into e:\ PM }
  525. if pos(CygDrivePrefix+'/',st)=1 then
  526. st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
  527. {$endif NODEBUG}
  528. {$endif Windows}
  529. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  530. for i:=Length(st) downto 2 do
  531. if (st[i]=' ') and (st[i-1]='\') then
  532. st:=copy(st,1,i-2)+copy(st,i,length(st));
  533. {$ifdef go32v2}
  534. { for go32v2 we should convert //e/ back into e:/ PM }
  535. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  536. st:=st[3]+':\'+copy(st,5,length(st));
  537. {$endif go32v2}
  538. { should we also use / chars ? }
  539. for i:=1 to Length(st) do
  540. if st[i]='/' then
  541. st[i]:='\';
  542. OSFileName:=LowerCaseStr(st);
  543. {$endif}
  544. end;
  545. {****************************************************************************
  546. TDebugController
  547. ****************************************************************************}
  548. procedure UpdateDebugViews;
  549. begin
  550. {$ifdef SUPPORT_REMOTE}
  551. PushStatus(msg_getting_info_on+RemoteMachine);
  552. {$endif SUPPORT_REMOTE}
  553. DeskTop^.Lock;
  554. If assigned(StackWindow) then
  555. StackWindow^.Update;
  556. If assigned(RegistersWindow) then
  557. RegistersWindow^.Update;
  558. {$ifndef NODEBUG}
  559. If assigned(Debugger) then
  560. Debugger^.ReadWatches;
  561. {$endif NODEBUG}
  562. If assigned(FPUWindow) then
  563. FPUWindow^.Update;
  564. If assigned(VectorWindow) then
  565. VectorWindow^.Update;
  566. DeskTop^.UnLock;
  567. {$ifdef SUPPORT_REMOTE}
  568. PopStatus;
  569. {$endif SUPPORT_REMOTE}
  570. end;
  571. {$ifndef NODEBUG}
  572. constructor TDebugController.Init;
  573. begin
  574. inherited Init;
  575. CenterDebuggerRow:=IniCenterDebuggerRow;
  576. Disableallinvalidbreakpoints:=false;
  577. NoSwitch:=False;
  578. HasExe:=false;
  579. Debugger:=@self;
  580. WindowWidth:=-1;
  581. switch_to_user:=true;
  582. GetDir(0,OrigPwd);
  583. Command('set print object off');
  584. end;
  585. procedure TDebugController.SetExe(const exefn:string);
  586. var f : string;
  587. begin
  588. f := GDBFileName(GetShortName(exefn));
  589. if (f<>'') and ExistsFile(exefn) then
  590. begin
  591. LoadFile(f);
  592. HasExe:=true;
  593. Command('b FPC_BREAK_ERROR');
  594. FPCBreakErrorNumber:=last_breakpoint_number;
  595. {$ifdef FrameNameKnown}
  596. { this fails in GDB 5.1 because
  597. GDB replies that there is an attempt to dereference
  598. a generic pointer...
  599. test delayed in DoSourceLine... PM
  600. Command('cond '+IntToStr(FPCBreakErrorNumber)+
  601. ' (('+FrameName+' + 8)^ <> 0) or'+
  602. ' (('+FrameName+' + 12)^ <> 0)'); }
  603. {$endif FrameNameKnown}
  604. SetArgs(GetRunParameters);
  605. SetSourceDirs;
  606. InsertBreakpoints;
  607. ReadWatches;
  608. end
  609. else
  610. begin
  611. HasExe:=false;
  612. Command('file');
  613. end;
  614. end;
  615. procedure TDebugController.SetWidth(AWidth : longint);
  616. begin
  617. WindowWidth:=AWidth;
  618. Command('set width '+inttostr(WindowWidth));
  619. end;
  620. procedure TDebugController.SetSourceDirs;
  621. var f,s: ansistring;
  622. i : longint;
  623. Dir : SearchRec;
  624. begin
  625. f:=GetSourceDirectories+';'+OrigPwd;
  626. repeat
  627. i:=pos(';',f);
  628. if i=0 then
  629. s:=f
  630. else
  631. begin
  632. s:=copy(f,1,i-1);
  633. system.delete(f,1,i);
  634. end;
  635. DefaultReplacements(s);
  636. if (pos('*',s)=0) and ExistsDir(s) then
  637. Command('dir '+GDBFileName(GetShortName(s)))
  638. { we should also handle the /* cases of -Fu option }
  639. else if pos('*',s)>0 then
  640. begin
  641. Dos.FindFirst(s,Directory,Dir);
  642. { the '*' can only be in the last dir level }
  643. s:=DirOf(s);
  644. while Dos.DosError=0 do
  645. begin
  646. if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
  647. Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
  648. Dos.FindNext(Dir);
  649. end;
  650. {$ifdef FPC}
  651. Dos.FindClose(Dir);
  652. {$endif def FPC}
  653. end;
  654. until i=0;
  655. end;
  656. procedure TDebugController.InsertBreakpoints;
  657. procedure DoInsert(PB : PBreakpoint);
  658. begin
  659. PB^.Insert;
  660. end;
  661. begin
  662. BreakpointsCollection^.ForEach(@DoInsert);
  663. Disableallinvalidbreakpoints:=false;
  664. end;
  665. procedure TDebugController.ReadWatches;
  666. procedure DoRead(PB : PWatch);
  667. begin
  668. PB^.Get_new_value;
  669. end;
  670. begin
  671. WatchesCollection^.ForEach(@DoRead);
  672. If Assigned(WatchesWindow) then
  673. WatchesWindow^.Update;
  674. end;
  675. procedure TDebugController.RereadWatches;
  676. procedure DoRead(PB : PWatch);
  677. begin
  678. PB^.Force_new_value;
  679. end;
  680. begin
  681. WatchesCollection^.ForEach(@DoRead);
  682. If Assigned(WatchesWindow) then
  683. WatchesWindow^.Update;
  684. end;
  685. procedure TDebugController.RemoveBreakpoints;
  686. procedure DoDelete(PB : PBreakpoint);
  687. begin
  688. PB^.Remove;
  689. end;
  690. begin
  691. BreakpointsCollection^.ForEach(@DoDelete);
  692. end;
  693. procedure TDebugController.ResetBreakpointsValues;
  694. procedure DoResetVal(PB : PBreakpoint);
  695. begin
  696. PB^.ResetValues;
  697. end;
  698. begin
  699. BreakpointsCollection^.ForEach(@DoResetVal);
  700. end;
  701. destructor TDebugController.Done;
  702. begin
  703. { kill the program if running }
  704. Reset;
  705. RemoveBreakpoints;
  706. inherited Done;
  707. end;
  708. procedure TDebugController.Run;
  709. {$ifdef Unix}
  710. var
  711. Debuggeefile : text;
  712. ResetOK, TTYUsed : boolean;
  713. {$endif Unix}
  714. {$ifdef PALMOSGDB}
  715. const
  716. TargetProtocol = 'palmos';
  717. {$else}
  718. const
  719. TargetProtocol = 'remote';
  720. {$endif PALMOSGDB}
  721. {$ifdef SUPPORT_REMOTE}
  722. var
  723. S,ErrorStr : string;
  724. {$endif SUPPORT_REMOTE}
  725. begin
  726. ResetBreakpointsValues;
  727. {$ifdef SUPPORT_REMOTE}
  728. NoSwitch:=true;
  729. isRemoteDebugging:=false;
  730. {$ifndef CROSSGDB}
  731. If (RemoteMachine<>'') and (RemotePort<>'') then
  732. {$else CROSSGDB}
  733. if true then
  734. {$endif CROSSGDB}
  735. begin
  736. isRemoteDebugging:=true;
  737. S:=RemoteMachine;
  738. If pos('@',S)>0 then
  739. S:=copy(S,pos('@',S)+1,High(S));
  740. If RemotePort<>'' then
  741. S:=S+':'+RemotePort;
  742. {$ifdef PALMOSGDB}
  743. { set the default value for PalmOS }
  744. If S='' then
  745. S:='localhost:2000';
  746. {$endif PALMOSGDB}
  747. PushStatus(msg_connectingto+S);
  748. Command('target '+TargetProtocol+' '+S);
  749. if Error then
  750. begin
  751. ErrorStr:=strpas(GetError);
  752. ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil);
  753. PopStatus;
  754. exit;
  755. end;
  756. PopStatus;
  757. end
  758. else
  759. begin
  760. {$endif SUPPORT_REMOTE}
  761. {$ifdef Windows}
  762. { Run the debugge in another console }
  763. if DebuggeeTTY<>'' then
  764. Command('set new-console on')
  765. else
  766. Command('set new-console off');
  767. NoSwitch:=DebuggeeTTY<>'';
  768. {$endif Windows}
  769. {$ifdef Unix}
  770. { Run the debuggee in another tty }
  771. if DebuggeeTTY <> '' then
  772. begin
  773. {$I-}
  774. Assign(Debuggeefile,DebuggeeTTY);
  775. system.Reset(Debuggeefile);
  776. ResetOK:=IOResult=0;
  777. If ResetOK and {$ifdef ver1_0}IsATTY(textrec(Debuggeefile).handle){$else}(IsATTY(textrec(Debuggeefile).handle)<>-1){$endif} then
  778. begin
  779. Command('tty '+DebuggeeTTY);
  780. TTYUsed:=true;
  781. end
  782. else
  783. begin
  784. Command('tty ');
  785. TTYUsed:=false;
  786. end;
  787. if ResetOK then
  788. close(Debuggeefile);
  789. if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
  790. NoSwitch:= true
  791. else
  792. NoSwitch:=false;
  793. end
  794. else
  795. begin
  796. if TTYName(input)<>'' then
  797. Command('tty '+TTYName(input));
  798. NoSwitch := false;
  799. end;
  800. {$endif Unix}
  801. {$ifdef SUPPORT_REMOTE}
  802. end;
  803. {$endif SUPPORT_REMOTE}
  804. { Switch to user screen to get correct handles }
  805. UserScreen;
  806. { Don't try to print GDB messages while in User Screen mode }
  807. If assigned(GDBWindow) then
  808. GDBWindow^.Editor^.Lock;
  809. {$ifdef SUPPORT_REMOTE}
  810. if isRemoteDebugging then
  811. begin
  812. inc(init_count);
  813. { pass the stop in start code }
  814. Command('continue');
  815. end else
  816. {$endif SUPPORT_REMOTE}
  817. { Set cwd for debuggee }
  818. SetDir(GetRunDir);
  819. inherited Run;
  820. { Restore cwd for IDE }
  821. SetDir(StartupDir);
  822. DebuggerScreen;
  823. If assigned(GDBWindow) then
  824. GDBWindow^.Editor^.UnLock;
  825. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  826. IDEApp.UpdateRunMenu(true);
  827. UpdateDebugViews;
  828. end;
  829. function TDebugController.IsRunning : boolean;
  830. begin
  831. IsRunning:=debuggee_started;
  832. end;
  833. procedure TDebugController.Continue;
  834. begin
  835. {$ifdef NODEBUG}
  836. NoDebugger;
  837. {$else}
  838. if not debuggee_started then
  839. Run
  840. else
  841. inherited Continue;
  842. UpdateDebugViews;
  843. {$endif NODEBUG}
  844. end;
  845. procedure TDebugController.UntilReturn;
  846. begin
  847. Command('finish');
  848. UpdateDebugViews;
  849. { We could try to get the return value !
  850. Not done yet }
  851. end;
  852. procedure TDebugController.CommandBegin(const s:string);
  853. begin
  854. if assigned(GDBWindow) and (in_command>1) then
  855. begin
  856. { We should do something special for errors !! }
  857. If StrLen(GetError)>0 then
  858. GDBWindow^.WriteErrorText(GetError);
  859. GDBWindow^.WriteOutputText(GetOutput);
  860. end;
  861. if assigned(GDBWindow) then
  862. GDBWindow^.WriteString(S);
  863. end;
  864. procedure TDebugController.CommandEnd(const s:string);
  865. begin
  866. if assigned(GDBWindow) and (in_command<=1) then
  867. begin
  868. { We should do something special for errors !! }
  869. If StrLen(GetError)>0 then
  870. GDBWindow^.WriteErrorText(GetError);
  871. GDBWindow^.WriteOutputText(GetOutput);
  872. GDBWindow^.Editor^.TextEnd;
  873. end;
  874. end;
  875. function TDebugController.AllowQuit : boolean;
  876. begin
  877. if IsRunning then
  878. begin
  879. if ConfirmBox('Really quit GDB window'#13+
  880. 'and kill running program?',nil,true)=cmYes then
  881. begin
  882. Reset;
  883. DoneGDBWindow;
  884. {AllowQuit:=true;}
  885. AllowQuit:=false;
  886. end
  887. else
  888. AllowQuit:=false;
  889. end
  890. else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
  891. begin
  892. DoneGDBWindow;
  893. {AllowQuit:=true;}
  894. AllowQuit:=false;
  895. end
  896. else
  897. AllowQuit:=false;
  898. end;
  899. procedure TDebugController.ResetDebuggerRows;
  900. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  901. begin
  902. if assigned(P) and
  903. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  904. PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  905. end;
  906. begin
  907. Desktop^.ForEach(@ResetDebuggerRow);
  908. end;
  909. procedure TDebugController.Reset;
  910. begin
  911. inherited Reset;
  912. { we need to free the executable
  913. if we want to recompile it }
  914. SetExe('');
  915. NoSwitch:=false;
  916. { In case we have something that the compiler touched }
  917. If IDEApp.IsRunning then
  918. begin
  919. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  920. IDEApp.UpdateRunMenu(false);
  921. AskToReloadAllModifiedFiles;
  922. ResetDebuggerRows;
  923. end;
  924. end;
  925. procedure TDebugController.AnnotateError;
  926. var errornb : longint;
  927. begin
  928. if error then
  929. begin
  930. errornb:=error_num;
  931. UpdateDebugViews;
  932. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  933. end;
  934. end;
  935. function TDebugController.GetValue(Const expr : string) : pchar;
  936. var
  937. p,p2,p3 : pchar;
  938. begin
  939. if WindowWidth<>-1 then
  940. Command('set width 0xffffffff');
  941. Command('p '+expr);
  942. p:=GetOutput;
  943. p3:=nil;
  944. if assigned(p) and (p[strlen(p)-1]=#10) then
  945. begin
  946. p3:=p+strlen(p)-1;
  947. p3^:=#0;
  948. end;
  949. if assigned(p) then
  950. p2:=strpos(p,'=')
  951. else
  952. p2:=nil;
  953. if assigned(p2) then
  954. p:=p2+1;
  955. while p^ in [' ',TAB] do
  956. inc(p);
  957. { get rid of type }
  958. if p^ = '(' then
  959. p:=strpos(p,')')+1;
  960. while p^ in [' ',TAB] do
  961. inc(p);
  962. if assigned(p) then
  963. GetValue:=StrNew(p)
  964. else
  965. GetValue:=StrNew(GetError);
  966. if assigned(p3) then
  967. p3^:=#10;
  968. got_error:=false;
  969. if WindowWidth<>-1 then
  970. Command('set width '+IntToStr(WindowWidth));
  971. end;
  972. function TDebugController.GetFramePointer : CORE_ADDR;
  973. var
  974. st : string;
  975. p : longint;
  976. begin
  977. {$ifdef FrameNameKnown}
  978. Command('p /d '+FrameName);
  979. st:=strpas(GetOutput);
  980. p:=pos('=',st);
  981. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  982. inc(p);
  983. Delete(st,1,p);
  984. p:=1;
  985. while (st[p] in ['0'..'9']) do
  986. inc(p);
  987. Delete(st,p,High(st));
  988. GetFramePointer:=StrToCard(st);
  989. {$else not FrameNameKnown}
  990. GetFramePointer:=0;
  991. {$endif not FrameNameKnown}
  992. end;
  993. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  994. var
  995. st : string;
  996. p : longint;
  997. begin
  998. Command('x /wd 0x'+hexstr(longint(addr),8));
  999. st:=strpas(GetOutput);
  1000. p:=pos(':',st);
  1001. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1002. inc(p);
  1003. Delete(st,1,p);
  1004. p:=1;
  1005. while (st[p] in ['0'..'9']) do
  1006. inc(p);
  1007. Delete(st,p,High(st));
  1008. GetLongintAt:=StrToInt(st);
  1009. end;
  1010. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  1011. var
  1012. st : string;
  1013. p : longint;
  1014. code : integer;
  1015. begin
  1016. Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
  1017. st:=strpas(GetOutput);
  1018. p:=pos(':',st);
  1019. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1020. inc(p);
  1021. if (p<length(st)) and (st[p+1]='$') then
  1022. inc(p);
  1023. Delete(st,1,p);
  1024. p:=1;
  1025. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  1026. inc(p);
  1027. Delete(st,p,High(st));
  1028. Val('$'+st,GetPointerAt,code);
  1029. end;
  1030. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  1031. var
  1032. W: PSourceWindow;
  1033. Found : boolean;
  1034. PB : PBreakpoint;
  1035. S : String;
  1036. BreakIndex : longint;
  1037. stop_addr : CORE_ADDR;
  1038. i,ExitCode : longint;
  1039. ExitAddr,ExitFrame : CORE_ADDR;
  1040. const
  1041. { try to find the parameters }
  1042. FirstArgOffset = -sizeof(pointer);
  1043. SecondArgOffset = 2*-sizeof(pointer);
  1044. ThirdArgOffset = 3*-sizeof(pointer);
  1045. begin
  1046. BreakIndex:=stop_breakpoint_number;
  1047. Desktop^.Lock;
  1048. { 0 based line count in Editor }
  1049. if Line>0 then
  1050. dec(Line);
  1051. S:=fn;
  1052. stop_addr:=current_pc;
  1053. if (BreakIndex=FPCBreakErrorNumber) then
  1054. begin
  1055. { Procedure HandleErrorAddrFrame
  1056. (Errno : longint;addr,frame : longint);
  1057. [public,alias:'FPC_BREAK_ERROR']; }
  1058. {$ifdef FrameNameKnown}
  1059. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  1060. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  1061. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  1062. if (ExitCode=0) and (ExitAddr=0) then
  1063. begin
  1064. Desktop^.Unlock;
  1065. Command('continue');
  1066. exit;
  1067. end;
  1068. { forget all old frames }
  1069. clear_frames;
  1070. { record new frames }
  1071. Command('backtrace');
  1072. for i:=0 to frame_count-1 do
  1073. begin
  1074. with frames[i]^ do
  1075. begin
  1076. if ExitAddr=address then
  1077. begin
  1078. Command('f '+IntToStr(i));
  1079. if assigned(file_name) then
  1080. begin
  1081. s:=strpas(file_name);
  1082. line:=line_number;
  1083. stop_addr:=address;
  1084. end;
  1085. break;
  1086. end;
  1087. end;
  1088. end;
  1089. {$endif FrameNameKnown}
  1090. end;
  1091. { Update Disassembly position }
  1092. if Assigned(DisassemblyWindow) then
  1093. DisassemblyWindow^.SetCurAddress(stop_addr);
  1094. if (fn=LastFileName) then
  1095. begin
  1096. W:=PSourceWindow(LastSource);
  1097. if assigned(W) then
  1098. begin
  1099. W^.Editor^.SetCurPtr(0,Line);
  1100. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1101. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1102. UpdateDebugViews;
  1103. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1104. handled by SelectInDebugSession}
  1105. W^.SelectInDebugSession;
  1106. InvalidSourceLine:=false;
  1107. end
  1108. else
  1109. InvalidSourceLine:=true;
  1110. end
  1111. else
  1112. begin
  1113. if s='' then
  1114. W:=nil
  1115. else
  1116. W:=TryToOpenFile(nil,s,0,Line,false);
  1117. if assigned(W) then
  1118. begin
  1119. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1120. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1121. UpdateDebugViews;
  1122. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1123. handled by SelectInDebugSession}
  1124. W^.SelectInDebugSession;
  1125. LastSource:=W;
  1126. InvalidSourceLine:=false;
  1127. end
  1128. { only search a file once }
  1129. else
  1130. begin
  1131. Desktop^.UnLock;
  1132. if s='' then
  1133. Found:=false
  1134. else
  1135. { it is easier to handle with a * at the end }
  1136. Found:=IDEApp.OpenSearch(s+'*');
  1137. Desktop^.Lock;
  1138. if not Found then
  1139. begin
  1140. InvalidSourceLine:=true;
  1141. LastSource:=Nil;
  1142. { Show the stack in that case }
  1143. InitStackWindow;
  1144. UpdateDebugViews;
  1145. StackWindow^.MakeFirst;
  1146. end
  1147. else
  1148. begin
  1149. { should now be open }
  1150. W:=TryToOpenFile(nil,s,0,Line,true);
  1151. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1152. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1153. UpdateDebugViews;
  1154. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1155. handled by SelectInDebugSession}
  1156. W^.SelectInDebugSession;
  1157. LastSource:=W;
  1158. InvalidSourceLine:=false;
  1159. end;
  1160. end;
  1161. end;
  1162. LastFileName:=s;
  1163. Desktop^.UnLock;
  1164. if BreakIndex>0 then
  1165. begin
  1166. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1167. if (BreakIndex=FPCBreakErrorNumber) then
  1168. begin
  1169. if (ExitCode<>0) or (ExitAddr<>0) then
  1170. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1171. #3'Error address $'+HexStr(ExitAddr,8),nil)
  1172. else
  1173. WarningBox(#3'Run Time Error',nil);
  1174. end
  1175. else if not assigned(PB) then
  1176. begin
  1177. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1178. end
  1179. { For watch we should get old and new value !! }
  1180. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1181. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1182. (PB^.typ<>bt_address) then
  1183. begin
  1184. Command('p '+GetStr(PB^.Name));
  1185. S:=GetPChar(GetOutput);
  1186. got_error:=false;
  1187. If Pos('=',S)>0 then
  1188. S:=Copy(S,Pos('=',S)+1,255);
  1189. If S[Length(S)]=#10 then
  1190. Delete(S,Length(S),1);
  1191. if Assigned(PB^.OldValue) then
  1192. DisposeStr(PB^.OldValue);
  1193. PB^.OldValue:=PB^.CurrentValue;
  1194. PB^.CurrentValue:=NewStr(S);
  1195. If PB^.typ=bt_function then
  1196. WarningBox(#3'GDB stopped due to'#13+
  1197. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1198. else if (GetStr(PB^.OldValue)<>S) then
  1199. WarningBox(#3'GDB stopped due to'#13+
  1200. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1201. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1202. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1203. else
  1204. WarningBox(#3'GDB stopped due to'#13+
  1205. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1206. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1207. end;
  1208. end;
  1209. end;
  1210. procedure TDebugController.DoUserSignal;
  1211. var P :Array[1..2] of pstring;
  1212. S1, S2 : string;
  1213. begin
  1214. S1:=strpas(signal_name);
  1215. S2:=strpas(signal_string);
  1216. P[1]:=@S1;
  1217. P[2]:=@S2;
  1218. WarningBox(msg_programsignal,@P);
  1219. end;
  1220. procedure TDebugController.DoEndSession(code:longint);
  1221. var P :Array[1..2] of longint;
  1222. begin
  1223. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1224. IDEApp.UpdateRunMenu(false);
  1225. ResetDebuggerRows;
  1226. LastExitCode:=Code;
  1227. If HiddenStepsCount=0 then
  1228. InformationBox(msg_programexitedwithexitcode,@code)
  1229. else
  1230. begin
  1231. P[1]:=code;
  1232. P[2]:=HiddenStepsCount;
  1233. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1234. end;
  1235. { In case we have something that the compiler touched }
  1236. AskToReloadAllModifiedFiles;
  1237. {$ifdef Windows}
  1238. main_pid_valid:=false;
  1239. {$endif Windows}
  1240. end;
  1241. procedure TDebugController.DoDebuggerScreen;
  1242. {$ifdef Windows}
  1243. var
  1244. IdeMode : DWord;
  1245. {$endif Windows}
  1246. begin
  1247. if NoSwitch then
  1248. begin
  1249. PopStatus;
  1250. end
  1251. else
  1252. begin
  1253. IDEApp.ShowIDEScreen;
  1254. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1255. PopStatus;
  1256. end;
  1257. {$ifdef Windows}
  1258. if NoSwitch then
  1259. begin
  1260. { Ctrl-C as normal char }
  1261. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1262. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1263. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1264. end;
  1265. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1266. {$endif Windows}
  1267. end;
  1268. procedure TDebugController.DoUserScreen;
  1269. {$ifdef Windows}
  1270. var
  1271. IdeMode : DWord;
  1272. {$endif Windows}
  1273. begin
  1274. Inc(RunCount);
  1275. if NoSwitch then
  1276. begin
  1277. {$ifdef SUPPORT_REMOTE}
  1278. PushStatus(msg_runningremotely+RemoteMachine);
  1279. {$else not SUPPORT_REMOTE}
  1280. {$ifdef Unix}
  1281. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1282. {$else not Unix}
  1283. PushStatus(msg_runninginanotherwindow);
  1284. {$endif Unix}
  1285. {$endif not SUPPORT_REMOTE}
  1286. end
  1287. else
  1288. begin
  1289. PushStatus(msg_runningprogram);
  1290. IDEApp.ShowUserScreen;
  1291. end;
  1292. {$ifdef Windows}
  1293. if NoSwitch then
  1294. begin
  1295. { Ctrl-C as interrupt }
  1296. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1297. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1298. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1299. end;
  1300. ChangeDebuggeeWindowTitleTo(Running_State);
  1301. {$endif Windows}
  1302. end;
  1303. {$endif NODEBUG}
  1304. {****************************************************************************
  1305. TBreakpoint
  1306. ****************************************************************************}
  1307. function ActiveBreakpoints : boolean;
  1308. var
  1309. IsActive : boolean;
  1310. procedure TestActive(PB : PBreakpoint);
  1311. begin
  1312. If PB^.state=bs_enabled then
  1313. IsActive:=true;
  1314. end;
  1315. begin
  1316. IsActive:=false;
  1317. If assigned(BreakpointsCollection) then
  1318. BreakpointsCollection^.ForEach(@TestActive);
  1319. ActiveBreakpoints:=IsActive;
  1320. end;
  1321. constructor TBreakpoint.Init_function(Const AFunc : String);
  1322. begin
  1323. typ:=bt_function;
  1324. state:=bs_enabled;
  1325. GDBState:=bs_deleted;
  1326. Name:=NewStr(AFunc);
  1327. FileName:=nil;
  1328. Line:=0;
  1329. IgnoreCount:=0;
  1330. Commands:=nil;
  1331. Conditions:=nil;
  1332. OldValue:=nil;
  1333. CurrentValue:=nil;
  1334. end;
  1335. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1336. begin
  1337. typ:=bt_address;
  1338. state:=bs_enabled;
  1339. GDBState:=bs_deleted;
  1340. Name:=NewStr(AAddress);
  1341. FileName:=nil;
  1342. Line:=0;
  1343. IgnoreCount:=0;
  1344. Commands:=nil;
  1345. Conditions:=nil;
  1346. OldValue:=nil;
  1347. CurrentValue:=nil;
  1348. end;
  1349. constructor TBreakpoint.Init_Empty;
  1350. begin
  1351. typ:=bt_function;
  1352. state:=bs_enabled;
  1353. GDBState:=bs_deleted;
  1354. Name:=Nil;
  1355. FileName:=nil;
  1356. Line:=0;
  1357. IgnoreCount:=0;
  1358. Commands:=nil;
  1359. Conditions:=nil;
  1360. OldValue:=nil;
  1361. CurrentValue:=nil;
  1362. end;
  1363. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1364. begin
  1365. typ:=atyp;
  1366. state:=bs_enabled;
  1367. GDBState:=bs_deleted;
  1368. Name:=NewStr(AnExpr);
  1369. IgnoreCount:=0;
  1370. Commands:=nil;
  1371. Conditions:=nil;
  1372. OldValue:=nil;
  1373. CurrentValue:=nil;
  1374. end;
  1375. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1376. var
  1377. CurDir : String;
  1378. begin
  1379. typ:=bt_file_line;
  1380. state:=bs_enabled;
  1381. GDBState:=bs_deleted;
  1382. AFile:=FEXpand(AFile);
  1383. (*
  1384. { d:test.pas:12 does not work !! }
  1385. { I do not know how to solve this if
  1386. if (Length(AFile)>1) and (AFile[2]=':') then
  1387. AFile:=Copy(AFile,3,255); }
  1388. {$ifdef Unix}
  1389. CurDir:=GetCurDir;
  1390. {$else}
  1391. CurDir:=LowerCaseStr(GetCurDir);
  1392. {$endif Unix}
  1393. if Pos(CurDir,OSFileName(AFile))=1 then
  1394. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1395. else
  1396. *)
  1397. FileName:=NewStr(OSFileName(AFile));
  1398. Name:=nil;
  1399. Line:=ALine;
  1400. IgnoreCount:=0;
  1401. Commands:=nil;
  1402. Conditions:=nil;
  1403. OldValue:=nil;
  1404. CurrentValue:=nil;
  1405. end;
  1406. constructor TBreakpoint.Load(var S: TStream);
  1407. var
  1408. FName : PString;
  1409. begin
  1410. S.Read(typ,SizeOf(BreakpointType));
  1411. S.Read(state,SizeOf(BreakpointState));
  1412. GDBState:=bs_deleted;
  1413. case typ of
  1414. bt_file_line :
  1415. begin
  1416. { convert to current target }
  1417. FName:=S.ReadStr;
  1418. FileName:=NewStr(OSFileName(GetStr(FName)));
  1419. If Assigned(FName) then
  1420. DisposeStr(FName);
  1421. S.Read(Line,SizeOf(Line));
  1422. Name:=nil;
  1423. end;
  1424. else
  1425. begin
  1426. Name:=S.ReadStr;
  1427. Line:=0;
  1428. FileName:=nil;
  1429. end;
  1430. end;
  1431. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1432. Commands:=S.StrRead;
  1433. Conditions:=S.ReadStr;
  1434. OldValue:=nil;
  1435. CurrentValue:=nil;
  1436. end;
  1437. procedure TBreakpoint.Store(var S: TStream);
  1438. var
  1439. St : String;
  1440. begin
  1441. S.Write(typ,SizeOf(BreakpointType));
  1442. S.Write(state,SizeOf(BreakpointState));
  1443. case typ of
  1444. bt_file_line :
  1445. begin
  1446. st:=OSFileName(GetStr(FileName));
  1447. S.WriteStr(@St);
  1448. S.Write(Line,SizeOf(Line));
  1449. end;
  1450. else
  1451. begin
  1452. S.WriteStr(Name);
  1453. end;
  1454. end;
  1455. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1456. S.StrWrite(Commands);
  1457. S.WriteStr(Conditions);
  1458. end;
  1459. procedure TBreakpoint.Insert;
  1460. var
  1461. p,p2 : pchar;
  1462. st : string;
  1463. begin
  1464. {$ifndef NODEBUG}
  1465. If not assigned(Debugger) then Exit;
  1466. Remove;
  1467. Debugger^.last_breakpoint_number:=0;
  1468. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1469. begin
  1470. if (typ=bt_file_line) and assigned(FileName) then
  1471. Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
  1472. else if (typ=bt_function) and assigned(name) then
  1473. Debugger^.Command('break '+name^)
  1474. else if (typ=bt_address) and assigned(name) then
  1475. Debugger^.Command('break *0x'+name^)
  1476. else if (typ=bt_watch) and assigned(name) then
  1477. Debugger^.Command('watch '+name^)
  1478. else if (typ=bt_awatch) and assigned(name) then
  1479. Debugger^.Command('awatch '+name^)
  1480. else if (typ=bt_rwatch) and assigned(name) then
  1481. Debugger^.Command('rwatch '+name^);
  1482. if Debugger^.last_breakpoint_number<>0 then
  1483. begin
  1484. GDBIndex:=Debugger^.last_breakpoint_number;
  1485. GDBState:=bs_enabled;
  1486. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1487. If IgnoreCount>0 then
  1488. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1489. If Assigned(Commands) then
  1490. begin
  1491. {Commands are not handled yet }
  1492. Debugger^.Command('command '+IntToStr(GDBIndex));
  1493. p:=commands;
  1494. while assigned(p) do
  1495. begin
  1496. p2:=strscan(p,#10);
  1497. if assigned(p2) then
  1498. p2^:=#0;
  1499. st:=strpas(p);
  1500. Debugger^.command(st);
  1501. if assigned(p2) then
  1502. p2^:=#10;
  1503. p:=p2;
  1504. if assigned(p) then
  1505. inc(p);
  1506. end;
  1507. Debugger^.Command('end');
  1508. end;
  1509. end
  1510. else
  1511. { Here there was a problem !! }
  1512. begin
  1513. GDBIndex:=0;
  1514. if not Debugger^.Disableallinvalidbreakpoints then
  1515. begin
  1516. if (typ=bt_file_line) and assigned(FileName) then
  1517. begin
  1518. ClearFormatParams;
  1519. AddFormatParamStr(NameAndExtOf(FileName^));
  1520. AddFormatParamInt(Line);
  1521. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1522. Debugger^.Disableallinvalidbreakpoints:=true;
  1523. end
  1524. else
  1525. begin
  1526. ClearFormatParams;
  1527. AddFormatParamStr(BreakpointTypeStr[typ]);
  1528. AddFormatParamStr(GetStr(Name));
  1529. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1530. Debugger^.Disableallinvalidbreakpoints:=true;
  1531. end;
  1532. end;
  1533. state:=bs_disabled;
  1534. UpdateSource;
  1535. end;
  1536. end
  1537. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1538. Enable
  1539. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1540. Disable;
  1541. {$endif NODEBUG}
  1542. end;
  1543. procedure TBreakpoint.Remove;
  1544. begin
  1545. {$ifndef NODEBUG}
  1546. If not assigned(Debugger) then Exit;
  1547. if GDBIndex>0 then
  1548. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1549. GDBIndex:=0;
  1550. GDBState:=bs_deleted;
  1551. {$endif NODEBUG}
  1552. end;
  1553. procedure TBreakpoint.Enable;
  1554. begin
  1555. {$ifndef NODEBUG}
  1556. If not assigned(Debugger) then Exit;
  1557. if GDBIndex>0 then
  1558. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1559. else
  1560. Insert;
  1561. GDBState:=bs_disabled;
  1562. {$endif NODEBUG}
  1563. end;
  1564. procedure TBreakpoint.Disable;
  1565. begin
  1566. {$ifndef NODEBUG}
  1567. If not assigned(Debugger) then Exit;
  1568. if GDBIndex>0 then
  1569. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1570. GDBState:=bs_disabled;
  1571. {$endif NODEBUG}
  1572. end;
  1573. procedure TBreakpoint.ResetValues;
  1574. begin
  1575. if assigned(OldValue) then
  1576. DisposeStr(OldValue);
  1577. OldValue:=nil;
  1578. if assigned(CurrentValue) then
  1579. DisposeStr(CurrentValue);
  1580. CurrentValue:=nil;
  1581. end;
  1582. procedure TBreakpoint.UpdateSource;
  1583. var W: PSourceWindow;
  1584. b : boolean;
  1585. begin
  1586. if typ=bt_file_line then
  1587. begin
  1588. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1589. If assigned(W) then
  1590. begin
  1591. if state=bs_enabled then
  1592. b:=true
  1593. else
  1594. b:=false;
  1595. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1596. end;
  1597. end;
  1598. end;
  1599. destructor TBreakpoint.Done;
  1600. begin
  1601. Remove;
  1602. ResetValues;
  1603. if assigned(Name) then
  1604. DisposeStr(Name);
  1605. if assigned(FileName) then
  1606. DisposeStr(FileName);
  1607. if assigned(Conditions) then
  1608. DisposeStr(Conditions);
  1609. if assigned(Commands) then
  1610. StrDispose(Commands);
  1611. inherited Done;
  1612. end;
  1613. {****************************************************************************
  1614. TBreakpointCollection
  1615. ****************************************************************************}
  1616. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1617. begin
  1618. At:=inherited At(Index);
  1619. end;
  1620. procedure TBreakpointCollection.Update;
  1621. begin
  1622. {$ifndef NODEBUG}
  1623. if assigned(Debugger) then
  1624. begin
  1625. Debugger^.RemoveBreakpoints;
  1626. Debugger^.InsertBreakpoints;
  1627. end;
  1628. {$endif NODEBUG}
  1629. if assigned(BreakpointsWindow) then
  1630. BreakpointsWindow^.Update;
  1631. end;
  1632. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1633. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1634. begin
  1635. IsNum:=P^.GDBIndex=index;
  1636. end;
  1637. begin
  1638. if index=0 then
  1639. GetGDB:=nil
  1640. else
  1641. GetGDB:=FirstThat(@IsNum);
  1642. end;
  1643. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1644. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1645. begin
  1646. If assigned(P^.FileName) and
  1647. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1648. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1649. end;
  1650. procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1651. var
  1652. PDL : PDisasLine;
  1653. S : string;
  1654. ps,qs,i : longint;
  1655. HAddr : PtrInt;
  1656. code : integer;
  1657. begin
  1658. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1659. begin
  1660. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1661. if PDL^.Address=0 then
  1662. begin
  1663. if (P^.typ=bt_file_line) then
  1664. begin
  1665. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1666. ps:=pos(':',S);
  1667. qs:=pos(' ',copy(S,ps+1,High(S)));
  1668. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1669. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1670. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1671. end;
  1672. end
  1673. else
  1674. begin
  1675. if assigned(P^.Name) then
  1676. begin
  1677. Val('$'+P^.Name^,HAddr,code);
  1678. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1679. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1680. end;
  1681. end;
  1682. end;
  1683. end;
  1684. begin
  1685. if W=PFPWindow(DisassemblyWindow) then
  1686. ForEach(@SetInDisassembly)
  1687. else
  1688. ForEach(@SetInSource);
  1689. end;
  1690. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1691. procedure AdaptInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1692. begin
  1693. If assigned(P^.FileName) and
  1694. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1695. begin
  1696. if P^.state=bs_enabled then
  1697. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1698. if P^.Line-1>=Pos then
  1699. begin
  1700. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1701. P^.line:=P^.Line+Change
  1702. else
  1703. begin
  1704. { removing inside a ForEach call leads to problems }
  1705. { so we do that after PM }
  1706. P^.state:=bs_delete_after;
  1707. end;
  1708. end;
  1709. if P^.state=bs_enabled then
  1710. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1711. end;
  1712. end;
  1713. var
  1714. I : longint;
  1715. begin
  1716. ForEach(@AdaptInSource);
  1717. I:=Count-1;
  1718. While (I>=0) do
  1719. begin
  1720. if At(I)^.state=bs_delete_after then
  1721. AtFree(I);
  1722. Dec(I);
  1723. end;
  1724. end;
  1725. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1726. function IsAtLine(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1727. begin
  1728. If assigned(P^.FileName) and
  1729. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1730. (Line=P^.Line) then
  1731. IsAtLine:=true
  1732. else
  1733. IsAtLine:=false;
  1734. end;
  1735. begin
  1736. FindBreakpointAt:=FirstThat(@IsAtLine);
  1737. end;
  1738. procedure TBreakpointCollection.ShowAllBreakpoints;
  1739. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1740. var
  1741. W : PSourceWindow;
  1742. begin
  1743. If assigned(P^.FileName) then
  1744. begin
  1745. W:=SearchOnDesktop(P^.FileName^,false);
  1746. if assigned(W) then
  1747. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1748. end;
  1749. end;
  1750. begin
  1751. ForEach(@SetInSource);
  1752. end;
  1753. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1754. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1755. begin
  1756. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1757. end;
  1758. begin
  1759. GetType:=FirstThat(@IsThis);
  1760. end;
  1761. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1762. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1763. begin
  1764. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1765. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1766. end;
  1767. var
  1768. PB : PBreakpoint;
  1769. begin
  1770. ToggleFileLine:=false;
  1771. FileName:=OSFileName(FExpand(FileName));
  1772. PB:=FirstThat(@IsThere);
  1773. If Assigned(PB) then
  1774. begin
  1775. { delete it form source window }
  1776. PB^.state:=bs_disabled;
  1777. PB^.UpdateSource;
  1778. { remove from collection }
  1779. BreakpointsCollection^.free(PB);
  1780. end
  1781. else
  1782. begin
  1783. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1784. if assigned(PB) then
  1785. Begin
  1786. Insert(PB);
  1787. PB^.UpdateSource;
  1788. ToggleFileLine:=true;
  1789. End;
  1790. end;
  1791. Update;
  1792. end;
  1793. {****************************************************************************
  1794. TBreakpointItem
  1795. ****************************************************************************}
  1796. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1797. begin
  1798. inherited Init;
  1799. Breakpoint:=ABreakpoint;
  1800. end;
  1801. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1802. var S: string;
  1803. begin
  1804. with Breakpoint^ do
  1805. begin
  1806. S:=BreakpointTypeStr[typ];
  1807. While Length(S)<10 do
  1808. S:=S+' ';
  1809. S:=S+'|';
  1810. S:=S+BreakpointStateStr[state]+' ';
  1811. While Length(S)<20 do
  1812. S:=S+' ';
  1813. S:=S+'|';
  1814. if (typ=bt_file_line) then
  1815. begin
  1816. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
  1817. While Length(S)<40 do
  1818. S:=S+' ';
  1819. S:=S+'|';
  1820. S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
  1821. end
  1822. else
  1823. S:=S+GetStr(name);
  1824. While Length(S)<70 do
  1825. S:=S+' ';
  1826. S:=S+'|';
  1827. if IgnoreCount>0 then
  1828. S:=S+IntToStr(IgnoreCount);
  1829. While Length(S)<79 do
  1830. S:=S+' ';
  1831. S:=S+'|';
  1832. if assigned(Conditions) then
  1833. S:=S+' '+GetStr(Conditions);
  1834. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1835. GetText:=S;
  1836. end;
  1837. end;
  1838. procedure TBreakpointItem.Selected;
  1839. begin
  1840. end;
  1841. function TBreakpointItem.GetModuleName: string;
  1842. begin
  1843. if breakpoint^.typ=bt_file_line then
  1844. GetModuleName:=GetStr(breakpoint^.FileName)
  1845. else
  1846. GetModuleName:='';
  1847. end;
  1848. {****************************************************************************
  1849. TBreakpointsListBox
  1850. ****************************************************************************}
  1851. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1852. begin
  1853. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1854. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1855. NoSelection:=true;
  1856. end;
  1857. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1858. var M: PMenu;
  1859. begin
  1860. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1861. M:=NewMenu(
  1862. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1863. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1864. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1865. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1866. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1867. nil))))));
  1868. GetLocalMenu:=M;
  1869. end;
  1870. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1871. var DontClear: boolean;
  1872. begin
  1873. case Event.What of
  1874. evKeyDown :
  1875. begin
  1876. DontClear:=false;
  1877. case Event.KeyCode of
  1878. kbEnd :
  1879. FocusItem(List^.Count-1);
  1880. kbHome :
  1881. FocusItem(0);
  1882. kbEnter :
  1883. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1884. kbIns :
  1885. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1886. kbDel :
  1887. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1888. else
  1889. DontClear:=true;
  1890. end;
  1891. if not DontClear then
  1892. ClearEvent(Event);
  1893. end;
  1894. evBroadcast :
  1895. case Event.Command of
  1896. cmListItemSelected :
  1897. if Event.InfoPtr=@Self then
  1898. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1899. end;
  1900. evCommand :
  1901. begin
  1902. DontClear:=false;
  1903. case Event.Command of
  1904. cmMsgTrackSource :
  1905. if Range>0 then
  1906. TrackSource;
  1907. cmEditBreakpoint :
  1908. EditCurrent;
  1909. cmToggleBreakpoint :
  1910. ToggleCurrent;
  1911. cmDeleteBreakpoint :
  1912. DeleteCurrent;
  1913. cmNewBreakpoint :
  1914. EditNew;
  1915. cmMsgClear :
  1916. Clear;
  1917. else
  1918. DontClear:=true;
  1919. end;
  1920. if not DontClear then
  1921. ClearEvent(Event);
  1922. end;
  1923. end;
  1924. inherited HandleEvent(Event);
  1925. end;
  1926. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1927. var W : integer;
  1928. begin
  1929. if List=nil then New(List, Init(20,20));
  1930. W:=length(P^.GetText(255));
  1931. if W>MaxWidth then
  1932. begin
  1933. MaxWidth:=W;
  1934. if HScrollBar<>nil then
  1935. HScrollBar^.SetRange(0,MaxWidth);
  1936. end;
  1937. List^.Insert(P);
  1938. SetRange(List^.Count);
  1939. if Focused=List^.Count-1-1 then
  1940. FocusItem(List^.Count-1);
  1941. P^.Breakpoint^.UpdateSource;
  1942. DrawView;
  1943. end;
  1944. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1945. var P: PBreakpointItem;
  1946. S: string;
  1947. begin
  1948. P:=List^.At(Item);
  1949. S:=P^.GetText(MaxLen);
  1950. GetText:=copy(S,1,MaxLen);
  1951. end;
  1952. procedure TBreakpointsListBox.Clear;
  1953. begin
  1954. if assigned(List) then
  1955. Dispose(List, Done);
  1956. List:=nil;
  1957. MaxWidth:=0;
  1958. SetRange(0); DrawView;
  1959. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1960. end;
  1961. procedure TBreakpointsListBox.TrackSource;
  1962. var W: PSourceWindow;
  1963. P: PBreakpointItem;
  1964. R: TRect;
  1965. begin
  1966. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1967. if Range=0 then Exit;*)
  1968. P:=List^.At(Focused);
  1969. if P^.GetModuleName='' then Exit;
  1970. Desktop^.Lock;
  1971. GetNextEditorBounds(R);
  1972. R.B.Y:=Owner^.Origin.Y;
  1973. W:=EditorWindowFile(P^.GetModuleName);
  1974. if assigned(W) then
  1975. begin
  1976. W^.GetExtent(R);
  1977. R.B.Y:=Owner^.Origin.Y;
  1978. W^.ChangeBounds(R);
  1979. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1980. end
  1981. else
  1982. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1983. if W<>nil then
  1984. begin
  1985. W^.Select;
  1986. W^.Editor^.TrackCursor(do_centre);
  1987. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  1988. end;
  1989. if Assigned(Owner) then
  1990. Owner^.Select;
  1991. Desktop^.UnLock;
  1992. end;
  1993. procedure TBreakpointsListBox.ToggleCurrent;
  1994. var
  1995. P: PBreakpointItem;
  1996. begin
  1997. if Range=0 then Exit;
  1998. P:=List^.At(Focused);
  1999. if P=nil then Exit;
  2000. if P^.Breakpoint^.state=bs_enabled then
  2001. P^.Breakpoint^.state:=bs_disabled
  2002. else if P^.Breakpoint^.state=bs_disabled then
  2003. P^.Breakpoint^.state:=bs_enabled;
  2004. P^.Breakpoint^.UpdateSource;
  2005. BreakpointsCollection^.Update;
  2006. end;
  2007. procedure TBreakpointsListBox.EditCurrent;
  2008. var
  2009. P: PBreakpointItem;
  2010. begin
  2011. if Range=0 then Exit;
  2012. P:=List^.At(Focused);
  2013. if P=nil then Exit;
  2014. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  2015. P^.Breakpoint^.UpdateSource;
  2016. BreakpointsCollection^.Update;
  2017. end;
  2018. procedure TBreakpointsListBox.DeleteCurrent;
  2019. var
  2020. P: PBreakpointItem;
  2021. begin
  2022. if Range=0 then Exit;
  2023. P:=List^.At(Focused);
  2024. if P=nil then Exit;
  2025. { delete it form source window }
  2026. P^.Breakpoint^.state:=bs_disabled;
  2027. P^.Breakpoint^.UpdateSource;
  2028. BreakpointsCollection^.free(P^.Breakpoint);
  2029. List^.free(P);
  2030. BreakpointsCollection^.Update;
  2031. end;
  2032. procedure TBreakpointsListBox.EditNew;
  2033. var
  2034. P: PBreakpoint;
  2035. begin
  2036. P:=New(PBreakpoint,Init_Empty);
  2037. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  2038. begin
  2039. P^.UpdateSource;
  2040. BreakpointsCollection^.Insert(P);
  2041. BreakpointsCollection^.Update;
  2042. end
  2043. else
  2044. dispose(P,Done);
  2045. end;
  2046. procedure TBreakpointsListBox.Draw;
  2047. var
  2048. I, J, Item: Sw_Integer;
  2049. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2050. ColWidth, CurCol, Indent: Integer;
  2051. B: TDrawBuffer;
  2052. Text: String;
  2053. SCOff: Byte;
  2054. TC: byte;
  2055. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2056. begin
  2057. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2058. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2059. begin
  2060. NormalColor := GetColor(1);
  2061. FocusedColor := GetColor(3);
  2062. SelectedColor := GetColor(4);
  2063. end else
  2064. begin
  2065. NormalColor := GetColor(2);
  2066. SelectedColor := GetColor(4);
  2067. end;
  2068. if Transparent then
  2069. begin MT(NormalColor); MT(SelectedColor); end;
  2070. if NoSelection then
  2071. SelectedColor:=NormalColor;
  2072. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2073. else Indent := 0;
  2074. ColWidth := Size.X div NumCols + 1;
  2075. for I := 0 to Size.Y - 1 do
  2076. begin
  2077. for J := 0 to NumCols-1 do
  2078. begin
  2079. Item := J*Size.Y + I + TopItem;
  2080. CurCol := J*ColWidth;
  2081. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2082. (Focused = Item) and (Range > 0) then
  2083. begin
  2084. Color := FocusedColor;
  2085. SetCursor(CurCol+1,I);
  2086. SCOff := 0;
  2087. end
  2088. else if (Item < Range) and IsSelected(Item) then
  2089. begin
  2090. Color := SelectedColor;
  2091. SCOff := 2;
  2092. end
  2093. else
  2094. begin
  2095. Color := NormalColor;
  2096. SCOff := 4;
  2097. end;
  2098. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2099. if Item < Range then
  2100. begin
  2101. Text := GetText(Item, ColWidth + Indent);
  2102. Text := Copy(Text,Indent,ColWidth);
  2103. MoveStr(B[CurCol+1], Text, Color);
  2104. if ShowMarkers then
  2105. begin
  2106. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2107. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2108. end;
  2109. end;
  2110. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2111. end;
  2112. WriteLine(0, I, Size.X, 1, B);
  2113. end;
  2114. end;
  2115. constructor TBreakpointsListBox.Load(var S: TStream);
  2116. begin
  2117. inherited Load(S);
  2118. end;
  2119. procedure TBreakpointsListBox.Store(var S: TStream);
  2120. var OL: PCollection;
  2121. OldR : integer;
  2122. begin
  2123. OL:=List;
  2124. OldR:=Range;
  2125. Range:=0;
  2126. New(List, Init(1,1));
  2127. inherited Store(S);
  2128. Dispose(List, Done);
  2129. Range:=OldR;
  2130. List:=OL;
  2131. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2132. collection? Pasting here a modified version of TListBox.Store+
  2133. TAdvancedListBox.Store isn't a better solution, since by eventually
  2134. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2135. end;
  2136. destructor TBreakpointsListBox.Done;
  2137. begin
  2138. inherited Done;
  2139. if List<>nil then Dispose(List, Done);
  2140. end;
  2141. {****************************************************************************
  2142. TBreakpointsWindow
  2143. ****************************************************************************}
  2144. constructor TBreakpointsWindow.Init;
  2145. var R,R2: TRect;
  2146. HSB,VSB: PScrollBar;
  2147. ST: PStaticText;
  2148. S: String;
  2149. X,X1 : Sw_integer;
  2150. Btn: PButton;
  2151. const
  2152. NumButtons = 5;
  2153. begin
  2154. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2155. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2156. HelpCtx:=hcBreakpointListWindow;
  2157. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2158. S:=label_breakpointpropheader;
  2159. New(ST, Init(R,S));
  2160. ST^.GrowMode:=gfGrowHiX;
  2161. Insert(ST);
  2162. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2163. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2164. ST^.GrowMode:=gfGrowHiX;
  2165. Insert(ST);
  2166. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2167. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2168. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2169. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2170. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2171. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2172. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2173. New(BreakLB, Init(R,HSB,VSB));
  2174. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2175. BreakLB^.Transparent:=true;
  2176. Insert(BreakLB);
  2177. GetExtent(R);R.Grow(-1,-1);
  2178. Dec(R.B.Y);
  2179. R.A.Y:=R.B.Y-2;
  2180. X:=(R.B.X-R.A.X) div NumButtons;
  2181. X1:=R.A.X+(X div 2);
  2182. R.A.X:=X1-3;R.B.X:=X1+7;
  2183. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2184. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2185. Insert(Btn);
  2186. X1:=X1+X;
  2187. R.A.X:=X1-3;R.B.X:=X1+7;
  2188. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2189. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2190. Insert(Btn);
  2191. X1:=X1+X;
  2192. R.A.X:=X1-3;R.B.X:=X1+7;
  2193. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2194. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2195. Insert(Btn);
  2196. X1:=X1+X;
  2197. R.A.X:=X1-3;R.B.X:=X1+7;
  2198. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2199. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2200. Insert(Btn);
  2201. X1:=X1+X;
  2202. R.A.X:=X1-3;R.B.X:=X1+7;
  2203. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2204. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2205. Insert(Btn);
  2206. BreakLB^.Select;
  2207. Update;
  2208. BreakpointsWindow:=@self;
  2209. end;
  2210. constructor TBreakpointsWindow.Load(var S: TStream);
  2211. begin
  2212. inherited Load(S);
  2213. GetSubViewPtr(S,BreakLB);
  2214. end;
  2215. procedure TBreakpointsWindow.Store(var S: TStream);
  2216. begin
  2217. inherited Store(S);
  2218. PutSubViewPtr(S,BreakLB);
  2219. end;
  2220. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2221. begin
  2222. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2223. end;
  2224. procedure TBreakpointsWindow.ClearBreakpoints;
  2225. begin
  2226. BreakLB^.Clear;
  2227. ReDraw;
  2228. end;
  2229. procedure TBreakpointsWindow.ReloadBreakpoints;
  2230. procedure InsertInBreakLB(P : PBreakpoint);
  2231. begin
  2232. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2233. end;
  2234. begin
  2235. If not assigned(BreakpointsCollection) then
  2236. exit;
  2237. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2238. ReDraw;
  2239. end;
  2240. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2241. begin
  2242. inherited SizeLimits(Min,Max);
  2243. Min.X:=40; Min.Y:=18;
  2244. end;
  2245. procedure TBreakpointsWindow.Close;
  2246. begin
  2247. Hide;
  2248. end;
  2249. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2250. var DontClear : boolean;
  2251. begin
  2252. case Event.What of
  2253. evKeyDown :
  2254. begin
  2255. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2256. begin
  2257. ClearEvent(Event);
  2258. Hide;
  2259. end;
  2260. end;
  2261. evCommand :
  2262. begin
  2263. DontClear:=False;
  2264. case Event.Command of
  2265. cmNewBreakpoint :
  2266. BreakLB^.EditNew;
  2267. cmEditBreakpoint :
  2268. BreakLB^.EditCurrent;
  2269. cmDeleteBreakpoint :
  2270. BreakLB^.DeleteCurrent;
  2271. cmToggleBreakInList :
  2272. BreakLB^.ToggleCurrent;
  2273. cmClose :
  2274. Hide;
  2275. else
  2276. DontClear:=true;
  2277. end;
  2278. if not DontClear then
  2279. ClearEvent(Event);
  2280. end;
  2281. evBroadcast :
  2282. case Event.Command of
  2283. cmUpdate :
  2284. Update;
  2285. end;
  2286. end;
  2287. inherited HandleEvent(Event);
  2288. end;
  2289. procedure TBreakpointsWindow.Update;
  2290. var
  2291. StoreFocus : longint;
  2292. begin
  2293. StoreFocus:=BreakLB^.Focused;
  2294. ClearBreakpoints;
  2295. ReloadBreakpoints;
  2296. If StoreFocus<BreakLB^.Range then
  2297. BreakLB^.FocusItem(StoreFocus);
  2298. end;
  2299. destructor TBreakpointsWindow.Done;
  2300. begin
  2301. inherited Done;
  2302. BreakpointsWindow:=nil;
  2303. end;
  2304. {****************************************************************************
  2305. TBreakpointItemDialog
  2306. ****************************************************************************}
  2307. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2308. var R,R2,R3: TRect;
  2309. Items: PSItem;
  2310. I : BreakpointType;
  2311. KeyCount: sw_integer;
  2312. begin
  2313. KeyCount:=longint(high(BreakpointType));
  2314. R.Assign(0,0,60,Max(9+KeyCount,18));
  2315. inherited Init(R,dialog_modifynewbreakpoint);
  2316. Breakpoint:=ABreakpoint;
  2317. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2318. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2319. New(NameIL, Init(R, 255)); Insert(NameIL);
  2320. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2321. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2322. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2323. R2.Copy(R); R2.Move(-1,-1);
  2324. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2325. R.Move(0,3);
  2326. R.B.X:=R.B.X-3;
  2327. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2328. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2329. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2330. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2331. R.Move(0,3); R.B.X:=R.A.X+36;
  2332. New(LineIL, Init(R, 128)); Insert(LineIL);
  2333. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2334. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2335. R.Move(0,3);
  2336. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2337. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2338. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2339. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2340. Items:=nil;
  2341. { don't use invalid type }
  2342. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2343. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2344. New(TypeRB, Init(R, Items));
  2345. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2346. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2347. Insert(TypeRB);
  2348. InsertButtons(@Self);
  2349. NameIL^.Select;
  2350. end;
  2351. function TBreakpointItemDialog.Execute: Word;
  2352. var R: sw_word;
  2353. S1: string;
  2354. err: word;
  2355. L: longint;
  2356. begin
  2357. R:=sw_word(Breakpoint^.typ);
  2358. TypeRB^.SetData(R);
  2359. If Breakpoint^.typ=bt_file_line then
  2360. S1:=GetStr(Breakpoint^.FileName)
  2361. else
  2362. S1:=GetStr(Breakpoint^.name);
  2363. NameIL^.SetData(S1);
  2364. If Breakpoint^.typ=bt_file_line then
  2365. S1:=IntToStr(Breakpoint^.Line)
  2366. else
  2367. S1:='0';
  2368. LineIL^.SetData(S1);
  2369. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2370. IgnoreIL^.SetData(S1);
  2371. S1:=GetStr(Breakpoint^.Conditions);
  2372. ConditionsIL^.SetData(S1);
  2373. if assigned(FirstEditorWindow) then
  2374. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2375. R:=inherited Execute;
  2376. FindReplaceEditor:=nil;
  2377. if R=cmOK then
  2378. begin
  2379. TypeRB^.GetData(R);
  2380. L:=R;
  2381. Breakpoint^.typ:=BreakpointType(L);
  2382. NameIL^.GetData(S1);
  2383. If Breakpoint^.typ=bt_file_line then
  2384. begin
  2385. If assigned(Breakpoint^.FileName) then
  2386. DisposeStr(Breakpoint^.FileName);
  2387. Breakpoint^.FileName:=NewStr(S1);
  2388. end
  2389. else
  2390. begin
  2391. If assigned(Breakpoint^.Name) then
  2392. DisposeStr(Breakpoint^.Name);
  2393. Breakpoint^.name:=NewStr(S1);
  2394. end;
  2395. If Breakpoint^.typ=bt_file_line then
  2396. begin
  2397. LineIL^.GetData(S1);
  2398. Val(S1,L,err);
  2399. Breakpoint^.Line:=L;
  2400. end;
  2401. IgnoreIL^.GetData(S1);
  2402. Val(S1,L,err);
  2403. Breakpoint^.IgnoreCount:=L;
  2404. ConditionsIL^.GetData(S1);
  2405. If assigned(Breakpoint^.Conditions) then
  2406. DisposeStr(Breakpoint^.Conditions);
  2407. Breakpoint^.Conditions:=NewStr(S1);
  2408. end;
  2409. Execute:=R;
  2410. end;
  2411. {****************************************************************************
  2412. TWatch
  2413. ****************************************************************************}
  2414. constructor TWatch.Init(s : string);
  2415. begin
  2416. expr:=NewStr(s);
  2417. last_value:=nil;
  2418. current_value:=nil;
  2419. Get_new_value;
  2420. GDBRunCount:=-1;
  2421. end;
  2422. constructor TWatch.Load(var S: TStream);
  2423. begin
  2424. expr:=S.ReadStr;
  2425. last_value:=nil;
  2426. current_value:=nil;
  2427. Get_new_value;
  2428. GDBRunCount:=-1;
  2429. end;
  2430. procedure TWatch.Store(var S: TStream);
  2431. begin
  2432. S.WriteStr(expr);
  2433. end;
  2434. procedure TWatch.rename(s : string);
  2435. begin
  2436. if assigned(expr) then
  2437. begin
  2438. if GetStr(expr)=S then
  2439. exit;
  2440. DisposeStr(expr);
  2441. end;
  2442. expr:=NewStr(s);
  2443. if assigned(last_value) then
  2444. StrDispose(last_value);
  2445. last_value:=nil;
  2446. if assigned(current_value) then
  2447. StrDispose(current_value);
  2448. current_value:=nil;
  2449. GDBRunCount:=-1;
  2450. Get_new_value;
  2451. end;
  2452. procedure TWatch.Get_new_value;
  2453. {$ifndef NODEBUG}
  2454. var p, q : pchar;
  2455. i, j, curframe, startframe : longint;
  2456. s,s2 : string;
  2457. loop_higher, found : boolean;
  2458. last_removed : char;
  2459. function GetValue(var s : string) : boolean;
  2460. begin
  2461. Debugger^.command('p '+s);
  2462. if not Debugger^.Error then
  2463. begin
  2464. s:=StrPas(Debugger^.GetOutput);
  2465. GetValue:=true;
  2466. end
  2467. else
  2468. begin
  2469. s:=StrPas(Debugger^.GetError);
  2470. GetValue:=false;
  2471. { do not open a messagebox for such errors }
  2472. Debugger^.got_error:=false;
  2473. end;
  2474. end;
  2475. begin
  2476. If not assigned(Debugger) or Not Debugger^.HasExe or
  2477. (GDBRunCount=Debugger^.RunCount) then
  2478. exit;
  2479. GDBRunCount:=Debugger^.RunCount;
  2480. if assigned(last_value) then
  2481. strdispose(last_value);
  2482. last_value:=current_value;
  2483. s:=GetStr(expr);
  2484. { Fix 2d array indexing, change [x,x] to [x][x] }
  2485. i:=pos('[',s);
  2486. if i>0 then
  2487. begin
  2488. while i<length(s) do
  2489. begin
  2490. if s[i]=',' then
  2491. begin
  2492. s[i]:='[';
  2493. insert(']',s,i);
  2494. inc(i);
  2495. end;
  2496. inc(i);
  2497. end;
  2498. end;
  2499. found:=GetValue(s);
  2500. Debugger^.got_error:=false;
  2501. loop_higher:=not found;
  2502. if not found then
  2503. begin
  2504. curframe:=Debugger^.get_current_frame;
  2505. startframe:=curframe;
  2506. end
  2507. else
  2508. begin
  2509. curframe:=0;
  2510. startframe:=0;
  2511. end;
  2512. while loop_higher do
  2513. begin
  2514. s:='parentfp';
  2515. if GetValue(s) then
  2516. begin
  2517. repeat
  2518. inc(curframe);
  2519. if not Debugger^.set_current_frame(curframe) then
  2520. loop_higher:=false;
  2521. {$ifdef FrameNameKnown}
  2522. s2:='/x '+FrameName;
  2523. {$else not FrameNameKnown}
  2524. s2:='/x $ebp';
  2525. {$endif FrameNameKnown}
  2526. getValue(s2);
  2527. j:=pos('=',s2);
  2528. if j>0 then
  2529. s2:=copy(s2,j+1,length(s2));
  2530. while s2[1] in [' ',TAB] do
  2531. delete(s2,1,1);
  2532. if pos(s2,s)>0 then
  2533. loop_higher :=false;
  2534. until not loop_higher;
  2535. { try again at that level }
  2536. s:=GetStr(expr);
  2537. found:=GetValue(s);
  2538. loop_higher:=not found;
  2539. end
  2540. else
  2541. loop_higher:=false;
  2542. end;
  2543. if found then
  2544. p:=StrNew(Debugger^.GetOutput)
  2545. else
  2546. begin
  2547. { get a reasonable output at least }
  2548. s:=GetStr(expr);
  2549. GetValue(s);
  2550. p:=StrNew(Debugger^.GetError);
  2551. end;
  2552. Debugger^.got_error:=false;
  2553. { We should try here to find the expr in parent
  2554. procedure if there are
  2555. I will implement this as I added a
  2556. parent_ebp pseudo local var to local procedure
  2557. in stabs debug info PM }
  2558. { But there are some pitfalls like
  2559. locals redefined in other sublocals that call the function }
  2560. if curframe<>startframe then
  2561. Debugger^.set_current_frame(startframe);
  2562. q:=nil;
  2563. if assigned(p) and (p[0]='$') then
  2564. q:=StrPos(p,'=');
  2565. if not assigned(q) then
  2566. q:=p;
  2567. if assigned(q) then
  2568. i:=strlen(q)
  2569. else
  2570. i:=0;
  2571. if (i>0) and (q[i-1]=#10) then
  2572. begin
  2573. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2574. dec(i);
  2575. last_removed:=q[i-1];
  2576. q[i-1]:=#0;
  2577. end
  2578. else
  2579. last_removed:=#0;
  2580. if assigned(q) then
  2581. current_value:=strnew(q)
  2582. else
  2583. current_value:=strnew('');
  2584. if last_removed<>#0 then
  2585. q[i-1]:=last_removed;
  2586. strdispose(p);
  2587. GDBRunCount:=Debugger^.RunCount;
  2588. end;
  2589. {$else NODEBUG}
  2590. begin
  2591. end;
  2592. {$endif NODEBUG}
  2593. procedure TWatch.Force_new_value;
  2594. begin
  2595. GDBRunCount:=-1;
  2596. Get_new_value;
  2597. end;
  2598. destructor TWatch.Done;
  2599. begin
  2600. if assigned(expr) then
  2601. disposestr(expr);
  2602. if assigned(last_value) then
  2603. strdispose(last_value);
  2604. if assigned(current_value) then
  2605. strdispose(current_value);
  2606. inherited done;
  2607. end;
  2608. {****************************************************************************
  2609. TWatchesCollection
  2610. ****************************************************************************}
  2611. constructor TWatchesCollection.Init;
  2612. begin
  2613. inherited Init(10,10);
  2614. end;
  2615. procedure TWatchesCollection.Insert(Item: Pointer);
  2616. begin
  2617. PWatch(Item)^.Get_new_value;
  2618. Inherited Insert(Item);
  2619. Update;
  2620. end;
  2621. procedure TWatchesCollection.Update;
  2622. var
  2623. W,W1 : integer;
  2624. procedure GetMax(P : PWatch);
  2625. begin
  2626. if assigned(P^.Current_value) then
  2627. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2628. else
  2629. W1:=2+Length(GetStr(P^.expr));
  2630. if W1>W then
  2631. W:=W1;
  2632. end;
  2633. begin
  2634. W:=0;
  2635. ForEach(@GetMax);
  2636. MaxW:=W;
  2637. If assigned(WatchesWindow) then
  2638. WatchesWindow^.WLB^.Update(MaxW);
  2639. end;
  2640. function TWatchesCollection.At(Index: Integer): PWatch;
  2641. begin
  2642. At:=Inherited At(Index);
  2643. end;
  2644. {****************************************************************************
  2645. TWatchesListBox
  2646. ****************************************************************************}
  2647. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2648. begin
  2649. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2650. If assigned(List) then
  2651. dispose(list,done);
  2652. List:=WatchesCollection;
  2653. end;
  2654. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2655. var R : TRect;
  2656. begin
  2657. GetExtent(R);
  2658. MaxWidth:=AMaxWidth;
  2659. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2660. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2661. else
  2662. HScrollBar^.SetRange(0,0);
  2663. if R.B.X-R.A.X>MaxWidth then
  2664. HScrollBar^.Hide
  2665. else
  2666. HScrollBar^.Show;
  2667. SetRange(List^.Count+1);
  2668. if R.B.Y-R.A.Y>Range then
  2669. VScrollBar^.Hide
  2670. else
  2671. VScrollBar^.Show;
  2672. {if Focused=List^.Count-1-1 then
  2673. FocusItem(List^.Count-1);
  2674. What was that for ?? PM }
  2675. DrawView;
  2676. end;
  2677. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2678. var
  2679. PW : PWatch;
  2680. ValOffset : Sw_integer;
  2681. S : String;
  2682. begin
  2683. Modified:=false;
  2684. if Item>=WatchesCollection^.Count then
  2685. begin
  2686. GetIndentedText:='';
  2687. exit;
  2688. end;
  2689. PW:=WatchesCollection^.At(Item);
  2690. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2691. if not assigned(PW^.expr) then
  2692. GetIndentedText:=''
  2693. else if Indent<ValOffset then
  2694. begin
  2695. S:=GetStr(PW^.Expr);
  2696. if Indent=0 then
  2697. S:=' '+S
  2698. else
  2699. S:=Copy(S,Indent,High(S));
  2700. if not assigned(PW^.current_value) then
  2701. S:=S+' <Unknown value>'
  2702. else
  2703. S:=S+' '+GetPChar(PW^.Current_value);
  2704. GetIndentedText:=Copy(S,1,MaxLen);
  2705. end
  2706. else
  2707. begin
  2708. if not assigned(PW^.Current_value) or
  2709. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2710. S:=''
  2711. else
  2712. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2713. GetIndentedText:=Copy(S,1,MaxLen);
  2714. end;
  2715. if assigned(PW^.current_value) and
  2716. assigned(PW^.last_value) and
  2717. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2718. Modified:=true;
  2719. end;
  2720. procedure TWatchesListBox.EditCurrent;
  2721. var
  2722. P: PWatch;
  2723. begin
  2724. if Range=0 then Exit;
  2725. if Focused<WatchesCollection^.Count then
  2726. P:=WatchesCollection^.At(Focused)
  2727. else
  2728. P:=New(PWatch,Init(''));
  2729. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2730. WatchesCollection^.Update;
  2731. end;
  2732. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2733. var
  2734. Dummy_Modified : boolean;
  2735. begin
  2736. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2737. end;
  2738. procedure TWatchesListBox.DeleteCurrent;
  2739. var
  2740. P: PWatch;
  2741. begin
  2742. if (Range=0) or
  2743. (Focused>=WatchesCollection^.Count) then
  2744. exit;
  2745. P:=WatchesCollection^.At(Focused);
  2746. WatchesCollection^.free(P);
  2747. WatchesCollection^.Update;
  2748. end;
  2749. procedure TWatchesListBox.EditNew;
  2750. var
  2751. P: PWatch;
  2752. S : string;
  2753. begin
  2754. if Focused<WatchesCollection^.Count then
  2755. begin
  2756. P:=WatchesCollection^.At(Focused);
  2757. S:=GetStr(P^.expr);
  2758. end
  2759. else
  2760. S:='';
  2761. P:=New(PWatch,Init(S));
  2762. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2763. begin
  2764. WatchesCollection^.AtInsert(Focused,P);
  2765. WatchesCollection^.Update;
  2766. end
  2767. else
  2768. dispose(P,Done);
  2769. end;
  2770. procedure TWatchesListBox.Draw;
  2771. var
  2772. I, J, Item: Sw_Integer;
  2773. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2774. ColWidth, CurCol, Indent: Integer;
  2775. B: TDrawBuffer;
  2776. Modified : boolean;
  2777. Text: String;
  2778. SCOff: Byte;
  2779. TC: byte;
  2780. procedure MT(var C: word);
  2781. begin
  2782. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2783. end;
  2784. begin
  2785. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2786. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2787. begin
  2788. NormalColor := GetColor(1);
  2789. FocusedColor := GetColor(3);
  2790. SelectedColor := GetColor(4);
  2791. end else
  2792. begin
  2793. NormalColor := GetColor(2);
  2794. SelectedColor := GetColor(4);
  2795. end;
  2796. if Transparent then
  2797. begin MT(NormalColor); MT(SelectedColor); end;
  2798. (* if NoSelection then
  2799. SelectedColor:=NormalColor;*)
  2800. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2801. else Indent := 0;
  2802. ColWidth := Size.X div NumCols + 1;
  2803. for I := 0 to Size.Y - 1 do
  2804. begin
  2805. for J := 0 to NumCols-1 do
  2806. begin
  2807. Item := J*Size.Y + I + TopItem;
  2808. CurCol := J*ColWidth;
  2809. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2810. (Focused = Item) and (Range > 0) then
  2811. begin
  2812. Color := FocusedColor;
  2813. SetCursor(CurCol+1,I);
  2814. SCOff := 0;
  2815. end
  2816. else if (Item < Range) and IsSelected(Item) then
  2817. begin
  2818. Color := SelectedColor;
  2819. SCOff := 2;
  2820. end
  2821. else
  2822. begin
  2823. Color := NormalColor;
  2824. SCOff := 4;
  2825. end;
  2826. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2827. if Item < Range then
  2828. begin
  2829. (* Text := GetText(Item, ColWidth + Indent);
  2830. Text := Copy(Text,Indent,ColWidth); *)
  2831. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2832. if modified then
  2833. begin
  2834. SCOff:=0;
  2835. Color:=(Color and $fff0) or Red;
  2836. end;
  2837. MoveStr(B[CurCol], Text, Color);
  2838. if {ShowMarkers or } Modified then
  2839. begin
  2840. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2841. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2842. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2843. end;
  2844. end;
  2845. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2846. end;
  2847. WriteLine(0, I, Size.X, 1, B);
  2848. end;
  2849. end;
  2850. function TWatchesListBox.GetLocalMenu: PMenu;
  2851. var M: PMenu;
  2852. begin
  2853. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2854. M:=NewMenu(
  2855. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2856. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2857. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2858. NewLine(
  2859. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2860. nil))))));
  2861. GetLocalMenu:=M;
  2862. end;
  2863. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2864. var DontClear: boolean;
  2865. begin
  2866. case Event.What of
  2867. evKeyDown :
  2868. begin
  2869. DontClear:=false;
  2870. case Event.KeyCode of
  2871. kbEnter :
  2872. Message(@Self,evCommand,cmEdit,nil);
  2873. kbIns :
  2874. Message(@Self,evCommand,cmNew,nil);
  2875. kbDel :
  2876. Message(@Self,evCommand,cmDelete,nil);
  2877. else
  2878. DontClear:=true;
  2879. end;
  2880. if not DontClear then
  2881. ClearEvent(Event);
  2882. end;
  2883. evBroadcast :
  2884. case Event.Command of
  2885. cmListItemSelected :
  2886. if Event.InfoPtr=@Self then
  2887. Message(@Self,evCommand,cmEdit,nil);
  2888. end;
  2889. evCommand :
  2890. begin
  2891. DontClear:=false;
  2892. case Event.Command of
  2893. cmEdit :
  2894. EditCurrent;
  2895. cmDelete :
  2896. DeleteCurrent;
  2897. cmNew :
  2898. EditNew;
  2899. else
  2900. DontClear:=true;
  2901. end;
  2902. if not DontClear then
  2903. ClearEvent(Event);
  2904. end;
  2905. end;
  2906. inherited HandleEvent(Event);
  2907. end;
  2908. constructor TWatchesListBox.Load(var S: TStream);
  2909. begin
  2910. inherited Load(S);
  2911. If assigned(List) then
  2912. dispose(list,done);
  2913. List:=WatchesCollection;
  2914. { we must set Range PM }
  2915. SetRange(List^.count+1);
  2916. end;
  2917. procedure TWatchesListBox.Store(var S: TStream);
  2918. var OL: PCollection;
  2919. OldRange : Sw_integer;
  2920. begin
  2921. OL:=List;
  2922. OldRange:=Range;
  2923. Range:=0;
  2924. New(List, Init(1,1));
  2925. inherited Store(S);
  2926. Dispose(List, Done);
  2927. List:=OL;
  2928. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2929. collection? Pasting here a modified version of TListBox.Store+
  2930. TAdvancedListBox.Store isn't a better solution, since by eventually
  2931. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2932. SetRange(OldRange);
  2933. end;
  2934. destructor TWatchesListBox.Done;
  2935. begin
  2936. List:=nil;
  2937. inherited Done;
  2938. end;
  2939. {****************************************************************************
  2940. TWatchesWindow
  2941. ****************************************************************************}
  2942. Constructor TWatchesWindow.Init;
  2943. var
  2944. HSB,VSB: PScrollBar;
  2945. R,R2 : trect;
  2946. begin
  2947. Desktop^.GetExtent(R);
  2948. R.A.Y:=R.B.Y-7;
  2949. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  2950. Palette:=wpCyanWindow;
  2951. GetExtent(R);
  2952. HelpCtx:=hcWatchesWindow;
  2953. R.Grow(-1,-1);
  2954. R2.Copy(R);
  2955. Inc(R2.B.Y);
  2956. R2.A.Y:=R2.B.Y-1;
  2957. New(HSB, Init(R2));
  2958. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2959. HSB^.SetStep(R.B.X-R.A.X,1);
  2960. Insert(HSB);
  2961. R2.Copy(R);
  2962. Inc(R2.B.X);
  2963. R2.A.X:=R2.B.X-1;
  2964. New(VSB, Init(R2));
  2965. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2966. Insert(VSB);
  2967. New(WLB,Init(R,HSB,VSB));
  2968. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2969. WLB^.Transparent:=true;
  2970. Insert(WLB);
  2971. If assigned(WatchesWindow) then
  2972. dispose(WatchesWindow,done);
  2973. WatchesWindow:=@Self;
  2974. Update;
  2975. end;
  2976. procedure TWatchesWindow.Update;
  2977. begin
  2978. WatchesCollection^.Update;
  2979. Draw;
  2980. end;
  2981. constructor TWatchesWindow.Load(var S: TStream);
  2982. begin
  2983. inherited Load(S);
  2984. GetSubViewPtr(S,WLB);
  2985. If assigned(WatchesWindow) then
  2986. dispose(WatchesWindow,done);
  2987. WatchesWindow:=@Self;
  2988. end;
  2989. procedure TWatchesWindow.Store(var S: TStream);
  2990. begin
  2991. inherited Store(S);
  2992. PutSubViewPtr(S,WLB);
  2993. end;
  2994. Destructor TWatchesWindow.Done;
  2995. begin
  2996. WatchesWindow:=nil;
  2997. Dispose(WLB,done);
  2998. inherited done;
  2999. end;
  3000. {****************************************************************************
  3001. TWatchItemDialog
  3002. ****************************************************************************}
  3003. constructor TWatchItemDialog.Init(AWatch: PWatch);
  3004. var R,R2: TRect;
  3005. begin
  3006. R.Assign(0,0,50,10);
  3007. inherited Init(R,'Edit Watch');
  3008. Watch:=AWatch;
  3009. GetExtent(R); R.Grow(-3,-2);
  3010. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  3011. New(NameIL, Init(R, 255)); Insert(NameIL);
  3012. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  3013. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  3014. R2.Copy(R); R2.Move(-1,-1);
  3015. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  3016. GetExtent(R);
  3017. R.Grow(-3,-1);
  3018. R.A.Y:=R.A.Y+3;
  3019. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  3020. Insert(TextST);
  3021. InsertButtons(@Self);
  3022. NameIL^.Select;
  3023. end;
  3024. function TWatchItemDialog.Execute: Word;
  3025. var R: word;
  3026. S1,S2: string;
  3027. begin
  3028. S1:=GetStr(Watch^.expr);
  3029. NameIL^.SetData(S1);
  3030. S1:=GetPChar(Watch^.Current_value);
  3031. S2:=GetPChar(Watch^.Last_value);
  3032. ClearFormatParams;
  3033. AddFormatParamStr(S1);
  3034. AddFormatParamStr(S2);
  3035. if assigned(Watch^.Last_value) and
  3036. assigned(Watch^.Current_value) and
  3037. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  3038. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  3039. else
  3040. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  3041. TextST^.SetText(S1);
  3042. if assigned(FirstEditorWindow) then
  3043. FindReplaceEditor:=FirstEditorWindow^.Editor;
  3044. R:=inherited Execute;
  3045. FindReplaceEditor:=nil;
  3046. if R=cmOK then
  3047. begin
  3048. NameIL^.GetData(S1);
  3049. Watch^.Rename(S1);
  3050. {$ifndef NODEBUG}
  3051. If assigned(Debugger) then
  3052. Debugger^.ReadWatches;
  3053. {$endif NODEBUG}
  3054. end;
  3055. Execute:=R;
  3056. end;
  3057. {****************************************************************************
  3058. TStackWindow
  3059. ****************************************************************************}
  3060. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3061. begin
  3062. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3063. end;
  3064. procedure TFramesListBox.Update;
  3065. var i : longint;
  3066. W : PSourceWindow;
  3067. begin
  3068. {$ifndef NODEBUG}
  3069. { call backtrace command }
  3070. If not assigned(Debugger) then
  3071. exit;
  3072. DeskTop^.Lock;
  3073. Clear;
  3074. { forget all old frames }
  3075. Debugger^.clear_frames;
  3076. if Debugger^.WindowWidth<>-1 then
  3077. Debugger^.Command('set width 0xffffffff');
  3078. Debugger^.Command('backtrace');
  3079. { generate list }
  3080. { all is in tframeentry }
  3081. for i:=0 to Debugger^.frame_count-1 do
  3082. begin
  3083. with Debugger^.frames[i]^ do
  3084. begin
  3085. if assigned(file_name) then
  3086. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3087. AddModuleName(GetPChar(file_name)),line_number,1)))
  3088. else
  3089. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3090. AddModuleName(''),line_number,1)));
  3091. W:=SearchOnDesktop(GetPChar(file_name),false);
  3092. { First reset all Debugger rows }
  3093. If assigned(W) then
  3094. begin
  3095. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3096. W^.Editor^.DebuggerRow:=-1;
  3097. end;
  3098. end;
  3099. end;
  3100. { Now set all Debugger rows }
  3101. for i:=0 to Debugger^.frame_count-1 do
  3102. begin
  3103. with Debugger^.frames[i]^ do
  3104. begin
  3105. W:=SearchOnDesktop(GetPChar(file_name),false);
  3106. If assigned(W) then
  3107. begin
  3108. If W^.Editor^.DebuggerRow=-1 then
  3109. begin
  3110. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3111. W^.Editor^.DebuggerRow:=line_number-1;
  3112. end;
  3113. end;
  3114. end;
  3115. end;
  3116. if Assigned(list) and (List^.Count > 0) then
  3117. FocusItem(0);
  3118. if Debugger^.WindowWidth<>-1 then
  3119. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3120. DeskTop^.Unlock;
  3121. {$endif NODEBUG}
  3122. end;
  3123. function TFramesListBox.GetLocalMenu: PMenu;
  3124. begin
  3125. GetLocalMenu:=Inherited GetLocalMenu;
  3126. end;
  3127. procedure TFramesListBox.GotoSource;
  3128. begin
  3129. {$ifndef NODEBUG}
  3130. { select frame for watches }
  3131. If not assigned(Debugger) then
  3132. exit;
  3133. Debugger^.Command('f '+IntToStr(Focused));
  3134. { for local vars }
  3135. Debugger^.RereadWatches;
  3136. {$endif NODEBUG}
  3137. { goto source }
  3138. inherited GotoSource;
  3139. end;
  3140. procedure TFramesListBox.GotoAssembly;
  3141. begin
  3142. {$ifndef NODEBUG}
  3143. { select frame for watches }
  3144. If not assigned(Debugger) then
  3145. exit;
  3146. Debugger^.Command('f '+IntToStr(Focused));
  3147. { for local vars }
  3148. Debugger^.RereadWatches;
  3149. {$endif}
  3150. { goto source/assembly mixture }
  3151. InitDisassemblyWindow;
  3152. DisassemblyWindow^.LoadFunction('');
  3153. {$ifndef NODEBUG}
  3154. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3155. DisassemblyWindow^.SelectInDebugSession;
  3156. {$endif NODEBUG}
  3157. end;
  3158. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3159. begin
  3160. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3161. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3162. GotoAssembly;
  3163. inherited HandleEvent(Event);
  3164. end;
  3165. destructor TFramesListBox.Done;
  3166. begin
  3167. Inherited Done;
  3168. end;
  3169. Constructor TStackWindow.Init;
  3170. var
  3171. HSB,VSB: PScrollBar;
  3172. R,R2 : trect;
  3173. begin
  3174. Desktop^.GetExtent(R);
  3175. R.A.Y:=R.B.Y-5;
  3176. inherited Init(R, dialog_callstack, wnNoNumber);
  3177. Palette:=wpCyanWindow;
  3178. GetExtent(R);
  3179. HelpCtx:=hcStackWindow;
  3180. R.Grow(-1,-1);
  3181. R2.Copy(R);
  3182. Inc(R2.B.Y);
  3183. R2.A.Y:=R2.B.Y-1;
  3184. New(HSB, Init(R2));
  3185. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3186. Insert(HSB);
  3187. R2.Copy(R);
  3188. Inc(R2.B.X);
  3189. R2.A.X:=R2.B.X-1;
  3190. New(VSB, Init(R2));
  3191. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3192. Insert(VSB);
  3193. New(FLB,Init(R,HSB,VSB));
  3194. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3195. Insert(FLB);
  3196. If assigned(StackWindow) then
  3197. dispose(StackWindow,done);
  3198. StackWindow:=@Self;
  3199. Update;
  3200. end;
  3201. procedure TStackWindow.Update;
  3202. begin
  3203. FLB^.Update;
  3204. DrawView;
  3205. end;
  3206. constructor TStackWindow.Load(var S: TStream);
  3207. begin
  3208. inherited Load(S);
  3209. GetSubViewPtr(S,FLB);
  3210. If assigned(StackWindow) then
  3211. dispose(StackWindow,done);
  3212. StackWindow:=@Self;
  3213. end;
  3214. procedure TStackWindow.Store(var S: TStream);
  3215. begin
  3216. inherited Store(S);
  3217. PutSubViewPtr(S,FLB);
  3218. end;
  3219. Destructor TStackWindow.Done;
  3220. begin
  3221. StackWindow:=nil;
  3222. Dispose(FLB,done);
  3223. inherited done;
  3224. end;
  3225. {****************************************************************************
  3226. Init/Final
  3227. ****************************************************************************}
  3228. function GetGDBTargetShortName : string;
  3229. begin
  3230. {$ifdef SUPPORT_REMOTE}
  3231. {$ifdef PALMOSGDB}
  3232. GetGDBTargetShortName:='palmos';
  3233. {$else}
  3234. GetGDBTargetShortName:='linux';
  3235. {$endif PALMOSGDB}
  3236. {$else not SUPPORT_REMOTE}
  3237. GetGDBTargetShortName:=source_info.shortname
  3238. {$endif not SUPPORT_REMOTE}
  3239. end;
  3240. procedure InitDebugger;
  3241. {$ifdef DEBUG}
  3242. var s : string;
  3243. i,p : longint;
  3244. {$endif DEBUG}
  3245. var
  3246. NeedRecompileExe : boolean;
  3247. cm : longint;
  3248. begin
  3249. {$ifdef DEBUG}
  3250. if not use_gdb_file then
  3251. begin
  3252. Assign(gdb_file,GDBOutFileName);
  3253. {$I-}
  3254. Rewrite(gdb_file);
  3255. if InOutRes<>0 then
  3256. begin
  3257. s:=GDBOutFileName;
  3258. p:=pos('.',s);
  3259. if p>1 then
  3260. for i:=0 to 9 do
  3261. begin
  3262. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3263. InOutRes:=0;
  3264. Assign(gdb_file,s);
  3265. rewrite(gdb_file);
  3266. if InOutRes=0 then
  3267. break;
  3268. end;
  3269. end;
  3270. if IOResult=0 then
  3271. Use_gdb_file:=true;
  3272. end;
  3273. {$I+}
  3274. {$endif}
  3275. NeedRecompileExe:=false;
  3276. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3277. begin
  3278. ClearFormatParams;
  3279. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3280. AddFormatParamStr(GetGDBTargetShortName);
  3281. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3282. if cm=cmCancel then
  3283. Exit;
  3284. if cm=cmYes then
  3285. begin
  3286. { force recompilation }
  3287. PrevMainFile:='';
  3288. NeedRecompileExe:=true;
  3289. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3290. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3291. DebugInfoSwitches^.SetCurrSelParam('l');
  3292. IDEApp.UpdateTarget;
  3293. end;
  3294. end;
  3295. if not NeedRecompileExe then
  3296. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3297. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3298. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3299. begin
  3300. ClearFormatParams;
  3301. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3302. if cm=cmCancel then
  3303. Exit;
  3304. if cm=cmYes then
  3305. begin
  3306. { force recompilation }
  3307. PrevMainFile:='';
  3308. NeedRecompileExe:=true;
  3309. DebugInfoSwitches^.SetCurrSelParam('l');
  3310. end;
  3311. end;
  3312. if NeedRecompileExe then
  3313. DoCompile(cRun);
  3314. if CompilationPhase<>cpDone then
  3315. Exit;
  3316. if (EXEFile='') then
  3317. begin
  3318. ErrorBox(msg_nothingtodebug,nil);
  3319. Exit;
  3320. end;
  3321. { init debugcontroller }
  3322. {$ifndef NODEBUG}
  3323. if not assigned(Debugger) then
  3324. begin
  3325. PushStatus(msg_startingdebugger);
  3326. new(Debugger,Init);
  3327. PopStatus;
  3328. end;
  3329. Debugger^.SetExe(ExeFile);
  3330. {$endif NODEBUG}
  3331. {$ifdef GDBWINDOW}
  3332. InitGDBWindow;
  3333. {$endif def GDBWINDOW}
  3334. end;
  3335. procedure DoneDebugger;
  3336. begin
  3337. {$ifdef DEBUG}
  3338. If IDEApp.IsRunning then
  3339. PushStatus('Closing debugger');
  3340. {$endif}
  3341. {$ifndef NODEBUG}
  3342. if assigned(Debugger) then
  3343. dispose(Debugger,Done);
  3344. Debugger:=nil;
  3345. {$endif NODEBUG}
  3346. {$ifdef DOS}
  3347. If assigned(UserScreen) then
  3348. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3349. {$endif DOS}
  3350. {$ifdef DEBUG}
  3351. If Use_gdb_file then
  3352. begin
  3353. Use_gdb_file:=false;
  3354. Close(GDB_file);
  3355. end;
  3356. If IDEApp.IsRunning then
  3357. PopStatus;
  3358. {$endif DEBUG}
  3359. end;
  3360. procedure InitGDBWindow;
  3361. var
  3362. R : TRect;
  3363. begin
  3364. if GDBWindow=nil then
  3365. begin
  3366. DeskTop^.GetExtent(R);
  3367. new(GDBWindow,init(R));
  3368. DeskTop^.Insert(GDBWindow);
  3369. end;
  3370. end;
  3371. procedure DoneGDBWindow;
  3372. begin
  3373. If IDEApp.IsRunning and
  3374. assigned(GDBWindow) then
  3375. begin
  3376. DeskTop^.Delete(GDBWindow);
  3377. end;
  3378. GDBWindow:=nil;
  3379. end;
  3380. procedure InitDisassemblyWindow;
  3381. var
  3382. R : TRect;
  3383. begin
  3384. if DisassemblyWindow=nil then
  3385. begin
  3386. DeskTop^.GetExtent(R);
  3387. new(DisassemblyWindow,init(R));
  3388. DeskTop^.Insert(DisassemblyWindow);
  3389. end;
  3390. end;
  3391. procedure DoneDisassemblyWindow;
  3392. begin
  3393. if assigned(DisassemblyWindow) then
  3394. begin
  3395. DeskTop^.Delete(DisassemblyWindow);
  3396. Dispose(DisassemblyWindow,Done);
  3397. DisassemblyWindow:=nil;
  3398. end;
  3399. end;
  3400. procedure InitStackWindow;
  3401. begin
  3402. if StackWindow=nil then
  3403. begin
  3404. new(StackWindow,init);
  3405. DeskTop^.Insert(StackWindow);
  3406. end;
  3407. end;
  3408. procedure DoneStackWindow;
  3409. begin
  3410. if assigned(StackWindow) then
  3411. begin
  3412. DeskTop^.Delete(StackWindow);
  3413. StackWindow:=nil;
  3414. end;
  3415. end;
  3416. procedure InitBreakpoints;
  3417. begin
  3418. New(BreakpointsCollection,init(10,10));
  3419. end;
  3420. procedure DoneBreakpoints;
  3421. begin
  3422. Dispose(BreakpointsCollection,Done);
  3423. BreakpointsCollection:=nil;
  3424. end;
  3425. procedure InitWatches;
  3426. begin
  3427. New(WatchesCollection,init);
  3428. end;
  3429. procedure DoneWatches;
  3430. begin
  3431. Dispose(WatchesCollection,Done);
  3432. WatchesCollection:=nil;
  3433. end;
  3434. procedure RegisterFPDebugViews;
  3435. begin
  3436. RegisterType(RWatchesWindow);
  3437. RegisterType(RBreakpointsWindow);
  3438. RegisterType(RWatchesListBox);
  3439. RegisterType(RBreakpointsListBox);
  3440. RegisterType(RStackWindow);
  3441. RegisterType(RFramesListBox);
  3442. RegisterType(RBreakpoint);
  3443. RegisterType(RWatch);
  3444. RegisterType(RBreakpointCollection);
  3445. RegisterType(RWatchesCollection);
  3446. end;
  3447. end.
  3448. {$endif NODEBUG}