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

+ array -> dyn. array type cast

Browse Source
This commit is contained in:
florian 2005-03-11 21:55:43 +00:00
parent 4c66861877
commit 737a81f30b
2 changed files with 87 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compiler/defcmp.pas
View File

@ -78,7 +78,8 @@ interface
tc_variant_2_enum,
tc_enum_2_variant,
tc_interface_2_variant,
tc_variant_2_interface
tc_variant_2_interface,
tc_array_2_dynarray
);
function compare_defs_ext(def_from,def_to : tdef;
@ -527,10 +528,20 @@ implementation
{ to dynamic array }
if is_dynamic_array(def_to) then
begin
{ dynamic array -> dynamic array }
if is_dynamic_array(def_from) and
equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
eq:=te_equal;
if equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
begin
{ dynamic array -> dynamic array }
if is_dynamic_array(def_from) then
eq:=te_equal
{ fpc modes only: array -> dyn. array }
else if (aktmodeswitches*[m_objfpc,m_fpc]<>[]) and
not(is_special_array(def_from)) and
is_zero_based_array(def_from) then
begin
eq:=te_convert_l2;
doconv:=tc_array_2_dynarray;
end;
end
end
else
{ to open array }
@ -1387,7 +1398,10 @@ implementation
end.
{
$Log$
Revision 1.69 2005-02-14 17:13:06 peter
Revision 1.70 2005-03-11 21:55:43 florian
+ array -> dyn. array type cast
Revision 1.69 2005/02/14 17:13:06 peter
* truncate log
Revision 1.68 2005/02/03 19:24:33 florian

72
compiler/ncnv.pas
View File

@ -80,6 +80,7 @@ interface
function resulttype_proc_to_procvar : tnode;
function resulttype_variant_to_interface : tnode;
function resulttype_interface_to_variant : tnode;
function resulttype_array_2_dynarray : tnode;
protected
function first_int_to_int : tnode;virtual;
function first_cstring_to_pchar : tnode;virtual;
@ -206,7 +207,7 @@ implementation
cclasses,globtype,systems,
cutils,verbose,globals,widestr,
symconst,symdef,symsym,symbase,symtable,
ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils,
ncon,ncal,nset,nadd,ninl,nmem,nmat,nbas,nutils,
cgbase,procinfo,
htypechk,pass_1,cpuinfo;
@ -631,7 +632,8 @@ implementation
'tc_variant_2_enum',
'tc_enum_2_variant',
'tc_interface_2_variant',
'tc_variant_2_interface'
'tc_variant_2_interface',
'tc_array_2_dynarray'
);
begin
inherited printnodeinfo(t);
@ -1173,6 +1175,60 @@ implementation
end;
function ttypeconvnode.resulttype_array_2_dynarray : tnode;
var
newstatement : tstatementnode;
temp : ttempcreatenode;
temp2 : ttempcreatenode;
begin
{ create statements with call to getmem+initialize }
result:=internalstatements(newstatement);
{ create temp for result }
temp:=ctempcreatenode.create(resulttype,resulttype.def.size,tt_persistent,true);
addstatement(newstatement,temp);
{ get temp for array of lengths }
temp2:=ctempcreatenode.create(sinttype,sinttype.def.size,tt_persistent,false);
addstatement(newstatement,temp2);
{ one dimensional }
addstatement(newstatement,cassignmentnode.create(
ctemprefnode.create_offset(temp2,0),
cordconstnode.create
(tarraydef(left.resulttype.def).highrange+1,s32inttype,true)));
{ create call to fpc_dynarr_setlength }
addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',
ccallparanode.create(caddrnode.create_internal
(ctemprefnode.create(temp2)),
ccallparanode.create(cordconstnode.create
(1,s32inttype,true),
ccallparanode.create(caddrnode.create_internal
(crttinode.create(tstoreddef(resulttype.def),initrtti)),
ccallparanode.create(
ctypeconvnode.create_internal(
ctemprefnode.create(temp),voidpointertype),
nil))))
));
addstatement(newstatement,ctempdeletenode.create(temp2));
{ copy ... }
addstatement(newstatement,cassignmentnode.create(
ctypeconvnode.create_internal(cderefnode.create(ctypeconvnode.create_internal(ctemprefnode.create(temp),voidpointertype)),left.resulttype),
left
));
{ left is reused }
left:=nil;
{ the last statement should return the value as
location and type, this is done be referencing the
temp and converting it first from a persistent temp to
normal temp }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
addstatement(newstatement,ctemprefnode.create(temp));
end;
procedure copyparasym(p:TNamedIndexItem;arg:pointer);
var
newparast : tsymtable absolute arg;
@ -1267,7 +1323,8 @@ implementation
{ variant_2_enum} @ttypeconvnode.resulttype_variant_to_enum,
{ enum_2_variant} @ttypeconvnode.resulttype_enum_to_variant,
{ variant_2_interface} @ttypeconvnode.resulttype_interface_to_variant,
{ interface_2_variant} @ttypeconvnode.resulttype_variant_to_interface
{ interface_2_variant} @ttypeconvnode.resulttype_variant_to_interface,
{ array_2_dynarray} @ttypeconvnode.resulttype_array_2_dynarray
);
type
tprocedureofobject = function : tnode of object;
@ -2100,6 +2157,7 @@ implementation
nil,
nil,
nil,
nil,
nil
);
type
@ -2336,7 +2394,8 @@ implementation
@ttypeconvnode._second_nothing, { variant_2_enum }
@ttypeconvnode._second_nothing, { enum_2_variant }
@ttypeconvnode._second_nothing, { variant_2_interface }
@ttypeconvnode._second_nothing { interface_2_variant }
@ttypeconvnode._second_nothing, { interface_2_variant }
@ttypeconvnode._second_nothing { array_2_dynarray }
);
type
tprocedureofobject = procedure of object;
@ -2595,7 +2654,10 @@ begin
end.
{
$Log$
Revision 1.178 2005-03-05 16:09:20 jonas
Revision 1.179 2005-03-11 21:55:43 florian
+ array -> dyn. array type cast
Revision 1.178 2005/03/05 16:09:20 jonas
* fixed small bug in ttypeconvnode.printnodeinfo
Revision 1.177 2005/02/14 17:13:06 peter