* never remove regvar-ability of parameters passed by reference

    (previously worked only for var/out, now also for const and
     is more generic)

git-svn-id: trunk@3554 -

compiler/htypechk.pas

@@ -124,7 +124,7 @@ interface
     function isbinaryoverloaded(var t : tnode) : boolean;
 
     { Register Allocation }
-    procedure make_not_regable(p : tnode);
+    procedure make_not_regable(p : tnode; how: tvarregable);
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
     { procvar handling }
@@ -641,18 +641,18 @@ implementation
 ****************************************************************************}
 
     { marks an lvalue as "unregable" }
-    procedure make_not_regable(p : tnode);
+    procedure make_not_regable(p : tnode; how: tvarregable);
       begin
          case p.nodetype of
             typeconvn :
-              make_not_regable(ttypeconvnode(p).left);
+              make_not_regable(ttypeconvnode(p).left,how);
             loadn :
-              if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym]) or
-                 ((tloadnode(p).symtableentry.typ = paravarsym) and
-                  { not a nested variable }
-                  (assigned(tloadnode(p).left) or
-                   not(tparavarsym(tloadnode(p).symtableentry).varspez in [vs_var,vs_out]))) then
-                tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
+              if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) and
+                 (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) then
+                if (tloadnode(p).symtableentry.typ = paravarsym) then
+                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
+                else
+                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
          end;
       end;
 
@@ -1009,7 +1009,7 @@ implementation
                       be in a register }
                     if (m_tp7 in aktmodeswitches) or
                        (todef.size<fromdef.size) then
-                      make_not_regable(hp)
+                      make_not_regable(hp,vr_addr)
                     else
                       if report_errors then
                         CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));

compiler/ncal.pas

@@ -699,7 +699,7 @@ type
                          (tloadnode(left).is_addr_param_load)
                         )
                     ) then
-                   make_not_regable(left);
+                   make_not_regable(left,vr_addr);
 
                  if do_count then
                   begin
@@ -2068,7 +2068,7 @@ type
           end
         else
           begin
-            tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,tabstractvarsym(p).varregable<>vr_none);
+            tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,not(tabstractvarsym(p).varregable in [vr_none,vr_addr]));
             addstatement(tempinfo^.createstatement,tempnode);
             if assigned(tlocalvarsym(p).defaultconstsym) then
               begin
@@ -2141,7 +2141,7 @@ type
                 { contents to that temp and then substitute the paramter    }
                 { with the temp everywhere in the function                  }
                 if
-                  ((tparavarsym(para.parasym).varregable = vr_none) and
+                  ((tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and
                    not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]))  or
                   { we can't assign to formaldef temps }
                   ((para.parasym.vartype.def.deftype<>formaldef) and
@@ -2205,9 +2205,7 @@ type
                    )
                   ) then
                   begin
-                    { in theory, this is always regable, but ncgcall can't }
-                    { handle it yet in all situations (JM)                 }
-                    tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,tparavarsym(para.parasym).varregable <> vr_none);
+                    tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr]));
                     addstatement(createstatement,tempnode);
                     { assign the value of the parameter to the temp, except in case of the function result }
                     { (in that case, para.left is a block containing the creation of a new temp, while we  }
@@ -2235,7 +2233,7 @@ type
                 { temp                                                        }
                 else if (paracomplexity > 1) then
                   begin
-                    tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,tparavarsym(para.parasym).varregable<>vr_none);
+                    tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr]));
                     addstatement(createstatement,tempnode);
                     addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
                       caddrnode.create_internal(para.left)));

compiler/ncgutil.pas

@@ -2008,7 +2008,8 @@ implementation
           begin
             localloc.size:=cgsize;
             case varregable of
-              vr_intreg :
+              vr_intreg,
+              vr_addr :
                 begin
                   localloc.loc:=LOC_CREGISTER;
                 end;
@@ -2057,7 +2058,7 @@ implementation
                           cgsize:=def_cgsize(vartype.def);
 {$ifndef OLDREGVARS}
                         { When there is assembler code we can't use regvars }
-                        if is_regvar then
+                        if is_regvar(isaddr) then
                           begin
                             init_regvar_loc(tabstractnormalvarsym(sym),cgsize);
                             if (st.symtabletype <> parasymtable) then

compiler/ncnv.pas

@@ -1385,7 +1385,7 @@ implementation
             convtype:=tc_equal;
             if not(tstoreddef(resulttype.def).is_intregable) and
                not(tstoreddef(resulttype.def).is_fpuregable) then
-              make_not_regable(left);
+              make_not_regable(left,vr_addr);
             exit;
           end;
 
@@ -1561,7 +1561,7 @@ implementation
                          not(tstoreddef(resulttype.def).is_fpuregable)) or
                         ((left.resulttype.def.deftype = floatdef) and
                          (resulttype.def.deftype <> floatdef))  then
-                       make_not_regable(left);
+                       make_not_regable(left,vr_addr);
 
                      { class/interface to class/interface, with checkobject support }
                      if is_class_or_interface(resulttype.def) and
@@ -2320,7 +2320,7 @@ implementation
         { When using only a part of the value it can't be in a register since
           that will load the value in a new register first }
         if (resulttype.def.size<left.resulttype.def.size) then
-          make_not_regable(left);
+          make_not_regable(left,vr_addr);
       end;
 
 

compiler/nld.pas

@@ -267,7 +267,7 @@ implementation
                        { we can't inline the referenced parent procedure }
                        exclude(tprocdef(symtable.defowner).procoptions,po_inline);
                        { reference in nested procedures, variable needs to be in memory }
-                       make_not_regable(self);
+                       make_not_regable(self,vr_none);
                      end;
                    { static variables referenced in procedures or from finalization,
                      variable needs to be in memory.
@@ -278,7 +278,7 @@ implementation
                        (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
                        (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
                       ) then
-                     make_not_regable(self);
+                     make_not_regable(self,vr_none);
                  end;
                { fix self type which is declared as voidpointer in the
                  definition }
@@ -361,10 +361,11 @@ implementation
                 if assigned(left) then
                   firstpass(left);
                 if not is_addr_param_load and
-                   tabstractvarsym(symtableentry).is_regvar then
+                   tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then
                   begin
                     case tabstractvarsym(symtableentry).varregable of
-                      vr_intreg :
+                      vr_intreg,
+                      vr_addr :
                         expectloc:=LOC_CREGISTER;
                       vr_fpureg :
                         expectloc:=LOC_CFPUREGISTER;

compiler/nmem.pas

@@ -340,7 +340,7 @@ implementation
         if codegenerror then
          exit;
 
-        make_not_regable(left);
+        make_not_regable(left,vr_addr);
 
         { don't allow constants }
         if is_constnode(left) then

compiler/symconst.pas

@@ -345,7 +345,10 @@ type
   tvarregable=(vr_none,
     vr_intreg,
     vr_fpureg,
-    vr_mmreg
+    vr_mmreg,
+    { does not mean "needs address register", but "if it's a parameter which is }
+    { passed by reference, then its address can be put in a register            }
+    vr_addr
   );
 
   { types of the symtables }

compiler/symsym.pas

@@ -145,7 +145,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  getsize : longint;
-          function  is_regvar:boolean;
+          function  is_regvar(refpara: boolean):boolean;
           procedure trigger_notifications(what:Tnotification_flag);
           function register_notification(flags:Tnotification_flags;
                                          callback:Tnotification_callback):cardinal;
@@ -1268,7 +1268,7 @@ implementation
       end;
 
 
-    function tabstractvarsym.is_regvar:boolean;
+    function tabstractvarsym.is_regvar(refpara: boolean):boolean;
       begin
         { Register variables are not allowed in the following cases:
            - regvars are disabled
@@ -1280,7 +1280,10 @@ implementation
                 not(pi_has_assembler_block in current_procinfo.flags) and
                 not(pi_uses_exceptions in current_procinfo.flags) and
                 not(vo_has_local_copy in varoptions) and
-                (varregable<>vr_none);
+                ((refpara and
+                  (varregable <> vr_none)) or
+                 (not refpara and
+                  not(varregable in [vr_none,vr_addr])));
       end;