+ rtti generation for classes added

  + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray

compiler/cg386mem.pas

@@ -117,8 +117,11 @@ implementation
 *****************************************************************************}
 
     procedure secondsimplenewdispose(var p : ptree);
+
       var
          pushed : tpushed;
+         r : preference;
+
       begin
          secondpass(p^.left);
          if codegenerror then
@@ -134,21 +137,53 @@ implementation
               p^.left^.location.register)));
             LOC_REFERENCE:
               emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-
          end;
 
          { call the mem handling procedures }
          case p^.treetype of
            simpledisposen:
-             emitcall('FREEMEM',true);
+             begin
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                  begin
+                     new(r);
+                     reset_reference(r^);
+                     r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_label));
+                     emitpushreferenceaddr(exprasmlist,r^);
+                     { push pointer adress }
+                     case p^.left^.location.loc of
+                        LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
+                          p^.left^.location.register)));
+                        LOC_REFERENCE:
+                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     end;
+                     emitcall('FINALIZE',true);
+                  end;
+                emitcall('FREEMEM',true);
+             end;
            simplenewn:
-             emitcall('GETMEM',true);
+             begin
+                emitcall('GETMEM',true);
+                if ppointerdef(p^.left^.resulttype)^.definition^.needs_rtti then
+                  begin
+                     new(r);
+                     reset_reference(r^);
+                     r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_label));
+                     emitpushreferenceaddr(exprasmlist,r^);
+                     { push pointer adress }
+                     case p^.left^.location.loc of
+                        LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
+                          p^.left^.location.register)));
+                        LOC_REFERENCE:
+                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     end;
+                     emitcall('INITIALIZE',true);
+                  end;
+             end;
          end;
-
          popusedregisters(pushed);
-           { may be load ESI }
-           maybe_loadesi;
-       end;
+         { may be load ESI }
+         maybe_loadesi;
+      end;
 
 
 {*****************************************************************************
@@ -608,7 +643,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  1998-08-20 11:27:40  michael
+  Revision 1.8  1998-08-23 21:04:34  florian
+    + rtti generation for classes added
+    + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
+
+  Revision 1.7  1998/08/20 11:27:40  michael
   * Applied Peters Fix
 
   Revision 1.6  1998/08/10 14:49:49  peter

compiler/mppc386.bat

@@ -1,4 +1,4 @@
-ppc386 -Ch8000000 -dI386 -dGDB -O2p5 -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9
+ppc386 -Ch8000000 -dI386 -dGDB -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9
 if errorlevel 0 goto success
 goto failed
 :success

compiler/pdecl.pas

@@ -925,6 +925,8 @@ unit pdecl;
          hp1        : pdef;
          oldprocsym : Pprocsym;
          oldparse_only : boolean;
+         classnamelabel,rttilabel : plabel;
+
       begin
          {Nowadays aktprocsym may already have a value, so we need to save
           it.}
@@ -1281,6 +1283,32 @@ unit pdecl;
 
          if (cs_smartlink in aktmoduleswitches) then
            datasegment^.concat(new(pai_cut,init));
+         { write extended info for classes }
+         if is_a_class then
+           begin
+              { write class name }
+              getlabel(classnamelabel);
+              datasegment^.concat(new(pai_label,init(classnamelabel)));
+              datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.name^))));
+              datasegment^.concat(new(pai_string,init(aktclass^.name^)));
+
+              { interface table }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { auto table }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { rtti for dispose }
+              datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(aktclass^.get_rtti_label)))));
+              { pointer to type info }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { pointer to field table }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { pointer to method table }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { pointer to dynamic table }
+              datasegment^.concat(new(pai_const,init_32bit(0)));
+              { pointer to class name string }
+              datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(classnamelabel)))));
+           end;
 {$ifdef GDB}
          { generate the VMT }
          if cs_debuginfo in aktmoduleswitches then
@@ -1907,7 +1935,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.40  1998-08-21 15:48:58  pierre
+  Revision 1.41  1998-08-23 21:04:36  florian
+    + rtti generation for classes added
+    + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
+
+  Revision 1.40  1998/08/21 15:48:58  pierre
     * more cdecl chagnes
       - better line info
       - changes the definition options of a procvar

compiler/symdef.inc

@@ -2504,7 +2504,11 @@
            rttilist^.concat(new(pai_const,init_8bit(17)))
          else
            rttilist^.concat(new(pai_const,init_8bit(16)));
-         writename;
+
+         { generate the name }
+         rttilist^.concat(new(pai_const,init_8bit(length(name^))));
+         rttilist^.concat(new(pai_string,init(name^)));
+         
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
          publicsyms^.foreach(count_field);
@@ -2531,7 +2535,11 @@
 
 {
   $Log$
-  Revision 1.24  1998-08-20 12:53:26  peter
+  Revision 1.25  1998-08-23 21:04:38  florian
+    + rtti generation for classes added
+    + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
+
+  Revision 1.24  1998/08/20 12:53:26  peter
     * object_options are always written for object syms
 
   Revision 1.23  1998/08/19 00:42:42  peter