{
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.
nils.sjoholm@mailbox.swipnet.se 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 *)
syntax highlighted by Code2HTML, v. 0.9.1