fpdebug.pas 106 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029
  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. Backtrace;
  1259. for i:=0 to frame_count-1 do
  1260. begin
  1261. with frames[i]^ do
  1262. begin
  1263. if ExitAddr=address then
  1264. begin
  1265. Command('f '+IntToStr(i));
  1266. if assigned(file_name) then
  1267. begin
  1268. s:=strpas(file_name);
  1269. line:=line_number;
  1270. stop_addr:=address;
  1271. end;
  1272. break;
  1273. end;
  1274. end;
  1275. end;
  1276. end;
  1277. end;
  1278. { Update Disassembly position }
  1279. if Assigned(DisassemblyWindow) then
  1280. DisassemblyWindow^.SetCurAddress(stop_addr);
  1281. if (fn=LastFileName) then
  1282. begin
  1283. W:=PSourceWindow(LastSource);
  1284. if assigned(W) then
  1285. begin
  1286. W^.Editor^.SetCurPtr(0,Line);
  1287. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1288. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1289. UpdateDebugViews;
  1290. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1291. handled by SelectInDebugSession}
  1292. W^.SelectInDebugSession;
  1293. InvalidSourceLine:=false;
  1294. end
  1295. else
  1296. InvalidSourceLine:=true;
  1297. end
  1298. else
  1299. begin
  1300. if s='' then
  1301. W:=nil
  1302. else
  1303. W:=TryToOpenFile(nil,s,0,Line,false);
  1304. if assigned(W) then
  1305. begin
  1306. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1307. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1308. UpdateDebugViews;
  1309. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1310. handled by SelectInDebugSession}
  1311. W^.SelectInDebugSession;
  1312. LastSource:=W;
  1313. InvalidSourceLine:=false;
  1314. end
  1315. { only search a file once }
  1316. else
  1317. begin
  1318. Desktop^.UnLock;
  1319. if s='' then
  1320. Found:=false
  1321. else
  1322. { it is easier to handle with a * at the end }
  1323. Found:=IDEApp.OpenSearch(s+'*');
  1324. Desktop^.Lock;
  1325. if not Found then
  1326. begin
  1327. InvalidSourceLine:=true;
  1328. LastSource:=Nil;
  1329. { Show the stack in that case }
  1330. InitStackWindow;
  1331. UpdateDebugViews;
  1332. StackWindow^.MakeFirst;
  1333. end
  1334. else
  1335. begin
  1336. { should now be open }
  1337. W:=TryToOpenFile(nil,s,0,Line,true);
  1338. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1339. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1340. UpdateDebugViews;
  1341. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1342. handled by SelectInDebugSession}
  1343. W^.SelectInDebugSession;
  1344. LastSource:=W;
  1345. InvalidSourceLine:=false;
  1346. end;
  1347. end;
  1348. end;
  1349. LastFileName:=s;
  1350. Desktop^.UnLock;
  1351. if BreakIndex>0 then
  1352. begin
  1353. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1354. if (BreakIndex=FPCBreakErrorNumber) then
  1355. begin
  1356. if (ExitCode<>0) or (ExitAddr<>0) then
  1357. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1358. #3'Error address $'+HexStr(ExitAddr,8),nil)
  1359. else
  1360. WarningBox(#3'Run Time Error',nil);
  1361. end
  1362. else if not assigned(PB) then
  1363. begin
  1364. if (BreakIndex<>start_break_number) and
  1365. (BreakIndex<>TbreakNumber) then
  1366. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1367. if BreakIndex=start_break_number then
  1368. start_break_number:=0;
  1369. if BreakIndex=TbreakNumber then
  1370. TbreakNumber:=0;
  1371. end
  1372. { For watch we should get old and new value !! }
  1373. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1374. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1375. (PB^.typ<>bt_address) then
  1376. begin
  1377. Command('p '+GetStr(PB^.Name));
  1378. S:=GetPChar(GetOutput);
  1379. got_error:=false;
  1380. If Pos('=',S)>0 then
  1381. S:=Copy(S,Pos('=',S)+1,255);
  1382. If S[Length(S)]=#10 then
  1383. Delete(S,Length(S),1);
  1384. if Assigned(PB^.OldValue) then
  1385. DisposeStr(PB^.OldValue);
  1386. PB^.OldValue:=PB^.CurrentValue;
  1387. PB^.CurrentValue:=NewStr(S);
  1388. If PB^.typ=bt_function then
  1389. WarningBox(#3'GDB stopped due to'#13+
  1390. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1391. else if (GetStr(PB^.OldValue)<>S) then
  1392. WarningBox(#3'GDB stopped due to'#13+
  1393. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1394. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1395. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1396. else
  1397. WarningBox(#3'GDB stopped due to'#13+
  1398. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1399. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1400. end;
  1401. end;
  1402. end;
  1403. procedure TDebugController.DoUserSignal;
  1404. var P :Array[1..2] of pstring;
  1405. S1, S2 : string;
  1406. begin
  1407. S1:=strpas(signal_name);
  1408. S2:=strpas(signal_string);
  1409. P[1]:=@S1;
  1410. P[2]:=@S2;
  1411. WarningBox(msg_programsignal,@P);
  1412. end;
  1413. procedure TDebugController.DoEndSession(code:longint);
  1414. var P :Array[1..2] of longint;
  1415. begin
  1416. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1417. IDEApp.UpdateRunMenu(false);
  1418. ResetDebuggerRows;
  1419. LastExitCode:=Code;
  1420. If HiddenStepsCount=0 then
  1421. InformationBox(msg_programexitedwithexitcode,@code)
  1422. else
  1423. begin
  1424. P[1]:=code;
  1425. P[2]:=HiddenStepsCount;
  1426. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1427. end;
  1428. { In case we have something that the compiler touched }
  1429. AskToReloadAllModifiedFiles;
  1430. {$ifdef Windows}
  1431. main_pid_valid:=false;
  1432. {$endif Windows}
  1433. end;
  1434. procedure TDebugController.DoDebuggerScreen;
  1435. {$ifdef Windows}
  1436. var
  1437. IdeMode : DWord;
  1438. {$endif Windows}
  1439. begin
  1440. if NoSwitch then
  1441. begin
  1442. PopStatus;
  1443. end
  1444. else
  1445. begin
  1446. IDEApp.ShowIDEScreen;
  1447. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1448. PopStatus;
  1449. end;
  1450. {$ifdef Windows}
  1451. if NoSwitch then
  1452. begin
  1453. { Ctrl-C as normal char }
  1454. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1455. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1456. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1457. end;
  1458. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1459. {$endif Windows}
  1460. If assigned(GDBWindow) then
  1461. GDBWindow^.Editor^.UnLock;
  1462. end;
  1463. procedure TDebugController.DoUserScreen;
  1464. {$ifdef Windows}
  1465. var
  1466. IdeMode : DWord;
  1467. {$endif Windows}
  1468. begin
  1469. Inc(RunCount);
  1470. if NoSwitch then
  1471. begin
  1472. {$ifdef SUPPORT_REMOTE}
  1473. if isRemoteDebugging then
  1474. PushStatus(msg_runningremotely+RemoteMachine)
  1475. else
  1476. {$endif SUPPORT_REMOTE}
  1477. {$ifdef Unix}
  1478. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1479. {$else not Unix}
  1480. PushStatus(msg_runninginanotherwindow);
  1481. {$endif Unix}
  1482. end
  1483. else
  1484. begin
  1485. PushStatus(msg_runningprogram);
  1486. IDEApp.ShowUserScreen;
  1487. end;
  1488. {$ifdef Windows}
  1489. if NoSwitch then
  1490. begin
  1491. { Ctrl-C as interrupt }
  1492. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1493. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1494. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1495. end;
  1496. ChangeDebuggeeWindowTitleTo(Running_State);
  1497. {$endif Windows}
  1498. { Don't try to print GDB messages while in User Screen mode }
  1499. If assigned(GDBWindow) then
  1500. GDBWindow^.Editor^.Lock;
  1501. end;
  1502. {$endif NODEBUG}
  1503. {****************************************************************************
  1504. TBreakpoint
  1505. ****************************************************************************}
  1506. function ActiveBreakpoints : boolean;
  1507. var
  1508. IsActive : boolean;
  1509. procedure TestActive(PB : PBreakpoint);
  1510. begin
  1511. If PB^.state=bs_enabled then
  1512. IsActive:=true;
  1513. end;
  1514. begin
  1515. IsActive:=false;
  1516. If assigned(BreakpointsCollection) then
  1517. BreakpointsCollection^.ForEach(@TestActive);
  1518. ActiveBreakpoints:=IsActive;
  1519. end;
  1520. constructor TBreakpoint.Init_function(Const AFunc : String);
  1521. begin
  1522. typ:=bt_function;
  1523. state:=bs_enabled;
  1524. GDBState:=bs_deleted;
  1525. Name:=NewStr(AFunc);
  1526. FileName:=nil;
  1527. Line:=0;
  1528. IgnoreCount:=0;
  1529. Commands:=nil;
  1530. Conditions:=nil;
  1531. OldValue:=nil;
  1532. CurrentValue:=nil;
  1533. end;
  1534. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1535. begin
  1536. typ:=bt_address;
  1537. state:=bs_enabled;
  1538. GDBState:=bs_deleted;
  1539. Name:=NewStr(AAddress);
  1540. FileName:=nil;
  1541. Line:=0;
  1542. IgnoreCount:=0;
  1543. Commands:=nil;
  1544. Conditions:=nil;
  1545. OldValue:=nil;
  1546. CurrentValue:=nil;
  1547. end;
  1548. constructor TBreakpoint.Init_Empty;
  1549. begin
  1550. typ:=bt_function;
  1551. state:=bs_enabled;
  1552. GDBState:=bs_deleted;
  1553. Name:=Nil;
  1554. FileName:=nil;
  1555. Line:=0;
  1556. IgnoreCount:=0;
  1557. Commands:=nil;
  1558. Conditions:=nil;
  1559. OldValue:=nil;
  1560. CurrentValue:=nil;
  1561. end;
  1562. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1563. begin
  1564. typ:=atyp;
  1565. state:=bs_enabled;
  1566. GDBState:=bs_deleted;
  1567. Name:=NewStr(AnExpr);
  1568. IgnoreCount:=0;
  1569. Commands:=nil;
  1570. Conditions:=nil;
  1571. OldValue:=nil;
  1572. CurrentValue:=nil;
  1573. end;
  1574. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1575. var
  1576. CurDir : String;
  1577. begin
  1578. typ:=bt_file_line;
  1579. state:=bs_enabled;
  1580. GDBState:=bs_deleted;
  1581. AFile:=FEXpand(AFile);
  1582. (*
  1583. { d:test.pas:12 does not work !! }
  1584. { I do not know how to solve this if
  1585. if (Length(AFile)>1) and (AFile[2]=':') then
  1586. AFile:=Copy(AFile,3,255); }
  1587. {$ifdef Unix}
  1588. CurDir:=GetCurDir;
  1589. {$else}
  1590. CurDir:=LowerCaseStr(GetCurDir);
  1591. {$endif Unix}
  1592. if Pos(CurDir,OSFileName(AFile))=1 then
  1593. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1594. else
  1595. *)
  1596. FileName:=NewStr(OSFileName(AFile));
  1597. Name:=nil;
  1598. Line:=ALine;
  1599. IgnoreCount:=0;
  1600. Commands:=nil;
  1601. Conditions:=nil;
  1602. OldValue:=nil;
  1603. CurrentValue:=nil;
  1604. end;
  1605. constructor TBreakpoint.Load(var S: TStream);
  1606. var
  1607. FName : PString;
  1608. begin
  1609. S.Read(typ,SizeOf(BreakpointType));
  1610. S.Read(state,SizeOf(BreakpointState));
  1611. GDBState:=bs_deleted;
  1612. case typ of
  1613. bt_file_line :
  1614. begin
  1615. { convert to current target }
  1616. FName:=S.ReadStr;
  1617. FileName:=NewStr(OSFileName(GetStr(FName)));
  1618. If Assigned(FName) then
  1619. DisposeStr(FName);
  1620. S.Read(Line,SizeOf(Line));
  1621. Name:=nil;
  1622. end;
  1623. else
  1624. begin
  1625. Name:=S.ReadStr;
  1626. Line:=0;
  1627. FileName:=nil;
  1628. end;
  1629. end;
  1630. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1631. Commands:=S.StrRead;
  1632. Conditions:=S.ReadStr;
  1633. OldValue:=nil;
  1634. CurrentValue:=nil;
  1635. end;
  1636. procedure TBreakpoint.Store(var S: TStream);
  1637. var
  1638. St : String;
  1639. begin
  1640. S.Write(typ,SizeOf(BreakpointType));
  1641. S.Write(state,SizeOf(BreakpointState));
  1642. case typ of
  1643. bt_file_line :
  1644. begin
  1645. st:=OSFileName(GetStr(FileName));
  1646. S.WriteStr(@St);
  1647. S.Write(Line,SizeOf(Line));
  1648. end;
  1649. else
  1650. begin
  1651. S.WriteStr(Name);
  1652. end;
  1653. end;
  1654. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1655. S.StrWrite(Commands);
  1656. S.WriteStr(Conditions);
  1657. end;
  1658. procedure TBreakpoint.Insert;
  1659. var
  1660. p,p2 : pchar;
  1661. st : string;
  1662. bkpt_no: LongInt = 0;
  1663. begin
  1664. {$ifndef NODEBUG}
  1665. If not assigned(Debugger) then Exit;
  1666. Remove;
  1667. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1668. begin
  1669. if (typ=bt_file_line) and assigned(FileName) then
  1670. bkpt_no := Debugger^.BreakpointInsert(GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line), [])
  1671. else if (typ=bt_function) and assigned(name) then
  1672. bkpt_no := Debugger^.BreakpointInsert(name^, [])
  1673. else if (typ=bt_address) and assigned(name) then
  1674. bkpt_no := Debugger^.BreakpointInsert('*0x'+name^, [])
  1675. else if (typ=bt_watch) and assigned(name) then
  1676. bkpt_no := Debugger^.WatchpointInsert(name^, wtWrite)
  1677. else if (typ=bt_awatch) and assigned(name) then
  1678. bkpt_no := Debugger^.WatchpointInsert(name^, wtReadWrite)
  1679. else if (typ=bt_rwatch) and assigned(name) then
  1680. bkpt_no := Debugger^.WatchpointInsert(name^, wtRead);
  1681. if bkpt_no<>0 then
  1682. begin
  1683. GDBIndex:=bkpt_no;
  1684. GDBState:=bs_enabled;
  1685. Debugger^.BreakpointCondition(GDBIndex, GetStr(Conditions));
  1686. If IgnoreCount>0 then
  1687. Debugger^.BreakpointSetIgnoreCount(GDBIndex, IgnoreCount);
  1688. If Assigned(Commands) then
  1689. begin
  1690. {Commands are not handled yet }
  1691. Debugger^.Command('command '+IntToStr(GDBIndex));
  1692. p:=commands;
  1693. while assigned(p) do
  1694. begin
  1695. p2:=strscan(p,#10);
  1696. if assigned(p2) then
  1697. p2^:=#0;
  1698. st:=strpas(p);
  1699. Debugger^.command(st);
  1700. if assigned(p2) then
  1701. p2^:=#10;
  1702. p:=p2;
  1703. if assigned(p) then
  1704. inc(p);
  1705. end;
  1706. Debugger^.Command('end');
  1707. end;
  1708. end
  1709. else
  1710. { Here there was a problem !! }
  1711. begin
  1712. GDBIndex:=0;
  1713. if not Debugger^.Disableallinvalidbreakpoints then
  1714. begin
  1715. if (typ=bt_file_line) and assigned(FileName) then
  1716. begin
  1717. ClearFormatParams;
  1718. AddFormatParamStr(NameAndExtOf(FileName^));
  1719. AddFormatParamInt(Line);
  1720. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1721. Debugger^.Disableallinvalidbreakpoints:=true;
  1722. end
  1723. else
  1724. begin
  1725. ClearFormatParams;
  1726. AddFormatParamStr(BreakpointTypeStr[typ]);
  1727. AddFormatParamStr(GetStr(Name));
  1728. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1729. Debugger^.Disableallinvalidbreakpoints:=true;
  1730. end;
  1731. end;
  1732. state:=bs_disabled;
  1733. UpdateSource;
  1734. end;
  1735. end
  1736. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1737. Enable
  1738. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1739. Disable;
  1740. {$endif NODEBUG}
  1741. end;
  1742. procedure TBreakpoint.Remove;
  1743. begin
  1744. {$ifndef NODEBUG}
  1745. If not assigned(Debugger) then Exit;
  1746. if GDBIndex>0 then
  1747. Debugger^.BreakpointDelete(GDBIndex);
  1748. GDBIndex:=0;
  1749. GDBState:=bs_deleted;
  1750. {$endif NODEBUG}
  1751. end;
  1752. procedure TBreakpoint.Enable;
  1753. begin
  1754. {$ifndef NODEBUG}
  1755. If not assigned(Debugger) then Exit;
  1756. if GDBIndex>0 then
  1757. Debugger^.BreakpointEnable(GDBIndex)
  1758. else
  1759. Insert;
  1760. GDBState:=bs_disabled;
  1761. {$endif NODEBUG}
  1762. end;
  1763. procedure TBreakpoint.Disable;
  1764. begin
  1765. {$ifndef NODEBUG}
  1766. If not assigned(Debugger) then Exit;
  1767. if GDBIndex>0 then
  1768. Debugger^.BreakpointDisable(GDBIndex);
  1769. GDBState:=bs_disabled;
  1770. {$endif NODEBUG}
  1771. end;
  1772. procedure TBreakpoint.ResetValues;
  1773. begin
  1774. if assigned(OldValue) then
  1775. DisposeStr(OldValue);
  1776. OldValue:=nil;
  1777. if assigned(CurrentValue) then
  1778. DisposeStr(CurrentValue);
  1779. CurrentValue:=nil;
  1780. end;
  1781. procedure TBreakpoint.UpdateSource;
  1782. var W: PSourceWindow;
  1783. b : boolean;
  1784. begin
  1785. if typ=bt_file_line then
  1786. begin
  1787. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1788. If assigned(W) then
  1789. begin
  1790. if state=bs_enabled then
  1791. b:=true
  1792. else
  1793. b:=false;
  1794. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1795. end;
  1796. end;
  1797. end;
  1798. destructor TBreakpoint.Done;
  1799. begin
  1800. Remove;
  1801. ResetValues;
  1802. if assigned(Name) then
  1803. DisposeStr(Name);
  1804. if assigned(FileName) then
  1805. DisposeStr(FileName);
  1806. if assigned(Conditions) then
  1807. DisposeStr(Conditions);
  1808. if assigned(Commands) then
  1809. StrDispose(Commands);
  1810. inherited Done;
  1811. end;
  1812. {****************************************************************************
  1813. TBreakpointCollection
  1814. ****************************************************************************}
  1815. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1816. begin
  1817. At:=inherited At(Index);
  1818. end;
  1819. procedure TBreakpointCollection.Update;
  1820. begin
  1821. {$ifndef NODEBUG}
  1822. if assigned(Debugger) then
  1823. begin
  1824. Debugger^.RemoveBreakpoints;
  1825. Debugger^.InsertBreakpoints;
  1826. end;
  1827. {$endif NODEBUG}
  1828. if assigned(BreakpointsWindow) then
  1829. BreakpointsWindow^.Update;
  1830. end;
  1831. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1832. function IsNum(P : PBreakpoint) : boolean;
  1833. begin
  1834. IsNum:=P^.GDBIndex=index;
  1835. end;
  1836. begin
  1837. if index=0 then
  1838. GetGDB:=nil
  1839. else
  1840. GetGDB:=FirstThat(@IsNum);
  1841. end;
  1842. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1843. procedure SetInSource(P : PBreakpoint);
  1844. begin
  1845. If assigned(P^.FileName) and
  1846. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1847. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1848. end;
  1849. procedure SetInDisassembly(P : PBreakpoint);
  1850. var
  1851. PDL : PDisasLine;
  1852. S : string;
  1853. ps,qs,i : longint;
  1854. HAddr : PtrInt;
  1855. code : integer;
  1856. begin
  1857. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1858. begin
  1859. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1860. if PDL^.Address=0 then
  1861. begin
  1862. if (P^.typ=bt_file_line) then
  1863. begin
  1864. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1865. ps:=pos(':',S);
  1866. qs:=pos(' ',copy(S,ps+1,High(S)));
  1867. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1868. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1869. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1870. end;
  1871. end
  1872. else
  1873. begin
  1874. if assigned(P^.Name) then
  1875. begin
  1876. Val('$'+P^.Name^,HAddr,code);
  1877. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1878. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1879. end;
  1880. end;
  1881. end;
  1882. end;
  1883. begin
  1884. if W=PFPWindow(DisassemblyWindow) then
  1885. ForEach(@SetInDisassembly)
  1886. else
  1887. ForEach(@SetInSource);
  1888. end;
  1889. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1890. procedure AdaptInSource(P : PBreakpoint);
  1891. begin
  1892. If assigned(P^.FileName) and
  1893. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1894. begin
  1895. if P^.state=bs_enabled then
  1896. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1897. if P^.Line-1>=Pos then
  1898. begin
  1899. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1900. P^.line:=P^.Line+Change
  1901. else
  1902. begin
  1903. { removing inside a ForEach call leads to problems }
  1904. { so we do that after PM }
  1905. P^.state:=bs_delete_after;
  1906. end;
  1907. end;
  1908. if P^.state=bs_enabled then
  1909. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1910. end;
  1911. end;
  1912. var
  1913. I : longint;
  1914. begin
  1915. ForEach(@AdaptInSource);
  1916. I:=Count-1;
  1917. While (I>=0) do
  1918. begin
  1919. if At(I)^.state=bs_delete_after then
  1920. AtFree(I);
  1921. Dec(I);
  1922. end;
  1923. end;
  1924. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1925. function IsAtLine(P : PBreakpoint) : boolean;
  1926. begin
  1927. If assigned(P^.FileName) and
  1928. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1929. (Line=P^.Line) then
  1930. IsAtLine:=true
  1931. else
  1932. IsAtLine:=false;
  1933. end;
  1934. begin
  1935. FindBreakpointAt:=FirstThat(@IsAtLine);
  1936. end;
  1937. procedure TBreakpointCollection.ShowAllBreakpoints;
  1938. procedure SetInSource(P : PBreakpoint);
  1939. var
  1940. W : PSourceWindow;
  1941. begin
  1942. If assigned(P^.FileName) then
  1943. begin
  1944. W:=SearchOnDesktop(P^.FileName^,false);
  1945. if assigned(W) then
  1946. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1947. end;
  1948. end;
  1949. begin
  1950. ForEach(@SetInSource);
  1951. end;
  1952. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1953. function IsThis(P : PBreakpoint) : boolean;
  1954. begin
  1955. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1956. end;
  1957. begin
  1958. GetType:=FirstThat(@IsThis);
  1959. end;
  1960. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1961. function IsThere(P : PBreakpoint) : boolean;
  1962. begin
  1963. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1964. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1965. end;
  1966. var
  1967. PB : PBreakpoint;
  1968. begin
  1969. ToggleFileLine:=false;
  1970. FileName:=OSFileName(FExpand(FileName));
  1971. PB:=FirstThat(@IsThere);
  1972. If Assigned(PB) then
  1973. begin
  1974. { delete it form source window }
  1975. PB^.state:=bs_disabled;
  1976. PB^.UpdateSource;
  1977. { remove from collection }
  1978. BreakpointsCollection^.free(PB);
  1979. end
  1980. else
  1981. begin
  1982. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1983. if assigned(PB) then
  1984. Begin
  1985. Insert(PB);
  1986. PB^.UpdateSource;
  1987. ToggleFileLine:=true;
  1988. End;
  1989. end;
  1990. Update;
  1991. end;
  1992. {****************************************************************************
  1993. TBreakpointItem
  1994. ****************************************************************************}
  1995. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1996. begin
  1997. inherited Init;
  1998. Breakpoint:=ABreakpoint;
  1999. end;
  2000. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  2001. var S: string;
  2002. begin
  2003. with Breakpoint^ do
  2004. begin
  2005. S:=BreakpointTypeStr[typ];
  2006. While Length(S)<10 do
  2007. S:=S+' ';
  2008. S:=S+'|';
  2009. S:=S+BreakpointStateStr[state]+' ';
  2010. While Length(S)<20 do
  2011. S:=S+' ';
  2012. S:=S+'|';
  2013. if (typ=bt_file_line) then
  2014. begin
  2015. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
  2016. While Length(S)<40 do
  2017. S:=S+' ';
  2018. S:=S+'|';
  2019. S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
  2020. end
  2021. else
  2022. S:=S+GetStr(name);
  2023. While Length(S)<70 do
  2024. S:=S+' ';
  2025. S:=S+'|';
  2026. if IgnoreCount>0 then
  2027. S:=S+IntToStr(IgnoreCount);
  2028. While Length(S)<79 do
  2029. S:=S+' ';
  2030. S:=S+'|';
  2031. if assigned(Conditions) then
  2032. S:=S+' '+GetStr(Conditions);
  2033. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  2034. GetText:=S;
  2035. end;
  2036. end;
  2037. procedure TBreakpointItem.Selected;
  2038. begin
  2039. end;
  2040. function TBreakpointItem.GetModuleName: string;
  2041. begin
  2042. if breakpoint^.typ=bt_file_line then
  2043. GetModuleName:=GetStr(breakpoint^.FileName)
  2044. else
  2045. GetModuleName:='';
  2046. end;
  2047. {****************************************************************************
  2048. TBreakpointsListBox
  2049. ****************************************************************************}
  2050. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2051. begin
  2052. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  2053. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2054. NoSelection:=true;
  2055. end;
  2056. function TBreakpointsListBox.GetLocalMenu: PMenu;
  2057. var M: PMenu;
  2058. begin
  2059. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2060. M:=NewMenu(
  2061. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  2062. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  2063. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  2064. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  2065. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  2066. nil))))));
  2067. GetLocalMenu:=M;
  2068. end;
  2069. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  2070. var DontClear: boolean;
  2071. begin
  2072. case Event.What of
  2073. evKeyDown :
  2074. begin
  2075. DontClear:=false;
  2076. case Event.KeyCode of
  2077. kbEnd :
  2078. FocusItem(List^.Count-1);
  2079. kbHome :
  2080. FocusItem(0);
  2081. kbEnter :
  2082. Message(@Self,evCommand,cmMsgGotoSource,nil);
  2083. kbIns :
  2084. Message(@Self,evCommand,cmNewBreakpoint,nil);
  2085. kbDel :
  2086. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  2087. else
  2088. DontClear:=true;
  2089. end;
  2090. if not DontClear then
  2091. ClearEvent(Event);
  2092. end;
  2093. evBroadcast :
  2094. case Event.Command of
  2095. cmListItemSelected :
  2096. if Event.InfoPtr=@Self then
  2097. Message(@Self,evCommand,cmEditBreakpoint,nil);
  2098. end;
  2099. evCommand :
  2100. begin
  2101. DontClear:=false;
  2102. case Event.Command of
  2103. cmMsgTrackSource :
  2104. if Range>0 then
  2105. TrackSource;
  2106. cmEditBreakpoint :
  2107. EditCurrent;
  2108. cmToggleBreakpoint :
  2109. ToggleCurrent;
  2110. cmDeleteBreakpoint :
  2111. DeleteCurrent;
  2112. cmNewBreakpoint :
  2113. EditNew;
  2114. cmMsgClear :
  2115. Clear;
  2116. else
  2117. DontClear:=true;
  2118. end;
  2119. if not DontClear then
  2120. ClearEvent(Event);
  2121. end;
  2122. end;
  2123. inherited HandleEvent(Event);
  2124. end;
  2125. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  2126. var W : integer;
  2127. begin
  2128. if List=nil then New(List, Init(20,20));
  2129. W:=length(P^.GetText(255));
  2130. if W>MaxWidth then
  2131. begin
  2132. MaxWidth:=W;
  2133. if HScrollBar<>nil then
  2134. HScrollBar^.SetRange(0,MaxWidth);
  2135. end;
  2136. List^.Insert(P);
  2137. SetRange(List^.Count);
  2138. if Focused=List^.Count-1-1 then
  2139. FocusItem(List^.Count-1);
  2140. P^.Breakpoint^.UpdateSource;
  2141. DrawView;
  2142. end;
  2143. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  2144. var P: PBreakpointItem;
  2145. S: string;
  2146. begin
  2147. P:=List^.At(Item);
  2148. S:=P^.GetText(MaxLen);
  2149. GetText:=copy(S,1,MaxLen);
  2150. end;
  2151. procedure TBreakpointsListBox.Clear;
  2152. begin
  2153. if assigned(List) then
  2154. Dispose(List, Done);
  2155. List:=nil;
  2156. MaxWidth:=0;
  2157. SetRange(0); DrawView;
  2158. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2159. end;
  2160. procedure TBreakpointsListBox.TrackSource;
  2161. var W: PSourceWindow;
  2162. P: PBreakpointItem;
  2163. R: TRect;
  2164. begin
  2165. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2166. if Range=0 then Exit;*)
  2167. P:=List^.At(Focused);
  2168. if P^.GetModuleName='' then Exit;
  2169. Desktop^.Lock;
  2170. GetNextEditorBounds(R);
  2171. R.B.Y:=Owner^.Origin.Y;
  2172. W:=EditorWindowFile(P^.GetModuleName);
  2173. if assigned(W) then
  2174. begin
  2175. W^.GetExtent(R);
  2176. R.B.Y:=Owner^.Origin.Y;
  2177. W^.ChangeBounds(R);
  2178. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  2179. end
  2180. else
  2181. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  2182. if W<>nil then
  2183. begin
  2184. W^.Select;
  2185. W^.Editor^.TrackCursor(do_centre);
  2186. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  2187. end;
  2188. if Assigned(Owner) then
  2189. Owner^.Select;
  2190. Desktop^.UnLock;
  2191. end;
  2192. procedure TBreakpointsListBox.ToggleCurrent;
  2193. var
  2194. P: PBreakpointItem;
  2195. begin
  2196. if Range=0 then Exit;
  2197. P:=List^.At(Focused);
  2198. if P=nil then Exit;
  2199. if P^.Breakpoint^.state=bs_enabled then
  2200. P^.Breakpoint^.state:=bs_disabled
  2201. else if P^.Breakpoint^.state=bs_disabled then
  2202. P^.Breakpoint^.state:=bs_enabled;
  2203. P^.Breakpoint^.UpdateSource;
  2204. BreakpointsCollection^.Update;
  2205. end;
  2206. procedure TBreakpointsListBox.EditCurrent;
  2207. var
  2208. P: PBreakpointItem;
  2209. begin
  2210. if Range=0 then Exit;
  2211. P:=List^.At(Focused);
  2212. if P=nil then Exit;
  2213. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  2214. P^.Breakpoint^.UpdateSource;
  2215. BreakpointsCollection^.Update;
  2216. end;
  2217. procedure TBreakpointsListBox.DeleteCurrent;
  2218. var
  2219. P: PBreakpointItem;
  2220. begin
  2221. if Range=0 then Exit;
  2222. P:=List^.At(Focused);
  2223. if P=nil then Exit;
  2224. { delete it form source window }
  2225. P^.Breakpoint^.state:=bs_disabled;
  2226. P^.Breakpoint^.UpdateSource;
  2227. BreakpointsCollection^.free(P^.Breakpoint);
  2228. List^.free(P);
  2229. BreakpointsCollection^.Update;
  2230. end;
  2231. procedure TBreakpointsListBox.EditNew;
  2232. var
  2233. P: PBreakpoint;
  2234. begin
  2235. P:=New(PBreakpoint,Init_Empty);
  2236. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  2237. begin
  2238. P^.UpdateSource;
  2239. BreakpointsCollection^.Insert(P);
  2240. BreakpointsCollection^.Update;
  2241. end
  2242. else
  2243. dispose(P,Done);
  2244. end;
  2245. procedure TBreakpointsListBox.Draw;
  2246. var
  2247. I, J, Item: Sw_Integer;
  2248. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2249. ColWidth, CurCol, Indent: Integer;
  2250. B: TDrawBuffer;
  2251. Text: String;
  2252. SCOff: Byte;
  2253. TC: byte;
  2254. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2255. begin
  2256. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2257. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2258. begin
  2259. NormalColor := GetColor(1);
  2260. FocusedColor := GetColor(3);
  2261. SelectedColor := GetColor(4);
  2262. end else
  2263. begin
  2264. NormalColor := GetColor(2);
  2265. SelectedColor := GetColor(4);
  2266. end;
  2267. if Transparent then
  2268. begin MT(NormalColor); MT(SelectedColor); end;
  2269. if NoSelection then
  2270. SelectedColor:=NormalColor;
  2271. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2272. else Indent := 0;
  2273. ColWidth := Size.X div NumCols + 1;
  2274. for I := 0 to Size.Y - 1 do
  2275. begin
  2276. for J := 0 to NumCols-1 do
  2277. begin
  2278. Item := J*Size.Y + I + TopItem;
  2279. CurCol := J*ColWidth;
  2280. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2281. (Focused = Item) and (Range > 0) then
  2282. begin
  2283. Color := FocusedColor;
  2284. SetCursor(CurCol+1,I);
  2285. SCOff := 0;
  2286. end
  2287. else if (Item < Range) and IsSelected(Item) then
  2288. begin
  2289. Color := SelectedColor;
  2290. SCOff := 2;
  2291. end
  2292. else
  2293. begin
  2294. Color := NormalColor;
  2295. SCOff := 4;
  2296. end;
  2297. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2298. if Item < Range then
  2299. begin
  2300. Text := GetText(Item, ColWidth + Indent);
  2301. Text := Copy(Text,Indent,ColWidth);
  2302. MoveStr(B[CurCol+1], Text, Color);
  2303. if ShowMarkers then
  2304. begin
  2305. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2306. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2307. end;
  2308. end;
  2309. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2310. end;
  2311. WriteLine(0, I, Size.X, 1, B);
  2312. end;
  2313. end;
  2314. constructor TBreakpointsListBox.Load(var S: TStream);
  2315. begin
  2316. inherited Load(S);
  2317. end;
  2318. procedure TBreakpointsListBox.Store(var S: TStream);
  2319. var OL: PCollection;
  2320. OldR : integer;
  2321. begin
  2322. OL:=List;
  2323. OldR:=Range;
  2324. Range:=0;
  2325. New(List, Init(1,1));
  2326. inherited Store(S);
  2327. Dispose(List, Done);
  2328. Range:=OldR;
  2329. List:=OL;
  2330. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2331. collection? Pasting here a modified version of TListBox.Store+
  2332. TAdvancedListBox.Store isn't a better solution, since by eventually
  2333. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2334. end;
  2335. destructor TBreakpointsListBox.Done;
  2336. begin
  2337. inherited Done;
  2338. if List<>nil then Dispose(List, Done);
  2339. end;
  2340. {****************************************************************************
  2341. TBreakpointsWindow
  2342. ****************************************************************************}
  2343. constructor TBreakpointsWindow.Init;
  2344. var R,R2: TRect;
  2345. HSB,VSB: PScrollBar;
  2346. ST: PStaticText;
  2347. S: String;
  2348. X,X1 : Sw_integer;
  2349. Btn: PButton;
  2350. const
  2351. NumButtons = 5;
  2352. begin
  2353. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2354. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2355. HelpCtx:=hcBreakpointListWindow;
  2356. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2357. S:=label_breakpointpropheader;
  2358. New(ST, Init(R,S));
  2359. ST^.GrowMode:=gfGrowHiX;
  2360. Insert(ST);
  2361. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2362. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2363. ST^.GrowMode:=gfGrowHiX;
  2364. Insert(ST);
  2365. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2366. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2367. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2368. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2369. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2370. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2371. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2372. New(BreakLB, Init(R,HSB,VSB));
  2373. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2374. BreakLB^.Transparent:=true;
  2375. Insert(BreakLB);
  2376. GetExtent(R);R.Grow(-1,-1);
  2377. Dec(R.B.Y);
  2378. R.A.Y:=R.B.Y-2;
  2379. X:=(R.B.X-R.A.X) div NumButtons;
  2380. X1:=R.A.X+(X div 2);
  2381. R.A.X:=X1-3;R.B.X:=X1+7;
  2382. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2383. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2384. Insert(Btn);
  2385. X1:=X1+X;
  2386. R.A.X:=X1-3;R.B.X:=X1+7;
  2387. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2388. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2389. Insert(Btn);
  2390. X1:=X1+X;
  2391. R.A.X:=X1-3;R.B.X:=X1+7;
  2392. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2393. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2394. Insert(Btn);
  2395. X1:=X1+X;
  2396. R.A.X:=X1-3;R.B.X:=X1+7;
  2397. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2398. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2399. Insert(Btn);
  2400. X1:=X1+X;
  2401. R.A.X:=X1-3;R.B.X:=X1+7;
  2402. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2403. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2404. Insert(Btn);
  2405. BreakLB^.Select;
  2406. Update;
  2407. BreakpointsWindow:=@self;
  2408. end;
  2409. constructor TBreakpointsWindow.Load(var S: TStream);
  2410. begin
  2411. inherited Load(S);
  2412. GetSubViewPtr(S,BreakLB);
  2413. end;
  2414. procedure TBreakpointsWindow.Store(var S: TStream);
  2415. begin
  2416. inherited Store(S);
  2417. PutSubViewPtr(S,BreakLB);
  2418. end;
  2419. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2420. begin
  2421. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2422. end;
  2423. procedure TBreakpointsWindow.ClearBreakpoints;
  2424. begin
  2425. BreakLB^.Clear;
  2426. ReDraw;
  2427. end;
  2428. procedure TBreakpointsWindow.ReloadBreakpoints;
  2429. procedure InsertInBreakLB(P : PBreakpoint);
  2430. begin
  2431. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2432. end;
  2433. begin
  2434. If not assigned(BreakpointsCollection) then
  2435. exit;
  2436. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2437. ReDraw;
  2438. end;
  2439. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2440. begin
  2441. inherited SizeLimits(Min,Max);
  2442. Min.X:=40; Min.Y:=18;
  2443. end;
  2444. procedure TBreakpointsWindow.Close;
  2445. begin
  2446. Hide;
  2447. end;
  2448. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2449. var DontClear : boolean;
  2450. begin
  2451. case Event.What of
  2452. evKeyDown :
  2453. begin
  2454. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2455. begin
  2456. ClearEvent(Event);
  2457. Hide;
  2458. end;
  2459. end;
  2460. evCommand :
  2461. begin
  2462. DontClear:=False;
  2463. case Event.Command of
  2464. cmNewBreakpoint :
  2465. BreakLB^.EditNew;
  2466. cmEditBreakpoint :
  2467. BreakLB^.EditCurrent;
  2468. cmDeleteBreakpoint :
  2469. BreakLB^.DeleteCurrent;
  2470. cmToggleBreakInList :
  2471. BreakLB^.ToggleCurrent;
  2472. cmClose :
  2473. Hide;
  2474. else
  2475. DontClear:=true;
  2476. end;
  2477. if not DontClear then
  2478. ClearEvent(Event);
  2479. end;
  2480. evBroadcast :
  2481. case Event.Command of
  2482. cmUpdate :
  2483. Update;
  2484. end;
  2485. end;
  2486. inherited HandleEvent(Event);
  2487. end;
  2488. procedure TBreakpointsWindow.Update;
  2489. var
  2490. StoreFocus : longint;
  2491. begin
  2492. StoreFocus:=BreakLB^.Focused;
  2493. ClearBreakpoints;
  2494. ReloadBreakpoints;
  2495. If StoreFocus<BreakLB^.Range then
  2496. BreakLB^.FocusItem(StoreFocus);
  2497. end;
  2498. destructor TBreakpointsWindow.Done;
  2499. begin
  2500. inherited Done;
  2501. BreakpointsWindow:=nil;
  2502. end;
  2503. {****************************************************************************
  2504. TBreakpointItemDialog
  2505. ****************************************************************************}
  2506. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2507. var R,R2,R3: TRect;
  2508. Items: PSItem;
  2509. I : BreakpointType;
  2510. KeyCount: sw_integer;
  2511. begin
  2512. KeyCount:=longint(high(BreakpointType));
  2513. R.Assign(0,0,60,Max(9+KeyCount,18));
  2514. inherited Init(R,dialog_modifynewbreakpoint);
  2515. Breakpoint:=ABreakpoint;
  2516. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2517. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2518. New(NameIL, Init(R, 255)); Insert(NameIL);
  2519. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2520. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2521. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2522. R2.Copy(R); R2.Move(-1,-1);
  2523. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2524. R.Move(0,3);
  2525. R.B.X:=R.B.X-3;
  2526. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2527. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2528. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2529. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2530. R.Move(0,3); R.B.X:=R.A.X+36;
  2531. New(LineIL, Init(R, 128)); Insert(LineIL);
  2532. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2533. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2534. R.Move(0,3);
  2535. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2536. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2537. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2538. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2539. Items:=nil;
  2540. { don't use invalid type }
  2541. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2542. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2543. New(TypeRB, Init(R, Items));
  2544. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2545. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2546. Insert(TypeRB);
  2547. InsertButtons(@Self);
  2548. NameIL^.Select;
  2549. end;
  2550. function TBreakpointItemDialog.Execute: Word;
  2551. var R: sw_word;
  2552. S1: string;
  2553. err: word;
  2554. L: longint;
  2555. begin
  2556. R:=sw_word(Breakpoint^.typ);
  2557. TypeRB^.SetData(R);
  2558. If Breakpoint^.typ=bt_file_line then
  2559. S1:=GetStr(Breakpoint^.FileName)
  2560. else
  2561. S1:=GetStr(Breakpoint^.name);
  2562. NameIL^.SetData(S1);
  2563. If Breakpoint^.typ=bt_file_line then
  2564. S1:=IntToStr(Breakpoint^.Line)
  2565. else
  2566. S1:='0';
  2567. LineIL^.SetData(S1);
  2568. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2569. IgnoreIL^.SetData(S1);
  2570. S1:=GetStr(Breakpoint^.Conditions);
  2571. ConditionsIL^.SetData(S1);
  2572. if assigned(FirstEditorWindow) then
  2573. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2574. R:=inherited Execute;
  2575. FindReplaceEditor:=nil;
  2576. if R=cmOK then
  2577. begin
  2578. TypeRB^.GetData(R);
  2579. L:=R;
  2580. Breakpoint^.typ:=BreakpointType(L);
  2581. NameIL^.GetData(S1);
  2582. If Breakpoint^.typ=bt_file_line then
  2583. begin
  2584. If assigned(Breakpoint^.FileName) then
  2585. DisposeStr(Breakpoint^.FileName);
  2586. Breakpoint^.FileName:=NewStr(S1);
  2587. end
  2588. else
  2589. begin
  2590. If assigned(Breakpoint^.Name) then
  2591. DisposeStr(Breakpoint^.Name);
  2592. Breakpoint^.name:=NewStr(S1);
  2593. end;
  2594. If Breakpoint^.typ=bt_file_line then
  2595. begin
  2596. LineIL^.GetData(S1);
  2597. Val(S1,L,err);
  2598. Breakpoint^.Line:=L;
  2599. end;
  2600. IgnoreIL^.GetData(S1);
  2601. Val(S1,L,err);
  2602. Breakpoint^.IgnoreCount:=L;
  2603. ConditionsIL^.GetData(S1);
  2604. If assigned(Breakpoint^.Conditions) then
  2605. DisposeStr(Breakpoint^.Conditions);
  2606. Breakpoint^.Conditions:=NewStr(S1);
  2607. end;
  2608. Execute:=R;
  2609. end;
  2610. {****************************************************************************
  2611. TWatch
  2612. ****************************************************************************}
  2613. constructor TWatch.Init(s : string);
  2614. begin
  2615. expr:=NewStr(s);
  2616. last_value:=nil;
  2617. current_value:=nil;
  2618. Get_new_value;
  2619. GDBRunCount:=-1;
  2620. end;
  2621. constructor TWatch.Load(var S: TStream);
  2622. begin
  2623. expr:=S.ReadStr;
  2624. last_value:=nil;
  2625. current_value:=nil;
  2626. Get_new_value;
  2627. GDBRunCount:=-1;
  2628. end;
  2629. procedure TWatch.Store(var S: TStream);
  2630. begin
  2631. S.WriteStr(expr);
  2632. end;
  2633. procedure TWatch.rename(s : string);
  2634. begin
  2635. if assigned(expr) then
  2636. begin
  2637. if GetStr(expr)=S then
  2638. exit;
  2639. DisposeStr(expr);
  2640. end;
  2641. expr:=NewStr(s);
  2642. if assigned(last_value) then
  2643. StrDispose(last_value);
  2644. last_value:=nil;
  2645. if assigned(current_value) then
  2646. StrDispose(current_value);
  2647. current_value:=nil;
  2648. GDBRunCount:=-1;
  2649. Get_new_value;
  2650. end;
  2651. procedure TWatch.Get_new_value;
  2652. {$ifndef NODEBUG}
  2653. var p, q : pchar;
  2654. i, j, curframe, startframe : longint;
  2655. s,s2 : string;
  2656. loop_higher, found : boolean;
  2657. last_removed : char;
  2658. function GetValue(var s : string) : boolean;
  2659. begin
  2660. Debugger^.command('p '+s);
  2661. if not Debugger^.Error then
  2662. begin
  2663. s:=StrPas(Debugger^.GetOutput);
  2664. GetValue:=true;
  2665. end
  2666. else
  2667. begin
  2668. s:=StrPas(Debugger^.GetError);
  2669. GetValue:=false;
  2670. { do not open a messagebox for such errors }
  2671. Debugger^.got_error:=false;
  2672. end;
  2673. end;
  2674. begin
  2675. If not assigned(Debugger) or Not Debugger^.HasExe or
  2676. (GDBRunCount=Debugger^.RunCount) then
  2677. exit;
  2678. GDBRunCount:=Debugger^.RunCount;
  2679. if assigned(last_value) then
  2680. strdispose(last_value);
  2681. last_value:=current_value;
  2682. s:=GetStr(expr);
  2683. { Fix 2d array indexing, change [x,x] to [x][x] }
  2684. i:=pos('[',s);
  2685. if i>0 then
  2686. begin
  2687. while i<length(s) do
  2688. begin
  2689. if s[i]=',' then
  2690. begin
  2691. s[i]:='[';
  2692. insert(']',s,i);
  2693. inc(i);
  2694. end;
  2695. inc(i);
  2696. end;
  2697. end;
  2698. found:=GetValue(s);
  2699. Debugger^.got_error:=false;
  2700. loop_higher:=not found;
  2701. if not found then
  2702. begin
  2703. curframe:=Debugger^.get_current_frame;
  2704. startframe:=curframe;
  2705. end
  2706. else
  2707. begin
  2708. curframe:=0;
  2709. startframe:=0;
  2710. end;
  2711. while loop_higher do
  2712. begin
  2713. s:='parentfp';
  2714. if GetValue(s) then
  2715. begin
  2716. repeat
  2717. inc(curframe);
  2718. if not Debugger^.set_current_frame(curframe) then
  2719. loop_higher:=false;
  2720. {$ifdef FrameNameKnown}
  2721. s2:='/x '+FrameName;
  2722. {$else not FrameNameKnown}
  2723. s2:='/x $ebp';
  2724. {$endif FrameNameKnown}
  2725. getValue(s2);
  2726. j:=pos('=',s2);
  2727. if j>0 then
  2728. s2:=copy(s2,j+1,length(s2));
  2729. while s2[1] in [' ',TAB] do
  2730. delete(s2,1,1);
  2731. if pos(s2,s)>0 then
  2732. loop_higher :=false;
  2733. until not loop_higher;
  2734. { try again at that level }
  2735. s:=GetStr(expr);
  2736. found:=GetValue(s);
  2737. loop_higher:=not found;
  2738. end
  2739. else
  2740. loop_higher:=false;
  2741. end;
  2742. if found then
  2743. p:=StrNew(Debugger^.GetOutput)
  2744. else
  2745. begin
  2746. { get a reasonable output at least }
  2747. s:=GetStr(expr);
  2748. GetValue(s);
  2749. p:=StrNew(Debugger^.GetError);
  2750. end;
  2751. Debugger^.got_error:=false;
  2752. { We should try here to find the expr in parent
  2753. procedure if there are
  2754. I will implement this as I added a
  2755. parent_ebp pseudo local var to local procedure
  2756. in stabs debug info PM }
  2757. { But there are some pitfalls like
  2758. locals redefined in other sublocals that call the function }
  2759. if curframe<>startframe then
  2760. Debugger^.set_current_frame(startframe);
  2761. q:=nil;
  2762. if assigned(p) and (p[0]='$') then
  2763. q:=StrPos(p,'=');
  2764. if not assigned(q) then
  2765. q:=p;
  2766. if assigned(q) then
  2767. i:=strlen(q)
  2768. else
  2769. i:=0;
  2770. if (i>0) and (q[i-1]=#10) then
  2771. begin
  2772. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2773. dec(i);
  2774. last_removed:=q[i-1];
  2775. q[i-1]:=#0;
  2776. end
  2777. else
  2778. last_removed:=#0;
  2779. if assigned(q) then
  2780. current_value:=strnew(q)
  2781. else
  2782. current_value:=strnew('');
  2783. if last_removed<>#0 then
  2784. q[i-1]:=last_removed;
  2785. strdispose(p);
  2786. GDBRunCount:=Debugger^.RunCount;
  2787. end;
  2788. {$else NODEBUG}
  2789. begin
  2790. end;
  2791. {$endif NODEBUG}
  2792. procedure TWatch.Force_new_value;
  2793. begin
  2794. GDBRunCount:=-1;
  2795. Get_new_value;
  2796. end;
  2797. destructor TWatch.Done;
  2798. begin
  2799. if assigned(expr) then
  2800. disposestr(expr);
  2801. if assigned(last_value) then
  2802. strdispose(last_value);
  2803. if assigned(current_value) then
  2804. strdispose(current_value);
  2805. inherited done;
  2806. end;
  2807. {****************************************************************************
  2808. TWatchesCollection
  2809. ****************************************************************************}
  2810. constructor TWatchesCollection.Init;
  2811. begin
  2812. inherited Init(10,10);
  2813. end;
  2814. procedure TWatchesCollection.Insert(Item: Pointer);
  2815. begin
  2816. PWatch(Item)^.Get_new_value;
  2817. Inherited Insert(Item);
  2818. Update;
  2819. end;
  2820. procedure TWatchesCollection.Update;
  2821. var
  2822. W,W1 : integer;
  2823. procedure GetMax(P : PWatch);
  2824. begin
  2825. if assigned(P^.Current_value) then
  2826. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2827. else
  2828. W1:=2+Length(GetStr(P^.expr));
  2829. if W1>W then
  2830. W:=W1;
  2831. end;
  2832. begin
  2833. W:=0;
  2834. ForEach(@GetMax);
  2835. MaxW:=W;
  2836. If assigned(WatchesWindow) then
  2837. WatchesWindow^.WLB^.Update(MaxW);
  2838. end;
  2839. function TWatchesCollection.At(Index: Integer): PWatch;
  2840. begin
  2841. At:=Inherited At(Index);
  2842. end;
  2843. {****************************************************************************
  2844. TWatchesListBox
  2845. ****************************************************************************}
  2846. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2847. begin
  2848. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2849. If assigned(List) then
  2850. dispose(list,done);
  2851. List:=WatchesCollection;
  2852. end;
  2853. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2854. var R : TRect;
  2855. begin
  2856. GetExtent(R);
  2857. MaxWidth:=AMaxWidth;
  2858. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2859. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2860. else
  2861. HScrollBar^.SetRange(0,0);
  2862. if R.B.X-R.A.X>MaxWidth then
  2863. HScrollBar^.Hide
  2864. else
  2865. HScrollBar^.Show;
  2866. SetRange(List^.Count+1);
  2867. if R.B.Y-R.A.Y>Range then
  2868. VScrollBar^.Hide
  2869. else
  2870. VScrollBar^.Show;
  2871. {if Focused=List^.Count-1-1 then
  2872. FocusItem(List^.Count-1);
  2873. What was that for ?? PM }
  2874. DrawView;
  2875. end;
  2876. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2877. var
  2878. PW : PWatch;
  2879. ValOffset : Sw_integer;
  2880. S : String;
  2881. begin
  2882. Modified:=false;
  2883. if Item>=WatchesCollection^.Count then
  2884. begin
  2885. GetIndentedText:='';
  2886. exit;
  2887. end;
  2888. PW:=WatchesCollection^.At(Item);
  2889. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2890. if not assigned(PW^.expr) then
  2891. GetIndentedText:=''
  2892. else if Indent<ValOffset then
  2893. begin
  2894. S:=GetStr(PW^.Expr);
  2895. if Indent=0 then
  2896. S:=' '+S
  2897. else
  2898. S:=Copy(S,Indent,High(S));
  2899. if not assigned(PW^.current_value) then
  2900. S:=S+' <Unknown value>'
  2901. else
  2902. S:=S+' '+GetPChar(PW^.Current_value);
  2903. GetIndentedText:=Copy(S,1,MaxLen);
  2904. end
  2905. else
  2906. begin
  2907. if not assigned(PW^.Current_value) or
  2908. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2909. S:=''
  2910. else
  2911. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2912. GetIndentedText:=Copy(S,1,MaxLen);
  2913. end;
  2914. if assigned(PW^.current_value) and
  2915. assigned(PW^.last_value) and
  2916. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2917. Modified:=true;
  2918. end;
  2919. procedure TWatchesListBox.EditCurrent;
  2920. var
  2921. P: PWatch;
  2922. begin
  2923. if Range=0 then Exit;
  2924. if Focused<WatchesCollection^.Count then
  2925. P:=WatchesCollection^.At(Focused)
  2926. else
  2927. P:=New(PWatch,Init(''));
  2928. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2929. WatchesCollection^.Update;
  2930. end;
  2931. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2932. var
  2933. Dummy_Modified : boolean;
  2934. begin
  2935. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2936. end;
  2937. procedure TWatchesListBox.DeleteCurrent;
  2938. var
  2939. P: PWatch;
  2940. begin
  2941. if (Range=0) or
  2942. (Focused>=WatchesCollection^.Count) then
  2943. exit;
  2944. P:=WatchesCollection^.At(Focused);
  2945. WatchesCollection^.free(P);
  2946. WatchesCollection^.Update;
  2947. end;
  2948. procedure TWatchesListBox.EditNew;
  2949. var
  2950. P: PWatch;
  2951. S : string;
  2952. begin
  2953. if Focused<WatchesCollection^.Count then
  2954. begin
  2955. P:=WatchesCollection^.At(Focused);
  2956. S:=GetStr(P^.expr);
  2957. end
  2958. else
  2959. S:='';
  2960. P:=New(PWatch,Init(S));
  2961. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2962. begin
  2963. WatchesCollection^.AtInsert(Focused,P);
  2964. WatchesCollection^.Update;
  2965. end
  2966. else
  2967. dispose(P,Done);
  2968. end;
  2969. procedure TWatchesListBox.Draw;
  2970. var
  2971. I, J, Item: Sw_Integer;
  2972. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2973. ColWidth, CurCol, Indent: Integer;
  2974. B: TDrawBuffer;
  2975. Modified : boolean;
  2976. Text: String;
  2977. SCOff: Byte;
  2978. TC: byte;
  2979. procedure MT(var C: word);
  2980. begin
  2981. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2982. end;
  2983. begin
  2984. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2985. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2986. begin
  2987. NormalColor := GetColor(1);
  2988. FocusedColor := GetColor(3);
  2989. SelectedColor := GetColor(4);
  2990. end else
  2991. begin
  2992. NormalColor := GetColor(2);
  2993. SelectedColor := GetColor(4);
  2994. end;
  2995. if Transparent then
  2996. begin MT(NormalColor); MT(SelectedColor); end;
  2997. (* if NoSelection then
  2998. SelectedColor:=NormalColor;*)
  2999. if HScrollBar <> nil then Indent := HScrollBar^.Value
  3000. else Indent := 0;
  3001. ColWidth := Size.X div NumCols + 1;
  3002. for I := 0 to Size.Y - 1 do
  3003. begin
  3004. for J := 0 to NumCols-1 do
  3005. begin
  3006. Item := J*Size.Y + I + TopItem;
  3007. CurCol := J*ColWidth;
  3008. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  3009. (Focused = Item) and (Range > 0) then
  3010. begin
  3011. Color := FocusedColor;
  3012. SetCursor(CurCol+1,I);
  3013. SCOff := 0;
  3014. end
  3015. else if (Item < Range) and IsSelected(Item) then
  3016. begin
  3017. Color := SelectedColor;
  3018. SCOff := 2;
  3019. end
  3020. else
  3021. begin
  3022. Color := NormalColor;
  3023. SCOff := 4;
  3024. end;
  3025. MoveChar(B[CurCol], ' ', Color, ColWidth);
  3026. if Item < Range then
  3027. begin
  3028. (* Text := GetText(Item, ColWidth + Indent);
  3029. Text := Copy(Text,Indent,ColWidth); *)
  3030. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  3031. if modified then
  3032. begin
  3033. SCOff:=0;
  3034. Color:=(Color and $fff0) or Red;
  3035. end;
  3036. MoveStr(B[CurCol], Text, Color);
  3037. if {ShowMarkers or } Modified then
  3038. begin
  3039. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  3040. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  3041. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  3042. end;
  3043. end;
  3044. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  3045. end;
  3046. WriteLine(0, I, Size.X, 1, B);
  3047. end;
  3048. end;
  3049. function TWatchesListBox.GetLocalMenu: PMenu;
  3050. var M: PMenu;
  3051. begin
  3052. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  3053. M:=NewMenu(
  3054. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  3055. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  3056. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  3057. NewLine(
  3058. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  3059. nil))))));
  3060. GetLocalMenu:=M;
  3061. end;
  3062. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  3063. var DontClear: boolean;
  3064. begin
  3065. case Event.What of
  3066. evMouseDown : begin
  3067. if Event.Double then
  3068. Message(@Self,evCommand,cmEdit,nil)
  3069. else
  3070. ClearEvent(Event);
  3071. end;
  3072. evKeyDown :
  3073. begin
  3074. DontClear:=false;
  3075. case Event.KeyCode of
  3076. kbEnter :
  3077. Message(@Self,evCommand,cmEdit,nil);
  3078. kbIns :
  3079. Message(@Self,evCommand,cmNew,nil);
  3080. kbDel :
  3081. Message(@Self,evCommand,cmDelete,nil);
  3082. else
  3083. DontClear:=true;
  3084. end;
  3085. if not DontClear then
  3086. ClearEvent(Event);
  3087. end;
  3088. evBroadcast :
  3089. case Event.Command of
  3090. cmListItemSelected :
  3091. if Event.InfoPtr=@Self then
  3092. Message(@Self,evCommand,cmEdit,nil);
  3093. end;
  3094. evCommand :
  3095. begin
  3096. DontClear:=false;
  3097. case Event.Command of
  3098. cmEdit :
  3099. EditCurrent;
  3100. cmDelete :
  3101. DeleteCurrent;
  3102. cmNew :
  3103. EditNew;
  3104. else
  3105. DontClear:=true;
  3106. end;
  3107. if not DontClear then
  3108. ClearEvent(Event);
  3109. end;
  3110. end;
  3111. inherited HandleEvent(Event);
  3112. end;
  3113. constructor TWatchesListBox.Load(var S: TStream);
  3114. begin
  3115. inherited Load(S);
  3116. If assigned(List) then
  3117. dispose(list,done);
  3118. List:=WatchesCollection;
  3119. { we must set Range PM }
  3120. SetRange(List^.count+1);
  3121. end;
  3122. procedure TWatchesListBox.Store(var S: TStream);
  3123. var OL: PCollection;
  3124. OldRange : Sw_integer;
  3125. begin
  3126. OL:=List;
  3127. OldRange:=Range;
  3128. Range:=0;
  3129. New(List, Init(1,1));
  3130. inherited Store(S);
  3131. Dispose(List, Done);
  3132. List:=OL;
  3133. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  3134. collection? Pasting here a modified version of TListBox.Store+
  3135. TAdvancedListBox.Store isn't a better solution, since by eventually
  3136. changing the obj-hierarchy you'll always have to modify this, too - BG }
  3137. SetRange(OldRange);
  3138. end;
  3139. destructor TWatchesListBox.Done;
  3140. begin
  3141. List:=nil;
  3142. inherited Done;
  3143. end;
  3144. {****************************************************************************
  3145. TWatchesWindow
  3146. ****************************************************************************}
  3147. Constructor TWatchesWindow.Init;
  3148. var
  3149. HSB,VSB: PScrollBar;
  3150. R,R2 : trect;
  3151. begin
  3152. Desktop^.GetExtent(R);
  3153. R.A.Y:=R.B.Y-7;
  3154. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  3155. Palette:=wpCyanWindow;
  3156. GetExtent(R);
  3157. HelpCtx:=hcWatchesWindow;
  3158. R.Grow(-1,-1);
  3159. R2.Copy(R);
  3160. Inc(R2.B.Y);
  3161. R2.A.Y:=R2.B.Y-1;
  3162. New(HSB, Init(R2));
  3163. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3164. HSB^.SetStep(R.B.X-R.A.X,1);
  3165. Insert(HSB);
  3166. R2.Copy(R);
  3167. Inc(R2.B.X);
  3168. R2.A.X:=R2.B.X-1;
  3169. New(VSB, Init(R2));
  3170. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3171. Insert(VSB);
  3172. New(WLB,Init(R,HSB,VSB));
  3173. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3174. WLB^.Transparent:=true;
  3175. Insert(WLB);
  3176. If assigned(WatchesWindow) then
  3177. dispose(WatchesWindow,done);
  3178. WatchesWindow:=@Self;
  3179. Update;
  3180. end;
  3181. procedure TWatchesWindow.Update;
  3182. begin
  3183. WatchesCollection^.Update;
  3184. Draw;
  3185. end;
  3186. constructor TWatchesWindow.Load(var S: TStream);
  3187. begin
  3188. inherited Load(S);
  3189. GetSubViewPtr(S,WLB);
  3190. If assigned(WatchesWindow) then
  3191. dispose(WatchesWindow,done);
  3192. WatchesWindow:=@Self;
  3193. end;
  3194. procedure TWatchesWindow.Store(var S: TStream);
  3195. begin
  3196. inherited Store(S);
  3197. PutSubViewPtr(S,WLB);
  3198. end;
  3199. Destructor TWatchesWindow.Done;
  3200. begin
  3201. WatchesWindow:=nil;
  3202. Dispose(WLB,done);
  3203. inherited done;
  3204. end;
  3205. {****************************************************************************
  3206. TWatchItemDialog
  3207. ****************************************************************************}
  3208. constructor TWatchItemDialog.Init(AWatch: PWatch);
  3209. var R,R2: TRect;
  3210. begin
  3211. R.Assign(0,0,50,10);
  3212. inherited Init(R,'Edit Watch');
  3213. Watch:=AWatch;
  3214. GetExtent(R); R.Grow(-3,-2);
  3215. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  3216. New(NameIL, Init(R, 255)); Insert(NameIL);
  3217. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  3218. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  3219. R2.Copy(R); R2.Move(-1,-1);
  3220. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  3221. GetExtent(R);
  3222. R.Grow(-3,-1);
  3223. R.A.Y:=R.A.Y+3;
  3224. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  3225. Insert(TextST);
  3226. InsertButtons(@Self);
  3227. NameIL^.Select;
  3228. end;
  3229. function TWatchItemDialog.Execute: Word;
  3230. var R: word;
  3231. S1,S2: string;
  3232. begin
  3233. S1:=GetStr(Watch^.expr);
  3234. NameIL^.SetData(S1);
  3235. S1:=GetPChar(Watch^.Current_value);
  3236. S2:=GetPChar(Watch^.Last_value);
  3237. ClearFormatParams;
  3238. AddFormatParamStr(S1);
  3239. AddFormatParamStr(S2);
  3240. if assigned(Watch^.Last_value) and
  3241. assigned(Watch^.Current_value) and
  3242. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  3243. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  3244. else
  3245. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  3246. TextST^.SetText(S1);
  3247. if assigned(FirstEditorWindow) then
  3248. FindReplaceEditor:=FirstEditorWindow^.Editor;
  3249. R:=inherited Execute;
  3250. FindReplaceEditor:=nil;
  3251. if R=cmOK then
  3252. begin
  3253. NameIL^.GetData(S1);
  3254. Watch^.Rename(S1);
  3255. {$ifndef NODEBUG}
  3256. If assigned(Debugger) then
  3257. Debugger^.ReadWatches;
  3258. {$endif NODEBUG}
  3259. end;
  3260. Execute:=R;
  3261. end;
  3262. {****************************************************************************
  3263. TStackWindow
  3264. ****************************************************************************}
  3265. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3266. begin
  3267. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3268. end;
  3269. procedure TFramesListBox.Update;
  3270. var i : longint;
  3271. W : PSourceWindow;
  3272. begin
  3273. {$ifndef NODEBUG}
  3274. { call backtrace command }
  3275. If not assigned(Debugger) then
  3276. exit;
  3277. DeskTop^.Lock;
  3278. Clear;
  3279. if Debugger^.WindowWidth<>-1 then
  3280. Debugger^.Command('set width 0xffffffff');
  3281. Debugger^.Backtrace;
  3282. { generate list }
  3283. { all is in tframeentry }
  3284. for i:=0 to Debugger^.frame_count-1 do
  3285. begin
  3286. with Debugger^.frames[i]^ do
  3287. begin
  3288. if assigned(file_name) then
  3289. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3290. AddModuleName(GetPChar(file_name)),line_number,1)))
  3291. else
  3292. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3293. AddModuleName(''),line_number,1)));
  3294. W:=SearchOnDesktop(GetPChar(file_name),false);
  3295. { First reset all Debugger rows }
  3296. If assigned(W) then
  3297. begin
  3298. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3299. W^.Editor^.DebuggerRow:=-1;
  3300. end;
  3301. end;
  3302. end;
  3303. { Now set all Debugger rows }
  3304. for i:=0 to Debugger^.frame_count-1 do
  3305. begin
  3306. with Debugger^.frames[i]^ do
  3307. begin
  3308. W:=SearchOnDesktop(GetPChar(file_name),false);
  3309. If assigned(W) then
  3310. begin
  3311. If W^.Editor^.DebuggerRow=-1 then
  3312. begin
  3313. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3314. W^.Editor^.DebuggerRow:=line_number-1;
  3315. end;
  3316. end;
  3317. end;
  3318. end;
  3319. if Assigned(list) and (List^.Count > 0) then
  3320. FocusItem(0);
  3321. if Debugger^.WindowWidth<>-1 then
  3322. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3323. DeskTop^.Unlock;
  3324. {$endif NODEBUG}
  3325. end;
  3326. function TFramesListBox.GetLocalMenu: PMenu;
  3327. begin
  3328. GetLocalMenu:=Inherited GetLocalMenu;
  3329. end;
  3330. procedure TFramesListBox.GotoSource;
  3331. begin
  3332. {$ifndef NODEBUG}
  3333. { select frame for watches }
  3334. If not assigned(Debugger) then
  3335. exit;
  3336. Debugger^.Command('f '+IntToStr(Focused));
  3337. { for local vars }
  3338. Debugger^.RereadWatches;
  3339. {$endif NODEBUG}
  3340. { goto source }
  3341. inherited GotoSource;
  3342. end;
  3343. procedure TFramesListBox.GotoAssembly;
  3344. begin
  3345. {$ifndef NODEBUG}
  3346. { select frame for watches }
  3347. If not assigned(Debugger) then
  3348. exit;
  3349. Debugger^.Command('f '+IntToStr(Focused));
  3350. { for local vars }
  3351. Debugger^.RereadWatches;
  3352. {$endif}
  3353. { goto source/assembly mixture }
  3354. InitDisassemblyWindow;
  3355. DisassemblyWindow^.LoadFunction('');
  3356. {$ifndef NODEBUG}
  3357. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3358. DisassemblyWindow^.SelectInDebugSession;
  3359. {$endif NODEBUG}
  3360. end;
  3361. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3362. begin
  3363. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3364. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3365. GotoAssembly;
  3366. inherited HandleEvent(Event);
  3367. end;
  3368. destructor TFramesListBox.Done;
  3369. begin
  3370. Inherited Done;
  3371. end;
  3372. Constructor TStackWindow.Init;
  3373. var
  3374. HSB,VSB: PScrollBar;
  3375. R,R2 : trect;
  3376. begin
  3377. Desktop^.GetExtent(R);
  3378. R.A.Y:=R.B.Y-5;
  3379. inherited Init(R, dialog_callstack, wnNoNumber);
  3380. Palette:=wpCyanWindow;
  3381. GetExtent(R);
  3382. HelpCtx:=hcStackWindow;
  3383. R.Grow(-1,-1);
  3384. R2.Copy(R);
  3385. Inc(R2.B.Y);
  3386. R2.A.Y:=R2.B.Y-1;
  3387. New(HSB, Init(R2));
  3388. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3389. Insert(HSB);
  3390. R2.Copy(R);
  3391. Inc(R2.B.X);
  3392. R2.A.X:=R2.B.X-1;
  3393. New(VSB, Init(R2));
  3394. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3395. Insert(VSB);
  3396. New(FLB,Init(R,HSB,VSB));
  3397. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3398. Insert(FLB);
  3399. If assigned(StackWindow) then
  3400. dispose(StackWindow,done);
  3401. StackWindow:=@Self;
  3402. Update;
  3403. end;
  3404. procedure TStackWindow.Update;
  3405. begin
  3406. FLB^.Update;
  3407. DrawView;
  3408. end;
  3409. constructor TStackWindow.Load(var S: TStream);
  3410. begin
  3411. inherited Load(S);
  3412. GetSubViewPtr(S,FLB);
  3413. If assigned(StackWindow) then
  3414. dispose(StackWindow,done);
  3415. StackWindow:=@Self;
  3416. end;
  3417. procedure TStackWindow.Store(var S: TStream);
  3418. begin
  3419. inherited Store(S);
  3420. PutSubViewPtr(S,FLB);
  3421. end;
  3422. Destructor TStackWindow.Done;
  3423. begin
  3424. StackWindow:=nil;
  3425. Dispose(FLB,done);
  3426. inherited done;
  3427. end;
  3428. {$ifdef SUPPORT_REMOTE}
  3429. {****************************************************************************
  3430. TransformRemoteString
  3431. ****************************************************************************}
  3432. function TransformRemoteString(st : string) : string;
  3433. begin
  3434. If RemoteConfig<>'' then
  3435. ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig)
  3436. else
  3437. ReplaceStrI(St,'$CONFIG','');
  3438. If RemoteIdent<>'' then
  3439. ReplaceStrI(St,'$IDENT','-i '+RemoteIdent)
  3440. else
  3441. ReplaceStrI(St,'$IDENT','');
  3442. If RemotePuttySession<>'' then
  3443. ReplaceStrI(St,'$PUTTYSESSION','-load '+RemotePuttySession)
  3444. else
  3445. ReplaceStrI(St,'$PUTTYSESSION','');
  3446. ReplaceStrI(St,'$LOCALFILENAME',NameAndExtOf(ExeFile));
  3447. ReplaceStrI(St,'$LOCALFILE',ExeFile);
  3448. ReplaceStrI(St,'$REMOTEDIR',RemoteDir);
  3449. ReplaceStrI(St,'$REMOTEPORT',RemotePort);
  3450. ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine);
  3451. ReplaceStrI(St,'$REMOTEGDBSERVER',maybequoted(remotegdbserver));
  3452. ReplaceStrI(St,'$REMOTECOPY',maybequoted(RemoteCopy));
  3453. ReplaceStrI(St,'$REMOTESHELL',maybequoted(RemoteShell));
  3454. { avoid infinite recursion here !!! }
  3455. if Pos('$REMOTEEXECCOMMAND',UpcaseSTr(St))>0 then
  3456. ReplaceStrI(St,'$REMOTEEXECCOMMAND',TransformRemoteString(RemoteExecCommand));
  3457. {$ifdef WINDOWS}
  3458. ReplaceStrI(St,'$START','start "Shell to remote"');
  3459. ReplaceStrI(St,'$DOITINBACKGROUND','');
  3460. {$else}
  3461. ReplaceStrI(St,'$START','');
  3462. ReplaceStrI(St,'$DOITINBACKGROUND',' &');
  3463. {$endif}
  3464. TransformRemoteString:=st;
  3465. end;
  3466. {$endif SUPPORT_REMOTE}
  3467. {****************************************************************************
  3468. Init/Final
  3469. ****************************************************************************}
  3470. function GetGDBTargetShortName : string;
  3471. begin
  3472. {$ifndef CROSSGDB}
  3473. GetGDBTargetShortName:=source_info.shortname;
  3474. {$else CROSSGDB}
  3475. {$ifdef SUPPORT_REMOTE}
  3476. {$ifdef PALMOSGDB}
  3477. GetGDBTargetShortName:='palmos';
  3478. {$else}
  3479. GetGDBTargetShortName:='linux';
  3480. {$endif PALMOSGDB}
  3481. {$endif not SUPPORT_REMOTE}
  3482. {$endif CROSSGDB}
  3483. end;
  3484. procedure InitDebugger;
  3485. {$ifdef DEBUG}
  3486. var s : string;
  3487. i,p : longint;
  3488. {$endif DEBUG}
  3489. var
  3490. NeedRecompileExe : boolean;
  3491. cm : longint;
  3492. begin
  3493. {$ifdef DEBUG}
  3494. if not use_gdb_file then
  3495. begin
  3496. Assign(gdb_file,GDBOutFileName);
  3497. {$I-}
  3498. Rewrite(gdb_file);
  3499. if InOutRes<>0 then
  3500. begin
  3501. s:=GDBOutFileName;
  3502. p:=pos('.',s);
  3503. if p>1 then
  3504. for i:=0 to 9 do
  3505. begin
  3506. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3507. InOutRes:=0;
  3508. Assign(gdb_file,s);
  3509. rewrite(gdb_file);
  3510. if InOutRes=0 then
  3511. break;
  3512. end;
  3513. end;
  3514. if IOResult=0 then
  3515. Use_gdb_file:=true;
  3516. end;
  3517. {$I+}
  3518. {$endif}
  3519. NeedRecompileExe:=false;
  3520. {$ifndef SUPPORT_REMOTE}
  3521. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3522. begin
  3523. ClearFormatParams;
  3524. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3525. AddFormatParamStr(GetGDBTargetShortName);
  3526. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3527. if cm=cmCancel then
  3528. Exit;
  3529. if cm=cmYes then
  3530. begin
  3531. { force recompilation }
  3532. PrevMainFile:='';
  3533. NeedRecompileExe:=true;
  3534. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3535. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3536. DebugInfoSwitches^.SetCurrSelParam('l');
  3537. IDEApp.UpdateTarget;
  3538. end;
  3539. end;
  3540. {$endif ndef SUPPORT_REMOTE}
  3541. if not NeedRecompileExe then
  3542. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3543. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3544. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3545. begin
  3546. ClearFormatParams;
  3547. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3548. if cm=cmCancel then
  3549. Exit;
  3550. if cm=cmYes then
  3551. begin
  3552. { force recompilation }
  3553. PrevMainFile:='';
  3554. NeedRecompileExe:=true;
  3555. DebugInfoSwitches^.SetCurrSelParam('l');
  3556. end;
  3557. end;
  3558. if NeedRecompileExe then
  3559. DoCompile(cRun);
  3560. if CompilationPhase<>cpDone then
  3561. Exit;
  3562. if (EXEFile='') then
  3563. begin
  3564. ErrorBox(msg_nothingtodebug,nil);
  3565. Exit;
  3566. end;
  3567. { init debugcontroller }
  3568. {$ifndef NODEBUG}
  3569. if not assigned(Debugger) then
  3570. begin
  3571. PushStatus(msg_startingdebugger);
  3572. new(Debugger,Init);
  3573. PopStatus;
  3574. end;
  3575. Debugger^.SetExe(ExeFile);
  3576. {$endif NODEBUG}
  3577. {$ifdef GDBWINDOW}
  3578. InitGDBWindow;
  3579. {$endif def GDBWINDOW}
  3580. end;
  3581. const
  3582. Invalid_gdb_file_handle: boolean = false;
  3583. procedure DoneDebugger;
  3584. begin
  3585. {$ifdef DEBUG}
  3586. If IDEApp.IsRunning then
  3587. PushStatus('Closing debugger');
  3588. {$endif}
  3589. {$ifndef NODEBUG}
  3590. if assigned(Debugger) then
  3591. dispose(Debugger,Done);
  3592. Debugger:=nil;
  3593. {$endif NODEBUG}
  3594. {$ifdef DOS}
  3595. If assigned(UserScreen) then
  3596. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3597. {$endif DOS}
  3598. {$ifdef DEBUG}
  3599. If Use_gdb_file then
  3600. begin
  3601. Use_gdb_file:=false;
  3602. {$IFOPT I+}
  3603. {$I-}
  3604. {$DEFINE REENABLE_I}
  3605. {$ENDIF}
  3606. Close(GDB_file);
  3607. if ioresult<>0 then
  3608. begin
  3609. { This handle seems to get lost for DJGPP
  3610. don't bother too much about this. }
  3611. Invalid_gdb_file_handle:=true;
  3612. end;
  3613. {$IFDEF REENABLE_I}
  3614. {$I+}
  3615. {$ENDIF}
  3616. end;
  3617. If IDEApp.IsRunning then
  3618. PopStatus;
  3619. {$endif DEBUG}
  3620. end;
  3621. procedure InitGDBWindow;
  3622. var
  3623. R : TRect;
  3624. begin
  3625. if GDBWindow=nil then
  3626. begin
  3627. DeskTop^.GetExtent(R);
  3628. new(GDBWindow,init(R));
  3629. DeskTop^.Insert(GDBWindow);
  3630. end;
  3631. end;
  3632. procedure DoneGDBWindow;
  3633. begin
  3634. If IDEApp.IsRunning and
  3635. assigned(GDBWindow) then
  3636. begin
  3637. DeskTop^.Delete(GDBWindow);
  3638. end;
  3639. GDBWindow:=nil;
  3640. end;
  3641. procedure InitDisassemblyWindow;
  3642. var
  3643. R : TRect;
  3644. begin
  3645. if DisassemblyWindow=nil then
  3646. begin
  3647. DeskTop^.GetExtent(R);
  3648. new(DisassemblyWindow,init(R));
  3649. DeskTop^.Insert(DisassemblyWindow);
  3650. end;
  3651. end;
  3652. procedure DoneDisassemblyWindow;
  3653. begin
  3654. if assigned(DisassemblyWindow) then
  3655. begin
  3656. DeskTop^.Delete(DisassemblyWindow);
  3657. Dispose(DisassemblyWindow,Done);
  3658. DisassemblyWindow:=nil;
  3659. end;
  3660. end;
  3661. procedure InitStackWindow;
  3662. begin
  3663. if StackWindow=nil then
  3664. begin
  3665. new(StackWindow,init);
  3666. DeskTop^.Insert(StackWindow);
  3667. end;
  3668. end;
  3669. procedure DoneStackWindow;
  3670. begin
  3671. if assigned(StackWindow) then
  3672. begin
  3673. DeskTop^.Delete(StackWindow);
  3674. StackWindow:=nil;
  3675. end;
  3676. end;
  3677. procedure InitBreakpoints;
  3678. begin
  3679. New(BreakpointsCollection,init(10,10));
  3680. end;
  3681. procedure DoneBreakpoints;
  3682. begin
  3683. Dispose(BreakpointsCollection,Done);
  3684. BreakpointsCollection:=nil;
  3685. end;
  3686. procedure InitWatches;
  3687. begin
  3688. New(WatchesCollection,init);
  3689. end;
  3690. procedure DoneWatches;
  3691. begin
  3692. Dispose(WatchesCollection,Done);
  3693. WatchesCollection:=nil;
  3694. end;
  3695. procedure RegisterFPDebugViews;
  3696. begin
  3697. RegisterType(RWatchesWindow);
  3698. RegisterType(RBreakpointsWindow);
  3699. RegisterType(RWatchesListBox);
  3700. RegisterType(RBreakpointsListBox);
  3701. RegisterType(RStackWindow);
  3702. RegisterType(RFramesListBox);
  3703. RegisterType(RBreakpoint);
  3704. RegisterType(RWatch);
  3705. RegisterType(RBreakpointCollection);
  3706. RegisterType(RWatchesCollection);
  3707. end;
  3708. end.
  3709. {$endif NODEBUG}