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);
      procedure addvalue(val: tai_abstracttypedconst);
      function valuecount: longint;
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
+     function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
      procedure finish;
      procedure finish;
      destructor destroy; override;
      destructor destroy; override;
    end;
    end;
@@ -168,6 +169,14 @@ type
    end;
    end;
    taggregateinformationclass = class of taggregateinformation;
    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,
    { Warning: never directly create a ttai_typedconstbuilder instance,
      instead create a cai_typedconstbuilder (this class can be overridden) }
      instead create a cai_typedconstbuilder (this class can be overridden) }
    ttai_typedconstbuilder = class abstract
    ttai_typedconstbuilder = class abstract
@@ -327,6 +336,16 @@ type
      function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
      function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
      function end_anonymous_record: 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.
      { The next group of routines are for constructing complex expressions.
        While parsing a typed constant these operators are encountered from
        While parsing a typed constant these operators are encountered from
        outer to inner, so that is also the order in which they should be
        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;
      property anonrecmarker: tai read fanonrecmarker write fanonrecmarker;
    end;
    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)
    ttai_lowleveltypedconstbuilder = class(ttai_typedconstbuilder)
     protected
     protected
      procedure mark_anon_aggregate_alignment; override;
      procedure mark_anon_aggregate_alignment; override;
@@ -404,6 +430,7 @@ type
     public
     public
      { set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
      { set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
      class constructor classcreate;
      class constructor classcreate;
+     function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
    end;
    end;
 
 
    var
    var
@@ -508,6 +535,15 @@ implementation
       end;
       end;
 
 
 
 
+{****************************************************************************
+                             ttypedconstplaceholder
+ ****************************************************************************}
+
+    constructor ttypedconstplaceholder.create(d: tdef);
+      begin
+        def:=d;
+      end;
+
 {****************************************************************************
 {****************************************************************************
                             tai_abstracttypedconst
                             tai_abstracttypedconst
  ****************************************************************************}
  ****************************************************************************}
@@ -685,6 +721,13 @@ implementation
      end;
      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;
    procedure tai_aggregatetypedconst.finish;
      begin
      begin
        if fisstring then
        if fisstring then
@@ -1430,6 +1473,22 @@ implementation
      end;
      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);
    procedure ttai_typedconstbuilder.queue_init(todef: tdef);
      var
      var
        info: taggregateinformation;
        info: taggregateinformation;
@@ -1609,6 +1668,28 @@ implementation
      end;
      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
                            tai_abstracttypedconst
  ****************************************************************************}
  ****************************************************************************}
@@ -1619,6 +1700,17 @@ implementation
      end;
      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;
    procedure ttai_lowleveltypedconstbuilder.mark_anon_aggregate_alignment;
      var
      var
        marker: tai_marker;
        marker: tai_marker;

+ 50 - 0
compiler/llvm/nllvmtcon.pas

@@ -45,6 +45,13 @@ interface
       property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
       property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
     end;
     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)
     tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
      protected type
      protected type
       public
       public
@@ -88,6 +95,8 @@ interface
       procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
       procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
       procedure queue_emit_ordconst(value: int64; 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;
       class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
     end;
     end;
 
 
@@ -117,6 +126,31 @@ implementation
     end;
     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;
   class constructor tllvmtai_typedconstbuilder.classcreate;
     begin
     begin
       caggregateinformation:=tllvmaggregateinformation;
       caggregateinformation:=tllvmaggregateinformation;
@@ -576,6 +610,22 @@ implementation
     end;
     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;
   class function tllvmtai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
     begin
     begin
       { LLVM does not support labels in the middle of a declaration }
       { LLVM does not support labels in the middle of a declaration }