* added vmt_offsets in destructors code also !!!

  * vmt_offset code for m68k

compiler/cg68kcal.pas

@@ -656,6 +656,7 @@ implementation
                                          new(r);
                                          reset_reference(r^);
                                          r^.base:=R_A5;
+                                         r^.offset:= p^.procdefinition^._class^.vmt_offset;
                                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
                                       end;
 
@@ -697,6 +698,7 @@ implementation
                              new(r);
                              reset_reference(r^);
                              r^.base:=R_A5;
+                             r^.offset:= p^.procdefinition^._class^.vmt_offset;
                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
                           end
                         else
@@ -795,6 +797,7 @@ implementation
                             new(r);
                             reset_reference(r^);
                             r^.base:=R_a5;
+                            r^.offset:= p^.procdefinition^._class^.vmt_offset;
                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
                             new(r);
                             reset_reference(r^);
@@ -1049,7 +1052,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1998-10-15 12:41:16  pierre
+  Revision 1.11  1998-10-16 13:12:46  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.10  1998/10/15 12:41:16  pierre
     * last memory leaks found when compiler
       a native atari compiler fixed
 

compiler/cg68kinl.pas

@@ -604,6 +604,8 @@ implementation
                         p^.location.loc:=LOC_REGISTER;
                         p^.location.register:=getregister32;
                         { load VMT pointer }
+                        inc(p^.left^.location.reference.offset,
+                          pobjectdef(p^.left^.resulttype)^.vmt_offset);
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                           newreference(p^.left^.location.reference),
                           p^.location.register)));
@@ -895,7 +897,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1998-10-14 16:53:04  pierre
+  Revision 1.11  1998-10-16 13:12:47  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.10  1998/10/14 16:53:04  pierre
    * bug in in_inc_x for constants out of range for A_ADDQ fixed
 
   Revision 1.9  1998/10/14 11:28:20  florian

compiler/cga68k.pas

@@ -742,6 +742,7 @@ begin
          begin
            procinfo.aktexitcode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
              newcsymbol('FPC_HELP_DESTRUCTOR',0))));
+           procinfo.aktexitcode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,procinfo._class^.vmt_offset,R_D0)));
            concat_external('FPC_HELP_DESTRUCTOR',EXT_NEAR);
          end;
      end;
@@ -1345,7 +1346,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.24  1998-10-15 12:37:42  pierre
+  Revision 1.25  1998-10-16 13:12:48  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.24  1998/10/15 12:37:42  pierre
     + passes vmt offset to HELP_CONSTRUCTOR for objects
 
   Revision 1.23  1998/10/14 11:28:22  florian

compiler/pdecl.pas

@@ -1164,13 +1164,12 @@ unit pdecl;
                    }
                    if (childof^.options and oo_isforward)<>0 then
                      Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^);
-                   fd^.childof:=childof;
                    aktclass:=fd;
-                   { ajust the size, because the child could be also
-                     forward defined
-                   }
-                   aktclass^.publicsyms^.datasize:=
-                     aktclass^.publicsyms^.datasize-4+childof^.publicsyms^.datasize;
+                   { we must inherit several options !!
+                     this was missing !!
+                     all is now done in set_parent
+                     including symtable datasize setting PM }
+                   fd^.set_parent(childof);
                 end
               else
                 aktclass:=new(pobjectdef,init(n,childof));
@@ -2065,7 +2064,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.71  1998-10-15 15:13:25  pierre
+  Revision 1.72  1998-10-16 13:12:51  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.71  1998/10/15 15:13:25  pierre
     + added oo_hasconstructor and oo_hasdestructor
       for objects options
 

compiler/symdef.inc

@@ -2528,35 +2528,50 @@
      begin
         tdef.init;
         deftype:=objectdef;
-        childof:=c;
         options:=0;
         vmt_offset:=0;
-        { some options are inherited !! }
-        if assigned(c) then
-          options:= c^.options and
-                    (oo_hasvirtual or oo_hasprivate or
-                     oo_hasprotected or
-                     oo_hasconstructor or oo_hasdestructor
-                     {or oo_can_have_published treated in pdecl }
-                     );
-        { privatesyms:=new(psymtable,init(objectsymtable));
-      protectedsyms:=new(psymtable,init(objectsymtable)); }
         publicsyms:=new(psymtable,init(objectsymtable));
+        publicsyms^.name := stringdup(n);
         { create space for vmt !! }
         publicsyms^.datasize:=Sizeof(pointer);
-        publicsyms^.name := stringdup(n);
-        { add the data of the anchestor class }
-        if assigned(childof) then
-          begin
-             publicsyms^.datasize:=
-               publicsyms^.datasize-SizeOf(pointer)+childof^.publicsyms^.datasize;
-          end;
-        name:=stringdup(n);
-        savesize := publicsyms^.datasize;
+        options:=oo_hasvmt;
         publicsyms^.defowner:=@self;
+        set_parent(c);
+        name:=stringdup(n);
      end;
 
 
+    procedure tobjectdef.set_parent( c : pobjectdef);
+      begin
+        { nothing to do if the parent was not forward !}
+        if assigned(childof) then
+          exit;
+        childof:=c;
+        { some options are inherited !! }
+        if assigned(c) then
+          begin
+             options:= options or (c^.options and
+                    (oo_hasvirtual or oo_hasprivate or
+                     oo_hasprotected or
+                     oo_hasconstructor or oo_hasdestructor
+                     ));
+             { add the data of the anchestor class }
+             publicsyms^.datasize:=publicsyms^.datasize
+               +childof^.publicsyms^.datasize;
+             if ((options and oo_hasvmt)<>0) and
+                ((c^.options and oo_hasvmt)<>0) then
+               publicsyms^.datasize:=publicsyms^.datasize-Sizeof(pointer);
+             { if parent has a vmt field then
+               the offset is the same for the child PM }
+             if ((c^.options and oo_hasvmt)<>0) then
+               begin
+                  vmt_offset:=c^.vmt_offset;
+                  options:=options or oo_hasvmt;
+               end;
+          end;
+        savesize := publicsyms^.datasize;
+      end;
+      
     constructor tobjectdef.load;
       var
          oldread_member : boolean;
@@ -2587,6 +2602,22 @@
        end;
 
 
+   procedure tobjectdef.insertvmt;
+     begin
+        if (options and oo_hasvmt)<>0 then
+          internalerror(12345)
+        else
+          begin
+             { first round up to multiple of 4 }
+             if (publicsyms^.datasize mod 4) <> 0 then
+               publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
+             vmt_offset:=publicsyms^.datasize;
+             publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
+             options:=options and oo_hasvmt;
+          end;
+          
+     end;
+     
    procedure tobjectdef.check_forwards;
      begin
         publicsyms^.check_forwards;
@@ -3088,7 +3119,11 @@
 
 {
   $Log$
-  Revision 1.59  1998-10-16 08:51:51  peter
+  Revision 1.60  1998-10-16 13:12:53  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.59  1998/10/16 08:51:51  peter
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries
 

compiler/symdefh.inc

@@ -177,6 +177,8 @@
           function vmt_mangledname : string;
           function rtti_name : string;
           function isclass : boolean;
+          procedure insertvmt;
+          procedure set_parent(c : pobjectdef);
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
@@ -478,7 +480,11 @@
 
 {
   $Log$
-  Revision 1.4  1998-10-16 08:51:52  peter
+  Revision 1.5  1998-10-16 13:12:55  pierre
+    * added vmt_offsets in destructors code also !!!
+    * vmt_offset code for m68k
+
+  Revision 1.4  1998/10/16 08:51:52  peter
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries