fpdebug.pas 106 KB

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