--- Merging r14020 into '.':

U    packages/fcl-process/src/unix/process.inc
--- Merging r14054 into '.':
U    tests/test/units/math/tnaninf.pp
--- Merging r14058 into '.':
U    packages/zorba/src/zorba.inc
--- Merging r14094 into '.':
U    rtl/wince/system.pp
U    rtl/win64/system.pp
U    rtl/win/syswin.inc
U    rtl/win32/system.pp
--- Merging r14168 into '.':
U    rtl/inc/lnfodwrf.pp
--- Merging r14169 into '.':
G    rtl/inc/lnfodwrf.pp
--- Merging r14172 into '.':
U    rtl/inc/lineinfo.pp
--- Merging r14211 into '.':
U    rtl/unix/sysdir.inc
U    rtl/go32v2/sysdir.inc
U    rtl/win/sysdir.inc
U    rtl/os2/sysdir.inc
U    rtl/inc/system.inc
U    rtl/inc/systemh.inc
U    rtl/objpas/objpas.pp
--- Merging r14212 into '.':
U    rtl/inc/rtti.inc
U    rtl/inc/objpas.inc
U    rtl/inc/compproc.inc
G    rtl/inc/system.inc
G    rtl/objpas/objpas.pp
--- Merging r14215 into '.':
U    packages/libxml/src/xmlxsd.pas
--- Merging r14216 into '.':
U    rtl/win/wininc/base.inc
U    rtl/win/wininc/defines.inc
U    rtl/win/wininc/struct.inc
--- Merging r14217 into '.':
U    tests/test/targ1b.pp
--- Merging r14220 into '.':
U    packages/fcl-db/src/sqlite/customsqliteds.pas
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas

# revisions: 14020,14054,14058,14094,14168,14169,14172,14211,14212,14215,14216,14217,14220
------------------------------------------------------------------------
r14020 | marco | 2009-11-03 23:15:29 +0100 (Tue, 03 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/fcl-process/src/unix/process.inc

 * Patch from Mantis 14709

------------------------------------------------------------------------
------------------------------------------------------------------------
r14054 | jonas | 2009-11-04 17:55:20 +0100 (Wed, 04 Nov 2009) | 2 lines
Changed paths:
   M /trunk/tests/test/units/math/tnaninf.pp

  * make test compilable by Kylix (math->Math)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14058 | ivost | 2009-11-04 18:46:43 +0100 (Wed, 04 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/zorba/src/zorba.inc

* changed out parameter

------------------------------------------------------------------------
------------------------------------------------------------------------
r14094 | michael | 2009-11-07 11:10:47 +0100 (Sat, 07 Nov 2009) | 1 line
Changed paths:
   M /trunk/rtl/win/syswin.inc
   M /trunk/rtl/win32/system.pp
   M /trunk/rtl/win64/system.pp
   M /trunk/rtl/wince/system.pp

* Patch to remove useless process_entry_hook from sven barth
------------------------------------------------------------------------
------------------------------------------------------------------------
r14168 | michael | 2009-11-14 11:12:53 +0100 (Sat, 14 Nov 2009) | 1 line
Changed paths:
   M /trunk/rtl/inc/lnfodwrf.pp

* Patch from Martin Friebe to buffer reading dwarf info
------------------------------------------------------------------------
------------------------------------------------------------------------
r14169 | michael | 2009-11-14 11:29:45 +0100 (Sat, 14 Nov 2009) | 1 line
Changed paths:
   M /trunk/rtl/inc/lnfodwrf.pp

* Added warning about thread-safety
------------------------------------------------------------------------
------------------------------------------------------------------------
r14172 | michael | 2009-11-14 12:34:28 +0100 (Sat, 14 Nov 2009) | 1 line
Changed paths:
   M /trunk/rtl/inc/lineinfo.pp

* Added warning about thread-safety
------------------------------------------------------------------------
------------------------------------------------------------------------
r14211 | marco | 2009-11-18 19:04:51 +0100 (Wed, 18 Nov 2009) | 2 lines
Changed paths:
   M /trunk/rtl/go32v2/sysdir.inc
   M /trunk/rtl/inc/system.inc
   M /trunk/rtl/inc/systemh.inc
   M /trunk/rtl/objpas/objpas.pp
   M /trunk/rtl/os2/sysdir.inc
   M /trunk/rtl/unix/sysdir.inc
   M /trunk/rtl/win/sysdir.inc

 * ansistring versions of mk/rm/chdir in objpas, Mantis 15010.  The os-dependant routines of *nix/os2/win/dos have been converted

------------------------------------------------------------------------
------------------------------------------------------------------------
r14212 | marco | 2009-11-18 22:16:12 +0100 (Wed, 18 Nov 2009) | 1 line
Changed paths:
   M /trunk/rtl/inc/compproc.inc
   M /trunk/rtl/inc/objpas.inc
   M /trunk/rtl/inc/rtti.inc
   M /trunk/rtl/inc/system.inc
   M /trunk/rtl/objpas/objpas.pp

 * More pluggability of the RTL. Mantis 15124
------------------------------------------------------------------------
------------------------------------------------------------------------
r14215 | ivost | 2009-11-19 12:33:03 +0100 (Thu, 19 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/libxml/src/xmlxsd.pas

* fixed bug in xsdTryParseBoolean (segfault on null string)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14216 | marco | 2009-11-19 12:51:03 +0100 (Thu, 19 Nov 2009) | 2 lines
Changed paths:
   M /trunk/rtl/win/wininc/base.inc
   M /trunk/rtl/win/wininc/defines.inc
   M /trunk/rtl/win/wininc/struct.inc

 * some defines from winioctl updated, mantis 15137

------------------------------------------------------------------------
------------------------------------------------------------------------
r14217 | pierre | 2009-11-19 14:55:44 +0100 (Thu, 19 Nov 2009) | 1 line
Changed paths:
   M /trunk/tests/test/targ1b.pp

 * Do not assume '.' is in path for Unix
------------------------------------------------------------------------
------------------------------------------------------------------------
r14220 | blikblum | 2009-11-20 01:52:26 +0100 (Fri, 20 Nov 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqlite3ds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqliteds.pas

* Implement LastInsertRowId
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14698 -

packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -150,6 +150,7 @@ type
     function SqliteExec(Sql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; virtual; abstract;
     procedure InternalCloseHandle; virtual; abstract;
     function InternalGetHandle: Pointer; virtual; abstract;
+    function GetLastInsertRowId: Int64; virtual; abstract;
     procedure GetSqliteHandle;
     procedure BuildLinkedList; virtual; abstract;
     procedure FreeItem(AItem: PDataRecord);
@@ -238,6 +239,7 @@ type
     property ExpectedUpdates: Integer write SetExpectedUpdates;
     property ExpectedDeletes: Integer write SetExpectedDeletes;
     property IndexFields[Value: Integer]: TField read GetIndexFields;
+    property LastInsertRowId: Int64 read GetLastInsertRowId;
     property RowsAffected: Integer read GetRowsAffected;
     property ReturnCode: Integer read FReturnCode;
     property SqliteHandle: Pointer read FSqliteHandle;

packages/fcl-db/src/sqlite/sqlite3ds.pas

@@ -46,6 +46,7 @@ type
   TSqlite3Dataset = class(TCustomSqliteDataset)
   protected
     procedure BuildLinkedList; override;
+    function GetLastInsertRowId: Int64; override;
     function GetRowsAffected:Integer; override;
     procedure InternalCloseHandle; override;
     function InternalGetHandle: Pointer; override;
@@ -322,6 +323,11 @@ begin
     FBeginItem^.Row[Counter] := nil;
 end;
 
+function TSqlite3Dataset.GetLastInsertRowId: Int64;
+begin
+  Result := sqlite3_last_insert_rowid(FSqliteHandle);
+end;
+
 function TSqlite3Dataset.ReturnString: String;
 begin
   Result := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(FSqliteHandle);

packages/fcl-db/src/sqlite/sqliteds.pas

@@ -48,6 +48,7 @@ type
     function GetSqliteEncoding: String;
   protected
     procedure BuildLinkedList; override;
+    function GetLastInsertRowId: Int64; override;
     function GetRowsAffected:Integer; override;
     function InternalGetHandle: Pointer; override;
     procedure InternalCloseHandle; override;
@@ -275,6 +276,11 @@ begin
     FBeginItem^.Row[Counter] := nil;
 end;
 
+function TSqliteDataset.GetLastInsertRowId: Int64;
+begin
+  Result := sqlite_last_insert_rowid(FSqliteHandle);
+end;
+
 function TSqliteDataset.ReturnString: String;
 begin
   case FReturnCode of

packages/fcl-process/src/unix/process.inc

@@ -371,7 +371,8 @@ Var
   R : Dword;
 
 begin
-  fexitcode:=waitprocess(handle);
+  if FRunning then
+    fexitcode:=waitprocess(handle);
   Result:=(fexitcode>=0);
   FRunning:=False;
 end;

packages/libxml/src/xmlxsd.pas

@@ -882,6 +882,9 @@ var
   P: PChar;
   Num: QWord;
 begin
+  if not Assigned(Chars) then
+    Exit(False);
+
   if Len < 0 then
   begin
     P := PChar(Chars);

packages/zorba/src/zorba.inc

@@ -84,9 +84,9 @@ type
 
 
 // external functions
-  external_function_init = procedure(user_data: PPointer; global_user_data: Pointer); extdecl;
+  external_function_init = procedure(out user_data: Pointer; global_user_data: Pointer); extdecl;
 
-  external_function_next = function(args: XQC_Sequence; argc: cint; result: XQC_Item_Ref;
+  external_function_next = function(args: XQC_Sequence; argc: cint; out result: XQC_Item;
     user_data: Pointer; global_user_data: Pointer): XQUERY_ERROR; extdecl;
 
   external_function_release = procedure(user_data: Pointer; global_user_data: Pointer); extdecl;
@@ -2052,7 +2052,7 @@ type
     (**
      * Can be used for user specific purposes.
      *)
-    user_data: pointer;
+    data: pointer;
   end;
 
 

rtl/go32v2/sysdir.inc

@@ -18,21 +18,18 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure DosDir(func:byte;const s:string);
+procedure DosDir(func:byte;s:pchar;len:integer);
 var
-  buffer : array[0..255] of char;
   regs   : trealregs;
 begin
-  move(s[1],buffer,length(s));
-  buffer[length(s)]:=#0;
-  DoDirSeparators(pchar(@buffer));
+  DoDirSeparators(s);
   { True DOS does not like backslashes at end
     Win95 DOS accepts this !!
     but "\" and "c:\" should still be kept and accepted hopefully PM }
-  if (length(s)>0) and (buffer[length(s)-1]='\') and
-     Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then
-    buffer[length(s)-1]:=#0;
-  syscopytodos(longint(@buffer),length(s)+1);
+  if (len>0) and (s[len-1]='\') and
+     Not ((len=1) or ((len=3) and (s[1]=':'))) then
+    s[len-1]:=#0;
+  syscopytodos(longint(s),len+1);
   regs.realedx:=tb_offset;
   regs.realds:=tb_segment;
   if LFNSupport then
@@ -44,35 +41,32 @@ begin
    GetInOutRes(lo(regs.realeax));
 end;
 
-
-procedure mkdir(const s : string);[IOCheck];
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 begin
-  If (s='') or (InOutRes <> 0) then
+ If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  DosDir($39,s);
+  DosDir($39,s,len);
 end;
 
-
-procedure rmdir(const s : string);[IOCheck];
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
 begin
-  if (s = '.' ) then
+  if (len=1) and (s[0] = '.' ) then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  DosDir($3a,s);
+  DosDir($3a,s,len);
 end;
 
-
-procedure chdir(const s : string);[IOCheck];
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
 var
   regs : trealregs;
 begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
 { First handle Drive changes }
-  if (length(s)>=2) and (s[2]=':') then
+  if (len>=2) and (s[1]=':') then
    begin
-     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
+     regs.realedx:=(ord(s[0]) and (not 32))-ord('A');
      regs.realeax:=$0e00;
      sysrealintr($21,regs);
      regs.realeax:=$1900;
@@ -84,14 +78,13 @@ begin
       end;
      { DosDir($3b,'c:') give Path not found error on
        pure DOS PM }
-     if length(s)=2 then
+     if len=2 then
        exit;
    end;
 { do the normal dos chdir }
-  DosDir($3b,s);
+  DosDir($3b,s,len);
 end;
 
-
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
 var
   temp : array[0..255] of char;

rtl/inc/compproc.inc

@@ -594,7 +594,9 @@ procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TG
 function  fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
 function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
 function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
 procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
+{$endif FPC_HAS_FEATURE_VARIANTS}
 {$endif FPC_HAS_FEATURE_CLASSES}
 
 

rtl/inc/lineinfo.pp

@@ -56,6 +56,7 @@ type
 
 { We use static variable so almost no stack is required, and is thus
   more safe when an error has occured in the program }
+{$WARNING This code is not thread-safe, and needs improvement }  
 var
   e          : TExeFile;
   staberr    : boolean;

rtl/inc/lnfodwrf.pp

@@ -35,7 +35,6 @@ uses
 { Current issues:
 
   - ignores DW_LNS_SET_FILE
-  - slow
 }
 
 {$MACRO ON}
@@ -53,9 +52,15 @@ uses
 type
   Bool8 = ByteBool;
 
+const
+  EBUF_SIZE = 100;
+  
+{$WARNING This code is not thread-safe, and needs improvement}  
 var
   { the input file to read DWARF debug info from, i.e. paramstr(0) }
   e : TExeFile;
+  EBuf: Array [0..EBUF_SIZE-1] of Byte;
+  EBufCnt, EBufPos: Integer;
   DwarfErr : boolean;
   { the offset and size of the DWARF debug_line section in the file }
   DwarfOffset : longint;
@@ -177,6 +182,8 @@ begin
   limit := aLimit;
   Init := (aBase + limit) <= e.size;
   seek(e.f, base);
+  EBufCnt := 0;
+  EBufPos := 0;
   index := 0;
 end;
 
@@ -196,39 +203,69 @@ procedure Seek(const newIndex : Int64);
 begin
   index := newIndex;
   system.seek(e.f, base + index);
+  EBufCnt := 0;
+  EBufPos := 0;
 end;
 
 
 { Returns the next Byte from the input stream, or -1 if there has been
   an error }
-function ReadNext() : Longint;
+function ReadNext() : Longint; inline;
 var
   bytesread : SizeInt;
   b : Byte;
 begin
   ReadNext := -1;
-  if (index < limit) then begin
-    blockread(e.f, b, 1, bytesread);
-    ReadNext := b;
-    inc(index);
+  if EBufPos >= EBufCnt then begin
+    EBufPos := 0;
+    EBufCnt := EBUF_SIZE;
+    if EBufCnt > limit - index then
+      EBufCnt := limit - index;
+    blockread(e.f, EBuf, EBufCnt, bytesread);
+    EBufCnt := bytesread;
   end;
-  if (bytesread <> 1) then
+  if EBufPos < EBufCnt then begin
+    ReadNext := EBuf[EBufPos];
+    inc(EBufPos);
+    inc(index);
+  end
+  else
     ReadNext := -1;
 end;
 
 { Reads the next size bytes into dest. Returns true if successful,
   false otherwise. Note that dest may be partially overwritten after
   returning false. }
-function ReadNext(var dest; size : SizeInt) : Boolean;
+function ReadNext(var dest; size : SizeInt) : Boolean; inline;
 var
-  bytesread : SizeInt;
+  bytesread, totalread : SizeInt;
+  r: Boolean;
+  d: PByte;
 begin
-  bytesread := 0;
-  if ((index + size) < limit) then begin
-    blockread(e.f, dest, size, bytesread);
-    inc(index, size);
+  d := @dest;
+  totalread := 0;
+  r := True;
+  while (totalread < size) and r do begin;
+    if EBufPos >= EBufCnt then begin
+      EBufPos := 0;
+      EBufCnt := EBUF_SIZE;
+      if EBufCnt > limit - index then
+        EBufCnt := limit - index;
+      blockread(e.f, EBuf, EBufCnt, bytesread);
+      EBufCnt := bytesread;
+      if bytesread <= 0 then
+        r := False;
+    end;
+    if EBufPos < EBufCnt then begin
+      bytesread := EBufCnt - EBufPos;
+      if bytesread > size - totalread then bytesread := size - totalread;
+      System.Move(EBuf[EBufPos], d[totalread], bytesread);
+      inc(EBufPos, bytesread);
+      inc(index, bytesread);
+      inc(totalread, bytesread);
+    end;
   end;
-  ReadNext := (bytesread = size);
+  ReadNext := r;
 end;
 
 

rtl/inc/objpas.inc

@@ -13,6 +13,7 @@
 
  **********************************************************************}
 
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     procedure DoDispCallByIDError(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer);
       begin
         handleerrorframe(RuntimeErrorExitCodes[reVarDispatch],get_frame);
@@ -26,6 +27,7 @@
       begin
         TDispProc(DispCallByIDProc)(Result,IDispatch(Dispatch),DispDesc,Params);
       end;
+{$endif FPC_HAS_FEATURE_VARIANTS}
 
 {****************************************************************************
                   Internal Routines called from the Compiler

rtl/inc/rtti.inc

@@ -133,15 +133,28 @@ end;
 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
-    tkAstring,tkWstring,tkUString,tkInterface,tkDynArray:
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
+    tkDynArray,
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+    tkAstring,
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+    tkWstring,tkUString,
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+    tkInterface:
       PPchar(Data)^:=Nil;
     tkArray:
       arrayrtti(data,typeinfo,@int_initialize);
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
     tkObject,
+{$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
       recordrtti(data,typeinfo,@int_initialize);
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
+{$endif FPC_HAS_FEATURE_VARIANTS}
   end;
 end;
 
@@ -149,28 +162,34 @@ end;
 Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring :
       begin
         fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
-{$ifndef VER2_2}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$ifndef VER2_2}
     tkUstring :
       begin
         fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
-{$endif VER2_2}
-{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$endif VER2_2}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     tkWstring :
       begin
         fpc_WideStr_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
-{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
     tkArray :
       arrayrtti(data,typeinfo,@int_finalize);
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
     tkObject,
+{$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
       recordrtti(data,typeinfo,@int_finalize);
     tkInterface:
@@ -178,13 +197,17 @@ begin
         Intf_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       begin
         fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
         PPointer(Data)^:=nil;
       end;
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_clear(PVarData(Data)^);
+{$endif FPC_HAS_FEATURE_VARIANTS}
   end;
 end;
 
@@ -192,27 +215,37 @@ end;
 Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring :
       fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
-{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     tkWstring :
       fpc_WideStr_Incr_Ref(PPointer(Data)^);
-{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
-{$ifndef VER2_2}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$ifndef VER2_2}
     tkUstring :
       fpc_UnicodeStr_Incr_Ref(PPointer(Data)^);
-{$endif VER2_2}
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
     tkArray :
       arrayrtti(data,typeinfo,@int_addref);
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
     tkobject,
+{$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
       recordrtti(data,typeinfo,@int_addref);
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_incr_ref(PPointer(Data)^);
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
     tkInterface:
       Intf_Incr_Ref(PPointer(Data)^);
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_addref(pvardata(Data)^);
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
   end;
 end;
 
@@ -225,27 +258,37 @@ Procedure fpc_DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];
 begin
   case PByte(TypeInfo)^ of
     { see AddRef for comment about below construct (JM) }
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring:
       fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
-{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     tkWstring:
       fpc_WideStr_Decr_Ref(PPointer(Data)^);
-{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
-{$ifndef VER2_2}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$ifndef VER2_2}
     tkUString:
       fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
-{$endif VER2_2}
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
     tkArray:
       arrayrtti(data,typeinfo,@fpc_systemDecRef);
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
     tkobject,
+{$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       recordrtti(data,typeinfo,@fpc_systemDecRef);
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_clear(pvardata(data)^);
+{$endif FPC_HAS_FEATURE_VARIANTS}
   end;
 end;
 
@@ -266,20 +309,24 @@ var
 begin
   result:=sizeof(pointer);
   case PByte(TypeInfo)^ of
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
     tkAstring:
       begin
         fpc_AnsiStr_Incr_Ref(PPointer(Src)^);
         fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
         PPointer(Dest)^:=PPointer(Src)^;
       end;
-{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     tkWstring:
       fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
-{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
-{$ifndef VER2_2}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$ifndef VER2_2}
     tkUstring:
       fpc_UnicodeStr_Assign(PPointer(Dest)^,PPointer(Src)^);
-{$endif VER2_2}
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
     tkArray:
       begin
         Temp:=PByte(TypeInfo);
@@ -303,7 +350,9 @@ begin
           fpc_Copy_internal(Src+(I*size),Dest+(I*size),Info);
         Result:=size*count;
       end;
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
     tkobject,
+{$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       begin
         Temp:=PByte(TypeInfo);
@@ -338,23 +387,27 @@ begin
         if result>expectedoffset then
           move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
       end;
+{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       begin
         fpc_dynarray_Incr_Ref(PPointer(Src)^);
         fpc_dynarray_Decr_Ref(PPointer(Dest)^,typeinfo);
         PPointer(Dest)^:=PPointer(Src)^;
       end;
+{$endif FPC_HAS_FEATURE_DYNARRAYS}
     tkInterface:
       begin
         Intf_Incr_Ref(PPointer(Src)^);
         Intf_Decr_Ref(PPointer(Dest)^);
         PPointer(Dest)^:=PPointer(Src)^;
       end;
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       begin
         VarCopyProc(pvardata(dest)^,pvardata(src)^);
         result:=sizeof(tvardata);
       end;
+{$endif FPC_HAS_FEATURE_VARIANTS}
   end;
 end;
 

rtl/inc/system.inc

@@ -374,7 +374,7 @@ function aligntoptr(p : pointer) : pointer;inline;
 
 {$ifdef FPC_HAS_FEATURE_RTTI}
 {$i rtti.inc}
-{$endif FPC_HAS_FEATURE_VARIANTS}
+{$endif FPC_HAS_FEATURE_RTTI}
 
 {$if defined(FPC_HAS_FEATURE_RANDOM)}
 
@@ -584,21 +584,6 @@ Begin
 End;
 
 
-{*****************************************************************************
-                             Directory support.
-*****************************************************************************}
-
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-Procedure getdir(drivenr:byte;Var dir:ansistring);
-{ this is needed to also allow ansistrings, the shortstring version is
-  OS dependent }
-var
-  s : shortstring;
-begin
-  getdir(drivenr,s);
-  dir:=s;
-end;
-{$endif}
 
 {$ifopt R+}
 {$define RangeCheckWasOn}
@@ -1333,8 +1318,58 @@ end;
                             Directory Handling
 *****************************************************************************}
 
+{$ifdef FPC_HAS_FEATURE_FILEIO}
 { OS dependent dir functions }
 {$i sysdir.inc}
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+{ this is needed to also allow ansistrings, the shortstring version is
+  OS dependent }
+var
+  s : shortstring;
+begin
+  getdir(drivenr,s);
+  dir:=s;
+end;
+{$endif}
+
+{$if defined(FPC_HAS_FEATURE_FILEIO)}
+
+Procedure MkDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  MkDir(@buffer[0],length(s));
+End;
+
+Procedure RmDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  RmDir(@buffer[0],length(s));
+End;
+
+Procedure ChDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  ChDir(@buffer[0],length(s));
+End;
+{$endif}
 
 {*****************************************************************************
                             Resources support

rtl/inc/systemh.inc

@@ -873,16 +873,17 @@ Procedure SetTextLineEnding(var f:Text; Ending:string);
 
 
 {$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure chdir(const s:string);
-Procedure mkdir(const s:string);
-Procedure rmdir(const s:string);
+Procedure chdir(const s:string); overload;
+Procedure mkdir(const s:string); overload;
+Procedure rmdir(const s:string); overload;
+// the pchar versions are exported via alias for use in objpas
+
 Procedure getdir(drivenr:byte;var dir:shortstring);
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure getdir(drivenr:byte;var dir:ansistring);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$endif FPC_HAS_FEATURE_FILEIO}
 
-
 {*****************************************************************************
                              Miscellaneous
 *****************************************************************************}

rtl/objpas/objpas.pp

@@ -48,27 +48,41 @@ Var
                              Compatibility routines.
 ****************************************************************************}
 
+{$ifdef FPC_HAS_FEATURE_FILEIO}
     { Untyped file support }
 
      Procedure AssignFile(out f:File;const Name:string);
      Procedure AssignFile(out f:File;p:pchar);
      Procedure AssignFile(out f:File;c:char);
      Procedure CloseFile(var f:File);
+{$endif FPC_HAS_FEATURE_FILEIO}
 
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
      { Text file support }
      Procedure AssignFile(out t:Text;const s:string);
      Procedure AssignFile(out t:Text;p:pchar);
      Procedure AssignFile(out t:Text;c:char);
      Procedure CloseFile(Var t:Text);
+{$endif FPC_HAS_FEATURE_TEXTIO}
 
+{$ifdef FPC_HAS_FEATURE_FILEIO}
      { Typed file supoort }
 
      Procedure AssignFile(out f:TypedFile;const Name:string);
      Procedure AssignFile(out f:TypedFile;p:pchar);
      Procedure AssignFile(out f:TypedFile;c:char);
+{$endif FPC_HAS_FEATURE_FILEIO}
 
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
      { ParamStr should return also an ansistring }
      Function ParamStr(Param : Integer) : Ansistring;
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+     Procedure MkDir(const s:ansistring);overload;
+     Procedure RmDir(const s:ansistring);overload;
+     Procedure ChDir(const s:ansistring);overload;
+{$endif FPC_HAS_FEATURE_FILEIO}
 
 {****************************************************************************
                              Resource strings.
@@ -104,6 +118,11 @@ Var
                              Compatibility routines.
 ****************************************************************************}
 
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+Procedure MkDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_MKDIR';
+Procedure ChDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_CHDIR';
+Procedure RmDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_RMDIR';
+
 { Untyped file support }
 
 Procedure AssignFile(out f:File;const Name:string);
@@ -130,7 +149,9 @@ begin
   { Catch Runtime error/Exception }
   System.Close(f);
 end;
+{$endif FPC_HAS_FEATURE_FILEIO}
 
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
 { Text file support }
 
 Procedure AssignFile(out t:Text;const s:string);
@@ -157,7 +178,9 @@ begin
   { Catch Runtime error/Exception }
   System.Close(T);
 end;
+{$endif FPC_HAS_FEATURE_TEXTIO}
 
+{$ifdef FPC_HAS_FEATURE_FILEIO}
 { Typed file support }
 
 Procedure AssignFile(out f:TypedFile;const Name:string);
@@ -177,7 +200,9 @@ Procedure AssignFile(out f:TypedFile;c:char);
 begin
   system.Assign (F,C);
 end;
+{$endif FPC_HAS_FEATURE_FILEIO}
 
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
 Function ParamStr(Param : Integer) : Ansistring;
 
 Var Len : longint;
@@ -205,8 +230,25 @@ begin
   else
     paramstr:='';
 end;
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+Procedure MkDir(const s:ansistring);
+begin
+  mkdirpchar(pchar(s),length(s));
+end;
 
+Procedure RmDir(const s:ansistring);
+begin
+  RmDirpchar(pchar(s),length(s));
+end;
 
+Procedure ChDir(const s:ansistring);
+begin
+  ChDirpchar(pchar(s),length(s));
+end;
+{$endif FPC_HAS_FEATURE_FILEIO}
 
 { ---------------------------------------------------------------------
     ResourceString support

rtl/os2/sysdir.inc

@@ -19,64 +19,57 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure MkDir (const S: string);[IOCHECK];
-var buffer:array[0..255] of char;
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+var 
     Rc : word;
 begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-      move(s[1],buffer,length(s));
-      buffer[length(s)]:=#0;
-      DoDirSeparators(Pchar(@buffer));
-      Rc := DosCreateDir(buffer,nil);
-      if Rc <> 0 then
-       begin
-         InOutRes := Rc;
-         Errno2Inoutres;
-       end;
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+    exit;
+  DoDirSeparators(s);
+  Rc := DosCreateDir(s,nil);
+  if Rc <> 0 then
+    begin
+      InOutRes := Rc;
+      Errno2Inoutres;
+    end;
 end;
 
-
-procedure rmdir(const s : string);[IOCHECK];
-var buffer:array[0..255] of char;
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+var 
     Rc : word;
 begin
-  if (s = '.' ) then
+  if (len=1) and (s^ = '.' ) then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-      move(s[1],buffer,length(s));
-      buffer[length(s)]:=#0;
-      DoDirSeparators(Pchar(@buffer));
-      Rc := DosDeleteDir(buffer);
-      if Rc <> 0 then
-       begin
-         InOutRes := Rc;
-         Errno2Inoutres;
-       end;
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+    exit;
+  DoDirSeparators(s);
+  Rc := DosDeleteDir(s);
+  if Rc <> 0 then
+    begin
+      InOutRes := Rc;
+      Errno2Inoutres;
+    end;
 end;
 
 {$ASMMODE INTEL}
 
-procedure ChDir (const S: string);[IOCheck];
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
 
 var RC: cardinal;
-    Buffer: array [0..255] of char;
 
 begin
-  If (s='') or (InOutRes <> 0) then exit;
-  if (Length (S) >= 2) and (S [2] = ':') then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+    exit;
+  if (Len >= 2) and (S[1] = ':') then
   begin
-    RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
+    RC := DosSetDefaultDisk ((Ord (S [0]) and not ($20)) - $40);
     if RC <> 0 then
       InOutRes := RC
     else
-      if Length (S) > 2 then
+      if Len > 2 then
       begin
-        Move (S [1], Buffer, Length (S));
-        Buffer [Length (S)] := #0;
-        DoDirSeparators (PChar (@Buffer));
-        RC := DosSetCurrentDir (@Buffer);
+        DoDirSeparators (s);
+        RC := DosSetCurrentDir (s);
         if RC <> 0 then
         begin
           InOutRes := RC;
@@ -84,10 +77,8 @@ begin
         end;
       end;
   end else begin
-    Move (S [1], Buffer, Length (S));
-    Buffer [Length (S)] := #0;
-    DoDirSeparators (PChar (@Buffer));
-    RC := DosSetCurrentDir (@Buffer);
+    DoDirSeparators (s);
+    RC := DosSetCurrentDir (s);
     if RC <> 0 then
     begin
       InOutRes:= RC;

rtl/unix/sysdir.inc

@@ -18,53 +18,44 @@
                            Directory Handling
 *****************************************************************************}
 
-Procedure MkDir(Const s: String);[IOCheck];
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 const
   { read/write search permission for everyone }
   MODE_MKDIR = S_IWUSR OR S_IRUSR OR
                S_IWGRP OR S_IRGRP OR
                S_IWOTH OR S_IROTH OR
                S_IXUSR OR S_IXGRP OR S_IXOTH;
-Var
-  Buffer: Array[0..255] of Char;
+
+// len is not passed to the *nix functions because the unix API doesn't 
+// use length safeguards for these functions. (probably because there
+// already is a length limit due to PATH_MAX)
+
 Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpmkdir(@buffer[0], MODE_MKDIR)<0 Then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+    exit;
+  If Fpmkdir(s, MODE_MKDIR)<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;
 End;
 
-
-Procedure RmDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
 Begin
-  if (s = '.') then
+  if (len=1) and (s^ = '.') then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fprmdir(@buffer[0])<0 Then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+    exit;
+  If Fprmdir(s)<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;
 End;
 
-
-Procedure ChDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
 Begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpchdir(@buffer[0])<0 Then
+  If Fpchdir(s)<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;

rtl/win/sysdir.inc

@@ -17,18 +17,13 @@
 {*****************************************************************************
                            Directory Handling
 *****************************************************************************}
-
 type
  TDirFnType=function(name:pointer):longbool;stdcall;
 
-procedure dirfn(afunc : TDirFnType;const s:string);
-var
-  buffer : array[0..255] of char;
+procedure dirfn(afunc : TDirFnType;s:pchar;len:integer);
 begin
-  move(s[1],buffer,length(s));
-  buffer[length(s)]:=#0;
-  DoDirSeparators(pchar(@buffer));
-  if not aFunc(@buffer) then
+  DoDirSeparators(s);
+  if not aFunc(s) then
     begin
       errno:=GetLastError;
       Errno2InoutRes;
@@ -40,36 +35,38 @@ begin
   CreateDirectoryTrunc:=CreateDirectory(name,nil);
 end;
 
-procedure mkdir(const s:string);[IOCHECK];
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s,len);
 end;
 
-procedure rmdir(const s:string);[IOCHECK];
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+
 begin
-  if (s ='.') then
+  if (len=1) and (s^ ='.') then
     InOutRes := 16;
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+   exit;
 {$ifdef WINCE}
-  if (s ='..') then
+  if (len=2) and (s[0]='.') and (s[1]='.') then
     InOutRes := 5;
 {$endif WINCE}
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@RemoveDirectory),s);
+  dirfn(TDirFnType(@RemoveDirectory),s,len);
 {$ifdef WINCE}
   if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
     Inoutres:=2;
 {$endif WINCE}
 end;
 
-procedure chdir(const s:string);[IOCHECK];
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+
 begin
 {$ifndef WINCE}
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  dirfn(TDirFnType(@SetCurrentDirectory),s);
+  dirfn(TDirFnType(@SetCurrentDirectory),s,len);
   if Inoutres=2 then
    Inoutres:=3;
 {$else WINCE}

rtl/win/syswin.inc

@@ -28,8 +28,6 @@ Var
 
 
 function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry'];
-  var
-    res : longbool;
   begin
 {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
      EntryInformation:=info;
@@ -43,12 +41,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            MainThreadIdWin32 := Win32GetCurrentThreadId;
            If SetJmp(DLLBuf) = 0 then
              begin
-               if assigned(Dll_Process_Attach_Hook) then
-                 begin
-                   res:=Dll_Process_Attach_Hook(DllParam);
-                   if not res then
-                     exit(false);
-                 end;
 {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
                EntryInformation.PascalMain();
 {$else FPC_HAS_INDIRECT_MAIN_INFORMATION}

rtl/win/wininc/base.inc

@@ -355,6 +355,9 @@
     FINDEX_SEARCH_OPS   = _FINDEX_SEARCH_OPS;
     PFINDEX_SEARCH_OPS  = ^TFINDEX_SEARCH_OPS;
 
+    PARTITION_STYLE     = (PARTITION_STYLE_MBR:=0,PARTITION_STYLE_GPT,PARTITION_STYLE_RAW);
+    TPARTITION_STYLE    = PARTITION_STYLE;
+    PPARTITION_STYLE    = ^TPARTITION_STYLE;
 
  {
    Macros

rtl/win/wininc/defines.inc

@@ -5647,6 +5647,18 @@ const
   FIND_FIRST_EX_CASE_SENSITIVE   = $00000001;
   FIND_FIRST_EX_LARGE_FETCH      = $00000002;
 
+  GPT_ATTRIBUTE_PLATFORM_REQUIRED  = $0000000000000001;
+
+//
+// The following are GPT partition attributes applicable when the
+// PartitionType is PARTITION_BASIC_DATA_GUID.
+//
+
+  GPT_BASIC_DATA_ATTRIBUTE_NO_DRIVE_LETTER    =qword($8000000000000000);
+  GPT_BASIC_DATA_ATTRIBUTE_HIDDEN             =qword($4000000000000000);
+  GPT_BASIC_DATA_ATTRIBUTE_SHADOW_COPY        =qword($2000000000000000);
+  GPT_BASIC_DATA_ATTRIBUTE_READ_ONLY          =qword($1000000000000000);
+
 {$endif read_interface}
 
 {$ifdef read_implementation}

rtl/win/wininc/struct.inc

@@ -2250,17 +2250,100 @@ Const
      PDRAWTEXTPARAMS = ^DRAWTEXTPARAMS;
 
      PARTITION_INFORMATION = record
-          PartitionType : BYTE;
-          BootIndicator : BOOLEAN;
-          RecognizedPartition : BOOLEAN;
-          RewritePartition : BOOLEAN;
           StartingOffset : LARGE_INTEGER;
-          PartitionLength : LARGE_INTEGER;
-          HiddenSectors : LARGE_INTEGER;
+          PartitionLength: LARGE_INTEGER;
+          HiddenSectors  : DWORD;
+	  PartitionNumber: DWORD;
+          PartitionType  : BYTE;
+	  BootIndicator       : BYTEBOOL;
+          RecognizedPartition : BYTEBOOL;
+          RewritePartition    : BYTEBOOL;
        end;
      _PARTITION_INFORMATION = PARTITION_INFORMATION;
      TPARTITIONINFORMATION = PARTITION_INFORMATION;
      PPARTITIONINFORMATION = ^PARTITION_INFORMATION;
+     
+     PARTITION_INFORMATION_GPT = record
+		                   PartitionType  : TGUID;
+				   PartitionID    : TGUID;
+				   Attributes     : DWORD64;
+				   Name		  : array[0..35] OF WCHAR;
+				  end; 	
+     TPARTITION_INFORMATION_GPT= PARTITION_INFORMATION_GPT;
+     PPARTITION_INFORMATION_GPT= ^PARTITION_INFORMATION_GPT;
+
+     PARTITION_INFORMATION_MBR = record
+		                   PartitionType  : Byte;
+				   BootIndicator  : ByteBool;
+				   RecognizedPartition : ByteBool;
+				   HiddenSectors  : DWORD;
+				  end; 	
+     TPARTITION_INFORMATION_MBR=  PARTITION_INFORMATION_MBR;
+     PPARTITION_INFORMATION_MBR= ^PARTITION_INFORMATION_MBR;
+
+     SET_PARTITION_INFORMATION = record
+          PartitionType : BYTE;
+       end;
+     _SET_PARTITION_INFORMATION = SET_PARTITION_INFORMATION;
+     TSETPARTITIONINFORMATION = SET_PARTITION_INFORMATION;
+     PSETPARTITIONINFORMATION = ^SET_PARTITION_INFORMATION;
+
+     SET_PARTITION_INFORMATION_MBR  = PARTITION_INFORMATION;
+     TSET_PARTITION_INFORMATION_MBR = PARTITION_INFORMATION;
+
+     SET_PARTITION_INFORMATION_GPT  = PARTITION_INFORMATION_GPT;
+     TSET_PARTITION_INFORMATION_GPT = PARTITION_INFORMATION_GPT;
+
+     SET_PARTITION_INFORMATION_EX   = record
+                                      PartitionStyle : TPartition_Style;
+				      case integer of 
+					0 : (mbr : SET_PARTITION_INFORMATION_MBR);
+					1 : (GPT : SET_PARTITION_INFORMATION_GPT);
+				      end;
+     TSET_PARTITION_INFORMATION_EX  = SET_PARTITION_INFORMATION_EX;  
+     PSET_PARTITION_INFORMATION_EX  = ^SET_PARTITION_INFORMATION_EX;  
+
+     CREATE_DISK_GPT = record
+			 DiskID 	   : TGUID;
+			 MaxPartitionCount : DWord;
+		        end;
+     TCREATE_DISK_GPT = CREATE_DISK_GPT;
+     PCREATE_DISK_GPT = ^TCREATE_DISK_GPT;
+
+     CREATE_DISK_MBR = record
+			 Signature 	   : DWord;
+		        end;
+     TCREATE_DISK_MBR = CREATE_DISK_MBR;
+     PCREATE_DISK_MBR = ^TCREATE_DISK_MBR;
+
+     CREATE_DISK  = record
+		       PartitionStyle : TPartition_Style;
+		       case integer of 
+			 0: ( MBR : Create_Disk_MBR);
+		         1: ( GPT : Create_Disk_GPT);	 
+		      end;
+     TCREATE_DISK = CREATE_DISK;
+     PCREATE_DISK = ^TCREATE_DISK;
+    
+     GET_LENGTH_INFORMATION = record
+	                        Length : LARGE_INTEGER;
+			      end;
+     TGET_LENGTH_INFORMATION = GET_LENGTH_INFORMATION; 
+     PGET_LENGTH_INFORMATION = ^GET_LENGTH_INFORMATION;
+
+     PARTITION_INFORMATION_EX = record
+	  PartitionStyle  : TPartition_Style;
+          StartingOffset  : LARGE_INTEGER;
+          PartitionLength : LARGE_INTEGER;
+	  PartitionNumber : DWORD;
+          RewritePartition: BYTEBOOL;
+	  case integer of 
+	    0: ( MBR : PARTITION_INFORMATION_MBR);
+	    1: ( GPT : PARTITION_INFORMATION_GPT);	 
+       end;
+     _PARTITION_INFORMATION_EX = PARTITION_INFORMATION_EX;
+     TPARTITIONINFORMATION_EX  = PARTITION_INFORMATION_EX;
+     PPARTITIONINFORMATION_EX  = ^PARTITION_INFORMATION_EX;
 
      DRIVE_LAYOUT_INFORMATION = record
           PartitionCount : DWORD;
@@ -5822,12 +5905,6 @@ Const
      TSESSIONHEADER = SESSION_HEADER;
      PSESSIONHEADER = ^SESSION_HEADER;
 
-     SET_PARTITION_INFORMATION = record
-          PartitionType : BYTE;
-       end;
-     _SET_PARTITION_INFORMATION = SET_PARTITION_INFORMATION;
-     TSETPARTITIONINFORMATION = SET_PARTITION_INFORMATION;
-     PSETPARTITIONINFORMATION = ^SET_PARTITION_INFORMATION;
 
      SHCONTF = (SHCONTF_FOLDERS := 32,SHCONTF_NONFOLDERS := 64,
        SHCONTF_INCLUDEHIDDEN := 128);

rtl/win32/system.pp

@@ -105,11 +105,9 @@ var
   StartupConsoleMode : DWORD;
 
 type
-  TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
   TDLL_Entry_Hook = procedure (dllparam : longint);
 
 const
-  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;

rtl/win64/system.pp

@@ -99,11 +99,9 @@ var
   cmdshow     : longint;
   DLLreason,DLLparam:longint;
 type
-  TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
   TDLL_Entry_Hook = procedure (dllparam : longint);
 
 const
-  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;

rtl/wince/system.pp

@@ -67,11 +67,9 @@ var
   DLLreason,DLLparam:DWord;
 
 type
-  TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
   TDLL_Entry_Hook = procedure (dllparam : longint);
 
 const
-  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
@@ -855,21 +853,12 @@ Const
      DLL_THREAD_DETACH = 3;
 
 function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
-var
-  res : longbool;
-
 begin
    IsLibrary:=true;
    Dll_entry:=false;
    case DLLreason of
      DLL_PROCESS_ATTACH :
        begin
-         if assigned(Dll_Process_Attach_Hook) then
-           begin
-             res:=Dll_Process_Attach_Hook(DllParam);
-             if not res then
-               exit(false);
-           end;
          PASCALMAIN;
          Dll_entry:=true;
        end;

tests/test/targ1b.pp

@@ -39,6 +39,13 @@ uses
   dos;
 
 const
+  Prefix =
+{$ifdef Unix}
+  './'
+{$else}
+  ''
+{$endif}
+  ;
   ExeSuffix =
 {$ifdef HasExeSuffix}
   '.exe'
@@ -60,7 +67,7 @@ var
 const
   Everything_ok : boolean = true;
 begin
-  cmd:='targ1a'+ExeSuffix;
+  cmd:=Prefix+'targ1a'+ExeSuffix;
   arg:='';
   first_wrong:=-1;
   for i:=0 to MAX do
@@ -70,7 +77,8 @@ begin
       Exec(cmd,arg);
       if (DosExitCode<>0) or (DosError<>0) then
         begin
-          Writeln(stderr,'Crash detected');
+          Writeln(stderr,'Crash detected, DosError=', DosError);
+          Writeln(stderr,'DosExitCode=',DosExitCode);
           if first_wrong=-1 then
             first_wrong:=i;
           Everything_ok := false;

tests/test/units/math/tnaninf.pp

@@ -1,5 +1,5 @@
 uses
-  math;
+  Math;
 
 begin
   if not(isnan(nan)) then