fpdebug.pas 101 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880
  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. var
  988. old_reset : boolean;
  989. begin
  990. inherited Reset;
  991. { we need to free the executable
  992. if we want to recompile it }
  993. old_reset:=reset_command;
  994. reset_command:=true;
  995. SetExe('');
  996. reset_command:=old_reset;
  997. NoSwitch:=false;
  998. { In case we have something that the compiler touched }
  999. If IDEApp.IsRunning then
  1000. begin
  1001. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  1002. IDEApp.UpdateRunMenu(false);
  1003. AskToReloadAllModifiedFiles;
  1004. ResetDebuggerRows;
  1005. end;
  1006. end;
  1007. procedure TDebugController.AnnotateError;
  1008. var errornb : longint;
  1009. begin
  1010. if error then
  1011. begin
  1012. errornb:=error_num;
  1013. UpdateDebugViews;
  1014. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  1015. end;
  1016. end;
  1017. function TDebugController.GetValue(Const expr : string) : pchar;
  1018. var
  1019. p,p2,p3 : pchar;
  1020. begin
  1021. if WindowWidth<>-1 then
  1022. Command('set width 0xffffffff');
  1023. Command('p '+expr);
  1024. p:=GetOutput;
  1025. p3:=nil;
  1026. if assigned(p) and (p[strlen(p)-1]=#10) then
  1027. begin
  1028. p3:=p+strlen(p)-1;
  1029. p3^:=#0;
  1030. end;
  1031. if assigned(p) then
  1032. p2:=strpos(p,'=')
  1033. else
  1034. p2:=nil;
  1035. if assigned(p2) then
  1036. p:=p2+1;
  1037. while p^ in [' ',TAB] do
  1038. inc(p);
  1039. { get rid of type }
  1040. if p^ = '(' then
  1041. p:=strpos(p,')')+1;
  1042. while p^ in [' ',TAB] do
  1043. inc(p);
  1044. if assigned(p) then
  1045. GetValue:=StrNew(p)
  1046. else
  1047. GetValue:=StrNew(GetError);
  1048. if assigned(p3) then
  1049. p3^:=#10;
  1050. got_error:=false;
  1051. if WindowWidth<>-1 then
  1052. Command('set width '+IntToStr(WindowWidth));
  1053. end;
  1054. function TDebugController.GetFramePointer : CORE_ADDR;
  1055. var
  1056. st : string;
  1057. p : longint;
  1058. begin
  1059. {$ifdef FrameNameKnown}
  1060. Command('p /d '+FrameName);
  1061. st:=strpas(GetOutput);
  1062. p:=pos('=',st);
  1063. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1064. inc(p);
  1065. Delete(st,1,p);
  1066. p:=1;
  1067. while (st[p] in ['0'..'9']) do
  1068. inc(p);
  1069. Delete(st,p,High(st));
  1070. GetFramePointer:=StrToCard(st);
  1071. {$else not FrameNameKnown}
  1072. GetFramePointer:=0;
  1073. {$endif not FrameNameKnown}
  1074. end;
  1075. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  1076. var
  1077. st : string;
  1078. p : longint;
  1079. begin
  1080. Command('x /wd 0x'+hexstr(longint(addr),8));
  1081. st:=strpas(GetOutput);
  1082. p:=pos(':',st);
  1083. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1084. inc(p);
  1085. Delete(st,1,p);
  1086. p:=1;
  1087. while (st[p] in ['0'..'9']) do
  1088. inc(p);
  1089. Delete(st,p,High(st));
  1090. GetLongintAt:=StrToInt(st);
  1091. end;
  1092. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  1093. var
  1094. st : string;
  1095. p : longint;
  1096. code : integer;
  1097. begin
  1098. Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
  1099. st:=strpas(GetOutput);
  1100. p:=pos(':',st);
  1101. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  1102. inc(p);
  1103. if (p<length(st)) and (st[p+1]='$') then
  1104. inc(p);
  1105. Delete(st,1,p);
  1106. p:=1;
  1107. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  1108. inc(p);
  1109. Delete(st,p,High(st));
  1110. Val('$'+st,GetPointerAt,code);
  1111. end;
  1112. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  1113. var
  1114. W: PSourceWindow;
  1115. Found : boolean;
  1116. PB : PBreakpoint;
  1117. S : String;
  1118. BreakIndex : longint;
  1119. stop_addr : CORE_ADDR;
  1120. i,ExitCode : longint;
  1121. ExitAddr,ExitFrame : CORE_ADDR;
  1122. const
  1123. { try to find the parameters }
  1124. FirstArgOffset = -sizeof(pointer);
  1125. SecondArgOffset = 2*-sizeof(pointer);
  1126. ThirdArgOffset = 3*-sizeof(pointer);
  1127. begin
  1128. BreakIndex:=stop_breakpoint_number;
  1129. Desktop^.Lock;
  1130. { 0 based line count in Editor }
  1131. if Line>0 then
  1132. dec(Line);
  1133. S:=fn;
  1134. stop_addr:=current_pc;
  1135. if (BreakIndex=FPCBreakErrorNumber) then
  1136. begin
  1137. { Procedure HandleErrorAddrFrame
  1138. (Errno : longint;addr,frame : longint);
  1139. [public,alias:'FPC_BREAK_ERROR']; }
  1140. {$ifdef FrameNameKnown}
  1141. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  1142. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  1143. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  1144. if (ExitCode=0) and (ExitAddr=0) then
  1145. begin
  1146. Desktop^.Unlock;
  1147. Command('continue');
  1148. exit;
  1149. end;
  1150. { forget all old frames }
  1151. clear_frames;
  1152. { record new frames }
  1153. Command('backtrace');
  1154. for i:=0 to frame_count-1 do
  1155. begin
  1156. with frames[i]^ do
  1157. begin
  1158. if ExitAddr=address then
  1159. begin
  1160. Command('f '+IntToStr(i));
  1161. if assigned(file_name) then
  1162. begin
  1163. s:=strpas(file_name);
  1164. line:=line_number;
  1165. stop_addr:=address;
  1166. end;
  1167. break;
  1168. end;
  1169. end;
  1170. end;
  1171. {$endif FrameNameKnown}
  1172. end;
  1173. { Update Disassembly position }
  1174. if Assigned(DisassemblyWindow) then
  1175. DisassemblyWindow^.SetCurAddress(stop_addr);
  1176. if (fn=LastFileName) then
  1177. begin
  1178. W:=PSourceWindow(LastSource);
  1179. if assigned(W) then
  1180. begin
  1181. W^.Editor^.SetCurPtr(0,Line);
  1182. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1183. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1184. UpdateDebugViews;
  1185. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1186. handled by SelectInDebugSession}
  1187. W^.SelectInDebugSession;
  1188. InvalidSourceLine:=false;
  1189. end
  1190. else
  1191. InvalidSourceLine:=true;
  1192. end
  1193. else
  1194. begin
  1195. if s='' then
  1196. W:=nil
  1197. else
  1198. W:=TryToOpenFile(nil,s,0,Line,false);
  1199. if assigned(W) then
  1200. begin
  1201. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1202. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1203. UpdateDebugViews;
  1204. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1205. handled by SelectInDebugSession}
  1206. W^.SelectInDebugSession;
  1207. LastSource:=W;
  1208. InvalidSourceLine:=false;
  1209. end
  1210. { only search a file once }
  1211. else
  1212. begin
  1213. Desktop^.UnLock;
  1214. if s='' then
  1215. Found:=false
  1216. else
  1217. { it is easier to handle with a * at the end }
  1218. Found:=IDEApp.OpenSearch(s+'*');
  1219. Desktop^.Lock;
  1220. if not Found then
  1221. begin
  1222. InvalidSourceLine:=true;
  1223. LastSource:=Nil;
  1224. { Show the stack in that case }
  1225. InitStackWindow;
  1226. UpdateDebugViews;
  1227. StackWindow^.MakeFirst;
  1228. end
  1229. else
  1230. begin
  1231. { should now be open }
  1232. W:=TryToOpenFile(nil,s,0,Line,true);
  1233. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  1234. W^.Editor^.TrackCursor(CenterDebuggerRow);
  1235. UpdateDebugViews;
  1236. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  1237. handled by SelectInDebugSession}
  1238. W^.SelectInDebugSession;
  1239. LastSource:=W;
  1240. InvalidSourceLine:=false;
  1241. end;
  1242. end;
  1243. end;
  1244. LastFileName:=s;
  1245. Desktop^.UnLock;
  1246. if BreakIndex>0 then
  1247. begin
  1248. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  1249. if (BreakIndex=FPCBreakErrorNumber) then
  1250. begin
  1251. if (ExitCode<>0) or (ExitAddr<>0) then
  1252. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  1253. #3'Error address $'+HexStr(ExitAddr,8),nil)
  1254. else
  1255. WarningBox(#3'Run Time Error',nil);
  1256. end
  1257. else if not assigned(PB) then
  1258. begin
  1259. if (BreakIndex<>start_break_number) and
  1260. (BreakIndex<>TbreakNumber) then
  1261. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  1262. if BreakIndex=start_break_number then
  1263. start_break_number:=0;
  1264. if BreakIndex=TbreakNumber then
  1265. TbreakNumber:=0;
  1266. end
  1267. { For watch we should get old and new value !! }
  1268. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  1269. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  1270. (PB^.typ<>bt_address) then
  1271. begin
  1272. Command('p '+GetStr(PB^.Name));
  1273. S:=GetPChar(GetOutput);
  1274. got_error:=false;
  1275. If Pos('=',S)>0 then
  1276. S:=Copy(S,Pos('=',S)+1,255);
  1277. If S[Length(S)]=#10 then
  1278. Delete(S,Length(S),1);
  1279. if Assigned(PB^.OldValue) then
  1280. DisposeStr(PB^.OldValue);
  1281. PB^.OldValue:=PB^.CurrentValue;
  1282. PB^.CurrentValue:=NewStr(S);
  1283. If PB^.typ=bt_function then
  1284. WarningBox(#3'GDB stopped due to'#13+
  1285. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1286. else if (GetStr(PB^.OldValue)<>S) then
  1287. WarningBox(#3'GDB stopped due to'#13+
  1288. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1289. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1290. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1291. else
  1292. WarningBox(#3'GDB stopped due to'#13+
  1293. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1294. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1295. end;
  1296. end;
  1297. end;
  1298. procedure TDebugController.DoUserSignal;
  1299. var P :Array[1..2] of pstring;
  1300. S1, S2 : string;
  1301. begin
  1302. S1:=strpas(signal_name);
  1303. S2:=strpas(signal_string);
  1304. P[1]:=@S1;
  1305. P[2]:=@S2;
  1306. WarningBox(msg_programsignal,@P);
  1307. end;
  1308. procedure TDebugController.DoEndSession(code:longint);
  1309. var P :Array[1..2] of longint;
  1310. begin
  1311. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1312. IDEApp.UpdateRunMenu(false);
  1313. ResetDebuggerRows;
  1314. LastExitCode:=Code;
  1315. If HiddenStepsCount=0 then
  1316. InformationBox(msg_programexitedwithexitcode,@code)
  1317. else
  1318. begin
  1319. P[1]:=code;
  1320. P[2]:=HiddenStepsCount;
  1321. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1322. end;
  1323. { In case we have something that the compiler touched }
  1324. AskToReloadAllModifiedFiles;
  1325. {$ifdef Windows}
  1326. main_pid_valid:=false;
  1327. {$endif Windows}
  1328. end;
  1329. procedure TDebugController.DoDebuggerScreen;
  1330. {$ifdef Windows}
  1331. var
  1332. IdeMode : DWord;
  1333. {$endif Windows}
  1334. begin
  1335. if NoSwitch then
  1336. begin
  1337. PopStatus;
  1338. end
  1339. else
  1340. begin
  1341. IDEApp.ShowIDEScreen;
  1342. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1343. PopStatus;
  1344. end;
  1345. {$ifdef Windows}
  1346. if NoSwitch then
  1347. begin
  1348. { Ctrl-C as normal char }
  1349. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1350. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1351. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1352. end;
  1353. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1354. {$endif Windows}
  1355. end;
  1356. procedure TDebugController.DoUserScreen;
  1357. {$ifdef Windows}
  1358. var
  1359. IdeMode : DWord;
  1360. {$endif Windows}
  1361. begin
  1362. Inc(RunCount);
  1363. if NoSwitch then
  1364. begin
  1365. {$ifdef SUPPORT_REMOTE}
  1366. if isRemoteDebugging then
  1367. PushStatus(msg_runningremotely+RemoteMachine)
  1368. else
  1369. {$endif SUPPORT_REMOTE}
  1370. {$ifdef Unix}
  1371. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1372. {$else not Unix}
  1373. PushStatus(msg_runninginanotherwindow);
  1374. {$endif Unix}
  1375. end
  1376. else
  1377. begin
  1378. PushStatus(msg_runningprogram);
  1379. IDEApp.ShowUserScreen;
  1380. end;
  1381. {$ifdef Windows}
  1382. if NoSwitch then
  1383. begin
  1384. { Ctrl-C as interrupt }
  1385. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1386. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1387. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1388. end;
  1389. ChangeDebuggeeWindowTitleTo(Running_State);
  1390. {$endif Windows}
  1391. end;
  1392. {$endif NODEBUG}
  1393. {****************************************************************************
  1394. TBreakpoint
  1395. ****************************************************************************}
  1396. function ActiveBreakpoints : boolean;
  1397. var
  1398. IsActive : boolean;
  1399. procedure TestActive(PB : PBreakpoint);
  1400. begin
  1401. If PB^.state=bs_enabled then
  1402. IsActive:=true;
  1403. end;
  1404. begin
  1405. IsActive:=false;
  1406. If assigned(BreakpointsCollection) then
  1407. BreakpointsCollection^.ForEach(@TestActive);
  1408. ActiveBreakpoints:=IsActive;
  1409. end;
  1410. constructor TBreakpoint.Init_function(Const AFunc : String);
  1411. begin
  1412. typ:=bt_function;
  1413. state:=bs_enabled;
  1414. GDBState:=bs_deleted;
  1415. Name:=NewStr(AFunc);
  1416. FileName:=nil;
  1417. Line:=0;
  1418. IgnoreCount:=0;
  1419. Commands:=nil;
  1420. Conditions:=nil;
  1421. OldValue:=nil;
  1422. CurrentValue:=nil;
  1423. end;
  1424. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1425. begin
  1426. typ:=bt_address;
  1427. state:=bs_enabled;
  1428. GDBState:=bs_deleted;
  1429. Name:=NewStr(AAddress);
  1430. FileName:=nil;
  1431. Line:=0;
  1432. IgnoreCount:=0;
  1433. Commands:=nil;
  1434. Conditions:=nil;
  1435. OldValue:=nil;
  1436. CurrentValue:=nil;
  1437. end;
  1438. constructor TBreakpoint.Init_Empty;
  1439. begin
  1440. typ:=bt_function;
  1441. state:=bs_enabled;
  1442. GDBState:=bs_deleted;
  1443. Name:=Nil;
  1444. FileName:=nil;
  1445. Line:=0;
  1446. IgnoreCount:=0;
  1447. Commands:=nil;
  1448. Conditions:=nil;
  1449. OldValue:=nil;
  1450. CurrentValue:=nil;
  1451. end;
  1452. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1453. begin
  1454. typ:=atyp;
  1455. state:=bs_enabled;
  1456. GDBState:=bs_deleted;
  1457. Name:=NewStr(AnExpr);
  1458. IgnoreCount:=0;
  1459. Commands:=nil;
  1460. Conditions:=nil;
  1461. OldValue:=nil;
  1462. CurrentValue:=nil;
  1463. end;
  1464. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1465. var
  1466. CurDir : String;
  1467. begin
  1468. typ:=bt_file_line;
  1469. state:=bs_enabled;
  1470. GDBState:=bs_deleted;
  1471. AFile:=FEXpand(AFile);
  1472. (*
  1473. { d:test.pas:12 does not work !! }
  1474. { I do not know how to solve this if
  1475. if (Length(AFile)>1) and (AFile[2]=':') then
  1476. AFile:=Copy(AFile,3,255); }
  1477. {$ifdef Unix}
  1478. CurDir:=GetCurDir;
  1479. {$else}
  1480. CurDir:=LowerCaseStr(GetCurDir);
  1481. {$endif Unix}
  1482. if Pos(CurDir,OSFileName(AFile))=1 then
  1483. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1484. else
  1485. *)
  1486. FileName:=NewStr(OSFileName(AFile));
  1487. Name:=nil;
  1488. Line:=ALine;
  1489. IgnoreCount:=0;
  1490. Commands:=nil;
  1491. Conditions:=nil;
  1492. OldValue:=nil;
  1493. CurrentValue:=nil;
  1494. end;
  1495. constructor TBreakpoint.Load(var S: TStream);
  1496. var
  1497. FName : PString;
  1498. begin
  1499. S.Read(typ,SizeOf(BreakpointType));
  1500. S.Read(state,SizeOf(BreakpointState));
  1501. GDBState:=bs_deleted;
  1502. case typ of
  1503. bt_file_line :
  1504. begin
  1505. { convert to current target }
  1506. FName:=S.ReadStr;
  1507. FileName:=NewStr(OSFileName(GetStr(FName)));
  1508. If Assigned(FName) then
  1509. DisposeStr(FName);
  1510. S.Read(Line,SizeOf(Line));
  1511. Name:=nil;
  1512. end;
  1513. else
  1514. begin
  1515. Name:=S.ReadStr;
  1516. Line:=0;
  1517. FileName:=nil;
  1518. end;
  1519. end;
  1520. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1521. Commands:=S.StrRead;
  1522. Conditions:=S.ReadStr;
  1523. OldValue:=nil;
  1524. CurrentValue:=nil;
  1525. end;
  1526. procedure TBreakpoint.Store(var S: TStream);
  1527. var
  1528. St : String;
  1529. begin
  1530. S.Write(typ,SizeOf(BreakpointType));
  1531. S.Write(state,SizeOf(BreakpointState));
  1532. case typ of
  1533. bt_file_line :
  1534. begin
  1535. st:=OSFileName(GetStr(FileName));
  1536. S.WriteStr(@St);
  1537. S.Write(Line,SizeOf(Line));
  1538. end;
  1539. else
  1540. begin
  1541. S.WriteStr(Name);
  1542. end;
  1543. end;
  1544. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1545. S.StrWrite(Commands);
  1546. S.WriteStr(Conditions);
  1547. end;
  1548. procedure TBreakpoint.Insert;
  1549. var
  1550. p,p2 : pchar;
  1551. st : string;
  1552. begin
  1553. {$ifndef NODEBUG}
  1554. If not assigned(Debugger) then Exit;
  1555. Remove;
  1556. Debugger^.last_breakpoint_number:=0;
  1557. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1558. begin
  1559. if (typ=bt_file_line) and assigned(FileName) then
  1560. Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
  1561. else if (typ=bt_function) and assigned(name) then
  1562. Debugger^.Command('break '+name^)
  1563. else if (typ=bt_address) and assigned(name) then
  1564. Debugger^.Command('break *0x'+name^)
  1565. else if (typ=bt_watch) and assigned(name) then
  1566. Debugger^.Command('watch '+name^)
  1567. else if (typ=bt_awatch) and assigned(name) then
  1568. Debugger^.Command('awatch '+name^)
  1569. else if (typ=bt_rwatch) and assigned(name) then
  1570. Debugger^.Command('rwatch '+name^);
  1571. if Debugger^.last_breakpoint_number<>0 then
  1572. begin
  1573. GDBIndex:=Debugger^.last_breakpoint_number;
  1574. GDBState:=bs_enabled;
  1575. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1576. If IgnoreCount>0 then
  1577. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1578. If Assigned(Commands) then
  1579. begin
  1580. {Commands are not handled yet }
  1581. Debugger^.Command('command '+IntToStr(GDBIndex));
  1582. p:=commands;
  1583. while assigned(p) do
  1584. begin
  1585. p2:=strscan(p,#10);
  1586. if assigned(p2) then
  1587. p2^:=#0;
  1588. st:=strpas(p);
  1589. Debugger^.command(st);
  1590. if assigned(p2) then
  1591. p2^:=#10;
  1592. p:=p2;
  1593. if assigned(p) then
  1594. inc(p);
  1595. end;
  1596. Debugger^.Command('end');
  1597. end;
  1598. end
  1599. else
  1600. { Here there was a problem !! }
  1601. begin
  1602. GDBIndex:=0;
  1603. if not Debugger^.Disableallinvalidbreakpoints then
  1604. begin
  1605. if (typ=bt_file_line) and assigned(FileName) then
  1606. begin
  1607. ClearFormatParams;
  1608. AddFormatParamStr(NameAndExtOf(FileName^));
  1609. AddFormatParamInt(Line);
  1610. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1611. Debugger^.Disableallinvalidbreakpoints:=true;
  1612. end
  1613. else
  1614. begin
  1615. ClearFormatParams;
  1616. AddFormatParamStr(BreakpointTypeStr[typ]);
  1617. AddFormatParamStr(GetStr(Name));
  1618. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1619. Debugger^.Disableallinvalidbreakpoints:=true;
  1620. end;
  1621. end;
  1622. state:=bs_disabled;
  1623. UpdateSource;
  1624. end;
  1625. end
  1626. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1627. Enable
  1628. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1629. Disable;
  1630. {$endif NODEBUG}
  1631. end;
  1632. procedure TBreakpoint.Remove;
  1633. begin
  1634. {$ifndef NODEBUG}
  1635. If not assigned(Debugger) then Exit;
  1636. if GDBIndex>0 then
  1637. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1638. GDBIndex:=0;
  1639. GDBState:=bs_deleted;
  1640. {$endif NODEBUG}
  1641. end;
  1642. procedure TBreakpoint.Enable;
  1643. begin
  1644. {$ifndef NODEBUG}
  1645. If not assigned(Debugger) then Exit;
  1646. if GDBIndex>0 then
  1647. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1648. else
  1649. Insert;
  1650. GDBState:=bs_disabled;
  1651. {$endif NODEBUG}
  1652. end;
  1653. procedure TBreakpoint.Disable;
  1654. begin
  1655. {$ifndef NODEBUG}
  1656. If not assigned(Debugger) then Exit;
  1657. if GDBIndex>0 then
  1658. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1659. GDBState:=bs_disabled;
  1660. {$endif NODEBUG}
  1661. end;
  1662. procedure TBreakpoint.ResetValues;
  1663. begin
  1664. if assigned(OldValue) then
  1665. DisposeStr(OldValue);
  1666. OldValue:=nil;
  1667. if assigned(CurrentValue) then
  1668. DisposeStr(CurrentValue);
  1669. CurrentValue:=nil;
  1670. end;
  1671. procedure TBreakpoint.UpdateSource;
  1672. var W: PSourceWindow;
  1673. b : boolean;
  1674. begin
  1675. if typ=bt_file_line then
  1676. begin
  1677. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1678. If assigned(W) then
  1679. begin
  1680. if state=bs_enabled then
  1681. b:=true
  1682. else
  1683. b:=false;
  1684. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1685. end;
  1686. end;
  1687. end;
  1688. destructor TBreakpoint.Done;
  1689. begin
  1690. Remove;
  1691. ResetValues;
  1692. if assigned(Name) then
  1693. DisposeStr(Name);
  1694. if assigned(FileName) then
  1695. DisposeStr(FileName);
  1696. if assigned(Conditions) then
  1697. DisposeStr(Conditions);
  1698. if assigned(Commands) then
  1699. StrDispose(Commands);
  1700. inherited Done;
  1701. end;
  1702. {****************************************************************************
  1703. TBreakpointCollection
  1704. ****************************************************************************}
  1705. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1706. begin
  1707. At:=inherited At(Index);
  1708. end;
  1709. procedure TBreakpointCollection.Update;
  1710. begin
  1711. {$ifndef NODEBUG}
  1712. if assigned(Debugger) then
  1713. begin
  1714. Debugger^.RemoveBreakpoints;
  1715. Debugger^.InsertBreakpoints;
  1716. end;
  1717. {$endif NODEBUG}
  1718. if assigned(BreakpointsWindow) then
  1719. BreakpointsWindow^.Update;
  1720. end;
  1721. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1722. function IsNum(P : PBreakpoint) : boolean;
  1723. begin
  1724. IsNum:=P^.GDBIndex=index;
  1725. end;
  1726. begin
  1727. if index=0 then
  1728. GetGDB:=nil
  1729. else
  1730. GetGDB:=FirstThat(@IsNum);
  1731. end;
  1732. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1733. procedure SetInSource(P : PBreakpoint);
  1734. begin
  1735. If assigned(P^.FileName) and
  1736. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1737. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1738. end;
  1739. procedure SetInDisassembly(P : PBreakpoint);
  1740. var
  1741. PDL : PDisasLine;
  1742. S : string;
  1743. ps,qs,i : longint;
  1744. HAddr : PtrInt;
  1745. code : integer;
  1746. begin
  1747. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1748. begin
  1749. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1750. if PDL^.Address=0 then
  1751. begin
  1752. if (P^.typ=bt_file_line) then
  1753. begin
  1754. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1755. ps:=pos(':',S);
  1756. qs:=pos(' ',copy(S,ps+1,High(S)));
  1757. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1758. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1759. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1760. end;
  1761. end
  1762. else
  1763. begin
  1764. if assigned(P^.Name) then
  1765. begin
  1766. Val('$'+P^.Name^,HAddr,code);
  1767. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1768. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1769. end;
  1770. end;
  1771. end;
  1772. end;
  1773. begin
  1774. if W=PFPWindow(DisassemblyWindow) then
  1775. ForEach(@SetInDisassembly)
  1776. else
  1777. ForEach(@SetInSource);
  1778. end;
  1779. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1780. procedure AdaptInSource(P : PBreakpoint);
  1781. begin
  1782. If assigned(P^.FileName) and
  1783. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1784. begin
  1785. if P^.state=bs_enabled then
  1786. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1787. if P^.Line-1>=Pos then
  1788. begin
  1789. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1790. P^.line:=P^.Line+Change
  1791. else
  1792. begin
  1793. { removing inside a ForEach call leads to problems }
  1794. { so we do that after PM }
  1795. P^.state:=bs_delete_after;
  1796. end;
  1797. end;
  1798. if P^.state=bs_enabled then
  1799. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1800. end;
  1801. end;
  1802. var
  1803. I : longint;
  1804. begin
  1805. ForEach(@AdaptInSource);
  1806. I:=Count-1;
  1807. While (I>=0) do
  1808. begin
  1809. if At(I)^.state=bs_delete_after then
  1810. AtFree(I);
  1811. Dec(I);
  1812. end;
  1813. end;
  1814. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1815. function IsAtLine(P : PBreakpoint) : boolean;
  1816. begin
  1817. If assigned(P^.FileName) and
  1818. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1819. (Line=P^.Line) then
  1820. IsAtLine:=true
  1821. else
  1822. IsAtLine:=false;
  1823. end;
  1824. begin
  1825. FindBreakpointAt:=FirstThat(@IsAtLine);
  1826. end;
  1827. procedure TBreakpointCollection.ShowAllBreakpoints;
  1828. procedure SetInSource(P : PBreakpoint);
  1829. var
  1830. W : PSourceWindow;
  1831. begin
  1832. If assigned(P^.FileName) then
  1833. begin
  1834. W:=SearchOnDesktop(P^.FileName^,false);
  1835. if assigned(W) then
  1836. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1837. end;
  1838. end;
  1839. begin
  1840. ForEach(@SetInSource);
  1841. end;
  1842. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1843. function IsThis(P : PBreakpoint) : boolean;
  1844. begin
  1845. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1846. end;
  1847. begin
  1848. GetType:=FirstThat(@IsThis);
  1849. end;
  1850. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1851. function IsThere(P : PBreakpoint) : boolean;
  1852. begin
  1853. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1854. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1855. end;
  1856. var
  1857. PB : PBreakpoint;
  1858. begin
  1859. ToggleFileLine:=false;
  1860. FileName:=OSFileName(FExpand(FileName));
  1861. PB:=FirstThat(@IsThere);
  1862. If Assigned(PB) then
  1863. begin
  1864. { delete it form source window }
  1865. PB^.state:=bs_disabled;
  1866. PB^.UpdateSource;
  1867. { remove from collection }
  1868. BreakpointsCollection^.free(PB);
  1869. end
  1870. else
  1871. begin
  1872. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1873. if assigned(PB) then
  1874. Begin
  1875. Insert(PB);
  1876. PB^.UpdateSource;
  1877. ToggleFileLine:=true;
  1878. End;
  1879. end;
  1880. Update;
  1881. end;
  1882. {****************************************************************************
  1883. TBreakpointItem
  1884. ****************************************************************************}
  1885. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1886. begin
  1887. inherited Init;
  1888. Breakpoint:=ABreakpoint;
  1889. end;
  1890. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1891. var S: string;
  1892. begin
  1893. with Breakpoint^ do
  1894. begin
  1895. S:=BreakpointTypeStr[typ];
  1896. While Length(S)<10 do
  1897. S:=S+' ';
  1898. S:=S+'|';
  1899. S:=S+BreakpointStateStr[state]+' ';
  1900. While Length(S)<20 do
  1901. S:=S+' ';
  1902. S:=S+'|';
  1903. if (typ=bt_file_line) then
  1904. begin
  1905. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
  1906. While Length(S)<40 do
  1907. S:=S+' ';
  1908. S:=S+'|';
  1909. S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
  1910. end
  1911. else
  1912. S:=S+GetStr(name);
  1913. While Length(S)<70 do
  1914. S:=S+' ';
  1915. S:=S+'|';
  1916. if IgnoreCount>0 then
  1917. S:=S+IntToStr(IgnoreCount);
  1918. While Length(S)<79 do
  1919. S:=S+' ';
  1920. S:=S+'|';
  1921. if assigned(Conditions) then
  1922. S:=S+' '+GetStr(Conditions);
  1923. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1924. GetText:=S;
  1925. end;
  1926. end;
  1927. procedure TBreakpointItem.Selected;
  1928. begin
  1929. end;
  1930. function TBreakpointItem.GetModuleName: string;
  1931. begin
  1932. if breakpoint^.typ=bt_file_line then
  1933. GetModuleName:=GetStr(breakpoint^.FileName)
  1934. else
  1935. GetModuleName:='';
  1936. end;
  1937. {****************************************************************************
  1938. TBreakpointsListBox
  1939. ****************************************************************************}
  1940. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1941. begin
  1942. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1943. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1944. NoSelection:=true;
  1945. end;
  1946. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1947. var M: PMenu;
  1948. begin
  1949. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1950. M:=NewMenu(
  1951. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1952. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1953. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1954. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1955. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1956. nil))))));
  1957. GetLocalMenu:=M;
  1958. end;
  1959. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1960. var DontClear: boolean;
  1961. begin
  1962. case Event.What of
  1963. evKeyDown :
  1964. begin
  1965. DontClear:=false;
  1966. case Event.KeyCode of
  1967. kbEnd :
  1968. FocusItem(List^.Count-1);
  1969. kbHome :
  1970. FocusItem(0);
  1971. kbEnter :
  1972. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1973. kbIns :
  1974. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1975. kbDel :
  1976. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1977. else
  1978. DontClear:=true;
  1979. end;
  1980. if not DontClear then
  1981. ClearEvent(Event);
  1982. end;
  1983. evBroadcast :
  1984. case Event.Command of
  1985. cmListItemSelected :
  1986. if Event.InfoPtr=@Self then
  1987. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1988. end;
  1989. evCommand :
  1990. begin
  1991. DontClear:=false;
  1992. case Event.Command of
  1993. cmMsgTrackSource :
  1994. if Range>0 then
  1995. TrackSource;
  1996. cmEditBreakpoint :
  1997. EditCurrent;
  1998. cmToggleBreakpoint :
  1999. ToggleCurrent;
  2000. cmDeleteBreakpoint :
  2001. DeleteCurrent;
  2002. cmNewBreakpoint :
  2003. EditNew;
  2004. cmMsgClear :
  2005. Clear;
  2006. else
  2007. DontClear:=true;
  2008. end;
  2009. if not DontClear then
  2010. ClearEvent(Event);
  2011. end;
  2012. end;
  2013. inherited HandleEvent(Event);
  2014. end;
  2015. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  2016. var W : integer;
  2017. begin
  2018. if List=nil then New(List, Init(20,20));
  2019. W:=length(P^.GetText(255));
  2020. if W>MaxWidth then
  2021. begin
  2022. MaxWidth:=W;
  2023. if HScrollBar<>nil then
  2024. HScrollBar^.SetRange(0,MaxWidth);
  2025. end;
  2026. List^.Insert(P);
  2027. SetRange(List^.Count);
  2028. if Focused=List^.Count-1-1 then
  2029. FocusItem(List^.Count-1);
  2030. P^.Breakpoint^.UpdateSource;
  2031. DrawView;
  2032. end;
  2033. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  2034. var P: PBreakpointItem;
  2035. S: string;
  2036. begin
  2037. P:=List^.At(Item);
  2038. S:=P^.GetText(MaxLen);
  2039. GetText:=copy(S,1,MaxLen);
  2040. end;
  2041. procedure TBreakpointsListBox.Clear;
  2042. begin
  2043. if assigned(List) then
  2044. Dispose(List, Done);
  2045. List:=nil;
  2046. MaxWidth:=0;
  2047. SetRange(0); DrawView;
  2048. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2049. end;
  2050. procedure TBreakpointsListBox.TrackSource;
  2051. var W: PSourceWindow;
  2052. P: PBreakpointItem;
  2053. R: TRect;
  2054. begin
  2055. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2056. if Range=0 then Exit;*)
  2057. P:=List^.At(Focused);
  2058. if P^.GetModuleName='' then Exit;
  2059. Desktop^.Lock;
  2060. GetNextEditorBounds(R);
  2061. R.B.Y:=Owner^.Origin.Y;
  2062. W:=EditorWindowFile(P^.GetModuleName);
  2063. if assigned(W) then
  2064. begin
  2065. W^.GetExtent(R);
  2066. R.B.Y:=Owner^.Origin.Y;
  2067. W^.ChangeBounds(R);
  2068. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  2069. end
  2070. else
  2071. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  2072. if W<>nil then
  2073. begin
  2074. W^.Select;
  2075. W^.Editor^.TrackCursor(do_centre);
  2076. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  2077. end;
  2078. if Assigned(Owner) then
  2079. Owner^.Select;
  2080. Desktop^.UnLock;
  2081. end;
  2082. procedure TBreakpointsListBox.ToggleCurrent;
  2083. var
  2084. P: PBreakpointItem;
  2085. begin
  2086. if Range=0 then Exit;
  2087. P:=List^.At(Focused);
  2088. if P=nil then Exit;
  2089. if P^.Breakpoint^.state=bs_enabled then
  2090. P^.Breakpoint^.state:=bs_disabled
  2091. else if P^.Breakpoint^.state=bs_disabled then
  2092. P^.Breakpoint^.state:=bs_enabled;
  2093. P^.Breakpoint^.UpdateSource;
  2094. BreakpointsCollection^.Update;
  2095. end;
  2096. procedure TBreakpointsListBox.EditCurrent;
  2097. var
  2098. P: PBreakpointItem;
  2099. begin
  2100. if Range=0 then Exit;
  2101. P:=List^.At(Focused);
  2102. if P=nil then Exit;
  2103. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  2104. P^.Breakpoint^.UpdateSource;
  2105. BreakpointsCollection^.Update;
  2106. end;
  2107. procedure TBreakpointsListBox.DeleteCurrent;
  2108. var
  2109. P: PBreakpointItem;
  2110. begin
  2111. if Range=0 then Exit;
  2112. P:=List^.At(Focused);
  2113. if P=nil then Exit;
  2114. { delete it form source window }
  2115. P^.Breakpoint^.state:=bs_disabled;
  2116. P^.Breakpoint^.UpdateSource;
  2117. BreakpointsCollection^.free(P^.Breakpoint);
  2118. List^.free(P);
  2119. BreakpointsCollection^.Update;
  2120. end;
  2121. procedure TBreakpointsListBox.EditNew;
  2122. var
  2123. P: PBreakpoint;
  2124. begin
  2125. P:=New(PBreakpoint,Init_Empty);
  2126. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  2127. begin
  2128. P^.UpdateSource;
  2129. BreakpointsCollection^.Insert(P);
  2130. BreakpointsCollection^.Update;
  2131. end
  2132. else
  2133. dispose(P,Done);
  2134. end;
  2135. procedure TBreakpointsListBox.Draw;
  2136. var
  2137. I, J, Item: Sw_Integer;
  2138. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2139. ColWidth, CurCol, Indent: Integer;
  2140. B: TDrawBuffer;
  2141. Text: String;
  2142. SCOff: Byte;
  2143. TC: byte;
  2144. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2145. begin
  2146. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2147. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2148. begin
  2149. NormalColor := GetColor(1);
  2150. FocusedColor := GetColor(3);
  2151. SelectedColor := GetColor(4);
  2152. end else
  2153. begin
  2154. NormalColor := GetColor(2);
  2155. SelectedColor := GetColor(4);
  2156. end;
  2157. if Transparent then
  2158. begin MT(NormalColor); MT(SelectedColor); end;
  2159. if NoSelection then
  2160. SelectedColor:=NormalColor;
  2161. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2162. else Indent := 0;
  2163. ColWidth := Size.X div NumCols + 1;
  2164. for I := 0 to Size.Y - 1 do
  2165. begin
  2166. for J := 0 to NumCols-1 do
  2167. begin
  2168. Item := J*Size.Y + I + TopItem;
  2169. CurCol := J*ColWidth;
  2170. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2171. (Focused = Item) and (Range > 0) then
  2172. begin
  2173. Color := FocusedColor;
  2174. SetCursor(CurCol+1,I);
  2175. SCOff := 0;
  2176. end
  2177. else if (Item < Range) and IsSelected(Item) then
  2178. begin
  2179. Color := SelectedColor;
  2180. SCOff := 2;
  2181. end
  2182. else
  2183. begin
  2184. Color := NormalColor;
  2185. SCOff := 4;
  2186. end;
  2187. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2188. if Item < Range then
  2189. begin
  2190. Text := GetText(Item, ColWidth + Indent);
  2191. Text := Copy(Text,Indent,ColWidth);
  2192. MoveStr(B[CurCol+1], Text, Color);
  2193. if ShowMarkers then
  2194. begin
  2195. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2196. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2197. end;
  2198. end;
  2199. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2200. end;
  2201. WriteLine(0, I, Size.X, 1, B);
  2202. end;
  2203. end;
  2204. constructor TBreakpointsListBox.Load(var S: TStream);
  2205. begin
  2206. inherited Load(S);
  2207. end;
  2208. procedure TBreakpointsListBox.Store(var S: TStream);
  2209. var OL: PCollection;
  2210. OldR : integer;
  2211. begin
  2212. OL:=List;
  2213. OldR:=Range;
  2214. Range:=0;
  2215. New(List, Init(1,1));
  2216. inherited Store(S);
  2217. Dispose(List, Done);
  2218. Range:=OldR;
  2219. List:=OL;
  2220. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2221. collection? Pasting here a modified version of TListBox.Store+
  2222. TAdvancedListBox.Store isn't a better solution, since by eventually
  2223. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2224. end;
  2225. destructor TBreakpointsListBox.Done;
  2226. begin
  2227. inherited Done;
  2228. if List<>nil then Dispose(List, Done);
  2229. end;
  2230. {****************************************************************************
  2231. TBreakpointsWindow
  2232. ****************************************************************************}
  2233. constructor TBreakpointsWindow.Init;
  2234. var R,R2: TRect;
  2235. HSB,VSB: PScrollBar;
  2236. ST: PStaticText;
  2237. S: String;
  2238. X,X1 : Sw_integer;
  2239. Btn: PButton;
  2240. const
  2241. NumButtons = 5;
  2242. begin
  2243. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2244. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2245. HelpCtx:=hcBreakpointListWindow;
  2246. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2247. S:=label_breakpointpropheader;
  2248. New(ST, Init(R,S));
  2249. ST^.GrowMode:=gfGrowHiX;
  2250. Insert(ST);
  2251. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2252. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2253. ST^.GrowMode:=gfGrowHiX;
  2254. Insert(ST);
  2255. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2256. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2257. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2258. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2259. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2260. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2261. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2262. New(BreakLB, Init(R,HSB,VSB));
  2263. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2264. BreakLB^.Transparent:=true;
  2265. Insert(BreakLB);
  2266. GetExtent(R);R.Grow(-1,-1);
  2267. Dec(R.B.Y);
  2268. R.A.Y:=R.B.Y-2;
  2269. X:=(R.B.X-R.A.X) div NumButtons;
  2270. X1:=R.A.X+(X div 2);
  2271. R.A.X:=X1-3;R.B.X:=X1+7;
  2272. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  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_New, cmNewBreakpoint, 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_Edit, cmEditBreakpoint, 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_ToggleButton, cmToggleBreakInList, bfNormal));
  2288. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2289. Insert(Btn);
  2290. X1:=X1+X;
  2291. R.A.X:=X1-3;R.B.X:=X1+7;
  2292. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2293. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2294. Insert(Btn);
  2295. BreakLB^.Select;
  2296. Update;
  2297. BreakpointsWindow:=@self;
  2298. end;
  2299. constructor TBreakpointsWindow.Load(var S: TStream);
  2300. begin
  2301. inherited Load(S);
  2302. GetSubViewPtr(S,BreakLB);
  2303. end;
  2304. procedure TBreakpointsWindow.Store(var S: TStream);
  2305. begin
  2306. inherited Store(S);
  2307. PutSubViewPtr(S,BreakLB);
  2308. end;
  2309. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2310. begin
  2311. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2312. end;
  2313. procedure TBreakpointsWindow.ClearBreakpoints;
  2314. begin
  2315. BreakLB^.Clear;
  2316. ReDraw;
  2317. end;
  2318. procedure TBreakpointsWindow.ReloadBreakpoints;
  2319. procedure InsertInBreakLB(P : PBreakpoint);
  2320. begin
  2321. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2322. end;
  2323. begin
  2324. If not assigned(BreakpointsCollection) then
  2325. exit;
  2326. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2327. ReDraw;
  2328. end;
  2329. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2330. begin
  2331. inherited SizeLimits(Min,Max);
  2332. Min.X:=40; Min.Y:=18;
  2333. end;
  2334. procedure TBreakpointsWindow.Close;
  2335. begin
  2336. Hide;
  2337. end;
  2338. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2339. var DontClear : boolean;
  2340. begin
  2341. case Event.What of
  2342. evKeyDown :
  2343. begin
  2344. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2345. begin
  2346. ClearEvent(Event);
  2347. Hide;
  2348. end;
  2349. end;
  2350. evCommand :
  2351. begin
  2352. DontClear:=False;
  2353. case Event.Command of
  2354. cmNewBreakpoint :
  2355. BreakLB^.EditNew;
  2356. cmEditBreakpoint :
  2357. BreakLB^.EditCurrent;
  2358. cmDeleteBreakpoint :
  2359. BreakLB^.DeleteCurrent;
  2360. cmToggleBreakInList :
  2361. BreakLB^.ToggleCurrent;
  2362. cmClose :
  2363. Hide;
  2364. else
  2365. DontClear:=true;
  2366. end;
  2367. if not DontClear then
  2368. ClearEvent(Event);
  2369. end;
  2370. evBroadcast :
  2371. case Event.Command of
  2372. cmUpdate :
  2373. Update;
  2374. end;
  2375. end;
  2376. inherited HandleEvent(Event);
  2377. end;
  2378. procedure TBreakpointsWindow.Update;
  2379. var
  2380. StoreFocus : longint;
  2381. begin
  2382. StoreFocus:=BreakLB^.Focused;
  2383. ClearBreakpoints;
  2384. ReloadBreakpoints;
  2385. If StoreFocus<BreakLB^.Range then
  2386. BreakLB^.FocusItem(StoreFocus);
  2387. end;
  2388. destructor TBreakpointsWindow.Done;
  2389. begin
  2390. inherited Done;
  2391. BreakpointsWindow:=nil;
  2392. end;
  2393. {****************************************************************************
  2394. TBreakpointItemDialog
  2395. ****************************************************************************}
  2396. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2397. var R,R2,R3: TRect;
  2398. Items: PSItem;
  2399. I : BreakpointType;
  2400. KeyCount: sw_integer;
  2401. begin
  2402. KeyCount:=longint(high(BreakpointType));
  2403. R.Assign(0,0,60,Max(9+KeyCount,18));
  2404. inherited Init(R,dialog_modifynewbreakpoint);
  2405. Breakpoint:=ABreakpoint;
  2406. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2407. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2408. New(NameIL, Init(R, 255)); Insert(NameIL);
  2409. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2410. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2411. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2412. R2.Copy(R); R2.Move(-1,-1);
  2413. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2414. R.Move(0,3);
  2415. R.B.X:=R.B.X-3;
  2416. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2417. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2418. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2419. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2420. R.Move(0,3); R.B.X:=R.A.X+36;
  2421. New(LineIL, Init(R, 128)); Insert(LineIL);
  2422. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2423. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2424. R.Move(0,3);
  2425. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2426. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2427. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2428. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2429. Items:=nil;
  2430. { don't use invalid type }
  2431. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2432. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2433. New(TypeRB, Init(R, Items));
  2434. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2435. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2436. Insert(TypeRB);
  2437. InsertButtons(@Self);
  2438. NameIL^.Select;
  2439. end;
  2440. function TBreakpointItemDialog.Execute: Word;
  2441. var R: sw_word;
  2442. S1: string;
  2443. err: word;
  2444. L: longint;
  2445. begin
  2446. R:=sw_word(Breakpoint^.typ);
  2447. TypeRB^.SetData(R);
  2448. If Breakpoint^.typ=bt_file_line then
  2449. S1:=GetStr(Breakpoint^.FileName)
  2450. else
  2451. S1:=GetStr(Breakpoint^.name);
  2452. NameIL^.SetData(S1);
  2453. If Breakpoint^.typ=bt_file_line then
  2454. S1:=IntToStr(Breakpoint^.Line)
  2455. else
  2456. S1:='0';
  2457. LineIL^.SetData(S1);
  2458. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2459. IgnoreIL^.SetData(S1);
  2460. S1:=GetStr(Breakpoint^.Conditions);
  2461. ConditionsIL^.SetData(S1);
  2462. if assigned(FirstEditorWindow) then
  2463. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2464. R:=inherited Execute;
  2465. FindReplaceEditor:=nil;
  2466. if R=cmOK then
  2467. begin
  2468. TypeRB^.GetData(R);
  2469. L:=R;
  2470. Breakpoint^.typ:=BreakpointType(L);
  2471. NameIL^.GetData(S1);
  2472. If Breakpoint^.typ=bt_file_line then
  2473. begin
  2474. If assigned(Breakpoint^.FileName) then
  2475. DisposeStr(Breakpoint^.FileName);
  2476. Breakpoint^.FileName:=NewStr(S1);
  2477. end
  2478. else
  2479. begin
  2480. If assigned(Breakpoint^.Name) then
  2481. DisposeStr(Breakpoint^.Name);
  2482. Breakpoint^.name:=NewStr(S1);
  2483. end;
  2484. If Breakpoint^.typ=bt_file_line then
  2485. begin
  2486. LineIL^.GetData(S1);
  2487. Val(S1,L,err);
  2488. Breakpoint^.Line:=L;
  2489. end;
  2490. IgnoreIL^.GetData(S1);
  2491. Val(S1,L,err);
  2492. Breakpoint^.IgnoreCount:=L;
  2493. ConditionsIL^.GetData(S1);
  2494. If assigned(Breakpoint^.Conditions) then
  2495. DisposeStr(Breakpoint^.Conditions);
  2496. Breakpoint^.Conditions:=NewStr(S1);
  2497. end;
  2498. Execute:=R;
  2499. end;
  2500. {****************************************************************************
  2501. TWatch
  2502. ****************************************************************************}
  2503. constructor TWatch.Init(s : string);
  2504. begin
  2505. expr:=NewStr(s);
  2506. last_value:=nil;
  2507. current_value:=nil;
  2508. Get_new_value;
  2509. GDBRunCount:=-1;
  2510. end;
  2511. constructor TWatch.Load(var S: TStream);
  2512. begin
  2513. expr:=S.ReadStr;
  2514. last_value:=nil;
  2515. current_value:=nil;
  2516. Get_new_value;
  2517. GDBRunCount:=-1;
  2518. end;
  2519. procedure TWatch.Store(var S: TStream);
  2520. begin
  2521. S.WriteStr(expr);
  2522. end;
  2523. procedure TWatch.rename(s : string);
  2524. begin
  2525. if assigned(expr) then
  2526. begin
  2527. if GetStr(expr)=S then
  2528. exit;
  2529. DisposeStr(expr);
  2530. end;
  2531. expr:=NewStr(s);
  2532. if assigned(last_value) then
  2533. StrDispose(last_value);
  2534. last_value:=nil;
  2535. if assigned(current_value) then
  2536. StrDispose(current_value);
  2537. current_value:=nil;
  2538. GDBRunCount:=-1;
  2539. Get_new_value;
  2540. end;
  2541. procedure TWatch.Get_new_value;
  2542. {$ifndef NODEBUG}
  2543. var p, q : pchar;
  2544. i, j, curframe, startframe : longint;
  2545. s,s2 : string;
  2546. loop_higher, found : boolean;
  2547. last_removed : char;
  2548. function GetValue(var s : string) : boolean;
  2549. begin
  2550. Debugger^.command('p '+s);
  2551. if not Debugger^.Error then
  2552. begin
  2553. s:=StrPas(Debugger^.GetOutput);
  2554. GetValue:=true;
  2555. end
  2556. else
  2557. begin
  2558. s:=StrPas(Debugger^.GetError);
  2559. GetValue:=false;
  2560. { do not open a messagebox for such errors }
  2561. Debugger^.got_error:=false;
  2562. end;
  2563. end;
  2564. begin
  2565. If not assigned(Debugger) or Not Debugger^.HasExe or
  2566. (GDBRunCount=Debugger^.RunCount) then
  2567. exit;
  2568. GDBRunCount:=Debugger^.RunCount;
  2569. if assigned(last_value) then
  2570. strdispose(last_value);
  2571. last_value:=current_value;
  2572. s:=GetStr(expr);
  2573. { Fix 2d array indexing, change [x,x] to [x][x] }
  2574. i:=pos('[',s);
  2575. if i>0 then
  2576. begin
  2577. while i<length(s) do
  2578. begin
  2579. if s[i]=',' then
  2580. begin
  2581. s[i]:='[';
  2582. insert(']',s,i);
  2583. inc(i);
  2584. end;
  2585. inc(i);
  2586. end;
  2587. end;
  2588. found:=GetValue(s);
  2589. Debugger^.got_error:=false;
  2590. loop_higher:=not found;
  2591. if not found then
  2592. begin
  2593. curframe:=Debugger^.get_current_frame;
  2594. startframe:=curframe;
  2595. end
  2596. else
  2597. begin
  2598. curframe:=0;
  2599. startframe:=0;
  2600. end;
  2601. while loop_higher do
  2602. begin
  2603. s:='parentfp';
  2604. if GetValue(s) then
  2605. begin
  2606. repeat
  2607. inc(curframe);
  2608. if not Debugger^.set_current_frame(curframe) then
  2609. loop_higher:=false;
  2610. {$ifdef FrameNameKnown}
  2611. s2:='/x '+FrameName;
  2612. {$else not FrameNameKnown}
  2613. s2:='/x $ebp';
  2614. {$endif FrameNameKnown}
  2615. getValue(s2);
  2616. j:=pos('=',s2);
  2617. if j>0 then
  2618. s2:=copy(s2,j+1,length(s2));
  2619. while s2[1] in [' ',TAB] do
  2620. delete(s2,1,1);
  2621. if pos(s2,s)>0 then
  2622. loop_higher :=false;
  2623. until not loop_higher;
  2624. { try again at that level }
  2625. s:=GetStr(expr);
  2626. found:=GetValue(s);
  2627. loop_higher:=not found;
  2628. end
  2629. else
  2630. loop_higher:=false;
  2631. end;
  2632. if found then
  2633. p:=StrNew(Debugger^.GetOutput)
  2634. else
  2635. begin
  2636. { get a reasonable output at least }
  2637. s:=GetStr(expr);
  2638. GetValue(s);
  2639. p:=StrNew(Debugger^.GetError);
  2640. end;
  2641. Debugger^.got_error:=false;
  2642. { We should try here to find the expr in parent
  2643. procedure if there are
  2644. I will implement this as I added a
  2645. parent_ebp pseudo local var to local procedure
  2646. in stabs debug info PM }
  2647. { But there are some pitfalls like
  2648. locals redefined in other sublocals that call the function }
  2649. if curframe<>startframe then
  2650. Debugger^.set_current_frame(startframe);
  2651. q:=nil;
  2652. if assigned(p) and (p[0]='$') then
  2653. q:=StrPos(p,'=');
  2654. if not assigned(q) then
  2655. q:=p;
  2656. if assigned(q) then
  2657. i:=strlen(q)
  2658. else
  2659. i:=0;
  2660. if (i>0) and (q[i-1]=#10) then
  2661. begin
  2662. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2663. dec(i);
  2664. last_removed:=q[i-1];
  2665. q[i-1]:=#0;
  2666. end
  2667. else
  2668. last_removed:=#0;
  2669. if assigned(q) then
  2670. current_value:=strnew(q)
  2671. else
  2672. current_value:=strnew('');
  2673. if last_removed<>#0 then
  2674. q[i-1]:=last_removed;
  2675. strdispose(p);
  2676. GDBRunCount:=Debugger^.RunCount;
  2677. end;
  2678. {$else NODEBUG}
  2679. begin
  2680. end;
  2681. {$endif NODEBUG}
  2682. procedure TWatch.Force_new_value;
  2683. begin
  2684. GDBRunCount:=-1;
  2685. Get_new_value;
  2686. end;
  2687. destructor TWatch.Done;
  2688. begin
  2689. if assigned(expr) then
  2690. disposestr(expr);
  2691. if assigned(last_value) then
  2692. strdispose(last_value);
  2693. if assigned(current_value) then
  2694. strdispose(current_value);
  2695. inherited done;
  2696. end;
  2697. {****************************************************************************
  2698. TWatchesCollection
  2699. ****************************************************************************}
  2700. constructor TWatchesCollection.Init;
  2701. begin
  2702. inherited Init(10,10);
  2703. end;
  2704. procedure TWatchesCollection.Insert(Item: Pointer);
  2705. begin
  2706. PWatch(Item)^.Get_new_value;
  2707. Inherited Insert(Item);
  2708. Update;
  2709. end;
  2710. procedure TWatchesCollection.Update;
  2711. var
  2712. W,W1 : integer;
  2713. procedure GetMax(P : PWatch);
  2714. begin
  2715. if assigned(P^.Current_value) then
  2716. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2717. else
  2718. W1:=2+Length(GetStr(P^.expr));
  2719. if W1>W then
  2720. W:=W1;
  2721. end;
  2722. begin
  2723. W:=0;
  2724. ForEach(@GetMax);
  2725. MaxW:=W;
  2726. If assigned(WatchesWindow) then
  2727. WatchesWindow^.WLB^.Update(MaxW);
  2728. end;
  2729. function TWatchesCollection.At(Index: Integer): PWatch;
  2730. begin
  2731. At:=Inherited At(Index);
  2732. end;
  2733. {****************************************************************************
  2734. TWatchesListBox
  2735. ****************************************************************************}
  2736. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2737. begin
  2738. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2739. If assigned(List) then
  2740. dispose(list,done);
  2741. List:=WatchesCollection;
  2742. end;
  2743. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2744. var R : TRect;
  2745. begin
  2746. GetExtent(R);
  2747. MaxWidth:=AMaxWidth;
  2748. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2749. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2750. else
  2751. HScrollBar^.SetRange(0,0);
  2752. if R.B.X-R.A.X>MaxWidth then
  2753. HScrollBar^.Hide
  2754. else
  2755. HScrollBar^.Show;
  2756. SetRange(List^.Count+1);
  2757. if R.B.Y-R.A.Y>Range then
  2758. VScrollBar^.Hide
  2759. else
  2760. VScrollBar^.Show;
  2761. {if Focused=List^.Count-1-1 then
  2762. FocusItem(List^.Count-1);
  2763. What was that for ?? PM }
  2764. DrawView;
  2765. end;
  2766. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2767. var
  2768. PW : PWatch;
  2769. ValOffset : Sw_integer;
  2770. S : String;
  2771. begin
  2772. Modified:=false;
  2773. if Item>=WatchesCollection^.Count then
  2774. begin
  2775. GetIndentedText:='';
  2776. exit;
  2777. end;
  2778. PW:=WatchesCollection^.At(Item);
  2779. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2780. if not assigned(PW^.expr) then
  2781. GetIndentedText:=''
  2782. else if Indent<ValOffset then
  2783. begin
  2784. S:=GetStr(PW^.Expr);
  2785. if Indent=0 then
  2786. S:=' '+S
  2787. else
  2788. S:=Copy(S,Indent,High(S));
  2789. if not assigned(PW^.current_value) then
  2790. S:=S+' <Unknown value>'
  2791. else
  2792. S:=S+' '+GetPChar(PW^.Current_value);
  2793. GetIndentedText:=Copy(S,1,MaxLen);
  2794. end
  2795. else
  2796. begin
  2797. if not assigned(PW^.Current_value) or
  2798. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2799. S:=''
  2800. else
  2801. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2802. GetIndentedText:=Copy(S,1,MaxLen);
  2803. end;
  2804. if assigned(PW^.current_value) and
  2805. assigned(PW^.last_value) and
  2806. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2807. Modified:=true;
  2808. end;
  2809. procedure TWatchesListBox.EditCurrent;
  2810. var
  2811. P: PWatch;
  2812. begin
  2813. if Range=0 then Exit;
  2814. if Focused<WatchesCollection^.Count then
  2815. P:=WatchesCollection^.At(Focused)
  2816. else
  2817. P:=New(PWatch,Init(''));
  2818. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2819. WatchesCollection^.Update;
  2820. end;
  2821. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2822. var
  2823. Dummy_Modified : boolean;
  2824. begin
  2825. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2826. end;
  2827. procedure TWatchesListBox.DeleteCurrent;
  2828. var
  2829. P: PWatch;
  2830. begin
  2831. if (Range=0) or
  2832. (Focused>=WatchesCollection^.Count) then
  2833. exit;
  2834. P:=WatchesCollection^.At(Focused);
  2835. WatchesCollection^.free(P);
  2836. WatchesCollection^.Update;
  2837. end;
  2838. procedure TWatchesListBox.EditNew;
  2839. var
  2840. P: PWatch;
  2841. S : string;
  2842. begin
  2843. if Focused<WatchesCollection^.Count then
  2844. begin
  2845. P:=WatchesCollection^.At(Focused);
  2846. S:=GetStr(P^.expr);
  2847. end
  2848. else
  2849. S:='';
  2850. P:=New(PWatch,Init(S));
  2851. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2852. begin
  2853. WatchesCollection^.AtInsert(Focused,P);
  2854. WatchesCollection^.Update;
  2855. end
  2856. else
  2857. dispose(P,Done);
  2858. end;
  2859. procedure TWatchesListBox.Draw;
  2860. var
  2861. I, J, Item: Sw_Integer;
  2862. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2863. ColWidth, CurCol, Indent: Integer;
  2864. B: TDrawBuffer;
  2865. Modified : boolean;
  2866. Text: String;
  2867. SCOff: Byte;
  2868. TC: byte;
  2869. procedure MT(var C: word);
  2870. begin
  2871. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2872. end;
  2873. begin
  2874. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2875. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2876. begin
  2877. NormalColor := GetColor(1);
  2878. FocusedColor := GetColor(3);
  2879. SelectedColor := GetColor(4);
  2880. end else
  2881. begin
  2882. NormalColor := GetColor(2);
  2883. SelectedColor := GetColor(4);
  2884. end;
  2885. if Transparent then
  2886. begin MT(NormalColor); MT(SelectedColor); end;
  2887. (* if NoSelection then
  2888. SelectedColor:=NormalColor;*)
  2889. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2890. else Indent := 0;
  2891. ColWidth := Size.X div NumCols + 1;
  2892. for I := 0 to Size.Y - 1 do
  2893. begin
  2894. for J := 0 to NumCols-1 do
  2895. begin
  2896. Item := J*Size.Y + I + TopItem;
  2897. CurCol := J*ColWidth;
  2898. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2899. (Focused = Item) and (Range > 0) then
  2900. begin
  2901. Color := FocusedColor;
  2902. SetCursor(CurCol+1,I);
  2903. SCOff := 0;
  2904. end
  2905. else if (Item < Range) and IsSelected(Item) then
  2906. begin
  2907. Color := SelectedColor;
  2908. SCOff := 2;
  2909. end
  2910. else
  2911. begin
  2912. Color := NormalColor;
  2913. SCOff := 4;
  2914. end;
  2915. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2916. if Item < Range then
  2917. begin
  2918. (* Text := GetText(Item, ColWidth + Indent);
  2919. Text := Copy(Text,Indent,ColWidth); *)
  2920. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2921. if modified then
  2922. begin
  2923. SCOff:=0;
  2924. Color:=(Color and $fff0) or Red;
  2925. end;
  2926. MoveStr(B[CurCol], Text, Color);
  2927. if {ShowMarkers or } Modified then
  2928. begin
  2929. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2930. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2931. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2932. end;
  2933. end;
  2934. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2935. end;
  2936. WriteLine(0, I, Size.X, 1, B);
  2937. end;
  2938. end;
  2939. function TWatchesListBox.GetLocalMenu: PMenu;
  2940. var M: PMenu;
  2941. begin
  2942. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2943. M:=NewMenu(
  2944. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2945. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2946. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2947. NewLine(
  2948. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2949. nil))))));
  2950. GetLocalMenu:=M;
  2951. end;
  2952. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2953. var DontClear: boolean;
  2954. begin
  2955. case Event.What of
  2956. evMouseDown : begin
  2957. if Event.Double then
  2958. Message(@Self,evCommand,cmEdit,nil)
  2959. else
  2960. ClearEvent(Event);
  2961. end;
  2962. evKeyDown :
  2963. begin
  2964. DontClear:=false;
  2965. case Event.KeyCode of
  2966. kbEnter :
  2967. Message(@Self,evCommand,cmEdit,nil);
  2968. kbIns :
  2969. Message(@Self,evCommand,cmNew,nil);
  2970. kbDel :
  2971. Message(@Self,evCommand,cmDelete,nil);
  2972. else
  2973. DontClear:=true;
  2974. end;
  2975. if not DontClear then
  2976. ClearEvent(Event);
  2977. end;
  2978. evBroadcast :
  2979. case Event.Command of
  2980. cmListItemSelected :
  2981. if Event.InfoPtr=@Self then
  2982. Message(@Self,evCommand,cmEdit,nil);
  2983. end;
  2984. evCommand :
  2985. begin
  2986. DontClear:=false;
  2987. case Event.Command of
  2988. cmEdit :
  2989. EditCurrent;
  2990. cmDelete :
  2991. DeleteCurrent;
  2992. cmNew :
  2993. EditNew;
  2994. else
  2995. DontClear:=true;
  2996. end;
  2997. if not DontClear then
  2998. ClearEvent(Event);
  2999. end;
  3000. end;
  3001. inherited HandleEvent(Event);
  3002. end;
  3003. constructor TWatchesListBox.Load(var S: TStream);
  3004. begin
  3005. inherited Load(S);
  3006. If assigned(List) then
  3007. dispose(list,done);
  3008. List:=WatchesCollection;
  3009. { we must set Range PM }
  3010. SetRange(List^.count+1);
  3011. end;
  3012. procedure TWatchesListBox.Store(var S: TStream);
  3013. var OL: PCollection;
  3014. OldRange : Sw_integer;
  3015. begin
  3016. OL:=List;
  3017. OldRange:=Range;
  3018. Range:=0;
  3019. New(List, Init(1,1));
  3020. inherited Store(S);
  3021. Dispose(List, Done);
  3022. List:=OL;
  3023. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  3024. collection? Pasting here a modified version of TListBox.Store+
  3025. TAdvancedListBox.Store isn't a better solution, since by eventually
  3026. changing the obj-hierarchy you'll always have to modify this, too - BG }
  3027. SetRange(OldRange);
  3028. end;
  3029. destructor TWatchesListBox.Done;
  3030. begin
  3031. List:=nil;
  3032. inherited Done;
  3033. end;
  3034. {****************************************************************************
  3035. TWatchesWindow
  3036. ****************************************************************************}
  3037. Constructor TWatchesWindow.Init;
  3038. var
  3039. HSB,VSB: PScrollBar;
  3040. R,R2 : trect;
  3041. begin
  3042. Desktop^.GetExtent(R);
  3043. R.A.Y:=R.B.Y-7;
  3044. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  3045. Palette:=wpCyanWindow;
  3046. GetExtent(R);
  3047. HelpCtx:=hcWatchesWindow;
  3048. R.Grow(-1,-1);
  3049. R2.Copy(R);
  3050. Inc(R2.B.Y);
  3051. R2.A.Y:=R2.B.Y-1;
  3052. New(HSB, Init(R2));
  3053. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3054. HSB^.SetStep(R.B.X-R.A.X,1);
  3055. Insert(HSB);
  3056. R2.Copy(R);
  3057. Inc(R2.B.X);
  3058. R2.A.X:=R2.B.X-1;
  3059. New(VSB, Init(R2));
  3060. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3061. Insert(VSB);
  3062. New(WLB,Init(R,HSB,VSB));
  3063. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3064. WLB^.Transparent:=true;
  3065. Insert(WLB);
  3066. If assigned(WatchesWindow) then
  3067. dispose(WatchesWindow,done);
  3068. WatchesWindow:=@Self;
  3069. Update;
  3070. end;
  3071. procedure TWatchesWindow.Update;
  3072. begin
  3073. WatchesCollection^.Update;
  3074. Draw;
  3075. end;
  3076. constructor TWatchesWindow.Load(var S: TStream);
  3077. begin
  3078. inherited Load(S);
  3079. GetSubViewPtr(S,WLB);
  3080. If assigned(WatchesWindow) then
  3081. dispose(WatchesWindow,done);
  3082. WatchesWindow:=@Self;
  3083. end;
  3084. procedure TWatchesWindow.Store(var S: TStream);
  3085. begin
  3086. inherited Store(S);
  3087. PutSubViewPtr(S,WLB);
  3088. end;
  3089. Destructor TWatchesWindow.Done;
  3090. begin
  3091. WatchesWindow:=nil;
  3092. Dispose(WLB,done);
  3093. inherited done;
  3094. end;
  3095. {****************************************************************************
  3096. TWatchItemDialog
  3097. ****************************************************************************}
  3098. constructor TWatchItemDialog.Init(AWatch: PWatch);
  3099. var R,R2: TRect;
  3100. begin
  3101. R.Assign(0,0,50,10);
  3102. inherited Init(R,'Edit Watch');
  3103. Watch:=AWatch;
  3104. GetExtent(R); R.Grow(-3,-2);
  3105. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  3106. New(NameIL, Init(R, 255)); Insert(NameIL);
  3107. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  3108. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  3109. R2.Copy(R); R2.Move(-1,-1);
  3110. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  3111. GetExtent(R);
  3112. R.Grow(-3,-1);
  3113. R.A.Y:=R.A.Y+3;
  3114. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  3115. Insert(TextST);
  3116. InsertButtons(@Self);
  3117. NameIL^.Select;
  3118. end;
  3119. function TWatchItemDialog.Execute: Word;
  3120. var R: word;
  3121. S1,S2: string;
  3122. begin
  3123. S1:=GetStr(Watch^.expr);
  3124. NameIL^.SetData(S1);
  3125. S1:=GetPChar(Watch^.Current_value);
  3126. S2:=GetPChar(Watch^.Last_value);
  3127. ClearFormatParams;
  3128. AddFormatParamStr(S1);
  3129. AddFormatParamStr(S2);
  3130. if assigned(Watch^.Last_value) and
  3131. assigned(Watch^.Current_value) and
  3132. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  3133. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  3134. else
  3135. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  3136. TextST^.SetText(S1);
  3137. if assigned(FirstEditorWindow) then
  3138. FindReplaceEditor:=FirstEditorWindow^.Editor;
  3139. R:=inherited Execute;
  3140. FindReplaceEditor:=nil;
  3141. if R=cmOK then
  3142. begin
  3143. NameIL^.GetData(S1);
  3144. Watch^.Rename(S1);
  3145. {$ifndef NODEBUG}
  3146. If assigned(Debugger) then
  3147. Debugger^.ReadWatches;
  3148. {$endif NODEBUG}
  3149. end;
  3150. Execute:=R;
  3151. end;
  3152. {****************************************************************************
  3153. TStackWindow
  3154. ****************************************************************************}
  3155. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3156. begin
  3157. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3158. end;
  3159. procedure TFramesListBox.Update;
  3160. var i : longint;
  3161. W : PSourceWindow;
  3162. begin
  3163. {$ifndef NODEBUG}
  3164. { call backtrace command }
  3165. If not assigned(Debugger) then
  3166. exit;
  3167. DeskTop^.Lock;
  3168. Clear;
  3169. { forget all old frames }
  3170. Debugger^.clear_frames;
  3171. if Debugger^.WindowWidth<>-1 then
  3172. Debugger^.Command('set width 0xffffffff');
  3173. Debugger^.Command('backtrace');
  3174. { generate list }
  3175. { all is in tframeentry }
  3176. for i:=0 to Debugger^.frame_count-1 do
  3177. begin
  3178. with Debugger^.frames[i]^ do
  3179. begin
  3180. if assigned(file_name) then
  3181. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3182. AddModuleName(GetPChar(file_name)),line_number,1)))
  3183. else
  3184. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3185. AddModuleName(''),line_number,1)));
  3186. W:=SearchOnDesktop(GetPChar(file_name),false);
  3187. { First reset all Debugger rows }
  3188. If assigned(W) then
  3189. begin
  3190. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3191. W^.Editor^.DebuggerRow:=-1;
  3192. end;
  3193. end;
  3194. end;
  3195. { Now set all Debugger rows }
  3196. for i:=0 to Debugger^.frame_count-1 do
  3197. begin
  3198. with Debugger^.frames[i]^ do
  3199. begin
  3200. W:=SearchOnDesktop(GetPChar(file_name),false);
  3201. If assigned(W) then
  3202. begin
  3203. If W^.Editor^.DebuggerRow=-1 then
  3204. begin
  3205. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3206. W^.Editor^.DebuggerRow:=line_number-1;
  3207. end;
  3208. end;
  3209. end;
  3210. end;
  3211. if Assigned(list) and (List^.Count > 0) then
  3212. FocusItem(0);
  3213. if Debugger^.WindowWidth<>-1 then
  3214. Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
  3215. DeskTop^.Unlock;
  3216. {$endif NODEBUG}
  3217. end;
  3218. function TFramesListBox.GetLocalMenu: PMenu;
  3219. begin
  3220. GetLocalMenu:=Inherited GetLocalMenu;
  3221. end;
  3222. procedure TFramesListBox.GotoSource;
  3223. begin
  3224. {$ifndef NODEBUG}
  3225. { select frame for watches }
  3226. If not assigned(Debugger) then
  3227. exit;
  3228. Debugger^.Command('f '+IntToStr(Focused));
  3229. { for local vars }
  3230. Debugger^.RereadWatches;
  3231. {$endif NODEBUG}
  3232. { goto source }
  3233. inherited GotoSource;
  3234. end;
  3235. procedure TFramesListBox.GotoAssembly;
  3236. begin
  3237. {$ifndef NODEBUG}
  3238. { select frame for watches }
  3239. If not assigned(Debugger) then
  3240. exit;
  3241. Debugger^.Command('f '+IntToStr(Focused));
  3242. { for local vars }
  3243. Debugger^.RereadWatches;
  3244. {$endif}
  3245. { goto source/assembly mixture }
  3246. InitDisassemblyWindow;
  3247. DisassemblyWindow^.LoadFunction('');
  3248. {$ifndef NODEBUG}
  3249. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3250. DisassemblyWindow^.SelectInDebugSession;
  3251. {$endif NODEBUG}
  3252. end;
  3253. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3254. begin
  3255. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3256. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3257. GotoAssembly;
  3258. inherited HandleEvent(Event);
  3259. end;
  3260. destructor TFramesListBox.Done;
  3261. begin
  3262. Inherited Done;
  3263. end;
  3264. Constructor TStackWindow.Init;
  3265. var
  3266. HSB,VSB: PScrollBar;
  3267. R,R2 : trect;
  3268. begin
  3269. Desktop^.GetExtent(R);
  3270. R.A.Y:=R.B.Y-5;
  3271. inherited Init(R, dialog_callstack, wnNoNumber);
  3272. Palette:=wpCyanWindow;
  3273. GetExtent(R);
  3274. HelpCtx:=hcStackWindow;
  3275. R.Grow(-1,-1);
  3276. R2.Copy(R);
  3277. Inc(R2.B.Y);
  3278. R2.A.Y:=R2.B.Y-1;
  3279. New(HSB, Init(R2));
  3280. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3281. Insert(HSB);
  3282. R2.Copy(R);
  3283. Inc(R2.B.X);
  3284. R2.A.X:=R2.B.X-1;
  3285. New(VSB, Init(R2));
  3286. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3287. Insert(VSB);
  3288. New(FLB,Init(R,HSB,VSB));
  3289. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3290. Insert(FLB);
  3291. If assigned(StackWindow) then
  3292. dispose(StackWindow,done);
  3293. StackWindow:=@Self;
  3294. Update;
  3295. end;
  3296. procedure TStackWindow.Update;
  3297. begin
  3298. FLB^.Update;
  3299. DrawView;
  3300. end;
  3301. constructor TStackWindow.Load(var S: TStream);
  3302. begin
  3303. inherited Load(S);
  3304. GetSubViewPtr(S,FLB);
  3305. If assigned(StackWindow) then
  3306. dispose(StackWindow,done);
  3307. StackWindow:=@Self;
  3308. end;
  3309. procedure TStackWindow.Store(var S: TStream);
  3310. begin
  3311. inherited Store(S);
  3312. PutSubViewPtr(S,FLB);
  3313. end;
  3314. Destructor TStackWindow.Done;
  3315. begin
  3316. StackWindow:=nil;
  3317. Dispose(FLB,done);
  3318. inherited done;
  3319. end;
  3320. {****************************************************************************
  3321. Init/Final
  3322. ****************************************************************************}
  3323. function GetGDBTargetShortName : string;
  3324. begin
  3325. {$ifndef CROSSGDB}
  3326. GetGDBTargetShortName:=source_info.shortname;
  3327. {$else CROSSGDB}
  3328. {$ifdef SUPPORT_REMOTE}
  3329. {$ifdef PALMOSGDB}
  3330. GetGDBTargetShortName:='palmos';
  3331. {$else}
  3332. GetGDBTargetShortName:='linux';
  3333. {$endif PALMOSGDB}
  3334. {$endif not SUPPORT_REMOTE}
  3335. {$endif CROSSGDB}
  3336. end;
  3337. procedure InitDebugger;
  3338. {$ifdef DEBUG}
  3339. var s : string;
  3340. i,p : longint;
  3341. {$endif DEBUG}
  3342. var
  3343. NeedRecompileExe : boolean;
  3344. cm : longint;
  3345. begin
  3346. {$ifdef DEBUG}
  3347. if not use_gdb_file then
  3348. begin
  3349. Assign(gdb_file,GDBOutFileName);
  3350. {$I-}
  3351. Rewrite(gdb_file);
  3352. if InOutRes<>0 then
  3353. begin
  3354. s:=GDBOutFileName;
  3355. p:=pos('.',s);
  3356. if p>1 then
  3357. for i:=0 to 9 do
  3358. begin
  3359. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3360. InOutRes:=0;
  3361. Assign(gdb_file,s);
  3362. rewrite(gdb_file);
  3363. if InOutRes=0 then
  3364. break;
  3365. end;
  3366. end;
  3367. if IOResult=0 then
  3368. Use_gdb_file:=true;
  3369. end;
  3370. {$I+}
  3371. {$endif}
  3372. NeedRecompileExe:=false;
  3373. {$ifndef SUPPORT_REMOTE}
  3374. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3375. begin
  3376. ClearFormatParams;
  3377. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3378. AddFormatParamStr(GetGDBTargetShortName);
  3379. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3380. if cm=cmCancel then
  3381. Exit;
  3382. if cm=cmYes then
  3383. begin
  3384. { force recompilation }
  3385. PrevMainFile:='';
  3386. NeedRecompileExe:=true;
  3387. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3388. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3389. DebugInfoSwitches^.SetCurrSelParam('l');
  3390. IDEApp.UpdateTarget;
  3391. end;
  3392. end;
  3393. {$endif ndef SUPPORT_REMOTE}
  3394. if not NeedRecompileExe then
  3395. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3396. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3397. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3398. begin
  3399. ClearFormatParams;
  3400. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3401. if cm=cmCancel then
  3402. Exit;
  3403. if cm=cmYes then
  3404. begin
  3405. { force recompilation }
  3406. PrevMainFile:='';
  3407. NeedRecompileExe:=true;
  3408. DebugInfoSwitches^.SetCurrSelParam('l');
  3409. end;
  3410. end;
  3411. if NeedRecompileExe then
  3412. DoCompile(cRun);
  3413. if CompilationPhase<>cpDone then
  3414. Exit;
  3415. if (EXEFile='') then
  3416. begin
  3417. ErrorBox(msg_nothingtodebug,nil);
  3418. Exit;
  3419. end;
  3420. { init debugcontroller }
  3421. {$ifndef NODEBUG}
  3422. if not assigned(Debugger) then
  3423. begin
  3424. PushStatus(msg_startingdebugger);
  3425. new(Debugger,Init);
  3426. PopStatus;
  3427. end;
  3428. Debugger^.SetExe(ExeFile);
  3429. {$endif NODEBUG}
  3430. {$ifdef GDBWINDOW}
  3431. InitGDBWindow;
  3432. {$endif def GDBWINDOW}
  3433. end;
  3434. const
  3435. Invalid_gdb_file_handle: boolean = false;
  3436. procedure DoneDebugger;
  3437. begin
  3438. {$ifdef DEBUG}
  3439. If IDEApp.IsRunning then
  3440. PushStatus('Closing debugger');
  3441. {$endif}
  3442. {$ifndef NODEBUG}
  3443. if assigned(Debugger) then
  3444. dispose(Debugger,Done);
  3445. Debugger:=nil;
  3446. {$endif NODEBUG}
  3447. {$ifdef DOS}
  3448. If assigned(UserScreen) then
  3449. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3450. {$endif DOS}
  3451. {$ifdef DEBUG}
  3452. If Use_gdb_file then
  3453. begin
  3454. Use_gdb_file:=false;
  3455. {$IFOPT I+}
  3456. {$I-}
  3457. {$DEFINE REENABLE_I}
  3458. {$ENDIF}
  3459. Close(GDB_file);
  3460. if ioresult<>0 then
  3461. begin
  3462. { This handle seems to get lost for DJGPP
  3463. don't bother too much about this. }
  3464. Invalid_gdb_file_handle:=true;
  3465. end;
  3466. {$IFDEF REENABLE_I}
  3467. {$I+}
  3468. {$ENDIF}
  3469. end;
  3470. If IDEApp.IsRunning then
  3471. PopStatus;
  3472. {$endif DEBUG}
  3473. end;
  3474. procedure InitGDBWindow;
  3475. var
  3476. R : TRect;
  3477. begin
  3478. if GDBWindow=nil then
  3479. begin
  3480. DeskTop^.GetExtent(R);
  3481. new(GDBWindow,init(R));
  3482. DeskTop^.Insert(GDBWindow);
  3483. end;
  3484. end;
  3485. procedure DoneGDBWindow;
  3486. begin
  3487. If IDEApp.IsRunning and
  3488. assigned(GDBWindow) then
  3489. begin
  3490. DeskTop^.Delete(GDBWindow);
  3491. end;
  3492. GDBWindow:=nil;
  3493. end;
  3494. procedure InitDisassemblyWindow;
  3495. var
  3496. R : TRect;
  3497. begin
  3498. if DisassemblyWindow=nil then
  3499. begin
  3500. DeskTop^.GetExtent(R);
  3501. new(DisassemblyWindow,init(R));
  3502. DeskTop^.Insert(DisassemblyWindow);
  3503. end;
  3504. end;
  3505. procedure DoneDisassemblyWindow;
  3506. begin
  3507. if assigned(DisassemblyWindow) then
  3508. begin
  3509. DeskTop^.Delete(DisassemblyWindow);
  3510. Dispose(DisassemblyWindow,Done);
  3511. DisassemblyWindow:=nil;
  3512. end;
  3513. end;
  3514. procedure InitStackWindow;
  3515. begin
  3516. if StackWindow=nil then
  3517. begin
  3518. new(StackWindow,init);
  3519. DeskTop^.Insert(StackWindow);
  3520. end;
  3521. end;
  3522. procedure DoneStackWindow;
  3523. begin
  3524. if assigned(StackWindow) then
  3525. begin
  3526. DeskTop^.Delete(StackWindow);
  3527. StackWindow:=nil;
  3528. end;
  3529. end;
  3530. procedure InitBreakpoints;
  3531. begin
  3532. New(BreakpointsCollection,init(10,10));
  3533. end;
  3534. procedure DoneBreakpoints;
  3535. begin
  3536. Dispose(BreakpointsCollection,Done);
  3537. BreakpointsCollection:=nil;
  3538. end;
  3539. procedure InitWatches;
  3540. begin
  3541. New(WatchesCollection,init);
  3542. end;
  3543. procedure DoneWatches;
  3544. begin
  3545. Dispose(WatchesCollection,Done);
  3546. WatchesCollection:=nil;
  3547. end;
  3548. procedure RegisterFPDebugViews;
  3549. begin
  3550. RegisterType(RWatchesWindow);
  3551. RegisterType(RBreakpointsWindow);
  3552. RegisterType(RWatchesListBox);
  3553. RegisterType(RBreakpointsListBox);
  3554. RegisterType(RStackWindow);
  3555. RegisterType(RFramesListBox);
  3556. RegisterType(RBreakpoint);
  3557. RegisterType(RWatch);
  3558. RegisterType(RBreakpointCollection);
  3559. RegisterType(RWatchesCollection);
  3560. end;
  3561. end.
  3562. {$endif NODEBUG}