+ introduced the discardresult directive and declared the UniqueString()

  overloads, using this directive

git-svn-id: branches/wasm@48283 -

compiler/pdecsub.pas

@@ -2429,7 +2429,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=53;
+  num_proc_directives=54;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2495,6 +2495,15 @@ const
       mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_assembler,po_external]
+    ),(
+      idtok:_DISCARDRESULT;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
+      handler  : nil;
+      pocall   : pocall_none;
+      pooption : [po_discardresult];
+      mutexclpocall : [];
+      mutexclpotype : [potype_function,potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : []
     ),(
       idtok:_DISPID;
       pd_flags : [pd_dispinterface];

compiler/symconst.pas

@@ -435,7 +435,9 @@ type
       "varargs" modifier or Mac-Pascal ".." parameter }
     po_variadic,
     { implicitly return same type as the class instance to which the message is sent }
-    po_objc_related_result_type
+    po_objc_related_result_type,
+    { procedure returns value (like a function), that should be discarded }
+    po_discardresult
   );
   tprocoptions=set of tprocoption;
 
@@ -1099,7 +1101,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       'po_is_auto_setter',{po_is_auto_setter}
       'po_noinline',{po_noinline}
       'C-style array-of-const', {po_variadic}
-      'objc-related-result-type' {po_objc_related_result_type}
+      'objc-related-result-type', {po_objc_related_result_type}
+      'po_discardresult' { po_discardresult }
     );
 
 implementation

compiler/tokens.pas

@@ -305,6 +305,7 @@ type
     _OBJCCATEGORY,
     _OBJCPROTOCOL,
     _WEAKEXTERNAL,
+    _DISCARDRESULT,
     _DISPINTERFACE,
     _UNIMPLEMENTED,
     _IMPLEMENTATION,
@@ -647,6 +648,7 @@ const
       (str:'OBJCCATEGORY'  ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C category }
       (str:'OBJCPROTOCOL'  ;special:false;keyword:[m_objectivec1];op:NOTOKEN), { Objective-C protocol }
       (str:'WEAKEXTERNAL'  ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'DISCARDRESULT' ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DISPINTERFACE' ;special:false;keyword:[m_class];op:NOTOKEN),
       (str:'UNIMPLEMENTED' ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'IMPLEMENTATION';special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),

compiler/wasm32/hlcgcpu.pas

@@ -1876,6 +1876,8 @@ implementation
     begin
       ft:=tcpuprocdef(pd).create_functype;
       totalremovesize:=Length(ft.params)-Length(ft.results);
+      if (Length(ft.results)=0) and (po_discardresult in pd.procoptions) then
+        dec(totalremovesize);
       { remove parameters from internal evaluation stack counter (in case of
         e.g. no parameters and a result, it can also increase) }
       if totalremovesize>0 then

compiler/wasm32/nwasmcal.pas

@@ -49,7 +49,7 @@ interface
 implementation
 
     uses
-      globtype, aasmdata, defutil, tgobj, hlcgcpu;
+      globtype, aasmdata, defutil, tgobj, hlcgcpu, symconst;
 
       { twasmcallnode }
 
@@ -60,7 +60,7 @@ implementation
 
     procedure twasmcallnode.do_release_unused_return_value;
       begin
-        if is_void(resultdef) then
+        if is_void(resultdef) and not (po_discardresult in procdefinition.procoptions) then
           exit;
         current_asmdata.CurrAsmList.concat(taicpu.op_none(a_drop));
         thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);

rtl/inc/systemh.inc

@@ -1319,7 +1319,7 @@ function  Pos(const substr : shortstring;c:char; Offset: Sizeint = 1): SizeInt;
 ****************************************************************************}
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE';
+Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE';discardresult;
 Function  Pos (const Substr : RawByteString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt;
 Function  Pos (c : AnsiChar; const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
 {$ifdef VER3_0}

rtl/inc/ustringh.inc

@@ -15,7 +15,7 @@
  **********************************************************************}
 
 
-Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';
+Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';discardresult;
 Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;

rtl/inc/wstringh.inc

@@ -15,7 +15,7 @@
  **********************************************************************}
 
 
-Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
+Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';discardresult;
 Function Pos (Const Substr : WideString; Const Source : WideString; Offset : SizeInt = 1) : SizeInt;
 Function Pos (c : Char; Const s : WideString; Offset : SizeInt = 1) : SizeInt;
 Function Pos (c : WideChar; Const s : WideString; Offset : SizeInt = 1) : SizeInt;