o update by Sven Barth to the NativeNT RTL:

* Many more RTL units are enabled now, like SysUtils, Classes, Math, FGL, etc and Text-, File- and ConsoleIO features are enabled now as well (Threading and Processes are enabled, too, but their implementations are only stubs!). ConsoleIO isn't tested though, because the processes that are started by SMSS have their Standard Handles set to 0.

git-svn-id: trunk@16553 -

.gitattributes

@@ -7041,16 +7041,34 @@ rtl/morphos/videodata.inc svneol=native#text/plain
 rtl/nativent/Makefile.fpc svneol=native#text/plain
 rtl/nativent/buildrtl.lpi svneol=native#text/plain
 rtl/nativent/buildrtl.pp svneol=native#text/pascal
+rtl/nativent/classes.pp svneol=native#text/pascal
 rtl/nativent/ddk.pas svneol=native#text/pascal
 rtl/nativent/ddk/ddkex.inc svneol=native#text/plain
 rtl/nativent/ddk/ddktypes.inc svneol=native#text/plain
 rtl/nativent/ndk.pas svneol=native#text/pascal
+rtl/nativent/ndk/iofuncs.inc svneol=native#text/plain
+rtl/nativent/ndk/iotypes.inc svneol=native#text/plain
+rtl/nativent/ndk/ketypes.inc svneol=native#text/plain
+rtl/nativent/ndk/ntdef.inc svneol=native#text/plain
+rtl/nativent/ndk/ntstatus.inc svneol=native#text/plain
+rtl/nativent/ndk/obfuncs.inc svneol=native#text/plain
+rtl/nativent/ndk/peb_teb.inc svneol=native#text/plain
+rtl/nativent/ndk/pstypes.inc svneol=native#text/plain
+rtl/nativent/ndk/rtlfuncs.inc svneol=native#text/plain
+rtl/nativent/ndk/rtltypes.inc svneol=native#text/plain
+rtl/nativent/ndk/umtypes.inc svneol=native#text/plain
+rtl/nativent/ndk/winnt.inc svneol=native#text/plain
 rtl/nativent/ndkutils.pas svneol=native#text/pascal
+rtl/nativent/sysdir.inc svneol=native#text/plain
+rtl/nativent/sysfile.inc svneol=native#text/plain
 rtl/nativent/sysheap.inc svneol=native#text/plain
-rtl/nativent/sysndk.inc svneol=native#text/plain
 rtl/nativent/sysos.inc svneol=native#text/plain
 rtl/nativent/sysosh.inc svneol=native#text/plain
 rtl/nativent/system.pp svneol=native#text/pascal
+rtl/nativent/systhrd.inc svneol=native#text/plain
+rtl/nativent/sysutils.pp svneol=native#text/pascal
+rtl/nativent/tthread.inc svneol=native#text/plain
+rtl/nativent/varutils.pp svneol=native#text/pascal
 rtl/nds/Makefile svneol=native#text/plain
 rtl/nds/Makefile.fpc svneol=native#text/plain
 rtl/nds/classes.pp svneol=native#text/plain

rtl/nativent/Makefile.fpc

@@ -8,18 +8,20 @@ main=rtl
 [target]
 loaders=
 #units=system objpas macpas iso7185 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
+units=system objpas iso7185 buildrtl
+implicitunits=ndk ndkutils ddk \
+      ctypes strings \
+#      heaptrc
+      matrix \
+#      initc cmem dynlibs signals \
+#      dos crt objects \
+      rtlconsts sysconst sysutils math types \
+      strutils dateutils varutils variants typinfo fgl classes \
+      convutils stdconvs $(CPU_UNITS) charset ucomplex getopts \
+#      sockets printer \
+#      video mouse keyboard
+       fmtbcd #\
+#      sharemem exeinfo fpintres
 
 # shared=$(DLLS)
 
@@ -36,7 +38,7 @@ fpcdir=../..
 target=nativent
 
 [compiler]
-includedir=$(INC) $(PROCINC) $(DDKINC)
+includedir=$(INC) $(PROCINC) $(DDKINC) $(NDKINC)
 sourcedir=$(INC) $(PROCINC) $(COMMON)
 
 
@@ -46,9 +48,20 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 DDKINC=ddk
+NDKINC=ndk
 
 UNITPREFIX=rtl
 
+CPU_UNITS=
+
+ifeq ($(ARCH),i386)
+CPU_UNITS=x86 cpu mmx
+endif
+
+ifeq ($(ARCH),x86_64)
+CPU_UNITS=x86 cpu
+endif
+
 ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
 #LOADERS=wprt0 wdllprt0 gprt0 wcygprt0
 DLLS=
@@ -101,8 +114,8 @@ system$(PPUEXT) : system.pp $(SYSDEPS)
 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)
+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

rtl/nativent/buildrtl.pp

@@ -3,7 +3,20 @@ unit buildrtl;
   interface
 
     uses
-      ndk, ndkutils, ddk;
+      ndk, ndkutils, ddk,
+      ctypes, strings,
+      matrix,
+      rtlconsts, sysconst, sysutils, math, types,
+      strutils, dateutils, varutils, variants, typinfo, fgl, classes,
+      convutils, stdconvs,
+{$ifdef cpui386}
+      mmx, cpu,
+{$endif}
+{$ifdef cpux86_64}
+      cpu,
+{$endif}
+      charset, ucomplex, getopts,
+      fmtbcd;
 
   implementation
 

rtl/nativent/classes.pp

@@ -0,0 +1,52 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2010 by Sven Barth
+
+    Classes unit for NativeNT
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+{$INLINE ON}
+
+interface
+
+uses
+  sysutils,
+  types,
+  typinfo,
+{$ifdef FPC_TESTGENERICS}
+  fgl,
+{$endif}
+  rtlconsts;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  NDK
+  ;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+finalization
+  CommonCleanup;
+end.

rtl/nativent/ndk.pas

@@ -2,7 +2,7 @@
     Native Development Kit for Native NT
 
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2009 by Sven Barth
+    Copyright (c) 2009-2010 by Sven Barth
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -17,17 +17,82 @@ unit NDK;
 
 interface
 
-{$I sysndk.inc}
+const
+{$ifdef kmode}
+  ntdll = 'ntoskrnl.exe';
+{$else}
+  ntdll = 'ntdll.dll';
+{$endif}
 
-function NtDelayExecution(aAlertable: Boolean; aInterval: PLargeInteger): NTSTATUS; stdcall; external ntdll;
+{$calling stdcall}
 
+{$include ntdef.inc}
+{$include winnt.inc}
 
-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;
+{$include ntstatus.inc}
 
+{$include umtypes.inc}
+{$include iotypes.inc}
+{$include rtltypes.inc}
+{$include ketypes.inc}
+{$include pstypes.inc}
+{$include peb_teb.inc}
+
+{$include rtlfuncs.inc}
+{$include iofuncs.inc}
+{$include obfuncs.inc}
+
+function NtClose(Handle: HANDLE): NTSTATUS; stdcall; external ntdll;
+
+function NtDelayExecution(aAlertable: NT_BOOLEAN; aInterval: PLARGE_INTEGER): NTSTATUS; stdcall; external ntdll;
+function NtDisplayString(aString: PUNICODE_STRING): NTSTATUS; stdcall; external ntdll;
+
+function LdrGetProcedureAddress(hModule: HANDLE; psName: PUNICODE_STRING; dwOrdinal: LongWord; var pProcedure: PVOID): NTSTATUS; stdcall; external ntdll;
+function LdrLoadDll(pwPath : PWord; pdwFlags : LongWord; pusPath : PUNICODE_STRING; var phModule : HANDLE): NTSTATUS; stdcall; external ntdll;
+function LdrUnloadDll(hModule: HANDLE): NTSTATUS; stdcall; external ntdll;
 
 implementation
 
+function SharedUserData: PKUSER_SHARED_DATA; register;
+begin
+  { this is a pointer to a page that is mapped into every process by the kernel
+  }
+  SharedUserData := PKUSER_SHARED_DATA(USER_SHARED_DATA);
+end;
+
+procedure InitializeObjectAttributes(var aObjectAttr: OBJECT_ATTRIBUTES;
+    aName: PUNICODE_STRING; aAttributes: ULONG; aRootDir: HANDLE;
+    aSecurity: Pointer {PSECURITY_DESCRIPTOR}); register;
+begin
+  with aObjectAttr do begin
+    Length := SizeOf(OBJECT_ATTRIBUTES);
+    RootDirectory := aRootDir;
+    Attributes := aAttributes;
+    ObjectName := aName;
+    SecurityDescriptor := aSecurity;
+    SecurityQualityOfService := Nil;
+  end;
+end;
+
+function NT_SUCCESS(Status: NTSTATUS): Boolean; register;
+begin
+  NT_SUCCESS := Status >= 0;
+end;
+
+function NT_INFORMATION(Status: NTSTATUS): Boolean; register;
+begin
+  NT_INFORMATION := ULONG(Status) shr 30 = 1;
+end;
+
+function NT_WARNING(Status: NTSTATUS): Boolean; register;
+begin
+  NT_WARNING := ULONG(Status) shr 30 = 2;
+end;
+
+function NT_ERROR(Status: NTSTATUS): Boolean; register;
+begin
+  NT_ERROR := ULONG(Status) shr 30 = 3;
+end;
+
 end.
 

rtl/nativent/ndk/iofuncs.inc

@@ -0,0 +1,85 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains IO functions.
+    Copyright (c) 2010 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 NtCreateFile(
+  FileHandle: PHANDLE;
+  DesiredAccess: ACCESS_MASK;
+  ObjectAttributes: POBJECT_ATTRIBUTES;
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  AllocationSize: PLARGE_INTEGER; { optional }
+  FileAttributes: ULONG;
+  ShareAccess: ULONG;
+  CreateDisposition: ULONG;
+  CreateOptions: ULONG;
+  EaBuffer: PVOID; { optional }
+  EaLength: ULONG
+): NTSTATUS; external ntdll;
+
+function NtOpenFile(
+  FileHandle: PHANDLE;
+  DesiredAccess: ACCESS_MASK;
+  ObjectAttributes: POBJECT_ATTRIBUTES;
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  ShareAccess: ULONG;
+  OpenOptions: ULONG
+): NTSTATUS; external ntdll;
+
+function NtQueryFullAttributesFile(
+  ObjectAttributes: POBJECT_ATTRIBUTES;
+  FileInformation: PFILE_NETWORK_OPEN_INFORMATION
+): NTSTATUS; external ntdll;
+
+function NtQueryInformationFile(
+  FileHandle: HANDLE;
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  FileInformation: PVOID;
+  Length: ULONG;
+  FileInformationClass: FILE_INFORMATION_CLASS
+): NTSTATUS; external ntdll;
+
+function NtReadFile(
+  FileHandle: HANDLE;
+  Event: HANDLE; { optional }
+  UserApcRoutine: Pointer; //PIO_APC_ROUTINE; { optional }
+  UserApcContext: PVOID; { optional }
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  Buffer: PVOID;
+  BufferLength: ULONG;
+  ByteOffset: PLARGE_INTEGER; { optional }
+  Key: PULONG { optional }
+): NTSTATUS; external ntdll;
+
+function NtSetInformationFile(
+  FileHandle: HANDLE;
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  FileInformation: PVOID;
+  Length: ULONG;
+  FileInformationClass: FILE_INFORMATION_CLASS
+): NTSTATUS; external ntdll;
+
+function NtWriteFile(
+  FileHandle: HANDLE;
+  Event: HANDLE; { optional }
+  ApcRoutine: Pointer; //PIO_APC_ROUTINE; { optional }
+  ApcContext: PVOID; { optional }
+  IoStatusBlock: PIO_STATUS_BLOCK;
+  Buffer: PVOID;
+  Length: ULONG;
+  ByteOffset: PLARGE_INTEGER; { optional? }
+  Key: PULONG { optional }
+): NTSTATUS; external ntdll;
+

rtl/nativent/ndk/iotypes.inc

@@ -0,0 +1,186 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains types used for IO functions.
+    Copyright (c) 2010 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.
+
+ **********************************************************************}
+
+const
+  //
+  // NtCreateFile OpenType Flags
+  //
+  FILE_SUPERSEDE                          = $00000000;
+  FILE_OPEN                               = $00000001;
+  FILE_CREATE                             = $00000002;
+  FILE_OPEN_IF                            = $00000003;
+  FILE_OVERWRITE                          = $00000004;
+  FILE_OVERWRITE_IF                       = $00000005;
+  FILE_MAXIMUM_DISPOSITION                = $00000005;
+
+  //
+  // NtCreateFile Flags
+  //
+  FILE_DIRECTORY_FILE                     = $00000001;
+  FILE_WRITE_THROUGH                      = $00000002;
+  FILE_SEQUENTIAL_ONLY                    = $00000004;
+  FILE_NO_INTERMEDIATE_BUFFERING          = $00000008;
+  FILE_SYNCHRONOUS_IO_ALERT               = $00000010;
+  FILE_SYNCHRONOUS_IO_NONALERT            = $00000020;
+  FILE_NON_DIRECTORY_FILE                 = $00000040;
+  FILE_CREATE_TREE_CONNECTION             = $00000080;
+  FILE_COMPLETE_IF_OPLOCKED               = $00000100;
+  FILE_NO_EA_KNOWLEDGE                    = $00000200;
+  FILE_OPEN_REMOTE_INSTANCE               = $00000400;
+  FILE_RANDOM_ACCESS                      = $00000800;
+  FILE_DELETE_ON_CLOSE                    = $00001000;
+  FILE_OPEN_BY_FILE_ID                    = $00002000;
+  FILE_OPEN_FOR_BACKUP_INTENT             = $00004000;
+  FILE_NO_COMPRESSION                     = $00008000;
+  FILE_RESERVE_OPFILTER                   = $00100000;
+  FILE_OPEN_REPARSE_POINT                 = $00200000;
+  FILE_OPEN_NO_RECALL                     = $00400000;
+  FILE_OPEN_FOR_FREE_SPACE_QUERY          = $00800000;
+
+type
+  //
+  // File Information Classes for NtQueryInformationFile
+  //
+  _FILE_INFORMATION_CLASS = (
+    FileDirectoryInformation = 1,
+    FileFullDirectoryInformation,
+    FileBothDirectoryInformation,
+    FileBasicInformation,
+    FileStandardInformation,
+    FileInternalInformation,
+    FileEaInformation,
+    FileAccessInformation,
+    FileNameInformation,
+    FileRenameInformation,
+    FileLinkInformation,
+    FileNamesInformation,
+    FileDispositionInformation,
+    FilePositionInformation,
+    FileFullEaInformation,
+    FileModeInformation,
+    FileAlignmentInformation,
+    FileAllInformation,
+    FileAllocationInformation,
+    FileEndOfFileInformation,
+    FileAlternateNameInformation,
+    FileStreamInformation,
+    FilePipeInformation,
+    FilePipeLocalInformation,
+    FilePipeRemoteInformation,
+    FileMailslotQueryInformation,
+    FileMailslotSetInformation,
+    FileCompressionInformation,
+    FileObjectIdInformation,
+    FileCompletionInformation,
+    FileMoveClusterInformation,
+    FileQuotaInformation,
+    FileReparsePointInformation,
+    FileNetworkOpenInformation,
+    FileAttributeTagInformation,
+    FileTrackingInformation,
+    FileIdBothDirectoryInformation,
+    FileIdFullDirectoryInformation,
+    FileValidDataLengthInformation,
+    FileShortNameInformation,
+    FileMaximumInformation
+  );
+  FILE_INFORMATION_CLASS = _FILE_INFORMATION_CLASS;
+  PFILE_INFORMATION_CLASS = ^FILE_INFORMATION_CLASS;
+
+  //
+  // I/O Status Block
+  //
+  _IO_STATUS_BLOCK = packed record
+    union1: packed record
+      case Boolean of
+        True: (Status: NTSTATUS);
+        False: (Pointer: PVOID);
+    end;
+    Information: ULONG_PTR;
+  end;
+  IO_STATUS_BLOCK = _IO_STATUS_BLOCK;
+  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
+
+  //
+  // File Information structures for NtQueryInformationFile
+  //
+  _FILE_BASIC_INFORMATION = packed record
+    CreationTime: LARGE_INTEGER;
+    LastAccessTime: LARGE_INTEGER;
+    LastWriteTime: LARGE_INTEGER;
+    ChangeTime: LARGE_INTEGER;
+    FileAttributes: ULONG;
+  end;
+  FILE_BASIC_INFORMATION = _FILE_BASIC_INFORMATION;
+  PFILE_BASIC_INFORMATION = FILE_BASIC_INFORMATION;
+
+  _FILE_STANDARD_INFORMATION = packed record
+      AllocationSize: LARGE_INTEGER;
+      EndOfFile: LARGE_INTEGER;
+      NumberOfLinks: ULONG;
+      DeletePending: NT_BOOLEAN;
+      Directory: NT_BOOLEAN;
+  end;
+  FILE_STANDARD_INFORMATION = _FILE_STANDARD_INFORMATION;
+  PFILE_STANDARD_INFORMATION = ^FILE_STANDARD_INFORMATION;
+
+  _FILE_NETWORK_OPEN_INFORMATION = packed record
+    CreationTime: LARGE_INTEGER;
+    LastAccessTime: LARGE_INTEGER;
+    LastWriteTime: LARGE_INTEGER;
+    ChangeTime: LARGE_INTEGER;
+    AllocationSize: LARGE_INTEGER;
+    EndOfFile: LARGE_INTEGER;
+    FileAttributes: ULONG;
+  end;
+  FILE_NETWORK_OPEN_INFORMATION = _FILE_NETWORK_OPEN_INFORMATION;
+  PFILE_NETWORK_OPEN_INFORMATION = ^FILE_NETWORK_OPEN_INFORMATION;
+
+  _FILE_POSITION_INFORMATION = packed record
+    CurrentByteOffset: LARGE_INTEGER;
+  end;
+  FILE_POSITION_INFORMATION = _FILE_POSITION_INFORMATION;
+  PFILE_POSITION_INFORMATION = ^FILE_POSITION_INFORMATION;
+
+  _FILE_DISPOSITION_INFORMATION = packed record
+    DeleteFile: NT_BOOLEAN;
+  end;
+  FILE_DISPOSITION_INFORMATION = _FILE_DISPOSITION_INFORMATION;
+  PFILE_DISPOSITION_INFORMATION = ^FILE_DISPOSITION_INFORMATION;
+
+  _FILE_RENAME_INFORMATION = packed record
+    ReplaceIfExists: NT_BOOLEAN;
+    RootDirectory: HANDLE;
+    FileNameLength: ULONG;
+    FileName: array[0..0] of WCHAR;
+  end;
+  FILE_RENAME_INFORMATION = _FILE_RENAME_INFORMATION;
+  PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION;
+
+  _FILE_ALLOCATION_INFORMATION = packed record
+    AllocationSize: LARGE_INTEGER;
+  end;
+  FILE_ALLOCATION_INFORMATION = _FILE_ALLOCATION_INFORMATION;
+  PFILE_ALLOCATION_INFORMATION = ^FILE_ALLOCATION_INFORMATION;
+
+  _FILE_END_OF_FILE_INFORMATION = packed record
+    EndOfFile: LARGE_INTEGER;
+  end;
+  FILE_END_OF_FILE_INFORMATION = _FILE_END_OF_FILE_INFORMATION;
+  PFILE_END_OF_FILE_INFORMATION = ^FILE_END_OF_FILE_INFORMATION;
+
+

rtl/nativent/ndk/ketypes.inc

@@ -0,0 +1,99 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains types used by the Kernel.
+    Copyright (c) 2010 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.
+
+ **********************************************************************}
+
+const
+  //
+  // Maximum WOW64 Entries in KUSER_SHARED_DATA
+  //
+  MAX_WOW64_SHARED_ENTRIES = 16;
+
+  //
+  // Maximum Processor Features supported in KUSER_SHARED_DATA
+  //
+  PROCESSOR_FEATURE_MAX = 64;
+
+
+type
+  //
+  // NT Product and Architecture Types
+  //
+  _NT_PRODUCT_TYPE = (
+    NtProductWinNt = 1,
+    NtProductLanManNt,
+    NtProductServer
+  );
+  NT_PRODUCT_TYPE = _NT_PRODUCT_TYPE;
+  PNT_PRODUCT_TYPE = ^NT_PRODUCT_TYPE;
+
+  _ALTERNATIVE_ARCHITECTURE_TYPE = (
+    StandardDesign,
+    NEC98x86,
+    EndAlternatives
+  );
+  ALTERNATIVE_ARCHITECTURE_TYPE = _ALTERNATIVE_ARCHITECTURE_TYPE;
+  PALTERNATIVE_ARCHITECTURE_TYPE = ^ALTERNATIVE_ARCHITECTURE_TYPE;
+
+  //
+  // System Time Structure
+  //
+  _KSYSTEM_TIME = packed record
+    LowPart: ULONG;
+    High1Time: LONG;
+    High2Time: LONG;
+  end;
+  KSYSTEM_TIME = _KSYSTEM_TIME;
+  PKSYSTEM_TIME = ^KSYSTEM_TIME;
+
+  //
+  // Shared Kernel User Data
+  //
+  _KUSER_SHARED_DATA = packed record
+    TickCountLowDeprecated: ULONG;
+    TickCountMultiplier: ULONG;
+    InterruptTime: KSYSTEM_TIME; {volatile}
+    SystemTime: KSYSTEM_TIME; {volatile}
+    TimeZoneBias: KSYSTEM_TIME; {volatile }
+    ImageNumberLow: USHORT;
+    ImageNumberHigh: USHORT;
+    NtSystemRoot: array[0..259] of WideChar;
+    MaxStackTraceDepth: ULONG;
+    CryptoExponent: ULONg;
+    TimeZoneId: ULONG;
+    LargePageMinimum: ULONG;
+    Reserved2: array[0..6] of ULONG;
+    NtProductType: NT_PRODUCT_TYPE;
+    ProductTypeIsValid: BOOLEAN;
+    NtMajorVersion: ULONG;
+    NtMinorVersion: ULONG;
+    ProcessorFeature: array[0..PROCESSOR_FEATURE_MAX - 1] of BOOLEAN;
+    Reserved1: ULONG;
+    Reserved3: ULONG;
+    TimeSlip: ULONG; {volatile}
+    AlternativeArchitecture: ALTERNATIVE_ARCHITECTURE_TYPE;
+    SystemExpirationDate: LARGE_INTEGER;
+    SuiteMask: ULONG;
+    KdDebuggerEnabled: BOOLEAN;
+    { from here on the structures differ by 1 Byte depending on the version -.- }
+  end;
+  KUSER_SHARED_DATA = _KUSER_SHARED_DATA;
+  PKUSER_SHARED_DATA = ^KUSER_SHARED_DATA;
+
+//
+// Dereferencable pointer to KUSER_SHARED_DATA in User-Mode
+//
+function SharedUserData: PKUSER_SHARED_DATA; inline; register;
+

rtl/nativent/ndk/ntdef.inc

@@ -0,0 +1,109 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This units contains some basic type definitions used by NT
+    Copyright (c) 2010 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
+  PVOID = Pointer;
+  PPVOID = ^PVOID;
+
+  HANDLE = THandle; // already defined in system unit
+  PHANDLE = ^HANDLE;
+
+  { Upper-Case Versions of Some Standard C Types }
+  //CHAR = Char;
+  SHORT = ShortInt;
+  LONG = LongInt;
+  //DOUBLE = Double;
+
+  { Unsigned Types }
+  UCHAR = Byte;
+  PUCHAR = ^Byte;
+  USHORT = Word;
+  PUSHORT = ^Word;
+  ULONG = LongWord;
+  PULONG = PLongWord;
+  PCUCHAR = ^UCHAR; { const }
+  PCUSHORT = ^USHORT; { const }
+  PCULONG = ^ULONG; { const }
+  FCHAR = UCHAR;
+  FSHORT = USHORT;
+  FLONG = ULONG;
+  { This type is originaly called BOOLEAN, but that might generate problems
+    in SysUtils include files, so we prefix it with NT. Also it's originally
+    defined as UCHAR, but ByteBool allows the use of True/False }
+  NT_BOOLEAN = ByteBool;
+  PNT_BOOLEAN = ^NT_BOOLEAN;
+  LOGICAL = ULONG;
+  PLOGICAL = ^ULONG;
+
+  { Signed Types }
+  PSHORT = ^SHORT;
+  PLONG = ^LONG;
+  NTSTATUS = LONG;
+  PNTSTATUS = ^NTSTATUS;
+  SCHAR = SmallInt;
+  PSCHAR = ^SCHAR;
+
+  { types from basetsd.h }
+  ULONG_PTR = LongWord; // seems to really be a PtrUInt
+
+  { Large Integer Unions }
+  // using Int64 is an alternative (QWord might have unintended side effects)
+  LARGE_INTEGER = packed record
+    case Boolean of
+      True:(u: record
+              LowPart: LongWord;
+              HighPart: LongInt;
+            end);
+      False:(QuadPart: Int64);
+  end;
+  PLARGE_INTEGER = ^LARGE_INTEGER;
+
+  { Native API Return Value Macros }
+function NT_SUCCESS(Status: NTSTATUS): Boolean; inline; register;
+function NT_INFORMATION(Status: NTSTATUS): Boolean; inline; register;
+function NT_WARNING(Status: NTSTATUS): Boolean; inline; register;
+function NT_ERROR(Status: NTSTATUS): Boolean; inline; register;
+
+type
+  { String Types }
+  _UNICODE_STRING = packed record
+    Length: Word;        // used characters in buffer
+    MaximumLength: Word; // maximum characters in buffer
+    Buffer: PWideChar;
+  end;
+  UNICODE_STRING = _UNICODE_STRING;
+  PUNICODE_STRING = ^UNICODE_STRING;
+  // alias to differ from TUnicodeString
+  TNtUnicodeString = UNICODE_STRING;
+  PNtUnicodeString = ^TNtUnicodeString;
+
+  { Object Attributes }
+  POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;
+  _OBJECT_ATTRIBUTES = record
+    Length: ULONG;
+    RootDirectory: HANDLE;
+    ObjectName: PUNICODE_STRING;
+    Attributes: ULONG;
+    SecurityDescriptor: PVOID;       // PSECURITY_DESCRIPTOR
+    SecurityQualityOfService: PVOID; // PSECURITY_QUALITY_OF_SERVICE
+  end;
+  OBJECT_ATTRIBUTES = _OBJECT_ATTRIBUTES;
+
+procedure InitializeObjectAttributes(var aObjectAttr: OBJECT_ATTRIBUTES;
+    aName: PUNICODE_STRING; aAttributes: ULONG; aRootDir: HANDLE;
+    aSecurity: Pointer {PSECURITY_DESCRIPTOR}); inline; register;
+

rtl/nativent/ndk/ntstatus.inc

@@ -0,0 +1,25 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This units contains the status codes used by NT
+    Copyright (c) 2010 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.
+
+ **********************************************************************}
+
+const
+  STATUS_SUCCESS                          = NTSTATUS($00000000);
+
+  STATUS_PENDING                          = NTSTATUS($00000103);
+
+  STATUS_OBJECT_TYPE_MISMATCH             = NTSTATUS($C0000024);
+  STATUS_OBJECT_NAME_COLLISION            = NTSTATUS($C0000035);
+

rtl/nativent/ndk/obfuncs.inc

@@ -0,0 +1,29 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains functions for use with the Object Manager.
+    Copyright (c) 2010 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 NtOpenDirectoryObject(
+  FileHandle: PHANDLE;
+  DesiredAccess: ACCESS_MASK;
+  ObjectAttributes: POBJECT_ATTRIBUTES
+): NTSTATUS; external ntdll;
+
+function NtWaitForSingleObject(
+  _Object: HANDLE;
+  Alertable: NT_BOOLEAN;
+  Time: PLARGE_INTEGER
+): NTSTATUS; external ntdll;
+

rtl/nativent/ndk/peb_teb.inc

@@ -0,0 +1,171 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This units contains PEB and TEB structures used by NT
+    Copyright (c) 2010 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.
+
+ **********************************************************************}
+
+const
+  GDI_HANDLE_BUFFER_SIZE_32 = 34;
+  GDI_HANDLE_BUFFER_SIZE_64 = 60;
+{$ifdef cpu64}
+  GDI_HANDLE_BUFFER_SIZE = GDI_HANDLE_BUFFER_SIZE_64;
+{$else}
+  GDI_HANDLE_BUFFER_SIZE = GDI_HANDLE_BUFFER_SIZE_32;
+{$endif}
+
+{ TODO : add bitness specific records }
+{ TODO : add OS version specific records }
+{ TODO : define remaining types }
+
+type
+  { The PEB comes in three flavors: the platform dependant one, the 32 bit one
+    and the 64 bit one. Only the first one should be used by natve processes.
+    The others are needed if one e.g. wants to examine the PEB of a 32 bit
+    process on a 64 bit system.
+  }
+
+  _PEB = packed record
+      InheritedAddressSpace: NT_BOOLEAN;
+      ReadImageFileExecOptions: NT_BOOLEAN;
+      BeingDebugged: NT_BOOLEAN;
+(*  #if (NTDDI_VERSION >= NTDDI_WS03)
+      union
+      {
+          BOOLEAN BitField;
+          struct
+          {
+              BOOLEAN ImageUsesLargePages:1;
+  #if (NTDDI_VERSION >= NTDDI_LONGHORN)
+              BOOLEAN IsProtectedProcess:1;
+              BOOLEAN IsLegacyProcess:1;
+              BOOLEAN IsImageDynamicallyRelocated:1;
+              BOOLEAN SkipPatchingUser32Forwarders:1;
+              BOOLEAN SpareBits:3;
+  #else
+              BOOLEAN SpareBits:7;
+  #endif
+          };
+      };
+  #else*)
+      SpareBool: NT_BOOLEAN;
+//  #endif
+      Mutant: PHANDLE;
+      ImageBaseAddress: PVOID;
+      Ldr: Pointer;//PPEB_LDR_DATA;
+      ProcessParameters: PRTL_USER_PROCESS_PARAMETERS;
+      SubSystemData: PVOID;
+      ProcessHeap: PVOID;
+      FastPebLock: Pointer; //PRTL_CRITICAL_SECTION;
+(*  #if (NTDDI_VERSION >= NTDDI_LONGHORN)
+      PTR(PVOID) AltThunkSListPtr;
+      PTR(PVOID) IFEOKey;
+      union
+      {
+          ULONG CrossProcessFlags;
+          struct
+          {
+              ULONG ProcessInJob:1;
+              ULONG ProcessInitializing:1;
+              ULONG ProcessUsingVEH:1;
+              ULONG ProcessUsingVCH:1;
+              ULONG ReservedBits0:28;
+          };
+      };
+      union
+      {
+          PTR(PVOID) KernelCallbackTable;
+          PTR(PVOID) UserSharedInfoPtr;
+      };
+  #elif (NTDDI_VERSION >= NTDDI_WS03)
+      PTR(PVOID) AltThunkSListPtr;
+      PTR(PVOID) SparePtr2;
+      ULONG EnvironmentUpdateCount;
+      PTR(PVOID) KernelCallbackTable;
+  #else*)
+      FastPebLockRoutine: Pointer; //PPEBLOCKROUTINE;
+      FastPebUnlockRoutine: Pointer; //PPEBLOCKROUTINE;
+      EnvironmentUpdateCount: ULONG;
+      KernelCallbackTable: PVOID;
+//  #endif
+      SystemReserved: array[0..0] of ULONG;
+      SpareUlong: ULONG; // AtlThunkSListPtr32
+      FreeList: Pointer; //PPEB_FREE_BLOCK;
+      TlsExpansionCounter: ULONG;
+      TlsBitmap: PVOID;
+      TlsBitmapBits: array[0..1] of ULONG;
+      ReadOnlySharedMemoryBase: PVOID;
+(*  #if (NTDDI_VERSION >= NTDDI_LONGHORN)
+      PTR(PVOID) HotpatchInformation;
+  #else*)
+      ReadOnlySharedMemoryHeap: PVOID;
+//  #endif
+      ReadOnlyStaticServerData: PPVOID;
+      AnsiCodePageData: PVOID;
+      OemCodePageData: PVOID;
+      UnicodeCaseTableData: PVOID;
+      NumberOfProcessors: ULONG;
+      NtGlobalFlag: ULONG;
+      CriticalSectionTimeout: LARGE_INTEGER;
+      HeapSegmentReserve: ULONG_PTR;
+      HeapSegmentCommit: ULONG_PTR;
+      HeapDeCommitTotalFreeThreshold: ULONG_PTR;
+      HeapDeCommitFreeBlockThreshold: ULONG_PTR;
+      NumberOfHeaps: ULONG;
+      MaximumNumberOfHeaps: ULONG;
+      ProcessHeaps: PPVOID;
+      GdiSharedHandleTable: PVOID;
+      ProcessStarterHelper: PVOID;
+      GdiDCAttributeList: ULONG;
+      LoaderLock: Pointer; //PRTL_CRITICAL_SECTION;
+      OSMajorVersion: ULONG;
+      OSMinorVersion: ULONG;
+      OSBuildNumber: USHORT;
+      OSCSDVersion: USHORT;
+      OSPlatformId: ULONG;
+      ImageSubsystem: ULONG;
+      ImageSubsystemMajorVersion: ULONG;
+      ImageSubsystemMinorVersion: ULONG;
+      ImageProcessAffinityMask: ULONG_PTR;
+      GdiHandleBuffer: array[0..GDI_HANDLE_BUFFER_SIZE-1] of ULONG;
+      PostProcessInitRoutine: Pointer; //PPOST_PROCESS_INIT_ROUTINE;
+      TlsExpansionBitmap: PVOID;
+      TlsExpansionBitmapBits: array[0..31] of ULONG;
+      SessionId: ULONG;
+{  #if (NTDDI_VERSION >= NTDDI_WINXP)
+      ULARGE_INTEGER AppCompatFlags;
+      ULARGE_INTEGER AppCompatFlagsUser;
+      PTR(PVOID) pShimData;
+      PTR(PVOID) AppCompatInfo;
+      STRUCT(UNICODE_STRING) CSDVersion;
+      PTR(struct _ACTIVATION_CONTEXT_DATA*) ActivationContextData;
+      PTR(struct _ASSEMBLY_STORAGE_MAP*) ProcessAssemblyStorageMap;
+      PTR(struct _ACTIVATION_CONTEXT_DATA*) SystemDefaultActivationContextData;
+      PTR(struct _ASSEMBLY_STORAGE_MAP*) SystemAssemblyStorageMap;
+      PTR(ULONG_PTR) MinimumStackCommit;
+  #endif
+  #if (NTDDI_VERSION >= NTDDI_WS03)
+      PTR(PVOID*) FlsCallback;
+      STRUCT(LIST_ENTRY) FlsListHead;
+      PTR(PVOID) FlsBitmap;
+      ULONG FlsBitmapBits[4];
+      ULONG FlsHighIndex;
+  #endif
+  #if (NTDDI_VERSION >= NTDDI_LONGHORN)
+      PTR(PVOID) WerRegistrationData;
+      PTR(PVOID) WerShipAssertPtr;
+  #endif}
+  end;
+  PEB = _PEB;
+  PPEB = ^PEB;
+

rtl/nativent/ndk/pstypes.inc

@@ -0,0 +1,23 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains types specific for processes.
+    Copyright (c) 2010 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.
+
+ **********************************************************************}
+
+const
+  //
+  // KUSER_SHARED_DATA location in User Mode
+  //
+  USER_SHARED_DATA = $7FFE0000;
+

rtl/nativent/ndk/rtlfuncs.inc

@@ -0,0 +1,27 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains RTL functions.
+    Copyright (c) 2010 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 RtlTimeFieldsToTime(
+  TimeFields: PTIME_FIELDS;
+  Time: PLARGE_INTEGER
+): NT_BOOLEAN; external ntdll;
+
+procedure RtlTimeToTimeFields(
+  Time: PLARGE_INTEGER;
+  TimeFields: PTIME_FIELDS
+); external ntdll;
+

rtl/nativent/ndk/rtltypes.inc

@@ -0,0 +1,89 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains types defined for RTL functions.
+    Copyright (c) 2010 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
+  //
+  // Time Structure for RTL Time calls
+  //
+  _TIME_FIELDS = packed record
+    Year: CSHORT;
+    Month: CSHORT;
+    Day: CSHORT;
+    Hour: CSHORT;
+    Minute: CSHORT;
+    Second: CSHORT;
+    Milliseconds: CSHORT;
+    Weekday: CSHORT;
+  end;
+  TIME_FIELDS = _TIME_FIELDS;
+  PTIME_FIELDS = ^TIME_FIELDS;
+
+  //
+  // Current Directory Structures
+  //
+  _CURDIR = packed record
+    DosPath: UNICODE_STRING;
+    Handle: HANDLE;
+  end;
+  CURDIR = _CURDIR;
+  PCURDIR = ^CURDIR;
+
+  _RTL_DRIVE_LETTER_CURDIR = packed record
+    Flags: USHORT;
+    Length: USHORT;
+    TimeStamp: ULONG;
+    DosPath: UNICODE_STRING;
+  end;
+  RTL_DRIVE_LETTER_CURDIR = _RTL_DRIVE_LETTER_CURDIR;
+  PRTL_DRIVE_LETTER_CURDIR = ^RTL_DRIVE_LETTER_CURDIR;
+
+  //
+  // Structures for RtlCreateUserProcess
+  //
+  _RTL_USER_PROCESS_PARAMETERS = packed record
+    MaximumLength: ULONG;
+    Length: ULONG;
+    Flags: ULONG;
+    DebugFlags: ULONG;
+    ConsoleHandle: HANDLE;
+    ConsoleFlags: ULONG;
+    StandardInput: HANDLE;
+    StandardOutput: HANDLE;
+    StandardError: HANDLE;
+    CurrentDirectory: CURDIR;
+    DllPath: UNICODE_STRING;
+    ImagePathName: UNICODE_STRING;
+    CommandLine: UNICODE_STRING;
+    Environment: PWSTR;
+    StartingX: ULONG;
+    StartingY: ULONG;
+    CountX: ULONG;
+    CountY: ULONG;
+    CountCharsX: ULONG;
+    CountCharsY: ULONG;
+    FillAttribute: ULONG;
+    WindowFlags: ULONG;
+    ShowWindowFlags: ULONG;
+    WindowTitle: UNICODE_STRING;
+    DesktopInfo: UNICODE_STRING;
+    ShellInfo: UNICODE_STRING;
+    RuntimeData: UNICODE_STRING;
+    CurrentDirectories: array[0..31] of RTL_DRIVE_LETTER_CURDIR;
+  end;
+  RTL_USER_PROCESS_PARAMETERS = _RTL_USER_PROCESS_PARAMETERS;
+  PRTL_USER_PROCESS_PARAMETERS = ^RTL_USER_PROCESS_PARAMETERS;
+

rtl/nativent/ndk/umtypes.inc

@@ -0,0 +1,30 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This unit contains basic user mode types.
+    Copyright (c) 2010 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
+  //
+  // Basic Types that aren't defined in User-Mode Headers
+  //
+  CINT = LongInt; // Int64 in 64 bit?
+  PCSZ = PChar;
+  CLONG = ULONG;
+  CSHORT = SmallInt;
+  PCSHORT = ^CSHORT;
+  PHYSICAL_ADDRESS = LARGE_INTEGER;
+  PPHYSICAL_ADDRESS = ^PHYSICAL_ADDRESS;
+  KPRIORITY = LONG;
+

rtl/nativent/ndk/winnt.inc

@@ -0,0 +1,72 @@
+{%MainUnit ndk.pas}
+{
+    Native Development Kit for Native NT
+
+    This file is part of the Free Pascal run time library.
+    This units contains some types and constants used by NT
+    Copyright (c) 2010 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
+  WCHAR = WideChar;
+  PWSTR = PWideChar;
+
+const
+  NT_DELETE           = $00010000;
+  NT_SYNCHRONIZE      = $00100000;
+
+  GENERIC_READ	      = $80000000;
+  GENERIC_WRITE	      = $40000000;
+  GENERIC_EXECUTE     = $20000000;
+  GENERIC_ALL	      = $10000000;
+
+  FILE_LIST_DIRECTORY		= $00000001;
+  FILE_READ_DATA		= $00000001;
+  FILE_ADD_FILE			= $00000002;
+  FILE_WRITE_DATA		= $00000002;
+  FILE_ADD_SUBDIRECTORY		= $00000004;
+  FILE_APPEND_DATA		= $00000004;
+  FILE_CREATE_PIPE_INSTANCE	= $00000004;
+  FILE_READ_EA			= $00000008;
+  FILE_READ_PROPERTIES		= $00000008;
+  FILE_WRITE_EA			= $00000010;
+  FILE_WRITE_PROPERTIES		= $00000010;
+  FILE_EXECUTE			= $00000020;
+  FILE_TRAVERSE			= $00000020;
+  FILE_DELETE_CHILD		= $00000040;
+  FILE_READ_ATTRIBUTES		= $00000080;
+  FILE_WRITE_ATTRIBUTES		= $00000100;
+
+  FILE_SHARE_READ			= $00000001;
+  FILE_SHARE_WRITE		        = $00000002;
+  FILE_SHARE_DELETE		        = $00000004;
+  FILE_SHARE_VALID_FLAGS		= $00000007;
+
+  FILE_ATTRIBUTE_READONLY		= $00000001;
+  FILE_ATTRIBUTE_HIDDEN			= $00000002;
+  FILE_ATTRIBUTE_SYSTEM			= $00000004;
+  FILE_ATTRIBUTE_DIRECTORY		= $00000010;
+  FILE_ATTRIBUTE_ARCHIVE		= $00000020;
+  FILE_ATTRIBUTE_DEVICE			= $00000040;
+  FILE_ATTRIBUTE_NORMAL			= $00000080;
+  FILE_ATTRIBUTE_TEMPORARY		= $00000100;
+  FILE_ATTRIBUTE_SPARSE_FILE		= $00000200;
+  FILE_ATTRIBUTE_REPARSE_POINT		= $00000400;
+  FILE_ATTRIBUTE_COMPRESSED		= $00000800;
+  FILE_ATTRIBUTE_OFFLINE		= $00001000;
+  FILE_ATTRIBUTE_NOT_CONTENT_INDEXED	= $00002000;
+  FILE_ATTRIBUTE_ENCRYPTED		= $00004000;
+  FILE_ATTRIBUTE_VALID_FLAGS		= $00007fb7;
+  FILE_ATTRIBUTE_VALID_SET_FLAGS	= $000031a7;
+
+type
+  ACCESS_MASK = DWORD;
+  PACCESS_MASK = ^ACCESS_MASK;

rtl/nativent/ndkutils.pas

@@ -1,5 +1,5 @@
 {
-    FPC Utility Function for Native NT applications
+    FPC Utility Functions for Native NT applications
 
     This file is part of the Free Pascal run time library.
     Copyright (c) 2009 by Sven Barth
@@ -15,24 +15,34 @@
 
 unit NDKUtils;
 
-{.$H+}
+{$mode objfpc}{$H+}
 
 interface
 
 uses
   NDK;
 
-procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: TNtUnicodeString);
-//procedure AnsiStrToNTStr(const aStr: String; var aNTStr: TNtUnicodeString);
+// Helpers for converting Pascal string types to NT's UNICODE_STRING
+procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: UNICODE_STRING);
+procedure AnsiStrToNTStr(const aStr: String; var aNTStr: UNICODE_STRING);
+procedure UnicodeStrToNtStr(const aStr: UnicodeString;
+    var aNTStr: UNICODE_STRING);
+procedure PCharToNTStr(aStr: PChar; aLen: Cardinal; var aNTStr: UNICODE_STRING);
+procedure FreeNTStr(var aNTStr: UNICODE_STRING);
+
+// Wraps NtDisplayString for use with Write(Ln)
+procedure AssignDisplayString(var aFile: Text; aUtf8: Boolean);
 
 implementation
 
-procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: TNtUnicodeString);
+uses
+  SysUtils;
+
+procedure ShortStrToNTStr(aStr: ShortString; var aNTStr: UNICODE_STRING);
 var
   buf: Pointer;
   i: Integer;
 begin
-  FillChar(aNTStr, SizeOf(TNtUnicodeString), 0);
   aNTStr.Length := Length(aStr) * 2;
   aNTStr.buffer := GetMem(aNTStr.Length);
   buf := aNTStr.buffer;
@@ -43,16 +53,111 @@ begin
   aNTStr.MaximumLength := aNTStr.Length;
 end;
 
-procedure InitializeObjectAttributes(var aObjectAttr: TObjectAttributes; aName: PNtUnicodeString; aAttributes: ULONG; aRootDir: THandle; aSecurity: Pointer);
+procedure AnsiStrToNTStr(const aStr: String; var aNTStr: UNICODE_STRING);
+var
+  buf: PWideChar;
+  i: Integer;
+begin
+  aNTStr.Length := Length(aStr) * 2;
+  aNTStr.Buffer := GetMem(aNTStr.Length);
+  buf := aNTStr.buffer;
+  for i := 1 to Length(aStr) do begin
+    buf^ := WideChar(Word(aStr[i]));
+    Inc(buf);
+  end;
+  aNTStr.MaximumLength := aNTStr.Length;
+end;
+
+procedure UnicodeStrToNtStr(const aStr: UnicodeString;
+    var aNTStr: UNICODE_STRING);
+var
+  buf: PWideChar;
+begin
+  { TODO : check why this prints garbage }
+  aNTStr.Length := Length(aStr) * 2;
+  aNTStr.Buffer := GetMem(aNTStr.Length);
+  if Length(aStr) > 0 then
+    Move(aStr[1], aNTStr.Buffer^, aNTStr.Length);
+  aNTStr.MaximumLength := aNTStr.Length;
+end;
+
+procedure PCharToNTStr(aStr: PChar; aLen: Cardinal; var aNTStr: UNICODE_STRING);
+var
+  i: Integer;
+begin
+  if (aLen = 0) and (aStr <> Nil) and (aStr^ <> #0) then
+    aLen := StrLen(aStr);
+  aNtStr.Length := aLen * SizeOf(WideChar);
+  aNtStr.MaximumLength := aNtStr.Length;
+  aNtStr.Buffer := GetMem(aNtStr.Length);
+  for i := 0 to aLen do
+    aNtStr.Buffer[i] := aStr[i];
+end;
+
+procedure FreeNTStr(var aNTStr: UNICODE_STRING);
+begin
+  if aNTStr.Buffer <> Nil then
+    FreeMem(aNTStr.Buffer);
+  FillChar(aNTStr, SizeOf(UNICODE_STRING), 0);
+end;
+
+function DisplayStringWriteFunc(var aFile: TTextRec ): LongInt;
+var
+  ntstr: TNtUnicodeString;
+  len: SizeUInt;
+begin
+  Result := 0;
+  with aFile do
+    if (BufPos>0) then begin
+      if Boolean(UserData[1]) then begin
+        { TODO : check why UTF8 prints garbage }
+        {len := Utf8ToUnicode(Nil, 0, PChar(BufPtr), BufPos);
+        ntstr.Length := len * 2;
+        ntstr.MaximumLength := ntstr.Length;
+        ntstr.Buffer := GetMem(ntstr.Length);
+        Utf8ToUnicode(ntstr.Buffer, len, PChar(BufPtr), BufPos);}
+        PCharToNtStr(PChar(BufPtr), BufPos, ntstr);
+      end else
+        PCharToNtStr(PChar(BufPtr), BufPos, ntstr);
+      NtDisplayString(@ntstr);
+      // FreeNTStr uses FreeMem, so we don't need an If here
+      FreeNtStr(ntstr);
+      BufPos := 0;
+    end;
+end;
+
+function DisplayStringCloseFunc(var aFile: TTextRec): LongInt;
+begin
+  Result := 0;
+end;
+
+
+function DisplayStringOpenFunc(var aFile: TTextRec ): LongInt;
+begin
+  Result := 0;
+end;
+
+procedure AssignDisplayString(var aFile: Text; aUtf8: Boolean);
 begin
-  with aObjectAttr do begin
-    Length := SizeOf(TObjectAttributes);
-    RootDirectory := aRootDir;
-    Attributes := aAttributes;
-    ObjectName := aName;
-    SecurityDescriptor := aSecurity;
-    SecurityQualityOfService := Nil;
+  FillChar(aFile, SizeOf(TextRec), 0);
+{ only set things that are not zero }
+  TextRec(aFile).Handle := UnusedHandle;
+  TextRec(aFile).mode := fmOutput;
+  TextRec(aFile).BufSize := TextRecBufSize;
+  TextRec(aFile).Bufptr := @TextRec(aFile).Buffer;
+  TextRec(aFile).OpenFunc := @DisplayStringOpenFunc;
+  case DefaultTextLineBreakStyle of
+    tlbsLF:
+      TextRec(aFile).LineEnd := #10;
+    tlbsCRLF:
+      TextRec(aFile).LineEnd := #13#10;
+    tlbsCR:
+      TextRec(aFile).LineEnd := #13;
   end;
+  TextRec(aFile).Closefunc := @DisplayStringCloseFunc;
+  TextRec(aFile).InOutFunc := @DisplayStringWriteFunc;
+  TextRec(aFile).FlushFunc := @DisplayStringWriteFunc;
+  TextRec(aFile).UserData[1] := Ord(aUTF8);
 end;
 
 end.

rtl/nativent/sysdir.inc

@@ -0,0 +1,128 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2010 by Sven Barth
+
+    FPC Pascal system unit for the Native NT 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
+*****************************************************************************}
+
+procedure MkDir(s: pchar; len: sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+var
+  objattr: TObjectAttributes;
+  name: TNtUnicodeString;
+  res: LongInt;
+  iostatus: TIOStatusBlock;
+  h: THandle;
+begin
+  if not Assigned(s) or (len <= 1) or (InOutRes <> 0) then
+    Exit;
+
+  SysPCharToNtStr(name, s, len);
+
+  { first we try to create a directory object }
+  SysInitializeObjectAttributes(objattr, @name, OBJ_PERMANENT, 0, Nil);
+
+  res := NtCreateDirectoryObject(@h, 0, @objattr);
+  if res <> STATUS_OBJECT_TYPE_MISMATCH then begin
+    if res = STATUS_SUCCESS then
+      NtClose(h);
+    errno := res;
+    Errno2InoutRes;
+    SysFreeNtStr(name);
+    Exit;
+  end;
+
+  { so the parent directory isn't a directory object... retry as normal file
+    object }
+
+  objattr.Attributes := 0; // OBJ_PERMANENT is not valid for file objects
+
+  { the flags are based on ReactOS' CreateDirectoryW except the missing LIST
+    access }
+  res := NtCreateFile(@h, NT_SYNCHRONIZE, @objattr, @iostatus, Nil,
+              FILE_ATTRIBUTE_NORMAL, FILE_SHARE_READ or FILE_SHARE_WRITE,
+              FILE_CREATE, FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT,
+              Nil, 0);
+  if res = STATUS_SUCCESS then
+    NtClose(h);
+  errno := res;
+  Errno2InOutRes;
+  SysFreeNtStr(name);
+end;
+
+procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+var
+  ntstr: TNtUnicodeString;
+  objattr: TObjectAttributes;
+  iostatus: TIOStatusBlock;
+  h: THandle;
+  disp: TFileDispositionInformation;
+  res: LongInt;
+begin
+  if (len = 1) and (s^ = '.') then
+    InOutRes := 16;
+  if not assigned(s) or (len = 0) or (InOutRes <> 0) then
+    Exit;
+  if (len = 2) and (s[0] = '.') and (s[1] = '.') then
+    InOutRes := 5;
+
+  SysPCharToNtStr(ntstr, s, len);
+  SysInitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+
+  res := NtOpenDirectoryObject(@h, STANDARD_RIGHTS_REQUIRED, @objattr);
+  if res >= 0 then begin
+    { this is a directory object, so just make it temporary }
+{$message warning 'Add check for subdirectories'}
+    res := NtMakeTemporaryObject(h);
+    NtClose(h);
+
+    errno := res;
+    Errno2InoutRes;
+
+    SysFreeNtStr(ntstr);
+  end else
+  if res = STATUS_OBJECT_TYPE_MISMATCH then begin
+    { this is a file directory or file, so do it like RemoveDirectoryW }
+    res := NtCreateFile(@h, NT_DELETE or NT_SYNCHRONIZE, @objattr, @iostatus, Nil,
+              0, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
+              FILE_OPEN, FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT,
+              Nil, 0);
+
+    if res >= 0 then begin
+      disp.DeleteFile := True;
+
+      { NtDeleteFile does not work here... }
+      res := NtSetInformationFile(h, @iostatus, @disp,
+        SizeOf(TFileDispositionInformation), FileDispositionInformation);
+
+      NtClose(h);
+    end;
+  end;
+
+  SysFreeNtStr(ntstr);
+  errno := res;
+  Errno2InoutRes;
+end;
+
+procedure ChDir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+begin
+  { for now this is not supported }
+  InOutRes := 3;
+end;
+
+procedure GetDir(DriveNr: byte; var Dir: ShortString);
+begin
+  { for now we return simply the root directory }
+  Dir := DirectorySeparator;
+end;

rtl/nativent/sysfile.inc

@@ -0,0 +1,402 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2010 by Sven Barth
+
+    Low leve file functions
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+function do_isdevice(handle:thandle):boolean;
+begin
+  do_isdevice := (handle = StdInputHandle) or
+                 (handle = StdOutputHandle) or
+                 (handle = StdErrorHandle);
+end;
+
+
+procedure do_close(h : thandle);
+begin
+  if do_isdevice(h) then
+    Exit;
+  NtClose(h);
+end;
+
+
+procedure do_erase(p : pchar);
+var
+  ntstr: TNtUnicodeString;
+  objattr: TObjectAttributes;
+  iostatus: TIOStatusBlock;
+  h: THandle;
+  disp: TFileDispositionInformation;
+  res: LongInt;
+begin
+  InoutRes := 4;
+  DoDirSeparators(p);
+
+  SysPCharToNtStr(ntstr, p, 0);
+  SysInitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+
+  res := NtCreateFile(@h, NT_DELETE or NT_SYNCHRONIZE, @objattr, @iostatus, Nil,
+            0, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
+            FILE_OPEN, FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT,
+            Nil, 0);
+
+  if res >= 0 then begin
+    disp.DeleteFile := True;
+
+    res := NtSetInformationFile(h, @iostatus, @disp,
+      SizeOf(TFileDispositionInformation), FileDispositionInformation);
+
+    errno := res;
+
+    NtClose(h);
+  end else
+  if res = STATUS_FILE_IS_A_DIRECTORY then
+    errno := 2
+  else
+    errno := res;
+
+  SysFreeNtStr(ntstr);
+  Errno2InoutRes;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+var
+  h: THandle;
+  objattr: TObjectAttributes;
+  iostatus: TIOStatusBlock;
+  dest, src: TNtUnicodeString;
+  renameinfo: PFileRenameInformation;
+  res: LongInt;
+begin
+  DoDirSeparators(p1);
+  DoDirSeparators(p2);
+
+  { check whether the destination exists first }
+  SysPCharToNtStr(dest, p2, 0);
+  SysInitializeObjectAttributes(objattr, @dest, 0, 0, Nil);
+
+  res := NtCreateFile(@h, 0, @objattr, @iostatus, Nil, 0,
+           FILE_SHARE_READ or FILE_SHARE_WRITE, FILE_OPEN,
+           FILE_NON_DIRECTORY_FILE, Nil, 0);
+  if res >= 0 then begin
+    { destination already exists => error }
+    NtClose(h);
+    errno := 5;
+    Errno2InoutRes;
+  end else begin
+    SysPCharToNtStr(src, p1, 0);
+    SysInitializeObjectAttributes(objattr, @src, 0, 0, Nil);
+
+    res := NtCreateFile(@h, GENERIC_ALL or NT_SYNCHRONIZE or FILE_READ_ATTRIBUTES,
+             @objattr, @iostatus, Nil, 0, FILE_SHARE_READ or FILE_SHARE_WRITE,
+             FILE_OPEN, FILE_OPEN_FOR_BACKUP_INTENT or FILE_OPEN_REMOTE_INSTANCE
+             or FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil,
+             0);
+
+    if res >= 0 then begin
+      renameinfo := GetMem(SizeOf(TFileRenameInformation) + dest.Length);
+      with renameinfo^ do begin
+        ReplaceIfExists := False;
+        RootDirectory := 0;
+        FileNameLength := dest.Length;
+        Move(dest.Buffer^, renameinfo^.FileName, dest.Length);
+      end;
+
+      res := NtSetInformationFile(h, @iostatus, renameinfo,
+               SizeOf(TFileRenameInformation) + dest.Length,
+               FileRenameInformation);
+      if res < 0 then begin
+        { this could happen if src and destination reside on different drives,
+          so we need to copy the file manually }
+        {$message warning 'do_rename: Implement file copy!'}
+        errno := res;
+        Errno2InoutRes;
+      end;
+
+      NtClose(h);
+    end else begin
+      errno := res;
+      Errno2InoutRes;
+    end;
+
+    SysFreeNtStr(src);
+  end;
+
+  SysFreeNtStr(dest);
+end;
+
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var
+  res: LongInt;
+  iostatus: TIoStatusBlock;
+begin
+  res := NtWriteFile(h, 0, Nil, Nil, @iostatus, addr, len, Nil, Nil);
+
+  if res = STATUS_PENDING then begin
+    res := NtWaitForSingleObject(h, False, Nil);
+    if res >= 0 then
+      res := iostatus.Status;
+  end;
+
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+    do_write := 0;
+  end else
+    do_write := LongInt(iostatus.Information);
+end;
+
+
+function do_read(h: thandle; addr: pointer; len: longint): longint;
+var
+  iostatus: TIOStatusBlock;
+  res: LongInt;
+begin
+  res := NtReadFile(h, 0, Nil, Nil, @iostatus, addr, len, Nil, Nil);
+
+  if res = STATUS_PENDING then begin
+    res := NtWaitForSingleObject(h, False, Nil);
+    if res >= 0 then
+      res := iostatus.Status;
+  end;
+
+  if (res < 0) and (res <> STATUS_PIPE_BROKEN) then begin
+    errno := res;
+    Errno2InoutRes;
+    do_read := 0;
+  end else
+  if res = STATUS_PIPE_BROKEN then
+    do_read := 0
+  else
+    do_read := LongInt(iostatus.Information);
+end;
+
+
+function do_filepos(handle : thandle) : Int64;
+var
+  res: LongInt;
+  iostatus: TIoStatusBlock;
+  position: TFilePositionInformation;
+begin
+  res := NtQueryInformationFile(handle, @iostatus, @position,
+           SizeOf(TFilePositionInformation), FilePositionInformation);
+
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+    do_filepos := 0;
+  end else
+    do_filepos := position.CurrentByteOffset.QuadPart;
+end;
+
+
+procedure do_seek(handle: thandle; pos: Int64);
+var
+  position: TFilePositionInformation;
+  iostatus: TIoStatusBlock;
+  res: LongInt;
+begin
+  position.CurrentByteOffset.QuadPart := pos;
+  res := NtSetInformationFile(handle, @iostatus, @position,
+           SizeOf(TFilePositionInformation), FilePositionInformation);
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+  end;
+end;
+
+
+function do_seekend(handle:thandle):Int64;
+var
+  res: LongInt;
+  standard: TFileStandardInformation;
+  position: TFilePositionInformation;
+  iostatus: TIoStatusBlock;
+begin
+  do_seekend := 0;
+
+  res := NtQueryInformationFile(handle, @iostatus, @standard,
+           SizeOf(TFileStandardInformation), FileStandardInformation);
+  if res >= 0 then begin
+    position.CurrentByteOffset.QuadPart := standard.EndOfFile.QuadPart;
+    res := NtSetInformationFile(handle, @iostatus, @position,
+             SizeOf(TFilePositionInformation), FilePositionInformation);
+    if res >= 0 then
+      do_seekend := position.CurrentByteOffset.QuadPart;
+  end;
+
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+  end;
+end;
+
+
+function do_filesize(handle : thandle) : Int64;
+var
+  res: LongInt;
+  iostatus: TIoStatusBlock;
+  standard: TFileStandardInformation;
+begin
+  res := NtQueryInformationFile(handle, @iostatus, @standard,
+           SizeOf(TFileStandardInformation), FileStandardInformation);
+  if res >= 0 then
+    do_filesize := standard.EndOfFile.QuadPart
+  else begin
+    errno := res;
+    Errno2InoutRes;
+    do_filesize := 0;
+  end;
+end;
+
+
+procedure do_truncate (handle:thandle;pos:Int64);
+var
+  endoffileinfo: TFileEndOfFileInformation;
+  allocinfo: TFileAllocationInformation;
+  iostatus: TIoStatusBlock;
+  res: LongInt;
+begin
+  // based on ReactOS' SetEndOfFile
+  endoffileinfo.EndOfFile.QuadPart := pos;
+  res := NtSetInformationFile(handle, @iostatus, @endoffileinfo,
+           SizeOf(TFileEndOfFileInformation), FileEndOfFileInformation);
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+  end else begin
+    allocinfo.AllocationSize.QuadPart := pos;
+    res := NtSetInformationFile(handle, @iostatus, @allocinfo,
+             SizeOf(TFileAllocationInformation), FileAllocationInformation);
+    if res < 0 then begin
+      errno := res;
+      Errno2InoutRes;
+    end;
+  end;
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  shflags, cd, oflags: LongWord;
+  objattr: TObjectAttributes;
+  iostatus: TIoStatusBlock;
+  ntstr: TNtUnicodeString;
+  res: LongInt;
+begin
+  DoDirSeparators(p);
+  { close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case filerec(f).mode of
+       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+       fmclosed : ;
+     else
+      begin
+        {not assigned}
+        inoutres:=102;
+        exit;
+      end;
+     end;
+   end;
+  { reset file handle }
+  filerec(f).handle:=UnusedHandle;
+  { convert filesharing }
+  shflags := 0;
+  if ((filemode and fmshareExclusive) = fmshareExclusive) then
+    { no sharing }
+  else
+    if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
+      shflags := FILE_SHARE_READ
+  else
+    if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
+      shflags := FILE_SHARE_WRITE
+  else
+    if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
+      shflags := FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
+  { convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : begin
+         filerec(f).mode:=fminput;
+         oflags := GENERIC_READ;
+       end;
+   1 : begin
+         filerec(f).mode:=fmoutput;
+         oflags := GENERIC_WRITE;
+       end;
+   2 : begin
+         filerec(f).mode:=fminout;
+         oflags := GENERIC_WRITE or GENERIC_READ;
+       end;
+  end;
+  oflags := oflags or NT_SYNCHRONIZE or FILE_READ_ATTRIBUTES;
+  { create it ? }
+  if (flags and $1000) <> 0 then
+    cd := FILE_OVERWRITE_IF
+  { or Append/Open ? }
+  else
+    cd := FILE_OPEN;
+  { empty name is special }
+  { console i/o not supported yet }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+
+  SysPCharToNtStr(ntstr, p, 0);
+
+  SysInitializeObjectAttributes(objattr, @ntstr, OBJ_INHERIT, 0, Nil);
+
+  res := NtCreateFile(@filerec(f).handle, oflags, @objattr, @iostatus, Nil,
+           FILE_ATTRIBUTE_NORMAL, shflags, cd,
+           FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil, 0);
+
+  SysFreeNtStr(ntstr);
+
+  { append mode }
+  if (flags and $100 <> 0) and (res >= 0) then begin
+    do_seekend(filerec(f).handle);
+    filerec(f).mode := fmoutput; {fool fmappend}
+  end;
+
+  { get errors }
+  if res < 0 then begin
+    errno := res;
+    Errno2InoutRes;
+  end;
+end;

rtl/nativent/sysheap.inc

@@ -32,11 +32,11 @@
    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;
+     SizeToCommit: PtrUInt; Lock: Pointer; Parameters: Pointer): THandle;
      stdcall; external ntdll name 'RtlCreateHeap';
 
 var
-  SysHeap: THandle = Nil;
+  SysHeap: THandle = 0;
 
 procedure PrepareSysHeap;
 begin
@@ -45,7 +45,7 @@ begin
     SysHeap := RtlCreateHeap(2, Nil, 65534, 65534, Nil, Nil)
   else
     // use the heap passed on startup
-    SysHeap := PPEB(CurrentPEB)^.ProcessHeap;
+    SysHeap := THandle(PSimplePEB(CurrentPEB)^.ProcessHeap);
 end;
 
 {$endif KMODE}
@@ -56,7 +56,7 @@ end;
 
 function SysOSAlloc(size: ptruint): pointer;
 begin
-  if SysHeap = Nil then
+  if SysHeap = 0 then
     PrepareSysHeap;
   SysOSAlloc := RtlAllocateHeap(SysHeap, 0, size);
 end;
@@ -66,7 +66,7 @@ end;
 procedure SysOSFree(p: pointer; size: ptruint);
 begin
   // if heap isn't set, then nothing was allocated
-  if SysHeap <> Nil then
+  if SysHeap <> 0 then
     RtlFreeHeap(SysHeap, 0, p);
 end;
 

rtl/nativent/sysndk.inc

@@ -1,219 +0,0 @@
-// 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;
-

rtl/nativent/sysos.inc

@@ -2,7 +2,7 @@
     Basic stuff for NativeNT RTLs
 
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2009 by Sven Barth
+    Copyright (c) 2009-2010 by Sven Barth
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,6 +13,371 @@
 
  **********************************************************************}
 
-// some needed types from NDK.pas
-{$include sysndk.inc}
+const
+{$ifdef kmode}
+  ntdll = 'ntoskrnl.exe';
+{$else}
+  ntdll = 'ntdll.dll';
+{$endif}
 
+type
+  PHandle = ^THandle;
+
+  TNtUnicodeString = packed record
+    Length: Word;        // used characters in buffer
+    MaximumLength: Word; // maximum characters in buffer
+    Buffer: PWideChar;
+  end;
+  PNtUnicodeString = ^TNtUnicodeString;
+
+  // 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;
+
+
+  TObjectAttributes = record
+    Length: LongWord;
+    RootDirectory: THandle;
+    ObjectName: PNtUnicodeString;
+    Attributes: LongWord;
+    SecurityDescriptor: Pointer;       // Points to type SECURITY_DESCRIPTOR
+    SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE
+  end;
+  PObjectAttributes = ^TObjectAttributes;
+
+  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;
+
+  // a simple version of the PEB that contains the common stuff
+  TSimplePEB = packed record
+    InheritedAddressSpace: Byte;
+    ReadImageFileExecOptions: Byte;
+    BeingDebugged: Byte;
+    SpareBool: Byte;
+    Mutant: THandle;
+    ImageBaseAddress: Pointer;
+    Ldr: Pointer;
+    ProcessParameters: PRtlUserProcessParameters;
+    SubSystemData: Pointer;
+    ProcessHeap: Pointer;
+    FastPebLock: Pointer;
+    FastPebLockRoutine: Pointer;
+    FastPebUnlockRoutine: Pointer;
+    EnvironmentUpdateCount: LongWord;
+    KernelCallbackTable: Pointer;
+    EventLogSection: Pointer;
+    EventLog: Pointer;
+    FreeList: Pointer;
+    TlsExpansionCounter: LongWord;
+    TlsBitmap: Pointer;
+    TlsBitmapBits: array[0..1] of LongWord;
+    ReadOnlySharedMemoryBase: Pointer;
+    ReadOnlySharedMemoryHeap: Pointer;
+    ReadOnlyStaticServerData: Pointer;
+    AnsiCodePageData: Pointer;
+    OemCodePageData: Pointer;
+    UnicodeCaseTableData: Pointer;
+    NumberOfProcessors: LongWord;
+    NtGlobalFlag: LongWord;
+    CriticalSectionTimeout: TLargeInteger;
+    HeapSegmentReserve: LongWord;
+    HeapSegmentCommit: LongWord;
+    HeapDeCommitTotalFreeThreshold: LongWord;
+    HeapDeCommitFreeBlockThreshold: LongWord;
+    NumberOfHeaps: LongWord;
+    MaximumNumberOfHeaps: LongWord;
+    ProcessHeaps: Pointer;
+    GdiSharedHandleTable: Pointer;
+    ProcessStarterHelper: Pointer;
+    GdiDCAttributeList: LongWord;
+    LoaderLock: Pointer;
+    OSMajorVersion: LongWord;
+    OSMinorVersion: LongWord;
+    OSBuildNumber: Word;
+    OSCSDVersion: Word;
+    OSPlatformId: LongWord;
+    ImageSubSystem: LongWord;
+    ImageSubSystemMajorVersion: LongWord;
+    ImageSubSystemMinorVersion: LongWord;
+    ImageProcessAffinityMask: LongWord;
+    GdiHandleBuffer: array[0..$21] of LongWord;
+    PostProcessInitRoutine: Pointer;
+    TlsExpansionBitmap: Pointer;
+    TlsExpansionBitmapBits: array[0..$19] of Word;
+    SessionId: LongWord;
+  end;
+  PSimplePEB = ^TSimplePEB;
+
+  PExceptionRegistrationRecord = ^TExceptionRegistrationRecord;
+  TExceptionRegistrationRecord = packed record
+    Next: PExceptionRegistrationRecord;
+    Handler: Pointer; //PExceptionRoutine;
+  end;
+
+  PNTTIB = ^TNTTIB;
+  TNTTIB = packed record
+    ExceptionList: PExceptionRegistrationRecord;
+    StackBase: Pointer;
+    StackLimit: Pointer;
+    SubSystemTib: Pointer;
+    union1: record
+              case Boolean of
+                True: (FiberData: Pointer);
+                False: (Version: DWord);
+            end;
+    ArbitraryUserPointer: Pointer;
+    Self: PNTTIB;
+  end;
+
+  TClientID = packed record
+    UniqueProcess: LongWord;
+    UniqueThread: LongWord;
+  end;
+  PClientID = ^TClientID;
+
+  TSimpleTEB = packed record
+    NtTib: TNTTIB;
+    EnvironmentPointer: Pointer;
+    ClientId: TClientID;
+  end;
+  PSimpleTEB = ^TSimpleTEB;
+
+const
+  STATUS_SUCCESS = LongInt($00000000);
+  STATUS_PENDING = LongInt($00000103);
+  STATUS_END_OF_FILE = LongInt($C0000011);
+  STATUS_ACCESS_DENIED = LongInt($C0000022);
+  STATUS_OBJECT_TYPE_MISMATCH = LongInt($C0000024);
+  STATUS_PIPE_BROKEN = LongInt($C000014B);
+  STATUS_OBJECT_NAME_NOT_FOUND = LongInt($C0000034);
+  STATUS_FILE_IS_A_DIRECTORY = LongInt($C00000BA);
+
+  OBJ_INHERIT = $00000002;
+  OBJ_PERMANENT = $00000010;
+
+  FILE_DIRECTORY_FILE = $00000001;
+  FILE_NON_DIRECTORY_FILE = $00000040;
+  FILE_SYNCHRONOUS_IO_NONALERT = $00000020;
+  FILE_OPEN_FOR_BACKUP_INTENT = $00004000;
+  FILE_OPEN_REMOTE_INSTANCE = $00000400;
+
+  STANDARD_RIGHTS_REQUIRED = $000F0000;
+
+  FILE_SHARE_READ = $00000001;
+  FILE_SHARE_WRITE = $00000002;
+  FILE_SHARE_DELETE = $00000004;
+
+  FILE_OPEN = $00000001;
+  FILE_CREATE = $00000002;
+  FILE_OVERWRITE_IF = $00000005;
+
+  FILE_ATTRIBUTE_NORMAL = $00000080;
+
+  NT_SYNCHRONIZE = $00100000; // normally called SYNCHRONIZE
+  NT_DELETE = $00010000; // normally called DELETE
+  GENERIC_READ = LongWord($80000000);
+  GENERIC_WRITE = $40000000;
+  GENERIC_ALL = $10000000;
+  FILE_READ_ATTRIBUTES = $00000080;
+
+  FileStandardInformation = 5;
+  FileRenameInformation = 10;
+  FileDispositionInformation = 13;
+  FilePositionInformation = 14;
+  FileAllocationInformation = 19;
+  FileEndOfFileInformation = 20;
+
+  { Share mode open }
+  fmShareCompat    = $00000000;
+  fmShareExclusive = $10;
+  fmShareDenyWrite = $20;
+  fmShareDenyRead  = $30;
+  fmShareDenyNone  = $40;
+
+type
+  TIoStatusBlock = record
+    Status: LongInt;
+    Information: PLongWord;
+  end;
+  PIoStatusBlock = ^TIoStatusBlock;
+
+  TFileDispositionInformation = record
+    DeleteFile: LongBool;
+  end;
+
+  TFileStandardInformation = record
+    AllocationSize: TLargeInteger;
+    EndOfFile: TLargeInteger;
+    NumberOfLinks: LongWord;
+    DeletePending: ByteBool;
+    Directory: ByteBool;
+  end;
+
+  TFilePositionInformation = record
+    CurrentByteOffset: TLargeInteger;
+  end;
+
+  TFileEndOfFileInformation = record
+    EndOfFile: TLargeInteger;
+  end;
+
+  TFileAllocationInformation = record
+    AllocationSize: TLargeInteger;
+  end;
+
+  TFileRenameInformation = record
+    ReplaceIfExists: ByteBool;
+    RootDirectory: THandle;
+    FileNameLength: LongWord;
+    FileName: array[0..0] of WideChar;
+  end;
+  PFileRenameInformation = ^TFileRenameInformation;
+
+threadvar
+  errno: LongInt;
+
+procedure Errno2InoutRes;
+var
+  r: Word;
+begin
+{$message warning 'Correctly implement Errno2InoutRes'}
+  case errno of
+    STATUS_OBJECT_NAME_NOT_FOUND:
+      r := 2;
+    STATUS_OBJECT_TYPE_MISMATCH:
+      r := 3;
+    STATUS_ACCESS_DENIED:
+      r := 5;
+    STATUS_END_OF_FILE:
+      r := 100;
+    else
+      r := errno;
+  end;
+  errno := 0;
+  InOutRes := r;
+end;
+
+function NtCreateFile(FileHandle: PHandle; DesiredAccess: LongWord;
+  ObjectAttributes: PObjectAttributes; IoStatusBlock: PIOStatusBlock;
+  AllocationSize: PLargeInteger; FileAttributes: LongWord;
+  ShareAccess: LongWord; CreateDisposition: LongWord; CreateOptions: LongWord;
+  EaBuffer: Pointer; EaLength: LongWord): LongInt; stdcall; external ntdll;
+function  NtCreateDirectoryObject(DirectoryHandle: PHandle;
+  DesiredAccess: LongWord; ObjectAttributes: PObjectAttributes): LongInt;
+  stdcall; external ntdll;
+function  NtOpenDirectoryObject(DirectoryHandle: PHandle;
+  DesiredAccess: LongWord; ObjectAttributes: PObjectAttributes): LongInt;
+  stdcall; external ntdll;
+function NtClose(Handle: THandle): LongInt; stdcall; external ntdll;
+function NtMakeTemporaryObject(Handle: THandle): LongInt; stdcall;
+  external ntdll;
+function  NtSetInformationFile(FileHandle: THandle;
+  IoStatusBlock: PIoStatusBlock; FileInformation: Pointer;
+  FileInformationLength: LongWord; FileInformationClass: LongWord):
+  LongInt; stdcall; external ntdll;
+function  NtQueryInformationFile(FileHandle: THandle;
+  IoStatusBlock: PIoStatusBlock; FileInformation: Pointer;
+  FileInformationLength: LongWord; FileInformationClass: LongWord):
+  LongInt; stdcall; external ntdll;
+function NtReadFile(FileHandle: THandle; Event: THandle; ApcRoutine: Pointer;
+  ApcContext: Pointer; IoStatusBlock: PIOStatusBlock; Buffer: Pointer;
+  Length: LongWord; ByteOffset: PLargeInteger; Key: PLongWord): LongInt;
+  stdcall; external ntdll;
+function NtWriteFile(FileHandle: THandle; Event: THandle;
+  ApcRoutine: Pointer; ApcContext: Pointer; IoStatusBlock: PIOStatusBlock;
+  Buffer: Pointer; Length: LongWord; ByteOffset: PLargeInteger; Key: PLongWord):
+  LongInt; stdcall; external ntdll;
+function NtWaitForSingleObject(Handle: THandle; Alertable: ByteBool;
+  Timeout: PLargeInteger): LongInt; stdcall; external ntdll;
+function NtDisplayString(aString: PNtUnicodeString): LongInt; stdcall; external ntdll;
+
+{ TODO : move to platform specific file }
+function NtCurrentTEB: PSimpleTEB; assembler;
+asm
+  movl %fs:(0x18),%eax
+end;
+
+(* from NDKUtils *)
+procedure SysInitializeObjectAttributes(var aObjectAttr: TObjectAttributes;
+  aName: PNtUnicodeString; aAttributes: LongWord; aRootDir: THandle;
+  aSecurity: Pointer);
+begin
+  with aObjectAttr do begin
+    Length := SizeOf(TObjectAttributes);
+    RootDirectory := aRootDir;
+    Attributes := aAttributes;
+    ObjectName := aName;
+    SecurityDescriptor := aSecurity;
+    SecurityQualityOfService := Nil;
+  end;
+end;
+
+procedure SysPCharToNtStr(var aNtStr: TNtUnicodeString; aText: PChar;
+  aLen: LongWord);
+var
+  i: Integer;
+begin
+  if (aLen = 0) and (aText <> Nil) and (aText^ <> #0) then
+    aLen := StrLen(aText);
+  aNtStr.Length := aLen * SizeOf(WideChar);
+  aNtStr.MaximumLength := aNtStr.Length;
+  aNtStr.Buffer := GetMem(aNtStr.Length);
+  for i := 0 to aLen do
+    aNtStr.Buffer[i] := aText[i];
+end;
+
+procedure SysFreeNtStr(var aNtStr: TNtUnicodeString);
+begin
+  if aNtStr.Buffer <> Nil then begin
+    FreeMem(aNtStr.Buffer);
+    aNtStr.Buffer := Nil;
+  end;
+  aNtStr.Length := 0;
+  aNtStr.MaximumLength := 0;
+end;

rtl/nativent/sysosh.inc

@@ -15,10 +15,8 @@
 
 { Platform specific information }
 type
-  THandle = Pointer;
-  ULONG_PTR = PtrUInt;
+  THandle = PtrUInt;
   TThreadID = THandle;
-  SIZE_T = ULONG_PTR;
 
   { the fields of this record are os dependent  }
   { and they shouldn't be used in a program     }
@@ -30,7 +28,7 @@ type
     RecursionCount : longint;
     OwningThread : THandle;
     LockSemaphore : THandle;
-    SpinCount : ULONG_PTR;
+    SpinCount : LongWord; // PtrUInt?
   end;
 
 var

rtl/nativent/system.pp

@@ -19,15 +19,16 @@ interface
   {$define SYSTEMEXCEPTIONDEBUG}
 {$endif SYSTEMDEBUG}
 
-{.$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
-
 {$ifdef cpui386}
   {$define Set_i386_Exception_handler}
 {$endif cpui386}
 
-{.$define DISABLE_NO_THREAD_MANAGER}
+{$define DISABLE_NO_THREAD_MANAGER}
 
 {$ifdef KMODE}
+  // in KernelMode we need use a memory manager that just wraps the routines
+  // provided by the NT Executive and allows to select whether we want to use
+  // paged or non-paged (use sparely!) memory
   {$define HAS_MEMORYMANAGER}
 {$endif KMODE}
 
@@ -49,7 +50,7 @@ const
  AllowDriveSeparators : set of char = [];
 
 { FileNameCaseSensitive is defined separately below!!! }
- maxExitCode = High(LongInt);
+ maxExitCode = High(ErrorCode);
  MaxPathLen = High(Word);
  AllFilesMask = '*';
 
@@ -60,6 +61,19 @@ type
      handler : pointer;
    end;
 
+var
+{ C compatible arguments }
+  argc: LongWord;
+  argvw: PPWideChar;
+  argv: PPChar;
+
+const
+{ Default filehandles }
+  UnusedHandle    : THandle = 0;
+  StdInputHandle  : THandle = 0;
+  StdOutputHandle : THandle = 0;
+  StdErrorHandle  : THandle = 0;
+
 {$ifndef kmode}
 type
   TDLL_Entry_Hook = procedure (dllparam : longint);
@@ -77,6 +91,7 @@ const
   CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
 
   sLineBreak = LineEnding;
+  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
   System_exception_frame : PEXCEPTION_FRAME =nil;
 
@@ -85,6 +100,165 @@ implementation
 { include system independent routines }
 {$I system.inc}
 
+function fpc_pwidechar_length(p: PWideChar): LongInt; external name 'FPC_PWIDECHAR_LENGTH';
+
+{ based on setup_arguments from Win32 RTL }
+procedure setup_arguments;
+var
+  i,len,
+  arglen,
+  count   : longint;
+  argstart,
+  pc,arg  : pwidechar;
+  pc2     : pchar;
+  quote   : Boolean;
+  argvlen : longint;
+  params  : PRTLUserProcessParameters;
+
+  procedure allocarg(idx,len:longint);
+    var
+      oldargvlen : longint;
+    begin
+      if idx>=argvlen then
+       begin
+         oldargvlen:=argvlen;
+         argvlen:=(idx+8) and (not 7);
+         sysreallocmem(argvw,argvlen*sizeof(pointer));
+         fillchar(argvw[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
+       end;
+      { use realloc to reuse already existing memory }
+      { always allocate, even if length is zero, since }
+      { the arg. is still present!                     }
+      sysreallocmem(argvw[idx],len*sizeof(widechar)+2);
+    end;
+
+begin
+  { create commandline, it starts with the executed filename which is argvw[0] }
+  { NativeNT passes inside the PEB which is passed on startup }
+  argvw:=nil;
+  argv:=nil;
+  argvlen:=0;
+  params:=PSimplePEB(CurrentPEB)^.ProcessParameters;
+  ArgLen:=params^.ImagePathName.Length + 1;
+  allocarg(0,arglen);
+  move(params^.ImagePathName.Buffer^,argvw[0]^,arglen*sizeof(widechar)+1);
+  { Setup cmdline variable }
+  { cmdline is a PChar, but NT uses PWideChar... don't set cmdline for now }
+  {$message warning 'cmdline is not set'}
+//  cmdline:=GetCommandLine;
+  { the first argument isn't the image file name, so start at 1 }
+  count:=1;
+  { process arguments }
+  pc:=params^.CommandLine.Buffer;
+  while pc^<>#0 do
+   begin
+     { skip leading spaces }
+     while (Ord(pc^) >= 1) and (Ord(pc^) <= 32) {pc^ in [#1..#32]} do
+      inc(pc);
+     if pc^=#0 then
+      break;
+     { calc argument length }
+     quote:=False;
+     argstart:=pc;
+     arglen:=0;
+     while pc^<>#0 do
+      begin
+        case pc^ of
+          #1..#32 :
+            begin
+              if quote then
+               inc(arglen)
+              else
+               break;
+            end;
+          '"' :
+            if pc[1]<>'"' then
+              quote := not quote
+              else
+              inc(pc);
+          else
+            inc(arglen);
+        end;
+        inc(pc);
+      end;
+     { copy argument }
+     { Don't copy the first one, it is already there.}
+     If Count<>0 then
+      begin
+        allocarg(count,arglen);
+        quote:=False;
+        pc:=argstart;
+        arg:=argvw[count];
+        while (pc^<>#0) do
+         begin
+           case pc^ of
+             #1..#32 :
+               begin
+                 if quote then
+                  begin
+                    arg^:=pc^;
+                    inc(arg);
+                  end
+                 else
+                  break;
+               end;
+             '"' :
+               if pc[1]<>'"' then
+                 quote := not quote
+                  else
+                inc(pc);
+             else
+               begin
+                 arg^:=pc^;
+                 inc(arg);
+               end;
+           end;
+           inc(pc);
+         end;
+        arg^:=#0;
+      end;
+     inc(count);
+   end;
+  { get argc }
+  argc:=count;
+  { free unused memory, leaving a nil entry at the end }
+  sysreallocmem(argvw,(count+1)*sizeof(pointer));
+  argvw[count] := nil;
+  { now we need to fill argv with UTF8 encoded arguments }
+  sysreallocmem(argv,(count+1)*sizeof(pointer));
+  fillchar(argv^,(count+1)*sizeof(pointer),0);
+  for i := 0 to count - 1 do begin
+    len := fpc_pwidechar_length(argvw[i]);
+    pc := argvw[i];
+    argv[i]:=nil;
+    sysreallocmem(argv[i],len+1);
+    pc2 := argv[i];
+    {$message warning 'Use UnicodeToUTF8 for argument conversion'}
+    while Ord(pc^) > 0  do begin
+      if word(pc^) < 127 then
+        pc2^ := Char(word(pc^))
+      else
+        pc2^ := '?';
+      Inc(pc);
+      Inc(pc2);
+    end;
+    pc2^ := #0;
+  end;
+end;
+
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
+
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l<argc) then
+    paramstr:=strpas(argv[l])
+  else
+    paramstr:='';
+end;
+
 procedure KeQueryTickCount(TickCount: PLargeInteger); stdcall; external ntdll name 'KeQueryTickCount';
 
 procedure randomize;
@@ -104,7 +278,7 @@ end;
 procedure PascalMain;stdcall;external name 'PASCALMAIN';
 
 {$ifndef KMODE}
-function NtTerminateProcess(aProcess: THandle; aStatus: NTSTATUS): NTSTATUS; stdcall; external ntdll name 'NtTerminateProcess';
+function NtTerminateProcess(aProcess: THandle; aStatus: LongInt): LongInt; stdcall; external ntdll name 'NtTerminateProcess';
 {$endif KMODE}
 
 Procedure system_exit;
@@ -117,7 +291,7 @@ begin
 end;
 
 {$ifdef kmode}
-function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): NTSTATUS; [public, alias: 'FPC_DriverStartup'];
+function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): LongInt; [public, alias: 'FPC_DriverStartup'];
 begin
   IsDeviceDriver := True;
   IsConsole := True;
@@ -202,6 +376,54 @@ begin
 end;
 {$endif}
 
+{$ifndef kmode}
+
+// other user mode only stuff
+
+procedure SysInitStdIO;
+begin
+  with PSimplePEB(CurrentPEB)^.ProcessParameters^ do begin
+    StdInputHandle := StandardInput;
+    StdOutputHandle := StandardOutput;
+    StdErrorHandle := StandardError;
+  end;
+  if StdInputHandle <> 0 then
+    OpenStdIO(Input, fmInput, StdInputHandle)
+  else
+    Assign(Input, '');
+  if StdOutputHandle <> 0 then begin
+    OpenStdIO(Output, fmOutput, StdOutputHandle);
+    OpenStdIO(StdOut, fmOutput, StdOutputHandle);
+  end else begin
+    Assign(Output, '');
+    Assign(StdOut, '');
+  end;
+  if StdErrorHandle <> 0 then begin
+    OpenStdIO(ErrOutput, fmOutput, StdErrorHandle);
+    OpenStdIO(StdErr, fmOutput, StdErrorHandle);
+  end else begin
+    Assign(ErrOutput, '');
+    Assign(StdErr, '');
+  end;
+end;
+
+{$else}
+
+// other kernel mode only stuff
+
+{$endif}
+
+function GetProcessID: SizeUInt;
+begin
+{$ifdef kmode}
+  // it might be that we can detect the user process that called us,
+  // but that needs to be checked... so for now just return 0
+  Result := 0;
+{$else}
+  Result := NtCurrentTEB^.ClientID.UniqueProcess;
+{$endif}
+end;
+
 begin
 {$if not defined(KMODE) and not defined(HAS_MEMORYMANAGER)}
   { Setup heap }
@@ -209,6 +431,14 @@ begin
 {$endif ndef KMODE and ndef HAS_MEMORYMANAGER}
   SysInitExceptions;
   initvariantmanager;
+{$ifndef KMODE}
+  SysInitStdIO;
+  { Arguments }
+  setup_arguments;
+{$endif}
+  InOutRes := 0;
+  InitSystemThreads;
+  errno := 0;
   { 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;

rtl/nativent/systhrd.inc

@@ -0,0 +1,265 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2010 by Sven Barth
+
+    Native NT threading support implementation
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                             Native NT API imports
+*****************************************************************************}
+
+const
+  STATUS_NOT_IMPLEMENTED = LongInt($C0000002);
+
+{*****************************************************************************
+                             Threadvar support
+*****************************************************************************}
+
+    const
+      threadvarblocksize : dword = 0;
+
+    procedure SysInitThreadvar(var offset : dword;size : dword);
+      begin
+        offset:=threadvarblocksize;
+      {$ifdef CPUARM}
+        // Data must be allocated at 4 bytes boundary for ARM
+        size:=(size + 3) and not dword(3);
+      {$endif CPUARM}
+        inc(threadvarblocksize,size);
+      end;
+
+
+    procedure SysAllocateThreadVars;
+      begin
+      end;
+
+    procedure SysInitMultithreading;
+      begin
+      end;
+
+
+    procedure SysFiniMultithreading;
+      begin
+      end;
+
+    function SysRelocateThreadvar(offset : dword) : pointer;
+      begin
+        SysRelocateThreadvar:=Pointer(Offset);
+      end;
+
+
+    procedure SysReleaseThreadVars;
+      begin
+      end;
+
+
+{*****************************************************************************
+                            Thread starting
+*****************************************************************************}
+
+    function SysBeginThread(sa : Pointer;stacksize : ptruint;
+                         ThreadFunction : tthreadfunc;p : pointer;
+                         creationFlags : dword;var ThreadId : TThreadID) : TThreadID;
+      begin
+        ThreadId := 0;
+        Result := 0;
+      end;
+
+
+    procedure SysEndThread(ExitCode : DWord);
+      begin
+        DoneThread;
+      end;
+
+
+    procedure SysThreadSwitch;
+    begin
+    end;
+
+
+    function  SysSuspendThread (threadHandle : TThreadID) : dword;
+    begin
+      Result := STATUS_NOT_IMPLEMENTED;
+    end;
+
+
+    function  SysResumeThread  (threadHandle : TThreadID) : dword;
+    begin
+      Result := STATUS_NOT_IMPLEMENTED;
+    end;
+
+
+    function  SysKillThread (threadHandle : TThreadID) : dword;
+    begin
+      Result := STATUS_NOT_IMPLEMENTED;
+    end;
+
+    function  SysCloseThread (threadHandle : TThreadID) : dword;
+    begin
+      Result := STATUS_NOT_IMPLEMENTED;
+    end;
+
+    function  SysWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword;
+    begin
+      Result := STATUS_NOT_IMPLEMENTED;
+    end;
+
+
+    function  SysThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean;            {-15..+15, 0=normal}
+    begin
+      Result := False;
+    end;
+
+
+    function  SysThreadGetPriority (threadHandle : TThreadID): longint;
+    begin
+      Result := 0;
+    end;
+
+    function  SysGetCurrentThreadId : TThreadID;
+    begin
+      Result := 0;
+    end;
+
+{*****************************************************************************
+                          Delphi/Win32 compatibility
+*****************************************************************************}
+
+procedure SysInitCriticalSection(var cs);
+begin
+  Pointer(cs) := GetMem(SizeOf(Pointer));
+end;
+
+
+procedure SysDoneCriticalSection(var cs);
+begin
+  FreeMem(Pointer(cs));
+end;
+
+
+procedure SysEnterCriticalSection(var cs);
+begin
+end;
+
+function SysTryEnterCriticalSection(var cs):longint;
+begin
+  Result := STATUS_NOT_IMPLEMENTED;
+end;
+
+procedure SysLeaveCriticalSection(var cs);
+begin
+end;
+
+
+function intBasicEventCreate(EventAttributes : Pointer;
+AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+begin
+  Result := GetMem(SizeOf(Pointer));
+end;
+
+procedure intbasiceventdestroy(state:peventstate);
+begin
+  FreeMem(state);
+end;
+
+procedure intbasiceventResetEvent(state:peventstate);
+begin
+
+end;
+
+procedure intbasiceventSetEvent(state:peventstate);
+begin
+end;
+
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+begin
+  Result := STATUS_NOT_IMPLEMENTED;
+end;
+
+function intRTLEventCreate: PRTLEvent;
+begin
+  Result := GetMem(SizeOf(Pointer));
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+begin
+  FreeMem(AEvent);
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+begin
+
+end;
+
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+begin
+
+end;
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+begin
+
+end;
+
+procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
+begin
+
+end;
+
+
+Var
+  NTThreadManager : TThreadManager;
+
+Procedure InitSystemThreads;
+begin
+  With NTThreadManager do
+    begin
+    InitManager            :=Nil;
+    DoneManager            :=Nil;
+    BeginThread            :=@SysBeginThread;
+    EndThread              :=@SysEndThread;
+    SuspendThread          :=@SysSuspendThread;
+    ResumeThread           :=@SysResumeThread;
+    KillThread             :=@SysKillThread;
+    ThreadSwitch           :=@SysThreadSwitch;
+    CloseThread		   :=@SysCloseThread;
+    WaitForThreadTerminate :=@SysWaitForThreadTerminate;
+    ThreadSetPriority      :=@SysThreadSetPriority;
+    ThreadGetPriority      :=@SysThreadGetPriority;
+    GetCurrentThreadId     :=@SysGetCurrentThreadId;
+    InitCriticalSection    :=@SysInitCriticalSection;
+    DoneCriticalSection    :=@SysDoneCriticalSection;
+    EnterCriticalSection   :=@SysEnterCriticalSection;
+    TryEnterCriticalSection:=@SysTryEnterCriticalSection;
+    LeaveCriticalSection   :=@SysLeaveCriticalSection;
+    InitThreadVar          :=@SysInitThreadVar;
+    RelocateThreadVar      :=@SysRelocateThreadVar;
+    AllocateThreadVars     :=@SysAllocateThreadVars;
+    ReleaseThreadVars      :=@SysReleaseThreadVars;
+    BasicEventCreate       :=@intBasicEventCreate;
+    BasicEventDestroy      :=@intBasicEventDestroy;
+    BasicEventResetEvent   :=@intBasicEventResetEvent;
+    BasicEventSetEvent     :=@intBasicEventSetEvent;
+    BasiceventWaitFor      :=@intBasiceventWaitFor;
+    RTLEventCreate         :=@intRTLEventCreate;
+    RTLEventDestroy        :=@intRTLEventDestroy;
+    RTLEventSetEvent       :=@intRTLEventSetEvent;
+    RTLEventResetEvent     :=@intRTLEventResetEvent;
+    RTLEventWaitFor        :=@intRTLEventWaitFor;
+    RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
+    end;
+  SetThreadManager(NTThreadManager);
+{  ThreadID := GetCurrentThreadID;
+  if IsLibrary then
+    SysInitMultithreading;}
+end;
+

rtl/nativent/sysutils.pp

@@ -0,0 +1,779 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2010 by Sven Barth
+    member of the Free Pascal development team
+
+    Sysutils unit for NativeNT
+
+    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 sysutils;
+interface
+
+{$MODE objfpc}
+{$MODESWITCH OUT}
+{ force ansistrings }
+{$H+}
+
+uses
+  ndk;
+
+{$DEFINE HAS_SLEEP}
+{$DEFINE HAS_CREATEGUID}
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+implementation
+
+  uses
+    sysconst, ndkutils;
+
+{$DEFINE FPC_NOGENERICANSIROUTINES}
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+function FileOpen(const FileName : string; Mode : Integer) : THandle;
+const
+  AccessMode: array[0..2] of ACCESS_MASK  = (
+    GENERIC_READ,
+    GENERIC_WRITE,
+    GENERIC_READ or GENERIC_WRITE);
+  ShareMode: array[0..4] of ULONG = (
+               0,
+               0,
+               FILE_SHARE_READ,
+               FILE_SHARE_WRITE,
+               FILE_SHARE_READ or FILE_SHARE_WRITE);
+var
+  ntstr: UNICODE_STRING;
+  objattr: OBJECT_ATTRIBUTES;
+  iostatus: IO_STATUS_BLOCK;
+begin
+  AnsiStrToNtStr(FileName, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+  NtCreateFile(@Result, AccessMode[Mode and 3] or NT_SYNCHRONIZE, @objattr,
+    @iostatus, Nil, FILE_ATTRIBUTE_NORMAL, ShareMode[(Mode and $F0) shr 4],
+    FILE_OPEN, FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil, 0);
+  FreeNtStr(ntstr);
+end;
+
+
+function FileCreate(const FileName : String) : THandle;
+var
+  ntstr: UNICODE_STRING;
+  objattr: OBJECT_ATTRIBUTES;
+  iostatus: IO_STATUS_BLOCK;
+  res: NTSTATUS;
+begin
+  AnsiStrToNTStr(FileName, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+  NtCreateFile(@Result, GENERIC_READ or GENERIC_WRITE or NT_SYNCHRONIZE,
+    @objattr, @iostatus, Nil, FILE_ATTRIBUTE_NORMAL, 0, FILE_OVERWRITE_IF,
+    FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil, 0);
+  FreeNtStr(ntstr);
+end;
+
+
+function FileCreate(const FileName : String; Mode: longint) : THandle;
+begin
+  FileCreate := FileCreate(FileName);
+end;
+
+
+function FileRead(Handle : THandle; out Buffer; Count : longint) : Longint;
+var
+  iostatus: IO_STATUS_BLOCK;
+  res: NTSTATUS;
+begin
+  res := NtReadFile(Handle, 0, Nil, Nil, @iostatus, @Buffer, Count, Nil, Nil);
+
+  if res = STATUS_PENDING then begin
+    res := NtWaitForSingleObject(Handle, False, Nil);
+    if NT_SUCCESS(res) then
+      res := iostatus.union1.Status;
+  end;
+
+  if NT_SUCCESS(res) then
+    Result := LongInt(iostatus.Information)
+  else
+    Result := -1;
+end;
+
+
+function FileWrite(Handle : THandle; const Buffer; Count : Longint) : Longint;
+var
+  iostatus: IO_STATUS_BLOCK;
+  res: NTSTATUS;
+begin
+  res := NtWriteFile(Handle, 0, Nil, Nil, @iostatus, @Buffer, Count, Nil,
+           Nil);
+
+  if res = STATUS_PENDING then begin
+    res := NtWaitForSingleObject(Handle, False, Nil);
+    if NT_SUCCESS(res) then
+      res := iostatus.union1.Status;
+  end;
+
+  if NT_SUCCESS(res) then
+    Result := LongInt(iostatus.Information)
+  else
+    Result := -1;
+end;
+
+
+function FileSeek(Handle : THandle;FOffset,Origin : Longint) : Longint;
+begin
+  Result := longint(FileSeek(Handle, Int64(FOffset), Origin));
+end;
+
+
+function FileSeek(Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
+const
+  ErrorCode = $FFFFFFFFFFFFFFFF;
+var
+  position: FILE_POSITION_INFORMATION;
+  standard: FILE_STANDARD_INFORMATION;
+  iostatus: IO_STATUS_BLOCK;
+  res: NTSTATUS;
+begin
+  { determine the new position }
+  case Origin of
+    fsFromBeginning:
+      position.CurrentByteOffset.QuadPart := FOffset;
+    fsFromCurrent: begin
+      res := NtQueryInformationFile(Handle, @iostatus, @position,
+               SizeOf(FILE_POSITION_INFORMATION), FilePositionInformation);
+      if res < 0 then begin
+        Result := ErrorCode;
+        Exit;
+      end;
+      position.CurrentByteOffset.QuadPart :=
+        position.CurrentByteOffset.QuadPart + FOffset;
+    end;
+    fsFromEnd: begin
+      res := NtQueryInformationFile(Handle, @iostatus, @standard,
+               SizeOf(FILE_STANDARD_INFORMATION), FileStandardInformation);
+      if res < 0 then begin
+        Result := ErrorCode;
+        Exit;
+      end;
+      position.CurrentByteOffset.QuadPart := standard.EndOfFile.QuadPart +
+                                               FOffset;
+    end;
+    else begin
+      Result := ErrorCode;
+      Exit;
+    end;
+  end;
+
+  { set the new position }
+  res := NtSetInformationFile(Handle, @iostatus, @position,
+           SizeOf(FILE_POSITION_INFORMATION), FilePositionInformation);
+  if res < 0 then
+    Result := ErrorCode
+  else
+    Result := position.CurrentByteOffset.QuadPart;
+end;
+
+
+procedure FileClose(Handle : THandle);
+begin
+  NtClose(Handle);
+end;
+
+
+function FileTruncate(Handle : THandle;Size: Int64) : boolean;
+var
+  endoffileinfo: FILE_END_OF_FILE_INFORMATION;
+  allocinfo: FILE_ALLOCATION_INFORMATION;
+  iostatus: IO_STATUS_BLOCK;
+  res: NTSTATUS;
+begin
+  // based on ReactOS' SetEndOfFile
+  endoffileinfo.EndOfFile.QuadPart := Size;
+  res := NtSetInformationFile(Handle, @iostatus, @endoffileinfo,
+           SizeOf(FILE_END_OF_FILE_INFORMATION), FileEndOfFileInformation);
+  if NT_SUCCESS(res) then begin
+    allocinfo.AllocationSize.QuadPart := Size;
+    res := NtSetInformationFile(handle, @iostatus, @allocinfo,
+             SizeOf(FILE_ALLOCATION_INFORMATION), FileAllocationInformation);
+    Result := NT_SUCCESS(res);
+  end else
+    Result := False;
+end;
+
+function NTToDosTime(const NtTime: LARGE_INTEGER): LongInt;
+var
+  userdata: PKUSER_SHARED_DATA;
+  local, bias: LARGE_INTEGER;
+  fields: TIME_FIELDS;
+  zs: LongInt;
+begin
+  userdata := SharedUserData;
+  repeat
+    bias.u.HighPart := userdata^.TimeZoneBias.High1Time;
+    bias.u.LowPart := userdata^.TimeZoneBias.LowPart;
+  until bias.u.HighPart = userdata^.TimeZoneBias.High2Time;
+
+  local.QuadPart := NtTime.QuadPart - bias.QuadPart;
+
+  RtlTimeToTimeFields(@local, @fields);
+
+  { from objpas\datutil.inc\DateTimeToDosDateTime }
+  Result := - 1980;
+  Result := Result + fields.Year and 127;
+  Result := Result shl 4;
+  Result := Result + fields.Month;
+  Result := Result shl 5;
+  Result := Result + fields.Day;
+  Result := Result shl 16;
+  zs := fields.Hour;
+  zs := zs shl 6;
+  zs := zs + fields.Minute;
+  zs := zs shl 5;
+  zs := zs + fields.Second div 2;
+  Result := Result + (zs and $ffff);
+end;
+
+function DosToNtTime(aDTime: LongInt; var aNtTime: LARGE_INTEGER): Boolean;
+var
+  fields: TIME_FIELDS;
+  local, bias: LARGE_INTEGER;
+  userdata: PKUSER_SHARED_DATA;
+begin
+  { from objpas\datutil.inc\DosDateTimeToDateTime }
+  fields.Second := (aDTime and 31) * 2;
+  aDTime := aDTime shr 5;
+  fields.Minute := aDTime and 63;
+  aDTime := aDTime shr 6;
+  fields.Hour := aDTime and 31;
+  aDTime := aDTime shr 5;
+  fields.Day := aDTime and 31;
+  aDTime := aDTime shr 5;
+  fields.Month := aDTime and 15;
+  aDTime := aDTime shr 4;
+  fields.Year := aDTime + 1980;
+
+  Result := RtlTimeFieldsToTime(@fields, @local);
+  if not Result then
+    Exit;
+
+  userdata := SharedUserData;
+  repeat
+    bias.u.HighPart := userdata^.TimeZoneBias.High1Time;
+    bias.u.LowPart := userdata^.TimeZoneBias.LowPart;
+  until bias.u.HighPart = userdata^.TimeZoneBias.High2Time;
+
+  aNtTime.QuadPart := local.QuadPart + bias.QuadPart;
+end;
+
+function FileAge(const FileName: String): Longint;
+begin
+  Result := -1;
+end;
+
+
+function FileExists(const FileName: String): Boolean;
+var
+  ntstr: UNICODE_STRING;
+  objattr: OBJECT_ATTRIBUTES;
+  res: NTSTATUS;
+  iostatus: IO_STATUS_BLOCK;
+  h: THandle;
+begin
+  AnsiStrToNtStr(FileName, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+  res := NtOpenFile(@h, 0, @objattr, @iostatus,
+           FILE_SHARE_READ or FILE_SHARE_WRITE,
+           FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
+  Result := NT_SUCCESS(res);
+
+  if Result then
+    NtClose(h);
+  FreeNtStr(ntstr);
+end;
+
+
+function DirectoryExists(const Directory : String) : Boolean;
+var
+  ntstr: UNICODE_STRING;
+  objattr: OBJECT_ATTRIBUTES;
+  res: NTSTATUS;
+  iostatus: IO_STATUS_BLOCK;
+  h: THandle;
+begin
+  AnsiStrToNtStr(Directory, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+
+  { first test wether this is a object directory }
+  res := NtOpenDirectoryObject(@h, 0, @objattr);
+  if NT_SUCCESS(res) then
+    Result := True
+  else begin
+    if res = STATUS_OBJECT_TYPE_MISMATCH then begin
+      { this is a file object! }
+      res := NtOpenFile(@h, 0, @objattr, @iostatus,
+        FILE_SHARE_READ or FILE_SHARE_WRITE,
+        FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
+      Result := NT_SUCCESS(res);
+    end else
+      Result := False;
+  end;
+
+  if Result then
+    NtClose(h);
+  FreeNtStr(ntstr);
+end;
+
+
+function FindMatch(var f: TSearchRec): Longint;
+begin
+  Result := -1;
+end;
+
+
+function FindFirst(const Path: String; Attr: Longint; out Rslt: TSearchRec): Longint;
+begin
+  Result := -1;
+end;
+
+
+function FindNext(var Rslt: TSearchRec): Longint;
+begin
+  Result := -1;
+end;
+
+
+procedure FindClose(var F: TSearchrec);
+begin
+  { empty }
+end;
+
+
+function FileGetDate(Handle: THandle): Longint;
+var
+  res: NTSTATUS;
+  basic: FILE_BASIC_INFORMATION;
+  iostatus: IO_STATUS_BLOCK;
+begin
+  res := NtQueryInformationFile(Handle, @iostatus, @basic,
+           SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
+  if NT_SUCCESS(res) then
+    Result := NtToDosTime(basic.LastWriteTime)
+  else
+    Result := -1;
+end;
+
+
+function FileSetDate(Handle: THandle;Age: Longint): Longint;
+var
+  res: NTSTATUS;
+  basic: FILE_BASIC_INFORMATION;
+  iostatus: IO_STATUS_BLOCK;
+begin
+  res := NtQueryInformationFile(Handle, @iostatus, @basic,
+           SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
+  if NT_SUCCESS(res) then begin
+    if not DosToNtTime(Age, basic.LastWriteTime) then begin
+      Result := -1;
+      Exit;
+    end;
+
+    res := NtSetInformationFile(Handle, @iostatus, @basic,
+             SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
+    if NT_SUCCESS(res) then
+      Result := 0
+    else
+      Result := res;
+  end else
+    Result := res;
+end;
+
+
+function FileGetAttr(const FileName: String): Longint;
+var
+  objattr: OBJECT_ATTRIBUTES;
+  info: FILE_NETWORK_OPEN_INFORMATION;
+  res: NTSTATUS;
+  ntstr: UNICODE_STRING;
+begin
+  AnsiStrToNtStr(FileName, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+
+  res := NtQueryFullAttributesFile(@objattr, @info);
+  if NT_SUCCESS(res) then
+    Result := info.FileAttributes
+  else
+    Result := 0;
+
+  FreeNtStr(ntstr);
+end;
+
+
+function FileSetAttr(const Filename: String; Attr: LongInt): Longint;
+var
+  h: THandle;
+  objattr: OBJECT_ATTRIBUTES;
+  ntstr: UNICODE_STRING;
+  basic: FILE_BASIC_INFORMATION;
+  res: NTSTATUS;
+  iostatus: IO_STATUS_BLOCK;
+begin
+  AnsiStrToNtStr(Filename, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+  res := NtOpenFile(@h,
+           NT_SYNCHRONIZE or FILE_READ_ATTRIBUTES or FILE_WRITE_ATTRIBUTES,
+           @objattr, @iostatus,
+           FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
+           FILE_SYNCHRONOUS_IO_NONALERT);
+
+  FreeNtStr(ntstr);
+
+  if NT_SUCCESS(res) then begin
+    res := NtQueryInformationFile(h, @iostatus, @basic,
+             SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
+
+    if NT_SUCCESS(res) then begin
+      basic.FileAttributes := Attr;
+      Result := NtSetInformationFile(h, @iostatus, @basic,
+                  SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
+    end;
+
+    NtClose(h);
+  end else
+    Result := res;
+end;
+
+
+function DeleteFile(const FileName: String): Boolean;
+var
+  h: THandle;
+  objattr: OBJECT_ATTRIBUTES;
+  ntstr: UNICODE_STRING;
+  dispinfo: FILE_DISPOSITION_INFORMATION;
+  res: NTSTATUS;
+  iostatus: IO_STATUS_BLOCK;
+begin
+  AnsiStrToNtStr(Filename, ntstr);
+  InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
+  res := NtOpenFile(@h, NT_DELETE, @objattr, @iostatus,
+           FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
+           FILE_NON_DIRECTORY_FILE);
+
+  FreeNtStr(ntstr);
+
+  if NT_SUCCESS(res) then begin
+    dispinfo.DeleteFile := True;
+
+    res := NtSetInformationFile(h, @iostatus, @dispinfo,
+             SizeOf(FILE_DISPOSITION_INFORMATION), FileDispositionInformation);
+
+    Result := NT_SUCCESS(res);
+
+    NtClose(h);
+  end else
+    Result := False;
+end;
+
+
+function RenameFile(const OldName, NewName: String): Boolean;
+var
+  h: THandle;
+  objattr: OBJECT_ATTRIBUTES;
+  iostatus: IO_STATUS_BLOCK;
+  dest, src: UNICODE_STRING;
+  renameinfo: PFILE_RENAME_INFORMATION;
+  res: LongInt;
+begin
+  { check whether the destination exists first }
+  AnsiStrToNtStr(NewName, dest);
+  InitializeObjectAttributes(objattr, @dest, 0, 0, Nil);
+
+  res := NtCreateFile(@h, 0, @objattr, @iostatus, Nil, 0,
+           FILE_SHARE_READ or FILE_SHARE_WRITE, FILE_OPEN,
+           FILE_NON_DIRECTORY_FILE, Nil, 0);
+  if NT_SUCCESS(res) then begin
+    { destination already exists => error }
+    NtClose(h);
+    Result := False;
+  end else begin
+    AnsiStrToNtStr(OldName, src);
+    InitializeObjectAttributes(objattr, @src, 0, 0, Nil);
+
+    res := NtCreateFile(@h,
+             GENERIC_ALL or NT_SYNCHRONIZE or FILE_READ_ATTRIBUTES,
+             @objattr, @iostatus, Nil, 0, FILE_SHARE_READ or FILE_SHARE_WRITE,
+             FILE_OPEN, FILE_OPEN_FOR_BACKUP_INTENT or FILE_OPEN_REMOTE_INSTANCE
+             or FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil,
+             0);
+
+    if NT_SUCCESS(res) then begin
+      renameinfo := GetMem(SizeOf(FILE_RENAME_INFORMATION) + dest.Length);
+      with renameinfo^ do begin
+        ReplaceIfExists := False;
+        RootDirectory := 0;
+        FileNameLength := dest.Length;
+        Move(dest.Buffer^, renameinfo^.FileName, dest.Length);
+      end;
+
+      res := NtSetInformationFile(h, @iostatus, renameinfo,
+               SizeOf(FILE_RENAME_INFORMATION) + dest.Length,
+               FileRenameInformation);
+      if not NT_SUCCESS(res) then begin
+        { this could happen if src and destination reside on different drives,
+          so we need to copy the file manually }
+        {$message warning 'RenameFile: Implement file copy!'}
+        Result := False;
+      end else
+        Result := True;
+
+      NtClose(h);
+    end else
+      Result := False;
+
+    FreeNtStr(src);
+  end;
+
+  FreeNtStr(dest);
+end;
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+function diskfree(drive: byte): int64;
+begin
+  { here the mount manager needs to be queried }
+  Result := -1;
+end;
+
+
+function disksize(drive: byte): int64;
+begin
+  { here the mount manager needs to be queried }
+  Result := -1;
+end;
+
+
+function GetCurrentDir: String;
+begin
+  GetDir(0, result);
+end;
+
+
+function SetCurrentDir(const NewDir: String): Boolean;
+begin
+{$I-}
+  ChDir(NewDir);
+{$I+}
+  Result := IOResult = 0;
+end;
+
+
+function CreateDir(const NewDir: String): Boolean;
+begin
+{$I-}
+  MkDir(NewDir);
+{$I+}
+  Result := IOResult = 0;
+end;
+
+
+function RemoveDir(const Dir: String): Boolean;
+begin
+{$I-}
+  RmDir(Dir);
+{$I+}
+  Result := IOResult = 0;
+end;
+
+
+{****************************************************************************
+                              Time Functions
+****************************************************************************}
+
+
+procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+  bias, syst: LARGE_INTEGER;
+  fields: TIME_FIELDS;
+  userdata: PKUSER_SHARED_DATA;
+begin
+  // get UTC time
+  userdata := SharedUserData;
+  repeat
+    syst.u.HighPart := userdata^.SystemTime.High1Time;
+    syst.u.LowPart := userdata^.SystemTime.LowPart;
+  until syst.u.HighPart = userdata^.SystemTime.High2Time;
+
+  // adjust to local time
+  repeat
+    bias.u.HighPart := userdata^.TimeZoneBias.High1Time;
+    bias.u.LowPart := userdata^.TimeZoneBias.LowPart;
+  until bias.u.HighPart = userdata^.TimeZoneBias.High2Time;
+  syst.QuadPart := syst.QuadPart - bias.QuadPart;
+
+  RtlTimeToTimeFields(@syst, @fields);
+
+  SystemTime.Year := fields.Year;
+  SystemTime.Month := fields.Month;
+  SystemTime.Day := fields.Day;
+  SystemTime.Hour := fields.Hour;
+  SystemTime.Minute := fields.Minute;
+  SystemTime.Second := fields.Second;
+  SystemTime.Millisecond := fields.MilliSeconds;
+end;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure sysbeep;
+begin
+  { empty }
+end;
+
+procedure InitInternational;
+begin
+  InitInternationalGeneric;
+end;
+
+
+{****************************************************************************
+                           Target Dependent
+****************************************************************************}
+
+function SysErrorMessage(ErrorCode: Integer): String;
+begin
+  Result := 'NT error code: 0x' + IntToHex(ErrorCode, 8);
+end;
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+function wstrlen(p: PWideChar): LongInt; external name 'FPC_PWIDECHAR_LENGTH';
+
+function GetEnvironmentVariable(const EnvVar: String): String;
+var
+   s : string;
+   i : longint;
+   hp: pwidechar;
+   len: sizeint;
+begin
+   { TODO : test once I know how to execute processes }
+   Result:='';
+   hp:=PPEB(CurrentPEB)^.ProcessParameters^.Environment;
+   while hp^<>#0 do
+     begin
+        len:=UnicodeToUTF8(Nil, hp, 0);
+        SetLength(s,len);
+        UnicodeToUTF8(PChar(s), hp, len);
+        //s:=strpas(hp);
+        i:=pos('=',s);
+        if uppercase(copy(s,1,i-1))=upcase(envvar) then
+          begin
+             Result:=copy(s,i+1,length(s)-i);
+             break;
+          end;
+        { next string entry}
+        hp:=hp+wstrlen(hp)+1;
+     end;
+end;
+
+function GetEnvironmentVariableCount: Integer;
+var
+  hp : pwidechar;
+begin
+  Result:=0;
+  hp:=PPEB(CurrentPEB)^.ProcessParameters^.Environment;
+  If (Hp<>Nil) then
+    while hp^<>#0 do
+      begin
+      Inc(Result);
+      hp:=hp+wstrlen(hp)+1;
+      end;
+end;
+
+function GetEnvironmentString(Index: Integer): String;
+var
+  hp : pwidechar;
+  len: sizeint;
+begin
+  Result:='';
+  hp:=PPEB(CurrentPEB)^.ProcessParameters^.Environment;
+  If (Hp<>Nil) then
+    begin
+    while (hp^<>#0) and (Index>1) do
+      begin
+      Dec(Index);
+      hp:=hp+wstrlen(hp)+1;
+      end;
+    If (hp^<>#0) then
+      begin
+        len:=UnicodeToUTF8(Nil, hp, 0);
+        SetLength(Result, len);
+        UnicodeToUTF8(PChar(Result), hp, len);
+      end;
+    end;
+end;
+
+
+function ExecuteProcess(const Path: AnsiString; const ComLine: AnsiString;
+  Flags: TExecuteFlags = []): Integer;
+begin
+  { TODO : implement }
+  Result := 0;
+end;
+
+function ExecuteProcess(const Path: AnsiString;
+  const ComLine: Array of AnsiString; Flags:TExecuteFlags = []): Integer;
+var
+  CommandLine: AnsiString;
+  I: integer;
+begin
+  Commandline := '';
+  for I := 0 to High (ComLine) do
+   if Pos (' ', ComLine [I]) <> 0 then
+    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+   else
+    CommandLine := CommandLine + ' ' + Comline [I];
+  ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
+end;
+
+procedure Sleep(Milliseconds: Cardinal);
+const
+  DelayFactor = 10000;
+var
+  interval: LARGE_INTEGER;
+begin
+  interval.QuadPart := - Milliseconds * DelayFactor;
+  NtDelayExecution(False, @interval);
+end;
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+  OnBeep := @SysBeep;
+finalization
+  DoneExceptions;
+end.

rtl/nativent/tthread.inc

@@ -0,0 +1,56 @@
+{ Thread management routines }
+
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: SizeUInt = DefaultStackSize);
+begin
+  inherited Create;
+end;
+
+
+destructor TThread.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+  FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+begin
+  Result := tpNormal;
+end;
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+end;
+
+procedure TThread.Suspend;
+begin
+end;
+
+procedure TThread.Resume;
+begin
+end;
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+  Result := -1;
+end;

rtl/nativent/varutils.pp

@@ -0,0 +1,38 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2010 by Sven Barth
+
+    Interface and OS-dependent part of variant support
+
+    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.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.