Browse Source

* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!

pierre 27 years ago
parent
commit
a5f0168fbb

+ 8 - 3
compiler/cg68kcal.pas

@@ -565,7 +565,7 @@ implementation
                                  { will be made                                  }
                                  { will be made                                  }
                                  { con- and destructors need a pointer to the vmt }
                                  { con- and destructors need a pointer to the vmt }
                                  if is_con_or_destructor and
                                  if is_con_or_destructor and
-                                   ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
+                                   ((pobjectdef(p^.methodpointer^.resulttype)^.options and oo_is_class)=0) and
                                    assigned(aktprocsym) then
                                    assigned(aktprocsym) then
                                    begin
                                    begin
                                     if not ((aktprocsym^.definition^.options
                                     if not ((aktprocsym^.definition^.options
@@ -578,7 +578,7 @@ implementation
                                            { classes need the mem ! }
                                            { classes need the mem ! }
                                            if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
                                            if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
 
 
-                                            oois_class)=0) then
+                                            oo_is_class)=0) then
                                              push_int(0)
                                              push_int(0)
                                            else
                                            else
                                                begin
                                                begin
@@ -1052,7 +1052,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.11  1998-10-16 13:12:46  pierre
+  Revision 1.12  1998-10-19 08:54:53  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.11  1998/10/16 13:12:46  pierre
     * added vmt_offsets in destructors code also !!!
     * added vmt_offsets in destructors code also !!!
     * vmt_offset code for m68k
     * vmt_offset code for m68k
 
 

+ 7 - 2
compiler/cg68kld.pas

@@ -201,7 +201,7 @@ implementation
                           end;
                           end;
                          { should be dereferenced later (FK)
                          { should be dereferenced later (FK)
                          if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
                          if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
-                           ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
+                           ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oo_is_class)<>0) then
                            begin
                            begin
                               simple_loadn:=false;
                               simple_loadn:=false;
                               if hregister=R_NO then
                               if hregister=R_NO then
@@ -510,7 +510,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  1998-10-14 08:47:16  pierre
+  Revision 1.7  1998-10-19 08:54:55  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.6  1998/10/14 08:47:16  pierre
     * bugs in secondfuncret for result in subprocedures removed
     * bugs in secondfuncret for result in subprocedures removed
 
 
   Revision 1.5  1998/10/14 08:08:53  pierre
   Revision 1.5  1998/10/14 08:08:53  pierre

+ 60 - 41
compiler/pdecl.pas

@@ -277,7 +277,11 @@ unit pdecl;
                 (token=ID) and (orgpattern='__asmname__') then
                 (token=ID) and (orgpattern='__asmname__') then
                begin
                begin
                  consume(ID);
                  consume(ID);
-                 C_name:=get_stringconst;
+                 C_name:=pattern;
+                 if token=CCHAR then
+                  consume(CCHAR)
+                 else
+                  consume(CSTRING);
                  Is_gpc_name:=true;
                  Is_gpc_name:=true;
                end;
                end;
              p:=read_type('');
              p:=read_type('');
@@ -325,13 +329,13 @@ unit pdecl;
                    symtablestack^.insert(abssym);
                    symtablestack^.insert(abssym);
                  end
                  end
                 else
                 else
-                 if token=CSTRING then
+                 if (token=CSTRING) or (token=CCHAR) then
                   begin
                   begin
                     storetokenpos:=tokenpos;
                     storetokenpos:=tokenpos;
                     tokenpos:=declarepos;
                     tokenpos:=declarepos;
                     abssym:=new(pabsolutesym,init(s,p));
                     abssym:=new(pabsolutesym,init(s,p));
                     s:=pattern;
                     s:=pattern;
-                    consume(CSTRING);
+                    consume(token);
                     abssym^.typ:=absolutesym;
                     abssym^.typ:=absolutesym;
                     abssym^.abstyp:=toasm;
                     abssym^.abstyp:=toasm;
                     abssym^.asmname:=stringdup(s);
                     abssym^.asmname:=stringdup(s);
@@ -691,7 +695,7 @@ unit pdecl;
            aktclass^.options:=aktclass^.options or oo_hasconstructor;
            aktclass^.options:=aktclass^.options or oo_hasconstructor;
            consume(SEMICOLON);
            consume(SEMICOLON);
              begin
              begin
-                if (aktclass^.options and oois_class)<>0 then
+                if (aktclass^.options and oo_is_class)<>0 then
                   begin
                   begin
                      { CLASS constructors return the created instance }
                      { CLASS constructors return the created instance }
                      aktprocsym^.definition^.retdef:=aktclass;
                      aktprocsym^.definition^.retdef:=aktclass;
@@ -753,7 +757,7 @@ unit pdecl;
 
 
         begin
         begin
            { check for a class }
            { check for a class }
-           if (aktclass^.options and oois_class=0) then
+           if (aktclass^.options and oo_is_class=0) then
             Message(parser_e_syntax_error);
             Message(parser_e_syntax_error);
            consume(_PROPERTY);
            consume(_PROPERTY);
            propertyparas:=nil;
            propertyparas:=nil;
@@ -1090,7 +1094,7 @@ unit pdecl;
                       the forward is resolved)
                       the forward is resolved)
                    }
                    }
                      ((hp1^.deftype=objectdef) and (
                      ((hp1^.deftype=objectdef) and (
-                     (pobjectdef(hp1)^.options and oois_class)<>0)) then
+                     (pobjectdef(hp1)^.options and oo_is_class)<>0)) then
                      begin
                      begin
                         pcrd:=new(pclassrefdef,init(hp1));
                         pcrd:=new(pclassrefdef,init(hp1));
                         object_dec:=pcrd;
                         object_dec:=pcrd;
@@ -1129,7 +1133,7 @@ unit pdecl;
                      end
                      end
                    else
                    else
                      aktclass:=new(pobjectdef,init(n,class_tobject));
                      aktclass:=new(pobjectdef,init(n,class_tobject));
-                   aktclass^.options:=aktclass^.options or oois_class or oo_isforward;
+                   aktclass^.options:=aktclass^.options or oo_is_class or oo_isforward;
                    object_dec:=aktclass;
                    object_dec:=aktclass;
                    exit;
                    exit;
                 end;
                 end;
@@ -1154,8 +1158,8 @@ unit pdecl;
                     childof:=nil;
                     childof:=nil;
                  end;
                  end;
                    { a mix of class and object isn't allowed }
                    { a mix of class and object isn't allowed }
-              if (((childof^.options and oois_class)<>0) and not is_a_class) or
-                 (((childof^.options and oois_class)=0) and is_a_class) then
+              if (((childof^.options and oo_is_class)<>0) and not is_a_class) or
+                 (((childof^.options and oo_is_class)=0) and is_a_class) then
                 Message(parser_e_mix_of_classes_and_objects);
                 Message(parser_e_mix_of_classes_and_objects);
               if assigned(fd) then
               if assigned(fd) then
                 begin
                 begin
@@ -1199,16 +1203,12 @@ unit pdecl;
                         if (childof^.options and oo_isforward)<>0 then
                         if (childof^.options and oo_isforward)<>0 then
                           Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^);
                           Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^);
                         aktclass:=fd;
                         aktclass:=fd;
-                        aktclass^.childof:=childof;
-                        { ajust the size, because the child could be also
-                          forward defined
-                        }
-                        aktclass^.publicsyms^.datasize:=
-                          aktclass^.publicsyms^.datasize-4+childof^.publicsyms^.datasize;
+                        aktclass^.set_parent(childof);
                      end
                      end
                    else
                    else
                      begin
                      begin
                         aktclass:=new(pobjectdef,init(n,childof));
                         aktclass:=new(pobjectdef,init(n,childof));
+                        aktclass^.set_parent(childof);
                      end;
                      end;
                 end;
                 end;
            end
            end
@@ -1218,7 +1218,7 @@ unit pdecl;
          { set the class attribute }
          { set the class attribute }
          if is_a_class then
          if is_a_class then
            begin
            begin
-              aktclass^.options:=aktclass^.options or oois_class;
+              aktclass^.options:=aktclass^.options or oo_is_class;
 
 
               if (cs_generate_rtti in aktlocalswitches) or
               if (cs_generate_rtti in aktlocalswitches) or
                   (assigned(aktclass^.childof) and
                   (assigned(aktclass^.childof) and
@@ -1340,7 +1340,7 @@ unit pdecl;
                                     consume(SEMICOLON);
                                     consume(SEMICOLON);
                                   end;
                                   end;
                       _OVERRIDE : begin
                       _OVERRIDE : begin
-                                    if (aktclass^.options and oois_class=0) then
+                                    if (aktclass^.options and oo_is_class=0) then
                                       Message(parser_e_constructor_cannot_be_not_virtual)
                                       Message(parser_e_constructor_cannot_be_not_virtual)
                                     else
                                     else
                                       aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
                                       aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
@@ -1390,6 +1390,13 @@ unit pdecl;
          curobjectname:='';
          curobjectname:='';
          typecanbeforward:=storetypeforwardsallowed;
          typecanbeforward:=storetypeforwardsallowed;
 
 
+         { generate vmt space if needed }
+         if ((aktclass^.options and
+             (oo_hasvirtual or oo_hasconstructor or
+              oo_hasdestructor or oo_is_class))<>0) and
+            ((aktclass^.options and
+              oo_hasvmt)=0) then
+          aktclass^.insertvmt;
          if (cs_smartlink in aktmoduleswitches) then
          if (cs_smartlink in aktmoduleswitches) then
            datasegment^.concat(new(pai_cut,init));
            datasegment^.concat(new(pai_cut,init));
          { write extended info for classes }
          { write extended info for classes }
@@ -1431,7 +1438,8 @@ unit pdecl;
            end;
            end;
 {$ifdef GDB}
 {$ifdef GDB}
          { generate the VMT }
          { generate the VMT }
-         if cs_debuginfo in aktmoduleswitches then
+         if (cs_debuginfo in aktmoduleswitches) and
+            ((aktclass^.options and oo_hasvmt)<>0) then
            begin
            begin
               do_count_dbx:=true;
               do_count_dbx:=true;
               if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
               if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
@@ -1439,31 +1447,37 @@ unit pdecl;
                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
            end;
            end;
 {$endif GDB}
 {$endif GDB}
-         datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
-
-         { determine the size with publicsyms^.datasize, because }
-         { size gives back 4 for CLASSes                         }
-         datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
-         datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
-
-         { write pointer to parent VMT, this isn't implemented in TP }
-         { but this is not used in FPC ? (PM) }
-         { it's not used yet, but the delphi-operators as and is need it (FK) }
-         if assigned(aktclass^.childof) then
+         if ((aktclass^.options and oo_hasvmt)<>0) then
            begin
            begin
-              datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.childof^.vmt_mangledname))));
-              if aktclass^.childof^.owner^.symtabletype=unitsymtable then
-                concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
-           end
-         else
-           datasegment^.concat(new(pai_const,init_32bit(0)));
-
-         { this generates the entries }
-         genvmt(aktclass);
-
+              datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
+     
+              { determine the size with publicsyms^.datasize, because }
+              { size gives back 4 for classes                         }
+              datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
+              datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
+     
+              { write pointer to parent VMT, this isn't implemented in TP }
+              { but this is not used in FPC ? (PM) }
+              { 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 !! }
+              if assigned(aktclass^.childof) and
+                 ((aktclass^.childof^.options and oo_hasvmt)<>0) then
+                begin
+                   datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.childof^.vmt_mangledname))));
+                   if aktclass^.childof^.owner^.symtabletype=unitsymtable then
+                     concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
+                end
+              else
+                datasegment^.concat(new(pai_const,init_32bit(0)));
+     
+              { this generates the entries }
+              genvmt(aktclass);
+           end;
+           
          { restore old state }
          { restore old state }
          symtablestack:=symtablestack^.next;
          symtablestack:=symtablestack^.next;
          procinfo._class:=nil;
          procinfo._class:=nil;
+         aktobjectdef:=nil;
          {Restore the aktprocsym.}
          {Restore the aktprocsym.}
          aktprocsym:=oldprocsym;
          aktprocsym:=oldprocsym;
 
 
@@ -1945,7 +1959,7 @@ unit pdecl;
                   (srsym^.typ=typesym) and
                   (srsym^.typ=typesym) and
                   (ptypesym(srsym)^.definition^.deftype=objectdef) and
                   (ptypesym(srsym)^.definition^.deftype=objectdef) and
                   ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and
                   ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and
-                  ((pobjectdef(ptypesym(srsym)^.definition)^.options and oois_class)<>0) then
+                  ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_is_class)<>0) then
                   begin
                   begin
                      { we can ignore the result   }
                      { we can ignore the result   }
                      { the definition is modified }
                      { the definition is modified }
@@ -2064,7 +2078,12 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.72  1998-10-16 13:12:51  pierre
+  Revision 1.73  1998-10-19 08:54:56  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.72  1998/10/16 13:12:51  pierre
     * added vmt_offsets in destructors code also !!!
     * added vmt_offsets in destructors code also !!!
     * vmt_offset code for m68k
     * vmt_offset code for m68k
 
 

+ 9 - 4
compiler/pexpr.pas

@@ -872,7 +872,7 @@ unit pexpr;
                                  else
                                  else
                                   if (token=POINT) and
                                   if (token=POINT) and
                                      (pd^.deftype=objectdef) and
                                      (pd^.deftype=objectdef) and
-                                     ((pobjectdef(pd)^.options and oois_class)=0) then
+                                     ((pobjectdef(pd)^.options and oo_is_class)=0) then
                                     begin
                                     begin
                                       consume(POINT);
                                       consume(POINT);
                                       if assigned(procinfo._class) then
                                       if assigned(procinfo._class) then
@@ -925,7 +925,7 @@ unit pexpr;
                                     begin
                                     begin
                                        { class reference ? }
                                        { class reference ? }
                                        if (pd^.deftype=objectdef)
                                        if (pd^.deftype=objectdef)
-                                         and ((pobjectdef(pd)^.options and oois_class)<>0) then
+                                         and ((pobjectdef(pd)^.options and oo_is_class)<>0) then
                                          begin
                                          begin
                                             p1:=genzeronode(typen);
                                             p1:=genzeronode(typen);
                                             p1^.resulttype:=pd;
                                             p1^.resulttype:=pd;
@@ -1399,7 +1399,7 @@ unit pexpr;
                     { determines the current object defintion }
                     { determines the current object defintion }
                     classh:=pobjectdef(ppointerdef(pd)^.definition);
                     classh:=pobjectdef(ppointerdef(pd)^.definition);
                     { check for an abstract class }
                     { check for an abstract class }
-                    if (classh^.options and oois_abstract)<>0 then
+                    if (classh^.options and oo_is_abstract)<>0 then
                       Message(sym_e_no_instance_of_abstract_object);
                       Message(sym_e_no_instance_of_abstract_object);
 
 
                     { search the constructor also in the symbol tables of
                     { search the constructor also in the symbol tables of
@@ -1863,7 +1863,12 @@ unit pexpr;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.66  1998-10-15 15:13:28  pierre
+  Revision 1.67  1998-10-19 08:54:57  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.66  1998/10/15 15:13:28  pierre
     + added oo_hasconstructor and oo_hasdestructor
     + added oo_hasconstructor and oo_hasdestructor
       for objects options
       for objects options
 
 

+ 12 - 1
compiler/pmodules.pas

@@ -794,6 +794,12 @@ unit pmodules;
               exit;
               exit;
            end;
            end;
 
 
+         { reset ranges/stabs in exported definitions }
+         { If I find who removed this line !!!!!!!
+           I AM TIRED OF THIS !!!!!!!!!!!
+           DONT TOUCH  WITHOUT ASKING ME Pierre Muller }
+
+         reset_global_defs;
          { All units are read, now give them a number }
          { All units are read, now give them a number }
          numberunits;
          numberunits;
 
 
@@ -1074,7 +1080,12 @@ unit pmodules;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.67  1998-10-13 13:10:25  peter
+  Revision 1.68  1998-10-19 08:54:59  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.67  1998/10/13 13:10:25  peter
     * new style for m68k/i386 infos and enums
     * new style for m68k/i386 infos and enums
 
 
   Revision 1.66  1998/10/09 16:36:05  pierre
   Revision 1.66  1998/10/09 16:36:05  pierre

+ 7 - 2
compiler/pstatmnt.pas

@@ -812,7 +812,7 @@ unit pstatmnt;
                      end;
                      end;
                    { check, if the first parameter is a pointer to a _class_ }
                    { check, if the first parameter is a pointer to a _class_ }
                    classh:=pobjectdef(ppointerdef(pd)^.definition);
                    classh:=pobjectdef(ppointerdef(pd)^.definition);
-                   if (classh^.options and oois_class)<>0 then
+                   if (classh^.options and oo_is_class)<>0 then
                          begin
                          begin
                             Message(parser_e_no_new_or_dispose_for_classes);
                             Message(parser_e_no_new_or_dispose_for_classes);
                             new_dispose_statement:=factor(false);
                             new_dispose_statement:=factor(false);
@@ -1215,7 +1215,12 @@ unit pstatmnt;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.44  1998-10-13 13:10:27  peter
+  Revision 1.45  1998-10-19 08:55:01  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.44  1998/10/13 13:10:27  peter
     * new style for m68k/i386 infos and enums
     * new style for m68k/i386 infos and enums
 
 
   Revision 1.43  1998/10/08 13:46:22  peter
   Revision 1.43  1998/10/08 13:46:22  peter

+ 71 - 1
compiler/ptconst.pas

@@ -63,6 +63,8 @@ unit ptconst;
          ca        : pchar;
          ca        : pchar;
          aktpos    : longint;
          aktpos    : longint;
          pd        : pprocdef;
          pd        : pprocdef;
+         obj       : pobjectdef;
+         symt      : psymtable;
          hp1,hp2   : pdefcoll;
          hp1,hp2   : pdefcoll;
          value     : bestreal;
          value     : bestreal;
 
 
@@ -540,6 +542,69 @@ unit ptconst;
                 datasegment^.concat(new(pai_const,init_8bit(0)));
                 datasegment^.concat(new(pai_const,init_8bit(0)));
               consume(RKLAMMER);
               consume(RKLAMMER);
            end;
            end;
+         { reads a typed object }
+         objectdef:
+           begin
+              if (pobjectdef(def)^.options and (oo_hasvmt or oo_is_class))<>0 then
+                begin
+                   Message(parser_e_type_const_not_possible);
+                   consume_all_until(RKLAMMER);
+                end
+              else
+                begin
+                   consume(LKLAMMER);
+                   aktpos:=0;
+                   while token<>RKLAMMER do
+                     begin
+                        s:=pattern;
+                        consume(ID);
+                        consume(COLON);
+                        srsym:=nil;
+                        obj:=pobjectdef(def);
+                        symt:=obj^.publicsyms;
+                        while (srsym=nil) and assigned(symt) do
+                          begin
+                             srsym:=symt^.search(s);
+                             if assigned(obj) then
+                               obj:=obj^.childof;
+                             if assigned(obj) then
+                               symt:=obj^.publicsyms
+                             else
+                               symt:=nil;
+                          end;
+                        
+                        if srsym=nil then
+                          begin
+                             Message1(sym_e_id_not_found,s);
+                             consume_all_until(SEMICOLON);
+                          end
+                        else
+                          begin
+                             { check position }
+                             if pvarsym(srsym)^.address<aktpos then
+                               Message(parser_e_invalid_record_const);
+     
+                             { if needed fill }
+                             if pvarsym(srsym)^.address>aktpos then
+                               for i:=1 to pvarsym(srsym)^.address-aktpos do
+                                 datasegment^.concat(new(pai_const,init_8bit(0)));
+     
+                             { new position }
+                             aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.definition^.size;
+     
+                             { read the data }
+                             readtypedconst(pvarsym(srsym)^.definition,nil);
+     
+                             if token=SEMICOLON then
+                               consume(SEMICOLON)
+                             else break;
+                          end;
+                     end;
+                   for i:=1 to def^.size-aktpos do
+                     datasegment^.concat(new(pai_const,init_8bit(0)));
+                   consume(RKLAMMER);
+                end;
+           end;
          else Message(parser_e_type_const_not_possible);
          else Message(parser_e_type_const_not_possible);
          end;
          end;
       end;
       end;
@@ -547,7 +612,12 @@ unit ptconst;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.20  1998-10-16 08:51:49  peter
+  Revision 1.21  1998-10-19 08:55:03  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.20  1998/10/16 08:51:49  peter
     + target_os.stackalignment
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries
     + stack can be aligned at 2 or 4 byte boundaries
 
 

+ 43 - 16
compiler/symdef.inc

@@ -2470,7 +2470,14 @@
         strpcopy(nss,'f'+retdef^.numberstring+','+tostr(i)+';');
         strpcopy(nss,'f'+retdef^.numberstring+','+tostr(i)+';');
         param := para1;
         param := para1;
         i := 0;
         i := 0;
-        while assigned(param) do
+        { this confuses gdb !!
+          we should use 'F' instead of 'f' but
+          as we use c++ language mode
+          it does not like that either
+          Please do not remove this part
+          might be used once
+          gdb for pascal is ready PM }
+        (* while assigned(param) do
           begin
           begin
           inc(i);
           inc(i);
           if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
           if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
@@ -2479,7 +2486,7 @@
           strcat(nss,pst);
           strcat(nss,pst);
           strdispose(pst);
           strdispose(pst);
           param := param^.next;
           param := param^.next;
-          end;
+          end; *)
         {strpcopy(strend(nss),';');}
         {strpcopy(strend(nss),';');}
         stabstring := strnew(nss);
         stabstring := strnew(nss);
         freemem(nss,1024);
         freemem(nss,1024);
@@ -2529,12 +2536,18 @@
         tdef.init;
         tdef.init;
         deftype:=objectdef;
         deftype:=objectdef;
         options:=0;
         options:=0;
-        vmt_offset:=0;
         publicsyms:=new(psymtable,init(objectsymtable));
         publicsyms:=new(psymtable,init(objectsymtable));
         publicsyms^.name := stringdup(n);
         publicsyms^.name := stringdup(n);
         { create space for vmt !! }
         { create space for vmt !! }
+{$ifdef OLDVMTSTYLE}
         publicsyms^.datasize:=Sizeof(pointer);
         publicsyms^.datasize:=Sizeof(pointer);
         options:=oo_hasvmt;
         options:=oo_hasvmt;
+        vmt_offset:=0;
+{$else }
+        options:=0;
+        vmt_offset:=0;
+        publicsyms^.datasize:=0;
+{$endif }
         publicsyms^.defowner:=@self;
         publicsyms^.defowner:=@self;
         set_parent(c);
         set_parent(c);
         name:=stringdup(n);
         name:=stringdup(n);
@@ -2609,13 +2622,20 @@
         else
         else
           begin
           begin
              { first round up to multiple of 4 }
              { first round up to multiple of 4 }
-             if (publicsyms^.datasize mod 4) <> 0 then
-               publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
+             if (aktpackrecords=2) then
+               begin
+                 if (publicsyms^.datasize and 1)<>0 then
+                   inc(publicsyms^.datasize);
+               end;
+             if (aktpackrecords>=4) then
+               begin
+                  if (publicsyms^.datasize mod 4) <> 0 then
+                    publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
+               end;
              vmt_offset:=publicsyms^.datasize;
              vmt_offset:=publicsyms^.datasize;
              publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
              publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
-             options:=options and oo_hasvmt;
+             options:=options or oo_hasvmt;
           end;
           end;
-          
      end;
      end;
      
      
    procedure tobjectdef.check_forwards;
    procedure tobjectdef.check_forwards;
@@ -2667,7 +2687,7 @@
 
 
    function tobjectdef.size : longint;
    function tobjectdef.size : longint;
      begin
      begin
-        if (options and oois_class)<>0 then
+        if (options and oo_is_class)<>0 then
           size:=sizeof(pointer)
           size:=sizeof(pointer)
 
 
         else
         else
@@ -2710,6 +2730,8 @@
     var
     var
       s1,s2:string;
       s1,s2:string;
     begin
     begin
+        if (options and oo_hasvmt)=0 then
+          internalerror(12346);
         if owner^.name=nil then
         if owner^.name=nil then
             s1:=''
             s1:=''
         else
         else
@@ -2740,7 +2762,7 @@
 
 
     function tobjectdef.isclass : boolean;
     function tobjectdef.isclass : boolean;
       begin
       begin
-         isclass:=(options and oois_class)<>0;
+         isclass:=(options and oo_is_class)<>0;
       end;
       end;
 
 
 
 
@@ -2868,21 +2890,21 @@
       {$else}
       {$else}
          publicsyms^.foreach(@addname);
          publicsyms^.foreach(@addname);
       {$endif tp}
       {$endif tp}
-      if (options and oo_hasvirtual) <> 0 then
-        if not assigned(childof) or ((childof^.options and oo_hasvirtual) = 0) then
+      if (options and oo_hasvmt) <> 0 then
+        if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
            begin
            begin
-              str_end:='$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;';
-              strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;');
+              strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
+                +','+tostr(vmt_offset*8)+';');
            end;
            end;
         {$ifdef tp}
         {$ifdef tp}
           publicsyms^.foreach(addprocname);
           publicsyms^.foreach(addprocname);
         {$else}
         {$else}
           publicsyms^.foreach(@addprocname);
           publicsyms^.foreach(@addprocname);
         {$endif tp }
         {$endif tp }
-        if (options and oo_hasvirtual) <> 0  then
+        if (options and oo_hasvmt) <> 0  then
           begin
           begin
              anc := @self;
              anc := @self;
-             while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvirtual) <> 0) do
+             while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvmt) <> 0) do
                anc := anc^.childof;
                anc := anc^.childof;
              str_end:=';~%'+anc^.numberstring+';';
              str_end:=';~%'+anc^.numberstring+';';
           end
           end
@@ -3119,7 +3141,12 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.60  1998-10-16 13:12:53  pierre
+  Revision 1.61  1998-10-19 08:55:05  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.60  1998/10/16 13:12:53  pierre
     * added vmt_offsets in destructors code also !!!
     * added vmt_offsets in destructors code also !!!
     * vmt_offset code for m68k
     * vmt_offset code for m68k
 
 

+ 7 - 2
compiler/symsym.inc

@@ -1001,7 +1001,7 @@
              {  check for instance of an abstract object or class }
              {  check for instance of an abstract object or class }
              {
              {
              if (pvarsym(sym)^.definition^.deftype=objectdef) and
              if (pvarsym(sym)^.definition^.deftype=objectdef) and
-               ((pobjectdef(pvarsym(sym)^.definition)^.options and oois_abstract)<>0) then
+               ((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
                Message(sym_e_no_instance_of_abstract_object);
                Message(sym_e_no_instance_of_abstract_object);
              }
              }
 
 
@@ -1712,7 +1712,12 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.53  1998-10-16 08:51:53  peter
+  Revision 1.54  1998-10-19 08:55:07  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.53  1998/10/16 08:51:53  peter
     + target_os.stackalignment
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries
     + stack can be aligned at 2 or 4 byte boundaries
 
 

+ 7 - 2
compiler/tcflw.pas

@@ -370,7 +370,7 @@ implementation
 
 
               { this must be a _class_ }
               { this must be a _class_ }
               if (p^.left^.resulttype^.deftype<>objectdef) or
               if (p^.left^.resulttype^.deftype<>objectdef) or
-                ((pobjectdef(p^.left^.resulttype)^.options and oois_class)=0) then
+                ((pobjectdef(p^.left^.resulttype)^.options and oo_is_class)=0) then
                 CGMessage(type_e_mismatch);
                 CGMessage(type_e_mismatch);
 
 
               p^.registersfpu:=p^.left^.registersfpu;
               p^.registersfpu:=p^.left^.registersfpu;
@@ -482,7 +482,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-10-06 20:49:10  peter
+  Revision 1.3  1998-10-19 08:55:10  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.2  1998/10/06 20:49:10  peter
     * m68k compiler compiles again
     * m68k compiler compiles again
 
 
   Revision 1.1  1998/09/23 20:42:24  peter
   Revision 1.1  1998/09/23 20:42:24  peter

+ 7 - 2
compiler/tcld.pas

@@ -116,7 +116,7 @@ implementation
                      appropriate tree node (FK)
                      appropriate tree node (FK)
 
 
                    if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
                    if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
-                      ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
+                      ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oo_is_class)<>0) then
                      p^.registers32:=1;
                      p^.registers32:=1;
                    }
                    }
 
 
@@ -399,7 +399,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  1998-10-06 20:49:12  peter
+  Revision 1.6  1998-10-19 08:55:12  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.5  1998/10/06 20:49:12  peter
     * m68k compiler compiles again
     * m68k compiler compiles again
 
 
   Revision 1.4  1998/09/28 11:07:40  peter
   Revision 1.4  1998/09/28 11:07:40  peter

+ 8 - 3
compiler/types.pas

@@ -326,7 +326,7 @@ unit types;
          ret_in_param:=(def^.deftype in [arraydef,recorddef]) or
          ret_in_param:=(def^.deftype in [arraydef,recorddef]) or
            ((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
            ((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
            ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
            ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
-           ((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
+           ((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oo_is_class)=0)) or
            ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
            ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
       end;
 
 
@@ -944,7 +944,7 @@ unit types;
                                   { generates an instance                     }
                                   { generates an instance                     }
                                   if (procdefcoll^.data^.options and poabstractmethod)<>0 then
                                   if (procdefcoll^.data^.options and poabstractmethod)<>0 then
                                     begin
                                     begin
-                                       _class^.options:=_class^.options or oois_abstract;
+                                       _class^.options:=_class^.options or oo_is_abstract;
                                        datasegment^.concat(new(pai_const,init_symbol('FPC_ABSTRACTERROR')));
                                        datasegment^.concat(new(pai_const,init_symbol('FPC_ABSTRACTERROR')));
                                     end
                                     end
                                   else
                                   else
@@ -982,7 +982,12 @@ unit types;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.34  1998-10-12 09:50:06  florian
+  Revision 1.35  1998-10-19 08:55:13  pierre
+    * wrong stabs info corrected once again !!
+    + variable vmt offset with vmt field only if required
+      implemented now !!!
+
+  Revision 1.34  1998/10/12 09:50:06  florian
     + support of <procedure var type>:=<pointer> in delphi mode added
     + support of <procedure var type>:=<pointer> in delphi mode added
 
 
   Revision 1.33  1998/10/06 20:43:30  peter
   Revision 1.33  1998/10/06 20:43:30  peter