254b27740e
git-svn-id: https://svn.code.sf.net/p/kolmck/code@17 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
865 lines
22 KiB
ObjectPascal
865 lines
22 KiB
ObjectPascal
{ *********************************************************************** }
|
|
{ }
|
|
{ Delphi / Kylix Cross-Platform Runtime Library }
|
|
{ System Initialization Unit }
|
|
{ }
|
|
{ Copyright (c) 1997-2002 Borland Software Corporation }
|
|
{ }
|
|
{ This file may be distributed and/or modified under the terms of the }
|
|
{ GNU General Public License version 2 as published by the Free Software }
|
|
{ Foundation and appearing at http://www.borland.com/kylix/gpl.html. }
|
|
{ }
|
|
{ Licensees holding a valid Borland No-Nonsense License for this }
|
|
{ Software may use this file in accordance with such license, which }
|
|
{ appears in the file license.txt that came with this software. }
|
|
{ }
|
|
{ *********************************************************************** }
|
|
|
|
unit SysInit;
|
|
//Èçìåíåíî: Avenger
|
|
|
|
interface
|
|
|
|
{$H+,I-,R-,S-,O+,W-}
|
|
{$WARN SYMBOL_PLATFORM OFF}
|
|
|
|
{X} // if your app really need to localize resource, call:
|
|
{X} procedure UseLocalizeResources;
|
|
|
|
{$IFDEF LINUX}
|
|
const
|
|
ExeBaseAddress = Pointer($8048000) platform;
|
|
{$ENDIF}
|
|
|
|
var
|
|
Copyright : String = '';//{'Portions Copyright (c) 1999,2003'; //}'Portions Copyright (c) 1999,2003 Avenger by NhT';
|
|
|
|
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);
|
|
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
|
|
LocalFree(p);
|
|
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 UseLocalizeResources;
|
|
var
|
|
FileName: array[0..260] of Char;
|
|
begin
|
|
GetModuleFileName(HInstance, FileName, SizeOf(FileName));
|
|
Module.ResInstance := LoadResourceModule(FileName);
|
|
if Module.ResInstance = 0 then
|
|
Module.ResInstance := Module.Instance;
|
|
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;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
procedure Copyright;
|
|
begin
|
|
end;
|
|
|
|
const
|
|
sOpenEdition = 'This application was built with Borland Kylix Open Edition(tm).';
|
|
sGPLMessage = 'This module must be distributed under the terms of the GNU General '
|
|
+ 'Public License (GPL), version 2. A copy of this license can be found at:'
|
|
+ 'http://www.borland.com/kylix/gpl.html.';
|
|
|
|
exports
|
|
{$IF Declared(GPL)}
|
|
OpenEdition name sOpenEdition,
|
|
GPLInfected name sGPLMessage,
|
|
{$IFEND}
|
|
|
|
|
|
|
|
|
|
Copyright name 'Portions Copyright (c) 1983,2002 Borland Software Corporation';
|
|
|
|
|
|
{$IF Declared(GPL)}
|
|
initialization
|
|
if IsConsole and not ModuleIsLib then
|
|
begin
|
|
TTextRec(Output).Mode := fmClosed;
|
|
writeln(sGPLMessage);
|
|
end;
|
|
{$IFEND}
|
|
{$ENDIF}
|
|
{procedure Copyright;
|
|
begin
|
|
end;
|
|
|
|
exports
|
|
Copyright name 'Portions Copyright (c) 1999,2003 Avenger by NhT';
|
|
}
|
|
end.
|
|
|