Browse Source

+ stabs for classes and classref working,
a class still needs an ^ to get that content of it,
but the class fields inside a class don't result into an
infinite loop anymore!

pierre 26 years ago
parent
commit
8b4c7f2402
4 changed files with 83 additions and 47 deletions
  1. 8 2
      compiler/psystem.pas
  2. 44 32
      compiler/symdef.inc
  3. 23 12
      compiler/symsym.inc
  4. 8 1
      compiler/symtable.pas

+ 8 - 2
compiler/psystem.pas

@@ -75,7 +75,6 @@ procedure insert_intern_types(p : psymtable);
 var
   { several defs to simulate more or less C++ objects for GDB }
   vmtdef      : precorddef;
-  pvmtdef     : ppointerdef;
   vmtarraydef : parraydef;
   vmtsymtable : psymtable;
 begin
@@ -180,6 +179,7 @@ begin
   charpointerdef:=ppointerdef(globaldef('char_pointer'));
   voidfarpointerdef:=ppointerdef(globaldef('void_farpointer'));
   cfiledef:=pfiledef(globaldef('file'));
+  pvmtdef:=ppointerdef(globaldef('pvmt'));
 end;
 
 
@@ -238,7 +238,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.26  1999-08-03 22:03:07  peter
+  Revision 1.27  1999-08-13 14:24:17  pierre
+    + stabs for classes and classref working,
+      a class still needs an ^ to get that content of it,
+      but the class fields inside a class don't result into an
+      infinite loop anymore!
+
+  Revision 1.26  1999/08/03 22:03:07  peter
     * moved bitmask constants to sets
     * some other type/const renamings
 

+ 44 - 32
compiler/symdef.inc

@@ -1524,12 +1524,13 @@
 {$ifdef GDB}
     function tclassrefdef.stabstring : pchar;
       begin
-         stabstring:=strpnew('');
+         stabstring:=strpnew('t'+pvmtdef^.numberstring+';');
       end;
 
 
     procedure tclassrefdef.concatstabto(asmlist : paasmoutput);
       begin
+        inherited concatstabto(asmlist);
       end;
 {$endif GDB}
 
@@ -1612,10 +1613,12 @@
     function tsetdef.stabstring : pchar;
       begin
          { For small sets write a longint, which can at least be seen
-           in the current GDB's (PFV) }
+           in the current GDB's (PFV)
+           this is obsolete with GDBPAS !!
+           and anyhow creates problems with version 4.18!! PM
          if settype=smallset then
            stabstring := strpnew('r'+s32bitdef^.numberstring+';0;0xffffffff;')
-         else
+         else }
            stabstring := strpnew('S'+setof^.numberstring);
       end;
 
@@ -2004,40 +2007,43 @@
     procedure addname(p : pnamedindexobject);
     var
       news, newrec : pchar;
-      spec : string[2];
+      spec : string[3];
       size : longint;
     begin
     { static variables from objects are like global objects }
     if (sp_static in psym(p)^.symoptions) then
       exit;
-    if (sp_protected in psym(p)^.symoptions) then
-      spec:='/1'
-    else if (sp_private in psym(p)^.symoptions) then
-      spec:='/0'
-    else
-      spec:='';
-
     If psym(p)^.typ = varsym then
        begin
-       size:=pvarsym(p)^.definition^.size;
-       { open arrays made overflows !! }
-       if size>$fffffff then
-         size:=$fffffff;
-       newrec := strpnew(p^.name+':'+spec+pvarsym(p)^.definition^.numberstring
-                     +','+tostr(pvarsym(p)^.address*8)+','
-                     +tostr(size*8)+';');
-       if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
-         begin
-            getmem(news,stabrecsize+memsizeinc);
-            strcopy(news,stabrecstring);
-            freemem(stabrecstring,stabrecsize);
-            stabrecsize:=stabrecsize+memsizeinc;
-            stabrecstring:=news;
-         end;
-       strcat(StabRecstring,newrec);
-       strdispose(newrec);
-       {This should be used for case !!}
-       RecOffset := RecOffset + pvarsym(p)^.definition^.size;
+         if (sp_protected in psym(p)^.symoptions) then
+           spec:='/1'
+         else if (sp_private in psym(p)^.symoptions) then
+           spec:='/0'
+         else
+           spec:='';
+         { class fields are pointers PM }
+         if (pvarsym(p)^.definition^.deftype=objectdef) and
+            pobjectdef(pvarsym(p)^.definition)^.is_class then
+            spec:=spec+'*';
+         size:=pvarsym(p)^.definition^.size;
+         { open arrays made overflows !! }
+         if size>$fffffff then
+           size:=$fffffff;
+         newrec := strpnew(p^.name+':'+spec+pvarsym(p)^.definition^.numberstring
+                       +','+tostr(pvarsym(p)^.address*8)+','
+                       +tostr(size*8)+';');
+         if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
+           begin
+              getmem(news,stabrecsize+memsizeinc);
+              strcopy(news,stabrecstring);
+              freemem(stabrecstring,stabrecsize);
+              stabrecsize:=stabrecsize+memsizeinc;
+              stabrecstring:=news;
+           end;
+         strcat(StabRecstring,newrec);
+         strdispose(newrec);
+         {This should be used for case !!}
+         RecOffset := RecOffset + pvarsym(p)^.definition^.size;
        end;
     end;
 
@@ -3419,7 +3425,7 @@ Const local_symtable_index : longint = $8001;
         oldrecsize:=stabrecsize;
         stabrecsize:=memsizeinc;
         GetMem(stabrecstring,stabrecsize);
-        strpcopy(stabRecString,'s'+tostr(size));
+        strpcopy(stabRecString,'s'+tostr(symtable^.datasize));
         if assigned(childof) then
           {only one ancestor not virtual, public, at base offset 0 }
           {       !1           ,    0       2         0    ,       }
@@ -3704,7 +3710,13 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.151  1999-08-12 14:31:20  peter
+  Revision 1.152  1999-08-13 14:24:18  pierre
+    + stabs for classes and classref working,
+      a class still needs an ^ to get that content of it,
+      but the class fields inside a class don't result into an
+      infinite loop anymore!
+
+  Revision 1.151  1999/08/12 14:31:20  peter
     * long line fix
 
   Revision 1.150  1999/08/11 08:56:53  michael

+ 23 - 12
compiler/symsym.inc

@@ -1318,14 +1318,19 @@
 {$ifdef GDB}
     function tvarsym.stabstring : pchar;
      var
-       st : char;
+       st : string[2];
      begin
+       if (definition^.deftype=objectdef) and
+          pobjectdef(definition)^.is_class then
+         st:='*'
+       else
+         st:='';
        if (owner^.symtabletype = objectsymtable) and
           (sp_static in symoptions) then
          begin
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
+            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
 {$ifndef Delphi}
-            stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
+            stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
                      +definition^.numberstring+'",'+
                      tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
 {$endif}
@@ -1337,26 +1342,26 @@
               because with G GDB doesn't look at the address field
               but searches the same name or with a leading underscore
               but these names don't exist in pascal !}
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
+            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
             stabstring := strpnew('"'+name+':'+st
                      +definition^.numberstring+'",'+
                      tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
          end
        else if owner^.symtabletype = staticsymtable then
          begin
-            stabstring := strpnew('"'+name+':S'
+            stabstring := strpnew('"'+name+':S'+st
                   +definition^.numberstring+'",'+
                   tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
          end
        else if (owner^.symtabletype=parasymtable) then
          begin
             case varspez of
-               vs_var   : st := 'v';
+               vs_var   : st := 'v'+st;
                vs_value,
                vs_const : if push_addr_param(definition) then
-                            st := 'v' { should be 'i' but 'i' doesn't work }
+                            st := 'v'+st { should be 'i' but 'i' doesn't work }
                           else
-                            st := 'p';
+                            st := 'p'+st;
               end;
             stabstring := strpnew('"'+name+':'+st
                   +definition^.numberstring+'",'+
@@ -1371,7 +1376,7 @@
            begin
               { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
               { this is the register order for GDB}
-              stabstring:=strpnew('"'+name+':r'
+              stabstring:=strpnew('"'+name+':r'+st
                         +definition^.numberstring+'",'+
                         tostr(N_RSYM)+',0,'+
                         tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
@@ -1380,11 +1385,11 @@
    {$endif i386}
            { I don't know if this will work (PM) }
            if (vo_is_C_var in varoptions) then
-            stabstring := strpnew('"'+name+':S'
+            stabstring := strpnew('"'+name+':S'+st
                   +definition^.numberstring+'",'+
                   tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
            else
-           stabstring := strpnew('"'+name+':'
+           stabstring := strpnew('"'+name+':'+st
                   +definition^.numberstring+'",'+
                   tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
        else
@@ -2099,7 +2104,13 @@
 
 {
   $Log$
-  Revision 1.111  1999-08-10 12:36:31  pierre
+  Revision 1.112  1999-08-13 14:24:20  pierre
+    + stabs for classes and classref working,
+      a class still needs an ^ to get that content of it,
+      but the class fields inside a class don't result into an
+      infinite loop anymore!
+
+  Revision 1.111  1999/08/10 12:36:31  pierre
    * use of procsym field for correct gdb info in local procedures
    * exported DLL vars made global to be able to use DLLTOOL with themz
 

+ 8 - 1
compiler/symtable.pas

@@ -299,6 +299,7 @@ unit symtable;
 
        class_tobject : pobjectdef; { pointer to the anchestor of all   }
                                    { clases                         }
+       pvmtdef     : ppointerdef;  { type of classrefs }
 
        aktprocsym : pprocsym;      { pointer to the symbol for the
                                      currently be parsed procedure }
@@ -2346,7 +2347,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  1999-08-10 16:25:42  pierre
+  Revision 1.41  1999-08-13 14:24:22  pierre
+    + stabs for classes and classref working,
+      a class still needs an ^ to get that content of it,
+      but the class fields inside a class don't result into an
+      infinite loop anymore!
+
+  Revision 1.40  1999/08/10 16:25:42  pierre
    * unitid changed to word
 
   Revision 1.39  1999/08/10 12:33:36  pierre