paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 17:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ introduced the discardresult directive and declared the UniqueString()

Browse Source 
overloads, using this directive

git-svn-id: branches/wasm@48283 -
This commit is contained in:
nickysn 2021-01-21 21:42:07 +00:00
parent 187659ff02
commit 7e958e0a35
8 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/pdecsub.pas
View File

@ -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];

7
compiler/symconst.pas
View File

@ -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

2
compiler/tokens.pas
View File

@ -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),

2
compiler/wasm32/hlcgcpu.pas
View File

@ -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

4
compiler/wasm32/nwasmcal.pas
View File

@ -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);

2
rtl/inc/systemh.inc
View File

@ -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}

2
rtl/inc/ustringh.inc
View File

@ -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;

2
rtl/inc/wstringh.inc
View File

@ -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;