* Implemented constref support, to force constant function-parameters to be

   passed by reference

git-svn-id: branches/xpcom@16008 -

compiler/arm/cpupara.pas

@@ -169,7 +169,7 @@ unit cpupara;
     function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        if varspez in [vs_var,vs_out] then
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/avr/cpupara.pas

@@ -155,7 +155,7 @@ unit cpupara;
     function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        if varspez in [vs_var,vs_out] then
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/browcol.pas

@@ -1343,10 +1343,11 @@ end;
              CurName:=': '+GetDefinitionStr(dc.vardef);
            CurName:=dc.RealName+CurName;
            case dc.varspez of
-             vs_Value : ;
-             vs_Const : CurName:='const '+CurName;
-             vs_Var   : CurName:='var '+CurName;
-             vs_Out   : CurName:='out '+CurName;
+             vs_Value    : ;
+             vs_Const    : CurName:='const '+CurName;
+             vs_Var      : CurName:='var '+CurName;
+             vs_Out      : CurName:='out '+CurName;
+             vs_Constref : CurName:='constref '+CurName;
            end;
            if Count>0 then
              CurName:='; '+CurName;

compiler/dbgstabs.pas

@@ -441,6 +441,8 @@ implementation
                         argnames:=argnames+'5const';
                       vs_out :
                         argnames:=argnames+'3out';
+                      vs_constref :
+                        argnames:=argnames+'8constref';
                     end;
                   end
                 else

compiler/defcmp.pas

@@ -1661,8 +1661,8 @@ implementation
                        if (
                            not(cpo_ignorevarspez in cpoptions) and
                            (currpara1.varspez<>currpara2.varspez) and
-                           ((currpara1.varspez in [vs_var,vs_out]) or
-                            (currpara2.varspez in [vs_var,vs_out]))
+                           ((currpara1.varspez in [vs_var,vs_out,vs_constref]) or
+                            (currpara2.varspez in [vs_var,vs_out,vs_constref]))
                           ) then
                          exit;
                        eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,

compiler/htypechk.pas

@@ -1399,7 +1399,7 @@ implementation
                          else
                           exit;
                        { read-only variable? }
-                       if (tabstractvarsym(tloadnode(hp).symtableentry).varspez=vs_const) then
+                       if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref]) then
                         begin
                           { allow p^:= constructions with p is const parameter }
                           if gotderef or gotdynarray or (Valid_Const in opts) or

compiler/i386/cpupara.pas

@@ -151,8 +151,8 @@ unit cpupara;
     function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/m68k/cpupara.pas

@@ -149,8 +149,8 @@ unit cpupara;
     function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/mips/cpupara.pas

@@ -110,8 +110,8 @@ implementation
     function tMIPSELparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/ncal.pas

@@ -443,7 +443,7 @@ implementation
                   internalerror(200611041);
               end;
 
-            dispatchbyref:=(assigned(para.parasym) and (para.parasym.varspez in [vs_var,vs_out])) or
+            dispatchbyref:=(assigned(para.parasym) and (para.parasym.varspez in [vs_var,vs_out,vs_constref])) or
                            (para.left.resultdef.typ in [variantdef]);
 
             { assign the argument/parameter to the temporary location }
@@ -818,7 +818,7 @@ implementation
                  if (cs_strict_var_strings in current_settings.localswitches) and
                     is_shortstring(left.resultdef) and
                     is_shortstring(parasym.vardef) and
-                    (parasym.varspez in [vs_out,vs_var]) and
+                    (parasym.varspez in [vs_out,vs_var,vs_constref]) and
                     not(is_open_string(parasym.vardef)) and
                     not(equal_defs(left.resultdef,parasym.vardef)) then
                    begin
@@ -860,6 +860,7 @@ implementation
 
                      case parasym.varspez of
                        vs_var,
+                       vs_constref,
                        vs_out :
                          begin
                            if not valid_for_formal_var(left,true) then
@@ -879,7 +880,7 @@ implementation
                        valid_for_var(left,true);
                    end;
 
-                 if parasym.varspez in [vs_var,vs_out] then
+                 if parasym.varspez in [vs_var,vs_out,vs_constref] then
                    set_unique(left);
 
                  { When the address needs to be pushed then the register is
@@ -915,7 +916,8 @@ implementation
                         set_varstate(left,vs_written,[]);
                         set_varstate(left,vs_readwritten,[]);
                       end;
-                    vs_var :
+                    vs_var,
+                    vs_constref:
                       set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
                     else
                       set_varstate(left,vs_read,[vsf_must_be_valid]);

compiler/ncgrtti.pas

@@ -659,10 +659,11 @@ implementation
              if not(vo_is_hidden_para in parasym.varoptions) then
                begin
                  case parasym.varspez of
-                   vs_value: paraspec := 0;
-                   vs_const: paraspec := pfConst;
-                   vs_var  : paraspec := pfVar;
-                   vs_out  : paraspec := pfOut;
+                   vs_value   : paraspec := 0;
+                   vs_const   : paraspec := pfConst;
+                   vs_var     : paraspec := pfVar;
+                   vs_out     : paraspec := pfOut;
+                   vs_constref: paraspec := pfConstRef;
                  end;
                  { Kylix also seems to always add both pfArray and pfReference
                    in this case

compiler/objcutil.pas

@@ -229,7 +229,7 @@ end;
             { addencodedtype always assumes a value parameter, so add
               a pointer indirection for var/out parameters.  }
             if not paramanager.push_addr_param(vs_value,vs.vardef,pocall_cdecl) and
-               (vs.varspez in [vs_var,vs_out]) then
+               (vs.varspez in [vs_var,vs_out,vs_constref]) then
               result:=result+'^';
             { Add the parameter type.  }
             if not addencodedtype(vs.vardef,ris_initial,false,result,founderror) then

compiler/options.pas

@@ -2411,6 +2411,7 @@ begin
   def_system_macro('FPC_STRTOSHORTSTRINGPROC');
   def_system_macro('FPC_OBJFPC_EXTENDED_IF');
   def_system_macro('FPC_HAS_OPERATOR_ENUMERATOR');
+  def_system_macro('FPC_HAS_CONSTREF');
 {$if defined(x86) or defined(powerpc) or defined(powerpc64)}
   def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
 {$endif}

compiler/opttail.pas

@@ -185,7 +185,7 @@ unit opttail;
         { check if the parameters actually would support tail recursion elimination }
         for i:=0 to p.paras.count-1 do
           with tparavarsym(p.paras[i]) do
-            if (varspez in [vs_out,vs_var]) or
+            if (varspez in [vs_out,vs_var,vs_constref]) or
               ((varspez=vs_const) and
                (paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or
                { parameters requiring tables are too complicated to handle

compiler/paramgr.pas

@@ -177,6 +177,7 @@ implementation
       begin
         push_size:=-1;
         case varspez of
+          vs_constref,
           vs_out,
           vs_var :
             push_size:=sizeof(pint);

compiler/pdecsub.pas

@@ -473,6 +473,9 @@ implementation
             if (m_out in current_settings.modeswitches) and
                try_to_consume(_OUT) then
               varspez:=vs_out
+          else
+           if try_to_consume(_CONSTREF) then
+             varspez:=vs_constref
           else
             if (m_mac in current_settings.modeswitches) and
                try_to_consume(_POINTPOINTPOINT) then
@@ -592,7 +595,7 @@ implementation
                 if is_shortstring(hdef) then
                   begin
                     case varspez of
-                      vs_var,vs_out:
+                      vs_var,vs_out,vs_constref:
                         begin
                           { not 100% Delphi-compatible: type xstr=string[255] cannot
                             become an openstring there, while here it can }

compiler/pdecvar.pas

@@ -363,6 +363,8 @@ implementation
                   varspez:=vs_var
                 else if try_to_consume(_CONST) then
                   varspez:=vs_const
+                else if try_to_consume(_CONSTREF) then
+                  varspez:=vs_constref
                 else if (m_out in current_settings.modeswitches) and try_to_consume(_OUT) then
                   varspez:=vs_out
                 else

compiler/powerpc/cpupara.pas

@@ -176,8 +176,8 @@ unit cpupara;
     function tppcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/powerpc64/cpupara.pas

@@ -159,8 +159,8 @@ function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef;
   calloption: tproccalloption): boolean;
 begin
   result := false;
-  { var,out always require address }
-  if varspez in [vs_var, vs_out] then
+  { var,out,constref always require address }
+  if varspez in [vs_var, vs_out, vs_constref] then
   begin
     result := true;
     exit;

compiler/psub.pas

@@ -1390,7 +1390,7 @@ implementation
             case currpara.vardef.typ of
               formaldef :
                 begin
-                  if (currpara.varspez in [vs_out,vs_var,vs_const]) then
+                  if (currpara.varspez in [vs_out,vs_var,vs_const,vs_constref]) then
                     begin
                       Message1(parser_w_not_supported_for_inline,'formal parameter');
                       Message(parser_w_inlining_disabled);

compiler/regvars.pas

@@ -69,7 +69,7 @@ implementation
       begin
          parasym:=pboolean(arg)^;
          if (tsym(p).typ=varsym) and ((tvarsym(p).varregable <> vr_none) or
-             ((tvarsym(p).varspez in [vs_var,vs_const,vs_out]) and
+             ((tvarsym(p).varspez in [vs_var,vs_const,vs_out,vs_constref]) and
               paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vardef,current_procinfo.procdef.proccalloption))) and
             not tvarsym(p).vardef.needs_inittable then
            begin

compiler/sparc/cpupara.pas

@@ -111,8 +111,8 @@ implementation
     function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;

compiler/symconst.pas

@@ -101,6 +101,7 @@ const
   pfAddress  = 8;
   pfReference= 16;
   pfOut      = 32;
+  pfConstRef = 64;
 
   unknown_level         = 0;
   main_program_level    = 1;
@@ -483,7 +484,7 @@ type
     vs_referred_not_inited,vs_written,vs_readwritten
   );
 
-  tvarspez = (vs_value,vs_const,vs_var,vs_out);
+  tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref);
 
   absolutetyp = (tovar,toasm,toaddr);
 

compiler/symdef.pas

@@ -2943,6 +2943,8 @@ implementation
                    s:=s+'const ';
                  vs_out :
                    s:=s+'out ';
+                 vs_constref :
+                   s:=s+'constref ';
                end;
                if hp.univpara then
                  s:=s+'univ ';

compiler/symsym.pas

@@ -1402,7 +1402,7 @@ implementation
     constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(paravarsym,n,vsp,def,vopts);
-         if (vsp in [vs_var,vs_value,vs_const]) then
+         if (vsp in [vs_var,vs_value,vs_const,vs_constref]) then
            varstate := vs_initialised;
          paranr:=nr;
          paraloc[calleeside].init;

compiler/symtable.pas

@@ -607,7 +607,7 @@ implementation
               begin
                  if (tsym(sym).owner.symtabletype=parasymtable) then
                    begin
-                     if not(tabstractvarsym(sym).varspez in [vs_var,vs_out]) and
+                     if not(tabstractvarsym(sym).varspez in [vs_var,vs_out,vs_constref]) and
                         not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
                        MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
                    end

compiler/tokens.pas

@@ -201,6 +201,7 @@ type
     _ABSOLUTE,
     _ABSTRACT,
     _BASESYSV,
+    _CONSTREF,
     _CONTAINS,
     _CONTINUE,
     _CPPCLASS,
@@ -463,6 +464,7 @@ const
       (str:'ABSOLUTE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'ABSTRACT'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'BASESYSV'      ;special:false;keyword:m_none;op:NOTOKEN),   { Syscall variation on MorphOS }
+      (str:'CONSTREF'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONTAINS'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONTINUE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CPPCLASS'      ;special:false;keyword:m_fpc;op:NOTOKEN),

compiler/x86_64/cpupara.pas

@@ -644,8 +644,8 @@ unit cpupara;
         numclasses: longint;
       begin
         result:=false;
-        { var,out always require address }
-        if varspez in [vs_var,vs_out] then
+        { var,out,constref always require address }
+        if varspez in [vs_var,vs_out,vs_constref] then
           begin
             result:=true;
             exit;