home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / doc / graphdoc / showtest.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-17  |  21KB  |  788 lines
  1. uses dos;
  2. const
  3.   {Flags for special features}
  4.  
  5.   ft_cursor = 1;   {Has hardware cursor}
  6.   ft_blit   = 2;   {Can do BitBLTs}
  7.   ft_line   = 4;   {Can do lines}
  8.   ft_rwbank = 8;   {Suports seperate R/W banks}
  9.  
  10.  
  11.   {DAC types}
  12.  
  13.   _dac0     =0;   {No DAC (MDA/CGA/EGA ..}
  14.   _dac8     =1;   {Std VGA DAC 256 cols.}
  15.   _dac15    =2;   {Sierra 32k DAC}
  16.   _dac16    =3;   {Sierra 64k DAC}
  17.   _dacss24  =4;   {Sierra?? 24bit RGB DAC}
  18.   _dacatt   =5;   {ATT 20c490/1/2  15/16/24 bit DAC}
  19.   _dacADAC1 =6;   {Acumos ADAC1  15/16/24 bit DAC}
  20.  
  21.   _dacalg   =7;   {Avance Logic  16 bit DAC}
  22.   _dacSC24  =8;   {Sierra SC15025 24bit DAC}
  23.   _dacCL24  =9;   {Cirrus Logic 24bit RAMDAC for CL542x series}
  24.   _dacMus   =10;  {Music MU9c1740 24bit DAC}
  25.   _dacUnk9  =11;
  26.   _dacBt484 =12;
  27.  
  28.  
  29.   _dacCEG   =13;  {Edsun CEG DAC}
  30.  
  31.  
  32. type
  33.   CHIPS=(__EGA,__VGA,__chips451,__chips452,__chips453,__paradise,__video7
  34.         ,__ET3000,__ET4000,__tridBR,__tridCS,__trid89,__everex,__ati1,__ati2
  35.         ,__genoa,__oak,__cirrus,__aheadA,__aheadB,__ncr,__yamaha,__poach
  36.         ,__s3,__al2101,__mxic,__vesa,__realtek,__p2000,__cir54,__cir64
  37.         ,__Weitek,__WeitekP9,__xga,__compaq,__iitagx,__ET4w32,__oak87,__atiGUP
  38.         ,__UMC,__HMC,__xbe,__none);
  39.  
  40. const
  41.   chipnam:array[chips] of string[8]=
  42.         ('EGA','VGA','CT451','CT452','CT453','WD','Video7'
  43.         ,'ET3000','ET4000','TR8800BR','TR8800CS','TR8900','Everex','ATI18800','ATI28800'
  44.         ,'Genoa','OAK','Cirrus','Ahead A','Ahead B','NCR','Yamaha','Poach'
  45.         ,'S3','ALG','MXIC','VESA','Realtek','Primus','CL54xx','CL64xx'
  46.         ,'Weitek','P9000','XGA','Compaq','IIT','ET4/W32','OAK 87','Mach 32'
  47.         ,'UMC','HMC','XBE','?');
  48.  
  49. type
  50.   mmods=(_text,
  51.          _text2,
  52.          _text4,
  53.          _herc,   {Hercules mono, 4 "banks" of 8kbytes}
  54.          _cga1,   {CGA 2 color, 2 "banks" of 16kbytes}
  55.          _cga2,   {CGA 4 color, 2 "banks" of 16kbytes}
  56.          _pl1 ,   {plain mono, 8 pixels per byte}
  57.          _pl1e,   {mono odd/even, 8 pixels per byte, two planes}
  58.          _pl2 ,   {4 color odd/even planes}
  59.          _pk2 ,   {4 color "packed" pixels 4 pixels per byte}
  60.          _pl4 ,   {std EGA/VGA 16 color: 4 planes, 8 pixels per byte}
  61.          _pk4 ,   {ATI mode 65h two 16 color pixels per byte}
  62.          _p8  ,   {one 256 color pixel per byte}
  63.          _p15 ,   {Sierra 15 bit}
  64.          _p16 ,   {Sierra 16bit/XGA}
  65.          _p24 ,   {RGB 3bytes per pixel}
  66.          _p32 );  {RGBa 3+1 bytes per pixel }
  67.  
  68.  
  69.   _AT0=record
  70.          SWvers:word;  {SW version}
  71.          vid_sys,         {Number of video systems}
  72.          cur_vid:word;    {Currently selected video system (1..)}
  73.          curtime:longint; {Date & time of the test}
  74.        end;
  75.        {This record followed by: (Name&Address),(Video desc),(System)}
  76.  
  77.   _AT1=record
  78.          chip:chips;
  79.          id:word;             {instance}
  80.          IOadr:word;          {I/O adr}
  81.          Xseg:word;
  82.          Phadr:longint;
  83.          version:word;        {version}
  84.          subver:word;         {Subversion}
  85.          DAC_RS2,DAC_RS3:word;{These address bits are fed to the
  86.                                RS2 and RS3 pins of the palette chip}
  87.          dac:word;            {The dac type}
  88.          dacname:string[20];  {The Name of the DACtype}
  89.          mem:word;            {#kilobytes of video memory}
  90.          features:word;       {Flags for special features}
  91.          sname:string[8];     {Short chip name}
  92.          name:string[40];     {Full chip name}
  93.        end;
  94.  
  95.   _AT2=record
  96.          mode:word;
  97.         Mmode:mmods;
  98.        pixels,
  99.          lins,
  100.         bytes,
  101.          crtc,
  102.          vseg:word;
  103.       Cpixels,
  104.         Clins,
  105.        Cbytes,
  106.         Cvseg:word;
  107.        CMmode:mmods;
  108.       ChWidth,
  109.      ChHeight,
  110.       ExtPixf,
  111.       ExtLinf:byte;
  112.          Vclk,
  113.          Hclk,
  114.          Fclk:real;
  115.         iLace:boolean;
  116.          Flag:byte;
  117.        end;
  118.        {This record followed by: (Comment), (reg values)}
  119.  
  120.   _AT3=record
  121.          mode:word;
  122.         Mmode:mmods;
  123.          Flag:byte;
  124.        end;
  125.        {This record followed by: (Comment)}
  126.  
  127.   _ATff=record
  128.           int10,
  129.           int6D,
  130.           m4a8,   {0:4A8h}
  131.           fnt8h,
  132.           fnt8l,
  133.           fnt14,
  134.           fnt14x9,
  135.           fnt16,
  136.           fnt16x9:word;
  137.           Base:word;
  138.           size:byte;
  139.         end;
  140.  
  141.   rs=record
  142.        tst:_AT2;
  143.        com2:string;
  144.        r:array[3..6] of
  145.           record
  146.             a:_AT3;
  147.             com:string;
  148.           end;
  149.        wd:word;
  150.        rg:array[1..1] of byte;
  151.      end;
  152.  
  153. var
  154.   buf:array[0..2048] of byte;
  155.   f:file;
  156.   t:text;
  157.   fofs:longint;
  158.   fst,fbytes:word;
  159.   eoff:boolean;
  160.  
  161.   AT0:record
  162.         r:_AT0;
  163.         email,nam,vid,sys,mods:string;
  164.       end;
  165.   AT1:array[1..10] of _at1;
  166.  
  167.   res:array[1..100] of ^rs;
  168.   ress,vds:word;
  169.  
  170.   mtxt:array[mmods] of string[4];
  171.  
  172. function featt(feat:word):string;
  173. var s:string[4];
  174. begin
  175.   s:='    ';
  176.   if (feat and ft_cursor)>0 then s[1]:='C';
  177.   if (feat and ft_blit)>0 then s[2]:='B';
  178.   if (feat and ft_line)>0 then s[3]:='L';
  179.   if (feat and ft_rwbank)>0 then s[4]:='R';
  180.   featt:=s;
  181. end;
  182.  
  183. function hex2(w:word):string;
  184. const hx:array[0..15] of char='0123456789ABCDEF';
  185. begin
  186.   hex2:=hx[lo(w) shr 4]+hx[w and 15];
  187. end;
  188.  
  189. function hex4(w:word):string;
  190. const hx:array[0..15] of char='0123456789ABCDEF';
  191. begin
  192.   hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[lo(w) shr 4]+hx[w and 15];
  193. end;
  194.  
  195. procedure fillbuf;
  196. var x:word;
  197. begin
  198.   if  (fst>0) and not eoff then
  199.   begin
  200.     dec(fbytes,fst);
  201.     move(buf[fst],buf,fbytes);
  202.     inc(fofs,fst);
  203.   end;
  204.   fst:=0;
  205.   if (fbytes<1500) and not eoff then
  206.   begin
  207.     blockread(f,buf[fbytes],2000-fbytes,x);
  208.     inc(fbytes,x);
  209.   end;
  210. end;
  211.  
  212. procedure cp(var b;byt:word);
  213. begin
  214.   move(buf[fst],b,byt);
  215.   inc(fst,byt);
  216. end;
  217.  
  218. procedure rdstr(var s:string);
  219. begin
  220.   cp(s,buf[fst]+1);
  221. end;
  222.  
  223. procedure rdat0(var a:_AT0;var nam,vid,sys:string);
  224. var x:word;
  225. begin
  226.   move(buf[fst+1],x,2);
  227.   inc(x,fst);
  228.   inc(fst,3);
  229.   cp(a,sizeof(_AT0));
  230.   rdstr(nam);
  231.   rdstr(vid);
  232.   rdstr(sys);
  233.   fst:=x;
  234.   fillbuf;
  235. end;
  236.  
  237. function opentstfil(nam:string):boolean;
  238. var
  239.   x,y,z:word;
  240.   a2:_AT2;
  241.   a3:_AT3;
  242.   c2,s:string;
  243.   mm:mmods;
  244. begin
  245.   opentstfil:=true;
  246.   eoff:=false;
  247.   if pos('.',nam)=0 then nam:=nam+'.tst';
  248.   assign(f,nam);
  249.   {$i-}
  250.   reset(f,1);
  251.   {$i+}
  252.   if ioresult<>0 then opentstfil:=false
  253.   else begin
  254.     fbytes:=0;fst:=0;fofs:=0;
  255.     fillbuf;
  256.   {  rdAT0(at0.r,at0.nam,at0.vid,at0.sys);
  257.     for x:=1 to at0.r.vid_sys do
  258.     begin
  259.       move(buf[fst+1],y,2);
  260.       move(buf[fst+3],at1[x],sizeof(_at1));
  261.       inc(fst,y);
  262.       fillbuf;
  263.     end; }
  264.     ress:=0;
  265.     vds:=0;
  266.     while (fbytes>0) and not eoff do
  267.     begin
  268.       x:=fst;
  269.       move(buf[fst+1],z,2);
  270.       inc(z,fst);
  271.       inc(fst,3);
  272.       case buf[x] of
  273.         0:begin
  274.             cp(at0.r,sizeof(_AT0));
  275.             rdstr(at0.email);
  276.             rdstr(at0.nam);
  277.             rdstr(at0.vid);
  278.             rdstr(at0.sys);
  279.             rdstr(at0.mods);
  280.             s:=at0.mods;
  281.             if s='' then s:='TXT TXT2TXT4HERCCGA1CGA2PL1 PL1EPL2 PK2 PL4 PK4 P8  P15 P16 P24 P32 ';
  282.             mm:=_text;
  283.             while s<>'' do
  284.             begin
  285.               mtxt[mm]:=copy(s,1,4);
  286.               delete(s,1,4);
  287.               inc(mm);
  288.             end;
  289.           end;
  290.         1:begin
  291.             inc(vds);
  292.             cp(at1[vds],sizeof(_at1));
  293.           end;
  294.         2:begin
  295.             cp(a2,sizeof(_AT2));
  296.             rdstr(c2);
  297.             y:=z-fst;
  298.             inc(ress);
  299.             getmem(res[ress],sizeof(rs)+y);
  300.             fillchar(res[ress]^,sizeof(rs),0);
  301.             res[ress]^.wd:=sizeof(rs)+y;
  302.             move(a2,res[ress]^.tst,sizeof(a2));
  303.             res[ress]^.com2:=c2;
  304.             move(buf[fst],res[ress]^.rg,y);
  305.           end;
  306.      3..6:begin
  307.             cp(a3,sizeof(_AT3));
  308.             rdstr(c2);
  309.             for y:=1 to ress do
  310.               if (res[y]^.tst.mode=a3.mode) and
  311.                 (res[y]^.tst.Mmode=a3.Mmode) then
  312.               begin
  313.                 move(a3,res[y]^.r[buf[x]].a,sizeof(a3));
  314.                 res[y]^.r[buf[x]].com:=c2;
  315.               end;
  316.  
  317.           end;
  318.       255:begin
  319.             eoff:=true;
  320.           end;
  321.       end;
  322.       fst:=z;
  323.       fillbuf;
  324.     end;
  325.   end;
  326. end;
  327.  
  328. procedure closetst;
  329. var x:word;
  330. begin
  331.   close(f);
  332.   for x:=1 to ress do
  333.     freemem(res[x],res[x]^.wd);
  334. end;
  335.  
  336. procedure wrdata(fnam:string);
  337. begin
  338.   if opentstfil(fnam) then
  339.   begin
  340.     closetst;
  341.   end;
  342. end;
  343.  
  344. procedure wrsumm;
  345. var
  346.   DI:searchrec;
  347.   p:^_at1;
  348. begin
  349.   writeln('     File:     Chip:  Vers: Mem: Feat:      Dac:            Name:');
  350.        {     WHVGA123.tst aabbccdd 5678  2048 C  R Sierra SC15025______ }
  351.   findfirst('*.tst',0,DI);
  352.   while doserror=0 do
  353.   begin
  354.     if opentstfil(DI.name) then
  355.     begin
  356.       p:=@AT1[AT0.r.cur_vid];
  357.  
  358.       writeln(DI.name:12,copy(' '+chipnam[p^.chip]+'         ',1,10)
  359.              +hex4(p^.subver),p^.mem:6,' '+featt(p^.features)+' '+copy(p^.dacname
  360.              +'                     ',1,21)+p^.name);
  361.       closetst;
  362.     end;
  363.     findnext(DI);
  364.   end;
  365. end;
  366.  
  367. function d2(w:word):string;
  368. begin
  369.   w:=w mod 100;
  370.   d2:=chr(w div 10+48)+chr(w mod 10+48);
  371. end;
  372.  
  373. function SWvers(swver:word):string;
  374. var s:string;
  375. begin
  376.   str(swver div 1000,s);
  377.   s:=s+'.'+d2(swver div 10);
  378.   if (SWver mod 10)>0 then s:=s+chr(SWver mod 10+$60);
  379.   SWvers:=s;
  380. end;
  381.  
  382. function Wdate(dt:longint):string;
  383. const
  384.   mon:array[1..12] of string[3]=('jan','feb','mar','apr','may','jun'
  385.                                 ,'jul','aug','sep','oct','nov','dec');
  386. var d:datetime;
  387. begin
  388.   unpacktime(dt,d);
  389.   Wdate:=d2(d.hour)+':'+d2(d.min)+':'+d2(d.sec)+' '
  390.         +d2(d.day)+'/'+mon[d.month]+'/'+d2(d.year div 100);
  391. end;
  392.  
  393. function Clk(r:real):string;
  394. var s:string;
  395. begin
  396.   if r<0.1 then Clk:='        '
  397.   else begin
  398.     str(r:8:3,s);
  399.     Clk:=s;
  400.   end;
  401. end;
  402.  
  403. procedure wrdetail(nam,tnam:string);
  404. const
  405.  ni:array[boolean] of string[2]=('  ',' i');
  406.  tok1:array[0..1] of string[4]=(' No ',' Ok ');
  407.  tok2:array[0..3] of string[4]=('    ',' No ',' Ok ',' Ok ');
  408. var
  409.   x,y:word;
  410.   sok:string;
  411.   t:text;
  412.   p:^_at1;
  413. begin
  414.   if opentstfil(nam) then
  415.   begin
  416.     x:=pos('.',nam);
  417.     if x>0 then nam[0]:=chr(x-1);
  418.     assign(t,nam+'.txt');
  419.     rewrite(t);
  420.     writeln(t,'File: '+nam+' Whatvga version: '+SWvers(at0.r.SWvers)
  421.               +' Date: '+Wdate(at0.r.curtime));
  422.     writeln(t,'Tester:');
  423.     writeln(t,at0.email);
  424.     writeln(t);
  425.     writeln(t,at0.nam);
  426.     writeln(t);
  427.     writeln(t,'Video System:');
  428.     writeln(t,at0.vid);
  429.     writeln(t);
  430.     writeln(t,'System description:');
  431.     writeln(t,at0.sys);
  432.     writeln(t);
  433.  
  434.     if at0.r.vid_sys>1 then
  435.     begin
  436.       writeln(t,'Video systems:');
  437.       for x:=1 to at0.r.vid_sys do
  438.       begin
  439.         p:=@AT1[x];
  440.         writeln(t,copy(' '+chipnam[p^.chip]+'         ',1,10)
  441.                +hex4(p^.subver),p^.mem:6,' '+featt(p^.features)+' '+copy(p^.dacname
  442.                +'                     ',1,21)+p^.name);
  443.       end;
  444.       writeln(t);
  445.     end;
  446.  
  447.     writeln(t,'Active Video System:');
  448.     p:=@AT1[AT0.r.cur_vid];
  449.  
  450.     writeln(t,chipnam[p^.chip]+' Revision: '+hex4(p^.subver)
  451.            +' '+p^.name+' with ',p^.mem,' Kbytes');
  452.     writeln(t,'Instance: '+hex4(p^.id)+' IOadr: '+hex4(p^.IOadr)
  453.            +' XGAseg: '+hex4(p^.xseg)+' Padr: '+hex4(p^.Phadr shr 16)+hex4(p^.phadr));
  454.     if p^.features<>0 then
  455.     begin
  456.       write(t,'Features:');
  457.       if (p^.features and ft_cursor)>0 then write(t,' Cursor');
  458.       if (p^.features and ft_blit)>0 then write(t,' BitBLT');
  459.       if (p^.features and ft_line)>0 then write(t,' Line');
  460.       if (p^.features and ft_rwbank)>0 then write(t,' RW-bank');
  461.       writeln(t);
  462.     end;
  463.     write(t,'DAC: '+p^.dacname);
  464.     if (p^.dac_rs2<>0) then write(t,' RS2 select: '+hex4(p^.dac_rs2));
  465.     if (p^.dac_rs3<>0) then write(t,' RS3 select: '+hex4(p^.dac_rs3));
  466.     writeln(t);
  467.  
  468.     writeln(t);
  469.     writeln(t,'  Mode:     X    Y  Byte Drw Src Ana Cur Blt Lin RW:   Vclk    Hclk    Fclk  i');
  470.           {    0038 P8__ 1024  768 1024 Ok  Ok  Ok  Ok  Ok  Ok  Ok}
  471.     for x:=1 to ress do
  472.       with res[x]^ do
  473.       begin
  474.         if (tst.pixels<>tst.Cpixels) or (tst.lins<>tst.Clins)
  475.          or (tst.bytes<>tst.Cbytes) or (tst.MMode<>tst.CMmode) then
  476.            tst.flag:=tst.flag and 15
  477.         else tst.flag:=tst.flag or 128;
  478.         sok:='                            ';
  479.         if (tst.flag and 1)>0 then
  480.         begin
  481.           sok:=tok1[(tst.flag and 2) shr 1]
  482.               +tok2[(tst.flag shr 2) and 3]
  483.               +tok1[(tst.flag shr 7)];
  484.           for y:=3 to 6 do
  485.             if (tst.mode=r[y].a.mode) then sok:=sok+tok1[r[y].a.flag and 1]
  486.             else sok:=sok+'    ';
  487.         end;
  488.         writeln(t,hex4(tst.mode)+' '+mtxt[tst.mmode],tst.pixels:5,tst.Lins:5
  489.                ,tst.Bytes:5,sok+Clk(tst.vclk)+clk(tst.Hclk)+clk(tst.Fclk)+ni[tst.ilace]);
  490.         if (com2<>'') then writeln(t,'    Comment:  '+com2);
  491.         if (tst.flag and 128)=0 then writeln(t,'    Analysis: Real: ',tst.pixels,'x'
  492.                                         ,tst.lins,' '+mtxt[tst.mmode]+' ('
  493.                                         ,tst.bytes,' bytes) Calc: ',tst.Cpixels
  494.                                         ,'x',tst.Clins,' '+mtxt[tst.Cmmode]
  495.                                         +' (',tst.bytes,' bytes)');
  496.         if (r[3].com<>'') then writeln(t,'    Cursor:   '+r[3].com);
  497.         if (r[4].com<>'') then writeln(t,'    BitBlt:   '+r[4].com);
  498.         if (r[5].com<>'') then writeln(t,'    Linedraw: '+r[5].com);
  499.         if (r[6].com<>'') then writeln(t,'    R/W bank: '+r[6].com);
  500.  
  501.  
  502.       end;
  503.     close(t);
  504.     closetst;
  505.   end;
  506. end;
  507.  
  508. procedure wrregs(nam,tnam:string);
  509. type
  510.   iarr=array[1..1000] of integer;
  511.   barr=array[1..1000] of byte;
  512.   iarrp=^iarr;
  513. var p:^_at1;
  514.   x,y,z,u,v,w,rgs:word;
  515.   i:integer;
  516.   stop:boolean;
  517.   rgg:array[1..1000] of
  518.       record
  519.         ofs:word;
  520.         inx,
  521.         typ:byte;   {1: special, 2: reg, 3: index}
  522.       end;
  523.   vll:array[1..100] of iarrp;
  524.   bp:^barr;
  525.   bpo:word;
  526.   wp:iarrp;
  527.   s:string;
  528.  
  529. const
  530.   spcreg:array[1..2] of string[8]=('Old seqD','Old seqE');
  531.  
  532. function popb:word;
  533. begin
  534.   inc(bpo);
  535.   popb:=bp^[bpo];
  536. end;
  537.  
  538. function popw:word;
  539. var w:word;
  540. begin
  541.   w:=popb;
  542.   popw:=w+(popb shl 8);
  543. end;
  544.  
  545. procedure addval(base,ix,typ,val:word);
  546. var x:word;
  547. begin
  548.   for x:=1 to rgs do
  549.     if (rgg[x].ofs=base) and (rgg[x].typ=typ) and (rgg[x].inx=ix) then
  550.       wp^[x]:=val;
  551. end;
  552.  
  553. procedure addrg(base,ix,typ:word);
  554. var x,y:word;
  555. begin
  556.   x:=1;y:=rgs+1;
  557.   while x<=rgs do
  558.     if (base>rgg[x].ofs) or ((base=rgg[x].ofs) and
  559.         ((typ>rgg[x].typ) or ((typ=rgg[x].typ) and
  560.         (ix>rgg[x].inx)))) then inc(x)
  561.     else begin
  562.       y:=x;
  563.       x:=maxint;
  564.     end;
  565.  
  566.   if (base<>rgg[y].ofs) or (typ<>rgg[y].typ) or (ix<>rgg[y].inx) then
  567.   begin
  568.    { for x:=rgs downto y do rgg[x+1]:=rgg[x]; }
  569.  
  570.     if rgs>=y then
  571.       move(rgg[y],rgg[y+1],(rgs-y+1)*sizeof(rgg[1]));
  572.     rgg[y].ofs :=base;
  573.     rgg[y].typ :=typ;
  574.     rgg[y].inx :=ix;
  575.     inc(rgs);
  576.   end;
  577.  
  578. end;
  579.  
  580. begin
  581.   rgs:=0;
  582.   if opentstfil(nam) then
  583.   begin
  584.     x:=pos('.',nam);
  585.     if x>0 then nam[0]:=chr(x-1);
  586.     assign(t,nam+'.reg');
  587.     rewrite(t);
  588.     writeln(t,'File: '+nam+' Whatvga version: '+SWvers(at0.r.SWvers)
  589.               +' Date: '+Wdate(at0.r.curtime));
  590.     p:=@AT1[AT0.r.cur_vid];
  591.  
  592.     writeln(t,chipnam[p^.chip]+' Revision: '+hex4(p^.subver)
  593.            +' '+p^.name+' with ',p^.mem,' Kbytes');
  594.     writeln(t);
  595.  
  596.     write(t,'Mode:    ');
  597.     for x:=1 to ress do write(t,' '+hex4(res[x]^.tst.mode));
  598.     writeln(t);
  599.     write(t,'Pixels:  ');
  600.     for x:=1 to ress do write(t,res[x]^.tst.pixels:5);
  601.     writeln(t);
  602.     write(t,'Lines:   ');
  603.     for x:=1 to ress do write(t,res[x]^.tst.lins:5);
  604.     writeln(t);
  605.     write(t,'Bytes:   ');
  606.     for x:=1 to ress do write(t,res[x]^.tst.bytes:5);
  607.     writeln(t);
  608.     write(t,'MemMode: ');
  609.     for x:=1 to ress do write(t,' '+mtxt[res[x]^.tst.Mmode]);
  610.     writeln(t);
  611.  
  612.     for x:=1 to ress do
  613.     begin
  614.       bp:=@res[x]^.rg;bpo:=0;stop:=false;
  615.       repeat
  616.         z:=popw;
  617.         case z of
  618.           0:stop:=true;
  619.           1:begin
  620.               w:=popw;
  621.               u:=popb;v:=popb;
  622.               for z:=u to v do addrg(w,z,3);
  623.               inc(bpo,v-u+1);
  624.             end;
  625.         255:begin
  626.               addrg(popw,0,1);
  627.               inc(bpo);
  628.             end;
  629.         else
  630.           if z<256 then
  631.           begin
  632.             w:=popw;
  633.             for w:=w to w+z-1 do addrg(w,0,2);
  634.             inc(bpo,z);
  635.           end
  636.           else begin
  637.             addrg(z,0,2);
  638.             inc(bpo);
  639.           end;
  640.         end;
  641.       until stop;
  642.     end;
  643.     for x:=1 to ress do
  644.     begin
  645.       getmem(wp,rgs*2);
  646.       for y:=1 to rgs do wp^[y]:=-1;
  647.       bp:=@res[x]^.rg;bpo:=0;stop:=false;
  648.       repeat
  649.         z:=popw;
  650.         case z of
  651.           0:stop:=true;
  652.           1:begin
  653.               w:=popw;
  654.               u:=popb;v:=popb;
  655.               for z:=u to v do addval(w,z,3,popb);
  656.             end;
  657.         255:begin
  658.               w:=popw;
  659.               addval(w,0,1,popb);
  660.             end;
  661.         else
  662.           if z<256 then
  663.           begin
  664.             w:=popw;
  665.             for w:=w to w+z-1 do addval(w,0,2,popb);
  666.           end
  667.           else addval(z,0,2,popb);
  668.         end;
  669.       until stop;
  670.       vll[x]:=wp;
  671.     end;
  672.     for x:=1 to rgs do
  673.     begin
  674.       case rgg[x].typ of
  675.         1:s:=spcreg[rgg[x].ofs];
  676.         2:s:=hex4(rgg[x].ofs)+'    ';
  677.         3:s:=hex4(rgg[x].ofs)+' i'+hex2(rgg[x].inx);
  678.       end;
  679.       write(t,s+':');
  680.       w:=vll[1]^[x];
  681.       stop:=(w>=0);
  682.       for y:=1 to ress do
  683.         if (w<>vll[y]^[x]) and (vll[y]^[x]>=0) then stop:=false;
  684.       if stop then
  685.       begin
  686.         write(t,'   '+hex2(w));
  687.         for y:=2 to ress do
  688.         begin
  689.           i:=vll[y]^[x];
  690.           if i<0 then write(t,'   --')
  691.           else if i=w then write(t,'    =')
  692.                       else write(t,'   '+hex2(i));
  693.         end;
  694.       end
  695.       else
  696.         for y:=1 to ress do
  697.           if vll[y]^[x]<0 then write(t,'   --')
  698.                           else write(t,'   '+hex2(vll[y]^[x]));
  699.       writeln(t);
  700.  
  701.     end;
  702.  
  703.     closetst;
  704.     for x:=1 to ress do freemem(vll[x],rgs*2);
  705.   end;
  706. end;
  707.  
  708. procedure wrBIOS(nam,tnam:string);
  709. var rhdr:_ATFF;
  710.   z,x,y:word;
  711.   l:longint;
  712.   o:file;
  713.   t:text;
  714.  
  715. begin
  716.   if opentstfil(nam) then
  717.   begin
  718.     x:=pos('.',nam);
  719.     if x>0 then nam[0]:=chr(x-1);
  720.     assign(o,nam+'.rom');
  721.     rewrite(o,1);
  722.     assign(t,nam+'.vct');
  723.     rewrite(t);
  724.     seek(f,fofs);
  725.     blockread(f,buf,512);
  726.     move(buf[1],z,2);
  727.     move(buf[3],rhdr,sizeof(rhdr));
  728.     writeln(t,'Int 10h:  '+hex4(rhdr.int10));
  729.     writeln(t,'Int 6Dh:  '+hex4(rhdr.int6d));
  730.     writeln(t,'Save Vct: '+hex4(rhdr.m4a8));
  731.     writeln(t,'Fnt 8h:   '+hex4(rhdr.fnt8h));
  732.     writeln(t,'Fnt 8l:   '+hex4(rhdr.fnt8l));
  733.     writeln(t,'Fnt 14:   '+hex4(rhdr.fnt14));
  734.     writeln(t,'Fnt 14x9: '+hex4(rhdr.fnt14x9));
  735.     writeln(t,'Fnt 16:   '+hex4(rhdr.fnt16));
  736.     writeln(t,'Fnt 16x9: '+hex4(rhdr.fnt16x9));
  737.     close(t);
  738.     seek(f,fofs+z);
  739.     l:=rhdr.size*longint(512);
  740.     z:=0;
  741.     while l>0 do
  742.     begin
  743.       x:=2048;
  744.       if x>l then x:=l;
  745.       blockread(f,buf,x,y);
  746.       for y:=0 to x-1 do
  747.       begin
  748.         z:=lo(z+buf[y]);
  749.         buf[y]:=z;
  750.       end;
  751.       blockwrite(o,buf,x);
  752.       dec(l,x);
  753.     end;
  754.     closetst;
  755.     close(o);
  756.   end;
  757. end;
  758.  
  759. var
  760.   fill:array[1..10] of string;
  761.   fills,x:word;
  762.   s:string;
  763. const
  764.   bdump:boolean=false;
  765.   regs:boolean=false;
  766.  
  767. begin
  768.  { if then directvideo:=false;}
  769.   fills:=0;fillchar(fill,sizeof(fill),0);
  770.   for x:=1 to paramcount do
  771.   begin
  772.     s:=paramstr(x);
  773.     if (s[1]='/') or (s[1]='-') then
  774.       case s[2] of
  775.         'b','B':bdump:=true;
  776.         'r','R':regs:=true;
  777.       end
  778.     else begin
  779.       inc(fills);
  780.       fill[fills]:=s;
  781.     end;
  782.   end;
  783.   if fills=0 then wrsumm
  784.   else if bdump then wrBIOS(fill[1],fill[2])
  785.        else if regs then wrregs(fill[1],fill[2])
  786.             else wrdetail(fill[1],fill[2]);
  787. end.
  788.