fpdebug.pas 105 KB

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