fpdebug.pas 94 KB

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