View Issue Details

IDProjectCategoryView StatusLast Update
0014887FPCRTLpublic2010-01-08 09:30
ReporterSven Barth Assigned ToFlorian  
PrioritynormalSeverityfeatureReproducibilityN/A
Status closedResolutionfixed 
Fixed in Version2.6.0 
Summary0014887: New RTL: Native NT user- and kernelmode
DescriptionHere's the RTL patch for the new Native NT target.

Whether one can use kernel- or usermode with this RTL is determined with a compiler define KMODE during compilation of the RTL.
This may seem a bit strange, but I didn't like the idea to add an extra target just for kernel mode. But this separation is needed, because the two modes follow different criterias:
* usermode code follows FPC's "write once, compile anywhere" approach (at least this is my goal)
* kernelmode code is VERY platform specific and complex (e. g. no full RTL)
Also using the kernel mode RTL is just a matter of compiling it with KMODE once, moving it to another directory and adjusting fpc.cfg.

Currently the only implemented RTL feature is the heap (usermode only). Also the RTL is currently not initialised in a DLL (some problems with heap-creation I'm facing).

Dynamical linked libraries (references solved by the OS) are working, but I have a problem with "GetProcAddress" in runtime linked ones (using "LoadLibrary).

Drivers are Libraries with {$apptype native} and need a RTL compiled with "-dKMODE". There is currently NO RTL code active in drivers (but PASCALMAIN is called and thus units are initialized).

I'm open to suggestions and/or corrections ;)
Additional InformationI added/stubbed the following units beside the normal RTL ones (similar to windows.pas ^^):

* NDK - Native Development Kit: basically methods from Jedi's jwanative.pas. But in Native NT this IS the OS interface so I need/want them in the RTL (some parts are also usable in kernelmode)
* NDKUtils: methods to ease the development with FPC on Native NT. For now it only contains a helper to convert ShortStrings to NtUnicodeString (also known as WideString - but that one is not implemented for now)
* DDK - Driver Development Kit: all methods and structures that are only useable/callable during driver development
TagsNo tags attached.
Fixed in Revision14568
FPCOldBugId
FPCTarget
Attached Files

Relationships

related to 0014886 closedFlorian New target: Native NT user- and kernelmode 

Activities

2009-10-24 14:33

 

nativent-rtl.patch (30,034 bytes)   
Index: rtl/Makefile.fpc
===================================================================
--- rtl/Makefile.fpc	(revision 13936)
+++ rtl/Makefile.fpc	(working copy)
@@ -31,6 +31,7 @@
 dirs_nds=nds
 dirs_symbian=symbian
 dirs_embedded=embedded
+dirs_nativent=nativent
 
 [install]
 fpcpackage=y

Property changes on: rtl\nativent
___________________________________________________________________
Added: bugtraq:url
   + http://mantis.freepascal.org/view.php?id=%BUGID%
Added: bugtraq:logregex
   + ([Ii]ssue|[Bb]ug|[Mm]antis|[Rr]esolve)s? #?(\d+)(,? ?#?(\d+))*(,? ?(and |or )?#?(\d+))?
(\d+)

Index: rtl/nativent/buildrtl.lpi
===================================================================
--- rtl/nativent/buildrtl.lpi	(revision 0)
+++ rtl/nativent/buildrtl.lpi	(revision 0)
@@ -0,0 +1,79 @@
+<?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="4">
+      <Unit0>
+        <Filename Value="buildrtl.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="buildrtl"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="ntmakefile.txt"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\ntmakefile.txt"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\test.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test"/>
+      </Unit3>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <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>
Index: rtl/nativent/buildrtl.pp
===================================================================
--- rtl/nativent/buildrtl.pp	(revision 0)
+++ rtl/nativent/buildrtl.pp	(revision 0)
@@ -0,0 +1,17 @@
+unit buildrtl;
+
+  interface
+
+    uses
+      sysinit,
+      ndk, ndkutils
+      {$ifdef KMODE}
+      , ddk
+      {$else}
+      // for now none
+      {$endif}
+      ;
+
+  implementation
+
+end.
Index: rtl/nativent/ddk.pas
===================================================================
--- rtl/nativent/ddk.pas	(revision 0)
+++ rtl/nativent/ddk.pas	(revision 0)
@@ -0,0 +1,85 @@
+{
+    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';
+
+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;
+
+function RegistryPath: PNtUnicodeString; inline;
+function DriverObject: PDriverObject; inline;
+
+function DbgPrint(aFormat: PChar): LongWord; cdecl; varargs; external ntkrnl;
+
+implementation
+
+function RegistryPath: PNtUnicodeString; inline;
+begin
+  RegistryPath := SysRegistryPath;
+end;
+
+function DriverObject: PDriverObject; inline;
+begin
+  DriverObject := SysDriverObject;
+end;
+
+end.
+
Index: rtl/nativent/Makefile.fpc
===================================================================
--- rtl/nativent/Makefile.fpc	(revision 0)
+++ rtl/nativent/Makefile.fpc	(revision 0)
@@ -0,0 +1,113 @@
+#
+#   Makefile.fpc for Free Pascal NativeNT RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=
+#units=system objpas macpas buildrtl lineinfo lnfodwrf
+units=system buildrtl
+implicitunits=sysinit 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)
+sourcedir=$(INC) $(PROCINC) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+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
+#
+
+#wprt0$(OEXT) : wprt0.as
+
+#gprt0$(OEXT) : gprt0.as
+
+#wdllprt0$(OEXT) : wdllprt0.as
+
+#wcygprt0$(OEXT) : wcygprt0.as
+
+#
+# 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) -I$(WININC) -Fu$(WININC) -Fu$(WINDIR) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
Index: rtl/nativent/ndk.pas
===================================================================
--- rtl/nativent/ndk.pas	(revision 0)
+++ rtl/nativent/ndk.pas	(revision 0)
@@ -0,0 +1,43 @@
+{
+    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}
+
+type
+  // using Int64 is an alternative (QWord might have unintended side effects)
+  TLargeInteger = packed record
+    case Boolean of
+      True:(LowPart: LongWord;
+            HighPart: LongInt);
+      False:(QuadPart: Int64);
+  end;
+  PLargeInteger = ^TLargeInteger;
+
+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.
+
Index: rtl/nativent/ndkutils.pas
===================================================================
--- rtl/nativent/ndkutils.pas	(revision 0)
+++ rtl/nativent/ndkutils.pas	(revision 0)
@@ -0,0 +1,47 @@
+{
+    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;
+
+end.
+
Index: rtl/nativent/sysdir.inc
===================================================================
--- rtl/nativent/sysdir.inc	(revision 0)
+++ rtl/nativent/sysdir.inc	(revision 0)
@@ -0,0 +1,20 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2009 by Sven Barth
+
+    FPC Pascal system unit for the NativeNT 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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+{ empty for now }
Index: rtl/nativent/sysheap.inc
===================================================================
--- rtl/nativent/sysheap.inc	(revision 0)
+++ rtl/nativent/sysheap.inc	(revision 0)
@@ -0,0 +1,47 @@
+{
+    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
+ ****************************************************************************}
+
+   { memory functions }
+   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';
+{$IFDEF SYSTEMDEBUG}
+   function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : DWord;
+     {$ifdef wince}cdecl{$else}stdcall{$endif};external 'kernel32' name 'HeapSize';
+{$ENDIF}
+
+function SysOSAlloc(size: ptruint): pointer;
+var
+  p : pointer;
+begin
+  p := RtlAllocateHeap(PPEB(CurrentPEB)^.ProcessHeap, 0, size);
+{$ifdef DUMPGROW}
+//  Writeln('new heap part at $',hexstr(p), ' size = ',WinAPIHeapSize(GetProcessHeap()));
+{$endif}
+  SysOSAlloc := p;
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+  RtlFreeHeap(PPEB(CurrentPEB)^.ProcessHeap, 0, p);
+end;
Index: rtl/nativent/sysinit.pp
===================================================================
--- rtl/nativent/sysinit.pp	(revision 0)
+++ rtl/nativent/sysinit.pp	(revision 0)
@@ -0,0 +1,43 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2009 Sven Barth
+
+    NativeNT 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
+
+{$ifdef kmode}
+    function FPCDriverStartup( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; external name 'FPC_DriverStartup';
+
+    function NtDriverEntry( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; stdcall; [public, alias: '_NtDriverEntry'];
+    begin
+      NtDriverEntry := FPCDriverStartup(aDriverObject, aRegistryPath);
+    end;
+{$else}
+    procedure FPCProcessStartup( aArgument : Pointer ); external name 'FPC_ProcessStartup';
+    function FPCDLLEntry( aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt ): LongBool; external name 'FPC_DLLEntry';
+
+    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}
+
+end.
Index: rtl/nativent/sysndk.inc
===================================================================
--- rtl/nativent/sysndk.inc	(revision 0)
+++ rtl/nativent/sysndk.inc	(revision 0)
@@ -0,0 +1,182 @@
+// These datatypes are used in system.pas and ndk.pas
+
+const
+{$ifdef kmode}
+  ntdll = 'ntoskrnl.exe';
+{$else}
+  ntdll = 'ntdll.dll';
+{$endif}
+
+type
+  NTSTATUS = LongInt;
+
+  { to differentiate from the other UTF-16      }
+  { I renamed it from UNICODE_STRING to         }
+  { TNtUnicodeString                            }
+  TNtUnicodeString = packed record
+    Length: Word;        // used characters in buffer
+    MaximumLength: Word; // maximum characters in buffer
+    Buffer: PWideChar;
+  end;
+  PNtUnicodeString = ^TNtUnicodeString;
+
+  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;
+
Index: rtl/nativent/sysos.inc
===================================================================
--- rtl/nativent/sysos.inc	(revision 0)
+++ rtl/nativent/sysos.inc	(revision 0)
@@ -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}
+
Index: rtl/nativent/sysosh.inc
===================================================================
--- rtl/nativent/sysosh.inc	(revision 0)
+++ rtl/nativent/sysosh.inc	(revision 0)
@@ -0,0 +1,42 @@
+{
+    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 = Pointer;
+  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 when apptype=native (device driver)
+  // real type: PNtUnicodeString; only valid during PascalMain
+  SysRegistryPath: Pointer = Nil;
+  // real type: PDriverObject; only valid during PascalMain (?)
+  SysDriverObject: Pointer = Nil;
+
Index: rtl/nativent/system.pp
===================================================================
--- rtl/nativent/system.pp	(revision 0)
+++ rtl/nativent/system.pp	(revision 0)
@@ -0,0 +1,160 @@
+{
+    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}
+
+// to simplify rtl development we control the implemented/activated features
+// here and not in the compiler
+{$define FPC_HAS_FEATURE_SUPPORT}
+// needed by FEATURE_ANSISTRINGS
+{$define FPC_HAS_FEATURE_HEAP}
+{$undef FPC_HAS_FEATURE_INITFINAL}
+{$undef FPC_HAS_FEATURE_RTTI}
+{$undef FPC_HAS_FEATURE_CLASSES}
+{$undef FPC_HAS_FEATURE_EXCEPTIONS}
+{$undef FPC_HAS_FEATURE_EXITCODE}
+{$undef FPC_HAS_FEATURE_ANSISTRINGS}
+{$undef FPC_HAS_FEATURE_WIDESTRINGS}
+{$undef FPC_HAS_FEATURE_TEXTIO}
+{$undef FPC_HAS_FEATURE_CONSOLEIO}
+{$undef FPC_HAS_FEATURE_FILEIO}
+{$undef FPC_HAS_FEATURE_RANDOM}
+{$undef FPC_HAS_FEATURE_VARIANTS}
+{$undef FPC_HAS_FEATURE_OBJECTS}
+{$undef FPC_HAS_FEATURE_DYNARRAYS}
+{$undef FPC_HAS_FEATURE_THREADING}
+{$undef FPC_HAS_FEATURE_COMMANDARGS}
+{$undef FPC_HAS_FEATURE_PROCESSES}
+{$undef FPC_HAS_FEATURE_STACKCHECK}
+{$undef FPC_HAS_FEATURE_DYNLIBS}
+{$undef FPC_HAS_FEATURE_OBJECTIVEC1}
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+var
+  CurrentPeb: Pointer;
+  IsDeviceDriver: Boolean = False;
+  // Exitstatus of the driver (NTSTATUS)
+  DriverStatus: LongInt = 0;
+
+const
+ LineEnding = #13#10;
+ LFNSupport = true;
+ DirectorySeparator = '\';
+ DriveSeparator = '\';
+ ExtensionSeparator = '.';
+ PathSeparator = ';';
+ AllowDirectorySeparators : set of char = ['\'];
+ AllowDriveSeparators : set of char = [];
+
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 65535;
+ MaxPathLen = 260;
+ AllFilesMask = '*';
+
+type
+   PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+   TEXCEPTION_FRAME = record
+     next : PEXCEPTION_FRAME;
+     handler : pointer;
+   end;
+
+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}
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+
+{.$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+procedure PascalMain;stdcall;external name 'PASCALMAIN';
+{.$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
+function NtTerminateProcess(aProcess: THandle; aStatus: NTSTATUS): NTSTATUS; stdcall; external ntdll;
+
+Procedure system_exit;
+begin
+  if IsLibrary or IsDeviceDriver then
+    Exit;
+  NtTerminateProcess(THandle(-1), 0{ExitCode});
+end;
+
+{$ifdef kmode}
+function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): LongInt; [public, alias: 'FPC_DriverStartup'];
+begin
+  IsDeviceDriver := True;
+  SysDriverObject := aDriverObject;
+  SysRegistryPath := aRegistryPath;
+
+  PASCALMAIN;
+
+  Result := DriverStatus;
+end;
+{$else}
+
+function FPCDLLEntry(aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt): LongBool; [public, alias: 'FPC_DLLEntry'];
+begin
+  IsLibrary := True;
+  FPCDLLEntry := True;
+  // todo: call PascalMain
+end;
+
+procedure FPCProcessStartup(aArgument: Pointer);[public, alias: 'FPC_ProcessStartup'];
+begin
+  IsConsole := True;
+  IsLibrary := False;
+  CurrentPeb := aArgument;
+
+  PASCALMAIN;
+
+  system_exit;
+end;
+{$endif}
+
+begin
+  // do not init any RTL parts inside a device driver!
+{$ifndef kmode}
+  { Setup heap }
+  InitHeap;
+{$endif}
+end.
+
nativent-rtl.patch (30,034 bytes)   

2009-10-26 09:19

 

nativent-rtl-2.patch (29,633 bytes)   
Index: rtl/Makefile.fpc
===================================================================
--- rtl/Makefile.fpc	(revision 13936)
+++ rtl/Makefile.fpc	(working copy)
@@ -31,6 +31,7 @@
 dirs_nds=nds
 dirs_symbian=symbian
 dirs_embedded=embedded
+dirs_nativent=nativent
 
 [install]
 fpcpackage=y

Property changes on: rtl\nativent
___________________________________________________________________
Added: bugtraq:url
   + http://mantis.freepascal.org/view.php?id=%BUGID%
Added: bugtraq:logregex
   + ([Ii]ssue|[Bb]ug|[Mm]antis|[Rr]esolve)s? #?(\d+)(,? ?#?(\d+))*(,? ?(and |or )?#?(\d+))?
(\d+)

Index: rtl/nativent/buildrtl.lpi
===================================================================
--- rtl/nativent/buildrtl.lpi	(revision 0)
+++ rtl/nativent/buildrtl.lpi	(revision 0)
@@ -0,0 +1,66 @@
+<?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>
+      <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>
Index: rtl/nativent/buildrtl.pp
===================================================================
--- rtl/nativent/buildrtl.pp	(revision 0)
+++ rtl/nativent/buildrtl.pp	(revision 0)
@@ -0,0 +1,17 @@
+unit buildrtl;
+
+  interface
+
+    uses
+      sysinit,
+      ndk, ndkutils
+      {$ifdef KMODE}
+      , ddk
+      {$else}
+      // for now none
+      {$endif}
+      ;
+
+  implementation
+
+end.
Index: rtl/nativent/ddk.pas
===================================================================
--- rtl/nativent/ddk.pas	(revision 0)
+++ rtl/nativent/ddk.pas	(revision 0)
@@ -0,0 +1,85 @@
+{
+    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';
+
+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;
+
+function RegistryPath: PNtUnicodeString; inline;
+function DriverObject: PDriverObject; inline;
+
+function DbgPrint(aFormat: PChar): LongWord; cdecl; varargs; external ntkrnl;
+
+implementation
+
+function RegistryPath: PNtUnicodeString; inline;
+begin
+  RegistryPath := SysRegistryPath;
+end;
+
+function DriverObject: PDriverObject; inline;
+begin
+  DriverObject := SysDriverObject;
+end;
+
+end.
+
Index: rtl/nativent/Makefile.fpc
===================================================================
--- rtl/nativent/Makefile.fpc	(revision 0)
+++ rtl/nativent/Makefile.fpc	(revision 0)
@@ -0,0 +1,113 @@
+#
+#   Makefile.fpc for Free Pascal NativeNT RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=
+#units=system objpas macpas buildrtl lineinfo lnfodwrf
+units=system buildrtl
+implicitunits=sysinit 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)
+sourcedir=$(INC) $(PROCINC) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+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
+#
+
+#wprt0$(OEXT) : wprt0.as
+
+#gprt0$(OEXT) : gprt0.as
+
+#wdllprt0$(OEXT) : wdllprt0.as
+
+#wcygprt0$(OEXT) : wcygprt0.as
+
+#
+# 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) -I$(WININC) -Fu$(WININC) -Fu$(WINDIR) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
Index: rtl/nativent/ndk.pas
===================================================================
--- rtl/nativent/ndk.pas	(revision 0)
+++ rtl/nativent/ndk.pas	(revision 0)
@@ -0,0 +1,43 @@
+{
+    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}
+
+type
+  // using Int64 is an alternative (QWord might have unintended side effects)
+  TLargeInteger = packed record
+    case Boolean of
+      True:(LowPart: LongWord;
+            HighPart: LongInt);
+      False:(QuadPart: Int64);
+  end;
+  PLargeInteger = ^TLargeInteger;
+
+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.
+
Index: rtl/nativent/ndkutils.pas
===================================================================
--- rtl/nativent/ndkutils.pas	(revision 0)
+++ rtl/nativent/ndkutils.pas	(revision 0)
@@ -0,0 +1,47 @@
+{
+    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;
+
+end.
+
Index: rtl/nativent/sysdir.inc
===================================================================
--- rtl/nativent/sysdir.inc	(revision 0)
+++ rtl/nativent/sysdir.inc	(revision 0)
@@ -0,0 +1,20 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2009 by Sven Barth
+
+    FPC Pascal system unit for the NativeNT 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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+{ empty for now }
Index: rtl/nativent/sysheap.inc
===================================================================
--- rtl/nativent/sysheap.inc	(revision 0)
+++ rtl/nativent/sysheap.inc	(revision 0)
@@ -0,0 +1,47 @@
+{
+    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
+ ****************************************************************************}
+
+   { memory functions }
+   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';
+{$IFDEF SYSTEMDEBUG}
+   function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : DWord;
+     {$ifdef wince}cdecl{$else}stdcall{$endif};external 'kernel32' name 'HeapSize';
+{$ENDIF}
+
+function SysOSAlloc(size: ptruint): pointer;
+var
+  p : pointer;
+begin
+  p := RtlAllocateHeap(PPEB(CurrentPEB)^.ProcessHeap, 0, size);
+{$ifdef DUMPGROW}
+//  Writeln('new heap part at $',hexstr(p), ' size = ',WinAPIHeapSize(GetProcessHeap()));
+{$endif}
+  SysOSAlloc := p;
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+  RtlFreeHeap(PPEB(CurrentPEB)^.ProcessHeap, 0, p);
+end;
Index: rtl/nativent/sysinit.pp
===================================================================
--- rtl/nativent/sysinit.pp	(revision 0)
+++ rtl/nativent/sysinit.pp	(revision 0)
@@ -0,0 +1,43 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2009 Sven Barth
+
+    NativeNT 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
+
+{$ifdef kmode}
+    function FPCDriverStartup( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; external name 'FPC_DriverStartup';
+
+    function NtDriverEntry( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; stdcall; [public, alias: '_NtDriverEntry'];
+    begin
+      NtDriverEntry := FPCDriverStartup(aDriverObject, aRegistryPath);
+    end;
+{$else}
+    procedure FPCProcessStartup( aArgument : Pointer ); external name 'FPC_ProcessStartup';
+    function FPCDLLEntry( aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt ): LongBool; external name 'FPC_DLLEntry';
+
+    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}
+
+end.
Index: rtl/nativent/sysndk.inc
===================================================================
--- rtl/nativent/sysndk.inc	(revision 0)
+++ rtl/nativent/sysndk.inc	(revision 0)
@@ -0,0 +1,182 @@
+// These datatypes are used in system.pas and ndk.pas
+
+const
+{$ifdef kmode}
+  ntdll = 'ntoskrnl.exe';
+{$else}
+  ntdll = 'ntdll.dll';
+{$endif}
+
+type
+  NTSTATUS = LongInt;
+
+  { to differentiate from the other UTF-16      }
+  { I renamed it from UNICODE_STRING to         }
+  { TNtUnicodeString                            }
+  TNtUnicodeString = packed record
+    Length: Word;        // used characters in buffer
+    MaximumLength: Word; // maximum characters in buffer
+    Buffer: PWideChar;
+  end;
+  PNtUnicodeString = ^TNtUnicodeString;
+
+  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;
+
Index: rtl/nativent/sysos.inc
===================================================================
--- rtl/nativent/sysos.inc	(revision 0)
+++ rtl/nativent/sysos.inc	(revision 0)
@@ -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}
+
Index: rtl/nativent/sysosh.inc
===================================================================
--- rtl/nativent/sysosh.inc	(revision 0)
+++ rtl/nativent/sysosh.inc	(revision 0)
@@ -0,0 +1,42 @@
+{
+    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 = Pointer;
+  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 when apptype=native (device driver)
+  // real type: PNtUnicodeString; only valid during PascalMain
+  SysRegistryPath: Pointer = Nil;
+  // real type: PDriverObject; only valid during PascalMain (?)
+  SysDriverObject: Pointer = Nil;
+
Index: rtl/nativent/system.pp
===================================================================
--- rtl/nativent/system.pp	(revision 0)
+++ rtl/nativent/system.pp	(revision 0)
@@ -0,0 +1,160 @@
+{
+    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}
+
+// to simplify rtl development we control the implemented/activated features
+// here and not in the compiler
+{$define FPC_HAS_FEATURE_SUPPORT}
+// needed by FEATURE_ANSISTRINGS
+{$define FPC_HAS_FEATURE_HEAP}
+{$undef FPC_HAS_FEATURE_INITFINAL}
+{$undef FPC_HAS_FEATURE_RTTI}
+{$undef FPC_HAS_FEATURE_CLASSES}
+{$undef FPC_HAS_FEATURE_EXCEPTIONS}
+{$undef FPC_HAS_FEATURE_EXITCODE}
+{$undef FPC_HAS_FEATURE_ANSISTRINGS}
+{$undef FPC_HAS_FEATURE_WIDESTRINGS}
+{$undef FPC_HAS_FEATURE_TEXTIO}
+{$undef FPC_HAS_FEATURE_CONSOLEIO}
+{$undef FPC_HAS_FEATURE_FILEIO}
+{$undef FPC_HAS_FEATURE_RANDOM}
+{$undef FPC_HAS_FEATURE_VARIANTS}
+{$undef FPC_HAS_FEATURE_OBJECTS}
+{$undef FPC_HAS_FEATURE_DYNARRAYS}
+{$undef FPC_HAS_FEATURE_THREADING}
+{$undef FPC_HAS_FEATURE_COMMANDARGS}
+{$undef FPC_HAS_FEATURE_PROCESSES}
+{$undef FPC_HAS_FEATURE_STACKCHECK}
+{$undef FPC_HAS_FEATURE_DYNLIBS}
+{$undef FPC_HAS_FEATURE_OBJECTIVEC1}
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+var
+  CurrentPeb: Pointer;
+  IsDeviceDriver: Boolean = False;
+  // Exitstatus of the driver (NTSTATUS)
+  DriverStatus: LongInt = 0;
+
+const
+ LineEnding = #13#10;
+ LFNSupport = true;
+ DirectorySeparator = '\';
+ DriveSeparator = '\';
+ ExtensionSeparator = '.';
+ PathSeparator = ';';
+ AllowDirectorySeparators : set of char = ['\'];
+ AllowDriveSeparators : set of char = [];
+
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 65535;
+ MaxPathLen = 260;
+ AllFilesMask = '*';
+
+type
+   PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+   TEXCEPTION_FRAME = record
+     next : PEXCEPTION_FRAME;
+     handler : pointer;
+   end;
+
+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}
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+
+{.$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+procedure PascalMain;stdcall;external name 'PASCALMAIN';
+{.$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
+function NtTerminateProcess(aProcess: THandle; aStatus: NTSTATUS): NTSTATUS; stdcall; external ntdll;
+
+Procedure system_exit;
+begin
+  if IsLibrary or IsDeviceDriver then
+    Exit;
+  NtTerminateProcess(THandle(-1), 0{ExitCode});
+end;
+
+{$ifdef kmode}
+function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): LongInt; [public, alias: 'FPC_DriverStartup'];
+begin
+  IsDeviceDriver := True;
+  SysDriverObject := aDriverObject;
+  SysRegistryPath := aRegistryPath;
+
+  PASCALMAIN;
+
+  Result := DriverStatus;
+end;
+{$else}
+
+function FPCDLLEntry(aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt): LongBool; [public, alias: 'FPC_DLLEntry'];
+begin
+  IsLibrary := True;
+  FPCDLLEntry := True;
+  // todo: call PascalMain
+end;
+
+procedure FPCProcessStartup(aArgument: Pointer);[public, alias: 'FPC_ProcessStartup'];
+begin
+  IsConsole := True;
+  IsLibrary := False;
+  CurrentPeb := aArgument;
+
+  PASCALMAIN;
+
+  system_exit;
+end;
+{$endif}
+
+begin
+  // do not init any RTL parts inside a device driver!
+{$ifndef kmode}
+  { Setup heap }
+  InitHeap;
+{$endif}
+end.
+
nativent-rtl-2.patch (29,633 bytes)   

Sven Barth

2009-10-26 09:20

manager   ~0031674

I just realized that buildrtl.lpi contained unrelated files as part of the project... I uploaded a corrected patch :)

Sven Barth

2009-12-09 21:53

manager   ~0032863

As mentioned in the compiler issue I've improved the NativeNT target.
Most of the features of the RTL are implemented with IO and Threading being left. Also I was able to implement them in user AND kernel mode (yes, one can use TObject and exceptions in drivers :D ).

For kernel mode I also implemented a (non) memory manager, which is needed because of the special requirments that exist in kernel mode.

I also decided to split up DDK and NDK units in include files (similar to Windows unit) grouped by the corresponding kernel components (well... I did with DDK - NDK is only planned for now ;) ).

Things that are next on my list (regarding this "project"):
* write some articles for the wiki (including examples)
* implement IO
* implement threading
* get all other RTL units working

By the way: how can I create documentation for the NDK and DDK units? I'm aware that you didn't document the Windows unit because it's documented in Delphi help and in MSDN, but the interface to the kernel is mostly undocumented (most of the time I'm digging around in ReactOS' source code)

As in the compiler update I'd like to know any reasons for not commiting this patch :)

2010-01-02 16:59

 

nativent-rtl-3.patch (36,042 bytes)   
Index: rtl/Makefile.fpc
===================================================================
--- rtl/Makefile.fpc	(revision 14375)
+++ rtl/Makefile.fpc	(working copy)
@@ -31,6 +31,7 @@
 dirs_nds=nds
 dirs_symbian=symbian
 dirs_embedded=embedded
+dirs_nativent=nativent
 
 [install]
 fpcpackage=y

Property changes on: rtl\nativent
___________________________________________________________________
Added: bugtraq:url
   + http://mantis.freepascal.org/view.php?id=%BUGID%
Added: bugtraq:logregex
   + ([Ii]ssue|[Bb]ug|[Mm]antis|[Rr]esolve)s? #?(\d+)(,? ?#?(\d+))*(,? ?(and |or )?#?(\d+))?
(\d+)

Index: rtl/nativent/buildrtl.lpi
===================================================================
--- rtl/nativent/buildrtl.lpi	(revision 0)
+++ rtl/nativent/buildrtl.lpi	(revision 0)
@@ -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>
Index: rtl/nativent/buildrtl.pp
===================================================================
--- rtl/nativent/buildrtl.pp	(revision 0)
+++ rtl/nativent/buildrtl.pp	(revision 0)
@@ -0,0 +1,10 @@
+unit buildrtl;
+
+  interface
+
+    uses
+      ndk, ndkutils, ddk;
+
+  implementation
+
+end.

Property changes on: rtl\nativent\ddk
___________________________________________________________________
Added: bugtraq:url
   + http://mantis.freepascal.org/view.php?id=%BUGID%
Added: bugtraq:logregex
   + ([Ii]ssue|[Bb]ug|[Mm]antis|[Rr]esolve)s? #?(\d+)(,? ?#?(\d+))*(,? ?(and |or )?#?(\d+))?
(\d+)

Index: rtl/nativent/ddk.pas
===================================================================
--- rtl/nativent/ddk.pas	(revision 0)
+++ rtl/nativent/ddk.pas	(revision 0)
@@ -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.
+
Index: rtl/nativent/ddk/ddkex.inc
===================================================================
--- rtl/nativent/ddk/ddkex.inc	(revision 0)
+++ rtl/nativent/ddk/ddkex.inc	(revision 0)
@@ -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';
+
Index: rtl/nativent/ddk/ddktypes.inc
===================================================================
--- rtl/nativent/ddk/ddktypes.inc	(revision 0)
+++ rtl/nativent/ddk/ddktypes.inc	(revision 0)
@@ -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;
+
Index: rtl/nativent/Makefile.fpc
===================================================================
--- rtl/nativent/Makefile.fpc	(revision 0)
+++ rtl/nativent/Makefile.fpc	(revision 0)
@@ -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
Index: rtl/nativent/ndk.pas
===================================================================
--- rtl/nativent/ndk.pas	(revision 0)
+++ rtl/nativent/ndk.pas	(revision 0)
@@ -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.
+
Index: rtl/nativent/ndkutils.pas
===================================================================
--- rtl/nativent/ndkutils.pas	(revision 0)
+++ rtl/nativent/ndkutils.pas	(revision 0)
@@ -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.
+
Index: rtl/nativent/sysheap.inc
===================================================================
--- rtl/nativent/sysheap.inc	(revision 0)
+++ rtl/nativent/sysheap.inc	(revision 0)
@@ -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}
Index: rtl/nativent/sysndk.inc
===================================================================
--- rtl/nativent/sysndk.inc	(revision 0)
+++ rtl/nativent/sysndk.inc	(revision 0)
@@ -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;
+
Index: rtl/nativent/sysos.inc
===================================================================
--- rtl/nativent/sysos.inc	(revision 0)
+++ rtl/nativent/sysos.inc	(revision 0)
@@ -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}
+
Index: rtl/nativent/sysosh.inc
===================================================================
--- rtl/nativent/sysosh.inc	(revision 0)
+++ rtl/nativent/sysosh.inc	(revision 0)
@@ -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}
Index: rtl/nativent/system.pp
===================================================================
--- rtl/nativent/system.pp	(revision 0)
+++ rtl/nativent/system.pp	(revision 0)
@@ -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.
+
nativent-rtl-3.patch (36,042 bytes)   

Sven Barth

2010-01-02 17:00

manager   ~0033432

I just realized that I forgot to add the updated patch after my last note. *blush*

Florian

2010-01-07 19:47

administrator   ~0033500

Thanks for the patch.

Sven Barth

2010-01-08 09:30

manager   ~0033508

Thanks for applying. I'm looking forward to a "svn up" this evening ;)

Issue History

Date Modified Username Field Change
2009-10-24 14:33 Sven Barth New Issue
2009-10-24 14:33 Sven Barth File Added: nativent-rtl.patch
2009-10-26 09:19 Sven Barth File Added: nativent-rtl-2.patch
2009-10-26 09:20 Sven Barth Note Added: 0031674
2009-12-09 21:53 Sven Barth Note Added: 0032863
2009-12-13 21:20 Marco van de Voort Relationship added related to 0014886
2010-01-02 16:59 Sven Barth File Added: nativent-rtl-3.patch
2010-01-02 17:00 Sven Barth Note Added: 0033432
2010-01-07 19:47 Florian Fixed in Revision => 14568
2010-01-07 19:47 Florian Status new => resolved
2010-01-07 19:47 Florian Fixed in Version => 2.5.1
2010-01-07 19:47 Florian Resolution open => fixed
2010-01-07 19:47 Florian Assigned To => Florian
2010-01-07 19:47 Florian Note Added: 0033500
2010-01-08 09:30 Sven Barth Status resolved => closed
2010-01-08 09:30 Sven Barth Note Added: 0033508