Merged revisions 1304-1306,1341,1355 via svnmerge from

http://peter@svn.freepascal.org/svn/fpc/trunk

r1304 (tom_at_work)
* bugfix of webbug 4404

r1305 (peter)
  * fixed DUMPGROW compile


r1306 (peter)
  * add winwidestringalloc boolean, set it to false to use the fpc
    heapmanager to allocate widestrings


r1341 (marco)
 * nanosleep for sleep(), since it is now in the POSIX group.


r1355 (peter)
  * remove comment level 2 warning

git-svn-id: branches/fixes_2_0@1440 -

rtl/inc/heap.inc

@@ -472,31 +472,33 @@ end;
 procedure DumpBlocks;
 var
   s,i,j : ptrint;
-  hp  : pfreerecord;
+  hpfixed  : pmemchunk_fixed;
+  hpvar  : pmemchunk_var;
 begin
-  for i := 1 to maxblock do
+  { fixed freelist }
+  for i := 1 to maxblockindex do
    begin
-     hp := freelists[i];
+     hpfixed := freelists_fixed[i];
      j := 0;
-     while assigned(hp) do
+     while assigned(hpfixed) do
       begin
         inc(j);
-        hp := hp^.next;
+        hpfixed := hpfixed^.next_fixed;
       end;
      writeln('Block ',i*blocksize,': ',j);
    end;
-{ freelist 0 }
-  hp := freelists[0];
+  { var freelist }
+  hpvar := freelist_var;
   j := 0;
   s := 0;
-  while assigned(hp) do
+  while assigned(hpvar) do
    begin
      inc(j);
-     if hp^.size>s then
-      s := hp^.size;
-     hp := hp^.next;
+     if hpvar^.size>s then
+      s := hpvar^.size;
+     hpvar := hpvar^.next_var;
    end;
-  writeln('Main: ',j,' maxsize: ',s);
+  writeln('Variable: ',j,' maxsize: ',s);
 end;
 {$endif}
 

rtl/inc/varianth.inc

@@ -420,7 +420,7 @@ operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inl
 {**********************************************************************
                              OLEVariant Operators
  **********************************************************************}
-{
+(*
 operator or(const op1,op2 : olevariant) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator and(const op1,op2 : olevariant) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator xor(const op1,op2 : olevariant) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -440,4 +440,4 @@ operator <(const op1,op2 : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inlin
 operator >(const op1,op2 : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator >=(const op1,op2 : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator <=(const op1,op2 : olevariant) dest : boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
-}
+*)

rtl/inc/wstringh.inc

@@ -85,6 +85,11 @@ function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inli
 function WideStringToUCS4String(const s : WideString) : UCS4String;
 function UCS4StringToWideString(const s : UCS4String) : WideString;
 
+{$ifdef MSWINDOWS}
+const
+  winwidestringalloc : boolean = true;
+{$endif MSWINDOWS}
+
 var
   widestringmanager : TWideStringManager;
 

rtl/inc/wstrings.inc

@@ -151,10 +151,11 @@ Var
   P : Pointer;
 begin
 {$ifdef MSWINDOWS}
-  P:=SysAllocStringLen(nil,Len*sizeof(WideChar)+WideRecLen);
-{$else MSWINDOWS}
-  GetMem(P,Len*sizeof(WideChar)+WideRecLen);
+  if winwidestringalloc then
+    P:=SysAllocStringLen(nil,Len*sizeof(WideChar)+WideRecLen)
+  else
 {$endif MSWINDOWS}
+    GetMem(P,Len*sizeof(WideChar)+WideRecLen);
   If P<>Nil then
     begin
      PWideRec(P)^.Len:=0;         { Initial length }
@@ -177,10 +178,11 @@ begin
     exit;
   Dec (S,WideFirstOff);
 {$ifdef MSWINDOWS}
-  SysFreeString(S);
-{$else MSWINDOWS}
-  FreeMem (S);
+  if winwidestringalloc then
+    SysFreeString(S)
+  else
 {$endif MSWINDOWS}
+    FreeMem (S);
   S:=Nil;
 end;
 
@@ -627,15 +629,17 @@ begin
       { windows doesn't support reallocing widestrings, this code
         is anyways subject to be removed because widestrings shouldn't be
         ref. counted anymore (FK) }
-{$ifndef MSWINDOWS}
-      else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
+      else if
+{$ifdef MSWINDOWS}
+              not winwidestringalloc and
+{$endif MSWINDOWS}
+              (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
         begin
           Dec(Pointer(S),WideFirstOff);
           if L*sizeof(WideChar)+WideRecLen>MemSize(Pointer(S)) then
               reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
           Inc(Pointer(S), WideFirstOff);
         end
-{$endif MSWINDOWS}
       else
         begin
           { Reallocation is needed... }

rtl/objpas/typinfo.pp

@@ -44,7 +44,8 @@ unit typinfo;
        TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
        TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
                       mkClassProcedure, mkClassFunction);
-       TParamFlags    = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
+       TParamFlag     = (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
+       TParamFlags    = set of TParamFlag;
        TIntfFlag      = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);
        TIntfFlags     = set of TIntfFlag;
        TIntfFlagsBase = set of TIntfFlag;

rtl/unix/sysutils.pp

@@ -259,7 +259,7 @@ begin
   fpclose(Handle);
 end;
 
-Function FileTruncate (Handle,Size: Longint) : boolean;
+Function FileTruncate (Handle,Size: TFileOffset) : boolean;
 
 begin
   FileTruncate:=fpftruncate(Handle,Size)>=0;
@@ -1057,22 +1057,12 @@ End;
 procedure Sleep(milliseconds: Cardinal);
 
 Var
-  fd : Integer;
-  fds : TfdSet;
-  timeout : TimeVal;
+  timeout,timeoutresult : TTimespec;
 
 begin
-  fd:=FileOpen('/dev/null',fmOpenRead);
-  If Not(Fd<0) then
-    try
-      fpfd_zero(fds);
-      fpfd_set(0,fds);
-      timeout.tv_sec:=Milliseconds div 1000;
-      timeout.tv_usec:=(Milliseconds mod 1000) * 1000;
-      fpSelect(1,Nil,Nil,@fds,@timeout);
-    finally
-      FileClose(fd);
-    end;
+  timeout.tv_sec:=milliseconds div 1000;
+  timeout.tv_nsec:=1000*1000*(milliseconds mod 1000);
+  fpnanosleep(@timeout,@timeoutresult);
 end;
 
 Function GetLastOSError : Integer;