fpdebug.pas 98 KB

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