fpdebug.pas 94 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998-2000 by Pierre Muller
  4. Debugger call routines for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPDebug;
  12. {$ifdef NODEBUG}
  13. interface
  14. implementation
  15. end.
  16. {$else}
  17. interface
  18. {$i globdir.inc}
  19. uses
  20. {$ifdef Windows}
  21. Windows,
  22. {$endif Windows}
  23. Objects,Dialogs,Drivers,Views,
  24. {$ifndef NODEBUG}
  25. GDBCon,GDBInt,
  26. {$endif NODEBUG}
  27. Menus,
  28. WViews,WEditor,
  29. FPViews;
  30. type
  31. {$ifndef NODEBUG}
  32. PDebugController=^TDebugController;
  33. TDebugController=object(TGDBController)
  34. InvalidSourceLine : boolean;
  35. { if true the current debugger raw will stay in middle of
  36. editor window when debugging PM }
  37. CenterDebuggerRow : TCentre;
  38. Disableallinvalidbreakpoints : boolean;
  39. OrigPwd, { pwd at startup }
  40. LastFileName : string;
  41. LastSource : PView; {PsourceWindow !! }
  42. HiddenStepsCount : longint;
  43. { no need to switch if using another terminal }
  44. NoSwitch : boolean;
  45. HasExe : boolean;
  46. RunCount : longint;
  47. WindowWidth : longint;
  48. FPCBreakErrorNumber : longint;
  49. {$ifdef SUPPORT_REMOTE}
  50. isRemoteDebugging:boolean;
  51. {$endif SUPPORT_REMOTE}
  52. constructor Init;
  53. procedure SetExe(const exefn:string);
  54. procedure SetWidth(AWidth : longint);
  55. procedure SetSourceDirs;
  56. destructor Done;
  57. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  58. { procedure DoStartSession;virtual;
  59. procedure DoBreakSession;virtual;}
  60. procedure DoEndSession(code:longint);virtual;
  61. procedure DoUserSignal;virtual;
  62. procedure AnnotateError;
  63. procedure InsertBreakpoints;
  64. procedure RemoveBreakpoints;
  65. procedure ReadWatches;
  66. procedure RereadWatches;
  67. procedure ResetBreakpointsValues;
  68. procedure DoDebuggerScreen;virtual;
  69. procedure DoUserScreen;virtual;
  70. procedure Reset;virtual;
  71. procedure ResetDebuggerRows;
  72. procedure Run;virtual;
  73. procedure Continue;virtual;
  74. procedure UntilReturn;virtual;
  75. procedure CommandBegin(const s:string);virtual;
  76. procedure CommandEnd(const s:string);virtual;
  77. function IsRunning : boolean;
  78. function AllowQuit : boolean;virtual;
  79. function GetValue(Const expr : string) : pchar;
  80. function GetFramePointer : CORE_ADDR;
  81. function GetLongintAt(addr : CORE_ADDR) : longint;
  82. function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  83. end;
  84. {$endif NODEBUG}
  85. BreakpointType = (bt_function,bt_file_line,bt_watch,
  86. bt_awatch,bt_rwatch,bt_address,bt_invalid);
  87. BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after);
  88. PBreakpointCollection=^TBreakpointCollection;
  89. PBreakpoint=^TBreakpoint;
  90. TBreakpoint=object(TObject)
  91. typ : BreakpointType;
  92. state : BreakpointState;
  93. owner : PBreakpointCollection;
  94. Name : PString; { either function name or expr to watch }
  95. FileName : PString;
  96. OldValue,CurrentValue : Pstring;
  97. Line : Longint; { only used for bt_file_line type }
  98. Conditions : PString; { conditions relative to that breakpoint }
  99. IgnoreCount : Longint; { how many counts should be ignored }
  100. Commands : pchar; { commands that should be executed on breakpoint }
  101. GDBIndex : longint;
  102. GDBState : BreakpointState;
  103. constructor Init_function(Const AFunc : String);
  104. constructor Init_Address(Const AAddress : String);
  105. constructor Init_Empty;
  106. constructor Init_file_line(AFile : String; ALine : longint);
  107. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  108. constructor Load(var S: TStream);
  109. procedure Store(var S: TStream);
  110. procedure Insert;
  111. procedure Remove;
  112. procedure Enable;
  113. procedure Disable;
  114. procedure UpdateSource;
  115. procedure ResetValues;
  116. destructor Done;virtual;
  117. end;
  118. TBreakpointCollection=object(TCollection)
  119. function At(Index: Integer): PBreakpoint;
  120. function GetGDB(index : longint) : PBreakpoint;
  121. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  122. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  123. procedure Update;
  124. procedure ShowBreakpoints(W : PFPWindow);
  125. function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  126. procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  127. procedure ShowAllBreakpoints;
  128. end;
  129. PBreakpointItem = ^TBreakpointItem;
  130. TBreakpointItem = object(TObject)
  131. Breakpoint : PBreakpoint;
  132. constructor Init(ABreakpoint : PBreakpoint);
  133. function GetText(MaxLen: Sw_integer): string; virtual;
  134. procedure Selected; virtual;
  135. function GetModuleName: string; virtual;
  136. end;
  137. PBreakpointsListBox = ^TBreakpointsListBox;
  138. TBreakpointsListBox = object(THSListBox)
  139. Transparent : boolean;
  140. NoSelection : boolean;
  141. MaxWidth : Sw_integer;
  142. (* ModuleNames : PStoreCollection; *)
  143. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  144. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  145. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  146. function GetLocalMenu: PMenu;virtual;
  147. procedure Clear; virtual;
  148. procedure TrackSource; virtual;
  149. procedure EditNew; virtual;
  150. procedure EditCurrent; virtual;
  151. procedure DeleteCurrent; virtual;
  152. procedure ToggleCurrent;
  153. procedure Draw; virtual;
  154. procedure HandleEvent(var Event: TEvent); virtual;
  155. constructor Load(var S: TStream);
  156. procedure Store(var S: TStream);
  157. destructor Done; virtual;
  158. end;
  159. PBreakpointsWindow = ^TBreakpointsWindow;
  160. TBreakpointsWindow = object(TFPDlgWindow)
  161. BreakLB : PBreakpointsListBox;
  162. constructor Init;
  163. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  164. procedure ClearBreakpoints;
  165. procedure ReloadBreakpoints;
  166. procedure Close; virtual;
  167. procedure SizeLimits(var Min, Max: TPoint);virtual;
  168. procedure HandleEvent(var Event: TEvent); virtual;
  169. procedure Update; virtual;
  170. constructor Load(var S: TStream);
  171. procedure Store(var S: TStream);
  172. destructor Done; virtual;
  173. end;
  174. PBreakpointItemDialog = ^TBreakpointItemDialog;
  175. TBreakpointItemDialog = object(TCenterDialog)
  176. constructor Init(ABreakpoint: PBreakpoint);
  177. function Execute: Word; virtual;
  178. private
  179. Breakpoint : PBreakpoint;
  180. TypeRB : PRadioButtons;
  181. NameIL : PEditorInputLine;
  182. ConditionsIL: PEditorInputLine;
  183. LineIL : PEditorInputLine;
  184. IgnoreIL : PEditorInputLine;
  185. end;
  186. PWatch = ^TWatch;
  187. TWatch = Object(TObject)
  188. constructor Init(s : string);
  189. constructor Load(var S: TStream);
  190. procedure Store(var S: TStream);
  191. procedure rename(s : string);
  192. procedure Get_new_value;
  193. procedure Force_new_value;
  194. destructor done;virtual;
  195. expr : pstring;
  196. last_value,current_value : pchar;
  197. private
  198. GDBRunCount : longint;
  199. end;
  200. PWatchesCollection = ^TWatchesCollection;
  201. TWatchesCollection = Object(TCollection)
  202. constructor Init;
  203. procedure Insert(Item: Pointer); virtual;
  204. function At(Index: Integer): PWatch;
  205. procedure Update;
  206. private
  207. MaxW : integer;
  208. end;
  209. PWatchesListBox = ^TWatchesListBox;
  210. TWatchesListBox = object(THSListBox)
  211. Transparent : boolean;
  212. MaxWidth : Sw_integer;
  213. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  214. (* procedure AddWatch(P: PWatch); virtual; *)
  215. procedure Update(AMaxWidth : integer);
  216. function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  217. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
  218. function GetLocalMenu: PMenu;virtual;
  219. (* procedure Clear; virtual;
  220. procedure TrackSource; virtual;*)
  221. procedure EditNew; virtual;
  222. procedure EditCurrent; virtual;
  223. procedure DeleteCurrent; virtual;
  224. (*procedure ToggleCurrent; *)
  225. procedure Draw; virtual;
  226. procedure HandleEvent(var Event: TEvent); virtual;
  227. constructor Load(var S: TStream);
  228. procedure Store(var S: TStream);
  229. destructor Done; virtual;
  230. end;
  231. PWatchItemDialog = ^TWatchItemDialog;
  232. TWatchItemDialog = object(TCenterDialog)
  233. constructor Init(AWatch: PWatch);
  234. function Execute: Word; virtual;
  235. private
  236. Watch : PWatch;
  237. NameIL : PEditorInputLine;
  238. TextST : PAdvancedStaticText;
  239. end;
  240. PWatchesWindow = ^TWatchesWindow;
  241. TWatchesWindow = Object(TFPDlgWindow)
  242. WLB : PWatchesListBox;
  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. PFramesListBox = ^TFramesListBox;
  250. TFramesListBox = object(TMessageListBox)
  251. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  252. procedure Update;
  253. function GetLocalMenu: PMenu;virtual;
  254. procedure GotoSource; virtual;
  255. procedure GotoAssembly; virtual;
  256. procedure HandleEvent(var Event: TEvent); virtual;
  257. destructor Done; virtual;
  258. end;
  259. PStackWindow = ^TStackWindow;
  260. TStackWindow = Object(TFPDlgWindow)
  261. FLB : PFramesListBox;
  262. Constructor Init;
  263. constructor Load(var S: TStream);
  264. procedure Store(var S: TStream);
  265. procedure Update; virtual;
  266. destructor Done; virtual;
  267. end;
  268. procedure InitStackWindow;
  269. procedure DoneStackWindow;
  270. function ActiveBreakpoints : boolean;
  271. function GDBFileName(st : string) : string;
  272. function OSFileName(st : string) : string;
  273. const
  274. BreakpointTypeStr : Array[BreakpointType] of String[9]
  275. = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
  276. BreakpointStateStr : Array[BreakpointState] of String[8]
  277. = ( 'enabled','disabled','invalid',''{'to be deleted' should never be used});
  278. var
  279. {$ifndef NODEBUG}
  280. Debugger : PDebugController;
  281. {$endif NODEBUG}
  282. BreakpointsCollection : PBreakpointCollection;
  283. WatchesCollection : PwatchesCollection;
  284. procedure InitDebugger;
  285. procedure DoneDebugger;
  286. procedure InitGDBWindow;
  287. procedure DoneGDBWindow;
  288. procedure InitDisassemblyWindow;
  289. procedure DoneDisassemblyWindow;
  290. procedure InitBreakpoints;
  291. procedure DoneBreakpoints;
  292. procedure InitWatches;
  293. procedure DoneWatches;
  294. procedure RegisterFPDebugViews;
  295. procedure UpdateDebugViews;
  296. implementation
  297. uses
  298. Dos,
  299. {$ifdef fpc}
  300. Video,
  301. {$endif fpc}
  302. {$ifdef DOS}
  303. fpusrscr,
  304. {$endif DOS}
  305. App,Strings,
  306. FVConsts,
  307. {$ifdef Windows}
  308. Windebug,
  309. {$endif Windows}
  310. {$ifdef Unix}
  311. {$ifdef VER1_0}
  312. Linux,
  313. {$else}
  314. termio,
  315. {$endif}
  316. {$endif Unix}
  317. Systems,Globals,
  318. FPRegs,
  319. FPString,FPVars,FPUtils,FPConst,FPSwitch,
  320. FPIntf,FPCompil,FPIde,FPHelp,
  321. Validate,WUtils,Wconsts;
  322. const
  323. RBreakpointsWindow: TStreamRec = (
  324. ObjType: 1701;
  325. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  326. Load: @TBreakpointsWindow.Load;
  327. Store: @TBreakpointsWindow.Store
  328. );
  329. RBreakpointsListBox : TStreamRec = (
  330. ObjType: 1702;
  331. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  332. Load: @TBreakpointsListBox.Load;
  333. Store: @TBreakpointsListBox.Store
  334. );
  335. RWatchesWindow: TStreamRec = (
  336. ObjType: 1703;
  337. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  338. Load: @TWatchesWindow.Load;
  339. Store: @TWatchesWindow.Store
  340. );
  341. RWatchesListBox: TStreamRec = (
  342. ObjType: 1704;
  343. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  344. Load: @TWatchesListBox.Load;
  345. Store: @TWatchesListBox.Store
  346. );
  347. RStackWindow: TStreamRec = (
  348. ObjType: 1705;
  349. VmtLink: Ofs(TypeOf(TStackWindow)^);
  350. Load: @TStackWindow.Load;
  351. Store: @TStackWindow.Store
  352. );
  353. RFramesListBox: TStreamRec = (
  354. ObjType: 1706;
  355. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  356. Load: @TFramesListBox.Load;
  357. Store: @TFramesListBox.Store
  358. );
  359. RBreakpoint: TStreamRec = (
  360. ObjType: 1707;
  361. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  362. Load: @TBreakpoint.Load;
  363. Store: @TBreakpoint.Store
  364. );
  365. RWatch: TStreamRec = (
  366. ObjType: 1708;
  367. VmtLink: Ofs(TypeOf(TWatch)^);
  368. Load: @TWatch.Load;
  369. Store: @TWatch.Store
  370. );
  371. RBreakpointCollection: TStreamRec = (
  372. ObjType: 1709;
  373. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  374. Load: @TBreakpointCollection.Load;
  375. Store: @TBreakpointCollection.Store
  376. );
  377. RWatchesCollection: TStreamRec = (
  378. ObjType: 1710;
  379. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  380. Load: @TWatchesCollection.Load;
  381. Store: @TWatchesCollection.Store
  382. );
  383. {$ifdef I386}
  384. const
  385. FrameName = '$ebp';
  386. {$define FrameNameKnown}
  387. {$endif i386}
  388. {$ifdef m68k}
  389. const
  390. FrameName = '$fp';
  391. {$define FrameNameKnown}
  392. {$endif m68k}
  393. {$ifdef powerpc}
  394. { stack and frame registers are the same on powerpc,
  395. so I am not sure that this will work PM }
  396. const
  397. FrameName = '$r1';
  398. {$define FrameNameKnown}
  399. {$endif powerpc}
  400. {$ifdef TP}
  401. function HexStr(Value: longint; Len: byte): string;
  402. begin
  403. HexStr:=IntToHex(Value,Len);
  404. end;
  405. {$endif}
  406. function GDBFileName(st : string) : string;
  407. {$ifndef Unix}
  408. var i : longint;
  409. {$endif Unix}
  410. begin
  411. {$ifdef NODEBUG}
  412. GDBFileName:=st;
  413. {$else NODEBUG}
  414. {$ifdef Unix}
  415. GDBFileName:=st;
  416. {$else}
  417. { should we also use / chars ? }
  418. for i:=1 to Length(st) do
  419. if st[i]='\' then
  420. {$ifdef Windows}
  421. { Don't touch at '\ ' used to escapes spaces in windows file names PM }
  422. if (i=length(st)) or (st[i+1]<>' ') then
  423. {$endif Windows}
  424. st[i]:='/';
  425. {$ifdef Windows}
  426. { for Windows we should convert e:\ into //e/ PM }
  427. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  428. st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
  429. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  430. for i:=Length(st) downto 1 do
  431. if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
  432. st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
  433. {$endif Windows}
  434. {$ifdef go32v2}
  435. { for go32v2 we should convert //e/ back into e:/ PM }
  436. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  437. st:=st[3]+':/'+copy(st,5,length(st));
  438. {$endif go32v2}
  439. GDBFileName:=LowerCaseStr(st);
  440. {$endif}
  441. {$endif NODEBUG}
  442. end;
  443. function OSFileName(st : string) : string;
  444. {$ifndef Unix}
  445. var i : longint;
  446. {$endif Unix}
  447. begin
  448. {$ifdef Unix}
  449. OSFileName:=st;
  450. {$else}
  451. {$ifdef Windows}
  452. {$ifndef NODEBUG}
  453. { for Windows we should convert /cygdrive/e/ into e:\ PM }
  454. if pos(CygDrivePrefix+'/',st)=1 then
  455. st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
  456. {$endif NODEBUG}
  457. {$endif Windows}
  458. { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
  459. for i:=Length(st) downto 2 do
  460. if (st[i]=' ') and (st[i-1]='\') then
  461. st:=copy(st,1,i-2)+copy(st,i,length(st));
  462. {$ifdef go32v2}
  463. { for go32v2 we should convert //e/ back into e:/ PM }
  464. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  465. st:=st[3]+':\'+copy(st,5,length(st));
  466. {$endif go32v2}
  467. { should we also use / chars ? }
  468. for i:=1 to Length(st) do
  469. if st[i]='/' then
  470. st[i]:='\';
  471. OSFileName:=LowerCaseStr(st);
  472. {$endif}
  473. end;
  474. {****************************************************************************
  475. TDebugController
  476. ****************************************************************************}
  477. procedure UpdateDebugViews;
  478. begin
  479. {$ifdef SUPPORT_REMOTE}
  480. PushStatus(msg_getting_info_on+RemoteMachine);
  481. {$endif SUPPORT_REMOTE}
  482. DeskTop^.Lock;
  483. If assigned(StackWindow) then
  484. StackWindow^.Update;
  485. If assigned(RegistersWindow) then
  486. RegistersWindow^.Update;
  487. {$ifndef NODEBUG}
  488. If assigned(Debugger) then
  489. Debugger^.ReadWatches;
  490. {$endif NODEBUG}
  491. If assigned(FPUWindow) then
  492. FPUWindow^.Update;
  493. If assigned(VectorWindow) then
  494. VectorWindow^.Update;
  495. DeskTop^.UnLock;
  496. {$ifdef SUPPORT_REMOTE}
  497. PopStatus;
  498. {$endif SUPPORT_REMOTE}
  499. end;
  500. {$ifndef NODEBUG}
  501. constructor TDebugController.Init;
  502. begin
  503. inherited Init;
  504. CenterDebuggerRow:=IniCenterDebuggerRow;
  505. Disableallinvalidbreakpoints:=false;
  506. NoSwitch:=False;
  507. HasExe:=false;
  508. Debugger:=@self;
  509. WindowWidth:=-1;
  510. switch_to_user:=true;
  511. GetDir(0,OrigPwd);
  512. Command('set print object off');
  513. end;
  514. procedure TDebugController.SetExe(const exefn:string);
  515. var f : string;
  516. begin
  517. f := GDBFileName(GetShortName(exefn));
  518. if (f<>'') and ExistsFile(exefn) then
  519. begin
  520. LoadFile(f);
  521. HasExe:=true;
  522. Command('b FPC_BREAK_ERROR');
  523. FPCBreakErrorNumber:=last_breakpoint_number;
  524. {$ifdef FrameNameKnown}
  525. { this fails in GDB 5.1 because
  526. GDB replies that there is an attempt to dereference
  527. a generic pointer...
  528. test delayed in DoSourceLine... PM
  529. Command('cond '+IntToStr(FPCBreakErrorNumber)+
  530. ' (('+FrameName+' + 8)^ <> 0) or'+
  531. ' (('+FrameName+' + 12)^ <> 0)'); }
  532. {$endif FrameNameKnown}
  533. SetArgs(GetRunParameters);
  534. SetSourceDirs;
  535. InsertBreakpoints;
  536. ReadWatches;
  537. end
  538. else
  539. begin
  540. HasExe:=false;
  541. Command('file');
  542. end;
  543. end;
  544. procedure TDebugController.SetWidth(AWidth : longint);
  545. begin
  546. WindowWidth:=AWidth;
  547. Command('set width '+inttostr(WindowWidth));
  548. end;
  549. procedure TDebugController.SetSourceDirs;
  550. var f,s: string;
  551. i : longint;
  552. Dir : SearchRec;
  553. begin
  554. f:=GetSourceDirectories+';'+OrigPwd;
  555. repeat
  556. i:=pos(';',f);
  557. if i=0 then
  558. s:=f
  559. else
  560. begin
  561. s:=copy(f,1,i-1);
  562. system.delete(f,1,i);
  563. end;
  564. DefaultReplacements(s);
  565. if (pos('*',s)=0) and ExistsDir(s) then
  566. Command('dir '+GDBFileName(GetShortName(s)))
  567. { we should also handle the /* cases of -Fu option }
  568. else if pos('*',s)>0 then
  569. begin
  570. Dos.FindFirst(s,Directory,Dir);
  571. { the '*' can only be in the last dir level }
  572. s:=DirOf(s);
  573. while Dos.DosError=0 do
  574. begin
  575. if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
  576. Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
  577. Dos.FindNext(Dir);
  578. end;
  579. {$ifdef FPC}
  580. Dos.FindClose(Dir);
  581. {$endif def FPC}
  582. end;
  583. until i=0;
  584. end;
  585. procedure TDebugController.InsertBreakpoints;
  586. procedure DoInsert(PB : PBreakpoint);
  587. begin
  588. PB^.Insert;
  589. end;
  590. begin
  591. BreakpointsCollection^.ForEach(@DoInsert);
  592. Disableallinvalidbreakpoints:=false;
  593. end;
  594. procedure TDebugController.ReadWatches;
  595. procedure DoRead(PB : PWatch);
  596. begin
  597. PB^.Get_new_value;
  598. end;
  599. begin
  600. WatchesCollection^.ForEach(@DoRead);
  601. If Assigned(WatchesWindow) then
  602. WatchesWindow^.Update;
  603. end;
  604. procedure TDebugController.RereadWatches;
  605. procedure DoRead(PB : PWatch);
  606. begin
  607. PB^.Force_new_value;
  608. end;
  609. begin
  610. WatchesCollection^.ForEach(@DoRead);
  611. If Assigned(WatchesWindow) then
  612. WatchesWindow^.Update;
  613. end;
  614. procedure TDebugController.RemoveBreakpoints;
  615. procedure DoDelete(PB : PBreakpoint);
  616. begin
  617. PB^.Remove;
  618. end;
  619. begin
  620. BreakpointsCollection^.ForEach(@DoDelete);
  621. end;
  622. procedure TDebugController.ResetBreakpointsValues;
  623. procedure DoResetVal(PB : PBreakpoint);
  624. begin
  625. PB^.ResetValues;
  626. end;
  627. begin
  628. BreakpointsCollection^.ForEach(@DoResetVal);
  629. end;
  630. destructor TDebugController.Done;
  631. begin
  632. { kill the program if running }
  633. Reset;
  634. RemoveBreakpoints;
  635. inherited Done;
  636. end;
  637. procedure TDebugController.Run;
  638. {$ifdef Unix}
  639. var
  640. Debuggeefile : text;
  641. ResetOK, TTYUsed : boolean;
  642. {$endif Unix}
  643. {$ifdef PALMOSGDB}
  644. const
  645. TargetProtocol = 'palmos';
  646. {$else}
  647. const
  648. TargetProtocol = 'remote';
  649. {$endif PALMOSGDB}
  650. {$ifdef SUPPORT_REMOTE}
  651. var
  652. S,ErrorStr : string;
  653. {$endif SUPPORT_REMOTE}
  654. begin
  655. ResetBreakpointsValues;
  656. {$ifdef SUPPORT_REMOTE}
  657. NoSwitch:=true;
  658. isRemoteDebugging:=false;
  659. {$ifndef CROSSGDB}
  660. If (RemoteMachine<>'') and (RemotePort<>'') then
  661. {$else CROSSGDB}
  662. if true then
  663. {$endif CROSSGDB}
  664. begin
  665. isRemoteDebugging:=true;
  666. S:=RemoteMachine;
  667. If pos('@',S)>0 then
  668. S:=copy(S,pos('@',S)+1,High(S));
  669. If RemotePort<>'' then
  670. S:=S+':'+RemotePort;
  671. {$ifdef PALMOSGDB}
  672. { set the default value for PalmOS }
  673. If S='' then
  674. S:='localhost:2000';
  675. {$endif PALMOSGDB}
  676. PushStatus(msg_connectingto+S);
  677. Command('target '+TargetProtocol+' '+S);
  678. if Error then
  679. begin
  680. ErrorStr:=strpas(GetError);
  681. ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil);
  682. PopStatus;
  683. exit;
  684. end;
  685. PopStatus;
  686. end
  687. else
  688. begin
  689. {$endif SUPPORT_REMOTE}
  690. {$ifdef Windows}
  691. { Run the debugge in another console }
  692. if DebuggeeTTY<>'' then
  693. Command('set new-console on')
  694. else
  695. Command('set new-console off');
  696. NoSwitch:=DebuggeeTTY<>'';
  697. {$endif Windows}
  698. {$ifdef Unix}
  699. { Run the debuggee in another tty }
  700. if DebuggeeTTY <> '' then
  701. begin
  702. {$I-}
  703. Assign(Debuggeefile,DebuggeeTTY);
  704. system.Reset(Debuggeefile);
  705. ResetOK:=IOResult=0;
  706. If ResetOK and {$ifdef ver1_0}IsATTY(textrec(Debuggeefile).handle){$else}(IsATTY(textrec(Debuggeefile).handle)<>-1){$endif} then
  707. begin
  708. Command('tty '+DebuggeeTTY);
  709. TTYUsed:=true;
  710. end
  711. else
  712. begin
  713. Command('tty ');
  714. TTYUsed:=false;
  715. end;
  716. if ResetOK then
  717. close(Debuggeefile);
  718. if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
  719. NoSwitch:= true
  720. else
  721. NoSwitch:=false;
  722. end
  723. else
  724. begin
  725. if TTYName(input)<>'' then
  726. Command('tty '+TTYName(input));
  727. NoSwitch := false;
  728. end;
  729. {$endif Unix}
  730. {$ifdef SUPPORT_REMOTE}
  731. end;
  732. {$endif SUPPORT_REMOTE}
  733. { Switch to user screen to get correct handles }
  734. UserScreen;
  735. { Don't try to print GDB messages while in User Screen mode }
  736. If assigned(GDBWindow) then
  737. GDBWindow^.Editor^.Lock;
  738. {$ifdef SUPPORT_REMOTE}
  739. if isRemoteDebugging then
  740. begin
  741. inc(init_count);
  742. { pass the stop in start code }
  743. Command('continue');
  744. end else
  745. {$endif SUPPORT_REMOTE}
  746. { Set cwd for debuggee }
  747. SetDir(GetRunDir);
  748. inherited Run;
  749. { Restore cwd for IDE }
  750. SetDir(StartupDir);
  751. DebuggerScreen;
  752. If assigned(GDBWindow) then
  753. GDBWindow^.Editor^.UnLock;
  754. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  755. IDEApp.UpdateRunMenu(true);
  756. UpdateDebugViews;
  757. end;
  758. function TDebugController.IsRunning : boolean;
  759. begin
  760. IsRunning:=debuggee_started;
  761. end;
  762. procedure TDebugController.Continue;
  763. begin
  764. {$ifdef NODEBUG}
  765. NoDebugger;
  766. {$else}
  767. if not debuggee_started then
  768. Run
  769. else
  770. inherited Continue;
  771. UpdateDebugViews;
  772. {$endif NODEBUG}
  773. end;
  774. procedure TDebugController.UntilReturn;
  775. begin
  776. Command('finish');
  777. UpdateDebugViews;
  778. { We could try to get the return value !
  779. Not done yet }
  780. end;
  781. procedure TDebugController.CommandBegin(const s:string);
  782. begin
  783. if assigned(GDBWindow) and (in_command>1) then
  784. begin
  785. { We should do something special for errors !! }
  786. If StrLen(GetError)>0 then
  787. GDBWindow^.WriteErrorText(GetError);
  788. GDBWindow^.WriteOutputText(GetOutput);
  789. end;
  790. if assigned(GDBWindow) then
  791. GDBWindow^.WriteString(S);
  792. end;
  793. procedure TDebugController.CommandEnd(const s:string);
  794. begin
  795. if assigned(GDBWindow) and (in_command<=1) then
  796. begin
  797. { We should do something special for errors !! }
  798. If StrLen(GetError)>0 then
  799. GDBWindow^.WriteErrorText(GetError);
  800. GDBWindow^.WriteOutputText(GetOutput);
  801. GDBWindow^.Editor^.TextEnd;
  802. end;
  803. end;
  804. function TDebugController.AllowQuit : boolean;
  805. begin
  806. if IsRunning then
  807. begin
  808. if ConfirmBox('Really quit GDB window'#13+
  809. 'and kill running program?',nil,true)=cmYes then
  810. begin
  811. Reset;
  812. DoneGDBWindow;
  813. {AllowQuit:=true;}
  814. AllowQuit:=false;
  815. end
  816. else
  817. AllowQuit:=false;
  818. end
  819. else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
  820. begin
  821. DoneGDBWindow;
  822. {AllowQuit:=true;}
  823. AllowQuit:=false;
  824. end
  825. else
  826. AllowQuit:=false;
  827. end;
  828. procedure TDebugController.ResetDebuggerRows;
  829. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  830. begin
  831. if assigned(P) and
  832. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  833. PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  834. end;
  835. begin
  836. Desktop^.ForEach(@ResetDebuggerRow);
  837. end;
  838. procedure TDebugController.Reset;
  839. begin
  840. inherited Reset;
  841. { we need to free the executable
  842. if we want to recompile it }
  843. SetExe('');
  844. NoSwitch:=false;
  845. { In case we have something that the compiler touched }
  846. If IDEApp.IsRunning then
  847. begin
  848. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  849. IDEApp.UpdateRunMenu(false);
  850. AskToReloadAllModifiedFiles;
  851. ResetDebuggerRows;
  852. end;
  853. end;
  854. procedure TDebugController.AnnotateError;
  855. var errornb : longint;
  856. begin
  857. if error then
  858. begin
  859. errornb:=error_num;
  860. UpdateDebugViews;
  861. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  862. end;
  863. end;
  864. function TDebugController.GetValue(Const expr : string) : pchar;
  865. var
  866. p,p2,p3 : pchar;
  867. begin
  868. if WindowWidth<>-1 then
  869. Command('set width 0xffffffff');
  870. Command('p '+expr);
  871. p:=GetOutput;
  872. p3:=nil;
  873. if assigned(p) and (p[strlen(p)-1]=#10) then
  874. begin
  875. p3:=p+strlen(p)-1;
  876. p3^:=#0;
  877. end;
  878. if assigned(p) then
  879. p2:=strpos(p,'=')
  880. else
  881. p2:=nil;
  882. if assigned(p2) then
  883. p:=p2+1;
  884. while p^ in [' ',TAB] do
  885. inc(p);
  886. { get rid of type }
  887. if p^ = '(' then
  888. p:=strpos(p,')')+1;
  889. while p^ in [' ',TAB] do
  890. inc(p);
  891. if assigned(p) then
  892. GetValue:=StrNew(p)
  893. else
  894. GetValue:=StrNew(GetError);
  895. if assigned(p3) then
  896. p3^:=#10;
  897. got_error:=false;
  898. if WindowWidth<>-1 then
  899. Command('set width '+IntToStr(WindowWidth));
  900. end;
  901. function TDebugController.GetFramePointer : CORE_ADDR;
  902. var
  903. st : string;
  904. p : longint;
  905. begin
  906. {$ifdef FrameNameKnown}
  907. Command('p /d '+FrameName);
  908. st:=strpas(GetOutput);
  909. p:=pos('=',st);
  910. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  911. inc(p);
  912. Delete(st,1,p);
  913. p:=1;
  914. while (st[p] in ['0'..'9']) do
  915. inc(p);
  916. Delete(st,p,High(st));
  917. GetFramePointer:=StrToCard(st);
  918. {$else not FrameNameKnown}
  919. GetFramePointer:=0;
  920. {$endif not FrameNameKnown}
  921. end;
  922. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  923. var
  924. st : string;
  925. p : longint;
  926. begin
  927. Command('x /wd 0x'+hexstr(longint(addr),8));
  928. st:=strpas(GetOutput);
  929. p:=pos(':',st);
  930. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  931. inc(p);
  932. Delete(st,1,p);
  933. p:=1;
  934. while (st[p] in ['0'..'9']) do
  935. inc(p);
  936. Delete(st,p,High(st));
  937. GetLongintAt:=StrToInt(st);
  938. end;
  939. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  940. var
  941. st : string;
  942. p : longint;
  943. code : integer;
  944. begin
  945. Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
  946. st:=strpas(GetOutput);
  947. p:=pos(':',st);
  948. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  949. inc(p);
  950. if (p<length(st)) and (st[p+1]='$') then
  951. inc(p);
  952. Delete(st,1,p);
  953. p:=1;
  954. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  955. inc(p);
  956. Delete(st,p,High(st));
  957. Val('$'+st,GetPointerAt,code);
  958. end;
  959. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  960. var
  961. W: PSourceWindow;
  962. Found : boolean;
  963. PB : PBreakpoint;
  964. S : String;
  965. BreakIndex : longint;
  966. stop_addr : CORE_ADDR;
  967. i,ExitCode : longint;
  968. ExitAddr,ExitFrame : CORE_ADDR;
  969. const
  970. { try to find the parameters }
  971. FirstArgOffset = -sizeof(pointer);
  972. SecondArgOffset = 2*-sizeof(pointer);
  973. ThirdArgOffset = 3*-sizeof(pointer);
  974. begin
  975. BreakIndex:=stop_breakpoint_number;
  976. Desktop^.Lock;
  977. { 0 based line count in Editor }
  978. if Line>0 then
  979. dec(Line);
  980. S:=fn;
  981. stop_addr:=current_pc;
  982. if (BreakIndex=FPCBreakErrorNumber) then
  983. begin
  984. { Procedure HandleErrorAddrFrame
  985. (Errno : longint;addr,frame : longint);
  986. [public,alias:'FPC_BREAK_ERROR']; }
  987. {$ifdef FrameNameKnown}
  988. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  989. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  990. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  991. if (ExitCode=0) and (ExitAddr=0) then
  992. begin
  993. Desktop^.Unlock;
  994. Command('continue');
  995. exit;
  996. end;
  997. { forget all old frames }
  998. clear_frames;
  999. { record new frames }
  1000. Command('backtrace');
  1001. for i:=0 to frame_count-1 do
  1002. begin
  1003. with frames[i]^ do
  1004. begin
  1005. if ExitAddr=address then
  1006. begin
  1007. Command('f '+IntToStr(i));
  1008. if assigned(file_name) then
  1009. begin
  1010. s:=strpas(file_name);
  1011. line:=line_number;
  1012. stop_addr:=address;
  1013. end;
  1014. break;
  1015. end;
  1016. end;
  1017. end;
  1018. {$endif FrameNameKnown}
  1019. end;
  1020. { Update Disassembly position }
  1021. if Assigned(DisassemblyWindow) then
  1022. DisassemblyWindow^.SetCurAddress(stop_addr);
  1023. if (fn=LastFileName) then
  1024. begin
  1025. W:=PSourceWindow(LastSource);
  1026. if assigned(W) then
  1027. begin
  1028. W^.Editor^.SetCurPtr(0,Line);
  1029. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1030. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1031. UpdateDebugViews;
  1032. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1033. handled by SelectInDebugSession}
  1034. W^.SelectInDebugSession;
  1035. InvalidSourceLine:=false;
  1036. end
  1037. else
  1038. InvalidSourceLine:=true;
  1039. end
  1040. else
  1041. begin
  1042. if s='' then
  1043. W:=nil
  1044. else
  1045. W:=TryToOpenFile(nil,s,0,Line,false);
  1046. if assigned(W) then
  1047. begin
  1048. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1049. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1050. UpdateDebugViews;
  1051. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1052. handled by SelectInDebugSession}
  1053. W^.SelectInDebugSession;
  1054. LastSource:=W;
  1055. InvalidSourceLine:=false;
  1056. end
  1057. { only search a file once }
  1058. else
  1059. begin
  1060. Desktop^.UnLock;
  1061. if s='' then
  1062. Found:=false
  1063. else
  1064. { it is easier to handle with a * at the end }
  1065. Found:=IDEApp.OpenSearch(s+'*');
  1066. Desktop^.Lock;
  1067. if not Found then
  1068. begin
  1069. InvalidSourceLine:=true;
  1070. LastSource:=Nil;
  1071. { Show the stack in that case }
  1072. InitStackWindow;
  1073. UpdateDebugViews;
  1074. StackWindow^.MakeFirst;
  1075. end
  1076. else
  1077. begin
  1078. { should now be open }
  1079. W:=TryToOpenFile(nil,s,0,Line,true);
  1080. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1081. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1082. UpdateDebugViews;
  1083. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1084. handled by SelectInDebugSession}
  1085. W^.SelectInDebugSession;
  1086. LastSource:=W;
  1087. InvalidSourceLine:=false;
  1088. end;
  1089. end;
  1090. end;
  1091. LastFileName:=s;
  1092. Desktop^.UnLock;
  1093. if BreakIndex>0 then
  1094. begin
  1095. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1096. if (BreakIndex=FPCBreakErrorNumber) then
  1097. begin
  1098. if (ExitCode<>0) or (ExitAddr<>0) then
  1099. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1100. #3'Error address $'+HexStr(ExitAddr,8),nil)
  1101. else
  1102. WarningBox(#3'Run Time Error',nil);
  1103. end
  1104. else if not assigned(PB) then
  1105. begin
  1106. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1107. end
  1108. { For watch we should get old and new value !! }
  1109. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1110. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1111. (PB^.typ<>bt_address) then
  1112. begin
  1113. Command('p '+GetStr(PB^.Name));
  1114. S:=GetPChar(GetOutput);
  1115. got_error:=false;
  1116. If Pos('=',S)>0 then
  1117. S:=Copy(S,Pos('=',S)+1,255);
  1118. If S[Length(S)]=#10 then
  1119. Delete(S,Length(S),1);
  1120. if Assigned(PB^.OldValue) then
  1121. DisposeStr(PB^.OldValue);
  1122. PB^.OldValue:=PB^.CurrentValue;
  1123. PB^.CurrentValue:=NewStr(S);
  1124. If PB^.typ=bt_function then
  1125. WarningBox(#3'GDB stopped due to'#13+
  1126. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1127. else if (GetStr(PB^.OldValue)<>S) then
  1128. WarningBox(#3'GDB stopped due to'#13+
  1129. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1130. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1131. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1132. else
  1133. WarningBox(#3'GDB stopped due to'#13+
  1134. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1135. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1136. end;
  1137. end;
  1138. end;
  1139. procedure TDebugController.DoUserSignal;
  1140. var P :Array[1..2] of pstring;
  1141. S1, S2 : string;
  1142. begin
  1143. S1:=strpas(signal_name);
  1144. S2:=strpas(signal_string);
  1145. P[1]:=@S1;
  1146. P[2]:=@S2;
  1147. WarningBox(msg_programsignal,@P);
  1148. end;
  1149. procedure TDebugController.DoEndSession(code:longint);
  1150. var P :Array[1..2] of longint;
  1151. begin
  1152. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1153. IDEApp.UpdateRunMenu(false);
  1154. ResetDebuggerRows;
  1155. LastExitCode:=Code;
  1156. If HiddenStepsCount=0 then
  1157. InformationBox(msg_programexitedwithexitcode,@code)
  1158. else
  1159. begin
  1160. P[1]:=code;
  1161. P[2]:=HiddenStepsCount;
  1162. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1163. end;
  1164. { In case we have something that the compiler touched }
  1165. AskToReloadAllModifiedFiles;
  1166. {$ifdef Windows}
  1167. main_pid_valid:=false;
  1168. {$endif Windows}
  1169. end;
  1170. procedure TDebugController.DoDebuggerScreen;
  1171. {$ifdef Windows}
  1172. var
  1173. IdeMode : DWord;
  1174. {$endif Windows}
  1175. begin
  1176. if NoSwitch then
  1177. begin
  1178. PopStatus;
  1179. end
  1180. else
  1181. begin
  1182. IDEApp.ShowIDEScreen;
  1183. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1184. PopStatus;
  1185. end;
  1186. {$ifdef Windows}
  1187. if NoSwitch then
  1188. begin
  1189. { Ctrl-C as normal char }
  1190. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1191. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1192. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1193. end;
  1194. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1195. {$endif Windows}
  1196. end;
  1197. procedure TDebugController.DoUserScreen;
  1198. {$ifdef Windows}
  1199. var
  1200. IdeMode : DWord;
  1201. {$endif Windows}
  1202. begin
  1203. Inc(RunCount);
  1204. if NoSwitch then
  1205. begin
  1206. {$ifdef SUPPORT_REMOTE}
  1207. PushStatus(msg_runningremotely+RemoteMachine);
  1208. {$else not SUPPORT_REMOTE}
  1209. {$ifdef Unix}
  1210. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1211. {$else not Unix}
  1212. PushStatus(msg_runninginanotherwindow);
  1213. {$endif Unix}
  1214. {$endif not SUPPORT_REMOTE}
  1215. end
  1216. else
  1217. begin
  1218. PushStatus(msg_runningprogram);
  1219. IDEApp.ShowUserScreen;
  1220. end;
  1221. {$ifdef Windows}
  1222. if NoSwitch then
  1223. begin
  1224. { Ctrl-C as interrupt }
  1225. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1226. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1227. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1228. end;
  1229. ChangeDebuggeeWindowTitleTo(Running_State);
  1230. {$endif Windows}
  1231. end;
  1232. {$endif NODEBUG}
  1233. {****************************************************************************
  1234. TBreakpoint
  1235. ****************************************************************************}
  1236. function ActiveBreakpoints : boolean;
  1237. var
  1238. IsActive : boolean;
  1239. procedure TestActive(PB : PBreakpoint);
  1240. begin
  1241. If PB^.state=bs_enabled then
  1242. IsActive:=true;
  1243. end;
  1244. begin
  1245. IsActive:=false;
  1246. If assigned(BreakpointsCollection) then
  1247. BreakpointsCollection^.ForEach(@TestActive);
  1248. ActiveBreakpoints:=IsActive;
  1249. end;
  1250. constructor TBreakpoint.Init_function(Const AFunc : String);
  1251. begin
  1252. typ:=bt_function;
  1253. state:=bs_enabled;
  1254. GDBState:=bs_deleted;
  1255. Name:=NewStr(AFunc);
  1256. FileName:=nil;
  1257. Line:=0;
  1258. IgnoreCount:=0;
  1259. Commands:=nil;
  1260. Conditions:=nil;
  1261. OldValue:=nil;
  1262. CurrentValue:=nil;
  1263. end;
  1264. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1265. begin
  1266. typ:=bt_address;
  1267. state:=bs_enabled;
  1268. GDBState:=bs_deleted;
  1269. Name:=NewStr(AAddress);
  1270. FileName:=nil;
  1271. Line:=0;
  1272. IgnoreCount:=0;
  1273. Commands:=nil;
  1274. Conditions:=nil;
  1275. OldValue:=nil;
  1276. CurrentValue:=nil;
  1277. end;
  1278. constructor TBreakpoint.Init_Empty;
  1279. begin
  1280. typ:=bt_function;
  1281. state:=bs_enabled;
  1282. GDBState:=bs_deleted;
  1283. Name:=Nil;
  1284. FileName:=nil;
  1285. Line:=0;
  1286. IgnoreCount:=0;
  1287. Commands:=nil;
  1288. Conditions:=nil;
  1289. OldValue:=nil;
  1290. CurrentValue:=nil;
  1291. end;
  1292. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1293. begin
  1294. typ:=atyp;
  1295. state:=bs_enabled;
  1296. GDBState:=bs_deleted;
  1297. Name:=NewStr(AnExpr);
  1298. IgnoreCount:=0;
  1299. Commands:=nil;
  1300. Conditions:=nil;
  1301. OldValue:=nil;
  1302. CurrentValue:=nil;
  1303. end;
  1304. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1305. var
  1306. CurDir : String;
  1307. begin
  1308. typ:=bt_file_line;
  1309. state:=bs_enabled;
  1310. GDBState:=bs_deleted;
  1311. AFile:=FEXpand(AFile);
  1312. (*
  1313. { d:test.pas:12 does not work !! }
  1314. { I do not know how to solve this if
  1315. if (Length(AFile)>1) and (AFile[2]=':') then
  1316. AFile:=Copy(AFile,3,255); }
  1317. {$ifdef Unix}
  1318. CurDir:=GetCurDir;
  1319. {$else}
  1320. CurDir:=LowerCaseStr(GetCurDir);
  1321. {$endif Unix}
  1322. if Pos(CurDir,OSFileName(AFile))=1 then
  1323. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1324. else
  1325. *)
  1326. FileName:=NewStr(OSFileName(AFile));
  1327. Name:=nil;
  1328. Line:=ALine;
  1329. IgnoreCount:=0;
  1330. Commands:=nil;
  1331. Conditions:=nil;
  1332. OldValue:=nil;
  1333. CurrentValue:=nil;
  1334. end;
  1335. constructor TBreakpoint.Load(var S: TStream);
  1336. var
  1337. FName : PString;
  1338. begin
  1339. S.Read(typ,SizeOf(BreakpointType));
  1340. S.Read(state,SizeOf(BreakpointState));
  1341. GDBState:=bs_deleted;
  1342. case typ of
  1343. bt_file_line :
  1344. begin
  1345. { convert to current target }
  1346. FName:=S.ReadStr;
  1347. FileName:=NewStr(OSFileName(GetStr(FName)));
  1348. If Assigned(FName) then
  1349. DisposeStr(FName);
  1350. S.Read(Line,SizeOf(Line));
  1351. Name:=nil;
  1352. end;
  1353. else
  1354. begin
  1355. Name:=S.ReadStr;
  1356. Line:=0;
  1357. FileName:=nil;
  1358. end;
  1359. end;
  1360. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1361. Commands:=S.StrRead;
  1362. Conditions:=S.ReadStr;
  1363. OldValue:=nil;
  1364. CurrentValue:=nil;
  1365. end;
  1366. procedure TBreakpoint.Store(var S: TStream);
  1367. var
  1368. St : String;
  1369. begin
  1370. S.Write(typ,SizeOf(BreakpointType));
  1371. S.Write(state,SizeOf(BreakpointState));
  1372. case typ of
  1373. bt_file_line :
  1374. begin
  1375. st:=OSFileName(GetStr(FileName));
  1376. S.WriteStr(@St);
  1377. S.Write(Line,SizeOf(Line));
  1378. end;
  1379. else
  1380. begin
  1381. S.WriteStr(Name);
  1382. end;
  1383. end;
  1384. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1385. S.StrWrite(Commands);
  1386. S.WriteStr(Conditions);
  1387. end;
  1388. procedure TBreakpoint.Insert;
  1389. var
  1390. p,p2 : pchar;
  1391. st : string;
  1392. begin
  1393. {$ifndef NODEBUG}
  1394. If not assigned(Debugger) then Exit;
  1395. Remove;
  1396. Debugger^.last_breakpoint_number:=0;
  1397. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1398. begin
  1399. if (typ=bt_file_line) and assigned(FileName) then
  1400. Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
  1401. else if (typ=bt_function) and assigned(name) then
  1402. Debugger^.Command('break '+name^)
  1403. else if (typ=bt_address) and assigned(name) then
  1404. Debugger^.Command('break *0x'+name^)
  1405. else if (typ=bt_watch) and assigned(name) then
  1406. Debugger^.Command('watch '+name^)
  1407. else if (typ=bt_awatch) and assigned(name) then
  1408. Debugger^.Command('awatch '+name^)
  1409. else if (typ=bt_rwatch) and assigned(name) then
  1410. Debugger^.Command('rwatch '+name^);
  1411. if Debugger^.last_breakpoint_number<>0 then
  1412. begin
  1413. GDBIndex:=Debugger^.last_breakpoint_number;
  1414. GDBState:=bs_enabled;
  1415. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1416. If IgnoreCount>0 then
  1417. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1418. If Assigned(Commands) then
  1419. begin
  1420. {Commands are not handled yet }
  1421. Debugger^.Command('command '+IntToStr(GDBIndex));
  1422. p:=commands;
  1423. while assigned(p) do
  1424. begin
  1425. p2:=strscan(p,#10);
  1426. if assigned(p2) then
  1427. p2^:=#0;
  1428. st:=strpas(p);
  1429. Debugger^.command(st);
  1430. if assigned(p2) then
  1431. p2^:=#10;
  1432. p:=p2;
  1433. if assigned(p) then
  1434. inc(p);
  1435. end;
  1436. Debugger^.Command('end');
  1437. end;
  1438. end
  1439. else
  1440. { Here there was a problem !! }
  1441. begin
  1442. GDBIndex:=0;
  1443. if not Debugger^.Disableallinvalidbreakpoints then
  1444. begin
  1445. if (typ=bt_file_line) and assigned(FileName) then
  1446. begin
  1447. ClearFormatParams;
  1448. AddFormatParamStr(NameAndExtOf(FileName^));
  1449. AddFormatParamInt(Line);
  1450. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1451. Debugger^.Disableallinvalidbreakpoints:=true;
  1452. end
  1453. else
  1454. begin
  1455. ClearFormatParams;
  1456. AddFormatParamStr(BreakpointTypeStr[typ]);
  1457. AddFormatParamStr(GetStr(Name));
  1458. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1459. Debugger^.Disableallinvalidbreakpoints:=true;
  1460. end;
  1461. end;
  1462. state:=bs_disabled;
  1463. UpdateSource;
  1464. end;
  1465. end
  1466. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1467. Enable
  1468. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1469. Disable;
  1470. {$endif NODEBUG}
  1471. end;
  1472. procedure TBreakpoint.Remove;
  1473. begin
  1474. {$ifndef NODEBUG}
  1475. If not assigned(Debugger) then Exit;
  1476. if GDBIndex>0 then
  1477. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1478. GDBIndex:=0;
  1479. GDBState:=bs_deleted;
  1480. {$endif NODEBUG}
  1481. end;
  1482. procedure TBreakpoint.Enable;
  1483. begin
  1484. {$ifndef NODEBUG}
  1485. If not assigned(Debugger) then Exit;
  1486. if GDBIndex>0 then
  1487. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1488. else
  1489. Insert;
  1490. GDBState:=bs_disabled;
  1491. {$endif NODEBUG}
  1492. end;
  1493. procedure TBreakpoint.Disable;
  1494. begin
  1495. {$ifndef NODEBUG}
  1496. If not assigned(Debugger) then Exit;
  1497. if GDBIndex>0 then
  1498. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1499. GDBState:=bs_disabled;
  1500. {$endif NODEBUG}
  1501. end;
  1502. procedure TBreakpoint.ResetValues;
  1503. begin
  1504. if assigned(OldValue) then
  1505. DisposeStr(OldValue);
  1506. OldValue:=nil;
  1507. if assigned(CurrentValue) then
  1508. DisposeStr(CurrentValue);
  1509. CurrentValue:=nil;
  1510. end;
  1511. procedure TBreakpoint.UpdateSource;
  1512. var W: PSourceWindow;
  1513. b : boolean;
  1514. begin
  1515. if typ=bt_file_line then
  1516. begin
  1517. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1518. If assigned(W) then
  1519. begin
  1520. if state=bs_enabled then
  1521. b:=true
  1522. else
  1523. b:=false;
  1524. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1525. end;
  1526. end;
  1527. end;
  1528. destructor TBreakpoint.Done;
  1529. begin
  1530. Remove;
  1531. ResetValues;
  1532. if assigned(Name) then
  1533. DisposeStr(Name);
  1534. if assigned(FileName) then
  1535. DisposeStr(FileName);
  1536. if assigned(Conditions) then
  1537. DisposeStr(Conditions);
  1538. if assigned(Commands) then
  1539. StrDispose(Commands);
  1540. inherited Done;
  1541. end;
  1542. {****************************************************************************
  1543. TBreakpointCollection
  1544. ****************************************************************************}
  1545. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1546. begin
  1547. At:=inherited At(Index);
  1548. end;
  1549. procedure TBreakpointCollection.Update;
  1550. begin
  1551. {$ifndef NODEBUG}
  1552. if assigned(Debugger) then
  1553. begin
  1554. Debugger^.RemoveBreakpoints;
  1555. Debugger^.InsertBreakpoints;
  1556. end;
  1557. {$endif NODEBUG}
  1558. if assigned(BreakpointsWindow) then
  1559. BreakpointsWindow^.Update;
  1560. end;
  1561. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1562. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1563. begin
  1564. IsNum:=P^.GDBIndex=index;
  1565. end;
  1566. begin
  1567. if index=0 then
  1568. GetGDB:=nil
  1569. else
  1570. GetGDB:=FirstThat(@IsNum);
  1571. end;
  1572. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1573. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1574. begin
  1575. If assigned(P^.FileName) and
  1576. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1577. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1578. end;
  1579. procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1580. var
  1581. PDL : PDisasLine;
  1582. S : string;
  1583. ps,qs,i : longint;
  1584. HAddr : PtrInt;
  1585. code : integer;
  1586. begin
  1587. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1588. begin
  1589. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1590. if PDL^.Address=0 then
  1591. begin
  1592. if (P^.typ=bt_file_line) then
  1593. begin
  1594. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1595. ps:=pos(':',S);
  1596. qs:=pos(' ',copy(S,ps+1,High(S)));
  1597. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1598. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1599. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1600. end;
  1601. end
  1602. else
  1603. begin
  1604. Val('$'+P^.Name^,HAddr,code);
  1605. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1606. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1607. end;
  1608. end;
  1609. end;
  1610. begin
  1611. if W=PFPWindow(DisassemblyWindow) then
  1612. ForEach(@SetInDisassembly)
  1613. else
  1614. ForEach(@SetInSource);
  1615. end;
  1616. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1617. procedure AdaptInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1618. begin
  1619. If assigned(P^.FileName) and
  1620. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1621. begin
  1622. if P^.state=bs_enabled then
  1623. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1624. if P^.Line-1>=Pos then
  1625. begin
  1626. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1627. P^.line:=P^.Line+Change
  1628. else
  1629. begin
  1630. { removing inside a ForEach call leads to problems }
  1631. { so we do that after PM }
  1632. P^.state:=bs_delete_after;
  1633. end;
  1634. end;
  1635. if P^.state=bs_enabled then
  1636. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1637. end;
  1638. end;
  1639. var
  1640. I : longint;
  1641. begin
  1642. ForEach(@AdaptInSource);
  1643. I:=Count-1;
  1644. While (I>=0) do
  1645. begin
  1646. if At(I)^.state=bs_delete_after then
  1647. AtFree(I);
  1648. Dec(I);
  1649. end;
  1650. end;
  1651. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1652. function IsAtLine(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1653. begin
  1654. If assigned(P^.FileName) and
  1655. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1656. (Line=P^.Line) then
  1657. IsAtLine:=true
  1658. else
  1659. IsAtLine:=false;
  1660. end;
  1661. begin
  1662. FindBreakpointAt:=FirstThat(@IsAtLine);
  1663. end;
  1664. procedure TBreakpointCollection.ShowAllBreakpoints;
  1665. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1666. var
  1667. W : PSourceWindow;
  1668. begin
  1669. If assigned(P^.FileName) then
  1670. begin
  1671. W:=SearchOnDesktop(P^.FileName^,false);
  1672. if assigned(W) then
  1673. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1674. end;
  1675. end;
  1676. begin
  1677. ForEach(@SetInSource);
  1678. end;
  1679. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1680. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1681. begin
  1682. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1683. end;
  1684. begin
  1685. GetType:=FirstThat(@IsThis);
  1686. end;
  1687. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1688. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1689. begin
  1690. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1691. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1692. end;
  1693. var
  1694. PB : PBreakpoint;
  1695. begin
  1696. ToggleFileLine:=false;
  1697. FileName:=OSFileName(FExpand(FileName));
  1698. PB:=FirstThat(@IsThere);
  1699. If Assigned(PB) then
  1700. begin
  1701. { delete it form source window }
  1702. PB^.state:=bs_disabled;
  1703. PB^.UpdateSource;
  1704. { remove from collection }
  1705. BreakpointsCollection^.free(PB);
  1706. end
  1707. else
  1708. begin
  1709. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1710. if assigned(PB) then
  1711. Begin
  1712. Insert(PB);
  1713. PB^.UpdateSource;
  1714. ToggleFileLine:=true;
  1715. End;
  1716. end;
  1717. Update;
  1718. end;
  1719. {****************************************************************************
  1720. TBreakpointItem
  1721. ****************************************************************************}
  1722. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1723. begin
  1724. inherited Init;
  1725. Breakpoint:=ABreakpoint;
  1726. end;
  1727. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1728. var S: string;
  1729. begin
  1730. with Breakpoint^ do
  1731. begin
  1732. S:=BreakpointTypeStr[typ];
  1733. While Length(S)<10 do
  1734. S:=S+' ';
  1735. S:=S+'|';
  1736. S:=S+BreakpointStateStr[state]+' ';
  1737. While Length(S)<20 do
  1738. S:=S+' ';
  1739. S:=S+'|';
  1740. if (typ=bt_file_line) then
  1741. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
  1742. else
  1743. S:=S+GetStr(name);
  1744. While Length(S)<40 do
  1745. S:=S+' ';
  1746. S:=S+'|';
  1747. if IgnoreCount>0 then
  1748. S:=S+IntToStr(IgnoreCount);
  1749. While Length(S)<49 do
  1750. S:=S+' ';
  1751. S:=S+'|';
  1752. if assigned(Conditions) then
  1753. S:=S+' '+GetStr(Conditions);
  1754. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1755. GetText:=S;
  1756. end;
  1757. end;
  1758. procedure TBreakpointItem.Selected;
  1759. begin
  1760. end;
  1761. function TBreakpointItem.GetModuleName: string;
  1762. begin
  1763. if breakpoint^.typ=bt_file_line then
  1764. GetModuleName:=GetStr(breakpoint^.FileName)
  1765. else
  1766. GetModuleName:='';
  1767. end;
  1768. {****************************************************************************
  1769. TBreakpointsListBox
  1770. ****************************************************************************}
  1771. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1772. begin
  1773. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1774. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1775. NoSelection:=true;
  1776. end;
  1777. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1778. var M: PMenu;
  1779. begin
  1780. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1781. M:=NewMenu(
  1782. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1783. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1784. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1785. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1786. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1787. nil))))));
  1788. GetLocalMenu:=M;
  1789. end;
  1790. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1791. var DontClear: boolean;
  1792. begin
  1793. case Event.What of
  1794. evKeyDown :
  1795. begin
  1796. DontClear:=false;
  1797. case Event.KeyCode of
  1798. kbEnd :
  1799. FocusItem(List^.Count-1);
  1800. kbHome :
  1801. FocusItem(0);
  1802. kbEnter :
  1803. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1804. kbIns :
  1805. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1806. kbDel :
  1807. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1808. else
  1809. DontClear:=true;
  1810. end;
  1811. if not DontClear then
  1812. ClearEvent(Event);
  1813. end;
  1814. evBroadcast :
  1815. case Event.Command of
  1816. cmListItemSelected :
  1817. if Event.InfoPtr=@Self then
  1818. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1819. end;
  1820. evCommand :
  1821. begin
  1822. DontClear:=false;
  1823. case Event.Command of
  1824. cmMsgTrackSource :
  1825. if Range>0 then
  1826. TrackSource;
  1827. cmEditBreakpoint :
  1828. EditCurrent;
  1829. cmToggleBreakpoint :
  1830. ToggleCurrent;
  1831. cmDeleteBreakpoint :
  1832. DeleteCurrent;
  1833. cmNewBreakpoint :
  1834. EditNew;
  1835. cmMsgClear :
  1836. Clear;
  1837. else
  1838. DontClear:=true;
  1839. end;
  1840. if not DontClear then
  1841. ClearEvent(Event);
  1842. end;
  1843. end;
  1844. inherited HandleEvent(Event);
  1845. end;
  1846. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1847. var W : integer;
  1848. begin
  1849. if List=nil then New(List, Init(20,20));
  1850. W:=length(P^.GetText(255));
  1851. if W>MaxWidth then
  1852. begin
  1853. MaxWidth:=W;
  1854. if HScrollBar<>nil then
  1855. HScrollBar^.SetRange(0,MaxWidth);
  1856. end;
  1857. List^.Insert(P);
  1858. SetRange(List^.Count);
  1859. if Focused=List^.Count-1-1 then
  1860. FocusItem(List^.Count-1);
  1861. P^.Breakpoint^.UpdateSource;
  1862. DrawView;
  1863. end;
  1864. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1865. var P: PBreakpointItem;
  1866. S: string;
  1867. begin
  1868. P:=List^.At(Item);
  1869. S:=P^.GetText(MaxLen);
  1870. GetText:=copy(S,1,MaxLen);
  1871. end;
  1872. procedure TBreakpointsListBox.Clear;
  1873. begin
  1874. if assigned(List) then
  1875. Dispose(List, Done);
  1876. List:=nil;
  1877. MaxWidth:=0;
  1878. SetRange(0); DrawView;
  1879. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1880. end;
  1881. procedure TBreakpointsListBox.TrackSource;
  1882. var W: PSourceWindow;
  1883. P: PBreakpointItem;
  1884. R: TRect;
  1885. begin
  1886. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1887. if Range=0 then Exit;*)
  1888. P:=List^.At(Focused);
  1889. if P^.GetModuleName='' then Exit;
  1890. Desktop^.Lock;
  1891. GetNextEditorBounds(R);
  1892. R.B.Y:=Owner^.Origin.Y;
  1893. W:=EditorWindowFile(P^.GetModuleName);
  1894. if assigned(W) then
  1895. begin
  1896. W^.GetExtent(R);
  1897. R.B.Y:=Owner^.Origin.Y;
  1898. W^.ChangeBounds(R);
  1899. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1900. end
  1901. else
  1902. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1903. if W<>nil then
  1904. begin
  1905. W^.Select;
  1906. W^.Editor^.TrackCursor(do_centre);
  1907. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  1908. end;
  1909. if Assigned(Owner) then
  1910. Owner^.Select;
  1911. Desktop^.UnLock;
  1912. end;
  1913. procedure TBreakpointsListBox.ToggleCurrent;
  1914. var
  1915. P: PBreakpointItem;
  1916. begin
  1917. if Range=0 then Exit;
  1918. P:=List^.At(Focused);
  1919. if P=nil then Exit;
  1920. if P^.Breakpoint^.state=bs_enabled then
  1921. P^.Breakpoint^.state:=bs_disabled
  1922. else if P^.Breakpoint^.state=bs_disabled then
  1923. P^.Breakpoint^.state:=bs_enabled;
  1924. P^.Breakpoint^.UpdateSource;
  1925. BreakpointsCollection^.Update;
  1926. end;
  1927. procedure TBreakpointsListBox.EditCurrent;
  1928. var
  1929. P: PBreakpointItem;
  1930. begin
  1931. if Range=0 then Exit;
  1932. P:=List^.At(Focused);
  1933. if P=nil then Exit;
  1934. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  1935. P^.Breakpoint^.UpdateSource;
  1936. BreakpointsCollection^.Update;
  1937. end;
  1938. procedure TBreakpointsListBox.DeleteCurrent;
  1939. var
  1940. P: PBreakpointItem;
  1941. begin
  1942. if Range=0 then Exit;
  1943. P:=List^.At(Focused);
  1944. if P=nil then Exit;
  1945. { delete it form source window }
  1946. P^.Breakpoint^.state:=bs_disabled;
  1947. P^.Breakpoint^.UpdateSource;
  1948. BreakpointsCollection^.free(P^.Breakpoint);
  1949. List^.free(P);
  1950. BreakpointsCollection^.Update;
  1951. end;
  1952. procedure TBreakpointsListBox.EditNew;
  1953. var
  1954. P: PBreakpoint;
  1955. begin
  1956. P:=New(PBreakpoint,Init_Empty);
  1957. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  1958. begin
  1959. P^.UpdateSource;
  1960. BreakpointsCollection^.Insert(P);
  1961. BreakpointsCollection^.Update;
  1962. end
  1963. else
  1964. dispose(P,Done);
  1965. end;
  1966. procedure TBreakpointsListBox.Draw;
  1967. var
  1968. I, J, Item: Sw_Integer;
  1969. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1970. ColWidth, CurCol, Indent: Integer;
  1971. B: TDrawBuffer;
  1972. Text: String;
  1973. SCOff: Byte;
  1974. TC: byte;
  1975. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1976. begin
  1977. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1978. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1979. begin
  1980. NormalColor := GetColor(1);
  1981. FocusedColor := GetColor(3);
  1982. SelectedColor := GetColor(4);
  1983. end else
  1984. begin
  1985. NormalColor := GetColor(2);
  1986. SelectedColor := GetColor(4);
  1987. end;
  1988. if Transparent then
  1989. begin MT(NormalColor); MT(SelectedColor); end;
  1990. if NoSelection then
  1991. SelectedColor:=NormalColor;
  1992. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1993. else Indent := 0;
  1994. ColWidth := Size.X div NumCols + 1;
  1995. for I := 0 to Size.Y - 1 do
  1996. begin
  1997. for J := 0 to NumCols-1 do
  1998. begin
  1999. Item := J*Size.Y + I + TopItem;
  2000. CurCol := J*ColWidth;
  2001. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2002. (Focused = Item) and (Range > 0) then
  2003. begin
  2004. Color := FocusedColor;
  2005. SetCursor(CurCol+1,I);
  2006. SCOff := 0;
  2007. end
  2008. else if (Item < Range) and IsSelected(Item) then
  2009. begin
  2010. Color := SelectedColor;
  2011. SCOff := 2;
  2012. end
  2013. else
  2014. begin
  2015. Color := NormalColor;
  2016. SCOff := 4;
  2017. end;
  2018. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2019. if Item < Range then
  2020. begin
  2021. Text := GetText(Item, ColWidth + Indent);
  2022. Text := Copy(Text,Indent,ColWidth);
  2023. MoveStr(B[CurCol+1], Text, Color);
  2024. if ShowMarkers then
  2025. begin
  2026. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2027. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2028. end;
  2029. end;
  2030. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2031. end;
  2032. WriteLine(0, I, Size.X, 1, B);
  2033. end;
  2034. end;
  2035. constructor TBreakpointsListBox.Load(var S: TStream);
  2036. begin
  2037. inherited Load(S);
  2038. end;
  2039. procedure TBreakpointsListBox.Store(var S: TStream);
  2040. var OL: PCollection;
  2041. OldR : integer;
  2042. begin
  2043. OL:=List;
  2044. OldR:=Range;
  2045. Range:=0;
  2046. New(List, Init(1,1));
  2047. inherited Store(S);
  2048. Dispose(List, Done);
  2049. Range:=OldR;
  2050. List:=OL;
  2051. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2052. collection? Pasting here a modified version of TListBox.Store+
  2053. TAdvancedListBox.Store isn't a better solution, since by eventually
  2054. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2055. end;
  2056. destructor TBreakpointsListBox.Done;
  2057. begin
  2058. inherited Done;
  2059. if List<>nil then Dispose(List, Done);
  2060. end;
  2061. {****************************************************************************
  2062. TBreakpointsWindow
  2063. ****************************************************************************}
  2064. constructor TBreakpointsWindow.Init;
  2065. var R,R2: TRect;
  2066. HSB,VSB: PScrollBar;
  2067. ST: PStaticText;
  2068. S: String;
  2069. X,X1 : Sw_integer;
  2070. Btn: PButton;
  2071. const
  2072. NumButtons = 5;
  2073. begin
  2074. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2075. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2076. HelpCtx:=hcBreakpointListWindow;
  2077. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2078. S:=label_breakpointpropheader;
  2079. New(ST, Init(R,S));
  2080. ST^.GrowMode:=gfGrowHiX;
  2081. Insert(ST);
  2082. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2083. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2084. ST^.GrowMode:=gfGrowHiX;
  2085. Insert(ST);
  2086. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2087. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2088. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2089. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2090. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2091. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2092. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2093. New(BreakLB, Init(R,HSB,VSB));
  2094. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2095. BreakLB^.Transparent:=true;
  2096. Insert(BreakLB);
  2097. GetExtent(R);R.Grow(-1,-1);
  2098. Dec(R.B.Y);
  2099. R.A.Y:=R.B.Y-2;
  2100. X:=(R.B.X-R.A.X) div NumButtons;
  2101. X1:=R.A.X+(X div 2);
  2102. R.A.X:=X1-3;R.B.X:=X1+7;
  2103. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2104. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2105. Insert(Btn);
  2106. X1:=X1+X;
  2107. R.A.X:=X1-3;R.B.X:=X1+7;
  2108. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2109. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2110. Insert(Btn);
  2111. X1:=X1+X;
  2112. R.A.X:=X1-3;R.B.X:=X1+7;
  2113. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2114. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2115. Insert(Btn);
  2116. X1:=X1+X;
  2117. R.A.X:=X1-3;R.B.X:=X1+7;
  2118. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2119. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2120. Insert(Btn);
  2121. X1:=X1+X;
  2122. R.A.X:=X1-3;R.B.X:=X1+7;
  2123. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2124. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2125. Insert(Btn);
  2126. BreakLB^.Select;
  2127. Update;
  2128. BreakpointsWindow:=@self;
  2129. end;
  2130. constructor TBreakpointsWindow.Load(var S: TStream);
  2131. begin
  2132. inherited Load(S);
  2133. GetSubViewPtr(S,BreakLB);
  2134. end;
  2135. procedure TBreakpointsWindow.Store(var S: TStream);
  2136. begin
  2137. inherited Store(S);
  2138. PutSubViewPtr(S,BreakLB);
  2139. end;
  2140. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2141. begin
  2142. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2143. end;
  2144. procedure TBreakpointsWindow.ClearBreakpoints;
  2145. begin
  2146. BreakLB^.Clear;
  2147. ReDraw;
  2148. end;
  2149. procedure TBreakpointsWindow.ReloadBreakpoints;
  2150. procedure InsertInBreakLB(P : PBreakpoint);
  2151. begin
  2152. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2153. end;
  2154. begin
  2155. If not assigned(BreakpointsCollection) then
  2156. exit;
  2157. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2158. ReDraw;
  2159. end;
  2160. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2161. begin
  2162. inherited SizeLimits(Min,Max);
  2163. Min.X:=40; Min.Y:=18;
  2164. end;
  2165. procedure TBreakpointsWindow.Close;
  2166. begin
  2167. Hide;
  2168. end;
  2169. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2170. var DontClear : boolean;
  2171. begin
  2172. case Event.What of
  2173. evKeyDown :
  2174. begin
  2175. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2176. begin
  2177. ClearEvent(Event);
  2178. Hide;
  2179. end;
  2180. end;
  2181. evCommand :
  2182. begin
  2183. DontClear:=False;
  2184. case Event.Command of
  2185. cmNewBreakpoint :
  2186. BreakLB^.EditNew;
  2187. cmEditBreakpoint :
  2188. BreakLB^.EditCurrent;
  2189. cmDeleteBreakpoint :
  2190. BreakLB^.DeleteCurrent;
  2191. cmToggleBreakInList :
  2192. BreakLB^.ToggleCurrent;
  2193. cmClose :
  2194. Hide;
  2195. else
  2196. DontClear:=true;
  2197. end;
  2198. if not DontClear then
  2199. ClearEvent(Event);
  2200. end;
  2201. evBroadcast :
  2202. case Event.Command of
  2203. cmUpdate :
  2204. Update;
  2205. end;
  2206. end;
  2207. inherited HandleEvent(Event);
  2208. end;
  2209. procedure TBreakpointsWindow.Update;
  2210. var
  2211. StoreFocus : longint;
  2212. begin
  2213. StoreFocus:=BreakLB^.Focused;
  2214. ClearBreakpoints;
  2215. ReloadBreakpoints;
  2216. If StoreFocus<BreakLB^.Range then
  2217. BreakLB^.FocusItem(StoreFocus);
  2218. end;
  2219. destructor TBreakpointsWindow.Done;
  2220. begin
  2221. inherited Done;
  2222. BreakpointsWindow:=nil;
  2223. end;
  2224. {****************************************************************************
  2225. TBreakpointItemDialog
  2226. ****************************************************************************}
  2227. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2228. var R,R2,R3: TRect;
  2229. Items: PSItem;
  2230. I : BreakpointType;
  2231. KeyCount: sw_integer;
  2232. begin
  2233. KeyCount:=longint(high(BreakpointType));
  2234. R.Assign(0,0,60,Max(9+KeyCount,18));
  2235. inherited Init(R,dialog_modifynewbreakpoint);
  2236. Breakpoint:=ABreakpoint;
  2237. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2238. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2239. New(NameIL, Init(R, 255)); Insert(NameIL);
  2240. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2241. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2242. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2243. R2.Copy(R); R2.Move(-1,-1);
  2244. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2245. R.Move(0,3);
  2246. R.B.X:=R.B.X-3;
  2247. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2248. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2249. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2250. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2251. R.Move(0,3); R.B.X:=R.A.X+36;
  2252. New(LineIL, Init(R, 128)); Insert(LineIL);
  2253. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2254. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2255. R.Move(0,3);
  2256. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2257. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2258. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2259. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2260. Items:=nil;
  2261. { don't use invalid type }
  2262. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2263. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2264. New(TypeRB, Init(R, Items));
  2265. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2266. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2267. Insert(TypeRB);
  2268. InsertButtons(@Self);
  2269. NameIL^.Select;
  2270. end;
  2271. function TBreakpointItemDialog.Execute: Word;
  2272. var R: sw_word;
  2273. S1: string;
  2274. err: word;
  2275. L: longint;
  2276. begin
  2277. R:=sw_word(Breakpoint^.typ);
  2278. TypeRB^.SetData(R);
  2279. If Breakpoint^.typ=bt_file_line then
  2280. S1:=GetStr(Breakpoint^.FileName)
  2281. else
  2282. S1:=GetStr(Breakpoint^.name);
  2283. NameIL^.SetData(S1);
  2284. If Breakpoint^.typ=bt_file_line then
  2285. S1:=IntToStr(Breakpoint^.Line)
  2286. else
  2287. S1:='0';
  2288. LineIL^.SetData(S1);
  2289. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2290. IgnoreIL^.SetData(S1);
  2291. S1:=GetStr(Breakpoint^.Conditions);
  2292. ConditionsIL^.SetData(S1);
  2293. if assigned(FirstEditorWindow) then
  2294. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2295. R:=inherited Execute;
  2296. FindReplaceEditor:=nil;
  2297. if R=cmOK then
  2298. begin
  2299. TypeRB^.GetData(R);
  2300. L:=R;
  2301. Breakpoint^.typ:=BreakpointType(L);
  2302. NameIL^.GetData(S1);
  2303. If Breakpoint^.typ=bt_file_line then
  2304. begin
  2305. If assigned(Breakpoint^.FileName) then
  2306. DisposeStr(Breakpoint^.FileName);
  2307. Breakpoint^.FileName:=NewStr(S1);
  2308. end
  2309. else
  2310. begin
  2311. If assigned(Breakpoint^.Name) then
  2312. DisposeStr(Breakpoint^.Name);
  2313. Breakpoint^.name:=NewStr(S1);
  2314. end;
  2315. If Breakpoint^.typ=bt_file_line then
  2316. begin
  2317. LineIL^.GetData(S1);
  2318. Val(S1,L,err);
  2319. Breakpoint^.Line:=L;
  2320. end;
  2321. IgnoreIL^.GetData(S1);
  2322. Val(S1,L,err);
  2323. Breakpoint^.IgnoreCount:=L;
  2324. ConditionsIL^.GetData(S1);
  2325. If assigned(Breakpoint^.Conditions) then
  2326. DisposeStr(Breakpoint^.Conditions);
  2327. Breakpoint^.Conditions:=NewStr(S1);
  2328. end;
  2329. Execute:=R;
  2330. end;
  2331. {****************************************************************************
  2332. TWatch
  2333. ****************************************************************************}
  2334. constructor TWatch.Init(s : string);
  2335. begin
  2336. expr:=NewStr(s);
  2337. last_value:=nil;
  2338. current_value:=nil;
  2339. Get_new_value;
  2340. GDBRunCount:=-1;
  2341. end;
  2342. constructor TWatch.Load(var S: TStream);
  2343. begin
  2344. expr:=S.ReadStr;
  2345. last_value:=nil;
  2346. current_value:=nil;
  2347. Get_new_value;
  2348. GDBRunCount:=-1;
  2349. end;
  2350. procedure TWatch.Store(var S: TStream);
  2351. begin
  2352. S.WriteStr(expr);
  2353. end;
  2354. procedure TWatch.rename(s : string);
  2355. begin
  2356. if assigned(expr) then
  2357. begin
  2358. if GetStr(expr)=S then
  2359. exit;
  2360. DisposeStr(expr);
  2361. end;
  2362. expr:=NewStr(s);
  2363. if assigned(last_value) then
  2364. StrDispose(last_value);
  2365. last_value:=nil;
  2366. if assigned(current_value) then
  2367. StrDispose(current_value);
  2368. current_value:=nil;
  2369. GDBRunCount:=-1;
  2370. Get_new_value;
  2371. end;
  2372. procedure TWatch.Get_new_value;
  2373. {$ifndef NODEBUG}
  2374. var p, q : pchar;
  2375. i, j, curframe, startframe : longint;
  2376. s,s2 : string;
  2377. loop_higher, found : boolean;
  2378. last_removed : char;
  2379. function GetValue(var s : string) : boolean;
  2380. begin
  2381. Debugger^.command('p '+s);
  2382. if not Debugger^.Error then
  2383. begin
  2384. s:=StrPas(Debugger^.GetOutput);
  2385. GetValue:=true;
  2386. end
  2387. else
  2388. begin
  2389. s:=StrPas(Debugger^.GetError);
  2390. GetValue:=false;
  2391. { do not open a messagebox for such errors }
  2392. Debugger^.got_error:=false;
  2393. end;
  2394. end;
  2395. begin
  2396. If not assigned(Debugger) or Not Debugger^.HasExe or
  2397. (GDBRunCount=Debugger^.RunCount) then
  2398. exit;
  2399. GDBRunCount:=Debugger^.RunCount;
  2400. if assigned(last_value) then
  2401. strdispose(last_value);
  2402. last_value:=current_value;
  2403. s:=GetStr(expr);
  2404. { Fix 2d array indexing, change [x,x] to [x][x] }
  2405. i:=pos('[',s);
  2406. if i>0 then
  2407. begin
  2408. while i<length(s) do
  2409. begin
  2410. if s[i]=',' then
  2411. begin
  2412. s[i]:='[';
  2413. insert(']',s,i);
  2414. inc(i);
  2415. end;
  2416. inc(i);
  2417. end;
  2418. end;
  2419. found:=GetValue(s);
  2420. Debugger^.got_error:=false;
  2421. loop_higher:=not found;
  2422. if not found then
  2423. begin
  2424. curframe:=Debugger^.get_current_frame;
  2425. startframe:=curframe;
  2426. end
  2427. else
  2428. begin
  2429. curframe:=0;
  2430. startframe:=0;
  2431. end;
  2432. while loop_higher do
  2433. begin
  2434. s:='parent_ebp';
  2435. if GetValue(s) then
  2436. begin
  2437. repeat
  2438. inc(curframe);
  2439. if not Debugger^.set_current_frame(curframe) then
  2440. loop_higher:=false;
  2441. {$ifdef FrameNameKnown}
  2442. s2:='/x '+FrameName;
  2443. {$else not FrameNameKnown}
  2444. s2:='/x $ebp';
  2445. {$endif FrameNameKnown}
  2446. getValue(s2);
  2447. j:=pos('=',s2);
  2448. if j>0 then
  2449. s2:=copy(s2,j+1,length(s2));
  2450. while s2[1] in [' ',TAB] do
  2451. delete(s2,1,1);
  2452. if pos(s2,s)>0 then
  2453. loop_higher :=false;
  2454. until not loop_higher;
  2455. { try again at that level }
  2456. s:=GetStr(expr);
  2457. found:=GetValue(s);
  2458. loop_higher:=not found;
  2459. end
  2460. else
  2461. loop_higher:=false;
  2462. end;
  2463. if found then
  2464. p:=StrNew(Debugger^.GetOutput)
  2465. else
  2466. begin
  2467. { get a reasonable output at least }
  2468. s:=GetStr(expr);
  2469. GetValue(s);
  2470. p:=StrNew(Debugger^.GetError);
  2471. end;
  2472. Debugger^.got_error:=false;
  2473. { We should try here to find the expr in parent
  2474. procedure if there are
  2475. I will implement this as I added a
  2476. parent_ebp pseudo local var to local procedure
  2477. in stabs debug info PM }
  2478. { But there are some pitfalls like
  2479. locals redefined in other sublocals that call the function }
  2480. if curframe<>startframe then
  2481. Debugger^.set_current_frame(startframe);
  2482. q:=nil;
  2483. if assigned(p) and (p[0]='$') then
  2484. q:=StrPos(p,'=');
  2485. if not assigned(q) then
  2486. q:=p;
  2487. if assigned(q) then
  2488. i:=strlen(q)
  2489. else
  2490. i:=0;
  2491. if (i>0) and (q[i-1]=#10) then
  2492. begin
  2493. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2494. dec(i);
  2495. last_removed:=q[i-1];
  2496. q[i-1]:=#0;
  2497. end
  2498. else
  2499. last_removed:=#0;
  2500. if assigned(q) then
  2501. current_value:=strnew(q)
  2502. else
  2503. current_value:=strnew('');
  2504. if last_removed<>#0 then
  2505. q[i-1]:=last_removed;
  2506. strdispose(p);
  2507. GDBRunCount:=Debugger^.RunCount;
  2508. end;
  2509. {$else NODEBUG}
  2510. begin
  2511. end;
  2512. {$endif NODEBUG}
  2513. procedure TWatch.Force_new_value;
  2514. begin
  2515. GDBRunCount:=-1;
  2516. Get_new_value;
  2517. end;
  2518. destructor TWatch.Done;
  2519. begin
  2520. if assigned(expr) then
  2521. disposestr(expr);
  2522. if assigned(last_value) then
  2523. strdispose(last_value);
  2524. if assigned(current_value) then
  2525. strdispose(current_value);
  2526. inherited done;
  2527. end;
  2528. {****************************************************************************
  2529. TWatchesCollection
  2530. ****************************************************************************}
  2531. constructor TWatchesCollection.Init;
  2532. begin
  2533. inherited Init(10,10);
  2534. end;
  2535. procedure TWatchesCollection.Insert(Item: Pointer);
  2536. begin
  2537. PWatch(Item)^.Get_new_value;
  2538. Inherited Insert(Item);
  2539. Update;
  2540. end;
  2541. procedure TWatchesCollection.Update;
  2542. var
  2543. W,W1 : integer;
  2544. procedure GetMax(P : PWatch);
  2545. begin
  2546. if assigned(P^.Current_value) then
  2547. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2548. else
  2549. W1:=2+Length(GetStr(P^.expr));
  2550. if W1>W then
  2551. W:=W1;
  2552. end;
  2553. begin
  2554. W:=0;
  2555. ForEach(@GetMax);
  2556. MaxW:=W;
  2557. If assigned(WatchesWindow) then
  2558. WatchesWindow^.WLB^.Update(MaxW);
  2559. end;
  2560. function TWatchesCollection.At(Index: Integer): PWatch;
  2561. begin
  2562. At:=Inherited At(Index);
  2563. end;
  2564. {****************************************************************************
  2565. TWatchesListBox
  2566. ****************************************************************************}
  2567. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2568. begin
  2569. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2570. If assigned(List) then
  2571. dispose(list,done);
  2572. List:=WatchesCollection;
  2573. end;
  2574. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2575. var R : TRect;
  2576. begin
  2577. GetExtent(R);
  2578. MaxWidth:=AMaxWidth;
  2579. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2580. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2581. else
  2582. HScrollBar^.SetRange(0,0);
  2583. if R.B.X-R.A.X>MaxWidth then
  2584. HScrollBar^.Hide
  2585. else
  2586. HScrollBar^.Show;
  2587. SetRange(List^.Count+1);
  2588. if R.B.Y-R.A.Y>Range then
  2589. VScrollBar^.Hide
  2590. else
  2591. VScrollBar^.Show;
  2592. {if Focused=List^.Count-1-1 then
  2593. FocusItem(List^.Count-1);
  2594. What was that for ?? PM }
  2595. DrawView;
  2596. end;
  2597. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2598. var
  2599. PW : PWatch;
  2600. ValOffset : Sw_integer;
  2601. S : String;
  2602. begin
  2603. Modified:=false;
  2604. if Item>=WatchesCollection^.Count then
  2605. begin
  2606. GetIndentedText:='';
  2607. exit;
  2608. end;
  2609. PW:=WatchesCollection^.At(Item);
  2610. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2611. if not assigned(PW^.expr) then
  2612. GetIndentedText:=''
  2613. else if Indent<ValOffset then
  2614. begin
  2615. S:=GetStr(PW^.Expr);
  2616. if Indent=0 then
  2617. S:=' '+S
  2618. else
  2619. S:=Copy(S,Indent,High(S));
  2620. if not assigned(PW^.current_value) then
  2621. S:=S+' <Unknown value>'
  2622. else
  2623. S:=S+' '+GetPChar(PW^.Current_value);
  2624. GetIndentedText:=Copy(S,1,MaxLen);
  2625. end
  2626. else
  2627. begin
  2628. if not assigned(PW^.Current_value) or
  2629. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2630. S:=''
  2631. else
  2632. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2633. GetIndentedText:=Copy(S,1,MaxLen);
  2634. end;
  2635. if assigned(PW^.current_value) and
  2636. assigned(PW^.last_value) and
  2637. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2638. Modified:=true;
  2639. end;
  2640. procedure TWatchesListBox.EditCurrent;
  2641. var
  2642. P: PWatch;
  2643. begin
  2644. if Range=0 then Exit;
  2645. if Focused<WatchesCollection^.Count then
  2646. P:=WatchesCollection^.At(Focused)
  2647. else
  2648. P:=New(PWatch,Init(''));
  2649. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2650. WatchesCollection^.Update;
  2651. end;
  2652. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2653. var
  2654. Dummy_Modified : boolean;
  2655. begin
  2656. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2657. end;
  2658. procedure TWatchesListBox.DeleteCurrent;
  2659. var
  2660. P: PWatch;
  2661. begin
  2662. if (Range=0) or
  2663. (Focused>=WatchesCollection^.Count) then
  2664. exit;
  2665. P:=WatchesCollection^.At(Focused);
  2666. WatchesCollection^.free(P);
  2667. WatchesCollection^.Update;
  2668. end;
  2669. procedure TWatchesListBox.EditNew;
  2670. var
  2671. P: PWatch;
  2672. S : string;
  2673. begin
  2674. if Focused<WatchesCollection^.Count then
  2675. begin
  2676. P:=WatchesCollection^.At(Focused);
  2677. S:=GetStr(P^.expr);
  2678. end
  2679. else
  2680. S:='';
  2681. P:=New(PWatch,Init(S));
  2682. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2683. begin
  2684. WatchesCollection^.AtInsert(Focused,P);
  2685. WatchesCollection^.Update;
  2686. end
  2687. else
  2688. dispose(P,Done);
  2689. end;
  2690. procedure TWatchesListBox.Draw;
  2691. var
  2692. I, J, Item: Sw_Integer;
  2693. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2694. ColWidth, CurCol, Indent: Integer;
  2695. B: TDrawBuffer;
  2696. Modified : boolean;
  2697. Text: String;
  2698. SCOff: Byte;
  2699. TC: byte;
  2700. procedure MT(var C: word);
  2701. begin
  2702. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2703. end;
  2704. begin
  2705. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2706. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2707. begin
  2708. NormalColor := GetColor(1);
  2709. FocusedColor := GetColor(3);
  2710. SelectedColor := GetColor(4);
  2711. end else
  2712. begin
  2713. NormalColor := GetColor(2);
  2714. SelectedColor := GetColor(4);
  2715. end;
  2716. if Transparent then
  2717. begin MT(NormalColor); MT(SelectedColor); end;
  2718. (* if NoSelection then
  2719. SelectedColor:=NormalColor;*)
  2720. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2721. else Indent := 0;
  2722. ColWidth := Size.X div NumCols + 1;
  2723. for I := 0 to Size.Y - 1 do
  2724. begin
  2725. for J := 0 to NumCols-1 do
  2726. begin
  2727. Item := J*Size.Y + I + TopItem;
  2728. CurCol := J*ColWidth;
  2729. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2730. (Focused = Item) and (Range > 0) then
  2731. begin
  2732. Color := FocusedColor;
  2733. SetCursor(CurCol+1,I);
  2734. SCOff := 0;
  2735. end
  2736. else if (Item < Range) and IsSelected(Item) then
  2737. begin
  2738. Color := SelectedColor;
  2739. SCOff := 2;
  2740. end
  2741. else
  2742. begin
  2743. Color := NormalColor;
  2744. SCOff := 4;
  2745. end;
  2746. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2747. if Item < Range then
  2748. begin
  2749. (* Text := GetText(Item, ColWidth + Indent);
  2750. Text := Copy(Text,Indent,ColWidth); *)
  2751. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2752. if modified then
  2753. begin
  2754. SCOff:=0;
  2755. Color:=(Color and $fff0) or Red;
  2756. end;
  2757. MoveStr(B[CurCol], Text, Color);
  2758. if {ShowMarkers or } Modified then
  2759. begin
  2760. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2761. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2762. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2763. end;
  2764. end;
  2765. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2766. end;
  2767. WriteLine(0, I, Size.X, 1, B);
  2768. end;
  2769. end;
  2770. function TWatchesListBox.GetLocalMenu: PMenu;
  2771. var M: PMenu;
  2772. begin
  2773. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2774. M:=NewMenu(
  2775. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2776. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2777. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2778. NewLine(
  2779. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2780. nil))))));
  2781. GetLocalMenu:=M;
  2782. end;
  2783. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2784. var DontClear: boolean;
  2785. begin
  2786. case Event.What of
  2787. evKeyDown :
  2788. begin
  2789. DontClear:=false;
  2790. case Event.KeyCode of
  2791. kbEnter :
  2792. Message(@Self,evCommand,cmEdit,nil);
  2793. kbIns :
  2794. Message(@Self,evCommand,cmNew,nil);
  2795. kbDel :
  2796. Message(@Self,evCommand,cmDelete,nil);
  2797. else
  2798. DontClear:=true;
  2799. end;
  2800. if not DontClear then
  2801. ClearEvent(Event);
  2802. end;
  2803. evBroadcast :
  2804. case Event.Command of
  2805. cmListItemSelected :
  2806. if Event.InfoPtr=@Self then
  2807. Message(@Self,evCommand,cmEdit,nil);
  2808. end;
  2809. evCommand :
  2810. begin
  2811. DontClear:=false;
  2812. case Event.Command of
  2813. cmEdit :
  2814. EditCurrent;
  2815. cmDelete :
  2816. DeleteCurrent;
  2817. cmNew :
  2818. EditNew;
  2819. else
  2820. DontClear:=true;
  2821. end;
  2822. if not DontClear then
  2823. ClearEvent(Event);
  2824. end;
  2825. end;
  2826. inherited HandleEvent(Event);
  2827. end;
  2828. constructor TWatchesListBox.Load(var S: TStream);
  2829. begin
  2830. inherited Load(S);
  2831. If assigned(List) then
  2832. dispose(list,done);
  2833. List:=WatchesCollection;
  2834. { we must set Range PM }
  2835. SetRange(List^.count+1);
  2836. end;
  2837. procedure TWatchesListBox.Store(var S: TStream);
  2838. var OL: PCollection;
  2839. OldRange : Sw_integer;
  2840. begin
  2841. OL:=List;
  2842. OldRange:=Range;
  2843. Range:=0;
  2844. New(List, Init(1,1));
  2845. inherited Store(S);
  2846. Dispose(List, Done);
  2847. List:=OL;
  2848. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2849. collection? Pasting here a modified version of TListBox.Store+
  2850. TAdvancedListBox.Store isn't a better solution, since by eventually
  2851. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2852. SetRange(OldRange);
  2853. end;
  2854. destructor TWatchesListBox.Done;
  2855. begin
  2856. List:=nil;
  2857. inherited Done;
  2858. end;
  2859. {****************************************************************************
  2860. TWatchesWindow
  2861. ****************************************************************************}
  2862. Constructor TWatchesWindow.Init;
  2863. var
  2864. HSB,VSB: PScrollBar;
  2865. R,R2 : trect;
  2866. begin
  2867. Desktop^.GetExtent(R);
  2868. R.A.Y:=R.B.Y-7;
  2869. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  2870. Palette:=wpCyanWindow;
  2871. GetExtent(R);
  2872. HelpCtx:=hcWatchesWindow;
  2873. R.Grow(-1,-1);
  2874. R2.Copy(R);
  2875. Inc(R2.B.Y);
  2876. R2.A.Y:=R2.B.Y-1;
  2877. New(HSB, Init(R2));
  2878. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2879. HSB^.SetStep(R.B.X-R.A.X,1);
  2880. Insert(HSB);
  2881. R2.Copy(R);
  2882. Inc(R2.B.X);
  2883. R2.A.X:=R2.B.X-1;
  2884. New(VSB, Init(R2));
  2885. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2886. Insert(VSB);
  2887. New(WLB,Init(R,HSB,VSB));
  2888. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2889. WLB^.Transparent:=true;
  2890. Insert(WLB);
  2891. If assigned(WatchesWindow) then
  2892. dispose(WatchesWindow,done);
  2893. WatchesWindow:=@Self;
  2894. Update;
  2895. end;
  2896. procedure TWatchesWindow.Update;
  2897. begin
  2898. WatchesCollection^.Update;
  2899. Draw;
  2900. end;
  2901. constructor TWatchesWindow.Load(var S: TStream);
  2902. begin
  2903. inherited Load(S);
  2904. GetSubViewPtr(S,WLB);
  2905. If assigned(WatchesWindow) then
  2906. dispose(WatchesWindow,done);
  2907. WatchesWindow:=@Self;
  2908. end;
  2909. procedure TWatchesWindow.Store(var S: TStream);
  2910. begin
  2911. inherited Store(S);
  2912. PutSubViewPtr(S,WLB);
  2913. end;
  2914. Destructor TWatchesWindow.Done;
  2915. begin
  2916. WatchesWindow:=nil;
  2917. Dispose(WLB,done);
  2918. inherited done;
  2919. end;
  2920. {****************************************************************************
  2921. TWatchItemDialog
  2922. ****************************************************************************}
  2923. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2924. var R,R2: TRect;
  2925. begin
  2926. R.Assign(0,0,50,10);
  2927. inherited Init(R,'Edit Watch');
  2928. Watch:=AWatch;
  2929. GetExtent(R); R.Grow(-3,-2);
  2930. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2931. New(NameIL, Init(R, 255)); Insert(NameIL);
  2932. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2933. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  2934. R2.Copy(R); R2.Move(-1,-1);
  2935. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  2936. GetExtent(R);
  2937. R.Grow(-3,-1);
  2938. R.A.Y:=R.A.Y+3;
  2939. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  2940. Insert(TextST);
  2941. InsertButtons(@Self);
  2942. NameIL^.Select;
  2943. end;
  2944. function TWatchItemDialog.Execute: Word;
  2945. var R: word;
  2946. S1,S2: string;
  2947. begin
  2948. S1:=GetStr(Watch^.expr);
  2949. NameIL^.SetData(S1);
  2950. S1:=GetPChar(Watch^.Current_value);
  2951. S2:=GetPChar(Watch^.Last_value);
  2952. ClearFormatParams;
  2953. AddFormatParamStr(S1);
  2954. AddFormatParamStr(S2);
  2955. if assigned(Watch^.Last_value) and
  2956. assigned(Watch^.Current_value) and
  2957. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2958. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  2959. else
  2960. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  2961. TextST^.SetText(S1);
  2962. if assigned(FirstEditorWindow) then
  2963. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2964. R:=inherited Execute;
  2965. FindReplaceEditor:=nil;
  2966. if R=cmOK then
  2967. begin
  2968. NameIL^.GetData(S1);
  2969. Watch^.Rename(S1);
  2970. {$ifndef NODEBUG}
  2971. If assigned(Debugger) then
  2972. Debugger^.ReadWatches;
  2973. {$endif NODEBUG}
  2974. end;
  2975. Execute:=R;
  2976. end;
  2977. {****************************************************************************
  2978. TStackWindow
  2979. ****************************************************************************}
  2980. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2981. begin
  2982. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2983. end;
  2984. procedure TFramesListBox.Update;
  2985. var i : longint;
  2986. W : PSourceWindow;
  2987. begin
  2988. {$ifndef NODEBUG}
  2989. { call backtrace command }
  2990. If not assigned(Debugger) then
  2991. exit;
  2992. DeskTop^.Lock;
  2993. Clear;
  2994. { forget all old frames }
  2995. Debugger^.clear_frames;
  2996. if Debugger^.WindowWidth<>-1 then
  2997. Debugger^.Command('set width 0xffffffff');
  2998. Debugger^.Command('backtrace');
  2999. { generate list }
  3000. { all is in tframeentry }
  3001. for i:=0 to Debugger^.frame_count-1 do
  3002. begin
  3003. with Debugger^.frames[i]^ do
  3004. begin
  3005. if assigned(file_name) then
  3006. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3007. AddModuleName(GetPChar(file_name)),line_number,1)))
  3008. else
  3009. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3010. AddModuleName(''),line_number,1)));
  3011. W:=SearchOnDesktop(GetPChar(file_name),false);
  3012. { First reset all Debugger rows }
  3013. If assigned(W) then
  3014. begin
  3015. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3016. W^.Editor^.DebuggerRow:=-1;
  3017. end;
  3018. end;
  3019. end;
  3020. { Now set all Debugger rows }
  3021. for i:=0 to Debugger^.frame_count-1 do
  3022. begin
  3023. with Debugger^.frames[i]^ do
  3024. begin
  3025. W:=SearchOnDesktop(GetPChar(file_name),false);
  3026. If assigned(W) then
  3027. begin
  3028. If W^.Editor^.DebuggerRow=-1 then
  3029. begin
  3030. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3031. W^.Editor^.DebuggerRow:=line_number-1;
  3032. end;
  3033. end;
  3034. end;
  3035. end;
  3036. if Assigned(list) and (List^.Count > 0) then
  3037. FocusItem(0);
  3038. if Debugger^.WindowWidth<>-1 then
  3039. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3040. DeskTop^.Unlock;
  3041. {$endif NODEBUG}
  3042. end;
  3043. function TFramesListBox.GetLocalMenu: PMenu;
  3044. begin
  3045. GetLocalMenu:=Inherited GetLocalMenu;
  3046. end;
  3047. procedure TFramesListBox.GotoSource;
  3048. begin
  3049. {$ifndef NODEBUG}
  3050. { select frame for watches }
  3051. If not assigned(Debugger) then
  3052. exit;
  3053. Debugger^.Command('f '+IntToStr(Focused));
  3054. { for local vars }
  3055. Debugger^.RereadWatches;
  3056. {$endif NODEBUG}
  3057. { goto source }
  3058. inherited GotoSource;
  3059. end;
  3060. procedure TFramesListBox.GotoAssembly;
  3061. begin
  3062. {$ifndef NODEBUG}
  3063. { select frame for watches }
  3064. If not assigned(Debugger) then
  3065. exit;
  3066. Debugger^.Command('f '+IntToStr(Focused));
  3067. { for local vars }
  3068. Debugger^.RereadWatches;
  3069. {$endif}
  3070. { goto source/assembly mixture }
  3071. InitDisassemblyWindow;
  3072. DisassemblyWindow^.LoadFunction('');
  3073. {$ifndef NODEBUG}
  3074. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3075. DisassemblyWindow^.SelectInDebugSession;
  3076. {$endif NODEBUG}
  3077. end;
  3078. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3079. begin
  3080. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3081. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3082. GotoAssembly;
  3083. inherited HandleEvent(Event);
  3084. end;
  3085. destructor TFramesListBox.Done;
  3086. begin
  3087. Inherited Done;
  3088. end;
  3089. Constructor TStackWindow.Init;
  3090. var
  3091. HSB,VSB: PScrollBar;
  3092. R,R2 : trect;
  3093. begin
  3094. Desktop^.GetExtent(R);
  3095. R.A.Y:=R.B.Y-5;
  3096. inherited Init(R, dialog_callstack, wnNoNumber);
  3097. Palette:=wpCyanWindow;
  3098. GetExtent(R);
  3099. HelpCtx:=hcStackWindow;
  3100. R.Grow(-1,-1);
  3101. R2.Copy(R);
  3102. Inc(R2.B.Y);
  3103. R2.A.Y:=R2.B.Y-1;
  3104. New(HSB, Init(R2));
  3105. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3106. Insert(HSB);
  3107. R2.Copy(R);
  3108. Inc(R2.B.X);
  3109. R2.A.X:=R2.B.X-1;
  3110. New(VSB, Init(R2));
  3111. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3112. Insert(VSB);
  3113. New(FLB,Init(R,HSB,VSB));
  3114. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3115. Insert(FLB);
  3116. If assigned(StackWindow) then
  3117. dispose(StackWindow,done);
  3118. StackWindow:=@Self;
  3119. Update;
  3120. end;
  3121. procedure TStackWindow.Update;
  3122. begin
  3123. FLB^.Update;
  3124. DrawView;
  3125. end;
  3126. constructor TStackWindow.Load(var S: TStream);
  3127. begin
  3128. inherited Load(S);
  3129. GetSubViewPtr(S,FLB);
  3130. If assigned(StackWindow) then
  3131. dispose(StackWindow,done);
  3132. StackWindow:=@Self;
  3133. end;
  3134. procedure TStackWindow.Store(var S: TStream);
  3135. begin
  3136. inherited Store(S);
  3137. PutSubViewPtr(S,FLB);
  3138. end;
  3139. Destructor TStackWindow.Done;
  3140. begin
  3141. StackWindow:=nil;
  3142. Dispose(FLB,done);
  3143. inherited done;
  3144. end;
  3145. {****************************************************************************
  3146. Init/Final
  3147. ****************************************************************************}
  3148. function GetGDBTargetShortName : string;
  3149. begin
  3150. {$ifdef SUPPORT_REMOTE}
  3151. {$ifdef PALMOSGDB}
  3152. GetGDBTargetShortName:='palmos';
  3153. {$else}
  3154. GetGDBTargetShortName:='linux';
  3155. {$endif PALMOSGDB}
  3156. {$else not SUPPORT_REMOTE}
  3157. GetGDBTargetShortName:=source_info.shortname
  3158. {$endif not SUPPORT_REMOTE}
  3159. end;
  3160. procedure InitDebugger;
  3161. {$ifdef DEBUG}
  3162. var s : string;
  3163. i,p : longint;
  3164. {$endif DEBUG}
  3165. var
  3166. NeedRecompileExe : boolean;
  3167. cm : longint;
  3168. begin
  3169. {$ifdef DEBUG}
  3170. if not use_gdb_file then
  3171. begin
  3172. Assign(gdb_file,GDBOutFileName);
  3173. {$I-}
  3174. Rewrite(gdb_file);
  3175. if InOutRes<>0 then
  3176. begin
  3177. s:=GDBOutFileName;
  3178. p:=pos('.',s);
  3179. if p>1 then
  3180. for i:=0 to 9 do
  3181. begin
  3182. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3183. InOutRes:=0;
  3184. Assign(gdb_file,s);
  3185. rewrite(gdb_file);
  3186. if InOutRes=0 then
  3187. break;
  3188. end;
  3189. end;
  3190. if IOResult=0 then
  3191. Use_gdb_file:=true;
  3192. end;
  3193. {$I+}
  3194. {$endif}
  3195. NeedRecompileExe:=false;
  3196. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3197. begin
  3198. ClearFormatParams;
  3199. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3200. AddFormatParamStr(GetGDBTargetShortName);
  3201. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3202. if cm=cmCancel then
  3203. Exit;
  3204. if cm=cmYes then
  3205. begin
  3206. { force recompilation }
  3207. PrevMainFile:='';
  3208. NeedRecompileExe:=true;
  3209. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3210. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3211. DebugInfoSwitches^.SetCurrSelParam('l');
  3212. IDEApp.UpdateTarget;
  3213. end;
  3214. end;
  3215. if not NeedRecompileExe then
  3216. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3217. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3218. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3219. begin
  3220. ClearFormatParams;
  3221. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3222. if cm=cmCancel then
  3223. Exit;
  3224. if cm=cmYes then
  3225. begin
  3226. { force recompilation }
  3227. PrevMainFile:='';
  3228. NeedRecompileExe:=true;
  3229. DebugInfoSwitches^.SetCurrSelParam('l');
  3230. end;
  3231. end;
  3232. if NeedRecompileExe then
  3233. DoCompile(cRun);
  3234. if CompilationPhase<>cpDone then
  3235. Exit;
  3236. if (EXEFile='') then
  3237. begin
  3238. ErrorBox(msg_nothingtodebug,nil);
  3239. Exit;
  3240. end;
  3241. { init debugcontroller }
  3242. {$ifndef NODEBUG}
  3243. if not assigned(Debugger) then
  3244. begin
  3245. PushStatus(msg_startingdebugger);
  3246. new(Debugger,Init);
  3247. PopStatus;
  3248. end;
  3249. Debugger^.SetExe(ExeFile);
  3250. {$endif NODEBUG}
  3251. {$ifdef GDBWINDOW}
  3252. InitGDBWindow;
  3253. {$endif def GDBWINDOW}
  3254. end;
  3255. procedure DoneDebugger;
  3256. begin
  3257. {$ifdef DEBUG}
  3258. If IDEApp.IsRunning then
  3259. PushStatus('Closing debugger');
  3260. {$endif}
  3261. {$ifndef NODEBUG}
  3262. if assigned(Debugger) then
  3263. dispose(Debugger,Done);
  3264. Debugger:=nil;
  3265. {$endif NODEBUG}
  3266. {$ifdef DOS}
  3267. If assigned(UserScreen) then
  3268. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3269. {$endif DOS}
  3270. {$ifdef DEBUG}
  3271. If Use_gdb_file then
  3272. begin
  3273. Use_gdb_file:=false;
  3274. Close(GDB_file);
  3275. end;
  3276. If IDEApp.IsRunning then
  3277. PopStatus;
  3278. {$endif DEBUG}
  3279. end;
  3280. procedure InitGDBWindow;
  3281. var
  3282. R : TRect;
  3283. begin
  3284. if GDBWindow=nil then
  3285. begin
  3286. DeskTop^.GetExtent(R);
  3287. new(GDBWindow,init(R));
  3288. DeskTop^.Insert(GDBWindow);
  3289. end;
  3290. end;
  3291. procedure DoneGDBWindow;
  3292. begin
  3293. If IDEApp.IsRunning and
  3294. assigned(GDBWindow) then
  3295. begin
  3296. DeskTop^.Delete(GDBWindow);
  3297. end;
  3298. GDBWindow:=nil;
  3299. end;
  3300. procedure InitDisassemblyWindow;
  3301. var
  3302. R : TRect;
  3303. begin
  3304. if DisassemblyWindow=nil then
  3305. begin
  3306. DeskTop^.GetExtent(R);
  3307. new(DisassemblyWindow,init(R));
  3308. DeskTop^.Insert(DisassemblyWindow);
  3309. end;
  3310. end;
  3311. procedure DoneDisassemblyWindow;
  3312. begin
  3313. if assigned(DisassemblyWindow) then
  3314. begin
  3315. DeskTop^.Delete(DisassemblyWindow);
  3316. Dispose(DisassemblyWindow,Done);
  3317. DisassemblyWindow:=nil;
  3318. end;
  3319. end;
  3320. procedure InitStackWindow;
  3321. begin
  3322. if StackWindow=nil then
  3323. begin
  3324. new(StackWindow,init);
  3325. DeskTop^.Insert(StackWindow);
  3326. end;
  3327. end;
  3328. procedure DoneStackWindow;
  3329. begin
  3330. if assigned(StackWindow) then
  3331. begin
  3332. DeskTop^.Delete(StackWindow);
  3333. StackWindow:=nil;
  3334. end;
  3335. end;
  3336. procedure InitBreakpoints;
  3337. begin
  3338. New(BreakpointsCollection,init(10,10));
  3339. end;
  3340. procedure DoneBreakpoints;
  3341. begin
  3342. Dispose(BreakpointsCollection,Done);
  3343. BreakpointsCollection:=nil;
  3344. end;
  3345. procedure InitWatches;
  3346. begin
  3347. New(WatchesCollection,init);
  3348. end;
  3349. procedure DoneWatches;
  3350. begin
  3351. Dispose(WatchesCollection,Done);
  3352. WatchesCollection:=nil;
  3353. end;
  3354. procedure RegisterFPDebugViews;
  3355. begin
  3356. RegisterType(RWatchesWindow);
  3357. RegisterType(RBreakpointsWindow);
  3358. RegisterType(RWatchesListBox);
  3359. RegisterType(RBreakpointsListBox);
  3360. RegisterType(RStackWindow);
  3361. RegisterType(RFramesListBox);
  3362. RegisterType(RBreakpoint);
  3363. RegisterType(RWatch);
  3364. RegisterType(RBreakpointCollection);
  3365. RegisterType(RWatchesCollection);
  3366. end;
  3367. end.
  3368. {$endif NODEBUG}