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

* patch from Thorsten Engler submitted in #8235

Browse Source 
git-svn-id: trunk@6272 -
This commit is contained in:
florian 2007-01-30 19:53:42 +00:00
parent 0650ebe3f2
commit 2167655902
4 changed files with 44 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/cgobj.pas
View File

@ -385,6 +385,7 @@ unit cgobj;
}
procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte);
procedure g_copyvariant(list : TAsmList;const source,dest : treference);
procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
@ -2512,6 +2513,27 @@ implementation
cgpara1.done;
end;
procedure tcg.g_copyvariant(list : TAsmList;const source,dest : treference);
var
cgpara1,cgpara2 : TCGPara;
begin
cgpara1.init;
cgpara2.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.allocparaloc(list,cgpara2);
a_paramaddr_ref(list,dest,cgpara2);
paramanager.allocparaloc(list,cgpara1);
a_paramaddr_ref(list,source,cgpara1);
paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE');
deallocallcpuregisters(list);
cgpara2.done;
cgpara1.done;
end;
procedure tcg.g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
var

15
compiler/ncgutil.pas
View File

@ -896,6 +896,14 @@ implementation
include(current_procinfo.flags,pi_do_call);
cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef).len)
end
else if tparavarsym(p).vardef.typ = variantdef then
begin
{ this code is only executed before the code for the body and the entry/exit code is generated
so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
}
include(current_procinfo.flags,pi_do_call);
cg.g_copyvariant(list,href,localcopyloc.reference)
end
else
begin
{ pass proper alignment info }
@ -1154,8 +1162,11 @@ implementation
vs_value :
if needs_inittable then
begin
location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
{ variants are already handled by the call to fpc_variant_copy_overwrite }
if tparavarsym(p).vardef.typ <> variantdef then begin
location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
end;
end;
vs_out :
begin

1
rtl/inc/compproc.inc
View File

@ -258,6 +258,7 @@ Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); comp
{$ifdef FPC_HAS_FEATURE_VARIANTS}
procedure fpc_variant_copy(d,s : pointer);compilerproc;
procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;
procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); compilerproc;
function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;

9
rtl/inc/variant.inc
View File

@ -43,12 +43,19 @@ procedure variant_addref(var v : tvardata);[Public,Alias:'FPC_VARIANT_ADDREF'];
end;
{ using pointers as argument here makes life for the compiler easier }
procedure fpc_variant_copy(d,s : pointer);compilerproc;
procedure fpc_variant_copy(d,s : pointer);[Public,Alias:'FPC_VARIANT_COPY']; compilerproc;
begin
if assigned(VarCopyProc) then
VarCopyProc(tvardata(d^),tvardata(s^));
end;
{ using pointers as argument here makes life for the compiler easier, overwrites target without finalizing }
procedure fpc_variant_copy_overwrite(source, dest : pointer);[Public,Alias:'FPC_VARIANT_COPY_OVERWRITE']; compilerproc;
begin
tvardata(dest^).VType := varEmpty;
if assigned(VarCopyProc) then
VarCopyProc(tvardata(dest^),tvardata(source^));
end;
Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
begin