fpdebug.pas 105 KB

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