unit sb_det3;
interface
const blaster:record
base:word;
irq:byte;
dma:byte;
ver:word; {hi.lo}
end=(base:$FFFF; irq:$FF; dma:$FF; ver:$0000);
got:record
base:boolean;
irq:boolean;
dma:boolean;
end=(base:false; irq:false; dma:false);
procedure hw_detect; far;
procedure sw_detect; far;
function hexw(w:word):string; far;
implementation
uses dos;
function ucase(str:string):string; assembler;
asm
mov dx,ds;
les di,@result;
lds si,[str];
mov bl,ds:[si];
mov es:[di],bl;
inc si; inc di;
@looppi:
mov al,ds:[si];
cmp al,'a';
jb @ei_pieni;
cmp al,'z';
ja @ei_pieni;
sub al,32;
mov es:[di],al;
jmp @more;
@ei_pieni:
cmp al,'ä';
jnz @ei_ae;
mov es:[di].byte,'Ä';
jmp @more;
@ei_ae:
cmp al,'ö';
jnz @ei_oe;
mov es:[di].byte[0],'Ö';
jmp @more;
@ei_oe:
cmp al,'å';
jnz @ei_o;
mov es:[di].byte[0],'Å';
jmp @more;
@ei_o:
mov es:[di],al;
@more:
inc si;
inc di;
dec bl;
jnz @looppi;
@loppu:
mov ds,dx;
end;
function getval:boolean;
var str,str2:string;
i,i2:word;
begin
getval:=false;
str:=ucase(getenv('BLASTER'));
str2:=copy(str,pos('A',str)+1,3);
val('$'+str2,i,i2);
if (i<$210) or (i>$280) then exit;
got.base:=true;
blaster.base:=i;
str2:=copy(str,pos('I',str)+1,2);
if pos(' ',str2)>0 then str2:=copy(str2,1,1);
val(str2,i,i2);
if (i<2) or (i>10) then exit;
got.irq:=true;
blaster.irq:=i;
str2:=copy(str,pos('D',str)+1,1);
val(str2,i,i2);
if (i>3) then exit;
got.dma:=true;
blaster.dma:=i;
getval:=true;
end;
procedure sw_detect;
begin
got.base:=false;
got.irq:=false;
got.dma:=false;
if not(getval) then begin
blaster.base:=$FFFF;
blaster.irq:=$FF;
blaster.dma:=$FF;
got.base:=false;
got.irq:=false;
got.dma:=false;
end;
blaster.ver:=$0000;
end;
(********** HARDWARE DETECTION PART **********)
var det:record
base:word;
dma,irq:byte;
end;
pic:array[0..15] of byte;
sb_ack:byte;
istom,istam:array [0..15] of byte;
dstom,dstam:byte;
airq:byte;
pageport:byte;
oldclk:pointer;
dsp_reset:word;
dsp_read_data:word;
dsp_write_data:word;
dsp_write_status:word;
dsp_data_avail:word;
koee:byte;
irqcheck:byte;
i:byte;
null:array[0..1023] of byte;
alku:word;
procedure retrace; assembler;
asm
mov dx,3dah;
xor cx,cx;
@vert1:
dec cx
jz @vert2;
in al,dx;
test al,8;
jz @vert1;
xor cx,cx;
@vert2:
dec cx
jz @end;
in al,dx;
test al,8;
jnz @vert2;
@end:;
end;
procedure writedsp(value:byte); assembler;
asm
mov dx,dsp_write_status;
xor cx,cx;
@loop:
dec cx;
jz @end;
in al,dx;
and al,$80;
jnz @loop;
@end:;
mov dx,dsp_write_data;
mov al,value;
out dx,al;
end;
function readdsp:byte; assembler;
asm
mov dx,dsp_data_avail;
xor cx,cx;
@loop:
dec cx;
jz @end;
in al,dx;
and al,$80;
jz @loop;
@end:;
mov dx,dsp_read_data;
in al,dx;
end;
function dspversion2:word;
var ver:word;
begin
asm cli; end;
writedsp($E1);
ver:=readdsp shl 8;
ver:=ver+readdsp;
dspversion2:=ver;
asm sti; end;
end;
function resetdsp(base:word; epatoivo:byte):boolean;
var eptoiv:byte;
reset:boolean;
begin
dsp_reset:=base+$6;
dsp_read_data:=base+$A;
dsp_write_data:=base+$C;
dsp_write_status:=base+$C;
dsp_data_avail:=base+$E;
eptoiv:=0;
reset:=false;
asm cli; end;
port[$0D]:=$00; {from soundss3}
repeat
inc(eptoiv);
port[dsp_reset]:=1;
retrace; retrace; {just in case.. 1/20 of this should do}
port[dsp_reset]:=0;
retrace;
asm
mov dx,dsp_data_avail;
xor cx,cx;
@loop:
dec cx;
jz @end;
in al,dx;
and al,$80;
jz @loop;
@end:;
end;
if readdsp=$AA then reset:=true else reset:=false;
until (reset) or (eptoiv>epatoivo);
asm sti; end;
resetdsp:=reset;
end;
procedure setfreq(freq:word);
begin
WriteDSP($D1);
WriteDSP($40);
WriteDSP(byte(256 - (1000000 div freq) ) );
end;
function SpeakerOn: byte;
begin
WriteDSP($D1);
end;
function SpeakerOff: byte;
begin
WriteDSP($D3);
end;
procedure DMAContinue;
begin
WriteDSP($D4);
end;
procedure DMAStop;
begin
WriteDSP($D0);
end;
procedure Playback(sound:Pointer; size:word; startmask,stopmask,pageport:byte; freq:word);
var time_constant:word;
page, offset:word;
begin
asm cli; end;
dec(size,1);
dmastop;
speakeroff;
offset := Seg(sound^) Shl 4 + Ofs(sound^);
page := (Seg(sound^) + Ofs(sound^) shr 4) shr 12;
Port[$0A]:=stopmask; { dmamaskport}
Port[$0C]:=0;{ dmaclrptrport}
Port[$0B]:=$48+startmask;{ dmamodeport}
Port[2*startmask]:=Lo(offset);{ dmabaseaddrport}
Port[2*startmask]:=Hi(offset);{ dmabaseaddrport}
Port[2*startmask+1]:=Lo(size);{ dmacountport}
Port[2*startmask+1]:=Hi(size);{ dmacountport}
Port[pageport]:=page;{ dmapageport}
Port[$0A]:=startmask;{ dmamaskport}
speakeron;
dmacontinue;
setfreq(freq);
writedsp($14); {8-bit single cycle (not auto-init) normal speed}
writedsp(lo(size));
writedsp(hi(size));
asm sti; end;
end;
procedure setintvek(intnro:byte; newhand:pointer);assembler; asm
mov ah,$25; mov al,[intnro]; push ds; lds dx,newhand;
int $21; pop ds; end; {like dos-setintvec}
function getintvek(intnro:byte):pointer;assembler; asm
mov ah,$35; mov al,[intnro]; int $21; mov dx,es;
mov ax,bx; end; {like dos-getintvec, except this one is a function}
{$S-}
procedure int2; interrupt;
begin
asm cli; end;
koee:=Port[sb_ack];{sb ack }
port[$20]:=$20;{pic ack}
irqcheck:=2;
asm sti; end;
end;
{$S-}
procedure int3; interrupt;
begin
asm cli; end;
koee:=Port[sb_ack]; {sb ack }
port[$20]:=$20;{pic ack}
irqcheck:=3;
asm sti; end;
end;
{$S-}
procedure int5; interrupt;
begin
asm cli; end;
koee:=Port[sb_ack]; {sb ack }
port[$20]:=$20;{pic ack}
irqcheck:=5;
asm sti; end;
end;
{$S-}
procedure int7; interrupt;
begin
asm cli; end;
koee:=Port[sb_ack]; {sb ack }
port[$20]:=$20;{pic ack}
irqcheck:=7;
asm sti; end;
end;
{$S-}
procedure int10; interrupt;
begin
asm cli; end;
koee:=Port[sb_ack]; {sb ack }
port[$A0]:=$20;{pic ack}
port[$20]:=$20;{pic ack}
irqcheck:=10;
asm sti; end;
end;
procedure hook_sb(irq:byte);
var inte:pointer;
begin
case irq of
2:inte:=@int2;
3:inte:=@int3;
5:inte:=@int5;
7:inte:=@int7;
10:inte:=@int10;
else exit;
end;
if irq<=7 then begin
airq:=$08+irq;
pic[irq]:=$21;
end else begin
airq:=$70+irq-8;
pic[irq]:=$A1;
end;
istom[irq]:=1 shl(IRQ mod 8);
istam[irq]:=not(istom[irq]);
asm cli; end;
port[pic[irq]]:=port[pic[irq]] or istom[irq];
oldclk:=getintvek(airq);
setintvek(airq,inte);
port[pic[irq]]:=port[pic[irq]] and istam[irq];
asm sti; end;
end;
procedure dehook_sb(irq:byte);
begin
if irq in [2,3,5,7,10] then begin
asm cli; end;
Port[pic[irq]] := Port[pic[irq]] or istom[irq];
setintvek(airq,oldclk);
asm sti; end;
end;
end;
procedure setup_dma(dma:byte);
begin
case DMA of
0:PagePort:=$87;
1:PagePort:=$83;
2:PagePort:=$81;
3:PagePort:=$82;
end;
dstam:=dma;
dstom:=dma or $04;
end;
procedure tst(baseio:word);
var irqq,dm,yritykset:byte;
loop:longint;
begin
if not(resetdsp(baseio,3)) then exit;
sb_ack:=baseio+$E;
for irqq:=2 to 10 do hook_sb(irqq);
irqcheck:=$FF;
yritykset:=0;
while (irqcheck=$FF) and (yritykset<10) do begin
for dm:=0 to 3 do if dm<>2 then begin
setup_dma(dm);
port[$20]:=$20;
port[$A0]:=$20;
playback(ptr(seg(null),ofs(null)+alku),4,dstam,dstom,pageport,11025);
retrace;
retrace;
if irqcheck<>$FF then break;
end;
inc(yritykset,1);
end;
if irqcheck=$FF then begin
writedsp($F2); {request interrupt}
retrace;
retrace;
dm:=$FF;
det.irq:=irqcheck;
det.dma:=dm;
got.irq:=(irqcheck<>$FF);
got.dma:=false;
end
else
if irqcheck<>$FF then begin
det.irq:=irqcheck;
det.dma:=dm;
got.irq:=true;
got.dma:=true;
end;
for irqq:=2 to 10 do dehook_sb(irqq);
dmastop;
speakeroff;
port[$0A]:=dstom;
resetdsp(baseio,0);
end;
function hexw(w:word): string;
const hexchars:array[0..$F] of char='0123456789ABCDEF';
begin
hexw:=hexchars[(w and $F000) shr 12]+
hexchars[(w and $0F00) shr 8]+
hexchars[(w and $00F0) shr 4]+
hexchars[(w and $000F)];
end;
function linear(segm,offs:word):longint;
begin
linear:=longint(segm)*16+longint(offs);
end;
procedure hw_detect;
var tries,i:byte;
begin
fillchar(null,sizeof(null),0);
alku:=0;
if linear(seg(null),ofs(null)+32)>65535 then alku:=64;
det.base:=$FFFF;
det.irq:=$FF;
det.dma:=$FF;
got.base:=false;
got.irq:=false;
got.dma:=false;
tries:=0;
while (tries<10) and (det.base=$FFFF) do begin
for i:=1 to 8 do
if resetdsp(i*$10+$200,3) then begin det.base:=$200+i*$10; break; end;
inc(tries);
end;
if det.base=$FFFF then begin
blaster.base:=$FFFF;
blaster.irq:=$FF;
blaster.dma:=$FF;
blaster.ver:=$0000;
got.base:=false;
got.irq:=false;
got.dma:=false;
exit;
end;
got.base:=true;
tst(det.base); {get dma and irq}
blaster.base:=det.base;
blaster.irq:=det.irq;
blaster.dma:=det.dma;
blaster.ver:=dspversion2;
end;
begin
end.