freepascal.compiler/packages/extra/amunits/units/expansion.pas

{
    This file is part of the Free Pascal run time library.

    A file in Amiga system run time library.
    Copyright (c) 1998-2003 by Nils Sjoholm
    member of the Amiga RTL development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{
    History:

    Added the defines use_amiga_smartlink and
    use_auto_openlib. Implemented autoopening of
    the library.
    14 Jan 2003.

    Update for AmigaOS 3.9.
    Changed start code for unit.
    01 Feb 2003.

    Changed cardinal > longword.
    09 Feb 2003.

    [email protected] Nils Sjoholm
}

{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
   {$smartlink on}
{$endif use_amiga_smartlink}

UNIT expansion;

INTERFACE
USES exec, configvars, amigados;

Const
    EXPANSIONNAME       : PChar = 'expansion.library';

{ flags for the AddDosNode() call }
    ADNB_STARTPROC      = 0;

    ADNF_STARTPROC      = 1;

VAR ExpansionBase : pLibrary;

FUNCTION AddBootNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode; configDev : pConfigDev) : BOOLEAN;
PROCEDURE AddConfigDev(configDev : pConfigDev);
FUNCTION AddDosNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode) : BOOLEAN;
PROCEDURE AllocBoardMem(slotSpec : ULONG);
FUNCTION AllocConfigDev : pConfigDev;
FUNCTION AllocExpansionMem(numSlots : ULONG; slotAlign : ULONG) : POINTER;
PROCEDURE ConfigBoard(board : POINTER; configDev : pConfigDev);
PROCEDURE ConfigChain(baseAddr : POINTER);
FUNCTION FindConfigDev(const oldConfigDev : pConfigDev; manufacturer : LONGINT; product : LONGINT) : pConfigDev;
PROCEDURE FreeBoardMem(startSlot : ULONG; slotSpec : ULONG);
PROCEDURE FreeConfigDev(configDev : pConfigDev);
PROCEDURE FreeExpansionMem(startSlot : ULONG; numSlots : ULONG);
FUNCTION GetCurrentBinding(const currentBinding : pCurrentBinding; bindingSize : ULONG) : ULONG;
FUNCTION MakeDosNode(const parmPacket : POINTER) : pDeviceNode;
PROCEDURE ObtainConfigBinding;
FUNCTION ReadExpansionByte(const board : POINTER; offset : ULONG) : BYTE;
PROCEDURE ReadExpansionRom(const board : POINTER; configDev : pConfigDev);
PROCEDURE ReleaseConfigBinding;
PROCEDURE RemConfigDev(configDev : pConfigDev);
PROCEDURE SetCurrentBinding(currentBinding : pCurrentBinding; bindingSize : ULONG);
PROCEDURE WriteExpansionByte(board : POINTER; offset : ULONG; byte : ULONG);

{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitEXPANSIONLibrary;
{$endif use_init_openlib}

{This is a variable that knows how the unit is compiled}
var
    EXPANSIONIsCompiledHow : longint;

IMPLEMENTATION

uses
{$ifndef dont_use_openlib}
msgbox;
{$endif dont_use_openlib}

FUNCTION AddBootNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode; configDev : pConfigDev) : BOOLEAN;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  bootPri,D0
    MOVE.L  flags,D1
    MOVEA.L deviceNode,A0
    MOVEA.L configDev,A1
    MOVEA.L ExpansionBase,A6
    JSR -036(A6)
    MOVEA.L (A7)+,A6
    TST.W   D0
    BEQ.B   @end
    MOVEQ   #1,D0
  @end: MOVE.B  D0,@RESULT
  END;
END;

PROCEDURE AddConfigDev(configDev : pConfigDev);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L configDev,A0
    MOVEA.L ExpansionBase,A6
    JSR -030(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION AddDosNode(bootPri : LONGINT; flags : ULONG; deviceNode : pDeviceNode) : BOOLEAN;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  bootPri,D0
    MOVE.L  flags,D1
    MOVEA.L deviceNode,A0
    MOVEA.L ExpansionBase,A6
    JSR -150(A6)
    MOVEA.L (A7)+,A6
    TST.W   D0
    BEQ.B   @end
    MOVEQ   #1,D0
  @end: MOVE.B  D0,@RESULT
  END;
END;

PROCEDURE AllocBoardMem(slotSpec : ULONG);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  slotSpec,D0
    MOVEA.L ExpansionBase,A6
    JSR -042(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION AllocConfigDev : pConfigDev;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L ExpansionBase,A6
    JSR -048(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION AllocExpansionMem(numSlots : ULONG; slotAlign : ULONG) : POINTER;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  numSlots,D0
    MOVE.L  slotAlign,D1
    MOVEA.L ExpansionBase,A6
    JSR -054(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE ConfigBoard(board : POINTER; configDev : pConfigDev);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L board,A0
    MOVEA.L configDev,A1
    MOVEA.L ExpansionBase,A6
    JSR -060(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE ConfigChain(baseAddr : POINTER);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L baseAddr,A0
    MOVEA.L ExpansionBase,A6
    JSR -066(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION FindConfigDev(const oldConfigDev : pConfigDev; manufacturer : LONGINT; product : LONGINT) : pConfigDev;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L oldConfigDev,A0
    MOVE.L  manufacturer,D0
    MOVE.L  product,D1
    MOVEA.L ExpansionBase,A6
    JSR -072(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE FreeBoardMem(startSlot : ULONG; slotSpec : ULONG);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  startSlot,D0
    MOVE.L  slotSpec,D1
    MOVEA.L ExpansionBase,A6
    JSR -078(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE FreeConfigDev(configDev : pConfigDev);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L configDev,A0
    MOVEA.L ExpansionBase,A6
    JSR -084(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE FreeExpansionMem(startSlot : ULONG; numSlots : ULONG);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVE.L  startSlot,D0
    MOVE.L  numSlots,D1
    MOVEA.L ExpansionBase,A6
    JSR -090(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION GetCurrentBinding(const currentBinding : pCurrentBinding; bindingSize : ULONG) : ULONG;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L currentBinding,A0
    MOVE.L  bindingSize,D0
    MOVEA.L ExpansionBase,A6
    JSR -138(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

FUNCTION MakeDosNode(const parmPacket : POINTER) : pDeviceNode;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L parmPacket,A0
    MOVEA.L ExpansionBase,A6
    JSR -144(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE ObtainConfigBinding;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L ExpansionBase,A6
    JSR -120(A6)
    MOVEA.L (A7)+,A6
  END;
END;

FUNCTION ReadExpansionByte(const board : POINTER; offset : ULONG) : BYTE;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L board,A0
    MOVE.L  offset,D0
    MOVEA.L ExpansionBase,A6
    JSR -096(A6)
    MOVEA.L (A7)+,A6
    MOVE.L  D0,@RESULT
  END;
END;

PROCEDURE ReadExpansionRom(const board : POINTER; configDev : pConfigDev);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L board,A0
    MOVEA.L configDev,A1
    MOVEA.L ExpansionBase,A6
    JSR -102(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE ReleaseConfigBinding;
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L ExpansionBase,A6
    JSR -126(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE RemConfigDev(configDev : pConfigDev);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L configDev,A0
    MOVEA.L ExpansionBase,A6
    JSR -108(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE SetCurrentBinding(currentBinding : pCurrentBinding; bindingSize : ULONG);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L currentBinding,A0
    MOVE.L  bindingSize,D0
    MOVEA.L ExpansionBase,A6
    JSR -132(A6)
    MOVEA.L (A7)+,A6
  END;
END;

PROCEDURE WriteExpansionByte(board : POINTER; offset : ULONG; byte : ULONG);
BEGIN
  ASM
    MOVE.L  A6,-(A7)
    MOVEA.L board,A0
    MOVE.L  offset,D0
    MOVE.L  byte,D1
    MOVEA.L ExpansionBase,A6
    JSR -114(A6)
    MOVEA.L (A7)+,A6
  END;
END;

const
    { Change VERSION and LIBVERSION to proper values }

    VERSION : string[2] = '0';
    LIBVERSION : longword = 0;

{$ifdef use_init_openlib}
  {$Info Compiling initopening of expansion.library}
  {$Info don't forget to use InitEXPANSIONLibrary in the beginning of your program}

var
    expansion_exit : Pointer;

procedure CloseexpansionLibrary;
begin
    ExitProc := expansion_exit;
    if ExpansionBase <> nil then begin
        CloseLibrary(ExpansionBase);
        ExpansionBase := nil;
    end;
end;

procedure InitEXPANSIONLibrary;
begin
    ExpansionBase := nil;
    ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
    if ExpansionBase <> nil then begin
        expansion_exit := ExitProc;
        ExitProc := @CloseexpansionLibrary;
    end else begin
        MessageBox('FPC Pascal Error',
        'Can''t open expansion.library version ' + VERSION + #10 +
        'Deallocating resources and closing down',
        'Oops');
        halt(20);
    end;
end;

begin
    EXPANSIONIsCompiledHow := 2;
{$endif use_init_openlib}

{$ifdef use_auto_openlib}
  {$Info Compiling autoopening of expansion.library}

var
    expansion_exit : Pointer;

procedure CloseexpansionLibrary;
begin
    ExitProc := expansion_exit;
    if ExpansionBase <> nil then begin
        CloseLibrary(ExpansionBase);
        ExpansionBase := nil;
    end;
end;

begin
    ExpansionBase := nil;
    ExpansionBase := OpenLibrary(EXPANSIONNAME,LIBVERSION);
    if ExpansionBase <> nil then begin
        expansion_exit := ExitProc;
        ExitProc := @CloseexpansionLibrary;
        EXPANSIONIsCompiledHow := 1;
    end else begin
        MessageBox('FPC Pascal Error',
        'Can''t open expansion.library version ' + VERSION + #10 +
        'Deallocating resources and closing down',
        'Oops');
        halt(20);
    end;

{$endif use_auto_openlib}

{$ifdef dont_use_openlib}
begin
    EXPANSIONIsCompiledHow := 3;
   {$Warning No autoopening of expansion.library compiled}
   {$Warning Make sure you open expansion.library yourself}
{$endif dont_use_openlib}


END. (* UNIT EXPANSION *)