* classes vmt changed to only positive addresses

  * sharedlib creation is working

base/makefile.fpc

@@ -720,13 +720,11 @@ fpc_staticlib:
 	$(MAKE) libsclean
 	$(MAKE) all SMARTLINK=YES
 
-fpc_sharedlib:
+fpc_sharedlib: all
 ifdef inlinux
 ifndef LIBNAME
-	$(ECHO) LIBNAME not set
+	@$(ECHO) LIBNAME not set
 else
-	$(MAKE) libsclean
-	$(MAKE) all
 	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
 endif
 else
@@ -741,17 +739,17 @@ endif
 fpc_showinstallfiles : all
 ifndef DEFAULTUNITS
 ifdef EXEOBJECTS
-	$(ECHO) $(addprefix "\n"$(BININSTALLDIR)/,$(EXEFILES))
+	@$(ECHO) $(addprefix "\n"$(BININSTALLDIR)/,$(EXEFILES))
 endif
 endif
 ifdef LOADEROBJECTS
-	$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(LOADEROFILES))
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(LOADEROFILES))
 endif
 ifdef UNITOBJECTS
-	$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(wildcard $(UNITPPUFILES) $(UNITOFILES) $(UNITAFILES)))
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(wildcard $(UNITPPUFILES) $(UNITOFILES) $(UNITAFILES)))
 endif
 ifdef EXTRAINSTALLUNITS
-	$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(wildcard $(addsuffix $(OEXT),$(EXTRAINSTALLUNITS)) $(addsuffix $(STATICLIBEXT),$(EXTRAINSTALLUNITS)) $(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))))
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(wildcard $(addsuffix $(OEXT),$(EXTRAINSTALLUNITS)) $(addsuffix $(STATICLIBEXT),$(EXTRAINSTALLUNITS)) $(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))))
 endif
 
 fpc_install : all
@@ -1045,7 +1043,11 @@ endif
 
 #
 # $Log$
-# Revision 1.42  1999-07-22 16:13:32  peter
+# Revision 1.43  1999-08-09 22:19:46  peter
+#   * classes vmt changed to only positive addresses
+#   * sharedlib creation is working
+#
+# Revision 1.42  1999/07/22 16:13:32  peter
 #   * install,clean fixes
 #
 # Revision 1.41  1999/07/21 14:21:00  peter

compiler/cg386cal.pas

@@ -754,7 +754,7 @@ implementation
                    }
                    if pprocdef(p^.procdefinition)^.extnumber=-1 then
                      internalerror(44584);
-                   r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
+                   r^.offset:=pprocdef(p^.procdefinition)^._class^.vmtmethodoffset(pprocdef(p^.procdefinition)^.extnumber);
 {$ifndef TESTOBJEXT}
                    if (cs_check_range in aktlocalswitches) then
                      begin
@@ -1178,7 +1178,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.98  1999-08-09 10:37:55  peter
+  Revision 1.99  1999-08-09 22:19:47  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.98  1999/08/09 10:37:55  peter
     * fixed pushing of self with methodpointer
 
   Revision 1.97  1999/08/04 13:45:18  florian

compiler/cg386ld.pas

@@ -331,7 +331,8 @@ implementation
                               new(hp);
                               reset_reference(hp^);
                               hp^.base:=R_EDI;
-                              hp^.offset:=pprocsym(p^.symtableentry)^.definition^.extnumber*4+12;
+                              hp^.offset:=pprocsym(p^.symtableentry)^.definition^._class^.vmtmethodoffset(
+                                pprocsym(p^.symtableentry)^.definition^.extnumber);
                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                                 hp,R_EDI)));
                               { ... and store it }
@@ -936,7 +937,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  1999-08-07 14:20:55  florian
+  Revision 1.72  1999-08-09 22:19:50  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.71  1999/08/07 14:20:55  florian
     * some small problems fixed
 
   Revision 1.70  1999/08/04 13:45:22  florian

compiler/options.pas

@@ -992,6 +992,7 @@ begin
   def_symbol('INT64');
   def_symbol('HASRESOURCESTRINGS');
   def_symbol('HASSAVEREGISTERS');
+  def_symbol('NEWVMTOFFSET');
 
 { some stuff for TP compatibility }
 {$ifdef i386}
@@ -1161,7 +1162,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  1999-08-05 23:45:10  peter
+  Revision 1.11  1999-08-09 22:19:52  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.10  1999/08/05 23:45:10  peter
     * saveregister is now working and used for assert and iocheck (which has
       been moved to system.inc because it's now system independent)
 

compiler/pdecl.pas

@@ -1577,78 +1577,41 @@ unit pdecl;
            aktclass^.insertvmt;
          if (cs_smartlink in aktmoduleswitches) then
            datasegment^.concat(new(pai_cut,init));
-         { write extended info for classes }
-         if is_a_class then
-           begin
-              if (oo_can_have_published in aktclass^.objectoptions) then
-                aktclass^.generate_rtti;
-              { write class name }
-              getdatalabel(classnamelabel);
-              datasegment^.concat(new(pai_label,init(classnamelabel)));
-              datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.objname^))));
-              datasegment^.concat(new(pai_string,init(aktclass^.objname^)));
-
-              { generate message and dynamic tables }
-              if (oo_has_msgstr in aktclass^.objectoptions) then
-                strmessagetable:=genstrmsgtab(aktclass);
-              if (oo_has_msgint in aktclass^.objectoptions) then
-                intmessagetable:=genintmsgtab(aktclass)
-              else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { table for string messages }
-              if (oo_has_msgstr in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,init(strmessagetable)))
-              else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { interface table }
-              datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { auto table }
-              datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { inittable for con-/destruction }
-              if aktclass^.needs_inittable then
-                datasegment^.concat(new(pai_const_symbol,init(aktclass^.get_inittable_label)))
-              else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { pointer to type info of published section }
-              if (oo_can_have_published in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,initname(aktclass^.rtti_name)))
-              else
-                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 }
-              if (oo_has_msgint in aktclass^.objectoptions) then
-                datasegment^.concat(new(pai_const_symbol,init(intmessagetable)))
-              else
-                datasegment^.concat(new(pai_const,init_32bit(0)));
-
-              { pointer to class name string }
-              datasegment^.concat(new(pai_const_symbol,init(classnamelabel)));
+         { Write the start of the VMT, wich is equal for classes and objects }
+         if (oo_has_vmt in aktclass^.objectoptions) then
+           begin
+              { write tables for classes, this must be done before the actual
+                class is written, because we need the labels defined }
+              if is_a_class then
+               begin
+                 { rtti }
+                 if (oo_can_have_published in aktclass^.objectoptions) then
+                  aktclass^.generate_rtti;
+                 { write class name }
+                 getdatalabel(classnamelabel);
+                 datasegment^.concat(new(pai_label,init(classnamelabel)));
+                 datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.objname^))));
+                 datasegment^.concat(new(pai_string,init(aktclass^.objname^)));
+                 { generate message and dynamic tables }
+                 if (oo_has_msgstr in aktclass^.objectoptions) then
+                   strmessagetable:=genstrmsgtab(aktclass);
+                 if (oo_has_msgint in aktclass^.objectoptions) then
+                   intmessagetable:=genintmsgtab(aktclass)
+                 else
+                   datasegment^.concat(new(pai_const,init_32bit(0)));
+               end;
 
-              datasegment^.concat(new(pai_symbol_end,init(classnamelabel)));
-           end;
+             { write debug info }
 {$ifdef GDB}
-         { generate the VMT }
-         if (cs_debuginfo in aktmoduleswitches) and
-            (oo_has_vmt in aktclass^.objectoptions) then
-           begin
-              do_count_dbx:=true;
-              if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
-               datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
-                typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
-           end;
+             if (cs_debuginfo in aktmoduleswitches) then
+              begin
+                do_count_dbx:=true;
+                if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
+                  datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
+                    typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
+              end;
 {$endif GDB}
-         if (oo_has_vmt in aktclass^.objectoptions) then
-           begin
               datasegment^.concat(new(pai_symbol,initname_global(aktclass^.vmt_mangledname,0)));
 
               { determine the size with symtable^.datasize, because }
@@ -1666,6 +1629,41 @@ unit pdecl;
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
+              { write extended info for classes, for the order see rtl/inc/objpash.inc }
+              if is_a_class then
+               begin
+                 { pointer to class name string }
+                 datasegment^.concat(new(pai_const_symbol,init(classnamelabel)));
+                 { pointer to dynamic table }
+                 if (oo_has_msgint in aktclass^.objectoptions) then
+                   datasegment^.concat(new(pai_const_symbol,init(intmessagetable)))
+                 else
+                   datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { pointer to method table }
+                 datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { pointer to field table }
+                 datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { pointer to type info of published section }
+                 if (oo_can_have_published in aktclass^.objectoptions) then
+                   datasegment^.concat(new(pai_const_symbol,initname(aktclass^.rtti_name)))
+                 else
+                   datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { inittable for con-/destruction }
+                 if aktclass^.needs_inittable then
+                   datasegment^.concat(new(pai_const_symbol,init(aktclass^.get_inittable_label)))
+                 else
+                   datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { auto table }
+                 datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { interface table }
+                 datasegment^.concat(new(pai_const,init_32bit(0)));
+                 { table for string messages }
+                 if (oo_has_msgstr in aktclass^.objectoptions) then
+                   datasegment^.concat(new(pai_const_symbol,init(strmessagetable)))
+                 else
+                   datasegment^.concat(new(pai_const,init_32bit(0)));
+               end;
+
               { this generates the entries }
               genvmt(aktclass);
 
@@ -2385,7 +2383,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.142  1999-08-05 16:53:02  peter
+  Revision 1.143  1999-08-09 22:19:53  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.142  1999/08/05 16:53:02  peter
     * V_Fatal=1, all other V_ are also increased
     * Check for local procedure when assigning procvar
     * fixed comment parsing because directives

compiler/symdef.inc

@@ -3192,6 +3192,16 @@ Const local_symtable_index : longint = $8001;
       end;
 
 
+    function tobjectdef.vmtmethodoffset(index:longint):longint;
+      begin
+        { for offset of methods for classes, see rtl/inc/objpash.inc }
+        if is_class then
+         vmtmethodoffset:=index*4+48
+        else
+         vmtmethodoffset:=index*4+12;
+      end;
+
+
     function tobjectdef.vmt_mangledname : string;
     {DM: I get a nil pointer on the owner name. I don't know if this
      mayhappen, and I have therefore fixed the problem by doing nil pointer
@@ -3445,7 +3455,7 @@ Const local_symtable_index : longint = $8001;
                 else
                   begin
                      { virtual method, write vmt offset }
-                     rttilist^.concat(new(pai_const,init_32bit(pprocdef(def)^.extnumber*4+12)));
+                     rttilist^.concat(new(pai_const,init_32bit(pprocdef(def)^._class^.vmtmethodoffset(pprocdef(def)^.extnumber))));
                      typvalue:=2;
                   end;
              end;
@@ -3617,7 +3627,11 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.146  1999-08-07 14:21:00  florian
+  Revision 1.147  1999-08-09 22:19:55  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.146  1999/08/07 14:21:00  florian
     * some small problems fixed
 
   Revision 1.145  1999/08/07 13:36:54  daniel

compiler/symdefh.inc

@@ -187,6 +187,7 @@
           procedure deref;virtual;
           function  size : longint;virtual;
           function  alignment:longint;virtual;
+          function  vmtmethodoffset(index:longint):longint;
           function  is_publishable : boolean;virtual;
           function  vmt_mangledname : string;
           function  rtti_name : string;
@@ -519,7 +520,11 @@
 
 {
   $Log$
-  Revision 1.39  1999-08-07 14:21:02  florian
+  Revision 1.40  1999-08-09 22:19:57  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.39  1999/08/07 14:21:02  florian
     * some small problems fixed
 
   Revision 1.38  1999/08/05 16:53:15  peter

fcl/linux/Makefile

@@ -29,6 +29,9 @@ INC=../inc
 XML=../xml
 PROCINC=../$(CPU)
 
+# default library name
+LIBNAME=fpfcl
+
 # Where to place the files
 TARGETDIR=.
 
@@ -135,7 +138,11 @@ ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc
 
 #
 # $Log$
-# Revision 1.12  1999-07-09 08:43:26  michael
+# Revision 1.13  1999-08-09 22:19:58  peter
+#   * classes vmt changed to only positive addresses
+#   * sharedlib creation is working
+#
+# Revision 1.12  1999/07/09 08:43:26  michael
 # + Added XML units
 #
 # Revision 1.11  1999/05/31 12:46:31  peter

rtl/i386/i386.inc

@@ -284,7 +284,11 @@ asm
         { esi contains the vmt }
         pushl   %esi
         { call newinstance (class method!) }
+{$ifdef NEWVMTOFFSET}
+        call    *52{vmtNewInstance}(%esi)
+{$else}
         call    *16(%esi)
+{$endif}
         popl    %edx
         popl    %ecx
         popl    %ebx
@@ -295,7 +299,7 @@ asm
 .LNEW_CLASS1:
         movl    %esi,8(%ebp)
         orl     %eax,%eax
-        popl   %edi
+        popl    %edi
 end;
 
 
@@ -319,13 +323,17 @@ asm
         { push self }
         pushl   %esi
         { call freeinstance }
+{$ifdef NEWVMTOFFSET}
+        call    *56{vmtFreeInstance}(%edi)
+{$else}
         call    *20(%edi)
+{$endif}
         popl    %edx
         popl    %ecx
         popl    %ebx
         popl    %eax
 .LDISPOSE_CLASS1:
-        popl   %edi
+        popl    %edi
 end;
 
 
@@ -824,7 +832,11 @@ end;
 
 {
   $Log$
-  Revision 1.50  1999-08-05 23:45:12  peter
+  Revision 1.51  1999-08-09 22:20:02  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.50  1999/08/05 23:45:12  peter
     * saveregister is now working and used for assert and iocheck (which has
       been moved to system.inc because it's now system independent)
 

rtl/inc/objpash.inc

@@ -19,7 +19,32 @@
 *****************************************************************************}
 
     const
-       // vmtSelfPtr           = -36;  { not implemented yet }
+{$ifdef NEWVMTOFFSET}
+       vmtInstanceSize         = 0;
+       vmtParent               = 8;
+       { These were negative value's, but are now positive, else classes
+         couldn't be used with shared linking which copies only all data from
+         the .global directive and not the data before the directive (PFV) }
+       vmtClassName            = 12;
+       vmtDynamicTable         = 16;
+       vmtMethodTable          = 20;
+       vmtFieldTable           = 24;
+       vmtTypeInfo             = 28;
+       vmtInitTable            = 32;
+       vmtAutoTable            = 36;
+       vmtIntfTable            = 40;
+       vmtMsgStrPtr            = 44;
+       { methods }
+       vmtMethodStart          = 48;
+       vmtDestroy              = vmtMethodStart;
+       vmtNewInstance          = vmtMethodStart+4;
+       vmtFreeInstance         = vmtMethodStart+8;
+       vmtSafeCallException    = vmtMethodStart+12;
+       vmtDefaultHandler       = vmtMethodStart+16;
+       vmtAfterConstruction    = vmtMethodStart+20;
+       vmtBeforeDestruction    = vmtMethodStart+24;
+       vmtDefaultHandlerStr    = vmtMethodStart+28;
+{$else}
        vmtMsgStrPtr            = -36;
        vmtIntfTable            = -32;
        vmtAutoTable            = -28;
@@ -39,6 +64,7 @@
        vmtAfterConstruction    = 32;
        vmtBeforeDestruction    = 36;
        vmtDefaultHandlerStr    = 40;
+{$endif}
 
     type
        { some pointer definitions }
@@ -193,7 +219,11 @@
        end;
 {
   $Log$
-  Revision 1.3  1999-05-17 21:52:38  florian
+  Revision 1.4  1999-08-09 22:20:03  peter
+    * classes vmt changed to only positive addresses
+    * sharedlib creation is working
+
+  Revision 1.3  1999/05/17 21:52:38  florian
     * most of the Object Pascal stuff moved to the system unit
 
 }