fpdebug.pas 105 KB

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