1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039 |
- {
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998-2000 by Pierre Muller
- Debugger call routines for the IDE
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit FPDebug;
- {$ifdef NODEBUG}
- interface
- implementation
- end.
- {$else}
- interface
- {$i globdir.inc}
- uses
- {$ifdef Windows}
- Windows,
- {$endif Windows}
- Objects,Dialogs,Drivers,Views,
- {$ifndef NODEBUG}
- {$ifdef GDBMI}
- GDBMICon,GDBMIInt,
- {$else GDBMI}
- GDBCon,GDBInt,
- {$endif GDBMI}
- {$endif NODEBUG}
- Menus,
- WViews,WEditor,
- FPViews;
- type
- {$ifndef NODEBUG}
- PDebugController=^TDebugController;
- TDebugController=object(TGDBController)
- private
- function GetFPCBreakErrorParameters(var ExitCode: LongInt; var ExitAddr, ExitFrame: CORE_ADDR): Boolean;
- public
- InvalidSourceLine : boolean;
- { if true the current debugger raw will stay in middle of
- editor window when debugging PM }
- CenterDebuggerRow : TCentre;
- Disableallinvalidbreakpoints : boolean;
- OrigPwd, { pwd at startup }
- LastFileName : string;
- LastSource : PView; {PsourceWindow !! }
- HiddenStepsCount : longint;
- { no need to switch if using another terminal }
- NoSwitch : boolean;
- HasExe : boolean;
- RunCount : longint;
- WindowWidth : longint;
- FPCBreakErrorNumber : longint;
- {$ifdef SUPPORT_REMOTE}
- isRemoteDebugging,
- isFirstRemote,
- isConnectedToRemote,
- usessh :boolean;
- {$endif SUPPORT_REMOTE}
- constructor Init;
- procedure SetExe(const exefn:string);
- procedure SetWidth(AWidth : longint);
- procedure SetSourceDirs;
- destructor Done;
- procedure DoSelectSourceline(const fn:string;line:longint);virtual;
- { procedure DoStartSession;virtual;
- procedure DoBreakSession;virtual;}
- procedure DoEndSession(code:longint);virtual;
- procedure DoUserSignal;virtual;
- procedure FlushAll; virtual;
- function Query(question : pchar; args : pchar) : longint; virtual;
- procedure AnnotateError;
- procedure InsertBreakpoints;
- procedure RemoveBreakpoints;
- procedure ReadWatches;
- procedure RereadWatches;
- procedure ResetBreakpointsValues;
- procedure DoDebuggerScreen;virtual;
- procedure DoUserScreen;virtual;
- procedure Reset;virtual;
- procedure ResetDebuggerRows;
- procedure Run;virtual;
- procedure Continue;virtual;
- procedure UntilReturn;virtual;
- procedure CommandBegin(const s:string);virtual;
- procedure CommandEnd(const s:string);virtual;
- function IsRunning : boolean;
- function AllowQuit : boolean;virtual;
- function GetValue(Const expr : string) : pchar;
- function GetFramePointer : CORE_ADDR;
- function GetLongintAt(addr : CORE_ADDR) : longint;
- function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
- end;
- {$endif NODEBUG}
- BreakpointType = (bt_function,bt_file_line,bt_watch,
- bt_awatch,bt_rwatch,bt_address,bt_invalid);
- BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after);
- PBreakpointCollection=^TBreakpointCollection;
- PBreakpoint=^TBreakpoint;
- TBreakpoint=object(TObject)
- typ : BreakpointType;
- state : BreakpointState;
- owner : PBreakpointCollection;
- Name : PString; { either function name or expr to watch }
- FileName : PString;
- OldValue,CurrentValue : Pstring;
- Line : Longint; { only used for bt_file_line type }
- Conditions : PString; { conditions relative to that breakpoint }
- IgnoreCount : Longint; { how many counts should be ignored }
- Commands : pchar; { commands that should be executed on breakpoint }
- GDBIndex : longint;
- GDBState : BreakpointState;
- constructor Init_function(Const AFunc : String);
- constructor Init_Address(Const AAddress : String);
- constructor Init_Empty;
- constructor Init_file_line(AFile : String; ALine : longint);
- constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- procedure Insert;
- procedure Remove;
- procedure Enable;
- procedure Disable;
- procedure UpdateSource;
- procedure ResetValues;
- destructor Done;virtual;
- end;
- TBreakpointCollection=object(TCollection)
- function At(Index: Integer): PBreakpoint;
- function GetGDB(index : longint) : PBreakpoint;
- function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
- function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
- procedure Update;
- procedure ShowBreakpoints(W : PFPWindow);
- function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
- procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
- procedure ShowAllBreakpoints;
- end;
- PBreakpointItem = ^TBreakpointItem;
- TBreakpointItem = object(TObject)
- Breakpoint : PBreakpoint;
- constructor Init(ABreakpoint : PBreakpoint);
- function GetText(MaxLen: Sw_integer): string; virtual;
- procedure Selected; virtual;
- function GetModuleName: string; virtual;
- end;
- PBreakpointsListBox = ^TBreakpointsListBox;
- TBreakpointsListBox = object(THSListBox)
- Transparent : boolean;
- NoSelection : boolean;
- MaxWidth : Sw_integer;
- (* ModuleNames : PStoreCollection; *)
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- procedure AddBreakpoint(P: PBreakpointItem); virtual;
- function GetText(Item,MaxLen: Sw_Integer): String; virtual;
- function GetLocalMenu: PMenu;virtual;
- procedure Clear; virtual;
- procedure TrackSource; virtual;
- procedure EditNew; virtual;
- procedure EditCurrent; virtual;
- procedure DeleteCurrent; virtual;
- procedure ToggleCurrent;
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- destructor Done; virtual;
- end;
- PBreakpointsWindow = ^TBreakpointsWindow;
- TBreakpointsWindow = object(TFPDlgWindow)
- BreakLB : PBreakpointsListBox;
- constructor Init;
- procedure AddBreakpoint(ABreakpoint : PBreakpoint);
- procedure ClearBreakpoints;
- procedure ReloadBreakpoints;
- procedure Close; virtual;
- procedure SizeLimits(var Min, Max: TPoint);virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure Update; virtual;
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- destructor Done; virtual;
- end;
- PBreakpointItemDialog = ^TBreakpointItemDialog;
- TBreakpointItemDialog = object(TCenterDialog)
- constructor Init(ABreakpoint: PBreakpoint);
- function Execute: Word; virtual;
- private
- Breakpoint : PBreakpoint;
- TypeRB : PRadioButtons;
- NameIL : PEditorInputLine;
- ConditionsIL: PEditorInputLine;
- LineIL : PEditorInputLine;
- IgnoreIL : PEditorInputLine;
- end;
- PWatch = ^TWatch;
- TWatch = Object(TObject)
- expr : pstring;
- last_value,current_value : pchar;
- constructor Init(s : string);
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- procedure rename(s : string);
- procedure Get_new_value;
- procedure Force_new_value;
- destructor done;virtual;
- private
- GDBRunCount : longint;
- end;
- PWatchesCollection = ^TWatchesCollection;
- TWatchesCollection = Object(TCollection)
- constructor Init;
- procedure Insert(Item: Pointer); virtual;
- function At(Index: Integer): PWatch;
- procedure Update;
- private
- MaxW : integer;
- end;
- PWatchesListBox = ^TWatchesListBox;
- TWatchesListBox = object(THSListBox)
- Transparent : boolean;
- MaxWidth : Sw_integer;
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- (* procedure AddWatch(P: PWatch); virtual; *)
- procedure Update(AMaxWidth : integer);
- function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
- function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
- function GetLocalMenu: PMenu;virtual;
- (* procedure Clear; virtual;
- procedure TrackSource; virtual;*)
- procedure EditNew; virtual;
- procedure EditCurrent; virtual;
- procedure DeleteCurrent; virtual;
- (*procedure ToggleCurrent; *)
- procedure Draw; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- destructor Done; virtual;
- end;
- PWatchItemDialog = ^TWatchItemDialog;
- TWatchItemDialog = object(TCenterDialog)
- constructor Init(AWatch: PWatch);
- function Execute: Word; virtual;
- private
- Watch : PWatch;
- NameIL : PEditorInputLine;
- TextST : PAdvancedStaticText;
- end;
- PWatchesWindow = ^TWatchesWindow;
- TWatchesWindow = Object(TFPDlgWindow)
- WLB : PWatchesListBox;
- Constructor Init;
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- PFramesListBox = ^TFramesListBox;
- TFramesListBox = object(TMessageListBox)
- constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- procedure Update;
- function GetLocalMenu: PMenu;virtual;
- procedure GotoSource; virtual;
- procedure GotoAssembly; virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- destructor Done; virtual;
- end;
- PStackWindow = ^TStackWindow;
- TStackWindow = Object(TFPDlgWindow)
- FLB : PFramesListBox;
- Constructor Init;
- constructor Load(var S: TStream);
- procedure Store(var S: TStream);
- procedure Update; virtual;
- destructor Done; virtual;
- end;
- procedure InitStackWindow;
- procedure DoneStackWindow;
- function ActiveBreakpoints : boolean;
- function GDBFileName(st : string) : string;
- function OSFileName(st : string) : string;
- const
- BreakpointTypeStr : Array[BreakpointType] of String[9]
- = ( 'function','file-line','watch','awatch','rwatch','address','invalid');
- BreakpointStateStr : Array[BreakpointState] of String[8]
- = ( 'enabled','disabled','invalid',''{'to be deleted' should never be used});
- var
- {$ifndef NODEBUG}
- Debugger : PDebugController;
- {$endif NODEBUG}
- BreakpointsCollection : PBreakpointCollection;
- WatchesCollection : PwatchesCollection;
- procedure InitDebugger;
- procedure DoneDebugger;
- procedure InitGDBWindow;
- procedure DoneGDBWindow;
- procedure InitDisassemblyWindow;
- procedure DoneDisassemblyWindow;
- procedure InitBreakpoints;
- procedure DoneBreakpoints;
- procedure InitWatches;
- procedure DoneWatches;
- procedure RegisterFPDebugViews;
- procedure UpdateDebugViews;
- {$ifdef SUPPORT_REMOTE}
- function TransformRemoteString(st : string) : string;
- {$endif SUPPORT_REMOTE}
- implementation
- uses
- Dos,
- Video,
- {$ifdef DOS}
- fpusrscr,
- {$endif DOS}
- fpredir,
- App,Strings,
- FVConsts,
- MsgBox,
- {$ifdef Windows}
- Windebug,
- {$endif Windows}
- {$ifdef Unix}
- termio,
- {$endif Unix}
- Systems,Globals,
- FPRegs,FPTools,
- FPVars,FPUtils,FPConst,FPSwitch,
- FPIntf,FPCompil,FPIde,FPHelp,
- Validate,WUtils,Wconsts;
- const
- RBreakpointsWindow: TStreamRec = (
- ObjType: 1701;
- VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
- Load: @TBreakpointsWindow.Load;
- Store: @TBreakpointsWindow.Store
- );
- RBreakpointsListBox : TStreamRec = (
- ObjType: 1702;
- VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
- Load: @TBreakpointsListBox.Load;
- Store: @TBreakpointsListBox.Store
- );
- RWatchesWindow: TStreamRec = (
- ObjType: 1703;
- VmtLink: Ofs(TypeOf(TWatchesWindow)^);
- Load: @TWatchesWindow.Load;
- Store: @TWatchesWindow.Store
- );
- RWatchesListBox: TStreamRec = (
- ObjType: 1704;
- VmtLink: Ofs(TypeOf(TWatchesListBox)^);
- Load: @TWatchesListBox.Load;
- Store: @TWatchesListBox.Store
- );
- RStackWindow: TStreamRec = (
- ObjType: 1705;
- VmtLink: Ofs(TypeOf(TStackWindow)^);
- Load: @TStackWindow.Load;
- Store: @TStackWindow.Store
- );
- RFramesListBox: TStreamRec = (
- ObjType: 1706;
- VmtLink: Ofs(TypeOf(TFramesListBox)^);
- Load: @TFramesListBox.Load;
- Store: @TFramesListBox.Store
- );
- RBreakpoint: TStreamRec = (
- ObjType: 1707;
- VmtLink: Ofs(TypeOf(TBreakpoint)^);
- Load: @TBreakpoint.Load;
- Store: @TBreakpoint.Store
- );
- RWatch: TStreamRec = (
- ObjType: 1708;
- VmtLink: Ofs(TypeOf(TWatch)^);
- Load: @TWatch.Load;
- Store: @TWatch.Store
- );
- RBreakpointCollection: TStreamRec = (
- ObjType: 1709;
- VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
- Load: @TBreakpointCollection.Load;
- Store: @TBreakpointCollection.Store
- );
- RWatchesCollection: TStreamRec = (
- ObjType: 1710;
- VmtLink: Ofs(TypeOf(TWatchesCollection)^);
- Load: @TWatchesCollection.Load;
- Store: @TWatchesCollection.Store
- );
- {$ifdef USERESSTRINGS}
- resourcestring
- {$else}
- const
- {$endif}
- button_OK = 'O~K~';
- button_Cancel = 'Cancel';
- button_New = '~N~ew';
- button_Edit = '~E~dit';
- button_Delete = '~D~elete';
- button_Close = '~C~lose';
- button_ToggleButton = '~T~oggle';
- { Watches local menu items }
- menu_watchlocal_edit = '~E~dit watch';
- menu_watchlocal_new = '~N~ew watch';
- menu_watchlocal_delete = '~D~elete watch';
- { Breakpoints window local menu items }
- menu_bplocal_gotosource = '~G~oto source';
- menu_bplocal_editbreakpoint = '~E~dit breakpoint';
- menu_bplocal_newbreakpoint = '~N~ew breakpoint';
- menu_bplocal_deletebreakpoint = '~D~elete breakpoint';
- menu_bplocal_togglestate = '~T~oggle state';
- { Debugger messages and status hints }
- msg_programexitedwithcodeandsteps = #3'Program exited with '#13+
- #3'exitcode = %d'#13+
- #3'hidden steps = %d';
- msg_programexitedwithexitcode = #3'Program exited with '#13+
- #3'exitcode = %d';
- msg_programsignal = #3'Program recieved signal %s'#13+
- #3'%s';
- msg_runningprogram = 'Running...';
- msg_runningremotely = 'Executable running remotely on ';
- msg_connectingto = 'Connecting to ';
- msg_getting_info_on = 'Getting infos from ';
- msg_runninginanotherwindow = 'Executable running in another window..';
- msg_couldnotsetbreakpointat = #3'Could not set Breakpoint'#13+
- #3+'%s:%d';
- msg_couldnotsetbreakpointtype = #3'Could not set Breakpoint'#13+
- #3+'%s %s';
- button_DisableAllBreakpoints = 'Dis. ~a~ll invalid';
- { Breakpoints window }
- dialog_breakpointlist = 'Breakpoint list';
- label_breakpointpropheader = ' Type | State | Position | Path | Ignore | Conditions ';
- dialog_modifynewbreakpoint = 'Modify/New Breakpoint';
- label_breakpoint_name = '~N~ame';
- label_breakpoint_line = '~L~ine';
- label_breakpoint_conditions = '~C~onditions';
- label_breakpoint_ignorecount = '~I~gnore count';
- label_breakpoint_type = '~T~ype';
- { Watches window }
- dialog_watches = 'Watches';
- label_watch_expressiontowatch = '~E~xpression to watch';
- label_watch_values = 'Watch values';
- msg_watch_currentvalue = 'Current value: '+#13+
- '%s';
- msg_watch_currentandpreviousvalue = 'Current value: '+#13+
- '%s'+#13+
- 'Previous value: '+#13+
- '%s';
- dialog_callstack = 'Call Stack';
- menu_msglocal_saveas = 'Save ~a~s';
- msg_cantdebugchangetargetto = #3'Sorry, can not debug'#13+
- #3'programs compiled for %s.'#13+
- #3'Change target to %s?';
- msg_compiledwithoutdebuginforecompile =
- #3'Warning, the program'#13+
- #3'was compiled without'#13+
- #3'debugging info.'#13+
- #3'Recompile it?';
- msg_nothingtodebug = 'Oooops, nothing to debug.';
- msg_startingdebugger = 'Starting debugger';
- {$ifdef I386}
- const
- FrameName = '$ebp';
- {$define FrameNameKnown}
- {$endif i386}
- {$ifdef x86_64}
- const
- FrameName = '$rbp';
- {$define FrameNameKnown}
- {$endif x86_64}
- {$ifdef m68k}
- const
- FrameName = '$fp';
- {$define FrameNameKnown}
- {$endif m68k}
- {$ifdef powerpc}
- { stack and frame registers are the same on powerpc,
- so I am not sure that this will work PM }
- const
- FrameName = '$r1';
- {$define FrameNameKnown}
- {$endif powerpc}
- function GDBFileName(st : string) : string;
- {$ifndef Unix}
- var i : longint;
- {$endif Unix}
- begin
- {$ifdef NODEBUG}
- GDBFileName:=st;
- {$else NODEBUG}
- {$ifdef Unix}
- GDBFileName:=st;
- {$else}
- { should we also use / chars ? }
- for i:=1 to Length(st) do
- if st[i]='\' then
- {$ifdef Windows}
- { Don't touch at '\ ' used to escapes spaces in windows file names PM }
- if (i=length(st)) or (st[i+1]<>' ') then
- {$endif Windows}
- st[i]:='/';
- {$ifdef Windows}
- {$ifndef USE_MINGW_GDB} // see mantis 11968 because of mingw build. MvdV
- { for Windows we should convert e:\ into //e/ PM }
- if
- {$ifdef GDBMI}
- using_cygwin_gdb and
- {$endif}
- (length(st)>2) and (st[2]=':') and (st[3]='/') then
- st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
- {$endif}
- { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
- for i:=Length(st) downto 1 do
- if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
- st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
- {$endif Windows}
- {$ifdef go32v2}
- { for go32v2 we should convert //e/ back into e:/ PM }
- if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
- st:=st[3]+':/'+copy(st,5,length(st));
- {$endif go32v2}
- GDBFileName:=LowerCaseStr(st);
- {$endif}
- {$endif NODEBUG}
- end;
- function OSFileName(st : string) : string;
- {$ifndef Unix}
- var i : longint;
- {$endif Unix}
- begin
- {$ifdef Unix}
- OSFileName:=st;
- {$else}
- {$ifdef Windows}
- {$ifndef NODEBUG}
- { for Windows we should convert /cygdrive/e/ into e:\ PM }
- if pos(CygDrivePrefix+'/',st)=1 then
- st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
- {$endif NODEBUG}
- {$endif Windows}
- { support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
- for i:=Length(st) downto 2 do
- if (st[i]=' ') and (st[i-1]='\') then
- st:=copy(st,1,i-2)+copy(st,i,length(st));
- {$ifdef go32v2}
- { for go32v2 we should convert //e/ back into e:/ PM }
- if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
- st:=st[3]+':\'+copy(st,5,length(st));
- {$endif go32v2}
- { should we also use / chars ? }
- for i:=1 to Length(st) do
- if st[i]='/' then
- st[i]:='\';
- OSFileName:=LowerCaseStr(st);
- {$endif}
- end;
- {****************************************************************************
- TDebugController
- ****************************************************************************}
- procedure UpdateDebugViews;
- begin
- {$ifdef SUPPORT_REMOTE}
- if assigned(Debugger) and
- Debugger^.isRemoteDebugging then
- PushStatus(msg_getting_info_on+RemoteMachine);
- {$endif SUPPORT_REMOTE}
- DeskTop^.Lock;
- If assigned(StackWindow) then
- StackWindow^.Update;
- If assigned(RegistersWindow) then
- RegistersWindow^.Update;
- {$ifndef NODEBUG}
- If assigned(Debugger) then
- Debugger^.ReadWatches;
- {$endif NODEBUG}
- If assigned(FPUWindow) then
- FPUWindow^.Update;
- If assigned(VectorWindow) then
- VectorWindow^.Update;
- DeskTop^.UnLock;
- {$ifdef SUPPORT_REMOTE}
- if assigned(Debugger) and
- Debugger^.isRemoteDebugging then
- PopStatus;
- {$endif SUPPORT_REMOTE}
- end;
- {$ifndef NODEBUG}
- constructor TDebugController.Init;
- begin
- inherited Init;
- CenterDebuggerRow:=IniCenterDebuggerRow;
- Disableallinvalidbreakpoints:=false;
- NoSwitch:=False;
- HasExe:=false;
- Debugger:=@self;
- WindowWidth:=-1;
- switch_to_user:=true;
- GetDir(0,OrigPwd);
- Command('set print object off');
- {$ifdef SUPPORT_REMOTE}
- isFirstRemote:=true;
- {$ifdef FPC_ARMEL32}
- { GDB needs advice on exact file type }
- Command('set gnutarget elf32-littlearm');
- {$endif FPC_ARMEL32}
- {$endif SUPPORT_REMOTE}
- end;
- procedure TDebugController.SetExe(const exefn:string);
- var f : string;
- begin
- f := GDBFileName(GetShortName(exefn));
- if (f<>'') and ExistsFile(exefn) then
- begin
- if not LoadFile(f) then
- begin
- HasExe:=false;
- MessageBox(#3'Failed to load file '#13#3+f,nil,mfOKbutton);
- exit;
- end;
- HasExe:=true;
- { Procedure HandleErrorAddrFrame
- (Errno : longint;addr,frame : longint);
- [public,alias:'FPC_BREAK_ERROR'];}
- FPCBreakErrorNumber:=BreakpointInsert('FPC_BREAK_ERROR', []);
- {$ifdef FrameNameKnown}
- { this fails in GDB 5.1 because
- GDB replies that there is an attempt to dereference
- a generic pointer...
- test delayed in DoSourceLine... PM
- Command('cond '+IntToStr(FPCBreakErrorNumber)+
- ' (('+FrameName+' + 8)^ <> 0) or'+
- ' (('+FrameName+' + 12)^ <> 0)'); }
- {$endif FrameNameKnown}
- SetArgs(GetRunParameters);
- SetSourceDirs;
- InsertBreakpoints;
- ReadWatches;
- end
- else
- begin
- HasExe:=false;
- reset_command:=true;
- {$ifdef GDBMI}
- Command('-file-exec-and-symbols');
- {$else GDBMI}
- Command('file');
- {$endif GDBMI}
- reset_command:=false;
- end;
- end;
- procedure TDebugController.SetWidth(AWidth : longint);
- begin
- WindowWidth:=AWidth;
- Command('set width '+inttostr(WindowWidth));
- end;
- procedure TDebugController.SetSourceDirs;
- const
- {$ifdef GDBMI}
- AddSourceDirCommand = '-environment-directory';
- {$else GDBMI}
- AddSourceDirCommand = 'dir';
- {$endif GDBMI}
- var f,s: ansistring;
- i : longint;
- Dir : SearchRec;
- begin
- f:=GetSourceDirectories+';'+OrigPwd;
- repeat
- i:=pos(';',f);
- if i=0 then
- s:=f
- else
- begin
- s:=copy(f,1,i-1);
- system.delete(f,1,i);
- end;
- DefaultReplacements(s);
- if (pos('*',s)=0) and ExistsDir(s) then
- Command(AddSourceDirCommand+' '+GDBFileName(GetShortName(s)))
- { we should also handle the /* cases of -Fu option }
- else if pos('*',s)>0 then
- begin
- Dos.FindFirst(s,Directory,Dir);
- { the '*' can only be in the last dir level }
- s:=DirOf(s);
- while Dos.DosError=0 do
- begin
- if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
- Command(AddSourceDirCommand+' '+GDBFileName(GetShortName(s+Dir.Name)));
- Dos.FindNext(Dir);
- end;
- Dos.FindClose(Dir);
- end;
- until i=0;
- end;
- procedure TDebugController.InsertBreakpoints;
- procedure DoInsert(PB : PBreakpoint);
- begin
- PB^.Insert;
- end;
- begin
- BreakpointsCollection^.ForEach(@DoInsert);
- Disableallinvalidbreakpoints:=false;
- end;
- procedure TDebugController.ReadWatches;
- procedure DoRead(PB : PWatch);
- begin
- PB^.Get_new_value;
- end;
- begin
- WatchesCollection^.ForEach(@DoRead);
- If Assigned(WatchesWindow) then
- WatchesWindow^.Update;
- end;
- procedure TDebugController.RereadWatches;
- procedure DoRead(PB : PWatch);
- begin
- PB^.Force_new_value;
- end;
- begin
- WatchesCollection^.ForEach(@DoRead);
- If Assigned(WatchesWindow) then
- WatchesWindow^.Update;
- end;
- procedure TDebugController.RemoveBreakpoints;
- procedure DoDelete(PB : PBreakpoint);
- begin
- PB^.Remove;
- end;
- begin
- BreakpointsCollection^.ForEach(@DoDelete);
- end;
- procedure TDebugController.ResetBreakpointsValues;
- procedure DoResetVal(PB : PBreakpoint);
- begin
- PB^.ResetValues;
- end;
- begin
- BreakpointsCollection^.ForEach(@DoResetVal);
- end;
- destructor TDebugController.Done;
- begin
- { kill the program if running }
- Reset;
- RemoveBreakpoints;
- inherited Done;
- end;
- procedure TDebugController.Run;
- const
- {$ifdef GDBMI}
- SetTTYCommand = '-inferior-tty-set';
- {$else GDBMI}
- SetTTYCommand = 'tty';
- {$endif GDBMI}
- {$ifdef Unix}
- var
- Debuggeefile : text;
- ResetOK, TTYUsed : boolean;
- {$endif Unix}
- {$ifdef PALMOSGDB}
- const
- TargetProtocol = 'palmos';
- {$else}
- const
- TargetProtocol = 'extended-remote';
- {$endif PALMOSGDB}
- {$ifdef SUPPORT_REMOTE}
- var
- S,ErrorStr : string;
- ErrorVal : longint;
- {$endif SUPPORT_REMOTE}
- begin
- ResetBreakpointsValues;
- {$ifdef SUPPORT_REMOTE}
- NoSwitch:=true;
- isRemoteDebugging:=false;
- if TargetProtocol<>'extended-remote' then
- isConnectedToRemote:=false;
- usessh:=true;
- {$ifndef CROSSGDB}
- If (RemoteMachine<>'') and (RemotePort<>'') then
- {$else CROSSGDB}
- if true then
- {$endif CROSSGDB}
- begin
- isRemoteDebugging:=true;
- if UseSsh and not isConnectedToRemote then
- begin
- s:=TransformRemoteString(RemoteSshExecCommand);
- PushStatus(S);
- {$ifdef Unix}
- error:=0;
- { return without waiting for the function to end }
- s:= s+' &';
- If fpsystem(s)=-1 Then
- ErrorVal:=fpgeterrno;
- {$else}
- IDEApp.DoExecute(GetEnv('COMSPEC'),'/C '+s,'','ssh__.out','ssh___.err',exNormal);
- ErrorVal:=DosError;
- {$endif}
- PopStatus;
- // if errorval <> 0 then
- // AdvMessageBoxRect(var R: TRect; const Msg: String; Params: Pointer; AOptions: longint): Word;
- AddToolMessage('',#3'Start'#13#3+s+#13#3'returned '+
- IntToStr(Errorval),0,0);
- end
- else if not UseSsh then
- begin
- s:=TransformRemoteString(RemoteExecCommand);
- MessageBox(#3'Start in remote'#13#3+s,nil,mfOKbutton);
- end;
- if usessh then
- { we use ssh port redirection }
- S:='localhost'
- //S:=TransformRemoteString('$REMOTEMACHINE')
- else
- S:=RemoteMachine;
- If pos('@',S)>0 then
- S:=copy(S,pos('@',S)+1,High(S));
- If RemotePort<>'' then
- S:=S+':'+RemotePort;
- {$ifdef PALMOSGDB}
- { set the default value for PalmOS }
- If S='' then
- S:='localhost:2000';
- {$endif PALMOSGDB}
- PushStatus(msg_connectingto+S);
- AddToolMessage('',msg_connectingto+S,0,0);
- UpdateToolMessages;
- if not isConnectedToRemote then
- Command('target '+TargetProtocol+' '+S);
- if Error then
- begin
- ErrorStr:=strpas(GetError);
- ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil);
- PopStatus;
- exit;
- end
- else
- isConnectedToRemote:=true;
- PopStatus;
- end
- else
- begin
- {$endif SUPPORT_REMOTE}
- {$ifdef Windows}
- { Run the debugge in another console }
- if DebuggeeTTY<>'' then
- Command('set new-console on')
- else
- Command('set new-console off');
- NoSwitch:=DebuggeeTTY<>'';
- {$endif Windows}
- {$ifdef Unix}
- { Run the debuggee in another tty }
- if DebuggeeTTY <> '' then
- begin
- {$I-}
- Assign(Debuggeefile,DebuggeeTTY);
- system.Reset(Debuggeefile);
- ResetOK:=IOResult=0;
- If ResetOK and (IsATTY(textrec(Debuggeefile).handle)<>-1) then
- begin
- Command(SetTTYCommand+' '+DebuggeeTTY);
- TTYUsed:=true;
- end
- else
- begin
- Command(SetTTYCommand+' ');
- TTYUsed:=false;
- end;
- if ResetOK then
- close(Debuggeefile);
- if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
- NoSwitch:= true
- else
- NoSwitch:=false;
- end
- else
- begin
- if TTYName(input)<>'' then
- Command(SetTTYCommand+' '+TTYName(input));
- NoSwitch := false;
- end;
- {$endif Unix}
- {$ifdef SUPPORT_REMOTE}
- end;
- {$endif SUPPORT_REMOTE}
- { Switch to user screen to get correct handles }
- UserScreen;
- {$ifdef SUPPORT_REMOTE}
- if isRemoteDebugging then
- begin
- inc(init_count);
- { pass the stop in start code }
- if isFirstRemote then
- Command('continue')
- else
- Command ('start');
- isFirstRemote:=false;
- end
- else
- {$endif SUPPORT_REMOTE}
- begin
- { Set cwd for debuggee }
- SetDir(GetRunDir);
- inherited Run;
- { Restore cwd for IDE }
- SetDir(StartupDir);
- end;
- DebuggerScreen;
- IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
- IDEApp.UpdateRunMenu(true);
- UpdateDebugViews;
- end;
- function TDebugController.IsRunning : boolean;
- begin
- IsRunning:=debuggee_started;
- end;
- procedure TDebugController.Continue;
- begin
- {$ifdef NODEBUG}
- NoDebugger;
- {$else}
- if not debuggee_started then
- Run
- else
- inherited Continue;
- UpdateDebugViews;
- {$endif NODEBUG}
- end;
- procedure TDebugController.UntilReturn;
- begin
- inherited UntilReturn;
- UpdateDebugViews;
- { We could try to get the return value !
- Not done yet }
- end;
- procedure TDebugController.CommandBegin(const s:string);
- begin
- if assigned(GDBWindow) and (in_command>1) then
- begin
- { We should do something special for errors !! }
- If StrLen(GetError)>0 then
- GDBWindow^.WriteErrorText(GetError);
- GDBWindow^.WriteOutputText(GetOutput);
- end;
- if assigned(GDBWindow) then
- GDBWindow^.WriteString(S);
- end;
- function TDebugController.Query(question : pchar; args : pchar) : longint;
- var
- c : char;
- WasModal : boolean;
- ModalView : PView;
- res : longint;
- begin
- if not assigned(Application) then
- begin
- system.Write(question);
- repeat
- system.write('(y or n)');
- system.read(c);
- system.writeln(c);
- until (lowercase(c)='y') or (lowercase(c)='n');
- if lowercase(c)='y' then
- query:=1
- else
- query:=0;
- exit;
- end;
- if assigned(Application^.Current) and
- ((Application^.Current^.State and sfModal)<>0) then
- begin
- WasModal:=true;
- ModalView:=Application^.Current;
- ModalView^.SetState(sfModal, false);
- ModalView^.Hide;
- end
- else
- WasModal:=false;
- PushStatus(Question);
- res:=MessageBox(Question,nil,mfyesbutton+mfnobutton);
- PopStatus;
- if res=cmYes then
- Query:=1
- else
- Query:=0;
- if WasModal then
- begin
- ModalView^.Show;
- ModalView^.SetState(sfModal, true);
- ModalView^.Draw;
- end;
- end;
- procedure TDebugController.FlushAll;
- begin
- if assigned(GDBWindow) then
- begin
- If StrLen(GetError)>0 then
- begin
- GDBWindow^.WriteErrorText(GetError);
- if in_command=0 then
- gdberrorbuf.reset;
- end;
- If StrLen(GetOutput)>0 then
- begin
- GDBWindow^.WriteOutputText(GetOutput);
- { Keep output for command results }
- if in_command=0 then
- gdboutputbuf.reset;
- end;
- end
- else
- Inherited FlushAll;
- end;
- procedure TDebugController.CommandEnd(const s:string);
- begin
- if assigned(GDBWindow) and (in_command<=1) then
- begin
- { We should do something special for errors !! }
- If StrLen(GetError)>0 then
- GDBWindow^.WriteErrorText(GetError);
- GDBWindow^.WriteOutputText(GetOutput);
- GDBWindow^.Editor^.TextEnd;
- end;
- end;
- function TDebugController.AllowQuit : boolean;
- begin
- if IsRunning then
- begin
- if ConfirmBox('Really quit GDB window'#13+
- 'and kill running program?',nil,true)=cmYes then
- begin
- Reset;
- DoneGDBWindow;
- {AllowQuit:=true;}
- AllowQuit:=false;
- end
- else
- AllowQuit:=false;
- end
- else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
- begin
- DoneGDBWindow;
- {AllowQuit:=true;}
- AllowQuit:=false;
- end
- else
- AllowQuit:=false;
- end;
- procedure TDebugController.ResetDebuggerRows;
- procedure ResetDebuggerRow(P: PView);
- begin
- if assigned(P) and
- (TypeOf(P^)=TypeOf(TSourceWindow)) then
- PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
- end;
- begin
- Desktop^.ForEach(@ResetDebuggerRow);
- end;
- procedure TDebugController.Reset;
- var
- old_reset : boolean;
- begin
- {$ifdef SUPPORT_REMOTE}
- if isConnectedToRemote then
- begin
- Command('monitor exit');
- Command('disconnect');
- isConnectedToRemote:=false;
- isFirstRemote:=true;
- end;
- {$endif SUPPORT_REMOTE}
- inherited Reset;
- { we need to free the executable
- if we want to recompile it }
- old_reset:=reset_command;
- reset_command:=true;
- SetExe('');
- reset_command:=old_reset;
- NoSwitch:=false;
- { In case we have something that the compiler touched }
- If IDEApp.IsRunning then
- begin
- IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
- IDEApp.UpdateRunMenu(false);
- AskToReloadAllModifiedFiles;
- ResetDebuggerRows;
- end;
- end;
- procedure TDebugController.AnnotateError;
- var errornb : longint;
- begin
- if error then
- begin
- errornb:=error_num;
- UpdateDebugViews;
- ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
- end;
- end;
- function TDebugController.GetValue(Const expr : string) : pchar;
- var
- p,p2,p3 : pchar;
- begin
- if WindowWidth<>-1 then
- Command('set width 0xffffffff');
- Command('p '+expr);
- p:=GetOutput;
- p3:=nil;
- if assigned(p) and (p[strlen(p)-1]=#10) then
- begin
- p3:=p+strlen(p)-1;
- p3^:=#0;
- end;
- if assigned(p) then
- p2:=strpos(p,'=')
- else
- p2:=nil;
- if assigned(p2) then
- p:=p2+1;
- while p^ in [' ',TAB] do
- inc(p);
- { get rid of type }
- if p^ = '(' then
- p:=strpos(p,')')+1;
- while p^ in [' ',TAB] do
- inc(p);
- if assigned(p) then
- GetValue:=StrNew(p)
- else
- GetValue:=StrNew(GetError);
- if assigned(p3) then
- p3^:=#10;
- got_error:=false;
- if WindowWidth<>-1 then
- Command('set width '+IntToStr(WindowWidth));
- end;
- function TDebugController.GetFramePointer : CORE_ADDR;
- var
- st : string;
- p : longint;
- begin
- {$ifdef FrameNameKnown}
- Command('p /d '+FrameName);
- st:=strpas(GetOutput);
- p:=pos('=',st);
- while (p<length(st)) and (st[p+1] in [' ',#9]) do
- inc(p);
- Delete(st,1,p);
- p:=1;
- while (st[p] in ['0'..'9']) do
- inc(p);
- Delete(st,p,High(st));
- GetFramePointer:=StrToCard(st);
- {$else not FrameNameKnown}
- GetFramePointer:=0;
- {$endif not FrameNameKnown}
- end;
- function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
- var
- st : string;
- p : longint;
- begin
- Command('x /wd 0x'+hexstr(longint(addr),8));
- st:=strpas(GetOutput);
- p:=pos(':',st);
- while (p<length(st)) and (st[p+1] in [' ',#9]) do
- inc(p);
- Delete(st,1,p);
- p:=1;
- while (st[p] in ['0'..'9']) do
- inc(p);
- Delete(st,p,High(st));
- GetLongintAt:=StrToInt(st);
- end;
- function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
- var
- st : string;
- p : longint;
- code : integer;
- begin
- Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
- st:=strpas(GetOutput);
- p:=pos(':',st);
- while (p<length(st)) and (st[p+1] in [' ',#9]) do
- inc(p);
- if (p<length(st)) and (st[p+1]='$') then
- inc(p);
- Delete(st,1,p);
- p:=1;
- while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
- inc(p);
- Delete(st,p,High(st));
- Val('$'+st,GetPointerAt,code);
- end;
- function TDebugController.GetFPCBreakErrorParameters(var ExitCode: LongInt; var ExitAddr, ExitFrame: CORE_ADDR): Boolean;
- const
- { try to find the parameters }
- FirstArgOffset = -sizeof(pointer);
- SecondArgOffset = 2*-sizeof(pointer);
- ThirdArgOffset = 3*-sizeof(pointer);
- begin
- // Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer);
- // [public,alias:'FPC_BREAK_ERROR']; {$ifdef cpui386} register; {$endif}
- {$if defined(i386)}
- GetFPCBreakErrorParameters :=
- GetIntRegister('eax', ExitCode) and
- GetIntRegister('edx', ExitAddr) and
- GetIntRegister('ecx', ExitFrame);
- {$elseif defined(x86_64)}
- {$ifdef Win64}
- GetFPCBreakErrorParameters :=
- GetIntRegister('rcx', ExitCode) and
- GetIntRegister('rdx', ExitAddr) and
- GetIntRegister('r8', ExitFrame);
- {$else Win64}
- GetFPCBreakErrorParameters :=
- GetIntRegister('rdi', ExitCode) and
- GetIntRegister('rsi', ExitAddr) and
- GetIntRegister('rdx', ExitFrame);
- {$endif Win64}
- {$elseif defined(FrameNameKnown)}
- ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
- ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
- ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
- GetFPCBreakErrorParameters := True;
- {$else}
- ExitCode := 0;
- ExitAddr := 0;
- ExitFrame := 0;
- GetFPCBreakErrorParameters := False;
- {$endif}
- end;
- procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
- var
- W: PSourceWindow;
- Found : boolean;
- PB : PBreakpoint;
- S : String;
- BreakIndex : longint;
- stop_addr : CORE_ADDR;
- i,ExitCode : longint;
- ExitAddr,ExitFrame : CORE_ADDR;
- begin
- BreakIndex:=stop_breakpoint_number;
- Desktop^.Lock;
- { 0 based line count in Editor }
- if Line>0 then
- dec(Line);
- S:=fn;
- stop_addr:=current_pc;
- if (BreakIndex=FPCBreakErrorNumber) then
- begin
- if GetFPCBreakErrorParameters(ExitCode, ExitAddr, ExitFrame) then
- begin
- if (ExitCode=0) and (ExitAddr=0) then
- begin
- Desktop^.Unlock;
- Command('continue');
- exit;
- end;
- Backtrace;
- for i:=0 to frame_count-1 do
- begin
- with frames[i]^ do
- begin
- if ExitAddr=address then
- begin
- Command('f '+IntToStr(i));
- if assigned(file_name) then
- begin
- s:=strpas(file_name);
- line:=line_number;
- stop_addr:=address;
- end;
- break;
- end;
- end;
- end;
- end;
- end;
- { Update Disassembly position }
- if Assigned(DisassemblyWindow) then
- DisassemblyWindow^.SetCurAddress(stop_addr);
- if (fn=LastFileName) then
- begin
- W:=PSourceWindow(LastSource);
- if assigned(W) then
- begin
- W^.Editor^.SetCurPtr(0,Line);
- W^.Editor^.TrackCursor(CenterDebuggerRow);
- W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
- UpdateDebugViews;
- {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- handled by SelectInDebugSession}
- W^.SelectInDebugSession;
- InvalidSourceLine:=false;
- end
- else
- InvalidSourceLine:=true;
- end
- else
- begin
- if s='' then
- W:=nil
- else
- W:=TryToOpenFile(nil,s,0,Line,false);
- if assigned(W) then
- begin
- W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
- W^.Editor^.TrackCursor(CenterDebuggerRow);
- UpdateDebugViews;
- {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- handled by SelectInDebugSession}
- W^.SelectInDebugSession;
- LastSource:=W;
- InvalidSourceLine:=false;
- end
- { only search a file once }
- else
- begin
- Desktop^.UnLock;
- if s='' then
- Found:=false
- else
- { it is easier to handle with a * at the end }
- Found:=IDEApp.OpenSearch(s+'*');
- Desktop^.Lock;
- if not Found then
- begin
- InvalidSourceLine:=true;
- LastSource:=Nil;
- { Show the stack in that case }
- InitStackWindow;
- UpdateDebugViews;
- StackWindow^.MakeFirst;
- end
- else
- begin
- { should now be open }
- W:=TryToOpenFile(nil,s,0,Line,true);
- W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
- W^.Editor^.TrackCursor(CenterDebuggerRow);
- UpdateDebugViews;
- {if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
- handled by SelectInDebugSession}
- W^.SelectInDebugSession;
- LastSource:=W;
- InvalidSourceLine:=false;
- end;
- end;
- end;
- LastFileName:=s;
- Desktop^.UnLock;
- if BreakIndex>0 then
- begin
- PB:=BreakpointsCollection^.GetGDB(BreakIndex);
- if (BreakIndex=FPCBreakErrorNumber) then
- begin
- if (ExitCode<>0) or (ExitAddr<>0) then
- WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
- #3'Error address $'+HexStr(ExitAddr,8),nil)
- else
- WarningBox(#3'Run Time Error',nil);
- end
- else if not assigned(PB) then
- begin
- if (BreakIndex<>start_break_number) and
- (BreakIndex<>TbreakNumber) then
- WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
- if BreakIndex=start_break_number then
- start_break_number:=0;
- if BreakIndex=TbreakNumber then
- TbreakNumber:=0;
- end
- { For watch we should get old and new value !! }
- else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
- (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
- (PB^.typ<>bt_address) then
- begin
- Command('p '+GetStr(PB^.Name));
- S:=GetPChar(GetOutput);
- got_error:=false;
- If Pos('=',S)>0 then
- S:=Copy(S,Pos('=',S)+1,255);
- If S[Length(S)]=#10 then
- Delete(S,Length(S),1);
- if Assigned(PB^.OldValue) then
- DisposeStr(PB^.OldValue);
- PB^.OldValue:=PB^.CurrentValue;
- PB^.CurrentValue:=NewStr(S);
- If PB^.typ=bt_function then
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
- else if (GetStr(PB^.OldValue)<>S) then
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
- #3+'Old value = '+GetStr(PB^.OldValue)+#13+
- #3+'New value = '+GetStr(PB^.CurrentValue),nil)
- else
- WarningBox(#3'GDB stopped due to'#13+
- #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
- #3+' value = '+GetStr(PB^.CurrentValue),nil);
- end;
- end;
- end;
- procedure TDebugController.DoUserSignal;
- var P :Array[1..2] of pstring;
- S1, S2 : string;
- begin
- S1:=strpas(signal_name);
- S2:=strpas(signal_string);
- P[1]:=@S1;
- P[2]:=@S2;
- WarningBox(msg_programsignal,@P);
- end;
- procedure TDebugController.DoEndSession(code:longint);
- var P :Array[1..2] of longint;
- begin
- IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
- IDEApp.UpdateRunMenu(false);
- ResetDebuggerRows;
- LastExitCode:=Code;
- If HiddenStepsCount=0 then
- InformationBox(msg_programexitedwithexitcode,@code)
- else
- begin
- P[1]:=code;
- P[2]:=HiddenStepsCount;
- WarningBox(msg_programexitedwithcodeandsteps,@P);
- end;
- { In case we have something that the compiler touched }
- AskToReloadAllModifiedFiles;
- {$ifdef Windows}
- main_pid_valid:=false;
- {$endif Windows}
- end;
- procedure TDebugController.DoDebuggerScreen;
- {$ifdef Windows}
- var
- IdeMode : DWord;
- {$endif Windows}
- begin
- if NoSwitch then
- begin
- PopStatus;
- end
- else
- begin
- IDEApp.ShowIDEScreen;
- Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
- PopStatus;
- end;
- {$ifdef Windows}
- if NoSwitch then
- begin
- { Ctrl-C as normal char }
- GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
- IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
- SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
- end;
- ChangeDebuggeeWindowTitleTo(Stopped_State);
- {$endif Windows}
- If assigned(GDBWindow) then
- GDBWindow^.Editor^.UnLock;
- end;
- procedure TDebugController.DoUserScreen;
- {$ifdef Windows}
- var
- IdeMode : DWord;
- {$endif Windows}
- begin
- Inc(RunCount);
- if NoSwitch then
- begin
- {$ifdef SUPPORT_REMOTE}
- if isRemoteDebugging then
- PushStatus(msg_runningremotely+RemoteMachine)
- else
- {$endif SUPPORT_REMOTE}
- {$ifdef Unix}
- PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
- {$else not Unix}
- PushStatus(msg_runninginanotherwindow);
- {$endif Unix}
- end
- else
- begin
- PushStatus(msg_runningprogram);
- IDEApp.ShowUserScreen;
- end;
- {$ifdef Windows}
- if NoSwitch then
- begin
- { Ctrl-C as interrupt }
- GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
- IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
- SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
- end;
- ChangeDebuggeeWindowTitleTo(Running_State);
- {$endif Windows}
- { Don't try to print GDB messages while in User Screen mode }
- If assigned(GDBWindow) then
- GDBWindow^.Editor^.Lock;
- end;
- {$endif NODEBUG}
- {****************************************************************************
- TBreakpoint
- ****************************************************************************}
- function ActiveBreakpoints : boolean;
- var
- IsActive : boolean;
- procedure TestActive(PB : PBreakpoint);
- begin
- If PB^.state=bs_enabled then
- IsActive:=true;
- end;
- begin
- IsActive:=false;
- If assigned(BreakpointsCollection) then
- BreakpointsCollection^.ForEach(@TestActive);
- ActiveBreakpoints:=IsActive;
- end;
- constructor TBreakpoint.Init_function(Const AFunc : String);
- begin
- typ:=bt_function;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=NewStr(AFunc);
- FileName:=nil;
- Line:=0;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_Address(Const AAddress : String);
- begin
- typ:=bt_address;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=NewStr(AAddress);
- FileName:=nil;
- Line:=0;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_Empty;
- begin
- typ:=bt_function;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=Nil;
- FileName:=nil;
- Line:=0;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
- begin
- typ:=atyp;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- Name:=NewStr(AnExpr);
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
- var
- CurDir : String;
- begin
- typ:=bt_file_line;
- state:=bs_enabled;
- GDBState:=bs_deleted;
- AFile:=FEXpand(AFile);
- (*
- { d:test.pas:12 does not work !! }
- { I do not know how to solve this if
- if (Length(AFile)>1) and (AFile[2]=':') then
- AFile:=Copy(AFile,3,255); }
- {$ifdef Unix}
- CurDir:=GetCurDir;
- {$else}
- CurDir:=LowerCaseStr(GetCurDir);
- {$endif Unix}
- if Pos(CurDir,OSFileName(AFile))=1 then
- FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
- else
- *)
- FileName:=NewStr(OSFileName(AFile));
- Name:=nil;
- Line:=ALine;
- IgnoreCount:=0;
- Commands:=nil;
- Conditions:=nil;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- constructor TBreakpoint.Load(var S: TStream);
- var
- FName : PString;
- begin
- S.Read(typ,SizeOf(BreakpointType));
- S.Read(state,SizeOf(BreakpointState));
- GDBState:=bs_deleted;
- case typ of
- bt_file_line :
- begin
- { convert to current target }
- FName:=S.ReadStr;
- FileName:=NewStr(OSFileName(GetStr(FName)));
- If Assigned(FName) then
- DisposeStr(FName);
- S.Read(Line,SizeOf(Line));
- Name:=nil;
- end;
- else
- begin
- Name:=S.ReadStr;
- Line:=0;
- FileName:=nil;
- end;
- end;
- S.Read(IgnoreCount,SizeOf(IgnoreCount));
- Commands:=S.StrRead;
- Conditions:=S.ReadStr;
- OldValue:=nil;
- CurrentValue:=nil;
- end;
- procedure TBreakpoint.Store(var S: TStream);
- var
- St : String;
- begin
- S.Write(typ,SizeOf(BreakpointType));
- S.Write(state,SizeOf(BreakpointState));
- case typ of
- bt_file_line :
- begin
- st:=OSFileName(GetStr(FileName));
- S.WriteStr(@St);
- S.Write(Line,SizeOf(Line));
- end;
- else
- begin
- S.WriteStr(Name);
- end;
- end;
- S.Write(IgnoreCount,SizeOf(IgnoreCount));
- S.StrWrite(Commands);
- S.WriteStr(Conditions);
- end;
- procedure TBreakpoint.Insert;
- var
- p,p2 : pchar;
- st : string;
- bkpt_no: LongInt = 0;
- begin
- {$ifndef NODEBUG}
- If not assigned(Debugger) then Exit;
- Remove;
- if (GDBState=bs_deleted) and (state=bs_enabled) then
- begin
- if (typ=bt_file_line) and assigned(FileName) then
- bkpt_no := Debugger^.BreakpointInsert(GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line), [])
- else if (typ=bt_function) and assigned(name) then
- bkpt_no := Debugger^.BreakpointInsert(name^, [])
- else if (typ=bt_address) and assigned(name) then
- bkpt_no := Debugger^.BreakpointInsert('*0x'+name^, [])
- else if (typ=bt_watch) and assigned(name) then
- bkpt_no := Debugger^.WatchpointInsert(name^, wtWrite)
- else if (typ=bt_awatch) and assigned(name) then
- bkpt_no := Debugger^.WatchpointInsert(name^, wtReadWrite)
- else if (typ=bt_rwatch) and assigned(name) then
- bkpt_no := Debugger^.WatchpointInsert(name^, wtRead);
- if bkpt_no<>0 then
- begin
- GDBIndex:=bkpt_no;
- GDBState:=bs_enabled;
- Debugger^.BreakpointCondition(GDBIndex, GetStr(Conditions));
- If IgnoreCount>0 then
- Debugger^.BreakpointSetIgnoreCount(GDBIndex, IgnoreCount);
- If Assigned(Commands) then
- begin
- {Commands are not handled yet }
- Debugger^.Command('command '+IntToStr(GDBIndex));
- p:=commands;
- while assigned(p) do
- begin
- p2:=strscan(p,#10);
- if assigned(p2) then
- p2^:=#0;
- st:=strpas(p);
- Debugger^.command(st);
- if assigned(p2) then
- p2^:=#10;
- p:=p2;
- if assigned(p) then
- inc(p);
- end;
- Debugger^.Command('end');
- end;
- end
- else
- { Here there was a problem !! }
- begin
- GDBIndex:=0;
- if not Debugger^.Disableallinvalidbreakpoints then
- begin
- if (typ=bt_file_line) and assigned(FileName) then
- begin
- ClearFormatParams;
- AddFormatParamStr(NameAndExtOf(FileName^));
- AddFormatParamInt(Line);
- if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
- Debugger^.Disableallinvalidbreakpoints:=true;
- end
- else
- begin
- ClearFormatParams;
- AddFormatParamStr(BreakpointTypeStr[typ]);
- AddFormatParamStr(GetStr(Name));
- if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
- Debugger^.Disableallinvalidbreakpoints:=true;
- end;
- end;
- state:=bs_disabled;
- UpdateSource;
- end;
- end
- else if (GDBState=bs_disabled) and (state=bs_enabled) then
- Enable
- else if (GDBState=bs_enabled) and (state=bs_disabled) then
- Disable;
- {$endif NODEBUG}
- end;
- procedure TBreakpoint.Remove;
- begin
- {$ifndef NODEBUG}
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.BreakpointDelete(GDBIndex);
- GDBIndex:=0;
- GDBState:=bs_deleted;
- {$endif NODEBUG}
- end;
- procedure TBreakpoint.Enable;
- begin
- {$ifndef NODEBUG}
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.BreakpointEnable(GDBIndex)
- else
- Insert;
- GDBState:=bs_disabled;
- {$endif NODEBUG}
- end;
- procedure TBreakpoint.Disable;
- begin
- {$ifndef NODEBUG}
- If not assigned(Debugger) then Exit;
- if GDBIndex>0 then
- Debugger^.BreakpointDisable(GDBIndex);
- GDBState:=bs_disabled;
- {$endif NODEBUG}
- end;
- procedure TBreakpoint.ResetValues;
- begin
- if assigned(OldValue) then
- DisposeStr(OldValue);
- OldValue:=nil;
- if assigned(CurrentValue) then
- DisposeStr(CurrentValue);
- CurrentValue:=nil;
- end;
- procedure TBreakpoint.UpdateSource;
- var W: PSourceWindow;
- b : boolean;
- begin
- if typ=bt_file_line then
- begin
- W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
- If assigned(W) then
- begin
- if state=bs_enabled then
- b:=true
- else
- b:=false;
- W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
- end;
- end;
- end;
- destructor TBreakpoint.Done;
- begin
- Remove;
- ResetValues;
- if assigned(Name) then
- DisposeStr(Name);
- if assigned(FileName) then
- DisposeStr(FileName);
- if assigned(Conditions) then
- DisposeStr(Conditions);
- if assigned(Commands) then
- StrDispose(Commands);
- inherited Done;
- end;
- {****************************************************************************
- TBreakpointCollection
- ****************************************************************************}
- function TBreakpointCollection.At(Index: Integer): PBreakpoint;
- begin
- At:=inherited At(Index);
- end;
- procedure TBreakpointCollection.Update;
- begin
- {$ifndef NODEBUG}
- if assigned(Debugger) then
- begin
- Debugger^.RemoveBreakpoints;
- Debugger^.InsertBreakpoints;
- end;
- {$endif NODEBUG}
- if assigned(BreakpointsWindow) then
- BreakpointsWindow^.Update;
- end;
- function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
- function IsNum(P : PBreakpoint) : boolean;
- begin
- IsNum:=P^.GDBIndex=index;
- end;
- begin
- if index=0 then
- GetGDB:=nil
- else
- GetGDB:=FirstThat(@IsNum);
- end;
- procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
- procedure SetInSource(P : PBreakpoint);
- begin
- If assigned(P^.FileName) and
- (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
- PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
- end;
- procedure SetInDisassembly(P : PBreakpoint);
- var
- PDL : PDisasLine;
- S : string;
- ps,qs,i : longint;
- HAddr : PtrInt;
- code : integer;
- begin
- for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
- begin
- PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
- if PDL^.Address=0 then
- begin
- if (P^.typ=bt_file_line) then
- begin
- S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
- ps:=pos(':',S);
- qs:=pos(' ',copy(S,ps+1,High(S)));
- if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
- (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
- PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
- end;
- end
- else
- begin
- if assigned(P^.Name) then
- begin
- Val('$'+P^.Name^,HAddr,code);
- If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
- PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
- end;
- end;
- end;
- end;
- begin
- if W=PFPWindow(DisassemblyWindow) then
- ForEach(@SetInDisassembly)
- else
- ForEach(@SetInSource);
- end;
- procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
- procedure AdaptInSource(P : PBreakpoint);
- begin
- If assigned(P^.FileName) and
- (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
- begin
- if P^.state=bs_enabled then
- Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
- if P^.Line-1>=Pos then
- begin
- if (Change>0) or (P^.Line-1>=Pos-Change) then
- P^.line:=P^.Line+Change
- else
- begin
- { removing inside a ForEach call leads to problems }
- { so we do that after PM }
- P^.state:=bs_delete_after;
- end;
- end;
- if P^.state=bs_enabled then
- Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
- end;
- end;
- var
- I : longint;
- begin
- ForEach(@AdaptInSource);
- I:=Count-1;
- While (I>=0) do
- begin
- if At(I)^.state=bs_delete_after then
- AtFree(I);
- Dec(I);
- end;
- end;
- function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
- function IsAtLine(P : PBreakpoint) : boolean;
- begin
- If assigned(P^.FileName) and
- (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
- (Line=P^.Line) then
- IsAtLine:=true
- else
- IsAtLine:=false;
- end;
- begin
- FindBreakpointAt:=FirstThat(@IsAtLine);
- end;
- procedure TBreakpointCollection.ShowAllBreakpoints;
- procedure SetInSource(P : PBreakpoint);
- var
- W : PSourceWindow;
- begin
- If assigned(P^.FileName) then
- begin
- W:=SearchOnDesktop(P^.FileName^,false);
- if assigned(W) then
- W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
- end;
- end;
- begin
- ForEach(@SetInSource);
- end;
- function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
- function IsThis(P : PBreakpoint) : boolean;
- begin
- IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
- end;
- begin
- GetType:=FirstThat(@IsThis);
- end;
- function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
- function IsThere(P : PBreakpoint) : boolean;
- begin
- IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
- (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
- end;
- var
- PB : PBreakpoint;
- begin
- ToggleFileLine:=false;
- FileName:=OSFileName(FExpand(FileName));
- PB:=FirstThat(@IsThere);
- If Assigned(PB) then
- begin
- { delete it form source window }
- PB^.state:=bs_disabled;
- PB^.UpdateSource;
- { remove from collection }
- BreakpointsCollection^.free(PB);
- end
- else
- begin
- PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
- if assigned(PB) then
- Begin
- Insert(PB);
- PB^.UpdateSource;
- ToggleFileLine:=true;
- End;
- end;
- Update;
- end;
- {****************************************************************************
- TBreakpointItem
- ****************************************************************************}
- constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
- begin
- inherited Init;
- Breakpoint:=ABreakpoint;
- end;
- function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
- var S: string;
- begin
- with Breakpoint^ do
- begin
- S:=BreakpointTypeStr[typ];
- While Length(S)<10 do
- S:=S+' ';
- S:=S+'|';
- S:=S+BreakpointStateStr[state]+' ';
- While Length(S)<20 do
- S:=S+' ';
- S:=S+'|';
- if (typ=bt_file_line) then
- begin
- S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
- While Length(S)<40 do
- S:=S+' ';
- S:=S+'|';
- S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
- end
- else
- S:=S+GetStr(name);
- While Length(S)<70 do
- S:=S+' ';
- S:=S+'|';
- if IgnoreCount>0 then
- S:=S+IntToStr(IgnoreCount);
- While Length(S)<79 do
- S:=S+' ';
- S:=S+'|';
- if assigned(Conditions) then
- S:=S+' '+GetStr(Conditions);
- if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
- GetText:=S;
- end;
- end;
- procedure TBreakpointItem.Selected;
- begin
- end;
- function TBreakpointItem.GetModuleName: string;
- begin
- if breakpoint^.typ=bt_file_line then
- GetModuleName:=GetStr(breakpoint^.FileName)
- else
- GetModuleName:='';
- end;
- {****************************************************************************
- TBreakpointsListBox
- ****************************************************************************}
- constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
- GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
- NoSelection:=true;
- end;
- function TBreakpointsListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
- NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
- NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
- NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
- NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
- nil))))));
- GetLocalMenu:=M;
- end;
- procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnd :
- FocusItem(List^.Count-1);
- kbHome :
- FocusItem(0);
- kbEnter :
- Message(@Self,evCommand,cmMsgGotoSource,nil);
- kbIns :
- Message(@Self,evCommand,cmNewBreakpoint,nil);
- kbDel :
- Message(@Self,evCommand,cmDeleteBreakpoint,nil);
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmEditBreakpoint,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmMsgTrackSource :
- if Range>0 then
- TrackSource;
- cmEditBreakpoint :
- EditCurrent;
- cmToggleBreakpoint :
- ToggleCurrent;
- cmDeleteBreakpoint :
- DeleteCurrent;
- cmNewBreakpoint :
- EditNew;
- cmMsgClear :
- Clear;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
- var W : integer;
- begin
- if List=nil then New(List, Init(20,20));
- W:=length(P^.GetText(255));
- if W>MaxWidth then
- begin
- MaxWidth:=W;
- if HScrollBar<>nil then
- HScrollBar^.SetRange(0,MaxWidth);
- end;
- List^.Insert(P);
- SetRange(List^.Count);
- if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- P^.Breakpoint^.UpdateSource;
- DrawView;
- end;
- function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
- var P: PBreakpointItem;
- S: string;
- begin
- P:=List^.At(Item);
- S:=P^.GetText(MaxLen);
- GetText:=copy(S,1,MaxLen);
- end;
- procedure TBreakpointsListBox.Clear;
- begin
- if assigned(List) then
- Dispose(List, Done);
- List:=nil;
- MaxWidth:=0;
- SetRange(0); DrawView;
- Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- end;
- procedure TBreakpointsListBox.TrackSource;
- var W: PSourceWindow;
- P: PBreakpointItem;
- R: TRect;
- begin
- (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
- if Range=0 then Exit;*)
- P:=List^.At(Focused);
- if P^.GetModuleName='' then Exit;
- Desktop^.Lock;
- GetNextEditorBounds(R);
- R.B.Y:=Owner^.Origin.Y;
- W:=EditorWindowFile(P^.GetModuleName);
- if assigned(W) then
- begin
- W^.GetExtent(R);
- R.B.Y:=Owner^.Origin.Y;
- W^.ChangeBounds(R);
- W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
- end
- else
- W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
- if W<>nil then
- begin
- W^.Select;
- W^.Editor^.TrackCursor(do_centre);
- W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
- end;
- if Assigned(Owner) then
- Owner^.Select;
- Desktop^.UnLock;
- end;
- procedure TBreakpointsListBox.ToggleCurrent;
- var
- P: PBreakpointItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- if P^.Breakpoint^.state=bs_enabled then
- P^.Breakpoint^.state:=bs_disabled
- else if P^.Breakpoint^.state=bs_disabled then
- P^.Breakpoint^.state:=bs_enabled;
- P^.Breakpoint^.UpdateSource;
- BreakpointsCollection^.Update;
- end;
- procedure TBreakpointsListBox.EditCurrent;
- var
- P: PBreakpointItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
- P^.Breakpoint^.UpdateSource;
- BreakpointsCollection^.Update;
- end;
- procedure TBreakpointsListBox.DeleteCurrent;
- var
- P: PBreakpointItem;
- begin
- if Range=0 then Exit;
- P:=List^.At(Focused);
- if P=nil then Exit;
- { delete it form source window }
- P^.Breakpoint^.state:=bs_disabled;
- P^.Breakpoint^.UpdateSource;
- BreakpointsCollection^.free(P^.Breakpoint);
- List^.free(P);
- BreakpointsCollection^.Update;
- end;
- procedure TBreakpointsListBox.EditNew;
- var
- P: PBreakpoint;
- begin
- P:=New(PBreakpoint,Init_Empty);
- if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
- begin
- P^.UpdateSource;
- BreakpointsCollection^.Insert(P);
- BreakpointsCollection^.Update;
- end
- else
- dispose(P,Done);
- end;
- procedure TBreakpointsListBox.Draw;
- var
- I, J, Item: Sw_Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- if NoSelection then
- SelectedColor:=NormalColor;
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth);
- MoveStr(B[CurCol+1], Text, Color);
- if ShowMarkers then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- constructor TBreakpointsListBox.Load(var S: TStream);
- begin
- inherited Load(S);
- end;
- procedure TBreakpointsListBox.Store(var S: TStream);
- var OL: PCollection;
- OldR : integer;
- begin
- OL:=List;
- OldR:=Range;
- Range:=0;
- New(List, Init(1,1));
- inherited Store(S);
- Dispose(List, Done);
- Range:=OldR;
- List:=OL;
- { ^^^ nasty trick - has anyone a better idea how to avoid storing the
- collection? Pasting here a modified version of TListBox.Store+
- TAdvancedListBox.Store isn't a better solution, since by eventually
- changing the obj-hierarchy you'll always have to modify this, too - BG }
- end;
- destructor TBreakpointsListBox.Done;
- begin
- inherited Done;
- if List<>nil then Dispose(List, Done);
- end;
- {****************************************************************************
- TBreakpointsWindow
- ****************************************************************************}
- constructor TBreakpointsWindow.Init;
- var R,R2: TRect;
- HSB,VSB: PScrollBar;
- ST: PStaticText;
- S: String;
- X,X1 : Sw_integer;
- Btn: PButton;
- const
- NumButtons = 5;
- begin
- Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
- inherited Init(R, dialog_breakpointlist, wnNoNumber);
- HelpCtx:=hcBreakpointListWindow;
- GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
- S:=label_breakpointpropheader;
- New(ST, Init(R,S));
- ST^.GrowMode:=gfGrowHiX;
- Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
- New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
- ST^.GrowMode:=gfGrowHiX;
- Insert(ST);
- GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
- R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
- HSB^.SetStep(R.B.X-R.A.X-2,1);
- R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
- VSB^.SetStep(R.B.Y-R.A.Y-2,1);
- New(BreakLB, Init(R,HSB,VSB));
- BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- BreakLB^.Transparent:=true;
- Insert(BreakLB);
- GetExtent(R);R.Grow(-1,-1);
- Dec(R.B.Y);
- R.A.Y:=R.B.Y-2;
- X:=(R.B.X-R.A.X) div NumButtons;
- X1:=R.A.X+(X div 2);
- R.A.X:=X1-3;R.B.X:=X1+7;
- New(Btn, Init(R, button_Close, cmClose, bfDefault));
- Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Btn);
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
- Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Btn);
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
- Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Btn);
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
- Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Btn);
- X1:=X1+X;
- R.A.X:=X1-3;R.B.X:=X1+7;
- New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
- Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
- Insert(Btn);
- BreakLB^.Select;
- Update;
- BreakpointsWindow:=@self;
- end;
- constructor TBreakpointsWindow.Load(var S: TStream);
- begin
- inherited Load(S);
- GetSubViewPtr(S,BreakLB);
- end;
- procedure TBreakpointsWindow.Store(var S: TStream);
- begin
- inherited Store(S);
- PutSubViewPtr(S,BreakLB);
- end;
- procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
- begin
- BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
- end;
- procedure TBreakpointsWindow.ClearBreakpoints;
- begin
- BreakLB^.Clear;
- ReDraw;
- end;
- procedure TBreakpointsWindow.ReloadBreakpoints;
- procedure InsertInBreakLB(P : PBreakpoint);
- begin
- BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
- end;
- begin
- If not assigned(BreakpointsCollection) then
- exit;
- BreakpointsCollection^.ForEach(@InsertInBreakLB);
- ReDraw;
- end;
- procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
- begin
- inherited SizeLimits(Min,Max);
- Min.X:=40; Min.Y:=18;
- end;
- procedure TBreakpointsWindow.Close;
- begin
- Hide;
- end;
- procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
- var DontClear : boolean;
- begin
- case Event.What of
- evKeyDown :
- begin
- if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
- begin
- ClearEvent(Event);
- Hide;
- end;
- end;
- evCommand :
- begin
- DontClear:=False;
- case Event.Command of
- cmNewBreakpoint :
- BreakLB^.EditNew;
- cmEditBreakpoint :
- BreakLB^.EditCurrent;
- cmDeleteBreakpoint :
- BreakLB^.DeleteCurrent;
- cmToggleBreakInList :
- BreakLB^.ToggleCurrent;
- cmClose :
- Hide;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmUpdate :
- Update;
- end;
- end;
- inherited HandleEvent(Event);
- end;
- procedure TBreakpointsWindow.Update;
- var
- StoreFocus : longint;
- begin
- StoreFocus:=BreakLB^.Focused;
- ClearBreakpoints;
- ReloadBreakpoints;
- If StoreFocus<BreakLB^.Range then
- BreakLB^.FocusItem(StoreFocus);
- end;
- destructor TBreakpointsWindow.Done;
- begin
- inherited Done;
- BreakpointsWindow:=nil;
- end;
- {****************************************************************************
- TBreakpointItemDialog
- ****************************************************************************}
- constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
- var R,R2,R3: TRect;
- Items: PSItem;
- I : BreakpointType;
- KeyCount: sw_integer;
- begin
- KeyCount:=longint(high(BreakpointType));
- R.Assign(0,0,60,Max(9+KeyCount,18));
- inherited Init(R,dialog_modifynewbreakpoint);
- Breakpoint:=ABreakpoint;
- GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
- Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
- New(NameIL, Init(R, 255)); Insert(NameIL);
- R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
- Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
- R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
- R2.Copy(R); R2.Move(-1,-1);
- Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
- R.Move(0,3);
- R.B.X:=R.B.X-3;
- New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
- R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
- Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
- R.Move(0,3); R.B.X:=R.A.X+36;
- New(LineIL, Init(R, 128)); Insert(LineIL);
- LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
- R.Move(0,3);
- New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
- IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
- R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
- R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
- Items:=nil;
- { don't use invalid type }
- for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
- Items:=NewSItem(BreakpointTypeStr[I], Items);
- New(TypeRB, Init(R, Items));
- R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
- Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
- Insert(TypeRB);
- InsertButtons(@Self);
- NameIL^.Select;
- end;
- function TBreakpointItemDialog.Execute: Word;
- var R: sw_word;
- S1: string;
- err: word;
- L: longint;
- begin
- R:=sw_word(Breakpoint^.typ);
- TypeRB^.SetData(R);
- If Breakpoint^.typ=bt_file_line then
- S1:=GetStr(Breakpoint^.FileName)
- else
- S1:=GetStr(Breakpoint^.name);
- NameIL^.SetData(S1);
- If Breakpoint^.typ=bt_file_line then
- S1:=IntToStr(Breakpoint^.Line)
- else
- S1:='0';
- LineIL^.SetData(S1);
- S1:=IntToStr(Breakpoint^.IgnoreCount);
- IgnoreIL^.SetData(S1);
- S1:=GetStr(Breakpoint^.Conditions);
- ConditionsIL^.SetData(S1);
- if assigned(FirstEditorWindow) then
- FindReplaceEditor:=FirstEditorWindow^.Editor;
- R:=inherited Execute;
- FindReplaceEditor:=nil;
- if R=cmOK then
- begin
- TypeRB^.GetData(R);
- L:=R;
- Breakpoint^.typ:=BreakpointType(L);
- NameIL^.GetData(S1);
- If Breakpoint^.typ=bt_file_line then
- begin
- If assigned(Breakpoint^.FileName) then
- DisposeStr(Breakpoint^.FileName);
- Breakpoint^.FileName:=NewStr(S1);
- end
- else
- begin
- If assigned(Breakpoint^.Name) then
- DisposeStr(Breakpoint^.Name);
- Breakpoint^.name:=NewStr(S1);
- end;
- If Breakpoint^.typ=bt_file_line then
- begin
- LineIL^.GetData(S1);
- Val(S1,L,err);
- Breakpoint^.Line:=L;
- end;
- IgnoreIL^.GetData(S1);
- Val(S1,L,err);
- Breakpoint^.IgnoreCount:=L;
- ConditionsIL^.GetData(S1);
- If assigned(Breakpoint^.Conditions) then
- DisposeStr(Breakpoint^.Conditions);
- Breakpoint^.Conditions:=NewStr(S1);
- end;
- Execute:=R;
- end;
- {****************************************************************************
- TWatch
- ****************************************************************************}
- constructor TWatch.Init(s : string);
- begin
- expr:=NewStr(s);
- last_value:=nil;
- current_value:=nil;
- Get_new_value;
- GDBRunCount:=-1;
- end;
- constructor TWatch.Load(var S: TStream);
- begin
- expr:=S.ReadStr;
- last_value:=nil;
- current_value:=nil;
- Get_new_value;
- GDBRunCount:=-1;
- end;
- procedure TWatch.Store(var S: TStream);
- begin
- S.WriteStr(expr);
- end;
- procedure TWatch.rename(s : string);
- begin
- if assigned(expr) then
- begin
- if GetStr(expr)=S then
- exit;
- DisposeStr(expr);
- end;
- expr:=NewStr(s);
- if assigned(last_value) then
- StrDispose(last_value);
- last_value:=nil;
- if assigned(current_value) then
- StrDispose(current_value);
- current_value:=nil;
- GDBRunCount:=-1;
- Get_new_value;
- end;
- procedure TWatch.Get_new_value;
- {$ifndef NODEBUG}
- var p, q : pchar;
- i, j, curframe, startframe : longint;
- s,s2 : string;
- loop_higher, found : boolean;
- last_removed : char;
- function GetValue(var s : string) : boolean;
- begin
- Debugger^.command('p '+s);
- if not Debugger^.Error then
- begin
- s:=StrPas(Debugger^.GetOutput);
- GetValue:=true;
- end
- else
- begin
- s:=StrPas(Debugger^.GetError);
- GetValue:=false;
- { do not open a messagebox for such errors }
- Debugger^.got_error:=false;
- end;
- end;
- begin
- If not assigned(Debugger) or Not Debugger^.HasExe or
- (GDBRunCount=Debugger^.RunCount) then
- exit;
- GDBRunCount:=Debugger^.RunCount;
- if assigned(last_value) then
- strdispose(last_value);
- last_value:=current_value;
- s:=GetStr(expr);
- { Fix 2d array indexing, change [x,x] to [x][x] }
- i:=pos('[',s);
- if i>0 then
- begin
- while i<length(s) do
- begin
- if s[i]=',' then
- begin
- s[i]:='[';
- insert(']',s,i);
- inc(i);
- end;
- inc(i);
- end;
- end;
- found:=GetValue(s);
- Debugger^.got_error:=false;
- loop_higher:=not found;
- if not found then
- begin
- curframe:=Debugger^.get_current_frame;
- startframe:=curframe;
- end
- else
- begin
- curframe:=0;
- startframe:=0;
- end;
- while loop_higher do
- begin
- s:='parentfp';
- if GetValue(s) then
- begin
- repeat
- inc(curframe);
- if not Debugger^.set_current_frame(curframe) then
- loop_higher:=false;
- {$ifdef FrameNameKnown}
- s2:='/x '+FrameName;
- {$else not FrameNameKnown}
- s2:='/x $ebp';
- {$endif FrameNameKnown}
- if not getValue(s2) then
- loop_higher:=false;
- j:=pos('=',s2);
- if j>0 then
- s2:=copy(s2,j+1,length(s2));
- while s2[1] in [' ',TAB] do
- delete(s2,1,1);
- if pos(s2,s)>0 then
- loop_higher :=false;
- until not loop_higher;
- { try again at that level }
- s:=GetStr(expr);
- found:=GetValue(s);
- loop_higher:=not found;
- end
- else
- loop_higher:=false;
- end;
- if found then
- p:=StrNew(Debugger^.GetOutput)
- else
- begin
- { get a reasonable output at least }
- s:=GetStr(expr);
- GetValue(s);
- p:=StrNew(Debugger^.GetError);
- end;
- Debugger^.got_error:=false;
- { We should try here to find the expr in parent
- procedure if there are
- I will implement this as I added a
- parent_ebp pseudo local var to local procedure
- in stabs debug info PM }
- { But there are some pitfalls like
- locals redefined in other sublocals that call the function }
- if curframe<>startframe then
- Debugger^.set_current_frame(startframe);
- q:=nil;
- if assigned(p) and (p[0]='$') then
- q:=StrPos(p,'=');
- if not assigned(q) then
- q:=p;
- if assigned(q) then
- i:=strlen(q)
- else
- i:=0;
- if (i>0) and (q[i-1]=#10) then
- begin
- while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
- dec(i);
- last_removed:=q[i-1];
- q[i-1]:=#0;
- end
- else
- last_removed:=#0;
- if assigned(q) then
- current_value:=strnew(q)
- else
- current_value:=strnew('');
- if last_removed<>#0 then
- q[i-1]:=last_removed;
- strdispose(p);
- GDBRunCount:=Debugger^.RunCount;
- end;
- {$else NODEBUG}
- begin
- end;
- {$endif NODEBUG}
- procedure TWatch.Force_new_value;
- begin
- GDBRunCount:=-1;
- Get_new_value;
- end;
- destructor TWatch.Done;
- begin
- if assigned(expr) then
- disposestr(expr);
- if assigned(last_value) then
- strdispose(last_value);
- if assigned(current_value) then
- strdispose(current_value);
- inherited done;
- end;
- {****************************************************************************
- TWatchesCollection
- ****************************************************************************}
- constructor TWatchesCollection.Init;
- begin
- inherited Init(10,10);
- end;
- procedure TWatchesCollection.Insert(Item: Pointer);
- begin
- PWatch(Item)^.Get_new_value;
- Inherited Insert(Item);
- Update;
- end;
- procedure TWatchesCollection.Update;
- var
- W,W1 : integer;
- procedure GetMax(P : PWatch);
- begin
- if assigned(P^.Current_value) then
- W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
- else
- W1:=2+Length(GetStr(P^.expr));
- if W1>W then
- W:=W1;
- end;
- begin
- W:=0;
- ForEach(@GetMax);
- MaxW:=W;
- If assigned(WatchesWindow) then
- WatchesWindow^.WLB^.Update(MaxW);
- end;
- function TWatchesCollection.At(Index: Integer): PWatch;
- begin
- At:=Inherited At(Index);
- end;
- {****************************************************************************
- TWatchesListBox
- ****************************************************************************}
- constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
- If assigned(List) then
- dispose(list,done);
- List:=WatchesCollection;
- end;
- procedure TWatchesListBox.Update(AMaxWidth : integer);
- var R : TRect;
- begin
- GetExtent(R);
- MaxWidth:=AMaxWidth;
- if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
- HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
- else
- HScrollBar^.SetRange(0,0);
- if R.B.X-R.A.X>MaxWidth then
- HScrollBar^.Hide
- else
- HScrollBar^.Show;
- SetRange(List^.Count+1);
- if R.B.Y-R.A.Y>Range then
- VScrollBar^.Hide
- else
- VScrollBar^.Show;
- {if Focused=List^.Count-1-1 then
- FocusItem(List^.Count-1);
- What was that for ?? PM }
- DrawView;
- end;
- function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
- var
- PW : PWatch;
- ValOffset : Sw_integer;
- S : String;
- begin
- Modified:=false;
- if Item>=WatchesCollection^.Count then
- begin
- GetIndentedText:='';
- exit;
- end;
- PW:=WatchesCollection^.At(Item);
- ValOffset:=Length(GetStr(PW^.Expr))+2;
- if not assigned(PW^.expr) then
- GetIndentedText:=''
- else if Indent<ValOffset then
- begin
- S:=GetStr(PW^.Expr);
- if Indent=0 then
- S:=' '+S
- else
- S:=Copy(S,Indent,High(S));
- if not assigned(PW^.current_value) then
- S:=S+' <Unknown value>'
- else
- S:=S+' '+GetPChar(PW^.Current_value);
- GetIndentedText:=Copy(S,1,MaxLen);
- end
- else
- begin
- if not assigned(PW^.Current_value) or
- (StrLen(PW^.Current_value)<Indent-Valoffset) then
- S:=''
- else
- S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
- GetIndentedText:=Copy(S,1,MaxLen);
- end;
- if assigned(PW^.current_value) and
- assigned(PW^.last_value) and
- (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
- Modified:=true;
- end;
- procedure TWatchesListBox.EditCurrent;
- var
- P: PWatch;
- begin
- if Range=0 then Exit;
- if Focused<WatchesCollection^.Count then
- P:=WatchesCollection^.At(Focused)
- else
- P:=New(PWatch,Init(''));
- Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
- WatchesCollection^.Update;
- end;
- function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
- var
- Dummy_Modified : boolean;
- begin
- GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
- end;
- procedure TWatchesListBox.DeleteCurrent;
- var
- P: PWatch;
- begin
- if (Range=0) or
- (Focused>=WatchesCollection^.Count) then
- exit;
- P:=WatchesCollection^.At(Focused);
- WatchesCollection^.free(P);
- WatchesCollection^.Update;
- end;
- procedure TWatchesListBox.EditNew;
- var
- P: PWatch;
- S : string;
- begin
- if Focused<WatchesCollection^.Count then
- begin
- P:=WatchesCollection^.At(Focused);
- S:=GetStr(P^.expr);
- end
- else
- S:='';
- P:=New(PWatch,Init(S));
- if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
- begin
- WatchesCollection^.AtInsert(Focused,P);
- WatchesCollection^.Update;
- end
- else
- dispose(P,Done);
- end;
- procedure TWatchesListBox.Draw;
- var
- I, J, Item: Sw_Integer;
- NormalColor, SelectedColor, FocusedColor, Color: Word;
- ColWidth, CurCol, Indent: Integer;
- B: TDrawBuffer;
- Modified : boolean;
- Text: String;
- SCOff: Byte;
- TC: byte;
- procedure MT(var C: word);
- begin
- if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
- end;
- begin
- if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
- if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
- begin
- NormalColor := GetColor(1);
- FocusedColor := GetColor(3);
- SelectedColor := GetColor(4);
- end else
- begin
- NormalColor := GetColor(2);
- SelectedColor := GetColor(4);
- end;
- if Transparent then
- begin MT(NormalColor); MT(SelectedColor); end;
- (* if NoSelection then
- SelectedColor:=NormalColor;*)
- if HScrollBar <> nil then Indent := HScrollBar^.Value
- else Indent := 0;
- ColWidth := Size.X div NumCols + 1;
- for I := 0 to Size.Y - 1 do
- begin
- for J := 0 to NumCols-1 do
- begin
- Item := J*Size.Y + I + TopItem;
- CurCol := J*ColWidth;
- if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
- (Focused = Item) and (Range > 0) then
- begin
- Color := FocusedColor;
- SetCursor(CurCol+1,I);
- SCOff := 0;
- end
- else if (Item < Range) and IsSelected(Item) then
- begin
- Color := SelectedColor;
- SCOff := 2;
- end
- else
- begin
- Color := NormalColor;
- SCOff := 4;
- end;
- MoveChar(B[CurCol], ' ', Color, ColWidth);
- if Item < Range then
- begin
- (* Text := GetText(Item, ColWidth + Indent);
- Text := Copy(Text,Indent,ColWidth); *)
- Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
- if modified then
- begin
- SCOff:=0;
- Color:=(Color and $fff0) or Red;
- end;
- MoveStr(B[CurCol], Text, Color);
- if {ShowMarkers or } Modified then
- begin
- WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
- WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
- WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
- end;
- end;
- MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
- end;
- WriteLine(0, I, Size.X, 1, B);
- end;
- end;
- function TWatchesListBox.GetLocalMenu: PMenu;
- var M: PMenu;
- begin
- if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
- M:=NewMenu(
- NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
- NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
- NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
- NewLine(
- NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
- nil))))));
- GetLocalMenu:=M;
- end;
- procedure TWatchesListBox.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- begin
- case Event.What of
- evMouseDown : begin
- if Event.Double then
- Message(@Self,evCommand,cmEdit,nil)
- else
- ClearEvent(Event);
- end;
- evKeyDown :
- begin
- DontClear:=false;
- case Event.KeyCode of
- kbEnter :
- Message(@Self,evCommand,cmEdit,nil);
- kbIns :
- Message(@Self,evCommand,cmNew,nil);
- kbDel :
- Message(@Self,evCommand,cmDelete,nil);
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmListItemSelected :
- if Event.InfoPtr=@Self then
- Message(@Self,evCommand,cmEdit,nil);
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmEdit :
- EditCurrent;
- cmDelete :
- DeleteCurrent;
- cmNew :
- EditNew;
- else
- DontClear:=true;
- end;
- if not DontClear then
- ClearEvent(Event);
- end;
- end;
- inherited HandleEvent(Event);
- end;
- constructor TWatchesListBox.Load(var S: TStream);
- begin
- inherited Load(S);
- If assigned(List) then
- dispose(list,done);
- List:=WatchesCollection;
- { we must set Range PM }
- SetRange(List^.count+1);
- end;
- procedure TWatchesListBox.Store(var S: TStream);
- var OL: PCollection;
- OldRange : Sw_integer;
- begin
- OL:=List;
- OldRange:=Range;
- Range:=0;
- New(List, Init(1,1));
- inherited Store(S);
- Dispose(List, Done);
- List:=OL;
- { ^^^ nasty trick - has anyone a better idea how to avoid storing the
- collection? Pasting here a modified version of TListBox.Store+
- TAdvancedListBox.Store isn't a better solution, since by eventually
- changing the obj-hierarchy you'll always have to modify this, too - BG }
- SetRange(OldRange);
- end;
- destructor TWatchesListBox.Done;
- begin
- List:=nil;
- inherited Done;
- end;
- {****************************************************************************
- TWatchesWindow
- ****************************************************************************}
- Constructor TWatchesWindow.Init;
- var
- HSB,VSB: PScrollBar;
- R,R2 : trect;
- begin
- Desktop^.GetExtent(R);
- R.A.Y:=R.B.Y-7;
- inherited Init(R, dialog_watches,SearchFreeWindowNo);
- Palette:=wpCyanWindow;
- GetExtent(R);
- HelpCtx:=hcWatchesWindow;
- R.Grow(-1,-1);
- R2.Copy(R);
- Inc(R2.B.Y);
- R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2));
- HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
- HSB^.SetStep(R.B.X-R.A.X,1);
- Insert(HSB);
- R2.Copy(R);
- Inc(R2.B.X);
- R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2));
- VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
- Insert(VSB);
- New(WLB,Init(R,HSB,VSB));
- WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- WLB^.Transparent:=true;
- Insert(WLB);
- If assigned(WatchesWindow) then
- dispose(WatchesWindow,done);
- WatchesWindow:=@Self;
- Update;
- end;
- procedure TWatchesWindow.Update;
- begin
- WatchesCollection^.Update;
- Draw;
- end;
- constructor TWatchesWindow.Load(var S: TStream);
- begin
- inherited Load(S);
- GetSubViewPtr(S,WLB);
- If assigned(WatchesWindow) then
- dispose(WatchesWindow,done);
- WatchesWindow:=@Self;
- end;
- procedure TWatchesWindow.Store(var S: TStream);
- begin
- inherited Store(S);
- PutSubViewPtr(S,WLB);
- end;
- Destructor TWatchesWindow.Done;
- begin
- WatchesWindow:=nil;
- Dispose(WLB,done);
- inherited done;
- end;
- {****************************************************************************
- TWatchItemDialog
- ****************************************************************************}
- constructor TWatchItemDialog.Init(AWatch: PWatch);
- var R,R2: TRect;
- begin
- R.Assign(0,0,50,10);
- inherited Init(R,'Edit Watch');
- Watch:=AWatch;
- GetExtent(R); R.Grow(-3,-2);
- Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
- New(NameIL, Init(R, 255)); Insert(NameIL);
- R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
- Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
- R2.Copy(R); R2.Move(-1,-1);
- Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
- GetExtent(R);
- R.Grow(-3,-1);
- R.A.Y:=R.A.Y+3;
- TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
- Insert(TextST);
- InsertButtons(@Self);
- NameIL^.Select;
- end;
- function TWatchItemDialog.Execute: Word;
- var R: word;
- S1,S2: string;
- begin
- S1:=GetStr(Watch^.expr);
- NameIL^.SetData(S1);
- S1:=GetPChar(Watch^.Current_value);
- S2:=GetPChar(Watch^.Last_value);
- ClearFormatParams;
- AddFormatParamStr(S1);
- AddFormatParamStr(S2);
- if assigned(Watch^.Last_value) and
- assigned(Watch^.Current_value) and
- (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
- S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
- else
- S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
- TextST^.SetText(S1);
- if assigned(FirstEditorWindow) then
- FindReplaceEditor:=FirstEditorWindow^.Editor;
- R:=inherited Execute;
- FindReplaceEditor:=nil;
- if R=cmOK then
- begin
- NameIL^.GetData(S1);
- Watch^.Rename(S1);
- {$ifndef NODEBUG}
- If assigned(Debugger) then
- Debugger^.ReadWatches;
- {$endif NODEBUG}
- end;
- Execute:=R;
- end;
- {****************************************************************************
- TStackWindow
- ****************************************************************************}
- constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
- begin
- Inherited Init(Bounds,AHScrollBar,AVScrollBar);
- end;
- procedure TFramesListBox.Update;
- var i : longint;
- W : PSourceWindow;
- begin
- {$ifndef NODEBUG}
- { call backtrace command }
- If not assigned(Debugger) then
- exit;
- DeskTop^.Lock;
- Clear;
- if Debugger^.WindowWidth<>-1 then
- Debugger^.Command('set width 0xffffffff');
- Debugger^.Backtrace;
- { generate list }
- { all is in tframeentry }
- for i:=0 to Debugger^.frame_count-1 do
- begin
- with Debugger^.frames[i]^ do
- begin
- if assigned(file_name) then
- AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
- AddModuleName(GetPChar(file_name)),line_number,1)))
- else
- AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
- AddModuleName(''),line_number,1)));
- W:=SearchOnDesktop(GetPChar(file_name),false);
- { First reset all Debugger rows }
- If assigned(W) then
- begin
- W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
- W^.Editor^.DebuggerRow:=-1;
- end;
- end;
- end;
- { Now set all Debugger rows }
- for i:=0 to Debugger^.frame_count-1 do
- begin
- with Debugger^.frames[i]^ do
- begin
- W:=SearchOnDesktop(GetPChar(file_name),false);
- If assigned(W) then
- begin
- If W^.Editor^.DebuggerRow=-1 then
- begin
- W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
- W^.Editor^.DebuggerRow:=line_number-1;
- end;
- end;
- end;
- end;
- if Assigned(list) and (List^.Count > 0) then
- FocusItem(0);
- if Debugger^.WindowWidth<>-1 then
- Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
- DeskTop^.Unlock;
- {$endif NODEBUG}
- end;
- function TFramesListBox.GetLocalMenu: PMenu;
- begin
- GetLocalMenu:=Inherited GetLocalMenu;
- end;
- procedure TFramesListBox.GotoSource;
- begin
- {$ifndef NODEBUG}
- { select frame for watches }
- If not assigned(Debugger) then
- exit;
- Debugger^.Command('f '+IntToStr(Focused));
- { for local vars }
- Debugger^.RereadWatches;
- {$endif NODEBUG}
- { goto source }
- inherited GotoSource;
- end;
- procedure TFramesListBox.GotoAssembly;
- begin
- {$ifndef NODEBUG}
- { select frame for watches }
- If not assigned(Debugger) then
- exit;
- Debugger^.Command('f '+IntToStr(Focused));
- { for local vars }
- Debugger^.RereadWatches;
- {$endif}
- { goto source/assembly mixture }
- InitDisassemblyWindow;
- DisassemblyWindow^.LoadFunction('');
- {$ifndef NODEBUG}
- DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
- DisassemblyWindow^.SelectInDebugSession;
- {$endif NODEBUG}
- end;
- procedure TFramesListBox.HandleEvent(var Event: TEvent);
- begin
- if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
- ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
- GotoAssembly;
- inherited HandleEvent(Event);
- end;
- destructor TFramesListBox.Done;
- begin
- Inherited Done;
- end;
- Constructor TStackWindow.Init;
- var
- HSB,VSB: PScrollBar;
- R,R2 : trect;
- begin
- Desktop^.GetExtent(R);
- R.A.Y:=R.B.Y-5;
- inherited Init(R, dialog_callstack, wnNoNumber);
- Palette:=wpCyanWindow;
- GetExtent(R);
- HelpCtx:=hcStackWindow;
- R.Grow(-1,-1);
- R2.Copy(R);
- Inc(R2.B.Y);
- R2.A.Y:=R2.B.Y-1;
- New(HSB, Init(R2));
- HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
- Insert(HSB);
- R2.Copy(R);
- Inc(R2.B.X);
- R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2));
- VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
- Insert(VSB);
- New(FLB,Init(R,HSB,VSB));
- FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
- Insert(FLB);
- If assigned(StackWindow) then
- dispose(StackWindow,done);
- StackWindow:=@Self;
- Update;
- end;
- procedure TStackWindow.Update;
- begin
- FLB^.Update;
- DrawView;
- end;
- constructor TStackWindow.Load(var S: TStream);
- begin
- inherited Load(S);
- GetSubViewPtr(S,FLB);
- If assigned(StackWindow) then
- dispose(StackWindow,done);
- StackWindow:=@Self;
- end;
- procedure TStackWindow.Store(var S: TStream);
- begin
- inherited Store(S);
- PutSubViewPtr(S,FLB);
- end;
- Destructor TStackWindow.Done;
- begin
- StackWindow:=nil;
- Dispose(FLB,done);
- inherited done;
- end;
- {$ifdef SUPPORT_REMOTE}
- {****************************************************************************
- TransformRemoteString
- ****************************************************************************}
- function TransformRemoteString(st : string) : string;
- begin
- If RemoteConfig<>'' then
- ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig)
- else
- ReplaceStrI(St,'$CONFIG','');
- If RemoteIdent<>'' then
- ReplaceStrI(St,'$IDENT','-i '+RemoteIdent)
- else
- ReplaceStrI(St,'$IDENT','');
- If RemotePuttySession<>'' then
- ReplaceStrI(St,'$PUTTYSESSION','-load '+RemotePuttySession)
- else
- ReplaceStrI(St,'$PUTTYSESSION','');
- ReplaceStrI(St,'$LOCALFILENAME',NameAndExtOf(ExeFile));
- ReplaceStrI(St,'$LOCALFILE',ExeFile);
- ReplaceStrI(St,'$REMOTEDIR',RemoteDir);
- ReplaceStrI(St,'$REMOTEPORT',RemotePort);
- ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine);
- ReplaceStrI(St,'$REMOTEGDBSERVER',maybequoted(remotegdbserver));
- ReplaceStrI(St,'$REMOTECOPY',maybequoted(RemoteCopy));
- ReplaceStrI(St,'$REMOTESHELL',maybequoted(RemoteShell));
- { avoid infinite recursion here !!! }
- if Pos('$REMOTEEXECCOMMAND',UpcaseSTr(St))>0 then
- ReplaceStrI(St,'$REMOTEEXECCOMMAND',TransformRemoteString(RemoteExecCommand));
- {$ifdef WINDOWS}
- ReplaceStrI(St,'$START','start "Shell to remote"');
- ReplaceStrI(St,'$DOITINBACKGROUND','');
- {$else}
- ReplaceStrI(St,'$START','');
- ReplaceStrI(St,'$DOITINBACKGROUND',' &');
- {$endif}
- TransformRemoteString:=st;
- end;
- {$endif SUPPORT_REMOTE}
- {****************************************************************************
- Init/Final
- ****************************************************************************}
- function GetGDBTargetShortName : string;
- begin
- {$ifndef CROSSGDB}
- GetGDBTargetShortName:=source_info.shortname;
- {$else CROSSGDB}
- {$ifdef SUPPORT_REMOTE}
- {$ifdef PALMOSGDB}
- GetGDBTargetShortName:='palmos';
- {$else}
- GetGDBTargetShortName:='linux';
- {$endif PALMOSGDB}
- {$endif not SUPPORT_REMOTE}
- {$endif CROSSGDB}
- end;
- procedure InitDebugger;
- {$ifdef DEBUG}
- var s : string;
- i,p : longint;
- {$endif DEBUG}
- var
- NeedRecompileExe : boolean;
- cm : longint;
- begin
- {$ifdef DEBUG}
- if not use_gdb_file then
- begin
- Assign(gdb_file,GDBOutFileName);
- {$I-}
- Rewrite(gdb_file);
- if InOutRes<>0 then
- begin
- s:=GDBOutFileName;
- p:=pos('.',s);
- if p>1 then
- for i:=0 to 9 do
- begin
- s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
- InOutRes:=0;
- Assign(gdb_file,s);
- rewrite(gdb_file);
- if InOutRes=0 then
- break;
- end;
- end;
- if IOResult=0 then
- Use_gdb_file:=true;
- end;
- {$I+}
- {$endif}
- NeedRecompileExe:=false;
- {$ifndef SUPPORT_REMOTE}
- if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
- begin
- ClearFormatParams;
- AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
- AddFormatParamStr(GetGDBTargetShortName);
- cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
- if cm=cmCancel then
- Exit;
- if cm=cmYes then
- begin
- { force recompilation }
- PrevMainFile:='';
- NeedRecompileExe:=true;
- TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
- If DebugInfoSwitches^.GetCurrSelParam='-' then
- DebugInfoSwitches^.SetCurrSelParam('l');
- IDEApp.UpdateTarget;
- end;
- end;
- {$endif ndef SUPPORT_REMOTE}
- if not NeedRecompileExe then
- NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
- (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
- if Not NeedRecompileExe and Not MainHasDebugInfo then
- begin
- ClearFormatParams;
- cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
- if cm=cmCancel then
- Exit;
- if cm=cmYes then
- begin
- { force recompilation }
- PrevMainFile:='';
- NeedRecompileExe:=true;
- DebugInfoSwitches^.SetCurrSelParam('l');
- end;
- end;
- if NeedRecompileExe then
- DoCompile(cRun);
- if CompilationPhase<>cpDone then
- Exit;
- if (EXEFile='') then
- begin
- ErrorBox(msg_nothingtodebug,nil);
- Exit;
- end;
- { init debugcontroller }
- {$ifndef NODEBUG}
- if not assigned(Debugger) then
- begin
- PushStatus(msg_startingdebugger);
- new(Debugger,Init);
- PopStatus;
- end;
- Debugger^.SetExe(ExeFile);
- {$endif NODEBUG}
- {$ifdef GDBWINDOW}
- InitGDBWindow;
- {$endif def GDBWINDOW}
- end;
- const
- Invalid_gdb_file_handle: boolean = false;
- procedure DoneDebugger;
- begin
- {$ifdef DEBUG}
- If IDEApp.IsRunning then
- PushStatus('Closing debugger');
- {$endif}
- {$ifndef NODEBUG}
- if assigned(Debugger) then
- dispose(Debugger,Done);
- Debugger:=nil;
- {$endif NODEBUG}
- {$ifdef DOS}
- If assigned(UserScreen) then
- PDosScreen(UserScreen)^.FreeGraphBuffer;
- {$endif DOS}
- {$ifdef DEBUG}
- If Use_gdb_file then
- begin
- Use_gdb_file:=false;
- {$IFOPT I+}
- {$I-}
- {$DEFINE REENABLE_I}
- {$ENDIF}
- Close(GDB_file);
- if ioresult<>0 then
- begin
- { This handle seems to get lost for DJGPP
- don't bother too much about this. }
- Invalid_gdb_file_handle:=true;
- end;
- {$IFDEF REENABLE_I}
- {$I+}
- {$ENDIF}
- end;
- If IDEApp.IsRunning then
- PopStatus;
- {$endif DEBUG}
- end;
- procedure InitGDBWindow;
- var
- R : TRect;
- begin
- if GDBWindow=nil then
- begin
- DeskTop^.GetExtent(R);
- new(GDBWindow,init(R));
- DeskTop^.Insert(GDBWindow);
- end;
- end;
- procedure DoneGDBWindow;
- begin
- If IDEApp.IsRunning and
- assigned(GDBWindow) then
- begin
- DeskTop^.Delete(GDBWindow);
- end;
- GDBWindow:=nil;
- end;
- procedure InitDisassemblyWindow;
- var
- R : TRect;
- begin
- if DisassemblyWindow=nil then
- begin
- DeskTop^.GetExtent(R);
- new(DisassemblyWindow,init(R));
- DeskTop^.Insert(DisassemblyWindow);
- end;
- end;
- procedure DoneDisassemblyWindow;
- begin
- if assigned(DisassemblyWindow) then
- begin
- DeskTop^.Delete(DisassemblyWindow);
- Dispose(DisassemblyWindow,Done);
- DisassemblyWindow:=nil;
- end;
- end;
- procedure InitStackWindow;
- begin
- if StackWindow=nil then
- begin
- new(StackWindow,init);
- DeskTop^.Insert(StackWindow);
- end;
- end;
- procedure DoneStackWindow;
- begin
- if assigned(StackWindow) then
- begin
- DeskTop^.Delete(StackWindow);
- StackWindow:=nil;
- end;
- end;
- procedure InitBreakpoints;
- begin
- New(BreakpointsCollection,init(10,10));
- end;
- procedure DoneBreakpoints;
- begin
- Dispose(BreakpointsCollection,Done);
- BreakpointsCollection:=nil;
- end;
- procedure InitWatches;
- begin
- New(WatchesCollection,init);
- end;
- procedure DoneWatches;
- begin
- Dispose(WatchesCollection,Done);
- WatchesCollection:=nil;
- end;
- procedure RegisterFPDebugViews;
- begin
- RegisterType(RWatchesWindow);
- RegisterType(RBreakpointsWindow);
- RegisterType(RWatchesListBox);
- RegisterType(RBreakpointsListBox);
- RegisterType(RStackWindow);
- RegisterType(RFramesListBox);
- RegisterType(RBreakpoint);
- RegisterType(RWatch);
- RegisterType(RBreakpointCollection);
- RegisterType(RWatchesCollection);
- end;
- end.
- {$endif NODEBUG}
|