fpdebug.pas 95 KB

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