Browse Source

* Merged XPCom branch into trunk, added support for constref and changed
the IInterface implementation to be XPCom-compatible
--- Merging r15997 through r16179 into '.':
U rtl/inc/variants.pp
U rtl/inc/objpash.inc
U rtl/inc/objpas.inc
U rtl/objpas/classes/persist.inc
U rtl/objpas/classes/compon.inc
U rtl/objpas/classes/classesh.inc
A tests/test/tconstref1.pp
A tests/test/tconstref2.pp
A tests/test/tconstref3.pp
U tests/test/tinterface4.pp
A tests/test/tconstref4.pp
U tests/webtbs/tw10897.pp
U tests/webtbs/tw4086.pp
U tests/webtbs/tw15363.pp
U tests/webtbs/tw2177.pp
U tests/webtbs/tw16592.pp
U tests/tbs/tb0546.pp
U compiler/sparc/cpupara.pas
U compiler/i386/cpupara.pas
U compiler/pdecsub.pas
U compiler/symdef.pas
U compiler/powerpc/cpupara.pas
U compiler/avr/cpupara.pas
U compiler/browcol.pas
U compiler/defcmp.pas
U compiler/powerpc64/cpupara.pas
U compiler/ncgrtti.pas
U compiler/x86_64/cpupara.pas
U compiler/opttail.pas
U compiler/htypechk.pas
U compiler/tokens.pas
U compiler/objcutil.pas
U compiler/ncal.pas
U compiler/symtable.pas
U compiler/symsym.pas
U compiler/m68k/cpupara.pas
U compiler/regvars.pas
U compiler/arm/cpupara.pas
U compiler/symconst.pas
U compiler/mips/cpupara.pas
U compiler/paramgr.pas
U compiler/psub.pas
U compiler/pdecvar.pas
U compiler/dbgstabs.pas
U compiler/options.pas
U packages/fcl-fpcunit/src/testutils.pp

git-svn-id: trunk@16180 -

joost 14 years ago
parent
commit
07bf44517c
47 changed files with 330 additions and 120 deletions
  1. 4 0
      .gitattributes
  2. 1 1
      compiler/arm/cpupara.pas
  3. 1 1
      compiler/avr/cpupara.pas
  4. 5 4
      compiler/browcol.pas
  5. 2 0
      compiler/dbgstabs.pas
  6. 2 2
      compiler/defcmp.pas
  7. 1 1
      compiler/htypechk.pas
  8. 2 2
      compiler/i386/cpupara.pas
  9. 2 2
      compiler/m68k/cpupara.pas
  10. 2 2
      compiler/mips/cpupara.pas
  11. 6 4
      compiler/ncal.pas
  12. 5 4
      compiler/ncgrtti.pas
  13. 1 1
      compiler/objcutil.pas
  14. 1 0
      compiler/options.pas
  15. 1 1
      compiler/opttail.pas
  16. 1 0
      compiler/paramgr.pas
  17. 4 1
      compiler/pdecsub.pas
  18. 2 0
      compiler/pdecvar.pas
  19. 2 2
      compiler/powerpc/cpupara.pas
  20. 2 2
      compiler/powerpc64/cpupara.pas
  21. 1 1
      compiler/psub.pas
  22. 1 1
      compiler/regvars.pas
  23. 2 2
      compiler/sparc/cpupara.pas
  24. 2 1
      compiler/symconst.pas
  25. 2 0
      compiler/symdef.pas
  26. 1 1
      compiler/symsym.pas
  27. 1 1
      compiler/symtable.pas
  28. 2 0
      compiler/tokens.pas
  29. 2 2
      compiler/x86_64/cpupara.pas
  30. 6 6
      packages/fcl-fpcunit/src/testutils.pp
  31. 7 7
      rtl/inc/objpas.inc
  32. 10 10
      rtl/inc/objpash.inc
  33. 6 6
      rtl/inc/variants.pp
  34. 6 6
      rtl/objpas/classes/classesh.inc
  35. 3 3
      rtl/objpas/classes/compon.inc
  36. 3 3
      rtl/objpas/classes/persist.inc
  37. 4 4
      tests/tbs/tb0546.pp
  38. 53 0
      tests/test/tconstref1.pp
  39. 12 0
      tests/test/tconstref2.pp
  40. 82 0
      tests/test/tconstref3.pp
  41. 41 0
      tests/test/tconstref4.pp
  42. 6 6
      tests/test/tinterface4.pp
  43. 4 4
      tests/webtbs/tw10897.pp
  44. 8 8
      tests/webtbs/tw15363.pp
  45. 6 6
      tests/webtbs/tw16592.pp
  46. 6 6
      tests/webtbs/tw2177.pp
  47. 6 6
      tests/webtbs/tw4086.pp

+ 4 - 0
.gitattributes

@@ -9167,6 +9167,10 @@ tests/test/tclassinfo1.pp svneol=native#text/pascal
 tests/test/tclrprop.pp svneol=native#text/plain
 tests/test/tcmp.pp svneol=native#text/plain
 tests/test/tcmp0.pp svneol=native#text/plain
+tests/test/tconstref1.pp svneol=native#text/pascal
+tests/test/tconstref2.pp svneol=native#text/pascal
+tests/test/tconstref3.pp svneol=native#text/pascal
+tests/test/tconstref4.pp svneol=native#text/pascal
 tests/test/tcstring1.pp svneol=native#text/pascal
 tests/test/tcstring2.pp svneol=native#text/pascal
 tests/test/tdel1.pp svneol=native#text/plain

+ 1 - 1
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;

+ 1 - 1
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;

+ 5 - 4
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;

+ 2 - 0
compiler/dbgstabs.pas

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

+ 2 - 2
compiler/defcmp.pas

@@ -1669,8 +1669,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,

+ 1 - 1
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

+ 2 - 2
compiler/i386/cpupara.pas

@@ -152,8 +152,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;

+ 2 - 2
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;

+ 2 - 2
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;

+ 6 - 4
compiler/ncal.pas

@@ -461,7 +461,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 }
@@ -836,7 +836,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
@@ -878,6 +878,7 @@ implementation
 
                      case parasym.varspez of
                        vs_var,
+                       vs_constref,
                        vs_out :
                          begin
                            if not valid_for_formal_var(left,true) then
@@ -897,7 +898,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
@@ -933,7 +934,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]);

+ 5 - 4
compiler/ncgrtti.pas

@@ -662,10 +662,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

+ 1 - 1
compiler/objcutil.pas

@@ -225,7 +225,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

+ 1 - 0
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}

+ 1 - 1
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

+ 1 - 0
compiler/paramgr.pas

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

+ 4 - 1
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 }

+ 2 - 0
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

+ 2 - 2
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;

+ 2 - 2
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;

+ 1 - 1
compiler/psub.pas

@@ -1363,7 +1363,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);

+ 1 - 1
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

+ 2 - 2
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;

+ 2 - 1
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);
 

+ 2 - 0
compiler/symdef.pas

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

+ 1 - 1
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;

+ 1 - 1
compiler/symtable.pas

@@ -608,7 +608,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

+ 2 - 0
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),

+ 2 - 2
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;

+ 6 - 6
packages/fcl-fpcunit/src/testutils.pp

@@ -26,9 +26,9 @@ type
   TNoRefCountObject = class(TObject, IInterface)
   protected
     { IInterface }
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   end;
   {$M-}
 
@@ -38,18 +38,18 @@ procedure GetMethodList( AClass: TClass; AList: TStrings ); overload;
 
 implementation
 
-function TNoRefCountObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+function TNoRefCountObject.QueryInterface(constref IID: TGUID; out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if GetInterface(IID, Obj) then Result := 0
     else Result := HRESULT($80004002);
 end;
 
-function TNoRefCountObject._AddRef: Integer;stdcall;
+function TNoRefCountObject._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   Result := -1;
 end;
 
-function TNoRefCountObject._Release: Integer;stdcall;
+function TNoRefCountObject._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   Result := -1;
 end;

+ 7 - 7
rtl/inc/objpas.inc

@@ -967,7 +967,7 @@
 ****************************************************************************}
 
     function TInterfacedObject.QueryInterface(
-      const iid : tguid;out obj) : longint;stdcall;
+      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          if getinterface(iid,obj) then
@@ -976,13 +976,13 @@
            result:=longint(E_NOINTERFACE);
       end;
 
-    function TInterfacedObject._AddRef : longint;stdcall;
+    function TInterfacedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          _addref:=interlockedincrement(frefcount);
       end;
 
-    function TInterfacedObject._Release : longint;stdcall;
+    function TInterfacedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          _Release:=interlockeddecrement(frefcount);
@@ -1026,19 +1026,19 @@
       end;
 
     function TAggregatedObject.QueryInterface(
-      const iid : tguid;out obj) : longint;stdcall;
+      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          Result := IUnknown(fcontroller).QueryInterface(iid, obj);
       end;
 
-    function TAggregatedObject._AddRef : longint;stdcall;
+    function TAggregatedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          Result := IUnknown(fcontroller)._AddRef;
       end;
 
-    function TAggregatedObject._Release : longint;stdcall;
+    function TAggregatedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       begin
          Result := IUnknown(fcontroller)._Release;
@@ -1055,7 +1055,7 @@
 ****************************************************************************}
 
     function TContainedObject.QueryInterface(
-            const iid : tguid;out obj) : longint; stdcall;
+            {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
     begin
       if getinterface(iid,obj) then

+ 10 - 10
rtl/inc/objpash.inc

@@ -243,9 +243,9 @@
 
        IUnknown = interface
          ['{00000000-0000-0000-C000-000000000046}']
-         function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-         function _AddRef : longint;stdcall;
-         function _Release : longint;stdcall;
+         function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+         function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+         function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
        end;
        IInterface = IUnknown;
 
@@ -283,9 +283,9 @@
        protected
           frefcount : longint;
           { implement methods of IUnknown }
-          function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-          function _AddRef : longint;stdcall;
-          function _Release : longint;stdcall;
+          function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+          function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+          function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
         public
           procedure AfterConstruction;override;
           procedure BeforeDestruction;override;
@@ -300,9 +300,9 @@
           function GetController: IUnknown;
        protected
           { implement methods of IUnknown }
-          function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-          function _AddRef : longint;stdcall;
-          function _Release : longint;stdcall;
+          function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+          function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+          function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
        public
           constructor Create(const aController: IUnknown);
           property Controller : IUnknown read GetController;
@@ -310,7 +310,7 @@
 
        TContainedObject = class(TAggregatedObject,IInterface)
          protected
-           function QueryInterface(const iid : tguid;out obj) : longint;virtual; stdcall;
+           function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
          end;
 
        { some pointer definitions }

+ 6 - 6
rtl/inc/variants.pp

@@ -161,9 +161,9 @@ type
   private
     FVarType: TVarType;
   protected
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure SimplisticClear(var V: TVarData);
     procedure SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False);
     procedure RaiseInvalidOp;
@@ -3575,19 +3575,19 @@ function Null: Variant;       // Null standard constant
   ---------------------------------------------------------------------}
 
 {$warnings off}
-function TCustomVariantType.QueryInterface(const IID: TGUID; out Obj): HResult;  stdcall;
+function TCustomVariantType.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     NotSupported('TCustomVariantType.QueryInterface');
   end;
 
 
-function TCustomVariantType._AddRef: Integer; stdcall;
+function TCustomVariantType._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     NotSupported('TCustomVariantType._AddRef');
   end;
 
 
-function TCustomVariantType._Release: Integer; stdcall;
+function TCustomVariantType._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     NotSupported('TCustomVariantType._Release');
   end;

+ 6 - 6
rtl/objpas/classes/classesh.inc

@@ -403,10 +403,10 @@ type
     FOwnerInterface: IInterface;
   protected
     { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   public
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure AfterConstruction; override;
   end;
 
@@ -1630,9 +1630,9 @@ type
     procedure ValidateContainer(AComponent: TComponent); dynamic;
     procedure ValidateInsert(AComponent: TComponent); dynamic;
     { IUnknown }
-    function QueryInterface(const IID: TGUID; out Obj): Hresult; virtual; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): Hresult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     function iicrGetComponent: TComponent;
     { IDispatch }
     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;

+ 3 - 3
rtl/objpas/classes/compon.inc

@@ -652,7 +652,7 @@ begin
     Result := False;
 end;
 
-function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
+function TComponent.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if Assigned(VCLComObject) then
     Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj)
@@ -663,7 +663,7 @@ begin
     Result := E_NOINTERFACE;
 end;
 
-function TComponent._AddRef: Integer;stdcall;
+function TComponent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if Assigned(VCLComObject) then
     Result := IVCLComObject(VCLComObject)._AddRef
@@ -671,7 +671,7 @@ begin
     Result := -1;
 end;
 
-function TComponent._Release: Integer;stdcall;
+function TComponent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if Assigned(VCLComObject) then
     Result := IVCLComObject(VCLComObject)._Release

+ 3 - 3
rtl/objpas/classes/persist.inc

@@ -91,7 +91,7 @@ begin
 end;
 
 
-function TInterfacedPersistent._AddRef: Integer;stdcall;
+function TInterfacedPersistent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if assigned(FOwnerInterface) then
     Result:=FOwnerInterface._AddRef
@@ -100,7 +100,7 @@ begin
 end;
 
 
-function TInterfacedPersistent._Release: Integer;stdcall;
+function TInterfacedPersistent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if assigned(FOwnerInterface) then
     Result:=FOwnerInterface._Release
@@ -109,7 +109,7 @@ begin
 end;
 
 
-function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
+function TInterfacedPersistent.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   if GetInterface(IID, Obj) then
     Result:=0

+ 4 - 4
tests/tbs/tb0546.pp

@@ -41,9 +41,9 @@ type
    private
       FInnerX: TInnerObject;
    protected
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     function GetX: TInnerObject; virtual;
     function GetY: IYInterface;
    public
@@ -96,7 +96,7 @@ begin
    result := -1;
 end;
 
-function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TFoo.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
 end;function TFoo.GetX: TInnerObject;

+ 53 - 0
tests/test/tconstref1.pp

@@ -0,0 +1,53 @@
+program tConstRef1;
+
+{$mode objfpc}{$h+}
+
+uses
+  Classes, SysUtils;
+
+type
+  TConstRefProc = procedure(constref AParam: integer);
+
+  TAClass = class(tobject)
+  private
+    function GetSomething(constref int:integer): integer;
+  public
+    property Something[constref int:integer] : integer read getSomething;
+  end;
+
+function TAClass.GetSomething(constref int: integer): integer;
+begin
+  if int<>$1234567 then
+    halt(1);
+  result := $54321;
+end;
+
+procedure TestConstRef(constref AParam: integer); [public, alias: '_TESTCONSTREF'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefAlias(AParam: PInteger); [external name '_TESTCONSTREF'];
+
+const c = $1234567;
+var a: integer;
+    aclass: TAClass;
+    p: TConstRefProc;
+
+begin
+  a := $1234567;
+  TestConstRef(a);
+  TestConstRef(c);
+  TestConstRef($1234567);
+  TestConstRefAlias(@a);
+
+  aclass := TAClass.Create;
+  if aclass.Something[a]<>$54321 then
+    halt(1);
+  aclass.Free;
+
+  p := @TestConstRef;
+  p(c);
+end.
+

+ 12 - 0
tests/test/tconstref2.pp

@@ -0,0 +1,12 @@
+{ %fail }
+program tConstRef2;
+
+procedure TestConstRef(constref AParam: integer);
+begin
+  AParam := 5;
+end;
+
+begin
+  TestConstRef(1);
+end.
+

+ 82 - 0
tests/test/tconstref3.pp

@@ -0,0 +1,82 @@
+program tconstref3;
+
+{$mode objfpc}{$h+}
+
+uses
+  SysUtils;
+
+const
+  CGuid: TGuid = '{67BD8D43-8960-491C-AA3A-50EC74A02F36}';
+
+type
+  PSmallRecord = ^TSmallRecord;
+  TSmallRecord = record
+                   p: PtrInt;
+                 end;
+
+  PAclass = ^TAclass;
+  TAclass = class
+  public
+    p: PtrInt;
+  end;
+
+procedure TestConstRefIntegerAlias(AParam: PInteger); [external name '_TESTCONSTREFINTEGER'];
+procedure TestConstRefInteger(constref AParam: integer); [public, alias: '_TESTCONSTREFINTEGER'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefStringAlias(AParam: PString); [external name '_TESTCONSTREFSTRING'];
+procedure TestConstRefString(constref AParam: String); [public, alias: '_TESTCONSTREFSTRING'];
+begin
+  if AParam<>'1234567' then
+    halt(1);
+end;
+
+procedure TestConstRefGUIDAlias(AParam: PGuid); [external name '_TESTCONSTREFGUID'];
+procedure TestConstRefGUID(constref AParam: TGuid); [public, alias: '_TESTCONSTREFGUID'];
+begin
+  if GUIDToString(AParam)<>'{67BD8D43-8960-491C-AA3A-50EC74A02F36}' then
+    halt(1);
+end;
+
+procedure TestConstRefRecordAlias(AParam: PSmallRecord); [external name '_TESTCONSTREFRECORD'];
+procedure TestConstRefRecord(constref AParam: TSmallRecord); [public, alias: '_TESTCONSTREFRECORD'];
+begin
+  if AParam.p<>$7654321 then
+    halt(1);
+end;
+
+procedure TestConstRefClassAlias(AParam: PAClass); [external name '_TESTCONSTREFCLASS'];
+procedure TestConstRefClass(constref AParam: TAClass); [public, alias: '_TESTCONSTREFCLASS'];
+begin
+  if AParam.p<>$3456789 then
+    halt(1);
+end;
+
+var a: integer;
+    s: string;
+    p: tguid;
+    sr: TSmallRecord;
+    ac: TAclass;
+
+begin
+  a := $1234567;
+  TestConstRefIntegerAlias(@a);
+
+  s := '1234567';
+  TestConstRefStringAlias(@s);
+
+  p := CGuid;
+  TestConstRefGUIDAlias(@p);
+
+  sr.p:=$7654321;
+  TestConstRefRecordAlias(@sr);
+
+  ac := TAclass.Create;
+  ac.p := $3456789;
+  TestConstRefClassAlias(@ac);
+  ac.Free;
+end.
+

+ 41 - 0
tests/test/tconstref4.pp

@@ -0,0 +1,41 @@
+program tconstref4;
+
+{$mode objfpc}{$h+}
+
+procedure TestConstRefSafecallAlias(AParam: PInteger); safecall; [external name '_TESTCONSTREFSAFECALL'];
+procedure TestConstRefSafecall(constref AParam: integer); safecall; [public, alias: '_TESTCONSTREFSAFECALL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefCdeclAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFCDECL'];
+procedure TestConstRefCdecl(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFCDECL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefStdcallAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFSTDCALL'];
+procedure TestConstRefStdcall(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFSTDCALL'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+procedure TestConstRefRegisterAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFREGISTER'];
+procedure TestConstRefRegister(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFREGISTER'];
+begin
+  if AParam<>$1234567 then
+    halt(1);
+end;
+
+var a : integer;
+begin
+  a := $1234567;
+  TestConstRefSafecallAlias(@a);
+  TestConstRefStdcallAlias(@a);
+  TestConstRefRegisterAlias(@a);
+  TestConstRefCdeclAlias(@a);
+end.
+

+ 6 - 6
tests/test/tinterface4.pp

@@ -13,9 +13,9 @@ type
   end;
   TA = class(TObject, IA, IInterface)
     destructor Destroy; override;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure AfterConstruction; override;
     class function NewInstance: TObject; override;
   end;
@@ -32,13 +32,13 @@ begin
   inherited AfterConstruction;
 end;
 
-function TA._AddRef: Integer; stdcall;
+function TA._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   InterlockedIncrement(fRefCount);
   Result := 0;
 end;
 
-function TA._Release: Integer; stdcall;
+function TA._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   InterlockedDecrement(fRefCount);
   if fRefCount = 0 then begin
@@ -49,7 +49,7 @@ begin
   Result := 0;
 end;
 
-function TA.QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
+function TA.QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   Result := E_NOINTERFACE;
 end;

+ 4 - 4
tests/webtbs/tw10897.pp

@@ -22,9 +22,9 @@ type
     fRef: Integer;
   public
     function GetOwner: IMyIntf;
-    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): HRESULT; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure Poing;
   end;
  
@@ -52,7 +52,7 @@ begin
   Writeln('GetOwner2');
 end;
  
-function TMYClass.QueryInterface(const IID: TGUID; out Obj): HRESULT;
+function TMYClass.QueryInterface(constref IID: TGUID; out Obj): HRESULT;
 begin
   if GetInterface(IID, Obj) then
     result := S_OK else result := -1;

+ 8 - 8
tests/webtbs/tw15363.pp

@@ -10,18 +10,18 @@ type
   TTestBE = class (TObject, ITest)
     function TestIt: integer;
     { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   End;
 
   TTest = class (TPersistent, IInterface)
     BE : TTestBE;
     protected
     { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   End;
 
 function TTestBE.TestIt : integer;
@@ -39,7 +39,7 @@ begin
   Result := -1;
 end;
 
-function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TTest.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   Result := BE.QueryInterface(IID, obj);
 end;
@@ -54,7 +54,7 @@ begin
   Result := -1;
 end;
 
-function TTestBE.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TTestBE.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   if GetInterface(IID, Obj)
     then Result := 0

+ 6 - 6
tests/webtbs/tw16592.pp

@@ -24,9 +24,9 @@ type
     protected
       FRefCount : longint;
     public
-      function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-      function _AddRef : longint;stdcall;
-      function _Release : longint;stdcall;
+      function QueryInterface(constref iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+      function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+      function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       constructor Create;
 
@@ -96,7 +96,7 @@ end;
     WriteLn(Format('%s Obj=$%P class=%s RefCount=%d', [Str, Pointer(Self), ClassName, FRefCount]));
   end;
 
-function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdcall;
+function TInterfacedObj.QueryInterface(constref iid: tguid; out obj): longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     Result:=GetInterface(iid, obj);
 
@@ -105,7 +105,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
       Result:=FOwner.QueryInterface(iid, obj);
   end;
 
-  function TInterfacedObj._AddRef : longint;stdcall;[public,alias:'TInterfacedObj_AddRef'];
+  function TInterfacedObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};[public,alias:'TInterfacedObj_AddRef'];
   begin
     if not FDestructorCalled then
       begin
@@ -117,7 +117,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
       end;
   end;
 
-  function TInterfacedObj._Release : longint;stdcall;
+  function TInterfacedObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     if FDestructorCalled then Exit;
 

+ 6 - 6
tests/webtbs/tw2177.pp

@@ -16,25 +16,25 @@ type
 
   Twii= class(TObject, ii)
     s: string;
-    function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
     procedure Show;stdcall;
   end;
 
   {________doomy interfaces______}
-  function Twii.QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
+  function Twii.QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;
 
-  function Twii._AddRef: Integer; stdcall;
+  function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;
 
-  function Twii._Release: Integer; stdcall;
+  function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;

+ 6 - 6
tests/webtbs/tw4086.pp

@@ -19,9 +19,9 @@ type
  
  ttestclass1 = class(tobject,itest)
   public
-   function queryinterface(const guid: tguid; out obj): hresult; stdcall;
-   function _addref: integer; stdcall;
-   function _release: integer; stdcall;
+   function queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function _addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function _release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    procedure testproc;
  end;
 
@@ -32,19 +32,19 @@ type
  
 { ttestclass1 }
 
-function ttestclass1.queryinterface(const guid: tguid; out obj): hresult; stdcall;
+function ttestclass1.queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  result:= integer(e_nointerface);
 end;
 
-function ttestclass1._addref: integer; stdcall;
+function ttestclass1._addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  writeln('addref called');
 // result:= inherited _addref;
  result:= -1;
 end;
 
-function ttestclass1._release: integer; stdcall;
+function ttestclass1._release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  writeln('release called');
 // result:= inherited _release;