diff --git a/.gitattributes b/.gitattributes index 73423d4ce1..4283bf3996 100644 --- a/.gitattributes +++ b/.gitattributes @@ -32,6 +32,7 @@ compiler/aarch64/ra64std.inc svneol=native#text/plain compiler/aarch64/ra64sup.inc svneol=native#text/plain compiler/aarch64/symcpu.pas svneol=native#text/plain compiler/aasmbase.pas svneol=native#text/plain +compiler/aasmcnst.pas svneol=native#text/plain compiler/aasmdata.pas svneol=native#text/plain compiler/aasmsym.pas svneol=native#text/plain compiler/aasmtai.pas svneol=native#text/plain diff --git a/compiler/aasmcnst.pas b/compiler/aasmcnst.pas new file mode 100644 index 0000000000..8246c19d0f --- /dev/null +++ b/compiler/aasmcnst.pas @@ -0,0 +1,338 @@ +{ + Copyright (c) 2014 by Jonas Maebe, member of the Free Pascal development + team + + This unit implements typed constant data elements at the assembler level + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit aasmcnst; + +{$i fpcdefs.inc} + +interface + +uses + cclasses,globtype,constexp, + aasmbase,aasmdata,aasmtai, + symtype,symdef,symsym; + +type + { Warning: never directly create a ttai_typedconstbuilder instance, + instead create a cai_typedconstbuilder (this class can be overridden) } + ttai_lowleveltypedconstbuilder = class abstract + protected + { temporary list in which all data is collected } + fasmlist: tasmlist; + { while queueing elements of a compound expression, this is the current + offset in the top-level array/record } + fqueue_offset: asizeint; + + { ensure that finalize_asmlist is called only once } + fasmlist_finalized: boolean; + + { returns whether def must be handled as an aggregate on the current + platform } + function aggregate_kind(def: tdef): ttypedconstkind; virtual; + { finalize the asmlist: add the necessary symbols etc } + procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean); virtual; + public + { sym is the symbol for which this typed constant data is emitted. } + constructor create; virtual; + destructor destroy; override; + + { add a simple constant data element (p) to the typed constant. + def is the type of the added value } + procedure emit_tai(p: tai; def: tdef); virtual; + { same as above, for a special case: when the def is a procvardef and we + want to use it explicitly as a procvdef (i.e., not as a record with a + code and data pointer in case of a complex procvardef) } + procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual; + { begin a potential aggregate type. Must be called for any type + that consists of multiple tai constant data entries, or that + represents an aggregate at the Pascal level (a record, a non-dynamic + array, ... } + procedure maybe_begin_aggregate(def: tdef); virtual; + { end a potential aggregate type. Must be paired with every + maybe_begin_aggregate } + procedure maybe_end_aggregate(def: tdef); virtual; + + { The next group of routines are for constructing complex expressions. + While parsing a typed constant these operators are encountered from + outer to inner, so that is also the order in which they should be + added to the queue. Only one queue can be active at a time. There is + no default implementation. } + { Init the queue. Gives an internalerror if a queu was already active } + procedure queue_init(todef: tdef); virtual; + { queue an array/string indexing operation (performs all range checking, + so it doesn't have to be duplicated in all descendents). Returns the + length of the elements (in bytes) and the index in the vector + (0-based) } + procedure queue_vecn(def: tdef; const index: tconstexprint); virtual; + { queue a subscripting operation } + procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual; + { queue a type conversion operation } + procedure queue_typeconvn(fromdef, todef: tdef); virtual; + { queue an address taking operation } + procedure queue_addrn(fromdef, todef: tdef); virtual; + { (these default implementations don't do anything but indicate the + queue has been flushed by resetting fqueueu_offset) + finalise the queue (so a new one can be created) and flush the + previously queued operations, applying them in reverse order on a...} + { ... procdef } + procedure queue_emit_proc(pd: tprocdef); virtual; + { ... staticvarsym } + procedure queue_emit_staticvar(vs: tstaticvarsym); virtual; + { ... labelsym } + procedure queue_emit_label(l: tlabelsym); virtual; + { ... constsym } + procedure queue_emit_const(cs: tconstsym); virtual; + { ... asmsym } + procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); virtual; + + { finalize the asmlist (if necessary) and return it. + At the end, the generated data can be found in the asmlist. It will + be freed when the builder is destroyed, so add its contents to + another list first. This property should only be accessed once all + data has been added. } + function get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist; + end; + ttai_lowleveltypedconstbuilderclass = class of ttai_lowleveltypedconstbuilder; + + var + ctai_typedconstbuilder: ttai_lowleveltypedconstbuilderclass; + +implementation + + uses + verbose,globals, + symconst,defutil; + + {***************************************************************************** + ttai_lowleveltypedconstbuilder + *****************************************************************************} + + function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind; + begin + if (def.typ in [recorddef,filedef,variantdef]) or + is_object(def) or + ((def.typ=procvardef) and + not tprocvardef(def).is_addressonly) then + result:=tck_record + else if ((def.typ=arraydef) and + not is_dynamic_array(def)) or + ((def.typ=setdef) and + not is_smallset(def)) or + is_shortstring(def) then + result:=tck_array + else + result:=tck_simple; + end; + + + procedure ttai_lowleveltypedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean); + var + prelist: tasmlist; + begin + prelist:=tasmlist.create_without_marker; + maybe_new_object_file(prelist); + { only now add items based on the symbolname, because it may be + modified by the "section" specifier in case of a typed constant } + new_section(prelist,section,secname,const_align(alignment)); + if not lab then + if sym.bind=AB_GLOBAL then + prelist.concat(tai_symbol.Create_Global(sym,0)) + else + prelist.concat(tai_symbol.Create(sym,0)) + else + prelist.concat(tai_label.Create(tasmlabel(sym))); + { insert the symbol information before the data } + fasmlist.insertlist(prelist); + { end of the symbol } + fasmlist.concat(tai_symbol_end.Createname(sym.name)); + { free the temporary list } + prelist.free; + end; + + + function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; lab: boolean): tasmlist; + begin + if not fasmlist_finalized then + begin + finalize_asmlist(sym,def,section,secname,alignment,lab); + fasmlist_finalized:=true; + end; + result:=fasmlist; + end; + + + constructor ttai_lowleveltypedconstbuilder.create; + begin + inherited create; + fasmlist:=tasmlist.create_without_marker; + { queue is empty } + fqueue_offset:=low(fqueue_offset); + end; + + + destructor ttai_lowleveltypedconstbuilder.destroy; + begin + { the queue should have been flushed if it was used } + if fqueue_offset<>low(fqueue_offset) then + internalerror(2014062901); + fasmlist.free; + inherited destroy; + end; + + + procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef); + begin + { by default, we ignore the def info since we don't care about it at the + the assembler level } + fasmlist.concat(p); + end; + + + procedure ttai_lowleveltypedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); + begin + { nothing special by default, since we don't care about the type } + emit_tai(p,pvdef); + end; + + + procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef); + begin + { do nothing } + end; + + + procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef); + begin + { do nothing } + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_init(todef: tdef); + begin + { nested call to init? } + if fqueue_offset<>low(fqueue_offset) then + internalerror(2014062101); + fqueue_offset:=0; + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint); + var + elelen, + vecbase: asizeint; + v: tconstexprint; + begin + elelen:=1; + vecbase:=0; + case def.typ of + stringdef : + ; + arraydef : + begin + if not is_packed_array(def) then + begin + elelen:=tarraydef(def).elesize; + vecbase:=tarraydef(def).lowrange; + end + else + Message(parser_e_packed_dynamic_open_array); + end; + else + Message(parser_e_illegal_expression); + end; + { Prevent overflow } + v:=index-vecbase; + if (vint64(high(fqueue_offset))) then + message3(type_e_range_check_error_bounds,tostr(v),tostr(low(fqueue_offset)),tostr(high(fqueue_offset))); + if high(fqueue_offset)-fqueue_offset div elelen>v then + inc(fqueue_offset,elelen*v.svalue) + else + message3(type_e_range_check_error_bounds,tostr(index),tostr(vecbase),tostr(high(fqueue_offset)-fqueue_offset div elelen+vecbase)) + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); + begin + inc(fqueue_offset,vs.fieldoffset); + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_typeconvn(fromdef, todef: tdef); + begin + { do nothing } + end; + + procedure ttai_lowleveltypedconstbuilder.queue_addrn(fromdef, todef: tdef); + begin + { do nothing } + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_emit_proc(pd: tprocdef); + begin + emit_tai(Tai_const.Createname(pd.mangledname,fqueue_offset),pd); + fqueue_offset:=low(fqueue_offset); + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym); + begin + { getpointerdef because we are emitting a pointer to the staticvarsym + data, not the data itself } + emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),getpointerdef(vs.vardef)); + fqueue_offset:=low(fqueue_offset); + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_emit_label(l: tlabelsym); + begin + emit_tai(Tai_const.Createname(l.mangledname,fqueue_offset),voidcodepointertype); + fqueue_offset:=low(fqueue_offset); + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_emit_const(cs: tconstsym); + begin + if cs.consttyp<>constresourcestring then + internalerror(2014062102); + if fqueue_offset<>0 then + internalerror(2014062103); + { warning: update if/when the type of resource strings changes } + emit_tai(Tai_const.Createname(make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA,sizeof(pint)),cansistringtype); + fqueue_offset:=low(fqueue_offset); + end; + + + procedure ttai_lowleveltypedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef); + begin + { getpointerdef, because "sym" represents the address of whatever the + data is } + def:=getpointerdef(def); + emit_tai(Tai_const.Create_sym(sym),def); + fqueue_offset:=low(fqueue_offset); + end; + + +begin + ctai_typedconstbuilder:=ttai_lowleveltypedconstbuilder; +end. +