Sound, Music & MIDI Collection 2/SMMVOL2.bin/PROG/SB16SND.ZIP/SBIO.PAS

Pascal/Delphi Source File | 1995-02-18 | 9.4 KB | 323 lines

{           Copyright 1995 by Ethan Brodsky.  All rights reserved.           }
unit SBIO;
  interface
    type
      Mode = (Input, Output);
    function  Init(BaseIO: word; IRQ: byte; DMA16: byte; IO: Mode; Rate: word): boolean;
    procedure Shutdown;

    procedure StartIO(Length: LongInt);

    procedure SetHandler(Ptr: pointer);

    procedure GetBuffer(var BufPtr: pointer; Length: word);
    procedure FreeBuffer(var BufPtr: pointer);

    function DMACount: word;

    var
      IntCount : LongInt;
      Done     : boolean;
      CurBlock : byte;
  implementation
    uses
      DOS;
    var
      ResetPort        : word;
      ReadPort         : word;
      WritePort        : word;
      PollPort         : word;
      Poll16Port       : word;

      PICRotatePort    : word;
      PICMaskPort      : word;

      DMAMaskPort      : word;
      DMAClrPtrPort    : word;
      DMAModePort      : word;
      DMABaseAddrPort  : word;
      DMACountPort     : word;
      DMAPagePort      : word;

      IRQStartMask     : byte;
      IRQStopMask      : byte;
      IRQIntVector     : byte;
      IntController    : byte;

      DMAStartMask     : byte;
      DMAStopMask      : byte;
      DMAMode          : byte;

      OldIntVector     : pointer;
      OldExitProc      : pointer;

      HandlerInstalled : boolean;

      MemArea          : pointer;
      MemAreaSize      : LongInt;
      BufferAddress    : LongInt;
      BufferPage       : byte;
      BufferOffset     : word;
      BufferLength     : word;
      BlockLength      : word;

      IOMode           : Mode;

      SamplesRemaining : LongInt;
      SamplingRate     : word;

    type
      HandlerProc = procedure;
    var
      Handler: HandlerProc;

   {Low level sound card I/O ════════════════════════════════════════════════}
    procedure WriteDSP(Value: byte);
      begin
        repeat until (Port[WritePort] and $80) = 0;
        Port[WritePort] := Value;
      end;

    function ReadDSP: byte;
      begin
        repeat until (Port[PollPort] and $80) <> 0;
        ReadDSP := Port[ReadPort];
      end;

    function ResetDSP: boolean;
      var
        i: byte;
      begin
        Port[ResetPort] := 1;
        Port[ResetPort] := 0;
        i := 100;
        while (ReadDSP <> $AA) and (i > 0) do Dec(i);
        if i > 0
          then ResetDSP := true
          else ResetDSP := false;
      end;

    function DMACount: word;
      var
        x: word;
      begin
        x := Port[DMACountPort];
        x := x + Port[DMACountPort] * 256;

        DMACount := x;
      end;

   {Initialization and shutdown ═════════════════════════════════════════════}
    procedure InstallHandler; forward;
    procedure UninstallHandler; forward;

    function  Init(BaseIO: word; IRQ: byte; DMA16: byte; IO: Mode; Rate: word): boolean;
      begin
       {Sound card IO ports}
        ResetPort  := BaseIO + $6;
        ReadPort   := BaseIO + $A;
        WritePort  := BaseIO + $C;
        PollPort   := BaseIO + $E;
        Poll16Port := BaseIO + $F;

        Init := true;
       {Reset DSP, get version, and pick output mode}
        if not(ResetDSP)
          then
            begin
              Init := false;
              Exit;
            end;

       {Compute interrupt ports and parameters}
        if IRQ <= 7
          then
            begin
              IRQIntVector  := $08+IRQ;
              PICRotatePort := $20;
              PICMaskPort   := $21;
              IntController := 1;
            end
          else
            begin
              IRQIntVector  := $70+IRQ-8;
              PICRotatePort := $A0;
              PICMaskPort   := $A1;
              IntController := 2;
            end;
        IRQStopMask  := 1 shl (IRQ mod 8);
        IRQStartMask := not(IRQStopMask);

       {Compute DMA ports and parameters}
        DMAMaskPort     := $D4;
        DMAClrPtrPort   := $D8;
        DMAModePort     := $D6;
        DMABaseAddrPort := $C0 + 4*(DMA16-4);
        DMACountPort    := $C2 + 4*(DMA16-4);
        case DMA16
          of
            5:  DMAPagePort := $8B;
            6:  DMAPagePort := $89;
            7:  DMAPagePort := $8A;
          end;
        DMAStopMask  := DMA16-4 + $04;   {000001xx}
        DMAStartMask := DMA16-4 + $00;   {000000xx}
        if IO = Input
          then DMAMode := DMA16-4 + $54  {010101xx (Input)  }
          else DMAMode := DMA16-4 + $58; {010110xx (Output) }

        IOMode := IO;
        SamplingRate := Rate;

        InstallHandler;
      end;

    procedure Shutdown;
      begin
        UninstallHandler;
        ResetDSP;
      end;

   {Start and stop input/output ═════════════════════════════════════════════}
    procedure StartIO(Length: LongInt);
      begin
        Done := false;
        SamplesRemaining := Length;
        CurBlock := 1;

       {Program DMA controller}
        Port[DMAMaskPort]     := DMAStopMask;
        Port[DMAClrPtrPort]   := $00;
        Port[DMAModePort]     := DMAMode;
        Port[DMABaseAddrPort] := Lo(BufferOffset);
        Port[DMABaseAddrPort] := Hi(BufferOffset);
        Port[DMACountPort]    := Lo(BufferLength - 1);
        Port[DMACountPort]    := Hi(BufferLength - 1);
        Port[DMAPagePort]     := BufferPage;
        Port[DMAMaskPort]     := DMAStartMask;

       {Program sound card}
        if IOMode = Output
          then WriteDSP($41)       {Set digitized sound output sampling rate }
          else WriteDSP($42);      {Set digitized sound input sampling rate  }
        WriteDSP(Hi(SamplingRate));
        WriteDSP(Lo(SamplingRate));
        if IOMode = Output
          then WriteDSP($B6)       {DSP command:  16-bit D/A, Auto-Init, FIFO}
          else WriteDSP($BE);      {DSP command:  16-bit A/D, Auto-Init, FIFO}
        WriteDSP($10);             {DMA mode:     16-bit Signed Mono         }
        WriteDSP(Lo(BlockLength - 1));
        WriteDSP(Hi(BlockLength - 1));
      end;

   {Interrupt handling ══════════════════════════════════════════════════════}
     procedure SetHandler(Ptr: pointer);
       begin
         Handler := HandlerProc(Ptr);
       end;
     procedure ToggleBlock;
       begin
         if CurBlock = 1
           then CurBlock := 2
           else CurBlock := 1;
       end;

     procedure IntHandler; interrupt;
       var
         Temp: byte;
       begin {CurBlock -> Block that just finished being output}
         Inc(IntCount);

         if @Handler <> nil then Handler;

         if SamplesRemaining > 0
           then
             Dec(SamplesRemaining, BlockLength)
           else
             begin
               Done := true;
               WriteDSP($D9);
             end;
         ToggleBlock; {CurBlock -> Block that just started}

         Temp := Port[Poll16Port];
         Port[$20] := $20;
       end;

    procedure EnableInterrupts;  InLine($FB); {STI}
    procedure DisableInterrupts; InLine($FA); {CLI}

    procedure InstallHandler;
      begin
        DisableInterrupts;
        Port[PICMaskPort] := Port[PICMaskPort] or IRQStopMask;
        GetIntVec(IRQIntVector, OldIntVector);
        SetIntVec(IRQIntVector, @IntHandler);
        Port[PICMaskPort] := Port[PICMaskPort] and IRQStartMask;
        EnableInterrupts;
        HandlerInstalled := true;
      end;

    procedure UninstallHandler;
      begin
        DisableInterrupts;
        Port[PICMaskPort] := Port[PICMaskPort] or IRQStopMask;
        SetIntVec(IRQIntVector, OldIntVector);
        EnableInterrupts;
        HandlerInstalled := false;
      end;

   {Memory management ═══════════════════════════════════════════════════════}
    function GetLinearAddr(Ptr: pointer): LongInt;
      begin
        GetLinearAddr := LongInt(Seg(Ptr^))*16 + LongInt(Ofs(Ptr^));
      end;

    function NormalizePtr(p: pointer): pointer;
      var
        LinearAddr: LongInt;
      begin
        LinearAddr := GetLinearAddr(p);
        NormalizePtr := Ptr(LinearAddr div 16, LinearAddr mod 16);
      end;

    procedure GetBuffer(var BufPtr: pointer; Length: word);
      begin
       {Find a block of memory that does not cross a page boundary}
        MemAreaSize := 8 * Length;
        GetMem(MemArea, MemAreaSize);
        if MemArea = nil then Halt;
        if ((GetLinearAddr(MemArea) div 2) mod 65536)+Length*2 < 65536
          then BufPtr := MemArea
          else BufPtr := NormalizePtr(Ptr(Seg(MemArea^), Ofs(MemArea^)+4*Length));

       {DMA parameters}
        BufferAddress := GetLinearAddr(BufPtr);
        BlockLength   := Length;  BufferLength := Length*2;
        BufferPage   := BufferAddress div 65536;
        BufferOffset := (BufferAddress div 2) mod 65536;
      end;

    procedure FreeBuffer(var BufPtr: pointer);
      begin
        BufPtr := nil;
        FreeMem(MemArea, MemAreaSize);
      end;


   {Emergency shutdown ══════════════════════════════════════════════════════}
    procedure SBExitProc; far; {Called automatically on program termination}
      begin
        ExitProc := OldExitProc;
        Port[$20] := $20;
        WriteDSP($D5);
        Port[DMAMaskPort] := DMAStopMask;
        if HandlerInstalled then UninstallHandler;
      end;

  begin
    IntCount    := 0;
    OldExitProc := ExitProc;
    ExitProc    := @SBExitProc;
    Handler     := nil
  end.