paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 19:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed dynarray copy

Browse Source
This commit is contained in:
peter 2002-11-26 23:02:07 +00:00
parent af371f5a97
commit 2b6e06bd4a
2 changed files with 42 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/inc/compproc.inc
View File

@ -54,7 +54,7 @@ Function fpc_shortstr_Copy(const s:shortstring;index:StrLenInt;count:StrLenInt)
Function fpc_ansistr_Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;compilerproc;
Function fpc_widestr_Copy (Const S : WideString; Index,Size : Longint) : WideString;compilerproc;
function fpc_char_copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;compilerproc;
procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);compilerproc;
procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;lowidx,highidx:longint);compilerproc;
function fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
@ -284,7 +284,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{
$Log$
Revision 1.28 2002-10-17 12:43:00 florian
Revision 1.29 2002-11-26 23:02:07 peter
* fixed dynarray copy
Revision 1.28 2002/10/17 12:43:00 florian
+ ansistring_append* implemented
Revision 1.27 2002/10/10 19:24:28 florian

45
rtl/inc/dynarr.inc
View File

@ -254,27 +254,56 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
end;
procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);{$ifdef hascompilerproc} compilerproc; {$endif}
{ provide local access to dynarr_copy }
procedure int_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
lowidx,highidx:longint);[external name 'FPC_DYNARR_COPY'];
procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
lowidx,highidx:longint);[Public,Alias:'FPC_DYNARR_COPY'];{$ifdef hascompilerproc} compilerproc; {$endif}
var
size : longint;
realpdest,
realpsrc : pdynarray;
cnt,
i,size : longint;
begin
pdest:=nil;
if psrc=nil then
exit;
realpsrc:=pdynarray(psrc-sizeof(tdynarray));
{ skip kind and name }
inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen));
{ -1, -1 is used to copy the whole array like a:=copy(b);, so
update the lowidx and highidx with the values from psrc }
if (lowidx=-1) and (highidx=-1) then
begin
lowidx:=0;
highidx:=realpsrc^.high;
end;
{ get number of elements and check for invalid values }
if (lowidx<0) or (highidx<0) then
HandleErrorFrame(201,get_frame);
cnt:=highidx-lowidx+1;
{ create new array }
size:=pdynarraytypeinfo(ti)^.elesize*(pdynarray(psrc)^.high+1)+sizeof(tdynarray);
getmem(pdest,size);
move(psrc^,pdest^,size);
size:=pdynarraytypeinfo(ti)^.elesize*cnt;
getmem(realpdest,size+sizeof(tdynarray));
pdest:=pointer(realpdest)+sizeof(tdynarray);
{ copy data }
move(pointer(psrc+pdynarraytypeinfo(ti)^.elesize*lowidx)^,pdest^,size);
{ fill new refcount }
realpdest^.refcount:=1;
realpdest^.high:=cnt-1;
{ increment ref. count of members }
for i:= 0 to cnt-1 do
int_addref(pointer(pdest+sizeof(tdynarray)+pdynarraytypeinfo(ti)^.elesize*i),pdynarraytypeinfo(ti)^.eletype);
end;
{
$Log$
Revision 1.20 2002-10-09 20:24:30 florian
Revision 1.21 2002-11-26 23:02:07 peter
* fixed dynarray copy
Revision 1.20 2002/10/09 20:24:30 florian
+ range checking for dyn. arrays
Revision 1.19 2002/10/02 18:21:51 peter