fpdebug.pas 99 KB

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