fpregs.pas 47 KB

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