fpdebug.pas 121 KB

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