Forráskód Böngészése

+ support for parsing structured data for which no tdef is available in
advance (e.g. ansistring constants, as they consist of a header
followed by an array of char equal to the string length, or RTTI data)
o use begin_anonymous_record() to start recording the field types (if
necessary for the current target), and end_anonymous_record() at the
end to generate the recorddef

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

Jonas Maebe 11 éve
szülő
commit
7a10959aa0
2 módosított fájl, 86 hozzáadás és 19 törlés
  1. 32 3
      compiler/aasmcnst.pas
  2. 54 16
      compiler/llvm/nllvmtcon.pas

+ 32 - 3
compiler/aasmcnst.pas

@@ -40,6 +40,8 @@ type
 
    { the type of the element and its def }
    tai_abstracttypedconst = class abstract (tai)
+    private
+     procedure setdef(def: tdef);
     protected
      fadetyp: ttypedconstkind;
      { the def of this element }
@@ -47,7 +49,7 @@ type
     public
      constructor create(_adetyp: ttypedconstkind; _def: tdef);
      property adetyp: ttypedconstkind read fadetyp;
-     property def: tdef read fdef;
+     property def: tdef read fdef write setdef;
    end;
 
    { a simple data element; the value is stored as a tai }
@@ -130,6 +132,13 @@ type
      { end a potential aggregate type. Must be paired with every
        maybe_begin_aggregate }
      procedure maybe_end_aggregate(def: tdef); virtual;
+     { similar as above, but in case
+        a) it's definitely a record
+        b) the def of the record should be automatically constructed based on
+           the types of the emitted fields
+     }
+     procedure begin_anonymous_record; virtual;
+     function end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef; virtual;
 
      { The next group of routines are for constructing complex expressions.
        While parsing a typed constant these operators are encountered from
@@ -179,14 +188,22 @@ type
 implementation
 
    uses
-     verbose,globals,systems,
-     defutil;
+     verbose,globals,systems,widestr,
+     symtable,defutil;
 
 
 {****************************************************************************
                             tai_abstracttypedconst
  ****************************************************************************}
 
+   procedure tai_abstracttypedconst.setdef(def: tdef);
+     begin
+       { should not be changed, rewrite the calling code if this happens }
+       if assigned(fdef) then
+         Internalerror(2014080203);
+       fdef:=def;
+     end;
+
    constructor tai_abstracttypedconst.create(_adetyp: ttypedconstkind; _def: tdef);
      begin
        inherited create;
@@ -496,6 +513,18 @@ implementation
        { do nothing }
      end;
 
+   procedure ttai_lowleveltypedconstbuilder.begin_anonymous_record;
+     begin
+       { do nothing }
+     end;
+
+
+   function ttai_lowleveltypedconstbuilder.end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef;
+     begin
+       { do nothing }
+       result:=nil;
+     end;
+
 
    procedure ttai_lowleveltypedconstbuilder.queue_init(todef: tdef);
      begin

+ 54 - 16
compiler/llvm/nllvmtcon.pas

@@ -53,6 +53,7 @@ interface
       procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
       procedure emit_tai_intern(p: tai; def: tdef; procvar2procdef: boolean);
       function wrap_with_type(p: tai; def: tdef): tai;
+      procedure begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
      public
       constructor create; override;
       destructor destroy; override;
@@ -60,6 +61,8 @@ interface
       procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
       procedure maybe_begin_aggregate(def: tdef); override;
       procedure maybe_end_aggregate(def: tdef); override;
+      procedure begin_anonymous_record; override;
+      function end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef; override;
       procedure queue_init(todef: tdef); override;
       procedure queue_vecn(def: tdef; const index: tconstexprint); override;
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@@ -76,8 +79,7 @@ implementation
     verbose,
     aasmdata,
     cpubase,llvmbase,
-    symtable,llvmdef,defutil;
-
+    symbase,symtable,llvmdef,defutil;
 
   procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean);
     var
@@ -173,6 +175,24 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
+    var
+      agg: tai_aggregatetypedconst;
+    begin
+      if not assigned(faggregates) then
+        faggregates:=tfplist.create;
+      agg:=tai_aggregatetypedconst.create(tck,def);
+      { nested aggregate -> add to parent }
+      if faggregates.count>0 then
+        tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(agg)
+      { otherwise add to asmlist }
+      else
+        fasmlist.concat(agg);
+      { new top level aggregate, future data will be added to it }
+      faggregates.add(agg);
+    end;
+
+
   constructor tllvmtai_typedconstbuilder.create;
     begin
       inherited create;
@@ -202,24 +222,11 @@ implementation
 
   procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
     var
-      agg: tai_aggregatetypedconst;
       tck: ttypedconstkind;
     begin
       tck:=aggregate_kind(def);
       if tck<>tck_simple then
-        begin
-          if not assigned(faggregates) then
-            faggregates:=tfplist.create;
-          agg:=tai_aggregatetypedconst.create(tck,def);
-          { nested aggregate -> add to parent }
-          if faggregates.count>0 then
-            tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(agg)
-          { otherwise add to asmlist }
-          else
-            fasmlist.concat(agg);
-          { new top level aggregate, future data will be added to it }
-          faggregates.add(agg);
-        end;
+        begin_aggregate_intern(tck,def);
       inherited;
     end;
 
@@ -239,6 +246,37 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.begin_anonymous_record;
+    begin
+      inherited;
+      begin_aggregate_intern(tck_record,nil);
+    end;
+
+
+  function tllvmtai_typedconstbuilder.end_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef;
+    var
+      agg: tai_aggregatetypedconst;
+      ele: tai_abstracttypedconst;
+      defs: tfplist;
+    begin
+      result:=inherited;
+      if assigned(result) then
+        exit;
+      if not assigned(faggregates) or
+         (faggregates.count=0) then
+        internalerror(2014080201);
+      agg:=tai_aggregatetypedconst(faggregates[faggregates.count-1]);
+      defs:=tfplist.create;
+      for ele in agg do
+        defs.add(ele.def);
+      result:=crecorddef.create_global_from_deflist(optionalname,defs,packrecords);
+      agg.def:=result;
+      { already added to the asmlist if necessary }
+      faggregates.count:=faggregates.count-1;
+      inherited;
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
     begin
       inherited;