fpdebug.pas 129 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653
  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,WEditor,
  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 : PEditorInputLine;
  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 : PEditorInputLine;
  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,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; R.B.X:=R.B.X-3;
  2145. New(NameIL, Init(R, 255)); Insert(NameIL);
  2146. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2147. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  2148. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2149. R2.Copy(R); R2.Move(-1,-1);
  2150. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2151. R.Move(0,3);
  2152. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2153. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2154. R.Move(0,3); R.B.X:=R.A.X+36;
  2155. New(LineIL, Init(R, 128)); Insert(LineIL);
  2156. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2157. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2158. R.Move(0,3);
  2159. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2160. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2161. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2162. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2163. Items:=nil;
  2164. { don't use invalid type }
  2165. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2166. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2167. New(TypeRB, Init(R, Items));
  2168. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2169. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2170. Insert(TypeRB);
  2171. InsertButtons(@Self);
  2172. NameIL^.Select;
  2173. end;
  2174. function TBreakpointItemDialog.Execute: Word;
  2175. var R: word;
  2176. S1: string;
  2177. err: word;
  2178. L: longint;
  2179. begin
  2180. R:=longint(Breakpoint^.typ);
  2181. TypeRB^.SetData(R);
  2182. If Breakpoint^.typ=bt_file_line then
  2183. S1:=GetStr(Breakpoint^.FileName)
  2184. else
  2185. S1:=GetStr(Breakpoint^.name);
  2186. NameIL^.SetData(S1);
  2187. If Breakpoint^.typ=bt_file_line then
  2188. S1:=IntToStr(Breakpoint^.Line)
  2189. else
  2190. S1:='0';
  2191. LineIL^.SetData(S1);
  2192. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2193. IgnoreIL^.SetData(S1);
  2194. S1:=GetStr(Breakpoint^.Conditions);
  2195. ConditionsIL^.SetData(S1);
  2196. if assigned(FirstEditorWindow) then
  2197. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2198. R:=inherited Execute;
  2199. FindReplaceEditor:=nil;
  2200. if R=cmOK then
  2201. begin
  2202. TypeRB^.GetData(R);
  2203. L:=R;
  2204. Breakpoint^.typ:=BreakpointType(L);
  2205. NameIL^.GetData(S1);
  2206. If Breakpoint^.typ=bt_file_line then
  2207. begin
  2208. If assigned(Breakpoint^.FileName) then
  2209. DisposeStr(Breakpoint^.FileName);
  2210. Breakpoint^.FileName:=NewStr(S1);
  2211. end
  2212. else
  2213. begin
  2214. If assigned(Breakpoint^.Name) then
  2215. DisposeStr(Breakpoint^.Name);
  2216. Breakpoint^.name:=NewStr(S1);
  2217. end;
  2218. If Breakpoint^.typ=bt_file_line then
  2219. begin
  2220. LineIL^.GetData(S1);
  2221. Val(S1,L,err);
  2222. Breakpoint^.Line:=L;
  2223. end;
  2224. IgnoreIL^.GetData(S1);
  2225. Val(S1,L,err);
  2226. Breakpoint^.IgnoreCount:=L;
  2227. ConditionsIL^.GetData(S1);
  2228. If assigned(Breakpoint^.Conditions) then
  2229. DisposeStr(Breakpoint^.Conditions);
  2230. Breakpoint^.Conditions:=NewStr(S1);
  2231. end;
  2232. Execute:=R;
  2233. end;
  2234. {****************************************************************************
  2235. TWatch
  2236. ****************************************************************************}
  2237. constructor TWatch.Init(s : string);
  2238. begin
  2239. expr:=NewStr(s);
  2240. last_value:=nil;
  2241. current_value:=nil;
  2242. Get_new_value;
  2243. GDBRunCount:=-1;
  2244. end;
  2245. constructor TWatch.Load(var S: TStream);
  2246. begin
  2247. expr:=S.ReadStr;
  2248. last_value:=nil;
  2249. current_value:=nil;
  2250. Get_new_value;
  2251. GDBRunCount:=-1;
  2252. end;
  2253. procedure TWatch.Store(var S: TStream);
  2254. begin
  2255. S.WriteStr(expr);
  2256. end;
  2257. procedure TWatch.rename(s : string);
  2258. begin
  2259. if assigned(expr) then
  2260. begin
  2261. if GetStr(expr)=S then
  2262. exit;
  2263. DisposeStr(expr);
  2264. end;
  2265. expr:=NewStr(s);
  2266. if assigned(last_value) then
  2267. StrDispose(last_value);
  2268. last_value:=nil;
  2269. if assigned(current_value) then
  2270. StrDispose(current_value);
  2271. current_value:=nil;
  2272. GDBRunCount:=-1;
  2273. Get_new_value;
  2274. end;
  2275. procedure TWatch.Get_new_value;
  2276. var p, q : pchar;
  2277. i, j, curframe, startframe : longint;
  2278. s,s2 : string;
  2279. loop_higher, found : boolean;
  2280. last_removed : char;
  2281. function GetValue(var s : string) : boolean;
  2282. begin
  2283. Debugger^.command('p '+s);
  2284. if not Debugger^.Error then
  2285. begin
  2286. s:=StrPas(Debugger^.GetOutput);
  2287. GetValue:=true;
  2288. end
  2289. else
  2290. begin
  2291. s:=StrPas(Debugger^.GetError);
  2292. GetValue:=false;
  2293. { do not open a messagebox for such errors }
  2294. Debugger^.got_error:=false;
  2295. end;
  2296. end;
  2297. begin
  2298. If not assigned(Debugger) or Not Debugger^.HasExe or
  2299. (GDBRunCount=Debugger^.RunCount) then
  2300. exit;
  2301. GDBRunCount:=Debugger^.RunCount;
  2302. if assigned(last_value) then
  2303. strdispose(last_value);
  2304. last_value:=current_value;
  2305. s:=GetStr(expr);
  2306. found:=GetValue(s);
  2307. Debugger^.got_error:=false;
  2308. loop_higher:=not found;
  2309. if not found then
  2310. begin
  2311. curframe:=Debugger^.get_current_frame;
  2312. startframe:=curframe;
  2313. end
  2314. else
  2315. begin
  2316. curframe:=0;
  2317. startframe:=0;
  2318. end;
  2319. while loop_higher do
  2320. begin
  2321. s:='parent_ebp';
  2322. if GetValue(s) then
  2323. begin
  2324. repeat
  2325. inc(curframe);
  2326. if not Debugger^.set_current_frame(curframe) then
  2327. loop_higher:=false;
  2328. s2:='/x $ebp';
  2329. getValue(s2);
  2330. j:=pos('=',s2);
  2331. if j>0 then
  2332. s2:=copy(s2,j+1,length(s2));
  2333. while s2[1] in [' ',TAB] do
  2334. delete(s2,1,1);
  2335. if pos(s2,s)>0 then
  2336. loop_higher :=false;
  2337. until not loop_higher;
  2338. { try again at that level }
  2339. s:=GetStr(expr);
  2340. found:=GetValue(s);
  2341. loop_higher:=not found;
  2342. end
  2343. else
  2344. loop_higher:=false;
  2345. end;
  2346. if found then
  2347. p:=StrNew(Debugger^.GetOutput)
  2348. else
  2349. begin
  2350. { get a reasonable output at least }
  2351. s:=GetStr(expr);
  2352. GetValue(s);
  2353. p:=StrNew(Debugger^.GetError);
  2354. end;
  2355. Debugger^.got_error:=false;
  2356. { We should try here to find the expr in parent
  2357. procedure if there are
  2358. I will implement this as I added a
  2359. parent_ebp pseudo local var to local procedure
  2360. in stabs debug info PM }
  2361. { But there are some pitfalls like
  2362. locals redefined in other sublocals that call the function }
  2363. if curframe<>startframe then
  2364. Debugger^.set_current_frame(startframe);
  2365. q:=nil;
  2366. if assigned(p) and (p[0]='$') then
  2367. q:=StrPos(p,'=');
  2368. if not assigned(q) then
  2369. q:=p;
  2370. if assigned(q) then
  2371. i:=strlen(q)
  2372. else
  2373. i:=0;
  2374. if (i>0) and (q[i-1]=#10) then
  2375. begin
  2376. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2377. dec(i);
  2378. last_removed:=q[i-1];
  2379. q[i-1]:=#0;
  2380. end
  2381. else
  2382. last_removed:=#0;
  2383. if assigned(q) then
  2384. current_value:=strnew(q)
  2385. else
  2386. current_value:=strnew('');
  2387. if last_removed<>#0 then
  2388. q[i-1]:=last_removed;
  2389. strdispose(p);
  2390. GDBRunCount:=Debugger^.RunCount;
  2391. end;
  2392. destructor TWatch.Done;
  2393. begin
  2394. if assigned(expr) then
  2395. disposestr(expr);
  2396. if assigned(last_value) then
  2397. strdispose(last_value);
  2398. if assigned(current_value) then
  2399. strdispose(current_value);
  2400. inherited done;
  2401. end;
  2402. {****************************************************************************
  2403. TWatchesCollection
  2404. ****************************************************************************}
  2405. constructor TWatchesCollection.Init;
  2406. begin
  2407. inherited Init(10,10);
  2408. end;
  2409. procedure TWatchesCollection.Insert(Item: Pointer);
  2410. begin
  2411. PWatch(Item)^.Get_new_value;
  2412. Inherited Insert(Item);
  2413. Update;
  2414. end;
  2415. procedure TWatchesCollection.Update;
  2416. var
  2417. W,W1 : integer;
  2418. procedure GetMax(P : PWatch);
  2419. begin
  2420. if assigned(P^.Current_value) then
  2421. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2422. else
  2423. W1:=2+Length(GetStr(P^.expr));
  2424. if W1>W then
  2425. W:=W1;
  2426. end;
  2427. begin
  2428. W:=0;
  2429. ForEach(@GetMax);
  2430. MaxW:=W;
  2431. If assigned(WatchesWindow) then
  2432. WatchesWindow^.WLB^.Update(MaxW);
  2433. end;
  2434. function TWatchesCollection.At(Index: Integer): PWatch;
  2435. begin
  2436. At:=Inherited At(Index);
  2437. end;
  2438. {****************************************************************************
  2439. TWatchesListBox
  2440. ****************************************************************************}
  2441. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2442. begin
  2443. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2444. If assigned(List) then
  2445. dispose(list,done);
  2446. List:=WatchesCollection;
  2447. end;
  2448. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2449. var R : TRect;
  2450. begin
  2451. GetExtent(R);
  2452. MaxWidth:=AMaxWidth;
  2453. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2454. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2455. else
  2456. HScrollBar^.SetRange(0,0);
  2457. if R.B.X-R.A.X>MaxWidth then
  2458. HScrollBar^.Hide
  2459. else
  2460. HScrollBar^.Show;
  2461. SetRange(List^.Count+1);
  2462. if R.B.Y-R.A.Y>Range then
  2463. VScrollBar^.Hide
  2464. else
  2465. VScrollBar^.Show;
  2466. {if Focused=List^.Count-1-1 then
  2467. FocusItem(List^.Count-1);
  2468. What was that for ?? PM }
  2469. DrawView;
  2470. end;
  2471. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2472. var
  2473. PW : PWatch;
  2474. ValOffset : Sw_integer;
  2475. S : String;
  2476. begin
  2477. Modified:=false;
  2478. if Item>=WatchesCollection^.Count then
  2479. begin
  2480. GetIndentedText:='';
  2481. exit;
  2482. end;
  2483. PW:=WatchesCollection^.At(Item);
  2484. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2485. if not assigned(PW^.expr) then
  2486. GetIndentedText:=''
  2487. else if Indent<ValOffset then
  2488. begin
  2489. S:=GetStr(PW^.Expr);
  2490. if Indent=0 then
  2491. S:=' '+S
  2492. else
  2493. S:=Copy(S,Indent,High(S));
  2494. if not assigned(PW^.current_value) then
  2495. S:=S+' <Unknown value>'
  2496. else
  2497. S:=S+' '+GetPChar(PW^.Current_value);
  2498. GetIndentedText:=Copy(S,1,MaxLen);
  2499. end
  2500. else
  2501. begin
  2502. if not assigned(PW^.Current_value) or
  2503. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2504. S:=''
  2505. else
  2506. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2507. GetIndentedText:=Copy(S,1,MaxLen);
  2508. end;
  2509. if assigned(PW^.current_value) and
  2510. assigned(PW^.last_value) and
  2511. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2512. Modified:=true;
  2513. end;
  2514. procedure TWatchesListBox.EditCurrent;
  2515. var
  2516. P: PWatch;
  2517. begin
  2518. if Range=0 then Exit;
  2519. if Focused<WatchesCollection^.Count then
  2520. P:=WatchesCollection^.At(Focused)
  2521. else
  2522. P:=New(PWatch,Init(''));
  2523. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2524. WatchesCollection^.Update;
  2525. end;
  2526. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2527. var
  2528. Dummy_Modified : boolean;
  2529. begin
  2530. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2531. end;
  2532. procedure TWatchesListBox.DeleteCurrent;
  2533. var
  2534. P: PWatch;
  2535. begin
  2536. if (Range=0) or
  2537. (Focused>=WatchesCollection^.Count) then
  2538. exit;
  2539. P:=WatchesCollection^.At(Focused);
  2540. WatchesCollection^.free(P);
  2541. WatchesCollection^.Update;
  2542. end;
  2543. procedure TWatchesListBox.EditNew;
  2544. var
  2545. P: PWatch;
  2546. S : string;
  2547. begin
  2548. if Focused<WatchesCollection^.Count then
  2549. begin
  2550. P:=WatchesCollection^.At(Focused);
  2551. S:=GetStr(P^.expr);
  2552. end
  2553. else
  2554. S:='';
  2555. P:=New(PWatch,Init(S));
  2556. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2557. begin
  2558. WatchesCollection^.AtInsert(Focused,P);
  2559. WatchesCollection^.Update;
  2560. end
  2561. else
  2562. dispose(P,Done);
  2563. end;
  2564. procedure TWatchesListBox.Draw;
  2565. var
  2566. I, J, Item: Sw_Integer;
  2567. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2568. ColWidth, CurCol, Indent: Integer;
  2569. B: TDrawBuffer;
  2570. Modified : boolean;
  2571. Text: String;
  2572. SCOff: Byte;
  2573. TC: byte;
  2574. procedure MT(var C: word);
  2575. begin
  2576. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2577. end;
  2578. begin
  2579. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2580. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2581. begin
  2582. NormalColor := GetColor(1);
  2583. FocusedColor := GetColor(3);
  2584. SelectedColor := GetColor(4);
  2585. end else
  2586. begin
  2587. NormalColor := GetColor(2);
  2588. SelectedColor := GetColor(4);
  2589. end;
  2590. if Transparent then
  2591. begin MT(NormalColor); MT(SelectedColor); end;
  2592. (* if NoSelection then
  2593. SelectedColor:=NormalColor;*)
  2594. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2595. else Indent := 0;
  2596. ColWidth := Size.X div NumCols + 1;
  2597. for I := 0 to Size.Y - 1 do
  2598. begin
  2599. for J := 0 to NumCols-1 do
  2600. begin
  2601. Item := J*Size.Y + I + TopItem;
  2602. CurCol := J*ColWidth;
  2603. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2604. (Focused = Item) and (Range > 0) then
  2605. begin
  2606. Color := FocusedColor;
  2607. SetCursor(CurCol+1,I);
  2608. SCOff := 0;
  2609. end
  2610. else if (Item < Range) and IsSelected(Item) then
  2611. begin
  2612. Color := SelectedColor;
  2613. SCOff := 2;
  2614. end
  2615. else
  2616. begin
  2617. Color := NormalColor;
  2618. SCOff := 4;
  2619. end;
  2620. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2621. if Item < Range then
  2622. begin
  2623. (* Text := GetText(Item, ColWidth + Indent);
  2624. Text := Copy(Text,Indent,ColWidth); *)
  2625. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2626. if modified then
  2627. begin
  2628. SCOff:=0;
  2629. Color:=(Color and $fff0) or Red;
  2630. end;
  2631. MoveStr(B[CurCol], Text, Color);
  2632. if {ShowMarkers or } Modified then
  2633. begin
  2634. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2635. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2636. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2637. end;
  2638. end;
  2639. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2640. end;
  2641. WriteLine(0, I, Size.X, 1, B);
  2642. end;
  2643. end;
  2644. function TWatchesListBox.GetLocalMenu: PMenu;
  2645. var M: PMenu;
  2646. begin
  2647. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2648. M:=NewMenu(
  2649. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2650. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2651. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2652. NewLine(
  2653. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2654. nil))))));
  2655. GetLocalMenu:=M;
  2656. end;
  2657. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2658. var DontClear: boolean;
  2659. begin
  2660. case Event.What of
  2661. evKeyDown :
  2662. begin
  2663. DontClear:=false;
  2664. case Event.KeyCode of
  2665. kbEnter :
  2666. Message(@Self,evCommand,cmEdit,nil);
  2667. kbIns :
  2668. Message(@Self,evCommand,cmNew,nil);
  2669. kbDel :
  2670. Message(@Self,evCommand,cmDelete,nil);
  2671. else
  2672. DontClear:=true;
  2673. end;
  2674. if not DontClear then
  2675. ClearEvent(Event);
  2676. end;
  2677. evBroadcast :
  2678. case Event.Command of
  2679. cmListItemSelected :
  2680. if Event.InfoPtr=@Self then
  2681. Message(@Self,evCommand,cmEdit,nil);
  2682. end;
  2683. evCommand :
  2684. begin
  2685. DontClear:=false;
  2686. case Event.Command of
  2687. cmEdit :
  2688. EditCurrent;
  2689. cmDelete :
  2690. DeleteCurrent;
  2691. cmNew :
  2692. EditNew;
  2693. else
  2694. DontClear:=true;
  2695. end;
  2696. if not DontClear then
  2697. ClearEvent(Event);
  2698. end;
  2699. end;
  2700. inherited HandleEvent(Event);
  2701. end;
  2702. constructor TWatchesListBox.Load(var S: TStream);
  2703. begin
  2704. inherited Load(S);
  2705. If assigned(List) then
  2706. dispose(list,done);
  2707. List:=WatchesCollection;
  2708. { we must set Range PM }
  2709. SetRange(List^.count+1);
  2710. end;
  2711. procedure TWatchesListBox.Store(var S: TStream);
  2712. var OL: PCollection;
  2713. OldRange : Sw_integer;
  2714. begin
  2715. OL:=List;
  2716. OldRange:=Range;
  2717. Range:=0;
  2718. New(List, Init(1,1));
  2719. inherited Store(S);
  2720. Dispose(List, Done);
  2721. List:=OL;
  2722. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2723. collection? Pasting here a modified version of TListBox.Store+
  2724. TAdvancedListBox.Store isn't a better solution, since by eventually
  2725. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2726. SetRange(OldRange);
  2727. end;
  2728. destructor TWatchesListBox.Done;
  2729. begin
  2730. List:=nil;
  2731. inherited Done;
  2732. end;
  2733. {****************************************************************************
  2734. TWatchesWindow
  2735. ****************************************************************************}
  2736. Constructor TWatchesWindow.Init;
  2737. var
  2738. HSB,VSB: PScrollBar;
  2739. R,R2 : trect;
  2740. begin
  2741. Desktop^.GetExtent(R);
  2742. R.A.Y:=R.B.Y-7;
  2743. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  2744. Palette:=wpCyanWindow;
  2745. GetExtent(R);
  2746. HelpCtx:=hcWatchesWindow;
  2747. R.Grow(-1,-1);
  2748. R2.Copy(R);
  2749. Inc(R2.B.Y);
  2750. R2.A.Y:=R2.B.Y-1;
  2751. New(HSB, Init(R2));
  2752. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2753. HSB^.SetStep(R.B.X-R.A.X,1);
  2754. Insert(HSB);
  2755. R2.Copy(R);
  2756. Inc(R2.B.X);
  2757. R2.A.X:=R2.B.X-1;
  2758. New(VSB, Init(R2));
  2759. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2760. Insert(VSB);
  2761. New(WLB,Init(R,HSB,VSB));
  2762. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2763. WLB^.Transparent:=true;
  2764. Insert(WLB);
  2765. If assigned(WatchesWindow) then
  2766. dispose(WatchesWindow,done);
  2767. WatchesWindow:=@Self;
  2768. Update;
  2769. end;
  2770. procedure TWatchesWindow.Update;
  2771. begin
  2772. WatchesCollection^.Update;
  2773. Draw;
  2774. end;
  2775. constructor TWatchesWindow.Load(var S: TStream);
  2776. begin
  2777. inherited Load(S);
  2778. GetSubViewPtr(S,WLB);
  2779. If assigned(WatchesWindow) then
  2780. dispose(WatchesWindow,done);
  2781. WatchesWindow:=@Self;
  2782. end;
  2783. procedure TWatchesWindow.Store(var S: TStream);
  2784. begin
  2785. inherited Store(S);
  2786. PutSubViewPtr(S,WLB);
  2787. end;
  2788. Destructor TWatchesWindow.Done;
  2789. begin
  2790. WatchesWindow:=nil;
  2791. Dispose(WLB,done);
  2792. inherited done;
  2793. end;
  2794. {****************************************************************************
  2795. TWatchItemDialog
  2796. ****************************************************************************}
  2797. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2798. var R,R2: TRect;
  2799. begin
  2800. R.Assign(0,0,50,10);
  2801. inherited Init(R,'Edit Watch');
  2802. Watch:=AWatch;
  2803. GetExtent(R); R.Grow(-3,-2);
  2804. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2805. New(NameIL, Init(R, 255)); Insert(NameIL);
  2806. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2807. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  2808. R2.Copy(R); R2.Move(-1,-1);
  2809. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  2810. GetExtent(R);
  2811. R.Grow(-3,-1);
  2812. R.A.Y:=R.A.Y+3;
  2813. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  2814. Insert(TextST);
  2815. InsertButtons(@Self);
  2816. NameIL^.Select;
  2817. end;
  2818. function TWatchItemDialog.Execute: Word;
  2819. var R: word;
  2820. S1,S2: string;
  2821. begin
  2822. S1:=GetStr(Watch^.expr);
  2823. NameIL^.SetData(S1);
  2824. S1:=GetPChar(Watch^.Current_value);
  2825. S2:=GetPChar(Watch^.Last_value);
  2826. ClearFormatParams;
  2827. AddFormatParamStr(S1);
  2828. AddFormatParamStr(S2);
  2829. if assigned(Watch^.Last_value) and
  2830. assigned(Watch^.Current_value) and
  2831. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2832. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  2833. else
  2834. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  2835. TextST^.SetText(S1);
  2836. if assigned(FirstEditorWindow) then
  2837. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2838. R:=inherited Execute;
  2839. FindReplaceEditor:=nil;
  2840. if R=cmOK then
  2841. begin
  2842. NameIL^.GetData(S1);
  2843. Watch^.Rename(S1);
  2844. If assigned(Debugger) then
  2845. Debugger^.ReadWatches;
  2846. end;
  2847. Execute:=R;
  2848. end;
  2849. {****************************************************************************
  2850. TRegistersView
  2851. ****************************************************************************}
  2852. function GetIntRegs(var rs : TIntRegs) : boolean;
  2853. var
  2854. p,po : pchar;
  2855. p1 : pchar;
  2856. reg,value : string;
  2857. buffer : array[0..255] of char;
  2858. v : dword;
  2859. code : word;
  2860. begin
  2861. GetIntRegs:=false;
  2862. {$ifndef NODEBUG}
  2863. Debugger^.Command('info registers');
  2864. if Debugger^.Error then
  2865. exit
  2866. else
  2867. begin
  2868. po:=StrNew(Debugger^.GetOutput);
  2869. p:=po;
  2870. if assigned(p) then
  2871. begin
  2872. fillchar(rs,sizeof(rs),0);
  2873. p1:=strscan(p,' ');
  2874. while assigned(p1) do
  2875. begin
  2876. strlcopy(buffer,p,p1-p);
  2877. reg:=strpas(buffer);
  2878. p:=strscan(p,'$');
  2879. p1:=strscan(p,#9);
  2880. strlcopy(buffer,p,p1-p);
  2881. value:=strpas(buffer);
  2882. val(value,v,code);
  2883. {$ifdef i386}
  2884. if reg='eax' then
  2885. rs.eax:=v
  2886. else if reg='ebx' then
  2887. rs.ebx:=v
  2888. else if reg='ecx' then
  2889. rs.ecx:=v
  2890. else if reg='edx' then
  2891. rs.edx:=v
  2892. else if reg='eip' then
  2893. rs.eip:=v
  2894. else if reg='esi' then
  2895. rs.esi:=v
  2896. else if reg='edi' then
  2897. rs.edi:=v
  2898. else if reg='esp' then
  2899. rs.esp:=v
  2900. else if reg='ebp' then
  2901. rs.ebp:=v
  2902. { under win32 flags are on a register named ps !! PM }
  2903. else if (reg='eflags') or (reg='ps') then
  2904. rs.eflags:=v
  2905. else if reg='cs' then
  2906. rs.cs:=v
  2907. else if reg='ds' then
  2908. rs.ds:=v
  2909. else if reg='es' then
  2910. rs.es:=v
  2911. else if reg='fs' then
  2912. rs.fs:=v
  2913. else if reg='gs' then
  2914. rs.gs:=v
  2915. else if reg='ss' then
  2916. rs.ss:=v;
  2917. {$endif i386}
  2918. {$ifdef m68k}
  2919. if reg='d0' then
  2920. rs.d0:=v
  2921. else if reg='d1' then
  2922. rs.d1:=v
  2923. else if reg='d2' then
  2924. rs.d2:=v
  2925. else if reg='d3' then
  2926. rs.d3:=v
  2927. else if reg='d4' then
  2928. rs.d4:=v
  2929. else if reg='d5' then
  2930. rs.d5:=v
  2931. else if reg='d6' then
  2932. rs.d6:=v
  2933. else if reg='d7' then
  2934. rs.d7:=v
  2935. else if reg='a0' then
  2936. rs.a0:=v
  2937. else if reg='a1' then
  2938. rs.a1:=v
  2939. else if reg='a2' then
  2940. rs.a2:=v
  2941. else if reg='a3' then
  2942. rs.a3:=v
  2943. else if reg='a4' then
  2944. rs.a4:=v
  2945. else if reg='a5' then
  2946. rs.a5:=v
  2947. else if reg='fp' then
  2948. rs.fp:=v
  2949. else if reg='sp' then
  2950. rs.sp:=v
  2951. else if (reg='ps') then
  2952. rs.ps:=v
  2953. else if reg='pc' then
  2954. rs.pc:=v;
  2955. {$endif m68k}
  2956. p:=strscan(p1,#10);
  2957. if assigned(p) then
  2958. begin
  2959. p1:=strscan(p,' ');
  2960. inc(p);
  2961. end
  2962. else
  2963. break;
  2964. end;
  2965. { free allocated memory }
  2966. strdispose(po);
  2967. end
  2968. else
  2969. exit;
  2970. end;
  2971. { do not open a messagebox for such errors }
  2972. Debugger^.got_error:=false;
  2973. GetIntRegs:=true;
  2974. {$endif}
  2975. end;
  2976. constructor TRegistersView.Init(var Bounds: TRect);
  2977. begin
  2978. inherited init(Bounds);
  2979. end;
  2980. procedure TRegistersView.Draw;
  2981. var
  2982. rs : tintregs;
  2983. color :byte;
  2984. procedure SetColor(x,y : longint);
  2985. begin
  2986. if x=y then
  2987. color:=7
  2988. else
  2989. color:=8;
  2990. end;
  2991. begin
  2992. inherited draw;
  2993. If not assigned(Debugger) then
  2994. begin
  2995. WriteStr(1,0,'<no values available>',7);
  2996. exit;
  2997. end;
  2998. if GetIntRegs(rs) then
  2999. begin
  3000. {$ifdef i386}
  3001. SetColor(rs.eax,OldReg.eax);
  3002. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  3003. SetColor(rs.ebx,OldReg.ebx);
  3004. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  3005. SetColor(rs.ecx,OldReg.ecx);
  3006. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  3007. SetColor(rs.edx,OldReg.edx);
  3008. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  3009. SetColor(rs.eip,OldReg.eip);
  3010. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  3011. SetColor(rs.esi,OldReg.esi);
  3012. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  3013. SetColor(rs.edi,OldReg.edi);
  3014. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  3015. SetColor(rs.esp,OldReg.esp);
  3016. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  3017. SetColor(rs.ebp,OldReg.ebp);
  3018. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  3019. SetColor(rs.cs,OldReg.cs);
  3020. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  3021. SetColor(rs.ds,OldReg.ds);
  3022. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  3023. SetColor(rs.es,OldReg.es);
  3024. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  3025. SetColor(rs.fs,OldReg.fs);
  3026. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  3027. SetColor(rs.gs,OldReg.gs);
  3028. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  3029. SetColor(rs.ss,OldReg.ss);
  3030. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  3031. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  3032. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  3033. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  3034. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  3035. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  3036. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  3037. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  3038. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  3039. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  3040. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  3041. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  3042. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  3043. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  3044. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  3045. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  3046. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  3047. {$endif i386}
  3048. {$ifdef m68k}
  3049. SetColor(rs.d0,OldReg.d0);
  3050. WriteStr(1,0,'d0 '+HexStr(rs.d0,8),color);
  3051. SetColor(rs.d1,OldReg.d1);
  3052. WriteStr(1,1,'d1 '+HexStr(rs.d1,8),color);
  3053. SetColor(rs.d2,OldReg.d2);
  3054. WriteStr(1,2,'d2 '+HexStr(rs.d2,8),color);
  3055. SetColor(rs.d3,OldReg.d3);
  3056. WriteStr(1,3,'d3 '+HexStr(rs.d3,8),color);
  3057. SetColor(rs.d4,OldReg.d4);
  3058. WriteStr(1,4,'d4 '+HexStr(rs.d4,8),color);
  3059. SetColor(rs.d5,OldReg.d5);
  3060. WriteStr(1,5,'d5 '+HexStr(rs.d5,8),color);
  3061. SetColor(rs.d6,OldReg.d6);
  3062. WriteStr(1,6,'d6 '+HexStr(rs.d6,8),color);
  3063. SetColor(rs.d7,OldReg.d7);
  3064. WriteStr(1,7,'d7 '+HexStr(rs.d7,8),color);
  3065. SetColor(rs.a0,OldReg.a0);
  3066. WriteStr(14,0,'a0 '+HexStr(rs.a0,8),color);
  3067. SetColor(rs.a1,OldReg.a1);
  3068. WriteStr(14,1,'a1 '+HexStr(rs.a1,8),color);
  3069. SetColor(rs.a2,OldReg.a2);
  3070. WriteStr(14,2,'a2 '+HexStr(rs.a2,8),color);
  3071. SetColor(rs.a3,OldReg.a3);
  3072. WriteStr(14,3,'a3 '+HexStr(rs.a3,8),color);
  3073. SetColor(rs.a4,OldReg.a4);
  3074. WriteStr(14,4,'a4 '+HexStr(rs.a4,8),color);
  3075. SetColor(rs.a5,OldReg.a5);
  3076. WriteStr(14,5,'a5 '+HexStr(rs.a5,8),color);
  3077. SetColor(rs.fp,OldReg.fp);
  3078. WriteStr(14,6,'fp '+HexStr(rs.fp,8),color);
  3079. SetColor(rs.sp,OldReg.sp);
  3080. WriteStr(14,7,'sp '+HexStr(rs.sp,8),color);
  3081. SetColor(rs.pc,OldReg.pc);
  3082. WriteStr(1,8,'pc '+HexStr(rs.pc,8),color);
  3083. SetColor(rs.ps and $1,OldReg.ps and $1);
  3084. WriteStr(20,8,'c'+chr(byte((rs.ps and $1)<>0)+48),color);
  3085. SetColor(rs.ps and $2,OldReg.ps and $2);
  3086. WriteStr(18,8,'v'+chr(byte((rs.ps and $2)<>0)+48),color);
  3087. SetColor(rs.ps and $4,OldReg.ps and $4);
  3088. WriteStr(16,8,'z'+chr(byte((rs.ps and $4)<>0)+48),color);
  3089. SetColor(rs.ps and $8,OldReg.ps and $8);
  3090. WriteStr(14,8,'x'+chr(byte((rs.ps and $8)<>0)+48),color);
  3091. {$endif i386}
  3092. OldReg:=rs;
  3093. end
  3094. else
  3095. WriteStr(0,0,'<debugger error>',7);
  3096. end;
  3097. destructor TRegistersView.Done;
  3098. begin
  3099. inherited done;
  3100. end;
  3101. {****************************************************************************
  3102. TRegistersWindow
  3103. ****************************************************************************}
  3104. constructor TRegistersWindow.Init;
  3105. var
  3106. R : TRect;
  3107. begin
  3108. Desktop^.GetExtent(R);
  3109. R.A.X:=R.B.X-28;
  3110. R.B.Y:=R.A.Y+11;
  3111. inherited Init(R,dialog_registers, wnNoNumber);
  3112. Flags:=wfClose or wfMove;
  3113. Palette:=wpCyanWindow;
  3114. HelpCtx:=hcRegistersWindow;
  3115. R.Assign(1,1,26,10);
  3116. RV:=new(PRegistersView,init(R));
  3117. Insert(RV);
  3118. If assigned(RegistersWindow) then
  3119. dispose(RegistersWindow,done);
  3120. RegistersWindow:=@Self;
  3121. Update;
  3122. end;
  3123. constructor TRegistersWindow.Load(var S: TStream);
  3124. begin
  3125. inherited load(S);
  3126. GetSubViewPtr(S,RV);
  3127. If assigned(RegistersWindow) then
  3128. dispose(RegistersWindow,done);
  3129. RegistersWindow:=@Self;
  3130. end;
  3131. procedure TRegistersWindow.Store(var S: TStream);
  3132. begin
  3133. inherited Store(s);
  3134. PutSubViewPtr(S,RV);
  3135. end;
  3136. procedure TRegistersWindow.Update;
  3137. begin
  3138. ReDraw;
  3139. end;
  3140. destructor TRegistersWindow.Done;
  3141. begin
  3142. RegistersWindow:=nil;
  3143. inherited done;
  3144. end;
  3145. {****************************************************************************
  3146. TFPUView
  3147. ****************************************************************************}
  3148. function GetFPURegs(var rs : TFPURegs) : boolean;
  3149. var
  3150. p,po : pchar;
  3151. p1 : pchar;
  3152. {$ifndef NODEBUG}
  3153. reg,value : string;
  3154. buffer : array[0..255] of char;
  3155. v : string;
  3156. res : cardinal;
  3157. i : longint;
  3158. err : word;
  3159. {$endif}
  3160. begin
  3161. GetFPURegs:=false;
  3162. {$ifndef NODEBUG}
  3163. Debugger^.Command('info all');
  3164. if Debugger^.Error then
  3165. exit
  3166. else
  3167. begin
  3168. po:=StrNew(Debugger^.GetOutput);
  3169. p:=po;
  3170. if assigned(p) then
  3171. begin
  3172. fillchar(rs,sizeof(rs),0);
  3173. p1:=strscan(p,' ');
  3174. while assigned(p1) do
  3175. begin
  3176. strlcopy(buffer,p,p1-p);
  3177. reg:=strpas(buffer);
  3178. p:=p1;
  3179. while p^=' ' do
  3180. inc(p);
  3181. if p^='$' then
  3182. p1:=strscan(p,#9)
  3183. else
  3184. p1:=strscan(p,#10);
  3185. strlcopy(buffer,p,p1-p);
  3186. v:=strpas(buffer);
  3187. for i:=1 to length(v) do
  3188. if v[i]=#9 then
  3189. v[i]:=' ';
  3190. val(v,res,err);
  3191. {$ifdef i386}
  3192. if reg='st0' then
  3193. rs.st0:=v
  3194. else if reg='st1' then
  3195. rs.st1:=v
  3196. else if reg='st2' then
  3197. rs.st2:=v
  3198. else if reg='st3' then
  3199. rs.st3:=v
  3200. else if reg='st4' then
  3201. rs.st4:=v
  3202. else if reg='st5' then
  3203. rs.st5:=v
  3204. else if reg='st6' then
  3205. rs.st6:=v
  3206. else if reg='st7' then
  3207. rs.st7:=v
  3208. else if reg='ftag' then
  3209. rs.ftag:=res
  3210. else if reg='fctrl' then
  3211. rs.fctrl:=res
  3212. else if reg='fstat' then
  3213. rs.fstat:=res
  3214. else if reg='fiseg' then
  3215. rs.fiseg:=res
  3216. else if reg='fioff' then
  3217. rs.fioff:=res
  3218. else if reg='foseg' then
  3219. rs.foseg:=res
  3220. else if reg='fooff' then
  3221. rs.fooff:=res
  3222. else if reg='fop' then
  3223. rs.fop:=res;
  3224. {$endif i386}
  3225. {$ifdef m68k}
  3226. if reg='fp0' then
  3227. rs.fp0:=v
  3228. else if reg='fp1' then
  3229. rs.fp1:=v
  3230. else if reg='fp2' then
  3231. rs.fp2:=v
  3232. else if reg='fp3' then
  3233. rs.fp3:=v
  3234. else if reg='fp4' then
  3235. rs.fp4:=v
  3236. else if reg='fp5' then
  3237. rs.fp5:=v
  3238. else if reg='fp6' then
  3239. rs.fp6:=v
  3240. else if reg='fp7' then
  3241. rs.fp7:=v
  3242. else if reg='fpcontrol' then
  3243. rs.fpcontrol:=res
  3244. else if reg='fpstatus' then
  3245. rs.fpstatus:=res
  3246. else if reg='fpiaddr' then
  3247. rs.fpiaddr:=res;
  3248. {$endif m68k}
  3249. p:=strscan(p1,#10);
  3250. if assigned(p) then
  3251. begin
  3252. p1:=strscan(p,' ');
  3253. inc(p);
  3254. end
  3255. else
  3256. break;
  3257. end;
  3258. { free allocated memory }
  3259. strdispose(po);
  3260. end
  3261. else
  3262. exit;
  3263. end;
  3264. { do not open a messagebox for such errors }
  3265. Debugger^.got_error:=false;
  3266. GetFPURegs:=true;
  3267. {$endif}
  3268. end;
  3269. constructor TFPUView.Init(var Bounds: TRect);
  3270. begin
  3271. inherited init(Bounds);
  3272. end;
  3273. procedure TFPUView.Draw;
  3274. var
  3275. rs : tfpuregs;
  3276. top : byte;
  3277. color :byte;
  3278. const
  3279. TypeStr : Array[0..3] of string[6] =
  3280. ('Valid ','Zero ','Spec ','Empty ');
  3281. procedure SetColor(Const x,y : string);
  3282. begin
  3283. if x=y then
  3284. color:=7
  3285. else
  3286. color:=8;
  3287. end;
  3288. procedure SetIColor(Const x,y : cardinal);
  3289. begin
  3290. if x=y then
  3291. color:=7
  3292. else
  3293. color:=8;
  3294. end;
  3295. begin
  3296. inherited draw;
  3297. If not assigned(Debugger) then
  3298. begin
  3299. WriteStr(1,0,'<no values available>',7);
  3300. exit;
  3301. end;
  3302. if GetFPURegs(rs) then
  3303. begin
  3304. {$ifdef i386}
  3305. top:=(rs.fstat shr 11) and 7;
  3306. SetColor(rs.st0,OldReg.st0);
  3307. WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
  3308. SetColor(rs.st1,OldReg.st1);
  3309. WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
  3310. SetColor(rs.st2,OldReg.st2);
  3311. WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
  3312. SetColor(rs.st3,OldReg.st3);
  3313. WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
  3314. SetColor(rs.st4,OldReg.st4);
  3315. WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
  3316. SetColor(rs.st5,OldReg.st5);
  3317. WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
  3318. SetColor(rs.st6,OldReg.st6);
  3319. WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
  3320. SetColor(rs.st7,OldReg.st7);
  3321. WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
  3322. SetIColor(rs.ftag,OldReg.ftag);
  3323. WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
  3324. SetIColor(rs.fctrl,OldReg.fctrl);
  3325. WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
  3326. SetIColor(rs.fstat,OldReg.fstat);
  3327. WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
  3328. SetIColor(rs.fop,OldReg.fop);
  3329. WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
  3330. if (rs.fiseg<>OldReg.fiseg) or
  3331. (rs.fioff<>OldReg.fioff) then
  3332. color:=8
  3333. else
  3334. color:=7;
  3335. WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
  3336. if (rs.foseg<>OldReg.foseg) or
  3337. (rs.fooff<>OldReg.fooff) then
  3338. color:=8
  3339. else
  3340. color:=7;
  3341. WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
  3342. OldReg:=rs;
  3343. {$endif i386}
  3344. {$ifdef m68k}
  3345. SetColor(rs.fp0,OldReg.fp0);
  3346. WriteStr(1,0,'fp0 '+rs.fp0,color);
  3347. SetColor(rs.fp1,OldReg.fp1);
  3348. WriteStr(1,1,'fp1 '+rs.fp1,color);
  3349. SetColor(rs.fp2,OldReg.fp2);
  3350. WriteStr(1,2,'fp2 '+rs.fp2,color);
  3351. SetColor(rs.fp3,OldReg.fp3);
  3352. WriteStr(1,3,'fp3 '+rs.fp3,color);
  3353. SetColor(rs.fp4,OldReg.fp4);
  3354. WriteStr(1,4,'fp4 '+rs.fp4,color);
  3355. SetColor(rs.fp5,OldReg.fp5);
  3356. WriteStr(1,5,'fp5 '+rs.fp5,color);
  3357. SetColor(rs.fp6,OldReg.fp6);
  3358. WriteStr(1,6,'fp6 '+rs.fp6,color);
  3359. SetColor(rs.fp7,OldReg.fp7);
  3360. WriteStr(1,7,'fp7 '+rs.fp7,color);
  3361. SetIColor(rs.fpcontrol,OldReg.fpcontrol);
  3362. WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
  3363. SetIColor(rs.fpstatus,OldReg.fpstatus);
  3364. WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
  3365. SetIColor(rs.fpiaddr,OldReg.fpiaddr);
  3366. WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
  3367. OldReg:=rs;
  3368. {$endif m68k}
  3369. end
  3370. else
  3371. WriteStr(0,0,'<debugger error>',7);
  3372. end;
  3373. destructor TFPUView.Done;
  3374. begin
  3375. inherited done;
  3376. end;
  3377. {****************************************************************************
  3378. TFPUWindow
  3379. ****************************************************************************}
  3380. constructor TFPUWindow.Init;
  3381. var
  3382. R : TRect;
  3383. begin
  3384. Desktop^.GetExtent(R);
  3385. R.A.X:=R.B.X-44;
  3386. R.B.Y:=R.A.Y+14;
  3387. inherited Init(R,dialog_fpu, wnNoNumber);
  3388. Flags:=wfClose or wfMove;
  3389. Palette:=wpCyanWindow;
  3390. HelpCtx:=hcFPURegisters;
  3391. R.Assign(1,1,42,13);
  3392. RV:=new(PFPUView,init(R));
  3393. Insert(RV);
  3394. If assigned(FPUWindow) then
  3395. dispose(FPUWindow,done);
  3396. FPUWindow:=@Self;
  3397. Update;
  3398. end;
  3399. constructor TFPUWindow.Load(var S: TStream);
  3400. begin
  3401. inherited load(S);
  3402. GetSubViewPtr(S,RV);
  3403. If assigned(FPUWindow) then
  3404. dispose(FPUWindow,done);
  3405. FPUWindow:=@Self;
  3406. end;
  3407. procedure TFPUWindow.Store(var S: TStream);
  3408. begin
  3409. inherited Store(s);
  3410. PutSubViewPtr(S,RV);
  3411. end;
  3412. procedure TFPUWindow.Update;
  3413. begin
  3414. ReDraw;
  3415. end;
  3416. destructor TFPUWindow.Done;
  3417. begin
  3418. FPUWindow:=nil;
  3419. inherited done;
  3420. end;
  3421. {****************************************************************************
  3422. TStackWindow
  3423. ****************************************************************************}
  3424. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3425. begin
  3426. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3427. end;
  3428. procedure TFramesListBox.Update;
  3429. var i : longint;
  3430. W : PSourceWindow;
  3431. begin
  3432. { call backtrace command }
  3433. If not assigned(Debugger) then
  3434. exit;
  3435. {$ifndef NODEBUG}
  3436. DeskTop^.Lock;
  3437. Clear;
  3438. { forget all old frames }
  3439. Debugger^.clear_frames;
  3440. if Debugger^.WindowWidth<>-1 then
  3441. Debugger^.Command('set width 0xffffffff');
  3442. Debugger^.Command('backtrace');
  3443. { generate list }
  3444. { all is in tframeentry }
  3445. for i:=0 to Debugger^.frame_count-1 do
  3446. begin
  3447. with Debugger^.frames[i]^ do
  3448. begin
  3449. if assigned(file_name) then
  3450. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3451. AddModuleName(GetPChar(file_name)),line_number,1)))
  3452. else
  3453. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3454. AddModuleName(''),line_number,1)));
  3455. W:=SearchOnDesktop(GetPChar(file_name),false);
  3456. { First reset all Debugger rows }
  3457. If assigned(W) then
  3458. begin
  3459. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3460. W^.Editor^.DebuggerRow:=-1;
  3461. end;
  3462. end;
  3463. end;
  3464. { Now set all Debugger rows }
  3465. for i:=0 to Debugger^.frame_count-1 do
  3466. begin
  3467. with Debugger^.frames[i]^ do
  3468. begin
  3469. W:=SearchOnDesktop(GetPChar(file_name),false);
  3470. If assigned(W) then
  3471. begin
  3472. If W^.Editor^.DebuggerRow=-1 then
  3473. begin
  3474. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3475. W^.Editor^.DebuggerRow:=line_number-1;
  3476. end;
  3477. end;
  3478. end;
  3479. end;
  3480. if Assigned(list) and (List^.Count > 0) then
  3481. FocusItem(0);
  3482. if Debugger^.WindowWidth<>-1 then
  3483. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3484. DeskTop^.Unlock;
  3485. {$endif}
  3486. end;
  3487. function TFramesListBox.GetLocalMenu: PMenu;
  3488. begin
  3489. GetLocalMenu:=Inherited GetLocalMenu;
  3490. end;
  3491. procedure TFramesListBox.GotoSource;
  3492. begin
  3493. { select frame for watches }
  3494. If not assigned(Debugger) then
  3495. exit;
  3496. {$ifndef NODEBUG}
  3497. Debugger^.Command('f '+IntToStr(Focused));
  3498. { for local vars }
  3499. Debugger^.ReadWatches;
  3500. {$endif}
  3501. { goto source }
  3502. inherited GotoSource;
  3503. end;
  3504. procedure TFramesListBox.GotoAssembly;
  3505. begin
  3506. { select frame for watches }
  3507. If not assigned(Debugger) then
  3508. exit;
  3509. {$ifndef NODEBUG}
  3510. Debugger^.Command('f '+IntToStr(Focused));
  3511. { for local vars }
  3512. Debugger^.ReadWatches;
  3513. {$endif}
  3514. { goto source/assembly mixture }
  3515. InitDisassemblyWindow;
  3516. DisassemblyWindow^.LoadFunction('');
  3517. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3518. DisassemblyWindow^.SelectInDebugSession;
  3519. end;
  3520. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3521. begin
  3522. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3523. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3524. GotoAssembly;
  3525. inherited HandleEvent(Event);
  3526. end;
  3527. destructor TFramesListBox.Done;
  3528. begin
  3529. Inherited Done;
  3530. end;
  3531. Constructor TStackWindow.Init;
  3532. var
  3533. HSB,VSB: PScrollBar;
  3534. R,R2 : trect;
  3535. begin
  3536. Desktop^.GetExtent(R);
  3537. R.A.Y:=R.B.Y-5;
  3538. inherited Init(R, dialog_callstack, wnNoNumber);
  3539. Palette:=wpCyanWindow;
  3540. GetExtent(R);
  3541. HelpCtx:=hcStackWindow;
  3542. R.Grow(-1,-1);
  3543. R2.Copy(R);
  3544. Inc(R2.B.Y);
  3545. R2.A.Y:=R2.B.Y-1;
  3546. New(HSB, Init(R2));
  3547. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3548. Insert(HSB);
  3549. R2.Copy(R);
  3550. Inc(R2.B.X);
  3551. R2.A.X:=R2.B.X-1;
  3552. New(VSB, Init(R2));
  3553. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3554. Insert(VSB);
  3555. New(FLB,Init(R,HSB,VSB));
  3556. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3557. Insert(FLB);
  3558. If assigned(StackWindow) then
  3559. dispose(StackWindow,done);
  3560. StackWindow:=@Self;
  3561. Update;
  3562. end;
  3563. procedure TStackWindow.Update;
  3564. begin
  3565. FLB^.Update;
  3566. DrawView;
  3567. end;
  3568. constructor TStackWindow.Load(var S: TStream);
  3569. begin
  3570. inherited Load(S);
  3571. GetSubViewPtr(S,FLB);
  3572. If assigned(StackWindow) then
  3573. dispose(StackWindow,done);
  3574. StackWindow:=@Self;
  3575. end;
  3576. procedure TStackWindow.Store(var S: TStream);
  3577. begin
  3578. inherited Store(S);
  3579. PutSubViewPtr(S,FLB);
  3580. end;
  3581. Destructor TStackWindow.Done;
  3582. begin
  3583. StackWindow:=nil;
  3584. Dispose(FLB,done);
  3585. inherited done;
  3586. end;
  3587. {****************************************************************************
  3588. Init/Final
  3589. ****************************************************************************}
  3590. procedure InitDebugger;
  3591. {$ifdef DEBUG}
  3592. var s : string;
  3593. i,p : longint;
  3594. {$endif DEBUG}
  3595. var
  3596. NeedRecompileExe : boolean;
  3597. cm : longint;
  3598. begin
  3599. {$ifdef DEBUG}
  3600. if not use_gdb_file then
  3601. begin
  3602. Assign(gdb_file,GDBOutFileName);
  3603. {$I-}
  3604. Rewrite(gdb_file);
  3605. if InOutRes<>0 then
  3606. begin
  3607. s:=GDBOutFileName;
  3608. p:=pos('.',s);
  3609. if p>1 then
  3610. for i:=0 to 9 do
  3611. begin
  3612. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3613. InOutRes:=0;
  3614. Assign(gdb_file,s);
  3615. rewrite(gdb_file);
  3616. if InOutRes=0 then
  3617. break;
  3618. end;
  3619. end;
  3620. if IOResult=0 then
  3621. Use_gdb_file:=true;
  3622. end;
  3623. {$I+}
  3624. {$endif}
  3625. NeedRecompileExe:=false;
  3626. if TargetSwitches^.GetCurrSelParam<>{$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname then
  3627. begin
  3628. ClearFormatParams;
  3629. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3630. AddFormatParamStr({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3631. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3632. if cm=cmCancel then
  3633. Exit;
  3634. if cm=cmYes then
  3635. begin
  3636. { force recompilation }
  3637. PrevMainFile:='';
  3638. NeedRecompileExe:=true;
  3639. TargetSwitches^.SetCurrSelParam({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3640. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3641. DebugInfoSwitches^.SetCurrSelParam('l');
  3642. IDEApp.UpdateTarget;
  3643. end;
  3644. end;
  3645. if not NeedRecompileExe then
  3646. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3647. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3648. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3649. begin
  3650. ClearFormatParams;
  3651. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3652. if cm=cmCancel then
  3653. Exit;
  3654. if cm=cmYes then
  3655. begin
  3656. { force recompilation }
  3657. PrevMainFile:='';
  3658. NeedRecompileExe:=true;
  3659. DebugInfoSwitches^.SetCurrSelParam('l');
  3660. end;
  3661. end;
  3662. if NeedRecompileExe then
  3663. DoCompile(cRun);
  3664. if CompilationPhase<>cpDone then
  3665. Exit;
  3666. if (EXEFile='') then
  3667. begin
  3668. ErrorBox(msg_nothingtodebug,nil);
  3669. Exit;
  3670. end;
  3671. { init debugcontroller }
  3672. if not assigned(Debugger) then
  3673. begin
  3674. PushStatus(msg_startingdebugger);
  3675. new(Debugger,Init);
  3676. PopStatus;
  3677. end;
  3678. Debugger^.SetExe(ExeFile);
  3679. {$ifdef GDBWINDOW}
  3680. InitGDBWindow;
  3681. {$endif def GDBWINDOW}
  3682. end;
  3683. procedure DoneDebugger;
  3684. begin
  3685. {$ifdef DEBUG}
  3686. If IDEApp.IsRunning then
  3687. PushStatus('Closing debugger');
  3688. {$endif}
  3689. if assigned(Debugger) then
  3690. dispose(Debugger,Done);
  3691. Debugger:=nil;
  3692. {$ifdef DEBUG}
  3693. If Use_gdb_file then
  3694. begin
  3695. Use_gdb_file:=false;
  3696. Close(GDB_file);
  3697. end;
  3698. If IDEApp.IsRunning then
  3699. PopStatus;
  3700. {$endif DEBUG}
  3701. end;
  3702. procedure InitGDBWindow;
  3703. var
  3704. R : TRect;
  3705. begin
  3706. if GDBWindow=nil then
  3707. begin
  3708. DeskTop^.GetExtent(R);
  3709. new(GDBWindow,init(R));
  3710. DeskTop^.Insert(GDBWindow);
  3711. end;
  3712. end;
  3713. procedure DoneGDBWindow;
  3714. begin
  3715. If IDEApp.IsRunning and
  3716. assigned(GDBWindow) then
  3717. begin
  3718. DeskTop^.Delete(GDBWindow);
  3719. end;
  3720. GDBWindow:=nil;
  3721. end;
  3722. procedure InitDisassemblyWindow;
  3723. var
  3724. R : TRect;
  3725. begin
  3726. if DisassemblyWindow=nil then
  3727. begin
  3728. DeskTop^.GetExtent(R);
  3729. new(DisassemblyWindow,init(R));
  3730. DeskTop^.Insert(DisassemblyWindow);
  3731. end;
  3732. end;
  3733. procedure DoneDisassemblyWindow;
  3734. begin
  3735. if assigned(DisassemblyWindow) then
  3736. begin
  3737. DeskTop^.Delete(DisassemblyWindow);
  3738. Dispose(DisassemblyWindow,Done);
  3739. DisassemblyWindow:=nil;
  3740. end;
  3741. end;
  3742. procedure InitStackWindow;
  3743. begin
  3744. if StackWindow=nil then
  3745. begin
  3746. new(StackWindow,init);
  3747. DeskTop^.Insert(StackWindow);
  3748. end;
  3749. end;
  3750. procedure DoneStackWindow;
  3751. begin
  3752. if assigned(StackWindow) then
  3753. begin
  3754. DeskTop^.Delete(StackWindow);
  3755. StackWindow:=nil;
  3756. end;
  3757. end;
  3758. procedure InitRegistersWindow;
  3759. begin
  3760. if RegistersWindow=nil then
  3761. begin
  3762. new(RegistersWindow,init);
  3763. DeskTop^.Insert(RegistersWindow);
  3764. end;
  3765. end;
  3766. procedure DoneRegistersWindow;
  3767. begin
  3768. if assigned(RegistersWindow) then
  3769. begin
  3770. DeskTop^.Delete(RegistersWindow);
  3771. RegistersWindow:=nil;
  3772. end;
  3773. end;
  3774. procedure InitFPUWindow;
  3775. begin
  3776. if FPUWindow=nil then
  3777. begin
  3778. new(FPUWindow,init);
  3779. DeskTop^.Insert(FPUWindow);
  3780. end;
  3781. end;
  3782. procedure DoneFPUWindow;
  3783. begin
  3784. if assigned(FPUWindow) then
  3785. begin
  3786. DeskTop^.Delete(FPUWindow);
  3787. FPUWindow:=nil;
  3788. end;
  3789. end;
  3790. procedure InitBreakpoints;
  3791. begin
  3792. New(BreakpointsCollection,init(10,10));
  3793. end;
  3794. procedure DoneBreakpoints;
  3795. begin
  3796. Dispose(BreakpointsCollection,Done);
  3797. BreakpointsCollection:=nil;
  3798. end;
  3799. procedure InitWatches;
  3800. begin
  3801. New(WatchesCollection,init);
  3802. end;
  3803. procedure DoneWatches;
  3804. begin
  3805. Dispose(WatchesCollection,Done);
  3806. WatchesCollection:=nil;
  3807. end;
  3808. procedure RegisterFPDebugViews;
  3809. begin
  3810. RegisterType(RWatchesWindow);
  3811. RegisterType(RBreakpointsWindow);
  3812. RegisterType(RWatchesListBox);
  3813. RegisterType(RBreakpointsListBox);
  3814. RegisterType(RStackWindow);
  3815. RegisterType(RFramesListBox);
  3816. RegisterType(RBreakpoint);
  3817. RegisterType(RWatch);
  3818. RegisterType(RBreakpointCollection);
  3819. RegisterType(RWatchesCollection);
  3820. RegisterType(RRegistersWindow);
  3821. RegisterType(RRegistersView);
  3822. RegisterType(RFPUWindow);
  3823. RegisterType(RFPUView);
  3824. end;
  3825. end.
  3826. {
  3827. $Log$
  3828. Revision 1.25 2002-09-03 13:59:47 pierre
  3829. + added history for watches and breakpoints
  3830. Revision 1.24 2002/09/02 10:18:09 pierre
  3831. * fix problems with breakpoint lists
  3832. Revision 1.23 2002/08/13 08:59:12 pierre
  3833. + Run menu changes depending on wether the debuggee is running or not
  3834. Revision 1.22 2002/08/13 07:15:02 pierre
  3835. + Disable all invalid breakpoints feature added
  3836. Revision 1.21 2002/06/10 19:26:48 pierre
  3837. * check if DebuggeTTY is a valid terminal
  3838. Revision 1.20 2002/06/06 14:11:25 pierre
  3839. * handle win32 Ctrl-C change for graphic version
  3840. Revision 1.19 2002/06/06 08:16:18 pierre
  3841. * avoid crashes if quitting while debuggee is running
  3842. Revision 1.18 2002/04/25 13:33:31 pierre
  3843. * fix the problem with dirs containing asterisks
  3844. Revision 1.17 2002/04/17 11:11:54 pierre
  3845. * avoid problems for ClassVariable in Watches window
  3846. Revision 1.16 2002/04/11 06:41:13 pierre
  3847. * fix problem of TWatchesListBox with fvision
  3848. Revision 1.15 2002/04/03 06:18:30 pierre
  3849. * fix some win32 GDB filename problems
  3850. Revision 1.14 2002/04/02 15:09:38 pierre
  3851. * fixed wrong exit without unlock
  3852. Revision 1.13 2002/04/02 13:23:54 pierre
  3853. * Use StrToCard and HexToCard functions to avoid signed/unsigned overflows
  3854. Revision 1.12 2002/04/02 12:20:58 pierre
  3855. * fix problem with breakpoints in subdirs
  3856. Revision 1.11 2002/04/02 11:10:29 pierre
  3857. * fix FPC_BREAK_ERROR problem and avoid blinking J
  3858. Revision 1.10 2002/03/27 11:24:09 pierre
  3859. * fix several problems related to long file nmze support for win32 exes
  3860. Revision 1.9 2002/02/06 14:45:00 pierre
  3861. + handle signals
  3862. Revision 1.8 2001/11/10 00:11:45 pierre
  3863. * change target menu name if target changed to become debug-able
  3864. Revision 1.7 2001/11/07 00:28:52 pierre
  3865. + Disassembly window made public
  3866. Revision 1.6 2001/10/14 14:16:06 peter
  3867. * fixed typo for linux
  3868. Revision 1.5 2001/10/11 11:39:35 pierre
  3869. * better NoSwitch check for unix
  3870. Revision 1.4 2001/09/12 09:48:38 pierre
  3871. + SetDirectories method added to help for disassembly window
  3872. Revision 1.3 2001/08/07 22:58:10 pierre
  3873. * watches display enhanced and crashes removed
  3874. Revision 1.2 2001/08/05 02:01:47 peter
  3875. * FVISION define to compile with fvision units
  3876. Revision 1.1 2001/08/04 11:30:23 peter
  3877. * ide works now with both compiler versions
  3878. Revision 1.1.2.35 2001/08/03 13:33:51 pierre
  3879. * better looking m68k flags
  3880. Revision 1.1.2.34 2001/07/31 21:40:42 pierre
  3881. * fix typo erros in last commit
  3882. Revision 1.1.2.33 2001/07/31 15:12:45 pierre
  3883. + some m68k register support
  3884. Revision 1.1.2.32 2001/07/29 22:12:23 peter
  3885. * fixed private symbol that needs to be public
  3886. Revision 1.1.2.31 2001/06/13 16:22:02 pierre
  3887. * use CygdrivePrefix function for win32
  3888. Revision 1.1.2.30 2001/04/10 11:50:09 pierre
  3889. * only stop if erroraddress or exitcode non zero
  3890. + reset the file in DoneDebugger to avoid problem
  3891. if the executable file remains opened by GDB when recompiling
  3892. Revision 1.1.2.29 2001/03/22 17:28:57 pierre
  3893. * more stuff for stop at exit if error
  3894. Revision 1.1.2.28 2001/03/22 01:14:08 pierre
  3895. * work on Exit breakpoint if error
  3896. Revision 1.1.2.27 2001/03/20 00:20:42 pierre
  3897. * fix some memory leaks + several small enhancements
  3898. Revision 1.1.2.26 2001/03/15 17:45:19 pierre
  3899. * avoid to get the values of expressions twice
  3900. Revision 1.1.2.25 2001/03/15 17:08:52 pierre
  3901. * avoid extra info past watches values
  3902. Revision 1.1.2.24 2001/03/13 00:36:44 pierre
  3903. * small DisassemblyWindow fixes
  3904. Revision 1.1.2.23 2001/03/12 17:34:54 pierre
  3905. + Disassembly window started
  3906. Revision 1.1.2.22 2001/03/09 15:08:12 pierre
  3907. * Watches list reorganised so that the behavior
  3908. is more near to BP one.
  3909. + First version of FPU window for i386.
  3910. Revision 1.1.2.21 2001/03/08 16:41:03 pierre
  3911. * correct watch horizontal scrolling
  3912. Revision 1.1.2.20 2001/03/06 22:42:22 pierre
  3913. * check for modifed open files at stop of beguggee
  3914. Revision 1.1.2.19 2001/03/06 21:44:13 pierre
  3915. * avoid problems if recompiling in debug session
  3916. Revision 1.1.2.18 2001/01/09 11:49:30 pierre
  3917. * fix DebugRow highlighting problem if Call Stack Window is open
  3918. Revision 1.1.2.17 2001/01/07 22:37:41 peter
  3919. * quiting gdbwindow works now
  3920. Revision 1.1.2.16 2000/12/13 16:58:11 pierre
  3921. * AllowQuit changed, still does not work correctly :(
  3922. Revision 1.1.2.15 2000/11/29 18:28:51 pierre
  3923. + add save to file capability for list boxes
  3924. Revision 1.1.2.14 2000/11/29 11:25:59 pierre
  3925. + TFPDlgWindow that handles cmSearchWindow
  3926. Revision 1.1.2.13 2000/11/29 00:54:44 pierre
  3927. + preserve window number and save special windows
  3928. Revision 1.1.2.12 2000/11/27 17:41:45 pierre
  3929. * better GDB window opening if nothing compiled yet
  3930. Revision 1.1.2.11 2000/11/16 23:06:30 pierre
  3931. * correct handling of Compile/Make if primary file is set
  3932. Revision 1.1.2.10 2000/11/14 17:40:42 pierre
  3933. + External linking now optional
  3934. Revision 1.1.2.9 2000/11/14 09:23:55 marco
  3935. * Second batch
  3936. Revision 1.1.2.8 2000/11/13 16:59:08 pierre
  3937. * some function in double removed from fputils unit
  3938. Revision 1.1.2.7 2000/10/31 07:47:54 pierre
  3939. * start to support FPC_BREAK_ERROR
  3940. Revision 1.1.2.6 2000/10/26 00:04:35 pierre
  3941. + gdb prompt and FPC_BREAK_ERROR stop
  3942. Revision 1.1.2.5 2000/10/09 19:48:15 pierre
  3943. * wrong commit corrected
  3944. Revision 1.1.2.4 2000/10/09 16:28:24 pierre
  3945. * several linux enhancements
  3946. Revision 1.1.2.3 2000/10/06 22:52:34 pierre
  3947. * fixes for linux GDB tty command
  3948. Revision 1.1.2.2 2000/09/22 12:02:34 jonas
  3949. * corrected command for running user program in other tty under linux
  3950. (doesn't work yet though)
  3951. Revision 1.1.2.1 2000/07/18 05:50:22 michael
  3952. + Merged Gabors fixes
  3953. Revision 1.1 2000/07/13 09:48:34 michael
  3954. + Initial import
  3955. Revision 1.63 2000/06/22 09:07:11 pierre
  3956. * Gabor changes: see fixes.txt
  3957. Revision 1.62 2000/06/11 07:01:32 peter
  3958. * give watches window also a number
  3959. * leave watches window in the bottom when cascading windows
  3960. Revision 1.61 2000/05/02 08:42:27 pierre
  3961. * new set of Gabor changes: see fixes.txt
  3962. Revision 1.60 2000/04/18 21:45:35 pierre
  3963. * Red line for breakpoint was off by one line
  3964. Revision 1.59 2000/04/18 11:42:36 pierre
  3965. lot of Gabor changes : see fixes.txt
  3966. Revision 1.58 2000/03/21 23:32:38 pierre
  3967. adapted to wcedit addition by Gabor
  3968. Revision 1.57 2000/03/14 14:22:30 pierre
  3969. + generate cmDebuggerStopped broadcast
  3970. Revision 1.56 2000/03/08 16:57:01 pierre
  3971. * Wrong highlighted line while debugging fixed
  3972. + Check if exe has debugging info
  3973. Revision 1.55 2000/03/07 21:52:54 pierre
  3974. + TDebugController.GetValue
  3975. Revision 1.54 2000/03/06 11:34:25 pierre
  3976. + windebug unit for Window Title change when debugging
  3977. Revision 1.53 2000/02/07 12:51:32 pierre
  3978. * typo fix
  3979. Revision 1.52 2000/02/07 11:50:30 pierre
  3980. Gabor changes for TP
  3981. Revision 1.51 2000/02/06 23:43:57 pierre
  3982. * breakpoint path problems fixes
  3983. Revision 1.50 2000/02/05 01:27:58 pierre
  3984. * bug with Toggle Break fixed, hopefully
  3985. + search for local vars in parent procs avoiding
  3986. wrong results (see test.pas source)
  3987. Revision 1.49 2000/02/04 23:18:05 pierre
  3988. * no pushstatus in DoneDebugger because its called after App.done
  3989. Revision 1.48 2000/02/04 14:34:46 pierre
  3990. readme.txt
  3991. Revision 1.47 2000/02/04 00:10:58 pierre
  3992. * Breakpoint line in Source Window better handled
  3993. Revision 1.46 2000/02/01 10:59:58 pierre
  3994. * allow FP to debug itself
  3995. Revision 1.45 2000/01/28 22:38:21 pierre
  3996. * CrtlF9 starts debugger if there are active breakpoints
  3997. Revision 1.44 2000/01/27 22:30:38 florian
  3998. * start of FPU window
  3999. * current executed line color has a higher priority then a breakpoint now
  4000. Revision 1.43 2000/01/20 00:31:53 pierre
  4001. * uses ShortName of exe to start GDB
  4002. Revision 1.42 2000/01/10 17:49:40 pierre
  4003. * Get RegisterView to Update correctly
  4004. * Write in white changed regs (keeping a copy of previous values)
  4005. Revision 1.41 2000/01/10 16:20:50 florian
  4006. * working register window
  4007. Revision 1.40 2000/01/10 13:20:57 pierre
  4008. + debug only possible on source target
  4009. Revision 1.39 2000/01/10 00:25:06 pierre
  4010. * RegisterWindow problem fixed
  4011. Revision 1.38 2000/01/09 21:05:51 florian
  4012. * some fixes for register view
  4013. Revision 1.37 2000/01/08 18:26:20 florian
  4014. + added a register window, doesn't work yet
  4015. Revision 1.36 1999/12/20 14:23:16 pierre
  4016. * MyApp renamed IDEApp
  4017. * TDebugController.ResetDebuggerRows added to
  4018. get resetting of debugger rows
  4019. Revision 1.35 1999/11/24 14:03:16 pierre
  4020. + Executing... in status line if in another window
  4021. Revision 1.34 1999/11/10 17:19:58 pierre
  4022. + Other window for Debuggee code
  4023. Revision 1.33 1999/10/25 16:39:03 pierre
  4024. + GetPChar to avoid nil pointer problems
  4025. Revision 1.32 1999/09/16 14:34:57 pierre
  4026. + TBreakpoint and TWatch registering
  4027. + WatchesCollection and BreakpointsCollection stored in desk file
  4028. * Syntax highlighting was broken
  4029. Revision 1.31 1999/09/13 16:24:43 peter
  4030. + clock
  4031. * backspace unident like tp7
  4032. Revision 1.30 1999/09/09 16:36:30 pierre
  4033. * Breakpoint storage problem corrected
  4034. Revision 1.29 1999/09/09 16:31:45 pierre
  4035. * some breakpoint related fixes and Help contexts
  4036. Revision 1.28 1999/09/09 14:20:05 pierre
  4037. + Stack Window
  4038. Revision 1.27 1999/08/24 22:04:33 pierre
  4039. + TCodeEditor.SetDebuggerRow
  4040. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  4041. so the current stop point in debugging is not lost if
  4042. we move the cursor
  4043. Revision 1.26 1999/08/22 22:26:48 pierre
  4044. + Registration of Breakpoint/Watches windows
  4045. Revision 1.25 1999/08/16 18:25:15 peter
  4046. * Adjusting the selection when the editor didn't contain any line.
  4047. * Reserved word recognition redesigned, but this didn't affect the overall
  4048. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  4049. The syntax scanner loop is a bit slow but the main problem is the
  4050. recognition of special symbols. Switching off symbol processing boosts
  4051. the performance up to ca. 200%...
  4052. * The editor didn't allow copying (for ex to clipboard) of a single character
  4053. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  4054. * Compiler Messages window (actually the whole desktop) did not act on any
  4055. keypress when compilation failed and thus the window remained visible
  4056. + Message windows are now closed upon pressing Esc
  4057. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  4058. only when neccessary
  4059. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  4060. + LineSelect (Ctrl+K+L) implemented
  4061. * The IDE had problems closing help windows before saving the desktop
  4062. Revision 1.24 1999/08/03 20:22:28 peter
  4063. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  4064. + Desktop saving should work now
  4065. - History saved
  4066. - Clipboard content saved
  4067. - Desktop saved
  4068. - Symbol info saved
  4069. * syntax-highlight bug fixed, which compared special keywords case sensitive
  4070. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  4071. * with 'whole words only' set, the editor didn't found occourences of the
  4072. searched text, if the text appeared previously in the same line, but didn't
  4073. satisfied the 'whole-word' condition
  4074. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  4075. (ie. the beginning of the selection)
  4076. * when started typing in a new line, but not at the start (X=0) of it,
  4077. the editor inserted the text one character more to left as it should...
  4078. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  4079. * Shift shouldn't cause so much trouble in TCodeEditor now...
  4080. * Syntax highlight had problems recognizing a special symbol if it was
  4081. prefixed by another symbol character in the source text
  4082. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  4083. Revision 1.23 1999/07/28 23:11:17 peter
  4084. * fixes from gabor
  4085. Revision 1.22 1999/07/12 13:14:15 pierre
  4086. * LineEnd bug corrected, now goes end of text even if selected
  4087. + Until Return for debugger
  4088. + Code for Quit inside GDB Window
  4089. Revision 1.21 1999/07/11 00:35:14 pierre
  4090. * fix problems for wrong watches
  4091. Revision 1.20 1999/07/10 01:24:14 pierre
  4092. + First implementation of watches window
  4093. Revision 1.19 1999/06/30 23:58:12 pierre
  4094. + BreakpointsList Window implemented
  4095. with Edit/New/Delete functions
  4096. + Individual breakpoint dialog with support for all types
  4097. ignorecount and conditions
  4098. (commands are not yet implemented, don't know if this wolud be useful)
  4099. awatch and rwatch have problems because GDB does not annotate them
  4100. I fixed v4.16 for this
  4101. Revision 1.18 1999/03/16 00:44:42 peter
  4102. * forgotten in last commit :(
  4103. Revision 1.17 1999/03/02 13:48:28 peter
  4104. * fixed far problem is fpdebug
  4105. * tile/cascading with message window
  4106. * grep fixes
  4107. Revision 1.16 1999/03/01 15:41:52 peter
  4108. + Added dummy entries for functions not yet implemented
  4109. * MenuBar didn't update itself automatically on command-set changes
  4110. * Fixed Debugging/Profiling options dialog
  4111. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  4112. set
  4113. * efBackSpaceUnindents works correctly
  4114. + 'Messages' window implemented
  4115. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  4116. + Added TP message-filter support (for ex. you can call GREP thru
  4117. GREP2MSG and view the result in the messages window - just like in TP)
  4118. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  4119. so topic search didn't work...
  4120. * In FPHELP.PAS there were still context-variables defined as word instead
  4121. of THelpCtx
  4122. * StdStatusKeys() was missing from the statusdef for help windows
  4123. + Topic-title for index-table can be specified when adding a HTML-files
  4124. Revision 1.15 1999/02/20 15:18:29 peter
  4125. + ctrl-c capture with confirm dialog
  4126. + ascii table in the tools menu
  4127. + heapviewer
  4128. * empty file fixed
  4129. * fixed callback routines in fpdebug to have far for tp7
  4130. Revision 1.14 1999/02/16 12:47:36 pierre
  4131. * GDBWindow does not popup on F7 or F8 anymore
  4132. Revision 1.13 1999/02/16 10:43:54 peter
  4133. * use -dGDB for the compiler
  4134. * only use gdb_file when -dDEBUG is used
  4135. * profiler switch is now a toggle instead of radiobutton
  4136. Revision 1.12 1999/02/11 19:07:20 pierre
  4137. * GDBWindow redesigned :
  4138. normal editor apart from
  4139. that any kbEnter will send the line (for begin to cursor)
  4140. to GDB command !
  4141. GDBWindow opened in Debugger Menu
  4142. still buggy :
  4143. -echo should not be present if at end of text
  4144. -GDBWindow becomes First after each step (I don't know why !)
  4145. Revision 1.11 1999/02/11 13:10:03 pierre
  4146. + GDBWindow only with -dGDBWindow for now : still buggy !!
  4147. Revision 1.10 1999/02/10 09:55:07 pierre
  4148. + added OldValue and CurrentValue field for watchpoints
  4149. + InitBreakpoints and DoneBreakpoints
  4150. + MessageBox if GDB stops bacause of a watchpoint !
  4151. Revision 1.9 1999/02/08 17:43:43 pierre
  4152. * RestDebugger or multiple running of debugged program now works
  4153. + added DoContToCursor(F4)
  4154. * Breakpoints are now inserted correctly (was mainlyy a problem
  4155. of directories)
  4156. Revision 1.8 1999/02/05 17:21:52 pierre
  4157. Invalid_line renamed InvalidSourceLine
  4158. Revision 1.7 1999/02/05 13:08:41 pierre
  4159. + new breakpoint types added
  4160. Revision 1.6 1999/02/05 12:11:53 pierre
  4161. + SourceDir that stores directories for sources that the
  4162. compiler should not know about
  4163. Automatically asked for addition when a new file that
  4164. needed filedialog to be found is in an unknown directory
  4165. Stored and retrieved from INIFile
  4166. + Breakpoints conditions added to INIFile
  4167. * Breakpoints insterted and removed at debin and end of debug session
  4168. Revision 1.5 1999/02/04 17:54:22 pierre
  4169. + several commands added
  4170. Revision 1.4 1999/02/04 13:32:02 pierre
  4171. * Several things added (I cannot commit them independently !)
  4172. + added TBreakpoint and TBreakpointCollection
  4173. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  4174. + Breakpoint list in INIFile
  4175. * Select items now also depend of SwitchMode
  4176. * Reading of option '-g' was not possible !
  4177. + added search for -Fu args pathes in TryToOpen
  4178. + added code for automatic opening of FileDialog
  4179. if source not found
  4180. Revision 1.3 1999/02/02 16:41:38 peter
  4181. + automatic .pas/.pp adding by opening of file
  4182. * better debuggerscreen changes
  4183. Revision 1.2 1999/01/22 18:14:09 pierre
  4184. * adaptd to changes in gdbint and gdbcon for to /
  4185. Revision 1.1 1999/01/22 10:24:03 peter
  4186. * first debugger things
  4187. }