paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed some bugs in setlength

Browse Source
This commit is contained in:
florian 2000-12-01 23:30:00 +00:00
parent 8dc8438e60
commit caee5e33c8
1 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/inc/dynarr.inc
View File

@ -65,7 +65,7 @@ procedure dynarray_clear(var p : pdynarray;ti : pdynarraytypeinfo);
finalizearray(p,ti^.eletype,p^.high+1,ti^.elesize); finalizearray(p,ti^.eletype,p^.high+1,ti^.elesize);
{ release the data } { release the data }
freemem(p,sizeof(tdynarray)+p^.high+1*ti^.elesize); freemem(p,sizeof(tdynarray)+(p^.high+1)*ti^.elesize);
p:=nil; p:=nil;
end; end;
@ -136,11 +136,11 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo;
begin begin
{ make an unique copy } { make an unique copy }
getmem(newp,size); getmem(newp,size);
move(p^,(newp+sizeof(tdynarray))^,ti^.elesize*dims[0]); move(p^,(pointer(newp)+sizeof(tdynarray))^,ti^.elesize*dims[0]);
{ increment ref. count of members } { increment ref. count of members }
for i:=0 to dims[0]-1 do for i:=0 to dims[0]-1 do
addref(newp+sizeof(tdynarray)+ti^.elesize*i,ti^.eletype); addref(pointer(newp)+sizeof(tdynarray)+ti^.elesize*i,ti^.eletype);
{ a declock(ref. count) isn't enough here } { a declock(ref. count) isn't enough here }
{ it could be that the in MT enviroments } { it could be that the in MT enviroments }
@ -164,14 +164,14 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo;
{ shrink the array? } { shrink the array? }
if dims[0]<realp^.high+1 then if dims[0]<realp^.high+1 then
begin begin
finalizearray(realp+sizeof(realp)+ti^.elesize*dims[0], finalizearray(pointer(realp)+sizeof(tdynarray)+ti^.elesize*dims[0],
ti^.eletype,realp^.high-dims[0]+1,ti^.elesize); ti^.eletype,realp^.high-dims[0]+1,ti^.elesize);
reallocmem(realp,size); reallocmem(realp,size);
end end
else if dims[0]>realp^.high+1 then else if dims[0]>realp^.high+1 then
begin begin
reallocmem(realp,size); reallocmem(realp,size);
fillchar((realp+sizeof(realp)+ti^.elesize*(realp^.high+1))^, fillchar((pointer(realp)+sizeof(tdynarray)+ti^.elesize*(realp^.high+1))^,
(dims[0]-realp^.high-1)*ti^.elesize,0); (dims[0]-realp^.high-1)*ti^.elesize,0);
end; end;
end; end;
@ -183,11 +183,11 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo;
if dimcount>1 then if dimcount>1 then
begin begin
for i:=0 to dims[0]-1 do for i:=0 to dims[0]-1 do
dynarray_setlength(pointer(plongint(newp+sizeof(tdynarray))[i*ti^.elesize]), dynarray_setlength(pointer(plongint(pointer(newp)+sizeof(tdynarray))[i*ti^.elesize]),
ti^.eletype,dimcount-1,@dims[1]); ti^.eletype,dimcount-1,@dims[1]);
end; end;
end; end;
p:=newp+sizeof(tdynarray); p:=pointer(newp)+sizeof(tdynarray);
newp^.refcount:=1; newp^.refcount:=1;
newp^.high:=dims[0]-1; newp^.high:=dims[0]-1;
end; end;
@ -202,7 +202,10 @@ function dynarray_copy(var p : pointer;ti : pdynarraytypeinfo;
{ {
$Log$ $Log$
Revision 1.4 2000-11-12 23:23:34 florian Revision 1.5 2000-12-01 23:30:00 florian
* fixed some bugs in setlength
Revision 1.4 2000/11/12 23:23:34 florian
* interfaces basically running * interfaces basically running
Revision 1.3 2000/11/07 23:42:21 florian Revision 1.3 2000/11/07 23:42:21 florian