fpregs.pas 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998-2000 by Pierre Muller
  4. Register debug 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 FPRegs;
  12. {$ifdef NODEBUG}
  13. interface
  14. implementation
  15. end.
  16. {$else NODEBUG}
  17. interface
  18. uses
  19. {$ifdef Windows}
  20. Windows,
  21. {$endif Windows}
  22. Objects,Dialogs,Drivers,Views,
  23. FPViews;
  24. const
  25. MaxRegs = 128;
  26. type
  27. {$undef cpu_known}
  28. TIntRegs = record
  29. {$ifndef test_generic_cpu}
  30. {$ifdef i386}
  31. {$define cpu_known}
  32. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  33. cs,ds,es,ss,fs,gs : word;
  34. eflags : dword;
  35. {$endif i386}
  36. {$ifdef x86_64}
  37. {$define cpu_known}
  38. rax,rbx,rcx,rdx,rsi,rdi,rbp,rsp,
  39. r8,r9,r10,r11,r12,r13,r14,r15,
  40. rip : qword;
  41. cs,ds,es,ss,fs,gs : word;
  42. eflags : dword;
  43. {$endif x86_64}
  44. {$ifdef m68k}
  45. {$define cpu_known}
  46. d0,d1,d2,d3,d4,d5,d6,d7 : dword;
  47. a0,a1,a2,a3,a4,a5,fp,sp : dword;
  48. ps,pc : dword;
  49. {$endif m68k}
  50. {$ifdef powerpc}
  51. {$define cpu_known}
  52. r : array [0..31] of dword;
  53. pc,ps,cr,lr,ctr,xer : dword;
  54. {$endif powerpc}
  55. {$ifdef sparc}
  56. {$define cpu_known}
  57. o : array [0..7] of dword;
  58. i : array [0..7] of dword;
  59. l : array [0..7] of dword;
  60. g : array [0..7] of dword;
  61. y,psr,wim,tbr,pc,npc,fsr,csr : dword;
  62. {$endif sparc}
  63. {$endif not test_generic_cpu}
  64. {$ifndef cpu_known}
  65. reg : array [0..MaxRegs-1] of string;
  66. {$endif not cpu_known}
  67. end;
  68. PRegistersView = ^TRegistersView;
  69. TRegistersView = object(TView)
  70. NewReg,OldReg : TIntRegs;
  71. InDraw : boolean;
  72. GDBCount : longint;
  73. first : boolean;
  74. constructor Init(var Bounds: TRect);
  75. procedure Draw;virtual;
  76. destructor Done; virtual;
  77. end;
  78. PRegistersWindow = ^TRegistersWindow;
  79. TRegistersWindow = Object(TFPDlgWindow)
  80. RV : PRegistersView;
  81. Constructor Init;
  82. constructor Load(var S: TStream);
  83. procedure Store(var S: TStream);
  84. procedure Update; virtual;
  85. destructor Done; virtual;
  86. end;
  87. TFPURegs = record
  88. {$ifndef test_generic_cpu}
  89. {$if defined(i386) or defined(x86_64)}
  90. st0,st1,st2,st3,st4,st5,st6,st7 :string;
  91. ftag,fop,fctrl,fstat,fiseg,foseg : word;
  92. fioff,fooff : cardinal;
  93. {$endif i386 or x86_64}
  94. {$ifdef m68k}
  95. fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string;
  96. fpcontrol,fpstatus,fpiaddr : dword;
  97. {$endif m68k}
  98. {$ifdef powerpc}
  99. f : array [0..31] of string;
  100. {$endif powerpc}
  101. {$ifdef sparc}
  102. f : array [0..31] of string;
  103. {$endif sparc}
  104. {$endif not test_generic_cpu}
  105. {$ifndef cpu_known}
  106. freg : array [0..MaxRegs-1] of string;
  107. {$endif not cpu_known}
  108. end;
  109. PFPUView = ^TFPUView;
  110. TFPUView = object(TView)
  111. NewReg,OldReg : TFPURegs;
  112. InDraw : boolean;
  113. GDBCount : longint;
  114. {$ifndef cpu_known}
  115. UseInfoFloat : boolean;
  116. {$endif not cpu_known}
  117. first : boolean;
  118. constructor Init(var Bounds: TRect);
  119. procedure Draw;virtual;
  120. destructor Done; virtual;
  121. end;
  122. PFPUWindow = ^TFPUWindow;
  123. TFPUWindow = Object(TFPDlgWindow)
  124. RV : PFPUView;
  125. Constructor Init;
  126. constructor Load(var S: TStream);
  127. procedure Store(var S: TStream);
  128. procedure Update; virtual;
  129. destructor Done; virtual;
  130. end;
  131. tssereg = record
  132. case byte of
  133. 1 : (bytearray : array[0..15] of byte);
  134. 2 : (wordarray : array[0..7] of word);
  135. 3 : (dwordarray : array[0..3] of dword);
  136. 4 : (qwordarray : array[0..1] of qword);
  137. 5 : (twordfield : array[0..1] of qword);
  138. 6 : (singlearray : array[0..3] of single);
  139. 7 : (doublearray : array[0..1] of double);
  140. end;
  141. tmmxreg = record
  142. case byte of
  143. 1 : (bytearray : array[0..7] of byte);
  144. 2 : (wordarray : array[0..3] of word);
  145. 3 : (dwordarray : array[0..1] of dword);
  146. 4 : (qwordfield : qword);
  147. 6 : (singlearray : array[0..1] of single);
  148. end;
  149. TVectorRegs = record
  150. {$ifndef test_generic_cpu}
  151. {$if defined(i386) or defined(x86_64)}
  152. xmm : array[0..7] of string;
  153. mmx : array[0..7] of string;
  154. mxcsr : string;
  155. {$endif i386 or x86_64}
  156. {$ifdef powerpc}
  157. m : array[0..31] of string;
  158. {$endif powerpc}
  159. {$endif not test_generic_cpu}
  160. {$ifndef cpu_known}
  161. vreg : array [0..MaxRegs-1] of string;
  162. {$endif not cpu_known}
  163. end;
  164. PVectorView = ^TVectorView;
  165. TVectorView = object(TView)
  166. NewReg,OldReg : TVectorRegs;
  167. InDraw : boolean;
  168. GDBCount : longint;
  169. {$ifndef cpu_known}
  170. UseInfoVector : boolean;
  171. {$endif not cpu_known}
  172. first : boolean;
  173. constructor Init(var Bounds: TRect);
  174. procedure Draw;virtual;
  175. destructor Done; virtual;
  176. end;
  177. PVectorWindow = ^TVectorWindow;
  178. TVectorWindow = Object(TFPDlgWindow)
  179. RV : PVectorView;
  180. Constructor Init;
  181. constructor Load(var S: TStream);
  182. procedure Store(var S: TStream);
  183. procedure Update; virtual;
  184. destructor Done; virtual;
  185. end;
  186. procedure InitRegistersWindow;
  187. procedure DoneRegistersWindow;
  188. procedure InitFPUWindow;
  189. procedure DoneFPUWindow;
  190. procedure InitVectorWindow;
  191. procedure DoneVectorWindow;
  192. procedure RegisterFPRegsViews;
  193. implementation
  194. uses
  195. Strings,
  196. {$ifndef NODEBUG}
  197. {$ifdef GDBMI}
  198. GDBMICon, GDBMIInt,
  199. {$else GDBMI}
  200. GDBCon,GDBInt,
  201. {$endif GDBMI}
  202. {$endif NODEBUG}
  203. App,Menus,
  204. WViews,WEditor,
  205. wutils,
  206. FPConst,FPVars,
  207. FPDebug;
  208. Const
  209. RRegistersWindow: TStreamRec = (
  210. ObjType: 1711;
  211. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  212. Load: @TRegistersWindow.Load;
  213. Store: @TRegistersWindow.Store
  214. );
  215. RRegistersView: TStreamRec = (
  216. ObjType: 1712;
  217. VmtLink: Ofs(TypeOf(TRegistersView)^);
  218. Load: @TRegistersView.Load;
  219. Store: @TRegistersView.Store
  220. );
  221. RFPUWindow: TStreamRec = (
  222. ObjType: 1713;
  223. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  224. Load: @TFPUWindow.Load;
  225. Store: @TFPUWindow.Store
  226. );
  227. RFPUView: TStreamRec = (
  228. ObjType: 1714;
  229. VmtLink: Ofs(TypeOf(TFPUView)^);
  230. Load: @TFPUView.Load;
  231. Store: @TFPUView.Store
  232. );
  233. RVectorView: TStreamRec = (
  234. ObjType: 1715;
  235. VmtLink: Ofs(TypeOf(TVectorView)^);
  236. Load: @TVectorView.Load;
  237. Store: @TVectorView.Store
  238. );
  239. {$ifdef useresstrings}
  240. resourcestring
  241. {$else}
  242. const
  243. {$endif}
  244. dialog_registers = 'Register View';
  245. dialog_fpu = 'FPU View';
  246. dialog_vector = 'Vector Unit View';
  247. msg_registervaluesnotavailable = '<no values available>';
  248. msg_registerwindowerror = '<debugger error>';
  249. {****************************************************************************
  250. TRegistersView
  251. ****************************************************************************}
  252. function GetIntRegs(var rs : TIntRegs) : boolean;
  253. var
  254. p,po : pchar;
  255. p1 : pchar;
  256. buffer : array[0..255] of char;
  257. i : byte;
  258. begin
  259. GetIntRegs:=false;
  260. {$ifndef NODEBUG}
  261. {$ifdef cpu_known}
  262. {$ifdef i386}
  263. GetIntRegs :=
  264. Debugger^.GetIntRegister('eax', rs.eax) and
  265. Debugger^.GetIntRegister('ebx', rs.ebx) and
  266. Debugger^.GetIntRegister('ecx', rs.ecx) and
  267. Debugger^.GetIntRegister('edx', rs.edx) and
  268. Debugger^.GetIntRegister('esi', rs.esi) and
  269. Debugger^.GetIntRegister('edi', rs.edi) and
  270. Debugger^.GetIntRegister('ebp', rs.ebp) and
  271. Debugger^.GetIntRegister('esp', rs.esp) and
  272. Debugger^.GetIntRegister('eip', rs.eip) and
  273. { under Windows flags are on a register named ps !! PM }
  274. (Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
  275. Debugger^.GetIntRegister('cs', rs.cs) and
  276. Debugger^.GetIntRegister('ds', rs.ds) and
  277. Debugger^.GetIntRegister('es', rs.es) and
  278. Debugger^.GetIntRegister('fs', rs.fs) and
  279. Debugger^.GetIntRegister('gs', rs.gs) and
  280. Debugger^.GetIntRegister('ss', rs.ss);
  281. {$endif i386}
  282. {$ifdef x86_64}
  283. GetIntRegs :=
  284. Debugger^.GetIntRegister('rax', rs.rax) and
  285. Debugger^.GetIntRegister('rbx', rs.rbx) and
  286. Debugger^.GetIntRegister('rcx', rs.rcx) and
  287. Debugger^.GetIntRegister('rdx', rs.rdx) and
  288. Debugger^.GetIntRegister('rsi', rs.rsi) and
  289. Debugger^.GetIntRegister('rdi', rs.rdi) and
  290. Debugger^.GetIntRegister('rbp', rs.rbp) and
  291. Debugger^.GetIntRegister('rsp', rs.rsp) and
  292. Debugger^.GetIntRegister('r8', rs.r8) and
  293. Debugger^.GetIntRegister('r9', rs.r9) and
  294. Debugger^.GetIntRegister('r10', rs.r10) and
  295. Debugger^.GetIntRegister('r11', rs.r11) and
  296. Debugger^.GetIntRegister('r12', rs.r12) and
  297. Debugger^.GetIntRegister('r13', rs.r13) and
  298. Debugger^.GetIntRegister('r14', rs.r14) and
  299. Debugger^.GetIntRegister('r15', rs.r15) and
  300. Debugger^.GetIntRegister('rip', rs.rip) and
  301. { under Windows flags are on a register named ps !! PM }
  302. (Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
  303. Debugger^.GetIntRegister('cs', rs.cs) and
  304. Debugger^.GetIntRegister('ds', rs.ds) and
  305. Debugger^.GetIntRegister('es', rs.es) and
  306. Debugger^.GetIntRegister('fs', rs.fs) and
  307. Debugger^.GetIntRegister('gs', rs.gs) and
  308. Debugger^.GetIntRegister('ss', rs.ss);
  309. {$endif x86_64}
  310. {$ifdef m68k}
  311. GetIntRegs :=
  312. Debugger^.GetIntRegister('d0', rs.d0) and
  313. Debugger^.GetIntRegister('d1', rs.d1) and
  314. Debugger^.GetIntRegister('d2', rs.d2) and
  315. Debugger^.GetIntRegister('d3', rs.d3) and
  316. Debugger^.GetIntRegister('d4', rs.d4) and
  317. Debugger^.GetIntRegister('d5', rs.d5) and
  318. Debugger^.GetIntRegister('d6', rs.d6) and
  319. Debugger^.GetIntRegister('d7', rs.d7) and
  320. Debugger^.GetIntRegister('a0', rs.a0) and
  321. Debugger^.GetIntRegister('a1', rs.a1) and
  322. Debugger^.GetIntRegister('a2', rs.a2) and
  323. Debugger^.GetIntRegister('a3', rs.a3) and
  324. Debugger^.GetIntRegister('a4', rs.a4) and
  325. Debugger^.GetIntRegister('a5', rs.a5) and
  326. Debugger^.GetIntRegister('fp', rs.fp) and
  327. Debugger^.GetIntRegister('sp', rs.sp) and
  328. Debugger^.GetIntRegister('ps', rs.ps) and
  329. Debugger^.GetIntRegister('pc', rs.pc);
  330. {$endif m68k}
  331. {$ifdef powerpc}
  332. GetIntRegs := true;
  333. for i:=0 to 31 do
  334. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('r'+inttostr(i), rs.r[i]);
  335. { other regs
  336. pc,ps,cr,lr,ctr,xer : dword; }
  337. GetIntRegs := GetIntRegs and
  338. Debugger^.GetIntRegister('pc', rs.pc) and
  339. Debugger^.GetIntRegister('ps', rs.ps) and
  340. Debugger^.GetIntRegister('lr', rs.lr) and
  341. Debugger^.GetIntRegister('ctr', rs.ctr) and
  342. Debugger^.GetIntRegister('xer', rs.xer);
  343. {$endif powerpc}
  344. {$ifdef sparc}
  345. GetIntRegs := true;
  346. for i:=0 to 7 do
  347. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('o'+inttostr(i), rs.o[i]);
  348. for i:=0 to 7 do
  349. if i = 6 then
  350. GetIntRegs := GetIntRegs and (Debugger^.GetIntRegister('i6', rs.i[6]) or Debugger^.GetIntRegister('fp', rs.i[6]))
  351. else
  352. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('i'+inttostr(i), rs.i[i]);
  353. for i:=0 to 7 do
  354. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('l'+inttostr(i), rs.l[i]);
  355. for i:=0 to 7 do
  356. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('g'+inttostr(i), rs.g[i]);
  357. GetIntRegs := GetIntRegs and
  358. Debugger^.GetIntRegister('y', rs.y) and
  359. Debugger^.GetIntRegister('psr', rs.psr) and
  360. Debugger^.GetIntRegister('wim', rs.wim) and
  361. Debugger^.GetIntRegister('tbs', rs.tbr) and
  362. Debugger^.GetIntRegister('pc', rs.pc) and
  363. Debugger^.GetIntRegister('npc', rs.npc) and
  364. Debugger^.GetIntRegister('fsr', rs.fsr) and
  365. Debugger^.GetIntRegister('csr', rs.csr);
  366. {$endif sparc}
  367. {$else cpu_known}
  368. Debugger^.Command('info registers');
  369. if Debugger^.Error then
  370. exit
  371. else
  372. begin
  373. i:=0;
  374. po:=StrNew(Debugger^.GetOutput);
  375. p:=po;
  376. if assigned(p) then
  377. begin
  378. fillchar(rs,sizeof(rs),0);
  379. p1:=strscan(p,' ');
  380. while assigned(p1) do
  381. begin
  382. p1:=strscan(p,#10);
  383. if assigned(p1) then
  384. begin
  385. strlcopy(buffer,p,p1-p);
  386. rs.reg[i]:=ExtractTabs(strpas(buffer),8);
  387. if i<MaxRegs-1 then
  388. inc(i);
  389. end;
  390. p:=strscan(p1,#10);
  391. if assigned(p) then
  392. begin
  393. p1:=strscan(p,' ');
  394. inc(p);
  395. end
  396. else
  397. break;
  398. end;
  399. { free allocated memory }
  400. strdispose(po);
  401. end
  402. else
  403. exit;
  404. end;
  405. { do not open a messagebox for such errors }
  406. Debugger^.got_error:=false;
  407. GetIntRegs:=true;
  408. {$endif cpu_known}
  409. {$endif not NODEBUG}
  410. end;
  411. constructor TRegistersView.Init(var Bounds: TRect);
  412. begin
  413. inherited init(Bounds);
  414. InDraw:=false;
  415. first:=true;
  416. FillChar(OldReg,Sizeof(OldReg),#0);
  417. FillChar(NewReg,Sizeof(NewReg),#0);
  418. GrowMode:=gfGrowHiX or GfGrowHiY;
  419. GDBCount:=-1;
  420. end;
  421. procedure TRegistersView.Draw;
  422. var
  423. rs : tintregs;
  424. OK : boolean;
  425. color :byte;
  426. i : byte;
  427. procedure SetColor(x,y : longint);
  428. begin
  429. if x=y then
  430. color:=7
  431. else
  432. color:=8;
  433. end;
  434. procedure SetColor(x,y : qword);
  435. begin
  436. if x=y then
  437. color:=7
  438. else
  439. color:=8;
  440. end;
  441. procedure SetStrColor(const x,y : string);
  442. begin
  443. if x=y then
  444. color:=7
  445. else
  446. color:=8;
  447. end;
  448. begin
  449. inherited draw;
  450. {$ifdef NODEBUG}
  451. WriteStr(1,0,msg_registervaluesnotavailable,7);
  452. {$else NODEBUG}
  453. If not assigned(Debugger) then
  454. begin
  455. WriteStr(1,0,msg_registervaluesnotavailable,7);
  456. exit;
  457. end;
  458. if InDraw then exit;
  459. InDraw:=true;
  460. if GDBCount<>Debugger^.RunCount then
  461. begin
  462. OldReg:=NewReg;
  463. OK:=GetIntRegs(rs);
  464. NewReg:=rs;
  465. { get inital values }
  466. if first then
  467. begin
  468. OldReg:=NewReg;
  469. first:=false;
  470. end;
  471. GDBCount:=Debugger^.RunCount;
  472. end
  473. else
  474. begin
  475. rs:=NewReg;
  476. OK:=true;
  477. end;
  478. if OK then
  479. begin
  480. {$ifdef cpu_known}
  481. {$ifdef i386}
  482. SetColor(rs.eax,OldReg.eax);
  483. WriteStr(1,0,'EAX '+HexStr(longint(rs.eax),8),color);
  484. SetColor(rs.ebx,OldReg.ebx);
  485. WriteStr(1,1,'EBX '+HexStr(longint(rs.ebx),8),color);
  486. SetColor(rs.ecx,OldReg.ecx);
  487. WriteStr(1,2,'ECX '+HexStr(longint(rs.ecx),8),color);
  488. SetColor(rs.edx,OldReg.edx);
  489. WriteStr(1,3,'EDX '+HexStr(longint(rs.edx),8),color);
  490. SetColor(rs.eip,OldReg.eip);
  491. WriteStr(1,4,'EIP '+HexStr(longint(rs.eip),8),color);
  492. SetColor(rs.esi,OldReg.esi);
  493. WriteStr(1,5,'ESI '+HexStr(longint(rs.esi),8),color);
  494. SetColor(rs.edi,OldReg.edi);
  495. WriteStr(1,6,'EDI '+HexStr(longint(rs.edi),8),color);
  496. SetColor(rs.esp,OldReg.esp);
  497. WriteStr(1,7,'ESP '+HexStr(longint(rs.esp),8),color);
  498. SetColor(rs.ebp,OldReg.ebp);
  499. WriteStr(1,8,'EBP '+HexStr(longint(rs.ebp),8),color);
  500. SetColor(rs.cs,OldReg.cs);
  501. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  502. SetColor(rs.ds,OldReg.ds);
  503. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  504. SetColor(rs.es,OldReg.es);
  505. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  506. SetColor(rs.fs,OldReg.fs);
  507. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  508. SetColor(rs.gs,OldReg.gs);
  509. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  510. SetColor(rs.ss,OldReg.ss);
  511. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  512. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  513. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  514. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  515. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  516. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  517. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  518. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  519. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  520. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  521. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  522. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  523. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  524. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  525. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  526. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  527. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  528. {$endif i386}
  529. {$ifdef x86_64}
  530. SetColor(rs.rax,OldReg.rax);
  531. WriteStr(1,0,'RAX '+HexStr(rs.rax,16),color);
  532. SetColor(rs.rbx,OldReg.rbx);
  533. WriteStr(1,1,'RBX '+HexStr(rs.rbx,16),color);
  534. SetColor(rs.rcx,OldReg.rcx);
  535. WriteStr(1,2,'RCX '+HexStr(rs.rcx,16),color);
  536. SetColor(rs.rdx,OldReg.rdx);
  537. WriteStr(1,3,'RDX '+HexStr(rs.rdx,16),color);
  538. SetColor(rs.rsi,OldReg.rsi);
  539. WriteStr(1,4,'RSI '+HexStr(rs.rsi,16),color);
  540. SetColor(rs.rdi,OldReg.rdi);
  541. WriteStr(1,5,'RDI '+HexStr(rs.rdi,16),color);
  542. SetColor(rs.rbp,OldReg.rbp);
  543. WriteStr(1,6,'RBP '+HexStr(rs.rbp,16),color);
  544. SetColor(rs.rsp,OldReg.rsp);
  545. WriteStr(1,7,'RSP '+HexStr(rs.rsp,16),color);
  546. SetColor(rs.r8,OldReg.r8);
  547. WriteStr(1,8,'R8 '+HexStr(rs.r8,16),color);
  548. SetColor(rs.r9,OldReg.r9);
  549. WriteStr(1,9,'R9 '+HexStr(rs.r9,16),color);
  550. SetColor(rs.r10,OldReg.r10);
  551. WriteStr(1,10,'R10 '+HexStr(rs.r10,16),color);
  552. SetColor(rs.r11,OldReg.r11);
  553. WriteStr(1,11,'R11 '+HexStr(rs.r11,16),color);
  554. SetColor(rs.r12,OldReg.r12);
  555. WriteStr(1,12,'R12 '+HexStr(rs.r12,16),color);
  556. SetColor(rs.r13,OldReg.r13);
  557. WriteStr(1,13,'R13 '+HexStr(rs.r13,16),color);
  558. SetColor(rs.r14,OldReg.r14);
  559. WriteStr(1,14,'R14 '+HexStr(rs.r14,16),color);
  560. SetColor(rs.r15,OldReg.r15);
  561. WriteStr(1,15,'R15 '+HexStr(rs.r15,16),color);
  562. SetColor(rs.rip,OldReg.rip);
  563. WriteStr(1,16,'RIP '+HexStr(rs.rip,16),color);
  564. SetColor(rs.cs,OldReg.cs);
  565. WriteStr(22,11,'CS '+HexStr(rs.cs,4),color);
  566. SetColor(rs.ds,OldReg.ds);
  567. WriteStr(22,12,'DS '+HexStr(rs.ds,4),color);
  568. SetColor(rs.es,OldReg.es);
  569. WriteStr(22,13,'ES '+HexStr(rs.es,4),color);
  570. SetColor(rs.fs,OldReg.fs);
  571. WriteStr(22,14,'FS '+HexStr(rs.fs,4),color);
  572. SetColor(rs.gs,OldReg.gs);
  573. WriteStr(22,15,'GS '+HexStr(rs.gs,4),color);
  574. SetColor(rs.ss,OldReg.ss);
  575. WriteStr(22,16,'SS '+HexStr(rs.ss,4),color);
  576. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  577. WriteStr(24,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  578. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  579. WriteStr(24,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  580. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  581. WriteStr(24,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  582. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  583. WriteStr(24,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  584. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  585. WriteStr(24,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  586. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  587. WriteStr(24,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  588. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  589. WriteStr(24,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  590. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  591. WriteStr(24,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  592. {$endif x86_64}
  593. {$ifdef m68k}
  594. SetColor(rs.d0,OldReg.d0);
  595. WriteStr(1,0,'d0 '+HexStr(longint(rs.d0),8),color);
  596. SetColor(rs.d1,OldReg.d1);
  597. WriteStr(1,1,'d1 '+HexStr(longint(rs.d1),8),color);
  598. SetColor(rs.d2,OldReg.d2);
  599. WriteStr(1,2,'d2 '+HexStr(longint(rs.d2),8),color);
  600. SetColor(rs.d3,OldReg.d3);
  601. WriteStr(1,3,'d3 '+HexStr(longint(rs.d3),8),color);
  602. SetColor(rs.d4,OldReg.d4);
  603. WriteStr(1,4,'d4 '+HexStr(longint(rs.d4),8),color);
  604. SetColor(rs.d5,OldReg.d5);
  605. WriteStr(1,5,'d5 '+HexStr(longint(rs.d5),8),color);
  606. SetColor(rs.d6,OldReg.d6);
  607. WriteStr(1,6,'d6 '+HexStr(longint(rs.d6),8),color);
  608. SetColor(rs.d7,OldReg.d7);
  609. WriteStr(1,7,'d7 '+HexStr(longint(rs.d7),8),color);
  610. SetColor(rs.a0,OldReg.a0);
  611. WriteStr(14,0,'a0 '+HexStr(longint(rs.a0),8),color);
  612. SetColor(rs.a1,OldReg.a1);
  613. WriteStr(14,1,'a1 '+HexStr(longint(rs.a1),8),color);
  614. SetColor(rs.a2,OldReg.a2);
  615. WriteStr(14,2,'a2 '+HexStr(longint(rs.a2),8),color);
  616. SetColor(rs.a3,OldReg.a3);
  617. WriteStr(14,3,'a3 '+HexStr(longint(rs.a3),8),color);
  618. SetColor(rs.a4,OldReg.a4);
  619. WriteStr(14,4,'a4 '+HexStr(longint(rs.a4),8),color);
  620. SetColor(rs.a5,OldReg.a5);
  621. WriteStr(14,5,'a5 '+HexStr(longint(rs.a5),8),color);
  622. SetColor(rs.fp,OldReg.fp);
  623. WriteStr(14,6,'fp '+HexStr(longint(rs.fp),8),color);
  624. SetColor(rs.sp,OldReg.sp);
  625. WriteStr(14,7,'sp '+HexStr(longint(rs.sp),8),color);
  626. SetColor(rs.pc,OldReg.pc);
  627. WriteStr(1,8,'pc '+HexStr(longint(rs.pc),8),color);
  628. SetColor(rs.ps and $1,OldReg.ps and $1);
  629. WriteStr(22,8,' c'+chr(byte((rs.ps and $1)<>0)+48),color);
  630. SetColor(rs.ps and $2,OldReg.ps and $2);
  631. WriteStr(19,8,' v'+chr(byte((rs.ps and $2)<>0)+48),color);
  632. SetColor(rs.ps and $4,OldReg.ps and $4);
  633. WriteStr(16,8,' z'+chr(byte((rs.ps and $4)<>0)+48),color);
  634. SetColor(rs.ps and $8,OldReg.ps and $8);
  635. WriteStr(14,8, 'x'+chr(byte((rs.ps and $8)<>0)+48),color);
  636. {$endif m68k}
  637. {$ifdef powerpc}
  638. for i:=0 to 15 do
  639. begin
  640. SetColor(rs.r[i],OldReg.r[i]);
  641. if i<10 then
  642. WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color)
  643. else
  644. WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
  645. end;
  646. for i:=16 to 31 do
  647. begin
  648. SetColor(rs.r[i],OldReg.r[i]);
  649. WriteStr(15,i-16,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
  650. end;
  651. { other regs pc,ps,cr,lr,ctr,xer : dword; }
  652. SetColor(rs.pc,OldReg.pc);
  653. WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
  654. SetColor(rs.ps,OldReg.ps);
  655. WriteStr(15,16,'ps '+HexStr(longint(rs.ps),8),color);
  656. SetColor(rs.lr,OldReg.lr);
  657. WriteStr(1,17,'lr '+HexStr(longint(rs.lr),8),color);
  658. SetColor(rs.ctr,OldReg.ctr);
  659. WriteStr(15,17,'ctr '+HexStr(longint(rs.ctr),8),color);
  660. SetColor(rs.xer,OldReg.xer);
  661. WriteStr(15,18,'xer '+HexStr(longint(rs.xer),8),color);
  662. {$endif powerpc}
  663. {$ifdef sparc}
  664. for i:=0 to 7 do
  665. begin
  666. SetColor(rs.g[i],OldReg.g[i]);
  667. WriteStr(1,i,'g'+IntToStr(i)+' '+HexStr(longint(rs.g[i]),8),color);
  668. SetColor(rs.l[i],OldReg.l[i]);
  669. WriteStr(1,i+8,'l'+IntToStr(i)+' '+HexStr(longint(rs.l[i]),8),color);
  670. end;
  671. for i:=0 to 7 do
  672. begin
  673. SetColor(rs.i[i],OldReg.i[i]);
  674. if i=6 then
  675. WriteStr(15,i,'fp '+HexStr(longint(rs.i[i]),8),color)
  676. else
  677. WriteStr(15,i,'i'+IntToStr(i)+' '+HexStr(longint(rs.i[i]),8),color);
  678. SetColor(rs.o[i],OldReg.o[i]);
  679. WriteStr(15,i+8,'o'+IntToStr(i)+' '+HexStr(longint(rs.o[i]),8),color);
  680. end;
  681. SetColor(rs.pc,OldReg.pc);
  682. WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
  683. SetColor(rs.y,OldReg.y);
  684. WriteStr(1,17,'y '+HexStr(longint(rs.y),8),color);
  685. SetColor(rs.psr,OldReg.psr);
  686. WriteStr(1,18,'psr '+HexStr(longint(rs.psr),8),color);
  687. SetColor(rs.csr,OldReg.csr);
  688. WriteStr(1,19,'csr '+HexStr(longint(rs.csr),8),color);
  689. SetColor(rs.npc,OldReg.npc);
  690. WriteStr(15,16,'npc '+HexStr(longint(rs.npc),8),color);
  691. SetColor(rs.tbr,OldReg.tbr);
  692. WriteStr(15,17,'tbr '+HexStr(longint(rs.tbr),8),color);
  693. SetColor(rs.wim,OldReg.wim);
  694. WriteStr(15,18,'wim '+HexStr(longint(rs.wim),8),color);
  695. SetColor(rs.fsr,OldReg.fsr);
  696. WriteStr(15,19,'fsr '+HexStr(longint(rs.fsr),8),color);
  697. {$endif sparc}
  698. {$else cpu_known}
  699. for i:=0 to MaxRegs-1 do
  700. begin
  701. SetStrColor(rs.reg[i],OldReg.reg[i]);
  702. WriteStr(1,i,rs.reg[i],color);
  703. end;
  704. {$endif cpu_known}
  705. end
  706. else
  707. WriteStr(0,0,msg_registerwindowerror,7);
  708. InDraw:=false;
  709. {$endif NODEBUG}
  710. end;
  711. destructor TRegistersView.Done;
  712. begin
  713. inherited done;
  714. end;
  715. {****************************************************************************
  716. TRegistersWindow
  717. ****************************************************************************}
  718. constructor TRegistersWindow.Init;
  719. var
  720. R : TRect;
  721. begin
  722. Desktop^.GetExtent(R);
  723. {$ifdef i386}
  724. R.A.X:=R.B.X-28;
  725. R.B.Y:=R.A.Y+11;
  726. {$endif i386}
  727. {$ifdef x86_64}
  728. R.A.X:=R.B.X-32;
  729. R.B.Y:=R.A.Y+19;
  730. {$endif x86_64}
  731. {$ifdef m68k}
  732. R.A.X:=R.B.X-28;
  733. R.B.Y:=R.A.Y+11;
  734. {$endif m68k}
  735. {$ifdef powerpc}
  736. R.A.X:=R.B.X-30;
  737. R.B.Y:=R.A.Y+21;
  738. {$endif powerpc}
  739. {$ifdef sparc}
  740. R.A.X:=R.B.X-30;
  741. R.B.Y:=R.A.Y+22;
  742. {$endif sparc}
  743. {$ifndef cpu_known}
  744. R.A.X:=R.B.X-28;
  745. R.B.Y:=R.A.Y+22;
  746. {$endif cpu_known}
  747. inherited Init(R,dialog_registers, wnNoNumber);
  748. Flags:=wfClose or wfMove;
  749. {$ifndef cpu_known}
  750. Flags:=Flags or wfgrow;
  751. {$endif cpu_known}
  752. Palette:=wpCyanWindow;
  753. HelpCtx:=hcRegistersWindow;
  754. R.Assign(1,1,Size.X-2,Size.Y-1);
  755. RV:=new(PRegistersView,init(R));
  756. Insert(RV);
  757. If assigned(RegistersWindow) then
  758. dispose(RegistersWindow,done);
  759. RegistersWindow:=@Self;
  760. Update;
  761. end;
  762. constructor TRegistersWindow.Load(var S: TStream);
  763. begin
  764. inherited load(S);
  765. GetSubViewPtr(S,RV);
  766. If assigned(RegistersWindow) then
  767. dispose(RegistersWindow,done);
  768. RegistersWindow:=@Self;
  769. end;
  770. procedure TRegistersWindow.Store(var S: TStream);
  771. begin
  772. inherited Store(s);
  773. PutSubViewPtr(S,RV);
  774. end;
  775. procedure TRegistersWindow.Update;
  776. begin
  777. ReDraw;
  778. end;
  779. destructor TRegistersWindow.Done;
  780. begin
  781. RegistersWindow:=nil;
  782. inherited done;
  783. end;
  784. {****************************************************************************
  785. TFPUView
  786. ****************************************************************************}
  787. function GetFPURegs(var rs : TFPURegs
  788. {$ifndef cpu_known}
  789. ; UseInfoFloat : boolean
  790. {$endif not cpu_known}
  791. ) : boolean;
  792. var
  793. p,po : pchar;
  794. p1 : pchar;
  795. {$ifndef NODEBUG}
  796. reg,value : string;
  797. buffer : array[0..255] of char;
  798. v : string;
  799. res : cardinal;
  800. i : longint;
  801. err : word;
  802. {$endif}
  803. begin
  804. GetFPURegs:=false;
  805. {$ifndef NODEBUG}
  806. {$ifndef cpu_known}
  807. if UseInfoFloat then
  808. begin
  809. Debugger^.Command('info float');
  810. if Debugger^.Error then
  811. begin
  812. UseInfofloat:=false;
  813. Debugger^.Command('info all');
  814. end;
  815. end
  816. else
  817. {$endif not cpu_known}
  818. Debugger^.Command('info all');
  819. if Debugger^.Error then
  820. exit
  821. else
  822. begin
  823. po:=StrNew(Debugger^.GetOutput);
  824. p:=po;
  825. {$ifndef cpu_known}
  826. i:=0;
  827. {$endif not cpu_known}
  828. if assigned(p) then
  829. begin
  830. fillchar(rs,sizeof(rs),0);
  831. p1:=strscan(p,' ');
  832. while assigned(p1) do
  833. begin
  834. strlcopy(buffer,p,p1-p);
  835. reg:=strpas(buffer);
  836. {$ifndef cpu_known}
  837. p1:=strscan(p,#10);
  838. if assigned(p1) then
  839. begin
  840. strlcopy(buffer,p,p1-p);
  841. rs.freg[i]:=ExtractTabs(strpas(buffer),8);
  842. if i<MaxRegs-1 then
  843. inc(i);
  844. end;
  845. {$else cpu_known}
  846. p:=p1;
  847. while p^=' ' do
  848. inc(p);
  849. if p^='$' then
  850. p1:=strscan(p,#9)
  851. else
  852. p1:=strscan(p,#10);
  853. strlcopy(buffer,p,p1-p);
  854. v:=strpas(buffer);
  855. for i:=1 to length(v) do
  856. if v[i]=#9 then
  857. v[i]:=' ';
  858. val(v,res,err);
  859. {$if defined(i386) or defined(x86_64)}
  860. if reg='st0' then
  861. rs.st0:=v
  862. else if reg='st1' then
  863. rs.st1:=v
  864. else if reg='st2' then
  865. rs.st2:=v
  866. else if reg='st3' then
  867. rs.st3:=v
  868. else if reg='st4' then
  869. rs.st4:=v
  870. else if reg='st5' then
  871. rs.st5:=v
  872. else if reg='st6' then
  873. rs.st6:=v
  874. else if reg='st7' then
  875. rs.st7:=v
  876. else if reg='ftag' then
  877. rs.ftag:=res
  878. else if reg='fctrl' then
  879. rs.fctrl:=res
  880. else if reg='fstat' then
  881. rs.fstat:=res
  882. else if reg='fiseg' then
  883. rs.fiseg:=res
  884. else if reg='fioff' then
  885. rs.fioff:=res
  886. else if reg='foseg' then
  887. rs.foseg:=res
  888. else if reg='fooff' then
  889. rs.fooff:=res
  890. else if reg='fop' then
  891. rs.fop:=res;
  892. {$endif i386 or x86_64}
  893. {$ifdef m68k}
  894. if reg='fp0' then
  895. rs.fp0:=v
  896. else if reg='fp1' then
  897. rs.fp1:=v
  898. else if reg='fp2' then
  899. rs.fp2:=v
  900. else if reg='fp3' then
  901. rs.fp3:=v
  902. else if reg='fp4' then
  903. rs.fp4:=v
  904. else if reg='fp5' then
  905. rs.fp5:=v
  906. else if reg='fp6' then
  907. rs.fp6:=v
  908. else if reg='fp7' then
  909. rs.fp7:=v
  910. else if reg='fpcontrol' then
  911. rs.fpcontrol:=res
  912. else if reg='fpstatus' then
  913. rs.fpstatus:=res
  914. else if reg='fpiaddr' then
  915. rs.fpiaddr:=res;
  916. {$endif m68k}
  917. {$ifdef powerpc}
  918. if reg[1]='f' then
  919. for i:=0 to 31 do
  920. if reg='f'+inttostr(i) then
  921. rs.f[i]:=v;
  922. {$endif powerpc}
  923. {$ifdef sparc}
  924. if reg[1]='f' then
  925. for i:=0 to 31 do
  926. if reg='f'+inttostr(i) then
  927. rs.f[i]:=v;
  928. {$endif sparc}
  929. {$endif cpu_known}
  930. p:=strscan(p1,#10);
  931. if assigned(p) then
  932. begin
  933. p1:=strscan(p,' ');
  934. inc(p);
  935. end
  936. else
  937. break;
  938. end;
  939. { free allocated memory }
  940. strdispose(po);
  941. end
  942. else
  943. exit;
  944. end;
  945. { do not open a messagebox for such errors }
  946. Debugger^.got_error:=false;
  947. GetFPURegs:=true;
  948. {$endif}
  949. end;
  950. constructor TFPUView.Init(var Bounds: TRect);
  951. begin
  952. inherited init(Bounds);
  953. GrowMode:=gfGrowHiX or GfGrowHiY;
  954. InDraw:=false;
  955. first:=true;
  956. FillChar(OldReg,Sizeof(oldreg),#0);
  957. FillChar(NewReg,Sizeof(newreg),#0);
  958. GDBCount:=-1;
  959. {$ifndef cpu_known}
  960. UseInfoFloat:=true;
  961. {$endif not cpu_known}
  962. end;
  963. procedure TFPUView.Draw;
  964. var
  965. rs : tfpuregs;
  966. top : byte;
  967. color :byte;
  968. ok : boolean;
  969. i : byte;
  970. const
  971. TypeStr : Array[0..3] of string[6] =
  972. ('Valid ','Zero ','Spec ','Empty ');
  973. procedure SetColor(Const x,y : string);
  974. begin
  975. if x=y then
  976. color:=7
  977. else
  978. color:=8;
  979. end;
  980. procedure SetIColor(Const x,y : cardinal);
  981. begin
  982. if x=y then
  983. color:=7
  984. else
  985. color:=8;
  986. end;
  987. begin
  988. inherited draw;
  989. {$ifdef NODEBUG}
  990. WriteStr(1,0,msg_registervaluesnotavailable,7);
  991. {$else NODEBUG}
  992. If not assigned(Debugger) then
  993. begin
  994. WriteStr(1,0,msg_registervaluesnotavailable,7);
  995. exit;
  996. end;
  997. if InDraw then
  998. exit;
  999. InDraw:=true;
  1000. if GDBCount<>Debugger^.RunCount then
  1001. begin
  1002. OldReg:=NewReg;
  1003. OK:=GetFPURegs(rs
  1004. {$ifndef cpu_known}
  1005. ,UseInfoFloat
  1006. {$endif not cpu_known}
  1007. );
  1008. NewReg:=rs;
  1009. { get inital values }
  1010. if first then
  1011. begin
  1012. OldReg:=NewReg;
  1013. first:=false;
  1014. end;
  1015. GDBCount:=Debugger^.RunCount;
  1016. end
  1017. else
  1018. begin
  1019. rs:=newreg;
  1020. OK:=true;
  1021. end;
  1022. if OK then
  1023. begin
  1024. {$ifdef cpu_known}
  1025. {$if defined(i386) or defined(x86_64)}
  1026. top:=(rs.fstat shr 11) and 7;
  1027. SetColor(rs.st0,OldReg.st0);
  1028. WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
  1029. SetColor(rs.st1,OldReg.st1);
  1030. WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
  1031. SetColor(rs.st2,OldReg.st2);
  1032. WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
  1033. SetColor(rs.st3,OldReg.st3);
  1034. WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
  1035. SetColor(rs.st4,OldReg.st4);
  1036. WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
  1037. SetColor(rs.st5,OldReg.st5);
  1038. WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
  1039. SetColor(rs.st6,OldReg.st6);
  1040. WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
  1041. SetColor(rs.st7,OldReg.st7);
  1042. WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
  1043. SetIColor(rs.ftag,OldReg.ftag);
  1044. WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
  1045. SetIColor(rs.fctrl,OldReg.fctrl);
  1046. WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
  1047. SetIColor(rs.fstat,OldReg.fstat);
  1048. WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
  1049. SetIColor(rs.fop,OldReg.fop);
  1050. WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
  1051. if (rs.fiseg<>OldReg.fiseg) or
  1052. (rs.fioff<>OldReg.fioff) then
  1053. color:=8
  1054. else
  1055. color:=7;
  1056. WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
  1057. if (rs.foseg<>OldReg.foseg) or
  1058. (rs.fooff<>OldReg.fooff) then
  1059. color:=8
  1060. else
  1061. color:=7;
  1062. WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
  1063. {$endif i386 or x86_64}
  1064. {$ifdef m68k}
  1065. SetColor(rs.fp0,OldReg.fp0);
  1066. WriteStr(1,0,'fp0 '+rs.fp0,color);
  1067. SetColor(rs.fp1,OldReg.fp1);
  1068. WriteStr(1,1,'fp1 '+rs.fp1,color);
  1069. SetColor(rs.fp2,OldReg.fp2);
  1070. WriteStr(1,2,'fp2 '+rs.fp2,color);
  1071. SetColor(rs.fp3,OldReg.fp3);
  1072. WriteStr(1,3,'fp3 '+rs.fp3,color);
  1073. SetColor(rs.fp4,OldReg.fp4);
  1074. WriteStr(1,4,'fp4 '+rs.fp4,color);
  1075. SetColor(rs.fp5,OldReg.fp5);
  1076. WriteStr(1,5,'fp5 '+rs.fp5,color);
  1077. SetColor(rs.fp6,OldReg.fp6);
  1078. WriteStr(1,6,'fp6 '+rs.fp6,color);
  1079. SetColor(rs.fp7,OldReg.fp7);
  1080. WriteStr(1,7,'fp7 '+rs.fp7,color);
  1081. SetIColor(rs.fpcontrol,OldReg.fpcontrol);
  1082. WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
  1083. SetIColor(rs.fpstatus,OldReg.fpstatus);
  1084. WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
  1085. SetIColor(rs.fpiaddr,OldReg.fpiaddr);
  1086. WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
  1087. {$endif m68k}
  1088. {$ifdef powerpc}
  1089. for i:=0 to 31 do
  1090. begin
  1091. SetColor(rs.f[i],OldReg.f[i]);
  1092. if i<10 then
  1093. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
  1094. else
  1095. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
  1096. end;
  1097. {$endif powerpc}
  1098. {$ifdef sparc}
  1099. for i:=0 to 31 do
  1100. begin
  1101. SetColor(rs.f[i],OldReg.f[i]);
  1102. if i<10 then
  1103. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
  1104. else
  1105. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
  1106. end;
  1107. {$endif sparc}
  1108. {$else not cpu_known}
  1109. for i:=0 to MaxRegs-1 do
  1110. begin
  1111. SetColor(rs.freg[i],OldReg.freg[i]);
  1112. WriteStr(1,i,rs.freg[i],color);
  1113. end;
  1114. {$endif cpu_known}
  1115. end
  1116. else
  1117. WriteStr(0,0,msg_registerwindowerror,7);
  1118. InDraw:=false;
  1119. {$endif NODEBUG}
  1120. end;
  1121. destructor TFPUView.Done;
  1122. begin
  1123. inherited done;
  1124. end;
  1125. {****************************************************************************
  1126. TFPUWindow
  1127. ****************************************************************************}
  1128. constructor TFPUWindow.Init;
  1129. var
  1130. R : TRect;
  1131. begin
  1132. Desktop^.GetExtent(R);
  1133. {$if defined(i386) or defined(x86_64)}
  1134. R.A.X:=R.B.X-44;
  1135. R.B.Y:=R.A.Y+14;
  1136. {$endif i386 or x86_64}
  1137. {$ifdef m68k}
  1138. R.A.X:=R.B.X-44;
  1139. R.B.Y:=R.A.Y+14;
  1140. {$endif m68k}
  1141. {$ifdef powerpc}
  1142. R.A.X:=R.B.X-44;
  1143. R.B.Y:=R.A.Y+33;
  1144. {$endif powerpc}
  1145. {$ifdef sparc}
  1146. R.A.X:=R.B.X-44;
  1147. R.B.Y:=R.A.Y+33;
  1148. {$endif sparc}
  1149. {$ifndef cpu_known}
  1150. R.A.X:=R.B.X-44;
  1151. R.B.Y:=R.A.Y+33;
  1152. {$endif cpu_known}
  1153. inherited Init(R,dialog_fpu, wnNoNumber);
  1154. Flags:=wfClose or wfMove or wfgrow;
  1155. Palette:=wpCyanWindow;
  1156. HelpCtx:=hcFPURegisters;
  1157. R.Assign(1,1,Size.X-2,Size.Y-2);
  1158. RV:=new(PFPUView,init(R));
  1159. Insert(RV);
  1160. If assigned(FPUWindow) then
  1161. dispose(FPUWindow,done);
  1162. FPUWindow:=@Self;
  1163. Update;
  1164. end;
  1165. constructor TFPUWindow.Load(var S: TStream);
  1166. begin
  1167. inherited load(S);
  1168. GetSubViewPtr(S,RV);
  1169. If assigned(FPUWindow) then
  1170. dispose(FPUWindow,done);
  1171. FPUWindow:=@Self;
  1172. end;
  1173. procedure TFPUWindow.Store(var S: TStream);
  1174. begin
  1175. inherited Store(s);
  1176. PutSubViewPtr(S,RV);
  1177. end;
  1178. procedure TFPUWindow.Update;
  1179. begin
  1180. ReDraw;
  1181. end;
  1182. destructor TFPUWindow.Done;
  1183. begin
  1184. FPUWindow:=nil;
  1185. inherited done;
  1186. end;
  1187. {****************************************************************************
  1188. TVectorView
  1189. ****************************************************************************}
  1190. function GetVectorRegs(var rs : TVectorRegs
  1191. {$ifndef cpu_known}
  1192. ; UseInfoVector : boolean
  1193. {$endif not cpu_known}
  1194. ) : boolean;
  1195. var
  1196. p,po : pchar;
  1197. p1 : pchar;
  1198. {$ifndef NODEBUG}
  1199. reg,value : string;
  1200. buffer : array[0..255] of char;
  1201. v : string;
  1202. res : cardinal;
  1203. i : longint;
  1204. err : word;
  1205. {$endif}
  1206. begin
  1207. GetVectorRegs:=false;
  1208. {$ifndef NODEBUG}
  1209. {$ifndef cpu_known}
  1210. if UseInfoVector then
  1211. begin
  1212. Debugger^.Command('info vector');
  1213. if Debugger^.Error then
  1214. begin
  1215. UseInfoVector:=false;
  1216. Debugger^.Command('info all');
  1217. end;
  1218. end
  1219. else
  1220. {$endif not cpu_known}
  1221. Debugger^.Command('info vector');
  1222. if Debugger^.Error then
  1223. exit
  1224. else
  1225. begin
  1226. po:=StrNew(Debugger^.GetOutput);
  1227. p:=po;
  1228. {$ifndef cpu_known}
  1229. i:=0;
  1230. {$endif not cpu_known}
  1231. if assigned(p) then
  1232. begin
  1233. fillchar(rs,sizeof(rs),0);
  1234. p1:=strscan(p,' ');
  1235. while assigned(p1) do
  1236. begin
  1237. strlcopy(buffer,p,p1-p);
  1238. reg:=strpas(buffer);
  1239. {$ifndef cpu_known}
  1240. p1:=strscan(p,#10);
  1241. if assigned(p1) then
  1242. begin
  1243. strlcopy(buffer,p,p1-p);
  1244. rs.vreg[i]:=ExtractTabs(strpas(buffer),8);
  1245. if i<MaxRegs-1 then
  1246. inc(i);
  1247. end;
  1248. {$else cpu_known}
  1249. p:=p1;
  1250. while p^=' ' do
  1251. inc(p);
  1252. if p^='$' then
  1253. p1:=strscan(p,#9)
  1254. else
  1255. p1:=strscan(p,#10);
  1256. strlcopy(buffer,p,p1-p);
  1257. v:=strpas(buffer);
  1258. for i:=1 to length(v) do
  1259. if v[i]=#9 then
  1260. v[i]:=' ';
  1261. val(v,res,err);
  1262. {$if defined(i386) or defined(x86_64)}
  1263. if reg[1]='x' then
  1264. for i:=0 to 7 do
  1265. begin
  1266. if reg='xmm'+inttostr(i) then
  1267. rs.xmm[i]:=v
  1268. end
  1269. else if reg='mxcsr' then
  1270. rs.mxcsr:=v
  1271. else if reg[1]='m' then
  1272. for i:=0 to 7 do
  1273. begin
  1274. if reg='mm'+inttostr(i) then
  1275. rs.mmx[i]:=v;
  1276. end;
  1277. {$endif i386 or x86_64}
  1278. {$ifdef powerpc}
  1279. { !!!! fixme }
  1280. if reg[1]='v' then
  1281. for i:=0 to 31 do
  1282. if reg='v'+inttostr(i) then
  1283. rs.m[i]:=v;
  1284. {$endif powerpc}
  1285. {$ifdef sparc}
  1286. {$endif sparc}
  1287. {$endif cpu_known}
  1288. p:=strscan(p1,#10);
  1289. if assigned(p) then
  1290. begin
  1291. p1:=strscan(p,' ');
  1292. inc(p);
  1293. end
  1294. else
  1295. break;
  1296. end;
  1297. { free allocated memory }
  1298. strdispose(po);
  1299. end
  1300. else
  1301. exit;
  1302. end;
  1303. { do not open a messagebox for such errors }
  1304. Debugger^.got_error:=false;
  1305. GetVectorRegs:=true;
  1306. {$endif}
  1307. end;
  1308. constructor TVectorView.Init(var Bounds: TRect);
  1309. begin
  1310. inherited init(Bounds);
  1311. GrowMode:=gfGrowHiX or GfGrowHiY;
  1312. InDraw:=false;
  1313. first:=true;
  1314. FillChar(OldReg,Sizeof(oldreg),#0);
  1315. FillChar(NewReg,Sizeof(newreg),#0);
  1316. GDBCount:=-1;
  1317. {$ifndef cpu_known}
  1318. UseInfoVector:=true;
  1319. {$endif not cpu_known}
  1320. end;
  1321. procedure TVectorView.Draw;
  1322. var
  1323. rs : tVectorregs;
  1324. top : byte;
  1325. color :byte;
  1326. ok : boolean;
  1327. i : byte;
  1328. const
  1329. TypeStr : Array[0..3] of string[6] =
  1330. ('Valid ','Zero ','Spec ','Empty ');
  1331. procedure SetColor(Const x,y : string);
  1332. begin
  1333. if x=y then
  1334. color:=7
  1335. else
  1336. color:=8;
  1337. end;
  1338. procedure SetIColor(Const x,y : cardinal);
  1339. begin
  1340. if x=y then
  1341. color:=7
  1342. else
  1343. color:=8;
  1344. end;
  1345. begin
  1346. inherited draw;
  1347. {$ifdef NODEBUG}
  1348. WriteStr(1,0,msg_registervaluesnotavailable,7);
  1349. {$else NODEBUG}
  1350. If not assigned(Debugger) then
  1351. begin
  1352. WriteStr(1,0,msg_registervaluesnotavailable,7);
  1353. exit;
  1354. end;
  1355. if InDraw then
  1356. exit;
  1357. InDraw:=true;
  1358. if GDBCount<>Debugger^.RunCount then
  1359. begin
  1360. OldReg:=NewReg;
  1361. OK:=GetVectorRegs(rs
  1362. {$ifndef cpu_known}
  1363. ,UseInfoVector
  1364. {$endif not cpu_known}
  1365. );
  1366. NewReg:=rs;
  1367. { get inital values }
  1368. if first then
  1369. begin
  1370. OldReg:=NewReg;
  1371. first:=false;
  1372. end;
  1373. GDBCount:=Debugger^.RunCount;
  1374. end
  1375. else
  1376. begin
  1377. rs:=newreg;
  1378. OK:=true;
  1379. end;
  1380. if OK then
  1381. begin
  1382. {$ifdef cpu_known}
  1383. {$if defined(i386) or defined(x86_64)}
  1384. for i:=0 to 7 do
  1385. begin
  1386. SetColor(rs.xmm[i],OldReg.xmm[i]);
  1387. WriteStr(1,i,'xmm'+IntToStr(i)+' '+rs.xmm[i],color);
  1388. end;
  1389. SetColor(rs.mxcsr,OldReg.mxcsr);
  1390. WriteStr(1,8,'mxcsr'+IntToStr(i)+' '+rs.mxcsr,color);
  1391. for i:=0 to 7 do
  1392. begin
  1393. SetColor(rs.mmx[i],OldReg.mmx[i]);
  1394. WriteStr(1,i+9,'mmx'+IntToStr(i)+' '+rs.mmx[i],color);
  1395. end;
  1396. {$endif i386 or x86_64}
  1397. {$ifdef powerpc}
  1398. for i:=0 to 31 do
  1399. begin
  1400. SetColor(rs.m[i],OldReg.m[i]);
  1401. if i<10 then
  1402. WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color)
  1403. else
  1404. WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color);
  1405. end;
  1406. {$endif powerpc}
  1407. {$ifdef sparc}
  1408. { no mm regs on the sparc }
  1409. {$endif sparc}
  1410. {$else not cpu_known}
  1411. for i:=0 to MaxRegs-1 do
  1412. begin
  1413. SetColor(rs.vreg[i],OldReg.vreg[i]);
  1414. WriteStr(1,i,rs.vreg[i],color);
  1415. end;
  1416. {$endif cpu_known}
  1417. end
  1418. else
  1419. WriteStr(0,0,msg_registerwindowerror,7);
  1420. InDraw:=false;
  1421. {$endif NODEBUG}
  1422. end;
  1423. destructor TVectorView.Done;
  1424. begin
  1425. inherited done;
  1426. end;
  1427. {****************************************************************************
  1428. TVectorWindow
  1429. ****************************************************************************}
  1430. constructor TVectorWindow.Init;
  1431. var
  1432. R : TRect;
  1433. begin
  1434. Desktop^.GetExtent(R);
  1435. {$if defined(i386) or defined(x86_64)}
  1436. R.A.X:=R.B.X-60;
  1437. R.B.Y:=R.A.Y+20;
  1438. {$endif i386 or x86_64}
  1439. {$ifdef m68k}
  1440. R.A.X:=R.B.X-60;
  1441. R.B.Y:=R.A.Y+14;
  1442. {$endif m68k}
  1443. {$ifdef powerpc}
  1444. R.A.X:=R.B.X-60;
  1445. R.B.Y:=R.A.Y+33;
  1446. {$endif powerpc}
  1447. {$ifdef sparc}
  1448. R.A.X:=R.B.X-60;
  1449. R.B.Y:=R.A.Y+33;
  1450. {$endif sparc}
  1451. {$ifndef cpu_known}
  1452. R.A.X:=R.B.X-60;
  1453. R.B.Y:=R.A.Y+33;
  1454. {$endif cpu_known}
  1455. inherited Init(R,dialog_Vector, wnNoNumber);
  1456. Flags:=wfClose or wfMove or wfgrow;
  1457. Palette:=wpCyanWindow;
  1458. HelpCtx:=hcVectorRegisters;
  1459. R.Assign(1,1,Size.X-2,Size.Y-2);
  1460. RV:=new(PVectorView,init(R));
  1461. Insert(RV);
  1462. If assigned(VectorWindow) then
  1463. dispose(VectorWindow,done);
  1464. VectorWindow:=@Self;
  1465. Update;
  1466. end;
  1467. constructor TVectorWindow.Load(var S: TStream);
  1468. begin
  1469. inherited load(S);
  1470. GetSubViewPtr(S,RV);
  1471. If assigned(VectorWindow) then
  1472. dispose(VectorWindow,done);
  1473. VectorWindow:=@Self;
  1474. end;
  1475. procedure TVectorWindow.Store(var S: TStream);
  1476. begin
  1477. inherited Store(s);
  1478. PutSubViewPtr(S,RV);
  1479. end;
  1480. procedure TVectorWindow.Update;
  1481. begin
  1482. ReDraw;
  1483. end;
  1484. destructor TVectorWindow.Done;
  1485. begin
  1486. VectorWindow:=nil;
  1487. inherited done;
  1488. end;
  1489. procedure InitRegistersWindow;
  1490. begin
  1491. if RegistersWindow=nil then
  1492. begin
  1493. new(RegistersWindow,init);
  1494. DeskTop^.Insert(RegistersWindow);
  1495. end;
  1496. end;
  1497. procedure DoneRegistersWindow;
  1498. begin
  1499. if assigned(RegistersWindow) then
  1500. begin
  1501. DeskTop^.Delete(RegistersWindow);
  1502. RegistersWindow:=nil;
  1503. end;
  1504. end;
  1505. procedure InitFPUWindow;
  1506. begin
  1507. if FPUWindow=nil then
  1508. begin
  1509. new(FPUWindow,init);
  1510. DeskTop^.Insert(FPUWindow);
  1511. end;
  1512. end;
  1513. procedure DoneFPUWindow;
  1514. begin
  1515. if assigned(FPUWindow) then
  1516. begin
  1517. DeskTop^.Delete(FPUWindow);
  1518. FPUWindow:=nil;
  1519. end;
  1520. end;
  1521. procedure InitVectorWindow;
  1522. begin
  1523. if VectorWindow=nil then
  1524. begin
  1525. new(VectorWindow,init);
  1526. DeskTop^.Insert(VectorWindow);
  1527. end;
  1528. end;
  1529. procedure DoneVectorWindow;
  1530. begin
  1531. if assigned(VectorWindow) then
  1532. begin
  1533. DeskTop^.Delete(VectorWindow);
  1534. VectorWindow:=nil;
  1535. end;
  1536. end;
  1537. procedure RegisterFPRegsViews;
  1538. begin
  1539. RegisterType(RRegistersWindow);
  1540. RegisterType(RRegistersView);
  1541. RegisterType(RFPUWindow);
  1542. RegisterType(RFPUView);
  1543. RegisterType(RVectorView);
  1544. end;
  1545. end.
  1546. {$endif NODEBUG}