fpdebug.pas 105 KB

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