fpdebug.pas 105 KB

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