blob: 5d396beb8f6792b86d2b56e2a7eee6cdf84084d6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2006 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team.
Win32 pascal only startup code
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.
**********************************************************************}
unit sysinit;
interface
implementation
var
SysInstance : QWord;
TlsKeyVar: DWord = $ffffffff;
InitFinalTable : record end; external name 'INITFINAL';
ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
WideInitTables : record end; external name 'FPC_WIDEINITTABLES';
{$ifdef FPC_HAS_RESSTRINITS}
ResStrInitTables : record end; external name 'FPC_RESSTRINITTABLES';
{$endif FPC_HAS_RESSTRINITS}
ResourceStringTables : record end; external name 'FPC_RESOURCESTRINGTABLES';
valgrind_used : boolean;external name '__fpc_valgrind';
{$if defined(FPC_USE_TLS_DIRECTORY) or defined(FPC_SECTION_THREADVARS)}
var
tlsdir: record end; external name '_tls_used';
procedure LinkIn(p1,p2,p3: Pointer); inline;
begin
end;
{$endif}
{$ifdef FPC_USE_TLS_DIRECTORY}
var
tls_callback_end: pointer; external name '__FPC_end_of_tls_callbacks';
tls_callback: pointer; external name '__FPC_tls_callbacks';
{$endif FPC_USE_TLS_DIRECTORY}
procedure EXE_Entry(constref info : TEntryInformation); external name '_FPC_EXE_Entry';
function DLL_Entry(constref info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
procedure PascalMain;external name 'PASCALMAIN';
function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
const
STD_INPUT_HANDLE = dword(-10);
SysInitEntryInformation : TEntryInformation = (
InitFinalTable : @InitFinalTable;
ThreadvarTablesTable : @ThreadvarTablesTable;
ResourceStringTables : @ResourceStringTables;
{$ifdef FPC_HAS_RESSTRINITS}
ResStrInitTables : @ResStrInitTables;
{$else FPC_HAS_RESSTRINITS}
ResStrInitTables : nil;
{$endif FPC_HAS_RESSTRINITS}
ResLocation : nil;
PascalMain : @PascalMain;
valgrind_used : false;
OS : (
TlsKeyAddr : @TlsKeyVar;
SysInstance : @SysInstance;
WideInitTables: @WideInitTables;
);
);
procedure SetupEntryInformation;
begin
{ valgind_used is the only thng that can change at startup
EntryInformation.InitFinalTable:=@InitFinalTable;
EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
EntryInformation.ResourceStringTables:=@ResourceStringTables;
EntryInformation.ResStrInitTables:=@ResStrInitTables;
EntryInformation.OS.asm_exit:=@asm_exit;
EntryInformation.OS.TlsKeyAddr:=@TlsKeyVar;
EntryInformation.OS.SysInstance:=@SysInstance;
EntryInformation.OS.WideInitTables:=@WideInitTables;
EntryInformation.PascalMain:=@PascalMain;}
SysInitEntryInformation.valgrind_used:=valgrind_used;
end;
{$define FPC_INSSIDE_SYSINIT}
{$include systlsdir.inc}
procedure _FPC_mainCRTStartup;stdcall;public name '_mainCRTStartup';
begin
IsConsole:=true;
{ do it like it is necessary for the startup code linking against cygwin }
GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
{$ifdef FPC_USE_TLS_DIRECTORY}
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
SetupEntryInformation;
Exe_entry(SysInitEntryInformation);
end;
procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
begin
IsConsole:=false;
{$ifdef FPC_USE_TLS_DIRECTORY}
LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
{$endif}
SetupEntryInformation;
Exe_entry(SysInitEntryInformation);
end;
procedure _FPC_DLLMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLMainCRTStartup';
begin
IsConsole:=true;
sysinstance:=_hinstance;
dllreason:=_dllreason;
dllparam:=PtrInt(_dllparam);
SetupEntryInformation;
DLL_Entry(SysInitEntryInformation);
end;
procedure _FPC_DLLWinMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLWinMainCRTStartup';
begin
IsConsole:=false;
sysinstance:=_hinstance;
dllreason:=_dllreason;
dllparam:=PtrInt(_dllparam);
SetupEntryInformation;
DLL_Entry(SysInitEntryInformation);
end;
end.
|
