fpdebug.pas 100 KB

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