sysinit.pas

这是不可多得的源代码

  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}
    CmdLine := GetCommandLine;
    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}
end.