fpdebug.pas 101 KB

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