Browse Source

+ support for emitting simple placeholder elements in the high level
typed const builder, for use when e.g. emitting a table preceded by
the number of elements in case that number is only known afterwards

git-svn-id: trunk@31648 -

Jonas Maebe 10 years ago
parent
commit
5a2217f645
2 changed files with 142 additions and 0 deletions
  1. 92 0
      compiler/aasmcnst.pas
  2. 50 0
      compiler/llvm/nllvmtcon.pas

+ 92 - 0
compiler/aasmcnst.pas

@@ -92,6 +92,7 @@ type
      procedure addvalue(val: tai_abstracttypedconst);
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
+     function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
      procedure finish;
      destructor destroy; override;
    end;
@@ -168,6 +169,14 @@ type
    end;
    taggregateinformationclass = class of taggregateinformation;
 
+   { information about a placeholder element that has been added, and which has
+     to be replaced later with a real data element }
+   ttypedconstplaceholder = class abstract
+     def: tdef;
+     constructor create(d: tdef);
+     procedure replace(ai: tai; d: tdef); virtual; abstract;
+   end;
+
    { Warning: never directly create a ttai_typedconstbuilder instance,
      instead create a cai_typedconstbuilder (this class can be overridden) }
    ttai_typedconstbuilder = class abstract
@@ -327,6 +336,16 @@ type
      function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
      function end_anonymous_record: trecorddef; virtual;
 
+     { add a placeholder element at the current position that later can be
+       filled in with the actual data (via ttypedconstplaceholder.replace)
+
+       useful in case you have table preceded by the number of elements, and
+       you cound the elements while building the table }
+     function emit_placeholder(def: tdef): ttypedconstplaceholder; virtual; abstract;
+     { common code to check whether a placeholder can be added at the current
+       position }
+     procedure check_add_placeholder(def: tdef);
+
      { 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
@@ -397,6 +416,13 @@ type
      property anonrecmarker: tai read fanonrecmarker write fanonrecmarker;
    end;
 
+   tlowleveltypedconstplaceholder = class(ttypedconstplaceholder)
+     list: tasmlist;
+     insertpos: tai;
+     constructor create(l: tasmlist; pos: tai; d: tdef);
+     procedure replace(ai: tai; d: tdef); override;
+   end;
+
    ttai_lowleveltypedconstbuilder = class(ttai_typedconstbuilder)
     protected
      procedure mark_anon_aggregate_alignment; override;
@@ -404,6 +430,7 @@ type
     public
      { set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
      class constructor classcreate;
+     function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
    end;
 
    var
@@ -508,6 +535,15 @@ implementation
       end;
 
 
+{****************************************************************************
+                             ttypedconstplaceholder
+ ****************************************************************************}
+
+    constructor ttypedconstplaceholder.create(d: tdef);
+      begin
+        def:=d;
+      end;
+
 {****************************************************************************
                             tai_abstracttypedconst
  ****************************************************************************}
@@ -685,6 +721,13 @@ implementation
      end;
 
 
+   function tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
+     begin
+       result:=tai_abstracttypedconst(fvalues[pos]);
+       fvalues[pos]:=val;
+     end;
+
+
    procedure tai_aggregatetypedconst.finish;
      begin
        if fisstring then
@@ -1430,6 +1473,22 @@ implementation
      end;
 
 
+   procedure ttai_typedconstbuilder.check_add_placeholder(def: tdef);
+     begin
+       { it only makes sense to add a placeholder inside an aggregate
+         (otherwise there can be but one element)
+
+         we cannot add a placeholder in the middle of a queued expression
+         either
+
+         the placeholder cannot be an aggregate }
+       if not assigned(curagginfo) or
+          queue_is_active or
+          (aggregate_kind(def)<>tck_simple) then
+         internalerror(2015091001);
+     end;
+
+
    procedure ttai_typedconstbuilder.queue_init(todef: tdef);
      var
        info: taggregateinformation;
@@ -1609,6 +1668,28 @@ implementation
      end;
 
 
+   {****************************************************************************
+                         tlowleveltypedconstplaceholder
+   ****************************************************************************}
+
+   constructor tlowleveltypedconstplaceholder.create(l: tasmlist; pos: tai; d: tdef);
+     begin
+       inherited create(d);
+       list:=l;
+       insertpos:=pos;
+     end;
+
+
+   procedure tlowleveltypedconstplaceholder.replace(ai: tai; d: tdef);
+     begin
+       if d<>def then
+         internalerror(2015091001);
+       list.insertafter(ai,insertpos);
+       list.remove(insertpos);
+       insertpos.free;
+     end;
+
+
 {****************************************************************************
                            tai_abstracttypedconst
  ****************************************************************************}
@@ -1619,6 +1700,17 @@ implementation
      end;
 
 
+   function ttai_lowleveltypedconstbuilder.emit_placeholder(def: tdef): ttypedconstplaceholder;
+     var
+       p: tai;
+     begin
+       check_add_placeholder(def);
+       p:=tai_marker.Create(mark_position);
+       emit_tai(p,def);
+       result:=tlowleveltypedconstplaceholder.create(fasmlist,p,def);
+     end;
+
+
    procedure ttai_lowleveltypedconstbuilder.mark_anon_aggregate_alignment;
      var
        marker: tai_marker;

+ 50 - 0
compiler/llvm/nllvmtcon.pas

@@ -45,6 +45,13 @@ interface
       property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
     end;
 
+    tllvmtypedconstplaceholder = class(ttypedconstplaceholder)
+      agginfo: tllvmaggregateinformation;
+      pos: longint;
+      constructor create(info: tllvmaggregateinformation; p: longint; d: tdef);
+      procedure replace(ai: tai; d: tdef); override;
+    end;
+
     tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
      protected type
       public
@@ -88,6 +95,8 @@ interface
       procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
       procedure queue_emit_ordconst(value: int64; def: tdef); override;
 
+      function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
+
       class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
     end;
 
@@ -117,6 +126,31 @@ implementation
     end;
 
 
+   { tllvmtypedconstplaceholder }
+
+  constructor tllvmtypedconstplaceholder.create(info: tllvmaggregateinformation; p: longint; d: tdef);
+    begin
+      inherited create(d);
+      agginfo:=info;
+      pos:=p;
+    end;
+
+
+  procedure tllvmtypedconstplaceholder.replace(ai: tai; d: tdef);
+    var
+      oldconst: tai_abstracttypedconst;
+    begin
+      if d<>def then
+        internalerror(2015091002);
+      oldconst:=agginfo.aggai.replacevalueatpos(
+        tai_simpletypedconst.create(tck_simple,d,ai),pos
+      );
+      oldconst.free;
+    end;
+
+
+  { tllvmtai_typedconstbuilder }
+
   class constructor tllvmtai_typedconstbuilder.classcreate;
     begin
       caggregateinformation:=tllvmaggregateinformation;
@@ -576,6 +610,22 @@ implementation
     end;
 
 
+  function tllvmtai_typedconstbuilder.emit_placeholder(def: tdef): ttypedconstplaceholder;
+    var
+      pos: longint;
+    begin
+      check_add_placeholder(def);
+      { we can't support extended constants, because those are transformed into
+        an array of bytes, so we can't easily replace them afterwards }
+      if (def.typ=floatdef) and
+         (tfloatdef(def).floattype=s80real) then
+        internalerror(2015091003);
+      pos:=tllvmaggregateinformation(curagginfo).aggai.valuecount;
+      emit_tai(tai_marker.Create(mark_position),def);
+      result:=tllvmtypedconstplaceholder.create(tllvmaggregateinformation(curagginfo),pos,def);
+    end;
+
+
   class function tllvmtai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
     begin
       { LLVM does not support labels in the middle of a declaration }