paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 20:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* converted "array of const" handling to the high level code generator

Browse Source 
git-svn-id: trunk@32207 -
This commit is contained in:
Jonas Maebe 2015-10-30 20:45:15 +00:00
parent ccf1c67665
commit 4670e0abc9
1 changed files with 85 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
compiler/ncgld.pas
View File

@ -1115,10 +1115,13 @@ implementation
procedure tcgarrayconstructornode.pass_generate_code; procedure tcgarrayconstructornode.pass_generate_code;
var var
hp : tarrayconstructornode; hp : tarrayconstructornode;
href : treference; href,
fref : treference;
lt : tdef; lt : tdef;
realresult: tdef; realresult: tdef;
paraloc : tcgparalocation; paraloc : tcgparalocation;
varvtypefield,
varfield : tfieldvarsym;
vtype : longint; vtype : longint;
eledef: tdef; eledef: tdef;
elesize : longint; elesize : longint;
@ -1135,6 +1138,7 @@ implementation
if dovariant then if dovariant then
begin begin
eledef:=search_system_type('TVARREC').typedef; eledef:=search_system_type('TVARREC').typedef;
varvtypefield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VTYPE'));
elesize:=eledef.size; elesize:=eledef.size;
{ in this case, the elementdef is set to "void", so create an { in this case, the elementdef is set to "void", so create an
array of tvarrec instead } array of tvarrec instead }
@ -1143,6 +1147,7 @@ implementation
else else
begin begin
eledef:=tarraydef(resultdef).elementdef; eledef:=tarraydef(resultdef).elementdef;
varvtypefield:=nil;
elesize:=tarraydef(resultdef).elesize; elesize:=tarraydef(resultdef).elesize;
realresult:=resultdef; realresult:=resultdef;
end; end;
@ -1181,6 +1186,7 @@ implementation
begin begin
{ find the correct vtype value } { find the correct vtype value }
vtype:=$ff; vtype:=$ff;
varfield:=nil;
vaddr:=false; vaddr:=false;
lt:=hp.left.resultdef; lt:=hp.left.resultdef;
case lt.typ of case lt.typ of
@ -1191,38 +1197,65 @@ implementation
begin begin
case torddef(lt).ordtype of case torddef(lt).ordtype of
scurrency: scurrency:
vtype:=vtCurrency; begin
vtype:=vtCurrency;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VCURRENCY'));
end;
s64bit: s64bit:
vtype:=vtInt64; begin
vtype:=vtInt64;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VINT64'));
end;
u64bit: u64bit:
vtype:=vtQWord; begin
vtype:=vtQWord;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VQWORD'));
end;
end; end;
freetemp:=false; freetemp:=false;
vaddr:=true; vaddr:=true;
end end
else if (lt.typ=enumdef) or else if (lt.typ=enumdef) or
is_integer(lt) then is_integer(lt) then
vtype:=vtInteger begin
vtype:=vtInteger;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VINTEGER'));
end
else else
if is_boolean(lt) then if is_boolean(lt) then
vtype:=vtBoolean begin
vtype:=vtBoolean;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VBOOLEAN'));
end
else else
if (lt.typ=orddef) then if (lt.typ=orddef) then
begin begin
case torddef(lt).ordtype of case torddef(lt).ordtype of
uchar: uchar:
vtype:=vtChar; begin
vtype:=vtChar;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VCHAR'));
end;
uwidechar: uwidechar:
vtype:=vtWideChar; begin
vtype:=vtWideChar;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VWIDECHAR'));
end;
end; end;
end; end;
end; end;
floatdef : floatdef :
begin begin
if is_currency(lt) then if is_currency(lt) then
vtype:=vtCurrency begin
vtype:=vtCurrency;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VCURRENCY'));
end
else else
vtype:=vtExtended; begin
vtype:=vtExtended;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VEXTENDED'));
end;
freetemp:=false; freetemp:=false;
vaddr:=true; vaddr:=true;
end; end;
@ -1230,26 +1263,45 @@ implementation
pointerdef : pointerdef :
begin begin
if is_pchar(lt) then if is_pchar(lt) then
vtype:=vtPChar begin
vtype:=vtPChar;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VPCHAR'));
end
else if is_pwidechar(lt) then else if is_pwidechar(lt) then
vtype:=vtPWideChar begin
vtype:=vtPWideChar;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VPWIDECHAR'));
end
else else
vtype:=vtPointer; begin
vtype:=vtPointer;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VPOINTER'));
end;
end; end;
variantdef : variantdef :
begin begin
vtype:=vtVariant; vtype:=vtVariant;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VVARIANT'));
vaddr:=true; vaddr:=true;
freetemp:=false; freetemp:=false;
end; end;
classrefdef : classrefdef :
vtype:=vtClass; begin
vtype:=vtClass;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VCLASS'));
end;
objectdef : objectdef :
if is_interface(lt) then if is_interface(lt) then
vtype:=vtInterface begin
vtype:=vtInterface;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VINTERFACE'));
end
{ vtObject really means a class based on TObject } { vtObject really means a class based on TObject }
else if is_class(lt) then else if is_class(lt) then
vtype:=vtObject begin
vtype:=vtObject;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VOBJECT'));
end
else else
internalerror(200505171); internalerror(200505171);
stringdef : stringdef :
@ -1257,6 +1309,7 @@ implementation
if is_shortstring(lt) then if is_shortstring(lt) then
begin begin
vtype:=vtString; vtype:=vtString;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VSTRING'));
vaddr:=true; vaddr:=true;
freetemp:=false; freetemp:=false;
end end
@ -1264,39 +1317,45 @@ implementation
if is_ansistring(lt) then if is_ansistring(lt) then
begin begin
vtype:=vtAnsiString; vtype:=vtAnsiString;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VANSISTRING'));
freetemp:=false; freetemp:=false;
end end
else else
if is_widestring(lt) then if is_widestring(lt) then
begin begin
vtype:=vtWideString; vtype:=vtWideString;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VWIDESTRING'));
freetemp:=false; freetemp:=false;
end end
else else
if is_unicodestring(lt) then if is_unicodestring(lt) then
begin begin
vtype:=vtUnicodeString; vtype:=vtUnicodeString;
varfield:=tfieldvarsym(search_struct_member_no_helper(trecorddef(eledef),'VUNICODESTRING'));
freetemp:=false; freetemp:=false;
end; end;
end; end;
end; end;
if vtype=$ff then if vtype=$ff then
internalerror(14357); internalerror(14357);
if not assigned(varfield) then
internalerror(2015102901);
{ write changing field update href to the next element } { write changing field update href to the next element }
inc(href.offset,sizeof(pint)); fref:=href;
hlcg.g_set_addr_nonbitpacked_record_field_ref(current_asmdata.CurrAsmList,trecorddef(eledef),varfield,fref);
if vaddr then if vaddr then
begin begin
hlcg.location_force_mem(current_asmdata.CurrAsmList,hp.left.location,hp.left.resultdef); hlcg.location_force_mem(current_asmdata.CurrAsmList,hp.left.location,lt);
tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidpointertype); tmpreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cpointerdef.getreusable(lt));
hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hp.left.resultdef,voidpointertype,hp.left.location.reference,tmpreg); hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hp.left.resultdef,cpointerdef.getreusable(lt),hp.left.location.reference,tmpreg);
hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,voidpointertype,voidpointertype,tmpreg,href); hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(lt),cpointerdef.getreusable(varfield.vardef),tmpreg,fref);
end end
else else
{ todo: proper type information for hlcg } hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,hp.left.resultdef,cpointerdef.getreusable(varfield.vardef),hp.left.location,fref);
hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,hp.left.resultdef,{$ifdef cpu16bitaddr}u32inttype{$else}voidpointertype{$endif},hp.left.location,href);
{ update href to the vtype field and write it } { update href to the vtype field and write it }
dec(href.offset,sizeof(pint)); fref:=href;
cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href); hlcg.g_set_addr_nonbitpacked_record_field_ref(current_asmdata.CurrAsmList,trecorddef(eledef),varvtypefield,fref);
hlcg.a_load_const_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(varvtypefield.vardef),vtype,fref);
{ goto next array element } { goto next array element }
advancearrayoffset(href,elesize); advancearrayoffset(href,elesize);
end end