+ unit with a buider class for typed constant/initialised data elements at

the assembler level
   o initially for use during the typed constant parsing, but usable anywhere
     we generate initialised data in the compiler

git-svn-id: branches/hlcgllvm@28117 -

.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

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 (v<int64(low(fqueue_offset))) or (v>int64(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.
+