1212 lines
29 KiB
ObjectPascal
1212 lines
29 KiB
ObjectPascal
|
|
type
|
|
str10 = string[10];
|
|
|
|
const
|
|
|
|
hx:array[0..15] of char='0123456789ABCDEF';
|
|
|
|
Debug:boolean=false; {If set step through video tests one by one}
|
|
Auto_test:boolean=false; {If set run tests automatically}
|
|
|
|
|
|
{Keys:}
|
|
Ch_Cr = $0D;
|
|
Ch_Esc = $1B;
|
|
Ch_F1 = $13B;
|
|
Ch_F2 = $13C;
|
|
Ch_F3 = $13D;
|
|
Ch_F4 = $13E;
|
|
Ch_F5 = $13F;
|
|
Ch_F6 = $140;
|
|
Ch_F7 = $141;
|
|
Ch_F8 = $142;
|
|
Ch_Home = $147;
|
|
Ch_ArUp = $148;
|
|
Ch_PgUp = $149;
|
|
Ch_ArLeft = $14B;
|
|
Ch_ArRight = $14D;
|
|
Ch_End = $14F;
|
|
Ch_ArDown = $150;
|
|
Ch_PgDn = $151;
|
|
Ch_Ins = $152;
|
|
Ch_Del = $153;
|
|
|
|
|
|
{Standard segment defines}
|
|
Seg0000 = $0000; {Interupt table}
|
|
Seg0040 = $0040; {BIOS data segment}
|
|
SegA000 = $A000; {Graphics Video buffer}
|
|
SegA800 = $A800; {Graphics Video buffer - upper half}
|
|
SegB000 = $B000; {Mono Text mode buffer}
|
|
SegB800 = $B800; {Color Text mode buffer}
|
|
SegC000 = $C000; {BIOS ROM segment}
|
|
|
|
{Gamma correction types}
|
|
GAM_None = 0; {No Gamma correction}
|
|
GAM_CanDo = 1; {}
|
|
GAM_LeftJ = 2; {left justify Red&Blue 1bit each}
|
|
GAM_Left8 = 4; {Left justify to 8bits}
|
|
GAM_8bit = 8; {DAC Gamma registers are 8bit (not 6)}
|
|
|
|
type
|
|
CursorType=Array[0..31] of longint; {32 lines of 32 pixels}
|
|
charr =array[1..255] of char;
|
|
chptr =^charr;
|
|
|
|
|
|
var
|
|
rp:registers;
|
|
|
|
video:string[20];
|
|
_crt:string[20];
|
|
secondary:string[20];
|
|
|
|
planes:word; {number of video planes}
|
|
|
|
|
|
dacHWcursor:boolean; {True if we use the DAC cursor, rather than the VGA one}
|
|
|
|
|
|
vseg:word; {Video buffer base segment}
|
|
biosseg:word;
|
|
|
|
curmode:word; {Current mode number}
|
|
memmode:byte; {current memory mode}
|
|
crtc:word; {I/O address of CRTC registers}
|
|
pixels:word; {Pixels in a scanline in current mode}
|
|
lins:word; {lines in current mode}
|
|
bytes:longint; {bytes in a scanline}
|
|
|
|
force_chip:byte;
|
|
force_mm:word; {Forced memory size in Kbytes}
|
|
force_version:word; {Forced chip version}
|
|
clocktest:boolean; {Set false to disable clocktesting.}
|
|
|
|
|
|
extpixfact:word; {The number of times each pixel is shown}
|
|
extlinfact:word; {The number of times each scan line is shown}
|
|
charwid :word; {Character width in pixels}
|
|
charhigh :word; {Character height in scanlines}
|
|
calcvseg:word;
|
|
calcpixels, {Calculated displayed pixels per scanline}
|
|
calclines, { " displayed scanlines}
|
|
calchtot, { " total pixels/scanline}
|
|
calcvtot, { " total lines/frame}
|
|
calchblks, { " Hor. Blanking Start}
|
|
calchblke, { " Hor Blanking End (see hblkmask)}
|
|
calchrtrs, { " Hor Retrace Start}
|
|
calchrtre, { " Hor Retrace End (see hrtrmask)}
|
|
calcvblks, { " Vert Blanking Start}
|
|
calcvblke, { " Vert Blanking End (see vblkmask)}
|
|
calcvrtrs, { " Vert Retrace Start}
|
|
calcvrtre, { " Vert Retrace End (see vrtrmask)}
|
|
hblkmask, { " }
|
|
hrtrmask, { " }
|
|
vblkmask, { " }
|
|
vrtrmask, { " }
|
|
calcbytes:word;
|
|
calcmmode:byte;
|
|
|
|
|
|
vclk,hclk,fclk:longint; {Pixel (kHz), Line (Hz) & Frame (mHz) clocks}
|
|
ilace:boolean;
|
|
|
|
|
|
daccomm:word; {The result of the last dac2comm}
|
|
|
|
|
|
BWlow,BWhigh:longint; {Bandwidth requirement - low & high in Kbytes/sec}
|
|
|
|
|
|
(* Interface declarations for functions. In DEFVGA.PAS *)
|
|
|
|
|
|
(* Utility & User interfrace functions*)
|
|
procedure disable; {Disable interupts}
|
|
|
|
procedure enable; {Enable interrupts}
|
|
|
|
function gtstr(var cp:char):string;
|
|
|
|
function getkey:word; {Waits for a key, and returns the keyID}
|
|
|
|
function peekkey:word; {Checks for a key, and returns the keyID}
|
|
|
|
procedure pushkey(k:word); {Simulates a keystroke}
|
|
|
|
{Pretend the last key was pushed again}
|
|
procedure repeatkey;
|
|
|
|
function strip(s:string):string; {strip leading and trailing spaces}
|
|
|
|
function upstr(s:string):string; {convert a string to upper case}
|
|
|
|
function istr(w:longint):str10; {convert number to string}
|
|
|
|
function dehex(s:string):longint; {Hex string to number}
|
|
|
|
function hex2(w:word):str10; {convert number to 2digit hex string}
|
|
|
|
function hex4(w:word):str10; {convert number to 4digit hex string}
|
|
|
|
function hex8(w:longint):str10; {convert number to 4digit hex string}
|
|
|
|
procedure swapbyte(var a,b:byte); {Swap the 2 bytes}
|
|
|
|
function clipstr(var s:string):string; {Cuts & returns the first non-space
|
|
substring from s}
|
|
|
|
{BIOS & lowlevel I/O functions}
|
|
|
|
procedure vio(ax:word); {INT 10h reg ax=AX. other reg. set from RP
|
|
on return rp.ax=reg AX}
|
|
|
|
procedure viop(ax,bx,cx,dx:word;p:pointer);
|
|
{INT 10h reg AX-DX, ES:DI = p}
|
|
|
|
function inp(reg:word):byte; {Reads a byte from I/O port REG}
|
|
|
|
function inpw(reg:word):word; {Reads a word from I/O port REG}
|
|
|
|
function inpl(reg:word):longint; {Reads a DWORD from I/O port REG}
|
|
|
|
procedure outp(reg,val:word); {Write the low byte of VAL to I/O port REG}
|
|
|
|
procedure outpw(reg,val:word); {Write the word byte of VAL to I/O port REG}
|
|
|
|
procedure outpl(reg:word;val:longint); {Write the word byte of VAL to I/O port REG}
|
|
|
|
{Outputs a 32bit value as a single OUT DX,EAX - requires 386 or better}
|
|
procedure outplong(reg:word;val:longint);
|
|
|
|
{Inputs a 32bit value as a single IN EAX,DX - requires 386 or better}
|
|
function inplong(reg:word):longint;
|
|
|
|
|
|
function rdinx(pt,inx:word):word; {read register PT index INX}
|
|
|
|
procedure wrinx(pt,inx,val:word); {write VAL to register PT index INX}
|
|
|
|
procedure wrinx2(pt,inx,val:word); {write VAL to register PT index INX}
|
|
|
|
procedure wrinx2m(pt,inx,val:word); {write VAL to register PT index INX}
|
|
|
|
procedure wrinx3(pt,inx:word;val:longint); {write VAL to register PT index INX}
|
|
|
|
procedure wrinx3m(pt,inx:word;val:longint); {write VAL to register PT index INX}
|
|
|
|
procedure modinx(pt,inx,mask,nwv:word); {In register PT index INX sets
|
|
the bits in MASK as in NWV
|
|
the other are left unchanged}
|
|
|
|
procedure setinx(pt,inx,val:word);
|
|
|
|
procedure clrinx(pt,inx,val:word);
|
|
|
|
procedure modreg(reg,mask,nwv:word); {In register PT index INX sets
|
|
the bits in MASK as in NWV
|
|
the other are left unchanged}
|
|
|
|
procedure setreg(reg,val:word);
|
|
|
|
procedure clrreg(reg,val:word);
|
|
|
|
procedure modregw(reg,mask,nwv:word); {In register PT index INX sets
|
|
the bits in MASK as in NWV
|
|
the other are left unchanged}
|
|
|
|
procedure setregw(reg,val:word);
|
|
|
|
procedure clrregw(reg,val:word);
|
|
|
|
{Lowlevel DAC stuff}
|
|
function trigdac:word; {Reads $3C6 4 times}
|
|
|
|
procedure setDACstd;
|
|
procedure setdac8(on:boolean);
|
|
function setdac15:boolean;
|
|
function setdac16:boolean;
|
|
function setdac24:boolean;
|
|
function setdac32:boolean;
|
|
|
|
function setDACgamma(on:boolean):word;
|
|
|
|
|
|
function setDACpage(index:word):word;
|
|
|
|
procedure clearDACpage;
|
|
|
|
function rdDACreg(index:word):word;
|
|
|
|
procedure wrDACreg(index,val:word);
|
|
|
|
procedure clrDACreg(index,val:word);
|
|
|
|
procedure setDACreg(index,val:word);
|
|
|
|
procedure modDACreg(index,msk,val:word);
|
|
|
|
|
|
function getdaccomm:word;
|
|
|
|
procedure dac2comm;
|
|
|
|
procedure dac2pel;
|
|
|
|
|
|
{Probe clocks, should really be in IDVGA ??}
|
|
procedure findclocks;
|
|
|
|
|
|
{The LOG functions writes output data to both the screen and the file
|
|
WHATVGA.TXT, to provide a log in case of lockup}
|
|
|
|
procedure openlog(scr:boolean);
|
|
|
|
procedure wrlog(s:string);
|
|
|
|
procedure closelog;
|
|
|
|
|
|
|
|
|
|
|
|
(* HW cursor, BitBLT, linedraw and clock function in BITBLT.PAS *)
|
|
|
|
procedure setHWcurmap(VAR map:CursorType);
|
|
|
|
procedure HWcuronoff(on:boolean);
|
|
|
|
procedure setHWcurpos(X,Y:word);
|
|
|
|
procedure setHWcurcol(fgcol,bkcol:longint);
|
|
|
|
|
|
procedure setZoomWindow(Xs,Ys,Xe,Ye:word);
|
|
|
|
procedure setZoomAdr(AdrX,AdrY:word);
|
|
|
|
procedure ZoomOnOff(On:boolean);
|
|
|
|
procedure setZoomFactor(Fx,Fy:word);
|
|
|
|
procedure vesamodeinfo(md:word;var vbedata);
|
|
|
|
|
|
procedure fillrect(xst,yst,dx,dy:word;col:longint);
|
|
|
|
procedure copyrect(srcX,srcY,dstX,dstY,dx,dy:word);
|
|
|
|
procedure line(x0,y0,x1,y1:integer;col:longint);
|
|
|
|
procedure setclk(Nbr,divi:word);
|
|
|
|
function getclk(var divisor,divid:word):word;
|
|
|
|
function getClockFreq:longint; {Effective pixel clock in kHz}
|
|
|
|
|
|
|
|
|
|
(* Bank, mode and Vstart rutines, in SUPERVGA.PAS *)
|
|
|
|
procedure setbank(bank:word);
|
|
|
|
procedure setRbank(bank:word);
|
|
|
|
procedure setvstart(x,y:word); {Set the display start to (x,y)}
|
|
|
|
function setmode(md:word;clear:boolean):boolean;
|
|
|
|
procedure SetTextMode;
|
|
|
|
|
|
|
|
procedure SetRGBPal(inx,r,g,b:word);
|
|
|
|
procedure SelectVideo(Item:word);
|
|
|
|
function rgb(r,g,b:word):longint; {Converts RGB values to pixel in the
|
|
current pixelformat }
|
|
|
|
{Returns the pixel BIT address}
|
|
function pixeladdress(x,y:word):longint;
|
|
|
|
implementation
|
|
uses idvga;
|
|
|
|
|
|
var
|
|
|
|
clocktbl:array[0..31] of longint;
|
|
|
|
|
|
procedure disable; (* Disable interupts *)
|
|
begin
|
|
inline($fa); (* CLI instruction *)
|
|
end;
|
|
|
|
|
|
procedure enable; (* Enable interrupts *)
|
|
begin
|
|
inline($fb); (* STI instruction *)
|
|
end;
|
|
|
|
|
|
function gtstr(var cp:char):string;
|
|
var x:word;
|
|
s:string;
|
|
str:chptr;
|
|
begin
|
|
str:=chptr(@cp);
|
|
s:='';x:=1;
|
|
if str<>NIL then
|
|
while (x<255) and (str^[x]<>#0) do
|
|
begin
|
|
if str^[x]<>#7 then s:=s+str^[x];
|
|
inc(x);
|
|
end;
|
|
gtstr:=s;
|
|
end;
|
|
|
|
const
|
|
key_stack:word=0; {Stored key stroke 0=none}
|
|
lastkey:word=0;
|
|
|
|
function getkey:word;
|
|
var c:char;
|
|
begin
|
|
if key_stack<>0 then
|
|
begin
|
|
lastkey:=key_stack;
|
|
key_stack:=0;
|
|
end
|
|
else begin
|
|
c:=readkey;
|
|
if c=#0 then lastkey:=$100+ord(readkey)
|
|
else lastkey:=ord(c);
|
|
end;
|
|
getkey:=lastkey;
|
|
end;
|
|
|
|
function peekkey:word;
|
|
begin
|
|
if (key_stack=0) and not keypressed then peekkey:=0
|
|
else peekkey:=getkey;
|
|
end;
|
|
|
|
procedure pushkey(k:word); {Simulates a key stroke}
|
|
var ch:char;
|
|
begin
|
|
key_stack:=k;
|
|
while keypressed do ch:=readkey;
|
|
end;
|
|
|
|
{Pretend the last key was pushed again}
|
|
procedure repeatkey;
|
|
begin
|
|
pushkey(lastkey);
|
|
end;
|
|
|
|
{Swap the 2 bytes}
|
|
procedure swapbyte(var a,b:byte);
|
|
var c:byte;
|
|
begin
|
|
c:=a;
|
|
a:=b;
|
|
b:=c;
|
|
end;
|
|
|
|
|
|
function strip(s:string):string; {strip leading and trailing spaces}
|
|
begin
|
|
while s[length(s)]=' ' do dec(s[0]);
|
|
while copy(s,1,1)=' ' do delete(s,1,1);
|
|
strip:=s;
|
|
end;
|
|
|
|
function upstr(s:string):string; {convert a string to upper case}
|
|
var x:word;
|
|
begin
|
|
for x:=1 to length(s) do
|
|
s[x]:=upcase(s[x]);
|
|
upstr:=s;
|
|
end;
|
|
|
|
function istr(w:longint):str10;
|
|
var s:str10;
|
|
begin
|
|
str(w,s);
|
|
istr:=s;
|
|
end;
|
|
|
|
|
|
function hex2(w:word):str10;
|
|
begin
|
|
hex2:=hx[(w shr 4) and 15]+hx[w and 15];
|
|
end;
|
|
|
|
function hex4(w:word):str10;
|
|
begin
|
|
hex4:=hex2(hi(w))+hex2(lo(w));
|
|
end;
|
|
|
|
function hex8(w:longint):str10;
|
|
begin
|
|
hex8:=hex4(w shr 16)+hex4(w);
|
|
end;
|
|
|
|
function dehex(s:string):longint;
|
|
var x:word;
|
|
l:longint;
|
|
c:char;
|
|
begin
|
|
l:=0;
|
|
for x:=1 to length(s) do
|
|
begin
|
|
c:=s[x];
|
|
case c of
|
|
'0'..'9':l:=(l shl 4)+(ord(c) and 15);
|
|
'a'..'f','A'..'F':
|
|
l:=(l shl 4)+(ord(c) and 15 +9);
|
|
end;
|
|
end;
|
|
dehex:=l;
|
|
end;
|
|
|
|
function clipstr(var s:string):string; {Cuts & returns the first non-space
|
|
substring from s}
|
|
var
|
|
i:integer;
|
|
begin
|
|
i:=0;
|
|
while s[i+1]=' ' do inc(i);
|
|
delete(s,1,i);
|
|
i:=0;
|
|
while (i<length(s)) and (s[i+1]>' ') do inc(i);
|
|
clipstr:=copy(s,1,i);
|
|
delete(s,1,i);
|
|
end;
|
|
|
|
|
|
procedure vio(ax:word); {INT 10h reg ax=AX. other reg. set from RP
|
|
on return rp.ax=reg AX}
|
|
begin
|
|
rp.ax:=ax;
|
|
intr($10,rp);
|
|
end;
|
|
|
|
procedure viop(ax,bx,cx,dx:word;p:pointer);
|
|
begin {INT 10h reg AX-DX, ES:DI = p}
|
|
rp.ax:=ax;
|
|
rp.bx:=bx;
|
|
rp.cx:=cx;
|
|
rp.dx:=dx;
|
|
rp.di:=ofs(p^);
|
|
rp.es:=seg(p^);
|
|
intr($10,rp);
|
|
end;
|
|
|
|
function inp(reg:word):byte; {Reads a byte from I/O port REG}
|
|
begin
|
|
reg:=port[reg];
|
|
inp:=reg;
|
|
end;
|
|
|
|
|
|
function inpw(reg:word):word; {Reads a word from I/O port REG}
|
|
begin
|
|
reg:=portw[reg];
|
|
inpw:=reg;
|
|
end;
|
|
|
|
function inpl(reg:word):longint; {Reads a word from I/O port REG}
|
|
var l:longint;
|
|
begin
|
|
l:=portw[reg];
|
|
inpl:=l+(longint(portw[reg+2]) shl 16);
|
|
end;
|
|
|
|
{Inputs a 32bit value as a single IN EAX,DX - requires 386 or better}
|
|
function inplong(reg:word):longint;
|
|
var l:longint;
|
|
begin
|
|
inline($8B/$56/<reg/$66/$ED/$66/$89/$46/<l);
|
|
inplong:=l;
|
|
end;
|
|
|
|
procedure outp(reg,val:word); {Write the low byte of VAL to I/O port REG}
|
|
begin
|
|
port[reg]:=val;
|
|
end;
|
|
|
|
procedure outpw(reg,val:word);
|
|
begin
|
|
portw[reg]:=val;
|
|
end;
|
|
|
|
procedure outpl(reg:word;val:longint); {Write the Dword of VAL to I/O port REG}
|
|
begin
|
|
portw[reg] :=val;
|
|
portw[reg+2]:=val shr 16;
|
|
end;
|
|
|
|
{Outputs a 32bit value as a single OUT DX,EAX - requires 386 or better}
|
|
procedure outplong(reg:word;val:longint);
|
|
begin
|
|
{mov dx,[BP+reg] mov eax,[BP+val] out dx,eax}
|
|
inline($8B/$56/<reg/$66/$8B/$46/<val/$66/$EF);
|
|
end;
|
|
|
|
|
|
function rdinx(pt,inx:word):word; {read register PT index INX}
|
|
var x:word;
|
|
begin
|
|
if pt=$3C0 then
|
|
begin
|
|
x:=inp(CRTC+6); {Reset Attribute Data/Address Flip-Flop}
|
|
outp($3C0,inx and $DF); {Clear bit 5 of index}
|
|
for x:=1 to 10 do;
|
|
rdinx:=inp($3C1); {delay}
|
|
x:=inp(CRTC+6); {Reset Attribute Data/Address Flip-Flop}
|
|
for x:=1 to 10 do; {delay}
|
|
outp($3C0,$20); {Set index bit 5 to keep display alive}
|
|
x:=inp(CRTC+6); {Reset Attribute Data/Address Flip-Flop}
|
|
end
|
|
else begin
|
|
outp(pt,inx);
|
|
rdinx:=inp(pt+1);
|
|
end;
|
|
end;
|
|
|
|
procedure wrinx(pt,inx,val:word); {write VAL to register PT index INX}
|
|
var x:word;
|
|
begin
|
|
if pt=$3C0 then
|
|
begin
|
|
x:=inp(CRTC+6);
|
|
outp($3C0,inx and $DF);
|
|
outp($3C0,val);
|
|
x:=inp(CRTC+6); {If Attribute Register then reset Flip-Flop}
|
|
outp($3C0,$20);
|
|
x:=inp(CRTC+6);
|
|
end
|
|
else begin
|
|
outp(pt,inx);
|
|
outp(pt+1,val);
|
|
end;
|
|
end;
|
|
|
|
procedure wrinx2(pt,inx,val:word);
|
|
begin
|
|
wrinx(pt,inx,lo(val));
|
|
wrinx(pt,inx+1,hi(val));
|
|
end;
|
|
|
|
procedure wrinx3(pt,inx:word;val:longint);
|
|
begin
|
|
wrinx(pt,inx,lo(val));
|
|
wrinx(pt,inx+1,hi(val));
|
|
wrinx(pt,inx+2,val shr 16);
|
|
end;
|
|
|
|
procedure wrinx2m(pt,inx,val:word); {Write VAL to the index pair (INX,INX+1)}
|
|
begin {in motorola (big endian) format}
|
|
wrinx(pt,inx,hi(val));
|
|
wrinx(pt,inx+1,lo(val));
|
|
end;
|
|
|
|
procedure wrinx3m(pt,inx:word;val:longint);
|
|
begin
|
|
wrinx(pt,inx+2,lo(val));
|
|
wrinx(pt,inx+1,hi(val));
|
|
wrinx(pt,inx,val shr 16);
|
|
end;
|
|
|
|
procedure modinx(pt,inx,mask,nwv:word); {In register PT index INX sets
|
|
the bits in MASK as in NWV
|
|
the other are left unchanged}
|
|
var temp:word;
|
|
begin
|
|
temp:=(rdinx(pt,inx) and (not mask))+(nwv and mask);
|
|
wrinx(pt,inx,temp);
|
|
end;
|
|
|
|
procedure modreg(reg,mask,nwv:word); {In register REG sets the bits in
|
|
MASK as in NWV other are left unchanged}
|
|
var temp:word;
|
|
begin
|
|
temp:=(inp(reg) and (not mask))+(nwv and mask);
|
|
outp(reg,temp);
|
|
end;
|
|
|
|
|
|
procedure setinx(pt,inx,val:word);
|
|
var x:word;
|
|
begin
|
|
x:=rdinx(pt,inx);
|
|
wrinx(pt,inx,x or val);
|
|
end;
|
|
|
|
procedure clrinx(pt,inx,val:word);
|
|
var x:word;
|
|
begin
|
|
x:=rdinx(pt,inx);
|
|
wrinx(pt,inx,x and (not val));
|
|
end;
|
|
|
|
procedure setreg(reg,val:word);
|
|
begin
|
|
outp(reg,inp(reg) or val);
|
|
end;
|
|
|
|
procedure clrreg(reg,val:word);
|
|
begin
|
|
outp(reg,inp(reg) and (not val));
|
|
end;
|
|
|
|
procedure modregw(reg,mask,nwv:word); {In register REG sets the bits in
|
|
MASK as in NWV other are left unchanged}
|
|
var temp:word;
|
|
begin
|
|
temp:=(inpw(reg) and (not mask))+(nwv and mask);
|
|
outpw(reg,temp);
|
|
end;
|
|
|
|
procedure setregw(reg,val:word);
|
|
begin
|
|
outpw(reg,inpw(reg) or val);
|
|
end;
|
|
|
|
procedure clrregw(reg,val:word);
|
|
begin
|
|
outpw(reg,inpw(reg) and (not val));
|
|
end;
|
|
|
|
|
|
{The LOG functions writes output data to both the screen and the file
|
|
WHATVGA.TXT, to provide a log in case of lockup}
|
|
var
|
|
logfile:text;
|
|
wrscr:boolean;
|
|
|
|
procedure openlog(scr:boolean);
|
|
begin
|
|
assign(logfile,'whatvga.txt');
|
|
rewrite(logfile);
|
|
wrscr:=scr;
|
|
if scr then SetTextMode;
|
|
end;
|
|
|
|
procedure wrlog(s:string);
|
|
begin
|
|
if wrscr then writeln(s);
|
|
writeln(logfile,s);
|
|
end;
|
|
|
|
procedure closelog;
|
|
begin
|
|
close(logfile);
|
|
end;
|
|
|
|
|
|
|
|
|
|
{Select the mode to use for the clock test, preferable a 25.175MHz one!
|
|
Returns the frequency (in kHz for the base freq}
|
|
function setstdmode:longint;
|
|
var md:integer;
|
|
begin
|
|
setstdmode:=25175;
|
|
case cv.chip of
|
|
__Mach32:md:=$321;
|
|
__Mach64:begin
|
|
md:=$1292;
|
|
setstdmode:=28322;
|
|
end;
|
|
{ __Compaq:if cv.version>=CPQ_QV then md:=$32
|
|
else md:=$12; }
|
|
__AGX:begin
|
|
md:=$64;
|
|
setstdmode:=44900;
|
|
end;
|
|
else md:=$12;
|
|
end;
|
|
if setmode(md,false) then;
|
|
end;
|
|
|
|
|
|
function Vretrace:boolean;
|
|
begin
|
|
case cv.chip of
|
|
__Mach64:VRetrace:=memw[cv.Xseg:$12]>=memw[cv.Xseg:$0A];
|
|
__Mach32:VRetrace:=inpw($CEEE)>=inpw($CAEE); {Hm!!}
|
|
__AGX:if (inp(cv.IOadr+5) and 1)>0 then
|
|
begin
|
|
outp(cv.IOadr+5,1); {Reset blanking flag}
|
|
VRetrace:=true;
|
|
end
|
|
else Vretrace:=false;
|
|
else
|
|
VRetrace:=(inp(crtc+6) and 8)>0; {3D4h/3B4h}
|
|
end;
|
|
end;
|
|
|
|
|
|
function getticks:longint;
|
|
var cnt,stp:longint;
|
|
stat,x:word;
|
|
begin
|
|
stat:=crtc+6;
|
|
disable;
|
|
stp:=200000;
|
|
cnt:=0;
|
|
|
|
while not VRetrace and (stp>0) do dec(stp);
|
|
while VRetrace and (stp>0) do dec(stp);
|
|
while not VRetrace and (stp>0) do dec(stp);
|
|
|
|
if stp>0 then
|
|
for x:=1 to 5 do
|
|
begin
|
|
while VRetrace and (cnt<1000000) do inc(cnt);
|
|
while not VRetrace and (cnt<1000000) do inc(cnt);
|
|
end;
|
|
|
|
enable;
|
|
getticks:=cnt;
|
|
end;
|
|
|
|
|
|
procedure progICD2061reg(clk:longint);
|
|
const
|
|
ser_clk=4;
|
|
ser_dta=8;
|
|
var
|
|
old,dta,bit:word;
|
|
procedure setbits(bits:word);
|
|
begin
|
|
outp($3C2,bits);
|
|
for bits:=1 to 5 do; {delay}
|
|
end;
|
|
|
|
begin
|
|
if cv.chip=__S3 then {Needs to enable the ICD for the STB Pegasus...}
|
|
begin
|
|
outpw(crtc,$4838);
|
|
outpw(crtc,$A539); {Enable S3 Ext}
|
|
modinx(crtc,$42,$F,3);
|
|
end;
|
|
old:=inp($3CC);
|
|
outpw(SEQ,$100);
|
|
dta:=(old and $F3)+ser_dta;
|
|
for bit:=1 to 6 do
|
|
begin
|
|
setbits(dta+ser_clk);
|
|
setbits(dta);
|
|
end;
|
|
dta:=dta and $F3;
|
|
setbits(dta);
|
|
setbits(dta+ser_clk);
|
|
setbits(dta);
|
|
setbits(dta+ser_clk);
|
|
|
|
for bit:=1 to 24 do
|
|
begin
|
|
dta:=dta and $F3;
|
|
if (clk and 1)=0 then dta:=dta+ser_dta;
|
|
setbits(dta+ser_clk);
|
|
setbits(dta);
|
|
dta:=dta xor ser_dta;
|
|
setbits(dta);
|
|
setbits(dta+ser_clk);
|
|
clk:=clk shr 1;
|
|
end;
|
|
dta:=dta or ser_dta;
|
|
setbits(dta+ser_clk);
|
|
setbits(dta);
|
|
setbits(dta+ser_clk);
|
|
setbits(dta);
|
|
outp($3C2,old);
|
|
if cv.chip=__S3 then
|
|
begin
|
|
modinx(crtc,$5C,3,2);
|
|
outpw(crtc,$5A39); {Disable S3 Ext}
|
|
outpw(crtc,$38);
|
|
end;
|
|
outpw(SEQ,$300);
|
|
delay(15);
|
|
end;
|
|
|
|
|
|
const
|
|
clkperm:integer=0;
|
|
|
|
function ClockPermission:boolean;
|
|
begin
|
|
if clkperm=0 then
|
|
begin
|
|
settextmode;
|
|
writeln('WHATVGA is about to test the clock chip or crystals on your');
|
|
writeln('board. This can cause strange behavior on the display.');
|
|
writeln('If your monitor is fixed-frequency (MDA, CGA, EGA or original');
|
|
writeln('VGA, in fact anything that can''t handle at least 800x600) this');
|
|
writeln('could in extreme situations potentionally hurt your monitor.');
|
|
writeln('Press Y to continue clock testing, any other key to skip it:');
|
|
if (getkey and $DF)=ord('Y') then clkperm:=1
|
|
else clkperm:=2;
|
|
end;
|
|
ClockPermission:=clkperm=1;
|
|
end;
|
|
|
|
procedure findclocks;
|
|
var clks,x,y,divi,divid:word;
|
|
basefreq,baselevel,l,l0,l1:longint;
|
|
progcheck:boolean; {Should we check for programmable clocks??}
|
|
begin
|
|
if (inp($3CC) and 1)>0 then crtc:=$3D4 else crtc:=$3B4;
|
|
progcheck:=true;
|
|
clks:=4;
|
|
case cv.clktype of
|
|
clk_ext3:clks:=8;
|
|
clk_ext4:clks:=16;
|
|
clk_ext5:clks:=32;
|
|
clk_ext6:clks:=64;
|
|
clk_sdac:progcheck:=false;
|
|
clk_TVP302x:begin
|
|
progcheck:=false;
|
|
clks:=0;
|
|
end;
|
|
end;
|
|
|
|
if (clks>0) and ClockPermission then
|
|
begin
|
|
memmode:=_PL4;
|
|
basefreq:=SetStdMode; {Usually mode 12h, but...}
|
|
y:=getclk(divi,divid);
|
|
baselevel:=getticks;
|
|
if baselevel>0 then
|
|
for x:=0 to clks-1 do
|
|
begin
|
|
if (x=8) and (cv.chip=__compaq) and (cv.version>=CPQ_QV) then
|
|
vio($32); {Hack to get at last 8 clock of QVision}
|
|
setclk(x,divid);
|
|
delay(50); {Let clock settle}
|
|
l:=getticks;
|
|
if l>0 then cv.clks[x]:=((basefreq*baselevel) div l)*(divi div 12);
|
|
end;
|
|
setclk(y,divid);
|
|
end;
|
|
if progcheck and ClockPermission then
|
|
begin
|
|
outp($3C2,(inp($3CC) and $F3) or $8); {Clk 2}
|
|
delay(150);
|
|
progICD2061reg($C00000);
|
|
progICD2061reg($41A83C); {14.318MHz* 2 * 109/62 = 50.35 MHz}
|
|
l0:=getticks;
|
|
progICD2061reg($41A8BC); {14.318MHz* 2/2 * 109/62 = 25.175 MHz}
|
|
l1:=getticks;
|
|
|
|
if (l0<>0) and (abs(l1-l0*2)<25) then
|
|
begin {Found an ICD2061}
|
|
cv.clktype:=clk_ICD2061;
|
|
progICD2061reg($C04000); {Set prescale bit to *4}
|
|
progICD2061reg($59A8BC); {14.318MHz* 4/2 * 109/62 = 50.35 MHz}
|
|
l:=getticks;
|
|
if abs(l1-l*2)<25 then {Prescale bit exists = ICD2061A}
|
|
cv.clktype:=clk_ICD2061A;
|
|
progICD2061reg($C00000); {Restore ?}
|
|
end;
|
|
setclk(y,divid);
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure SelectVideo(item:word);
|
|
begin
|
|
cv:=vid[item];
|
|
loadmodes;
|
|
video:=header[cv.chip];
|
|
settextmode;
|
|
end;
|
|
|
|
|
|
procedure dac2pel; {Force DAC back to PEL mode}
|
|
begin
|
|
if inp($3c8)=0 then;
|
|
end;
|
|
|
|
function trigdac:word; {Reads $3C6 4 times}
|
|
var x:word;
|
|
begin
|
|
x:=inp($3c6);
|
|
x:=inp($3c6);
|
|
x:=inp($3c6);
|
|
if (cv.dactype=_dacMU1880) then x:=inp($3C6);
|
|
trigdac:=inp($3c6);
|
|
end;
|
|
|
|
procedure dac2comm; {Enter command mode of HiColor DACs}
|
|
begin
|
|
dac2pel;
|
|
daccomm:=trigdac;
|
|
end;
|
|
|
|
function getdaccomm:word;
|
|
begin
|
|
{if cv.DAC_RS2<>0 then getdaccomm:=inp($3C6+cv.DAC_RS2)
|
|
else} begin
|
|
dac2comm;
|
|
getdaccomm:=inp($3C6);
|
|
dac2pel;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
SavedDACpage:word=0; {DAC page state saved by SaveDACpage, reset by clearDACpage}
|
|
|
|
procedure SaveDACpage;
|
|
begin
|
|
SavedDACpage:=0; {default}
|
|
if (cv.flags and FLG_ExtDAC)>0 then {RS2/3 addressing ?}
|
|
case cv.chip of
|
|
__S3:begin
|
|
outpw(crtc,$4838); {Unlock S3 regs}
|
|
outpw(crtc,$A539);
|
|
SavedDACpage:=(rdinx(crtc,$43) and 2) shl 1;
|
|
if (cv.version>S3_924) and (SavedDACpage=0) then
|
|
SavedDACpage:=(rdinx(crtc,$55) and 3) shl 2;
|
|
if (rdinx(crtc,$5C) and $20)>0 then inc(SavedDACpage,16);
|
|
outpw(crtc,$5A39);
|
|
outpw(crtc,$38); {Lock S3 regs}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
const
|
|
DACpage:boolean=false; {Set if DAC registers enabled (MGA,Weitek..)}
|
|
|
|
{Returns the address of the DAC register selected by index (0..3
|
|
for standard DACs, 0..7 or 0..15 for advanced DACs), and sets
|
|
any necessary flags. }
|
|
function setDACpage(index:word):word;
|
|
const
|
|
DACadr:array[0..3] of word=($3C8,$3C9,$3C6,$3C7);
|
|
M32DACadr:array[0..3] of word=($2EC,$2ED,$2EA,$2EB);
|
|
var ret,x:word;
|
|
found:boolean;
|
|
begin
|
|
found:=true;
|
|
ret:=DACadr[index and 3];
|
|
if cv.chip=__AGX then outp(cv.IOadr,1); {Enable VGA regs}
|
|
if (cv.flags and FLG_ExtDAC)>0 then {RS2/3 addressing ?}
|
|
case cv.chip of
|
|
__AGX:begin
|
|
if index>7 then ret:=cv.spcreg+(index and 3);
|
|
if (index and 4)>0 then outp(cv.IOadr+10,$51)
|
|
else outp(cv.IOadr+10,0);
|
|
end;
|
|
__ATI:if cv.Version<ATI_GUP_3 then found:=false
|
|
else modinx(cv.IOadr,$A0,$60,index shl 3);
|
|
__Compaq:begin
|
|
if (index and 4)>0 then inc(ret,$8000);
|
|
if (index and 8)>0 then inc(ret,$1000);
|
|
end;
|
|
__Mach32:begin
|
|
{ modinx(cv.IOadr,$A0,$60,index shl 3);}
|
|
x:=inp($8EEF) and $CF;
|
|
outp($7AEF,x+((index and $C) shl 2));
|
|
ret:=ret-$DC; {3C8 -> 2EC}
|
|
end;
|
|
__Mach64:begin
|
|
outp($62EC,index shr 2);
|
|
ret:=$5EEC+(index and 3);
|
|
end;
|
|
__MGA:begin
|
|
if (not DACpage) and (cv.PCIid>0) then
|
|
begin
|
|
wPCIlong($10,$AC000); {Map ACC regs at AC000h}
|
|
cv.Xseg:=$AC00;
|
|
DACpage:=true;
|
|
end;
|
|
ret:=0;
|
|
end;
|
|
__NCR:ret:=ret+((index and 4) shl 13); {A15 = $8000}
|
|
__S3:begin
|
|
outpw(crtc,$4838); {Unlock S3 regs}
|
|
outpw(crtc,$A539);
|
|
if cv.version>S3_924 then
|
|
begin
|
|
clrinx(crtc,$43,2); {Just in case}
|
|
modinx(crtc,$55,3,index shr 2);
|
|
modinx(crtc,$5C,$20,index shl 1); {TVP3025 control}
|
|
end
|
|
else modinx(crtc,$43,2,index shr 1);
|
|
outpw(crtc,$5A39);
|
|
outpw(crtc,$38); {Lock S3 regs}
|
|
end;
|
|
__Tseng:begin
|
|
outp($3BF,3);
|
|
outp(crtc+4,$A0);
|
|
modinx(crtc,$31,$40,index shl 4); {Chrontel DAC}
|
|
end;
|
|
{Diamond Viper w/ OAK }
|
|
__OAK:ret:=ret+(index and $C) shl 12;
|
|
__Weitek,__WeitekP9:
|
|
if (cv.version<WT_P9100) and (cv.PCIid=0) then
|
|
ret:=ret+(index and $C) shl 12 {Non-PCI P9000s}
|
|
else begin
|
|
if not DACpage then
|
|
begin
|
|
outp($9100,$41);
|
|
x:=inp($9104);
|
|
outp($9100,$41);
|
|
outp($9104,(x and $F3) or 4); {Enable Acc regs at A000h}
|
|
DACpage:=true;
|
|
end;
|
|
ret:=0;
|
|
end;
|
|
else found:=false;
|
|
end
|
|
else found:=false;
|
|
if not found and (index=dacHIcmd) then dac2comm;
|
|
setDACpage:=ret;
|
|
end;
|
|
|
|
{Clears any bits set by setDACpage. Should be used after a sequence
|
|
of extended DAC register accesses to avoid problems with accessess
|
|
to the standard DAC registers}
|
|
procedure clearDACpage;
|
|
var x:word;
|
|
begin
|
|
if cv.chip=__AGX then outp(cv.IOadr,4); {Disable VGA regs}
|
|
if SavedDACpage>0 then
|
|
x:=setDACpage(SavedDACpage)
|
|
else begin
|
|
if (cv.flags and FLG_ExtDAC)>0 then {RS2/3 addressing ?}
|
|
case cv.chip of
|
|
__AGX:outp(cv.IOadr+10,0);
|
|
__ATI:clrinx(cv.IOadr,$A0,$60);
|
|
__Mach64:outp($62EC,0);
|
|
__MGA:if DACpage then
|
|
wPCIlong($10,PCIrec[cv.PCIid].l[4]);
|
|
__S3:begin
|
|
outpw(crtc,$4838); {Unlock S3 regs}
|
|
outpw(crtc,$A539);
|
|
if cv.version>S3_924 then clrinx(crtc,$55,3);
|
|
clrinx(crtc,$43,2);
|
|
outpw(crtc,$5A39);
|
|
outpw(crtc,$38); {Lock S3 regs}
|
|
end;
|
|
__Tseng:begin
|
|
outp($3BF,3);
|
|
outp(crtc+4,$A0);
|
|
clrinx(crtc,$31,$40); {Chrontel DAC}
|
|
end;
|
|
__Weitek,__WeitekP9:
|
|
if DACpage then
|
|
begin
|
|
outp($9100,$41);
|
|
x:=inp($9104);
|
|
outp($9100,$41);
|
|
outp($9104,x and $F3); {Disable Acc regs at A000h}
|
|
end;
|
|
else dac2pel;
|
|
end
|
|
else dac2pel;
|
|
end;
|
|
DACpage:=false;
|
|
end;
|
|
|
|
|
|
|
|
function rdDACreg(index:word):word;
|
|
var inx:word;
|
|
begin
|
|
inx:=SetDACpage(index);
|
|
if inx=0 then
|
|
case cv.chip of
|
|
__MGA:rdDACreg:=mem[cv.Xseg:$3C00+index*4];
|
|
__Weitek,__WeitekP9:
|
|
begin
|
|
if mem[SegA000:$198]=0 then; {Wait ?}
|
|
rdDACreg:=mem[SegA000:$200+4*index];
|
|
end;
|
|
end
|
|
else rdDACreg:=inp(inx);
|
|
end;
|
|
|
|
procedure wrDACreg(index,val:word);
|
|
var inx:word;
|
|
begin
|
|
inx:=SetDACpage(index);
|
|
if inx=0 then
|
|
case cv.chip of
|
|
__MGA:mem[cv.Xseg:$3C00+index*4]:=val;
|
|
__Weitek,__WeitekP9:
|
|
mem[SegA000:$200+4*index]:=val;
|
|
end
|
|
else outp(inx,val);
|
|
end;
|
|
|
|
|
|
procedure clrDACreg(index,val:word);
|
|
begin
|
|
wrDACreg(index,rdDACreg(index) and not val);
|
|
end;
|
|
|
|
procedure setDACreg(index,val:word);
|
|
begin
|
|
wrDACreg(index,rdDACreg(index) or val);
|
|
end;
|
|
|
|
procedure modDACreg(index,msk,val:word);
|
|
begin
|
|
wrDACreg(index,(rdDACreg(index) and not msk) or (msk and val));
|
|
end;
|
|
|
|
|
|
function rgb(r,g,b:word):longint;
|
|
begin
|
|
r:=lo(r);g:=lo(g);b:=lo(b);
|
|
case memmode of
|
|
_PL1,_PL1E,_CGA1:
|
|
rgb:=r and 1;
|
|
_PL2,_CGA2:
|
|
rgb:=r and 3;
|
|
_PL4,_PK4:rgb:=r and 15;
|
|
_P8:rgb:=r;
|
|
_P15:rgb:=((r shr 3) shl 5+(g shr 3)) shl 5+(b shr 3);
|
|
_P16:rgb:=((r shr 3) shl 6+(g shr 2)) shl 5+(b shr 3);
|
|
_P24,_P32:rgb:=(longint(r) shl 8+g) shl 8 +b;
|
|
_P24b,_P32b:rgb:=(longint(b) shl 8+g) shl 8 +r;
|
|
_p32c:rgb:=((longint(r) shl 8+g) shl 8 +b) shl 8;
|
|
_P32d:rgb:=((longint(b) shl 8+g) shl 8 +r) shl 8;
|
|
end;
|
|
end;
|
|
|
|
|
|
{Writes a 32bit value to a DWORD at offset ADR in Xseg}
|
|
procedure write32(adr:word;val:longint);
|
|
var w:word;
|
|
begin
|
|
w:=cv.Xseg;
|
|
{mov es,[cv.Xseg] mov di,[BP+adr] mov eax,[BP+val] mov es:[di],eax}
|
|
inline($8E/$46/<w/$8B/$7E/<adr/$66/$8B/$46/<val/$66/$26/$89/5);
|
|
end;
|
|
|
|
{Writes a two 16bit values to a DWORD at offset ADR in Xseg as one MOVL}
|
|
procedure write32w(adr:word;hiw,low:word);
|
|
var w:word;
|
|
l:longint;
|
|
begin
|
|
l:=(longint(hiw) shl 16)+low;
|
|
w:=cv.Xseg;
|
|
{mov es,[cv.Xseg] mov di,[BP+adr] mov eax,[BP+l] mov es:[di],eax}
|
|
inline($8E/$46/<w/$8B/$7E/<adr/$66/$8B/$46/<l/$66/$26/$89/5);
|
|
end;
|
|
|