fpdebug.pas 106 KB

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