summaryrefslogtreecommitdiff
path: root/rtl
diff options
context:
space:
mode:
authorflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-01-07 18:47:04 +0000
committerflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-01-07 18:47:04 +0000
commit6f99ceb6aa51f2de9ec36a9c0031483a17676eda (patch)
treebd10bd75cfd8f82bb6e932eeffa6236427d784fa /rtl
parent7a2cab35de443d177969b1078dc0345c5f4e6367 (diff)
downloadfpc-6f99ceb6aa51f2de9ec36a9c0031483a17676eda.tar.gz
+ patch by Sven Barth to add native NT rtl support to the fpc rtl, resolves #14887
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@14568 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'rtl')
-rw-r--r--rtl/Makefile59
-rw-r--r--rtl/Makefile.fpc1
-rw-r--r--rtl/nativent/Makefile.fpc108
-rw-r--r--rtl/nativent/buildrtl.lpi67
-rw-r--r--rtl/nativent/buildrtl.pp10
-rw-r--r--rtl/nativent/ddk.pas59
-rw-r--r--rtl/nativent/ddk/ddkex.inc20
-rw-r--r--rtl/nativent/ddk/ddktypes.inc75
-rw-r--r--rtl/nativent/ndk.pas33
-rw-r--r--rtl/nativent/ndkutils.pas59
-rw-r--r--rtl/nativent/sysheap.inc160
-rw-r--r--rtl/nativent/sysndk.inc219
-rw-r--r--rtl/nativent/sysos.inc18
-rw-r--r--rtl/nativent/sysosh.inc58
-rw-r--r--rtl/nativent/system.pp218
15 files changed, 1162 insertions, 2 deletions
diff --git a/rtl/Makefile b/rtl/Makefile
index 5d647bee8f..8f3bfed0fa 100644
--- a/rtl/Makefile
+++ b/rtl/Makefile
@@ -1,8 +1,8 @@
#
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/12/07]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/01/07]
#
default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) solaris qnx haiku
LIMIT83fs = go32v2 os2 emx watcom
@@ -314,6 +314,9 @@ endif
ifeq ($(FULL_TARGET),i386-symbian)
override TARGET_DIRS+=symbian
endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override TARGET_DIRS+=nativent
+endif
ifeq ($(FULL_TARGET),m68k-linux)
override TARGET_DIRS+=linux
endif
@@ -772,6 +775,10 @@ ifeq ($(OS_TARGET),symbian)
SHAREDLIBEXT=.dll
SHORTSUFFIX=symbian
endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
else
ifeq ($(OS_TARGET),go32v1)
PPUEXT=.pp1
@@ -1730,6 +1737,9 @@ endif
ifeq ($(FULL_TARGET),i386-symbian)
TARGET_DIRS_SYMBIAN=1
endif
+ifeq ($(FULL_TARGET),i386-nativent)
+TARGET_DIRS_NATIVENT=1
+endif
ifeq ($(FULL_TARGET),m68k-linux)
TARGET_DIRS_LINUX=1
endif
@@ -2564,6 +2574,51 @@ symbian:
$(MAKE) -C symbian all
.PHONY: symbian_all symbian_debug symbian_smart symbian_release symbian_units symbian_examples symbian_shared symbian_install symbian_sourceinstall symbian_exampleinstall symbian_distinstall symbian_zipinstall symbian_zipsourceinstall symbian_zipexampleinstall symbian_zipdistinstall symbian_clean symbian_distclean symbian_cleanall symbian_info symbian_makefiles symbian
endif
+ifdef TARGET_DIRS_NATIVENT
+nativent_all:
+ $(MAKE) -C nativent all
+nativent_debug:
+ $(MAKE) -C nativent debug
+nativent_smart:
+ $(MAKE) -C nativent smart
+nativent_release:
+ $(MAKE) -C nativent release
+nativent_units:
+ $(MAKE) -C nativent units
+nativent_examples:
+ $(MAKE) -C nativent examples
+nativent_shared:
+ $(MAKE) -C nativent shared
+nativent_install:
+ $(MAKE) -C nativent install
+nativent_sourceinstall:
+ $(MAKE) -C nativent sourceinstall
+nativent_exampleinstall:
+ $(MAKE) -C nativent exampleinstall
+nativent_distinstall:
+ $(MAKE) -C nativent distinstall
+nativent_zipinstall:
+ $(MAKE) -C nativent zipinstall
+nativent_zipsourceinstall:
+ $(MAKE) -C nativent zipsourceinstall
+nativent_zipexampleinstall:
+ $(MAKE) -C nativent zipexampleinstall
+nativent_zipdistinstall:
+ $(MAKE) -C nativent zipdistinstall
+nativent_clean:
+ $(MAKE) -C nativent clean
+nativent_distclean:
+ $(MAKE) -C nativent distclean
+nativent_cleanall:
+ $(MAKE) -C nativent cleanall
+nativent_info:
+ $(MAKE) -C nativent info
+nativent_makefiles:
+ $(MAKE) -C nativent makefiles
+nativent:
+ $(MAKE) -C nativent all
+.PHONY: nativent_all nativent_debug nativent_smart nativent_release nativent_units nativent_examples nativent_shared nativent_install nativent_sourceinstall nativent_exampleinstall nativent_distinstall nativent_zipinstall nativent_zipsourceinstall nativent_zipexampleinstall nativent_zipdistinstall nativent_clean nativent_distclean nativent_cleanall nativent_info nativent_makefiles nativent
+endif
ifdef TARGET_DIRS_AMIGA
amiga_all:
$(MAKE) -C amiga all
diff --git a/rtl/Makefile.fpc b/rtl/Makefile.fpc
index 6a3aa9716b..9923acbb87 100644
--- a/rtl/Makefile.fpc
+++ b/rtl/Makefile.fpc
@@ -31,6 +31,7 @@ dirs_gba=gba
dirs_nds=nds
dirs_symbian=symbian
dirs_embedded=embedded
+dirs_nativent=nativent
[install]
fpcpackage=y
diff --git a/rtl/nativent/Makefile.fpc b/rtl/nativent/Makefile.fpc
new file mode 100644
index 0000000000..0db1a6b233
--- /dev/null
+++ b/rtl/nativent/Makefile.fpc
@@ -0,0 +1,108 @@
+#
+# Makefile.fpc for Free Pascal NativeNT RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=
+#units=system objpas macpas buildrtl lineinfo lnfodwrf
+units=system objpas buildrtl
+implicitunits=ndk ndkutils ddk
+# ctypes strings
+# heaptrc matrix \
+# windows winsock winsock2 initc cmem dynlibs signals \
+# dos crt objects messages \
+# rtlconsts sysconst sysutils math types \
+# strutils dateutils varutils variants typinfo fgl classes \
+# convutils stdconvs cpu mmx charset ucomplex getopts \
+# winevent sockets printer \
+# video mouse keyboard fmtbcd \
+# winsysut sharemem exeinfo fpintres
+
+# shared=$(DLLS)
+
+rsts=math varutils typinfo variants classes dateutils sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=nativent
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(DDKINC)
+sourcedir=$(INC) $(PROCINC) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+DDKINC=ddk
+
+UNITPREFIX=rtl
+
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+#LOADERS=wprt0 wdllprt0 gprt0 wcygprt0
+DLLS=
+else
+DLLS=fpcmemdll
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+# Files used by windows.pp
+#include $(WININC)/makefile.inc
+
+WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
+
+
+[rules]
+.NOTPARALLEL:
+SYSTEMPPU=$(addsuffix $(PPUEXT),system)
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+# none
+
+#
+# Unit specific rules
+#
+
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+#macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) buildrtl$(PPUEXT)
+# $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+buildrtl$(PPUEXT): buildrtl.pp system$(PPUEXT) objpas$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(PROCINC) -I$(OBJPASDIR) -Fi$(DDKINC) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
diff --git a/rtl/nativent/buildrtl.lpi b/rtl/nativent/buildrtl.lpi
new file mode 100644
index 0000000000..2d8feb17a4
--- /dev/null
+++ b/rtl/nativent/buildrtl.lpi
@@ -0,0 +1,67 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="7"/>
+ <General>
+ <Flags>
+ <MainUnitHasUsesSectionForAllUnits Value="False"/>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ <Runnable Value="False"/>
+ <LRSInOutputDirectory Value="False"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=".exe"/>
+ <Title Value="buildrtl"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="buildrtl.pp"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="buildrtl"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="8"/>
+ <PathDelim Value="\"/>
+ <SearchPaths>
+ <IncludeFiles Value="..\inc\;..\$TargetCPU()\;ddk\;..\objpas\;..\objpas\classes\;..\objpas\sysutils\"/>
+ <UnitOutputDirectory Value="..\units\i386-nativent"/>
+ </SearchPaths>
+ <Parsing>
+ <Style Value="2"/>
+ <SyntaxOptions>
+ <SyntaxMode Value="fpc"/>
+ </SyntaxOptions>
+ </Parsing>
+ <Other>
+ <Verbosity>
+ <ShowNotes Value="False"/>
+ <ShowHints Value="False"/>
+ </Verbosity>
+ <CustomOptions Value="-dKMODE"/>
+ <CompilerPath Value="$(CompPath)"/>
+ <ExecuteBefore>
+ <ShowAllMessages Value="True"/>
+ </ExecuteBefore>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/rtl/nativent/buildrtl.pp b/rtl/nativent/buildrtl.pp
new file mode 100644
index 0000000000..c588164789
--- /dev/null
+++ b/rtl/nativent/buildrtl.pp
@@ -0,0 +1,10 @@
+unit buildrtl;
+
+ interface
+
+ uses
+ ndk, ndkutils, ddk;
+
+ implementation
+
+end.
diff --git a/rtl/nativent/ddk.pas b/rtl/nativent/ddk.pas
new file mode 100644
index 0000000000..130b4722e6
--- /dev/null
+++ b/rtl/nativent/ddk.pas
@@ -0,0 +1,59 @@
+{
+ Driver Development Kit for Native NT
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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 DDK;
+
+interface
+
+uses
+ NDK;
+
+const
+ // we distinguish the user- AND kernel-mode imports (NDK.ntdll) from the pure
+ // kernel mode imports (ntkrnl)
+ ntkrnl = 'ntoskrnl.exe';
+
+{$include ddktypes.inc}
+
+// these two only return not Nil in main routine of a device driver
+function RegistryPath: PNtUnicodeString; inline;
+function DriverObject: PDriverObject; inline;
+
+function DbgPrint(aFormat: PChar): LongWord; cdecl; varargs; external ntkrnl name 'DbgPrint';
+
+function PoolTag(aTag: TTagString): LongWord;
+
+{$include ddkex.inc}
+
+implementation
+
+function RegistryPath: PNtUnicodeString; inline;
+begin
+ RegistryPath := SysRegistryPath;
+end;
+
+function DriverObject: PDriverObject; inline;
+begin
+ DriverObject := SysDriverObject;
+end;
+
+function PoolTag(aTag: TTagString): LongWord;
+begin
+ PoolTag := Ord(aTag[1]) + Ord(aTag[2]) shl 8 +
+ Ord(aTag[3]) shl 16 + Ord(aTag[4]) shl 24;
+end;
+
+end.
+
diff --git a/rtl/nativent/ddk/ddkex.inc b/rtl/nativent/ddk/ddkex.inc
new file mode 100644
index 0000000000..3e44826a94
--- /dev/null
+++ b/rtl/nativent/ddk/ddkex.inc
@@ -0,0 +1,20 @@
+{%MainUnit ddk.pas}
+{
+ Driver Development Kit for Native NT
+ Imports for Executive
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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.
+
+ **********************************************************************}
+
+function ExAllocatePoolWithTag(PoolType: TPoolType; NumberOfBytes: PtrUInt; Tag: LongWord): Pointer; stdcall; external ntkrnl name 'ExAllocatePoolWithTag';
+procedure ExFreePoolWithTag(P: Pointer; Tag: LongWord); stdcall; external ntkrnl name 'ExFreePoolWithTag';
+
diff --git a/rtl/nativent/ddk/ddktypes.inc b/rtl/nativent/ddk/ddktypes.inc
new file mode 100644
index 0000000000..fb0a9c4f27
--- /dev/null
+++ b/rtl/nativent/ddk/ddktypes.inc
@@ -0,0 +1,75 @@
+{%MainUnit ddk.pas}
+{
+ Driver Development Kit for Native NT
+ Basic types used in Kernel Mode
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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.
+
+ **********************************************************************}
+
+type
+ _DEVICE_OBJECT = packed record
+
+ end;
+ TDeviceObject = _DEVICE_OBJECT;
+ PDeviceObject = ^TDeviceObject;
+
+ _FAST_IO_DISPATCH = packed record
+
+ end;
+ TFastIODispatch = _FAST_IO_DISPATCH;
+ PFastIODispatch = ^TFastIODispatch;
+
+ _DRIVER_EXTENSION = packed record
+
+ end;
+ TDriverExtension = _DRIVER_EXTENSION;
+ PDriverExtension = ^TDriverExtension;
+
+ _DRIVER_OBJECT = packed record
+ _Type: SmallInt;
+ Size: SmallInt;
+ DeviceObject: PDeviceObject;
+ Flags: LongWord;
+ DriverStart: Pointer;
+ DriverSize: LongWord;
+ DriverSection: Pointer;
+ DriverExtension: PDriverExtension;
+ DriverName: TNtUnicodeString;
+ HardwareDatabase: PNtUnicodeString;
+ FastIoDispatch: PFastIODispatch;
+ DriverInit: PLongInt;
+ DriverStartIo: Pointer;
+ DriverUnload: Pointer;
+ MajorFunction: array[0..27] of PLongInt;
+ end;
+ TDriverObject = _Driver_Object;
+ PDriverObject = ^TDriverObject;
+
+ POOL_TYPE = (
+ NonPagedPool,
+ PagedPool,
+ NonPagedPoolMustSucceed,
+ DontUseThisType,
+ NonPagedPoolCacheAligned,
+ PagedPoolCacheAligned,
+ NonPagedPoolCacheAlignedMustS,
+ MaxPoolType,
+ NonPagedPoolSession = 32,
+ PagedPoolSession,
+ NonPagedPoolMustSucceedSession,
+ DontUseThisTypeSession,
+ NonPagedPoolCacheAlignedSession,
+ PagedPoolCacheAlignedSession,
+ NonPagedPoolCacheAlignedMustSSession
+ );
+ TPoolType = POOL_TYPE;
+
diff --git a/rtl/nativent/ndk.pas b/rtl/nativent/ndk.pas
new file mode 100644
index 0000000000..de83c74646
--- /dev/null
+++ b/rtl/nativent/ndk.pas
@@ -0,0 +1,33 @@
+{
+ Native Development Kit for Native NT
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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 NDK;
+
+interface
+
+{$I sysndk.inc}
+
+function NtDelayExecution(aAlertable: Boolean; aInterval: PLargeInteger): NTSTATUS; stdcall; external ntdll;
+
+
+function LdrGetProcedureAddress(hModule: THandle; psName: PNtUnicodeString; dwOrdinal: LongWord; var pProcedure: Pointer): NTSTATUS; stdcall; external ntdll;
+function LdrLoadDll(pwPath : PWord; pdwFlags : LongWord; pusPath : PNtUnicodeString; var phModule : THandle): NTSTATUS; stdcall; external ntdll;
+function LdrUnloadDll(hModule: THandle): NTSTATUS; stdcall; external ntdll;
+
+
+implementation
+
+end.
+
diff --git a/rtl/nativent/ndkutils.pas b/rtl/nativent/ndkutils.pas
new file mode 100644
index 0000000000..d50e07b71b
--- /dev/null
+++ b/rtl/nativent/ndkutils.pas
@@ -0,0 +1,59 @@
+{
+ FPC Utility Function for Native NT applications
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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 NDKUtils;
+
+{.$H+}
+
+interface
+
+uses
+ NDK;
+
+procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: TNtUnicodeString);
+//procedure AnsiStrToNTStr(const aStr: String; var aNTStr: TNtUnicodeString);
+
+implementation
+
+procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: TNtUnicodeString);
+var
+ buf: Pointer;
+ i: Integer;
+begin
+ FillChar(aNTStr, SizeOf(TNtUnicodeString), 0);
+ aNTStr.Length := Length(aStr) * 2;
+ aNTStr.buffer := GetMem(aNTStr.Length);
+ buf := aNTStr.buffer;
+ for i := 1 to Length(aStr) do begin
+ PWord(buf)^ := Word(aStr[i]);
+ buf := Pointer(PtrUInt(buf) + SizeOf(Word));
+ end;
+ aNTStr.MaximumLength := aNTStr.Length;
+end;
+
+procedure InitializeObjectAttributes(var aObjectAttr: TObjectAttributes; aName: PNtUnicodeString; aAttributes: ULONG; aRootDir: THandle; aSecurity: Pointer);
+begin
+ with aObjectAttr do begin
+ Length := SizeOf(TObjectAttributes);
+ RootDirectory := aRootDir;
+ Attributes := aAttributes;
+ ObjectName := aName;
+ SecurityDescriptor := aSecurity;
+ SecurityQualityOfService := Nil;
+ end;
+end;
+
+end.
+
diff --git a/rtl/nativent/sysheap.inc b/rtl/nativent/sysheap.inc
new file mode 100644
index 0000000000..6fa04e224a
--- /dev/null
+++ b/rtl/nativent/sysheap.inc
@@ -0,0 +1,160 @@
+{
+ Basic heap handling for windows platforms
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001-2005 by Free Pascal development team
+
+ 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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+ { In kernel mode we can either use FPC's build in memory manager or we use a
+ custom non-chunking manager. The problem with the build in one is that the
+ driver developer has far less control of the allocated memory blocks. }
+
+ { memory functions }
+{$ifdef KMODE}
+ function ExAllocatePoolWithTag(PoolType: LongInt; NumberOfBytes: PtrUInt; Tag: LongWord): Pointer; stdcall; external ntdll name 'ExAllocatePoolWithTag';
+ procedure ExFreePoolWithTag(P: Pointer; Tag: LongWord); stdcall; external ntdll name 'ExFreePoolWithTag';
+{$else KMODE}
+ function RtlAllocateHeap(hHeap : THandle; dwFlags : LongWord; Size : Longword): Pointer;
+ stdcall; external ntdll name 'RtlAllocateHeap';
+ function RtlFreeHeap(hHeap : THandle; dwFlags : LongWord; MemoryPointer : Pointer): Boolean;
+ stdcall; external ntdll name 'RtlFreeHeap';
+ function RtlCreateHeap(Flags: LongWord; Base: Pointer; SizeToReserve: PtrUInt;
+ SizeToCommit: PtrUInt; Lock: PVOID; Parameters: Pointer): THandle;
+ stdcall; external ntdll name 'RtlCreateHeap';
+
+var
+ SysHeap: THandle = Nil;
+
+procedure PrepareSysHeap;
+begin
+ if IsLibrary then
+ // create a new heap (flag is HEAP_GROWABLE)
+ SysHeap := RtlCreateHeap(2, Nil, 65534, 65534, Nil, Nil)
+ else
+ // use the heap passed on startup
+ SysHeap := PPEB(CurrentPEB)^.ProcessHeap;
+end;
+
+{$endif KMODE}
+
+{$ifndef KMODE}
+
+// default memory manager
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+ if SysHeap = Nil then
+ PrepareSysHeap;
+ SysOSAlloc := RtlAllocateHeap(SysHeap, 0, size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+ // if heap isn't set, then nothing was allocated
+ if SysHeap <> Nil then
+ RtlFreeHeap(SysHeap, 0, p);
+end;
+
+{$else KMODE}
+
+// custom non-chunking memory manager for kernel mode
+
+// memory layout:
+// <PtrUInt>: Size of reserved chunk
+// <Tag>: Tag that was used in ExAllocateFromPoolWithTag (needed in free)
+// <...>: Userdata
+
+function SysGetMem(Size: PtrUInt): Pointer;
+var
+ tag: LongWord;
+ pooltype: LongInt;
+begin
+ if HeapUsePagedPool then
+ pooltype := 1
+ else
+ pooltype := 0;
+ tag := Ord(HeapPoolTag[1]) + Ord(HeapPoolTag[2]) shl 8 +
+ Ord(HeapPoolTag[3]) shl 16 + Ord(HeapPoolTag[4]) shl 24;
+ // the kernel keeps track of our memory, but there's no way to ask it
+ // so we need to track the size by ourself
+ SysGetMem := ExAllocatePoolWithTag(pooltype, Size + SizeOf(PtrUInt) + SizeOf(LongWord), tag);
+ // save the size
+ PPtrUInt(SysGetMem)^ := Size;
+ SysGetMem := SysGetMem + SizeOf(PtrUInt);
+ // save the tag
+ PLongWord(SysGetMem)^ := tag;
+ SysGetMem := SysGetMem + SizeOf(LongWord);
+end;
+
+function SysFreeMem(p: Pointer): PtrUInt;
+var
+ tag: PLongWord;
+begin
+ tag := p - SizeOf(LongWord);
+ // we need to pass the tag we used to allocate the memory (else: BSOD)
+ ExFreePoolWithTag(p - SizeOf(PtrUInt) - SizeOf(LongWord), tag^);
+ SysFreeMem := 0;
+end;
+
+function SysFreeMemSize(p: Pointer; Size: PtrUInt): PtrUInt;
+begin
+ SysFreeMemSize := 0;
+ if (Size > 0) and (p <> nil) then
+ Result := SysFreeMem(p);
+end;
+
+Function SysAllocMem(Size: PtrUInt): Pointer;
+begin
+ SysAllocMem := SysGetMem(Size);
+ if SysAllocMem <> nil then
+ FillChar(SysAllocMem^, Size, 0);
+end;
+
+Function SysReAllocMem (var p: pointer; Size: PtrUInt): Pointer;
+begin
+ SysReAllocMem := SysGetMem(Size);
+ Move(p^, SysReAllocMem^, Size);
+ p := SysReAllocMem;
+end;
+
+function SysTryResizeMem(var p: Pointer; size: PtrUInt): Boolean;
+var
+ res: pointer;
+begin
+ res := SysGetMem(Size);
+ SysTryResizeMem := (res <> Nil) or (Size = 0);
+ if SysTryResizeMem then
+ p := res;
+end;
+
+function SysMemSize(P : pointer): PtrUInt;
+begin
+ SysMemSize := PPtrUInt(P - SizeOf(PtrUInt) - SizeOf(LongWord))^;
+end;
+
+function SysGetHeapStatus: THeapStatus;
+begin
+ FillChar(SysGetHeapStatus, SizeOf(SysGetHeapStatus), 0);
+end;
+
+function SysGetFPCHeapStatus: TFPCHeapStatus;
+begin
+ FillChar(SysGetFPCHeapStatus, SizeOf(SysGetHeapStatus), 0);
+end;
+
+{$endif KMODE}
diff --git a/rtl/nativent/sysndk.inc b/rtl/nativent/sysndk.inc
new file mode 100644
index 0000000000..32f06861ee
--- /dev/null
+++ b/rtl/nativent/sysndk.inc
@@ -0,0 +1,219 @@
+// These datatypes are used in system.pas and ndk.pas
+
+const
+{$ifdef kmode}
+ ntdll = 'ntoskrnl.exe';
+{$else}
+ ntdll = 'ntdll.dll';
+{$endif}
+
+type
+ //
+ // some basic types
+ //
+ HANDLE = THandle;
+ PVOID = Pointer;
+ LONG = LongInt;
+ ULONG = LongWord;
+
+
+ NTSTATUS = LongInt;
+
+ UNICODE_STRING = packed record
+ Length: Word; // used characters in buffer
+ MaximumLength: Word; // maximum characters in buffer
+ Buffer: PWideChar;
+ end;
+ PUNICODE_STRING = ^UNICODE_STRING;
+ // alias to differ from TUnicodeString
+ TNtUnicodeString = UNICODE_STRING;
+ PNtUnicodeString = ^TNtUnicodeString;
+
+ // using Int64 is an alternative (QWord might have unintended side effects)
+ LARGE_INTEGER = packed record
+ case Boolean of
+ True:(LowPart: LongWord;
+ HighPart: LongInt);
+ False:(QuadPart: Int64);
+ end;
+ PLARGE_INTEGER = ^LARGE_INTEGER;
+ TLargeInteger = LARGE_INTEGER;
+ PLargeInteger = ^TLargeInteger;
+
+
+//
+// Object Attributes structure
+//
+ POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;
+ _OBJECT_ATTRIBUTES = record
+ Length: ULONG;
+ RootDirectory: HANDLE;
+ ObjectName: PUNICODE_STRING;
+ Attributes: ULONG;
+ SecurityDescriptor: PVOID; // Points to type SECURITY_DESCRIPTOR
+ SecurityQualityOfService: PVOID; // Points to type SECURITY_QUALITY_OF_SERVICE
+ end;
+ OBJECT_ATTRIBUTES = _OBJECT_ATTRIBUTES;
+ TObjectAttributes = OBJECT_ATTRIBUTES;
+ PObjectAttributes = POBJECT_ATTRIBUTES;
+
+ TRtlDriveLetterCurDir = packed record
+ Flags: Word;
+ Length: Word;
+ TimeStamp: LongWord;
+ DosPath: TNtUnicodeString;
+ end;
+
+ TCurDir = packed record
+ DosPath: TNtUnicodeString;
+ Handle: THandle;
+ end;
+
+ TRtlUserProcessParameters = packed record
+ MaximumLength: LongWord;
+ Length: LongWord;
+ Flags: LongWord;
+ DebugFlags: LongWord;
+ ConsoleHandle: THandle;
+ ConsoleFlags: LongWord;
+ StandardInput: THandle;
+ StandardOutput: THandle;
+ StandardError: THandle;
+ CurrentDirectory: TCurDir;
+ DllPath: TNtUnicodeString;
+ ImagePathName: TNtUnicodeString;
+ CommandLine: TNtUnicodeString;
+ Environment: ^Word; // PWSTR
+ StartingX: LongWord;
+ StartingY: LongWord;
+ CountX: LongWord;
+ CountY: LongWord;
+ CountCharsX: LongWord;
+ CountCharsY: LongWord;
+ FillAttribute: LongWord;
+ WindowFlags: LongWord;
+ ShowWindowFlags: LongWord;
+ WindowTitle: TNtUnicodeString;
+ DesktopInfo: TNtUnicodeString;
+ ShellInfo: TNtUnicodeString;
+ RuntimeData: TNtUnicodeString;
+ CurrentDirectories: array[0..31] of TRtlDriveLetterCurDir;
+ end;
+ PRtlUserProcessParameters = ^TRtlUserProcessParameters;
+
+ TSimplePEB = packed record
+ InheritedAddressSpace: Byte;
+ ReadImageFileExecOptions: Byte;
+ BeingDebugged: Byte;
+//#if (NTDDI_VERSION >= NTDDI_WS03)
+// struct
+ {
+ UCHAR ImageUsesLargePages:1;
+ #if (NTDDI_VERSION >= NTDDI_LONGHORN)
+ UCHAR IsProtectedProcess:1;
+ UCHAR IsLegacyProcess:1;
+ UCHAR SpareBits:5;
+ #else
+ UCHAR SpareBits:7;
+ #endif
+ }//;
+//#else
+ SpareBool: Byte;
+//#endif
+ Mutant: THandle;
+ ImageBaseAddress: Pointer;
+ Ldr: Pointer; // PPEB_LDR_DATA
+ ProcessParameters: PRtlUserProcessParameters;
+ SubSystemData: Pointer;
+ ProcessHeap: Pointer;
+//#if (NTDDI_VERSION >= NTDDI_LONGHORN)
+(* struct _RTL_CRITICAL_SECTION *FastPebLock;
+ PVOID AltThunkSListPtr;
+ PVOID IFEOKey;
+ ULONG Spare;
+ union
+ {
+ PVOID* KernelCallbackTable;
+ PVOID UserSharedInfoPtr;
+ };
+ ULONG SystemReserved[1];
+ ULONG SpareUlong;*)
+//#else
+ FastPebLock: Pointer;
+ FastPebLockRoutine: Pointer; // PPEBLOCKROUTINE
+ FastPebUnlockRoutine: Pointer; // PPEBLOCKROUTINE
+ EnvironmentUpdateCount: LongWord;
+ KernelCallbackTable: Pointer; // PVOID*
+ EventLogSection: Pointer;
+ EventLog: Pointer;
+//#endif
+ FreeList: Pointer; // PPEB_FREE_BLOCK
+ TlsExpansionCounter: LongWord;
+ TlsBitmap: Pointer;
+ TlsBitmapBits: array[0..1] of LongWord; //TlsBitmapBits[0x2]
+ ReadOnlySharedMemoryBase: Pointer;
+ ReadOnlySharedMemoryHeap: Pointer;
+ ReadOnlyStaticServerData: Pointer; //PVOID*
+ AnsiCodePageData: Pointer;
+ OemCodePageData: Pointer;
+ UnicodeCaseTableData: Pointer;
+ NumberOfProcessors: LongWord;
+ NtGlobalFlag: LongWord;
+ CriticalSectionTimeout: Int64; // LARGE_INTEGER
+ HeapSegmentReserve: LongWord;
+ HeapSegmentCommit: LongWord;
+ HeapDeCommitTotalFreeThreshold: LongWord;
+ HeapDeCommitFreeBlockThreshold: LongWord;
+ NumberOfHeaps: LongWord;
+ MaximumNumberOfHeaps: LongWord;
+ ProcessHeaps: Pointer; // PVOID*
+ GdiSharedHandleTable: Pointer;
+ ProcessStarterHelper: Pointer;
+ GdiDCAttributeList: LongWord;
+//#if (NTDDI_VERSION >= NTDDI_LONGHORN)
+// struct _RTL_CRITICAL_SECTION *LoaderLock;
+//#else
+ LoaderLock: Pointer;
+//#endif
+ OSMajorVersion: LongWord;
+ OSMinorVersion: LongWord;
+ OSBuildNumber: Word; // USHORT
+ OSCSDVersion: Word; // USHORT
+ OSPlatformId: LongWord;
+ ImageSubSystem: LongWord;
+ ImageSubSystemMajorVersion: LongWord;
+ ImageSubSystemMinorVersion: LongWord;
+ ImageProcessAffinityMask: LongWord;
+ GdiHandleBuffer: array[0..$21] of LongWord; // GdiHandleBuffer[0x22]
+ PostProcessInitRoutine: Pointer; //PPOST_PROCESS_INIT_ROUTINE
+ TlsExpansionBitmap: Pointer; //struct _RTL_BITMAP *TlsExpansionBitmap
+ TlsExpansionBitmapBits: array[0..$19] of Word; //TlsExpansionBitmapBits[0x20]
+ SessionId: LongWord;
+{#if (NTDDI_VERSION >= NTDDI_WINXP)
+ ULARGE_INTEGER AppCompatFlags;
+ ULARGE_INTEGER AppCompatFlagsUser;
+ PVOID pShimData;
+ PVOID AppCompatInfo;
+ UNICODE_STRING CSDVersion;
+ struct _ACTIVATION_CONTEXT_DATA *ActivationContextData;
+ struct _ASSEMBLY_STORAGE_MAP *ProcessAssemblyStorageMap;
+ struct _ACTIVATION_CONTEXT_DATA *SystemDefaultActivationContextData;
+ struct _ASSEMBLY_STORAGE_MAP *SystemAssemblyStorageMap;
+ ULONG MinimumStackCommit;
+#endif
+#if (NTDDI_VERSION >= NTDDI_WS03)
+ PVOID *FlsCallback;
+ LIST_ENTRY FlsListHead;
+ struct _RTL_BITMAP *FlsBitmap;
+ ULONG FlsBitmapBits[4];
+ ULONG FlsHighIndex;
+#endif
+#if (NTDDI_VERSION >= NTDDI_LONGHORN)
+ PVOID WerRegistrationData;
+ PVOID WerShipAssertPtr;
+#endif}
+ end;
+ PPEB = ^TSimplePEB;
+
+function NtDisplayString(aString: PNtUnicodeString): NTSTATUS; stdcall; external ntdll;
+
diff --git a/rtl/nativent/sysos.inc b/rtl/nativent/sysos.inc
new file mode 100644
index 0000000000..a3e0630d86
--- /dev/null
+++ b/rtl/nativent/sysos.inc
@@ -0,0 +1,18 @@
+{
+ Basic stuff for NativeNT RTLs
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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.
+
+ **********************************************************************}
+
+// some needed types from NDK.pas
+{$include sysndk.inc}
+
diff --git a/rtl/nativent/sysosh.inc b/rtl/nativent/sysosh.inc
new file mode 100644
index 0000000000..6cb478d6b4
--- /dev/null
+++ b/rtl/nativent/sysosh.inc
@@ -0,0 +1,58 @@
+{
+ Basic Native NT stuff
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ 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.
+
+ **********************************************************************}
+
+{ Platform specific information }
+type
+ THandle = Pointer;
+ ULONG_PTR = PtrUInt;
+ TThreadID = THandle;
+ SIZE_T = ULONG_PTR;
+
+ { the fields of this record are os dependent }
+ { and they shouldn't be used in a program }
+ { only the type TCriticalSection is important }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ DebugInfo : pointer;
+ LockCount : longint;
+ RecursionCount : longint;
+ OwningThread : THandle;
+ LockSemaphore : THandle;
+ SpinCount : ULONG_PTR;
+ end;
+
+var
+ { the following variables are only set if apptype=native and the RTL is
+ compiled with -dKMODE (device driver)
+ they are exported with their real types in unit DDK }
+ // real type: PNtUnicodeString; only valid during PascalMain
+ SysRegistryPath: Pointer = Nil;
+ // real type: PDriverObject; only valid during PascalMain
+ SysDriverObject: Pointer = Nil;
+
+type
+ TTagString = String[4];
+
+{$ifdef KMODE}
+const
+ DefaultPoolTag = 'fpc';
+
+var
+ // tells the heap whether to use paged memory or not
+ HeapUsePagedPool: Boolean = True;
+ // the tag is a four byte string to identify the memory allocated by our
+ // driver, which must not be empty
+ HeapPoolTag: TTagString = DefaultPoolTag;
+{$endif KMODE}
diff --git a/rtl/nativent/system.pp b/rtl/nativent/system.pp
new file mode 100644
index 0000000000..290938b22b
--- /dev/null
+++ b/rtl/nativent/system.pp
@@ -0,0 +1,218 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2009 by Sven Barth
+
+ FPC Pascal system unit for the WinNT API.
+
+ 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 System;
+interface
+
+{$ifdef SYSTEMDEBUG}
+ {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{.$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
+{$ifdef cpui386}
+ {$define Set_i386_Exception_handler}
+{$endif cpui386}
+
+{.$define DISABLE_NO_THREAD_MANAGER}
+
+{$ifdef KMODE}
+ {$define HAS_MEMORYMANAGER}
+{$endif KMODE}
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+var
+ CurrentPeb: Pointer;
+ IsDeviceDriver: Boolean = False;
+
+const
+ LineEnding = #13#10;
+ LFNSupport = true;
+ DirectorySeparator = '\';
+ DriveSeparator = '\';
+ ExtensionSeparator = '.';
+ PathSeparator = ';';
+ AllowDirectorySeparators : set of char = ['\'];
+ AllowDriveSeparators : set of char = [];
+
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = High(LongInt);
+ MaxPathLen = High(Word);
+ AllFilesMask = '*';
+
+type
+ PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+ TEXCEPTION_FRAME = record
+ next : PEXCEPTION_FRAME;
+ handler : pointer;
+ end;
+
+{$ifndef kmode}
+type
+ TDLL_Entry_Hook = procedure (dllparam : longint);
+
+const
+ Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
+{$endif}
+
+const
+ // NT is case sensitive
+ FileNameCaseSensitive : boolean = true;
+ // todo: check whether this is really the case on NT
+ CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+ sLineBreak = LineEnding;
+
+ { Thread count for DLL }
+ Thread_count : longint = 0;
+ System_exception_frame : PEXCEPTION_FRAME =nil;
+
+implementation
+
+{ include system independent routines }
+{$I system.inc}
+
+procedure KeQueryTickCount(TickCount: PLargeInteger); stdcall; external ntdll name 'KeQueryTickCount';
+
+procedure randomize;
+var
+ tc: PLargeInteger;
+begin
+ FillChar(tc, SizeOf(TLargeInteger), 0);
+ KeQueryTickCount(@tc);
+ // the lower part should differ most on system startup
+ randseed := tc^.LowPart;
+end;
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+procedure PascalMain;stdcall;external name 'PASCALMAIN';
+
+{$ifndef KMODE}
+function NtTerminateProcess(aProcess: THandle; aStatus: NTSTATUS): NTSTATUS; stdcall; external ntdll name 'NtTerminateProcess';
+{$endif KMODE}
+
+Procedure system_exit;
+begin
+ if IsLibrary or IsDeviceDriver then
+ Exit;
+{$ifndef KMODE}
+ NtTerminateProcess(THandle(-1), ExitCode);
+{$endif KMODE}
+end;
+
+{$ifdef kmode}
+function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): NTSTATUS; [public, alias: 'FPC_DriverStartup'];
+begin
+ IsDeviceDriver := True;
+ IsConsole := True;
+ IsLibrary := True;
+
+ SysDriverObject := aDriverObject;
+ SysRegistryPath := aRegistryPath;
+
+ PASCALMAIN;
+
+ SysDriverObject := Nil;
+ SysRegistryPath := Nil;
+
+ Result := ExitCode;
+end;
+{$else}
+
+const
+ DLL_PROCESS_ATTACH = 1;
+ DLL_THREAD_ATTACH = 2;
+ DLL_PROCESS_DETACH = 0;
+ DLL_THREAD_DETACH = 3;
+
+function FPCDLLEntry(aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt): LongBool; [public, alias: 'FPC_DLLEntry'];
+begin
+ IsLibrary := True;
+ FPCDLLEntry := True;
+ case aDLLReason of
+ DLL_PROCESS_ATTACH: begin
+ PascalMain;
+ FPCDLLEntry := ExitCode = 0;
+ end;
+ DLL_THREAD_ATTACH: begin
+ if Dll_Thread_Attach_Hook <> Nil then
+ Dll_Thread_Attach_Hook(aDllParam);
+ end;
+ DLL_THREAD_DETACH: begin
+ if Dll_Thread_Detach_Hook <> Nil then
+ Dll_Thread_Detach_Hook(aDllParam);
+ end;
+ DLL_PROCESS_DETACH: begin
+ if Dll_Process_Detach_Hook <> Nil then
+ Dll_Process_Detach_Hook(aDllParam);
+ // finalize units
+ do_exit;
+ end;
+ end;
+end;
+
+procedure FPCProcessStartup(aArgument: Pointer);[public, alias: 'FPC_ProcessStartup'];
+begin
+ IsConsole := True;
+ IsLibrary := False;
+ CurrentPeb := aArgument;
+
+ PASCALMAIN;
+
+ system_exit;
+end;
+{$endif}
+
+{$ifdef kmode}
+
+// Kernel Mode Entry Point
+
+function NtDriverEntry( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; stdcall; [public, alias: '_NtDriverEntry'];
+begin
+ NtDriverEntry := FPCDriverStartup(aDriverObject, aRegistryPath);
+end;
+{$else}
+
+// User Mode Entry Points
+
+procedure NtProcessStartup( aArgument: Pointer ); stdcall; [public, alias: '_NtProcessStartup'];
+begin
+ FPCProcessStartup(aArgument);
+end;
+
+function DLLMainStartup( aHInstance: Pointer; aDLLReason, aDLLParam: LongInt ): LongBool; stdcall; [public, alias: '_DLLMainStartup'];
+begin
+ DLLMainStartup := FPCDLLEntry(aHInstance, aDLLReason, aDLLParam);
+end;
+{$endif}
+
+begin
+{$if not defined(KMODE) and not defined(HAS_MEMORYMANAGER)}
+ { Setup heap }
+ InitHeap;
+{$endif ndef KMODE and ndef HAS_MEMORYMANAGER}
+ SysInitExceptions;
+ initvariantmanager;
+ { we do not use winlike widestrings and also the RTL can't be compiled with
+ 2.2, so we can savely use the UnicodeString manager only. }
+ initunicodestringmanager;
+end.
+