Prechádzať zdrojové kódy

* fixes for inline for operators
* inline procedure more correctly restricted

pierre 27 rokov pred
rodič
commit
1a44be1502

+ 24 - 10
compiler/cgi386.pas

@@ -1623,11 +1623,14 @@ implementation
               { set it to the same lexical level }
               p^.procdefinition^.parast^.symtablelevel:=
                 aktprocsym^.definition^.parast^.symtablelevel;
-              if assigned(p^.left) then
+              if inlinecode^.para_size>0 then
                 inlinecode^.para_offset:=
                   gettempofsizepersistant(inlinecode^.para_size);
+              inlinecode^.retoffset:=inlinecode^.para_offset;
               p^.procdefinition^.parast^.call_offset:=
                 inlinecode^.para_offset;
+              if ret_in_param(p^.procdefinition^.retdef) then
+                inc(p^.procdefinition^.parast^.call_offset,sizeof(pointer));
 {$ifdef extdebug}
              Comment(V_debug,
                'inlined parasymtable is at offset '
@@ -1726,14 +1729,22 @@ implementation
          params:=p^.left;
          p^.left:=nil;
          if inlined then
-           inlinecode^.retoffset:=gettempofsizepersistant(4);
+           begin
+              inlinecode^.retoffset:=inlinecode^.para_offset;
+           end;
          if ret_in_param(p^.resulttype) then
            begin
               inc(pushedparasize,4);
               if inlined then
                 begin
+{$ifdef extdebug}
+                   exprasmlist^.concat(new(pai_asm_comment,init(
+                     strpnew('inlined func ret address is at offset '
+                     +tostr(inlinecode^.retoffset)))));
+{$endif extdebug}
                    exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
                      newreference(funcretref),R_EDI)));
+
                    r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
                      R_EDI,r)));
@@ -2092,8 +2103,9 @@ implementation
                    { set poinline again }
                    p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
                    { free the args }
-                   ungetpersistanttemp(p^.procdefinition^.parast^.call_offset,
-                     p^.procdefinition^.parast^.datasize);
+                   if inlinecode^.para_size>0 then
+                     ungetpersistanttemp(inlinecode^.para_offset,
+                       inlinecode^.para_size);
                 end;
               if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
                 begin
@@ -2309,8 +2321,7 @@ implementation
                   ungetiftemp(pp^.left^.location.reference);
               pp:=pp^.right;
            end;
-         if inlined then
-           ungetpersistanttemp(inlinecode^.retoffset,4);
+
          disposetree(params);
 
 
@@ -3185,7 +3196,7 @@ implementation
     procedure secondhnewn(var p : ptree);
 
       begin
-       end;
+      end;
 
     procedure secondnewn(var p : ptree);
 
@@ -5034,8 +5045,7 @@ do_jmp:
               do_secondpass(p);
 
 {$ifdef StoreFPULevel}
-              if assigned(aktprocsym) then
-                aktprocsym^.fpu_used:=p^.registersfpu;
+              procinfo.def^.fpu_used:=p^.registersfpu;
 {$endif StoreFPULevel}
               { all registers can be used again }
               usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
@@ -5053,7 +5063,11 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.33  1998-06-04 23:51:37  peter
+  Revision 1.34  1998-06-05 14:37:27  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.33  1998/06/04 23:51:37  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

+ 8 - 2
compiler/makefile

@@ -64,7 +64,9 @@ REPLACE=mv -f
 CP=cp -f
 else
 EXEEXT=.exe
-REPLACE=mv -f
+# mv -f gives problem under dos 
+# claiming source and destinaztion are the same files !
+REPLACE=copy /y
 CP=cp -f
 endif
 
@@ -415,7 +417,11 @@ rtlclean :
 # Test of log at the end
 # does CVS add # at start of each line ??
 # $Log$
-# Revision 1.15  1998-06-03 09:33:39  michael
+# Revision 1.16  1998-06-05 14:37:28  pierre
+#   * fixes for inline for operators
+#   * inline procedure more correctly restricted
+#
+# Revision 1.15  1998/06/03 09:33:39  michael
 # added distclean target to remove ppc1-ppc3 too
 #
 # Revision 1.14  1998/06/03 09:27:51  michael

+ 29 - 15
compiler/pass_1.pas

@@ -167,6 +167,8 @@ unit pass_1;
              (p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]);
         end;
 
+    function is_assignment_overloaded(from_def,to_def : pdef) : boolean;forward;
+    
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
              explicit : boolean) : boolean;
@@ -286,6 +288,9 @@ unit pass_1;
                 end;
               b:=true;
            end
+         { assignment overwritten ?? }
+         else if is_assignment_overloaded(def_from,def_to) then
+           b:=true
          else if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and
                  (parraydef(def_to)^.lowrange=0) and
                  is_equal(ppointerdef(def_from)^.definition,
@@ -2268,15 +2273,18 @@ unit pass_1;
      function is_assignment_overloaded(from_def,to_def : pdef) : boolean;
        var
           passproc : pprocdef;
+          convtyp : tconverttype;
        begin
           is_assignment_overloaded:=false;
           if assigned(overloaded_operators[assignment]) then
             passproc:=overloaded_operators[assignment]^.definition
           else
-            passproc:=nil;
+            exit;
           while passproc<>nil do
             begin
-              if (passproc^.retdef=to_def) and (passproc^.para1^.data=from_def) then
+              if is_equal(passproc^.retdef,to_def) and
+                 isconvertable(from_def,passproc^.para1^.data,convtyp,
+                   ordconstn { nur Dummy},false ) then
                 begin
                    is_assignment_overloaded:=true;
                    break;
@@ -2352,19 +2360,19 @@ unit pass_1;
        p^.registersmmx:=p^.left^.registersmmx;
 {$endif}
        set_location(p^.location,p^.left^.location);
+       if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
+         begin
+            procinfo.flags:=procinfo.flags or pi_do_call;
+            hp:=gencallnode(overloaded_operators[assignment],nil);
+            hp^.left:=gencallparanode(p^.left,nil);
+            putnode(p);
+            p:=hp;
+            firstpass(p);
+            exit;
+         end;
        if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
            p^.convtyp,p^.left^.treetype,p^.explizit))) then
          begin
-            if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
-              begin
-                 procinfo.flags:=procinfo.flags or pi_do_call;
-                 hp:=gencallnode(overloaded_operators[assignment],nil);
-                 hp^.left:=gencallparanode(p^.left,nil);
-                 putnode(p);
-                 p:=hp;
-                 firstpass(p);
-                 exit;
-              end;
            {Procedures have a resulttype of voiddef and functions of their
            own resulttype. They will therefore always be incompatible with
            a procvar. Because isconvertable cannot check for procedures we
@@ -2539,7 +2547,9 @@ unit pass_1;
                      { the conversion into a strutured type is only }
                      { possible, if the source is no register         }
                      if (p^.resulttype^.deftype in [recorddef,stringdef,arraydef,objectdef]) and
-                        (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                        (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
+                        {it also works if the assignment is overloaded }
+                        not is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
                        Message(cg_e_illegal_type_conversion);
                 end
               else
@@ -3265,10 +3275,10 @@ unit pass_1;
                           comment(v_fatal,'no code for inline procedure stored');
                         if assigned(inlinecode) then
                           begin
-                             firstpass(inlinecode);
                              { consider it has not inlined if called
                                again inside the args }
                              p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+                             firstpass(inlinecode);
                              inlined:=true;
                           end;
 
@@ -5003,7 +5013,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.27  1998-06-05 00:01:06  florian
+  Revision 1.28  1998-06-05 14:37:29  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.27  1998/06/05 00:01:06  florian
     * bugs with assigning related objects and passing objects by reference
       to a procedure
 

+ 30 - 19
compiler/pbase.pas

@@ -68,6 +68,8 @@ unit pbase;
     { a syntax error is written                           }
     procedure consume(i : ttoken);
 
+    function tokenstring(i : ttoken) : string;
+    
     { consumes all tokens til atoken (for error recovering }
     procedure consume_all_until(atoken : ttoken);
 
@@ -91,12 +93,8 @@ unit pbase;
 
        files,scanner,systems,verbose;
 
-    { consumes token i, if the current token is unequal i }
-    { a syntax error is written                           }
-    procedure consume(i : ttoken);
-
       { generates a syntax error message }
-      procedure syntaxerror(const s : string);
+      procedure syntaxerror(s : string);
 
         begin
            Message2(scan_f_syn_expected,tostr(get_current_col),s);
@@ -119,26 +117,35 @@ unit pbase;
                  'identifier','const real.','end of file',
                  'ord const','const string','const char','@@');
 
+    function tokenstring(i : ttoken) : string;
+
       var
          j : integer;
 
       begin
-         if token<>i then
+         if i<_AND then
+           tokenstring:=tokens[i]
+         else
            begin
-              if i<_AND then
-                syntaxerror(tokens[i])
-              else
-                begin
+              { um die ProgrammgrӇe klein zu halten, }
+              { wird f�r ein Schl�sselwort-Token der  }
+              { "Text" in der Schl�sselworttabelle    }
+              { des Scanners nachgeschaut             }
+
+              for j:=1 to anz_keywords do
+                if keyword_token[j]=i then
+                tokenstring:=keyword[j];
+           end;
+      end;
 
-                   { um die ProgrammgrӇe klein zu halten, }
-                   { wird f�r ein Schl�sselwort-Token der  }
-                   { "Text" in der Schl�sselworttabelle    }
-                   { des Scanners nachgeschaut             }
+    { consumes token i, if the current token is unequal i }
+    { a syntax error is written                           }
+    procedure consume(i : ttoken);
 
-                   for j:=1 to anz_keywords do
-                     if keyword_token[j]=i then
-                       syntaxerror(keyword[j])
-                end;
+      begin
+         if token<>i then
+           begin
+              syntaxerror(tokenstring(i));
            end
          else
            begin
@@ -218,7 +225,11 @@ end.
 
 {
   $Log$
-  Revision 1.9  1998-06-03 22:48:58  peter
+  Revision 1.10  1998-06-05 14:37:31  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.9  1998/06/03 22:48:58  peter
     + wordbool,longbool
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas

+ 41 - 9
compiler/pdecl.pas

@@ -1750,27 +1750,55 @@ unit pdecl;
          block_type:=old_block_type;
       end;
 
+    procedure Not_supported_for_inline(t : ttoken);
+
+      begin
+         if assigned(aktprocsym) and
+            ((aktprocsym^.definition^.options and poinline)<>0) then
+           Begin
+              Comment(V_Warning,tokenstring(t)+' not yet supported inside inline procedure/function ');
+              Comment(V_Warning,'inlining disabled');
+              aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
+           End;
+      end;
+      
     procedure read_declarations(islibrary : boolean);
 
       begin
          repeat
            case token of
               _LABEL:
-                label_dec;
+                begin
+                   Not_supported_for_inline(token);
+                   label_dec;
+                end;
               _CONST:
-                const_dec;
+                begin
+                   Not_supported_for_inline(token);
+                   const_dec;
+                end;
               _TYPE:
-                type_dec;
+                begin
+                   Not_supported_for_inline(token);
+                   type_dec;
+                end;
               _VAR:
                 var_dec;
               _CONSTRUCTOR,_DESTRUCTOR,
               _FUNCTION,_PROCEDURE,_OPERATOR,_CLASS:
-                unter_dec;
+                begin
+                   Not_supported_for_inline(token);
+                   unter_dec;
+                end;
               _EXPORTS:
-                if islibrary then
-                  read_exports
-                else
-                  break;
+                begin
+                   { here we should be at lexlevel 1, no ? PM }
+                   Not_supported_for_inline(token);
+                   if islibrary then
+                     read_exports
+                   else
+                     break;
+                end
               else break;
            end;
          until false;
@@ -1801,7 +1829,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.23  1998-06-04 23:51:50  peter
+  Revision 1.24  1998-06-05 14:37:32  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.23  1998/06/04 23:51:50  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

+ 9 - 5
compiler/pexpr.pas

@@ -928,9 +928,9 @@ unit pexpr;
            begin
               { is this an access to a function result ? }
               if assigned(aktprocsym) and
-                 ((sym^.name=aktprocsym^.name) or
+                 ((sym^.name=aktprocsym^.name){ or
                  ((pvarsym(srsym)=opsym) and
-                 ((p^.flags and pi_operator)<>0))) and
+                 ((p^.flags and pi_operator)<>0))}) and
                  (p^.retdef<>pdef(voiddef)) and
                  (token<>LKLAMMER) and
                  (not ((cs_tp_compatible in aktswitches) and
@@ -988,9 +988,9 @@ unit pexpr;
 {$ifndef TEST_FUNCRET}
                       { is this an access to a function result ? }
                        if assigned(aktprocsym) and
-                        ((srsym^.name=aktprocsym^.name) or
+                        ((srsym^.name=aktprocsym^.name){ or
                         ((pvarsym(srsym)=opsym) and
-                        ((procinfo.flags and pi_operator)<>0))) and
+                        ((procinfo.flags and pi_operator)<>0))}) and
                         (procinfo.retdef<>pdef(voiddef)) and
                         (token<>LKLAMMER) and
                         (not ((cs_tp_compatible in aktswitches) and
@@ -1784,7 +1784,11 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.24  1998-06-04 23:51:52  peter
+  Revision 1.25  1998-06-05 14:37:33  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.24  1998/06/04 23:51:52  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

+ 6 - 2
compiler/pmodules.pas

@@ -323,7 +323,7 @@ unit pmodules;
               { the written crc is false, because        }
               { not defined when writing the ppufile !!  }
 {$ifdef TEST_IMPL}
-              if (loaded_unit^.crc<>0) and (loaded_unit^.crc<>checksum) then
+              if (checksum<>0) and (loaded_unit^.crc<>checksum) then
                 begin
                    { we have to compile the current unit }
                    { remove stuff which isn't needed     }
@@ -992,7 +992,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.21  1998-06-04 23:51:53  peter
+  Revision 1.22  1998-06-05 14:37:34  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.21  1998/06/04 23:51:53  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

+ 6 - 1
compiler/pstatmnt.pas

@@ -1019,6 +1019,7 @@ unit pstatmnt;
               { if the current is a function aktprocsym is non nil }
               { and there is a local symtable set }
               funcretsym:=new(pfuncretsym,init(aktprocsym^.name),@procinfo);
+              procinfo.retoffset:=-funcretsym^.address;
               { insert in local symtable }
               symtablestack^.insert(funcretsym);
            end;
@@ -1145,7 +1146,11 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.17  1998-06-04 09:55:43  pierre
+  Revision 1.18  1998-06-05 14:37:35  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  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: ----------------------------------------------------------------------

+ 28 - 9
compiler/symdef.inc

@@ -1535,12 +1535,15 @@
          while assigned(pdc) do
            begin
               case pdc^.paratyp of
-                vs_value : l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
-                  vs_var : l:=l+sizeof(pointer);
-                vs_const : if dont_copy_const_param(pdc^.data) then
-                             l:=l+sizeof(pointer)
-                           else
-                             l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
+                vs_value :
+                  l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
+                vs_var :
+                  l:=l+sizeof(pointer);
+                vs_const :
+                  if dont_copy_const_param(pdc^.data) then
+                    l:=l+sizeof(pointer)
+                  else
+                    l:=l+pdc^.data^.size+(pdc^.data^.size mod 2);
                 end;
               pdc:=pdc^.next;
            end;
@@ -1557,7 +1560,7 @@
          tdef.write;
          writedefref(retdef);
 {$ifdef StoreFPULevel}
-         writebyte(FPU_used);
+         writebyte(fpu_used);
 {$endif StoreFPULevel}
          writelong(options);
          hp:=para1;
@@ -1661,6 +1664,7 @@
 {$endif alpha}
          forwarddef:=true;
          _class := nil;
+         code:=nil;
       end;
 
     constructor tprocdef.load;
@@ -1852,6 +1856,17 @@
          writelong(extnumber);
          writedefref(nextoverloaded);
          writedefref(_class);
+         if (options and poinline) <> 0 then
+           begin
+              { we need to save
+                - the para and the local symtable
+                - the code ptree !! PM
+               writesymtable(parast);
+               writesymtable(localst);
+               writeptree(ptree(code));
+               }
+           end;
+           
 {$ifdef NEWPPU}
          ppufile^.writeentry(ibprocdef);
 {$endif}
@@ -2019,7 +2034,7 @@
          { plausible (PM) }
 {$ifdef StoreFPULevel}
          if is_fpu(retdef) then
-           fpu_used:=3
+           fpu_used:=2
          else
            fpu_used:=0;
 {$endif StoreFPULevel}
@@ -2428,7 +2443,11 @@
 
 {
   $Log$
-  Revision 1.5  1998-06-04 23:52:01  peter
+  Revision 1.6  1998-06-05 14:37:37  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  Revision 1.5  1998/06/04 23:52:01  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

+ 7 - 1
compiler/tree.pas

@@ -1146,6 +1146,8 @@ unit tree;
          p^.retoffset:=-4; { less dangerous as zero (PM) }
          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);
          { copy args }
          p^.left:=getcopy(code);
          p^.registers32:=code^.registers32;
@@ -1538,7 +1540,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.13  1998-06-04 09:55:49  pierre
+  Revision 1.14  1998-06-05 14:37:40  pierre
+    * fixes for inline for operators
+    * inline procedure more correctly restricted
+
+  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: ----------------------------------------------------------------------