paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-09 21:27:20 +01:00
Code Issues Packages Projects Releases Wiki Activity

* unmerged table based initialization of libraries.

Browse Source 
git-svn-id: trunk@16941 -
This commit is contained in:
marco 2011-02-19 17:24:37 +00:00
parent 27b6b908f1
commit 88e22be01a
11 changed files with 1604 additions and 1805 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1003
packages/ibase/src/ibase60.inc
View File

File diff suppressed because it is too large Load Diff

2
packages/ibase/src/ibase60.pp
View File

@ -2,7 +2,7 @@
}
unit ibase60;
{$UNDEF LOAD_DYNAMICALLY}
{$UNDEF LinkDynamically}
{$i ibase60.inc}

2
packages/ibase/src/ibase60dyn.pp
View File

@ -11,7 +11,7 @@
unit ibase60dyn;
{$DEFINE LOAD_DYNAMICALLY}
{$DEFINE LinkDynamically}
{$i ibase60.inc}

819
packages/mysql/src/mysql.inc
View File

File diff suppressed because it is too large Load Diff

2
packages/mysql/src/mysql40dyn.pp
View File

@ -4,7 +4,7 @@
unit mysql40dyn;
{$DEFINE LOAD_DYNAMICALLY}
{$DEFINE LinkDynamically}
{$UNDEF MYSQL41}
{$i mysql.inc}

2
packages/mysql/src/mysql41dyn.pp
View File

@ -4,7 +4,7 @@
unit mysql41dyn;
{$DEFINE LOAD_DYNAMICALLY}
{$DEFINE LinkDynamically}
{$DEFINE MYSQL41}
{$i mysql.inc}

2
packages/mysql/src/mysql4_comtypes.inc
View File

@ -8,7 +8,7 @@ type
My_socket = longint;
my_bool = byte;
gptr = Pointer;
pppchar = ^ppchar;
{
Common definition between mysql server & client
}

2
packages/mysql/src/mysql50dyn.pp
View File

@ -4,7 +4,7 @@
unit mysql50dyn;
{$DEFINE LOAD_DYNAMICALLY}
{$DEFINE LinkDynamically}
{$DEFINE MYSQL50}
{$i mysql.inc}

1198
packages/sqlite/src/sqlite3.inc
View File

File diff suppressed because it is too large Load Diff

68
packages/zorba/src/zorba.inc
View File

@ -21,7 +21,7 @@
interface
uses
ctypes, dynlibs, xqc;
Sysutils,ctypes, dynlibs, xqc;
{$IFDEF UNIX}
{$DEFINE extdecl:=cdecl}
@ -74,40 +74,70 @@ function TryInitializeZorba(const LibraryName: string = ''): Integer;
function ReleaseZorba: Integer;
var
ZorbaLibrary: TLibHandler;
ZorbaLibraryHandle: TLibHandle;
{$ENDIF LOAD_DYNAMICALLY}
implementation
{$IFDEF LOAD_DYNAMICALLY}
const
zorba_symbols: array[0..6] of TLibSymbol = (
(pvar:@create_simple_store; name:'create_simple_store'; weak:false),
(pvar:@shutdown_simple_store; name:'shutdown_simple_store'; weak:false),
(pvar:@zorba_implementation; name:'zorba_implementation'; weak:false),
(pvar:@Zorba_CompilerHints_default; name:'Zorba_CompilerHints_default'; weak:false),
(pvar:@Zorba_SerializerOptions_default; name:'Zorba_SerializerOptions_default'; weak:false),
(pvar:@Zorba_SerializerOptions_free; name:'Zorba_SerializerOptions_free'; weak:false),
(pvar:@Zorba_SerializerOptions_set; name:'Zorba_SerializerOptions_set'; weak:false)
);
function TryInitializeZorba(const LibraryName: string): Integer;
ResourceString
SErrDefaultsFailed = 'Can not load default Zorba clients ("%s" or "%s"). Check your installation.';
SErrLoadFailed = 'Can not load Zorba client library "%s". Check your installation.';
SErrAlreadyLoaded = 'Zorba interface already initialized from library %s.';
var
RefCount : integer;
LoadedLibrary : String;
Function TryInitializeZorba(Const LibraryName : String) : integer;
begin
Result := TryInitializeLibrary(ZorbaLibrary, LibraryName);
Result := 0;
if (RefCount=0) then
begin
ZorbaLibraryHandle:=LoadLibrary(LibraryName);
if (ZorbaLibraryHandle=nilhandle) then
Exit;
inc(RefCount);
LoadedLibrary:=LibraryName;
pointer(create_simple_store) :=GetProcedureAddress(ZorbaLibraryHandle,'create_simple_store');
pointer(shutdown_simple_store) :=GetProcedureAddress(ZorbaLibraryHandle,'shutdown_simple_store');
pointer(zorba_implementation) :=GetProcedureAddress(ZorbaLibraryHandle,'zorba_implementation');
pointer(Zorba_CompilerHints_default) :=GetProcedureAddress(ZorbaLibraryHandle,'Zorba_CompilerHints_default');
pointer(Zorba_SerializerOptions_default):=GetProcedureAddress(ZorbaLibraryHandle,'Zorba_SerializerOptions_default');
pointer(Zorba_SerializerOptions_free) :=GetProcedureAddress(ZorbaLibraryHandle,'Zorba_SerializerOptions_free');
pointer(Zorba_SerializerOptions_set) :=GetProcedureAddress(ZorbaLibraryHandle,'Zorba_SerializerOptions_set');
end
else
inc(RefCount);
Result := RefCount;
end;
function InitializeZorba(const LibraryName: String): Integer;
begin
Result := InitializeLibrary(ZorbaLibrary, LibraryName);
Result := TryInitializeZorba( LibraryName);
If Result = 0 then
Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName])
else If (LibraryName<>LoadedLibrary) then
begin
Dec(RefCount);
Result := RefCount;
Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
end;
end;
function ReleaseZorba: Integer;
begin
Result := ReleaseLibrary(ZorbaLibrary);
if RefCount>1 then
Dec(RefCount)
else if UnloadLibrary(ZorbaLibraryHandle) then
begin
Dec(RefCount);
ZorbaLibraryHandle := NilHandle;
LoadedLibrary:='';
end;
end;
initialization
ZorbaLibrary := LibraryHandler('zorba', [zorbalib,zorbavlib], @zorba_symbols, Length(zorba_symbols));
{$ENDIF}
end.

309
rtl/inc/dynlibs.pas
View File

@ -20,9 +20,6 @@ unit dynlibs;
interface
uses
SysUtils, RtlConsts, SysConst;
{ ---------------------------------------------------------------------
Read OS-dependent interface declarations.
---------------------------------------------------------------------}
@ -41,86 +38,13 @@ Function LoadLibrary(const Name : AnsiString) : TLibHandle;
Function GetProcedureAddress(Lib : TlibHandle; const ProcName : AnsiString) : Pointer;
Function UnloadLibrary(Lib : TLibHandle) : Boolean;
// Kylix/Delphi compability
Type
HModule = TLibHandle;
Function FreeLibrary(Lib : TLibHandle) : Boolean;
Function GetProcAddress(Lib : TlibHandle; const ProcName : AnsiString) : Pointer;
// Dynamic Library Manager
{ Note: If you look for some code that uses this library handler, take a look at
sqlite3.inc of sqlite package (simple) or
mysql.inc of mysql package (advanced)
}
type
PLibHandler = ^TLibHandler;
TLibEventLoading = function(User: Pointer; Handler: PLibHandler): Boolean;
TLibEventUnloading = procedure(Handler: PLibHandler);
TLibIdent = QWord;
TLibIdentGetter = function(const Filename: String): TLibIdent;
PPLibSymbol = ^PLibSymbol;
PLibSymbol = ^TLibSymbol;
TLibSymbol = record
pvar: PPointer; { pointer to Symbol variable }
name: String; { name of the Symbol }
weak: Boolean; { weak }
end;
PLibSymbolPtrArray = ^TLibSymbolPtrArray;
TLibSymbolPtrArray = array of PLibSymbol;
TLibHandler = record
InterfaceName: String; { abstract name of the library }
Defaults : array of String; { list of default library filenames }
Filename : String; { filename of the current loaded library }
Handle : TLibHandle; { handle of the current loaded library }
Loading : TLibEventLoading; { loading event, called after the unit is loaded }
Unloading : TLibEventUnloading; { unloading event, called before the unit is unloaded }
IdentGetter : TLibIdentGetter; { identifier getter event }
Ident : TLibIdent; { identifier of the current loaded library }
SymCount : Integer; { number of symbols }
Symbols : PLibSymbol; { symbol address- and namelist }
ErrorMsg : String; { last error message }
RefCount : Integer; { reference counter }
end;
{ handler definition }
function LibraryHandler(const InterfaceName: String; const DefaultLibraries: array of String;
const Symbols: PLibSymbol; const SymCount: Integer; const AfterLoading: TLibEventLoading = nil;
const BeforeUnloading: TLibEventUnloading = nil; const IdentGetter: TLibIdentGetter = nil): TLibHandler;
{ initialization/finalization }
function TryInitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
const User: Pointer = nil; const NoSymbolErrors: Boolean = True): Integer;
function TryInitializeLibrary(var Handler: TLibHandler; const LibraryName: String = '';
const User: Pointer = nil; const NoSymbolErrors: Boolean = True): Integer;
function InitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
const User: Pointer = nil; const NoSymbolErrors: Boolean = True): Integer;
function InitializeLibrary(var Handler: TLibHandler; const LibraryName: String = '';
const User: Pointer = nil; const NoSymbolErrors: Boolean = True): Integer;
function ReleaseLibrary(var Handler: TLibHandler): Integer;
{ errors }
procedure AppendLibraryError(var Handler: TLibHandler; const Msg: String);
function GetLastLibraryError(var Handler: TLibHandler): String;
procedure RaiseLibraryException(var Handler: TLibHandler);
{ symbol load/clear }
function LoadLibrarySymbols(const Lib: TLibHandle; const Symbols: PLibSymbol; const Count: Integer;
const ErrorSymbols: PLibSymbolPtrArray = nil): Boolean;
procedure ClearLibrarySymbols(const Symbols: PLibSymbol; const Count: Integer);
Type
HModule = TLibHandle;
Implementation
@ -148,6 +72,7 @@ Function SafeLoadLibrary(const Name : AnsiString) : TLibHandle;
var w : word;
{$endif}
Begin
{$ifdef i386}
w:=get8087cw;
@ -159,232 +84,4 @@ Begin
{$endif}
End;
function LibraryHandler(const InterfaceName: String; const DefaultLibraries: array of String;
const Symbols: PLibSymbol; const SymCount: Integer; const AfterLoading: TLibEventLoading;
const BeforeUnloading: TLibEventUnloading; const IdentGetter: TLibIdentGetter): TLibHandler;
var
I: Integer;
begin
Result.InterfaceName := InterfaceName;
Result.Filename := '';
Result.Handle := NilHandle;
Result.Loading := AfterLoading;
Result.Unloading := BeforeUnloading;
Result.IdentGetter := IdentGetter;
Result.Ident := 0;
Result.SymCount := SymCount;
Result.Symbols := Symbols;
Result.ErrorMsg := '';
Result.RefCount := 0;
SetLength(Result.Defaults, Length(DefaultLibraries));
for I := 0 to High(DefaultLibraries) do
Result.Defaults[I] := DefaultLibraries[I];
end;
function TryInitializeLibraryInternal(var Handler: TLibHandler; const LibraryName: String;
const User: Pointer; const NoSymbolErrors: Boolean): Integer;
var
ErrSyms: TLibSymbolPtrArray;
NewIdent: TLibIdent;
I: Integer;
begin
if Handler.Filename <> '' then
begin
if Assigned(Handler.IdentGetter) then
begin
NewIdent := Handler.IdentGetter(LibraryName);
if NewIdent <> Handler.Ident then
begin
AppendLibraryError(Handler, Format(SLibraryAlreadyLoaded, [Handler.InterfaceName, Handler.Filename]));
Result := -1;
Exit;
end;
end;
end;
Result := InterlockedIncrement(Handler.RefCount);
if Result = 1 then
begin
Handler.Handle := LoadLibrary(LibraryName);
if Handler.Handle = NilHandle then
begin
AppendLibraryError(Handler, Format(SLibraryNotLoaded, [Handler.InterfaceName, LibraryName]));
Handler.RefCount := 0;
Result := -1;
Exit;
end;
Handler.Filename := LibraryName;
if not LoadLibrarySymbols(Handler.Handle, Handler.Symbols, Handler.SymCount, @ErrSyms) and not NoSymbolErrors then
begin
for I := 0 to Length(ErrSyms) - 1 do
AppendLibraryError(Handler, Format(SLibraryUnknownSym, [ErrSyms[I]^.name, Handler.InterfaceName, LibraryName]));
UnloadLibrary(Handler.Handle);
Handler.Handle := NilHandle;
Handler.Filename := '';
Handler.RefCount := 0;
Result := -1;
Exit;
end;
if Assigned(Handler.Loading) and not Handler.Loading(User, @Handler) then
begin
UnloadLibrary(Handler.Handle);
Handler.Handle := NilHandle;
Handler.Filename := '';
Handler.RefCount := 0;
Result := -1;
Exit;
end;
if Assigned(Handler.IdentGetter) then
Handler.Ident := Handler.IdentGetter(Handler.Filename)
else
Handler.Ident := 0;
end;
end;
function TryInitializeLibrary(var Handler: TLibHandler; const LibraryName: String;
const User: Pointer; const NoSymbolErrors: Boolean): Integer;
begin
if LibraryName <> '' then
begin
Handler.ErrorMsg := '';
Result := TryInitializeLibraryInternal(Handler, LibraryName, User, NoSymbolErrors);
end else
Result := TryInitializeLibrary(Handler, Handler.Defaults, User, NoSymbolErrors);
end;
function TryInitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
const User: Pointer; const NoSymbolErrors: Boolean): Integer;
var
I: Integer;
begin
Handler.ErrorMsg := '';
if Length(LibraryNames) <= 0 then
begin
if Length(Handler.Defaults) > 0 then
begin
Result := TryInitializeLibrary(Handler, Handler.Defaults, User, NoSymbolErrors);
Exit;
end;
AppendLibraryError(Handler, SVarInvalid);
Result := -1;
Exit;
end;
for I := 0 to High(LibraryNames) do
begin
Result := TryInitializeLibraryInternal(Handler, LibraryNames[I], User, NoSymbolErrors);
if Result > 0 then
begin
Handler.ErrorMsg := '';
Exit;
end;
end;
end;
function InitializeLibrary(var Handler: TLibHandler; const LibraryNames: array of String;
const User: Pointer; const NoSymbolErrors: Boolean): Integer;
begin
Result := TryInitializeLibrary(Handler, LibraryNames, User, NoSymbolErrors);
if Result < 0 then
RaiseLibraryException(Handler);
end;
function InitializeLibrary(var Handler: TLibHandler; const LibraryName: String;
const User: Pointer; const NoSymbolErrors: Boolean): Integer;
begin
Result := TryInitializeLibrary(Handler, LibraryName, User, NoSymbolErrors);
if Result < 0 then
RaiseLibraryException(Handler);
end;
function ReleaseLibrary(var Handler: TLibHandler): Integer;
begin
Handler.ErrorMsg := '';
Result := InterlockedDecrement(Handler.RefCount);
if Result = 0 then
begin
if Assigned(Handler.Unloading) then
Handler.Unloading(@Handler);
ClearLibrarySymbols(Handler.Symbols, Handler.SymCount);
UnloadLibrary(Handler.Handle);
Handler.Handle := NilHandle;
Handler.Filename := '';
Handler.Ident := 0;
end else
if Result < 0 then
Handler.RefCount := 0;
end;
procedure AppendLibraryError(var Handler: TLibHandler; const Msg: String);
begin
if Handler.ErrorMsg <> '' then
Handler.ErrorMsg := Handler.ErrorMsg + LineEnding + Msg
else
Handler.ErrorMsg := Msg;
end;
function GetLastLibraryError(var Handler: TLibHandler): String;
begin
Result := Handler.ErrorMsg;
Handler.ErrorMsg := '';
end;
procedure RaiseLibraryException(var Handler: TLibHandler);
var
Msg: String;
begin
Msg := GetLastLibraryError(Handler);
if Msg <> '' then
raise EInOutError.Create(Msg)
else
raise EInOutError.Create(SUnknown);
end;
function LoadLibrarySymbols(const Lib: TLibHandle; const Symbols: PLibSymbol; const Count: Integer;
const ErrorSymbols: PLibSymbolPtrArray): Boolean;
var
P,L: PLibSymbol;
Len: Integer;
begin
P := Symbols;
L := @Symbols[Count];
while P < L do
begin
P^.pvar^ := GetProcedureAddress(Lib, P^.name);
if not Assigned(P^.pvar^) and not P^.weak then
begin
if Assigned(ErrorSymbols) then
begin
Len := Length(ErrorSymbols^);
SetLength(ErrorSymbols^, Len+1);
ErrorSymbols^[Len] := P;
end;
Result := False;
end;
Inc(P);
end;
Result := True;
end;
procedure ClearLibrarySymbols(const Symbols: PLibSymbol; const Count: Integer);
var
P,L: PLibSymbol;
begin
P := Symbols;
L := @Symbols[Count];
while P < L do
begin
P^.pvar^ := nil;
Inc(P);
end;
end;
end.