* demangled name of procsym reworked to become independant of the mangling scheme

Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

compiler/cgi386.pas

@@ -4203,6 +4203,8 @@ do_jmp:
 
       begin
          exprasmlist^.concatlist(p^.p_asm);
+         if not p^.object_preserved then
+           maybe_loadesi;
        end;
 
     procedure secondcase(var p : ptree);
@@ -5059,7 +5061,12 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.31  1998-06-03 22:48:52  peter
+  Revision 1.32  1998-06-04 09:55:35  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.31  1998/06/03 22:48:52  peter
     + wordbool,longbool
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas

compiler/hcodegen.pas

@@ -50,6 +50,8 @@ unit hcodegen;
           _class : pobjectdef;
           { return type }
           retdef : pdef;
+          { return type }
+          sym : pprocsym;
           { the definition of the proc itself }
           def : pdef;
           { frame pointer offset }
@@ -392,7 +394,12 @@ end.
 
 {
   $Log$
-  Revision 1.6  1998-05-23 01:21:08  peter
+  Revision 1.7  1998-06-04 09:55:38  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.6  1998/05/23 01:21:08  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in

compiler/pass_1.pas

@@ -500,7 +500,7 @@ unit pass_1;
               putnode(p);
               p:=genzeronode(funcretn);
               p^.funcretprocinfo:=pprocinfo(pfuncretsym(p^.symtableentry)^.funcretprocinfo);
-              p^.retdef:=pfuncretsym(p^.symtableentry)^.retdef;
+              p^.retdef:=pfuncretsym(p^.symtableentry)^.funcretdef;
               firstpass(p);
               exit;
            end;
@@ -2568,6 +2568,48 @@ unit pass_1;
 
     { *************** subroutine handling **************** }
 
+    { protected field handling
+      protected field can not appear in
+      var parameters of function !!
+      this can only be done after we have determined the
+      overloaded function
+      this is the reason why it is not in the parser
+       PM }
+      
+    procedure test_protected_sym(sym : psym);
+
+      begin
+         if ((sym^.properties and sp_protected)<>0) and
+           ((sym^.owner^.symtabletype=unitsymtable) or
+            ((sym^.owner^.symtabletype=objectsymtable) and
+           (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then
+          Message(parser_e_cant_access_protected_member);
+      end;
+      
+    procedure test_protected(p : ptree);
+
+      begin
+         if p^.treetype=loadn then
+           begin
+              test_protected_sym(p^.symtableentry);
+           end
+         else if p^.treetype=typeconvn then
+           begin
+              test_protected(p^.left);
+           end
+         else if p^.treetype=derefn then
+           begin
+              test_protected(p^.left);
+           end
+         else if p^.treetype=subscriptn then
+           begin
+              { test_protected(p^.left);
+               Is a field of a protected var
+                also protected ???  PM }
+              test_protected_sym(p^.vs);
+           end;
+      end;
+      
     procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
 
       var store_valid : boolean;
@@ -2612,6 +2654,8 @@ unit pass_1;
                if count_ref then
                  begin
                     store_valid:=must_be_valid;
+                    if (defcoll^.paratyp=vs_var) then
+                      test_protected(p^.left);
                     if (defcoll^.paratyp<>vs_var) then
                       must_be_valid:=true
                     else
@@ -3356,14 +3400,17 @@ unit pass_1;
 
     procedure firstfuncret(var p : ptree);
 
-          begin
+      begin
 {$ifdef TEST_FUNCRET}
-             p^.resulttype:=p^.retdef;
+         p^.resulttype:=p^.retdef;
-             p^.location.loc:=LOC_REFERENCE;
+         p^.location.loc:=LOC_REFERENCE;
-             if ret_in_param(p^.retdef) or
+         if ret_in_param(p^.retdef) or
-                (@procinfo<>pprocinfo(p^.funcretprocinfo)) then
+            (@procinfo<>pprocinfo(p^.funcretprocinfo)) then
-               p^.registers32:=1;
+           p^.registers32:=1;
-         if must_be_valid and not pprocinfo(p^.funcretprocinfo)^.funcret_is_valid then
+         { no claim if setting higher return values }
+         if must_be_valid and
+            (@procinfo=pprocinfo(p^.funcretprocinfo)) and
+            not procinfo.funcret_is_valid then
            note(uninitialized_function_return);
          if count_ref then pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
 {$else TEST_FUNCRET}
@@ -4949,7 +4996,12 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.25  1998-06-03 22:48:57  peter
+  Revision 1.26  1998-06-04 09:55:39  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.25  1998/06/03 22:48:57  peter
     + wordbool,longbool
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas
@@ -4992,7 +5044,6 @@ end.
     * UseBrower updated gives a global list of all position of all used symbols
       with switch -gb
 
->>>>>>> h:/cvs/compiler/PASS_1.pas
   Revision 1.18  1998/05/11 13:07:55  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required

compiler/pexpr.pas

@@ -599,9 +599,11 @@ unit pexpr;
               if ((sym^.properties and sp_private)<>0) and
                  (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
                 Message(parser_e_cant_access_private_member);
+              { this is wrong protected should not be overwritten but
+              can be called !! PM
               if ((sym^.properties and sp_protected)<>0) and
                 (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
-               Message(parser_e_cant_access_protected_member);
+               Message(parser_e_cant_access_protected_member); }
               { we assume, that only procsyms and varsyms are in an object }
               { symbol table, for classes, properties are allowed          }
               case sym^.typ of
@@ -616,6 +618,11 @@ unit pexpr;
                    end;
                  varsym:
                    begin
+                      if ((sym^.properties and sp_protected)<>0) and
+                         (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) and
+                         not(afterassignment) and
+                         not(in_args) then
+                         Message(parser_e_cant_access_protected_member);
                       if isclassref then
                         Message(parser_e_only_class_methods_via_class_ref);
                       if (sym^.properties and sp_static)<>0 then
@@ -918,6 +925,39 @@ unit pexpr;
          p^[l]:=p^[l] or (1 shl (pos mod 8));
       end;
 
+{$ifdef TEST_FUNCRET}
+    function is_func_ret(sym : psym) : boolean;
+    var
+       p : pprocinfo;
+       
+      begin
+         p:=@procinfo;
+         is_func_ret:=false;
+         while assigned(p) do
+           begin
+              { is this an access to a function result ? }
+              if assigned(aktprocsym) and
+                 ((sym^.name=aktprocsym^.name) or
+                 ((pvarsym(srsym)=opsym) and
+                 ((p^.flags and pi_operator)<>0))) and
+                 (p^.retdef<>pdef(voiddef)) and
+                 (token<>LKLAMMER) and
+                 (not ((cs_tp_compatible in aktswitches) and
+                 (afterassignment or in_args))) then
+                begin
+                   p1:=genzeronode(funcretn);
+                   pd:=p^.retdef;
+                   p1^.funcretprocinfo:=p;
+                   p1^.retdef:=pd;
+                   is_func_ret:=true;
+                   exit;
+                end;
+              p:=p^.parent;
+           end;
+      end;
+{$endif TEST_FUNCRET}
+           
+
       var
          possible_error : boolean;
 
@@ -953,6 +993,7 @@ unit pexpr;
                       else
                         getsym(pattern,true);
                       consume(ID);
+{$ifndef TEST_FUNCRET}
                       { is this an access to a function result ? }
                        if assigned(aktprocsym) and
                         ((srsym^.name=aktprocsym^.name) or
@@ -965,12 +1006,11 @@ unit pexpr;
                         begin
                            p1:=genzeronode(funcretn);
                            pd:=procinfo.retdef;
-{$ifdef TEST_FUNCRET}
-                           p1^.funcretprocinfo:=pointer(@procinfo);
-                           p1^.retdef:=pd;
-{$endif TEST_FUNCRET}
                         end
                       else
+{$else TEST_FUNCRET}
+                    if not is_func_ret(srsym) then
+{$endif TEST_FUNCRET}
                         { else it's a normal symbol }
                         begin
                            if srsym^.typ=unitsym then
@@ -1752,7 +1792,12 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.22  1998-06-02 17:03:03  pierre
+  Revision 1.23  1998-06-04 09:55:40  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.22  1998/06/02 17:03:03  pierre
     *  with node corrected for objects
     * small bugs for SUPPORT_MMX fixed
 

compiler/pmodules.pas

@@ -312,8 +312,8 @@ unit pmodules;
               { but for the implementation part          }
               { the written crc is false, because        }
               { not defined when writing the ppufile !!  }
-              (* if {(loaded_unit^.crc<>checksum) or}
+{$ifdef TEST_IMPL}
-                (do_build and loaded_unit^.sources_avail) then
+              if (loaded_unit^.crc<>0) and (loaded_unit^.crc<>checksum) then
                 begin
                    { we have to compile the current unit }
                    { remove stuff which isn't needed     }
@@ -324,7 +324,7 @@ unit pmodules;
                    dispose(hp^.ppufile,done);
                    hp^.ppufile:=nil;
                    if not(hp^.sources_avail) then
-                    Message1(unit_f_cant_compile_unit,hp^.unitname^)
+                    Message1(unit_f_cant_compile_unit,hp^.modulename^)
                    else
                      begin
                         oldhp^.current_inputfile^.tempclose;
@@ -332,7 +332,8 @@ unit pmodules;
                         oldhp^.current_inputfile^.tempclose;
                      end;
                    exit;
-                end; *)
+                end;
+{$endif TEST_IMPL}
               { read until ibend }
               hp^.ppufile^.read_data(b,1,count);
            end;
@@ -516,7 +517,7 @@ unit pmodules;
          consume(SEMICOLON);
 
          { now insert the units in the symtablestack }
-         hp:=pused_unit(current_module^.used_units.first);
+          hp:=pused_unit(current_module^.used_units.first);
          { set the symtable to systemunit so it gets reorderd correctly }
          symtablestack:=systemunit;
          while assigned(hp) do
@@ -981,7 +982,12 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.19  1998-06-03 23:40:38  peter
+  Revision 1.20  1998-06-04 09:55:42  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.19  1998/06/03 23:40:38  peter
     + unlimited file support, release tempclose
 
   Revision 1.18  1998/06/03 22:49:00  peter

compiler/pstatmnt.pas

@@ -584,6 +584,8 @@ unit pstatmnt;
 {$ifdef i386}
     function _asm_statement : ptree;
 
+      var asm_stat : ptree;
+      
       begin
          if (aktprocsym^.definition^.options and poinline)<>0 then
            Begin
@@ -592,9 +594,9 @@ unit pstatmnt;
               aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
            End;
          case aktasmmode of
-            I386_ATT : _asm_statement:=ratti386.assemble;
+            I386_ATT : asm_stat:=ratti386.assemble;
-            I386_INTEL : _asm_statement:=rai386.assemble;
+            I386_INTEL : asm_stat:=rai386.assemble;
-            I386_DIRECT : _asm_statement:=radi386.assemble;
+            I386_DIRECT : asm_stat:=radi386.assemble;
             else internalerror(30004);
          end;
 
@@ -607,6 +609,7 @@ unit pstatmnt;
            begin
               { it's possible to specify the modified registers }
               consume(LECKKLAMMER);
+              asm_stat^.object_preserved:=true;
               if token<>RECKKLAMMER then
                 repeat
                   pattern:=upper(pattern);
@@ -619,7 +622,10 @@ unit pstatmnt;
                   else if pattern='EDX' then
                     usedinproc:=usedinproc or ($80 shr byte(R_EDX))
                   else if pattern='ESI' then
-                    usedinproc:=usedinproc or ($80 shr byte(R_ESI))
+                    begin
+                       usedinproc:=usedinproc or ($80 shr byte(R_ESI));
+                       asm_stat^.object_preserved:=false;
+                    end
                   else if pattern='EDI' then
                     usedinproc:=usedinproc or ($80 shr byte(R_EDI))
                   else consume(RECKKLAMMER);
@@ -630,6 +636,7 @@ unit pstatmnt;
               consume(RECKKLAMMER);
            end
          else usedinproc:=$ff;
+         _asm_statement:=asm_stat;
       end;
 {$endif}
 
@@ -1138,34 +1145,15 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.16  1998-06-02 17:03:04  pierre
+  Revision 1.17  1998-06-04 09:55:43  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.16  1998/06/02 17:03:04  pierre
     *  with node corrected for objects
     * small bugs for SUPPORT_MMX fixed
 
-<<<<<<< PSTATMNT.pas
-  Revision 1.14  1998/05/29 09:58:14  pierre
-    * OPR_REGISTER for 1 arg was missing in ratti386.pas
-      (probably a merging problem)
-    * errors at start of line were lost
-
-  Revision 1.13  1998/05/28 17:26:50  peter
-    * fixed -R switch, it didn't work after my previous akt/init patch
-    * fixed bugs 110,130,136
-
-  Revision 1.12  1998/05/21 19:33:33  peter
-    + better procedure directive handling and only one table
-
-  Revision 1.11  1998/05/20 09:42:35  pierre
-    + UseTokenInfo now default
-    * unit in interface uses and implementation uses gives error now
-    * only one error for unknown symbol (uses lastsymknown boolean)
-      the problem came from the label code !
-    + first inlined procedures and function work
-      (warning there might be allowed cases were the result is still wrong !!)
-    * UseBrower updated gives a global list of all position of all used symbols
-      with switch -gb
-
-=======
   Revision 1.15  1998/05/30 14:31:06  peter
     + $ASMMODE
 
@@ -1191,7 +1179,6 @@ end.
     * UseBrower updated gives a global list of all position of all used symbols
       with switch -gb
 
->>>>>>> h:/cvs/compiler/PSTATMNT.pas
   Revision 1.10  1998/05/11 13:07:56  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
@@ -1240,3 +1227,4 @@ end.
       and creates wrong assembler files !!)
       procsym types sym in tdef removed !!
 }
+

compiler/symdef.inc

@@ -1556,6 +1556,33 @@
            end;
       end;
 
+    function tabstractprocdef.demangled_paras : string;
+      var s : string;
+          p : pdefcoll;
+      begin
+        s:='';
+        p:=para1;
+        if assigned(p) then
+          begin
+             s:=s+'(';
+             while assigned(p) do
+               begin
+                  if assigned(p^.data^.sym) then
+                    s:=s+p^.data^.sym^.name
+                  else if p^.paratyp=vs_var then
+                    s:=s+'var'
+                  else if p^.paratyp=vs_const then
+                    s:=s+'const';
+                  p:=p^.next;
+                  if assigned(p) then
+                    s:=s+','
+                  else
+                    s:=s+')';
+               end;
+          end;
+        demangled_paras:=s;
+      end;
+
 {$ifdef GDB}
     function tabstractprocdef.stabstring : pchar;
       begin
@@ -2263,8 +2290,13 @@
                  while assigned(para) do
                    begin
                    if para^.data^.deftype = formaldef then
-                     argnames := argnames+'3var'
+                     begin
-                     else
+                        if para^.paratyp=vs_var then
+                          argnames := argnames+'3var'
+                        else if para^.paratyp=vs_const then
+                          argnames:=argnames+'5const';
+                     end
+                   else
                      begin
                      { if the arg definition is like (v: ^byte;..
                      there is no sym attached to data !!! }
@@ -2375,7 +2407,12 @@
 
 {
   $Log$
-  Revision 1.3  1998-06-03 22:49:03  peter
+  Revision 1.4  1998-06-04 09:55:45  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.3  1998/06/03 22:49:03  peter
     + wordbool,longbool
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas

compiler/symsym.inc

@@ -533,7 +533,7 @@
 
     function tprocsym.demangledname:string;
       begin
-        demangledname:=name+'('+demangledparas(definition^.mangledname)+')';
+        demangledname:=name+definition^.demangled_paras;
       end;
 
 
@@ -550,10 +550,10 @@
                 begin
 {$ifdef GDB}
                    if assigned(pd^._class) then
-                    Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+'('+demangledparas(pd^.mangledname)+')')
+                     Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
-                     else
+                   else
 {$endif GDB}
-                    Message1(sym_e_forward_not_resolved,demangledname)
+                     Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras)
                 end;
               pd:=pd^.nextoverloaded;
            end;
@@ -758,15 +758,15 @@
 ****************************************************************************}
 
 {$ifdef TEST_FUNCRET}
-    constructor tfuncretsym.init(const n : string;approcinfo : pprocinfo);
+    constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
 
       begin
          tsym.init(n);
          funcretprocinfo:=approcinfo;
-         funcretdef:=approcinfo^.retdef;
+         funcretdef:=pprocinfo(approcinfo)^.retdef;
          { address valid for ret in param only }
          { otherwise set by insert             }
-         address:=approcinfo^.retoffset;
+         address:=pprocinfo(approcinfo)^.retoffset;
       end;
 {$endif TEST_FUNCRET}
 
@@ -1690,7 +1690,12 @@
 
 {
   $Log$
-  Revision 1.3  1998-06-03 22:14:20  florian
+  Revision 1.4  1998-06-04 09:55:46  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.3  1998/06/03 22:14:20  florian
     * problem with sizes of classes fixed (if the anchestor was declared
       forward, the compiler doesn't update the child classes size)
 

compiler/tree.pas

@@ -228,7 +228,7 @@ unit tree;
                             retoffset,para_offset,para_size : longint);
              setconstrn : (constset : pconstset);
              loopn : (t1,t2 : ptree;backward : boolean);
-             asmn : (p_asm : paasmoutput);
+             asmn : (p_asm : paasmoutput;object_preserved : boolean);
              casen : (nodes : pcaserecord;elseblock : ptree);
              labeln,goton : (labelnr : plabel);
              withn : (withsymtable : psymtable;tablecount : longint);
@@ -294,6 +294,9 @@ unit tree;
   implementation
 
     uses
+{$ifdef extdebug}
+       types,
+{$endif extdebug}
        verbose,files;
 
 {****************************************************************************
@@ -887,6 +890,7 @@ unit tree;
          p^.treetype:=asmn;
          p^.registers32:=4;
          p^.p_asm:=p_asm;
+         p^.object_preserved:=false;
 {         p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=8;
@@ -1534,7 +1538,12 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.12  1998-06-03 22:49:06  peter
+  Revision 1.13  1998-06-04 09:55:49  pierre
+    * demangled name of procsym reworked to become independant of the mangling scheme
+
+  Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
+
+  Revision 1.12  1998/06/03 22:49:06  peter
     + wordbool,longbool
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas