home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / doc / graphdoc / defvga.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-12  |  32.0 KB  |  1,322 lines
  1.  
  2. const
  3.   ATTR= $3C0;
  4.   SEQ = $3C4;
  5.   GRC = $3CE;
  6.  
  7. type
  8.   str10=string[10];
  9.  
  10.   mmods=(_text,
  11.          _text2,
  12.          _text4,
  13.          _herc,   {Hercules mono, 4 "banks" of 8kbytes}
  14.          _cga1,   {CGA 2 color, 2 "banks" of 16kbytes}
  15.          _cga2,   {CGA 4 color, 2 "banks" of 16kbytes}
  16.          _pl1 ,   {plain mono, 8 pixels per byte}
  17.          _pl1e,   {mono odd/even, 8 pixels per byte, two planes}
  18.          _pl2 ,   {4 color odd/even planes}
  19.          _pk2 ,   {4 color "packed" pixels 4 pixels per byte}
  20.          _pl4 ,   {std EGA/VGA 16 color: 4 planes, 8 pixels per byte}
  21.          _pk4 ,   {ATI mode 65h two 16 color pixels per byte}
  22.          _p8  ,   {one 256 color pixel per byte}
  23.          _p15 ,   {Sierra 15 bit}
  24.          _p16 ,   {Sierra 16bit/XGA}
  25.          _p24 ,   {RGB 3bytes per pixel}
  26.          _p32 );  {RGBa 3+1 bytes per pixel }
  27.  
  28.   modetype=record
  29.              md,xres,yres,bytes:word;
  30.              memmode:mmods;
  31.            end;
  32.  
  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.   CursorType=Array[0..31] of longint;  {32 lines of 32 pixels}
  41.  
  42. const
  43.  
  44.   header:array[CHIPS] of string[14]=
  45.      ('EGA','VGA','Chips&Tech','Chips&Tech','Chips&Tech'
  46.      ,'Paradise','Video7','ET3000','ET4000','Trident','Trident'
  47.          ,'Trident','Everex','ATI','ATI','Genoa','Oak','Cirrus','Ahead'
  48.          ,'Ahead','NCR','Yamaha','Poach','S3','AL2101','MXIC','VESA'
  49.          ,'Realtek','PRIMUS','Cirrus54','Cirrus64','Weitek','WeitekP9'
  50.          ,'XGA','COMPAQ','IITAGX','ET4000W32','Oak','ATI','UMC','HMC'
  51.          ,'XBE','');
  52.  
  53.  
  54. const   {Short name for chip families}
  55.   chipnam:array[chips] of string[8]=
  56.         ('EGA','VGA','CT451','CT452','CT453','WD','Video7'
  57.         ,'ET3000','ET4000','TR8800BR','TR8800CS','TR8900','Everex','ATI18800'
  58.         ,'ATI28800','Genoa','OAK','Cirrus','Ahead A','Ahead B','NCR','Yamaha','Poach'
  59.         ,'S3','ALG','MXIC','VESA','Realtek','Primus','CL54xx','CL64xx'
  60.         ,'Weitek','P9000','XGA','Compaq','IIT','ET4/W32','OAK 87','Mach 32'
  61.         ,'UMC','HMC','XBE','?');
  62.  
  63.  
  64.  
  65. const
  66.  
  67.   {DAC types}
  68.  
  69.   _dac0     =0;   {No DAC (MDA/CGA/EGA ..}
  70.   _dac8     =1;   {Std VGA DAC 256 cols.}
  71.   _dac15    =2;   {Sierra 32k DAC}
  72.   _dac16    =3;   {Sierra 64k DAC}
  73.   _dacss24  =4;   {Sierra?? 24bit RGB DAC}
  74.   _dacatt   =5;   {ATT 20c490/1/2  15/16/24 bit DAC}
  75.   _dacADAC1 =6;   {Acumos ADAC1  15/16/24 bit DAC}
  76.  
  77.   _dacalg   =7;   {Avance Logic  16 bit DAC}
  78.   _dacSC24  =8;   {Sierra SC15025 24bit DAC}
  79.   _dacCL24  =9;   {Cirrus Logic 24bit RAMDAC for CL542x series}
  80.   _dacMus   =10;  {Music MU9c1740 24bit DAC}
  81.   _dacUnk9  =11;
  82.   _dacBt484 =12;
  83.  
  84.  
  85.   _dacCEG   =13;  {Edsun CEG DAC}
  86.  
  87.  
  88.   {Flags for special features}
  89.  
  90.   ft_cursor = 1;   {Has hardware cursor}
  91.   ft_blit   = 2;   {Can do BitBLTs}
  92.   ft_line   = 4;   {Can do lines}
  93.   ft_rwbank = 8;   {Suports seperate R/W banks}
  94.  
  95.  
  96.  
  97.   (* Chip versions *)
  98.  
  99.   VS_VBE      =   90;
  100.   VS_XBE      =   91;
  101.  
  102.   CL_Unk54    =  100;
  103.   CL_AVGA1    =  101;
  104.   CL_AVGA2    =  102;
  105.   CL_GD5401   =  103;
  106.   CL_GD5402   =  104;
  107.   CL_GD5402r1 =  105;
  108.   CL_GD5420   =  106;
  109.   CL_GD5420r1 =  107;
  110.   CL_GD5422   =  108;
  111.   CL_GD5424   =  109;
  112.   CL_GD5426   =  110;
  113.   CL_GD5428   =  111;
  114.   CL_GD543x   =  112;
  115.  
  116.   CL_GD6205   =  115;
  117.   CL_GD6215   =  116;
  118.   CL_GD6225   =  117;
  119.   CL_GD6235   =  118;
  120.  
  121.   CL_Unk64    =  120;
  122.   CL_GD5410   =  121;
  123.   CL_GD6410   =  122;
  124.   CL_GD6412   =  123;
  125.  
  126.   CL_GD6420   =  124;
  127.   CL_GD6440   =  125;
  128.  
  129.   WD_PVGA1A   =  130;
  130.   WD_90c00    =  131;
  131.   WD_90c10    =  132;
  132.   WD_90c11    =  133;
  133.   WD_90c20    =  134;
  134.   WD_90c20A   =  135;
  135.   WD_90c22    =  136;
  136.   WD_90c24    =  137;
  137.   WD_90c26    =  138;
  138.   WD_90c30    =  139;
  139.   WD_90c31    =  140;
  140.   WD_90c33    =  141;
  141.  
  142.   CT_Unknown  =  160;
  143.   CT_450      =  161;
  144.   CT_451      =  162;
  145.   CT_452      =  163;
  146.   CT_453      =  164;
  147.   CT_455      =  165;
  148.   CT_456      =  166;
  149.   CT_457      =  167;
  150.   CT_65520    =  168;
  151.   CT_65530    =  169;
  152.   CT_65510    =  170;
  153.  
  154.   CL_old_unk  =  180;
  155.   CL_V7_OEM   =  181;
  156.   CL_GD5x0    =  182;
  157.   CL_GD6x0    =  183;
  158.  
  159.   NCR_Unknown =  190;
  160.   NCR_77c21   =  191;
  161.   NCR_77c22   =  192;
  162.   NCR_77c22e  =  193;
  163.   NCR_77c22ep =  194;
  164.  
  165.   OAK_Unknown =  200;
  166.   OAK_037     =  201;
  167.   OAK_057     =  202;
  168.   OAK_067     =  203;
  169.   OAK_077     =  204;
  170.   OAK_083     =  205;
  171.   OAK_087     =  206;
  172.  
  173.   RT_Unknown  =  210;
  174.   RT_3103     =  211;
  175.   RT_3105     =  212;
  176.   RT_3106     =  213;
  177.  
  178.   S3_Unknown  =  220;
  179.   S3_911      =  221;
  180.   S3_924      =  222;
  181.   S3_801AB    =  223;
  182.   S3_805AB    =  224;
  183.   S3_801C     =  225;
  184.   S3_805C     =  226;
  185.   S3_801D     =  227;
  186.   S3_805D     =  228;
  187.   S3_928C     =  229;
  188.   S3_928D     =  230;
  189.   S3_928E     =  231;
  190.   S3_928PCI   =  232;
  191.  
  192.   TR_Unknown  =  240;
  193.   TR_8800BR   =  241;
  194.   TR_8800CS   =  242;
  195.   TR_8900B    =  243;
  196.   TR_8900C    =  244;
  197.   TR_9000     =  245;
  198.   TR_8900CL   =  246;
  199.   TR_9000i    =  247;
  200.   TR_8900CXr  =  248;
  201.   TR_LCD9100B =  249;
  202.   TR_GUI9420  =  250;
  203.   TR_LX8200   =  251;
  204.   TR_LCD9320  =  252;
  205.   TR_9200CXi  =  253;
  206.  
  207.   AH_A        =  260;
  208.   AH_B        =  261;
  209.  
  210.   AL_2101     =  270;
  211.  
  212.   CPQ_Unknown =  280;
  213.   CPQ_IVGS    =  281;
  214.   CPQ_AVGA    =  282;
  215.   CPQ_AVPORT  =  283;
  216.   CPQ_QV1024  =  284;
  217.   CPQ_QV1280  =  285;
  218.  
  219.   MX_86000    =  290;
  220.   MX_86010    =  291;
  221.  
  222.   GE_5100     =  301;
  223.   GE_5300     =  302;
  224.   GE_6100     =  303;
  225.   GE_6200     =  304;
  226.   GE_6400     =  305;
  227.  
  228.   PR_2000     =  310;
  229.  
  230.   IIT_AGX     =  320;
  231.  
  232.   ET_4Unk     =  330;
  233.   ET_3000     =  331;
  234.   ET_4000     =  332;
  235.   ET_4W32     =  333;
  236.   ET_4W32i    =  334;
  237.   ET_4W32p    =  335;
  238.  
  239.   V7_Unknown  =  340;
  240.   V7_VEGA     =  341;
  241.   V7_208_13   =  342;
  242.   V7_208A     =  343;
  243.   V7_208B     =  344;
  244.   V7_208CD    =  345;
  245.   V7_216BC    =  346;
  246.   V7_216D     =  347;
  247.   V7_216E     =  348;
  248.   V7_216F     =  349;
  249.  
  250.   WT_5086     =  361;
  251.   WT_5186     =  362;
  252.   WT_5286     =  363;
  253.  
  254.   YA_6388     =  370;
  255.  
  256.   XGA_org     =  380;
  257.   XGA_NI      =  381;
  258.  
  259.   UMC_408     =  390;
  260.  
  261.   ATI_Unknown =  400;
  262.   ATI_EGA     =  401;
  263.   ATI_18800   =  402;
  264.   ATI_18800_1 =  403;
  265.   ATI_28800_2 =  404;
  266.   ATI_28800_4 =  405;
  267.   ATI_28800_5 =  406;
  268.   ATI_GUP_3   =  407;
  269.   ATI_GUP_6   =  408;
  270.   ATI_GUP_AX  =  409;
  271.   ATI_GUP_LX  =  410;
  272.  
  273.   HMC_304     =  420;
  274.  
  275.  
  276. type
  277.   charr =array[1..255] of char;
  278.   chptr =^charr;
  279.   intarr=array[1..100] of word;
  280.  
  281.  
  282.  
  283.  
  284.   {VESA VBE (VGA) record definitions}
  285.   _vbe0=record
  286.           sign  :longint;       {Must be 'VESA'}
  287.           vers  :word;          {VBE version.}
  288.           oemadr:chptr;
  289.           capab :longint;
  290.           model :^intarr;       {Ptr to list of modes}
  291.           mem   :byte;          {#64k blocks}
  292.           xx:array[0..499] of byte;   {Buffer is too large, as some cards
  293.                                          can return more than 256 bytes}
  294.         end;
  295.  
  296.  
  297.   _vbe1=record
  298.           attr  :word;
  299.           wina  :byte;
  300.           winb  :byte;
  301.           gran  :word;
  302.           winsiz:word;
  303.           sega  :word;
  304.           segb  :word;
  305.           pagefunc:pointer;
  306.           bytes :word;
  307.           width :word;
  308.           height:word;
  309.           charw :byte;
  310.           charh :byte;
  311.           planes:byte;
  312.           bits  :byte;   {bits per pixel}
  313.           nbanks:byte;
  314.           model :byte;
  315.           banks :byte;
  316.           images:byte;
  317.           res   :byte;
  318.           redinf:word;   {red   - low byte = #bits, high byte = start pos}
  319.           grninf:word;   {green - }
  320.           bluinf:word;   {blue  - }
  321.           resinf:word;
  322.  
  323.           x:array[byte] of byte;    {might get trashed by 4F01h}
  324.         end;
  325.   _vbe1p=^_vbe1;
  326.  
  327.  
  328.   {VESA VXE (XGA) record definitions}
  329.   _xbe0=record
  330.           sign:longint;    {must be 'VESA'}
  331.           vers:word;
  332.           oemadr:chptr;
  333.           capab:longint;
  334.           xgas:word;
  335.           xx:array[1..240] of byte;
  336.         end;
  337.  
  338.   _xbe1=record
  339.           oemadr:chptr;
  340.           capab:longint;
  341.           romadr:longint;
  342.           memreg:longint;
  343.           iobase:word;
  344.           vidadr:longint;  {32bit address of video memory}
  345.           adr4MB:longint;
  346.           adr1MB:longint;
  347.           adr64k:longint;
  348.           adroem:longint;
  349.           sizoem:word;
  350.           modep :^intarr;
  351.           memory:word;
  352.           manid :longint;
  353.           xx:array[1..206] of byte;
  354.         end;
  355.  
  356.   _xbe2=record
  357.           attrib:word;
  358.           bytes :word;
  359.           pixels:word;
  360.           lins  :word;
  361.           charw :byte;
  362.           charh :byte;
  363.           planes:byte;
  364.           bits  :byte;
  365.           model :byte;
  366.           images:byte;
  367.           redinf:word;   {red   - low byte = #bits, high byte = start pos}
  368.           grninf:word;   {green - }
  369.           bluinf:word;   {blue  - }
  370.           resinf:word;
  371.           xx:array[1..234] of byte;
  372.         end;
  373.  
  374.   _AT0=record
  375.          SWvers:word;  {SW version}
  376.          vid_sys,         {Number of video systems}
  377.          cur_vid:word;    {Currently selected video system (1..)}
  378.          curtime:longint; {Date & time of the test}
  379.        end;
  380.        {This record followed by: (Email),(Name&Address),(Video desc)
  381.                     ,(System),(modenames)}
  382.  
  383.   _AT2=record
  384.          mode:word;
  385.         Mmode:mmods;
  386.        pixels,
  387.          lins,
  388.         bytes,
  389.          crtc,
  390.          vseg:word;
  391.       Cpixels,
  392.         Clins,
  393.        Cbytes,
  394.         Cvseg:word;
  395.        CMmode:mmods;
  396.       ChWidth,
  397.      ChHeight,
  398.       ExtPixf,
  399.       ExtLinf:byte;
  400.          Vclk,
  401.          Hclk,
  402.          Fclk:real;
  403.         iLace:boolean;
  404.          Flag:byte;
  405.        end;
  406.        {This record followed by: (Comment), (reg values)}
  407.  
  408.   _AT3=record
  409.          mode:word;
  410.         Mmode:mmods;
  411.          Flag:byte;
  412.        end;
  413.        {This record followed by: (Comment)}
  414.  
  415.   _ATff=record
  416.           int10,
  417.           int6D,
  418.           m4a8,   {0:4A8h}
  419.           fnt8h,
  420.           fnt8l,
  421.           fnt14,
  422.           fnt14x9,
  423.           fnt16,
  424.           fnt16x9:word;
  425.           Base:word;
  426.           size:byte;
  427.         end;
  428.  
  429. const
  430.  
  431.   novgamodes=14;
  432.   stdmodetbl:array[1..novgamodes] of modetype=
  433.         ((md: 0;xres: 40;yres: 25;bytes: 80;memmode:_TEXT)
  434.         ,(md: 1;xres: 40;yres: 25;bytes: 80;memmode:_TEXT)
  435.         ,(md: 2;xres: 80;yres: 25;bytes:160;memmode:_TEXT)
  436.         ,(md: 3;xres: 80;yres: 25;bytes:160;memmode:_TEXT)
  437.         ,(md: 4;xres:320;yres:200;bytes: 80;memmode:_cga2)
  438.         ,(md: 5;xres:320;yres:200;bytes: 80;memmode:_cga2)
  439.         ,(md: 6;xres:640;yres:200;bytes: 80;memmode:_cga1)
  440.         ,(md:13;xres:320;yres:200;bytes: 40;memmode:_pl4)
  441.         ,(md:14;xres:640;yres:200;bytes: 80;memmode:_pl4)
  442.         ,(md:15;xres:640;yres:350;bytes: 80;memmode:_pl1)
  443.         ,(md:16;xres:640;yres:350;bytes: 80;memmode:_pl4)
  444.         ,(md:17;xres:640;yres:480;bytes: 80;memmode:_pl1)
  445.         ,(md:18;xres:640;yres:480;bytes: 80;memmode:_pl4)
  446.         ,(md:19;xres:320;yres:200;bytes:320;memmode:_p8));
  447.  
  448.   colbits:array[mmods] of integer=
  449.                (0,0,0,1,1,1,1,2,2,2,4,4,8,15,16,24,24);
  450.   modecols:array[mmods] of longint=
  451.                (0,0,0,2,2,2,2,4,4,4,16,16,256,32768,65536,16777216,16777216);
  452.  
  453.   mdtxt:array[mmods] of string[20]=('Text','2 color Text','4 color Text'
  454.                 ,'Hercules','CGA 2 color','CGA 4 color','Monochrome','2 colors planar'
  455.                 ,'4 colors planar','4 colors packed','16 colors planar','16 colors packed'
  456.                 ,'256 colors packed','32K colors','64K colors'
  457.                 ,'16M colors','16M colors');
  458.  
  459.   mmodenames:array[mmods] of string[4]=('TXT ','TXT2','TXT4','HERC','CGA1','CGA2'
  460.               ,'PL1 ','PL1E','PL2 ','PK2 ','PL4 ','PK4 ','P8  ','P15 ','P16 ','P24 ','P32 ');
  461.  
  462.   Debug:boolean=false;      {If set step through video tests one by one}
  463.   Auto_test:boolean=false;  {If set run tests automatically}
  464.  
  465.  
  466.   {Keys:}
  467.   Ch_Cr       =  $0D;
  468.   Ch_Esc      =  $1B;
  469.   Ch_ArUp     = $148;
  470.   Ch_ArLeft   = $14B;
  471.   Ch_ArRight  = $14D;
  472.   Ch_ArDown   = $150;
  473.   Ch_PgUp     = $149;
  474.   Ch_PgDn     = $151;
  475.   Ch_Ins      = $152;
  476.   Ch_Del      = $153;
  477.  
  478.  
  479. var
  480.  
  481.   vids:word;
  482.   vid:array[1..10] of
  483.       record
  484.         chip:chips;
  485.         id:word;             {instance}
  486.         IOadr:word;          {I/O adr}
  487.         Xseg:word;
  488.         Phadr:longint;
  489.         version:word;        {version}
  490.         subver:word;         {Subversion}
  491.         DAC_RS2,DAC_RS3:word;{These address bits are fed to the
  492.                               RS2 and RS3 pins of the palette chip}
  493.         dac:word;            {The dac type}
  494.         dacname:string[20];  {The Name of the DACtype}
  495.         mem:word;            {#kilobytes of video memory}
  496.         features:word;       {Flags for special features}
  497.         sname:string[8];     {Short chip family name}
  498.         name:string[40];     {Full chip name}
  499.       end;
  500.  
  501.  
  502.  
  503. var
  504.   rp:registers;
  505.  
  506.   video:string[20];
  507.   dacname:string[20];
  508.   _crt:string[20];
  509.   secondary:string[20];
  510.  
  511.   planes:word;     {number of video planes}
  512.  
  513.   nomodes:word;
  514.   modetbl:array[1..50] of modetype;
  515.  
  516.  
  517.  
  518.   dotest:array[CHIPS] of boolean;
  519.  
  520.  
  521.   CHIP:CHIPS;
  522.   mm:word;           {Video memory in kilobytes}
  523.   vseg:word;         {Video buffer base segment}
  524.   version:word;      {Version of chip or interface}
  525.   subvers:word;      {Subversion, for Unknown versions}
  526.   IOadr:word;        {I/O select address (ATI, XGA..)}
  527.   instance:word;     {ID for XGA and other multi board systems.}
  528.   features:word;     {Flags for special features   (ft_*) }
  529.   biosseg:word;
  530.   DAC_RS2,
  531.   DAC_RS3:word;      {These address bits are fed to the
  532.                       RS2 and RS3 pins of the palette chip}
  533.   dactype:word;
  534.   name:string[40];
  535.  
  536.   curmode:word;      {Current mode number}
  537.   memmode:mmods;     {current memory mode}
  538.   crtc:word;         {I/O address of CRTC registers}
  539.   pixels:word;       {Pixels in a scanline in current mode}
  540.   lins:word;         {lines in current mode}
  541.   bytes:longint;     {bytes in a scanline}
  542.  
  543.   force_mm:word;     {Forced memory size in Kbytes}
  544.  
  545.   extpixfact:word;  {The number of times each pixel is shown}
  546.   extlinfact:word;  {The number of times each scan line is shown}
  547.   charwid   :word;  {Character width in pixels}
  548.   charhigh  :word;  {Character height in scanlines}
  549.   calcpixels,
  550.   calclines,
  551.   calcvseg,
  552.   calcbytes:word;
  553.   calcmmode:mmods;
  554.  
  555.  
  556.   vclk,hclk,fclk:real;
  557.   ilace:boolean;
  558.  
  559.  
  560.  
  561.  
  562. function getkey:word;             {Waits for a key, and returns the keyID}
  563. function peekkey:word;            {Checks for a key, and returns the keyID}
  564.  
  565. procedure pushkey(k:word);        {Simulates a keystroke}
  566.  
  567. function strip(s:string):string;       {strip leading and trailing spaces}
  568. function upstr(s:string):string;       {convert a string to upper case}
  569. function istr(w:longint):str10;
  570. function hex2(w:word):str10;
  571. function hex4(w:word):str10;
  572. function dehex(s:string):word;
  573.  
  574.  
  575. procedure vio(ax:word);         {INT 10h reg ax=AX. other reg. set from RP
  576.                                  on return rp.ax=reg AX}
  577.  
  578. procedure viop(ax,bx,cx,dx:word;p:pointer);
  579.                                 {INT 10h reg AX-DX, ES:DI = p}
  580.  
  581. function inp(reg:word):byte;     {Reads a byte from I/O port REG}
  582.  
  583. procedure outp(reg,val:word);    {Write the low byte of VAL to I/O port REG}
  584.  
  585. procedure outpw(reg,val:word);    {Write the word byte of VAL to I/O port REG}
  586.  
  587. function rdinx(pt,inx:word):word;       {read register PT index INX}
  588.  
  589. procedure wrinx(pt,inx,val:word);       {write VAL to register PT index INX}
  590.  
  591. procedure modinx(pt,inx,mask,nwv:word);  {In register PT index INX sets
  592.                                           the bits in MASK as in NWV
  593.                                           the other are left unchanged}
  594.  
  595. procedure setinx(pt,inx,val:word);
  596.  
  597. procedure clrinx(pt,inx,val:word);
  598.  
  599. procedure setbank(bank:word);
  600.  
  601. procedure setRbank(bank:word);
  602.  
  603. procedure setvstart(x,y:word);       {Set the display start to (x,y)}
  604.  
  605. function setmode(md:word):boolean;
  606.  
  607. procedure setdac6;
  608. procedure setdac8;
  609. function setdac15:boolean;
  610. function setdac16:boolean;
  611. function setdac24:boolean;
  612.  
  613. procedure vesamodeinfo(md:word;vbe1:_vbe1p);
  614.  
  615. procedure setHWcurmap(VAR map:CursorType);
  616.  
  617. procedure HWcuronoff(on:boolean);
  618.  
  619. procedure setHWcurpos(X,Y:word);
  620.  
  621. procedure setHWcurcol(fgcol,bkcol:longint);
  622.  
  623. procedure fillrect(xst,yst,dx,dy:word;col:longint);
  624.  
  625. procedure copyrect(srcX,srcY,dstX,dstY,dx,dy:word);
  626.  
  627. procedure line(x0,y0,x1,y1:integer;col:longint);
  628.  
  629.  
  630. procedure dac2comm;
  631.  
  632. procedure dac2pel;
  633.  
  634. procedure findvideo;
  635.  
  636. {procedure AnalyseMode(mode:word; var pixs,lins,bytes,vseg:word;var mmode:mmods);}
  637.  
  638. function FormatRgs(var b:byte):word;   {Format registers for dump}
  639.  
  640. function dumpVGAregs:word;
  641.  
  642. procedure dumpVGAregfile;
  643.  
  644. procedure SelectVideo(Item:word);
  645.  
  646. implementation
  647.  
  648. uses crt;
  649.  
  650. procedure testdac;forward;
  651.  
  652.  
  653. const
  654.   mmmask :array[0..8] of byte=(0,0,0,0,1,3,3,7,15);
  655.  
  656.   hx:array[0..15] of char='0123456789ABCDEF';
  657.  
  658.  
  659. var
  660.  
  661.   spcreg:word;    {Special register offset (IIT)}
  662.   xgaseg:word;    {Segment address of memory mapped registers}
  663.   Phadr:longint;  {Physical address of video buffer}
  664.  
  665.   old,curbank:word;
  666.  
  667.   vgran:word;
  668.  
  669.  
  670.  
  671. procedure disable; (* Disable interupts *)
  672. begin
  673.   inline($fa);  (* CLI instruction *)
  674. end;
  675.  
  676. procedure enable;  (* Enable interrupts *)
  677. begin
  678.   inline($fb);  (* STI instruction *)
  679. end;
  680.  
  681.  
  682. function gtstr(var c:chptr):string;
  683. var x:word;
  684.   s:string;
  685. begin
  686.   s:='';x:=1;
  687.   if c<>NIL then
  688.     while (x<255) and (c^[x]<>#0) do
  689.     begin
  690.       if c^[x]<>#7 then s:=s+c^[x];
  691.       inc(x);
  692.     end;
  693.   gtstr:=s;
  694. end;
  695.  
  696. const
  697.   key_stack:word=0;    {Stored key stroke 0=none}
  698.  
  699. function getkey:word;
  700. var c:char;
  701. begin
  702.   if key_stack<>0 then
  703.   begin
  704.     getkey:=key_stack;
  705.     key_stack:=0;
  706.   end
  707.   else begin
  708.     c:=readkey;
  709.     if c=#0 then getkey:=$100+ord(readkey)
  710.             else getkey:=ord(c);
  711.   end;
  712. end;
  713.  
  714. function peekkey:word;
  715. begin
  716.   if (key_stack=0) and not keypressed then peekkey:=0
  717.                                       else peekkey:=getkey;
  718. end;
  719.  
  720. procedure pushkey(k:word);  {Simulates a key stroke}
  721. var ch:char;
  722. begin
  723.   key_stack:=k;
  724.   while keypressed do ch:=readkey;
  725. end;
  726.  
  727.  
  728. function strip(s:string):string;       {strip leading and trailing spaces}
  729. begin
  730.   while s[length(s)]=' ' do dec(s[0]);
  731.   while copy(s,1,1)=' ' do delete(s,1,1);
  732.   strip:=s;
  733. end;
  734.  
  735. function upstr(s:string):string;       {convert a string to upper case}
  736. var x:word;
  737. begin
  738.   for x:=1 to length(s) do
  739.     s[x]:=upcase(s[x]);
  740.   upstr:=s;
  741. end;
  742.  
  743. function istr(w:longint):str10;
  744. var s:str10;
  745. begin
  746.   str(w,s);
  747.   istr:=s;
  748. end;
  749.  
  750. function hex2(w:word):str10;
  751. begin
  752.   hex2:=hx[(w shr 4) and 15]+hx[w and 15];
  753. end;
  754.  
  755. function hex4(w:word):str10;
  756. begin
  757.   hex4:=hex2(hi(w))+hex2(lo(w));
  758. end;
  759.  
  760. function dehex(s:string):word;
  761. var w,x:word;
  762.     c:char;
  763. begin
  764.   w:=0;
  765.   for x:=1 to length(s) do
  766.   begin
  767.     c:=s[x];
  768.     case c of
  769.       '0'..'9':w:=(w shl 4)+(ord(c) and 15);
  770.       'a'..'f','A'..'F':
  771.                w:=(w shl 4)+(ord(c) and 15 +9);
  772.     end;
  773.   end;
  774.   dehex:=w;
  775. end;
  776.  
  777.  
  778.  
  779. procedure vio(ax:word);         {INT 10h reg ax=AX. other reg. set from RP
  780.                                  on return rp.ax=reg AX}
  781. begin
  782.   rp.ax:=ax;
  783.   intr($10,rp);
  784. end;
  785.  
  786. procedure viop(ax,bx,cx,dx:word;p:pointer);
  787. begin                            {INT 10h reg AX-DX, ES:DI = p}
  788.   rp.ax:=ax;
  789.   rp.bx:=bx;
  790.   rp.cx:=cx;
  791.   rp.dx:=dx;
  792.   rp.di:=ofs(p^);
  793.   rp.es:=seg(p^);
  794.   intr($10,rp);
  795. end;
  796.  
  797. function inp(reg:word):byte;     {Reads a byte from I/O port REG}
  798. begin
  799.   reg:=port[reg];
  800.   inp:=reg;
  801. end;
  802.  
  803. procedure outp(reg,val:word);    {Write the low byte of VAL to I/O port REG}
  804. begin
  805.   port[reg]:=val;
  806. end;
  807.  
  808. function inpw(reg:word):word;    {Reads a word from I/O port REG}
  809. begin
  810.   reg:=portw[reg];
  811.   inpw:=reg;
  812. end;
  813.  
  814. procedure outpw(reg,val:word);
  815. begin
  816.   portw[reg]:=val;
  817. end;
  818.  
  819. function rdinx(pt,inx:word):word;       {read register PT index INX}
  820. var x:word;
  821. begin
  822.   if pt=$3C0 then x:=inp(CRTC+6);    {If Attribute Register then reset Flip-Flop}
  823.   outp(pt,inx);
  824.   rdinx:=inp(pt+1);
  825. end;
  826.  
  827. procedure wrinx(pt,inx,val:word);       {write VAL to register PT index INX}
  828. var x:word;
  829. begin
  830.   if pt=$3C0 then
  831.   begin
  832.     x:=inp(CRTC+6);
  833.     outp(pt,inx);
  834.     outp(pt,val);
  835.   end
  836.   else begin
  837.     outp(pt,inx);
  838.     outp(pt+1,val);
  839.   end;
  840. end;
  841.  
  842. procedure wrinx2(pt,inx,val:word);
  843. begin
  844.   wrinx(pt,inx,lo(val));
  845.   wrinx(pt,inx+1,hi(val));
  846. end;
  847.  
  848. procedure wrinx3(pt,inx:word;val:longint);
  849. begin
  850.   wrinx(pt,inx,lo(val));
  851.   wrinx(pt,inx+1,hi(val));
  852.   wrinx(pt,inx+2,val shr 16);
  853. end;
  854.  
  855. procedure wrinx2m(pt,inx,val:word); {Write VAL to the index pair (INX,INX+1)}
  856. begin                               {in motorola (big endian) format}
  857.   wrinx(pt,inx,hi(val));
  858.   wrinx(pt,inx+1,lo(val));
  859. end;
  860.  
  861. procedure wrinx3m(pt,inx:word;val:longint);
  862. begin
  863.   wrinx(pt,inx+2,lo(val));
  864.   wrinx(pt,inx+1,hi(val));
  865.   wrinx(pt,inx,val shr 16);
  866. end;
  867.  
  868. procedure modinx(pt,inx,mask,nwv:word);  {In register PT index INX sets
  869.                                           the bits in MASK as in NWV
  870.                                           the other are left unchanged}
  871. var temp:word;
  872. begin
  873.   temp:=(rdinx(pt,inx) and (not mask))+(nwv and mask);
  874.   wrinx(pt,inx,temp);
  875. end;
  876.  
  877. procedure modreg(reg,mask,nwv:word);  {In register REG sets the bits in
  878.                                        MASK as in NWV other are left unchanged}
  879. var temp:word;
  880. begin
  881.   temp:=(inp(reg) and (not mask))+(nwv and mask);
  882.   outp(reg,temp);
  883. end;
  884.  
  885.  
  886. procedure setinx(pt,inx,val:word);
  887. var x:word;
  888. begin
  889.   x:=rdinx(pt,inx);
  890.   wrinx(pt,inx,x or val);
  891. end;
  892.  
  893. procedure clrinx(pt,inx,val:word);
  894. var x:word;
  895. begin
  896.   x:=rdinx(pt,inx);
  897.   wrinx(pt,inx,x and (not val));
  898. end;
  899.  
  900.  
  901. function getbios(offs,lnn:word):string;
  902. var s:string;
  903. begin
  904.   s[0]:=chr(lnn);
  905.   move(mem[biosseg:offs],s[1],lnn);
  906.   getbios:=s;
  907. end;
  908.  
  909.  
  910.  
  911. type
  912.   regblk=record
  913.            base:word;
  914.            nbr:word;
  915.            x:array[0..255] of byte;
  916.          end;
  917.  
  918.   regtype=record
  919.             chip:chips;
  920.             mmode:mmods;
  921.             mode,pixels,lins,bytes,tridold0d,tridold0e:word;
  922.             attregs:array[0..31] of byte;
  923.             seqregs,grcregs,crtcregs,xxregs:regblk;
  924.             stdregs:array[$3c0..$3df] of byte;
  925.             xgaregs:array[0..15] of byte;
  926.           end;
  927.  
  928. var
  929.   rgs:regtype;
  930.   oldreg:boolean;
  931.  
  932.  
  933. procedure opentxtfile(var t:text;name:string);
  934. begin
  935.   if ioresult=0 then;  {Clear any old error code}
  936.   assign(t,name);
  937.   {$i-}
  938.   reset(t);
  939.   {$i+}
  940.   if ioresult<>0 then
  941.   begin         {Fatal file error!!!}
  942.     textmode(3);
  943.     writeln('Fatal file error (',name,') !!');
  944.     halt(1);
  945.   end;
  946. end;
  947.  
  948.  
  949.  
  950.  
  951.  
  952. procedure loadmodes;              {Load extended modes for this chip}
  953. var
  954.   t:text;
  955.   s,pat:string;
  956.   md,x,xres,yres,err,mreq,byt:word;
  957.   vbe0:_vbe0;
  958.   vbe1:_vbe1;
  959.   xbe1:_xbe1;
  960.   xbe2:_xbe2;
  961.   ok:boolean;
  962.  
  963. function unhex(s:string):word;
  964. var x:word;
  965. begin
  966.   for x:=1 to 4 do
  967.     if s[x]>'9' then
  968.       s[x]:=chr(ord(s[x]) and $5f-7);
  969.   unhex:=(((word(ord(s[1])-48) shl 4
  970.          +  word(ord(s[2])-48)) shl 4
  971.          +  word(ord(s[3])-48)) shl 4
  972.          +  word(ord(s[4])-48));
  973. end;
  974.  
  975. function mmode(s:string;var md:mmods):boolean;
  976. var x:mmods;
  977.    ok:boolean;
  978. begin
  979.   ok:=false;
  980.   for x:=_text to _p32 do
  981.     if s=mmodenames[x] then
  982.     begin
  983.       md:=x;
  984.       ok:=true;
  985.     end;
  986.   mmode:=ok;
  987. end;
  988.  
  989. function VESAmemmode(model,bits,redinf,grninf,bluinf,resinf:word):mmods;
  990. const
  991.   mode6s=4;
  992.   mode:array[1..mode6s] of mmods=(_p15,_p16,_p24,_p32);
  993.   blui:array[1..mode6s] of word =(   5,   5,    8,    8);
  994.   grni:array[1..mode6s] of word =($505,$506, $808, $808);
  995.   redi:array[1..mode6s] of word =($A05,$B05,$1008,$1008);
  996.   resi:array[1..mode6s] of word =($f01,   0,    0,$1808);
  997. var x:word;
  998. begin
  999.   VESAmemmode:=_text;  {catch weird modes}
  1000.   if (bits=15) and (resinf=0) then resinf:=$F01;   {Bloody ATI Vesa driver @#$}
  1001.   case model of
  1002.     0:VESAmemmode:=_text;
  1003.     1:case bits of
  1004.         1:VESAmemmode:=_cga1;
  1005.         2:VESAmemmode:=_cga2;
  1006.       end;
  1007.     2:memmode:=_herc;
  1008.     3:case bits of
  1009.         2:VESAmemmode:=_pl2;
  1010.         4:VESAmemmode:=_pl4;
  1011.       end;
  1012.     4:case bits of
  1013.         4:VESAmemmode:=_pk4;
  1014.         8:VESAmemmode:=_p8;
  1015.        15:VESAmemmode:=_p15;
  1016.        16:VESAmemmode:=_p16;
  1017.        24:VESAmemmode:=_p24;
  1018.       end;
  1019.     5:;
  1020.     6:for x:=1 to mode6s do
  1021.       if (redinf=redi[x]) and (grninf=grni[x]) and (bluinf=blui[x])
  1022.         and (resinf=resi[x]) then VESAmemmode:=mode[x];
  1023.     7:;
  1024.   end;
  1025. end;
  1026.  
  1027.  
  1028. procedure addmode(md,xres,yres,bytes:word;memmode:mmods);
  1029. begin
  1030.   inc(nomodes);
  1031.   modetbl[nomodes].md     :=md;
  1032.   modetbl[nomodes].xres   :=xres;
  1033.   modetbl[nomodes].yres   :=yres;
  1034.   modetbl[nomodes].bytes  :=bytes;
  1035.   modetbl[nomodes].memmode:=memmode;
  1036. end;
  1037.  
  1038. begin
  1039.   nomodes:=0;
  1040.   case chip of
  1041.    __vesa:begin
  1042.             vbe0.sign:=$41534556;    (* VESA *)
  1043.             viop($4f00,0,0,0,@vbe0);
  1044.  
  1045.                {S3 VESA driver can return wrong segment if run with QEMM}
  1046.             IF seg(vbe0.model^)=$e000 then
  1047.               vbe0.model:=ptr($c000,ofs(vbe0.model^));
  1048.             x:=1;
  1049.             while vbe0.model^[x]<>$FFFF do
  1050.             begin
  1051.               vesamodeinfo(vbe0.model^[x],@vbe1);
  1052.               if (vbe1.attr and 1)<>0 then
  1053.               begin
  1054.                 memmode:=VESAmemmode(vbe1.model,vbe1.bits,vbe1.redinf
  1055.                    ,vbe1.grninf,vbe1.bluinf,vbe1.resinf);
  1056.                 addmode(vbe0.model^[x],vbe1.width,vbe1.height,vbe1.bytes,memmode);
  1057.               end;
  1058.               inc(x);
  1059.             end;
  1060.           end;
  1061.     __xbe:begin
  1062.             viop($4E01,0,0,instance,@xbe1);
  1063.             x:=1;
  1064.             while xbe1.modep^[x]<>$FFFF do
  1065.             begin
  1066.               viop($4E02,0,xbe1.modep^[x],instance,@xbe2);
  1067.               if (rp.ax=$4E) and ((xbe2.attrib and 1)>0) then
  1068.               begin
  1069.                 memmode:=VESAmemmode(xbe2.model,xbe2.bits,xbe2.redinf
  1070.                    ,xbe2.grninf,xbe2.bluinf,xbe2.resinf);
  1071.                 addmode(xbe1.modep^[x],xbe2.pixels,xbe2.lins,xbe2.bytes,memmode);
  1072.               end;
  1073.               inc(x);
  1074.             end;
  1075.  
  1076.           end;
  1077.   else
  1078.     pat:='['+header[chip]+']';
  1079.     opentxtfile(t,'whatvga.lst');
  1080.     s:=' ';
  1081.     while (not eof(t)) and (s<>pat) do readln(t,s);
  1082.     s:=' ';
  1083.     readln(t,s);
  1084.     while (s[1]<>'[') and (s<>'') do
  1085.     begin
  1086.       md:=unhex(copy(s,1,4));
  1087.       ok:=mmode(copy(s,6,4),memmode);
  1088.       val(copy(s,11,5),xres,err);
  1089.       val(copy(s,17,4),yres,err);
  1090.       case memmode of
  1091.  _text,_text2,_text4:bytes:=xres*2;
  1092.    _pl1e, _herc,_cga1,_pl1:
  1093.                      bytes:=xres shr 3;
  1094.      _pk2,_pl2,_cga2:bytes:=xres shr 4;
  1095.            _pl4,_pk4:bytes:=xres shr 1;
  1096.                  _p8:bytes:=xres;
  1097.            _p15,_p16:bytes:=xres*2;
  1098.                 _p24:bytes:=xres*3;
  1099.                 _p32:bytes:=xres*4;
  1100.       else
  1101.       end;
  1102.       case dactype of
  1103.         _dacCEG,
  1104.           _dac8:if memmode>_p8 then ok:=false;
  1105.          _dac15:if memmode>_p15 then ok:=false;
  1106.          _dac16:if memmode>_p16 then ok:=false;
  1107.       end;
  1108.       case version of
  1109.         S3_911,S3_924:if (md>$105) and (md<$200) then ok:=false;
  1110.     ATI_Unknown..ATI_GUP_LX:
  1111.           if md<$100 then
  1112.           begin
  1113.             rp.bx:=$5506;
  1114.             rp.bp:=$FFFF;
  1115.             rp.si:=0;
  1116.             vio($1200+md);
  1117.             if rp.bp=$FFFF then ok:=false;
  1118.           end;
  1119.       end;
  1120.       val(copy(s,22,5),byt,err);
  1121.       if (err=0) and (byt>0) then bytes:=byt;
  1122.       mreq:=(longint(bytes)*yres+1023) div 1024;
  1123.       case memmode of
  1124.         _pl4:bytes:=xres shr 3;
  1125.       end;
  1126.       if ok and (mm>=mreq) then
  1127.         addmode(md,xres,yres,bytes,memmode);
  1128.       readln(t,s);
  1129.     end;
  1130.     close(t);
  1131.   end;
  1132. end;
  1133.  
  1134. procedure SelectVideo(item:word);
  1135. begin
  1136.   chip    :=vid[item].chip;
  1137.   instance:=vid[item].id;
  1138.   IOadr   :=vid[item].IOadr;
  1139.   version :=vid[item].version;
  1140.   dactype :=vid[item].dac;
  1141.   dacname :=vid[item].dacname;
  1142.   mm      :=vid[item].mem;
  1143.   features:=vid[item].features;
  1144.   name    :=vid[item].name;
  1145.   XGAseg  :=vid[item].xseg;
  1146.   phadr   :=vid[item].phadr;
  1147.   subvers :=vid[item].subver;
  1148.   DAC_RS2 :=vid[item].DAC_RS2;
  1149.   DAC_RS3 :=vid[item].DAC_RS3;
  1150.   loadmodes;
  1151.   video:=header[chip];
  1152. end;
  1153.  
  1154.  
  1155. procedure addvideo;
  1156. var nam,s:string;
  1157.     t:text;
  1158.     nr,err:word;
  1159. begin
  1160.   nam:='';
  1161.   if version<>0 then
  1162.   begin
  1163.     opentxtfile(t,'chips.lst');
  1164.     while not eof(t) do
  1165.     begin
  1166.       readln(t,s);
  1167.       val(copy(s,1,4),nr,err);
  1168.       if nr=version then
  1169.       begin
  1170.         nam:=copy(s,7,255);
  1171.         if nam[length(nam)]='(' then nam:=nam+hex4(subvers)+')';
  1172.       end;
  1173.     end;
  1174.     close(t);
  1175.   end;
  1176.   nam:=nam+' '+name;
  1177.   if dactype=0 then testdac;
  1178.   if force_mm<>0 then mm:=force_mm;
  1179.   inc(vids);
  1180.   vid[vids].chip    :=chip;
  1181.   vid[vids].id      :=instance;   {instance (XBE)}
  1182.   vid[vids].ioadr   :=IOadr;      {base I/O adr}
  1183.   vid[vids].version :=version;
  1184.   vid[vids].dac     :=dactype;
  1185.   vid[vids].dacname :=dacname;
  1186.   vid[vids].mem     :=mm;
  1187.   vid[vids].features:=features;
  1188.   vid[vids].name    :=nam;
  1189.   vid[vids].xseg    :=XGAseg;
  1190.   vid[vids].phadr   :=phadr;
  1191.   vid[vids].subver  :=subvers;
  1192.   vid[vids].DAC_RS2 :=DAC_RS2;
  1193.   vid[vids].DAC_RS3 :=DAC_RS3;
  1194.   vid[vids].sname   :=chipnam[chip];
  1195. end;
  1196.  
  1197. procedure UNK(vers,code:word);
  1198. begin
  1199.   version:=vers;
  1200.   subvers:=code;
  1201. end;
  1202.  
  1203. procedure SetVersion(vers:word;nam:string);
  1204. begin
  1205.   Version:=vers;
  1206.   name:=nam;
  1207. end;
  1208.  
  1209.  
  1210. procedure SetDAC(typ:word;Name:string);
  1211. begin
  1212.   dactype:=typ;
  1213.   dacname:=name;
  1214. end;
  1215.  
  1216.  
  1217. function tstrg(pt,msk:word):boolean;       {Returns true if the bits in MSK
  1218.                                             of register PT are read/writable}
  1219. var old,nw1,nw2:word;
  1220. begin
  1221.   old:=inp(pt);
  1222.   outp(pt,old and not msk);
  1223.   nw1:=inp(pt) and msk;
  1224.   outp(pt,old or msk);
  1225.   nw2:=inp(pt) and msk;
  1226.   outp(pt,old);
  1227.   tstrg:=(nw1=0) and (nw2=msk);
  1228. end;
  1229.  
  1230. function testinx2(pt,rg,msk:word):boolean;   {Returns true if the bits in MSK
  1231.                                               of register PT index RG are
  1232.                                               read/writable}
  1233. var old,nw1,nw2:word;
  1234. begin
  1235.   old:=rdinx(pt,rg);
  1236.   wrinx(pt,rg,old and not msk);
  1237.   nw1:=rdinx(pt,rg) and msk;
  1238.   wrinx(pt,rg,old or msk);
  1239.   nw2:=rdinx(pt,rg) and msk;
  1240.   wrinx(pt,rg,old);
  1241.   testinx2:=(nw1=0) and (nw2=msk);
  1242. end;
  1243.  
  1244. function testinx(pt,rg:word):boolean;     {Returns true if all bits of
  1245.                                            register PT index RG are
  1246.                                            read/writable.}
  1247. var old,nw1,nw2:word;
  1248. begin
  1249.   testinx:=testinx2(pt,rg,$ff);
  1250. end;
  1251.  
  1252. procedure dac2pel;    {Force DAC back to PEL mode}
  1253. begin
  1254.   if inp($3c8)=0 then;
  1255. end;
  1256.  
  1257. var
  1258.   daccomm:word;
  1259.  
  1260. function trigdac:word;  {Reads $3C6 4 times}
  1261. var x:word;
  1262. begin
  1263.   x:=inp($3c6);
  1264.   x:=inp($3c6);
  1265.   x:=inp($3c6);
  1266.   trigdac:=inp($3c6);
  1267. end;
  1268.  
  1269. procedure dac2comm;    {Enter command mode of HiColor DACs}
  1270. begin
  1271.   dac2pel;
  1272.   daccomm:=trigdac;
  1273. end;
  1274.  
  1275. function getdaccomm:word;
  1276. begin
  1277.   if DAC_RS2<>0 then getdaccomm:=inp($3C6+DAC_RS2)
  1278.   else begin
  1279.     dac2comm;
  1280.     getdaccomm:=inp($3C6);
  1281.     dac2pel;
  1282.   end;
  1283. end;
  1284.  
  1285.  
  1286.  
  1287. procedure checkmem(mx:word);
  1288. var
  1289.   fail:boolean;
  1290.   ma:array[0..99] of byte;
  1291.   x:word;
  1292. begin
  1293.   memmode:=_p8;
  1294.  
  1295.   fail:=true;
  1296.   while (mx>1) and fail do
  1297.   begin
  1298.     setbank(mx-1);
  1299.     move(mem[$a000:0],ma,100);
  1300.     for x:=0 to 99 do
  1301.       mem[$a000:x]:=ma[x] xor $aa;
  1302.     setbank(mx-1);
  1303.     fail:=false;
  1304.     for x:=0 to 99 do
  1305.       if mem[$a000:x]<>ma[x] xor $aa then fail:=true;
  1306.     move(ma,mem[$a000:0],100);
  1307.     if not fail then
  1308.     begin
  1309.       setbank((mx shr 1)-1);
  1310.       for x:=0 to 99 do
  1311.         mem[$a000:x]:=ma[x] xor $55;
  1312.       setbank(mx-1);
  1313.       fail:=true;
  1314.       for x:=0 to 99 do
  1315.         if mem[$a000:x]<>ma[x] xor $55 then fail:=false;
  1316.       move(ma,mem[$a000:0],100);
  1317.     end;
  1318.     mx:=mx shr 1;
  1319.   end;
  1320.   mm:=mx*128;
  1321. end;
  1322.