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

* win32 system unit doesn't depend anymore directly on the main program, this is necessary to be able to keep it in a dll

Browse Source 
git-svn-id: trunk@9052 -
This commit is contained in:
florian 2007-11-01 21:59:43 +00:00
parent 1536e9e65b
commit b2b0e749bb
8 changed files with 155 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/i386/fastmove.inc
View File

@ -864,15 +864,21 @@ end;
{$asmmode att}
{$ifdef FPC_HAS_VALGRINDBOOL}
{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
var
valgrind_used : boolean;external name '__fpc_valgrind';
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
{$endif FPC_HAS_VALGRINDBOOL}
procedure setup_fastmove;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$ifdef FPC_HAS_VALGRINDBOOL}
{ workaround valgrind bug }
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
if EntryInformation.valgrind_used then
{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
if valgrind_used then
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
begin
fastmoveproc_forward:=@Forwards_Valgrind;
fastmoveproc_backward:=@Backwards_Valgrind;

15
rtl/inc/system.inc
View File

@ -700,14 +700,19 @@ type
InitProc,
FinalProc : TProcedure;
end;
TInitFinalTable=record
TInitFinalTable = record
TableCount,
InitCount : longint;
Procs : array[1..maxunits] of TInitFinalRec;
end;
PInitFinalTable = ^TInitFinalTable;
{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
var
InitFinalTable : TInitFinalTable;external name 'INITFINAL';
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
var
@ -715,7 +720,9 @@ var
begin
{ call cpu/fpu initialisation routine }
fpc_cpuinit;
with InitFinalTable do
with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
InitFinalTable
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} do
begin
for i:=1 to TableCount do
begin
@ -731,7 +738,9 @@ end;
procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
begin
with InitFinalTable do
with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
InitFinalTable
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} do
begin
while (InitCount>0) do
begin

9
rtl/inc/systemh.inc
View File

@ -293,6 +293,15 @@ Type
{ platform dependent types }
{$i sysosh.inc}
type
TEntryInformation = record
InitFinalTable : Pointer;
ThreadvarTablesTable : Pointer;
asm_exit : Procedure;stdcall;
PascalMain : Procedure;stdcall;
valgrind_used : boolean;
end;
const
{ Maximum value of the biggest signed and unsigned integer type available}

22
rtl/inc/threadvr.inc
View File

@ -31,9 +31,12 @@ type
count : dword;
tables : packed array [1..32767] of pltvInitEntry;
end;
PltvInitTablesTable = ^TltvInitTablesTable;
{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
var
ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
procedure init_unit_threadvars (tableEntry : pltvInitEntry);
begin
@ -50,10 +53,14 @@ var
i : integer;
begin
{$ifdef DEBUG_MT}
WriteLn ('init_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
WriteLn ('init_all_unit_threadvars (',
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count,') units');
{$endif}
for i := 1 to ThreadvarTablesTable.count do
init_unit_threadvars (ThreadvarTablesTable.tables[i]);
for i := 1 to {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count do
init_unit_threadvars ({$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.tables[i]);
end;
@ -77,10 +84,13 @@ var
i : integer;
begin
{$ifdef DEBUG_MT}
WriteLn ('copy_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
WriteLn ('copy_all_unit_threadvars (',{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count,') units');
{$endif}
for i := 1 to ThreadvarTablesTable.count do
copy_unit_threadvars (ThreadvarTablesTable.tables[i]);
for i := 1 to {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count do
copy_unit_threadvars ({$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.tables[i]);
end;
procedure InitThreadVars(RelocProc : Pointer);

33
rtl/win32/sysinitcyg.pp
View File

@ -21,6 +21,11 @@ unit sysinitcyg;
var
SysInstance : Longint;external name '_FPC_SysInstance';
EntryInformation : TEntryInformation;
InitFinalTable : record end; external name 'INITFINAL';
ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
valgrind_used : boolean;external name '__fpc_valgrind';
procedure EXE_Entry; external name '_FPC_EXE_Entry';
function DLL_Entry : longbool; external name '_FPC_DLL_Entry';
@ -34,6 +39,24 @@ unit sysinitcyg;
function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
procedure PascalMain;stdcall;external name 'PASCALMAIN';
procedure asm_exit;stdcall;public name 'asm_exit';
begin
end;
procedure SetupEntryInformation;
begin
EntryInformation.InitFinalTable:=@InitFinalTable;
EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
EntryInformation.asm_exit:=@asm_exit;
EntryInformation.PascalMain:=@PascalMain;
EntryInformation.valgrind_used:=valgrind_used;
end;
procedure CMainEXE;cdecl;
begin
asm
@ -41,7 +64,8 @@ unit sysinitcyg;
andl $0xfffffff0,%esp
end;
__main;
EXE_Entry;
SetupEntryInformation;
EXE_Entry(EntryInformation);
end;
@ -52,7 +76,8 @@ unit sysinitcyg;
andl $0xfffffff0,%esp
end;
__main;
DLL_Entry;
SetupEntryInformation;
DLL_Entry(EntryInformation);
end;
@ -109,8 +134,4 @@ unit sysinitcyg;
Cygwin_crt0(@CMainDLL);
end;
procedure asm_exit;stdcall;public name 'asm_exit';
begin
end;
end.

38
rtl/win32/sysinitgprof.pp
View File

@ -30,6 +30,11 @@ unit sysinitgprof;
var
SysInstance : Longint;external name '_FPC_SysInstance';
EntryInformation : TEntryInformation;
InitFinalTable : record end; external name 'INITFINAL';
ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
valgrind_used : boolean;external name '__fpc_valgrind';
stext : record end;external name '__text_start__';
etext : record end;external name 'etext';
@ -51,6 +56,26 @@ unit sysinitgprof;
function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
procedure PascalMain;stdcall;external name 'PASCALMAIN';
procedure asm_exit;stdcall;public name 'asm_exit';
begin
_mcleanup;
end;
procedure SetupEntryInformation;
begin
EntryInformation.InitFinalTable:=@InitFinalTable;
EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
EntryInformation.asm_exit:=@asm_exit;
EntryInformation.PascalMain:=@PascalMain;
EntryInformation.valgrind_used:=valgrind_used;
end;
procedure EXEgmon_start;
begin
if monstarted=0 then
@ -79,7 +104,8 @@ unit sysinitgprof;
end;
EXEgmon_start;
__main;
EXE_Entry;
SetupEntryInformation;
EXE_Entry(EntryInformation);
end;
@ -91,7 +117,8 @@ unit sysinitgprof;
end;
DLLgmon_start;
__main;
DLL_Entry;
SetupEntryInformation;
DLL_Entry(EntryInformation);
end;
@ -148,11 +175,4 @@ unit sysinitgprof;
Cygwin_crt0(@CMainDLL);
end;
procedure asm_exit;stdcall;public name 'asm_exit';
begin
_mcleanup;
end;
end.

39
rtl/win32/sysinitpas.pp
View File

@ -21,9 +21,28 @@ unit sysinitpas;
var
SysInstance : Longint;external name '_FPC_SysInstance';
EntryInformation : TEntryInformation;
procedure EXE_Entry; external name '_FPC_EXE_Entry';
function DLL_entry : longbool; external name '_FPC_DLL_Entry';
InitFinalTable : record end; external name 'INITFINAL';
ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
valgrind_used : boolean;external name '__fpc_valgrind';
procedure asm_exit;stdcall;public name 'asm_exit';
begin
end;
procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
procedure PascalMain;stdcall;external name 'PASCALMAIN';
procedure SetupEntryInformation;
begin
EntryInformation.InitFinalTable:=@InitFinalTable;
EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
EntryInformation.asm_exit:=@asm_exit;
EntryInformation.PascalMain:=@PascalMain;
EntryInformation.valgrind_used:=valgrind_used;
end;
const
STD_INPUT_HANDLE = dword(-10);
@ -36,14 +55,16 @@ unit sysinitpas;
IsConsole:=true;
{ do it like it is necessary for the startup code linking against cygwin }
GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
Exe_entry;
SetupEntryInformation;
Exe_entry(EntryInformation);
end;
procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
begin
IsConsole:=false;
Exe_entry;
SetupEntryInformation;
Exe_entry(EntryInformation);
end;
@ -53,7 +74,8 @@ unit sysinitpas;
sysinstance:=_hinstance;
dllreason:=_dllreason;
dllparam:=_dllparam;
DLL_Entry;
SetupEntryInformation;
DLL_Entry(EntryInformation);
end;
@ -63,11 +85,8 @@ unit sysinitpas;
sysinstance:=_hinstance;
dllreason:=_dllreason;
dllparam:=_dllparam;
DLL_Entry;
SetupEntryInformation;
DLL_Entry(EntryInformation);
end;
procedure asm_exit;stdcall;public name 'asm_exit';
begin
end;
end.

34
rtl/win32/system.pp
View File

@ -20,6 +20,8 @@ interface
{$define SYSTEMEXCEPTIONDEBUG}
{$endif SYSTEMDEBUG}
{$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
{$ifdef cpui386}
{$define Set_i386_Exception_handler}
{$endif cpui386}
@ -111,6 +113,7 @@ const
implementation
var
EntryInformation : TEntryInformation;
SysInstance : Longint;public name '_FPC_SysInstance';
{$ifdef CPUI386}
@ -311,7 +314,9 @@ end;
procedure install_exception_handlers;forward;
procedure remove_exception_handlers;forward;
{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
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';
@ -338,7 +343,11 @@ begin
{ in 2.0 asm_exit does an exitprocess }
{$ifndef ver2_0}
{ do cleanup required by the startup code }
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
EntryInformation.asm_exit();
{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
asm_exit;
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
{$endif ver2_0}
{ call exitprocess, with cleanup as required }
@ -350,10 +359,11 @@ var
to check if the call stack can be written on exceptions }
_SS : Cardinal;
procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
var
ST : pointer;
begin
EntryInformation:=info;
IsLibrary:=false;
{ install the handlers for exe only ?
or should we install them for DLL also ? (PM) }
@ -380,7 +390,13 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
movw %ss,%ax
movl %eax,_SS
xorl %ebp,%ebp
call PASCALMAIN
end;
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
EntryInformation.PascalMain();
{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
PascalMain;
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
asm
popl %ebp
end;
{ if we pass here there was no error ! }
@ -399,11 +415,11 @@ Var
Const
DLLExitOK : boolean = true;
function Dll_entry : longbool; [public,alias:'_FPC_DLL_Entry'];
var
res : longbool;
function Dll_entry(const info : TEntryInformation) : longbool; [public,alias:'_FPC_DLL_Entry'];
var
res : longbool;
begin
EntryInformation:=info;
IsLibrary:=true;
Dll_entry:=false;
case DLLreason of
@ -417,7 +433,11 @@ var
if not res then
exit(false);
end;
PASCALMAIN;
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
EntryInformation.PascalMain();
{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
PascalMain;
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
Dll_entry:=true;
end
else