fpdebug.pas 95 KB

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