Browse Source

* move the common sequence to build a VMT for an objectdef into a separate procedure (based on a patch by Blaise.ru)

git-svn-id: trunk@43674 -
svenbarth 5 years ago
parent
commit
bf5d75e594
4 changed files with 20 additions and 18 deletions
  1. 2 8
      compiler/jvm/pjvm.pas
  2. 16 0
      compiler/nobj.pas
  3. 1 6
      compiler/pdecl.pas
  4. 1 4
      compiler/pgenutil.pas

+ 2 - 8
compiler/jvm/pjvm.pas

@@ -140,7 +140,6 @@ implementation
 
 
     procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
     procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
       var
       var
-        vmtbuilder: tvmtbuilder;
         arrdef: tarraydef;
         arrdef: tarraydef;
         arrsym: ttypesym;
         arrsym: ttypesym;
         juhashmap: tdef;
         juhashmap: tdef;
@@ -319,9 +318,7 @@ implementation
 
 
         symtablestack.pop(enumclass.symtable);
         symtablestack.pop(enumclass.symtable);
 
 
-        vmtbuilder:=TVMTBuilder.Create(enumclass);
-        vmtbuilder.generate_vmt;
-        vmtbuilder.free;
+        build_vmt(enumclass);
 
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
         restore_after_new_class(sstate,islocal,oldsymtablestack);
         current_structdef:=old_current_structdef;
         current_structdef:=old_current_structdef;
@@ -330,7 +327,6 @@ implementation
 
 
     procedure jvm_create_procvar_class_intern(const name: TIDString; def: tdef; force_no_callback_intf: boolean);
     procedure jvm_create_procvar_class_intern(const name: TIDString; def: tdef; force_no_callback_intf: boolean);
       var
       var
-        vmtbuilder: tvmtbuilder;
         oldsymtablestack: tsymtablestack;
         oldsymtablestack: tsymtablestack;
         pvclass,
         pvclass,
         pvintf: tobjectdef;
         pvintf: tobjectdef;
@@ -429,9 +425,7 @@ implementation
 
 
         symtablestack.pop(pvclass.symtable);
         symtablestack.pop(pvclass.symtable);
 
 
-        vmtbuilder:=TVMTBuilder.Create(pvclass);
-        vmtbuilder.generate_vmt;
-        vmtbuilder.free;
+        build_vmt(pvclass);
 
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
         restore_after_new_class(sstate,islocal,oldsymtablestack);
       end;
       end;

+ 16 - 0
compiler/nobj.pas

@@ -54,6 +54,12 @@ interface
       end;
       end;
 
 
 
 
+{ convenince routine to build the VMT for an objectdef
+  Note: also ensures that the procdefs of the objectdef have their hidden
+  parameters inserted }
+procedure build_vmt(def:tobjectdef);
+
+
 implementation
 implementation
 
 
     uses
     uses
@@ -979,4 +985,14 @@ implementation
           end;
           end;
       end;
       end;
 
 
+
+    procedure build_vmt(def:tobjectdef);
+      var
+        vmtbuilder : TVMTBuilder;
+      begin
+        vmtbuilder:=TVMTBuilder.create(def);
+        vmtbuilder.generate_vmt;
+        vmtbuilder.free;
+      end;
+
 end.
 end.

+ 1 - 6
compiler/pdecl.pas

@@ -661,7 +661,6 @@ implementation
          istyperenaming : boolean;
          istyperenaming : boolean;
          generictypelist : tfphashobjectlist;
          generictypelist : tfphashobjectlist;
          generictokenbuf : tdynamicarray;
          generictokenbuf : tdynamicarray;
-         vmtbuilder : TVMTBuilder;
          p:tnode;
          p:tnode;
          gendef : tstoreddef;
          gendef : tstoreddef;
          s : shortstring;
          s : shortstring;
@@ -1088,11 +1087,7 @@ implementation
                     { Build VMT indexes, skip for type renaming and forward classes }
                     { Build VMT indexes, skip for type renaming and forward classes }
                     if (hdef.typesym=newtype) and
                     if (hdef.typesym=newtype) and
                        not(oo_is_forward in tobjectdef(hdef).objectoptions) then
                        not(oo_is_forward in tobjectdef(hdef).objectoptions) then
-                      begin
-                        vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
-                        vmtbuilder.generate_vmt;
-                        vmtbuilder.free;
-                      end;
+                      build_vmt(tobjectdef(hdef));
 
 
                     { In case of an objcclass, verify that all methods have a message
                     { In case of an objcclass, verify that all methods have a message
                       name set. We only check this now, because message names can be set
                       name set. We only check this now, because message names can be set

+ 1 - 4
compiler/pgenutil.pas

@@ -675,7 +675,6 @@ uses
         oldcurrent_filepos : tfileposinfo;
         oldcurrent_filepos : tfileposinfo;
         recordbuf : tdynamicarray;
         recordbuf : tdynamicarray;
         hadtypetoken : boolean;
         hadtypetoken : boolean;
-        vmtbuilder : tvmtbuilder;
         i,
         i,
         replaydepth : longint;
         replaydepth : longint;
         item : tobject;
         item : tobject;
@@ -1000,9 +999,7 @@ uses
                             consume(_SEMICOLON);
                             consume(_SEMICOLON);
                         end;
                         end;
 
 
-                      vmtbuilder:=TVMTBuilder.Create(tobjectdef(result));
-                      vmtbuilder.generate_vmt;
-                      vmtbuilder.free;
+                      build_vmt(tobjectdef(result));
                     end;
                     end;
                   { handle params, calling convention, etc }
                   { handle params, calling convention, etc }
                   procvardef:
                   procvardef: