* several memory corruptions due to double freemem solved

    => never use p^.loc.location:=p^.left^.loc.location;
  + finally I added now by default
    that ra386dir translates global and unit symbols
  + added a first field in tsymtable and
    a nextsym field in tsym
    (this allows to obtain ordered type info for
    records and objects in gdb !)

compiler/ag68kmpw.pas

@@ -547,7 +547,7 @@ ait_labeled_instruction :
     begin
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
+       comment(v_info,'Start writing MPW-styled assembler output for '+current_module^.mainsource^);
 {$endif}
       WriteTree(externals);
       AsmLn;
@@ -579,7 +579,17 @@ ait_labeled_instruction :
 end.
 {
   $Log$
-  Revision 1.4  1998-10-14 15:56:42  pierre
+  Revision 1.5  1998-10-20 08:06:37  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.4  1998/10/14 15:56:42  pierre
     * all references to comp suppressed for m68k
 
   Revision 1.3  1998/10/12 12:20:47  pierre

compiler/cg386add.pas

@@ -507,7 +507,10 @@ implementation
                        if p^.left^.treetype=ordconstn then
                         swaptree(p);
                        secondpass(p^.left);
-                       p^.location:=p^.left^.location;
+                       set_location(p^.location,p^.left^.location);
+                       {p^.location:=p^.left^.location;
+                       created a bug !!! PM
+                       because symbol was used twice }
                        { are enough registers free ? }
                        pushed:=maybe_push(p^.right^.registers32,p);
                        secondpass(p^.right);
@@ -1290,7 +1293,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  1998-10-09 11:47:45  pierre
+  Revision 1.18  1998-10-20 08:06:38  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.17  1998/10/09 11:47:45  pierre
     * still more memory leaks fixes !!
 
   Revision 1.16  1998/10/09 08:56:21  pierre

compiler/cg386cal.pas

@@ -1163,6 +1163,8 @@ implementation
                 emitcall(p^.procdefinition^.mangledname,
                   (p^.symtableproc^.symtabletype=unitsymtable) or
                   ((p^.symtableproc^.symtabletype=objectsymtable) and
+                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
+                  ((p^.symtableproc^.symtabletype=withsymtable) and
                   (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
               else { inlined proc }
                 { inlined code is in inlinecode }
@@ -1512,7 +1514,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  1998-10-16 08:51:45  peter
+  Revision 1.36  1998-10-20 08:06:39  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.35  1998/10/16 08:51:45  peter
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries
 

compiler/cg386inl.pas

@@ -814,12 +814,25 @@ implementation
                  end
                 else
                  begin
+                    { BUG HERE : detected with nasm :
+                      hregister is allways 32 bit
+                      it should be converted to 16 or 8 bit depending on op_size  PM }
+                    { still not perfect :
+                      if hregister is already a 16 bit reg ?? PM }
+                    case opsize of
+                      S_B : hregister:=reg32toreg8(hregister);
+                      S_W : hregister:=reg32toreg16(hregister);
+                    end;
                     if p^.left^.left^.location.loc=LOC_CREGISTER then
                       exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
                         hregister,p^.left^.left^.location.register)))
                     else
                       exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
                         hregister,newreference(p^.left^.left^.location.reference))));
+                    case opsize of
+                      S_B : hregister:=reg8toreg32(hregister);
+                      S_W : hregister:=reg16toreg32(hregister);
+                    end;
                    ungetregister32(hregister);
                  end;
                 emitoverflowcheck(p^.left^.left);
@@ -929,6 +942,7 @@ implementation
                         end
                       else
                         begin
+                           internalerror(10083);
                         end;
                    end;
               end;
@@ -941,7 +955,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  1998-10-13 16:50:02  pierre
+  Revision 1.14  1998-10-20 08:06:40  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.13  1998/10/13 16:50:02  pierre
     * undid some changes of Peter that made the compiler wrong
       for m68k (I had to reinsert some ifdefs)
     * removed several memory leaks under m68k

compiler/cg386mat.pas

@@ -348,7 +348,7 @@ implementation
 {$ifdef SUPPORT_MMX}
             LOC_MMXREGISTER:
               begin
-                 p^.location:=p^.left^.location;
+                 set_location(p^.location,p^.left^.location);
                  emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
                  do_mmx_neg;
               end;
@@ -488,7 +488,7 @@ implementation
                  { load operand }
                  case p^.left^.location.loc of
                     LOC_MMXREGISTER:
-                      p^.location:=p^.left^.location;
+                      set_location(p^.location,p^.left^.location);
                     LOC_CMMXREGISTER:
                       begin
                          p^.location.register:=getregistermmx;
@@ -561,7 +561,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  1998-10-09 08:56:24  pierre
+  Revision 1.9  1998-10-20 08:06:42  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.8  1998/10/09 08:56:24  pierre
     * several memory leaks fixed
 
   Revision 1.7  1998/09/17 09:42:17  peter

compiler/cg68kadd.pas

@@ -580,7 +580,7 @@ implementation
                        if p^.left^.treetype=ordconstn then
                         swaptree(p);
                        secondpass(p^.left);
-                       p^.location:=p^.left^.location;
+                       set_location(p^.location,p^.left^.location);
                        { are enough registers free ? }
                        pushed:=maybe_push(p^.right^.registers32,p);
                        secondpass(p^.right);
@@ -1279,7 +1279,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  1998-10-17 02:53:48  carl
+  Revision 1.13  1998-10-20 08:06:43  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.12  1998/10/17 02:53:48  carl
     * bugfix of FPU deallocation in $E- mode
 
   Revision 1.11  1998/10/14 11:28:15  florian

compiler/cg68kcal.pas

@@ -841,7 +841,11 @@ implementation
                 end
               else
                 emitcall(p^.procdefinition^.mangledname,
-                  p^.symtableproc^.symtabletype=unitsymtable);
+                  (p^.symtableproc^.symtabletype=unitsymtable) or
+                  ((p^.symtableproc^.symtabletype=objectsymtable) and
+                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
+                  ((p^.symtableproc^.symtabletype=withsymtable) and
+                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)));
               if ((p^.procdefinition^.options and poclearstack)<>0) then
                 begin
                    if (pushedparasize > 0) and (pushedparasize < 9) then
@@ -1052,7 +1056,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  1998-10-19 08:54:53  pierre
+  Revision 1.13  1998-10-20 08:06:45  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  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 !!!

compiler/cga68k.pas

@@ -1327,14 +1327,14 @@ end;
              if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
                begin
                  emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
-                 p^.location:=dest_loc;
+                 set_location(p^.location,dest_loc);
                  in_dest_loc:=true;
                end
              else
              if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
                begin
                  exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
-                 p^.location:=dest_loc;
+                 set_location(p^.location,dest_loc);
                  in_dest_loc:=true;
                end
              else
@@ -1346,7 +1346,17 @@ end;
 end.
 {
   $Log$
-  Revision 1.25  1998-10-16 13:12:48  pierre
+  Revision 1.26  1998-10-20 08:06:46  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.25  1998/10/16 13:12:48  pierre
     * added vmt_offsets in destructors code also !!!
     * vmt_offset code for m68k
 

compiler/msgtxt.inc

@@ -385,7 +385,7 @@ const msgtxt : array[0..00091,1..240] of char=(+
   'W_NEAR ignored'#000+
   'W_FAR ignored'#000+
   'D_Creating inline asm lookup tables'#000+
-  'W_Using a defined name as a local ','label'#000+
+  'E_Using a defined name as a local ','label'#000+
   'F_internal error in HandleExtend()'#000+
   'E_Invalid character: <'#000+
   'E_Invalid character: >'#000+

compiler/pstatmnt.pas

@@ -377,6 +377,7 @@ unit pstatmnt;
                               symtab^.next:=new(psymtable,init(symtable.withsymtable));
                               symtab:=symtab^.next;
                               symtab^.root:=obj^.publicsyms^.root;
+                              symtab^.defowner:=obj;
                               obj:=obj^.childof;
                               inc(levelcount);
                             end;
@@ -1203,8 +1204,8 @@ unit pstatmnt;
                   procinfo.framepointer:=R_SP;
 {$endif}
                   { set the right value for parameters }
-                  dec(aktprocsym^.definition^.parast^.call_offset,sizeof(pointer));
-                  dec(procinfo.call_offset,sizeof(pointer));
+                  dec(aktprocsym^.definition^.parast^.call_offset,target_os.size_of_pointer);
+                  dec(procinfo.call_offset,target_os.size_of_pointer);
               end;
             assembler_block:=_asm_statement;
           { becuase the END is already read we need to get the
@@ -1215,7 +1216,17 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.45  1998-10-19 08:55:01  pierre
+  Revision 1.46  1998-10-20 08:06:53  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  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 !!!

compiler/ptconst.pas

@@ -54,7 +54,7 @@ unit ptconst;
 {$ifdef m68k}
          j : longint;
 {$endif m68k}
-         p         : ptree;
+         p,hp      : ptree;
          i,l,offset,
          strlength : longint;
          lsym      : pvarsym;
@@ -166,6 +166,14 @@ unit ptconst;
            begin
               p:=comp_expr(true);
               do_firstpass(p);
+              { allows horrible ofs(typeof(TButton)^) code !! }
+              if (p^.treetype=addrn) and (p^.left^.treetype=derefn) then
+                begin
+                   hp:=p^.left^.left;
+                   p^.left^.left:=nil;
+                   disposetree(p);
+                   p:=hp;
+                end;
               { nil pointer ? }
               if p^.treetype=niln then
                 datasegment^.concat(new(pai_const,init_32bit(0)))
@@ -612,7 +620,17 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.21  1998-10-19 08:55:03  pierre
+  Revision 1.22  1998-10-20 08:06:56  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  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 !!!

compiler/ra386dir.pas

@@ -180,7 +180,7 @@ unit Ra386dir;
                                       else
 
                                         begin
-{$ifdef TESTGLOBALVAR}
+{$ifndef IGNOREGLOBALVAR}
                                            getsym(upper(hs),false);
                                            sym:=srsym;
                                            if assigned(sym) and (sym^.owner^.symtabletype in [unitsymtable,
@@ -262,7 +262,17 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.8  1998-09-04 08:42:08  peter
+  Revision 1.9  1998-10-20 08:06:57  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.8  1998/09/04 08:42:08  peter
     * updated some error messages
 
   Revision 1.7  1998/09/03 17:39:05  florian

compiler/symdef.inc

@@ -423,7 +423,7 @@
          string_typ:=st_longstring;
          deftype:=stringdef;
          len:=l;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -433,7 +433,7 @@
          deftype:=stringdef;
          string_typ:=st_longstring;
          len:=readlong;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -443,7 +443,7 @@
          string_typ:=st_ansistring;
          deftype:=stringdef;
          len:=l;
-         savesize:=sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -453,7 +453,7 @@
          deftype:=stringdef;
          string_typ:=st_ansistring;
          len:=readlong;
-         savesize:=sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -463,7 +463,7 @@
          string_typ:=st_widestring;
          deftype:=stringdef;
          len:=l;
-         savesize:=sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -473,7 +473,7 @@
          deftype:=stringdef;
          string_typ:=st_widestring;
          len:=readlong;
-         savesize:=sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1166,7 +1166,7 @@
          inherited init;
          deftype:=pointerdef;
          definition:=def;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1176,7 +1176,7 @@
          deftype:=pointerdef;
          { the real address in memory is calculated later (deref) }
          definition:=readdefref;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1254,7 +1254,7 @@
          inherited init(def);
          deftype:=classrefdef;
          definition:=def;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1409,7 +1409,7 @@
       begin
          inherited init;
          deftype:=formaldef;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1417,7 +1417,7 @@
       begin
          inherited load;
          deftype:=formaldef;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1690,13 +1690,21 @@
     procedure addname(p : psym);
     var
       news, newrec : pchar;
+      spec : string[2];
     begin
     { static variables from objects are like global objects }
     if ((p^.properties and sp_static)<>0) then
       exit;
+    if ((p^.properties and sp_protected)<>0) then
+      spec:='/1'
+    else if ((p^.properties and sp_private)<>0) then
+      spec:='/0'
+    else
+      spec:='';
+
     If p^.typ = varsym then
        begin
-       newrec := strpnew(p^.name+':'+pvarsym(p)^.definition^.numberstring
+       newrec := strpnew(p^.name+':'+spec+pvarsym(p)^.definition^.numberstring
                      +','+tostr(pvarsym(p)^.address*8)+','
                      +tostr(pvarsym(p)^.definition^.size*8)+';');
        if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
@@ -1718,6 +1726,7 @@
     function trecdef.stabstring : pchar;
       Var oldrec : pchar;
           oldsize : longint;
+          cur : psym;
       begin
         oldrec := stabrecstring;
         oldsize:=stabrecsize;
@@ -1725,11 +1734,20 @@
         stabrecsize:=memsizeinc;
         strpcopy(stabRecString,'s'+tostr(savesize));
         RecOffset := 0;
+{$ifdef nonextfield}
         {$ifdef tp}
           symtable^.foreach(addname);
         {$else}
           symtable^.foreach(@addname);
         {$endif}
+{$else nonextfield}
+         cur:=symtable^.root;
+         while assigned(cur) do
+           begin
+              addname(cur);
+              cur:=cur^.nextsym;
+           end;
+{$endif nonextfield}
         { FPC doesn't want to convert a char to a pchar}
         { is this a bug ? }
         strpcopy(strend(StabRecString),';');
@@ -1843,7 +1861,7 @@
          fpu_used:=0;
          options:=0;
          retdef:=voiddef;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
       end;
 
 
@@ -1915,7 +1933,7 @@
          options:=readlong;
          count:=readword;
          para1:=nil;
-         savesize:=Sizeof(pointer);
+         savesize:=target_os.size_of_pointer;
          for i:=1 to count do
            begin
               new(hp);
@@ -1942,9 +1960,9 @@
           begin
             case pdc^.paratyp of
               vs_value : inc(l,align(pdc^.data^.size,target_os.stackalignment));
-              vs_var   : inc(l,sizeof(pointer));
+              vs_var   : inc(l,target_os.size_of_pointer);
               vs_const : if dont_copy_const_param(pdc^.data) then
-                          inc(l,sizeof(pointer))
+                          inc(l,target_os.size_of_pointer)
                          else
                           inc(l,align(pdc^.data^.size,target_os.stackalignment));
             end;
@@ -2298,6 +2316,7 @@
       if i>0 then
         begin
         strpcopy(strend(StabRecString),','+tostr(i)+';');
+        (* confuse gdb !! PM
         if assigned(parast) then
           {$IfDef TP}
           parast^.foreach(addparaname)
@@ -2318,7 +2337,7 @@
                +':'+param^.data^.numberstring+','+vartyp+';');
             param := param^.next;
             end;
-          end;
+          end;   *)
         {strpcopy(strend(StabRecString),';');}
         end;
       stabstring := strnew(stabrecstring);
@@ -2444,9 +2463,9 @@
     function tprocvardef.size : longint;
       begin
          if (options and pomethodpointer)=0 then
-           size:=sizeof(pointer)
+           size:=target_os.size_of_pointer
          else
-           size:=2*sizeof(pointer);
+           size:=2*target_os.size_of_pointer;
       end;
 
 
@@ -2540,7 +2559,7 @@
         publicsyms^.name := stringdup(n);
         { create space for vmt !! }
 {$ifdef OLDVMTSTYLE}
-        publicsyms^.datasize:=Sizeof(pointer);
+        publicsyms^.datasize:=target_os.size_of_pointer;
         options:=oo_hasvmt;
         vmt_offset:=0;
 {$else }
@@ -2573,7 +2592,7 @@
                +childof^.publicsyms^.datasize;
              if ((options and oo_hasvmt)<>0) and
                 ((c^.options and oo_hasvmt)<>0) then
-               publicsyms^.datasize:=publicsyms^.datasize-Sizeof(pointer);
+               publicsyms^.datasize:=publicsyms^.datasize-target_os.size_of_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
@@ -2633,7 +2652,7 @@
                     publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
                end;
              vmt_offset:=publicsyms^.datasize;
-             publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
+             publicsyms^.datasize:=publicsyms^.datasize+target_os.size_of_pointer;
              options:=options or oo_hasvmt;
           end;
      end;
@@ -2688,7 +2707,7 @@
    function tobjectdef.size : longint;
      begin
         if (options and oo_is_class)<>0 then
-          size:=sizeof(pointer)
+          size:=target_os.size_of_pointer
 
         else
           size:=publicsyms^.datasize;
@@ -2873,6 +2892,9 @@
           oldrec : pchar;
           oldrecsize : longint;
           str_end : string;
+{$ifndef nonextfield}
+          cur : psym;
+{$endif nonextfield}
       begin
         oldrec := stabrecstring;
         oldrecsize:=stabrecsize;
@@ -2885,22 +2907,40 @@
           strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
         {virtual table to implement yet}
         RecOffset := 0;
-      {$ifdef tp}
-         publicsyms^.foreach(addname);
-      {$else}
-         publicsyms^.foreach(@addname);
-      {$endif tp}
+{$ifdef nonextfield}
+        {$ifdef tp}
+          publicsyms^.foreach(addname);
+        {$else}
+          publicsyms^.foreach(@addname);
+        {$endif}
+{$else nonextfield}
+         cur:=publicsyms^.root;
+         while assigned(cur) do
+           begin
+              addname(cur);
+              cur:=cur^.nextsym;
+           end;
+{$endif nonextfield}
       if (options and oo_hasvmt) <> 0 then
         if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
            begin
               strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
                 +','+tostr(vmt_offset*8)+';');
            end;
+{$ifdef nonextfield}
         {$ifdef tp}
           publicsyms^.foreach(addprocname);
         {$else}
           publicsyms^.foreach(@addprocname);
         {$endif tp }
+{$else nonextfield}
+         cur:=publicsyms^.root;
+         while assigned(cur) do
+           begin
+              addprocname(cur);
+              cur:=cur^.nextsym;
+           end;
+{$endif nonextfield}
         if (options and oo_hasvmt) <> 0  then
           begin
              anc := @self;
@@ -3141,7 +3181,17 @@
 
 {
   $Log$
-  Revision 1.61  1998-10-19 08:55:05  pierre
+  Revision 1.62  1998-10-20 08:06:58  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  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 !!!

compiler/symppu.inc

@@ -307,7 +307,6 @@
       end;
 
 
-{$ifdef UseBrowser}
     function readsymref : psym;
       var
         hd : psym;
@@ -316,7 +315,6 @@
         longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
         readsymref:=hd;
       end;
-{$endif}
 
 
     procedure readsourcefiles;
@@ -445,7 +443,17 @@
 
 {
   $Log$
-  Revision 1.23  1998-10-16 13:37:24  florian
+  Revision 1.24  1998-10-20 08:06:59  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.23  1998/10/16 13:37:24  florian
     + switch -FD added to specify the path for utilities
 
   Revision 1.22  1998/10/14 13:38:24  peter

compiler/symsym.inc

@@ -28,6 +28,9 @@
       begin
          left:=nil;
          right:=nil;
+{$ifdef nextfield}
+          nextsym:=nil;
+{$endif nextfield}
          setname(n);
          typ:=abstractsym;
          properties:=current_object_option;
@@ -214,7 +217,7 @@
          setstring(_name,s);
       end;
 
-    { for most symbol types ther is nothing to do at all }
+    { for most symbol types there is nothing to do at all }
     procedure tsym.insert_in_data;
       begin
       end;
@@ -944,30 +947,30 @@
               case varspez of
                  vs_value : begin
                               if is_open_array(definition) then
-                                getsize:=sizeof(pointer)+4
+                                getsize:=target_os.size_of_pointer+target_os.size_of_longint
                               else
                                 getsize:=definition^.size;
                             end;
                    vs_var : begin
                             { open arrays push also the high valye }
                               if is_open_array(definition) then
-                                getsize:=sizeof(pointer)+4
+                                getsize:=target_os.size_of_pointer+target_os.size_of_pointer
                               else
-                                getsize:=sizeof(pointer);
+                                getsize:=target_os.size_of_pointer;
                             end;
                  vs_const : begin
                               case definition^.deftype of
                              stringdef,
                              recorddef,
                              objectdef,
-                                setdef : getsize:=sizeof(pointer);
+                                setdef : getsize:=target_os.size_of_pointer;
                               arraydef : begin
                                          { open arrays push also the high valye }
                                            if (parraydef(definition)^.lowrange=0) and
                                               (parraydef(definition)^.highrange=-1) then
-                                             getsize:=sizeof(pointer)+4
+                                             getsize:=target_os.size_of_pointer+target_os.size_of_pointer
                                            else
-                                             getsize:=sizeof(pointer);
+                                             getsize:=target_os.size_of_pointer;
                                          end;
                               else
                                getsize:=definition^.size;
@@ -1712,7 +1715,17 @@
 
 {
   $Log$
-  Revision 1.54  1998-10-19 08:55:07  pierre
+  Revision 1.55  1998-10-20 08:07:00  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  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 !!!

compiler/symsymh.inc

@@ -39,6 +39,9 @@
           typ        : tsymtyp;
           _name      : pchar;
           left,right : psym;
+{$ifndef nonextfield}
+          nextsym    : psym;
+{$endif nextfield}
           speedvalue : longint;
           properties : symprop;
           owner      : psymtable;
@@ -315,7 +318,17 @@
 
 {
   $Log$
-  Revision 1.3  1998-10-08 17:17:34  pierre
+  Revision 1.4  1998-10-20 08:07:02  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.3  1998/10/08 17:17:34  pierre
     * current_module old scanner tagged as invalid if unit is recompiled
     + added ppheap for better info on tracegetmem of heaptrc
       (adds line column and file index)

compiler/systems.pas

@@ -120,7 +120,9 @@ unit systems;
           Cprefix   : string[2];
           newline   : string[2];
           endian    : tendian;
-          stackalignment : longint;
+          stackalignment : {longint this is a little overkill no ?? }byte;
+          size_of_pointer : byte;
+          size_of_longint : byte;
           use_function_relative_addresses : boolean;
        end;
 
@@ -222,6 +224,8 @@ implementation
             newline      : #13#10;
             endian       : endian_little;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : true
           ),
           (
@@ -238,6 +242,8 @@ implementation
             newline      : #13#10;
             endian       : endian_little;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : true
           ),
           (
@@ -254,6 +260,8 @@ implementation
             newline      : #10;
             endian       : endian_little;
             stackalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : true
           ),
           (
@@ -270,6 +278,8 @@ implementation
             newline      : #13#10;
             endian       : endian_little;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : false
           ),
           (
@@ -286,6 +296,8 @@ implementation
             newline      : #13#10;
             endian       : endian_little;
             stackalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : true
           ),
           (
@@ -302,6 +314,8 @@ implementation
             newline      : #10;
             endian       : endian_big;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : false
           ),
           (
@@ -318,6 +332,8 @@ implementation
             newline      : #10;
             endian       : endian_big;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : false
           ),
           (
@@ -334,6 +350,8 @@ implementation
             newline      : #13;
             endian       : endian_big;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : false
           ),
           (
@@ -350,6 +368,8 @@ implementation
             newline      : #10;
             endian       : endian_big;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : true
           ),
           (
@@ -366,6 +386,8 @@ implementation
             newline      : #10;
             endian       : endian_big;
             stackalignment : 2;
+            size_of_pointer : 4;
+            size_of_longint : 4;
             use_function_relative_addresses : false
           )
           );
@@ -1152,7 +1174,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  1998-10-16 08:51:54  peter
+  Revision 1.47  1998-10-20 08:07:04  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.46  1998/10/16 08:51:54  peter
     + target_os.stackalignment
     + stack can be aligned at 2 or 4 byte boundaries
 

compiler/tcadd.pas

@@ -509,13 +509,23 @@ implementation
                 if (psetdef(ld)^.settype<>smallset) and
                    (psetdef(rd)^.settype=smallset) then
                  begin
-                   p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
+                   if (p^.right^.treetype=setconstn) then
+                     begin
+                        t:=gensetconstnode(p^.right^.value_set,psetdef(p^.left^.resulttype));
+                        t^.left:=p^.right^.left;
+                        putnode(p^.right);
+                        p^.right:=t;
+                     end
+                   else
+                     p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
                    firstpass(p^.right);
                  end;
 
-                { do constant evalution }
+                { do constant evaluation }
                 if (p^.right^.treetype=setconstn) and
-                   (p^.left^.treetype=setconstn) then
+                   not assigned(p^.right^.left) and
+                   (p^.left^.treetype=setconstn) and
+                   not assigned(p^.left^.left) then
                   begin
                      new(resultset);
                      case p^.treetype of
@@ -905,7 +915,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-10-14 12:53:39  peter
+  Revision 1.5  1998-10-20 08:07:05  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.4  1998/10/14 12:53:39  peter
     * fixed small tp7 things
     * boolean:=longbool and longbool fixed
 

compiler/tree.pas

@@ -308,7 +308,7 @@ unit tree;
   implementation
 
     uses
-       verbose,files,types;
+       systems,verbose,files,types;
 
 
     function getnode : ptree;
@@ -1151,7 +1151,7 @@ unit tree;
          p^.para_offset:=0;
          p^.para_size:=p^.inlineprocdef^.para_size;
          if ret_in_param(p^.inlineprocdef^.retdef) then
-           p^.para_size:=p^.para_size+sizeof(pointer);
+           p^.para_size:=p^.para_size+target_os.size_of_pointer;
          { copy args }
          p^.left:=getcopy(code);
          p^.registers32:=code^.registers32;
@@ -1620,7 +1620,17 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.46  1998-10-08 17:17:37  pierre
+  Revision 1.47  1998-10-20 08:07:07  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.46  1998/10/08 17:17:37  pierre
     * current_module old scanner tagged as invalid if unit is recompiled
     + added ppheap for better info on tracegetmem of heaptrc
       (adds line column and file index)