fpdebug.pas 105 KB

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