fpdebug.pas 106 KB

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