fpdebug.pas 104 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968
  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 Assigned(PB^.OldValue) then
  1367. DisposeStr(PB^.OldValue);
  1368. PB^.OldValue:=PB^.CurrentValue;
  1369. PB^.CurrentValue:=NewStr(S);
  1370. If PB^.typ=bt_function then
  1371. WarningBox(#3'GDB stopped due to'#13+
  1372. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  1373. else if (GetStr(PB^.OldValue)<>S) then
  1374. WarningBox(#3'GDB stopped due to'#13+
  1375. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1376. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  1377. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  1378. else
  1379. WarningBox(#3'GDB stopped due to'#13+
  1380. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  1381. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  1382. end;
  1383. end;
  1384. DoSelectSourceLine := True;
  1385. end;
  1386. procedure TDebugController.DoUserSignal;
  1387. var P :Array[1..2] of pstring;
  1388. S1, S2 : string;
  1389. begin
  1390. S1:=strpas(signal_name);
  1391. S2:=strpas(signal_string);
  1392. P[1]:=@S1;
  1393. P[2]:=@S2;
  1394. WarningBox(msg_programsignal,@P);
  1395. end;
  1396. procedure TDebugController.DoEndSession(code:longint);
  1397. var P :Array[1..2] of longint;
  1398. begin
  1399. IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
  1400. IDEApp.UpdateRunMenu(false);
  1401. ResetDebuggerRows;
  1402. LastExitCode:=Code;
  1403. If HiddenStepsCount=0 then
  1404. InformationBox(msg_programexitedwithexitcode,@code)
  1405. else
  1406. begin
  1407. P[1]:=code;
  1408. P[2]:=HiddenStepsCount;
  1409. WarningBox(msg_programexitedwithcodeandsteps,@P);
  1410. end;
  1411. { In case we have something that the compiler touched }
  1412. AskToReloadAllModifiedFiles;
  1413. {$ifdef Windows}
  1414. main_pid_valid:=false;
  1415. {$endif Windows}
  1416. end;
  1417. procedure TDebugController.DoDebuggerScreen;
  1418. {$ifdef Windows}
  1419. var
  1420. IdeMode : DWord;
  1421. {$endif Windows}
  1422. begin
  1423. if NoSwitch then
  1424. begin
  1425. PopStatus;
  1426. end
  1427. else
  1428. begin
  1429. IDEApp.ShowIDEScreen;
  1430. Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
  1431. PopStatus;
  1432. end;
  1433. {$ifdef Windows}
  1434. if NoSwitch then
  1435. begin
  1436. { Ctrl-C as normal char }
  1437. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1438. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
  1439. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1440. end;
  1441. ChangeDebuggeeWindowTitleTo(Stopped_State);
  1442. {$endif Windows}
  1443. If assigned(GDBWindow) then
  1444. GDBWindow^.Editor^.UnLock;
  1445. end;
  1446. procedure TDebugController.DoUserScreen;
  1447. {$ifdef Windows}
  1448. var
  1449. IdeMode : DWord;
  1450. {$endif Windows}
  1451. begin
  1452. Inc(RunCount);
  1453. if NoSwitch then
  1454. begin
  1455. {$ifdef SUPPORT_REMOTE}
  1456. if isRemoteDebugging then
  1457. PushStatus(msg_runningremotely+RemoteMachine)
  1458. else
  1459. {$endif SUPPORT_REMOTE}
  1460. {$ifdef Unix}
  1461. PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
  1462. {$else not Unix}
  1463. PushStatus(msg_runninginanotherwindow);
  1464. {$endif Unix}
  1465. end
  1466. else
  1467. begin
  1468. PushStatus(msg_runningprogram);
  1469. IDEApp.ShowUserScreen;
  1470. end;
  1471. {$ifdef Windows}
  1472. if NoSwitch then
  1473. begin
  1474. { Ctrl-C as interrupt }
  1475. GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
  1476. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
  1477. SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
  1478. end;
  1479. ChangeDebuggeeWindowTitleTo(Running_State);
  1480. {$endif Windows}
  1481. { Don't try to print GDB messages while in User Screen mode }
  1482. If assigned(GDBWindow) then
  1483. GDBWindow^.Editor^.Lock;
  1484. end;
  1485. {$endif NODEBUG}
  1486. {****************************************************************************
  1487. TBreakpoint
  1488. ****************************************************************************}
  1489. function ActiveBreakpoints : boolean;
  1490. var
  1491. IsActive : boolean;
  1492. procedure TestActive(PB : PBreakpoint);
  1493. begin
  1494. If PB^.state=bs_enabled then
  1495. IsActive:=true;
  1496. end;
  1497. begin
  1498. IsActive:=false;
  1499. If assigned(BreakpointsCollection) then
  1500. BreakpointsCollection^.ForEach(@TestActive);
  1501. ActiveBreakpoints:=IsActive;
  1502. end;
  1503. constructor TBreakpoint.Init_function(Const AFunc : String);
  1504. begin
  1505. typ:=bt_function;
  1506. state:=bs_enabled;
  1507. GDBState:=bs_deleted;
  1508. Name:=NewStr(AFunc);
  1509. FileName:=nil;
  1510. Line:=0;
  1511. IgnoreCount:=0;
  1512. Commands:=nil;
  1513. Conditions:=nil;
  1514. OldValue:=nil;
  1515. CurrentValue:=nil;
  1516. end;
  1517. constructor TBreakpoint.Init_Address(Const AAddress : String);
  1518. begin
  1519. typ:=bt_address;
  1520. state:=bs_enabled;
  1521. GDBState:=bs_deleted;
  1522. Name:=NewStr(AAddress);
  1523. FileName:=nil;
  1524. Line:=0;
  1525. IgnoreCount:=0;
  1526. Commands:=nil;
  1527. Conditions:=nil;
  1528. OldValue:=nil;
  1529. CurrentValue:=nil;
  1530. end;
  1531. constructor TBreakpoint.Init_Empty;
  1532. begin
  1533. typ:=bt_function;
  1534. state:=bs_enabled;
  1535. GDBState:=bs_deleted;
  1536. Name:=Nil;
  1537. FileName:=nil;
  1538. Line:=0;
  1539. IgnoreCount:=0;
  1540. Commands:=nil;
  1541. Conditions:=nil;
  1542. OldValue:=nil;
  1543. CurrentValue:=nil;
  1544. end;
  1545. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  1546. begin
  1547. typ:=atyp;
  1548. state:=bs_enabled;
  1549. GDBState:=bs_deleted;
  1550. Name:=NewStr(AnExpr);
  1551. IgnoreCount:=0;
  1552. Commands:=nil;
  1553. Conditions:=nil;
  1554. OldValue:=nil;
  1555. CurrentValue:=nil;
  1556. end;
  1557. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  1558. var
  1559. CurDir : String;
  1560. begin
  1561. typ:=bt_file_line;
  1562. state:=bs_enabled;
  1563. GDBState:=bs_deleted;
  1564. AFile:=FEXpand(AFile);
  1565. (*
  1566. { d:test.pas:12 does not work !! }
  1567. { I do not know how to solve this if
  1568. if (Length(AFile)>1) and (AFile[2]=':') then
  1569. AFile:=Copy(AFile,3,255); }
  1570. {$ifdef Unix}
  1571. CurDir:=GetCurDir;
  1572. {$else}
  1573. CurDir:=LowerCaseStr(GetCurDir);
  1574. {$endif Unix}
  1575. if Pos(CurDir,OSFileName(AFile))=1 then
  1576. FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
  1577. else
  1578. *)
  1579. FileName:=NewStr(OSFileName(AFile));
  1580. Name:=nil;
  1581. Line:=ALine;
  1582. IgnoreCount:=0;
  1583. Commands:=nil;
  1584. Conditions:=nil;
  1585. OldValue:=nil;
  1586. CurrentValue:=nil;
  1587. end;
  1588. constructor TBreakpoint.Load(var S: TStream);
  1589. var
  1590. FName : PString;
  1591. begin
  1592. S.Read(typ,SizeOf(BreakpointType));
  1593. S.Read(state,SizeOf(BreakpointState));
  1594. GDBState:=bs_deleted;
  1595. case typ of
  1596. bt_file_line :
  1597. begin
  1598. { convert to current target }
  1599. FName:=S.ReadStr;
  1600. FileName:=NewStr(OSFileName(GetStr(FName)));
  1601. If Assigned(FName) then
  1602. DisposeStr(FName);
  1603. S.Read(Line,SizeOf(Line));
  1604. Name:=nil;
  1605. end;
  1606. else
  1607. begin
  1608. Name:=S.ReadStr;
  1609. Line:=0;
  1610. FileName:=nil;
  1611. end;
  1612. end;
  1613. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  1614. Commands:=S.StrRead;
  1615. Conditions:=S.ReadStr;
  1616. OldValue:=nil;
  1617. CurrentValue:=nil;
  1618. end;
  1619. procedure TBreakpoint.Store(var S: TStream);
  1620. var
  1621. St : String;
  1622. begin
  1623. S.Write(typ,SizeOf(BreakpointType));
  1624. S.Write(state,SizeOf(BreakpointState));
  1625. case typ of
  1626. bt_file_line :
  1627. begin
  1628. st:=OSFileName(GetStr(FileName));
  1629. S.WriteStr(@St);
  1630. S.Write(Line,SizeOf(Line));
  1631. end;
  1632. else
  1633. begin
  1634. S.WriteStr(Name);
  1635. end;
  1636. end;
  1637. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  1638. S.StrWrite(Commands);
  1639. S.WriteStr(Conditions);
  1640. end;
  1641. procedure TBreakpoint.Insert;
  1642. var
  1643. p,p2 : pchar;
  1644. st : string;
  1645. bkpt_no: LongInt = 0;
  1646. begin
  1647. {$ifndef NODEBUG}
  1648. If not assigned(Debugger) then Exit;
  1649. Remove;
  1650. if (GDBState=bs_deleted) and (state=bs_enabled) then
  1651. begin
  1652. if (typ=bt_file_line) and assigned(FileName) then
  1653. bkpt_no := Debugger^.BreakpointInsert(GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line), [])
  1654. else if (typ=bt_function) and assigned(name) then
  1655. bkpt_no := Debugger^.BreakpointInsert(name^, [])
  1656. else if (typ=bt_address) and assigned(name) then
  1657. bkpt_no := Debugger^.BreakpointInsert('*0x'+name^, [])
  1658. else if (typ=bt_watch) and assigned(name) then
  1659. bkpt_no := Debugger^.WatchpointInsert(name^, wtWrite)
  1660. else if (typ=bt_awatch) and assigned(name) then
  1661. bkpt_no := Debugger^.WatchpointInsert(name^, wtReadWrite)
  1662. else if (typ=bt_rwatch) and assigned(name) then
  1663. bkpt_no := Debugger^.WatchpointInsert(name^, wtRead);
  1664. if bkpt_no<>0 then
  1665. begin
  1666. GDBIndex:=bkpt_no;
  1667. GDBState:=bs_enabled;
  1668. Debugger^.BreakpointCondition(GDBIndex, GetStr(Conditions));
  1669. If IgnoreCount>0 then
  1670. Debugger^.BreakpointSetIgnoreCount(GDBIndex, IgnoreCount);
  1671. If Assigned(Commands) then
  1672. begin
  1673. {Commands are not handled yet }
  1674. Debugger^.Command('command '+IntToStr(GDBIndex));
  1675. p:=commands;
  1676. while assigned(p) do
  1677. begin
  1678. p2:=strscan(p,#10);
  1679. if assigned(p2) then
  1680. p2^:=#0;
  1681. st:=strpas(p);
  1682. Debugger^.command(st);
  1683. if assigned(p2) then
  1684. p2^:=#10;
  1685. p:=p2;
  1686. if assigned(p) then
  1687. inc(p);
  1688. end;
  1689. Debugger^.Command('end');
  1690. end;
  1691. end
  1692. else
  1693. { Here there was a problem !! }
  1694. begin
  1695. GDBIndex:=0;
  1696. if not Debugger^.Disableallinvalidbreakpoints then
  1697. begin
  1698. if (typ=bt_file_line) and assigned(FileName) then
  1699. begin
  1700. ClearFormatParams;
  1701. AddFormatParamStr(NameAndExtOf(FileName^));
  1702. AddFormatParamInt(Line);
  1703. if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1704. Debugger^.Disableallinvalidbreakpoints:=true;
  1705. end
  1706. else
  1707. begin
  1708. ClearFormatParams;
  1709. AddFormatParamStr(BreakpointTypeStr[typ]);
  1710. AddFormatParamStr(GetStr(Name));
  1711. if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
  1712. Debugger^.Disableallinvalidbreakpoints:=true;
  1713. end;
  1714. end;
  1715. state:=bs_disabled;
  1716. UpdateSource;
  1717. end;
  1718. end
  1719. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  1720. Enable
  1721. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  1722. Disable;
  1723. {$endif NODEBUG}
  1724. end;
  1725. procedure TBreakpoint.Remove;
  1726. begin
  1727. {$ifndef NODEBUG}
  1728. If not assigned(Debugger) then Exit;
  1729. if GDBIndex>0 then
  1730. Debugger^.BreakpointDelete(GDBIndex);
  1731. GDBIndex:=0;
  1732. GDBState:=bs_deleted;
  1733. {$endif NODEBUG}
  1734. end;
  1735. procedure TBreakpoint.Enable;
  1736. begin
  1737. {$ifndef NODEBUG}
  1738. If not assigned(Debugger) then Exit;
  1739. if GDBIndex>0 then
  1740. Debugger^.BreakpointEnable(GDBIndex)
  1741. else
  1742. Insert;
  1743. GDBState:=bs_disabled;
  1744. {$endif NODEBUG}
  1745. end;
  1746. procedure TBreakpoint.Disable;
  1747. begin
  1748. {$ifndef NODEBUG}
  1749. If not assigned(Debugger) then Exit;
  1750. if GDBIndex>0 then
  1751. Debugger^.BreakpointDisable(GDBIndex);
  1752. GDBState:=bs_disabled;
  1753. {$endif NODEBUG}
  1754. end;
  1755. procedure TBreakpoint.ResetValues;
  1756. begin
  1757. if assigned(OldValue) then
  1758. DisposeStr(OldValue);
  1759. OldValue:=nil;
  1760. if assigned(CurrentValue) then
  1761. DisposeStr(CurrentValue);
  1762. CurrentValue:=nil;
  1763. end;
  1764. procedure TBreakpoint.UpdateSource;
  1765. var W: PSourceWindow;
  1766. b : boolean;
  1767. begin
  1768. if typ=bt_file_line then
  1769. begin
  1770. W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
  1771. If assigned(W) then
  1772. begin
  1773. if state=bs_enabled then
  1774. b:=true
  1775. else
  1776. b:=false;
  1777. W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
  1778. end;
  1779. end;
  1780. end;
  1781. destructor TBreakpoint.Done;
  1782. begin
  1783. Remove;
  1784. ResetValues;
  1785. if assigned(Name) then
  1786. DisposeStr(Name);
  1787. if assigned(FileName) then
  1788. DisposeStr(FileName);
  1789. if assigned(Conditions) then
  1790. DisposeStr(Conditions);
  1791. if assigned(Commands) then
  1792. StrDispose(Commands);
  1793. inherited Done;
  1794. end;
  1795. {****************************************************************************
  1796. TBreakpointCollection
  1797. ****************************************************************************}
  1798. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  1799. begin
  1800. At:=inherited At(Index);
  1801. end;
  1802. procedure TBreakpointCollection.Update;
  1803. begin
  1804. {$ifndef NODEBUG}
  1805. if assigned(Debugger) then
  1806. begin
  1807. Debugger^.RemoveBreakpoints;
  1808. Debugger^.InsertBreakpoints;
  1809. end;
  1810. {$endif NODEBUG}
  1811. if assigned(BreakpointsWindow) then
  1812. BreakpointsWindow^.Update;
  1813. end;
  1814. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  1815. function IsNum(P : PBreakpoint) : boolean;
  1816. begin
  1817. IsNum:=P^.GDBIndex=index;
  1818. end;
  1819. begin
  1820. if index=0 then
  1821. GetGDB:=nil
  1822. else
  1823. GetGDB:=FirstThat(@IsNum);
  1824. end;
  1825. procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
  1826. procedure SetInSource(P : PBreakpoint);
  1827. begin
  1828. If assigned(P^.FileName) and
  1829. (OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
  1830. PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1831. end;
  1832. procedure SetInDisassembly(P : PBreakpoint);
  1833. var
  1834. PDL : PDisasLine;
  1835. S : string;
  1836. ps,qs,i : longint;
  1837. HAddr : PtrInt;
  1838. code : integer;
  1839. begin
  1840. for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
  1841. begin
  1842. PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
  1843. if PDL^.Address=0 then
  1844. begin
  1845. if (P^.typ=bt_file_line) then
  1846. begin
  1847. S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
  1848. ps:=pos(':',S);
  1849. qs:=pos(' ',copy(S,ps+1,High(S)));
  1850. if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
  1851. (StrToInt(copy(S,ps+1,qs-1))=P^.line) then
  1852. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1853. end;
  1854. end
  1855. else
  1856. begin
  1857. if assigned(P^.Name) then
  1858. begin
  1859. Val('$'+P^.Name^,HAddr,code);
  1860. If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
  1861. PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
  1862. end;
  1863. end;
  1864. end;
  1865. end;
  1866. begin
  1867. if W=PFPWindow(DisassemblyWindow) then
  1868. ForEach(@SetInDisassembly)
  1869. else
  1870. ForEach(@SetInSource);
  1871. end;
  1872. procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
  1873. procedure AdaptInSource(P : PBreakpoint);
  1874. begin
  1875. If assigned(P^.FileName) and
  1876. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
  1877. begin
  1878. if P^.state=bs_enabled then
  1879. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
  1880. if P^.Line-1>=Pos then
  1881. begin
  1882. if (Change>0) or (P^.Line-1>=Pos-Change) then
  1883. P^.line:=P^.Line+Change
  1884. else
  1885. begin
  1886. { removing inside a ForEach call leads to problems }
  1887. { so we do that after PM }
  1888. P^.state:=bs_delete_after;
  1889. end;
  1890. end;
  1891. if P^.state=bs_enabled then
  1892. Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
  1893. end;
  1894. end;
  1895. var
  1896. I : longint;
  1897. begin
  1898. ForEach(@AdaptInSource);
  1899. I:=Count-1;
  1900. While (I>=0) do
  1901. begin
  1902. if At(I)^.state=bs_delete_after then
  1903. AtFree(I);
  1904. Dec(I);
  1905. end;
  1906. end;
  1907. function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
  1908. function IsAtLine(P : PBreakpoint) : boolean;
  1909. begin
  1910. If assigned(P^.FileName) and
  1911. (P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
  1912. (Line=P^.Line) then
  1913. IsAtLine:=true
  1914. else
  1915. IsAtLine:=false;
  1916. end;
  1917. begin
  1918. FindBreakpointAt:=FirstThat(@IsAtLine);
  1919. end;
  1920. procedure TBreakpointCollection.ShowAllBreakpoints;
  1921. procedure SetInSource(P : PBreakpoint);
  1922. var
  1923. W : PSourceWindow;
  1924. begin
  1925. If assigned(P^.FileName) then
  1926. begin
  1927. W:=SearchOnDesktop(P^.FileName^,false);
  1928. if assigned(W) then
  1929. W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
  1930. end;
  1931. end;
  1932. begin
  1933. ForEach(@SetInSource);
  1934. end;
  1935. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  1936. function IsThis(P : PBreakpoint) : boolean;
  1937. begin
  1938. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  1939. end;
  1940. begin
  1941. GetType:=FirstThat(@IsThis);
  1942. end;
  1943. function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
  1944. function IsThere(P : PBreakpoint) : boolean;
  1945. begin
  1946. IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
  1947. (OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
  1948. end;
  1949. var
  1950. PB : PBreakpoint;
  1951. begin
  1952. ToggleFileLine:=false;
  1953. FileName:=OSFileName(FExpand(FileName));
  1954. PB:=FirstThat(@IsThere);
  1955. If Assigned(PB) then
  1956. begin
  1957. { delete it form source window }
  1958. PB^.state:=bs_disabled;
  1959. PB^.UpdateSource;
  1960. { remove from collection }
  1961. BreakpointsCollection^.free(PB);
  1962. end
  1963. else
  1964. begin
  1965. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  1966. if assigned(PB) then
  1967. Begin
  1968. Insert(PB);
  1969. PB^.UpdateSource;
  1970. ToggleFileLine:=true;
  1971. End;
  1972. end;
  1973. Update;
  1974. end;
  1975. {****************************************************************************
  1976. TBreakpointItem
  1977. ****************************************************************************}
  1978. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  1979. begin
  1980. inherited Init;
  1981. Breakpoint:=ABreakpoint;
  1982. end;
  1983. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  1984. var S: string;
  1985. begin
  1986. with Breakpoint^ do
  1987. begin
  1988. S:=BreakpointTypeStr[typ];
  1989. While Length(S)<10 do
  1990. S:=S+' ';
  1991. S:=S+'|';
  1992. S:=S+BreakpointStateStr[state]+' ';
  1993. While Length(S)<20 do
  1994. S:=S+' ';
  1995. S:=S+'|';
  1996. if (typ=bt_file_line) then
  1997. begin
  1998. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line);
  1999. While Length(S)<40 do
  2000. S:=S+' ';
  2001. S:=S+'|';
  2002. S:=S+copy(DirOf(GetStr(FileName)),1,min(length(DirOf(GetStr(FileName))),29));
  2003. end
  2004. else
  2005. S:=S+GetStr(name);
  2006. While Length(S)<70 do
  2007. S:=S+' ';
  2008. S:=S+'|';
  2009. if IgnoreCount>0 then
  2010. S:=S+IntToStr(IgnoreCount);
  2011. While Length(S)<79 do
  2012. S:=S+' ';
  2013. S:=S+'|';
  2014. if assigned(Conditions) then
  2015. S:=S+' '+GetStr(Conditions);
  2016. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  2017. GetText:=S;
  2018. end;
  2019. end;
  2020. procedure TBreakpointItem.Selected;
  2021. begin
  2022. end;
  2023. function TBreakpointItem.GetModuleName: string;
  2024. begin
  2025. if breakpoint^.typ=bt_file_line then
  2026. GetModuleName:=GetStr(breakpoint^.FileName)
  2027. else
  2028. GetModuleName:='';
  2029. end;
  2030. {****************************************************************************
  2031. TBreakpointsListBox
  2032. ****************************************************************************}
  2033. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2034. begin
  2035. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  2036. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2037. NoSelection:=true;
  2038. end;
  2039. function TBreakpointsListBox.GetLocalMenu: PMenu;
  2040. var M: PMenu;
  2041. begin
  2042. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2043. M:=NewMenu(
  2044. NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  2045. NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  2046. NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  2047. NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  2048. NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  2049. nil))))));
  2050. GetLocalMenu:=M;
  2051. end;
  2052. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  2053. var DontClear: boolean;
  2054. begin
  2055. case Event.What of
  2056. evKeyDown :
  2057. begin
  2058. DontClear:=false;
  2059. case Event.KeyCode of
  2060. kbEnd :
  2061. FocusItem(List^.Count-1);
  2062. kbHome :
  2063. FocusItem(0);
  2064. kbEnter :
  2065. Message(@Self,evCommand,cmMsgGotoSource,nil);
  2066. kbIns :
  2067. Message(@Self,evCommand,cmNewBreakpoint,nil);
  2068. kbDel :
  2069. Message(@Self,evCommand,cmDeleteBreakpoint,nil);
  2070. else
  2071. DontClear:=true;
  2072. end;
  2073. if not DontClear then
  2074. ClearEvent(Event);
  2075. end;
  2076. evBroadcast :
  2077. case Event.Command of
  2078. cmListItemSelected :
  2079. if Event.InfoPtr=@Self then
  2080. Message(@Self,evCommand,cmEditBreakpoint,nil);
  2081. end;
  2082. evCommand :
  2083. begin
  2084. DontClear:=false;
  2085. case Event.Command of
  2086. cmMsgTrackSource :
  2087. if Range>0 then
  2088. TrackSource;
  2089. cmEditBreakpoint :
  2090. EditCurrent;
  2091. cmToggleBreakpoint :
  2092. ToggleCurrent;
  2093. cmDeleteBreakpoint :
  2094. DeleteCurrent;
  2095. cmNewBreakpoint :
  2096. EditNew;
  2097. cmMsgClear :
  2098. Clear;
  2099. else
  2100. DontClear:=true;
  2101. end;
  2102. if not DontClear then
  2103. ClearEvent(Event);
  2104. end;
  2105. end;
  2106. inherited HandleEvent(Event);
  2107. end;
  2108. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  2109. var W : integer;
  2110. begin
  2111. if List=nil then New(List, Init(20,20));
  2112. W:=length(P^.GetText(255));
  2113. if W>MaxWidth then
  2114. begin
  2115. MaxWidth:=W;
  2116. if HScrollBar<>nil then
  2117. HScrollBar^.SetRange(0,MaxWidth);
  2118. end;
  2119. List^.Insert(P);
  2120. SetRange(List^.Count);
  2121. if Focused=List^.Count-1-1 then
  2122. FocusItem(List^.Count-1);
  2123. P^.Breakpoint^.UpdateSource;
  2124. DrawView;
  2125. end;
  2126. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  2127. var P: PBreakpointItem;
  2128. S: string;
  2129. begin
  2130. P:=List^.At(Item);
  2131. S:=P^.GetText(MaxLen);
  2132. GetText:=copy(S,1,MaxLen);
  2133. end;
  2134. procedure TBreakpointsListBox.Clear;
  2135. begin
  2136. if assigned(List) then
  2137. Dispose(List, Done);
  2138. List:=nil;
  2139. MaxWidth:=0;
  2140. SetRange(0); DrawView;
  2141. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2142. end;
  2143. procedure TBreakpointsListBox.TrackSource;
  2144. var W: PSourceWindow;
  2145. P: PBreakpointItem;
  2146. R: TRect;
  2147. begin
  2148. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  2149. if Range=0 then Exit;*)
  2150. P:=List^.At(Focused);
  2151. if P^.GetModuleName='' then Exit;
  2152. Desktop^.Lock;
  2153. GetNextEditorBounds(R);
  2154. R.B.Y:=Owner^.Origin.Y;
  2155. W:=EditorWindowFile(P^.GetModuleName);
  2156. if assigned(W) then
  2157. begin
  2158. W^.GetExtent(R);
  2159. R.B.Y:=Owner^.Origin.Y;
  2160. W^.ChangeBounds(R);
  2161. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  2162. end
  2163. else
  2164. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  2165. if W<>nil then
  2166. begin
  2167. W^.Select;
  2168. W^.Editor^.TrackCursor(do_centre);
  2169. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
  2170. end;
  2171. if Assigned(Owner) then
  2172. Owner^.Select;
  2173. Desktop^.UnLock;
  2174. end;
  2175. procedure TBreakpointsListBox.ToggleCurrent;
  2176. var
  2177. P: PBreakpointItem;
  2178. begin
  2179. if Range=0 then Exit;
  2180. P:=List^.At(Focused);
  2181. if P=nil then Exit;
  2182. if P^.Breakpoint^.state=bs_enabled then
  2183. P^.Breakpoint^.state:=bs_disabled
  2184. else if P^.Breakpoint^.state=bs_disabled then
  2185. P^.Breakpoint^.state:=bs_enabled;
  2186. P^.Breakpoint^.UpdateSource;
  2187. BreakpointsCollection^.Update;
  2188. end;
  2189. procedure TBreakpointsListBox.EditCurrent;
  2190. var
  2191. P: PBreakpointItem;
  2192. begin
  2193. if Range=0 then Exit;
  2194. P:=List^.At(Focused);
  2195. if P=nil then Exit;
  2196. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  2197. P^.Breakpoint^.UpdateSource;
  2198. BreakpointsCollection^.Update;
  2199. end;
  2200. procedure TBreakpointsListBox.DeleteCurrent;
  2201. var
  2202. P: PBreakpointItem;
  2203. begin
  2204. if Range=0 then Exit;
  2205. P:=List^.At(Focused);
  2206. if P=nil then Exit;
  2207. { delete it form source window }
  2208. P^.Breakpoint^.state:=bs_disabled;
  2209. P^.Breakpoint^.UpdateSource;
  2210. BreakpointsCollection^.free(P^.Breakpoint);
  2211. List^.free(P);
  2212. BreakpointsCollection^.Update;
  2213. end;
  2214. procedure TBreakpointsListBox.EditNew;
  2215. var
  2216. P: PBreakpoint;
  2217. begin
  2218. P:=New(PBreakpoint,Init_Empty);
  2219. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  2220. begin
  2221. P^.UpdateSource;
  2222. BreakpointsCollection^.Insert(P);
  2223. BreakpointsCollection^.Update;
  2224. end
  2225. else
  2226. dispose(P,Done);
  2227. end;
  2228. procedure TBreakpointsListBox.Draw;
  2229. var
  2230. I, J, Item: Sw_Integer;
  2231. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2232. ColWidth, CurCol, Indent: Integer;
  2233. B: TDrawBuffer;
  2234. Text: String;
  2235. SCOff: Byte;
  2236. TC: byte;
  2237. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  2238. begin
  2239. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2240. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2241. begin
  2242. NormalColor := GetColor(1);
  2243. FocusedColor := GetColor(3);
  2244. SelectedColor := GetColor(4);
  2245. end else
  2246. begin
  2247. NormalColor := GetColor(2);
  2248. SelectedColor := GetColor(4);
  2249. end;
  2250. if Transparent then
  2251. begin MT(NormalColor); MT(SelectedColor); end;
  2252. if NoSelection then
  2253. SelectedColor:=NormalColor;
  2254. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2255. else Indent := 0;
  2256. ColWidth := Size.X div NumCols + 1;
  2257. for I := 0 to Size.Y - 1 do
  2258. begin
  2259. for J := 0 to NumCols-1 do
  2260. begin
  2261. Item := J*Size.Y + I + TopItem;
  2262. CurCol := J*ColWidth;
  2263. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2264. (Focused = Item) and (Range > 0) then
  2265. begin
  2266. Color := FocusedColor;
  2267. SetCursor(CurCol+1,I);
  2268. SCOff := 0;
  2269. end
  2270. else if (Item < Range) and IsSelected(Item) then
  2271. begin
  2272. Color := SelectedColor;
  2273. SCOff := 2;
  2274. end
  2275. else
  2276. begin
  2277. Color := NormalColor;
  2278. SCOff := 4;
  2279. end;
  2280. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2281. if Item < Range then
  2282. begin
  2283. Text := GetText(Item, ColWidth + Indent);
  2284. Text := Copy(Text,Indent,ColWidth);
  2285. MoveStr(B[CurCol+1], Text, Color);
  2286. if ShowMarkers then
  2287. begin
  2288. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2289. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2290. end;
  2291. end;
  2292. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2293. end;
  2294. WriteLine(0, I, Size.X, 1, B);
  2295. end;
  2296. end;
  2297. constructor TBreakpointsListBox.Load(var S: TStream);
  2298. begin
  2299. inherited Load(S);
  2300. end;
  2301. procedure TBreakpointsListBox.Store(var S: TStream);
  2302. var OL: PCollection;
  2303. OldR : integer;
  2304. begin
  2305. OL:=List;
  2306. OldR:=Range;
  2307. Range:=0;
  2308. New(List, Init(1,1));
  2309. inherited Store(S);
  2310. Dispose(List, Done);
  2311. Range:=OldR;
  2312. List:=OL;
  2313. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  2314. collection? Pasting here a modified version of TListBox.Store+
  2315. TAdvancedListBox.Store isn't a better solution, since by eventually
  2316. changing the obj-hierarchy you'll always have to modify this, too - BG }
  2317. end;
  2318. destructor TBreakpointsListBox.Done;
  2319. begin
  2320. inherited Done;
  2321. if List<>nil then Dispose(List, Done);
  2322. end;
  2323. {****************************************************************************
  2324. TBreakpointsWindow
  2325. ****************************************************************************}
  2326. constructor TBreakpointsWindow.Init;
  2327. var R,R2: TRect;
  2328. HSB,VSB: PScrollBar;
  2329. ST: PStaticText;
  2330. S: String;
  2331. X,X1 : Sw_integer;
  2332. Btn: PButton;
  2333. const
  2334. NumButtons = 5;
  2335. begin
  2336. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  2337. inherited Init(R, dialog_breakpointlist, wnNoNumber);
  2338. HelpCtx:=hcBreakpointListWindow;
  2339. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  2340. S:=label_breakpointpropheader;
  2341. New(ST, Init(R,S));
  2342. ST^.GrowMode:=gfGrowHiX;
  2343. Insert(ST);
  2344. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  2345. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  2346. ST^.GrowMode:=gfGrowHiX;
  2347. Insert(ST);
  2348. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  2349. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  2350. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  2351. HSB^.SetStep(R.B.X-R.A.X-2,1);
  2352. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  2353. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2354. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  2355. New(BreakLB, Init(R,HSB,VSB));
  2356. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2357. BreakLB^.Transparent:=true;
  2358. Insert(BreakLB);
  2359. GetExtent(R);R.Grow(-1,-1);
  2360. Dec(R.B.Y);
  2361. R.A.Y:=R.B.Y-2;
  2362. X:=(R.B.X-R.A.X) div NumButtons;
  2363. X1:=R.A.X+(X div 2);
  2364. R.A.X:=X1-3;R.B.X:=X1+7;
  2365. New(Btn, Init(R, button_Close, cmClose, bfDefault));
  2366. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2367. Insert(Btn);
  2368. X1:=X1+X;
  2369. R.A.X:=X1-3;R.B.X:=X1+7;
  2370. New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
  2371. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2372. Insert(Btn);
  2373. X1:=X1+X;
  2374. R.A.X:=X1-3;R.B.X:=X1+7;
  2375. New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
  2376. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2377. Insert(Btn);
  2378. X1:=X1+X;
  2379. R.A.X:=X1-3;R.B.X:=X1+7;
  2380. New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
  2381. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2382. Insert(Btn);
  2383. X1:=X1+X;
  2384. R.A.X:=X1-3;R.B.X:=X1+7;
  2385. New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
  2386. Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2387. Insert(Btn);
  2388. BreakLB^.Select;
  2389. Update;
  2390. BreakpointsWindow:=@self;
  2391. end;
  2392. constructor TBreakpointsWindow.Load(var S: TStream);
  2393. begin
  2394. inherited Load(S);
  2395. GetSubViewPtr(S,BreakLB);
  2396. end;
  2397. procedure TBreakpointsWindow.Store(var S: TStream);
  2398. begin
  2399. inherited Store(S);
  2400. PutSubViewPtr(S,BreakLB);
  2401. end;
  2402. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  2403. begin
  2404. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  2405. end;
  2406. procedure TBreakpointsWindow.ClearBreakpoints;
  2407. begin
  2408. BreakLB^.Clear;
  2409. ReDraw;
  2410. end;
  2411. procedure TBreakpointsWindow.ReloadBreakpoints;
  2412. procedure InsertInBreakLB(P : PBreakpoint);
  2413. begin
  2414. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  2415. end;
  2416. begin
  2417. If not assigned(BreakpointsCollection) then
  2418. exit;
  2419. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  2420. ReDraw;
  2421. end;
  2422. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  2423. begin
  2424. inherited SizeLimits(Min,Max);
  2425. Min.X:=40; Min.Y:=18;
  2426. end;
  2427. procedure TBreakpointsWindow.Close;
  2428. begin
  2429. Hide;
  2430. end;
  2431. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  2432. var DontClear : boolean;
  2433. begin
  2434. case Event.What of
  2435. evKeyDown :
  2436. begin
  2437. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  2438. begin
  2439. ClearEvent(Event);
  2440. Hide;
  2441. end;
  2442. end;
  2443. evCommand :
  2444. begin
  2445. DontClear:=False;
  2446. case Event.Command of
  2447. cmNewBreakpoint :
  2448. BreakLB^.EditNew;
  2449. cmEditBreakpoint :
  2450. BreakLB^.EditCurrent;
  2451. cmDeleteBreakpoint :
  2452. BreakLB^.DeleteCurrent;
  2453. cmToggleBreakInList :
  2454. BreakLB^.ToggleCurrent;
  2455. cmClose :
  2456. Hide;
  2457. else
  2458. DontClear:=true;
  2459. end;
  2460. if not DontClear then
  2461. ClearEvent(Event);
  2462. end;
  2463. evBroadcast :
  2464. case Event.Command of
  2465. cmUpdate :
  2466. Update;
  2467. end;
  2468. end;
  2469. inherited HandleEvent(Event);
  2470. end;
  2471. procedure TBreakpointsWindow.Update;
  2472. var
  2473. StoreFocus : longint;
  2474. begin
  2475. StoreFocus:=BreakLB^.Focused;
  2476. ClearBreakpoints;
  2477. ReloadBreakpoints;
  2478. If StoreFocus<BreakLB^.Range then
  2479. BreakLB^.FocusItem(StoreFocus);
  2480. end;
  2481. destructor TBreakpointsWindow.Done;
  2482. begin
  2483. inherited Done;
  2484. BreakpointsWindow:=nil;
  2485. end;
  2486. {****************************************************************************
  2487. TBreakpointItemDialog
  2488. ****************************************************************************}
  2489. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  2490. var R,R2,R3: TRect;
  2491. Items: PSItem;
  2492. I : BreakpointType;
  2493. KeyCount: sw_integer;
  2494. begin
  2495. KeyCount:=longint(high(BreakpointType));
  2496. R.Assign(0,0,60,Max(9+KeyCount,18));
  2497. inherited Init(R,dialog_modifynewbreakpoint);
  2498. Breakpoint:=ABreakpoint;
  2499. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  2500. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
  2501. New(NameIL, Init(R, 255)); Insert(NameIL);
  2502. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2503. Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
  2504. R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
  2505. R2.Copy(R); R2.Move(-1,-1);
  2506. Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
  2507. R.Move(0,3);
  2508. R.B.X:=R.B.X-3;
  2509. New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
  2510. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  2511. Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
  2512. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
  2513. R.Move(0,3); R.B.X:=R.A.X+36;
  2514. New(LineIL, Init(R, 128)); Insert(LineIL);
  2515. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2516. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
  2517. R.Move(0,3);
  2518. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  2519. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  2520. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
  2521. R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
  2522. Items:=nil;
  2523. { don't use invalid type }
  2524. for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
  2525. Items:=NewSItem(BreakpointTypeStr[I], Items);
  2526. New(TypeRB, Init(R, Items));
  2527. R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
  2528. Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
  2529. Insert(TypeRB);
  2530. InsertButtons(@Self);
  2531. NameIL^.Select;
  2532. end;
  2533. function TBreakpointItemDialog.Execute: Word;
  2534. var R: sw_word;
  2535. S1: string;
  2536. err: word;
  2537. L: longint;
  2538. begin
  2539. R:=sw_word(Breakpoint^.typ);
  2540. TypeRB^.SetData(R);
  2541. If Breakpoint^.typ=bt_file_line then
  2542. S1:=GetStr(Breakpoint^.FileName)
  2543. else
  2544. S1:=GetStr(Breakpoint^.name);
  2545. NameIL^.SetData(S1);
  2546. If Breakpoint^.typ=bt_file_line then
  2547. S1:=IntToStr(Breakpoint^.Line)
  2548. else
  2549. S1:='0';
  2550. LineIL^.SetData(S1);
  2551. S1:=IntToStr(Breakpoint^.IgnoreCount);
  2552. IgnoreIL^.SetData(S1);
  2553. S1:=GetStr(Breakpoint^.Conditions);
  2554. ConditionsIL^.SetData(S1);
  2555. if assigned(FirstEditorWindow) then
  2556. FindReplaceEditor:=FirstEditorWindow^.Editor;
  2557. R:=inherited Execute;
  2558. FindReplaceEditor:=nil;
  2559. if R=cmOK then
  2560. begin
  2561. TypeRB^.GetData(R);
  2562. L:=R;
  2563. Breakpoint^.typ:=BreakpointType(L);
  2564. NameIL^.GetData(S1);
  2565. If Breakpoint^.typ=bt_file_line then
  2566. begin
  2567. If assigned(Breakpoint^.FileName) then
  2568. DisposeStr(Breakpoint^.FileName);
  2569. Breakpoint^.FileName:=NewStr(S1);
  2570. end
  2571. else
  2572. begin
  2573. If assigned(Breakpoint^.Name) then
  2574. DisposeStr(Breakpoint^.Name);
  2575. Breakpoint^.name:=NewStr(S1);
  2576. end;
  2577. If Breakpoint^.typ=bt_file_line then
  2578. begin
  2579. LineIL^.GetData(S1);
  2580. Val(S1,L,err);
  2581. Breakpoint^.Line:=L;
  2582. end;
  2583. IgnoreIL^.GetData(S1);
  2584. Val(S1,L,err);
  2585. Breakpoint^.IgnoreCount:=L;
  2586. ConditionsIL^.GetData(S1);
  2587. If assigned(Breakpoint^.Conditions) then
  2588. DisposeStr(Breakpoint^.Conditions);
  2589. Breakpoint^.Conditions:=NewStr(S1);
  2590. end;
  2591. Execute:=R;
  2592. end;
  2593. {****************************************************************************
  2594. TWatch
  2595. ****************************************************************************}
  2596. constructor TWatch.Init(s : string);
  2597. begin
  2598. expr:=NewStr(s);
  2599. last_value:=nil;
  2600. current_value:=nil;
  2601. Get_new_value;
  2602. GDBRunCount:=-1;
  2603. end;
  2604. constructor TWatch.Load(var S: TStream);
  2605. begin
  2606. expr:=S.ReadStr;
  2607. last_value:=nil;
  2608. current_value:=nil;
  2609. Get_new_value;
  2610. GDBRunCount:=-1;
  2611. end;
  2612. procedure TWatch.Store(var S: TStream);
  2613. begin
  2614. S.WriteStr(expr);
  2615. end;
  2616. procedure TWatch.rename(s : string);
  2617. begin
  2618. if assigned(expr) then
  2619. begin
  2620. if GetStr(expr)=S then
  2621. exit;
  2622. DisposeStr(expr);
  2623. end;
  2624. expr:=NewStr(s);
  2625. if assigned(last_value) then
  2626. StrDispose(last_value);
  2627. last_value:=nil;
  2628. if assigned(current_value) then
  2629. StrDispose(current_value);
  2630. current_value:=nil;
  2631. GDBRunCount:=-1;
  2632. Get_new_value;
  2633. end;
  2634. procedure TWatch.Get_new_value;
  2635. {$ifndef NODEBUG}
  2636. var i, curframe, startframe : longint;
  2637. s,s2,orig_s_result : AnsiString;
  2638. loop_higher, found : boolean;
  2639. function GetValue(var s : AnsiString) : boolean;
  2640. begin
  2641. s:=Debugger^.PrintCommand(s);
  2642. GetValue := not Debugger^.Error;
  2643. { do not open a messagebox for such errors }
  2644. Debugger^.got_error:=false;
  2645. end;
  2646. begin
  2647. If not assigned(Debugger) or Not Debugger^.HasExe or
  2648. (GDBRunCount=Debugger^.RunCount) then
  2649. exit;
  2650. GDBRunCount:=Debugger^.RunCount;
  2651. if assigned(last_value) then
  2652. strdispose(last_value);
  2653. last_value:=current_value;
  2654. s:=GetStr(expr);
  2655. { Fix 2d array indexing, change [x,x] to [x][x] }
  2656. i:=pos('[',s);
  2657. if i>0 then
  2658. begin
  2659. while i<length(s) do
  2660. begin
  2661. if s[i]=',' then
  2662. begin
  2663. s[i]:='[';
  2664. insert(']',s,i);
  2665. inc(i);
  2666. end;
  2667. inc(i);
  2668. end;
  2669. end;
  2670. found:=GetValue(s);
  2671. orig_s_result:=s;
  2672. Debugger^.got_error:=false;
  2673. loop_higher:=not found;
  2674. if not found then
  2675. begin
  2676. curframe:=Debugger^.get_current_frame;
  2677. startframe:=curframe;
  2678. end
  2679. else
  2680. begin
  2681. curframe:=0;
  2682. startframe:=0;
  2683. end;
  2684. while loop_higher do
  2685. begin
  2686. s:='parentfp';
  2687. if GetValue(s) then
  2688. begin
  2689. repeat
  2690. inc(curframe);
  2691. if not Debugger^.set_current_frame(curframe) then
  2692. loop_higher:=false;
  2693. {$ifdef FrameNameKnown}
  2694. s2:=FrameName;
  2695. {$else not FrameNameKnown}
  2696. s2:='$ebp';
  2697. {$endif FrameNameKnown}
  2698. if not getValue(s2) then
  2699. loop_higher:=false;
  2700. if pos(s2,s)>0 then
  2701. loop_higher :=false;
  2702. until not loop_higher;
  2703. { try again at that level }
  2704. s:=GetStr(expr);
  2705. found:=GetValue(s);
  2706. loop_higher:=not found;
  2707. end
  2708. else
  2709. loop_higher:=false;
  2710. end;
  2711. if found then
  2712. current_value:=StrNew(PChar('= ' + s))
  2713. else
  2714. current_value:=StrNew(PChar(orig_s_result));
  2715. Debugger^.got_error:=false;
  2716. { We should try here to find the expr in parent
  2717. procedure if there are
  2718. I will implement this as I added a
  2719. parent_ebp pseudo local var to local procedure
  2720. in stabs debug info PM }
  2721. { But there are some pitfalls like
  2722. locals redefined in other sublocals that call the function }
  2723. if curframe<>startframe then
  2724. Debugger^.set_current_frame(startframe);
  2725. GDBRunCount:=Debugger^.RunCount;
  2726. end;
  2727. {$else NODEBUG}
  2728. begin
  2729. end;
  2730. {$endif NODEBUG}
  2731. procedure TWatch.Force_new_value;
  2732. begin
  2733. GDBRunCount:=-1;
  2734. Get_new_value;
  2735. end;
  2736. destructor TWatch.Done;
  2737. begin
  2738. if assigned(expr) then
  2739. disposestr(expr);
  2740. if assigned(last_value) then
  2741. strdispose(last_value);
  2742. if assigned(current_value) then
  2743. strdispose(current_value);
  2744. inherited done;
  2745. end;
  2746. {****************************************************************************
  2747. TWatchesCollection
  2748. ****************************************************************************}
  2749. constructor TWatchesCollection.Init;
  2750. begin
  2751. inherited Init(10,10);
  2752. end;
  2753. procedure TWatchesCollection.Insert(Item: Pointer);
  2754. begin
  2755. PWatch(Item)^.Get_new_value;
  2756. Inherited Insert(Item);
  2757. Update;
  2758. end;
  2759. procedure TWatchesCollection.Update;
  2760. var
  2761. W,W1 : integer;
  2762. procedure GetMax(P : PWatch);
  2763. begin
  2764. if assigned(P^.Current_value) then
  2765. W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
  2766. else
  2767. W1:=2+Length(GetStr(P^.expr));
  2768. if W1>W then
  2769. W:=W1;
  2770. end;
  2771. begin
  2772. W:=0;
  2773. ForEach(@GetMax);
  2774. MaxW:=W;
  2775. If assigned(WatchesWindow) then
  2776. WatchesWindow^.WLB^.Update(MaxW);
  2777. end;
  2778. function TWatchesCollection.At(Index: Integer): PWatch;
  2779. begin
  2780. At:=Inherited At(Index);
  2781. end;
  2782. {****************************************************************************
  2783. TWatchesListBox
  2784. ****************************************************************************}
  2785. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2786. begin
  2787. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  2788. If assigned(List) then
  2789. dispose(list,done);
  2790. List:=WatchesCollection;
  2791. end;
  2792. procedure TWatchesListBox.Update(AMaxWidth : integer);
  2793. var R : TRect;
  2794. begin
  2795. GetExtent(R);
  2796. MaxWidth:=AMaxWidth;
  2797. if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
  2798. HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
  2799. else
  2800. HScrollBar^.SetRange(0,0);
  2801. if R.B.X-R.A.X>MaxWidth then
  2802. HScrollBar^.Hide
  2803. else
  2804. HScrollBar^.Show;
  2805. SetRange(List^.Count+1);
  2806. if R.B.Y-R.A.Y>Range then
  2807. VScrollBar^.Hide
  2808. else
  2809. VScrollBar^.Show;
  2810. {if Focused=List^.Count-1-1 then
  2811. FocusItem(List^.Count-1);
  2812. What was that for ?? PM }
  2813. DrawView;
  2814. end;
  2815. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
  2816. var
  2817. PW : PWatch;
  2818. ValOffset : Sw_integer;
  2819. S : String;
  2820. begin
  2821. Modified:=false;
  2822. if Item>=WatchesCollection^.Count then
  2823. begin
  2824. GetIndentedText:='';
  2825. exit;
  2826. end;
  2827. PW:=WatchesCollection^.At(Item);
  2828. ValOffset:=Length(GetStr(PW^.Expr))+2;
  2829. if not assigned(PW^.expr) then
  2830. GetIndentedText:=''
  2831. else if Indent<ValOffset then
  2832. begin
  2833. S:=GetStr(PW^.Expr);
  2834. if Indent=0 then
  2835. S:=' '+S
  2836. else
  2837. S:=Copy(S,Indent,High(S));
  2838. if not assigned(PW^.current_value) then
  2839. S:=S+' <Unknown value>'
  2840. else
  2841. S:=S+' '+GetPChar(PW^.Current_value);
  2842. GetIndentedText:=Copy(S,1,MaxLen);
  2843. end
  2844. else
  2845. begin
  2846. if not assigned(PW^.Current_value) or
  2847. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  2848. S:=''
  2849. else
  2850. S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
  2851. GetIndentedText:=Copy(S,1,MaxLen);
  2852. end;
  2853. if assigned(PW^.current_value) and
  2854. assigned(PW^.last_value) and
  2855. (strcomp(PW^.Last_value,PW^.Current_value)<>0) then
  2856. Modified:=true;
  2857. end;
  2858. procedure TWatchesListBox.EditCurrent;
  2859. var
  2860. P: PWatch;
  2861. begin
  2862. if Range=0 then Exit;
  2863. if Focused<WatchesCollection^.Count then
  2864. P:=WatchesCollection^.At(Focused)
  2865. else
  2866. P:=New(PWatch,Init(''));
  2867. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  2868. WatchesCollection^.Update;
  2869. end;
  2870. function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2871. var
  2872. Dummy_Modified : boolean;
  2873. begin
  2874. GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
  2875. end;
  2876. procedure TWatchesListBox.DeleteCurrent;
  2877. var
  2878. P: PWatch;
  2879. begin
  2880. if (Range=0) or
  2881. (Focused>=WatchesCollection^.Count) then
  2882. exit;
  2883. P:=WatchesCollection^.At(Focused);
  2884. WatchesCollection^.free(P);
  2885. WatchesCollection^.Update;
  2886. end;
  2887. procedure TWatchesListBox.EditNew;
  2888. var
  2889. P: PWatch;
  2890. S : string;
  2891. begin
  2892. if Focused<WatchesCollection^.Count then
  2893. begin
  2894. P:=WatchesCollection^.At(Focused);
  2895. S:=GetStr(P^.expr);
  2896. end
  2897. else
  2898. S:='';
  2899. P:=New(PWatch,Init(S));
  2900. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  2901. begin
  2902. WatchesCollection^.AtInsert(Focused,P);
  2903. WatchesCollection^.Update;
  2904. end
  2905. else
  2906. dispose(P,Done);
  2907. end;
  2908. procedure TWatchesListBox.Draw;
  2909. var
  2910. I, J, Item: Sw_Integer;
  2911. NormalColor, SelectedColor, FocusedColor, Color: Word;
  2912. ColWidth, CurCol, Indent: Integer;
  2913. B: TDrawBuffer;
  2914. Modified : boolean;
  2915. Text: String;
  2916. SCOff: Byte;
  2917. TC: byte;
  2918. procedure MT(var C: word);
  2919. begin
  2920. if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
  2921. end;
  2922. begin
  2923. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  2924. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  2925. begin
  2926. NormalColor := GetColor(1);
  2927. FocusedColor := GetColor(3);
  2928. SelectedColor := GetColor(4);
  2929. end else
  2930. begin
  2931. NormalColor := GetColor(2);
  2932. SelectedColor := GetColor(4);
  2933. end;
  2934. if Transparent then
  2935. begin MT(NormalColor); MT(SelectedColor); end;
  2936. (* if NoSelection then
  2937. SelectedColor:=NormalColor;*)
  2938. if HScrollBar <> nil then Indent := HScrollBar^.Value
  2939. else Indent := 0;
  2940. ColWidth := Size.X div NumCols + 1;
  2941. for I := 0 to Size.Y - 1 do
  2942. begin
  2943. for J := 0 to NumCols-1 do
  2944. begin
  2945. Item := J*Size.Y + I + TopItem;
  2946. CurCol := J*ColWidth;
  2947. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  2948. (Focused = Item) and (Range > 0) then
  2949. begin
  2950. Color := FocusedColor;
  2951. SetCursor(CurCol+1,I);
  2952. SCOff := 0;
  2953. end
  2954. else if (Item < Range) and IsSelected(Item) then
  2955. begin
  2956. Color := SelectedColor;
  2957. SCOff := 2;
  2958. end
  2959. else
  2960. begin
  2961. Color := NormalColor;
  2962. SCOff := 4;
  2963. end;
  2964. MoveChar(B[CurCol], ' ', Color, ColWidth);
  2965. if Item < Range then
  2966. begin
  2967. (* Text := GetText(Item, ColWidth + Indent);
  2968. Text := Copy(Text,Indent,ColWidth); *)
  2969. Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
  2970. if modified then
  2971. begin
  2972. SCOff:=0;
  2973. Color:=(Color and $fff0) or Red;
  2974. end;
  2975. MoveStr(B[CurCol], Text, Color);
  2976. if {ShowMarkers or } Modified then
  2977. begin
  2978. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  2979. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  2980. WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
  2981. end;
  2982. end;
  2983. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  2984. end;
  2985. WriteLine(0, I, Size.X, 1, B);
  2986. end;
  2987. end;
  2988. function TWatchesListBox.GetLocalMenu: PMenu;
  2989. var M: PMenu;
  2990. begin
  2991. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  2992. M:=NewMenu(
  2993. NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
  2994. NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
  2995. NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
  2996. NewLine(
  2997. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  2998. nil))))));
  2999. GetLocalMenu:=M;
  3000. end;
  3001. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  3002. var DontClear: boolean;
  3003. begin
  3004. case Event.What of
  3005. evMouseDown : begin
  3006. if Event.Double then
  3007. Message(@Self,evCommand,cmEdit,nil)
  3008. else
  3009. ClearEvent(Event);
  3010. end;
  3011. evKeyDown :
  3012. begin
  3013. DontClear:=false;
  3014. case Event.KeyCode of
  3015. kbEnter :
  3016. Message(@Self,evCommand,cmEdit,nil);
  3017. kbIns :
  3018. Message(@Self,evCommand,cmNew,nil);
  3019. kbDel :
  3020. Message(@Self,evCommand,cmDelete,nil);
  3021. else
  3022. DontClear:=true;
  3023. end;
  3024. if not DontClear then
  3025. ClearEvent(Event);
  3026. end;
  3027. evBroadcast :
  3028. case Event.Command of
  3029. cmListItemSelected :
  3030. if Event.InfoPtr=@Self then
  3031. Message(@Self,evCommand,cmEdit,nil);
  3032. end;
  3033. evCommand :
  3034. begin
  3035. DontClear:=false;
  3036. case Event.Command of
  3037. cmEdit :
  3038. EditCurrent;
  3039. cmDelete :
  3040. DeleteCurrent;
  3041. cmNew :
  3042. EditNew;
  3043. else
  3044. DontClear:=true;
  3045. end;
  3046. if not DontClear then
  3047. ClearEvent(Event);
  3048. end;
  3049. end;
  3050. inherited HandleEvent(Event);
  3051. end;
  3052. constructor TWatchesListBox.Load(var S: TStream);
  3053. begin
  3054. inherited Load(S);
  3055. If assigned(List) then
  3056. dispose(list,done);
  3057. List:=WatchesCollection;
  3058. { we must set Range PM }
  3059. SetRange(List^.count+1);
  3060. end;
  3061. procedure TWatchesListBox.Store(var S: TStream);
  3062. var OL: PCollection;
  3063. OldRange : Sw_integer;
  3064. begin
  3065. OL:=List;
  3066. OldRange:=Range;
  3067. Range:=0;
  3068. New(List, Init(1,1));
  3069. inherited Store(S);
  3070. Dispose(List, Done);
  3071. List:=OL;
  3072. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  3073. collection? Pasting here a modified version of TListBox.Store+
  3074. TAdvancedListBox.Store isn't a better solution, since by eventually
  3075. changing the obj-hierarchy you'll always have to modify this, too - BG }
  3076. SetRange(OldRange);
  3077. end;
  3078. destructor TWatchesListBox.Done;
  3079. begin
  3080. List:=nil;
  3081. inherited Done;
  3082. end;
  3083. {****************************************************************************
  3084. TWatchesWindow
  3085. ****************************************************************************}
  3086. Constructor TWatchesWindow.Init;
  3087. var
  3088. HSB,VSB: PScrollBar;
  3089. R,R2 : trect;
  3090. begin
  3091. Desktop^.GetExtent(R);
  3092. R.A.Y:=R.B.Y-7;
  3093. inherited Init(R, dialog_watches,SearchFreeWindowNo);
  3094. Palette:=wpCyanWindow;
  3095. GetExtent(R);
  3096. HelpCtx:=hcWatchesWindow;
  3097. R.Grow(-1,-1);
  3098. R2.Copy(R);
  3099. Inc(R2.B.Y);
  3100. R2.A.Y:=R2.B.Y-1;
  3101. New(HSB, Init(R2));
  3102. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3103. HSB^.SetStep(R.B.X-R.A.X,1);
  3104. Insert(HSB);
  3105. R2.Copy(R);
  3106. Inc(R2.B.X);
  3107. R2.A.X:=R2.B.X-1;
  3108. New(VSB, Init(R2));
  3109. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3110. Insert(VSB);
  3111. New(WLB,Init(R,HSB,VSB));
  3112. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3113. WLB^.Transparent:=true;
  3114. Insert(WLB);
  3115. If assigned(WatchesWindow) then
  3116. dispose(WatchesWindow,done);
  3117. WatchesWindow:=@Self;
  3118. Update;
  3119. end;
  3120. procedure TWatchesWindow.Update;
  3121. begin
  3122. WatchesCollection^.Update;
  3123. Draw;
  3124. end;
  3125. constructor TWatchesWindow.Load(var S: TStream);
  3126. begin
  3127. inherited Load(S);
  3128. GetSubViewPtr(S,WLB);
  3129. If assigned(WatchesWindow) then
  3130. dispose(WatchesWindow,done);
  3131. WatchesWindow:=@Self;
  3132. end;
  3133. procedure TWatchesWindow.Store(var S: TStream);
  3134. begin
  3135. inherited Store(S);
  3136. PutSubViewPtr(S,WLB);
  3137. end;
  3138. Destructor TWatchesWindow.Done;
  3139. begin
  3140. WatchesWindow:=nil;
  3141. Dispose(WLB,done);
  3142. inherited done;
  3143. end;
  3144. {****************************************************************************
  3145. TWatchItemDialog
  3146. ****************************************************************************}
  3147. constructor TWatchItemDialog.Init(AWatch: PWatch);
  3148. var R,R2: TRect;
  3149. begin
  3150. R.Assign(0,0,50,10);
  3151. inherited Init(R,'Edit Watch');
  3152. Watch:=AWatch;
  3153. GetExtent(R); R.Grow(-3,-2);
  3154. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  3155. New(NameIL, Init(R, 255)); Insert(NameIL);
  3156. R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
  3157. Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
  3158. R2.Copy(R); R2.Move(-1,-1);
  3159. Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
  3160. GetExtent(R);
  3161. R.Grow(-3,-1);
  3162. R.A.Y:=R.A.Y+3;
  3163. TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
  3164. Insert(TextST);
  3165. InsertButtons(@Self);
  3166. NameIL^.Select;
  3167. end;
  3168. function TWatchItemDialog.Execute: Word;
  3169. var R: word;
  3170. S1,S2: string;
  3171. begin
  3172. S1:=GetStr(Watch^.expr);
  3173. NameIL^.SetData(S1);
  3174. S1:=GetPChar(Watch^.Current_value);
  3175. S2:=GetPChar(Watch^.Last_value);
  3176. ClearFormatParams;
  3177. AddFormatParamStr(S1);
  3178. AddFormatParamStr(S2);
  3179. if assigned(Watch^.Last_value) and
  3180. assigned(Watch^.Current_value) and
  3181. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  3182. S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
  3183. else
  3184. S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
  3185. TextST^.SetText(S1);
  3186. if assigned(FirstEditorWindow) then
  3187. FindReplaceEditor:=FirstEditorWindow^.Editor;
  3188. R:=inherited Execute;
  3189. FindReplaceEditor:=nil;
  3190. if R=cmOK then
  3191. begin
  3192. NameIL^.GetData(S1);
  3193. Watch^.Rename(S1);
  3194. {$ifndef NODEBUG}
  3195. If assigned(Debugger) then
  3196. Debugger^.ReadWatches;
  3197. {$endif NODEBUG}
  3198. end;
  3199. Execute:=R;
  3200. end;
  3201. {****************************************************************************
  3202. TStackWindow
  3203. ****************************************************************************}
  3204. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3205. begin
  3206. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3207. end;
  3208. procedure TFramesListBox.Update;
  3209. var i : longint;
  3210. W : PSourceWindow;
  3211. begin
  3212. {$ifndef NODEBUG}
  3213. { call backtrace command }
  3214. If not assigned(Debugger) then
  3215. exit;
  3216. DeskTop^.Lock;
  3217. Clear;
  3218. if Debugger^.WindowWidth<>-1 then
  3219. Debugger^.SetCommand('width 0xffffffff');
  3220. Debugger^.Backtrace;
  3221. { generate list }
  3222. { all is in tframeentry }
  3223. for i:=0 to Debugger^.frame_count-1 do
  3224. begin
  3225. with Debugger^.frames[i]^ do
  3226. begin
  3227. if assigned(file_name) then
  3228. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  3229. AddModuleName(GetPChar(file_name)),line_number,1)))
  3230. else
  3231. AddItem(new(PMessageItem,init(0,HexStr(address,SizeOf(address)*2)+' '+GetPChar(function_name)+GetPChar(args),
  3232. AddModuleName(''),line_number,1)));
  3233. W:=SearchOnDesktop(GetPChar(file_name),false);
  3234. { First reset all Debugger rows }
  3235. If assigned(W) then
  3236. begin
  3237. W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
  3238. W^.Editor^.DebuggerRow:=-1;
  3239. end;
  3240. end;
  3241. end;
  3242. { Now set all Debugger rows }
  3243. for i:=0 to Debugger^.frame_count-1 do
  3244. begin
  3245. with Debugger^.frames[i]^ do
  3246. begin
  3247. W:=SearchOnDesktop(GetPChar(file_name),false);
  3248. If assigned(W) then
  3249. begin
  3250. If W^.Editor^.DebuggerRow=-1 then
  3251. begin
  3252. W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
  3253. W^.Editor^.DebuggerRow:=line_number-1;
  3254. end;
  3255. end;
  3256. end;
  3257. end;
  3258. if Assigned(list) and (List^.Count > 0) then
  3259. FocusItem(0);
  3260. if Debugger^.WindowWidth<>-1 then
  3261. Debugger^.SetCommand('width '+IntToStr(Debugger^.WindowWidth));
  3262. DeskTop^.Unlock;
  3263. {$endif NODEBUG}
  3264. end;
  3265. function TFramesListBox.GetLocalMenu: PMenu;
  3266. begin
  3267. GetLocalMenu:=Inherited GetLocalMenu;
  3268. end;
  3269. procedure TFramesListBox.GotoSource;
  3270. begin
  3271. {$ifndef NODEBUG}
  3272. { select frame for watches }
  3273. If not assigned(Debugger) then
  3274. exit;
  3275. Debugger^.SelectFrameCommand(Focused);
  3276. { for local vars }
  3277. Debugger^.RereadWatches;
  3278. {$endif NODEBUG}
  3279. { goto source }
  3280. inherited GotoSource;
  3281. end;
  3282. procedure TFramesListBox.GotoAssembly;
  3283. begin
  3284. {$ifndef NODEBUG}
  3285. { select frame for watches }
  3286. If not assigned(Debugger) then
  3287. exit;
  3288. Debugger^.SelectFrameCommand(Focused);
  3289. { for local vars }
  3290. Debugger^.RereadWatches;
  3291. {$endif}
  3292. { goto source/assembly mixture }
  3293. InitDisassemblyWindow;
  3294. DisassemblyWindow^.LoadFunction('');
  3295. {$ifndef NODEBUG}
  3296. DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
  3297. DisassemblyWindow^.SelectInDebugSession;
  3298. {$endif NODEBUG}
  3299. end;
  3300. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  3301. begin
  3302. if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
  3303. ((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
  3304. GotoAssembly;
  3305. inherited HandleEvent(Event);
  3306. end;
  3307. destructor TFramesListBox.Done;
  3308. begin
  3309. Inherited Done;
  3310. end;
  3311. Constructor TStackWindow.Init;
  3312. var
  3313. HSB,VSB: PScrollBar;
  3314. R,R2 : trect;
  3315. begin
  3316. Desktop^.GetExtent(R);
  3317. R.A.Y:=R.B.Y-5;
  3318. inherited Init(R, dialog_callstack, wnNoNumber);
  3319. Palette:=wpCyanWindow;
  3320. GetExtent(R);
  3321. HelpCtx:=hcStackWindow;
  3322. R.Grow(-1,-1);
  3323. R2.Copy(R);
  3324. Inc(R2.B.Y);
  3325. R2.A.Y:=R2.B.Y-1;
  3326. New(HSB, Init(R2));
  3327. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  3328. Insert(HSB);
  3329. R2.Copy(R);
  3330. Inc(R2.B.X);
  3331. R2.A.X:=R2.B.X-1;
  3332. New(VSB, Init(R2));
  3333. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  3334. Insert(VSB);
  3335. New(FLB,Init(R,HSB,VSB));
  3336. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3337. Insert(FLB);
  3338. If assigned(StackWindow) then
  3339. dispose(StackWindow,done);
  3340. StackWindow:=@Self;
  3341. Update;
  3342. end;
  3343. procedure TStackWindow.Update;
  3344. begin
  3345. FLB^.Update;
  3346. DrawView;
  3347. end;
  3348. constructor TStackWindow.Load(var S: TStream);
  3349. begin
  3350. inherited Load(S);
  3351. GetSubViewPtr(S,FLB);
  3352. If assigned(StackWindow) then
  3353. dispose(StackWindow,done);
  3354. StackWindow:=@Self;
  3355. end;
  3356. procedure TStackWindow.Store(var S: TStream);
  3357. begin
  3358. inherited Store(S);
  3359. PutSubViewPtr(S,FLB);
  3360. end;
  3361. Destructor TStackWindow.Done;
  3362. begin
  3363. StackWindow:=nil;
  3364. Dispose(FLB,done);
  3365. inherited done;
  3366. end;
  3367. {$ifdef SUPPORT_REMOTE}
  3368. {****************************************************************************
  3369. TransformRemoteString
  3370. ****************************************************************************}
  3371. function TransformRemoteString(st : string) : string;
  3372. begin
  3373. If RemoteConfig<>'' then
  3374. ReplaceStrI(St,'$CONFIG','-F '+RemoteConfig)
  3375. else
  3376. ReplaceStrI(St,'$CONFIG','');
  3377. If RemoteIdent<>'' then
  3378. ReplaceStrI(St,'$IDENT','-i '+RemoteIdent)
  3379. else
  3380. ReplaceStrI(St,'$IDENT','');
  3381. If RemotePuttySession<>'' then
  3382. ReplaceStrI(St,'$PUTTYSESSION','-load '+RemotePuttySession)
  3383. else
  3384. ReplaceStrI(St,'$PUTTYSESSION','');
  3385. ReplaceStrI(St,'$LOCALFILENAME',NameAndExtOf(ExeFile));
  3386. ReplaceStrI(St,'$LOCALFILE',ExeFile);
  3387. ReplaceStrI(St,'$REMOTEDIR',RemoteDir);
  3388. ReplaceStrI(St,'$REMOTEPORT',RemotePort);
  3389. ReplaceStrI(St,'$REMOTEMACHINE',RemoteMachine);
  3390. ReplaceStrI(St,'$REMOTEGDBSERVER',maybequoted(remotegdbserver));
  3391. ReplaceStrI(St,'$REMOTECOPY',maybequoted(RemoteCopy));
  3392. ReplaceStrI(St,'$REMOTESHELL',maybequoted(RemoteShell));
  3393. { avoid infinite recursion here !!! }
  3394. if Pos('$REMOTEEXECCOMMAND',UpcaseSTr(St))>0 then
  3395. ReplaceStrI(St,'$REMOTEEXECCOMMAND',TransformRemoteString(RemoteExecCommand));
  3396. {$ifdef WINDOWS}
  3397. ReplaceStrI(St,'$START','start "Shell to remote"');
  3398. ReplaceStrI(St,'$DOITINBACKGROUND','');
  3399. {$else}
  3400. ReplaceStrI(St,'$START','');
  3401. ReplaceStrI(St,'$DOITINBACKGROUND',' &');
  3402. {$endif}
  3403. TransformRemoteString:=st;
  3404. end;
  3405. {$endif SUPPORT_REMOTE}
  3406. {****************************************************************************
  3407. Init/Final
  3408. ****************************************************************************}
  3409. function GetGDBTargetShortName : string;
  3410. begin
  3411. {$ifndef CROSSGDB}
  3412. GetGDBTargetShortName:=source_info.shortname;
  3413. {$else CROSSGDB}
  3414. {$ifdef SUPPORT_REMOTE}
  3415. {$ifdef PALMOSGDB}
  3416. GetGDBTargetShortName:='palmos';
  3417. {$else}
  3418. GetGDBTargetShortName:='linux';
  3419. {$endif PALMOSGDB}
  3420. {$endif not SUPPORT_REMOTE}
  3421. {$endif CROSSGDB}
  3422. end;
  3423. procedure InitDebugger;
  3424. {$ifdef DEBUG}
  3425. var s : string;
  3426. i,p : longint;
  3427. {$endif DEBUG}
  3428. var
  3429. NeedRecompileExe : boolean;
  3430. cm : longint;
  3431. begin
  3432. {$ifdef DEBUG}
  3433. if not use_gdb_file then
  3434. begin
  3435. Assign(gdb_file,GDBOutFileName);
  3436. {$I-}
  3437. Rewrite(gdb_file);
  3438. if InOutRes<>0 then
  3439. begin
  3440. s:=GDBOutFileName;
  3441. p:=pos('.',s);
  3442. if p>1 then
  3443. for i:=0 to 9 do
  3444. begin
  3445. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  3446. InOutRes:=0;
  3447. Assign(gdb_file,s);
  3448. rewrite(gdb_file);
  3449. if InOutRes=0 then
  3450. break;
  3451. end;
  3452. end;
  3453. if IOResult=0 then
  3454. Use_gdb_file:=true;
  3455. end;
  3456. {$I+}
  3457. {$endif}
  3458. NeedRecompileExe:=false;
  3459. {$ifndef SUPPORT_REMOTE}
  3460. if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
  3461. begin
  3462. ClearFormatParams;
  3463. AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
  3464. AddFormatParamStr(GetGDBTargetShortName);
  3465. cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
  3466. if cm=cmCancel then
  3467. Exit;
  3468. if cm=cmYes then
  3469. begin
  3470. { force recompilation }
  3471. PrevMainFile:='';
  3472. NeedRecompileExe:=true;
  3473. TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
  3474. If DebugInfoSwitches^.GetCurrSelParam='-' then
  3475. DebugInfoSwitches^.SetCurrSelParam('l');
  3476. IDEApp.UpdateTarget;
  3477. end;
  3478. end;
  3479. {$endif ndef SUPPORT_REMOTE}
  3480. if not NeedRecompileExe then
  3481. NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
  3482. (PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
  3483. if Not NeedRecompileExe and Not MainHasDebugInfo then
  3484. begin
  3485. ClearFormatParams;
  3486. cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
  3487. if cm=cmCancel then
  3488. Exit;
  3489. if cm=cmYes then
  3490. begin
  3491. { force recompilation }
  3492. PrevMainFile:='';
  3493. NeedRecompileExe:=true;
  3494. DebugInfoSwitches^.SetCurrSelParam('l');
  3495. end;
  3496. end;
  3497. if NeedRecompileExe then
  3498. DoCompile(cRun);
  3499. if CompilationPhase<>cpDone then
  3500. Exit;
  3501. if (EXEFile='') then
  3502. begin
  3503. ErrorBox(msg_nothingtodebug,nil);
  3504. Exit;
  3505. end;
  3506. { init debugcontroller }
  3507. {$ifndef NODEBUG}
  3508. if not assigned(Debugger) then
  3509. begin
  3510. PushStatus(msg_startingdebugger);
  3511. new(Debugger,Init);
  3512. PopStatus;
  3513. end;
  3514. Debugger^.SetExe(ExeFile);
  3515. {$endif NODEBUG}
  3516. {$ifdef GDBWINDOW}
  3517. InitGDBWindow;
  3518. {$endif def GDBWINDOW}
  3519. end;
  3520. const
  3521. Invalid_gdb_file_handle: boolean = false;
  3522. procedure DoneDebugger;
  3523. begin
  3524. {$ifdef DEBUG}
  3525. If IDEApp.IsRunning then
  3526. PushStatus('Closing debugger');
  3527. {$endif}
  3528. {$ifndef NODEBUG}
  3529. if assigned(Debugger) then
  3530. dispose(Debugger,Done);
  3531. Debugger:=nil;
  3532. {$endif NODEBUG}
  3533. {$ifdef DOS}
  3534. If assigned(UserScreen) then
  3535. PDosScreen(UserScreen)^.FreeGraphBuffer;
  3536. {$endif DOS}
  3537. {$ifdef DEBUG}
  3538. If Use_gdb_file then
  3539. begin
  3540. Use_gdb_file:=false;
  3541. {$IFOPT I+}
  3542. {$I-}
  3543. {$DEFINE REENABLE_I}
  3544. {$ENDIF}
  3545. Close(GDB_file);
  3546. if ioresult<>0 then
  3547. begin
  3548. { This handle seems to get lost for DJGPP
  3549. don't bother too much about this. }
  3550. Invalid_gdb_file_handle:=true;
  3551. end;
  3552. {$IFDEF REENABLE_I}
  3553. {$I+}
  3554. {$ENDIF}
  3555. end;
  3556. If IDEApp.IsRunning then
  3557. PopStatus;
  3558. {$endif DEBUG}
  3559. end;
  3560. procedure InitGDBWindow;
  3561. var
  3562. R : TRect;
  3563. begin
  3564. if GDBWindow=nil then
  3565. begin
  3566. DeskTop^.GetExtent(R);
  3567. new(GDBWindow,init(R));
  3568. DeskTop^.Insert(GDBWindow);
  3569. end;
  3570. end;
  3571. procedure DoneGDBWindow;
  3572. begin
  3573. If IDEApp.IsRunning and
  3574. assigned(GDBWindow) then
  3575. begin
  3576. DeskTop^.Delete(GDBWindow);
  3577. end;
  3578. GDBWindow:=nil;
  3579. end;
  3580. procedure InitDisassemblyWindow;
  3581. var
  3582. R : TRect;
  3583. begin
  3584. if DisassemblyWindow=nil then
  3585. begin
  3586. DeskTop^.GetExtent(R);
  3587. new(DisassemblyWindow,init(R));
  3588. DeskTop^.Insert(DisassemblyWindow);
  3589. end;
  3590. end;
  3591. procedure DoneDisassemblyWindow;
  3592. begin
  3593. if assigned(DisassemblyWindow) then
  3594. begin
  3595. DeskTop^.Delete(DisassemblyWindow);
  3596. Dispose(DisassemblyWindow,Done);
  3597. DisassemblyWindow:=nil;
  3598. end;
  3599. end;
  3600. procedure InitStackWindow;
  3601. begin
  3602. if StackWindow=nil then
  3603. begin
  3604. new(StackWindow,init);
  3605. DeskTop^.Insert(StackWindow);
  3606. end;
  3607. end;
  3608. procedure DoneStackWindow;
  3609. begin
  3610. if assigned(StackWindow) then
  3611. begin
  3612. DeskTop^.Delete(StackWindow);
  3613. StackWindow:=nil;
  3614. end;
  3615. end;
  3616. procedure InitBreakpoints;
  3617. begin
  3618. New(BreakpointsCollection,init(10,10));
  3619. end;
  3620. procedure DoneBreakpoints;
  3621. begin
  3622. Dispose(BreakpointsCollection,Done);
  3623. BreakpointsCollection:=nil;
  3624. end;
  3625. procedure InitWatches;
  3626. begin
  3627. New(WatchesCollection,init);
  3628. end;
  3629. procedure DoneWatches;
  3630. begin
  3631. Dispose(WatchesCollection,Done);
  3632. WatchesCollection:=nil;
  3633. end;
  3634. procedure RegisterFPDebugViews;
  3635. begin
  3636. RegisterType(RWatchesWindow);
  3637. RegisterType(RBreakpointsWindow);
  3638. RegisterType(RWatchesListBox);
  3639. RegisterType(RBreakpointsListBox);
  3640. RegisterType(RStackWindow);
  3641. RegisterType(RFramesListBox);
  3642. RegisterType(RBreakpoint);
  3643. RegisterType(RWatch);
  3644. RegisterType(RBreakpointCollection);
  3645. RegisterType(RWatchesCollection);
  3646. end;
  3647. end.
  3648. {$endif NODEBUG}