fpdebug.pas 121 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998-2000 by Pierre Muller
  5. Debugger call routines for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit FPDebug;
  13. interface
  14. uses
  15. Objects,Dialogs,Drivers,Views,
  16. GDBCon,GDBInt,Menus,
  17. WViews,
  18. FPViews;
  19. type
  20. PDebugController=^TDebugController;
  21. TDebugController=object(TGDBController)
  22. InvalidSourceLine : boolean;
  23. { if true the current debugger raw will stay in middle of
  24. editor window when debugging PM }
  25. CenterDebuggerRow : boolean;
  26. LastFileName : string;
  27. LastSource : PView; {PsourceWindow !! }
  28. HiddenStepsCount : longint;
  29. { no need to switch if using another terminal }
  30. NoSwitch : boolean;
  31. HasExe : boolean;
  32. RunCount : longint;
  33. FPCBreakErrorNumber : longint;
  34. constructor Init;
  35. procedure SetExe(const exefn:string);
  36. procedure SetDirectories;
  37. destructor Done;
  38. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  39. { procedure DoStartSession;virtual;
  40. procedure DoBreakSession;virtual;}
  41. procedure DoEndSession(code:longint);virtual;
  42. procedure AnnotateError;
  43. procedure InsertBreakpoints;
  44. procedure RemoveBreakpoints;
  45. procedure ReadWatches;
  46. procedure ResetBreakpointsValues;
  47. procedure DoDebuggerScreen;virtual;
  48. procedure DoUserScreen;virtual;
  49. procedure Reset;virtual;
  50. procedure ResetDebuggerRows;
  51. procedure Run;virtual;
  52. procedure Continue;virtual;
  53. procedure UntilReturn;virtual;
  54. procedure CommandBegin(const s:string);virtual;
  55. procedure CommandEnd(const s:string);virtual;
  56. function IsRunning : boolean;
  57. function AllowQuit : boolean;virtual;
  58. function GetValue(Const expr : string) : pchar;
  59. function GetFramePointer : CORE_ADDR;
  60. function GetLongintAt(addr : CORE_ADDR) : longint;
  61. function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  62. end;
  63. BreakpointType = (bt_function,bt_file_line,bt_watch,
  64. bt_awatch,bt_rwatch,bt_address,bt_invalid);
  65. BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
  66. PBreakpointCollection=^TBreakpointCollection;
  67. PBreakpoint=^TBreakpoint;
  68. TBreakpoint=object(TObject)
  69. typ : BreakpointType;
  70. state : BreakpointState;
  71. owner : PBreakpointCollection;
  72. Name : PString; { either function name or expr to watch }
  73. FileName : PString;
  74. OldValue,CurrentValue : Pstring;
  75. Line : Longint; { only used for bt_file_line type }
  76. Conditions : PString; { conditions relative to that breakpoint }
  77. IgnoreCount : Longint; { how many counts should be ignored }
  78. Commands : pchar; { commands that should be executed on breakpoint }
  79. GDBIndex : longint;
  80. GDBState : BreakpointState;
  81. constructor Init_function(Const AFunc : String);
  82. constructor Init_Address(Const AAddress : String);
  83. constructor Init_Empty;
  84. constructor Init_file_line(AFile : String; ALine : longint);
  85. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  86. constructor Load(var S: TStream);
  87. procedure Store(var S: TStream);
  88. procedure Insert;
  89. procedure Remove;
  90. procedure Enable;
  91. procedure Disable;
  92. procedure UpdateSource;
  93. procedure ResetValues;
  94. destructor Done;virtual;
  95. end;
  96. TBreakpointCollection=object(TCollection)
  97. function At(Index: Integer): PBreakpoint;
  98. function GetGDB(index : longint) : PBreakpoint;
  99. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  100. function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  101. procedure Update;
  102. procedure ShowBreakpoints(W : PFPWindow);
  103. procedure ShowAllBreakpoints;
  104. end;
  105. PBreakpointItem = ^TBreakpointItem;
  106. TBreakpointItem = object(TObject)
  107. Breakpoint : PBreakpoint;
  108. constructor Init(ABreakpoint : PBreakpoint);
  109. function GetText(MaxLen: Sw_integer): string; virtual;
  110. procedure Selected; virtual;
  111. function GetModuleName: string; virtual;
  112. end;
  113. PBreakpointsListBox = ^TBreakpointsListBox;
  114. TBreakpointsListBox = object(THSListBox)
  115. Transparent : boolean;
  116. NoSelection : boolean;
  117. MaxWidth : Sw_integer;
  118. (* ModuleNames : PStoreCollection; *)
  119. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  120. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  121. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  122. function GetLocalMenu: PMenu;virtual;
  123. procedure Clear; virtual;
  124. procedure TrackSource; virtual;
  125. procedure EditNew; virtual;
  126. procedure EditCurrent; virtual;
  127. procedure DeleteCurrent; virtual;
  128. procedure ToggleCurrent;
  129. procedure Draw; virtual;
  130. procedure HandleEvent(var Event: TEvent); virtual;
  131. constructor Load(var S: TStream);
  132. procedure Store(var S: TStream);
  133. destructor Done; virtual;
  134. end;
  135. PBreakpointsWindow = ^TBreakpointsWindow;
  136. TBreakpointsWindow = object(TFPDlgWindow)
  137. BreakLB : PBreakpointsListBox;
  138. constructor Init;
  139. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  140. procedure ClearBreakpoints;
  141. procedure ReloadBreakpoints;
  142. procedure Close; virtual;
  143. procedure SizeLimits(var Min, Max: TPoint);virtual;
  144. procedure HandleEvent(var Event: TEvent); virtual;
  145. procedure Update; virtual;
  146. constructor Load(var S: TStream);
  147. procedure Store(var S: TStream);
  148. destructor Done; virtual;
  149. end;
  150. PBreakpointItemDialog = ^TBreakpointItemDialog;
  151. TBreakpointItemDialog = object(TCenterDialog)
  152. constructor Init(ABreakpoint: PBreakpoint);
  153. function Execute: Word; virtual;
  154. private
  155. Breakpoint : PBreakpoint;
  156. TypeRB : PRadioButtons;
  157. NameIL : PInputLine;
  158. ConditionsIL: PInputLine;
  159. LineIL : PInputLine;
  160. IgnoreIL : PInputLine;
  161. end;
  162. PWatch = ^TWatch;
  163. TWatch = Object(TObject)
  164. constructor Init(s : string);
  165. constructor Load(var S: TStream);
  166. procedure Store(var S: TStream);
  167. procedure rename(s : string);
  168. procedure Get_new_value;
  169. destructor done;virtual;
  170. expr : pstring;
  171. private
  172. GDBRunCount : longint;
  173. last_value,current_value : pchar;
  174. end;
  175. PWatchesCollection = ^TWatchesCollection;
  176. TWatchesCollection = Object(TCollection)
  177. constructor Init;
  178. procedure Insert(Item: Pointer); virtual;
  179. function At(Index: Integer): PWatch;
  180. procedure Update;
  181. private
  182. MaxW : integer;
  183. end;
  184. PWatchesListBox = ^TWatchesListBox;
  185. TWatchesListBox = object(THSListBox)
  186. Transparent : boolean;
  187. MaxWidth : Sw_integer;
  188. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  189. (* procedure AddWatch(P: PWatch); virtual; *)
  190. procedure Update(AMaxWidth : integer);
  191. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
  192. function GetLocalMenu: PMenu;virtual;
  193. (* procedure Clear; virtual;
  194. procedure TrackSource; virtual;*)
  195. procedure EditNew; virtual;
  196. procedure EditCurrent; virtual;
  197. procedure DeleteCurrent; virtual;
  198. (*procedure ToggleCurrent; *)
  199. procedure Draw; virtual;
  200. procedure HandleEvent(var Event: TEvent); virtual;
  201. constructor Load(var S: TStream);
  202. procedure Store(var S: TStream);
  203. destructor Done; virtual;
  204. end;
  205. PWatchItemDialog = ^TWatchItemDialog;
  206. TWatchItemDialog = object(TCenterDialog)
  207. constructor Init(AWatch: PWatch);
  208. function Execute: Word; virtual;
  209. private
  210. Watch : PWatch;
  211. NameIL : PInputLine;
  212. TextST : PAdvancedStaticText;
  213. end;
  214. PWatchesWindow = ^TWatchesWindow;
  215. TWatchesWindow = Object(TFPDlgWindow)
  216. WLB : PWatchesListBox;
  217. Constructor Init;
  218. constructor Load(var S: TStream);
  219. procedure Store(var S: TStream);
  220. procedure Update; virtual;
  221. destructor Done; virtual;
  222. end;
  223. PFramesListBox = ^TFramesListBox;
  224. TFramesListBox = object(TMessageListBox)
  225. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  226. procedure Update;
  227. function GetLocalMenu: PMenu;virtual;
  228. procedure GotoSource; virtual;
  229. procedure GotoAssembly; virtual;
  230. procedure HandleEvent(var Event: TEvent); virtual;
  231. destructor Done; virtual;
  232. end;
  233. PStackWindow = ^TStackWindow;
  234. TStackWindow = Object(TFPDlgWindow)
  235. FLB : PFramesListBox;
  236. Constructor Init;
  237. constructor Load(var S: TStream);
  238. procedure Store(var S: TStream);
  239. procedure Update; virtual;
  240. destructor Done; virtual;
  241. end;
  242. {$ifdef TP} dword = longint; {$endif}
  243. TIntRegs = record
  244. {$ifdef I386}
  245. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  246. cs,ds,es,ss,fs,gs : word;
  247. eflags : dword;
  248. {$endif I386}
  249. {$ifdef m68k}
  250. d0,d1,d2,d3,d4,d5,d6,d7 : dword;
  251. a0,a1,a2,a3,a4,a5,fp,sp : dword;
  252. ps,pc : dword;
  253. {$endif m68k}
  254. end;
  255. PRegistersView = ^TRegistersView;
  256. TRegistersView = object(TView)
  257. OldReg : TIntRegs;
  258. constructor Init(var Bounds: TRect);
  259. procedure Draw;virtual;
  260. destructor Done; virtual;
  261. end;
  262. PRegistersWindow = ^TRegistersWindow;
  263. TRegistersWindow = Object(TFPDlgWindow)
  264. RV : PRegistersView;
  265. Constructor Init;
  266. constructor Load(var S: TStream);
  267. procedure Store(var S: TStream);
  268. procedure Update; virtual;
  269. destructor Done; virtual;
  270. end;
  271. TFPURegs = record
  272. {$ifdef I386}
  273. st0,st1,st2,st3,st4,st5,st6,st7 :string;
  274. ftag,fop,fctrl,fstat,fiseg,foseg : word;
  275. fioff,fooff : cardinal;
  276. {$endif I386}
  277. {$ifdef m68k}
  278. fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string;
  279. fpcontrol,fpstatus,fpiaddr : dword;
  280. {$endif m68k}
  281. end;
  282. PFPUView = ^TFPUView;
  283. TFPUView = object(TView)
  284. OldReg : TFPURegs;
  285. constructor Init(var Bounds: TRect);
  286. procedure Draw;virtual;
  287. destructor Done; virtual;
  288. end;
  289. PFPUWindow = ^TFPUWindow;
  290. TFPUWindow = Object(TFPDlgWindow)
  291. RV : PFPUView;
  292. Constructor Init;
  293. constructor Load(var S: TStream);
  294. procedure Store(var S: TStream);
  295. procedure Update; virtual;
  296. destructor Done; virtual;
  297. end;
  298. procedure InitStackWindow;
  299. procedure DoneStackWindow;
  300. procedure InitRegistersWindow;
  301. procedure DoneRegistersWindow;
  302. procedure InitFPUWindow;
  303. procedure DoneFPUWindow;
  304. function ActiveBreakpoints : boolean;
  305. function GDBFileName(st : string) : string;
  306. const
  307. BreakpointTypeStr : Array[BreakpointType] of String[9]
  308. = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
  309. BreakpointStateStr : Array[BreakpointState] of String[8]
  310. = ( 'enabled','disabled','invalid' );
  311. DebuggeeTTY : string = '';
  312. var
  313. Debugger : PDebugController;
  314. BreakpointsCollection : PBreakpointCollection;
  315. WatchesCollection : PwatchesCollection;
  316. procedure InitDebugger;
  317. procedure DoneDebugger;
  318. procedure InitGDBWindow;
  319. procedure DoneGDBWindow;
  320. procedure InitDisassemblyWindow;
  321. procedure DoneDisassemblyWindow;
  322. procedure InitBreakpoints;
  323. procedure DoneBreakpoints;
  324. procedure InitWatches;
  325. procedure DoneWatches;
  326. procedure RegisterFPDebugViews;
  327. procedure UpdateDebugViews;
  328. implementation
  329. uses
  330. Dos,Video,
  331. App,Strings,
  332. {$ifdef FVISION}
  333. FVConsts,
  334. {$else}
  335. Commands,HelpCtx,
  336. {$endif}
  337. {$ifdef win32}
  338. Windebug,
  339. {$endif win32}
  340. {$ifdef Unix}
  341. {$ifdef VER1_0}
  342. Linux,
  343. {$else}
  344. Unix,
  345. {$endif}
  346. {$endif Unix}
  347. Systems,
  348. FPString,FPVars,FPUtils,FPConst,FPSwitch,
  349. FPIntf,FPCompil,FPIde,FPHelp,
  350. Validate,WEditor,WUtils;
  351. const
  352. RBreakpointsWindow: TStreamRec = (
  353. ObjType: 1701;
  354. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  355. Load: @TBreakpointsWindow.Load;
  356. Store: @TBreakpointsWindow.Store
  357. );
  358. RBreakpointsListBox : TStreamRec = (
  359. ObjType: 1702;
  360. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  361. Load: @TBreakpointsListBox.Load;
  362. Store: @TBreakpointsListBox.Store
  363. );
  364. RWatchesWindow: TStreamRec = (
  365. ObjType: 1703;
  366. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  367. Load: @TWatchesWindow.Load;
  368. Store: @TWatchesWindow.Store
  369. );
  370. RWatchesListBox: TStreamRec = (
  371. ObjType: 1704;
  372. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  373. Load: @TWatchesListBox.Load;
  374. Store: @TWatchesListBox.Store
  375. );
  376. RStackWindow: TStreamRec = (
  377. ObjType: 1705;
  378. VmtLink: Ofs(TypeOf(TStackWindow)^);
  379. Load: @TStackWindow.Load;
  380. Store: @TStackWindow.Store
  381. );
  382. RFramesListBox: TStreamRec = (
  383. ObjType: 1706;
  384. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  385. Load: @TFramesListBox.Load;
  386. Store: @TFramesListBox.Store
  387. );
  388. RBreakpoint: TStreamRec = (
  389. ObjType: 1707;
  390. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  391. Load: @TBreakpoint.Load;
  392. Store: @TBreakpoint.Store
  393. );
  394. RWatch: TStreamRec = (
  395. ObjType: 1708;
  396. VmtLink: Ofs(TypeOf(TWatch)^);
  397. Load: @TWatch.Load;
  398. Store: @TWatch.Store
  399. );
  400. RBreakpointCollection: TStreamRec = (
  401. ObjType: 1709;
  402. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  403. Load: @TBreakpointCollection.Load;
  404. Store: @TBreakpointCollection.Store
  405. );
  406. RWatchesCollection: TStreamRec = (
  407. ObjType: 1710;
  408. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  409. Load: @TWatchesCollection.Load;
  410. Store: @TWatchesCollection.Store
  411. );
  412. RRegistersWindow: TStreamRec = (
  413. ObjType: 1711;
  414. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  415. Load: @TRegistersWindow.Load;
  416. Store: @TRegistersWindow.Store
  417. );
  418. RRegistersView: TStreamRec = (
  419. ObjType: 1712;
  420. VmtLink: Ofs(TypeOf(TRegistersView)^);
  421. Load: @TRegistersView.Load;
  422. Store: @TRegistersView.Store
  423. );
  424. RFPUWindow: TStreamRec = (
  425. ObjType: 1713;
  426. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  427. Load: @TFPUWindow.Load;
  428. Store: @TFPUWindow.Store
  429. );
  430. RFPUView: TStreamRec = (
  431. ObjType: 1714;
  432. VmtLink: Ofs(TypeOf(TFPUView)^);
  433. Load: @TFPUView.Load;
  434. Store: @TFPUView.Store
  435. );
  436. {$ifdef I386}
  437. const
  438. FrameName = '$ebp';
  439. {$define FrameNameKnown}
  440. {$endif i386}
  441. {$ifdef m68k}
  442. const
  443. FrameName = '$fp';
  444. {$define FrameNameKnown}
  445. {$endif m68k}
  446. {$ifdef TP}
  447. function HexStr(Value: longint; Len: byte): string;
  448. begin
  449. HexStr:=IntToHex(Value,Len);
  450. end;
  451. {$endif}
  452. function GDBFileName(st : string) : string;
  453. {$ifndef Unix}
  454. var i : longint;
  455. {$endif Unix}
  456. begin
  457. {$ifdef Unix}
  458. GDBFileName:=st;
  459. {$else}
  460. { should we also use / chars ? }
  461. for i:=1 to Length(st) do
  462. if st[i]='\' then
  463. st[i]:='/';
  464. {$ifdef win32}
  465. { for win32 we should convert e:\ into //e/ PM }
  466. if (length(st)>2) and (st[2]=':') and (st[3]='/') then
  467. st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
  468. {$endif win32}
  469. {$ifdef go32v2}
  470. { for go32v2 we should convert //e/ back into e:/ PM }
  471. if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
  472. st:=st[3]+':/'+copy(st,5,length(st));
  473. {$endif go32v2}
  474. GDBFileName:=LowerCaseStr(st);
  475. {$endif}
  476. end;
  477. {****************************************************************************
  478. TDebugController
  479. ****************************************************************************}
  480. procedure UpdateDebugViews;
  481. begin
  482. DeskTop^.Lock;
  483. If assigned(StackWindow) then
  484. StackWindow^.Update;
  485. If assigned(RegistersWindow) then
  486. RegistersWindow^.Update;
  487. If assigned(Debugger) then
  488. Debugger^.ReadWatches;
  489. If assigned(FPUWindow) then
  490. FPUWindow^.Update;
  491. DeskTop^.UnLock;
  492. end;
  493. constructor TDebugController.Init;
  494. begin
  495. inherited Init;
  496. CenterDebuggerRow:=IniCenterDebuggerRow;
  497. NoSwitch:=False;
  498. HasExe:=false;
  499. Debugger:=@self;
  500. {$ifndef GABOR}
  501. switch_to_user:=true;
  502. {$endif}
  503. end;
  504. procedure TDebugController.SetExe(const exefn:string);
  505. var f : string;
  506. begin
  507. f := GetShortName(GDBFileName(exefn));
  508. if (f<>'') and ExistsFile(exefn) then
  509. begin
  510. LoadFile(f);
  511. HasExe:=true;
  512. Command('b FPC_BREAK_ERROR');
  513. FPCBreakErrorNumber:=last_breakpoint_number;
  514. {$ifdef FrameNameKnown}
  515. Command('cond '+IntToStr(FPCBreakErrorNumber)+
  516. ' (('+FrameName+' + 8)^ <> 0) or'+
  517. ' (('+FrameName+' + 12)^ <> 0)');
  518. {$endif FrameNameKnown}
  519. SetArgs(GetRunParameters);
  520. SetDirectories;
  521. InsertBreakpoints;
  522. ReadWatches;
  523. end
  524. else
  525. begin
  526. HasExe:=false;
  527. Command('file');
  528. end;
  529. end;
  530. procedure TDebugController.SetDirectories;
  531. var f,s: string;
  532. i : longint;
  533. begin
  534. f:=GetSourceDirectories;
  535. repeat
  536. i:=pos(';',f);
  537. if i=0 then
  538. s:=f
  539. else
  540. begin
  541. s:=copy(f,1,i-1);
  542. system.delete(f,1,i);
  543. end;
  544. Command('dir '+s);
  545. until i=0;
  546. end;
  547. procedure TDebugController.InsertBreakpoints;
  548. procedure DoInsert(PB : PBreakpoint);
  549. begin
  550. PB^.Insert;
  551. end;
  552. begin
  553. BreakpointsCollection^.ForEach(@DoInsert);
  554. end;
  555. procedure TDebugController.ReadWatches;
  556. procedure DoRead(PB : PWatch);
  557. begin
  558. PB^.Get_new_value;
  559. end;
  560. begin
  561. WatchesCollection^.ForEach(@DoRead);
  562. If Assigned(WatchesWindow) then
  563. WatchesWindow^.Update;
  564. end;
  565. procedure TDebugController.RemoveBreakpoints;
  566. procedure DoDelete(PB : PBreakpoint);
  567. begin
  568. PB^.Remove;
  569. end;
  570. begin
  571. BreakpointsCollection^.ForEach(@DoDelete);
  572. end;
  573. procedure TDebugController.ResetBreakpointsValues;
  574. procedure DoResetVal(PB : PBreakpoint);
  575. begin
  576. PB^.ResetValues;
  577. end;
  578. begin
  579. BreakpointsCollection^.ForEach(@DoResetVal);
  580. end;
  581. function ActiveBreakpoints : boolean;
  582. var
  583. IsActive : boolean;
  584. procedure TestActive(PB : PBreakpoint);
  585. begin
  586. If PB^.state=bs_enabled then
  587. IsActive:=true;
  588. end;
  589. begin
  590. IsActive:=false;
  591. If assigned(BreakpointsCollection) then
  592. BreakpointsCollection^.ForEach(@TestActive);
  593. ActiveBreakpoints:=IsActive;
  594. end;
  595. destructor TDebugController.Done;
  596. begin
  597. { kill the program if running }
  598. Reset;
  599. RemoveBreakpoints;
  600. inherited Done;
  601. end;
  602. procedure TDebugController.Run;
  603. begin
  604. ResetBreakpointsValues;
  605. {$ifdef win32}
  606. { Run the debugge in another console }
  607. if DebuggeeTTY<>'' then
  608. Command('set new-console on')
  609. else
  610. Command('set new-console off');
  611. NoSwitch:=DebuggeeTTY<>'';
  612. {$endif win32}
  613. {$ifdef Unix}
  614. { Run the debuggee in another tty }
  615. if DebuggeeTTY <> '' then
  616. begin
  617. Command('tty '+DebuggeeTTY);
  618. if DebuggeeTTY<>TTYName(stdout) then
  619. NoSwitch:= true
  620. else
  621. NoSwitch:=false;
  622. end
  623. else
  624. begin
  625. if TTYName(input)<>'' then
  626. Command('tty '+TTYName(input));
  627. NoSwitch := false;
  628. end;
  629. {$endif Unix}
  630. { Switch to user screen to get correct handles }
  631. UserScreen;
  632. { Don't try to print GDB messages while in User Screen mode }
  633. If assigned(GDBWindow) then
  634. GDBWindow^.Editor^.Lock;
  635. inherited Run;
  636. DebuggerScreen;
  637. If assigned(GDBWindow) then
  638. GDBWindow^.Editor^.UnLock;
  639. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  640. UpdateDebugViews;
  641. end;
  642. function TDebugController.IsRunning : boolean;
  643. begin
  644. IsRunning:=debuggee_started;
  645. end;
  646. procedure TDebugController.Continue;
  647. begin
  648. {$ifdef NODEBUG}
  649. NoDebugger;
  650. {$else}
  651. if not debuggee_started then
  652. Run
  653. else
  654. inherited Continue;
  655. UpdateDebugViews;
  656. {$endif NODEBUG}
  657. end;
  658. procedure TDebugController.UntilReturn;
  659. begin
  660. Command('finish');
  661. UpdateDebugViews;
  662. { We could try to get the return value !
  663. Not done yet }
  664. end;
  665. procedure TDebugController.CommandBegin(const s:string);
  666. begin
  667. if assigned(GDBWindow) and (in_command>1) then
  668. begin
  669. { We should do something special for errors !! }
  670. If StrLen(GetError)>0 then
  671. GDBWindow^.WriteErrorText(GetError);
  672. GDBWindow^.WriteOutputText(GetOutput);
  673. end;
  674. if assigned(GDBWindow) then
  675. GDBWindow^.WriteString(S);
  676. end;
  677. procedure TDebugController.CommandEnd(const s:string);
  678. begin
  679. if assigned(GDBWindow) and (in_command=0) then
  680. begin
  681. { We should do something special for errors !! }
  682. If StrLen(GetError)>0 then
  683. GDBWindow^.WriteErrorText(GetError);
  684. GDBWindow^.WriteOutputText(GetOutput);
  685. GDBWindow^.Editor^.TextEnd;
  686. end;
  687. end;
  688. function TDebugController.AllowQuit : boolean;
  689. begin
  690. if IsRunning then
  691. begin
  692. if ConfirmBox('Really quit GDB window'#13+
  693. 'and kill running program?',nil,true)=cmYes then
  694. begin
  695. Reset;
  696. DoneGDBWindow;
  697. {AllowQuit:=true;}
  698. AllowQuit:=false;
  699. end
  700. else
  701. AllowQuit:=false;
  702. end
  703. else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
  704. begin
  705. DoneGDBWindow;
  706. {AllowQuit:=true;}
  707. AllowQuit:=false;
  708. end
  709. else
  710. AllowQuit:=false;
  711. end;
  712. procedure TDebugController.ResetDebuggerRows;
  713. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  714. begin
  715. if assigned(P) and
  716. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  717. PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  718. end;
  719. begin
  720. Desktop^.ForEach(@ResetDebuggerRow);
  721. end;
  722. procedure TDebugController.Reset;
  723. begin
  724. inherited Reset;
  725. { we need to free the executable
  726. if we want to recompile it }
  727. SetExe('');
  728. NoSwitch:=false;
  729. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  730. { In case we have something that the compiler touched }
  731. AskToReloadAllModifiedFiles;
  732. ResetDebuggerRows;
  733. end;
  734. procedure TDebugController.AnnotateError;
  735. var errornb : longint;
  736. begin
  737. if error then
  738. begin
  739. errornb:=error_num;
  740. UpdateDebugViews;
  741. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  742. end;
  743. end;
  744. function TDebugController.GetValue(Const expr : string) : pchar;
  745. var
  746. p,p2,p3 : pchar;
  747. begin
  748. Command('p '+expr);
  749. p:=GetOutput;
  750. p3:=nil;
  751. if assigned(p) and (p[strlen(p)-1]=#10) then
  752. begin
  753. p3:=p+strlen(p)-1;
  754. p3^:=#0;
  755. end;
  756. if assigned(p) then
  757. p2:=strpos(p,'=')
  758. else
  759. p2:=nil;
  760. if assigned(p2) then
  761. p:=p2+1;
  762. while p^ in [' ',TAB] do
  763. inc(p);
  764. { get rid of type }
  765. if p^ = '(' then
  766. p:=strpos(p,')')+1;
  767. while p^ in [' ',TAB] do
  768. inc(p);
  769. if assigned(p) then
  770. GetValue:=StrNew(p)
  771. else
  772. GetValue:=StrNew(GetError);
  773. if assigned(p3) then
  774. p3^:=#10;
  775. got_error:=false;
  776. end;
  777. function TDebugController.GetFramePointer : CORE_ADDR;
  778. var
  779. st : string;
  780. p : longint;
  781. begin
  782. {$ifdef FrameNameKnown}
  783. Command('p /d '+FrameName);
  784. st:=strpas(GetOutput);
  785. p:=pos('=',st);
  786. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  787. inc(p);
  788. Delete(st,1,p);
  789. p:=1;
  790. while (st[p] in ['0'..'9']) do
  791. inc(p);
  792. Delete(st,p,High(st));
  793. GetFramePointer:=StrToInt(st);
  794. {$else not FrameNameKnown}
  795. GetFramePointer:=0;
  796. {$endif not FrameNameKnown}
  797. end;
  798. function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
  799. var
  800. st : string;
  801. p : longint;
  802. begin
  803. Command('x /wd 0x'+hexstr(addr,8));
  804. st:=strpas(GetOutput);
  805. p:=pos(':',st);
  806. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  807. inc(p);
  808. Delete(st,1,p);
  809. p:=1;
  810. while (st[p] in ['0'..'9']) do
  811. inc(p);
  812. Delete(st,p,High(st));
  813. GetLongintAt:=StrToInt(st);
  814. end;
  815. function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
  816. var
  817. val : CORE_ADDR;
  818. st : string;
  819. p : longint;
  820. begin
  821. Command('x /wx 0x'+hexstr(addr,8));
  822. st:=strpas(GetOutput);
  823. p:=pos(':',st);
  824. while (p<length(st)) and (st[p+1] in [' ',#9]) do
  825. inc(p);
  826. if (p<length(st)) and (st[p+1]='$') then
  827. inc(p);
  828. Delete(st,1,p);
  829. p:=1;
  830. while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
  831. inc(p);
  832. Delete(st,p,High(st));
  833. GetPointerAt:=HexToInt(st);
  834. end;
  835. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  836. var
  837. W: PSourceWindow;
  838. Found : boolean;
  839. PB : PBreakpoint;
  840. S : String;
  841. BreakIndex : longint;
  842. ebp,stop_addr : CORE_ADDR;
  843. i,ExitCode : longint;
  844. ExitAddr,ExitFrame : CORE_ADDR;
  845. const
  846. FirstArgOffset = 2 * sizeof(CORE_ADDR);
  847. SecondArgOffset = 3 * sizeof(CORE_ADDR);
  848. ThirdArgOffset = 4 * sizeof(CORE_ADDR);
  849. begin
  850. BreakIndex:=stop_breakpoint_number;
  851. Desktop^.Lock;
  852. { 0 based line count in Editor }
  853. if Line>0 then
  854. dec(Line);
  855. S:=fn;
  856. stop_addr:=current_pc;
  857. if (BreakIndex=FPCBreakErrorNumber) then
  858. begin
  859. { Procedure HandleErrorAddrFrame
  860. (Errno : longint;addr,frame : longint);
  861. [public,alias:'FPC_BREAK_ERROR']; }
  862. {$ifdef FrameNameKnown}
  863. ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
  864. ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
  865. ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
  866. { forget all old frames }
  867. clear_frames;
  868. { record new frames }
  869. Command('backtrace');
  870. for i:=0 to frame_count-1 do
  871. begin
  872. with frames[i]^ do
  873. begin
  874. if ExitAddr=address then
  875. begin
  876. Command('f '+IntToStr(i));
  877. if assigned(file_name) then
  878. begin
  879. s:=strpas(file_name);
  880. line:=line_number;
  881. stop_addr:=address;
  882. end;
  883. break;
  884. end;
  885. end;
  886. end;
  887. {$endif FrameNameKnown}
  888. end;
  889. { Update Disassembly position }
  890. if Assigned(DisassemblyWindow) then
  891. DisassemblyWindow^.SetCurAddress(stop_addr);
  892. if (fn=LastFileName) then
  893. begin
  894. W:=PSourceWindow(LastSource);
  895. if assigned(W) then
  896. begin
  897. W^.Editor^.SetCurPtr(0,Line);
  898. W^.Editor^.TrackCursor(CenterDebuggerRow);
  899. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  900. UpdateDebugViews;
  901. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  902. handled by SelectInDebugSession}
  903. W^.SelectInDebugSession;
  904. InvalidSourceLine:=false;
  905. end
  906. else
  907. InvalidSourceLine:=true;
  908. end
  909. else
  910. begin
  911. if s='' then
  912. W:=nil
  913. else
  914. W:=TryToOpenFile(nil,s,0,Line,false);
  915. if assigned(W) then
  916. begin
  917. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  918. W^.Editor^.TrackCursor(CenterDebuggerRow);
  919. UpdateDebugViews;
  920. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  921. handled by SelectInDebugSession}
  922. W^.SelectInDebugSession;
  923. LastSource:=W;
  924. InvalidSourceLine:=false;
  925. end
  926. { only search a file once }
  927. else
  928. begin
  929. Desktop^.UnLock;
  930. if s='' then
  931. Found:=false
  932. else
  933. { it is easier to handle with a * at the end }
  934. Found:=IDEApp.OpenSearch(s+'*');
  935. Desktop^.Lock;
  936. if not Found then
  937. begin
  938. InvalidSourceLine:=true;
  939. LastSource:=Nil;
  940. { Show the stack in that case }
  941. InitStackWindow;
  942. UpdateDebugViews;
  943. StackWindow^.MakeFirst;
  944. end
  945. else
  946. begin
  947. { should now be open }
  948. W:=TryToOpenFile(nil,s,0,Line,true);
  949. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
  950. W^.Editor^.TrackCursor(CenterDebuggerRow);
  951. UpdateDebugViews;
  952. {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  953. handled by SelectInDebugSession}
  954. W^.SelectInDebugSession;
  955. LastSource:=W;
  956. InvalidSourceLine:=false;
  957. end;
  958. end;
  959. end;
  960. LastFileName:=s;
  961. Desktop^.UnLock;
  962. if BreakIndex>0 then
  963. begin
  964. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  965. if (BreakIndex=FPCBreakErrorNumber) then
  966. begin
  967. if (ExitCode<>0) or (ExitAddr<>0) then
  968. WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
  969. #3'Error address $'+IntToHex(ExitAddr,8),nil)
  970. else
  971. WarningBox(#3'Run Time Error',nil);
  972. end
  973. else if not assigned(PB) then
  974. begin
  975. WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
  976. end
  977. { For watch we should get old and new value !! }
  978. else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  979. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
  980. (PB^.typ<>bt_address) then
  981. begin
  982. Command('p '+GetStr(PB^.Name));
  983. S:=GetPChar(GetOutput);
  984. got_error:=false;
  985. If Pos('=',S)>0 then
  986. S:=Copy(S,Pos('=',S)+1,255);
  987. If S[Length(S)]=#10 then
  988. Delete(S,Length(S),1);
  989. if Assigned(PB^.OldValue) then
  990. DisposeStr(PB^.OldValue);
  991. PB^.OldValue:=PB^.CurrentValue;
  992. PB^.CurrentValue:=NewStr(S);
  993. If PB^.typ=bt_function then
  994. WarningBox(#3'GDB stopped due to'#13+
  995. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  996. else if (GetStr(PB^.OldValue)<>S) then
  997. WarningBox(#3'GDB stopped due to'#13+
  998. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  999. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1000. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1001. else
  1002. WarningBox(#3'GDB stopped due to'#13+
  1003. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1004. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1005. end;
  1006. end;
  1007. end;
  1008. procedure TDebugController.DoEndSession(code:longint);
  1009. var P :Array[1..2] of longint;
  1010. begin
  1011. IDEApp.SetCmdState([cmResetDebugger],false);
  1012. ResetDebuggerRows;
  1013. LastExitCode:=Code;
  1014. If HiddenStepsCount=0 then
  1015. InformationBox(msg_programexitedwithexitcode,@code)
  1016. else
  1017. begin
  1018. P[1]:=code;
  1019. P[2]:=HiddenStepsCount;
  1020. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1021. end;
  1022. { In case we have something that the compiler touched }
  1023. AskToReloadAllModifiedFiles;
  1024. end;
  1025. procedure TDebugController.DoDebuggerScreen;
  1026. begin
  1027. if NoSwitch then
  1028. begin
  1029. PopStatus;
  1030. end
  1031. else
  1032. begin
  1033. IDEApp.ShowIDEScreen;
  1034. Message(Application,evBroadcast,cmDebuggerStopped,pointer(RunCount));
  1035. PopStatus;
  1036. end;
  1037. {$ifdef win32}
  1038. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1039. {$endif win32}
  1040. end;
  1041. procedure TDebugController.DoUserScreen;
  1042. begin
  1043. Inc(RunCount);
  1044. if NoSwitch then
  1045. begin
  1046. {$ifdef Unix}
  1047. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1048. {$else not Unix}
  1049. PushStatus(msg_runninginanotherwindow);
  1050. {$endif Unix}
  1051. end
  1052. else
  1053. begin
  1054. PushStatus(msg_runningprogram);
  1055. IDEApp.ShowUserScreen;
  1056. end;
  1057. {$ifdef win32}
  1058. ChangeDebuggeeWindowTitleTo(Running_State);
  1059. {$endif win32}
  1060. end;
  1061. {****************************************************************************
  1062. TBreakpoint
  1063. ****************************************************************************}
  1064. constructor TBreakpoint.Init_function(Const AFunc : String);
  1065. begin
  1066. typ:=bt_function;
  1067. state:=bs_enabled;
  1068. GDBState:=bs_deleted;
  1069. Name:=NewStr(AFunc);
  1070. FileName:=nil;
  1071. Line:=0;
  1072. IgnoreCount:=0;
  1073. Commands:=nil;
  1074. Conditions:=nil;
  1075. OldValue:=nil;
  1076. CurrentValue:=nil;
  1077. end;
  1078. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1079. begin
  1080. typ:=bt_address;
  1081. state:=bs_enabled;
  1082. GDBState:=bs_deleted;
  1083. Name:=NewStr(AAddress);
  1084. FileName:=nil;
  1085. Line:=0;
  1086. IgnoreCount:=0;
  1087. Commands:=nil;
  1088. Conditions:=nil;
  1089. OldValue:=nil;
  1090. CurrentValue:=nil;
  1091. end;
  1092. constructor TBreakpoint.Init_Empty;
  1093. begin
  1094. typ:=bt_function;
  1095. state:=bs_enabled;
  1096. GDBState:=bs_deleted;
  1097. Name:=Nil;
  1098. FileName:=nil;
  1099. Line:=0;
  1100. IgnoreCount:=0;
  1101. Commands:=nil;
  1102. Conditions:=nil;
  1103. OldValue:=nil;
  1104. CurrentValue:=nil;
  1105. end;
  1106. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1107. begin
  1108. typ:=atyp;
  1109. state:=bs_enabled;
  1110. GDBState:=bs_deleted;
  1111. Name:=NewStr(AnExpr);
  1112. IgnoreCount:=0;
  1113. Commands:=nil;
  1114. Conditions:=nil;
  1115. OldValue:=nil;
  1116. CurrentValue:=nil;
  1117. end;
  1118. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1119. begin
  1120. typ:=bt_file_line;
  1121. state:=bs_enabled;
  1122. GDBState:=bs_deleted;
  1123. { d:test.pas:12 does not work !! }
  1124. { I do not know how to solve this if
  1125. if (Length(AFile)>1) and (AFile[2]=':') then
  1126. AFile:=Copy(AFile,3,255); }
  1127. FileName:=NewStr(GDBFileName(AFile));
  1128. Name:=nil;
  1129. Line:=ALine;
  1130. IgnoreCount:=0;
  1131. Commands:=nil;
  1132. Conditions:=nil;
  1133. OldValue:=nil;
  1134. CurrentValue:=nil;
  1135. end;
  1136. constructor TBreakpoint.Load(var S: TStream);
  1137. var
  1138. FName : PString;
  1139. begin
  1140. S.Read(typ,SizeOf(BreakpointType));
  1141. S.Read(state,SizeOf(BreakpointState));
  1142. GDBState:=bs_deleted;
  1143. case typ of
  1144. bt_file_line :
  1145. begin
  1146. { convert to current target }
  1147. FName:=S.ReadStr;
  1148. FileName:=NewStr(GDBFileName(GetStr(FName)));
  1149. If Assigned(FName) then
  1150. DisposeStr(FName);
  1151. S.Read(Line,SizeOf(Line));
  1152. Name:=nil;
  1153. end;
  1154. else
  1155. begin
  1156. Name:=S.ReadStr;
  1157. Line:=0;
  1158. FileName:=nil;
  1159. end;
  1160. end;
  1161. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1162. Commands:=S.StrRead;
  1163. Conditions:=S.ReadStr;
  1164. OldValue:=nil;
  1165. CurrentValue:=nil;
  1166. end;
  1167. procedure TBreakpoint.Store(var S: TStream);
  1168. begin
  1169. S.Write(typ,SizeOf(BreakpointType));
  1170. S.Write(state,SizeOf(BreakpointState));
  1171. case typ of
  1172. bt_file_line :
  1173. begin
  1174. S.WriteStr(FileName);
  1175. S.Write(Line,SizeOf(Line));
  1176. end;
  1177. else
  1178. begin
  1179. S.WriteStr(Name);
  1180. end;
  1181. end;
  1182. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1183. S.StrWrite(Commands);
  1184. S.WriteStr(Conditions);
  1185. end;
  1186. procedure TBreakpoint.Insert;
  1187. var
  1188. p,p2 : pchar;
  1189. st : string;
  1190. begin
  1191. If not assigned(Debugger) then Exit;
  1192. Remove;
  1193. Debugger^.last_breakpoint_number:=0;
  1194. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1195. begin
  1196. if (typ=bt_file_line) and assigned(FileName) then
  1197. Debugger^.Command('break '+NameAndExtOf(FileName^)+':'+IntToStr(Line))
  1198. else if (typ=bt_function) and assigned(name) then
  1199. Debugger^.Command('break '+name^)
  1200. else if (typ=bt_address) and assigned(name) then
  1201. Debugger^.Command('break *0x'+name^)
  1202. else if (typ=bt_watch) and assigned(name) then
  1203. Debugger^.Command('watch '+name^)
  1204. else if (typ=bt_awatch) and assigned(name) then
  1205. Debugger^.Command('awatch '+name^)
  1206. else if (typ=bt_rwatch) and assigned(name) then
  1207. Debugger^.Command('rwatch '+name^);
  1208. if Debugger^.last_breakpoint_number<>0 then
  1209. begin
  1210. GDBIndex:=Debugger^.last_breakpoint_number;
  1211. GDBState:=bs_enabled;
  1212. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  1213. If IgnoreCount>0 then
  1214. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  1215. If Assigned(Commands) then
  1216. begin
  1217. {Commands are not handled yet }
  1218. Debugger^.Command('command '+IntToStr(GDBIndex));
  1219. p:=commands;
  1220. while assigned(p) do
  1221. begin
  1222. p2:=strscan(p,#10);
  1223. if assigned(p2) then
  1224. p2^:=#0;
  1225. st:=strpas(p);
  1226. Debugger^.command(st);
  1227. if assigned(p2) then
  1228. p2^:=#10;
  1229. p:=p2;
  1230. if assigned(p) then
  1231. inc(p);
  1232. end;
  1233. Debugger^.Command('end');
  1234. end;
  1235. end
  1236. else
  1237. { Here there was a problem !! }
  1238. begin
  1239. GDBIndex:=0;
  1240. if (typ=bt_file_line) and assigned(FileName) then
  1241. begin
  1242. ClearFormatParams;
  1243. AddFormatParamStr(NameAndExtOf(FileName^));
  1244. AddFormatParamInt(Line);
  1245. ErrorBox(msg_couldnotsetbreakpointat,@FormatParams);
  1246. end
  1247. else
  1248. begin
  1249. ClearFormatParams;
  1250. AddFormatParamStr(BreakpointTypeStr[typ]);
  1251. AddFormatParamStr(GetStr(Name));
  1252. ErrorBox(msg_couldnotsetbreakpointtype,@FormatParams);
  1253. end;
  1254. state:=bs_disabled;
  1255. end;
  1256. end
  1257. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1258. Enable
  1259. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1260. Disable;
  1261. end;
  1262. procedure TBreakpoint.Remove;
  1263. begin
  1264. If not assigned(Debugger) then Exit;
  1265. if GDBIndex>0 then
  1266. Debugger^.Command('delete '+IntToStr(GDBIndex));
  1267. GDBIndex:=0;
  1268. GDBState:=bs_deleted;
  1269. end;
  1270. procedure TBreakpoint.Enable;
  1271. begin
  1272. If not assigned(Debugger) then Exit;
  1273. if GDBIndex>0 then
  1274. Debugger^.Command('enable '+IntToStr(GDBIndex))
  1275. else
  1276. Insert;
  1277. GDBState:=bs_enabled;
  1278. end;
  1279. procedure TBreakpoint.Disable;
  1280. begin
  1281. If not assigned(Debugger) then Exit;
  1282. if GDBIndex>0 then
  1283. Debugger^.Command('disable '+IntToStr(GDBIndex));
  1284. GDBState:=bs_disabled;
  1285. end;
  1286. procedure TBreakpoint.ResetValues;
  1287. begin
  1288. if assigned(OldValue) then
  1289. DisposeStr(OldValue);
  1290. OldValue:=nil;
  1291. if assigned(CurrentValue) then
  1292. DisposeStr(CurrentValue);
  1293. CurrentValue:=nil;
  1294. end;
  1295. procedure TBreakpoint.UpdateSource;
  1296. var W: PSourceWindow;
  1297. b : boolean;
  1298. begin
  1299. if typ=bt_file_line then
  1300. begin
  1301. W:=SearchOnDesktop(GetStr(FileName),false);
  1302. If assigned(W) then
  1303. begin
  1304. if state=bs_enabled then
  1305. b:=true
  1306. else
  1307. b:=false;
  1308. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1309. end;
  1310. end;
  1311. end;
  1312. destructor TBreakpoint.Done;
  1313. begin
  1314. Remove;
  1315. ResetValues;
  1316. if assigned(Name) then
  1317. DisposeStr(Name);
  1318. if assigned(FileName) then
  1319. DisposeStr(FileName);
  1320. if assigned(Conditions) then
  1321. DisposeStr(Conditions);
  1322. if assigned(Commands) then
  1323. StrDispose(Commands);
  1324. inherited Done;
  1325. end;
  1326. {****************************************************************************
  1327. TBreakpointCollection
  1328. ****************************************************************************}
  1329. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1330. begin
  1331. At:=inherited At(Index);
  1332. end;
  1333. procedure TBreakpointCollection.Update;
  1334. begin
  1335. if assigned(Debugger) then
  1336. begin
  1337. Debugger^.RemoveBreakpoints;
  1338. Debugger^.InsertBreakpoints;
  1339. end;
  1340. if assigned(BreakpointsWindow) then
  1341. BreakpointsWindow^.Update;
  1342. end;
  1343. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1344. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1345. begin
  1346. IsNum:=P^.GDBIndex=index;
  1347. end;
  1348. begin
  1349. if index=0 then
  1350. GetGDB:=nil
  1351. else
  1352. GetGDB:=FirstThat(@IsNum);
  1353. end;
  1354. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1355. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1356. begin
  1357. If assigned(P^.FileName) and
  1358. (GDBFileName(FExpand(P^.FileName^))=GDBFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1359. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1360. end;
  1361. procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1362. var
  1363. PDL : PDisasLine;
  1364. S : string;
  1365. ps,qs,i : longint;
  1366. begin
  1367. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1368. begin
  1369. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1370. if PDL^.Address=0 then
  1371. begin
  1372. if (P^.typ=bt_file_line) then
  1373. begin
  1374. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1375. ps:=pos(':',S);
  1376. qs:=pos(' ',copy(S,ps+1,High(S)));
  1377. if (GDBFileName(FExpand(P^.FileName^))=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1378. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1379. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1380. end;
  1381. end
  1382. else
  1383. begin
  1384. If (P^.typ=bt_address) and (PDL^.Address=HexToInt(P^.Name^)) then
  1385. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1386. end;
  1387. end;
  1388. end;
  1389. begin
  1390. if W=PFPWindow(DisassemblyWindow) then
  1391. ForEach(@SetInDisassembly)
  1392. else
  1393. ForEach(@SetInSource);
  1394. end;
  1395. procedure TBreakpointCollection.ShowAllBreakpoints;
  1396. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  1397. var
  1398. W : PSourceWindow;
  1399. begin
  1400. If assigned(P^.FileName) then
  1401. begin
  1402. W:=SearchOnDesktop(P^.FileName^,false);
  1403. if assigned(W) then
  1404. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1405. end;
  1406. end;
  1407. begin
  1408. ForEach(@SetInSource);
  1409. end;
  1410. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1411. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1412. begin
  1413. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1414. end;
  1415. begin
  1416. GetType:=FirstThat(@IsThis);
  1417. end;
  1418. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1419. var PB : PBreakpoint;
  1420. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  1421. begin
  1422. IsThere:=(P^.typ=bt_file_line) and (P^.FileName^=FileName) and (P^.Line=LineNr);
  1423. end;
  1424. begin
  1425. FileName:=GDBFileName(FileName);
  1426. PB:=FirstThat(@IsThere);
  1427. ToggleFileLine:=false;
  1428. If Assigned(PB) then
  1429. if PB^.state=bs_disabled then
  1430. begin
  1431. PB^.state:=bs_enabled;
  1432. ToggleFileLine:=true;
  1433. end
  1434. else if PB^.state=bs_enabled then
  1435. PB^.state:=bs_disabled;
  1436. If not assigned(PB) then
  1437. begin
  1438. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1439. if assigned(PB) then
  1440. Begin
  1441. Insert(PB);
  1442. ToggleFileLine:=true;
  1443. End;
  1444. end;
  1445. if assigned(PB) then
  1446. PB^.UpdateSource;
  1447. Update;
  1448. end;
  1449. {****************************************************************************
  1450. TBreakpointItem
  1451. ****************************************************************************}
  1452. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1453. begin
  1454. inherited Init;
  1455. Breakpoint:=ABreakpoint;
  1456. end;
  1457. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1458. var S: string;
  1459. begin
  1460. with Breakpoint^ do
  1461. begin
  1462. S:=BreakpointTypeStr[typ];
  1463. While Length(S)<10 do
  1464. S:=S+' ';
  1465. S:=S+'|';
  1466. S:=S+BreakpointStateStr[state]+' ';
  1467. While Length(S)<20 do
  1468. S:=S+' ';
  1469. S:=S+'|';
  1470. if (typ=bt_file_line) then
  1471. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
  1472. else
  1473. S:=S+GetStr(name);
  1474. While Length(S)<40 do
  1475. S:=S+' ';
  1476. S:=S+'|';
  1477. if IgnoreCount>0 then
  1478. S:=S+IntToStr(IgnoreCount);
  1479. While Length(S)<49 do
  1480. S:=S+' ';
  1481. S:=S+'|';
  1482. if assigned(Conditions) then
  1483. S:=S+' '+GetStr(Conditions);
  1484. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1485. GetText:=S;
  1486. end;
  1487. end;
  1488. procedure TBreakpointItem.Selected;
  1489. begin
  1490. end;
  1491. function TBreakpointItem.GetModuleName: string;
  1492. begin
  1493. if breakpoint^.typ=bt_file_line then
  1494. GetModuleName:=GetStr(breakpoint^.FileName)
  1495. else
  1496. GetModuleName:='';
  1497. end;
  1498. {****************************************************************************
  1499. TBreakpointsListBox
  1500. ****************************************************************************}
  1501. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1502. begin
  1503. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1504. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1505. NoSelection:=true;
  1506. end;
  1507. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1508. var M: PMenu;
  1509. begin
  1510. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1511. M:=NewMenu(
  1512. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1513. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1514. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1515. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1516. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1517. nil))))));
  1518. GetLocalMenu:=M;
  1519. end;
  1520. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1521. var DontClear: boolean;
  1522. begin
  1523. case Event.What of
  1524. evKeyDown :
  1525. begin
  1526. DontClear:=false;
  1527. case Event.KeyCode of
  1528. kbEnter :
  1529. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1530. kbIns :
  1531. Message(@Self,evCommand,cmNewBreakpoint,nil);
  1532. kbDel :
  1533. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  1534. else
  1535. DontClear:=true;
  1536. end;
  1537. if not DontClear then
  1538. ClearEvent(Event);
  1539. end;
  1540. evBroadcast :
  1541. case Event.Command of
  1542. cmListItemSelected :
  1543. if Event.InfoPtr=@Self then
  1544. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1545. end;
  1546. evCommand :
  1547. begin
  1548. DontClear:=false;
  1549. case Event.Command of
  1550. cmMsgTrackSource :
  1551. if Range>0 then
  1552. TrackSource;
  1553. cmEditBreakpoint :
  1554. EditCurrent;
  1555. cmToggleBreakpoint :
  1556. ToggleCurrent;
  1557. cmDeleteBreakpoint :
  1558. DeleteCurrent;
  1559. cmNewBreakpoint :
  1560. EditNew;
  1561. cmMsgClear :
  1562. Clear;
  1563. else
  1564. DontClear:=true;
  1565. end;
  1566. if not DontClear then
  1567. ClearEvent(Event);
  1568. end;
  1569. end;
  1570. inherited HandleEvent(Event);
  1571. end;
  1572. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1573. var W : integer;
  1574. begin
  1575. if List=nil then New(List, Init(20,20));
  1576. W:=length(P^.GetText(255));
  1577. if W>MaxWidth then
  1578. begin
  1579. MaxWidth:=W;
  1580. if HScrollBar<>nil then
  1581. HScrollBar^.SetRange(0,MaxWidth);
  1582. end;
  1583. List^.Insert(P);
  1584. SetRange(List^.Count);
  1585. if Focused=List^.Count-1-1 then
  1586. FocusItem(List^.Count-1);
  1587. P^.Breakpoint^.UpdateSource;
  1588. DrawView;
  1589. end;
  1590. (* function TBreakpointsListBox.AddModuleName(const Name: string): PString;
  1591. var P: PString;
  1592. begin
  1593. if ModuleNames<>nil then
  1594. P:=ModuleNames^.Add(Name)
  1595. else
  1596. P:=nil;
  1597. AddModuleName:=P;
  1598. end; *)
  1599. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1600. var P: PBreakpointItem;
  1601. S: string;
  1602. begin
  1603. P:=List^.At(Item);
  1604. S:=P^.GetText(MaxLen);
  1605. GetText:=copy(S,1,MaxLen);
  1606. end;
  1607. procedure TBreakpointsListBox.Clear;
  1608. begin
  1609. if assigned(List) then
  1610. Dispose(List, Done);
  1611. List:=nil;
  1612. MaxWidth:=0;
  1613. (* if assigned(ModuleNames) then
  1614. ModuleNames^.FreeAll; *)
  1615. SetRange(0); DrawView;
  1616. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1617. end;
  1618. procedure TBreakpointsListBox.TrackSource;
  1619. var W: PSourceWindow;
  1620. P: PBreakpointItem;
  1621. R: TRect;
  1622. (* Row,Col: sw_integer; *)
  1623. begin
  1624. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1625. if Range=0 then Exit;*)
  1626. P:=List^.At(Focused);
  1627. if P^.GetModuleName='' then Exit;
  1628. Desktop^.Lock;
  1629. GetNextEditorBounds(R);
  1630. R.B.Y:=Owner^.Origin.Y;
  1631. W:=EditorWindowFile(P^.GetModuleName);
  1632. if assigned(W) then
  1633. begin
  1634. W^.GetExtent(R);
  1635. R.B.Y:=Owner^.Origin.Y;
  1636. W^.ChangeBounds(R);
  1637. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1638. end
  1639. else
  1640. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1641. if W<>nil then
  1642. begin
  1643. W^.Select;
  1644. W^.Editor^.TrackCursor(true);
  1645. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  1646. end;
  1647. if Assigned(Owner) then
  1648. Owner^.Select;
  1649. Desktop^.UnLock;
  1650. end;
  1651. procedure TBreakpointsListBox.ToggleCurrent;
  1652. var
  1653. P: PBreakpointItem;
  1654. begin
  1655. if Range=0 then Exit;
  1656. P:=List^.At(Focused);
  1657. if P=nil then Exit;
  1658. if P^.Breakpoint^.state=bs_enabled then
  1659. P^.Breakpoint^.state:=bs_disabled
  1660. else if P^.Breakpoint^.state=bs_disabled then
  1661. P^.Breakpoint^.state:=bs_enabled;
  1662. P^.Breakpoint^.UpdateSource;
  1663. BreakpointsCollection^.Update;
  1664. end;
  1665. procedure TBreakpointsListBox.EditCurrent;
  1666. var
  1667. P: PBreakpointItem;
  1668. begin
  1669. if Range=0 then Exit;
  1670. P:=List^.At(Focused);
  1671. if P=nil then Exit;
  1672. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  1673. P^.Breakpoint^.UpdateSource;
  1674. BreakpointsCollection^.Update;
  1675. end;
  1676. procedure TBreakpointsListBox.DeleteCurrent;
  1677. var
  1678. P: PBreakpointItem;
  1679. begin
  1680. if Range=0 then Exit;
  1681. P:=List^.At(Focused);
  1682. if P=nil then Exit;
  1683. { delete it form source window }
  1684. P^.Breakpoint^.state:=bs_disabled;
  1685. P^.Breakpoint^.UpdateSource;
  1686. BreakpointsCollection^.free(P^.Breakpoint);
  1687. List^.free(P);
  1688. BreakpointsCollection^.Update;
  1689. end;
  1690. procedure TBreakpointsListBox.EditNew;
  1691. var
  1692. P: PBreakpoint;
  1693. begin
  1694. P:=New(PBreakpoint,Init_Empty);
  1695. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  1696. begin
  1697. P^.UpdateSource;
  1698. BreakpointsCollection^.Insert(P);
  1699. BreakpointsCollection^.Update;
  1700. end
  1701. else
  1702. dispose(P,Done);
  1703. end;
  1704. procedure TBreakpointsListBox.Draw;
  1705. var
  1706. I, J, Item: Sw_Integer;
  1707. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1708. ColWidth, CurCol, Indent: Integer;
  1709. B: TDrawBuffer;
  1710. Text: String;
  1711. SCOff: Byte;
  1712. TC: byte;
  1713. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1714. begin
  1715. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1716. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1717. begin
  1718. NormalColor := GetColor(1);
  1719. FocusedColor := GetColor(3);
  1720. SelectedColor := GetColor(4);
  1721. end else
  1722. begin
  1723. NormalColor := GetColor(2);
  1724. SelectedColor := GetColor(4);
  1725. end;
  1726. if Transparent then
  1727. begin MT(NormalColor); MT(SelectedColor); end;
  1728. if NoSelection then
  1729. SelectedColor:=NormalColor;
  1730. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1731. else Indent := 0;
  1732. ColWidth := Size.X div NumCols + 1;
  1733. for I := 0 to Size.Y - 1 do
  1734. begin
  1735. for J := 0 to NumCols-1 do
  1736. begin
  1737. Item := J*Size.Y + I + TopItem;
  1738. CurCol := J*ColWidth;
  1739. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1740. (Focused = Item) and (Range > 0) then
  1741. begin
  1742. Color := FocusedColor;
  1743. SetCursor(CurCol+1,I);
  1744. SCOff := 0;
  1745. end
  1746. else if (Item < Range) and IsSelected(Item) then
  1747. begin
  1748. Color := SelectedColor;
  1749. SCOff := 2;
  1750. end
  1751. else
  1752. begin
  1753. Color := NormalColor;
  1754. SCOff := 4;
  1755. end;
  1756. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1757. if Item < Range then
  1758. begin
  1759. Text := GetText(Item, ColWidth + Indent);
  1760. Text := Copy(Text,Indent,ColWidth);
  1761. MoveStr(B[CurCol+1], Text, Color);
  1762. if ShowMarkers then
  1763. begin
  1764. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1765. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1766. end;
  1767. end;
  1768. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1769. end;
  1770. WriteLine(0, I, Size.X, 1, B);
  1771. end;
  1772. end;
  1773. constructor TBreakpointsListBox.Load(var S: TStream);
  1774. begin
  1775. inherited Load(S);
  1776. end;
  1777. procedure TBreakpointsListBox.Store(var S: TStream);
  1778. var OL: PCollection;
  1779. OldR : integer;
  1780. begin
  1781. OL:=List;
  1782. OldR:=Range;
  1783. Range:=0;
  1784. New(List, Init(1,1));
  1785. inherited Store(S);
  1786. Dispose(List, Done);
  1787. Range:=OldR;
  1788. List:=OL;
  1789. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1790. collection? Pasting here a modified version of TListBox.Store+
  1791. TAdvancedListBox.Store isn't a better solution, since by eventually
  1792. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1793. end;
  1794. destructor TBreakpointsListBox.Done;
  1795. begin
  1796. inherited Done;
  1797. if List<>nil then Dispose(List, Done);
  1798. (* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
  1799. end;
  1800. {****************************************************************************
  1801. TBreakpointsWindow
  1802. ****************************************************************************}
  1803. constructor TBreakpointsWindow.Init;
  1804. var R,R2: TRect;
  1805. HSB,VSB: PScrollBar;
  1806. ST: PStaticText;
  1807. S: String;
  1808. X,X1 : Sw_integer;
  1809. Btn: PButton;
  1810. begin
  1811. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  1812. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  1813. HelpCtx:=hcBreakpointListWindow;
  1814. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1815. S:=label_breakpointpropheader;
  1816. New(ST, Init(R,S));
  1817. ST^.GrowMode:=gfGrowHiX;
  1818. Insert(ST);
  1819. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  1820. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  1821. ST^.GrowMode:=gfGrowHiX;
  1822. Insert(ST);
  1823. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  1824. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1825. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1826. HSB^.SetStep(R.B.X-R.A.X-2,1);
  1827. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1828. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1829. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  1830. New(BreakLB, Init(R,HSB,VSB));
  1831. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1832. BreakLB^.Transparent:=true;
  1833. Insert(BreakLB);
  1834. GetExtent(R);R.Grow(-1,-1);
  1835. Dec(R.B.Y);
  1836. R.A.Y:=R.B.Y-2;
  1837. X:=(R.B.X-R.A.X) div 4;
  1838. X1:=R.A.X+(X div 2);
  1839. R.A.X:=X1-3;R.B.X:=X1+7;
  1840. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  1841. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1842. Insert(Btn);
  1843. X1:=X1+X;
  1844. R.A.X:=X1-3;R.B.X:=X1+7;
  1845. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  1846. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1847. Insert(Btn);
  1848. X1:=X1+X;
  1849. R.A.X:=X1-3;R.B.X:=X1+7;
  1850. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  1851. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1852. Insert(Btn);
  1853. X1:=X1+X;
  1854. R.A.X:=X1-3;R.B.X:=X1+7;
  1855. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  1856. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1857. Insert(Btn);
  1858. BreakLB^.Select;
  1859. Update;
  1860. BreakpointsWindow:=@self;
  1861. end;
  1862. constructor TBreakpointsWindow.Load(var S: TStream);
  1863. begin
  1864. inherited Load(S);
  1865. GetSubViewPtr(S,BreakLB);
  1866. end;
  1867. procedure TBreakpointsWindow.Store(var S: TStream);
  1868. begin
  1869. inherited Store(S);
  1870. PutSubViewPtr(S,BreakLB);
  1871. end;
  1872. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  1873. begin
  1874. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  1875. end;
  1876. procedure TBreakpointsWindow.ClearBreakpoints;
  1877. begin
  1878. BreakLB^.Clear;
  1879. ReDraw;
  1880. end;
  1881. procedure TBreakpointsWindow.ReloadBreakpoints;
  1882. procedure InsertInBreakLB(P : PBreakpoint);
  1883. begin
  1884. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  1885. end;
  1886. begin
  1887. If not assigned(BreakpointsCollection) then
  1888. exit;
  1889. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  1890. ReDraw;
  1891. end;
  1892. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  1893. begin
  1894. inherited SizeLimits(Min,Max);
  1895. Min.X:=40; Min.Y:=18;
  1896. end;
  1897. procedure TBreakpointsWindow.Close;
  1898. begin
  1899. Hide;
  1900. end;
  1901. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  1902. var DontClear : boolean;
  1903. begin
  1904. case Event.What of
  1905. evKeyDown :
  1906. begin
  1907. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  1908. begin
  1909. ClearEvent(Event);
  1910. Hide;
  1911. end;
  1912. end;
  1913. evCommand :
  1914. begin
  1915. DontClear:=False;
  1916. case Event.Command of
  1917. cmNewBreakpoint :
  1918. BreakLB^.EditNew;
  1919. cmEditBreakpoint :
  1920. BreakLB^.EditCurrent;
  1921. cmDeleteBreakpoint :
  1922. BreakLB^.DeleteCurrent;
  1923. cmClose :
  1924. Hide;
  1925. else
  1926. DontClear:=true;
  1927. end;
  1928. if not DontClear then
  1929. ClearEvent(Event);
  1930. end;
  1931. evBroadcast :
  1932. case Event.Command of
  1933. cmUpdate :
  1934. Update;
  1935. end;
  1936. end;
  1937. inherited HandleEvent(Event);
  1938. end;
  1939. procedure TBreakpointsWindow.Update;
  1940. begin
  1941. ClearBreakpoints;
  1942. ReloadBreakpoints;
  1943. end;
  1944. destructor TBreakpointsWindow.Done;
  1945. begin
  1946. inherited Done;
  1947. BreakpointsWindow:=nil;
  1948. end;
  1949. {****************************************************************************
  1950. TBreakpointItemDialog
  1951. ****************************************************************************}
  1952. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  1953. var R,R2,R3: TRect;
  1954. Items: PSItem;
  1955. I : BreakpointType;
  1956. KeyCount: sw_integer;
  1957. begin
  1958. KeyCount:=longint(high(BreakpointType));
  1959. R.Assign(0,0,60,Max(3+KeyCount,18));
  1960. inherited Init(R,dialog_modifynewbreakpoint);
  1961. Breakpoint:=ABreakpoint;
  1962. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  1963. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  1964. New(NameIL, Init(R, 128)); Insert(NameIL);
  1965. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  1966. R.Move(0,3);
  1967. New(LineIL, Init(R, 128)); Insert(LineIL);
  1968. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1969. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  1970. R.Move(0,3);
  1971. New(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
  1972. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  1973. R.Move(0,3);
  1974. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  1975. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1976. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  1977. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  1978. Items:=nil;
  1979. for I:=high(BreakpointType) downto low(BreakpointType) do
  1980. Items:=NewSItem(BreakpointTypeStr[I], Items);
  1981. New(TypeRB, Init(R, Items));
  1982. Insert(TypeRB);
  1983. InsertButtons(@Self);
  1984. NameIL^.Select;
  1985. end;
  1986. function TBreakpointItemDialog.Execute: Word;
  1987. var R: word;
  1988. S1: string;
  1989. err: word;
  1990. L: longint;
  1991. begin
  1992. R:=longint(Breakpoint^.typ);
  1993. TypeRB^.SetData(R);
  1994. If Breakpoint^.typ=bt_file_line then
  1995. S1:=GetStr(Breakpoint^.FileName)
  1996. else
  1997. S1:=GetStr(Breakpoint^.name);
  1998. NameIL^.SetData(S1);
  1999. If Breakpoint^.typ=bt_file_line then
  2000. S1:=IntToStr(Breakpoint^.Line)
  2001. else
  2002. S1:='0';
  2003. LineIL^.SetData(S1);
  2004. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2005. IgnoreIL^.SetData(S1);
  2006. S1:=GetStr(Breakpoint^.Conditions);
  2007. ConditionsIL^.SetData(S1);
  2008. R:=inherited Execute;
  2009. if R=cmOK then
  2010. begin
  2011. TypeRB^.GetData(R);
  2012. L:=R;
  2013. Breakpoint^.typ:=BreakpointType(L);
  2014. NameIL^.GetData(S1);
  2015. If Breakpoint^.typ=bt_file_line then
  2016. begin
  2017. If assigned(Breakpoint^.FileName) then
  2018. DisposeStr(Breakpoint^.FileName);
  2019. Breakpoint^.FileName:=NewStr(S1);
  2020. end
  2021. else
  2022. begin
  2023. If assigned(Breakpoint^.Name) then
  2024. DisposeStr(Breakpoint^.Name);
  2025. Breakpoint^.name:=NewStr(S1);
  2026. end;
  2027. If Breakpoint^.typ=bt_file_line then
  2028. begin
  2029. LineIL^.GetData(S1);
  2030. Val(S1,L,err);
  2031. Breakpoint^.Line:=L;
  2032. end;
  2033. IgnoreIL^.GetData(S1);
  2034. Val(S1,L,err);
  2035. Breakpoint^.IgnoreCount:=L;
  2036. ConditionsIL^.GetData(S1);
  2037. If assigned(Breakpoint^.Conditions) then
  2038. DisposeStr(Breakpoint^.Conditions);
  2039. Breakpoint^.Conditions:=NewStr(S1);
  2040. end;
  2041. Execute:=R;
  2042. end;
  2043. {****************************************************************************
  2044. TWatch
  2045. ****************************************************************************}
  2046. constructor TWatch.Init(s : string);
  2047. begin
  2048. expr:=NewStr(s);
  2049. last_value:=nil;
  2050. current_value:=nil;
  2051. Get_new_value;
  2052. GDBRunCount:=-1;
  2053. end;
  2054. constructor TWatch.Load(var S: TStream);
  2055. begin
  2056. expr:=S.ReadStr;
  2057. last_value:=nil;
  2058. current_value:=nil;
  2059. Get_new_value;
  2060. GDBRunCount:=-1;
  2061. end;
  2062. procedure TWatch.Store(var S: TStream);
  2063. begin
  2064. S.WriteStr(expr);
  2065. end;
  2066. procedure TWatch.rename(s : string);
  2067. begin
  2068. if assigned(expr) then
  2069. begin
  2070. if GetStr(expr)=S then
  2071. exit;
  2072. DisposeStr(expr);
  2073. end;
  2074. expr:=NewStr(s);
  2075. if assigned(last_value) then
  2076. StrDispose(last_value);
  2077. last_value:=nil;
  2078. if assigned(current_value) then
  2079. StrDispose(current_value);
  2080. current_value:=nil;
  2081. GDBRunCount:=-1;
  2082. Get_new_value;
  2083. end;
  2084. procedure TWatch.Get_new_value;
  2085. var p, q : pchar;
  2086. i, j, curframe, startframe : longint;
  2087. s,s2 : string;
  2088. loop_higher, found : boolean;
  2089. last_removed : char;
  2090. function GetValue(var s : string) : boolean;
  2091. begin
  2092. Debugger^.command('p '+s);
  2093. if not Debugger^.Error then
  2094. begin
  2095. s:=StrPas(Debugger^.GetOutput);
  2096. GetValue:=true;
  2097. end
  2098. else
  2099. begin
  2100. s:=StrPas(Debugger^.GetError);
  2101. GetValue:=false;
  2102. { do not open a messagebox for such errors }
  2103. Debugger^.got_error:=false;
  2104. end;
  2105. end;
  2106. begin
  2107. If not assigned(Debugger) or Not Debugger^.HasExe or
  2108. (GDBRunCount=Debugger^.RunCount) then
  2109. exit;
  2110. GDBRunCount:=Debugger^.RunCount;
  2111. if assigned(last_value) then
  2112. strdispose(last_value);
  2113. last_value:=current_value;
  2114. s:=GetStr(expr);
  2115. found:=GetValue(s);
  2116. Debugger^.got_error:=false;
  2117. loop_higher:=not found;
  2118. if not found then
  2119. begin
  2120. curframe:=Debugger^.get_current_frame;
  2121. startframe:=curframe;
  2122. end
  2123. else
  2124. begin
  2125. curframe:=0;
  2126. startframe:=0;
  2127. end;
  2128. while loop_higher do
  2129. begin
  2130. s:='parent_ebp';
  2131. if GetValue(s) then
  2132. begin
  2133. repeat
  2134. inc(curframe);
  2135. if not Debugger^.set_current_frame(curframe) then
  2136. loop_higher:=false;
  2137. s2:='/x $ebp';
  2138. getValue(s2);
  2139. j:=pos('=',s2);
  2140. if j>0 then
  2141. s2:=copy(s2,j+1,length(s2));
  2142. while s2[1] in [' ',TAB] do
  2143. delete(s2,1,1);
  2144. if pos(s2,s)>0 then
  2145. loop_higher :=false;
  2146. until not loop_higher;
  2147. { try again at that level }
  2148. s:=GetStr(expr);
  2149. found:=GetValue(s);
  2150. loop_higher:=not found;
  2151. end
  2152. else
  2153. loop_higher:=false;
  2154. end;
  2155. if found then
  2156. p:=StrNew(Debugger^.GetOutput)
  2157. else
  2158. begin
  2159. { get a reasonable output at least }
  2160. s:=GetStr(expr);
  2161. GetValue(s);
  2162. p:=StrNew(Debugger^.GetError);
  2163. end;
  2164. Debugger^.got_error:=false;
  2165. { We should try here to find the expr in parent
  2166. procedure if there are
  2167. I will implement this as I added a
  2168. parent_ebp pseudo local var to local procedure
  2169. in stabs debug info PM }
  2170. { But there are some pitfalls like
  2171. locals redefined in other sublocals that call the function }
  2172. if curframe<>startframe then
  2173. Debugger^.set_current_frame(startframe);
  2174. q:=nil;
  2175. if assigned(p) and (p[0]='$') then
  2176. q:=StrPos(p,'=');
  2177. if not assigned(q) then
  2178. q:=p;
  2179. if assigned(q) then
  2180. i:=strlen(q)
  2181. else
  2182. i:=0;
  2183. if (i>0) and (q[i-1]=#10) then
  2184. begin
  2185. while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
  2186. dec(i);
  2187. last_removed:=q[i-1];
  2188. q[i-1]:=#0;
  2189. end
  2190. else
  2191. last_removed:=#0;
  2192. if assigned(q) then
  2193. current_value:=strnew(q)
  2194. else
  2195. current_value:=strnew('');
  2196. if last_removed<>#0 then
  2197. q[i-1]:=last_removed;
  2198. strdispose(p);
  2199. GDBRunCount:=Debugger^.RunCount;
  2200. end;
  2201. destructor TWatch.Done;
  2202. begin
  2203. if assigned(expr) then
  2204. disposestr(expr);
  2205. if assigned(last_value) then
  2206. strdispose(last_value);
  2207. if assigned(current_value) then
  2208. strdispose(current_value);
  2209. inherited done;
  2210. end;
  2211. {****************************************************************************
  2212. TWatchesCollection
  2213. ****************************************************************************}
  2214. constructor TWatchesCollection.Init;
  2215. begin
  2216. inherited Init(10,10);
  2217. end;
  2218. procedure TWatchesCollection.Insert(Item: Pointer);
  2219. begin
  2220. PWatch(Item)^.Get_new_value;
  2221. Inherited Insert(Item);
  2222. Update;
  2223. end;
  2224. procedure TWatchesCollection.Update;
  2225. var
  2226. W,W1 : integer;
  2227. procedure GetMax(P : PWatch);
  2228. begin
  2229. if assigned(P^.Current_value) then
  2230. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2231. else
  2232. W1:=2+Length(GetStr(P^.expr));
  2233. if W1>W then
  2234. W:=W1;
  2235. end;
  2236. begin
  2237. W:=0;
  2238. ForEach(@GetMax);
  2239. MaxW:=W;
  2240. If assigned(WatchesWindow) then
  2241. WatchesWindow^.WLB^.Update(MaxW);
  2242. end;
  2243. function TWatchesCollection.At(Index: Integer): PWatch;
  2244. begin
  2245. At:=Inherited At(Index);
  2246. end;
  2247. {****************************************************************************
  2248. TWatchesListBox
  2249. ****************************************************************************}
  2250. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2251. begin
  2252. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2253. If assigned(List) then
  2254. dispose(list,done);
  2255. List:=WatchesCollection;
  2256. end;
  2257. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2258. var R : TRect;
  2259. begin
  2260. GetExtent(R);
  2261. MaxWidth:=AMaxWidth;
  2262. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2263. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2264. else
  2265. HScrollBar^.SetRange(0,0);
  2266. if R.B.X-R.A.X>MaxWidth then
  2267. HScrollBar^.Hide
  2268. else
  2269. HScrollBar^.Show;
  2270. SetRange(List^.Count+1);
  2271. if R.B.Y-R.A.Y>Range then
  2272. VScrollBar^.Hide
  2273. else
  2274. VScrollBar^.Show;
  2275. {if Focused=List^.Count-1-1 then
  2276. FocusItem(List^.Count-1);
  2277. What was that for ?? PM }
  2278. DrawView;
  2279. end;
  2280. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2281. var
  2282. PW : PWatch;
  2283. ValOffset : Sw_integer;
  2284. S : String;
  2285. begin
  2286. Modified:=false;
  2287. if Item>=WatchesCollection^.Count then
  2288. begin
  2289. GetIndentedText:='';
  2290. exit;
  2291. end;
  2292. PW:=WatchesCollection^.At(Item);
  2293. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2294. if not assigned(PW^.expr) then
  2295. GetIndentedText:=''
  2296. else if Indent<ValOffset then
  2297. begin
  2298. S:=GetStr(PW^.Expr);
  2299. if Indent=0 then
  2300. S:=' '+S
  2301. else
  2302. S:=Copy(S,Indent,High(S));
  2303. if not assigned(PW^.current_value) then
  2304. S:=S+' <Unknown value>'
  2305. else
  2306. S:=S+' '+GetPChar(PW^.Current_value);
  2307. GetIndentedText:=Copy(S,1,MaxLen);
  2308. end
  2309. else
  2310. begin
  2311. if not assigned(PW^.Current_value) or
  2312. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2313. S:=''
  2314. else
  2315. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2316. GetIndentedText:=Copy(S,1,MaxLen);
  2317. end;
  2318. if assigned(PW^.current_value) and
  2319. assigned(PW^.last_value) and
  2320. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2321. Modified:=true;
  2322. end;
  2323. procedure TWatchesListBox.EditCurrent;
  2324. var
  2325. P: PWatch;
  2326. begin
  2327. if Range=0 then Exit;
  2328. if Focused<WatchesCollection^.Count then
  2329. P:=WatchesCollection^.At(Focused)
  2330. else
  2331. P:=New(PWatch,Init(''));
  2332. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2333. WatchesCollection^.Update;
  2334. end;
  2335. procedure TWatchesListBox.DeleteCurrent;
  2336. var
  2337. P: PWatch;
  2338. begin
  2339. if (Range=0) or
  2340. (Focused>=WatchesCollection^.Count) then
  2341. exit;
  2342. P:=WatchesCollection^.At(Focused);
  2343. WatchesCollection^.free(P);
  2344. WatchesCollection^.Update;
  2345. end;
  2346. procedure TWatchesListBox.EditNew;
  2347. var
  2348. P: PWatch;
  2349. S : string;
  2350. begin
  2351. if Focused<WatchesCollection^.Count then
  2352. begin
  2353. P:=WatchesCollection^.At(Focused);
  2354. S:=GetStr(P^.expr);
  2355. end
  2356. else
  2357. S:='';
  2358. P:=New(PWatch,Init(S));
  2359. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2360. begin
  2361. WatchesCollection^.AtInsert(Focused,P);
  2362. WatchesCollection^.Update;
  2363. end
  2364. else
  2365. dispose(P,Done);
  2366. end;
  2367. procedure TWatchesListBox.Draw;
  2368. var
  2369. I, J, Item: Sw_Integer;
  2370. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2371. ColWidth, CurCol, Indent: Integer;
  2372. B: TDrawBuffer;
  2373. Modified : boolean;
  2374. Text: String;
  2375. SCOff: Byte;
  2376. TC: byte;
  2377. procedure MT(var C: word);
  2378. begin
  2379. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2380. end;
  2381. begin
  2382. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2383. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2384. begin
  2385. NormalColor := GetColor(1);
  2386. FocusedColor := GetColor(3);
  2387. SelectedColor := GetColor(4);
  2388. end else
  2389. begin
  2390. NormalColor := GetColor(2);
  2391. SelectedColor := GetColor(4);
  2392. end;
  2393. if Transparent then
  2394. begin MT(NormalColor); MT(SelectedColor); end;
  2395. (* if NoSelection then
  2396. SelectedColor:=NormalColor;*)
  2397. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2398. else Indent := 0;
  2399. ColWidth := Size.X div NumCols + 1;
  2400. for I := 0 to Size.Y - 1 do
  2401. begin
  2402. for J := 0 to NumCols-1 do
  2403. begin
  2404. Item := J*Size.Y + I + TopItem;
  2405. CurCol := J*ColWidth;
  2406. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2407. (Focused = Item) and (Range > 0) then
  2408. begin
  2409. Color := FocusedColor;
  2410. SetCursor(CurCol+1,I);
  2411. SCOff := 0;
  2412. end
  2413. else if (Item < Range) and IsSelected(Item) then
  2414. begin
  2415. Color := SelectedColor;
  2416. SCOff := 2;
  2417. end
  2418. else
  2419. begin
  2420. Color := NormalColor;
  2421. SCOff := 4;
  2422. end;
  2423. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2424. if Item < Range then
  2425. begin
  2426. (* Text := GetText(Item, ColWidth + Indent);
  2427. Text := Copy(Text,Indent,ColWidth); *)
  2428. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2429. if modified then
  2430. begin
  2431. SCOff:=0;
  2432. Color:=(Color and $fff0) or Red;
  2433. end;
  2434. MoveStr(B[CurCol], Text, Color);
  2435. if {ShowMarkers or } Modified then
  2436. begin
  2437. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2438. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2439. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2440. end;
  2441. end;
  2442. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2443. end;
  2444. WriteLine(0, I, Size.X, 1, B);
  2445. end;
  2446. end;
  2447. function TWatchesListBox.GetLocalMenu: PMenu;
  2448. var M: PMenu;
  2449. begin
  2450. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2451. M:=NewMenu(
  2452. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2453. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2454. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2455. NewLine(
  2456. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2457. nil))))));
  2458. GetLocalMenu:=M;
  2459. end;
  2460. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  2461. var DontClear: boolean;
  2462. begin
  2463. case Event.What of
  2464. evKeyDown :
  2465. begin
  2466. DontClear:=false;
  2467. case Event.KeyCode of
  2468. kbEnter :
  2469. Message(@Self,evCommand,cmEdit,nil);
  2470. kbIns :
  2471. Message(@Self,evCommand,cmNew,nil);
  2472. kbDel :
  2473. Message(@Self,evCommand,cmDelete,nil);
  2474. else
  2475. DontClear:=true;
  2476. end;
  2477. if not DontClear then
  2478. ClearEvent(Event);
  2479. end;
  2480. evBroadcast :
  2481. case Event.Command of
  2482. cmListItemSelected :
  2483. if Event.InfoPtr=@Self then
  2484. Message(@Self,evCommand,cmEdit,nil);
  2485. end;
  2486. evCommand :
  2487. begin
  2488. DontClear:=false;
  2489. case Event.Command of
  2490. cmEdit :
  2491. EditCurrent;
  2492. cmDelete :
  2493. DeleteCurrent;
  2494. cmNew :
  2495. EditNew;
  2496. else
  2497. DontClear:=true;
  2498. end;
  2499. if not DontClear then
  2500. ClearEvent(Event);
  2501. end;
  2502. end;
  2503. inherited HandleEvent(Event);
  2504. end;
  2505. constructor TWatchesListBox.Load(var S: TStream);
  2506. begin
  2507. inherited Load(S);
  2508. If assigned(List) then
  2509. dispose(list,done);
  2510. List:=WatchesCollection;
  2511. { we must set Range PM }
  2512. SetRange(List^.count+1);
  2513. end;
  2514. procedure TWatchesListBox.Store(var S: TStream);
  2515. var OL: PCollection;
  2516. OldRange : Sw_integer;
  2517. begin
  2518. OL:=List;
  2519. OldRange:=Range;
  2520. Range:=0;
  2521. New(List, Init(1,1));
  2522. inherited Store(S);
  2523. Dispose(List, Done);
  2524. List:=OL;
  2525. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2526. collection? Pasting here a modified version of TListBox.Store+
  2527. TAdvancedListBox.Store isn't a better solution, since by eventually
  2528. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2529. SetRange(OldRange);
  2530. end;
  2531. destructor TWatchesListBox.Done;
  2532. begin
  2533. List:=nil;
  2534. inherited Done;
  2535. end;
  2536. {****************************************************************************
  2537. TWatchesWindow
  2538. ****************************************************************************}
  2539. Constructor TWatchesWindow.Init;
  2540. var
  2541. HSB,VSB: PScrollBar;
  2542. R,R2 : trect;
  2543. begin
  2544. Desktop^.GetExtent(R);
  2545. R.A.Y:=R.B.Y-7;
  2546. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  2547. Palette:=wpCyanWindow;
  2548. GetExtent(R);
  2549. HelpCtx:=hcWatchesWindow;
  2550. R.Grow(-1,-1);
  2551. R2.Copy(R);
  2552. Inc(R2.B.Y);
  2553. R2.A.Y:=R2.B.Y-1;
  2554. New(HSB, Init(R2));
  2555. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2556. HSB^.SetStep(R.B.X-R.A.X,1);
  2557. Insert(HSB);
  2558. R2.Copy(R);
  2559. Inc(R2.B.X);
  2560. R2.A.X:=R2.B.X-1;
  2561. New(VSB, Init(R2));
  2562. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2563. Insert(VSB);
  2564. New(WLB,Init(R,HSB,VSB));
  2565. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2566. WLB^.Transparent:=true;
  2567. Insert(WLB);
  2568. If assigned(WatchesWindow) then
  2569. dispose(WatchesWindow,done);
  2570. WatchesWindow:=@Self;
  2571. Update;
  2572. end;
  2573. procedure TWatchesWindow.Update;
  2574. begin
  2575. WatchesCollection^.Update;
  2576. Draw;
  2577. end;
  2578. constructor TWatchesWindow.Load(var S: TStream);
  2579. begin
  2580. inherited Load(S);
  2581. GetSubViewPtr(S,WLB);
  2582. If assigned(WatchesWindow) then
  2583. dispose(WatchesWindow,done);
  2584. WatchesWindow:=@Self;
  2585. end;
  2586. procedure TWatchesWindow.Store(var S: TStream);
  2587. begin
  2588. inherited Store(S);
  2589. PutSubViewPtr(S,WLB);
  2590. end;
  2591. Destructor TWatchesWindow.Done;
  2592. begin
  2593. WatchesWindow:=nil;
  2594. Dispose(WLB,done);
  2595. inherited done;
  2596. end;
  2597. {****************************************************************************
  2598. TWatchItemDialog
  2599. ****************************************************************************}
  2600. constructor TWatchItemDialog.Init(AWatch: PWatch);
  2601. var R,R2: TRect;
  2602. begin
  2603. R.Assign(0,0,50,10);
  2604. inherited Init(R,'Edit Watch');
  2605. Watch:=AWatch;
  2606. GetExtent(R); R.Grow(-3,-2);
  2607. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2608. New(NameIL, Init(R, 255)); Insert(NameIL);
  2609. R2.Copy(R); R2.Move(-1,-1);
  2610. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  2611. GetExtent(R);
  2612. R.Grow(-1,-1);
  2613. R.A.Y:=R.A.Y+3;
  2614. R.B.X:=R.A.X+36;
  2615. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  2616. Insert(TextST);
  2617. InsertButtons(@Self);
  2618. NameIL^.Select;
  2619. end;
  2620. function TWatchItemDialog.Execute: Word;
  2621. var R: word;
  2622. S1,S2: string;
  2623. begin
  2624. S1:=GetStr(Watch^.expr);
  2625. NameIL^.SetData(S1);
  2626. if assigned(Watch^.Current_value) then
  2627. S1:=GetPChar(Watch^.Current_value)
  2628. else
  2629. S1:='';
  2630. if assigned(Watch^.Last_value) then
  2631. S2:=GetPChar(Watch^.Last_value)
  2632. else
  2633. S2:='';
  2634. ClearFormatParams;
  2635. AddFormatParamStr(S1);
  2636. AddFormatParamStr(S2);
  2637. if assigned(Watch^.Last_value) and
  2638. assigned(Watch^.Current_value) and
  2639. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2640. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  2641. else
  2642. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  2643. TextST^.SetText(S1);
  2644. R:=inherited Execute;
  2645. if R=cmOK then
  2646. begin
  2647. NameIL^.GetData(S1);
  2648. Watch^.Rename(S1);
  2649. If assigned(Debugger) then
  2650. Debugger^.ReadWatches;
  2651. end;
  2652. Execute:=R;
  2653. end;
  2654. {****************************************************************************
  2655. TRegistersView
  2656. ****************************************************************************}
  2657. function GetIntRegs(var rs : TIntRegs) : boolean;
  2658. var
  2659. p,po : pchar;
  2660. p1 : pchar;
  2661. reg,value : string;
  2662. buffer : array[0..255] of char;
  2663. v : dword;
  2664. code : word;
  2665. begin
  2666. GetIntRegs:=false;
  2667. {$ifndef NODEBUG}
  2668. Debugger^.Command('info registers');
  2669. if Debugger^.Error then
  2670. exit
  2671. else
  2672. begin
  2673. po:=StrNew(Debugger^.GetOutput);
  2674. p:=po;
  2675. if assigned(p) then
  2676. begin
  2677. fillchar(rs,sizeof(rs),0);
  2678. p1:=strscan(p,' ');
  2679. while assigned(p1) do
  2680. begin
  2681. strlcopy(buffer,p,p1-p);
  2682. reg:=strpas(buffer);
  2683. p:=strscan(p,'$');
  2684. p1:=strscan(p,#9);
  2685. strlcopy(buffer,p,p1-p);
  2686. value:=strpas(buffer);
  2687. val(value,v,code);
  2688. {$ifdef i386}
  2689. if reg='eax' then
  2690. rs.eax:=v
  2691. else if reg='ebx' then
  2692. rs.ebx:=v
  2693. else if reg='ecx' then
  2694. rs.ecx:=v
  2695. else if reg='edx' then
  2696. rs.edx:=v
  2697. else if reg='eip' then
  2698. rs.eip:=v
  2699. else if reg='esi' then
  2700. rs.esi:=v
  2701. else if reg='edi' then
  2702. rs.edi:=v
  2703. else if reg='esp' then
  2704. rs.esp:=v
  2705. else if reg='ebp' then
  2706. rs.ebp:=v
  2707. { under win32 flags are on a register named ps !! PM }
  2708. else if (reg='eflags') or (reg='ps') then
  2709. rs.eflags:=v
  2710. else if reg='cs' then
  2711. rs.cs:=v
  2712. else if reg='ds' then
  2713. rs.ds:=v
  2714. else if reg='es' then
  2715. rs.es:=v
  2716. else if reg='fs' then
  2717. rs.fs:=v
  2718. else if reg='gs' then
  2719. rs.gs:=v
  2720. else if reg='ss' then
  2721. rs.ss:=v;
  2722. {$endif i386}
  2723. {$ifdef m68k}
  2724. if reg='d0' then
  2725. rs.d0:=v
  2726. else if reg='d1' then
  2727. rs.d1:=v
  2728. else if reg='d2' then
  2729. rs.d2:=v
  2730. else if reg='d3' then
  2731. rs.d3:=v
  2732. else if reg='d4' then
  2733. rs.d4:=v
  2734. else if reg='d5' then
  2735. rs.d5:=v
  2736. else if reg='d6' then
  2737. rs.d6:=v
  2738. else if reg='d7' then
  2739. rs.d7:=v
  2740. else if reg='a0' then
  2741. rs.a0:=v
  2742. else if reg='a1' then
  2743. rs.a1:=v
  2744. else if reg='a2' then
  2745. rs.a2:=v
  2746. else if reg='a3' then
  2747. rs.a3:=v
  2748. else if reg='a4' then
  2749. rs.a4:=v
  2750. else if reg='a5' then
  2751. rs.a5:=v
  2752. else if reg='fp' then
  2753. rs.fp:=v
  2754. else if reg='sp' then
  2755. rs.sp:=v
  2756. else if (reg='ps') then
  2757. rs.ps:=v
  2758. else if reg='pc' then
  2759. rs.pc:=v;
  2760. {$endif m68k}
  2761. p:=strscan(p1,#10);
  2762. if assigned(p) then
  2763. begin
  2764. p1:=strscan(p,' ');
  2765. inc(p);
  2766. end
  2767. else
  2768. break;
  2769. end;
  2770. { free allocated memory }
  2771. strdispose(po);
  2772. end
  2773. else
  2774. exit;
  2775. end;
  2776. { do not open a messagebox for such errors }
  2777. Debugger^.got_error:=false;
  2778. GetIntRegs:=true;
  2779. {$endif}
  2780. end;
  2781. constructor TRegistersView.Init(var Bounds: TRect);
  2782. begin
  2783. inherited init(Bounds);
  2784. end;
  2785. procedure TRegistersView.Draw;
  2786. var
  2787. rs : tintregs;
  2788. color :byte;
  2789. procedure SetColor(x,y : longint);
  2790. begin
  2791. if x=y then
  2792. color:=7
  2793. else
  2794. color:=8;
  2795. end;
  2796. begin
  2797. inherited draw;
  2798. If not assigned(Debugger) then
  2799. begin
  2800. WriteStr(1,0,'<no values available>',7);
  2801. exit;
  2802. end;
  2803. if GetIntRegs(rs) then
  2804. begin
  2805. {$ifdef i386}
  2806. SetColor(rs.eax,OldReg.eax);
  2807. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2808. SetColor(rs.ebx,OldReg.ebx);
  2809. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2810. SetColor(rs.ecx,OldReg.ecx);
  2811. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2812. SetColor(rs.edx,OldReg.edx);
  2813. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2814. SetColor(rs.eip,OldReg.eip);
  2815. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2816. SetColor(rs.esi,OldReg.esi);
  2817. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2818. SetColor(rs.edi,OldReg.edi);
  2819. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2820. SetColor(rs.esp,OldReg.esp);
  2821. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2822. SetColor(rs.ebp,OldReg.ebp);
  2823. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2824. SetColor(rs.cs,OldReg.cs);
  2825. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2826. SetColor(rs.ds,OldReg.ds);
  2827. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2828. SetColor(rs.es,OldReg.es);
  2829. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2830. SetColor(rs.fs,OldReg.fs);
  2831. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2832. SetColor(rs.gs,OldReg.gs);
  2833. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2834. SetColor(rs.ss,OldReg.ss);
  2835. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2836. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2837. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2838. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2839. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2840. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2841. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2842. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2843. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2844. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2845. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2846. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2847. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2848. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2849. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2850. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2851. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2852. {$endif i386}
  2853. {$ifdef m68k}
  2854. SetColor(rs.d0,OldReg.d0);
  2855. WriteStr(1,0,'d0 '+HexStr(rs.d0,8),color);
  2856. SetColor(rs.d1,OldReg.d1);
  2857. WriteStr(1,1,'d1 '+HexStr(rs.d1,8),color);
  2858. SetColor(rs.d2,OldReg.d2);
  2859. WriteStr(1,2,'d2 '+HexStr(rs.d2,8),color);
  2860. SetColor(rs.d3,OldReg.d3);
  2861. WriteStr(1,3,'d3 '+HexStr(rs.d3,8),color);
  2862. SetColor(rs.d4,OldReg.d4);
  2863. WriteStr(1,4,'d4 '+HexStr(rs.d4,8),color);
  2864. SetColor(rs.d5,OldReg.d5);
  2865. WriteStr(1,5,'d5 '+HexStr(rs.d5,8),color);
  2866. SetColor(rs.d6,OldReg.d6);
  2867. WriteStr(1,6,'d6 '+HexStr(rs.d6,8),color);
  2868. SetColor(rs.d7,OldReg.d7);
  2869. WriteStr(1,7,'d7 '+HexStr(rs.d7,8),color);
  2870. SetColor(rs.a0,OldReg.a0);
  2871. WriteStr(14,0,'a0 '+HexStr(rs.a0,8),color);
  2872. SetColor(rs.a1,OldReg.a1);
  2873. WriteStr(14,1,'a1 '+HexStr(rs.a1,8),color);
  2874. SetColor(rs.a2,OldReg.a2);
  2875. WriteStr(14,2,'a2 '+HexStr(rs.a2,8),color);
  2876. SetColor(rs.a3,OldReg.a3);
  2877. WriteStr(14,3,'a3 '+HexStr(rs.a3,8),color);
  2878. SetColor(rs.a4,OldReg.a4);
  2879. WriteStr(14,4,'a4 '+HexStr(rs.a4,8),color);
  2880. SetColor(rs.a5,OldReg.a5);
  2881. WriteStr(14,5,'a5 '+HexStr(rs.a5,8),color);
  2882. SetColor(rs.fp,OldReg.fp);
  2883. WriteStr(14,6,'fp '+HexStr(rs.fp,8),color);
  2884. SetColor(rs.sp,OldReg.sp);
  2885. WriteStr(14,7,'sp '+HexStr(rs.sp,8),color);
  2886. SetColor(rs.pc,OldReg.pc);
  2887. WriteStr(1,8,'pc '+HexStr(rs.pc,8),color);
  2888. SetColor(rs.ps and $1,OldReg.ps and $1);
  2889. WriteStr(20,8,'c'+chr(byte((rs.ps and $1)<>0)+48),color);
  2890. SetColor(rs.ps and $2,OldReg.ps and $2);
  2891. WriteStr(18,8,'v'+chr(byte((rs.ps and $2)<>0)+48),color);
  2892. SetColor(rs.ps and $4,OldReg.ps and $4);
  2893. WriteStr(16,8,'z'+chr(byte((rs.ps and $4)<>0)+48),color);
  2894. SetColor(rs.ps and $8,OldReg.ps and $8);
  2895. WriteStr(14,8,'x'+chr(byte((rs.ps and $8)<>0)+48),color);
  2896. {$endif i386}
  2897. OldReg:=rs;
  2898. end
  2899. else
  2900. WriteStr(0,0,'<debugger error>',7);
  2901. end;
  2902. destructor TRegistersView.Done;
  2903. begin
  2904. inherited done;
  2905. end;
  2906. {****************************************************************************
  2907. TRegistersWindow
  2908. ****************************************************************************}
  2909. constructor TRegistersWindow.Init;
  2910. var
  2911. R : TRect;
  2912. begin
  2913. Desktop^.GetExtent(R);
  2914. R.A.X:=R.B.X-28;
  2915. R.B.Y:=R.A.Y+11;
  2916. inherited Init(R,dialog_registers, wnNoNumber);
  2917. Flags:=wfClose or wfMove;
  2918. Palette:=wpCyanWindow;
  2919. HelpCtx:=hcRegistersWindow;
  2920. R.Assign(1,1,26,10);
  2921. RV:=new(PRegistersView,init(R));
  2922. Insert(RV);
  2923. If assigned(RegistersWindow) then
  2924. dispose(RegistersWindow,done);
  2925. RegistersWindow:=@Self;
  2926. Update;
  2927. end;
  2928. constructor TRegistersWindow.Load(var S: TStream);
  2929. begin
  2930. inherited load(S);
  2931. GetSubViewPtr(S,RV);
  2932. If assigned(RegistersWindow) then
  2933. dispose(RegistersWindow,done);
  2934. RegistersWindow:=@Self;
  2935. end;
  2936. procedure TRegistersWindow.Store(var S: TStream);
  2937. begin
  2938. inherited Store(s);
  2939. PutSubViewPtr(S,RV);
  2940. end;
  2941. procedure TRegistersWindow.Update;
  2942. begin
  2943. ReDraw;
  2944. end;
  2945. destructor TRegistersWindow.Done;
  2946. begin
  2947. RegistersWindow:=nil;
  2948. inherited done;
  2949. end;
  2950. {****************************************************************************
  2951. TFPUView
  2952. ****************************************************************************}
  2953. function GetFPURegs(var rs : TFPURegs) : boolean;
  2954. var
  2955. p,po : pchar;
  2956. p1 : pchar;
  2957. {$ifndef NODEBUG}
  2958. reg,value : string;
  2959. buffer : array[0..255] of char;
  2960. v : string;
  2961. res : cardinal;
  2962. i : longint;
  2963. err : word;
  2964. {$endif}
  2965. begin
  2966. GetFPURegs:=false;
  2967. {$ifndef NODEBUG}
  2968. Debugger^.Command('info all');
  2969. if Debugger^.Error then
  2970. exit
  2971. else
  2972. begin
  2973. po:=StrNew(Debugger^.GetOutput);
  2974. p:=po;
  2975. if assigned(p) then
  2976. begin
  2977. fillchar(rs,sizeof(rs),0);
  2978. p1:=strscan(p,' ');
  2979. while assigned(p1) do
  2980. begin
  2981. strlcopy(buffer,p,p1-p);
  2982. reg:=strpas(buffer);
  2983. p:=p1;
  2984. while p^=' ' do
  2985. inc(p);
  2986. if p^='$' then
  2987. p1:=strscan(p,#9)
  2988. else
  2989. p1:=strscan(p,#10);
  2990. strlcopy(buffer,p,p1-p);
  2991. v:=strpas(buffer);
  2992. for i:=1 to length(v) do
  2993. if v[i]=#9 then
  2994. v[i]:=' ';
  2995. val(v,res,err);
  2996. {$ifdef i386}
  2997. if reg='st0' then
  2998. rs.st0:=v
  2999. else if reg='st1' then
  3000. rs.st1:=v
  3001. else if reg='st2' then
  3002. rs.st2:=v
  3003. else if reg='st3' then
  3004. rs.st3:=v
  3005. else if reg='st4' then
  3006. rs.st4:=v
  3007. else if reg='st5' then
  3008. rs.st5:=v
  3009. else if reg='st6' then
  3010. rs.st6:=v
  3011. else if reg='st7' then
  3012. rs.st7:=v
  3013. else if reg='ftag' then
  3014. rs.ftag:=res
  3015. else if reg='fctrl' then
  3016. rs.fctrl:=res
  3017. else if reg='fstat' then
  3018. rs.fstat:=res
  3019. else if reg='fiseg' then
  3020. rs.fiseg:=res
  3021. else if reg='fioff' then
  3022. rs.fioff:=res
  3023. else if reg='foseg' then
  3024. rs.foseg:=res
  3025. else if reg='fooff' then
  3026. rs.fooff:=res
  3027. else if reg='fop' then
  3028. rs.fop:=res;
  3029. {$endif i386}
  3030. {$ifdef m68k}
  3031. if reg='fp0' then
  3032. rs.fp0:=v
  3033. else if reg='fp1' then
  3034. rs.fp1:=v
  3035. else if reg='fp2' then
  3036. rs.fp2:=v
  3037. else if reg='fp3' then
  3038. rs.fp3:=v
  3039. else if reg='fp4' then
  3040. rs.fp4:=v
  3041. else if reg='fp5' then
  3042. rs.fp5:=v
  3043. else if reg='fp6' then
  3044. rs.fp6:=v
  3045. else if reg='fp7' then
  3046. rs.fp7:=v
  3047. else if reg='fpcontrol' then
  3048. rs.fpcontrol:=res
  3049. else if reg='fpstatus' then
  3050. rs.fpstatus:=res
  3051. else if reg='fpiaddr' then
  3052. rs.fpiaddr:=res;
  3053. {$endif m68k}
  3054. p:=strscan(p1,#10);
  3055. if assigned(p) then
  3056. begin
  3057. p1:=strscan(p,' ');
  3058. inc(p);
  3059. end
  3060. else
  3061. break;
  3062. end;
  3063. { free allocated memory }
  3064. strdispose(po);
  3065. end
  3066. else
  3067. exit;
  3068. end;
  3069. { do not open a messagebox for such errors }
  3070. Debugger^.got_error:=false;
  3071. GetFPURegs:=true;
  3072. {$endif}
  3073. end;
  3074. constructor TFPUView.Init(var Bounds: TRect);
  3075. begin
  3076. inherited init(Bounds);
  3077. end;
  3078. procedure TFPUView.Draw;
  3079. var
  3080. rs : tfpuregs;
  3081. top : byte;
  3082. color :byte;
  3083. const
  3084. TypeStr : Array[0..3] of string[6] =
  3085. ('Valid ','Zero ','Spec ','Empty ');
  3086. procedure SetColor(Const x,y : string);
  3087. begin
  3088. if x=y then
  3089. color:=7
  3090. else
  3091. color:=8;
  3092. end;
  3093. procedure SetIColor(Const x,y : cardinal);
  3094. begin
  3095. if x=y then
  3096. color:=7
  3097. else
  3098. color:=8;
  3099. end;
  3100. begin
  3101. inherited draw;
  3102. If not assigned(Debugger) then
  3103. begin
  3104. WriteStr(1,0,'<no values available>',7);
  3105. exit;
  3106. end;
  3107. if GetFPURegs(rs) then
  3108. begin
  3109. {$ifdef i386}
  3110. top:=(rs.fstat shr 11) and 7;
  3111. SetColor(rs.st0,OldReg.st0);
  3112. WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
  3113. SetColor(rs.st1,OldReg.st1);
  3114. WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
  3115. SetColor(rs.st2,OldReg.st2);
  3116. WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
  3117. SetColor(rs.st3,OldReg.st3);
  3118. WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
  3119. SetColor(rs.st4,OldReg.st4);
  3120. WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
  3121. SetColor(rs.st5,OldReg.st5);
  3122. WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
  3123. SetColor(rs.st6,OldReg.st6);
  3124. WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
  3125. SetColor(rs.st7,OldReg.st7);
  3126. WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
  3127. SetIColor(rs.ftag,OldReg.ftag);
  3128. WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
  3129. SetIColor(rs.fctrl,OldReg.fctrl);
  3130. WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
  3131. SetIColor(rs.fstat,OldReg.fstat);
  3132. WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
  3133. SetIColor(rs.fop,OldReg.fop);
  3134. WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
  3135. if (rs.fiseg<>OldReg.fiseg) or
  3136. (rs.fioff<>OldReg.fioff) then
  3137. color:=8
  3138. else
  3139. color:=7;
  3140. WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
  3141. if (rs.foseg<>OldReg.foseg) or
  3142. (rs.fooff<>OldReg.fooff) then
  3143. color:=8
  3144. else
  3145. color:=7;
  3146. WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
  3147. OldReg:=rs;
  3148. {$endif i386}
  3149. {$ifdef m68k}
  3150. SetColor(rs.fp0,OldReg.fp0);
  3151. WriteStr(1,0,'fp0 '+rs.fp0,color);
  3152. SetColor(rs.fp1,OldReg.fp1);
  3153. WriteStr(1,1,'fp1 '+rs.fp1,color);
  3154. SetColor(rs.fp2,OldReg.fp2);
  3155. WriteStr(1,2,'fp2 '+rs.fp2,color);
  3156. SetColor(rs.fp3,OldReg.fp3);
  3157. WriteStr(1,3,'fp3 '+rs.fp3,color);
  3158. SetColor(rs.fp4,OldReg.fp4);
  3159. WriteStr(1,4,'fp4 '+rs.fp4,color);
  3160. SetColor(rs.fp5,OldReg.fp5);
  3161. WriteStr(1,5,'fp5 '+rs.fp5,color);
  3162. SetColor(rs.fp6,OldReg.fp6);
  3163. WriteStr(1,6,'fp6 '+rs.fp6,color);
  3164. SetColor(rs.fp7,OldReg.fp7);
  3165. WriteStr(1,7,'fp7 '+rs.fp7,color);
  3166. SetIColor(rs.fpcontrol,OldReg.fpcontrol);
  3167. WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
  3168. SetIColor(rs.fpstatus,OldReg.fpstatus);
  3169. WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
  3170. SetIColor(rs.fpiaddr,OldReg.fpiaddr);
  3171. WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
  3172. OldReg:=rs;
  3173. {$endif m68k}
  3174. end
  3175. else
  3176. WriteStr(0,0,'<debugger error>',7);
  3177. end;
  3178. destructor TFPUView.Done;
  3179. begin
  3180. inherited done;
  3181. end;
  3182. {****************************************************************************
  3183. TFPUWindow
  3184. ****************************************************************************}
  3185. constructor TFPUWindow.Init;
  3186. var
  3187. R : TRect;
  3188. begin
  3189. Desktop^.GetExtent(R);
  3190. R.A.X:=R.B.X-44;
  3191. R.B.Y:=R.A.Y+14;
  3192. inherited Init(R,dialog_fpu, wnNoNumber);
  3193. Flags:=wfClose or wfMove;
  3194. Palette:=wpCyanWindow;
  3195. HelpCtx:=hcFPURegisters;
  3196. R.Assign(1,1,42,13);
  3197. RV:=new(PFPUView,init(R));
  3198. Insert(RV);
  3199. If assigned(FPUWindow) then
  3200. dispose(FPUWindow,done);
  3201. FPUWindow:=@Self;
  3202. Update;
  3203. end;
  3204. constructor TFPUWindow.Load(var S: TStream);
  3205. begin
  3206. inherited load(S);
  3207. GetSubViewPtr(S,RV);
  3208. If assigned(FPUWindow) then
  3209. dispose(FPUWindow,done);
  3210. FPUWindow:=@Self;
  3211. end;
  3212. procedure TFPUWindow.Store(var S: TStream);
  3213. begin
  3214. inherited Store(s);
  3215. PutSubViewPtr(S,RV);
  3216. end;
  3217. procedure TFPUWindow.Update;
  3218. begin
  3219. ReDraw;
  3220. end;
  3221. destructor TFPUWindow.Done;
  3222. begin
  3223. FPUWindow:=nil;
  3224. inherited done;
  3225. end;
  3226. {****************************************************************************
  3227. TStackWindow
  3228. ****************************************************************************}
  3229. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3230. begin
  3231. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3232. end;
  3233. procedure TFramesListBox.Update;
  3234. var i : longint;
  3235. W : PSourceWindow;
  3236. begin
  3237. { call backtrace command }
  3238. If not assigned(Debugger) then
  3239. exit;
  3240. {$ifndef NODEBUG}
  3241. DeskTop^.Lock;
  3242. Clear;
  3243. { forget all old frames }
  3244. Debugger^.clear_frames;
  3245. Debugger^.Command('backtrace');
  3246. { generate list }
  3247. { all is in tframeentry }
  3248. for i:=0 to Debugger^.frame_count-1 do
  3249. begin
  3250. with Debugger^.frames[i]^ do
  3251. begin
  3252. if assigned(file_name) then
  3253. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3254. AddModuleName(GetPChar(file_name)),line_number,1)))
  3255. else
  3256. AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
  3257. AddModuleName(''),line_number,1)));
  3258. W:=SearchOnDesktop(GetPChar(file_name),false);
  3259. { First reset all Debugger rows }
  3260. If assigned(W) then
  3261. begin
  3262. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3263. W^.Editor^.DebuggerRow:=-1;
  3264. end;
  3265. end;
  3266. end;
  3267. { Now set all Debugger rows }
  3268. for i:=0 to Debugger^.frame_count-1 do
  3269. begin
  3270. with Debugger^.frames[i]^ do
  3271. begin
  3272. W:=SearchOnDesktop(GetPChar(file_name),false);
  3273. If assigned(W) then
  3274. begin
  3275. If W^.Editor^.DebuggerRow=-1 then
  3276. begin
  3277. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3278. W^.Editor^.DebuggerRow:=line_number-1;
  3279. end;
  3280. end;
  3281. end;
  3282. end;
  3283. if Assigned(list) and (List^.Count > 0) then
  3284. FocusItem(0);
  3285. DeskTop^.Unlock;
  3286. {$endif}
  3287. end;
  3288. function TFramesListBox.GetLocalMenu: PMenu;
  3289. begin
  3290. GetLocalMenu:=Inherited GetLocalMenu;
  3291. end;
  3292. procedure TFramesListBox.GotoSource;
  3293. begin
  3294. { select frame for watches }
  3295. If not assigned(Debugger) then
  3296. exit;
  3297. {$ifndef NODEBUG}
  3298. Debugger^.Command('f '+IntToStr(Focused));
  3299. { for local vars }
  3300. Debugger^.ReadWatches;
  3301. {$endif}
  3302. { goto source }
  3303. inherited GotoSource;
  3304. end;
  3305. procedure TFramesListBox.GotoAssembly;
  3306. begin
  3307. { select frame for watches }
  3308. If not assigned(Debugger) then
  3309. exit;
  3310. {$ifndef NODEBUG}
  3311. Debugger^.Command('f '+IntToStr(Focused));
  3312. { for local vars }
  3313. Debugger^.ReadWatches;
  3314. {$endif}
  3315. { goto source/assembly mixture }
  3316. InitDisassemblyWindow;
  3317. DisassemblyWindow^.LoadFunction('');
  3318. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3319. DisassemblyWindow^.SelectInDebugSession;
  3320. end;
  3321. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3322. begin
  3323. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3324. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3325. GotoAssembly;
  3326. inherited HandleEvent(Event);
  3327. end;
  3328. destructor TFramesListBox.Done;
  3329. begin
  3330. Inherited Done;
  3331. end;
  3332. Constructor TStackWindow.Init;
  3333. var
  3334. HSB,VSB: PScrollBar;
  3335. R,R2 : trect;
  3336. begin
  3337. Desktop^.GetExtent(R);
  3338. R.A.Y:=R.B.Y-5;
  3339. inherited Init(R, dialog_callstack, wnNoNumber);
  3340. Palette:=wpCyanWindow;
  3341. GetExtent(R);
  3342. HelpCtx:=hcStackWindow;
  3343. R.Grow(-1,-1);
  3344. R2.Copy(R);
  3345. Inc(R2.B.Y);
  3346. R2.A.Y:=R2.B.Y-1;
  3347. New(HSB, Init(R2));
  3348. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3349. Insert(HSB);
  3350. R2.Copy(R);
  3351. Inc(R2.B.X);
  3352. R2.A.X:=R2.B.X-1;
  3353. New(VSB, Init(R2));
  3354. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3355. Insert(VSB);
  3356. New(FLB,Init(R,HSB,VSB));
  3357. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3358. Insert(FLB);
  3359. If assigned(StackWindow) then
  3360. dispose(StackWindow,done);
  3361. StackWindow:=@Self;
  3362. Update;
  3363. end;
  3364. procedure TStackWindow.Update;
  3365. begin
  3366. FLB^.Update;
  3367. DrawView;
  3368. end;
  3369. constructor TStackWindow.Load(var S: TStream);
  3370. begin
  3371. inherited Load(S);
  3372. GetSubViewPtr(S,FLB);
  3373. If assigned(StackWindow) then
  3374. dispose(StackWindow,done);
  3375. StackWindow:=@Self;
  3376. end;
  3377. procedure TStackWindow.Store(var S: TStream);
  3378. begin
  3379. inherited Store(S);
  3380. PutSubViewPtr(S,FLB);
  3381. end;
  3382. Destructor TStackWindow.Done;
  3383. begin
  3384. StackWindow:=nil;
  3385. Dispose(FLB,done);
  3386. inherited done;
  3387. end;
  3388. {****************************************************************************
  3389. Init/Final
  3390. ****************************************************************************}
  3391. procedure InitDebugger;
  3392. {$ifdef DEBUG}
  3393. var s : string;
  3394. i,p : longint;
  3395. {$endif DEBUG}
  3396. var
  3397. NeedRecompileExe : boolean;
  3398. cm : longint;
  3399. begin
  3400. {$ifdef DEBUG}
  3401. if not use_gdb_file then
  3402. begin
  3403. Assign(gdb_file,GDBOutFileName);
  3404. {$I-}
  3405. Rewrite(gdb_file);
  3406. if InOutRes<>0 then
  3407. begin
  3408. s:=GDBOutFileName;
  3409. p:=pos('.',s);
  3410. if p>1 then
  3411. for i:=0 to 9 do
  3412. begin
  3413. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3414. InOutRes:=0;
  3415. Assign(gdb_file,s);
  3416. rewrite(gdb_file);
  3417. if InOutRes=0 then
  3418. break;
  3419. end;
  3420. end;
  3421. if IOResult=0 then
  3422. Use_gdb_file:=true;
  3423. end;
  3424. {$I+}
  3425. {$endif}
  3426. NeedRecompileExe:=false;
  3427. if TargetSwitches^.GetCurrSelParam<>{$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname then
  3428. begin
  3429. ClearFormatParams;
  3430. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3431. AddFormatParamStr({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3432. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3433. if cm=cmCancel then
  3434. Exit;
  3435. if cm=cmYes then
  3436. begin
  3437. { force recompilation }
  3438. PrevMainFile:='';
  3439. NeedRecompileExe:=true;
  3440. TargetSwitches^.SetCurrSelParam({$ifdef COMPILER_1_0}source_os{$else}source_info{$endif}.shortname);
  3441. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3442. DebugInfoSwitches^.SetCurrSelParam('l');
  3443. IDEApp.UpdateTarget;
  3444. end;
  3445. end;
  3446. if not NeedRecompileExe then
  3447. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3448. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3449. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3450. begin
  3451. ClearFormatParams;
  3452. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3453. if cm=cmCancel then
  3454. Exit;
  3455. if cm=cmYes then
  3456. begin
  3457. { force recompilation }
  3458. PrevMainFile:='';
  3459. NeedRecompileExe:=true;
  3460. DebugInfoSwitches^.SetCurrSelParam('l');
  3461. end;
  3462. end;
  3463. if NeedRecompileExe then
  3464. DoCompile(cRun);
  3465. if CompilationPhase<>cpDone then
  3466. Exit;
  3467. if (EXEFile='') then
  3468. begin
  3469. ErrorBox(msg_nothingtodebug,nil);
  3470. Exit;
  3471. end;
  3472. { init debugcontroller }
  3473. if not assigned(Debugger) then
  3474. begin
  3475. PushStatus(msg_startingdebugger);
  3476. new(Debugger,Init);
  3477. PopStatus;
  3478. end;
  3479. Debugger^.SetExe(ExeFile);
  3480. {$ifdef GDBWINDOW}
  3481. InitGDBWindow;
  3482. {$endif def GDBWINDOW}
  3483. end;
  3484. procedure DoneDebugger;
  3485. begin
  3486. {$ifdef DEBUG}
  3487. { PushStatus('Closing debugger');
  3488. No its called after App.Done !! }
  3489. {$endif}
  3490. if assigned(Debugger) then
  3491. dispose(Debugger,Done);
  3492. Debugger:=nil;
  3493. {$ifdef DEBUG}
  3494. If Use_gdb_file then
  3495. Close(GDB_file);
  3496. Use_gdb_file:=false;
  3497. {PopStatus;}
  3498. {$endif DEBUG}
  3499. {DoneGDBWindow;}
  3500. end;
  3501. procedure InitGDBWindow;
  3502. var
  3503. R : TRect;
  3504. begin
  3505. if GDBWindow=nil then
  3506. begin
  3507. DeskTop^.GetExtent(R);
  3508. new(GDBWindow,init(R));
  3509. DeskTop^.Insert(GDBWindow);
  3510. end;
  3511. end;
  3512. procedure DoneGDBWindow;
  3513. begin
  3514. if assigned(GDBWindow) then
  3515. begin
  3516. DeskTop^.Delete(GDBWindow);
  3517. GDBWindow:=nil;
  3518. end;
  3519. end;
  3520. procedure InitDisassemblyWindow;
  3521. var
  3522. R : TRect;
  3523. begin
  3524. if DisassemblyWindow=nil then
  3525. begin
  3526. DeskTop^.GetExtent(R);
  3527. new(DisassemblyWindow,init(R));
  3528. DeskTop^.Insert(DisassemblyWindow);
  3529. end;
  3530. end;
  3531. procedure DoneDisassemblyWindow;
  3532. begin
  3533. if assigned(DisassemblyWindow) then
  3534. begin
  3535. DeskTop^.Delete(DisassemblyWindow);
  3536. Dispose(DisassemblyWindow,Done);
  3537. DisassemblyWindow:=nil;
  3538. end;
  3539. end;
  3540. procedure InitStackWindow;
  3541. begin
  3542. if StackWindow=nil then
  3543. begin
  3544. new(StackWindow,init);
  3545. DeskTop^.Insert(StackWindow);
  3546. end;
  3547. end;
  3548. procedure DoneStackWindow;
  3549. begin
  3550. if assigned(StackWindow) then
  3551. begin
  3552. DeskTop^.Delete(StackWindow);
  3553. StackWindow:=nil;
  3554. end;
  3555. end;
  3556. procedure InitRegistersWindow;
  3557. begin
  3558. if RegistersWindow=nil then
  3559. begin
  3560. new(RegistersWindow,init);
  3561. DeskTop^.Insert(RegistersWindow);
  3562. end;
  3563. end;
  3564. procedure DoneRegistersWindow;
  3565. begin
  3566. if assigned(RegistersWindow) then
  3567. begin
  3568. DeskTop^.Delete(RegistersWindow);
  3569. RegistersWindow:=nil;
  3570. end;
  3571. end;
  3572. procedure InitFPUWindow;
  3573. begin
  3574. if FPUWindow=nil then
  3575. begin
  3576. new(FPUWindow,init);
  3577. DeskTop^.Insert(FPUWindow);
  3578. end;
  3579. end;
  3580. procedure DoneFPUWindow;
  3581. begin
  3582. if assigned(FPUWindow) then
  3583. begin
  3584. DeskTop^.Delete(FPUWindow);
  3585. FPUWindow:=nil;
  3586. end;
  3587. end;
  3588. procedure InitBreakpoints;
  3589. begin
  3590. New(BreakpointsCollection,init(10,10));
  3591. end;
  3592. procedure DoneBreakpoints;
  3593. begin
  3594. Dispose(BreakpointsCollection,Done);
  3595. BreakpointsCollection:=nil;
  3596. end;
  3597. procedure InitWatches;
  3598. begin
  3599. New(WatchesCollection,init);
  3600. end;
  3601. procedure DoneWatches;
  3602. begin
  3603. Dispose(WatchesCollection,Done);
  3604. WatchesCollection:=nil;
  3605. end;
  3606. procedure RegisterFPDebugViews;
  3607. begin
  3608. RegisterType(RWatchesWindow);
  3609. RegisterType(RBreakpointsWindow);
  3610. RegisterType(RWatchesListBox);
  3611. RegisterType(RBreakpointsListBox);
  3612. RegisterType(RStackWindow);
  3613. RegisterType(RFramesListBox);
  3614. RegisterType(RBreakpoint);
  3615. RegisterType(RWatch);
  3616. RegisterType(RBreakpointCollection);
  3617. RegisterType(RWatchesCollection);
  3618. RegisterType(RRegistersWindow);
  3619. RegisterType(RRegistersView);
  3620. RegisterType(RFPUWindow);
  3621. RegisterType(RFPUView);
  3622. end;
  3623. end.
  3624. {
  3625. $Log$
  3626. Revision 1.8 2001-11-10 00:11:45 pierre
  3627. * change target menu name if target changed to become debug-able
  3628. Revision 1.7 2001/11/07 00:28:52 pierre
  3629. + Disassembly window made public
  3630. Revision 1.6 2001/10/14 14:16:06 peter
  3631. * fixed typo for linux
  3632. Revision 1.5 2001/10/11 11:39:35 pierre
  3633. * better NoSwitch check for unix
  3634. Revision 1.4 2001/09/12 09:48:38 pierre
  3635. + SetDirectories method added to help for disassembly window
  3636. Revision 1.3 2001/08/07 22:58:10 pierre
  3637. * watches display enhanced and crashes removed
  3638. Revision 1.2 2001/08/05 02:01:47 peter
  3639. * FVISION define to compile with fvision units
  3640. Revision 1.1 2001/08/04 11:30:23 peter
  3641. * ide works now with both compiler versions
  3642. Revision 1.1.2.35 2001/08/03 13:33:51 pierre
  3643. * better looking m68k flags
  3644. Revision 1.1.2.34 2001/07/31 21:40:42 pierre
  3645. * fix typo erros in last commit
  3646. Revision 1.1.2.33 2001/07/31 15:12:45 pierre
  3647. + some m68k register support
  3648. Revision 1.1.2.32 2001/07/29 22:12:23 peter
  3649. * fixed private symbol that needs to be public
  3650. Revision 1.1.2.31 2001/06/13 16:22:02 pierre
  3651. * use CygdrivePrefix function for win32
  3652. Revision 1.1.2.30 2001/04/10 11:50:09 pierre
  3653. * only stop if erroraddress or exitcode non zero
  3654. + reset the file in DoneDebugger to avoid problem
  3655. if the executable file remains opened by GDB when recompiling
  3656. Revision 1.1.2.29 2001/03/22 17:28:57 pierre
  3657. * more stuff for stop at exit if error
  3658. Revision 1.1.2.28 2001/03/22 01:14:08 pierre
  3659. * work on Exit breakpoint if error
  3660. Revision 1.1.2.27 2001/03/20 00:20:42 pierre
  3661. * fix some memory leaks + several small enhancements
  3662. Revision 1.1.2.26 2001/03/15 17:45:19 pierre
  3663. * avoid to get the values of expressions twice
  3664. Revision 1.1.2.25 2001/03/15 17:08:52 pierre
  3665. * avoid extra info past watches values
  3666. Revision 1.1.2.24 2001/03/13 00:36:44 pierre
  3667. * small DisassemblyWindow fixes
  3668. Revision 1.1.2.23 2001/03/12 17:34:54 pierre
  3669. + Disassembly window started
  3670. Revision 1.1.2.22 2001/03/09 15:08:12 pierre
  3671. * Watches list reorganised so that the behavior
  3672. is more near to BP one.
  3673. + First version of FPU window for i386.
  3674. Revision 1.1.2.21 2001/03/08 16:41:03 pierre
  3675. * correct watch horizontal scrolling
  3676. Revision 1.1.2.20 2001/03/06 22:42:22 pierre
  3677. * check for modifed open files at stop of beguggee
  3678. Revision 1.1.2.19 2001/03/06 21:44:13 pierre
  3679. * avoid problems if recompiling in debug session
  3680. Revision 1.1.2.18 2001/01/09 11:49:30 pierre
  3681. * fix DebugRow highlighting problem if Call Stack Window is open
  3682. Revision 1.1.2.17 2001/01/07 22:37:41 peter
  3683. * quiting gdbwindow works now
  3684. Revision 1.1.2.16 2000/12/13 16:58:11 pierre
  3685. * AllowQuit changed, still does not work correctly :(
  3686. Revision 1.1.2.15 2000/11/29 18:28:51 pierre
  3687. + add save to file capability for list boxes
  3688. Revision 1.1.2.14 2000/11/29 11:25:59 pierre
  3689. + TFPDlgWindow that handles cmSearchWindow
  3690. Revision 1.1.2.13 2000/11/29 00:54:44 pierre
  3691. + preserve window number and save special windows
  3692. Revision 1.1.2.12 2000/11/27 17:41:45 pierre
  3693. * better GDB window opening if nothing compiled yet
  3694. Revision 1.1.2.11 2000/11/16 23:06:30 pierre
  3695. * correct handling of Compile/Make if primary file is set
  3696. Revision 1.1.2.10 2000/11/14 17:40:42 pierre
  3697. + External linking now optional
  3698. Revision 1.1.2.9 2000/11/14 09:23:55 marco
  3699. * Second batch
  3700. Revision 1.1.2.8 2000/11/13 16:59:08 pierre
  3701. * some function in double removed from fputils unit
  3702. Revision 1.1.2.7 2000/10/31 07:47:54 pierre
  3703. * start to support FPC_BREAK_ERROR
  3704. Revision 1.1.2.6 2000/10/26 00:04:35 pierre
  3705. + gdb prompt and FPC_BREAK_ERROR stop
  3706. Revision 1.1.2.5 2000/10/09 19:48:15 pierre
  3707. * wrong commit corrected
  3708. Revision 1.1.2.4 2000/10/09 16:28:24 pierre
  3709. * several linux enhancements
  3710. Revision 1.1.2.3 2000/10/06 22:52:34 pierre
  3711. * fixes for linux GDB tty command
  3712. Revision 1.1.2.2 2000/09/22 12:02:34 jonas
  3713. * corrected command for running user program in other tty under linux
  3714. (doesn't work yet though)
  3715. Revision 1.1.2.1 2000/07/18 05:50:22 michael
  3716. + Merged Gabors fixes
  3717. Revision 1.1 2000/07/13 09:48:34 michael
  3718. + Initial import
  3719. Revision 1.63 2000/06/22 09:07:11 pierre
  3720. * Gabor changes: see fixes.txt
  3721. Revision 1.62 2000/06/11 07:01:32 peter
  3722. * give watches window also a number
  3723. * leave watches window in the bottom when cascading windows
  3724. Revision 1.61 2000/05/02 08:42:27 pierre
  3725. * new set of Gabor changes: see fixes.txt
  3726. Revision 1.60 2000/04/18 21:45:35 pierre
  3727. * Red line for breakpoint was off by one line
  3728. Revision 1.59 2000/04/18 11:42:36 pierre
  3729. lot of Gabor changes : see fixes.txt
  3730. Revision 1.58 2000/03/21 23:32:38 pierre
  3731. adapted to wcedit addition by Gabor
  3732. Revision 1.57 2000/03/14 14:22:30 pierre
  3733. + generate cmDebuggerStopped broadcast
  3734. Revision 1.56 2000/03/08 16:57:01 pierre
  3735. * Wrong highlighted line while debugging fixed
  3736. + Check if exe has debugging info
  3737. Revision 1.55 2000/03/07 21:52:54 pierre
  3738. + TDebugController.GetValue
  3739. Revision 1.54 2000/03/06 11:34:25 pierre
  3740. + windebug unit for Window Title change when debugging
  3741. Revision 1.53 2000/02/07 12:51:32 pierre
  3742. * typo fix
  3743. Revision 1.52 2000/02/07 11:50:30 pierre
  3744. Gabor changes for TP
  3745. Revision 1.51 2000/02/06 23:43:57 pierre
  3746. * breakpoint path problems fixes
  3747. Revision 1.50 2000/02/05 01:27:58 pierre
  3748. * bug with Toggle Break fixed, hopefully
  3749. + search for local vars in parent procs avoiding
  3750. wrong results (see test.pas source)
  3751. Revision 1.49 2000/02/04 23:18:05 pierre
  3752. * no pushstatus in DoneDebugger because its called after App.done
  3753. Revision 1.48 2000/02/04 14:34:46 pierre
  3754. readme.txt
  3755. Revision 1.47 2000/02/04 00:10:58 pierre
  3756. * Breakpoint line in Source Window better handled
  3757. Revision 1.46 2000/02/01 10:59:58 pierre
  3758. * allow FP to debug itself
  3759. Revision 1.45 2000/01/28 22:38:21 pierre
  3760. * CrtlF9 starts debugger if there are active breakpoints
  3761. Revision 1.44 2000/01/27 22:30:38 florian
  3762. * start of FPU window
  3763. * current executed line color has a higher priority then a breakpoint now
  3764. Revision 1.43 2000/01/20 00:31:53 pierre
  3765. * uses ShortName of exe to start GDB
  3766. Revision 1.42 2000/01/10 17:49:40 pierre
  3767. * Get RegisterView to Update correctly
  3768. * Write in white changed regs (keeping a copy of previous values)
  3769. Revision 1.41 2000/01/10 16:20:50 florian
  3770. * working register window
  3771. Revision 1.40 2000/01/10 13:20:57 pierre
  3772. + debug only possible on source target
  3773. Revision 1.39 2000/01/10 00:25:06 pierre
  3774. * RegisterWindow problem fixed
  3775. Revision 1.38 2000/01/09 21:05:51 florian
  3776. * some fixes for register view
  3777. Revision 1.37 2000/01/08 18:26:20 florian
  3778. + added a register window, doesn't work yet
  3779. Revision 1.36 1999/12/20 14:23:16 pierre
  3780. * MyApp renamed IDEApp
  3781. * TDebugController.ResetDebuggerRows added to
  3782. get resetting of debugger rows
  3783. Revision 1.35 1999/11/24 14:03:16 pierre
  3784. + Executing... in status line if in another window
  3785. Revision 1.34 1999/11/10 17:19:58 pierre
  3786. + Other window for Debuggee code
  3787. Revision 1.33 1999/10/25 16:39:03 pierre
  3788. + GetPChar to avoid nil pointer problems
  3789. Revision 1.32 1999/09/16 14:34:57 pierre
  3790. + TBreakpoint and TWatch registering
  3791. + WatchesCollection and BreakpointsCollection stored in desk file
  3792. * Syntax highlighting was broken
  3793. Revision 1.31 1999/09/13 16:24:43 peter
  3794. + clock
  3795. * backspace unident like tp7
  3796. Revision 1.30 1999/09/09 16:36:30 pierre
  3797. * Breakpoint storage problem corrected
  3798. Revision 1.29 1999/09/09 16:31:45 pierre
  3799. * some breakpoint related fixes and Help contexts
  3800. Revision 1.28 1999/09/09 14:20:05 pierre
  3801. + Stack Window
  3802. Revision 1.27 1999/08/24 22:04:33 pierre
  3803. + TCodeEditor.SetDebuggerRow
  3804. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  3805. so the current stop point in debugging is not lost if
  3806. we move the cursor
  3807. Revision 1.26 1999/08/22 22:26:48 pierre
  3808. + Registration of Breakpoint/Watches windows
  3809. Revision 1.25 1999/08/16 18:25:15 peter
  3810. * Adjusting the selection when the editor didn't contain any line.
  3811. * Reserved word recognition redesigned, but this didn't affect the overall
  3812. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  3813. The syntax scanner loop is a bit slow but the main problem is the
  3814. recognition of special symbols. Switching off symbol processing boosts
  3815. the performance up to ca. 200%...
  3816. * The editor didn't allow copying (for ex to clipboard) of a single character
  3817. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  3818. * Compiler Messages window (actually the whole desktop) did not act on any
  3819. keypress when compilation failed and thus the window remained visible
  3820. + Message windows are now closed upon pressing Esc
  3821. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  3822. only when neccessary
  3823. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  3824. + LineSelect (Ctrl+K+L) implemented
  3825. * The IDE had problems closing help windows before saving the desktop
  3826. Revision 1.24 1999/08/03 20:22:28 peter
  3827. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  3828. + Desktop saving should work now
  3829. - History saved
  3830. - Clipboard content saved
  3831. - Desktop saved
  3832. - Symbol info saved
  3833. * syntax-highlight bug fixed, which compared special keywords case sensitive
  3834. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  3835. * with 'whole words only' set, the editor didn't found occourences of the
  3836. searched text, if the text appeared previously in the same line, but didn't
  3837. satisfied the 'whole-word' condition
  3838. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  3839. (ie. the beginning of the selection)
  3840. * when started typing in a new line, but not at the start (X=0) of it,
  3841. the editor inserted the text one character more to left as it should...
  3842. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  3843. * Shift shouldn't cause so much trouble in TCodeEditor now...
  3844. * Syntax highlight had problems recognizing a special symbol if it was
  3845. prefixed by another symbol character in the source text
  3846. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  3847. Revision 1.23 1999/07/28 23:11:17 peter
  3848. * fixes from gabor
  3849. Revision 1.22 1999/07/12 13:14:15 pierre
  3850. * LineEnd bug corrected, now goes end of text even if selected
  3851. + Until Return for debugger
  3852. + Code for Quit inside GDB Window
  3853. Revision 1.21 1999/07/11 00:35:14 pierre
  3854. * fix problems for wrong watches
  3855. Revision 1.20 1999/07/10 01:24:14 pierre
  3856. + First implementation of watches window
  3857. Revision 1.19 1999/06/30 23:58:12 pierre
  3858. + BreakpointsList Window implemented
  3859. with Edit/New/Delete functions
  3860. + Individual breakpoint dialog with support for all types
  3861. ignorecount and conditions
  3862. (commands are not yet implemented, don't know if this wolud be useful)
  3863. awatch and rwatch have problems because GDB does not annotate them
  3864. I fixed v4.16 for this
  3865. Revision 1.18 1999/03/16 00:44:42 peter
  3866. * forgotten in last commit :(
  3867. Revision 1.17 1999/03/02 13:48:28 peter
  3868. * fixed far problem is fpdebug
  3869. * tile/cascading with message window
  3870. * grep fixes
  3871. Revision 1.16 1999/03/01 15:41:52 peter
  3872. + Added dummy entries for functions not yet implemented
  3873. * MenuBar didn't update itself automatically on command-set changes
  3874. * Fixed Debugging/Profiling options dialog
  3875. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  3876. set
  3877. * efBackSpaceUnindents works correctly
  3878. + 'Messages' window implemented
  3879. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  3880. + Added TP message-filter support (for ex. you can call GREP thru
  3881. GREP2MSG and view the result in the messages window - just like in TP)
  3882. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  3883. so topic search didn't work...
  3884. * In FPHELP.PAS there were still context-variables defined as word instead
  3885. of THelpCtx
  3886. * StdStatusKeys() was missing from the statusdef for help windows
  3887. + Topic-title for index-table can be specified when adding a HTML-files
  3888. Revision 1.15 1999/02/20 15:18:29 peter
  3889. + ctrl-c capture with confirm dialog
  3890. + ascii table in the tools menu
  3891. + heapviewer
  3892. * empty file fixed
  3893. * fixed callback routines in fpdebug to have far for tp7
  3894. Revision 1.14 1999/02/16 12:47:36 pierre
  3895. * GDBWindow does not popup on F7 or F8 anymore
  3896. Revision 1.13 1999/02/16 10:43:54 peter
  3897. * use -dGDB for the compiler
  3898. * only use gdb_file when -dDEBUG is used
  3899. * profiler switch is now a toggle instead of radiobutton
  3900. Revision 1.12 1999/02/11 19:07:20 pierre
  3901. * GDBWindow redesigned :
  3902. normal editor apart from
  3903. that any kbEnter will send the line (for begin to cursor)
  3904. to GDB command !
  3905. GDBWindow opened in Debugger Menu
  3906. still buggy :
  3907. -echo should not be present if at end of text
  3908. -GDBWindow becomes First after each step (I don't know why !)
  3909. Revision 1.11 1999/02/11 13:10:03 pierre
  3910. + GDBWindow only with -dGDBWindow for now : still buggy !!
  3911. Revision 1.10 1999/02/10 09:55:07 pierre
  3912. + added OldValue and CurrentValue field for watchpoints
  3913. + InitBreakpoints and DoneBreakpoints
  3914. + MessageBox if GDB stops bacause of a watchpoint !
  3915. Revision 1.9 1999/02/08 17:43:43 pierre
  3916. * RestDebugger or multiple running of debugged program now works
  3917. + added DoContToCursor(F4)
  3918. * Breakpoints are now inserted correctly (was mainlyy a problem
  3919. of directories)
  3920. Revision 1.8 1999/02/05 17:21:52 pierre
  3921. Invalid_line renamed InvalidSourceLine
  3922. Revision 1.7 1999/02/05 13:08:41 pierre
  3923. + new breakpoint types added
  3924. Revision 1.6 1999/02/05 12:11:53 pierre
  3925. + SourceDir that stores directories for sources that the
  3926. compiler should not know about
  3927. Automatically asked for addition when a new file that
  3928. needed filedialog to be found is in an unknown directory
  3929. Stored and retrieved from INIFile
  3930. + Breakpoints conditions added to INIFile
  3931. * Breakpoints insterted and removed at debin and end of debug session
  3932. Revision 1.5 1999/02/04 17:54:22 pierre
  3933. + several commands added
  3934. Revision 1.4 1999/02/04 13:32:02 pierre
  3935. * Several things added (I cannot commit them independently !)
  3936. + added TBreakpoint and TBreakpointCollection
  3937. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  3938. + Breakpoint list in INIFile
  3939. * Select items now also depend of SwitchMode
  3940. * Reading of option '-g' was not possible !
  3941. + added search for -Fu args pathes in TryToOpen
  3942. + added code for automatic opening of FileDialog
  3943. if source not found
  3944. Revision 1.3 1999/02/02 16:41:38 peter
  3945. + automatic .pas/.pp adding by opening of file
  3946. * better debuggerscreen changes
  3947. Revision 1.2 1999/01/22 18:14:09 pierre
  3948. * adaptd to changes in gdbint and gdbcon for to /
  3949. Revision 1.1 1999/01/22 10:24:03 peter
  3950. * first debugger things
  3951. }