fpdebug.pas 105 KB

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