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