Browse Source

* fixed several VMT element types to correspond to the types used to
construct the VMT def in the VMT builder in r30950

git-svn-id: trunk@31063 -

Jonas Maebe 10 years ago
parent
commit
3597e710b6
1 changed files with 27 additions and 10 deletions
  1. 27 10
      compiler/ncgvmt.pas

+ 27 - 10
compiler/ncgvmt.pas

@@ -769,8 +769,12 @@ implementation
         end;
         end;
 
 
         { IIDStr }
         { IIDStr }
-        tcb.emit_tai(Tai_const.CreateName(
-          make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),AT_DATA,0),getpointerdef(getarraydef(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1)));
+        tcb.queue_init(getpointerdef(cshortstringtype));
+        tcb.queue_emit_asmsym(
+          current_asmdata.RefAsmSymbol(
+            make_mangledname('IIDSTR',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),
+            AT_DATA),
+          getpointerdef(getarraydef(cansichartype,length(AImplIntf.IntfDef.iidstr^)+1)));
         { IType }
         { IType }
         tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef);
         tcb.emit_ord_const(aint(AImplIntf.VtblImplIntf.IType),interfaceentrytypedef);
         tcb.maybe_end_aggregate(interfaceentrydef);
         tcb.maybe_end_aggregate(interfaceentrydef);
@@ -1037,6 +1041,9 @@ implementation
          interfacetabledef,
          interfacetabledef,
          strmessagetabledef,
          strmessagetabledef,
          intmessagetabledef: trecorddef;
          intmessagetabledef: trecorddef;
+         parentvmtdef: tdef;
+         pinterfacetabledef,
+         pstringmessagetabledef: tdef;
       begin
       begin
 {$ifdef WITHDMT}
 {$ifdef WITHDMT}
          dmtlabel:=gendmt;
          dmtlabel:=gendmt;
@@ -1109,22 +1116,27 @@ implementation
          { but this is not used in FPC ? (PM) }
          { but this is not used in FPC ? (PM) }
          { it's not used yet, but the delphi-operators as and is need it (FK) }
          { it's not used yet, but the delphi-operators as and is need it (FK) }
          { it is not written for parents that don't have any vmt !! }
          { it is not written for parents that don't have any vmt !! }
+         if is_class(_class) then
+           parentvmtdef:=getpointerdef(search_system_type('TVMT').typedef)
+         else
+           parentvmtdef:=voidpointertype;
          if assigned(_class.childof) and
          if assigned(_class.childof) and
             (oo_has_vmt in _class.childof.objectoptions) then
             (oo_has_vmt in _class.childof.objectoptions) then
            begin
            begin
-             tcb.queue_init(voidpointertype);
+             tcb.queue_init(parentvmtdef);
              tcb.queue_emit_asmsym(
              tcb.queue_emit_asmsym(
                current_asmdata.RefAsmSymbol(_class.childof.vmt_mangledname,AT_DATA),
                current_asmdata.RefAsmSymbol(_class.childof.vmt_mangledname,AT_DATA),
                tfieldvarsym(_class.childof.vmt_field).vardef);
                tfieldvarsym(_class.childof.vmt_field).vardef);
            end
            end
          else
          else
-           tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+           tcb.emit_tai(Tai_const.Create_nil_dataptr,parentvmtdef);
 
 
          { write extended info for classes, for the order see rtl/inc/objpash.inc }
          { write extended info for classes, for the order see rtl/inc/objpash.inc }
          if is_class(_class) then
          if is_class(_class) then
           begin
           begin
             { pointer to class name string }
             { pointer to class name string }
-            tcb.emit_tai(Tai_const.Create_sym(classnamelabel),getpointerdef(classnamedef));
+            tcb.queue_init(getpointerdef(cshortstringtype));
+            tcb.queue_emit_asmsym(classnamelabel,classnamedef);
             { pointer to dynamic table or nil }
             { pointer to dynamic table or nil }
             if (oo_has_msgint in _class.objectoptions) then
             if (oo_has_msgint in _class.objectoptions) then
               begin
               begin
@@ -1159,23 +1171,28 @@ implementation
             { auto table }
             { auto table }
             tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
             tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
             { interface table }
             { interface table }
+            pinterfacetabledef:=search_system_type('PINTERFACETABLE').typedef;
             if _class.ImplementedInterfaces.count>0 then
             if _class.ImplementedInterfaces.count>0 then
               begin
               begin
-                tcb.queue_init(voidpointertype);
+                tcb.queue_init(pinterfacetabledef);
                 tcb.queue_emit_asmsym(interfacetable,interfacetabledef)
                 tcb.queue_emit_asmsym(interfacetable,interfacetabledef)
               end
               end
             else if _class.implements_any_interfaces then
             else if _class.implements_any_interfaces then
-              tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
+              tcb.emit_tai(Tai_const.Create_nil_dataptr,pinterfacetabledef)
             else
             else
-              tcb.emit_tai(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA)),voidpointertype);
+              begin
+                tcb.queue_init(pinterfacetabledef);
+                tcb.queue_emit_asmsym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF',AT_DATA),ptruinttype);
+              end;
             { table for string messages }
             { table for string messages }
+            pstringmessagetabledef:=search_system_type('PSTRINGMESSAGETABLE').typedef;
             if (oo_has_msgstr in _class.objectoptions) then
             if (oo_has_msgstr in _class.objectoptions) then
               begin
               begin
                 tcb.queue_init(voidpointertype);
                 tcb.queue_init(voidpointertype);
-                tcb.queue_emit_asmsym(strmessagetable,strmessagetabledef);
+                tcb.queue_emit_asmsym(strmessagetable,pstringmessagetabledef);
               end
               end
             else
             else
-              tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+              tcb.emit_tai(Tai_const.Create_nil_dataptr,pstringmessagetabledef);
           end;
           end;
          { write virtual methods }
          { write virtual methods }
          writevirtualmethods(tcb);
          writevirtualmethods(tcb);