mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-18 20:56:02 +01:00
+ added hook for "individual value to open array of one element"-conversion,
so it can be intercepted by the JVM backend (it has to create an actual
array)
+ JVM support for the elem_2_open_array hook
git-svn-id: branches/jvmbackend@18561 -
This commit is contained in:
Jonas Maebe
parent
8248e6762f
commit
aa1f299a17
@ -90,7 +90,8 @@ interface
|
||||
tc_enum_2_variant,
|
||||
tc_interface_2_variant,
|
||||
tc_variant_2_interface,
|
||||
tc_array_2_dynarray
|
||||
tc_array_2_dynarray,
|
||||
tc_elem_2_openarray
|
||||
);
|
||||
|
||||
function compare_defs_ext(def_from,def_to : tdef;
|
||||
@ -680,7 +681,7 @@ implementation
|
||||
(def_from.typ=tarraydef(def_to).elementdef.typ) and
|
||||
equal_defs(def_from,tarraydef(def_to).elementdef) then
|
||||
begin
|
||||
doconv:=tc_equal;
|
||||
doconv:=tc_elem_2_openarray;
|
||||
{ also update in htypechk.pas/var_para_allowed if changed
|
||||
here }
|
||||
eq:=te_convert_l3;
|
||||
|
||||
@ -54,6 +54,7 @@ interface
|
||||
{ procedure second_pchar_to_string;override; }
|
||||
{ procedure second_class_to_intf;override; }
|
||||
{ procedure second_char_to_char;override; }
|
||||
procedure second_elem_to_openarray; override;
|
||||
function target_specific_explicit_typeconv: boolean; override;
|
||||
function target_specific_general_typeconv: boolean; override;
|
||||
protected
|
||||
@ -443,6 +444,36 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tjvmtypeconvnode.second_elem_to_openarray;
|
||||
var
|
||||
primitivetype: boolean;
|
||||
opc: tasmop;
|
||||
mangledname: string;
|
||||
basereg: tregister;
|
||||
arrayref: treference;
|
||||
begin
|
||||
{ create an array with one element of the required type }
|
||||
thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
|
||||
mangledname:=jvmarrtype(left.resultdef,primitivetype);
|
||||
if primitivetype then
|
||||
opc:=a_newarray
|
||||
else
|
||||
opc:=a_anewarray;
|
||||
{ doesn't change stack height: one int replaced by one reference }
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
|
||||
{ store the data in the newly created array }
|
||||
basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
|
||||
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
|
||||
reference_reset_base(arrayref,basereg,0,4);
|
||||
arrayref.arrayreftype:=art_indexconst;
|
||||
arrayref.indexoffset:=0;
|
||||
hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
|
||||
location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4);
|
||||
tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
|
||||
hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
|
||||
end;
|
||||
|
||||
|
||||
procedure get_most_nested_types(var fromdef, todef: tdef);
|
||||
begin
|
||||
while is_dynamic_array(fromdef) and
|
||||
|
||||
@ -50,6 +50,7 @@ interface
|
||||
procedure second_ansistring_to_pchar;override;
|
||||
procedure second_class_to_intf;override;
|
||||
procedure second_char_to_char;override;
|
||||
procedure second_elem_to_openarray;override;
|
||||
procedure second_nothing;override;
|
||||
procedure pass_generate_code;override;
|
||||
{$ifdef cpuflags}
|
||||
@ -705,6 +706,12 @@ interface
|
||||
internalerror(2007081202);
|
||||
end;
|
||||
|
||||
procedure tcgtypeconvnode.second_elem_to_openarray;
|
||||
begin
|
||||
{ nothing special to do by default }
|
||||
second_nothing;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgtypeconvnode.second_nothing;
|
||||
var
|
||||
|
||||
@ -95,6 +95,7 @@ interface
|
||||
function typecheck_variant_to_interface : tnode; virtual;
|
||||
function typecheck_interface_to_variant : tnode; virtual;
|
||||
function typecheck_array_2_dynarray : tnode; virtual;
|
||||
function typecheck_elem_2_openarray : tnode; virtual;
|
||||
private
|
||||
function _typecheck_int_to_int : tnode;
|
||||
function _typecheck_cord_to_pointer : tnode;
|
||||
@ -124,6 +125,7 @@ interface
|
||||
function _typecheck_variant_to_interface : tnode;
|
||||
function _typecheck_interface_to_variant : tnode;
|
||||
function _typecheck_array_2_dynarray : tnode;
|
||||
function _typecheck_elem_2_openarray : tnode;
|
||||
protected
|
||||
function first_int_to_int : tnode;virtual;
|
||||
function first_cstring_to_pchar : tnode;virtual;
|
||||
@ -199,6 +201,7 @@ interface
|
||||
procedure _second_ansistring_to_pchar;virtual;
|
||||
procedure _second_class_to_intf;virtual;
|
||||
procedure _second_char_to_char;virtual;
|
||||
procedure _second_elem_to_openarray;virtual;
|
||||
procedure _second_nothing; virtual;
|
||||
|
||||
protected
|
||||
@ -223,6 +226,7 @@ interface
|
||||
procedure second_ansistring_to_pchar;virtual;abstract;
|
||||
procedure second_class_to_intf;virtual;abstract;
|
||||
procedure second_char_to_char;virtual;abstract;
|
||||
procedure second_elem_to_openarray;virtual;abstract;
|
||||
procedure second_nothing; virtual;abstract;
|
||||
end;
|
||||
ttypeconvnodeclass = class of ttypeconvnode;
|
||||
@ -904,7 +908,8 @@ implementation
|
||||
'tc_enum_2_variant',
|
||||
'tc_interface_2_variant',
|
||||
'tc_variant_2_interface',
|
||||
'tc_array_2_dynarray'
|
||||
'tc_array_2_dynarray',
|
||||
'tc_elem_2_openarray'
|
||||
);
|
||||
begin
|
||||
inherited printnodeinfo(t);
|
||||
@ -1619,6 +1624,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.typecheck_elem_2_openarray : tnode;
|
||||
begin
|
||||
result:=nil;
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode._typecheck_int_to_int : tnode;
|
||||
begin
|
||||
result := typecheck_int_to_int;
|
||||
@ -1787,6 +1798,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode._typecheck_elem_2_openarray : tnode;
|
||||
begin
|
||||
result := typecheck_elem_2_openarray;
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.target_specific_general_typeconv: boolean;
|
||||
begin
|
||||
result:=false;
|
||||
@ -1901,7 +1918,8 @@ implementation
|
||||
{ enum_2_variant} @ttypeconvnode._typecheck_enum_to_variant,
|
||||
{ variant_2_interface} @ttypeconvnode._typecheck_interface_to_variant,
|
||||
{ interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
|
||||
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray
|
||||
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
|
||||
{ elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray
|
||||
);
|
||||
type
|
||||
tprocedureofobject = function : tnode of object;
|
||||
@ -3281,7 +3299,8 @@ implementation
|
||||
nil,
|
||||
nil,
|
||||
nil,
|
||||
nil
|
||||
nil,
|
||||
@ttypeconvnode._first_nothing
|
||||
);
|
||||
type
|
||||
tprocedureofobject = function : tnode of object;
|
||||
@ -3490,6 +3509,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure ttypeconvnode._second_elem_to_openarray;
|
||||
begin
|
||||
second_elem_to_openarray;
|
||||
end;
|
||||
|
||||
|
||||
procedure ttypeconvnode._second_nothing;
|
||||
begin
|
||||
second_nothing;
|
||||
@ -3538,7 +3563,8 @@ implementation
|
||||
@ttypeconvnode._second_nothing, { enum_2_variant }
|
||||
@ttypeconvnode._second_nothing, { variant_2_interface }
|
||||
@ttypeconvnode._second_nothing, { interface_2_variant }
|
||||
@ttypeconvnode._second_nothing { array_2_dynarray }
|
||||
@ttypeconvnode._second_nothing, { array_2_dynarray }
|
||||
@ttypeconvnode._second_elem_to_openarray { elem_2_openarray }
|
||||
);
|
||||
type
|
||||
tprocedureofobject = procedure of object;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user