fpdebug.pas 101 KB

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