fpdebug.pas 104 KB

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