paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 19:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix crash under win32 with previous reallocmem fix

Browse Source
This commit is contained in:
peter 2005-03-21 16:31:33 +00:00
parent 239beee554
commit ccf36c0afd
2 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
rtl/inc/heap.inc
View File

@ -734,6 +734,9 @@ var
mc_tmp : pmemchunk_var;
size_right : ptrint;
begin
// mc_right can't be a fixed size block
if mc_right^.size and fixedsizeflag<>0 then
HandleError(204);
// left block free, concat with right-block
size_right := mc_right^.size and sizemask;
inc(mc_left^.size, size_right);
@ -1106,6 +1109,7 @@ begin
{$endif TestFreeLists}
end;
function SysFreeMem(p: pointer): ptrint;
var
pcurrsize: ptrint;
@ -1214,9 +1218,9 @@ begin
currsize := pcurrsize and fixedsizemask;
size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
end;
oldsize := currsize;
{ is the allocated block still correct? }
if (currsize>=size) and (size>(currsize-16)) then
if (currsize>=size) and (size>(currsize-blocksize)) then
begin
SysTryResizeMem := true;
{$ifdef TestFreeLists}
@ -1235,6 +1239,7 @@ begin
{ get pointer to block }
pcurr := pmemchunk_var(pointer(p)-sizeof(tmemchunk_var_hdr));
oldsize := currsize;
{ do we need to allocate more memory ? }
if size>currsize then
@ -1349,7 +1354,10 @@ end;
{
$Log$
Revision 1.48 2005-03-20 18:57:29 peter
Revision 1.49 2005-03-21 16:31:33 peter
* fix crash under win32 with previous reallocmem fix
Revision 1.48 2005/03/20 18:57:29 peter
* fixed tryresizemem
Revision 1.47 2005/03/04 16:49:34 peter

19
rtl/win32/system.pp
View File

@ -143,11 +143,15 @@ var
argvlen : longint;
procedure allocarg(idx,len:longint);
var
oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
end;
{ use realloc to reuse already existing memory }
{ always allocate, even if length is zero, since }
@ -715,7 +719,7 @@ var
{$ifdef SYSTEMEXCEPTIONDEBUG}
procedure DebugHandleErrorAddrFrame(error, addr, frame : longint);
begin
if IsConsole then
if IsConsole then
begin
write(stderr,'HandleErrorAddrFrame(error=',error);
write(stderr,',addr=',hexstr(addr,8));
@ -918,13 +922,13 @@ end;
function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharUpperBuffW';
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharLowerBuffW';
function Win32WideUpper(const s : WideString) : WideString;
begin
result:=s;
UniqueString(result);
if length(result)>0 then
if length(result)>0 then
CharUpperBuff(LPWSTR(result),length(result));
end;
@ -936,7 +940,7 @@ function Win32WideLower(const s : WideString) : WideString;
if length(result)>0 then
CharLowerBuff(LPWSTR(result),length(result));
end;
{ there is a similiar procedure in sysutils which inits the fields which
are only relevant for the sysutils units }
@ -945,7 +949,7 @@ procedure InitWin32Widestrings;
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
widestringmanager.LowerWideStringProc:=@Win32WideLower;
end;
{$endif HASWIDESTRING}
@ -1106,7 +1110,10 @@ end.
{
$Log$
Revision 1.71 2005-03-02 19:18:42 florian
Revision 1.72 2005-03-21 16:31:33 peter
* fix crash under win32 with previous reallocmem fix
Revision 1.71 2005/03/02 19:18:42 florian
* fixed compilation with 1.0.10
Revision 1.70 2005/02/26 20:43:52 florian