procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
dimcount : sizeint;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; compilerproc;
var
i : tdynarrayindex;
movelen,
size : sizeint;
{ contains the "fixed" pointers where the refcount }
{ and high are at positive offsets }
realp,newp : pdynarray;
ti : pointer;
updatep: boolean;
elesize : sizeint;
eletype : pointer;
begin
{ negative length is not allowed }
if dims[0]<0 then
HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
{ skip kind and name }
ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
elesize:=pdynarraytypedata(ti)^.elSize;
eletype:=pdynarraytypedata(ti)^.elType2;
{ determine new memory size }
size:=elesize*dims[0]+sizeof(tdynarray);
updatep := false;
{ not assigned yet? }
if not(assigned(p)) then
begin
{ do we have to allocate memory? }
if dims[0] = 0 then
exit;
getmem(newp,size);
fillchar(newp^,size,0);
updatep := true;
end
else
begin
{ if the new dimension is 0, we've to release all data }
if dims[0]=0 then
begin
fpc_dynarray_clear(p,pti);
exit;
end;
realp:=pdynarray(p-sizeof(tdynarray));
newp := realp;
if realp^.refcount<>1 then
begin
updatep := true;
{ make an unique copy }
getmem(newp,size);
fillchar(newp^,size,0);
if realp^.high < dims[0] then
movelen := realp^.high+1
else
movelen := dims[0];
move(p^,(pointer(newp)+sizeof(tdynarray))^,elesize*movelen);
{ increment ref. count of members }
for i:= 0 to movelen-1 do
int_addref(pointer(newp)+sizeof(tdynarray)+elesize*i,eletype);
{ a declock(ref. count) isn't enough here }
{ it could be that the in MT environments }
{ in the mean time the refcount was }
{ decremented }
{ it is, because it doesn't really matter }
{ if the array is now removed }
fpc_dynarray_clear(p,pti);
end
else if dims[0]<>realp^.high+1 then
begin
{ range checking is quite difficult ... }
{ if size overflows then it is less than }
{ the values it was calculated from }
if (size<sizeof(tdynarray)) or
((elesize>0) and (size<elesize)) then
HandleErrorAddrFrameInd(201,get_pc_addr,get_frame);
{ resize? }
{ here, realp^.refcount has to be one, otherwise the previous }
{ if-statement would have been taken. Or is this also for MT }
{ code? (JM) }
if realp^.refcount=1 then
begin
{ shrink the array? }
if dims[0]<realp^.high+1 then
begin
int_finalizearray(pointer(realp)+sizeof(tdynarray)+
elesize*dims[0],
eletype,realp^.high-dims[0]+1);
reallocmem(realp,size);
end
else if dims[0]>realp^.high+1 then
begin
reallocmem(realp,size);
fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
(dims[0]-realp^.high-1)*elesize,0);
end;
newp := realp;
updatep := true;
end;
end;
end;
{ handle nested arrays }
if dimcount>1 then
begin
for i:=0 to dims[0]-1 do
int_dynarray_setlength(pointer((pointer(newp)+sizeof(tdynarray)+i*elesize)^),
eletype,dimcount-1,@dims[1]);
end;
if updatep then
begin
p:=pointer(newp)+sizeof(tdynarray);
newp^.refcount:=1;
newp^.high:=dims[0]-1;
end;
end;
Recent
