diff --git a/rtl/inc/heap.inc b/rtl/inc/heap.inc index 70f3236378..e12dd40f38 100644 --- a/rtl/inc/heap.inc +++ b/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} diff --git a/rtl/inc/varianth.inc b/rtl/inc/varianth.inc index 61d2da743e..7a3ac4bef9 100644 --- a/rtl/inc/varianth.inc +++ b/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} -} +*) diff --git a/rtl/inc/wstringh.inc b/rtl/inc/wstringh.inc index 35a99a1ae5..d2193e5c2c 100644 --- a/rtl/inc/wstringh.inc +++ b/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; diff --git a/rtl/inc/wstrings.inc b/rtl/inc/wstrings.inc index 5a30e71da0..ebd252c3bb 100644 --- a/rtl/inc/wstrings.inc +++ b/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... } diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index 080814137f..e98c1a5c8c 100644 --- a/rtl/objpas/typinfo.pp +++ b/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; diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp index 4d68fe9f77..92372e9fcf 100644 --- a/rtl/unix/sysutils.pp +++ b/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;