Browse Source

* moved generation of vmt llvm type info from classrefdef to tobjectdef
(so we can also access it when we only have an objectdef)
- removed 'byval' uses, I don't think we need it after all

git-svn-id: branches/llvm@11401 -

Jonas Maebe 17 years ago
parent
commit
f76c76c060
3 changed files with 116 additions and 71 deletions
  1. 58 53
      compiler/llvmdef.pas
  2. 57 14
      compiler/symdef.pas
  3. 1 4
      compiler/symtype.pas

+ 58 - 53
compiler/llvmdef.pas

@@ -49,6 +49,7 @@ interface
         function def_llvm_name(def:tdef) : tasmsymbol;
         function def_llvm_name(def:tdef) : tasmsymbol;
         function def_llvm_pointer_name(def: tdef): tasmsymbol;
         function def_llvm_pointer_name(def: tdef): tasmsymbol;
         function def_llvm_class_struct_name(def:tobjectdef) : tasmsymbol;
         function def_llvm_class_struct_name(def:tobjectdef) : tasmsymbol;
+        function def_llvm_vmt_name(def:tobjectdef) : tasmsymbol;
       protected
       protected
         vardatadef: trecorddef;
         vardatadef: trecorddef;
 
 
@@ -63,7 +64,6 @@ interface
         procedure appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
         procedure appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
         procedure appenddef_record(list:TAsmList;def:trecorddef);override;
         procedure appenddef_record(list:TAsmList;def:trecorddef);override;
         procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
         procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
-        procedure appenddef_classref(list:TAsmList;def: tclassrefdef);override;
         procedure appenddef_string(list:TAsmList;def:tstringdef);override;
         procedure appenddef_string(list:TAsmList;def:tstringdef);override;
         procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
         procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
         procedure appendprocdef(list:TAsmList;def:tprocdef);override;
         procedure appendprocdef(list:TAsmList;def:tprocdef);override;
@@ -145,6 +145,13 @@ implementation
       end;
       end;
 
 
 
 
+    function TLLVMDefInfo.def_llvm_vmt_name(def:tobjectdef) : tasmsymbol;
+      begin
+        record_def(def);
+        result:=def.llvm_vmt_name_sym;
+      end;
+
+
     constructor TLLVMDefInfo.Create;
     constructor TLLVMDefInfo.Create;
       begin
       begin
         inherited Create;
         inherited Create;
@@ -347,52 +354,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure TLLVMDefInfo.appenddef_classref(list:TAsmList;def: tclassrefdef);
-      var
-        defstr: ansistring;
-        i: longint;
-      begin
-        { a pointer to the VMT. Structure of the VMT: }
-        {   InstanceSize  : ptrint  }
-        {   -InstanceSize : ptrint  }
-        {   Parent        : ^parent }
-        {   ClassName     : pointer }
-        {   DynamicTable  : pointer }
-        {   MethodTable   : pointer }
-        {   FieldTable    : pointer }
-        {   TypeInfo      : pointer }
-        {   InitTable     : pointer }
-        {   AutoTable     : pointer }
-        {   IntfTable     : pointer }
-        {   MsgStrTable   : pointer }
-        {   Methods       : X times procvar }
-        defstr:=def_llvm_name(ptrsinttype).name+', ';
-        defstr:='< '+defstr+defstr;
-{ needs to be pointer to the parent class' vmt!
-        if assigned(tobjectdef(def.pointeddef).childof) then
-          defstr:=defstr+def_llvm_name(tobjectdef(def.pointeddef).childof).name+'*,'
-        else
-}
-          defstr:=defstr+'void*, ';
-        { class name (length+string) }
-        defstr:=defstr+'['+tostr(length(tobjectdef(def.pointeddef).objrealname^)+1)+' x i8]*, ';
-        { the other fields }
-        for i:=1 to 8 do
-          defstr:=defstr+'void*, ';
-        if not assigned(tobjectdef(def.pointeddef).VMTEntries) then
-          with TVMTBuilder.Create(tobjectdef(def.pointeddef)) do
-            begin
-              generate_vmt;
-              free;
-            end;
-        for i:= 0 to tobjectdef(def.pointeddef).VMTEntries.Count-1 do
-          defstr:=defstr+def_llvm_pointer_name(tprocdef(tobjectdef(def.pointeddef).VMTEntries[i])).name+', ';
-        setlength(defstr,length(defstr)-2);
-        defstr:=defstr+' >*';
-        list.concat(taillvm.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr));
-      end;
-
-
     procedure TLLVMDefInfo.appenddef_string(list:TAsmList;def:tstringdef);
     procedure TLLVMDefInfo.appenddef_string(list:TAsmList;def:tstringdef);
 
 
       procedure addnormalstringdef(lendef: tdef);
       procedure addnormalstringdef(lendef: tdef);
@@ -472,16 +433,17 @@ implementation
               if paramanager.push_addr_param(varspez,vardef,def.proccalloption) then
               if paramanager.push_addr_param(varspez,vardef,def.proccalloption) then
                 begin
                 begin
                   result:=result+'*';
                   result:=result+'*';
+                  if (vo_is_funcret in varoptions) then
+                    result:=result+' sret';
+                end
+              else
+                begin
                   { 'byval' means that the parameter is copied onto the stack at the }
                   { 'byval' means that the parameter is copied onto the stack at the }
                   { right location at the caller side rather than that the calling   }
                   { right location at the caller side rather than that the calling   }
                   { conventions are used to determine whether the address or value   }
                   { conventions are used to determine whether the address or value   }
                   { of the parameter is passed                                       }
                   { of the parameter is passed                                       }
-                  { An array of const needs to be constructed on/copied to the call  }
-                  { stack                                                            }
-                  if is_array_of_const(vardef) then
-                    result:=result+' byval'
-                  else if (vo_is_funcret in varoptions) then
-                    result:=result+' sret';
+                  { I don't think we need this for something right now               }
+                  // result:=result+' byval'
                 end;
                 end;
               result:=result+', '
               result:=result+', '
             end;
             end;
@@ -976,6 +938,48 @@ implementation
           appenddef_abstractrecord(list,def);
           appenddef_abstractrecord(list,def);
         end;
         end;
 
 
+      procedure doappend_classvmt;
+        var
+          defstr: ansistring;
+          i: longint;
+        begin
+          { a pointer to the VMT. Structure of the VMT: }
+          {   InstanceSize  : ptrint  }
+          {   -InstanceSize : ptrint  }
+          {   Parent        : ^parent }
+          {   ClassName     : pointer }
+          {   DynamicTable  : pointer }
+          {   MethodTable   : pointer }
+          {   FieldTable    : pointer }
+          {   TypeInfo      : pointer }
+          {   InitTable     : pointer }
+          {   AutoTable     : pointer }
+          {   IntfTable     : pointer }
+          {   MsgStrTable   : pointer }
+          {   Methods       : X times procvar }
+          defstr:=def_llvm_name(ptrsinttype).name+', ';
+          defstr:='< '+defstr+defstr;
+          if assigned(def.childof) then
+            defstr:=defstr+def_llvm_vmt_name(def.childof).name+'*, '
+          else
+            defstr:=defstr+'void*, ';
+          { class name (length+string) }
+          defstr:=defstr+'['+tostr(length(def.objrealname^)+1)+' x i8]*, ';
+          { the other fields }
+          for i:=1 to 8 do
+            defstr:=defstr+'void*, ';
+          if not assigned(def.VMTEntries) then
+            with TVMTBuilder.create(def) do
+              begin
+                generate_vmt;
+                free;
+              end;
+          for i:= 0 to def.VMTEntries.Count-1 do
+            defstr:=defstr+def_llvm_pointer_name(tprocdef(def.VMTEntries[i])).name+', ';
+          setlength(defstr,length(defstr)-2);
+          defstr:=defstr+' >*';
+          list.concat(taillvm.op_ressym_string(LA_TYPE,def_llvm_vmt_name(def),defstr));
+        end;
 
 
       begin
       begin
         case def.objecttype of
         case def.objecttype of
@@ -990,6 +994,7 @@ implementation
               { implicit pointer }
               { implicit pointer }
               list.concat(taillvm.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_class_struct_name(def).name+'*'));
               list.concat(taillvm.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_class_struct_name(def).name+'*'));
               doappend;
               doappend;
+              doappend_classvmt;
             end;
             end;
           else
           else
             internalerror(200602041);
             internalerror(200602041);

+ 57 - 14
compiler/symdef.pas

@@ -85,13 +85,13 @@ interface
           function is_fpuregable : boolean;
           function is_fpuregable : boolean;
           { generics }
           { generics }
           procedure initgeneric;
           procedure initgeneric;
-       private
+       protected
 {$ifdef support_llvm}
 {$ifdef support_llvm}
-          procedure set_llvm_name_syms;
+          procedure set_llvm_name_syms; virtual;
           function get_llvm_name_sym: tasmsymbol;override;
           function get_llvm_name_sym: tasmsymbol;override;
           function get_llvm_pointer_name_sym: tasmsymbol;override;
           function get_llvm_pointer_name_sym: tasmsymbol;override;
-          function get_llvm_class_struct_name_sym: tasmsymbol;override;
 {$endif support_llvm}
 {$endif support_llvm}
+       private
           savesize  : aint;
           savesize  : aint;
        end;
        end;
 
 
@@ -242,6 +242,14 @@ interface
        { tobjectdef }
        { tobjectdef }
 
 
        tobjectdef = class(tabstractrecorddef)
        tobjectdef = class(tabstractrecorddef)
+{$ifdef support_llvm}
+       private
+          fllvm_class_struct_name_sym : tasmsymbol;
+          fllvm_vmt_name_sym : tasmsymbol;
+          procedure set_llvm_name_syms; override;
+          function get_llvm_class_struct_name_sym: tasmsymbol;
+          function get_llvm_vmt_name_sym: tasmsymbol;
+{$endif}
        public
        public
           dwarf_struct_lab : tasmsymbol;
           dwarf_struct_lab : tasmsymbol;
           childof        : tobjectdef;
           childof        : tobjectdef;
@@ -285,6 +293,10 @@ interface
           procedure set_parent(c : tobjectdef);
           procedure set_parent(c : tobjectdef);
           function FindDestructor : tprocdef;
           function FindDestructor : tprocdef;
           function implements_any_interfaces: boolean;
           function implements_any_interfaces: boolean;
+{$ifdef support_llvm}
+          property llvm_class_struct_name_sym: tasmsymbol read get_llvm_class_struct_name_sym;
+          property llvm_vmt_name_sym: tasmsymbol read get_llvm_vmt_name_sym;
+{$endif support_llvm}
        end;
        end;
 
 
        tclassrefdef = class(tabstractpointerdef)
        tclassrefdef = class(tabstractpointerdef)
@@ -293,6 +305,10 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function GetTypeName:string;override;
           function GetTypeName:string;override;
           function  is_publishable : boolean;override;
           function  is_publishable : boolean;override;
+{$ifdef support_llvm}
+       protected
+          procedure set_llvm_name_syms; override;
+{$endif}
        end;
        end;
 
 
        tarraydef = class(tstoreddef)
        tarraydef = class(tstoreddef)
@@ -968,9 +984,9 @@ implementation
       begin
       begin
         if assigned(typesym) and
         if assigned(typesym) and
            (owner.symtabletype in [staticsymtable,globalsymtable]) then
            (owner.symtabletype in [staticsymtable,globalsymtable]) then
-          result:=make_mangledname('llvm',owner,typesym.name)
+          result:=make_mangledname('llvm$$$',owner,typesym.name)
         else
         else
-          result:=make_mangledname('llvm',findunitsymtable(owner),'DEF'+tostr(DefId));
+          result:=make_mangledname('llvm$$$',findunitsymtable(owner),'DEF'+tostr(DefId));
         result:='%'+result;
         result:='%'+result;
       end;
       end;
 {$endif support_llvm}
 {$endif support_llvm}
@@ -1138,8 +1154,6 @@ implementation
           begin
           begin
             fllvm_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname,AB_LOCAL,AT_DATA);
             fllvm_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname,AB_LOCAL,AT_DATA);
             fllvm_pointer_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'*',AB_LOCAL,AT_DATA);
             fllvm_pointer_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'*',AB_LOCAL,AT_DATA);
-            if is_class_or_interface_or_dispinterface(self) then
-              fllvm_class_struct_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'$$$struct',AB_LOCAL,AT_DATA);
           end;
           end;
       end;
       end;
 
 
@@ -1156,13 +1170,6 @@ implementation
         set_llvm_name_syms;
         set_llvm_name_syms;
         result:=fllvm_pointer_name_sym;
         result:=fllvm_pointer_name_sym;
       end;
       end;
-
-
-    function tstoreddef.get_llvm_class_struct_name_sym: tasmsymbol;
-      begin
-        set_llvm_name_syms;
-        result:=fllvm_class_struct_name_sym;
-      end;
 {$endif support_llvm}
 {$endif support_llvm}
 
 
 
 
@@ -2120,6 +2127,15 @@ implementation
       end;
       end;
 
 
 
 
+{$ifdef support_llvm}
+    procedure tclassrefdef.set_llvm_name_syms;
+      begin
+        tobjectdef(pointeddef).set_llvm_name_syms;
+        fllvm_name_sym:=tobjectdef(pointeddef).llvm_vmt_name_sym;
+        fllvm_pointer_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'*',AB_LOCAL,AT_DATA);
+      end;
+{$endif support_llvm}
+
 {***************************************************************************
 {***************************************************************************
                                    TSETDEF
                                    TSETDEF
 ***************************************************************************}
 ***************************************************************************}
@@ -4249,6 +4265,33 @@ implementation
       end;
       end;
 
 
 
 
+{$ifdef support_llvm}
+    procedure tobjectdef.set_llvm_name_syms;
+      begin
+        inherited set_llvm_name_syms;
+        if not assigned(fllvm_class_struct_name_sym) and
+           is_class_or_interface_or_dispinterface(self) then
+          begin
+            fllvm_class_struct_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'$$$struct',AB_LOCAL,AT_DATA);
+            fllvm_vmt_name_sym:=current_asmdata.DefineAsmSymbol(llvm_mangledname+'$$$vmt',AB_LOCAL,AT_DATA);
+          end;
+      end;
+
+
+    function tobjectdef.get_llvm_class_struct_name_sym: tasmsymbol;
+      begin
+        set_llvm_name_syms;
+        result:=fllvm_class_struct_name_sym;
+      end;
+
+
+    function tobjectdef.get_llvm_vmt_name_sym: tasmsymbol;
+      begin
+        set_llvm_name_syms;
+        result:=fllvm_vmt_name_sym;
+      end;
+{$endif support_llvm}
+
 {****************************************************************************
 {****************************************************************************
                              TImplementedInterface
                              TImplementedInterface
 ****************************************************************************}
 ****************************************************************************}

+ 1 - 4
compiler/symtype.pas

@@ -66,8 +66,7 @@ interface
         protected
         protected
          fllvm_name_sym,
          fllvm_name_sym,
          { so we don't have to create pointerdefs all the time }
          { so we don't have to create pointerdefs all the time }
-         fllvm_pointer_name_sym,
-         fllvm_class_struct_name_sym : tasmsymbol;
+         fllvm_pointer_name_sym: tasmsymbol;
         public
         public
 {$endif support_llvm}
 {$endif support_llvm}
          constructor create(dt:tdeftyp);
          constructor create(dt:tdeftyp);
@@ -97,11 +96,9 @@ interface
         protected
         protected
          function get_llvm_name_sym: tasmsymbol;virtual;abstract;
          function get_llvm_name_sym: tasmsymbol;virtual;abstract;
          function get_llvm_pointer_name_sym: tasmsymbol;virtual;abstract;
          function get_llvm_pointer_name_sym: tasmsymbol;virtual;abstract;
-         function get_llvm_class_struct_name_sym: tasmsymbol;virtual;abstract;
         public
         public
          property llvm_name_sym: tasmsymbol read get_llvm_name_sym;
          property llvm_name_sym: tasmsymbol read get_llvm_name_sym;
          property llvm_pointername_sym: tasmsymbol read get_llvm_pointer_name_sym;
          property llvm_pointername_sym: tasmsymbol read get_llvm_pointer_name_sym;
-         property llvm_class_struct_name_sym: tasmsymbol read get_llvm_class_struct_name_sym;
 {$endif support_llvm}
 {$endif support_llvm}
       end;
       end;