From 69abbba6bbbf5f0cb64b07acc06a78f930f4c8c6 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 20 Aug 2011 08:24:40 +0000
Subject: [PATCH] * split several parameter insertion helpers out from
pdecsub for easier reuse elsewhere
git-svn-id: branches/jvmbackend@18687 -
---
.gitattributes | 1 +
compiler/pdecsub.pas | 320 +------------------------------------
compiler/pparautl.pas | 362 ++++++++++++++++++++++++++++++++++++++++++
compiler/psub.pas | 2 +-
4 files changed, 365 insertions(+), 320 deletions(-)
create mode 100644 compiler/pparautl.pas
diff --git a/.gitattributes b/.gitattributes
index 14ad7ecf73..31e2f7e303 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -484,6 +484,7 @@ compiler/powerpc64/rppcstd.inc svneol=native#text/plain
compiler/powerpc64/rppcsup.inc svneol=native#text/plain
compiler/pp.lpi svneol=native#text/plain
compiler/pp.pas svneol=native#text/plain
+compiler/pparautl.pas svneol=native#text/plain
compiler/ppc.cfg -text
compiler/ppc.conf -text
compiler/ppc.dof -text
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index e4e0ee97dc..bdd69561b5 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -52,8 +52,6 @@ interface
function check_proc_directive(isprocvar:boolean):boolean;
- procedure insert_funcret_local(pd:tprocdef);
-
function proc_add_definition(var currpd:tprocdef):boolean;
function proc_get_importname(pd:tprocdef):string;
procedure proc_set_mangledname(pd:tprocdef);
@@ -94,7 +92,7 @@ implementation
objcutil,
{ parser }
scanner,
- pbase,pexpr,ptype,pdecl
+ pbase,pexpr,ptype,pdecl,pparautl
;
const
@@ -161,322 +159,6 @@ implementation
inc(result,pop_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
end;
- procedure insert_funcret_para(pd:tabstractprocdef);
- var
- storepos : tfileposinfo;
- vs : tparavarsym;
- paranr : word;
- begin
- if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
- not is_void(pd.returndef) and
- paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
- begin
- storepos:=current_tokenpos;
- if pd.typ=procdef then
- current_tokenpos:=tprocdef(pd).fileinfo;
-
-{$if defined(i386)}
- { For left to right add it at the end to be delphi compatible.
- In the case of safecalls with safecal-exceptions support the
- funcret-para is (from the 'c'-point of view) a normal parameter
- which has to be added to the end of the parameter-list }
- if (pd.proccalloption in (pushleftright_pocalls)) or
- ((tf_safecall_exceptions in target_info.flags) and
- (pd.proccalloption=pocall_safecall)) then
- paranr:=paranr_result_leftright
- else
-{$elseif defined(x86) or defined(arm)}
- if (tf_safecall_exceptions in target_info.flags) and
- (pd.proccalloption = pocall_safecall) then
- paranr:=paranr_result_leftright
- else
-{$endif}
- paranr:=paranr_result;
- { Generate result variable accessing function result }
- vs:=tparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
- pd.parast.insert(vs);
- { Store the this symbol as funcretsym for procedures }
- if pd.typ=procdef then
- tprocdef(pd).funcretsym:=vs;
-
- current_tokenpos:=storepos;
- end;
- end;
-
-
- procedure insert_parentfp_para(pd:tabstractprocdef);
- var
- storepos : tfileposinfo;
- vs : tparavarsym;
- paranr : longint;
- begin
- if pd.parast.symtablelevel>normal_function_level then
- begin
- storepos:=current_tokenpos;
- if pd.typ=procdef then
- current_tokenpos:=tprocdef(pd).fileinfo;
-
- { if no support for nested procvars is activated, use the old
- calling convention to pass the parent frame pointer for backwards
- compatibility }
- if not(m_nested_procvars in current_settings.modeswitches) then
- paranr:=paranr_parentfp
- { nested procvars require Delphi-style parentfp passing, see
- po_delphi_nested_cc declaration for more info }
-{$ifdef i386}
- else if (pd.proccalloption in pushleftright_pocalls) then
- paranr:=paranr_parentfp_delphi_cc_leftright
-{$endif i386}
- else
- paranr:=paranr_parentfp_delphi_cc;
- { Generate frame pointer. It can't be put in a register since it
- must be accessable from nested routines }
- if not(target_info.system in systems_fpnestedstruct) then
- begin
- vs:=tparavarsym.create('$parentfp',paranr,vs_value
- ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
- vs.varregable:=vr_none;
- end
- else
- begin
- if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
- build_parentfpstruct(tprocdef(pd.owner.defowner));
- vs:=tparavarsym.create('$parentfp',paranr,vs_value
- ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
- end;
- pd.parast.insert(vs);
-
- current_tokenpos:=storepos;
- end;
- end;
-
-
- procedure insert_self_and_vmt_para(pd:tabstractprocdef);
- var
- storepos : tfileposinfo;
- vs : tparavarsym;
- hdef : tdef;
- selfdef : tabstractrecorddef;
- vsp : tvarspez;
- aliasvs : tabsolutevarsym;
- sl : tpropaccesslist;
- begin
- if (pd.typ=procdef) and
- is_objc_class_or_protocol(tprocdef(pd).struct) and
- (pd.parast.symtablelevel=normal_function_level) then
- begin
- { insert Objective-C self and selector parameters }
- vs:=tparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
- pd.parast.insert(vs);
- { make accessible to code }
- sl:=tpropaccesslist.create;
- sl.addsym(sl_load,vs);
- aliasvs:=tabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
- include(aliasvs.varoptions,vo_is_msgsel);
- tlocalsymtable(tprocdef(pd).localst).insert(aliasvs);
-
- if (po_classmethod in pd.procoptions) then
- { compatible with what gcc does }
- hdef:=objc_idtype
- else
- hdef:=tprocdef(pd).struct;
-
- vs:=tparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
- pd.parast.insert(vs);
- end
- else if (pd.typ=procvardef) and
- pd.is_methodpointer then
- begin
- { Generate self variable }
- vs:=tparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
- pd.parast.insert(vs);
- end
- else
- begin
- if (pd.typ=procdef) and
- assigned(tprocdef(pd).struct) and
- (pd.parast.symtablelevel=normal_function_level) then
- begin
- { static class methods have no hidden self/vmt pointer }
- if pd.no_self_node then
- exit;
-
- storepos:=current_tokenpos;
- current_tokenpos:=tprocdef(pd).fileinfo;
-
- { Generate VMT variable for constructor/destructor }
- if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
- not(is_cppclass(tprocdef(pd).struct) or
- is_record(tprocdef(pd).struct) or
- is_javaclass(tprocdef(pd).struct)) then
- begin
- { can't use classrefdef as type because inheriting
- will then always file because of a type mismatch }
- vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,voidpointertype,[vo_is_vmt,vo_is_hidden_para]);
- pd.parast.insert(vs);
- end;
-
- { for helpers the type of Self is equivalent to the extended
- type or equal to an instance of it }
- if is_objectpascal_helper(tprocdef(pd).struct) then
- selfdef:=tobjectdef(tprocdef(pd).struct).extendeddef
- else
- selfdef:=tprocdef(pd).struct;
- { Generate self variable, for classes we need
- to use the generic voidpointer to be compatible with
- methodpointers }
- vsp:=vs_value;
- if (po_staticmethod in pd.procoptions) or
- (po_classmethod in pd.procoptions) then
- hdef:=tclassrefdef.create(selfdef)
- else
- begin
- if is_object(selfdef) or is_record(selfdef) then
- vsp:=vs_var;
- hdef:=selfdef;
- end;
- vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
- pd.parast.insert(vs);
-
- current_tokenpos:=storepos;
- end;
- end;
- end;
-
-
- procedure insert_funcret_local(pd:tprocdef);
- var
- storepos : tfileposinfo;
- vs : tlocalvarsym;
- aliasvs : tabsolutevarsym;
- sl : tpropaccesslist;
- hs : string;
- begin
- { The result from constructors and destructors can't be accessed directly }
- if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
- not is_void(pd.returndef) then
- begin
- storepos:=current_tokenpos;
- current_tokenpos:=pd.fileinfo;
-
- { We need to insert a varsym for the result in the localst
- when it is returning in a register }
- if not paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
- begin
- vs:=tlocalvarsym.create('$result',vs_value,pd.returndef,[vo_is_funcret]);
- pd.localst.insert(vs);
- pd.funcretsym:=vs;
- end;
-
- { insert the name of the procedure as alias for the function result,
- we can't use realname because that will not work for compilerprocs
- as the name is lowercase and unreachable from the code }
- if assigned(pd.resultname) then
- hs:=pd.resultname^
- else
- hs:=pd.procsym.name;
- sl:=tpropaccesslist.create;
- sl.addsym(sl_load,pd.funcretsym);
- aliasvs:=tabsolutevarsym.create_ref(hs,pd.returndef,sl);
- include(aliasvs.varoptions,vo_is_funcret);
- tlocalsymtable(pd.localst).insert(aliasvs);
-
- { insert result also if support is on }
- if (m_result in current_settings.modeswitches) then
- begin
- sl:=tpropaccesslist.create;
- sl.addsym(sl_load,pd.funcretsym);
- aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.returndef,sl);
- include(aliasvs.varoptions,vo_is_funcret);
- include(aliasvs.varoptions,vo_is_result);
- tlocalsymtable(pd.localst).insert(aliasvs);
- end;
-
- current_tokenpos:=storepos;
- end;
- end;
-
-
- procedure insert_hidden_para(p:TObject;arg:pointer);
- var
- hvs : tparavarsym;
- pd : tabstractprocdef absolute arg;
- begin
- if (tsym(p).typ<>paravarsym) then
- exit;
- with tparavarsym(p) do
- begin
- { We need a local copy for a value parameter when only the
- address is pushed. Open arrays and Array of Const are
- an exception because they are allocated at runtime and the
- address that is pushed is patched }
- if (varspez=vs_value) and
- paramanager.push_addr_param(varspez,vardef,pd.proccalloption) and
- not(is_open_array(vardef) or
- is_array_of_const(vardef)) then
- include(varoptions,vo_has_local_copy);
-
- { needs high parameter ? }
- if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
- begin
- hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
- hvs.symoptions:=[];
- owner.insert(hvs);
- end
- else
- begin
- { Give a warning that cdecl routines does not include high()
- support }
- if (pd.proccalloption in cdecl_pocalls) and
- paramanager.push_high_param(varspez,vardef,pocall_default) then
- begin
- if is_open_string(vardef) then
- MessagePos(fileinfo,parser_w_cdecl_no_openstring);
- if not(po_external in pd.procoptions) and
- (pd.typ<>procvardef) and
- not is_objc_class_or_protocol(tprocdef(pd).struct) then
- if is_array_of_const(vardef) then
- MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external)
- else
- MessagePos(fileinfo,parser_w_cdecl_has_no_high);
- end;
- if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
- begin
- hvs:=tparavarsym.create('$typinfo'+name,paranr+1,vs_const,voidpointertype,
- [vo_is_typinfo_para,vo_is_hidden_para]);
- owner.insert(hvs);
- end;
- end;
- end;
- end;
-
-
- procedure check_c_para(pd:Tabstractprocdef);
- var
- i,
- lastparaidx : longint;
- sym : TSym;
- begin
- lastparaidx:=pd.parast.SymList.Count-1;
- for i:=0 to pd.parast.SymList.Count-1 do
- begin
- sym:=tsym(pd.parast.SymList[i]);
- if (sym.typ=paravarsym) and
- (tparavarsym(sym).vardef.typ=arraydef) then
- begin
- if not is_variant_array(tparavarsym(sym).vardef) and
- not is_array_of_const(tparavarsym(sym).vardef) and
- (tparavarsym(sym).varspez<>vs_var) then
- MessagePos(tparavarsym(sym).fileinfo,parser_h_c_arrays_are_references);
- if is_array_of_const(tparavarsym(sym).vardef) and
- (i<lastparaidx) and
- (tsym(pd.parast.SymList[i+1]).typ=paravarsym) and
- not(vo_is_high_para in tparavarsym(pd.parast.SymList[i+1]).varoptions) then
- MessagePos(tparavarsym(sym).fileinfo,parser_e_C_array_of_const_must_be_last);
- end;
- end;
- end;
-
procedure check_msg_para(p:TObject;arg:pointer);
begin
diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas
new file mode 100644
index 0000000000..57297137e2
--- /dev/null
+++ b/compiler/pparautl.pas
@@ -0,0 +1,362 @@
+{
+ Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione
+
+ Helpers for dealing with subroutine parameters during parsing
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit pparautl;
+
+
+interface
+
+ uses
+ symdef;
+
+ procedure insert_funcret_para(pd:tabstractprocdef);
+ procedure insert_parentfp_para(pd:tabstractprocdef);
+ procedure insert_self_and_vmt_para(pd:tabstractprocdef);
+ procedure insert_funcret_local(pd:tprocdef);
+ procedure insert_hidden_para(p:TObject;arg:pointer);
+ procedure check_c_para(pd:Tabstractprocdef);
+
+implementation
+
+ uses
+ globals,globtype,verbose,systems,
+ symconst,symtype,symbase,symsym,symtable,symcreat,defutil,
+ paramgr;
+
+
+ procedure insert_funcret_para(pd:tabstractprocdef);
+ var
+ storepos : tfileposinfo;
+ vs : tparavarsym;
+ paranr : word;
+ begin
+ if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
+ not is_void(pd.returndef) and
+ paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
+ begin
+ storepos:=current_tokenpos;
+ if pd.typ=procdef then
+ current_tokenpos:=tprocdef(pd).fileinfo;
+
+{$if defined(i386)}
+ { For left to right add it at the end to be delphi compatible.
+ In the case of safecalls with safecal-exceptions support the
+ funcret-para is (from the 'c'-point of view) a normal parameter
+ which has to be added to the end of the parameter-list }
+ if (pd.proccalloption in (pushleftright_pocalls)) or
+ ((tf_safecall_exceptions in target_info.flags) and
+ (pd.proccalloption=pocall_safecall)) then
+ paranr:=paranr_result_leftright
+ else
+{$elseif defined(x86) or defined(arm)}
+ if (tf_safecall_exceptions in target_info.flags) and
+ (pd.proccalloption = pocall_safecall) then
+ paranr:=paranr_result_leftright
+ else
+{$endif}
+ paranr:=paranr_result;
+ { Generate result variable accessing function result }
+ vs:=tparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+ { Store the this symbol as funcretsym for procedures }
+ if pd.typ=procdef then
+ tprocdef(pd).funcretsym:=vs;
+
+ current_tokenpos:=storepos;
+ end;
+ end;
+
+
+ procedure insert_parentfp_para(pd:tabstractprocdef);
+ var
+ storepos : tfileposinfo;
+ vs : tparavarsym;
+ paranr : longint;
+ begin
+ if pd.parast.symtablelevel>normal_function_level then
+ begin
+ storepos:=current_tokenpos;
+ if pd.typ=procdef then
+ current_tokenpos:=tprocdef(pd).fileinfo;
+
+ { if no support for nested procvars is activated, use the old
+ calling convention to pass the parent frame pointer for backwards
+ compatibility }
+ if not(m_nested_procvars in current_settings.modeswitches) then
+ paranr:=paranr_parentfp
+ { nested procvars require Delphi-style parentfp passing, see
+ po_delphi_nested_cc declaration for more info }
+{$ifdef i386}
+ else if (pd.proccalloption in pushleftright_pocalls) then
+ paranr:=paranr_parentfp_delphi_cc_leftright
+{$endif i386}
+ else
+ paranr:=paranr_parentfp_delphi_cc;
+ { Generate frame pointer. It can't be put in a register since it
+ must be accessable from nested routines }
+ if not(target_info.system in systems_fpnestedstruct) then
+ begin
+ vs:=tparavarsym.create('$parentfp',paranr,vs_value
+ ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
+ vs.varregable:=vr_none;
+ end
+ else
+ begin
+ if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
+ build_parentfpstruct(tprocdef(pd.owner.defowner));
+ vs:=tparavarsym.create('$parentfp',paranr,vs_value
+ ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
+ end;
+ pd.parast.insert(vs);
+
+ current_tokenpos:=storepos;
+ end;
+ end;
+
+
+ procedure insert_self_and_vmt_para(pd:tabstractprocdef);
+ var
+ storepos : tfileposinfo;
+ vs : tparavarsym;
+ hdef : tdef;
+ selfdef : tabstractrecorddef;
+ vsp : tvarspez;
+ aliasvs : tabsolutevarsym;
+ sl : tpropaccesslist;
+ begin
+ if (pd.typ=procdef) and
+ is_objc_class_or_protocol(tprocdef(pd).struct) and
+ (pd.parast.symtablelevel=normal_function_level) then
+ begin
+ { insert Objective-C self and selector parameters }
+ vs:=tparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+ { make accessible to code }
+ sl:=tpropaccesslist.create;
+ sl.addsym(sl_load,vs);
+ aliasvs:=tabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
+ include(aliasvs.varoptions,vo_is_msgsel);
+ tlocalsymtable(tprocdef(pd).localst).insert(aliasvs);
+
+ if (po_classmethod in pd.procoptions) then
+ { compatible with what gcc does }
+ hdef:=objc_idtype
+ else
+ hdef:=tprocdef(pd).struct;
+
+ vs:=tparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+ end
+ else if (pd.typ=procvardef) and
+ pd.is_methodpointer then
+ begin
+ { Generate self variable }
+ vs:=tparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+ end
+ else
+ begin
+ if (pd.typ=procdef) and
+ assigned(tprocdef(pd).struct) and
+ (pd.parast.symtablelevel=normal_function_level) then
+ begin
+ { static class methods have no hidden self/vmt pointer }
+ if pd.no_self_node then
+ exit;
+
+ storepos:=current_tokenpos;
+ current_tokenpos:=tprocdef(pd).fileinfo;
+
+ { Generate VMT variable for constructor/destructor }
+ if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
+ not(is_cppclass(tprocdef(pd).struct) or
+ is_record(tprocdef(pd).struct) or
+ is_javaclass(tprocdef(pd).struct)) then
+ begin
+ { can't use classrefdef as type because inheriting
+ will then always file because of a type mismatch }
+ vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,voidpointertype,[vo_is_vmt,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+ end;
+
+ { for helpers the type of Self is equivalent to the extended
+ type or equal to an instance of it }
+ if is_objectpascal_helper(tprocdef(pd).struct) then
+ selfdef:=tobjectdef(tprocdef(pd).struct).extendeddef
+ else
+ selfdef:=tprocdef(pd).struct;
+ { Generate self variable, for classes we need
+ to use the generic voidpointer to be compatible with
+ methodpointers }
+ vsp:=vs_value;
+ if (po_staticmethod in pd.procoptions) or
+ (po_classmethod in pd.procoptions) then
+ hdef:=tclassrefdef.create(selfdef)
+ else
+ begin
+ if is_object(selfdef) or is_record(selfdef) then
+ vsp:=vs_var;
+ hdef:=selfdef;
+ end;
+ vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
+ pd.parast.insert(vs);
+
+ current_tokenpos:=storepos;
+ end;
+ end;
+ end;
+
+
+ procedure insert_funcret_local(pd:tprocdef);
+ var
+ storepos : tfileposinfo;
+ vs : tlocalvarsym;
+ aliasvs : tabsolutevarsym;
+ sl : tpropaccesslist;
+ hs : string;
+ begin
+ { The result from constructors and destructors can't be accessed directly }
+ if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
+ not is_void(pd.returndef) then
+ begin
+ storepos:=current_tokenpos;
+ current_tokenpos:=pd.fileinfo;
+
+ { We need to insert a varsym for the result in the localst
+ when it is returning in a register }
+ if not paramanager.ret_in_param(pd.returndef,pd.proccalloption) then
+ begin
+ vs:=tlocalvarsym.create('$result',vs_value,pd.returndef,[vo_is_funcret]);
+ pd.localst.insert(vs);
+ pd.funcretsym:=vs;
+ end;
+
+ { insert the name of the procedure as alias for the function result,
+ we can't use realname because that will not work for compilerprocs
+ as the name is lowercase and unreachable from the code }
+ if assigned(pd.resultname) then
+ hs:=pd.resultname^
+ else
+ hs:=pd.procsym.name;
+ sl:=tpropaccesslist.create;
+ sl.addsym(sl_load,pd.funcretsym);
+ aliasvs:=tabsolutevarsym.create_ref(hs,pd.returndef,sl);
+ include(aliasvs.varoptions,vo_is_funcret);
+ tlocalsymtable(pd.localst).insert(aliasvs);
+
+ { insert result also if support is on }
+ if (m_result in current_settings.modeswitches) then
+ begin
+ sl:=tpropaccesslist.create;
+ sl.addsym(sl_load,pd.funcretsym);
+ aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.returndef,sl);
+ include(aliasvs.varoptions,vo_is_funcret);
+ include(aliasvs.varoptions,vo_is_result);
+ tlocalsymtable(pd.localst).insert(aliasvs);
+ end;
+
+ current_tokenpos:=storepos;
+ end;
+ end;
+
+
+ procedure insert_hidden_para(p:TObject;arg:pointer);
+ var
+ hvs : tparavarsym;
+ pd : tabstractprocdef absolute arg;
+ begin
+ if (tsym(p).typ<>paravarsym) then
+ exit;
+ with tparavarsym(p) do
+ begin
+ { We need a local copy for a value parameter when only the
+ address is pushed. Open arrays and Array of Const are
+ an exception because they are allocated at runtime and the
+ address that is pushed is patched }
+ if (varspez=vs_value) and
+ paramanager.push_addr_param(varspez,vardef,pd.proccalloption) and
+ not(is_open_array(vardef) or
+ is_array_of_const(vardef)) then
+ include(varoptions,vo_has_local_copy);
+
+ { needs high parameter ? }
+ if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
+ begin
+ hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
+ hvs.symoptions:=[];
+ owner.insert(hvs);
+ end
+ else
+ begin
+ { Give a warning that cdecl routines does not include high()
+ support }
+ if (pd.proccalloption in cdecl_pocalls) and
+ paramanager.push_high_param(varspez,vardef,pocall_default) then
+ begin
+ if is_open_string(vardef) then
+ MessagePos(fileinfo,parser_w_cdecl_no_openstring);
+ if not(po_external in pd.procoptions) and
+ (pd.typ<>procvardef) and
+ not is_objc_class_or_protocol(tprocdef(pd).struct) then
+ if is_array_of_const(vardef) then
+ MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external)
+ else
+ MessagePos(fileinfo,parser_w_cdecl_has_no_high);
+ end;
+ if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
+ begin
+ hvs:=tparavarsym.create('$typinfo'+name,paranr+1,vs_const,voidpointertype,
+ [vo_is_typinfo_para,vo_is_hidden_para]);
+ owner.insert(hvs);
+ end;
+ end;
+ end;
+ end;
+
+
+ procedure check_c_para(pd:Tabstractprocdef);
+ var
+ i,
+ lastparaidx : longint;
+ sym : TSym;
+ begin
+ lastparaidx:=pd.parast.SymList.Count-1;
+ for i:=0 to pd.parast.SymList.Count-1 do
+ begin
+ sym:=tsym(pd.parast.SymList[i]);
+ if (sym.typ=paravarsym) and
+ (tparavarsym(sym).vardef.typ=arraydef) then
+ begin
+ if not is_variant_array(tparavarsym(sym).vardef) and
+ not is_array_of_const(tparavarsym(sym).vardef) and
+ (tparavarsym(sym).varspez<>vs_var) then
+ MessagePos(tparavarsym(sym).fileinfo,parser_h_c_arrays_are_references);
+ if is_array_of_const(tparavarsym(sym).vardef) and
+ (i<lastparaidx) and
+ (tsym(pd.parast.SymList[i+1]).typ=paravarsym) and
+ not(vo_is_high_para in tparavarsym(pd.parast.SymList[i+1]).varoptions) then
+ MessagePos(tparavarsym(sym).fileinfo,parser_e_C_array_of_const_must_be_last);
+ end;
+ end;
+ end;
+
+
+end.
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 013b9e7c5f..69c2acfa22 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -101,7 +101,7 @@ implementation
{$endif}
{ parser }
scanner,import,gendef,
- pbase,pstatmnt,pdecl,pdecsub,pexports,
+ pbase,pstatmnt,pdecl,pdecsub,pexports,pparautl,
{ codegen }
tgobj,cgbase,cgobj,cgcpu,hlcgobj,hlcgcpu,dbgbase,
ncgutil,regvars,