fpdebug.pas 128 KB

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