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

* moved tasmlisttypedconstbuilder.tc_emit_string_offset() to

Browse Source 
ttai_typedconstbuilder.emit_string_offset() so it can also be used outside
    the context of parsing a Pascal-level typed constant

git-svn-id: branches/hlcgllvm@30111 -
This commit is contained in:
Jonas Maebe 2015-03-06 19:45:04 +00:00
parent 511e878606
commit 9c42437326
3 changed files with 47 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/aasmcnst.pas
View File

@ -226,6 +226,9 @@ type
will be created/destroyed internally by these methods) }
class function emit_ansistring_const(list: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding; newsection: boolean): tasmlabofs;
class function emit_unicodestring_const(list: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
{ emits a tasmlabofs as returned by emit_*string_const }
procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
{ emit a shortstring constant, and return its def }
function emit_shortstring_const(const str: shortstring): tdef;
{ emit a guid constant }
@ -1017,6 +1020,11 @@ implementation
datatcb.free;
end;
procedure ttai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
begin
emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
end;
function ttai_typedconstbuilder.emit_shortstring_const(const str: shortstring): tdef;
begin

81
compiler/llvm/nllvmtcon.pas
View File

@ -72,6 +72,7 @@ interface
constructor create; override;
destructor destroy; override;
procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
procedure queue_init(todef: tdef); override;
procedure queue_vecn(def: tdef; const index: tconstexprint); override;
procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@ -83,11 +84,6 @@ interface
end;
tllvmasmlisttypedconstbuilder = class(tasmlisttypedconstbuilder)
protected
procedure tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
end;
implementation
uses
@ -248,6 +244,42 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
var
srsym : tsym;
srsymtable: tsymtable;
strrecdef : trecorddef;
offset: pint;
field: tfieldvarsym;
dataptrdef: tdef;
begin
{ if the returned offset is <> 0, then the string data
starts at that offset -> translate to a field for the
high level code generator }
if ll.ofs<>0 then
begin
{ get the recorddef for this string constant }
if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
internalerror(2014080406);
strrecdef:=trecorddef(ttypesym(srsym).typedef);
{ offset in the record of the the string data }
offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
{ field corresponding to this offset }
field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
{ pointerdef to the string data array }
dataptrdef:=getpointerdef(field.vardef);
queue_init(charptrdef);
queue_addrn(dataptrdef,charptrdef);
queue_subscriptn(strrecdef,field);
queue_emit_asmsym(ll.lab,strrecdef);
end
else
{ since llvm doesn't support labels in the middle of structs, this
offset should never be 0 }
internalerror(2014080506);
end;
procedure tllvmtai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
var
agg: tai_aggregatetypedconst;
@ -454,46 +486,7 @@ implementation
end;
{ tllvmasmlisttypedconstbuilder }
procedure tllvmasmlisttypedconstbuilder.tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
var
srsym : tsym;
srsymtable: tsymtable;
strrecdef : trecorddef;
offset: pint;
field: tfieldvarsym;
dataptrdef: tdef;
begin
{ if the returned offset is <> 0, then the string data
starts at that offset -> translate to a field for the
high level code generator }
if ll.ofs<>0 then
begin
{ get the recorddef for this string constant }
if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
internalerror(2014080406);
strrecdef:=trecorddef(ttypesym(srsym).typedef);
{ offset in the record of the the string data }
offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
{ field corresponding to this offset }
field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
{ pointerdef to the string data array }
dataptrdef:=getpointerdef(field.vardef);
ftcb.queue_init(charptrdef);
ftcb.queue_addrn(dataptrdef,charptrdef);
ftcb.queue_subscriptn(strrecdef,field);
ftcb.queue_emit_asmsym(ll.lab,strrecdef);
end
else
{ since llvm doesn't support labels in the middle of structs, this
offset should never be 0 }
internalerror(2014080506);
end;
begin
ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
ctypedconstbuilder:=tllvmasmlisttypedconstbuilder;
end.

12
compiler/ngtcon.pas
View File

@ -98,8 +98,6 @@ interface
procedure tc_emit_setdef(def: tsetdef; var node: tnode);override;
procedure tc_emit_enumdef(def: tenumdef; var node: tnode);override;
procedure tc_emit_stringdef(def: tstringdef; var node: tnode);override;
procedure tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
public
constructor create(sym: tstaticvarsym);virtual;
procedure parse_into_asmlist;
@ -449,12 +447,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
end;
procedure tasmlisttypedconstbuilder.tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
begin
ftcb.emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
end;
procedure tasmlisttypedconstbuilder.tc_emit_stringdef(def: tstringdef; var node: tnode);
var
strlength : aint;
@ -563,7 +555,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
end
else
ll:=ctai_typedconstbuilder.emit_ansistring_const(fdatalist,strval,strlength,def.encoding,true);
tc_emit_string_offset(ll,strlength,def.stringtype,false,charpointertype);
ftcb.emit_string_offset(ll,strlength,def.stringtype,false,charpointertype);
end;
st_unicodestring,
st_widestring:
@ -599,7 +591,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
Include(tcsym.varoptions,vo_force_finalize);
end;
end;
tc_emit_string_offset(ll,strlength,def.stringtype,winlike,widecharpointertype);
ftcb.emit_string_offset(ll,strlength,def.stringtype,winlike,widecharpointertype);
end;
else
internalerror(200107081);