fpdebug.pas 104 KB

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