git-svn-id: https://svn.code.sf.net/p/kolmck/code@42 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
@ -1,838 +0,0 @@
|
||||
{ *********************************************************************** }
|
||||
{ }
|
||||
{ Delphi / Kylix Cross-Platform Runtime Library }
|
||||
{ System Initialization Unit }
|
||||
{ }
|
||||
{ Copyright (c) 1997-2005 Borland Software Corporation }
|
||||
{ }
|
||||
{ *********************************************************************** }
|
||||
|
||||
unit SysInit;
|
||||
|
||||
interface
|
||||
|
||||
{$H+,I-,R-,S-,O+,W-}
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
{$WARN UNSAFE_TYPE OFF}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
const
|
||||
ExeBaseAddress = Pointer($8048000) platform;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
ModuleIsLib: Boolean; { True if this module is a dll (a library or a package) }
|
||||
ModuleIsPackage: Boolean; { True if this module is a package }
|
||||
ModuleIsCpp: Boolean; { True if this module is compiled using C++ Builder }
|
||||
TlsIndex: Integer = -1; { Thread local storage index }
|
||||
TlsLast: Byte; { Set by linker so its offset is last in TLS segment }
|
||||
HInstance: LongWord; { Handle of this instance }
|
||||
{$EXTERNALSYM HInstance}
|
||||
(*$HPPEMIT 'namespace Sysinit' *)
|
||||
(*$HPPEMIT '{' *)
|
||||
(*$HPPEMIT 'extern PACKAGE HINSTANCE HInstance;' *)
|
||||
(*$HPPEMIT '} /* namespace Sysinit */' *)
|
||||
DllProc: TDLLProc; { Called whenever DLL entry point is called }
|
||||
{ DllProcEx passes the Reserved param provided by WinNT on DLL load & exit }
|
||||
DllProcEx: TDLLProcEx absolute DllProc;
|
||||
DataMark: Integer = 0; { Used to find the virtual base of DATA seg }
|
||||
CoverageLibraryName: array [0..128] of Char = '*'; { initialized by the linker! }
|
||||
{$IFDEF ELF}
|
||||
TypeImportsTable: array [0..0] of Pointer platform; { VMT and RTTI imports table for exes }
|
||||
_GLOBAL_OFFSET_TABLE_: ARRAY [0..2] OF Cardinal platform;
|
||||
(* _DYNAMIC: ARRAY [0..0] OF Elf32_Dyn; *)
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
TextStartAdj: Byte platform; { See GetTextStart }
|
||||
CodeSegSize: Byte platform; { See GetTextStart }
|
||||
function GetTextStart : LongInt; platform;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
PtrToNil: Pointer = nil; // provides pointer to nil for compiler codegen
|
||||
|
||||
function _GetTls: Pointer;
|
||||
{$IFDEF LINUX}
|
||||
procedure _InitLib(Context: PInitContext);
|
||||
procedure _GetCallerEIP;
|
||||
procedure _InitExe(InitTable: Pointer; Argc: Integer; Argp: Pointer);
|
||||
procedure _start; cdecl;
|
||||
function _ExitLib: Integer; cdecl;
|
||||
function _InitPkg: LongBool;
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
procedure _InitLib;
|
||||
procedure _InitExe(InitTable: Pointer);
|
||||
function _InitPkg(Hinst: Integer; Reason: Integer; Resvd: Pointer): LongBool; stdcall;
|
||||
{$ENDIF}
|
||||
procedure _PackageLoad(const Table: PackageInfo);
|
||||
procedure _PackageUnload(const Table: PackageInfo);
|
||||
|
||||
{ Invoked by C++ startup code to allow initialization of VCL global vars }
|
||||
procedure VclInit(isDLL, isPkg: Boolean; hInst: LongInt; isGui: Boolean); cdecl;
|
||||
procedure VclExit; cdecl;
|
||||
|
||||
{$IFDEF LINUX}
|
||||
function GetThisModuleHandle: LongWord;
|
||||
{$ENDIF}
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
const
|
||||
kernel = 'kernel32.dll';
|
||||
|
||||
function FreeLibrary(ModuleHandle: Longint): LongBool; stdcall;
|
||||
external kernel name 'FreeLibrary';
|
||||
|
||||
function GetModuleFileName(Module: Integer; Filename: PChar; Size: Integer): Integer; stdcall;
|
||||
external kernel name 'GetModuleFileNameA';
|
||||
|
||||
function GetModuleHandle(ModuleName: PChar): Integer; stdcall;
|
||||
external kernel name 'GetModuleHandleA';
|
||||
|
||||
//function LocalAlloc(flags, size: Integer): Pointer; stdcall;
|
||||
// external kernel name 'LocalAlloc';
|
||||
|
||||
//function LocalFree(addr: Pointer): Pointer; stdcall;
|
||||
// external kernel name 'LocalFree';
|
||||
|
||||
function TlsAlloc: Integer; stdcall;
|
||||
external kernel name 'TlsAlloc';
|
||||
|
||||
function TlsFree(TlsIndex: Integer): Boolean; stdcall;
|
||||
external kernel name 'TlsFree';
|
||||
|
||||
function TlsGetValue(TlsIndex: Integer): Pointer; stdcall;
|
||||
external kernel name 'TlsGetValue';
|
||||
|
||||
function TlsSetValue(TlsIndex: Integer; TlsValue: Pointer): Boolean; stdcall;
|
||||
external kernel name 'TlsSetValue';
|
||||
|
||||
function GetCommandLine: PChar; stdcall;
|
||||
external kernel name 'GetCommandLineA';
|
||||
|
||||
const
|
||||
tlsArray = $2C; { offset of tls array from FS: }
|
||||
LMEM_ZEROINIT = $40;
|
||||
|
||||
function AllocTlsBuffer(Size: Integer): Pointer;
|
||||
begin
|
||||
//Result := LocalAlloc(LMEM_ZEROINIT, Size);
|
||||
GetMem(Result, Size);
|
||||
end;
|
||||
|
||||
var
|
||||
tlsBuffer: Pointer; // RTM32 DOS support
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
|
||||
{$IFDEF PIC}
|
||||
function GetGOT: Pointer; export;
|
||||
begin
|
||||
asm
|
||||
MOV Result,EBX
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
RTLD_LAZY = 1;
|
||||
RTLD_NOW = 2;
|
||||
RTLD_BINDING_MASK = RTLD_LAZY or RTLD_NOW;
|
||||
RTLD_GLOBAL = $100;
|
||||
RTLD_LOCAL = 0;
|
||||
RTLD_NEXT = Pointer(-1);
|
||||
RTLD_DEFAULT = nil;
|
||||
|
||||
type
|
||||
TDLInfo = record
|
||||
Filename: PChar;
|
||||
BaseAddress: Pointer;
|
||||
NearestSymbolName: PChar;
|
||||
NearestSymbolAddr: Pointer;
|
||||
end;
|
||||
|
||||
const
|
||||
libcmodulename = 'libc.so.6';
|
||||
libdlmodulename = 'libdl.so.2';
|
||||
libpthreadmodulename = 'libpthread.so.0';
|
||||
tlsSizeName = '@Sysinit@tlsSize';
|
||||
|
||||
function malloc(Size: LongWord): Pointer; cdecl;
|
||||
external libcmodulename name 'malloc';
|
||||
|
||||
procedure free(P: Pointer); cdecl;
|
||||
external libcmodulename name 'free';
|
||||
|
||||
function dlopen(Filename: PChar; Flag: Integer): LongWord; cdecl;
|
||||
external libdlmodulename name 'dlopen';
|
||||
|
||||
function dlerror: PChar; cdecl;
|
||||
external libdlmodulename name 'dlerror';
|
||||
|
||||
function dlsym(Handle: LongWord; Symbol: PChar): Pointer; cdecl;
|
||||
external libdlmodulename name 'dlsym';
|
||||
|
||||
function dlclose(Handle: LongWord): Integer; cdecl;
|
||||
external libdlmodulename name 'dlclose';
|
||||
|
||||
function FreeLibrary(Handle: LongWord): Integer; cdecl;
|
||||
external libdlmodulename name 'dlclose';
|
||||
|
||||
function dladdr(Address: Pointer; var Info: TDLInfo): Integer; cdecl;
|
||||
external libdlmodulename name 'dladdr';
|
||||
|
||||
type
|
||||
TInitOnceProc = procedure; cdecl;
|
||||
TKeyValueDestructor = procedure(ValueInKey: Pointer); cdecl;
|
||||
|
||||
function pthread_once(var InitOnceSemaphore: Integer; InitOnceProc: TInitOnceProc): Integer; cdecl;
|
||||
external libpthreadmodulename name 'pthread_once';
|
||||
|
||||
function pthread_key_create(var Key: Integer; KeyValueDestructor: TKeyValueDestructor): Integer; cdecl;
|
||||
external libpthreadmodulename name 'pthread_key_create';
|
||||
|
||||
function pthread_key_delete(Key: Integer): Integer; cdecl;
|
||||
external libpthreadmodulename name 'pthread_key_delete';
|
||||
|
||||
function TlsGetValue(Key: Integer): Pointer; cdecl;
|
||||
external libpthreadmodulename name 'pthread_getspecific';
|
||||
|
||||
function TlsSetValue(Key: Integer; Ptr: Pointer): Integer; cdecl;
|
||||
external libpthreadmodulename name 'pthread_setspecific';
|
||||
|
||||
function AllocTlsBuffer(Size: Cardinal): Pointer;
|
||||
begin
|
||||
// The C++ rtl handles all tls in a C++ module
|
||||
if ModuleIsCpp then
|
||||
RunError(226);
|
||||
|
||||
Result := malloc(Size);
|
||||
if Result <> nil then
|
||||
FillChar(Result^, Size, 0);
|
||||
end;
|
||||
|
||||
procedure FreeTLSBuffer(ValueInKey: Pointer); export cdecl;
|
||||
begin
|
||||
// The C++ rtl handles all tls in a C++ module
|
||||
if ModuleIsCpp then
|
||||
RunError(226);
|
||||
free(ValueInKey);
|
||||
end;
|
||||
|
||||
procedure AllocTlsIndex; cdecl export;
|
||||
begin
|
||||
// guaranteed to reach here only once per process
|
||||
// The C++ rtl handles all tls in a C++ module
|
||||
if ModuleIsCpp then
|
||||
RunError(226);
|
||||
if pthread_key_create(TlsIndex, FreeTLSBuffer) <> 0 then
|
||||
begin
|
||||
TlsIndex := -1;
|
||||
RunError(226);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetThisModuleHandle: LongWord;
|
||||
var
|
||||
Info: TDLInfo;
|
||||
begin
|
||||
if (dladdr(@GetThisModuleHandle, Info) = 0) or (Info.BaseAddress = ExeBaseAddress) then
|
||||
Info.FileName := nil; // if we're not in a library, we must be main exe
|
||||
Result := LongWord(dlopen(Info.Filename, RTLD_LAZY));
|
||||
if Result <> 0 then
|
||||
dlclose(Result);
|
||||
end;
|
||||
|
||||
var
|
||||
InitOnceSemaphore: Integer;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
Module: TLibModule = (
|
||||
Next: nil;
|
||||
Instance: 0;
|
||||
CodeInstance: 0;
|
||||
DataInstance: 0;
|
||||
ResInstance: 0;
|
||||
Reserved: 0
|
||||
{$IFDEF LINUX}
|
||||
; InstanceVar: nil;
|
||||
GOT: 0;
|
||||
CodeSegStart: 0;
|
||||
CodeSegEnd: 0
|
||||
);
|
||||
{$ELSE}
|
||||
);
|
||||
{$ENDIF}
|
||||
|
||||
function GetTlsSize: Integer;
|
||||
{$IFDEF LINUX}
|
||||
asm
|
||||
MOV EAX, offset TlsLast
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
begin
|
||||
Result := Integer(@TlsLast);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure InitThreadTLS;
|
||||
var
|
||||
p: Pointer;
|
||||
tlsSize: Integer;
|
||||
begin
|
||||
tlsSize := GetTlsSize;
|
||||
if tlsSize = 0 then Exit;
|
||||
{$IFDEF LINUX}
|
||||
pthread_once(InitOnceSemaphore, AllocTlsIndex);
|
||||
{$ENDIF}
|
||||
if TlsIndex = -1 then RunError(226);
|
||||
p := AllocTlsBuffer(tlsSize);
|
||||
if p = nil then
|
||||
RunError(226)
|
||||
else
|
||||
TlsSetValue(TlsIndex, p);
|
||||
end;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
procedure InitProcessTLS;
|
||||
begin
|
||||
if @TlsLast = nil then
|
||||
Exit;
|
||||
TlsIndex := TlsAlloc;
|
||||
InitThreadTLS;
|
||||
tlsBuffer := TlsGetValue(TlsIndex); // RTM32 DOS support
|
||||
end;
|
||||
|
||||
procedure ExitThreadTLS;
|
||||
var
|
||||
p: Pointer;
|
||||
begin
|
||||
if @TlsLast = nil then
|
||||
Exit;
|
||||
if TlsIndex <> -1 then begin
|
||||
p := TlsGetValue(TlsIndex);
|
||||
if p <> nil then begin
|
||||
//LocalFree(p);
|
||||
FreeMem(p);
|
||||
TlsSetValue(TlsIndex, nil);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ExitProcessTLS;
|
||||
begin
|
||||
if @TlsLast = nil then
|
||||
Exit;
|
||||
ExitThreadTLS;
|
||||
if TlsIndex <> -1 then
|
||||
TlsFree(TlsIndex);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
DLL_PROCESS_ATTACH = 1;
|
||||
DLL_THREAD_ATTACH = 2;
|
||||
DLL_THREAD_DETACH = 3;
|
||||
|
||||
function _GetTls: Pointer;
|
||||
{$IFDEF LINUX}
|
||||
begin
|
||||
Result := TlsGetValue(TlsIndex);
|
||||
if Result = nil then
|
||||
begin
|
||||
InitThreadTLS;
|
||||
Result := TlsGetValue(TlsIndex);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
asm
|
||||
MOV CL,ModuleIsLib
|
||||
MOV EAX,TlsIndex
|
||||
TEST CL,CL
|
||||
JNE @@isDll
|
||||
MOV EDX,FS:tlsArray
|
||||
MOV EAX,[EDX+EAX*4]
|
||||
RET
|
||||
|
||||
@@initTls:
|
||||
CALL InitThreadTLS
|
||||
MOV EAX,TlsIndex
|
||||
PUSH EAX
|
||||
CALL TlsGetValue
|
||||
TEST EAX,EAX
|
||||
JE @@RTM32
|
||||
RET
|
||||
|
||||
@@RTM32:
|
||||
MOV EAX, tlsBuffer
|
||||
RET
|
||||
|
||||
@@isDll:
|
||||
PUSH EAX
|
||||
CALL TlsGetValue
|
||||
TEST EAX,EAX
|
||||
JE @@initTls
|
||||
end;
|
||||
|
||||
const
|
||||
TlsProc: array [DLL_PROCESS_DETACH..DLL_THREAD_DETACH] of procedure =
|
||||
(ExitProcessTLS,InitProcessTLS,InitThreadTLS,ExitThreadTLS);
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
const
|
||||
UNWINDFI_TOPOFSTACK = $BE00EF00;
|
||||
|
||||
{
|
||||
The linker sets the value of TextStartAdj to be the delta between GetTextStart
|
||||
and the start of the text segment. This allows us to get the pointer to the
|
||||
start of the text segment in a position independent fashion.
|
||||
}
|
||||
function GetTextStart : LongInt;
|
||||
asm
|
||||
CALL @@label1
|
||||
@@label1:
|
||||
POP EAX
|
||||
SUB EAX, 5 + offset TextStartAdj
|
||||
end;
|
||||
|
||||
{
|
||||
The linker sets the value of CodeSegSize to the length of the text segment,
|
||||
excluding the PC map. This allows us to get the pointer to the exception
|
||||
information that we need at runtime, also in a position independent fashion.
|
||||
}
|
||||
function GetTextEnd : LongInt;
|
||||
asm
|
||||
CALL GetTextStart
|
||||
ADD EAX, offset CodeSegSize
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure InitializeModule;
|
||||
begin
|
||||
RegisterModule(@Module);
|
||||
end;
|
||||
|
||||
procedure UninitializeModule;
|
||||
begin
|
||||
UnregisterModule(@Module);
|
||||
if (Module.ResInstance <> Module.Instance) and (Module.ResInstance <> 0) then
|
||||
FreeLibrary(Module.ResInstance);
|
||||
end;
|
||||
|
||||
procedure VclInit(isDLL, isPkg: Boolean; hInst: LongInt; isGui: Boolean); cdecl;
|
||||
begin
|
||||
ModuleIsLib := isDLL;
|
||||
ModuleIsPackage := isPkg;
|
||||
IsLibrary := isDLL and not isPkg;
|
||||
HInstance := hInst;
|
||||
Module.Instance := hInst;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
ModuleIsCpp := True;
|
||||
{$IFDEF LINUX}
|
||||
if ModuleIsLib then
|
||||
Module.InstanceVar := @HInstance;
|
||||
{$IFDEF PIC}
|
||||
Module.GOT := LongWord(GetGot);
|
||||
{$ENDIF}
|
||||
{ Module.CodeSegStart, Module.CodeSegEnd not used: the C++
|
||||
rtl will feed the unwinder. }
|
||||
{$ENDIF}
|
||||
InitializeModule;
|
||||
if not ModuleIsLib then
|
||||
begin
|
||||
Module.CodeInstance := FindHInstance(@VclInit);
|
||||
Module.DataInstance := FindHInstance(@DataMark);
|
||||
{$IFDEF MSWINDOWS}
|
||||
{X CmdLine := GetCommandLine; - converted to a function }
|
||||
IsConsole := not isGui;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure VclExit; cdecl;
|
||||
var
|
||||
P: procedure;
|
||||
begin
|
||||
if not ModuleIsLib then
|
||||
while ExitProc <> nil do
|
||||
begin
|
||||
@P := ExitProc;
|
||||
ExitProc := nil;
|
||||
P;
|
||||
end;
|
||||
UnInitializeModule;
|
||||
end;
|
||||
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
procedure RegisterPCMap;
|
||||
begin
|
||||
SysRegisterIPLookup(GetTextStart,
|
||||
GetTextEnd,
|
||||
Pointer(GetTextEnd),
|
||||
LongWord(@_Global_Offset_Table_));
|
||||
end;
|
||||
|
||||
procedure UnregisterPCMap;
|
||||
begin
|
||||
SysUnregisterIPLookup(GetTextStart);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
function _InitPkg(Hinst: Longint; Reason: Integer; Resvd: Pointer): Longbool; stdcall;
|
||||
begin
|
||||
ModuleIsLib := True;
|
||||
ModuleIsPackage := True;
|
||||
Module.Instance := Hinst;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
HInstance := Hinst;
|
||||
if @TlsLast <> nil then
|
||||
TlsProc[Reason];
|
||||
if Reason = DLL_PROCESS_ATTACH then
|
||||
InitializeModule
|
||||
else if Reason = DLL_PROCESS_DETACH then
|
||||
UninitializeModule;
|
||||
_InitPkg := True;
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
function _InitPkg: LongBool;
|
||||
begin
|
||||
{$IFDEF DEBUG_STARTUP}
|
||||
asm
|
||||
INT 3
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
RegisterPCMap;
|
||||
{$ENDIF}
|
||||
TlsIndex := -1;
|
||||
ModuleIsLib := True;
|
||||
ModuleIsPackage := True;
|
||||
Module.Instance := GetThisModuleHandle;
|
||||
Module.InstanceVar := @HInstance;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
Module.GOT := LongWord(@_Global_Offset_Table_);
|
||||
Module.CodeSegStart := GetTextStart;
|
||||
Module.CodeSegEnd := GetTextEnd;
|
||||
HInstance := Module.Instance;
|
||||
InitializeModule;
|
||||
_InitPkg := True;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure _PackageLoad(const Table: PackageInfo);
|
||||
begin
|
||||
System._PackageLoad(Table, @Module);
|
||||
end;
|
||||
|
||||
procedure _PackageUnload(const Table: PackageInfo);
|
||||
begin
|
||||
System._PackageUnload(Table, @Module);
|
||||
end;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
procedure _InitLib;
|
||||
asm
|
||||
{ -> EAX Inittable }
|
||||
{ [EBP+8] Hinst }
|
||||
{ [EBP+12] Reason }
|
||||
{ [EBP+16] Resvd }
|
||||
|
||||
MOV EDX,offset Module
|
||||
CMP dword ptr [EBP+12],DLL_PROCESS_ATTACH
|
||||
JNE @@notInit
|
||||
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
MOV ModuleIsLib,1
|
||||
MOV ECX,[EBP+8]
|
||||
MOV HInstance,ECX
|
||||
MOV [EDX].TLibModule.Instance,ECX
|
||||
MOV [EDX].TLibModule.CodeInstance,0
|
||||
MOV [EDX].TLibModule.DataInstance,0
|
||||
CALL InitializeModule
|
||||
POP EDX
|
||||
POP EAX
|
||||
|
||||
@@notInit:
|
||||
PUSH DllProc
|
||||
MOV ECX,offset TlsProc
|
||||
CALL _StartLib
|
||||
end;
|
||||
|
||||
// ExitLib is the same as InitLib in Windows.
|
||||
|
||||
{$ENDIF MSWINDOWS}
|
||||
{$IFDEF LINUX}
|
||||
procedure _InitLib(Context: PInitContext);
|
||||
begin
|
||||
{$IFDEF DEBUG_STARTUP}
|
||||
asm
|
||||
INT 3
|
||||
end;
|
||||
{$ENDIF}
|
||||
asm
|
||||
PUSH UNWINDFI_TOPOFSTACK
|
||||
end;
|
||||
Context.DLLInitState := DLL_PROCESS_ATTACH;
|
||||
TlsIndex := -1;
|
||||
ModuleIsLib := True;
|
||||
HInstance := GetThisModuleHandle;
|
||||
Module.Instance := HInstance;
|
||||
Module.InstanceVar := @HInstance;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
Module.GOT := LongWord(@_Global_Offset_Table_);
|
||||
Module.CodeSegStart := GetTextStart;
|
||||
Module.CodeSegEnd := GetTextEnd;
|
||||
InitializeModule;
|
||||
RegisterPCMap;
|
||||
_StartLib(Context, @Module, DLLProcEx);
|
||||
asm
|
||||
ADD ESP, 4
|
||||
end;
|
||||
end;
|
||||
|
||||
// InnerExitLib provides GOT fixup and global var addressing
|
||||
function InnerExitLib(Context: PInitContext): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
if ModuleIsPackage then
|
||||
begin
|
||||
UninitializeModule;
|
||||
UnregisterPCMap;
|
||||
end
|
||||
else
|
||||
_StartLib(Context, @Module, DLLProcEx);
|
||||
end;
|
||||
|
||||
function _ExitLib: Integer; cdecl;
|
||||
asm
|
||||
{$IFDEF DEBUG_STARTUP}
|
||||
INT 3
|
||||
{$ENDIF}
|
||||
PUSH EBP
|
||||
MOV EBP,ESP
|
||||
PUSH UNWINDFI_TOPOFSTACK
|
||||
XOR EAX,EAX
|
||||
PUSH DLL_PROCESS_DETACH // InitContext.DLLInitState
|
||||
PUSH EDI
|
||||
PUSH ESI
|
||||
PUSH EBX
|
||||
PUSH EBP
|
||||
PUSH EAX // InitContext.Module
|
||||
PUSH EAX // InitContext.InitCount
|
||||
PUSH EAX // InitContext.InitTable (filled in later)
|
||||
PUSH EAX // InitContext.OuterContext
|
||||
MOV EAX,ESP
|
||||
CALL InnerExitLib;
|
||||
ADD ESP, 16
|
||||
POP EBP
|
||||
POP EBX
|
||||
POP ESI
|
||||
POP EDI
|
||||
MOV ESP,EBP
|
||||
POP EBP
|
||||
end;
|
||||
|
||||
procedure _GetCallerEIP;
|
||||
asm
|
||||
MOV EBX, [ESP]
|
||||
end;
|
||||
{$ENDIF LINUX}
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
procedure _InitExe(InitTable: Pointer);
|
||||
begin
|
||||
TlsIndex := 0;
|
||||
HInstance := GetModuleHandle(nil);
|
||||
Module.Instance := HInstance;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
InitializeModule;
|
||||
_StartExe(InitTable, @Module);
|
||||
end;
|
||||
{$ENDIF MSWINDOWS}
|
||||
{$IFDEF LINUX}
|
||||
procedure InitVmtImports;
|
||||
var
|
||||
P: ^Integer;
|
||||
begin
|
||||
P := @TypeImportsTable;
|
||||
if P = nil then Exit;
|
||||
while P^ <> 0 do
|
||||
begin
|
||||
P^ := Integer(dlsym(0, PChar(P^)));
|
||||
Inc(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure _InitExe(InitTable: Pointer; Argc: Integer; Argp: Pointer); export;
|
||||
begin
|
||||
{$IFDEF DEBUG_STARTUP}
|
||||
asm
|
||||
INT 3
|
||||
end;
|
||||
{$ENDIF}
|
||||
HInstance := GetThisModuleHandle;
|
||||
Module.Instance := HInstance;
|
||||
Module.InstanceVar := @HInstance;
|
||||
Module.CodeInstance := 0;
|
||||
Module.DataInstance := 0;
|
||||
InitializeModule;
|
||||
InitThreadTLS;
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
RegisterPCMap();
|
||||
{$ENDIF}
|
||||
InitVmtImports;
|
||||
_StartExe(InitTable, @Module, Argc, Argp);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{$IFDEF LINUX}
|
||||
var
|
||||
InitAddr: Pointer;
|
||||
|
||||
function _main(argc: Integer; argv: Pointer; envp: Pointer): Integer; export cdecl;
|
||||
type
|
||||
TInitFunction = function (argc: Integer; argv, envp: Pointer): Integer; cdecl;
|
||||
TExternalInit = function (argc: Integer; argv, envp: Pointer; InitExe: TInitFunction): Integer; cdecl;
|
||||
var
|
||||
ExternalInit: TExternalInit;
|
||||
InitFunc: TInitFunction;
|
||||
begin
|
||||
@ExternalInit := dlsym(GetThisModuleHandle, 'ExternalInit');
|
||||
@InitFunc := InitAddr;
|
||||
System.envp := envp;
|
||||
if @ExternalInit <> nil then
|
||||
ExternalInit(argc, argv, envp, InitFunc);
|
||||
Result := InitFunc(argc, argv, envp);
|
||||
end;
|
||||
|
||||
function __libc_start_main (Main: Pointer; Argc: Integer; Argv: Pointer;
|
||||
Init, Fini, rtld_Fini: Pointer; StackEnd: Pointer)
|
||||
: Integer;
|
||||
cdecl;
|
||||
external libcmodulename name '__libc_start_main';
|
||||
|
||||
{ Program entry point }
|
||||
procedure _start;
|
||||
asm
|
||||
{$IFDEF DEBUG_STARTUP}
|
||||
INT 3
|
||||
{$ENDIF}
|
||||
{ Mark outermost frame, suggested by ELF i386 ABI. }
|
||||
xor ebp,ebp
|
||||
|
||||
{ Get data passed on stack }
|
||||
pop eax { argc }
|
||||
mov ecx,esp { argv }
|
||||
|
||||
{ Align stack }
|
||||
and esp,0fffffff8h
|
||||
{$IFDEF PC_MAPPED_EXCEPTIONS}
|
||||
{ Mark the top of the stack with a signature }
|
||||
push UNWINDFI_TOPOFSTACK
|
||||
{$ENDIF}
|
||||
push ebp { padding }
|
||||
push esp { crt1.o does this, don't know why }
|
||||
push edx { function to be registered with
|
||||
atexit(), passed by loader }
|
||||
push offset @@ret { _fini dummy }
|
||||
push offset @@ret { _init dummy }
|
||||
push ecx { argv }
|
||||
push eax { argc }
|
||||
{ We need a symbol for the Pascal entry point (main unit's
|
||||
body). An external symbol `main' fixed up by the linker
|
||||
would be fine. Alas, external declarations can't do that;
|
||||
they must be resolved either in the same file with a $L
|
||||
directive, or in a shared object. Hack: use a bogus,
|
||||
distinctive symbol to mark the fixup, find and patch it
|
||||
in the linker. }
|
||||
{$IFDEF PIC}
|
||||
call GetGOT
|
||||
mov ebx, eax
|
||||
add [esp+12],ebx
|
||||
add [esp+8],ebx
|
||||
// Linker will replace _GLOBAL_OFFSET_TABLE_ address with main program block
|
||||
mov eax, offset _GLOBAL_OFFSET_TABLE_
|
||||
add eax, ebx
|
||||
mov [ebx].InitAddr, eax
|
||||
mov eax, offset _main
|
||||
add eax, ebx
|
||||
push eax
|
||||
{$ELSE}
|
||||
// Linker will replace _GLOBAL_OFFSET_TABLE_ address with main program block
|
||||
push offset _GLOBAL_OFFSET_TABLE_
|
||||
pop InitAddr
|
||||
push offset _main
|
||||
{$ENDIF}
|
||||
call __libc_start_main
|
||||
hlt { they never come back }
|
||||
|
||||
@@ret:
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
{ Procedure body not generated on Windows currently }
|
||||
procedure OpenEdition;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure GPLInfected;
|
||||
begin
|
||||
end;
|
||||
|
||||
{$IFDEF TRIAL_EDITION}
|
||||
procedure Evaluation;
|
||||
begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure Copyright;
|
||||
begin
|
||||
end;
|
||||
|
||||
const
|
||||
sOpenEdition = 'This application was built with Borland Kylix Open Edition(tm).'; // do not localize
|
||||
sGPLMessage = 'This module must be distributed under the terms of the GNU General ' // do not localize
|
||||
+ 'Public License (GPL), version 2. A copy of this license can be found at:' // do not localize
|
||||
+ 'http://www.borland.com/kylix/gpl.html.'; // do not localize
|
||||
|
||||
exports
|
||||
{$IF Declared(GPL)}
|
||||
OpenEdition name sOpenEdition,
|
||||
GPLInfected name sGPLMessage,
|
||||
{$IFEND}
|
||||
{$IFDEF TRIAL_EDITION}
|
||||
Evaluation name 'This module was compiled with an evaluation version of Borland Delphi', // do not localize
|
||||
{$ENDIF}
|
||||
|
||||
Copyright name 'Portions Copyright (c) 1983,2002 Borland Software Corporation'; // do not localize
|
||||
|
||||
|
||||
{$IF Declared(GPL)}
|
||||
initialization
|
||||
if IsConsole and not ModuleIsLib then
|
||||
begin
|
||||
TTextRec(Output).Mode := fmClosed;
|
||||
writeln(sGPLMessage);
|
||||
end;
|
||||
{$IFEND}
|
||||
{$ENDIF}
|
||||
end.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user