Metropoli BBS
VIEWER: sb_det3.pas MODE: TEXT (CP437)
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.
[ RETURN TO DIRECTORY ]