fpdebug.pas 94 KB

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