fpdebug.pas 101 KB

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