From 4a9c8e330b9287c86cd86c50791c8c9d35500e2d Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Thu, 8 Dec 2011 16:11:07 +0000
Subject: [PATCH] + Move EXEC_callback into separate file win/systlsdir.inc
* In win32/sysinitXX units, rename EntryInforation to
SysInitEntryInformation. include new win/systlsdir.inc file from
win/syswin.inc for win64 target and from win32/sysinit.inc for win32
target. Set fields of both SysInitEntryInformation and EntryInformation
by converting them into typed constants.
git-svn-id: trunk@19779 -
---
.gitattributes | 1 +
rtl/inc/thread.inc | 2 +-
rtl/win/systhrd.inc | 7 +-
rtl/win/systlsdir.inc | 148 ++++++++++++++++++++++++++++++++++++++
rtl/win/syswin.inc | 99 +------------------------
rtl/win32/sysinit.inc | 20 ++++--
rtl/win32/sysinitcyg.pp | 4 +-
rtl/win32/sysinitgprof.pp | 4 +-
rtl/win32/sysinitpas.pp | 8 +--
rtl/win32/system.pp | 21 +++++-
10 files changed, 198 insertions(+), 116 deletions(-)
create mode 100644 rtl/win/systlsdir.inc
diff --git a/.gitattributes b/.gitattributes
index da833c0b9e..ebf6df6cb3 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -8162,6 +8162,7 @@ rtl/win/sysheap.inc svneol=native#text/plain
rtl/win/sysos.inc svneol=native#text/plain
rtl/win/sysosh.inc svneol=native#text/plain
rtl/win/systhrd.inc svneol=native#text/plain
+rtl/win/systlsdir.inc svneol=native#text/plain
rtl/win/sysutils.pp svneol=native#text/plain
rtl/win/syswin.inc svneol=native#text/plain
rtl/win/tthread.inc svneol=native#text/plain
diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc
index d8622057dc..93adce84fe 100644
--- a/rtl/inc/thread.inc
+++ b/rtl/inc/thread.inc
@@ -603,7 +603,7 @@ begin
SetThreadManager(NoThreadManager);
end;
-Procedure InitSystemThreads;
+Procedure InitSystemThreads; public name '_FPC_InitSystemThreads';
begin
{ This should be changed to a real value during
thread driver initialization if appropriate. }
diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc
index 1d5551996e..ee528f88ee 100644
--- a/rtl/win/systhrd.inc
+++ b/rtl/win/systhrd.inc
@@ -95,7 +95,8 @@ var
threadvarblocksize : dword = 0;
const
- TLSKey : DWord = $ffffffff;
+ TLSKey : DWord = $ffffffff; public name '_FPC_TlsKey';
+
var
MainThreadIdWin32 : DWORD;
@@ -110,7 +111,7 @@ var
end;
- procedure SysAllocateThreadVars;
+ procedure SysAllocateThreadVars; public name '_FPC_SysAllocateThreadVars';
var
dataindex : pointer;
errorsave : dword;
@@ -482,7 +483,7 @@ end;
Var
WinThreadManager : TThreadManager;
-Procedure InitSystemThreads;
+Procedure InitSystemThreads;public name '_FPC_InitSystemThreads';
{$IFDEF SUPPORT_WIN95}
var
KernelHandle : THandle;
diff --git a/rtl/win/systlsdir.inc b/rtl/win/systlsdir.inc
new file mode 100644
index 0000000000..d959fab813
--- /dev/null
+++ b/rtl/win/systlsdir.inc
@@ -0,0 +1,148 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2008 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit part shared by win32/win64.
+
+ 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.
+
+ **********************************************************************}
+
+{ TLS Directory code }
+
+{$ifdef FPC_USE_TLS_DIRECTORY}
+{ Process TLS callback function }
+{ This is only useful for executables
+ for DLLs, DLL_Entry gets called. PM }
+{ The consts are the same as for DDL_Entry,
+ but as this file can be either in system unit or sysinitXXX
+ we need to rename them with EXEC prefix
+ to avoid duplicate entries. }
+Const
+ EXEC_PROCESS_ATTACH = 1;
+ EXEC_THREAD_ATTACH = 2;
+ EXEC_PROCESS_DETACH = 0;
+ EXEC_THREAD_DETACH = 3;
+{$ifdef FPC_INSSIDE_SYSINIT}
+var
+ TlsKey : dword; external name '_FPC_TlsKey';
+
+type
+ TTlsDirectory=packed record
+ data_start, data_end : pointer;
+ index_pointer, callbacks_pointer : pointer;
+ zero_fill_size : dword;
+ flags : dword;
+ end;
+
+
+function TlsGetValue(dwTlsIndex : DWord) : pointer; stdcall;
+ external 'kernel32' name 'TlsGetValue';
+
+procedure InitSystemThreads; external name '_FPC_InitSystemThreads';
+procedure SysAllocateThreadVars; external name '_FPC_SysAllocateThreadVars';
+{$endif FPC_INSSIDE_SYSINIT}
+
+procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer);
+ stdcall; [public,alias:'_FPC_Tls_Callback'];
+ begin
+ if IsLibrary then
+ Exit;
+ case reason of
+ { For executables, EXEC_PROCESS_ATTACH is called *before* the entry point,
+ and EXEC_PROCESS_DETACH is called *after* RTL shuts down and calls ExitProcess.
+ It isn't a good idea to handle resources of the main thread at these points.
+ InitSystemThreads is necessary however, because if some statically loaded
+ DLL creates a thread, it will invoke EXEC_THREAD_ATTACH before anything else is
+ initialized.
+ TODO: The problem is that InitSystemThreads depends (in case of Win32)
+ on EntryInformation which is not available at this point.
+ Solving it properly needs to move this routine
+ to sysinit unit or something like that.
+ Exec_Tls_Callback is now part of sysinit unit for win32
+ and the EntryInformation is a constant which sholud prevent troubles }
+ EXEC_PROCESS_ATTACH:
+ InitSystemThreads;
+
+ EXEC_THREAD_ATTACH :
+ begin
+ { !!! SysInitMultithreading must NOT be called here. Windows guarantees that
+ the main thread invokes PROCESS_ATTACH, not THREAD_ATTACH. So this always
+ executes in non-main thread. SysInitMultithreading() here will cause
+ initial threadvars to be copied to TLS of non-main thread, and threadvars
+ of the main thread will be reinitialized upon the next access with zeroes,
+ ending up in a delayed failure which is very hard to debug.
+ Fortunately this nasty scenario can happen only when the first non-main thread
+ was created outside of RTL (Sergei).
+ }
+ { Allocate Threadvars }
+ SysAllocateThreadVars;
+
+ { NS : no idea what is correct to pass here - pass dummy value for now }
+ { passing a dummy is ok, the correct value is read from the coff header of SysInstance (FK) }
+ InitThread($1000000); { Assume everything is idempotent there, as the thread could have been created with BeginThread... }
+ end;
+ EXEC_THREAD_DETACH :
+ begin
+ if TlsGetValue(TLSKey)<>nil then
+ DoneThread; { Assume everything is idempotent there }
+ end;
+ end;
+ end;
+
+
+{ Mingw tlssup.c source code has
+ _CRTALLOC(".CRT$XLA") PIMAGE_TLS_CALLBACK __xl_a = 0;
+ _CRTALLOC(".CRT$XLZ") PIMAGE_TLS_CALLBACK __xl_z = 0;
+ and the callback pointer is set to:
+ (&__xl_a+1), (+1 meaning =+sizeof(pointer))
+ I am not sure this can be compatible with
+}
+
+const
+ FreePascal_TLS_callback : pointer = @Exec_Tls_callback;
+ public name '__FPC_tls_callbacks' section '.CRT$XLFPC';
+ FreePascal_end_of_TLS_callback : pointer = nil;
+ public name '__FPC_end_of_tls_callbacks' section '.CRT$XLZZZ';
+var
+ tls_callbacks : pointer; external name '___crt_xl_start__';
+ tls_data_start : pointer; external name '___tls_start__';
+ tls_data_end : pointer; external name '___tls_end__';
+
+ _tls_index : dword; cvar; external;
+
+const
+ _tls_used : TTlsDirectory = (
+ data_start : @tls_data_start;
+ data_end : @tls_data_end;
+ index_pointer : @_tls_index;
+ callbacks_pointer : @tls_callbacks;
+ zero_fill_size : 0;
+ flags : 0;
+ ); cvar; public;
+
+{$ifdef win64}
+ { This is a hack to support external linking.
+ All released win64 versions of GNU binutils miss proper prefix handling
+ when searching for _tls_used and expect two leading underscores.
+ The issue has been fixed in binutils snapshots, but not released yet.
+
+ TODO: This should be removed as soon as next version of binutils (>2.21) is
+ released and we upgrade to it. }
+ __tls_used : TTlsDirectory = (
+ data_start : @tls_data_start;
+ data_end : @tls_data_end;
+ index_pointer : @_tls_index;
+ callbacks_pointer : @tls_callbacks;
+ zero_fill_size : 0;
+ flags : 0;
+ ); cvar; public;
+{$endif win64}
+{$endif FPC_USE_TLS_DIRECTORY}
+
diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc
index df5a588368..df1fbd5bb6 100644
--- a/rtl/win/syswin.inc
+++ b/rtl/win/syswin.inc
@@ -327,104 +327,9 @@ Procedure ExitDLL(Exitcode : longint);
LongJmp(DLLBuf,1);
end;
-{$ifdef FPC_USE_TLS_DIRECTORY}
-{ Process TLS callback function }
-{ This is only useful for executables
- for DLLs, DLL_Entry gets called. PM }
-
-procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer);
- stdcall; [public,alias:'_FPC_Tls_Callback'];
- begin
- if IsLibrary then
- Exit;
- case reason of
- { For executables, DLL_PROCESS_ATTACH is called *before* the entry point,
- and DLL_PROCESS_DETACH is called *after* RTL shuts down and calls ExitProcess.
- It isn't a good idea to handle resources of the main thread at these points.
- InitSystemThreads is necessary however, because if some statically loaded
- DLL creates a thread, it will invoke DLL_THREAD_ATTACH before anything else is
- initialized.
- TODO: The problem is that InitSystemThreads depends (in case of Win32) on EntryInformation
- which is not available at this point. Solving it properly needs to move this routine
- to sysinit unit or something like that. }
-// DLL_PROCESS_ATTACH:
-// InitSystemThreads;
-
- DLL_THREAD_ATTACH :
- begin
- { !!! SysInitMultithreading must NOT be called here. Windows guarantees that
- the main thread invokes PROCESS_ATTACH, not THREAD_ATTACH. So this always
- executes in non-main thread. SysInitMultithreading() here will cause
- initial threadvars to be copied to TLS of non-main thread, and threadvars
- of the main thread will be reinitialized upon the next access with zeroes,
- ending up in a delayed failure which is very hard to debug.
- Fortunately this nasty scenario can happen only when the first non-main thread
- was created outside of RTL (Sergei).
- }
- { Allocate Threadvars }
- SysAllocateThreadVars;
-
- { NS : no idea what is correct to pass here - pass dummy value for now }
- { passing a dummy is ok, the correct value is read from the coff header of SysInstance (FK) }
- InitThread($1000000); { Assume everything is idempotent there, as the thread could have been created with BeginThread... }
- end;
- DLL_THREAD_DETACH :
- begin
- if TlsGetValue(TLSKey)<>nil then
- DoneThread; { Assume everything is idempotent there }
- end;
- end;
- end;
-
-
-{ Mingw tlssup.c source code has
- _CRTALLOC(".CRT$XLA") PIMAGE_TLS_CALLBACK __xl_a = 0;
- _CRTALLOC(".CRT$XLZ") PIMAGE_TLS_CALLBACK __xl_z = 0;
- and the callback pointer is set to:
- (&__xl_a+1), (+1 meaning =+sizeof(pointer))
- I am not sure this can be compatible with
-}
-
-const
- FreePascal_TLS_callback : pointer = @Exec_Tls_callback;
- public name '__FPC_tls_callbacks' section '.CRT$XLFPC';
- FreePascal_end_of_TLS_callback : pointer = nil;
- public name '__FPC_end_of_tls_callbacks' section '.CRT$XLZZZ';
-var
- tls_callbacks : pointer; external name '___crt_xl_start__';
- tls_data_start : pointer; external name '___tls_start__';
- tls_data_end : pointer; external name '___tls_end__';
-
- _tls_index : dword; cvar; external;
-
-const
- _tls_used : TTlsDirectory = (
- data_start : @tls_data_start;
- data_end : @tls_data_end;
- index_pointer : @_tls_index;
- callbacks_pointer : @tls_callbacks;
- zero_fill_size : 0;
- flags : 0;
- ); cvar; public;
-
{$ifdef win64}
- { This is a hack to support external linking.
- All released win64 versions of GNU binutils miss proper prefix handling
- when searching for _tls_used and expect two leading underscores.
- The issue has been fixed in binutils snapshots, but not released yet.
-
- TODO: This should be removed as soon as next version of binutils (>2.21) is
- released and we upgrade to it. }
- __tls_used : TTlsDirectory = (
- data_start : @tls_data_start;
- data_end : @tls_data_end;
- index_pointer : @_tls_index;
- callbacks_pointer : @tls_callbacks;
- zero_fill_size : 0;
- flags : 0;
- ); cvar; public;
+{$include systlsdir.inc}
{$endif win64}
-{$endif FPC_USE_TLS_DIRECTORY}
{****************************************************************************
@@ -681,7 +586,7 @@ var
{$endif}
function GetACP:UINT; stdcall; external 'kernel32' name 'GetACP';
-function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP';
+function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP';
function Win32GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
begin
diff --git a/rtl/win32/sysinit.inc b/rtl/win32/sysinit.inc
index e852a13395..c2d1f6e8aa 100644
--- a/rtl/win32/sysinit.inc
+++ b/rtl/win32/sysinit.inc
@@ -13,10 +13,9 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
-
+
var
SysInstance : Longint;external name '_FPC_SysInstance';
- EntryInformation : TEntryInformation;
InitFinalTable : record end; external name 'INITFINAL';
ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
@@ -46,12 +45,25 @@
const
STD_INPUT_HANDLE = dword(-10);
+ SysInitEntryInformation : TEntryInformation = (
+ InitFinalTable : @InitFinalTable;
+ ThreadvarTablesTable : @ThreadvarTablesTable;
+ asm_exit : @asm_exit;
+ PascalMain : @PascalMain;
+ valgrind_used : false;
+ );
+
procedure SetupEntryInformation;
begin
+ { valgind_used is the only thng that can change at startup
EntryInformation.InitFinalTable:=@InitFinalTable;
EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
EntryInformation.asm_exit:=@asm_exit;
- EntryInformation.PascalMain:=@PascalMain;
- EntryInformation.valgrind_used:=valgrind_used;
+ EntryInformation.PascalMain:=@PascalMain;}
+ SysInitEntryInformation.valgrind_used:=valgrind_used;
end;
+
+{$define FPC_INSSIDE_SYSINIT}
+{$include systlsdir.inc}
+
diff --git a/rtl/win32/sysinitcyg.pp b/rtl/win32/sysinitcyg.pp
index 69e2fcfbbd..b7fba0e024 100644
--- a/rtl/win32/sysinitcyg.pp
+++ b/rtl/win32/sysinitcyg.pp
@@ -41,7 +41,7 @@ unit sysinitcyg;
{$ifdef FPC_USE_TLS_DIRECTORY}
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
- EXE_Entry(EntryInformation);
+ EXE_Entry(SysInitEntryInformation);
end;
@@ -53,7 +53,7 @@ unit sysinitcyg;
end;
__main;
SetupEntryInformation;
- DLL_Entry(EntryInformation);
+ DLL_Entry(SysInitEntryInformation);
end;
diff --git a/rtl/win32/sysinitgprof.pp b/rtl/win32/sysinitgprof.pp
index 448356b611..217c5372fb 100644
--- a/rtl/win32/sysinitgprof.pp
+++ b/rtl/win32/sysinitgprof.pp
@@ -75,7 +75,7 @@ unit sysinitgprof;
{$ifdef FPC_USE_TLS_DIRECTORY}
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
- EXE_Entry(EntryInformation);
+ EXE_Entry(SysInitEntryInformation);
end;
@@ -88,7 +88,7 @@ unit sysinitgprof;
DLLgmon_start;
__main;
SetupEntryInformation;
- DLL_Entry(EntryInformation);
+ DLL_Entry(SysInitEntryInformation);
end;
diff --git a/rtl/win32/sysinitpas.pp b/rtl/win32/sysinitpas.pp
index 8d8d707c4f..2fea8d6bd8 100644
--- a/rtl/win32/sysinitpas.pp
+++ b/rtl/win32/sysinitpas.pp
@@ -35,7 +35,7 @@ unit sysinitpas;
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
SetupEntryInformation;
- Exe_entry(EntryInformation);
+ Exe_entry(SysInitEntryInformation);
end;
@@ -46,7 +46,7 @@ unit sysinitpas;
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
SetupEntryInformation;
- Exe_entry(EntryInformation);
+ Exe_entry(SysInitEntryInformation);
end;
@@ -57,7 +57,7 @@ unit sysinitpas;
dllreason:=_dllreason;
dllparam:=_dllparam;
SetupEntryInformation;
- DLL_Entry(EntryInformation);
+ DLL_Entry(SysInitEntryInformation);
end;
@@ -68,7 +68,7 @@ unit sysinitpas;
dllreason:=_dllreason;
dllparam:=_dllparam;
SetupEntryInformation;
- DLL_Entry(EntryInformation);
+ DLL_Entry(SysInitEntryInformation);
end;
end.
diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp
index 9a241d7cd9..148b2b5d4a 100644
--- a/rtl/win32/system.pp
+++ b/rtl/win32/system.pp
@@ -123,8 +123,19 @@ Const
implementation
var
- EntryInformation : TEntryInformation;
SysInstance : Longint;public name '_FPC_SysInstance';
+ InitFinalTable : record end; external name 'INITFINAL';
+ ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+ procedure PascalMain;stdcall;external name 'PASCALMAIN';
+ procedure asm_exit;stdcall;external name 'asm_exit';
+const
+ EntryInformation : TEntryInformation = (
+ InitFinalTable : @InitFinalTable;
+ ThreadvarTablesTable : @ThreadvarTablesTable;
+ asm_exit : @asm_exit;
+ PascalMain : @PascalMain;
+ valgrind_used : false;
+ );
{ include system independent routines }
{$I system.inc}
@@ -142,7 +153,6 @@ procedure PascalMain;stdcall;external name 'PASCALMAIN';
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
Procedure ExitDLL(Exitcode : longint); forward;
-procedure asm_exit;stdcall;external name 'asm_exit';
Procedure system_exit;
begin
@@ -653,7 +663,12 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
DataDirectory : array[1..$80] of byte;
end;
begin
- result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
+ if (SysInstance=0) and not IsLibrary then
+ SysInstance:=getmodulehandle(nil);
+ if (SysInstance=0) then
+ result:=stklen
+ else
+ result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
end;