|
|
@@ -2880,8 +2880,6 @@ implementation
|
|
|
statements : tstatementnode;
|
|
|
converted_result_data : ttempcreatenode;
|
|
|
calltype: tdispcalltype;
|
|
|
- label
|
|
|
- errorexit;
|
|
|
begin
|
|
|
result:=nil;
|
|
|
candidates:=nil;
|
|
|
@@ -2889,460 +2887,462 @@ implementation
|
|
|
oldcallnode:=aktcallnode;
|
|
|
aktcallnode:=self;
|
|
|
|
|
|
- { determine length of parameter list }
|
|
|
- pt:=tcallparanode(left);
|
|
|
- paralength:=0;
|
|
|
- while assigned(pt) do
|
|
|
- begin
|
|
|
- inc(paralength);
|
|
|
- pt:=tcallparanode(pt.right);
|
|
|
- end;
|
|
|
+ try
|
|
|
+ { determine length of parameter list }
|
|
|
+ pt:=tcallparanode(left);
|
|
|
+ paralength:=0;
|
|
|
+ while assigned(pt) do
|
|
|
+ begin
|
|
|
+ inc(paralength);
|
|
|
+ pt:=tcallparanode(pt.right);
|
|
|
+ end;
|
|
|
|
|
|
- { determine the type of the parameters }
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- tcallparanode(left).get_paratype;
|
|
|
- if codegenerror then
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
+ { determine the type of the parameters }
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ tcallparanode(left).get_paratype;
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- if assigned(methodpointer) then
|
|
|
- typecheckpass(methodpointer);
|
|
|
+ if assigned(methodpointer) then
|
|
|
+ typecheckpass(methodpointer);
|
|
|
|
|
|
- { procedure variable ? }
|
|
|
- if assigned(right) then
|
|
|
- begin
|
|
|
- set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
|
- typecheckpass(right);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
+ { procedure variable ? }
|
|
|
+ if assigned(right) then
|
|
|
+ begin
|
|
|
+ set_varstate(right,vs_read,[vsf_must_be_valid]);
|
|
|
+ typecheckpass(right);
|
|
|
+ if codegenerror then
|
|
|
+ exit;
|
|
|
|
|
|
- procdefinition:=tabstractprocdef(right.resultdef);
|
|
|
+ procdefinition:=tabstractprocdef(right.resultdef);
|
|
|
|
|
|
- { Compare parameters from right to left }
|
|
|
- paraidx:=procdefinition.Paras.count-1;
|
|
|
- { Skip default parameters }
|
|
|
- if not(po_varargs in procdefinition.procoptions) then
|
|
|
- begin
|
|
|
- { ignore hidden parameters }
|
|
|
- while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
- dec(paraidx);
|
|
|
- for i:=1 to procdefinition.maxparacount-paralength do
|
|
|
- begin
|
|
|
- if paraidx<0 then
|
|
|
- internalerror(200402265);
|
|
|
- if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
|
|
|
- begin
|
|
|
- CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
+ { Compare parameters from right to left }
|
|
|
+ paraidx:=procdefinition.Paras.count-1;
|
|
|
+ { Skip default parameters }
|
|
|
+ if not(po_varargs in procdefinition.procoptions) then
|
|
|
+ begin
|
|
|
+ { ignore hidden parameters }
|
|
|
+ while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
dec(paraidx);
|
|
|
- end;
|
|
|
- end;
|
|
|
- while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
- dec(paraidx);
|
|
|
- pt:=tcallparanode(left);
|
|
|
- lastpara:=paralength;
|
|
|
- while (paraidx>=0) and assigned(pt) do
|
|
|
- begin
|
|
|
- { only goto next para if we're out of the varargs }
|
|
|
- if not(po_varargs in procdefinition.procoptions) or
|
|
|
- (lastpara<=procdefinition.maxparacount) then
|
|
|
- begin
|
|
|
- repeat
|
|
|
- dec(paraidx);
|
|
|
- until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
|
|
|
- end;
|
|
|
- pt:=tcallparanode(pt.right);
|
|
|
- dec(lastpara);
|
|
|
- end;
|
|
|
- if assigned(pt) or
|
|
|
- ((paraidx>=0) and
|
|
|
- not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then
|
|
|
- begin
|
|
|
- if assigned(pt) then
|
|
|
- current_filepos:=pt.fileinfo;
|
|
|
- CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- { not a procedure variable }
|
|
|
- begin
|
|
|
- { do we know the procedure to call ? }
|
|
|
- if not(assigned(procdefinition)) then
|
|
|
- begin
|
|
|
- { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
|
|
|
- ignorevisibility:=(nf_isproperty in flags) or
|
|
|
- ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
|
|
|
- candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
|
|
|
- not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
|
|
|
- callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags);
|
|
|
-
|
|
|
- { no procedures found? then there is something wrong
|
|
|
- with the parameter size or the procedures are
|
|
|
- not accessible }
|
|
|
- if candidates.count=0 then
|
|
|
- begin
|
|
|
- { when it's an auto inherited call and there
|
|
|
- is no procedure found, but the procedures
|
|
|
- were defined with overload directive and at
|
|
|
- least two procedures are defined then we ignore
|
|
|
- this inherited by inserting a nothingn. Only
|
|
|
- do this ugly hack in Delphi mode as it looks more
|
|
|
- like a bug. It's also not documented }
|
|
|
- if (m_delphi in current_settings.modeswitches) and
|
|
|
- (cnf_anon_inherited in callnodeflags) and
|
|
|
- (symtableprocentry.owner.symtabletype=ObjectSymtable) and
|
|
|
- (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
|
|
|
- (symtableprocentry.ProcdefList.Count>=2) then
|
|
|
- result:=cnothingnode.create
|
|
|
- else
|
|
|
- begin
|
|
|
- { in tp mode we can try to convert to procvar if
|
|
|
- there are no parameters specified }
|
|
|
- if not(assigned(left)) and
|
|
|
- not(cnf_inherited in callnodeflags) and
|
|
|
- ((m_tp_procvar in current_settings.modeswitches) or
|
|
|
- (m_mac_procvar in current_settings.modeswitches)) and
|
|
|
- (not assigned(methodpointer) or
|
|
|
- (methodpointer.nodetype <> typen)) then
|
|
|
- begin
|
|
|
- hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
|
|
|
- if assigned(methodpointer) then
|
|
|
- tloadnode(hpt).set_mp(methodpointer.getcopy);
|
|
|
- typecheckpass(hpt);
|
|
|
- result:=hpt;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
|
|
|
- symtableprocentry.write_parameter_lists(nil);
|
|
|
- end;
|
|
|
- end;
|
|
|
- candidates.free;
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
+ for i:=1 to procdefinition.maxparacount-paralength do
|
|
|
+ begin
|
|
|
+ if paraidx<0 then
|
|
|
+ internalerror(200402265);
|
|
|
+ if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
|
|
|
+ begin
|
|
|
+ CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ dec(paraidx);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
+ dec(paraidx);
|
|
|
+ pt:=tcallparanode(left);
|
|
|
+ lastpara:=paralength;
|
|
|
+ while (paraidx>=0) and assigned(pt) do
|
|
|
+ begin
|
|
|
+ { only goto next para if we're out of the varargs }
|
|
|
+ if not(po_varargs in procdefinition.procoptions) or
|
|
|
+ (lastpara<=procdefinition.maxparacount) then
|
|
|
+ begin
|
|
|
+ repeat
|
|
|
+ dec(paraidx);
|
|
|
+ until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
|
|
|
+ end;
|
|
|
+ pt:=tcallparanode(pt.right);
|
|
|
+ dec(lastpara);
|
|
|
+ end;
|
|
|
+ if assigned(pt) or
|
|
|
+ ((paraidx>=0) and
|
|
|
+ not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then
|
|
|
+ begin
|
|
|
+ if assigned(pt) then
|
|
|
+ current_filepos:=pt.fileinfo;
|
|
|
+ CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ { not a procedure variable }
|
|
|
+ begin
|
|
|
+ { do we know the procedure to call ? }
|
|
|
+ if not(assigned(procdefinition)) then
|
|
|
+ begin
|
|
|
+ { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
|
|
|
+ ignorevisibility:=(nf_isproperty in flags) or
|
|
|
+ ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
|
|
|
+ candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
|
|
|
+ not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
|
|
|
+ callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags);
|
|
|
+
|
|
|
+ { no procedures found? then there is something wrong
|
|
|
+ with the parameter size or the procedures are
|
|
|
+ not accessible }
|
|
|
+ if candidates.count=0 then
|
|
|
+ begin
|
|
|
+ { when it's an auto inherited call and there
|
|
|
+ is no procedure found, but the procedures
|
|
|
+ were defined with overload directive and at
|
|
|
+ least two procedures are defined then we ignore
|
|
|
+ this inherited by inserting a nothingn. Only
|
|
|
+ do this ugly hack in Delphi mode as it looks more
|
|
|
+ like a bug. It's also not documented }
|
|
|
+ if (m_delphi in current_settings.modeswitches) and
|
|
|
+ (cnf_anon_inherited in callnodeflags) and
|
|
|
+ (symtableprocentry.owner.symtabletype=ObjectSymtable) and
|
|
|
+ (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
|
|
|
+ (symtableprocentry.ProcdefList.Count>=2) then
|
|
|
+ result:=cnothingnode.create
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { in tp mode we can try to convert to procvar if
|
|
|
+ there are no parameters specified }
|
|
|
+ if not(assigned(left)) and
|
|
|
+ not(cnf_inherited in callnodeflags) and
|
|
|
+ ((m_tp_procvar in current_settings.modeswitches) or
|
|
|
+ (m_mac_procvar in current_settings.modeswitches)) and
|
|
|
+ (not assigned(methodpointer) or
|
|
|
+ (methodpointer.nodetype <> typen)) then
|
|
|
+ begin
|
|
|
+ hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
|
|
|
+ if assigned(methodpointer) then
|
|
|
+ tloadnode(hpt).set_mp(methodpointer.getcopy);
|
|
|
+ typecheckpass(hpt);
|
|
|
+ result:=hpt;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
|
|
|
+ symtableprocentry.write_parameter_lists(nil);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ candidates.free;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- { Retrieve information about the candidates }
|
|
|
- candidates.get_information;
|
|
|
+ { Retrieve information about the candidates }
|
|
|
+ candidates.get_information;
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- { Display info when multiple candidates are found }
|
|
|
- if candidates.count>1 then
|
|
|
- candidates.dump_info(V_Debug);
|
|
|
+ { Display info when multiple candidates are found }
|
|
|
+ if candidates.count>1 then
|
|
|
+ candidates.dump_info(V_Debug);
|
|
|
{$endif EXTDEBUG}
|
|
|
|
|
|
- { Choose the best candidate and count the number of
|
|
|
- candidates left }
|
|
|
- cand_cnt:=candidates.choose_best(procdefinition,
|
|
|
- assigned(left) and
|
|
|
- not assigned(tcallparanode(left).right) and
|
|
|
- (tcallparanode(left).left.resultdef.typ=variantdef));
|
|
|
+ { Choose the best candidate and count the number of
|
|
|
+ candidates left }
|
|
|
+ cand_cnt:=candidates.choose_best(procdefinition,
|
|
|
+ assigned(left) and
|
|
|
+ not assigned(tcallparanode(left).right) and
|
|
|
+ (tcallparanode(left).left.resultdef.typ=variantdef));
|
|
|
|
|
|
- { All parameters are checked, check if there are any
|
|
|
- procedures left }
|
|
|
- if cand_cnt>0 then
|
|
|
- begin
|
|
|
- { Multiple candidates left? }
|
|
|
- if cand_cnt>1 then
|
|
|
- begin
|
|
|
- CGMessage(type_e_cant_choose_overload_function);
|
|
|
+ { All parameters are checked, check if there are any
|
|
|
+ procedures left }
|
|
|
+ if cand_cnt>0 then
|
|
|
+ begin
|
|
|
+ { Multiple candidates left? }
|
|
|
+ if cand_cnt>1 then
|
|
|
+ begin
|
|
|
+ CGMessage(type_e_cant_choose_overload_function);
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- candidates.dump_info(V_Hint);
|
|
|
+ candidates.dump_info(V_Hint);
|
|
|
{$else EXTDEBUG}
|
|
|
- candidates.list(false);
|
|
|
+ candidates.list(false);
|
|
|
{$endif EXTDEBUG}
|
|
|
- { we'll just use the first candidate to make the
|
|
|
- call }
|
|
|
- end;
|
|
|
+ { we'll just use the first candidate to make the
|
|
|
+ call }
|
|
|
+ end;
|
|
|
|
|
|
- { assign procdefinition }
|
|
|
- if symtableproc=nil then
|
|
|
- symtableproc:=procdefinition.owner;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { No candidates left, this must be a type error,
|
|
|
- because wrong size is already checked. procdefinition
|
|
|
- is filled with the first (random) definition that is
|
|
|
- found. We use this definition to display a nice error
|
|
|
- message that the wrong type is passed }
|
|
|
- candidates.find_wrong_para;
|
|
|
- candidates.list(true);
|
|
|
+ { assign procdefinition }
|
|
|
+ if symtableproc=nil then
|
|
|
+ symtableproc:=procdefinition.owner;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { No candidates left, this must be a type error,
|
|
|
+ because wrong size is already checked. procdefinition
|
|
|
+ is filled with the first (random) definition that is
|
|
|
+ found. We use this definition to display a nice error
|
|
|
+ message that the wrong type is passed }
|
|
|
+ candidates.find_wrong_para;
|
|
|
+ candidates.list(true);
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- candidates.dump_info(V_Hint);
|
|
|
+ candidates.dump_info(V_Hint);
|
|
|
{$endif EXTDEBUG}
|
|
|
|
|
|
- { We can not proceed, release all procs and exit }
|
|
|
- candidates.free;
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
+ { We can not proceed, release all procs and exit }
|
|
|
+ candidates.free;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- candidates.free;
|
|
|
- end; { end of procedure to call determination }
|
|
|
- end;
|
|
|
+ candidates.free;
|
|
|
+ end; { end of procedure to call determination }
|
|
|
+ end;
|
|
|
|
|
|
- { check for hints (deprecated etc) }
|
|
|
- if procdefinition.typ = procdef then
|
|
|
- check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions,tprocdef(procdefinition).deprecatedmsg);
|
|
|
+ { check for hints (deprecated etc) }
|
|
|
+ if procdefinition.typ = procdef then
|
|
|
+ check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions,tprocdef(procdefinition).deprecatedmsg);
|
|
|
|
|
|
- { add reference to corresponding procsym; may not be the one
|
|
|
- originally found/passed to the constructor because of overloads }
|
|
|
- if procdefinition.typ = procdef then
|
|
|
- addsymref(tprocdef(procdefinition).procsym);
|
|
|
+ { add reference to corresponding procsym; may not be the one
|
|
|
+ originally found/passed to the constructor because of overloads }
|
|
|
+ if procdefinition.typ = procdef then
|
|
|
+ addsymref(tprocdef(procdefinition).procsym);
|
|
|
|
|
|
- { add needed default parameters }
|
|
|
- if (paralength<procdefinition.maxparacount) then
|
|
|
- begin
|
|
|
- paraidx:=0;
|
|
|
- i:=0;
|
|
|
- while (i<paralength) do
|
|
|
- begin
|
|
|
- if paraidx>=procdefinition.Paras.count then
|
|
|
- internalerror(200306181);
|
|
|
- if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then
|
|
|
- inc(i);
|
|
|
- inc(paraidx);
|
|
|
- end;
|
|
|
- while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
- inc(paraidx);
|
|
|
- while (paraidx<procdefinition.paras.count) do
|
|
|
- begin
|
|
|
- if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
|
|
|
- internalerror(200212142);
|
|
|
- left:=ccallparanode.create(genconstsymtree(
|
|
|
- tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left);
|
|
|
- { Ignore vs_hidden parameters }
|
|
|
- repeat
|
|
|
+ { add needed default parameters }
|
|
|
+ if (paralength<procdefinition.maxparacount) then
|
|
|
+ begin
|
|
|
+ paraidx:=0;
|
|
|
+ i:=0;
|
|
|
+ while (i<paralength) do
|
|
|
+ begin
|
|
|
+ if paraidx>=procdefinition.Paras.count then
|
|
|
+ internalerror(200306181);
|
|
|
+ if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then
|
|
|
+ inc(i);
|
|
|
inc(paraidx);
|
|
|
- until (paraidx>=procdefinition.paras.count) or
|
|
|
- not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
|
|
|
- end;
|
|
|
- end;
|
|
|
+ end;
|
|
|
+ while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
|
|
|
+ inc(paraidx);
|
|
|
+ while (paraidx<procdefinition.paras.count) do
|
|
|
+ begin
|
|
|
+ if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
|
|
|
+ internalerror(200212142);
|
|
|
+ left:=ccallparanode.create(genconstsymtree(
|
|
|
+ tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left);
|
|
|
+ { Ignore vs_hidden parameters }
|
|
|
+ repeat
|
|
|
+ inc(paraidx);
|
|
|
+ until (paraidx>=procdefinition.paras.count) or
|
|
|
+ not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
|
|
|
- { recursive call? }
|
|
|
- if assigned(current_procinfo) and
|
|
|
- (procdefinition=current_procinfo.procdef) then
|
|
|
- include(current_procinfo.flags,pi_is_recursive);
|
|
|
-
|
|
|
- { handle predefined procedures }
|
|
|
- is_const:=(po_internconst in procdefinition.procoptions) and
|
|
|
- ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
|
|
|
- (assigned(left) and ((tcallparanode(left).left.nodetype in [realconstn,ordconstn])
|
|
|
- and (not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype in [realconstn,ordconstn])))));
|
|
|
- if (procdefinition.proccalloption=pocall_internproc) or is_const then
|
|
|
- begin
|
|
|
- if assigned(left) then
|
|
|
- begin
|
|
|
- { convert types to those of the prototype, this is required by functions like ror, rol, sar
|
|
|
- some use however a dummy type (Typedfile) so this would break them }
|
|
|
- if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then
|
|
|
- begin
|
|
|
- { bind parasyms to the callparanodes and insert hidden parameters }
|
|
|
- bind_parasym;
|
|
|
+ { recursive call? }
|
|
|
+ if assigned(current_procinfo) and
|
|
|
+ (procdefinition=current_procinfo.procdef) then
|
|
|
+ include(current_procinfo.flags,pi_is_recursive);
|
|
|
+
|
|
|
+ { handle predefined procedures }
|
|
|
+ is_const:=(po_internconst in procdefinition.procoptions) and
|
|
|
+ ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
|
|
|
+ (assigned(left) and ((tcallparanode(left).left.nodetype in [realconstn,ordconstn])
|
|
|
+ and (not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype in [realconstn,ordconstn])))));
|
|
|
+ if (procdefinition.proccalloption=pocall_internproc) or is_const then
|
|
|
+ begin
|
|
|
+ if assigned(left) then
|
|
|
+ begin
|
|
|
+ { convert types to those of the prototype, this is required by functions like ror, rol, sar
|
|
|
+ some use however a dummy type (Typedfile) so this would break them }
|
|
|
+ if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then
|
|
|
+ begin
|
|
|
+ { bind parasyms to the callparanodes and insert hidden parameters }
|
|
|
+ bind_parasym;
|
|
|
|
|
|
- { insert type conversions for parameters }
|
|
|
- if assigned(left) then
|
|
|
- tcallparanode(left).insert_typeconv;
|
|
|
- end;
|
|
|
+ { insert type conversions for parameters }
|
|
|
+ if assigned(left) then
|
|
|
+ tcallparanode(left).insert_typeconv;
|
|
|
+ end;
|
|
|
|
|
|
- { ptr and settextbuf need two args }
|
|
|
- if assigned(tcallparanode(left).right) then
|
|
|
- begin
|
|
|
- hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
|
|
|
- left:=nil;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
|
|
|
- tcallparanode(left).left:=nil;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
|
|
|
- result:=hpt;
|
|
|
- goto errorexit;
|
|
|
- end;
|
|
|
+ { ptr and settextbuf need two args }
|
|
|
+ if assigned(tcallparanode(left).right) then
|
|
|
+ begin
|
|
|
+ hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
|
|
|
+ left:=nil;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
|
|
|
+ tcallparanode(left).left:=nil;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
|
|
|
+ result:=hpt;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- { ensure that the result type is set }
|
|
|
- if not(cnf_typedefset in callnodeflags) then
|
|
|
- begin
|
|
|
- { constructors return their current class type, not the type where the
|
|
|
- constructor is declared, this can be different because of inheritance }
|
|
|
- if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
- assigned(methodpointer) and
|
|
|
- assigned(methodpointer.resultdef) and
|
|
|
- (methodpointer.resultdef.typ=classrefdef) then
|
|
|
- resultdef:=tclassrefdef(methodpointer.resultdef).pointeddef
|
|
|
- else
|
|
|
- { Member call to a (inherited) constructor from the class, the return
|
|
|
- value is always self, so we change it to voidtype to generate an
|
|
|
- error and to prevent users from generating non-working code
|
|
|
- when they expect to clone the current instance, see bug 3662 (PFV) }
|
|
|
+ { ensure that the result type is set }
|
|
|
+ if not(cnf_typedefset in callnodeflags) then
|
|
|
+ begin
|
|
|
+ { constructors return their current class type, not the type where the
|
|
|
+ constructor is declared, this can be different because of inheritance }
|
|
|
if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
- is_class(tprocdef(procdefinition).struct) and
|
|
|
assigned(methodpointer) and
|
|
|
- (methodpointer.nodetype=loadn) and
|
|
|
- (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
|
|
|
- resultdef:=voidtype
|
|
|
+ assigned(methodpointer.resultdef) and
|
|
|
+ (methodpointer.resultdef.typ=classrefdef) then
|
|
|
+ resultdef:=tclassrefdef(methodpointer.resultdef).pointeddef
|
|
|
else
|
|
|
- resultdef:=procdefinition.returndef;
|
|
|
- end
|
|
|
- else
|
|
|
- resultdef:=typedef;
|
|
|
-
|
|
|
- { Check object/class for methods }
|
|
|
- if assigned(methodpointer) then
|
|
|
- begin
|
|
|
- { direct call to inherited abstract method, then we
|
|
|
- can already give a error in the compiler instead
|
|
|
- of a runtime error }
|
|
|
- if (cnf_inherited in callnodeflags) and
|
|
|
- (po_abstractmethod in procdefinition.procoptions) then
|
|
|
- begin
|
|
|
- if (m_delphi in current_settings.modeswitches) and
|
|
|
- (cnf_anon_inherited in callnodeflags) then
|
|
|
- begin
|
|
|
- CGMessage(cg_h_inherited_ignored);
|
|
|
- result:=cnothingnode.create;
|
|
|
- exit;
|
|
|
- end
|
|
|
+ { Member call to a (inherited) constructor from the class, the return
|
|
|
+ value is always self, so we change it to voidtype to generate an
|
|
|
+ error and to prevent users from generating non-working code
|
|
|
+ when they expect to clone the current instance, see bug 3662 (PFV) }
|
|
|
+ if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
+ is_class(tprocdef(procdefinition).struct) and
|
|
|
+ assigned(methodpointer) and
|
|
|
+ (methodpointer.nodetype=loadn) and
|
|
|
+ (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
|
|
|
+ resultdef:=voidtype
|
|
|
else
|
|
|
- CGMessage(cg_e_cant_call_abstract_method);
|
|
|
- end;
|
|
|
+ resultdef:=procdefinition.returndef;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ resultdef:=typedef;
|
|
|
|
|
|
- { directly calling an interface/protocol/category/class helper
|
|
|
- method via its type is not possible (always must be called via
|
|
|
- the actual instance) }
|
|
|
- if (methodpointer.nodetype=typen) and
|
|
|
- (is_interface(methodpointer.resultdef) or
|
|
|
- is_objc_protocol_or_category(methodpointer.resultdef)) then
|
|
|
- CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
|
|
|
-
|
|
|
- { if an inherited con- or destructor should be }
|
|
|
- { called in a con- or destructor then a warning }
|
|
|
- { will be made }
|
|
|
- { con- and destructors need a pointer to the vmt }
|
|
|
- if (cnf_inherited in callnodeflags) and
|
|
|
- (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
|
|
|
- is_object(methodpointer.resultdef) and
|
|
|
- not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
|
|
|
- CGMessage(cg_w_member_cd_call_from_method);
|
|
|
-
|
|
|
- if methodpointer.nodetype<>typen then
|
|
|
- begin
|
|
|
- { Remove all postfix operators }
|
|
|
- hpt:=methodpointer;
|
|
|
- while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
|
|
|
- hpt:=tunarynode(hpt).left;
|
|
|
-
|
|
|
- if ((hpt.nodetype=loadvmtaddrn) or
|
|
|
- ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
|
|
|
- not (procdefinition.proctypeoption=potype_constructor) and
|
|
|
- not (po_classmethod in procdefinition.procoptions) and
|
|
|
- not (po_staticmethod in procdefinition.procoptions) then
|
|
|
- { error: we are calling instance method from the class method/static method }
|
|
|
- CGMessage(parser_e_only_class_members);
|
|
|
-
|
|
|
- if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
- assigned(symtableproc) and
|
|
|
- (symtableproc.symtabletype=withsymtable) and
|
|
|
- (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
|
|
|
- CGmessage(cg_e_cannot_call_cons_dest_inside_with);
|
|
|
-
|
|
|
- { skip (absolute and other simple) type conversions -- only now,
|
|
|
- because the checks above have to take type conversions into
|
|
|
- e.g. class reference types account }
|
|
|
- hpt:=actualtargetnode(@hpt)^;
|
|
|
-
|
|
|
- { R.Init then R will be initialized by the constructor,
|
|
|
- Also allow it for simple loads }
|
|
|
- if (procdefinition.proctypeoption=potype_constructor) or
|
|
|
- ((hpt.nodetype=loadn) and
|
|
|
- (((methodpointer.resultdef.typ=objectdef) and
|
|
|
- not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
|
|
|
- (methodpointer.resultdef.typ=recorddef)
|
|
|
- )
|
|
|
- ) then
|
|
|
- { a constructor will and a method may write something to }
|
|
|
- { the fields }
|
|
|
- set_varstate(methodpointer,vs_readwritten,[])
|
|
|
- else
|
|
|
- set_varstate(methodpointer,vs_read,[vsf_must_be_valid]);
|
|
|
- end;
|
|
|
+ { Check object/class for methods }
|
|
|
+ if assigned(methodpointer) then
|
|
|
+ begin
|
|
|
+ { direct call to inherited abstract method, then we
|
|
|
+ can already give a error in the compiler instead
|
|
|
+ of a runtime error }
|
|
|
+ if (cnf_inherited in callnodeflags) and
|
|
|
+ (po_abstractmethod in procdefinition.procoptions) then
|
|
|
+ begin
|
|
|
+ if (m_delphi in current_settings.modeswitches) and
|
|
|
+ (cnf_anon_inherited in callnodeflags) then
|
|
|
+ begin
|
|
|
+ CGMessage(cg_h_inherited_ignored);
|
|
|
+ result:=cnothingnode.create;
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ CGMessage(cg_e_cant_call_abstract_method);
|
|
|
+ end;
|
|
|
|
|
|
- { if we are calling the constructor check for abstract
|
|
|
- methods. Ignore inherited and member calls, because the
|
|
|
- class is then already created }
|
|
|
- if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
- not(cnf_inherited in callnodeflags) and
|
|
|
- not(cnf_member_call in callnodeflags) then
|
|
|
- verifyabstractcalls;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { When this is method the methodpointer must be available }
|
|
|
- if (right=nil) and
|
|
|
- (procdefinition.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
|
|
|
- not procdefinition.no_self_node then
|
|
|
- internalerror(200305061);
|
|
|
- end;
|
|
|
+ { directly calling an interface/protocol/category/class helper
|
|
|
+ method via its type is not possible (always must be called via
|
|
|
+ the actual instance) }
|
|
|
+ if (methodpointer.nodetype=typen) and
|
|
|
+ (is_interface(methodpointer.resultdef) or
|
|
|
+ is_objc_protocol_or_category(methodpointer.resultdef)) then
|
|
|
+ CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
|
|
|
+
|
|
|
+ { if an inherited con- or destructor should be }
|
|
|
+ { called in a con- or destructor then a warning }
|
|
|
+ { will be made }
|
|
|
+ { con- and destructors need a pointer to the vmt }
|
|
|
+ if (cnf_inherited in callnodeflags) and
|
|
|
+ (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
|
|
|
+ is_object(methodpointer.resultdef) and
|
|
|
+ not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
|
|
|
+ CGMessage(cg_w_member_cd_call_from_method);
|
|
|
+
|
|
|
+ if methodpointer.nodetype<>typen then
|
|
|
+ begin
|
|
|
+ { Remove all postfix operators }
|
|
|
+ hpt:=methodpointer;
|
|
|
+ while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
|
|
|
+ hpt:=tunarynode(hpt).left;
|
|
|
+
|
|
|
+ if ((hpt.nodetype=loadvmtaddrn) or
|
|
|
+ ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
|
|
|
+ not (procdefinition.proctypeoption=potype_constructor) and
|
|
|
+ not (po_classmethod in procdefinition.procoptions) and
|
|
|
+ not (po_staticmethod in procdefinition.procoptions) then
|
|
|
+ { error: we are calling instance method from the class method/static method }
|
|
|
+ CGMessage(parser_e_only_class_members);
|
|
|
+
|
|
|
+ if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
+ assigned(symtableproc) and
|
|
|
+ (symtableproc.symtabletype=withsymtable) and
|
|
|
+ (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
|
|
|
+ CGmessage(cg_e_cannot_call_cons_dest_inside_with);
|
|
|
+
|
|
|
+ { skip (absolute and other simple) type conversions -- only now,
|
|
|
+ because the checks above have to take type conversions into
|
|
|
+ e.g. class reference types account }
|
|
|
+ hpt:=actualtargetnode(@hpt)^;
|
|
|
+
|
|
|
+ { R.Init then R will be initialized by the constructor,
|
|
|
+ Also allow it for simple loads }
|
|
|
+ if (procdefinition.proctypeoption=potype_constructor) or
|
|
|
+ ((hpt.nodetype=loadn) and
|
|
|
+ (((methodpointer.resultdef.typ=objectdef) and
|
|
|
+ not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
|
|
|
+ (methodpointer.resultdef.typ=recorddef)
|
|
|
+ )
|
|
|
+ ) then
|
|
|
+ { a constructor will and a method may write something to }
|
|
|
+ { the fields }
|
|
|
+ set_varstate(methodpointer,vs_readwritten,[])
|
|
|
+ else
|
|
|
+ set_varstate(methodpointer,vs_read,[vsf_must_be_valid]);
|
|
|
+ end;
|
|
|
|
|
|
- { Set flag that the procedure uses varargs, also if they are not passed it is still
|
|
|
- needed for x86_64 to pass the number of SSE registers used }
|
|
|
- if po_varargs in procdefinition.procoptions then
|
|
|
- include(callnodeflags,cnf_uses_varargs);
|
|
|
+ { if we are calling the constructor check for abstract
|
|
|
+ methods. Ignore inherited and member calls, because the
|
|
|
+ class is then already created }
|
|
|
+ if (procdefinition.proctypeoption=potype_constructor) and
|
|
|
+ not(cnf_inherited in callnodeflags) and
|
|
|
+ not(cnf_member_call in callnodeflags) then
|
|
|
+ verifyabstractcalls;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { When this is method the methodpointer must be available }
|
|
|
+ if (right=nil) and
|
|
|
+ (procdefinition.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
|
|
|
+ not procdefinition.no_self_node then
|
|
|
+ internalerror(200305061);
|
|
|
+ end;
|
|
|
|
|
|
- { set the appropriate node flag if the call never returns }
|
|
|
- if po_noreturn in procdefinition.procoptions then
|
|
|
- include(callnodeflags,cnf_call_never_returns);
|
|
|
+ { Set flag that the procedure uses varargs, also if they are not passed it is still
|
|
|
+ needed for x86_64 to pass the number of SSE registers used }
|
|
|
+ if po_varargs in procdefinition.procoptions then
|
|
|
+ include(callnodeflags,cnf_uses_varargs);
|
|
|
|
|
|
- { Change loading of array of const to varargs }
|
|
|
- if assigned(left) and
|
|
|
- is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and
|
|
|
- (procdefinition.proccalloption in cdecl_pocalls) then
|
|
|
- convert_carg_array_of_const;
|
|
|
+ { set the appropriate node flag if the call never returns }
|
|
|
+ if po_noreturn in procdefinition.procoptions then
|
|
|
+ include(callnodeflags,cnf_call_never_returns);
|
|
|
|
|
|
- { bind parasyms to the callparanodes and insert hidden parameters }
|
|
|
- bind_parasym;
|
|
|
+ { Change loading of array of const to varargs }
|
|
|
+ if assigned(left) and
|
|
|
+ is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and
|
|
|
+ (procdefinition.proccalloption in cdecl_pocalls) then
|
|
|
+ convert_carg_array_of_const;
|
|
|
|
|
|
- { insert type conversions for parameters }
|
|
|
- if assigned(left) then
|
|
|
- tcallparanode(left).insert_typeconv;
|
|
|
+ { bind parasyms to the callparanodes and insert hidden parameters }
|
|
|
+ bind_parasym;
|
|
|
|
|
|
- { dispinterface methode invoke? }
|
|
|
- if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then
|
|
|
- begin
|
|
|
- case procdefinition.proctypeoption of
|
|
|
- potype_propgetter: calltype:=dct_propget;
|
|
|
- potype_propsetter: calltype:=dct_propput;
|
|
|
- else
|
|
|
- calltype:=dct_method;
|
|
|
- end;
|
|
|
- { if the result is used, we've to insert a call to convert the type to be on the "safe side" }
|
|
|
- if (cnf_return_value_used in callnodeflags) and not is_void(procdefinition.returndef) then
|
|
|
- begin
|
|
|
- result:=internalstatements(statements);
|
|
|
- converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),
|
|
|
- tt_persistent,true);
|
|
|
- addstatement(statements,converted_result_data);
|
|
|
- addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
|
|
|
- ctypeconvnode.create_internal(
|
|
|
- translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
|
|
|
- procdefinition.returndef)));
|
|
|
- addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
|
|
|
- addstatement(statements,ctemprefnode.create(converted_result_data));
|
|
|
- end
|
|
|
- else
|
|
|
- result:=translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,voidtype);
|
|
|
+ { insert type conversions for parameters }
|
|
|
+ if assigned(left) then
|
|
|
+ tcallparanode(left).insert_typeconv;
|
|
|
|
|
|
- { don't free reused nodes }
|
|
|
- methodpointer:=nil;
|
|
|
- parameters:=nil;
|
|
|
- end;
|
|
|
+ { dispinterface methode invoke? }
|
|
|
+ if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then
|
|
|
+ begin
|
|
|
+ case procdefinition.proctypeoption of
|
|
|
+ potype_propgetter: calltype:=dct_propget;
|
|
|
+ potype_propsetter: calltype:=dct_propput;
|
|
|
+ else
|
|
|
+ calltype:=dct_method;
|
|
|
+ end;
|
|
|
+ { if the result is used, we've to insert a call to convert the type to be on the "safe side" }
|
|
|
+ if (cnf_return_value_used in callnodeflags) and not is_void(procdefinition.returndef) then
|
|
|
+ begin
|
|
|
+ result:=internalstatements(statements);
|
|
|
+ converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),
|
|
|
+ tt_persistent,true);
|
|
|
+ addstatement(statements,converted_result_data);
|
|
|
+ addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
|
|
|
+ ctypeconvnode.create_internal(
|
|
|
+ translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
|
|
|
+ procdefinition.returndef)));
|
|
|
+ addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
|
|
|
+ addstatement(statements,ctemprefnode.create(converted_result_data));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ result:=translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,voidtype);
|
|
|
|
|
|
- errorexit:
|
|
|
- aktcallnode:=oldcallnode;
|
|
|
+ { don't free reused nodes }
|
|
|
+ methodpointer:=nil;
|
|
|
+ parameters:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+ finally
|
|
|
+ aktcallnode:=oldcallnode;
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
|
Jonas Maebe