fpdebug.pas 104 KB

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