fpdebug.pas 128 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998-2000 by Pierre Muller
  5. Debugger call routines for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit FPDebug;
  13. interface
  14. uses
  15. {$ifdef win32}
  16. Windows,
  17. {$endif win32}
  18. Objects,Dialogs,Drivers,Views,
  19. GDBCon,GDBInt,Menus,
  20. WViews,
  21. FPViews;
  22. type
  23. PDebugController=^TDebugController;
  24. TDebugController=object(TGDBController)
  25. InvalidSourceLine : boolean;
  26. { if true the current debugger raw will stay in middle of
  27. editor window when debugging PM }
  28. CenterDebuggerRow : boolean;
  29. Disableallinvalidbreakpoints : boolean;
  30. LastFileName : string;
  31. LastSource : PView; {PsourceWindow !! }
  32. HiddenStepsCount : longint;
  33. { no need to switch if using another terminal }
  34. NoSwitch : boolean;
  35. HasExe : boolean;
  36. RunCount : longint;
  37. WindowWidth : longint;
  38. FPCBreakErrorNumber : longint;
  39. constructor Init;
  40. procedure SetExe(const exefn:string);
  41. procedure SetWidth(AWidth : longint);
  42. procedure SetDirectories;
  43. destructor Done;
  44. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  45. { procedure DoStartSession;virtual;
  46. procedure DoBreakSession;virtual;}
  47. procedure DoEndSession(code:longint);virtual;
  48. procedure DoUserSignal;virtual;
  49. procedure AnnotateError;
  50. procedure InsertBreakpoints;
  51. procedure RemoveBreakpoints;
  52. procedure ReadWatches;
  53. procedure ResetBreakpointsValues;
  54. procedure DoDebuggerScreen;virtual;
  55. procedure DoUserScreen;virtual;
  56. procedure Reset;virtual;
  57. procedure ResetDebuggerRows;
  58. procedure Run;virtual;
  59. procedure Continue;virtual;
  60. procedure UntilReturn;virtual;
  61. procedure CommandBegin(const s:string);virtual;
  62. procedure CommandEnd(const s:string);virtual;
  63. function IsRunning : boolean;
  64. function AllowQuit : boolean;virtual;
  65. function GetValue(Const expr : string) : pchar;
  66. function GetFramePointer : CORE_ADDR;
  67. function GetLongintAt(addr : CORE_ADDR) : longint;
  68. function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  69. end;
  70. BreakpointType = (bt_function,bt_file_line,bt_watch,
  71. bt_awatch,bt_rwatch,bt_address,bt_invalid);
  72. BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
  73. PBreakpointCollection=^TBreakpointCollection;
  74. PBreakpoint=^TBreakpoint;
  75. TBreakpoint=object(TObject)
  76. typ : BreakpointType;
  77. state : BreakpointState;
  78. owner : PBreakpointCollection;
  79. Name : PString; { either function name or expr to watch }
  80. FileName : PString;
  81. OldValue,CurrentValue : Pstring;
  82. Line : Longint; { only used for bt_file_line type }
  83. Conditions : PString; { conditions relative to that breakpoint }
  84. IgnoreCount : Longint; { how many counts should be ignored }
  85. Commands : pchar; { commands that should be executed on breakpoint }
  86. GDBIndex : longint;
  87. GDBState : BreakpointState;
  88. constructor Init_function(Const AFunc : String);
  89. constructor Init_Address(Const AAddress : String);
  90. constructor Init_Empty;
  91. constructor Init_file_line(AFile : String; ALine : longint);
  92. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  93. constructor Load(var S: TStream);
  94. procedure Store(var S: TStream);
  95. procedure Insert;
  96. procedure Remove;
  97. procedure Enable;
  98. procedure Disable;
  99. procedure UpdateSource;
  100. procedure ResetValues;
  101. destructor Done;virtual;
  102. end;
  103. TBreakpointCollection=object(TCollection)
  104. function At(Index: Integer): PBreakpoint;
  105. function GetGDB(index : longint) : PBreakpoint;
  106. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  107. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  108. procedure Update;
  109. procedure ShowBreakpoints(W : PFPWindow);
  110. procedure ShowAllBreakpoints;
  111. end;
  112. PBreakpointItem = ^TBreakpointItem;
  113. TBreakpointItem = object(TObject)
  114. Breakpoint : PBreakpoint;
  115. constructor Init(ABreakpoint : PBreakpoint);
  116. function GetText(MaxLen: Sw_integer): string; virtual;
  117. procedure Selected; virtual;
  118. function GetModuleName: string; virtual;
  119. end;
  120. PBreakpointsListBox = ^TBreakpointsListBox;
  121. TBreakpointsListBox = object(THSListBox)
  122. Transparent : boolean;
  123. NoSelection : boolean;
  124. MaxWidth : Sw_integer;
  125. (* ModuleNames : PStoreCollection; *)
  126. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  127. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  128. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  129. function GetLocalMenu: PMenu;virtual;
  130. procedure Clear; virtual;
  131. procedure TrackSource; virtual;
  132. procedure EditNew; virtual;
  133. procedure EditCurrent; virtual;
  134. procedure DeleteCurrent; virtual;
  135. procedure ToggleCurrent;
  136. procedure Draw; virtual;
  137. procedure HandleEvent(var Event: TEvent); virtual;
  138. constructor Load(var S: TStream);
  139. procedure Store(var S: TStream);
  140. destructor Done; virtual;
  141. end;
  142. PBreakpointsWindow = ^TBreakpointsWindow;
  143. TBreakpointsWindow = object(TFPDlgWindow)
  144. BreakLB : PBreakpointsListBox;
  145. constructor Init;
  146. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  147. procedure ClearBreakpoints;
  148. procedure ReloadBreakpoints;
  149. procedure Close; virtual;
  150. procedure SizeLimits(var Min, Max: TPoint);virtual;
  151. procedure HandleEvent(var Event: TEvent); virtual;
  152. procedure Update; virtual;
  153. constructor Load(var S: TStream);
  154. procedure Store(var S: TStream);
  155. destructor Done; virtual;
  156. end;
  157. PBreakpointItemDialog = ^TBreakpointItemDialog;
  158. TBreakpointItemDialog = object(TCenterDialog)
  159. constructor Init(ABreakpoint: PBreakpoint);
  160. function Execute: Word; virtual;
  161. private
  162. Breakpoint : PBreakpoint;
  163. TypeRB : PRadioButtons;
  164. NameIL : PInputLine;
  165. ConditionsIL: PInputLine;
  166. LineIL : PInputLine;
  167. IgnoreIL : PInputLine;
  168. end;
  169. PWatch = ^TWatch;
  170. TWatch = Object(TObject)
  171. constructor Init(s : string);
  172. constructor Load(var S: TStream);
  173. procedure Store(var S: TStream);
  174. procedure rename(s : string);
  175. procedure Get_new_value;
  176. destructor done;virtual;
  177. expr : pstring;
  178. private
  179. GDBRunCount : longint;
  180. last_value,current_value : pchar;
  181. end;
  182. PWatchesCollection = ^TWatchesCollection;
  183. TWatchesCollection = Object(TCollection)
  184. constructor Init;
  185. procedure Insert(Item: Pointer); virtual;
  186. function At(Index: Integer): PWatch;
  187. procedure Update;
  188. private
  189. MaxW : integer;
  190. end;
  191. PWatchesListBox = ^TWatchesListBox;
  192. TWatchesListBox = object(THSListBox)
  193. Transparent : boolean;
  194. MaxWidth : Sw_integer;
  195. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  196. (* procedure AddWatch(P: PWatch); virtual; *)
  197. procedure Update(AMaxWidth : integer);
  198. function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  199. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
  200. function GetLocalMenu: PMenu;virtual;
  201. (* procedure Clear; virtual;
  202. procedure TrackSource; virtual;*)
  203. procedure EditNew; virtual;
  204. procedure EditCurrent; virtual;
  205. procedure DeleteCurrent; virtual;
  206. (*procedure ToggleCurrent; *)
  207. procedure Draw; virtual;
  208. procedure HandleEvent(var Event: TEvent); virtual;
  209. constructor Load(var S: TStream);
  210. procedure Store(var S: TStream);
  211. destructor Done; virtual;
  212. end;
  213. PWatchItemDialog = ^TWatchItemDialog;
  214. TWatchItemDialog = object(TCenterDialog)
  215. constructor Init(AWatch: PWatch);
  216. function Execute: Word; virtual;
  217. private
  218. Watch : PWatch;
  219. NameIL : PInputLine;
  220. TextST : PAdvancedStaticText;
  221. end;
  222. PWatchesWindow = ^TWatchesWindow;
  223. TWatchesWindow = Object(TFPDlgWindow)
  224. WLB : PWatchesListBox;
  225. Constructor Init;
  226. constructor Load(var S: TStream);
  227. procedure Store(var S: TStream);
  228. procedure Update; virtual;
  229. destructor Done; virtual;
  230. end;
  231. PFramesListBox = ^TFramesListBox;
  232. TFramesListBox = object(TMessageListBox)
  233. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  234. procedure Update;
  235. function GetLocalMenu: PMenu;virtual;
  236. procedure GotoSource; virtual;
  237. procedure GotoAssembly; virtual;
  238. procedure HandleEvent(var Event: TEvent); virtual;
  239. destructor Done; virtual;
  240. end;
  241. PStackWindow = ^TStackWindow;
  242. TStackWindow = Object(TFPDlgWindow)
  243. FLB : PFramesListBox;
  244. Constructor Init;
  245. constructor Load(var S: TStream);
  246. procedure Store(var S: TStream);
  247. procedure Update; virtual;
  248. destructor Done; virtual;
  249. end;
  250. {$ifdef TP} dword = longint; {$endif}
  251. TIntRegs = record
  252. {$ifdef I386}
  253. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  254. cs,ds,es,ss,fs,gs : word;
  255. eflags : dword;
  256. {$endif I386}
  257. {$ifdef m68k}
  258. d0,d1,d2,d3,d4,d5,d6,d7 : dword;
  259. a0,a1,a2,a3,a4,a5,fp,sp : dword;
  260. ps,pc : dword;
  261. {$endif m68k}
  262. end;
  263. PRegistersView = ^TRegistersView;
  264. TRegistersView = object(TView)
  265. OldReg : TIntRegs;
  266. constructor Init(var Bounds: TRect);
  267. procedure Draw;virtual;
  268. destructor Done; virtual;
  269. end;
  270. PRegistersWindow = ^TRegistersWindow;
  271. TRegistersWindow = Object(TFPDlgWindow)
  272. RV : PRegistersView;
  273. Constructor Init;
  274. constructor Load(var S: TStream);
  275. procedure Store(var S: TStream);
  276. procedure Update; virtual;
  277. destructor Done; virtual;
  278. end;
  279. TFPURegs = record
  280. {$ifdef I386}
  281. st0,st1,st2,st3,st4,st5,st6,st7 :string;
  282. ftag,fop,fctrl,fstat,fiseg,foseg : word;
  283. fioff,fooff : cardinal;
  284. {$endif I386}
  285. {$ifdef m68k}
  286. fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string;
  287. fpcontrol,fpstatus,fpiaddr : dword;
  288. {$endif m68k}
  289. end;
  290. PFPUView = ^TFPUView;
  291. TFPUView = object(TView)
  292. OldReg : TFPURegs;
  293. constructor Init(var Bounds: TRect);
  294. procedure Draw;virtual;
  295. destructor Done; virtual;
  296. end;
  297. PFPUWindow = ^TFPUWindow;
  298. TFPUWindow = Object(TFPDlgWindow)
  299. RV : PFPUView;
  300. Constructor Init;
  301. constructor Load(var S: TStream);
  302. procedure Store(var S: TStream);
  303. procedure Update; virtual;
  304. destructor Done; virtual;
  305. end;
  306. procedure InitStackWindow;
  307. procedure DoneStackWindow;
  308. procedure InitRegistersWindow;
  309. procedure DoneRegistersWindow;
  310. procedure InitFPUWindow;
  311. procedure DoneFPUWindow;
  312. function ActiveBreakpoints : boolean;
  313. function GDBFileName(st : string) : string;
  314. function OSFileName(st : string) : string;
  315. const
  316. BreakpointTypeStr : Array[BreakpointType] of String[9]
  317. = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
  318. BreakpointStateStr : Array[BreakpointState] of String[8]
  319. = ( 'enabled','disabled','invalid' );
  320. DebuggeeTTY : string = '';
  321. var
  322. Debugger : PDebugController;
  323. BreakpointsCollection : PBreakpointCollection;
  324. WatchesCollection : PwatchesCollection;
  325. procedure InitDebugger;
  326. procedure DoneDebugger;
  327. procedure InitGDBWindow;
  328. procedure DoneGDBWindow;
  329. procedure InitDisassemblyWindow;
  330. procedure DoneDisassemblyWindow;
  331. procedure InitBreakpoints;
  332. procedure DoneBreakpoints;
  333. procedure InitWatches;
  334. procedure DoneWatches;
  335. procedure RegisterFPDebugViews;
  336. procedure UpdateDebugViews;
  337. implementation
  338. uses
  339. Dos,Video,
  340. App,Strings,
  341. {$ifdef FVISION}
  342. FVConsts,
  343. {$else}
  344. Commands,HelpCtx,
  345. {$endif}
  346. {$ifdef win32}
  347. Windebug,
  348. {$endif win32}
  349. {$ifdef Unix}
  350. {$ifdef VER1_0}
  351. Linux,
  352. {$else}
  353. Unix,
  354. {$endif}
  355. {$endif Unix}
  356. Systems,Globals,
  357. FPString,FPVars,FPUtils,FPConst,FPSwitch,
  358. FPIntf,FPCompil,FPIde,FPHelp,
  359. Validate,WEditor,WUtils,Wconsts;
  360. const
  361. RBreakpointsWindow: TStreamRec = (
  362. ObjType: 1701;
  363. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  364. Load: @TBreakpointsWindow.Load;
  365. Store: @TBreakpointsWindow.Store
  366. );
  367. RBreakpointsListBox : TStreamRec = (
  368. ObjType: 1702;
  369. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  370. Load: @TBreakpointsListBox.Load;
  371. Store: @TBreakpointsListBox.Store
  372. );
  373. RWatchesWindow: TStreamRec = (
  374. ObjType: 1703;
  375. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  376. Load: @TWatchesWindow.Load;
  377. Store: @TWatchesWindow.Store
  378. );
  379. RWatchesListBox: TStreamRec = (
  380. ObjType: 1704;
  381. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  382. Load: @TWatchesListBox.Load;
  383. Store: @TWatchesListBox.Store
  384. );
  385. RStackWindow: TStreamRec = (
  386. ObjType: 1705;
  387. VmtLink: Ofs(TypeOf(TStackWindow)^);
  388. Load: @TStackWindow.Load;
  389. Store: @TStackWindow.Store
  390. );
  391. RFramesListBox: TStreamRec = (
  392. ObjType: 1706;
  393. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  394. Load: @TFramesListBox.Load;
  395. Store: @TFramesListBox.Store
  396. );
  397. RBreakpoint: TStreamRec = (
  398. ObjType: 1707;
  399. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  400. Load: @TBreakpoint.Load;
  401. Store: @TBreakpoint.Store
  402. );
  403. RWatch: TStreamRec = (
  404. ObjType: 1708;
  405. VmtLink: Ofs(TypeOf(TWatch)^);
  406. Load: @TWatch.Load;
  407. Store: @TWatch.Store
  408. );
  409. RBreakpointCollection: TStreamRec = (
  410. ObjType: 1709;
  411. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  412. Load: @TBreakpointCollection.Load;
  413. Store: @TBreakpointCollection.Store
  414. );
  415. RWatchesCollection: TStreamRec = (
  416. ObjType: 1710;
  417. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  418. Load: @TWatchesCollection.Load;
  419. Store: @TWatchesCollection.Store
  420. );
  421. RRegistersWindow: TStreamRec = (
  422. ObjType: 1711;
  423. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  424. Load: @TRegistersWindow.Load;
  425. Store: @TRegistersWindow.Store
  426. );
  427. RRegistersView: TStreamRec = (
  428. ObjType: 1712;
  429. VmtLink: Ofs(TypeOf(TRegistersView)^);
  430. Load: @TRegistersView.Load;
  431. Store: @TRegistersView.Store
  432. );
  433. RFPUWindow: TStreamRec = (
  434. ObjType: 1713;
  435. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  436. Load: @TFPUWindow.Load;
  437. Store: @TFPUWindow.Store
  438. );
  439. RFPUView: TStreamRec = (
  440. ObjType: 1714;
  441. VmtLink: Ofs(TypeOf(TFPUView)^);
  442. Load: @TFPUView.Load;
  443. Store: @TFPUView.Store
  444. );
  445. {$ifdef I386}
  446. const
  447. FrameName = '$ebp';
  448. {$define FrameNameKnown}
  449. {$endif i386}
  450. {$ifdef m68k}
  451. const
  452. FrameName = '$fp';
  453. {$define FrameNameKnown}
  454. {$endif m68k}
  455. {$ifdef TP}
  456. function HexStr(Value: longint; Len: byte): string;
  457. begin
  458. HexStr:=IntToHex(Value,Len);
  459. end;
  460. {$endif}
  461. function GDBFileName(st : string) : string;
  462. {$ifndef Unix}
  463. var i : longint;
  464. {$endif Unix}
  465. begin
  466. {$ifdef Unix}
  467. GDBFileName:=st;
  468. {$else}
  469. { should we also use / chars ? }
  470. for i:=1 to Length(st) do
  471. if st[i]='\' then
  472. {$ifdef win32}
  473. { Don't touch at '\ ' used to escapes spaces in windows file names PM }
  474. if (i=length(st)) or (st[i+1]<>' ') then
  475. {$endif win32}
  476. st[i]:='/';
  477. {$ifdef win32}
  478. { for win32 we should convert e:\ into //e/ PM }
  479. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  480. st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
  481. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  482. for i:=Length(st) downto 1 do
  483. if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
  484. st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
  485. {$endif win32}
  486. {$ifdef go32v2}
  487. { for go32v2 we should convert //e/ back into e:/ PM }
  488. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  489. st:=st[3]+':/'+copy(st,5,length(st));
  490. {$endif go32v2}
  491. GDBFileName:=LowerCaseStr(st);
  492. {$endif}
  493. end;
  494. function OSFileName(st : string) : string;
  495. {$ifndef Unix}
  496. var i : longint;
  497. {$endif Unix}
  498. begin
  499. {$ifdef Unix}
  500. OSFileName:=st;
  501. {$else}
  502. {$ifdef win32}
  503. { for win32 we should convert /cygdrive/e/ into e:\ PM }
  504. if pos(CygDrivePrefix+'/',st)=1 then
  505. st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
  506. {$endif win32}
  507. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  508. for i:=Length(st) downto 2 do
  509. if (st[i]=' ') and (st[i-1]='\') then
  510. st:=copy(st,1,i-2)+copy(st,i,length(st));
  511. {$ifdef go32v2}
  512. { for go32v2 we should convert //e/ back into e:/ PM }
  513. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  514. st:=st[3]+':\'+copy(st,5,length(st));
  515. {$endif go32v2}
  516. { should we also use / chars ? }
  517. for i:=1 to Length(st) do
  518. if st[i]='/' then
  519. st[i]:='\';
  520. OSFileName:=LowerCaseStr(st);
  521. {$endif}
  522. end;
  523. {****************************************************************************
  524. TDebugController
  525. ****************************************************************************}
  526. procedure UpdateDebugViews;
  527. begin
  528. DeskTop^.Lock;
  529. If assigned(StackWindow) then
  530. StackWindow^.Update;
  531. If assigned(RegistersWindow) then
  532. RegistersWindow^.Update;
  533. If assigned(Debugger) then
  534. Debugger^.ReadWatches;
  535. If assigned(FPUWindow) then
  536. FPUWindow^.Update;
  537. DeskTop^.UnLock;
  538. end;
  539. constructor TDebugController.Init;
  540. begin
  541. inherited Init;
  542. CenterDebuggerRow:=IniCenterDebuggerRow;
  543. Disableallinvalidbreakpoints:=false;
  544. NoSwitch:=False;
  545. HasExe:=false;
  546. Debugger:=@self;
  547. WindowWidth:=-1;
  548. {$ifndef GABOR}
  549. switch_to_user:=true;
  550. {$endif}
  551. Command('set print object off');
  552. end;
  553. procedure TDebugController.SetExe(const exefn:string);
  554. var f : string;
  555. begin
  556. f := GDBFileName(GetShortName(exefn));
  557. if (f<>'') and ExistsFile(exefn) then
  558. begin
  559. LoadFile(f);
  560. HasExe:=true;
  561. Command('b FPC_BREAK_ERROR');
  562. FPCBreakErrorNumber:=last_breakpoint_number;
  563. {$ifdef FrameNameKnown}
  564. { this fails in GDB 5.1 because
  565. GDB replies that there is an attempt to dereference
  566. a generic pointer...
  567. test delayed in DoSourceLine... PM
  568. Command('cond '+IntToStr(FPCBreakErrorNumber)+
  569. ' (('+FrameName+' + 8)^ <> 0) or'+
  570. ' (('+FrameName+' + 12)^ <> 0)'); }
  571. {$endif FrameNameKnown}
  572. SetArgs(GetRunParameters);
  573. SetDirectories;
  574. InsertBreakpoints;
  575. ReadWatches;
  576. end
  577. else
  578. begin
  579. HasExe:=false;
  580. Command('file');
  581. end;
  582. end;
  583. procedure TDebugController.SetWidth(AWidth : longint);
  584. begin
  585. WindowWidth:=AWidth;
  586. Command('set width '+inttostr(WindowWidth));
  587. end;
  588. procedure TDebugController.SetDirectories;
  589. var f,s: string;
  590. i : longint;
  591. Dir : SearchRec;
  592. begin
  593. f:=GetSourceDirectories;
  594. repeat
  595. i:=pos(';',f);
  596. if i=0 then
  597. s:=f
  598. else
  599. begin
  600. s:=copy(f,1,i-1);
  601. system.delete(f,1,i);
  602. end;
  603. DefaultReplacements(s);
  604. if (pos('*',s)=0) and ExistsDir(s) then
  605. Command('dir '+GDBFileName(GetShortName(s)))
  606. { we should also handle the /* cases of -Fu option }
  607. else if pos('*',s)>0 then
  608. begin
  609. Dos.FindFirst(s,Directory,Dir);
  610. { the '*' can only be in the last dir level }
  611. s:=DirOf(s);
  612. while Dos.DosError=0 do
  613. begin
  614. if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
  615. Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
  616. Dos.FindNext(Dir);
  617. end;
  618. {$ifdef FPC}
  619. Dos.FindClose(Dir);
  620. {$endif def FPC}
  621. end;
  622. until i=0;
  623. end;
  624. procedure TDebugController.InsertBreakpoints;
  625. procedure DoInsert(PB : PBreakpoint);
  626. begin
  627. PB^.Insert;
  628. end;
  629. begin
  630. BreakpointsCollection^.ForEach(@DoInsert);
  631. Disableallinvalidbreakpoints:=false;
  632. end;
  633. procedure TDebugController.ReadWatches;
  634. procedure DoRead(PB : PWatch);
  635. begin
  636. PB^.Get_new_value;
  637. end;
  638. begin
  639. WatchesCollection^.ForEach(@DoRead);
  640. If Assigned(WatchesWindow) then
  641. WatchesWindow^.Update;
  642. end;
  643. procedure TDebugController.RemoveBreakpoints;
  644. procedure DoDelete(PB : PBreakpoint);
  645. begin
  646. PB^.Remove;
  647. end;
  648. begin
  649. BreakpointsCollection^.ForEach(@DoDelete);
  650. end;
  651. procedure TDebugController.ResetBreakpointsValues;
  652. procedure DoResetVal(PB : PBreakpoint);
  653. begin
  654. PB^.ResetValues;
  655. end;
  656. begin
  657. BreakpointsCollection^.ForEach(@DoResetVal);
  658. end;
  659. function ActiveBreakpoints : boolean;
  660. var
  661. IsActive : boolean;
  662. procedure TestActive(PB : PBreakpoint);
  663. begin
  664. If PB^.state=bs_enabled then
  665. IsActive:=true;
  666. end;
  667. begin
  668. IsActive:=false;
  669. If assigned(BreakpointsCollection) then
  670. BreakpointsCollection^.ForEach(@TestActive);
  671. ActiveBreakpoints:=IsActive;
  672. end;
  673. destructor TDebugController.Done;
  674. begin
  675. { kill the program if running }
  676. Reset;
  677. RemoveBreakpoints;
  678. inherited Done;
  679. end;
  680. procedure TDebugController.Run;
  681. {$ifdef Unix}
  682. var
  683. Debuggeefile : text;
  684. ResetOK, TTYUsed : boolean;
  685. {$endif Unix}
  686. begin
  687. ResetBreakpointsValues;
  688. {$ifdef win32}
  689. { Run the debugge in another console }
  690. if DebuggeeTTY<>'' then
  691. Command('set new-console on')
  692. else
  693. Command('set new-console off');
  694. NoSwitch:=DebuggeeTTY<>'';
  695. {$endif win32}
  696. {$ifdef Unix}
  697. { Run the debuggee in another tty }
  698. if DebuggeeTTY <> '' then
  699. begin
  700. {$I-}
  701. Assign(Debuggeefile,DebuggeeTTY);
  702. system.Reset(Debuggeefile);
  703. ResetOK:=IOResult=0;
  704. If ResetOK and IsATTY(textrec(Debuggeefile).handle) then
  705. begin
  706. Command('tty '+DebuggeeTTY);
  707. TTYUsed:=true;
  708. end
  709. else
  710. begin
  711. Command('tty ');
  712. TTYUsed:=false;
  713. end;
  714. if ResetOK then
  715. close(Debuggeefile);
  716. if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
  717. NoSwitch:= true
  718. else
  719. NoSwitch:=false;
  720. end
  721. else
  722. begin
  723. if TTYName(input)<>'' then
  724. Command('tty '+TTYName(input));
  725. NoSwitch := false;
  726. end;
  727. {$endif Unix}
  728. { Switch to user screen to get correct handles }
  729. UserScreen;
  730. { Don't try to print GDB messages while in User Screen mode }
  731. If assigned(GDBWindow) then
  732. GDBWindow^.Editor^.Lock;
  733. inherited Run;
  734. DebuggerScreen;
  735. If assigned(GDBWindow) then
  736. GDBWindow^.Editor^.UnLock;
  737. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  738. IDEApp.UpdateRunMenu(true);
  739. UpdateDebugViews;
  740. end;
  741. function TDebugController.IsRunning : boolean;
  742. begin
  743. IsRunning:=debuggee_started;
  744. end;
  745. procedure TDebugController.Continue;
  746. begin
  747. {$ifdef NODEBUG}
  748. NoDebugger;
  749. {$else}
  750. if not debuggee_started then
  751. Run
  752. else
  753. inherited Continue;
  754. UpdateDebugViews;
  755. {$endif NODEBUG}
  756. end;
  757. procedure TDebugController.UntilReturn;
  758. begin
  759. Command('finish');
  760. UpdateDebugViews;
  761. { We could try to get the return value !
  762. Not done yet }
  763. end;
  764. procedure TDebugController.CommandBegin(const s:string);
  765. begin
  766. if assigned(GDBWindow) and (in_command>1) then
  767. begin
  768. { We should do something special for errors !! }
  769. If StrLen(GetError)>0 then
  770. GDBWindow^.WriteErrorText(GetError);
  771. GDBWindow^.WriteOutputText(GetOutput);
  772. end;
  773. if assigned(GDBWindow) then
  774. GDBWindow^.WriteString(S);
  775. end;
  776. procedure TDebugController.CommandEnd(const s:string);
  777. begin
  778. if assigned(GDBWindow) and (in_command=0) then
  779. begin
  780. { We should do something special for errors !! }
  781. If StrLen(GetError)>0 then
  782. GDBWindow^.WriteErrorText(GetError);
  783. GDBWindow^.WriteOutputText(GetOutput);
  784. GDBWindow^.Editor^.TextEnd;
  785. end;
  786. end;
  787. function TDebugController.AllowQuit : boolean;
  788. begin
  789. if IsRunning then
  790. begin
  791. if ConfirmBox('Really quit GDB window'#13+
  792. 'and kill running program?',nil,true)=cmYes then
  793. begin
  794. Reset;
  795. DoneGDBWindow;
  796. {AllowQuit:=true;}
  797. AllowQuit:=false;
  798. end
  799. else
  800. AllowQuit:=false;
  801. end
  802. else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
  803. begin
  804. DoneGDBWindow;
  805. {AllowQuit:=true;}
  806. AllowQuit:=false;
  807. end
  808. else
  809. AllowQuit:=false;
  810. end;
  811. procedure TDebugController.ResetDebuggerRows;
  812. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  813. begin
  814. if assigned(P) and
  815. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  816. PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  817. end;
  818. begin
  819. Desktop^.ForEach(@ResetDebuggerRow);
  820. end;
  821. procedure TDebugController.Reset;
  822. begin
  823. inherited Reset;
  824. { we need to free the executable
  825. if we want to recompile it }
  826. SetExe('');
  827. NoSwitch:=false;
  828. { In case we have something that the compiler touched }
  829. If IDEApp.IsRunning then
  830. begin
  831. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  832. IDEApp.UpdateRunMenu(false);
  833. AskToReloadAllModifiedFiles;
  834. ResetDebuggerRows;
  835. end;
  836. end;
  837. procedure TDebugController.AnnotateError;
  838. var errornb : longint;
  839. begin
  840. if error then
  841. begin
  842. errornb:=error_num;
  843. UpdateDebugViews;
  844. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  845. end;
  846. end;
  847. function TDebugController.GetValue(Const expr : string) : pchar;
  848. var
  849. p,p2,p3 : pchar;
  850. begin
  851. if WindowWidth<>-1 then
  852. Command('set width 0xffffffff');
  853. Command('p '+expr);
  854. p:=GetOutput;
  855. p3:=nil;
  856. if assigned(p) and (p[strlen(p)-1]=#10) then
  857. begin
  858. p3:=p+strlen(p)-1;
  859. p3^:=#0;
  860. end;
  861. if assigned(p) then
  862. p2:=strpos(p,'=')
  863. else
  864. p2:=nil;
  865. if assigned(p2) then
  866. p:=p2+1;
  867. while p^ in [' ',TAB] do
  868. inc(p);
  869. { get rid of type }
  870. if p^ = '(' then
  871. p:=strpos(p,')')+1;
  872. while p^ in [' ',TAB] do
  873. inc(p);
  874. if assigned(p) then
  875. GetValue:=StrNew(p)
  876. else
  877. GetValue:=StrNew(GetError);
  878. if assigned(p3) then
  879. p3^:=#10;
  880. got_error:=false;
  881. if WindowWidth<>-1 then
  882. Command('set width '+IntToStr(WindowWidth));
  883. end;
  884. function TDebugController.GetFramePointer : CORE_ADDR;
  885. var
  886. st : string;
  887. p : longint;
  888. begin
  889. {$ifdef FrameNameKnown}
  890. Command('p /d '+FrameName);
  891. st:=strpas(GetOutput);
  892. p:=pos('=',st);
  893. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  894. inc(p);
  895. Delete(st,1,p);
  896. p:=1;
  897. while (st[p] in ['0'..'9']) do
  898. inc(p);
  899. Delete(st,p,High(st));
  900. GetFramePointer:=StrToCard(st);
  901. {$else not FrameNameKnown}
  902. GetFramePointer:=0;
  903. {$endif not FrameNameKnown}
  904. end;
  905. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  906. var
  907. st : string;
  908. p : longint;
  909. begin
  910. Command('x /wd 0x'+hexstr(addr,8));
  911. st:=strpas(GetOutput);
  912. p:=pos(':',st);
  913. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  914. inc(p);
  915. Delete(st,1,p);
  916. p:=1;
  917. while (st[p] in ['0'..'9']) do
  918. inc(p);
  919. Delete(st,p,High(st));
  920. GetLongintAt:=StrToInt(st);
  921. end;
  922. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  923. var
  924. val : CORE_ADDR;
  925. st : string;
  926. p : longint;
  927. begin
  928. Command('x /wx 0x'+hexstr(addr,8));
  929. st:=strpas(GetOutput);
  930. p:=pos(':',st);
  931. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  932. inc(p);
  933. if (p<length(st)) and (st[p+1]='$') then
  934. inc(p);
  935. Delete(st,1,p);
  936. p:=1;
  937. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  938. inc(p);
  939. Delete(st,p,High(st));
  940. GetPointerAt:=HexToCard(st);
  941. end;
  942. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  943. var
  944. W: PSourceWindow;
  945. Found : boolean;
  946. PB : PBreakpoint;
  947. S : String;
  948. BreakIndex : longint;
  949. ebp,stop_addr : CORE_ADDR;
  950. i,ExitCode : longint;
  951. ExitAddr,ExitFrame : CORE_ADDR;
  952. const
  953. FirstArgOffset = 2 * sizeof(CORE_ADDR);
  954. SecondArgOffset = 3 * sizeof(CORE_ADDR);
  955. ThirdArgOffset = 4 * sizeof(CORE_ADDR);
  956. begin
  957. BreakIndex:=stop_breakpoint_number;
  958. Desktop^.Lock;
  959. { 0 based line count in Editor }
  960. if Line>0 then
  961. dec(Line);
  962. S:=fn;
  963. stop_addr:=current_pc;
  964. if (BreakIndex=FPCBreakErrorNumber) then
  965. begin
  966. { Procedure HandleErrorAddrFrame
  967. (Errno : longint;addr,frame : longint);
  968. [public,alias:'FPC_BREAK_ERROR']; }
  969. {$ifdef FrameNameKnown}
  970. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  971. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  972. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  973. if (ExitCode=0) and (ExitAddr=0) then
  974. begin
  975. Desktop^.Unlock;
  976. Command('continue');
  977. exit;
  978. end;
  979. { forget all old frames }
  980. clear_frames;
  981. { record new frames }
  982. Command('backtrace');
  983. for i:=0 to frame_count-1 do
  984. begin
  985. with frames[i]^ do
  986. begin
  987. if ExitAddr=address then
  988. begin
  989. Command('f '+IntToStr(i));
  990. if assigned(file_name) then
  991. begin
  992. s:=strpas(file_name);
  993. line:=line_number;
  994. stop_addr:=address;
  995. end;
  996. break;
  997. end;
  998. end;
  999. end;
  1000. {$endif FrameNameKnown}
  1001. end;
  1002. { Update Disassembly position }
  1003. if Assigned(DisassemblyWindow) then
  1004. DisassemblyWindow^.SetCurAddress(stop_addr);
  1005. if (fn=LastFileName) then
  1006. begin
  1007. W:=PSourceWindow(LastSource);
  1008. if assigned(W) then
  1009. begin
  1010. W^.Editor^.SetCurPtr(0,Line);
  1011. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1012. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1013. UpdateDebugViews;
  1014. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1015. handled by SelectInDebugSession}
  1016. W^.SelectInDebugSession;
  1017. InvalidSourceLine:=false;
  1018. end
  1019. else
  1020. InvalidSourceLine:=true;
  1021. end
  1022. else
  1023. begin
  1024. if s='' then
  1025. W:=nil
  1026. else
  1027. W:=TryToOpenFile(nil,s,0,Line,false);
  1028. if assigned(W) then
  1029. begin
  1030. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1031. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1032. UpdateDebugViews;
  1033. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1034. handled by SelectInDebugSession}
  1035. W^.SelectInDebugSession;
  1036. LastSource:=W;
  1037. InvalidSourceLine:=false;
  1038. end
  1039. { only search a file once }
  1040. else
  1041. begin
  1042. Desktop^.UnLock;
  1043. if s='' then
  1044. Found:=false
  1045. else
  1046. { it is easier to handle with a * at the end }
  1047. Found:=IDEApp.OpenSearch(s+'*');
  1048. Desktop^.Lock;
  1049. if not Found then
  1050. begin
  1051. InvalidSourceLine:=true;
  1052. LastSource:=Nil;
  1053. { Show the stack in that case }
  1054. InitStackWindow;
  1055. UpdateDebugViews;
  1056. StackWindow^.MakeFirst;
  1057. end
  1058. else
  1059. begin
  1060. { should now be open }
  1061. W:=TryToOpenFile(nil,s,0,Line,true);
  1062. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1063. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1064. UpdateDebugViews;
  1065. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1066. handled by SelectInDebugSession}
  1067. W^.SelectInDebugSession;
  1068. LastSource:=W;
  1069. InvalidSourceLine:=false;
  1070. end;
  1071. end;
  1072. end;
  1073. LastFileName:=s;
  1074. Desktop^.UnLock;
  1075. if BreakIndex>0 then
  1076. begin
  1077. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1078. if (BreakIndex=FPCBreakErrorNumber) then
  1079. begin
  1080. if (ExitCode<>0) or (ExitAddr<>0) then
  1081. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1082. #3'Error address $'+IntToHex(ExitAddr,8),nil)
  1083. else
  1084. WarningBox(#3'Run Time Error',nil);
  1085. end
  1086. else if not assigned(PB) then
  1087. begin
  1088. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1089. end
  1090. { For watch we should get old and new value !! }
  1091. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1092. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1093. (PB^.typ<>bt_address) then
  1094. begin
  1095. Command('p '+GetStr(PB^.Name));
  1096. S:=GetPChar(GetOutput);
  1097. got_error:=false;
  1098. If Pos('=',S)>0 then
  1099. S:=Copy(S,Pos('=',S)+1,255);
  1100. If S[Length(S)]=#10 then
  1101. Delete(S,Length(S),1);
  1102. if Assigned(PB^.OldValue) then
  1103. DisposeStr(PB^.OldValue);
  1104. PB^.OldValue:=PB^.CurrentValue;
  1105. PB^.CurrentValue:=NewStr(S);
  1106. If PB^.typ=bt_function then
  1107. WarningBox(#3'GDB stopped due to'#13+
  1108. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1109. else if (GetStr(PB^.OldValue)<>S) then
  1110. WarningBox(#3'GDB stopped due to'#13+
  1111. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1112. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1113. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1114. else
  1115. WarningBox(#3'GDB stopped due to'#13+
  1116. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1117. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1118. end;
  1119. end;
  1120. end;
  1121. procedure TDebugController.DoUserSignal;
  1122. var P :Array[1..2] of pstring;
  1123. S1, S2 : string;
  1124. begin
  1125. S1:=strpas(signal_name);
  1126. S2:=strpas(signal_string);
  1127. P[1]:=@S1;
  1128. P[2]:=@S2;
  1129. WarningBox(msg_programsignal,@P);
  1130. end;
  1131. procedure TDebugController.DoEndSession(code:longint);
  1132. var P :Array[1..2] of longint;
  1133. begin
  1134. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1135. IDEApp.UpdateRunMenu(false);
  1136. ResetDebuggerRows;
  1137. LastExitCode:=Code;
  1138. If HiddenStepsCount=0 then
  1139. InformationBox(msg_programexitedwithexitcode,@code)
  1140. else
  1141. begin
  1142. P[1]:=code;
  1143. P[2]:=HiddenStepsCount;
  1144. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1145. end;
  1146. { In case we have something that the compiler touched }
  1147. AskToReloadAllModifiedFiles;
  1148. {$ifdef win32}
  1149. main_pid_valid:=false;
  1150. {$endif win32}
  1151. end;
  1152. procedure TDebugController.DoDebuggerScreen;
  1153. {$ifdef win32}
  1154. var
  1155. IdeMode : DWord;
  1156. {$endif win32}
  1157. begin
  1158. if NoSwitch then
  1159. begin
  1160. PopStatus;
  1161. end
  1162. else
  1163. begin
  1164. IDEApp.ShowIDEScreen;
  1165. Message(Application,evBroadcast,cmDebuggerStopped,pointer(RunCount));
  1166. PopStatus;
  1167. end;
  1168. {$ifdef win32}
  1169. if NoSwitch then
  1170. begin
  1171. { Ctrl-C as normal char }
  1172. GetConsoleMode(GetStdHandle(Std_Input_Handle), @IdeMode);
  1173. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1174. SetConsoleMode(GetStdHandle(Std_Input_Handle), IdeMode);
  1175. end;
  1176. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1177. {$endif win32}
  1178. end;
  1179. procedure TDebugController.DoUserScreen;
  1180. {$ifdef win32}
  1181. var
  1182. IdeMode : DWord;
  1183. {$endif win32}
  1184. begin
  1185. Inc(RunCount);
  1186. if NoSwitch then
  1187. begin
  1188. {$ifdef Unix}
  1189. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1190. {$else not Unix}
  1191. PushStatus(msg_runninginanotherwindow);
  1192. {$endif Unix}
  1193. end
  1194. else
  1195. begin
  1196. PushStatus(msg_runningprogram);
  1197. IDEApp.ShowUserScreen;
  1198. end;
  1199. {$ifdef win32}
  1200. if NoSwitch then
  1201. begin
  1202. { Ctrl-C as interrupt }
  1203. GetConsoleMode(GetStdHandle(Std_Input_Handle), @IdeMode);
  1204. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1205. SetConsoleMode(GetStdHandle(Std_Input_Handle), IdeMode);
  1206. end;
  1207. ChangeDebuggeeWindowTitleTo(Running_State);
  1208. {$endif win32}
  1209. end;
  1210. {****************************************************************************
  1211. TBreakpoint
  1212. ****************************************************************************}
  1213. constructor TBreakpoint.Init_function(Const AFunc : String);
  1214. begin
  1215. typ:=bt_function;
  1216. state:=bs_enabled;
  1217. GDBState:=bs_deleted;
  1218. Name:=NewStr(AFunc);
  1219. FileName:=nil;
  1220. Line:=0;
  1221. IgnoreCount:=0;
  1222. Commands:=nil;
  1223. Conditions:=nil;
  1224. OldValue:=nil;
  1225. CurrentValue:=nil;
  1226. end;
  1227. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1228. begin
  1229. typ:=bt_address;
  1230. state:=bs_enabled;
  1231. GDBState:=bs_deleted;
  1232. Name:=NewStr(AAddress);
  1233. FileName:=nil;
  1234. Line:=0;
  1235. IgnoreCount:=0;
  1236. Commands:=nil;
  1237. Conditions:=nil;
  1238. OldValue:=nil;
  1239. CurrentValue:=nil;
  1240. end;
  1241. constructor TBreakpoint.Init_Empty;
  1242. begin
  1243. typ:=bt_function;
  1244. state:=bs_enabled;
  1245. GDBState:=bs_deleted;
  1246. Name:=Nil;
  1247. FileName:=nil;
  1248. Line:=0;
  1249. IgnoreCount:=0;
  1250. Commands:=nil;
  1251. Conditions:=nil;
  1252. OldValue:=nil;
  1253. CurrentValue:=nil;
  1254. end;
  1255. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1256. begin
  1257. typ:=atyp;
  1258. state:=bs_enabled;
  1259. GDBState:=bs_deleted;
  1260. Name:=NewStr(AnExpr);
  1261. IgnoreCount:=0;
  1262. Commands:=nil;
  1263. Conditions:=nil;
  1264. OldValue:=nil;
  1265. CurrentValue:=nil;
  1266. end;
  1267. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1268. var
  1269. CurDir : String;
  1270. begin
  1271. typ:=bt_file_line;
  1272. state:=bs_enabled;
  1273. GDBState:=bs_deleted;
  1274. { d:test.pas:12 does not work !! }
  1275. { I do not know how to solve this if
  1276. if (Length(AFile)>1) and (AFile[2]=':') then
  1277. AFile:=Copy(AFile,3,255); }
  1278. {$ifdef Unix}
  1279. CurDir:=GetCurDir;
  1280. {$else}
  1281. CurDir:=LowerCaseStr(GetCurDir);
  1282. {$endif Unix}
  1283. if Pos(CurDir,OSFileName(FEXpand(AFile)))=1 then
  1284. FileName:=NewStr(Copy(OSFileName(FExpand(AFile)),length(CurDir)+1,255))
  1285. else
  1286. FileName:=NewStr(OSFileName(FExpand(AFile)));
  1287. Name:=nil;
  1288. Line:=ALine;
  1289. IgnoreCount:=0;
  1290. Commands:=nil;
  1291. Conditions:=nil;
  1292. OldValue:=nil;
  1293. CurrentValue:=nil;
  1294. end;
  1295. constructor TBreakpoint.Load(var S: TStream);
  1296. var
  1297. FName : PString;
  1298. begin
  1299. S.Read(typ,SizeOf(BreakpointType));
  1300. S.Read(state,SizeOf(BreakpointState));
  1301. GDBState:=bs_deleted;
  1302. case typ of
  1303. bt_file_line :
  1304. begin
  1305. { convert to current target }
  1306. FName:=S.ReadStr;
  1307. FileName:=NewStr(OSFileName(GetStr(FName)));
  1308. If Assigned(FName) then
  1309. DisposeStr(FName);
  1310. S.Read(Line,SizeOf(Line));
  1311. Name:=nil;
  1312. end;
  1313. else
  1314. begin
  1315. Name:=S.ReadStr;
  1316. Line:=0;
  1317. FileName:=nil;
  1318. end;
  1319. end;
  1320. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1321. Commands:=S.StrRead;
  1322. Conditions:=S.ReadStr;
  1323. OldValue:=nil;
  1324. CurrentValue:=nil;
  1325. end;
  1326. procedure TBreakpoint.Store(var S: TStream);
  1327. var
  1328. St : String;
  1329. begin
  1330. S.Write(typ,SizeOf(BreakpointType));
  1331. S.Write(state,SizeOf(BreakpointState));
  1332. case typ of
  1333. bt_file_line :
  1334. begin
  1335. st:=OSFileName(GetStr(FileName));
  1336. S.WriteStr(@St);
  1337. S.Write(Line,SizeOf(Line));
  1338. end;
  1339. else
  1340. begin
  1341. S.WriteStr(Name);
  1342. end;
  1343. end;
  1344. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1345. S.StrWrite(Commands);
  1346. S.WriteStr(Conditions);
  1347. end;
  1348. procedure TBreakpoint.Insert;
  1349. var
  1350. p,p2 : pchar;
  1351. st : string;
  1352. begin
  1353. If not assigned(Debugger) then Exit;
  1354. Remove;
  1355. Debugger^.last_breakpoint_number:=0;
  1356. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1357. begin
  1358. if (typ=bt_file_line) and assigned(FileName) then
  1359. Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
  1360. else if (typ=bt_function) and assigned(name) then
  1361. Debugger^.Command('break '+name^)
  1362. else if (typ=bt_address) and assigned(name) then
  1363. Debugger^.Command('break *0x'+name^)
  1364. else if (typ=bt_watch) and assigned(name) then
  1365. Debugger^.Command('watch '+name^)
  1366. else if (typ=bt_awatch) and assigned(name) then
  1367. Debugger^.Command('awatch '+name^)
  1368. else if (typ=bt_rwatch) and assigned(name) then
  1369. Debugger^.Command('rwatch '+name^);
  1370. if Debugger^.last_breakpoint_number<>0 then
  1371. begin
  1372. GDBIndex:=Debugger^.last_breakpoint_number;
  1373. GDBState:=bs_enabled;
  1374. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1375. If IgnoreCount>0 then
  1376. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1377. If Assigned(Commands) then
  1378. begin
  1379. {Commands are not handled yet }
  1380. Debugger^.Command('command '+IntToStr(GDBIndex));
  1381. p:=commands;
  1382. while assigned(p) do
  1383. begin
  1384. p2:=strscan(p,#10);
  1385. if assigned(p2) then
  1386. p2^:=#0;
  1387. st:=strpas(p);
  1388. Debugger^.command(st);
  1389. if assigned(p2) then
  1390. p2^:=#10;
  1391. p:=p2;
  1392. if assigned(p) then
  1393. inc(p);
  1394. end;
  1395. Debugger^.Command('end');
  1396. end;
  1397. end
  1398. else
  1399. { Here there was a problem !! }
  1400. begin
  1401. GDBIndex:=0;
  1402. if not Debugger^.Disableallinvalidbreakpoints then
  1403. begin
  1404. if (typ=bt_file_line) and assigned(FileName) then
  1405. begin
  1406. ClearFormatParams;
  1407. AddFormatParamStr(NameAndExtOf(FileName^));
  1408. AddFormatParamInt(Line);
  1409. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1410. Debugger^.Disableallinvalidbreakpoints:=true;
  1411. end
  1412. else
  1413. begin
  1414. ClearFormatParams;
  1415. AddFormatParamStr(BreakpointTypeStr[typ]);
  1416. AddFormatParamStr(GetStr(Name));
  1417. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1418. Debugger^.Disableallinvalidbreakpoints:=true;
  1419. end;
  1420. end;
  1421. state:=bs_disabled;
  1422. end;
  1423. end
  1424. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1425. Enable
  1426. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1427. Disable;
  1428. end;
  1429. procedure TBreakpoint.Remove;
  1430. begin
  1431. If not assigned(Debugger) then Exit;
  1432. if GDBIndex>0 then
  1433. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1434. GDBIndex:=0;
  1435. GDBState:=bs_deleted;
  1436. end;
  1437. procedure TBreakpoint.Enable;
  1438. begin
  1439. If not assigned(Debugger) then Exit;
  1440. if GDBIndex>0 then
  1441. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1442. else
  1443. Insert;
  1444. GDBState:=bs_enabled;
  1445. end;
  1446. procedure TBreakpoint.Disable;
  1447. begin
  1448. If not assigned(Debugger) then Exit;
  1449. if GDBIndex>0 then
  1450. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1451. GDBState:=bs_disabled;
  1452. end;
  1453. procedure TBreakpoint.ResetValues;
  1454. begin
  1455. if assigned(OldValue) then
  1456. DisposeStr(OldValue);
  1457. OldValue:=nil;
  1458. if assigned(CurrentValue) then
  1459. DisposeStr(CurrentValue);
  1460. CurrentValue:=nil;
  1461. end;
  1462. procedure TBreakpoint.UpdateSource;
  1463. var W: PSourceWindow;
  1464. b : boolean;
  1465. begin
  1466. if typ=bt_file_line then
  1467. begin
  1468. W:=SearchOnDesktop(FExpand(OSFileName(GetStr(FileName))),false);
  1469. If assigned(W) then
  1470. begin
  1471. if state=bs_enabled then
  1472. b:=true
  1473. else
  1474. b:=false;
  1475. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1476. end;
  1477. end;
  1478. end;
  1479. destructor TBreakpoint.Done;
  1480. begin
  1481. Remove;
  1482. ResetValues;
  1483. if assigned(Name) then
  1484. DisposeStr(Name);
  1485. if assigned(FileName) then
  1486. DisposeStr(FileName);
  1487. if assigned(Conditions) then
  1488. DisposeStr(Conditions);
  1489. if assigned(Commands) then
  1490. StrDispose(Commands);
  1491. inherited Done;
  1492. end;
  1493. {****************************************************************************
  1494. TBreakpointCollection
  1495. ****************************************************************************}
  1496. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1497. begin
  1498. At:=inherited At(Index);
  1499. end;
  1500. procedure TBreakpointCollection.Update;
  1501. begin
  1502. if assigned(Debugger) then
  1503. begin
  1504. Debugger^.RemoveBreakpoints;
  1505. Debugger^.InsertBreakpoints;
  1506. end;
  1507. if assigned(BreakpointsWindow) then
  1508. BreakpointsWindow^.Update;
  1509. end;
  1510. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1511. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1512. begin
  1513. IsNum:=P^.GDBIndex=index;
  1514. end;
  1515. begin
  1516. if index=0 then
  1517. GetGDB:=nil
  1518. else
  1519. GetGDB:=FirstThat(@IsNum);
  1520. end;
  1521. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1522. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1523. begin
  1524. If assigned(P^.FileName) and
  1525. (OSFileName(FExpand(P^.FileName^))=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1526. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1527. end;
  1528. procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1529. var
  1530. PDL : PDisasLine;
  1531. S : string;
  1532. ps,qs,i : longint;
  1533. begin
  1534. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1535. begin
  1536. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1537. if PDL^.Address=0 then
  1538. begin
  1539. if (P^.typ=bt_file_line) then
  1540. begin
  1541. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1542. ps:=pos(':',S);
  1543. qs:=pos(' ',copy(S,ps+1,High(S)));
  1544. if (GDBFileName(FExpand(P^.FileName^))=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1545. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1546. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1547. end;
  1548. end
  1549. else
  1550. begin
  1551. If (P^.typ=bt_address) and (PDL^.Address=HexToCard(P^.Name^)) then
  1552. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1553. end;
  1554. end;
  1555. end;
  1556. begin
  1557. if W=PFPWindow(DisassemblyWindow) then
  1558. ForEach(@SetInDisassembly)
  1559. else
  1560. ForEach(@SetInSource);
  1561. end;
  1562. procedure TBreakpointCollection.ShowAllBreakpoints;
  1563. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1564. var
  1565. W : PSourceWindow;
  1566. begin
  1567. If assigned(P^.FileName) then
  1568. begin
  1569. W:=SearchOnDesktop(P^.FileName^,false);
  1570. if assigned(W) then
  1571. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1572. end;
  1573. end;
  1574. begin
  1575. ForEach(@SetInSource);
  1576. end;
  1577. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1578. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1579. begin
  1580. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1581. end;
  1582. begin
  1583. GetType:=FirstThat(@IsThis);
  1584. end;
  1585. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1586. var PB : PBreakpoint;
  1587. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1588. begin
  1589. IsThere:=(P^.typ=bt_file_line) and (OSFileName(FExpand(P^.FileName^))=FileName) and (P^.Line=LineNr);
  1590. end;
  1591. begin
  1592. FileName:=OSFileName(FileName);
  1593. PB:=FirstThat(@IsThere);
  1594. ToggleFileLine:=false;
  1595. If Assigned(PB) then
  1596. if PB^.state=bs_disabled then
  1597. begin
  1598. PB^.state:=bs_enabled;
  1599. ToggleFileLine:=true;
  1600. end
  1601. else if PB^.state=bs_enabled then
  1602. PB^.state:=bs_disabled;
  1603. If not assigned(PB) then
  1604. begin
  1605. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1606. if assigned(PB) then
  1607. Begin
  1608. Insert(PB);
  1609. ToggleFileLine:=true;
  1610. End;
  1611. end;
  1612. if assigned(PB) then
  1613. PB^.UpdateSource;
  1614. Update;
  1615. end;
  1616. {****************************************************************************
  1617. TBreakpointItem
  1618. ****************************************************************************}
  1619. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1620. begin
  1621. inherited Init;
  1622. Breakpoint:=ABreakpoint;
  1623. end;
  1624. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1625. var S: string;
  1626. begin
  1627. with Breakpoint^ do
  1628. begin
  1629. S:=BreakpointTypeStr[typ];
  1630. While Length(S)<10 do
  1631. S:=S+' ';
  1632. S:=S+'|';
  1633. S:=S+BreakpointStateStr[state]+' ';
  1634. While Length(S)<20 do
  1635. S:=S+' ';
  1636. S:=S+'|';
  1637. if (typ=bt_file_line) then
  1638. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
  1639. else
  1640. S:=S+GetStr(name);
  1641. While Length(S)<40 do
  1642. S:=S+' ';
  1643. S:=S+'|';
  1644. if IgnoreCount>0 then
  1645. S:=S+IntToStr(IgnoreCount);
  1646. While Length(S)<49 do
  1647. S:=S+' ';
  1648. S:=S+'|';
  1649. if assigned(Conditions) then
  1650. S:=S+' '+GetStr(Conditions);
  1651. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1652. GetText:=S;
  1653. end;
  1654. end;
  1655. procedure TBreakpointItem.Selected;
  1656. begin
  1657. end;
  1658. function TBreakpointItem.GetModuleName: string;
  1659. begin
  1660. if breakpoint^.typ=bt_file_line then
  1661. GetModuleName:=GetStr(breakpoint^.FileName)
  1662. else
  1663. GetModuleName:='';
  1664. end;
  1665. {****************************************************************************
  1666. TBreakpointsListBox
  1667. ****************************************************************************}
  1668. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1669. begin
  1670. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1671. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1672. NoSelection:=true;
  1673. end;
  1674. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1675. var M: PMenu;
  1676. begin
  1677. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1678. M:=NewMenu(
  1679. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1680. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1681. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1682. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1683. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1684. nil))))));
  1685. GetLocalMenu:=M;
  1686. end;
  1687. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1688. var DontClear: boolean;
  1689. begin
  1690. case Event.What of
  1691. evKeyDown :
  1692. begin
  1693. DontClear:=false;
  1694. case Event.KeyCode of
  1695. kbEnter :
  1696. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1697. kbIns :
  1698. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1699. kbDel :
  1700. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1701. else
  1702. DontClear:=true;
  1703. end;
  1704. if not DontClear then
  1705. ClearEvent(Event);
  1706. end;
  1707. evBroadcast :
  1708. case Event.Command of
  1709. cmListItemSelected :
  1710. if Event.InfoPtr=@Self then
  1711. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1712. end;
  1713. evCommand :
  1714. begin
  1715. DontClear:=false;
  1716. case Event.Command of
  1717. cmMsgTrackSource :
  1718. if Range>0 then
  1719. TrackSource;
  1720. cmEditBreakpoint :
  1721. EditCurrent;
  1722. cmToggleBreakpoint :
  1723. ToggleCurrent;
  1724. cmDeleteBreakpoint :
  1725. DeleteCurrent;
  1726. cmNewBreakpoint :
  1727. EditNew;
  1728. cmMsgClear :
  1729. Clear;
  1730. else
  1731. DontClear:=true;
  1732. end;
  1733. if not DontClear then
  1734. ClearEvent(Event);
  1735. end;
  1736. end;
  1737. inherited HandleEvent(Event);
  1738. end;
  1739. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1740. var W : integer;
  1741. begin
  1742. if List=nil then New(List, Init(20,20));
  1743. W:=length(P^.GetText(255));
  1744. if W>MaxWidth then
  1745. begin
  1746. MaxWidth:=W;
  1747. if HScrollBar<>nil then
  1748. HScrollBar^.SetRange(0,MaxWidth);
  1749. end;
  1750. List^.Insert(P);
  1751. SetRange(List^.Count);
  1752. if Focused=List^.Count-1-1 then
  1753. FocusItem(List^.Count-1);
  1754. P^.Breakpoint^.UpdateSource;
  1755. DrawView;
  1756. end;
  1757. (* function TBreakpointsListBox.AddModuleName(const Name: string): PString;
  1758. var P: PString;
  1759. begin
  1760. if ModuleNames<>nil then
  1761. P:=ModuleNames^.Add(Name)
  1762. else
  1763. P:=nil;
  1764. AddModuleName:=P;
  1765. end; *)
  1766. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1767. var P: PBreakpointItem;
  1768. S: string;
  1769. begin
  1770. P:=List^.At(Item);
  1771. S:=P^.GetText(MaxLen);
  1772. GetText:=copy(S,1,MaxLen);
  1773. end;
  1774. procedure TBreakpointsListBox.Clear;
  1775. begin
  1776. if assigned(List) then
  1777. Dispose(List, Done);
  1778. List:=nil;
  1779. MaxWidth:=0;
  1780. (* if assigned(ModuleNames) then
  1781. ModuleNames^.FreeAll; *)
  1782. SetRange(0); DrawView;
  1783. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1784. end;
  1785. procedure TBreakpointsListBox.TrackSource;
  1786. var W: PSourceWindow;
  1787. P: PBreakpointItem;
  1788. R: TRect;
  1789. (* Row,Col: sw_integer; *)
  1790. begin
  1791. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1792. if Range=0 then Exit;*)
  1793. P:=List^.At(Focused);
  1794. if P^.GetModuleName='' then Exit;
  1795. Desktop^.Lock;
  1796. GetNextEditorBounds(R);
  1797. R.B.Y:=Owner^.Origin.Y;
  1798. W:=EditorWindowFile(P^.GetModuleName);
  1799. if assigned(W) then
  1800. begin
  1801. W^.GetExtent(R);
  1802. R.B.Y:=Owner^.Origin.Y;
  1803. W^.ChangeBounds(R);
  1804. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1805. end
  1806. else
  1807. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1808. if W<>nil then
  1809. begin
  1810. W^.Select;
  1811. W^.Editor^.TrackCursor(true);
  1812. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  1813. end;
  1814. if Assigned(Owner) then
  1815. Owner^.Select;
  1816. Desktop^.UnLock;
  1817. end;
  1818. procedure TBreakpointsListBox.ToggleCurrent;
  1819. var
  1820. P: PBreakpointItem;
  1821. begin
  1822. if Range=0 then Exit;
  1823. P:=List^.At(Focused);
  1824. if P=nil then Exit;
  1825. if P^.Breakpoint^.state=bs_enabled then
  1826. P^.Breakpoint^.state:=bs_disabled
  1827. else if P^.Breakpoint^.state=bs_disabled then
  1828. P^.Breakpoint^.state:=bs_enabled;
  1829. P^.Breakpoint^.UpdateSource;
  1830. BreakpointsCollection^.Update;
  1831. end;
  1832. procedure TBreakpointsListBox.EditCurrent;
  1833. var
  1834. P: PBreakpointItem;
  1835. begin
  1836. if Range=0 then Exit;
  1837. P:=List^.At(Focused);
  1838. if P=nil then Exit;
  1839. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  1840. P^.Breakpoint^.UpdateSource;
  1841. BreakpointsCollection^.Update;
  1842. end;
  1843. procedure TBreakpointsListBox.DeleteCurrent;
  1844. var
  1845. P: PBreakpointItem;
  1846. begin
  1847. if Range=0 then Exit;
  1848. P:=List^.At(Focused);
  1849. if P=nil then Exit;
  1850. { delete it form source window }
  1851. P^.Breakpoint^.state:=bs_disabled;
  1852. P^.Breakpoint^.UpdateSource;
  1853. BreakpointsCollection^.free(P^.Breakpoint);
  1854. List^.free(P);
  1855. BreakpointsCollection^.Update;
  1856. end;
  1857. procedure TBreakpointsListBox.EditNew;
  1858. var
  1859. P: PBreakpoint;
  1860. begin
  1861. P:=New(PBreakpoint,Init_Empty);
  1862. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  1863. begin
  1864. P^.UpdateSource;
  1865. BreakpointsCollection^.Insert(P);
  1866. BreakpointsCollection^.Update;
  1867. end
  1868. else
  1869. dispose(P,Done);
  1870. end;
  1871. procedure TBreakpointsListBox.Draw;
  1872. var
  1873. I, J, Item: Sw_Integer;
  1874. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1875. ColWidth, CurCol, Indent: Integer;
  1876. B: TDrawBuffer;
  1877. Text: String;
  1878. SCOff: Byte;
  1879. TC: byte;
  1880. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1881. begin
  1882. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1883. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1884. begin
  1885. NormalColor := GetColor(1);
  1886. FocusedColor := GetColor(3);
  1887. SelectedColor := GetColor(4);
  1888. end else
  1889. begin
  1890. NormalColor := GetColor(2);
  1891. SelectedColor := GetColor(4);
  1892. end;
  1893. if Transparent then
  1894. begin MT(NormalColor); MT(SelectedColor); end;
  1895. if NoSelection then
  1896. SelectedColor:=NormalColor;
  1897. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1898. else Indent := 0;
  1899. ColWidth := Size.X div NumCols + 1;
  1900. for I := 0 to Size.Y - 1 do
  1901. begin
  1902. for J := 0 to NumCols-1 do
  1903. begin
  1904. Item := J*Size.Y + I + TopItem;
  1905. CurCol := J*ColWidth;
  1906. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1907. (Focused = Item) and (Range > 0) then
  1908. begin
  1909. Color := FocusedColor;
  1910. SetCursor(CurCol+1,I);
  1911. SCOff := 0;
  1912. end
  1913. else if (Item < Range) and IsSelected(Item) then
  1914. begin
  1915. Color := SelectedColor;
  1916. SCOff := 2;
  1917. end
  1918. else
  1919. begin
  1920. Color := NormalColor;
  1921. SCOff := 4;
  1922. end;
  1923. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1924. if Item < Range then
  1925. begin
  1926. Text := GetText(Item, ColWidth + Indent);
  1927. Text := Copy(Text,Indent,ColWidth);
  1928. MoveStr(B[CurCol+1], Text, Color);
  1929. if ShowMarkers then
  1930. begin
  1931. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1932. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1933. end;
  1934. end;
  1935. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1936. end;
  1937. WriteLine(0, I, Size.X, 1, B);
  1938. end;
  1939. end;
  1940. constructor TBreakpointsListBox.Load(var S: TStream);
  1941. begin
  1942. inherited Load(S);
  1943. end;
  1944. procedure TBreakpointsListBox.Store(var S: TStream);
  1945. var OL: PCollection;
  1946. OldR : integer;
  1947. begin
  1948. OL:=List;
  1949. OldR:=Range;
  1950. Range:=0;
  1951. New(List, Init(1,1));
  1952. inherited Store(S);
  1953. Dispose(List, Done);
  1954. Range:=OldR;
  1955. List:=OL;
  1956. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1957. collection? Pasting here a modified version of TListBox.Store+
  1958. TAdvancedListBox.Store isn't a better solution, since by eventually
  1959. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1960. end;
  1961. destructor TBreakpointsListBox.Done;
  1962. begin
  1963. inherited Done;
  1964. if List<>nil then Dispose(List, Done);
  1965. (* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
  1966. end;
  1967. {****************************************************************************
  1968. TBreakpointsWindow
  1969. ****************************************************************************}
  1970. constructor TBreakpointsWindow.Init;
  1971. var R,R2: TRect;
  1972. HSB,VSB: PScrollBar;
  1973. ST: PStaticText;
  1974. S: String;
  1975. X,X1 : Sw_integer;
  1976. Btn: PButton;
  1977. const
  1978. NumButtons = 5;
  1979. begin
  1980. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  1981. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  1982. HelpCtx:=hcBreakpointListWindow;
  1983. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1984. S:=label_breakpointpropheader;
  1985. New(ST, Init(R,S));
  1986. ST^.GrowMode:=gfGrowHiX;
  1987. Insert(ST);
  1988. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  1989. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  1990. ST^.GrowMode:=gfGrowHiX;
  1991. Insert(ST);
  1992. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  1993. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1994. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1995. HSB^.SetStep(R.B.X-R.A.X-2,1);
  1996. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1997. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1998. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  1999. New(BreakLB, Init(R,HSB,VSB));
  2000. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2001. BreakLB^.Transparent:=true;
  2002. Insert(BreakLB);
  2003. GetExtent(R);R.Grow(-1,-1);
  2004. Dec(R.B.Y);
  2005. R.A.Y:=R.B.Y-2;
  2006. X:=(R.B.X-R.A.X) div NumButtons;
  2007. X1:=R.A.X+(X div 2);
  2008. R.A.X:=X1-3;R.B.X:=X1+7;
  2009. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2010. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2011. Insert(Btn);
  2012. X1:=X1+X;
  2013. R.A.X:=X1-3;R.B.X:=X1+7;
  2014. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2015. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2016. Insert(Btn);
  2017. X1:=X1+X;
  2018. R.A.X:=X1-3;R.B.X:=X1+7;
  2019. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2020. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2021. Insert(Btn);
  2022. X1:=X1+X;
  2023. R.A.X:=X1-3;R.B.X:=X1+7;
  2024. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2025. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2026. Insert(Btn);
  2027. X1:=X1+X;
  2028. R.A.X:=X1-3;R.B.X:=X1+7;
  2029. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2030. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2031. Insert(Btn);
  2032. BreakLB^.Select;
  2033. Update;
  2034. BreakpointsWindow:=@self;
  2035. end;
  2036. constructor TBreakpointsWindow.Load(var S: TStream);
  2037. begin
  2038. inherited Load(S);
  2039. GetSubViewPtr(S,BreakLB);
  2040. end;
  2041. procedure TBreakpointsWindow.Store(var S: TStream);
  2042. begin
  2043. inherited Store(S);
  2044. PutSubViewPtr(S,BreakLB);
  2045. end;
  2046. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2047. begin
  2048. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2049. end;
  2050. procedure TBreakpointsWindow.ClearBreakpoints;
  2051. begin
  2052. BreakLB^.Clear;
  2053. ReDraw;
  2054. end;
  2055. procedure TBreakpointsWindow.ReloadBreakpoints;
  2056. procedure InsertInBreakLB(P : PBreakpoint);
  2057. begin
  2058. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2059. end;
  2060. begin
  2061. If not assigned(BreakpointsCollection) then
  2062. exit;
  2063. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2064. ReDraw;
  2065. end;
  2066. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2067. begin
  2068. inherited SizeLimits(Min,Max);
  2069. Min.X:=40; Min.Y:=18;
  2070. end;
  2071. procedure TBreakpointsWindow.Close;
  2072. begin
  2073. Hide;
  2074. end;
  2075. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2076. var DontClear : boolean;
  2077. begin
  2078. case Event.What of
  2079. evKeyDown :
  2080. begin
  2081. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2082. begin
  2083. ClearEvent(Event);
  2084. Hide;
  2085. end;
  2086. end;
  2087. evCommand :
  2088. begin
  2089. DontClear:=False;
  2090. case Event.Command of
  2091. cmNewBreakpoint :
  2092. BreakLB^.EditNew;
  2093. cmEditBreakpoint :
  2094. BreakLB^.EditCurrent;
  2095. cmDeleteBreakpoint :
  2096. BreakLB^.DeleteCurrent;
  2097. cmToggleBreakInList :
  2098. BreakLB^.ToggleCurrent;
  2099. cmClose :
  2100. Hide;
  2101. else
  2102. DontClear:=true;
  2103. end;
  2104. if not DontClear then
  2105. ClearEvent(Event);
  2106. end;
  2107. evBroadcast :
  2108. case Event.Command of
  2109. cmUpdate :
  2110. Update;
  2111. end;
  2112. end;
  2113. inherited HandleEvent(Event);
  2114. end;
  2115. procedure TBreakpointsWindow.Update;
  2116. var
  2117. StoreFocus : longint;
  2118. begin
  2119. StoreFocus:=BreakLB^.Focused;
  2120. ClearBreakpoints;
  2121. ReloadBreakpoints;
  2122. If StoreFocus<BreakLB^.Range then
  2123. BreakLB^.FocusItem(StoreFocus);
  2124. end;
  2125. destructor TBreakpointsWindow.Done;
  2126. begin
  2127. inherited Done;
  2128. BreakpointsWindow:=nil;
  2129. end;
  2130. {****************************************************************************
  2131. TBreakpointItemDialog
  2132. ****************************************************************************}
  2133. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2134. var R,R2,R3: TRect;
  2135. Items: PSItem;
  2136. I : BreakpointType;
  2137. KeyCount: sw_integer;
  2138. begin
  2139. KeyCount:=longint(high(BreakpointType));
  2140. R.Assign(0,0,60,Max(9+KeyCount,18));
  2141. inherited Init(R,dialog_modifynewbreakpoint);
  2142. Breakpoint:=ABreakpoint;
  2143. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2144. Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2145. New(NameIL, Init(R, 255)); Insert(NameIL);
  2146. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2147. R.Move(0,3);
  2148. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2149. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2150. R.Move(0,3); R.B.X:=R.A.X+36;
  2151. New(LineIL, Init(R, 128)); Insert(LineIL);
  2152. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2153. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2154. R.Move(0,3);
  2155. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2156. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2157. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2158. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2159. Items:=nil;
  2160. { don't use invalid type }
  2161. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2162. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2163. New(TypeRB, Init(R, Items));
  2164. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2165. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2166. Insert(TypeRB);
  2167. InsertButtons(@Self);
  2168. NameIL^.Select;
  2169. end;
  2170. function TBreakpointItemDialog.Execute: Word;
  2171. var R: word;
  2172. S1: string;
  2173. err: word;
  2174. L: longint;
  2175. begin
  2176. R:=longint(Breakpoint^.typ);
  2177. TypeRB^.SetData(R);
  2178. If Breakpoint^.typ=bt_file_line then
  2179. S1:=GetStr(Breakpoint^.FileName)
  2180. else
  2181. S1:=GetStr(Breakpoint^.name);
  2182. NameIL^.SetData(S1);
  2183. If Breakpoint^.typ=bt_file_line then
  2184. S1:=IntToStr(Breakpoint^.Line)
  2185. else
  2186. S1:='0';
  2187. LineIL^.SetData(S1);
  2188. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2189. IgnoreIL^.SetData(S1);
  2190. S1:=GetStr(Breakpoint^.Conditions);
  2191. ConditionsIL^.SetData(S1);
  2192. R:=inherited Execute;
  2193. if R=cmOK then
  2194. begin
  2195. TypeRB^.GetData(R);
  2196. L:=R;
  2197. Breakpoint^.typ:=BreakpointType(L);
  2198. NameIL^.GetData(S1);
  2199. If Breakpoint^.typ=bt_file_line then
  2200. begin
  2201. If assigned(Breakpoint^.FileName) then
  2202. DisposeStr(Breakpoint^.FileName);
  2203. Breakpoint^.FileName:=NewStr(S1);
  2204. end
  2205. else
  2206. begin
  2207. If assigned(Breakpoint^.Name) then
  2208. DisposeStr(Breakpoint^.Name);
  2209. Breakpoint^.name:=NewStr(S1);
  2210. end;
  2211. If Breakpoint^.typ=bt_file_line then
  2212. begin
  2213. LineIL^.GetData(S1);
  2214. Val(S1,L,err);
  2215. Breakpoint^.Line:=L;
  2216. end;
  2217. IgnoreIL^.GetData(S1);
  2218. Val(S1,L,err);
  2219. Breakpoint^.IgnoreCount:=L;
  2220. ConditionsIL^.GetData(S1);
  2221. If assigned(Breakpoint^.Conditions) then
  2222. DisposeStr(Breakpoint^.Conditions);
  2223. Breakpoint^.Conditions:=NewStr(S1);
  2224. end;
  2225. Execute:=R;
  2226. end;
  2227. {****************************************************************************
  2228. TWatch
  2229. ****************************************************************************}
  2230. constructor TWatch.Init(s : string);
  2231. begin
  2232. expr:=NewStr(s);
  2233. last_value:=nil;
  2234. current_value:=nil;
  2235. Get_new_value;
  2236. GDBRunCount:=-1;
  2237. end;
  2238. constructor TWatch.Load(var S: TStream);
  2239. begin
  2240. expr:=S.ReadStr;
  2241. last_value:=nil;
  2242. current_value:=nil;
  2243. Get_new_value;
  2244. GDBRunCount:=-1;
  2245. end;
  2246. procedure TWatch.Store(var S: TStream);
  2247. begin
  2248. S.WriteStr(expr);
  2249. end;
  2250. procedure TWatch.rename(s : string);
  2251. begin
  2252. if assigned(expr) then
  2253. begin
  2254. if GetStr(expr)=S then
  2255. exit;
  2256. DisposeStr(expr);
  2257. end;
  2258. expr:=NewStr(s);
  2259. if assigned(last_value) then
  2260. StrDispose(last_value);
  2261. last_value:=nil;
  2262. if assigned(current_value) then
  2263. StrDispose(current_value);
  2264. current_value:=nil;
  2265. GDBRunCount:=-1;
  2266. Get_new_value;
  2267. end;
  2268. procedure TWatch.Get_new_value;
  2269. var p, q : pchar;
  2270. i, j, curframe, startframe : longint;
  2271. s,s2 : string;
  2272. loop_higher, found : boolean;
  2273. last_removed : char;
  2274. function GetValue(var s : string) : boolean;
  2275. begin
  2276. Debugger^.command('p '+s);
  2277. if not Debugger^.Error then
  2278. begin
  2279. s:=StrPas(Debugger^.GetOutput);
  2280. GetValue:=true;
  2281. end
  2282. else
  2283. begin
  2284. s:=StrPas(Debugger^.GetError);
  2285. GetValue:=false;
  2286. { do not open a messagebox for such errors }
  2287. Debugger^.got_error:=false;
  2288. end;
  2289. end;
  2290. begin
  2291. If not assigned(Debugger) or Not Debugger^.HasExe or
  2292. (GDBRunCount=Debugger^.RunCount) then
  2293. exit;
  2294. GDBRunCount:=Debugger^.RunCount;
  2295. if assigned(last_value) then
  2296. strdispose(last_value);
  2297. last_value:=current_value;
  2298. s:=GetStr(expr);
  2299. found:=GetValue(s);
  2300. Debugger^.got_error:=false;
  2301. loop_higher:=not found;
  2302. if not found then
  2303. begin
  2304. curframe:=Debugger^.get_current_frame;
  2305. startframe:=curframe;
  2306. end
  2307. else
  2308. begin
  2309. curframe:=0;
  2310. startframe:=0;
  2311. end;
  2312. while loop_higher do
  2313. begin
  2314. s:='parent_ebp';
  2315. if GetValue(s) then
  2316. begin
  2317. repeat
  2318. inc(curframe);
  2319. if not Debugger^.set_current_frame(curframe) then
  2320. loop_higher:=false;
  2321. s2:='/x $ebp';
  2322. getValue(s2);
  2323. j:=pos('=',s2);
  2324. if j>0 then
  2325. s2:=copy(s2,j+1,length(s2));
  2326. while s2[1] in [' ',TAB] do
  2327. delete(s2,1,1);
  2328. if pos(s2,s)>0 then
  2329. loop_higher :=false;
  2330. until not loop_higher;
  2331. { try again at that level }
  2332. s:=GetStr(expr);
  2333. found:=GetValue(s);
  2334. loop_higher:=not found;
  2335. end
  2336. else
  2337. loop_higher:=false;
  2338. end;
  2339. if found then
  2340. p:=StrNew(Debugger^.GetOutput)
  2341. else
  2342. begin
  2343. { get a reasonable output at least }
  2344. s:=GetStr(expr);
  2345. GetValue(s);
  2346. p:=StrNew(Debugger^.GetError);
  2347. end;
  2348. Debugger^.got_error:=false;
  2349. { We should try here to find the expr in parent
  2350. procedure if there are
  2351. I will implement this as I added a
  2352. parent_ebp pseudo local var to local procedure
  2353. in stabs debug info PM }
  2354. { But there are some pitfalls like
  2355. locals redefined in other sublocals that call the function }
  2356. if curframe<>startframe then
  2357. Debugger^.set_current_frame(startframe);
  2358. q:=nil;
  2359. if assigned(p) and (p[0]='$') then
  2360. q:=StrPos(p,'=');
  2361. if not assigned(q) then
  2362. q:=p;
  2363. if assigned(q) then
  2364. i:=strlen(q)
  2365. else
  2366. i:=0;
  2367. if (i>0) and (q[i-1]=#10) then
  2368. begin
  2369. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2370. dec(i);
  2371. last_removed:=q[i-1];
  2372. q[i-1]:=#0;
  2373. end
  2374. else
  2375. last_removed:=#0;
  2376. if assigned(q) then
  2377. current_value:=strnew(q)
  2378. else
  2379. current_value:=strnew('');
  2380. if last_removed<>#0 then
  2381. q[i-1]:=last_removed;
  2382. strdispose(p);
  2383. GDBRunCount:=Debugger^.RunCount;
  2384. end;
  2385. destructor TWatch.Done;
  2386. begin
  2387. if assigned(expr) then
  2388. disposestr(expr);
  2389. if assigned(last_value) then
  2390. strdispose(last_value);
  2391. if assigned(current_value) then
  2392. strdispose(current_value);
  2393. inherited done;
  2394. end;
  2395. {****************************************************************************
  2396. TWatchesCollection
  2397. ****************************************************************************}
  2398. constructor TWatchesCollection.Init;
  2399. begin
  2400. inherited Init(10,10);
  2401. end;
  2402. procedure TWatchesCollection.Insert(Item: Pointer);
  2403. begin
  2404. PWatch(Item)^.Get_new_value;
  2405. Inherited Insert(Item);
  2406. Update;
  2407. end;
  2408. procedure TWatchesCollection.Update;
  2409. var
  2410. W,W1 : integer;
  2411. procedure GetMax(P : PWatch);
  2412. begin
  2413. if assigned(P^.Current_value) then
  2414. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2415. else
  2416. W1:=2+Length(GetStr(P^.expr));
  2417. if W1>W then
  2418. W:=W1;
  2419. end;
  2420. begin
  2421. W:=0;
  2422. ForEach(@GetMax);
  2423. MaxW:=W;
  2424. If assigned(WatchesWindow) then
  2425. WatchesWindow^.WLB^.Update(MaxW);
  2426. end;
  2427. function TWatchesCollection.At(Index: Integer): PWatch;
  2428. begin
  2429. At:=Inherited At(Index);
  2430. end;
  2431. {****************************************************************************
  2432. TWatchesListBox
  2433. ****************************************************************************}
  2434. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2435. begin
  2436. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2437. If assigned(List) then
  2438. dispose(list,done);
  2439. List:=WatchesCollection;
  2440. end;
  2441. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2442. var R : TRect;
  2443. begin
  2444. GetExtent(R);
  2445. MaxWidth:=AMaxWidth;
  2446. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2447. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2448. else
  2449. HScrollBar^.SetRange(0,0);
  2450. if R.B.X-R.A.X>MaxWidth then
  2451. HScrollBar^.Hide
  2452. else
  2453. HScrollBar^.Show;
  2454. SetRange(List^.Count+1);
  2455. if R.B.Y-R.A.Y>Range then
  2456. VScrollBar^.Hide
  2457. else
  2458. VScrollBar^.Show;
  2459. {if Focused=List^.Count-1-1 then
  2460. FocusItem(List^.Count-1);
  2461. What was that for ?? PM }
  2462. DrawView;
  2463. end;
  2464. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2465. var
  2466. PW : PWatch;
  2467. ValOffset : Sw_integer;
  2468. S : String;
  2469. begin
  2470. Modified:=false;
  2471. if Item>=WatchesCollection^.Count then
  2472. begin
  2473. GetIndentedText:='';
  2474. exit;
  2475. end;
  2476. PW:=WatchesCollection^.At(Item);
  2477. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2478. if not assigned(PW^.expr) then
  2479. GetIndentedText:=''
  2480. else if Indent<ValOffset then
  2481. begin
  2482. S:=GetStr(PW^.Expr);
  2483. if Indent=0 then
  2484. S:=' '+S
  2485. else
  2486. S:=Copy(S,Indent,High(S));
  2487. if not assigned(PW^.current_value) then
  2488. S:=S+' <Unknown value>'
  2489. else
  2490. S:=S+' '+GetPChar(PW^.Current_value);
  2491. GetIndentedText:=Copy(S,1,MaxLen);
  2492. end
  2493. else
  2494. begin
  2495. if not assigned(PW^.Current_value) or
  2496. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2497. S:=''
  2498. else
  2499. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2500. GetIndentedText:=Copy(S,1,MaxLen);
  2501. end;
  2502. if assigned(PW^.current_value) and
  2503. assigned(PW^.last_value) and
  2504. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2505. Modified:=true;
  2506. end;
  2507. procedure TWatchesListBox.EditCurrent;
  2508. var
  2509. P: PWatch;
  2510. begin
  2511. if Range=0 then Exit;
  2512. if Focused<WatchesCollection^.Count then
  2513. P:=WatchesCollection^.At(Focused)
  2514. else
  2515. P:=New(PWatch,Init(''));
  2516. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2517. WatchesCollection^.Update;
  2518. end;
  2519. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2520. var
  2521. Dummy_Modified : boolean;
  2522. begin
  2523. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2524. end;
  2525. procedure TWatchesListBox.DeleteCurrent;
  2526. var
  2527. P: PWatch;
  2528. begin
  2529. if (Range=0) or
  2530. (Focused>=WatchesCollection^.Count) then
  2531. exit;
  2532. P:=WatchesCollection^.At(Focused);
  2533. WatchesCollection^.free(P);
  2534. WatchesCollection^.Update;
  2535. end;
  2536. procedure TWatchesListBox.EditNew;
  2537. var
  2538. P: PWatch;
  2539. S : string;
  2540. begin
  2541. if Focused<WatchesCollection^.Count then
  2542. begin
  2543. P:=WatchesCollection^.At(Focused);
  2544. S:=GetStr(P^.expr);
  2545. end
  2546. else
  2547. S:='';
  2548. P:=New(PWatch,Init(S));
  2549. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2550. begin
  2551. WatchesCollection^.AtInsert(Focused,P);
  2552. WatchesCollection^.Update;
  2553. end
  2554. else
  2555. dispose(P,Done);
  2556. end;
  2557. procedure TWatchesListBox.Draw;
  2558. var
  2559. I, J, Item: Sw_Integer;
  2560. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2561. ColWidth, CurCol, Indent: Integer;
  2562. B: TDrawBuffer;
  2563. Modified : boolean;
  2564. Text: String;
  2565. SCOff: Byte;
  2566. TC: byte;
  2567. procedure MT(var C: word);
  2568. begin
  2569. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2570. end;
  2571. begin
  2572. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2573. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2574. begin
  2575. NormalColor := GetColor(1);
  2576. FocusedColor := GetColor(3);
  2577. SelectedColor := GetColor(4);
  2578. end else
  2579. begin
  2580. NormalColor := GetColor(2);
  2581. SelectedColor := GetColor(4);
  2582. end;
  2583. if Transparent then
  2584. begin MT(NormalColor); MT(SelectedColor); end;
  2585. (* if NoSelection then
  2586. SelectedColor:=NormalColor;*)
  2587. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2588. else Indent := 0;
  2589. ColWidth := Size.X div NumCols + 1;
  2590. for I := 0 to Size.Y - 1 do
  2591. begin
  2592. for J := 0 to NumCols-1 do
  2593. begin
  2594. Item := J*Size.Y + I + TopItem;
  2595. CurCol := J*ColWidth;
  2596. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2597. (Focused = Item) and (Range > 0) then
  2598. begin
  2599. Color := FocusedColor;
  2600. SetCursor(CurCol+1,I);
  2601. SCOff := 0;
  2602. end
  2603. else if (Item < Range) and IsSelected(Item) then
  2604. begin
  2605. Color := SelectedColor;
  2606. SCOff := 2;
  2607. end
  2608. else
  2609. begin
  2610. Color := NormalColor;
  2611. SCOff := 4;
  2612. end;
  2613. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2614. if Item < Range then
  2615. begin
  2616. (* Text := GetText(Item, ColWidth + Indent);
  2617. Text := Copy(Text,Indent,ColWidth); *)
  2618. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2619. if modified then
  2620. begin
  2621. SCOff:=0;
  2622. Color:=(Color and $fff0) or Red;
  2623. end;
  2624. MoveStr(B[CurCol], Text, Color);
  2625. if {ShowMarkers or } Modified then
  2626. begin
  2627. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2628. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2629. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2630. end;
  2631. end;
  2632. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2633. end;
  2634. WriteLine(0, I, Size.X, 1, B);
  2635. end;
  2636. end;
  2637. function TWatchesListBox.GetLocalMenu: PMenu;
  2638. var M: PMenu;
  2639. begin
  2640. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2641. M:=NewMenu(
  2642. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2643. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2644. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2645. NewLine(
  2646. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2647. nil))))));
  2648. GetLocalMenu:=M;
  2649. end;
  2650. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2651. var DontClear: boolean;
  2652. begin
  2653. case Event.What of
  2654. evKeyDown :
  2655. begin
  2656. DontClear:=false;
  2657. case Event.KeyCode of
  2658. kbEnter :
  2659. Message(@Self,evCommand,cmEdit,nil);
  2660. kbIns :
  2661. Message(@Self,evCommand,cmNew,nil);
  2662. kbDel :
  2663. Message(@Self,evCommand,cmDelete,nil);
  2664. else
  2665. DontClear:=true;
  2666. end;
  2667. if not DontClear then
  2668. ClearEvent(Event);
  2669. end;
  2670. evBroadcast :
  2671. case Event.Command of
  2672. cmListItemSelected :
  2673. if Event.InfoPtr=@Self then
  2674. Message(@Self,evCommand,cmEdit,nil);
  2675. end;
  2676. evCommand :
  2677. begin
  2678. DontClear:=false;
  2679. case Event.Command of
  2680. cmEdit :
  2681. EditCurrent;
  2682. cmDelete :
  2683. DeleteCurrent;
  2684. cmNew :
  2685. EditNew;
  2686. else
  2687. DontClear:=true;
  2688. end;
  2689. if not DontClear then
  2690. ClearEvent(Event);
  2691. end;
  2692. end;
  2693. inherited HandleEvent(Event);
  2694. end;
  2695. constructor TWatchesListBox.Load(var S: TStream);
  2696. begin
  2697. inherited Load(S);
  2698. If assigned(List) then
  2699. dispose(list,done);
  2700. List:=WatchesCollection;
  2701. { we must set Range PM }
  2702. SetRange(List^.count+1);
  2703. end;
  2704. procedure TWatchesListBox.Store(var S: TStream);
  2705. var OL: PCollection;
  2706. OldRange : Sw_integer;
  2707. begin
  2708. OL:=List;
  2709. OldRange:=Range;
  2710. Range:=0;
  2711. New(List, Init(1,1));
  2712. inherited Store(S);
  2713. Dispose(List, Done);
  2714. List:=OL;
  2715. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2716. collection? Pasting here a modified version of TListBox.Store+
  2717. TAdvancedListBox.Store isn't a better solution, since by eventually
  2718. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2719. SetRange(OldRange);
  2720. end;
  2721. destructor TWatchesListBox.Done;
  2722. begin
  2723. List:=nil;
  2724. inherited Done;
  2725. end;
  2726. {****************************************************************************
  2727. TWatchesWindow
  2728. ****************************************************************************}
  2729. Constructor TWatchesWindow.Init;
  2730. var
  2731. HSB,VSB: PScrollBar;
  2732. R,R2 : trect;
  2733. begin
  2734. Desktop^.GetExtent(R);
  2735. R.A.Y:=R.B.Y-7;
  2736. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  2737. Palette:=wpCyanWindow;
  2738. GetExtent(R);
  2739. HelpCtx:=hcWatchesWindow;
  2740. R.Grow(-1,-1);
  2741. R2.Copy(R);
  2742. Inc(R2.B.Y);
  2743. R2.A.Y:=R2.B.Y-1;
  2744. New(HSB, Init(R2));
  2745. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2746. HSB^.SetStep(R.B.X-R.A.X,1);
  2747. Insert(HSB);
  2748. R2.Copy(R);
  2749. Inc(R2.B.X);
  2750. R2.A.X:=R2.B.X-1;
  2751. New(VSB, Init(R2));
  2752. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2753. Insert(VSB);
  2754. New(WLB,Init(R,HSB,VSB));
  2755. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2756. WLB^.Transparent:=true;
  2757. Insert(WLB);
  2758. If assigned(WatchesWindow) then
  2759. dispose(WatchesWindow,done);
  2760. WatchesWindow:=@Self;
  2761. Update;
  2762. end;
  2763. procedure TWatchesWindow.Update;
  2764. begin
  2765. WatchesCollection^.Update;
  2766. Draw;
  2767. end;
  2768. constructor TWatchesWindow.Load(var S: TStream);
  2769. begin
  2770. inherited Load(S);
  2771. GetSubViewPtr(S,WLB);
  2772. If assigned(WatchesWindow) then
  2773. dispose(WatchesWindow,done);
  2774. WatchesWindow:=@Self;
  2775. end;
  2776. procedure TWatchesWindow.Store(var S: TStream);
  2777. begin
  2778. inherited Store(S);
  2779. PutSubViewPtr(S,WLB);
  2780. end;
  2781. Destructor TWatchesWindow.Done;
  2782. begin
  2783. WatchesWindow:=nil;
  2784. Dispose(WLB,done);
  2785. inherited done;
  2786. end;
  2787. {****************************************************************************
  2788. TWatchItemDialog
  2789. ****************************************************************************}
  2790. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2791. var R,R2: TRect;
  2792. begin
  2793. R.Assign(0,0,50,10);
  2794. inherited Init(R,'Edit Watch');
  2795. Watch:=AWatch;
  2796. GetExtent(R); R.Grow(-3,-2);
  2797. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2798. New(NameIL, Init(R, 255)); Insert(NameIL);
  2799. R2.Copy(R); R2.Move(-1,-1);
  2800. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  2801. GetExtent(R);
  2802. R.Grow(-1,-1);
  2803. R.A.Y:=R.A.Y+3;
  2804. R.B.X:=R.A.X+36;
  2805. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  2806. Insert(TextST);
  2807. InsertButtons(@Self);
  2808. NameIL^.Select;
  2809. end;
  2810. function TWatchItemDialog.Execute: Word;
  2811. var R: word;
  2812. S1,S2: string;
  2813. begin
  2814. S1:=GetStr(Watch^.expr);
  2815. NameIL^.SetData(S1);
  2816. if assigned(Watch^.Current_value) then
  2817. S1:=GetPChar(Watch^.Current_value)
  2818. else
  2819. S1:='';
  2820. if assigned(Watch^.Last_value) then
  2821. S2:=GetPChar(Watch^.Last_value)
  2822. else
  2823. S2:='';
  2824. ClearFormatParams;
  2825. AddFormatParamStr(S1);
  2826. AddFormatParamStr(S2);
  2827. if assigned(Watch^.Last_value) and
  2828. assigned(Watch^.Current_value) and
  2829. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2830. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  2831. else
  2832. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  2833. TextST^.SetText(S1);
  2834. R:=inherited Execute;
  2835. if R=cmOK then
  2836. begin
  2837. NameIL^.GetData(S1);
  2838. Watch^.Rename(S1);
  2839. If assigned(Debugger) then
  2840. Debugger^.ReadWatches;
  2841. end;
  2842. Execute:=R;
  2843. end;
  2844. {****************************************************************************
  2845. TRegistersView
  2846. ****************************************************************************}
  2847. function GetIntRegs(var rs : TIntRegs) : boolean;
  2848. var
  2849. p,po : pchar;
  2850. p1 : pchar;
  2851. reg,value : string;
  2852. buffer : array[0..255] of char;
  2853. v : dword;
  2854. code : word;
  2855. begin
  2856. GetIntRegs:=false;
  2857. {$ifndef NODEBUG}
  2858. Debugger^.Command('info registers');
  2859. if Debugger^.Error then
  2860. exit
  2861. else
  2862. begin
  2863. po:=StrNew(Debugger^.GetOutput);
  2864. p:=po;
  2865. if assigned(p) then
  2866. begin
  2867. fillchar(rs,sizeof(rs),0);
  2868. p1:=strscan(p,' ');
  2869. while assigned(p1) do
  2870. begin
  2871. strlcopy(buffer,p,p1-p);
  2872. reg:=strpas(buffer);
  2873. p:=strscan(p,'$');
  2874. p1:=strscan(p,#9);
  2875. strlcopy(buffer,p,p1-p);
  2876. value:=strpas(buffer);
  2877. val(value,v,code);
  2878. {$ifdef i386}
  2879. if reg='eax' then
  2880. rs.eax:=v
  2881. else if reg='ebx' then
  2882. rs.ebx:=v
  2883. else if reg='ecx' then
  2884. rs.ecx:=v
  2885. else if reg='edx' then
  2886. rs.edx:=v
  2887. else if reg='eip' then
  2888. rs.eip:=v
  2889. else if reg='esi' then
  2890. rs.esi:=v
  2891. else if reg='edi' then
  2892. rs.edi:=v
  2893. else if reg='esp' then
  2894. rs.esp:=v
  2895. else if reg='ebp' then
  2896. rs.ebp:=v
  2897. { under win32 flags are on a register named ps !! PM }
  2898. else if (reg='eflags') or (reg='ps') then
  2899. rs.eflags:=v
  2900. else if reg='cs' then
  2901. rs.cs:=v
  2902. else if reg='ds' then
  2903. rs.ds:=v
  2904. else if reg='es' then
  2905. rs.es:=v
  2906. else if reg='fs' then
  2907. rs.fs:=v
  2908. else if reg='gs' then
  2909. rs.gs:=v
  2910. else if reg='ss' then
  2911. rs.ss:=v;
  2912. {$endif i386}
  2913. {$ifdef m68k}
  2914. if reg='d0' then
  2915. rs.d0:=v
  2916. else if reg='d1' then
  2917. rs.d1:=v
  2918. else if reg='d2' then
  2919. rs.d2:=v
  2920. else if reg='d3' then
  2921. rs.d3:=v
  2922. else if reg='d4' then
  2923. rs.d4:=v
  2924. else if reg='d5' then
  2925. rs.d5:=v
  2926. else if reg='d6' then
  2927. rs.d6:=v
  2928. else if reg='d7' then
  2929. rs.d7:=v
  2930. else if reg='a0' then
  2931. rs.a0:=v
  2932. else if reg='a1' then
  2933. rs.a1:=v
  2934. else if reg='a2' then
  2935. rs.a2:=v
  2936. else if reg='a3' then
  2937. rs.a3:=v
  2938. else if reg='a4' then
  2939. rs.a4:=v
  2940. else if reg='a5' then
  2941. rs.a5:=v
  2942. else if reg='fp' then
  2943. rs.fp:=v
  2944. else if reg='sp' then
  2945. rs.sp:=v
  2946. else if (reg='ps') then
  2947. rs.ps:=v
  2948. else if reg='pc' then
  2949. rs.pc:=v;
  2950. {$endif m68k}
  2951. p:=strscan(p1,#10);
  2952. if assigned(p) then
  2953. begin
  2954. p1:=strscan(p,' ');
  2955. inc(p);
  2956. end
  2957. else
  2958. break;
  2959. end;
  2960. { free allocated memory }
  2961. strdispose(po);
  2962. end
  2963. else
  2964. exit;
  2965. end;
  2966. { do not open a messagebox for such errors }
  2967. Debugger^.got_error:=false;
  2968. GetIntRegs:=true;
  2969. {$endif}
  2970. end;
  2971. constructor TRegistersView.Init(var Bounds: TRect);
  2972. begin
  2973. inherited init(Bounds);
  2974. end;
  2975. procedure TRegistersView.Draw;
  2976. var
  2977. rs : tintregs;
  2978. color :byte;
  2979. procedure SetColor(x,y : longint);
  2980. begin
  2981. if x=y then
  2982. color:=7
  2983. else
  2984. color:=8;
  2985. end;
  2986. begin
  2987. inherited draw;
  2988. If not assigned(Debugger) then
  2989. begin
  2990. WriteStr(1,0,'<no values available>',7);
  2991. exit;
  2992. end;
  2993. if GetIntRegs(rs) then
  2994. begin
  2995. {$ifdef i386}
  2996. SetColor(rs.eax,OldReg.eax);
  2997. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2998. SetColor(rs.ebx,OldReg.ebx);
  2999. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  3000. SetColor(rs.ecx,OldReg.ecx);
  3001. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  3002. SetColor(rs.edx,OldReg.edx);
  3003. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  3004. SetColor(rs.eip,OldReg.eip);
  3005. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  3006. SetColor(rs.esi,OldReg.esi);
  3007. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  3008. SetColor(rs.edi,OldReg.edi);
  3009. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  3010. SetColor(rs.esp,OldReg.esp);
  3011. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  3012. SetColor(rs.ebp,OldReg.ebp);
  3013. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  3014. SetColor(rs.cs,OldReg.cs);
  3015. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  3016. SetColor(rs.ds,OldReg.ds);
  3017. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  3018. SetColor(rs.es,OldReg.es);
  3019. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  3020. SetColor(rs.fs,OldReg.fs);
  3021. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  3022. SetColor(rs.gs,OldReg.gs);
  3023. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  3024. SetColor(rs.ss,OldReg.ss);
  3025. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  3026. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  3027. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  3028. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  3029. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  3030. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  3031. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  3032. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  3033. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  3034. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  3035. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  3036. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  3037. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  3038. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  3039. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  3040. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  3041. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  3042. {$endif i386}
  3043. {$ifdef m68k}
  3044. SetColor(rs.d0,OldReg.d0);
  3045. WriteStr(1,0,'d0 '+HexStr(rs.d0,8),color);
  3046. SetColor(rs.d1,OldReg.d1);
  3047. WriteStr(1,1,'d1 '+HexStr(rs.d1,8),color);
  3048. SetColor(rs.d2,OldReg.d2);
  3049. WriteStr(1,2,'d2 '+HexStr(rs.d2,8),color);
  3050. SetColor(rs.d3,OldReg.d3);
  3051. WriteStr(1,3,'d3 '+HexStr(rs.d3,8),color);
  3052. SetColor(rs.d4,OldReg.d4);
  3053. WriteStr(1,4,'d4 '+HexStr(rs.d4,8),color);
  3054. SetColor(rs.d5,OldReg.d5);
  3055. WriteStr(1,5,'d5 '+HexStr(rs.d5,8),color);
  3056. SetColor(rs.d6,OldReg.d6);
  3057. WriteStr(1,6,'d6 '+HexStr(rs.d6,8),color);
  3058. SetColor(rs.d7,OldReg.d7);
  3059. WriteStr(1,7,'d7 '+HexStr(rs.d7,8),color);
  3060. SetColor(rs.a0,OldReg.a0);
  3061. WriteStr(14,0,'a0 '+HexStr(rs.a0,8),color);
  3062. SetColor(rs.a1,OldReg.a1);
  3063. WriteStr(14,1,'a1 '+HexStr(rs.a1,8),color);
  3064. SetColor(rs.a2,OldReg.a2);
  3065. WriteStr(14,2,'a2 '+HexStr(rs.a2,8),color);
  3066. SetColor(rs.a3,OldReg.a3);
  3067. WriteStr(14,3,'a3 '+HexStr(rs.a3,8),color);
  3068. SetColor(rs.a4,OldReg.a4);
  3069. WriteStr(14,4,'a4 '+HexStr(rs.a4,8),color);
  3070. SetColor(rs.a5,OldReg.a5);
  3071. WriteStr(14,5,'a5 '+HexStr(rs.a5,8),color);
  3072. SetColor(rs.fp,OldReg.fp);
  3073. WriteStr(14,6,'fp '+HexStr(rs.fp,8),color);
  3074. SetColor(rs.sp,OldReg.sp);
  3075. WriteStr(14,7,'sp '+HexStr(rs.sp,8),color);
  3076. SetColor(rs.pc,OldReg.pc);
  3077. WriteStr(1,8,'pc '+HexStr(rs.pc,8),color);
  3078. SetColor(rs.ps and $1,OldReg.ps and $1);
  3079. WriteStr(20,8,'c'+chr(byte((rs.ps and $1)<>0)+48),color);
  3080. SetColor(rs.ps and $2,OldReg.ps and $2);
  3081. WriteStr(18,8,'v'+chr(byte((rs.ps and $2)<>0)+48),color);
  3082. SetColor(rs.ps and $4,OldReg.ps and $4);
  3083. WriteStr(16,8,'z'+chr(byte((rs.ps and $4)<>0)+48),color);
  3084. SetColor(rs.ps and $8,OldReg.ps and $8);
  3085. WriteStr(14,8,'x'+chr(byte((rs.ps and $8)<>0)+48),color);
  3086. {$endif i386}
  3087. OldReg:=rs;
  3088. end
  3089. else
  3090. WriteStr(0,0,'<debugger error>',7);
  3091. end;
  3092. destructor TRegistersView.Done;
  3093. begin
  3094. inherited done;
  3095. end;
  3096. {****************************************************************************
  3097. TRegistersWindow
  3098. ****************************************************************************}
  3099. constructor TRegistersWindow.Init;
  3100. var
  3101. R : TRect;
  3102. begin
  3103. Desktop^.GetExtent(R);
  3104. R.A.X:=R.B.X-28;
  3105. R.B.Y:=R.A.Y+11;
  3106. inherited Init(R,dialog_registers, wnNoNumber);
  3107. Flags:=wfClose or wfMove;
  3108. Palette:=wpCyanWindow;
  3109. HelpCtx:=hcRegistersWindow;
  3110. R.Assign(1,1,26,10);
  3111. RV:=new(PRegistersView,init(R));
  3112. Insert(RV);
  3113. If assigned(RegistersWindow) then
  3114. dispose(RegistersWindow,done);
  3115. RegistersWindow:=@Self;
  3116. Update;
  3117. end;
  3118. constructor TRegistersWindow.Load(var S: TStream);
  3119. begin
  3120. inherited load(S);
  3121. GetSubViewPtr(S,RV);
  3122. If assigned(RegistersWindow) then
  3123. dispose(RegistersWindow,done);
  3124. RegistersWindow:=@Self;
  3125. end;
  3126. procedure TRegistersWindow.Store(var S: TStream);
  3127. begin
  3128. inherited Store(s);
  3129. PutSubViewPtr(S,RV);
  3130. end;
  3131. procedure TRegistersWindow.Update;
  3132. begin
  3133. ReDraw;
  3134. end;
  3135. destructor TRegistersWindow.Done;
  3136. begin
  3137. RegistersWindow:=nil;
  3138. inherited done;
  3139. end;
  3140. {****************************************************************************
  3141. TFPUView
  3142. ****************************************************************************}
  3143. function GetFPURegs(var rs : TFPURegs) : boolean;
  3144. var
  3145. p,po : pchar;
  3146. p1 : pchar;
  3147. {$ifndef NODEBUG}
  3148. reg,value : string;
  3149. buffer : array[0..255] of char;
  3150. v : string;
  3151. res : cardinal;
  3152. i : longint;
  3153. err : word;
  3154. {$endif}
  3155. begin
  3156. GetFPURegs:=false;
  3157. {$ifndef NODEBUG}
  3158. Debugger^.Command('info all');
  3159. if Debugger^.Error then
  3160. exit
  3161. else
  3162. begin
  3163. po:=StrNew(Debugger^.GetOutput);
  3164. p:=po;
  3165. if assigned(p) then
  3166. begin
  3167. fillchar(rs,sizeof(rs),0);
  3168. p1:=strscan(p,' ');
  3169. while assigned(p1) do
  3170. begin
  3171. strlcopy(buffer,p,p1-p);
  3172. reg:=strpas(buffer);
  3173. p:=p1;
  3174. while p^=' ' do
  3175. inc(p);
  3176. if p^='$' then
  3177. p1:=strscan(p,#9)
  3178. else
  3179. p1:=strscan(p,#10);
  3180. strlcopy(buffer,p,p1-p);
  3181. v:=strpas(buffer);
  3182. for i:=1 to length(v) do
  3183. if v[i]=#9 then
  3184. v[i]:=' ';
  3185. val(v,res,err);
  3186. {$ifdef i386}
  3187. if reg='st0' then
  3188. rs.st0:=v
  3189. else if reg='st1' then
  3190. rs.st1:=v
  3191. else if reg='st2' then
  3192. rs.st2:=v
  3193. else if reg='st3' then
  3194. rs.st3:=v
  3195. else if reg='st4' then
  3196. rs.st4:=v
  3197. else if reg='st5' then
  3198. rs.st5:=v
  3199. else if reg='st6' then
  3200. rs.st6:=v
  3201. else if reg='st7' then
  3202. rs.st7:=v
  3203. else if reg='ftag' then
  3204. rs.ftag:=res
  3205. else if reg='fctrl' then
  3206. rs.fctrl:=res
  3207. else if reg='fstat' then
  3208. rs.fstat:=res
  3209. else if reg='fiseg' then
  3210. rs.fiseg:=res
  3211. else if reg='fioff' then
  3212. rs.fioff:=res
  3213. else if reg='foseg' then
  3214. rs.foseg:=res
  3215. else if reg='fooff' then
  3216. rs.fooff:=res
  3217. else if reg='fop' then
  3218. rs.fop:=res;
  3219. {$endif i386}
  3220. {$ifdef m68k}
  3221. if reg='fp0' then
  3222. rs.fp0:=v
  3223. else if reg='fp1' then
  3224. rs.fp1:=v
  3225. else if reg='fp2' then
  3226. rs.fp2:=v
  3227. else if reg='fp3' then
  3228. rs.fp3:=v
  3229. else if reg='fp4' then
  3230. rs.fp4:=v
  3231. else if reg='fp5' then
  3232. rs.fp5:=v
  3233. else if reg='fp6' then
  3234. rs.fp6:=v
  3235. else if reg='fp7' then
  3236. rs.fp7:=v
  3237. else if reg='fpcontrol' then
  3238. rs.fpcontrol:=res
  3239. else if reg='fpstatus' then
  3240. rs.fpstatus:=res
  3241. else if reg='fpiaddr' then
  3242. rs.fpiaddr:=res;
  3243. {$endif m68k}
  3244. p:=strscan(p1,#10);
  3245. if assigned(p) then
  3246. begin
  3247. p1:=strscan(p,' ');
  3248. inc(p);
  3249. end
  3250. else
  3251. break;
  3252. end;
  3253. { free allocated memory }
  3254. strdispose(po);
  3255. end
  3256. else
  3257. exit;
  3258. end;
  3259. { do not open a messagebox for such errors }
  3260. Debugger^.got_error:=false;
  3261. GetFPURegs:=true;
  3262. {$endif}
  3263. end;
  3264. constructor TFPUView.Init(var Bounds: TRect);
  3265. begin
  3266. inherited init(Bounds);
  3267. end;
  3268. procedure TFPUView.Draw;
  3269. var
  3270. rs : tfpuregs;
  3271. top : byte;
  3272. color :byte;
  3273. const
  3274. TypeStr : Array[0..3] of string[6] =
  3275. ('Valid ','Zero ','Spec ','Empty ');
  3276. procedure SetColor(Const x,y : string);
  3277. begin
  3278. if x=y then
  3279. color:=7
  3280. else
  3281. color:=8;
  3282. end;
  3283. procedure SetIColor(Const x,y : cardinal);
  3284. begin
  3285. if x=y then
  3286. color:=7
  3287. else
  3288. color:=8;
  3289. end;
  3290. begin
  3291. inherited draw;
  3292. If not assigned(Debugger) then
  3293. begin
  3294. WriteStr(1,0,'<no values available>',7);
  3295. exit;
  3296. end;
  3297. if GetFPURegs(rs) then
  3298. begin
  3299. {$ifdef i386}
  3300. top:=(rs.fstat shr 11) and 7;
  3301. SetColor(rs.st0,OldReg.st0);
  3302. WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
  3303. SetColor(rs.st1,OldReg.st1);
  3304. WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
  3305. SetColor(rs.st2,OldReg.st2);
  3306. WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
  3307. SetColor(rs.st3,OldReg.st3);
  3308. WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
  3309. SetColor(rs.st4,OldReg.st4);
  3310. WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
  3311. SetColor(rs.st5,OldReg.st5);
  3312. WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
  3313. SetColor(rs.st6,OldReg.st6);
  3314. WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
  3315. SetColor(rs.st7,OldReg.st7);
  3316. WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
  3317. SetIColor(rs.ftag,OldReg.ftag);
  3318. WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
  3319. SetIColor(rs.fctrl,OldReg.fctrl);
  3320. WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
  3321. SetIColor(rs.fstat,OldReg.fstat);
  3322. WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
  3323. SetIColor(rs.fop,OldReg.fop);
  3324. WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
  3325. if (rs.fiseg<>OldReg.fiseg) or
  3326. (rs.fioff<>OldReg.fioff) then
  3327. color:=8
  3328. else
  3329. color:=7;
  3330. WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
  3331. if (rs.foseg<>OldReg.foseg) or
  3332. (rs.fooff<>OldReg.fooff) then
  3333. color:=8
  3334. else
  3335. color:=7;
  3336. WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
  3337. OldReg:=rs;
  3338. {$endif i386}
  3339. {$ifdef m68k}
  3340. SetColor(rs.fp0,OldReg.fp0);
  3341. WriteStr(1,0,'fp0 '+rs.fp0,color);
  3342. SetColor(rs.fp1,OldReg.fp1);
  3343. WriteStr(1,1,'fp1 '+rs.fp1,color);
  3344. SetColor(rs.fp2,OldReg.fp2);
  3345. WriteStr(1,2,'fp2 '+rs.fp2,color);
  3346. SetColor(rs.fp3,OldReg.fp3);
  3347. WriteStr(1,3,'fp3 '+rs.fp3,color);
  3348. SetColor(rs.fp4,OldReg.fp4);
  3349. WriteStr(1,4,'fp4 '+rs.fp4,color);
  3350. SetColor(rs.fp5,OldReg.fp5);
  3351. WriteStr(1,5,'fp5 '+rs.fp5,color);
  3352. SetColor(rs.fp6,OldReg.fp6);
  3353. WriteStr(1,6,'fp6 '+rs.fp6,color);
  3354. SetColor(rs.fp7,OldReg.fp7);
  3355. WriteStr(1,7,'fp7 '+rs.fp7,color);
  3356. SetIColor(rs.fpcontrol,OldReg.fpcontrol);
  3357. WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
  3358. SetIColor(rs.fpstatus,OldReg.fpstatus);
  3359. WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
  3360. SetIColor(rs.fpiaddr,OldReg.fpiaddr);
  3361. WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
  3362. OldReg:=rs;
  3363. {$endif m68k}
  3364. end
  3365. else
  3366. WriteStr(0,0,'<debugger error>',7);
  3367. end;
  3368. destructor TFPUView.Done;
  3369. begin
  3370. inherited done;
  3371. end;
  3372. {****************************************************************************
  3373. TFPUWindow
  3374. ****************************************************************************}
  3375. constructor TFPUWindow.Init;
  3376. var
  3377. R : TRect;
  3378. begin
  3379. Desktop^.GetExtent(R);
  3380. R.A.X:=R.B.X-44;
  3381. R.B.Y:=R.A.Y+14;
  3382. inherited Init(R,dialog_fpu, wnNoNumber);
  3383. Flags:=wfClose or wfMove;
  3384. Palette:=wpCyanWindow;
  3385. HelpCtx:=hcFPURegisters;
  3386. R.Assign(1,1,42,13);
  3387. RV:=new(PFPUView,init(R));
  3388. Insert(RV);
  3389. If assigned(FPUWindow) then
  3390. dispose(FPUWindow,done);
  3391. FPUWindow:=@Self;
  3392. Update;
  3393. end;
  3394. constructor TFPUWindow.Load(var S: TStream);
  3395. begin
  3396. inherited load(S);
  3397. GetSubViewPtr(S,RV);
  3398. If assigned(FPUWindow) then
  3399. dispose(FPUWindow,done);
  3400. FPUWindow:=@Self;
  3401. end;
  3402. procedure TFPUWindow.Store(var S: TStream);
  3403. begin
  3404. inherited Store(s);
  3405. PutSubViewPtr(S,RV);
  3406. end;
  3407. procedure TFPUWindow.Update;
  3408. begin
  3409. ReDraw;
  3410. end;
  3411. destructor TFPUWindow.Done;
  3412. begin
  3413. FPUWindow:=nil;
  3414. inherited done;
  3415. end;
  3416. {****************************************************************************
  3417. TStackWindow
  3418. ****************************************************************************}
  3419. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3420. begin
  3421. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3422. end;
  3423. procedure TFramesListBox.Update;
  3424. var i : longint;
  3425. W : PSourceWindow;
  3426. begin
  3427. { call backtrace command }
  3428. If not assigned(Debugger) then
  3429. exit;
  3430. {$ifndef NODEBUG}
  3431. DeskTop^.Lock;
  3432. Clear;
  3433. { forget all old frames }
  3434. Debugger^.clear_frames;
  3435. if Debugger^.WindowWidth<>-1 then
  3436. Debugger^.Command('set width 0xffffffff');
  3437. Debugger^.Command('backtrace');
  3438. { generate list }
  3439. { all is in tframeentry }
  3440. for i:=0 to Debugger^.frame_count-1 do
  3441. begin
  3442. with Debugger^.frames[i]^ do
  3443. begin
  3444. if assigned(file_name) then
  3445. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3446. AddModuleName(GetPChar(file_name)),line_number,1)))
  3447. else
  3448. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3449. AddModuleName(''),line_number,1)));
  3450. W:=SearchOnDesktop(GetPChar(file_name),false);
  3451. { First reset all Debugger rows }
  3452. If assigned(W) then
  3453. begin
  3454. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3455. W^.Editor^.DebuggerRow:=-1;
  3456. end;
  3457. end;
  3458. end;
  3459. { Now set all Debugger rows }
  3460. for i:=0 to Debugger^.frame_count-1 do
  3461. begin
  3462. with Debugger^.frames[i]^ do
  3463. begin
  3464. W:=SearchOnDesktop(GetPChar(file_name),false);
  3465. If assigned(W) then
  3466. begin
  3467. If W^.Editor^.DebuggerRow=-1 then
  3468. begin
  3469. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3470. W^.Editor^.DebuggerRow:=line_number-1;
  3471. end;
  3472. end;
  3473. end;
  3474. end;
  3475. if Assigned(list) and (List^.Count > 0) then
  3476. FocusItem(0);
  3477. if Debugger^.WindowWidth<>-1 then
  3478. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3479. DeskTop^.Unlock;
  3480. {$endif}
  3481. end;
  3482. function TFramesListBox.GetLocalMenu: PMenu;
  3483. begin
  3484. GetLocalMenu:=Inherited GetLocalMenu;
  3485. end;
  3486. procedure TFramesListBox.GotoSource;
  3487. begin
  3488. { select frame for watches }
  3489. If not assigned(Debugger) then
  3490. exit;
  3491. {$ifndef NODEBUG}
  3492. Debugger^.Command('f '+IntToStr(Focused));
  3493. { for local vars }
  3494. Debugger^.ReadWatches;
  3495. {$endif}
  3496. { goto source }
  3497. inherited GotoSource;
  3498. end;
  3499. procedure TFramesListBox.GotoAssembly;
  3500. begin
  3501. { select frame for watches }
  3502. If not assigned(Debugger) then
  3503. exit;
  3504. {$ifndef NODEBUG}
  3505. Debugger^.Command('f '+IntToStr(Focused));
  3506. { for local vars }
  3507. Debugger^.ReadWatches;
  3508. {$endif}
  3509. { goto source/assembly mixture }
  3510. InitDisassemblyWindow;
  3511. DisassemblyWindow^.LoadFunction('');
  3512. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3513. DisassemblyWindow^.SelectInDebugSession;
  3514. end;
  3515. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3516. begin
  3517. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3518. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3519. GotoAssembly;
  3520. inherited HandleEvent(Event);
  3521. end;
  3522. destructor TFramesListBox.Done;
  3523. begin
  3524. Inherited Done;
  3525. end;
  3526. Constructor TStackWindow.Init;
  3527. var
  3528. HSB,VSB: PScrollBar;
  3529. R,R2 : trect;
  3530. begin
  3531. Desktop^.GetExtent(R);
  3532. R.A.Y:=R.B.Y-5;
  3533. inherited Init(R, dialog_callstack, wnNoNumber);
  3534. Palette:=wpCyanWindow;
  3535. GetExtent(R);
  3536. HelpCtx:=hcStackWindow;
  3537. R.Grow(-1,-1);
  3538. R2.Copy(R);
  3539. Inc(R2.B.Y);
  3540. R2.A.Y:=R2.B.Y-1;
  3541. New(HSB, Init(R2));
  3542. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3543. Insert(HSB);
  3544. R2.Copy(R);
  3545. Inc(R2.B.X);
  3546. R2.A.X:=R2.B.X-1;
  3547. New(VSB, Init(R2));
  3548. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3549. Insert(VSB);
  3550. New(FLB,Init(R,HSB,VSB));
  3551. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3552. Insert(FLB);
  3553. If assigned(StackWindow) then
  3554. dispose(StackWindow,done);
  3555. StackWindow:=@Self;
  3556. Update;
  3557. end;
  3558. procedure TStackWindow.Update;
  3559. begin
  3560. FLB^.Update;
  3561. DrawView;
  3562. end;
  3563. constructor TStackWindow.Load(var S: TStream);
  3564. begin
  3565. inherited Load(S);
  3566. GetSubViewPtr(S,FLB);
  3567. If assigned(StackWindow) then
  3568. dispose(StackWindow,done);
  3569. StackWindow:=@Self;
  3570. end;
  3571. procedure TStackWindow.Store(var S: TStream);
  3572. begin
  3573. inherited Store(S);
  3574. PutSubViewPtr(S,FLB);
  3575. end;
  3576. Destructor TStackWindow.Done;
  3577. begin
  3578. StackWindow:=nil;
  3579. Dispose(FLB,done);
  3580. inherited done;
  3581. end;
  3582. {****************************************************************************
  3583. Init/Final
  3584. ****************************************************************************}
  3585. procedure InitDebugger;
  3586. {$ifdef DEBUG}
  3587. var s : string;
  3588. i,p : longint;
  3589. {$endif DEBUG}
  3590. var
  3591. NeedRecompileExe : boolean;
  3592. cm : longint;
  3593. begin
  3594. {$ifdef DEBUG}
  3595. if not use_gdb_file then
  3596. begin
  3597. Assign(gdb_file,GDBOutFileName);
  3598. {$I-}
  3599. Rewrite(gdb_file);
  3600. if InOutRes<>0 then
  3601. begin
  3602. s:=GDBOutFileName;
  3603. p:=pos('.',s);
  3604. if p>1 then
  3605. for i:=0 to 9 do
  3606. begin
  3607. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3608. InOutRes:=0;
  3609. Assign(gdb_file,s);
  3610. rewrite(gdb_file);
  3611. if InOutRes=0 then
  3612. break;
  3613. end;
  3614. end;
  3615. if IOResult=0 then
  3616. Use_gdb_file:=true;
  3617. end;
  3618. {$I+}
  3619. {$endif}
  3620. NeedRecompileExe:=false;
  3621. if TargetSwitches^.GetCurrSelParam<>{$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname then
  3622. begin
  3623. ClearFormatParams;
  3624. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3625. AddFormatParamStr({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3626. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3627. if cm=cmCancel then
  3628. Exit;
  3629. if cm=cmYes then
  3630. begin
  3631. { force recompilation }
  3632. PrevMainFile:='';
  3633. NeedRecompileExe:=true;
  3634. TargetSwitches^.SetCurrSelParam({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3635. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3636. DebugInfoSwitches^.SetCurrSelParam('l');
  3637. IDEApp.UpdateTarget;
  3638. end;
  3639. end;
  3640. if not NeedRecompileExe then
  3641. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3642. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3643. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3644. begin
  3645. ClearFormatParams;
  3646. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3647. if cm=cmCancel then
  3648. Exit;
  3649. if cm=cmYes then
  3650. begin
  3651. { force recompilation }
  3652. PrevMainFile:='';
  3653. NeedRecompileExe:=true;
  3654. DebugInfoSwitches^.SetCurrSelParam('l');
  3655. end;
  3656. end;
  3657. if NeedRecompileExe then
  3658. DoCompile(cRun);
  3659. if CompilationPhase<>cpDone then
  3660. Exit;
  3661. if (EXEFile='') then
  3662. begin
  3663. ErrorBox(msg_nothingtodebug,nil);
  3664. Exit;
  3665. end;
  3666. { init debugcontroller }
  3667. if not assigned(Debugger) then
  3668. begin
  3669. PushStatus(msg_startingdebugger);
  3670. new(Debugger,Init);
  3671. PopStatus;
  3672. end;
  3673. Debugger^.SetExe(ExeFile);
  3674. {$ifdef GDBWINDOW}
  3675. InitGDBWindow;
  3676. {$endif def GDBWINDOW}
  3677. end;
  3678. procedure DoneDebugger;
  3679. begin
  3680. {$ifdef DEBUG}
  3681. If IDEApp.IsRunning then
  3682. PushStatus('Closing debugger');
  3683. {$endif}
  3684. if assigned(Debugger) then
  3685. dispose(Debugger,Done);
  3686. Debugger:=nil;
  3687. {$ifdef DEBUG}
  3688. If Use_gdb_file then
  3689. begin
  3690. Use_gdb_file:=false;
  3691. Close(GDB_file);
  3692. end;
  3693. If IDEApp.IsRunning then
  3694. PopStatus;
  3695. {$endif DEBUG}
  3696. end;
  3697. procedure InitGDBWindow;
  3698. var
  3699. R : TRect;
  3700. begin
  3701. if GDBWindow=nil then
  3702. begin
  3703. DeskTop^.GetExtent(R);
  3704. new(GDBWindow,init(R));
  3705. DeskTop^.Insert(GDBWindow);
  3706. end;
  3707. end;
  3708. procedure DoneGDBWindow;
  3709. begin
  3710. If IDEApp.IsRunning and
  3711. assigned(GDBWindow) then
  3712. begin
  3713. DeskTop^.Delete(GDBWindow);
  3714. end;
  3715. GDBWindow:=nil;
  3716. end;
  3717. procedure InitDisassemblyWindow;
  3718. var
  3719. R : TRect;
  3720. begin
  3721. if DisassemblyWindow=nil then
  3722. begin
  3723. DeskTop^.GetExtent(R);
  3724. new(DisassemblyWindow,init(R));
  3725. DeskTop^.Insert(DisassemblyWindow);
  3726. end;
  3727. end;
  3728. procedure DoneDisassemblyWindow;
  3729. begin
  3730. if assigned(DisassemblyWindow) then
  3731. begin
  3732. DeskTop^.Delete(DisassemblyWindow);
  3733. Dispose(DisassemblyWindow,Done);
  3734. DisassemblyWindow:=nil;
  3735. end;
  3736. end;
  3737. procedure InitStackWindow;
  3738. begin
  3739. if StackWindow=nil then
  3740. begin
  3741. new(StackWindow,init);
  3742. DeskTop^.Insert(StackWindow);
  3743. end;
  3744. end;
  3745. procedure DoneStackWindow;
  3746. begin
  3747. if assigned(StackWindow) then
  3748. begin
  3749. DeskTop^.Delete(StackWindow);
  3750. StackWindow:=nil;
  3751. end;
  3752. end;
  3753. procedure InitRegistersWindow;
  3754. begin
  3755. if RegistersWindow=nil then
  3756. begin
  3757. new(RegistersWindow,init);
  3758. DeskTop^.Insert(RegistersWindow);
  3759. end;
  3760. end;
  3761. procedure DoneRegistersWindow;
  3762. begin
  3763. if assigned(RegistersWindow) then
  3764. begin
  3765. DeskTop^.Delete(RegistersWindow);
  3766. RegistersWindow:=nil;
  3767. end;
  3768. end;
  3769. procedure InitFPUWindow;
  3770. begin
  3771. if FPUWindow=nil then
  3772. begin
  3773. new(FPUWindow,init);
  3774. DeskTop^.Insert(FPUWindow);
  3775. end;
  3776. end;
  3777. procedure DoneFPUWindow;
  3778. begin
  3779. if assigned(FPUWindow) then
  3780. begin
  3781. DeskTop^.Delete(FPUWindow);
  3782. FPUWindow:=nil;
  3783. end;
  3784. end;
  3785. procedure InitBreakpoints;
  3786. begin
  3787. New(BreakpointsCollection,init(10,10));
  3788. end;
  3789. procedure DoneBreakpoints;
  3790. begin
  3791. Dispose(BreakpointsCollection,Done);
  3792. BreakpointsCollection:=nil;
  3793. end;
  3794. procedure InitWatches;
  3795. begin
  3796. New(WatchesCollection,init);
  3797. end;
  3798. procedure DoneWatches;
  3799. begin
  3800. Dispose(WatchesCollection,Done);
  3801. WatchesCollection:=nil;
  3802. end;
  3803. procedure RegisterFPDebugViews;
  3804. begin
  3805. RegisterType(RWatchesWindow);
  3806. RegisterType(RBreakpointsWindow);
  3807. RegisterType(RWatchesListBox);
  3808. RegisterType(RBreakpointsListBox);
  3809. RegisterType(RStackWindow);
  3810. RegisterType(RFramesListBox);
  3811. RegisterType(RBreakpoint);
  3812. RegisterType(RWatch);
  3813. RegisterType(RBreakpointCollection);
  3814. RegisterType(RWatchesCollection);
  3815. RegisterType(RRegistersWindow);
  3816. RegisterType(RRegistersView);
  3817. RegisterType(RFPUWindow);
  3818. RegisterType(RFPUView);
  3819. end;
  3820. end.
  3821. {
  3822. $Log$
  3823. Revision 1.24 2002-09-02 10:18:09 pierre
  3824. * fix problems with breakpoint lists
  3825. Revision 1.23 2002/08/13 08:59:12 pierre
  3826. + Run menu changes depending on wether the debuggee is running or not
  3827. Revision 1.22 2002/08/13 07:15:02 pierre
  3828. + Disable all invalid breakpoints feature added
  3829. Revision 1.21 2002/06/10 19:26:48 pierre
  3830. * check if DebuggeTTY is a valid terminal
  3831. Revision 1.20 2002/06/06 14:11:25 pierre
  3832. * handle win32 Ctrl-C change for graphic version
  3833. Revision 1.19 2002/06/06 08:16:18 pierre
  3834. * avoid crashes if quitting while debuggee is running
  3835. Revision 1.18 2002/04/25 13:33:31 pierre
  3836. * fix the problem with dirs containing asterisks
  3837. Revision 1.17 2002/04/17 11:11:54 pierre
  3838. * avoid problems for ClassVariable in Watches window
  3839. Revision 1.16 2002/04/11 06:41:13 pierre
  3840. * fix problem of TWatchesListBox with fvision
  3841. Revision 1.15 2002/04/03 06:18:30 pierre
  3842. * fix some win32 GDB filename problems
  3843. Revision 1.14 2002/04/02 15:09:38 pierre
  3844. * fixed wrong exit without unlock
  3845. Revision 1.13 2002/04/02 13:23:54 pierre
  3846. * Use StrToCard and HexToCard functions to avoid signed/unsigned overflows
  3847. Revision 1.12 2002/04/02 12:20:58 pierre
  3848. * fix problem with breakpoints in subdirs
  3849. Revision 1.11 2002/04/02 11:10:29 pierre
  3850. * fix FPC_BREAK_ERROR problem and avoid blinking J
  3851. Revision 1.10 2002/03/27 11:24:09 pierre
  3852. * fix several problems related to long file nmze support for win32 exes
  3853. Revision 1.9 2002/02/06 14:45:00 pierre
  3854. + handle signals
  3855. Revision 1.8 2001/11/10 00:11:45 pierre
  3856. * change target menu name if target changed to become debug-able
  3857. Revision 1.7 2001/11/07 00:28:52 pierre
  3858. + Disassembly window made public
  3859. Revision 1.6 2001/10/14 14:16:06 peter
  3860. * fixed typo for linux
  3861. Revision 1.5 2001/10/11 11:39:35 pierre
  3862. * better NoSwitch check for unix
  3863. Revision 1.4 2001/09/12 09:48:38 pierre
  3864. + SetDirectories method added to help for disassembly window
  3865. Revision 1.3 2001/08/07 22:58:10 pierre
  3866. * watches display enhanced and crashes removed
  3867. Revision 1.2 2001/08/05 02:01:47 peter
  3868. * FVISION define to compile with fvision units
  3869. Revision 1.1 2001/08/04 11:30:23 peter
  3870. * ide works now with both compiler versions
  3871. Revision 1.1.2.35 2001/08/03 13:33:51 pierre
  3872. * better looking m68k flags
  3873. Revision 1.1.2.34 2001/07/31 21:40:42 pierre
  3874. * fix typo erros in last commit
  3875. Revision 1.1.2.33 2001/07/31 15:12:45 pierre
  3876. + some m68k register support
  3877. Revision 1.1.2.32 2001/07/29 22:12:23 peter
  3878. * fixed private symbol that needs to be public
  3879. Revision 1.1.2.31 2001/06/13 16:22:02 pierre
  3880. * use CygdrivePrefix function for win32
  3881. Revision 1.1.2.30 2001/04/10 11:50:09 pierre
  3882. * only stop if erroraddress or exitcode non zero
  3883. + reset the file in DoneDebugger to avoid problem
  3884. if the executable file remains opened by GDB when recompiling
  3885. Revision 1.1.2.29 2001/03/22 17:28:57 pierre
  3886. * more stuff for stop at exit if error
  3887. Revision 1.1.2.28 2001/03/22 01:14:08 pierre
  3888. * work on Exit breakpoint if error
  3889. Revision 1.1.2.27 2001/03/20 00:20:42 pierre
  3890. * fix some memory leaks + several small enhancements
  3891. Revision 1.1.2.26 2001/03/15 17:45:19 pierre
  3892. * avoid to get the values of expressions twice
  3893. Revision 1.1.2.25 2001/03/15 17:08:52 pierre
  3894. * avoid extra info past watches values
  3895. Revision 1.1.2.24 2001/03/13 00:36:44 pierre
  3896. * small DisassemblyWindow fixes
  3897. Revision 1.1.2.23 2001/03/12 17:34:54 pierre
  3898. + Disassembly window started
  3899. Revision 1.1.2.22 2001/03/09 15:08:12 pierre
  3900. * Watches list reorganised so that the behavior
  3901. is more near to BP one.
  3902. + First version of FPU window for i386.
  3903. Revision 1.1.2.21 2001/03/08 16:41:03 pierre
  3904. * correct watch horizontal scrolling
  3905. Revision 1.1.2.20 2001/03/06 22:42:22 pierre
  3906. * check for modifed open files at stop of beguggee
  3907. Revision 1.1.2.19 2001/03/06 21:44:13 pierre
  3908. * avoid problems if recompiling in debug session
  3909. Revision 1.1.2.18 2001/01/09 11:49:30 pierre
  3910. * fix DebugRow highlighting problem if Call Stack Window is open
  3911. Revision 1.1.2.17 2001/01/07 22:37:41 peter
  3912. * quiting gdbwindow works now
  3913. Revision 1.1.2.16 2000/12/13 16:58:11 pierre
  3914. * AllowQuit changed, still does not work correctly :(
  3915. Revision 1.1.2.15 2000/11/29 18:28:51 pierre
  3916. + add save to file capability for list boxes
  3917. Revision 1.1.2.14 2000/11/29 11:25:59 pierre
  3918. + TFPDlgWindow that handles cmSearchWindow
  3919. Revision 1.1.2.13 2000/11/29 00:54:44 pierre
  3920. + preserve window number and save special windows
  3921. Revision 1.1.2.12 2000/11/27 17:41:45 pierre
  3922. * better GDB window opening if nothing compiled yet
  3923. Revision 1.1.2.11 2000/11/16 23:06:30 pierre
  3924. * correct handling of Compile/Make if primary file is set
  3925. Revision 1.1.2.10 2000/11/14 17:40:42 pierre
  3926. + External linking now optional
  3927. Revision 1.1.2.9 2000/11/14 09:23:55 marco
  3928. * Second batch
  3929. Revision 1.1.2.8 2000/11/13 16:59:08 pierre
  3930. * some function in double removed from fputils unit
  3931. Revision 1.1.2.7 2000/10/31 07:47:54 pierre
  3932. * start to support FPC_BREAK_ERROR
  3933. Revision 1.1.2.6 2000/10/26 00:04:35 pierre
  3934. + gdb prompt and FPC_BREAK_ERROR stop
  3935. Revision 1.1.2.5 2000/10/09 19:48:15 pierre
  3936. * wrong commit corrected
  3937. Revision 1.1.2.4 2000/10/09 16:28:24 pierre
  3938. * several linux enhancements
  3939. Revision 1.1.2.3 2000/10/06 22:52:34 pierre
  3940. * fixes for linux GDB tty command
  3941. Revision 1.1.2.2 2000/09/22 12:02:34 jonas
  3942. * corrected command for running user program in other tty under linux
  3943. (doesn't work yet though)
  3944. Revision 1.1.2.1 2000/07/18 05:50:22 michael
  3945. + Merged Gabors fixes
  3946. Revision 1.1 2000/07/13 09:48:34 michael
  3947. + Initial import
  3948. Revision 1.63 2000/06/22 09:07:11 pierre
  3949. * Gabor changes: see fixes.txt
  3950. Revision 1.62 2000/06/11 07:01:32 peter
  3951. * give watches window also a number
  3952. * leave watches window in the bottom when cascading windows
  3953. Revision 1.61 2000/05/02 08:42:27 pierre
  3954. * new set of Gabor changes: see fixes.txt
  3955. Revision 1.60 2000/04/18 21:45:35 pierre
  3956. * Red line for breakpoint was off by one line
  3957. Revision 1.59 2000/04/18 11:42:36 pierre
  3958. lot of Gabor changes : see fixes.txt
  3959. Revision 1.58 2000/03/21 23:32:38 pierre
  3960. adapted to wcedit addition by Gabor
  3961. Revision 1.57 2000/03/14 14:22:30 pierre
  3962. + generate cmDebuggerStopped broadcast
  3963. Revision 1.56 2000/03/08 16:57:01 pierre
  3964. * Wrong highlighted line while debugging fixed
  3965. + Check if exe has debugging info
  3966. Revision 1.55 2000/03/07 21:52:54 pierre
  3967. + TDebugController.GetValue
  3968. Revision 1.54 2000/03/06 11:34:25 pierre
  3969. + windebug unit for Window Title change when debugging
  3970. Revision 1.53 2000/02/07 12:51:32 pierre
  3971. * typo fix
  3972. Revision 1.52 2000/02/07 11:50:30 pierre
  3973. Gabor changes for TP
  3974. Revision 1.51 2000/02/06 23:43:57 pierre
  3975. * breakpoint path problems fixes
  3976. Revision 1.50 2000/02/05 01:27:58 pierre
  3977. * bug with Toggle Break fixed, hopefully
  3978. + search for local vars in parent procs avoiding
  3979. wrong results (see test.pas source)
  3980. Revision 1.49 2000/02/04 23:18:05 pierre
  3981. * no pushstatus in DoneDebugger because its called after App.done
  3982. Revision 1.48 2000/02/04 14:34:46 pierre
  3983. readme.txt
  3984. Revision 1.47 2000/02/04 00:10:58 pierre
  3985. * Breakpoint line in Source Window better handled
  3986. Revision 1.46 2000/02/01 10:59:58 pierre
  3987. * allow FP to debug itself
  3988. Revision 1.45 2000/01/28 22:38:21 pierre
  3989. * CrtlF9 starts debugger if there are active breakpoints
  3990. Revision 1.44 2000/01/27 22:30:38 florian
  3991. * start of FPU window
  3992. * current executed line color has a higher priority then a breakpoint now
  3993. Revision 1.43 2000/01/20 00:31:53 pierre
  3994. * uses ShortName of exe to start GDB
  3995. Revision 1.42 2000/01/10 17:49:40 pierre
  3996. * Get RegisterView to Update correctly
  3997. * Write in white changed regs (keeping a copy of previous values)
  3998. Revision 1.41 2000/01/10 16:20:50 florian
  3999. * working register window
  4000. Revision 1.40 2000/01/10 13:20:57 pierre
  4001. + debug only possible on source target
  4002. Revision 1.39 2000/01/10 00:25:06 pierre
  4003. * RegisterWindow problem fixed
  4004. Revision 1.38 2000/01/09 21:05:51 florian
  4005. * some fixes for register view
  4006. Revision 1.37 2000/01/08 18:26:20 florian
  4007. + added a register window, doesn't work yet
  4008. Revision 1.36 1999/12/20 14:23:16 pierre
  4009. * MyApp renamed IDEApp
  4010. * TDebugController.ResetDebuggerRows added to
  4011. get resetting of debugger rows
  4012. Revision 1.35 1999/11/24 14:03:16 pierre
  4013. + Executing... in status line if in another window
  4014. Revision 1.34 1999/11/10 17:19:58 pierre
  4015. + Other window for Debuggee code
  4016. Revision 1.33 1999/10/25 16:39:03 pierre
  4017. + GetPChar to avoid nil pointer problems
  4018. Revision 1.32 1999/09/16 14:34:57 pierre
  4019. + TBreakpoint and TWatch registering
  4020. + WatchesCollection and BreakpointsCollection stored in desk file
  4021. * Syntax highlighting was broken
  4022. Revision 1.31 1999/09/13 16:24:43 peter
  4023. + clock
  4024. * backspace unident like tp7
  4025. Revision 1.30 1999/09/09 16:36:30 pierre
  4026. * Breakpoint storage problem corrected
  4027. Revision 1.29 1999/09/09 16:31:45 pierre
  4028. * some breakpoint related fixes and Help contexts
  4029. Revision 1.28 1999/09/09 14:20:05 pierre
  4030. + Stack Window
  4031. Revision 1.27 1999/08/24 22:04:33 pierre
  4032. + TCodeEditor.SetDebuggerRow
  4033. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  4034. so the current stop point in debugging is not lost if
  4035. we move the cursor
  4036. Revision 1.26 1999/08/22 22:26:48 pierre
  4037. + Registration of Breakpoint/Watches windows
  4038. Revision 1.25 1999/08/16 18:25:15 peter
  4039. * Adjusting the selection when the editor didn't contain any line.
  4040. * Reserved word recognition redesigned, but this didn't affect the overall
  4041. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  4042. The syntax scanner loop is a bit slow but the main problem is the
  4043. recognition of special symbols. Switching off symbol processing boosts
  4044. the performance up to ca. 200%...
  4045. * The editor didn't allow copying (for ex to clipboard) of a single character
  4046. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  4047. * Compiler Messages window (actually the whole desktop) did not act on any
  4048. keypress when compilation failed and thus the window remained visible
  4049. + Message windows are now closed upon pressing Esc
  4050. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  4051. only when neccessary
  4052. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  4053. + LineSelect (Ctrl+K+L) implemented
  4054. * The IDE had problems closing help windows before saving the desktop
  4055. Revision 1.24 1999/08/03 20:22:28 peter
  4056. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  4057. + Desktop saving should work now
  4058. - History saved
  4059. - Clipboard content saved
  4060. - Desktop saved
  4061. - Symbol info saved
  4062. * syntax-highlight bug fixed, which compared special keywords case sensitive
  4063. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  4064. * with 'whole words only' set, the editor didn't found occourences of the
  4065. searched text, if the text appeared previously in the same line, but didn't
  4066. satisfied the 'whole-word' condition
  4067. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  4068. (ie. the beginning of the selection)
  4069. * when started typing in a new line, but not at the start (X=0) of it,
  4070. the editor inserted the text one character more to left as it should...
  4071. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  4072. * Shift shouldn't cause so much trouble in TCodeEditor now...
  4073. * Syntax highlight had problems recognizing a special symbol if it was
  4074. prefixed by another symbol character in the source text
  4075. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  4076. Revision 1.23 1999/07/28 23:11:17 peter
  4077. * fixes from gabor
  4078. Revision 1.22 1999/07/12 13:14:15 pierre
  4079. * LineEnd bug corrected, now goes end of text even if selected
  4080. + Until Return for debugger
  4081. + Code for Quit inside GDB Window
  4082. Revision 1.21 1999/07/11 00:35:14 pierre
  4083. * fix problems for wrong watches
  4084. Revision 1.20 1999/07/10 01:24:14 pierre
  4085. + First implementation of watches window
  4086. Revision 1.19 1999/06/30 23:58:12 pierre
  4087. + BreakpointsList Window implemented
  4088. with Edit/New/Delete functions
  4089. + Individual breakpoint dialog with support for all types
  4090. ignorecount and conditions
  4091. (commands are not yet implemented, don't know if this wolud be useful)
  4092. awatch and rwatch have problems because GDB does not annotate them
  4093. I fixed v4.16 for this
  4094. Revision 1.18 1999/03/16 00:44:42 peter
  4095. * forgotten in last commit :(
  4096. Revision 1.17 1999/03/02 13:48:28 peter
  4097. * fixed far problem is fpdebug
  4098. * tile/cascading with message window
  4099. * grep fixes
  4100. Revision 1.16 1999/03/01 15:41:52 peter
  4101. + Added dummy entries for functions not yet implemented
  4102. * MenuBar didn't update itself automatically on command-set changes
  4103. * Fixed Debugging/Profiling options dialog
  4104. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  4105. set
  4106. * efBackSpaceUnindents works correctly
  4107. + 'Messages' window implemented
  4108. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  4109. + Added TP message-filter support (for ex. you can call GREP thru
  4110. GREP2MSG and view the result in the messages window - just like in TP)
  4111. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  4112. so topic search didn't work...
  4113. * In FPHELP.PAS there were still context-variables defined as word instead
  4114. of THelpCtx
  4115. * StdStatusKeys() was missing from the statusdef for help windows
  4116. + Topic-title for index-table can be specified when adding a HTML-files
  4117. Revision 1.15 1999/02/20 15:18:29 peter
  4118. + ctrl-c capture with confirm dialog
  4119. + ascii table in the tools menu
  4120. + heapviewer
  4121. * empty file fixed
  4122. * fixed callback routines in fpdebug to have far for tp7
  4123. Revision 1.14 1999/02/16 12:47:36 pierre
  4124. * GDBWindow does not popup on F7 or F8 anymore
  4125. Revision 1.13 1999/02/16 10:43:54 peter
  4126. * use -dGDB for the compiler
  4127. * only use gdb_file when -dDEBUG is used
  4128. * profiler switch is now a toggle instead of radiobutton
  4129. Revision 1.12 1999/02/11 19:07:20 pierre
  4130. * GDBWindow redesigned :
  4131. normal editor apart from
  4132. that any kbEnter will send the line (for begin to cursor)
  4133. to GDB command !
  4134. GDBWindow opened in Debugger Menu
  4135. still buggy :
  4136. -echo should not be present if at end of text
  4137. -GDBWindow becomes First after each step (I don't know why !)
  4138. Revision 1.11 1999/02/11 13:10:03 pierre
  4139. + GDBWindow only with -dGDBWindow for now : still buggy !!
  4140. Revision 1.10 1999/02/10 09:55:07 pierre
  4141. + added OldValue and CurrentValue field for watchpoints
  4142. + InitBreakpoints and DoneBreakpoints
  4143. + MessageBox if GDB stops bacause of a watchpoint !
  4144. Revision 1.9 1999/02/08 17:43:43 pierre
  4145. * RestDebugger or multiple running of debugged program now works
  4146. + added DoContToCursor(F4)
  4147. * Breakpoints are now inserted correctly (was mainlyy a problem
  4148. of directories)
  4149. Revision 1.8 1999/02/05 17:21:52 pierre
  4150. Invalid_line renamed InvalidSourceLine
  4151. Revision 1.7 1999/02/05 13:08:41 pierre
  4152. + new breakpoint types added
  4153. Revision 1.6 1999/02/05 12:11:53 pierre
  4154. + SourceDir that stores directories for sources that the
  4155. compiler should not know about
  4156. Automatically asked for addition when a new file that
  4157. needed filedialog to be found is in an unknown directory
  4158. Stored and retrieved from INIFile
  4159. + Breakpoints conditions added to INIFile
  4160. * Breakpoints insterted and removed at debin and end of debug session
  4161. Revision 1.5 1999/02/04 17:54:22 pierre
  4162. + several commands added
  4163. Revision 1.4 1999/02/04 13:32:02 pierre
  4164. * Several things added (I cannot commit them independently !)
  4165. + added TBreakpoint and TBreakpointCollection
  4166. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  4167. + Breakpoint list in INIFile
  4168. * Select items now also depend of SwitchMode
  4169. * Reading of option '-g' was not possible !
  4170. + added search for -Fu args pathes in TryToOpen
  4171. + added code for automatic opening of FileDialog
  4172. if source not found
  4173. Revision 1.3 1999/02/02 16:41:38 peter
  4174. + automatic .pas/.pp adding by opening of file
  4175. * better debuggerscreen changes
  4176. Revision 1.2 1999/01/22 18:14:09 pierre
  4177. * adaptd to changes in gdbint and gdbcon for to /
  4178. Revision 1.1 1999/01/22 10:24:03 peter
  4179. * first debugger things
  4180. }