fpdebug.pas 105 KB

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