mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-25 18:46:02 +02:00
060d81b8fa
svn+ssh://jonas@svn.freepascal.org/FPC/svn/fpc/branches/wpo
........
r11878 | jonas | 2008-10-11 02:25:18 +0200 (Sat, 11 Oct 2008) | 19 lines
+ initial implementation of whole-program optimisation framework
+ implementation of whole-program devirtualisation
o use:
a) generate whole-program optimisation information (no need
to completely compile the program and all of its units
with -OW/-FW, only the main program is sufficient)
fpc -OWdevirtcalls -FWmyprog.wpo myprog
b) use it to optimise the program
fpc -B -Owdevirtcalls -Fwmyprog.wpo myprog
(the -B is not required, but only sources recompiled during
the second pass will actually be optimised -- if you want,
you can even rebuild the rtl devirtualised for a particular
program; and these options can obviously also be used
together with regular optimisation switches)
o warning:
- there are no checks yet to ensure that you do not use
units optimised for a particular program with another
program (or with a changed version of the same program)
........
r11881 | jonas | 2008-10-11 19:35:52 +0200 (Sat, 11 Oct 2008) | 13 lines
* extracted code to detect constructed class/object types from
tcallnode.gen_vmt_tree into its own method to avoid clutter
* detect x.classtype.create constructs (with classtype = the
system.tobject.classtype method), and treat them as if a
"class of x" has been instantiated rather than a
"class of tobject". this required storing the instantiated
classrefs in their own array though, because at such a
point we don't have a "class of x" tdef available (so
now "x", and all other defs instantiated via a classref,
are now stored as tobjectdefs in a separate array)
+ support for devirtualising class methods (including
constructors)
........
r11882 | jonas | 2008-10-11 20:44:02 +0200 (Sat, 11 Oct 2008) | 7 lines
+ -Owoptvmts whole program optimisation which replaces vmt entries
with method names of child classes in case the current class'
method can never be called (e.g., because this class is never
instantiated). As a result, such methods can then be removed
by dead code removal/smart linking (not much effect for either
the compiler, lazarus or a trivial lazarus app though).
........
r11889 | jonas | 2008-10-12 14:29:54 +0200 (Sun, 12 Oct 2008) | 2 lines
* some comment fixes
........
r11891 | jonas | 2008-10-12 18:49:13 +0200 (Sun, 12 Oct 2008) | 4 lines
* fixed twpofilereader.getnextnoncommentline() when reusing a previously
read line
* fixed skipping of unnecessary wpo feedback file sections
........
r11892 | jonas | 2008-10-12 23:42:43 +0200 (Sun, 12 Oct 2008) | 31 lines
+ symbol liveness wpo information extracted from smartlinked programs
(-OW/-Owsymbolliveness)
+ use symbol liveness information to improve devirtualisation (don't
consider classes created in code that has been dead code stripped).
This requires at least two passes of using wpo (first uses dead code
info to locate classes that are constructed only in dead code,
second pass uses this info to potentially further devirtualise).
I.e.:
1) generate initial liveness and devirtualisation feedback
fpc -FWtt.wpo -OWall tt.pp -Xs- -CX -XX
2) use previously generated feedback, and regenerate new feedback
based on this (i.e., disregard classes created in dead code)
fpc -FWtt-1.wpo -OWall -Fwtt.wo -Owall tt.pp -Xs- -CX -XX
3) use the newly generated feedback (in theory, it is possible
that even more opportunities pop up afterwards; you can
continue until the program does not get smaller anymore)
fpc -Fwtt-1.wpo -Owall tt.pp -CX -XX
* changed all message() to cgmessage() calls so the set codegenerror
* changed static fsectionhandlers field to a regular field called
fwpocomponents
* changed registration of wpocomponents: no longer happens in the
initialization section of their unit, but in the InitWpo routine
(which has been moved from the woinfo to the wpo unit). This way
you can register different classes based on the target/parameters.
+ added static method to twpocomponentbase for checking whether
the command line parameters don't conflict with the requested
optimisations (e.g. generating liveness info requires that
smartlinking is turned on)
+ added static method to twpocomponentbase to request the
section name
........
r11893 | jonas | 2008-10-12 23:53:57 +0200 (Sun, 12 Oct 2008) | 3 lines
* fixed comment error (twpodeadcodeinfo keeps a list of live,
not dead symbols)
........
r11895 | jonas | 2008-10-13 00:13:59 +0200 (Mon, 13 Oct 2008) | 2 lines
+ documented -OW<x>, -Ow<x>, -FW<x> and -Fw<x> wpo parameters
........
r11899 | jonas | 2008-10-14 22:14:56 +0200 (Tue, 14 Oct 2008) | 2 lines
* replaced hardcoded string with objdumpsearchstr constant
........
r11900 | jonas | 2008-10-14 22:15:25 +0200 (Tue, 14 Oct 2008) | 2 lines
* reset wpofeedbackinput and wpofeedbackoutput in wpodone
........
r11901 | jonas | 2008-10-14 22:16:07 +0200 (Tue, 14 Oct 2008) | 2 lines
* various additional comments and comment fixes
........
r11902 | jonas | 2008-10-15 18:09:42 +0200 (Wed, 15 Oct 2008) | 5 lines
* store vmt procdefs in the ppu files so we don't have to use a hack to
regenerate them for whole-program optimisation
* fixed crash when performing devirtualisation optimisation on programs
that do not construct any classes/objects with optimisable vmts
........
r11935 | jonas | 2008-10-19 12:24:26 +0200 (Sun, 19 Oct 2008) | 4 lines
* set the vmt entries of non-class virtual methods of not instantiated
objects/classes to FPC_ABSTRACTERROR so the code they refer to can
be thrown away if it is not referred to in any other way either
........
r11938 | jonas | 2008-10-19 20:55:02 +0200 (Sun, 19 Oct 2008) | 7 lines
* record all classrefdefs/objdefs for which a loadvmtaddrnode is generated,
and instead of marking all classes that derive from instantiated
classrefdefs as instantiated, only mark those classes from the above
collection that derive from instantiated classrefdefs as
instantiated (since to instantiate a class, you have to load its vmt
somehow -- this may be broken by using assembler code though)
........
r12212 | jonas | 2008-11-23 12:26:34 +0100 (Sun, 23 Nov 2008) | 3 lines
* fixed to work with the new vmtentries that are always available and
removed previously added code to save/load vmtentries to ppu files
........
r12304 | jonas | 2008-12-05 22:23:30 +0100 (Fri, 05 Dec 2008) | 4 lines
* check whether the correct wpo feedback file is used in the current
compilation when using units that were compiled using wpo information
during a previous compilation run
........
r12308 | jonas | 2008-12-06 18:03:39 +0100 (Sat, 06 Dec 2008) | 2 lines
* abort compilation if an error occurred during wpo initialisation
........
r12309 | jonas | 2008-12-06 18:04:28 +0100 (Sat, 06 Dec 2008) | 3 lines
* give an error message instead of crashing with an io exception if the
compiler is unable to create the wpo feedback file specified using -FW
........
r12310 | jonas | 2008-12-06 18:12:43 +0100 (Sat, 06 Dec 2008) | 3 lines
* don't let the used wpo feedback file influence the interface crc (there's
a separate check for such changes)
........
r12316 | jonas | 2008-12-08 19:08:25 +0100 (Mon, 08 Dec 2008) | 3 lines
* document the format of the sections of the wpo feedback file inside the
feedback file itself
........
r12330 | jonas | 2008-12-10 22:26:47 +0100 (Wed, 10 Dec 2008) | 2 lines
* use sysutils instead of dos to avoid command line length limits
........
r12331 | jonas | 2008-12-10 22:31:11 +0100 (Wed, 10 Dec 2008) | 3 lines
+ support for testing whole program optimisation tests (multiple
compilations using successively generated feedback files)
........
r12332 | jonas | 2008-12-10 22:31:40 +0100 (Wed, 10 Dec 2008) | 2 lines
+ whole program optimisation tests
........
r12334 | jonas | 2008-12-10 22:38:07 +0100 (Wed, 10 Dec 2008) | 2 lines
- removed unused local variable
........
r12339 | jonas | 2008-12-11 18:06:36 +0100 (Thu, 11 Dec 2008) | 2 lines
+ comments for newly added fields to tobjectdef for devirtualisation
........
r12340 | jonas | 2008-12-11 18:10:01 +0100 (Thu, 11 Dec 2008) | 2 lines
* increase ppu version (was no longer different from trunk due to merging)
........
git-svn-id: trunk@12341 -
1173 lines
50 KiB
ObjectPascal
1173 lines
50 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
Generate assembler for call nodes
|
|
|
|
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 ncgcal;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cpubase,
|
|
globtype,
|
|
parabase,cgutils,
|
|
symdef,node,ncal;
|
|
|
|
type
|
|
tcgcallparanode = class(tcallparanode)
|
|
private
|
|
tempcgpara : tcgpara;
|
|
procedure push_addr_para;
|
|
procedure push_value_para;
|
|
public
|
|
constructor create(expr,next : tnode);override;
|
|
destructor destroy;override;
|
|
procedure secondcallparan;override;
|
|
end;
|
|
|
|
tcgcallnode = class(tcallnode)
|
|
private
|
|
procedure handle_return_value;
|
|
procedure release_unused_return_value;
|
|
procedure release_para_temps;
|
|
procedure pushparas;
|
|
procedure freeparas;
|
|
protected
|
|
framepointer_paraloc : tcgpara;
|
|
{# This routine is used to push the current frame pointer
|
|
on the stack. This is used in nested routines where the
|
|
value of the frame pointer is always pushed as an extra
|
|
parameter.
|
|
|
|
The default handling is the standard handling used on
|
|
most stack based machines, where the frame pointer is
|
|
the first invisible parameter.
|
|
}
|
|
procedure pop_parasize(pop_size:longint);virtual;
|
|
procedure extra_interrupt_code;virtual;
|
|
procedure extra_call_code;virtual;
|
|
procedure extra_post_call_code;virtual;
|
|
procedure do_syscall;virtual;abstract;
|
|
public
|
|
procedure pass_generate_code;override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
systems,
|
|
cutils,verbose,globals,
|
|
cpuinfo,
|
|
symconst,symtable,defutil,paramgr,
|
|
cgbase,pass_2,
|
|
aasmbase,aasmtai,aasmdata,
|
|
nbas,nmem,nld,ncnv,nutils,
|
|
{$ifdef x86}
|
|
cga,cgx86,aasmcpu,
|
|
{$endif x86}
|
|
ncgutil,
|
|
cgobj,tgobj,
|
|
procinfo,
|
|
wpobase;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCGCALLPARANODE
|
|
*****************************************************************************}
|
|
|
|
constructor tcgcallparanode.create(expr,next : tnode);
|
|
begin
|
|
inherited create(expr,next);
|
|
tempcgpara.init;
|
|
end;
|
|
|
|
|
|
destructor tcgcallparanode.destroy;
|
|
begin
|
|
tempcgpara.done;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.push_addr_para;
|
|
begin
|
|
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
|
|
internalerror(200304235);
|
|
cg.a_paramaddr_ref(current_asmdata.CurrAsmList,left.location.reference,tempcgpara);
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.push_value_para;
|
|
{$ifdef i386}
|
|
var
|
|
href : treference;
|
|
size : longint;
|
|
{$endif i386}
|
|
begin
|
|
{ we've nothing to push when the size of the parameter is 0 }
|
|
if left.resultdef.size=0 then
|
|
exit;
|
|
|
|
{ Move flags and jump in register to make it less complex }
|
|
if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then
|
|
location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false);
|
|
|
|
{ Handle Floating point types differently
|
|
|
|
This doesn't depend on emulator settings, emulator settings should
|
|
be handled by cpupara }
|
|
|
|
if left.resultdef.typ=floatdef then
|
|
begin
|
|
{$ifdef i386}
|
|
if tempcgpara.location^.loc<>LOC_REFERENCE then
|
|
internalerror(200309291);
|
|
case left.location.loc of
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
begin
|
|
size:=align(TCGSize2Size[left.location.size],tempcgpara.alignment);
|
|
if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
|
|
begin
|
|
cg.g_stackpointer_alloc(current_asmdata.CurrAsmList,size);
|
|
reference_reset_base(href,NR_STACK_POINTER_REG,0);
|
|
end
|
|
else
|
|
reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
|
|
cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,left.location.size,left.location.register,href);
|
|
end;
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
begin
|
|
size:=align(tfloatdef(left.resultdef).size,tempcgpara.alignment);
|
|
if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
|
|
begin
|
|
cg.g_stackpointer_alloc(current_asmdata.CurrAsmList,size);
|
|
reference_reset_base(href,NR_STACK_POINTER_REG,0);
|
|
end
|
|
else
|
|
reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
|
|
cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,left.location.size,left.location.size,left.location.register,href,mms_movescalar);
|
|
end;
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE :
|
|
begin
|
|
size:=align(left.resultdef.size,tempcgpara.alignment);
|
|
if (not use_fixed_stack) and
|
|
(tempcgpara.location^.reference.index=NR_STACK_POINTER_REG) then
|
|
cg.a_param_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara)
|
|
else
|
|
begin
|
|
reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,left.location.reference,href,size);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(2002042430);
|
|
end;
|
|
{$else i386}
|
|
case left.location.loc of
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
case tempcgpara.location^.loc of
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE,
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
cg.a_parammm_reg(current_asmdata.CurrAsmList,left.location.size,left.location.register,tempcgpara,mms_movescalar);
|
|
{$ifdef x86_64}
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOVD,S_NO,left.location.register,tempcgpara.location^.register));
|
|
end;
|
|
{$endif x86_64}
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
begin
|
|
location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
|
|
cg.a_paramfpu_reg(current_asmdata.CurrAsmList,left.location.size,left.location.register,tempcgpara);
|
|
end;
|
|
else
|
|
internalerror(200204249);
|
|
end;
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
case tempcgpara.location^.loc of
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
begin
|
|
location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false);
|
|
cg.a_parammm_reg(current_asmdata.CurrAsmList,left.location.size,left.location.register,tempcgpara,mms_movescalar);
|
|
end;
|
|
{$ifdef cpu64bitalu}
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
{ force integer size }
|
|
left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
|
|
cg.a_param_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara);
|
|
end;
|
|
{$endif cpu64bitalu}
|
|
{$ifdef powerpc}
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
{ aix abi passes floats of varargs in both fpu and }
|
|
{ integer registers }
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
{ force integer size }
|
|
left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
|
|
if (left.location.size in [OS_32,OS_S32]) then
|
|
cg.a_param_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara)
|
|
else
|
|
cg64.a_param64_ref(current_asmdata.CurrAsmList,left.location.reference,tempcgpara);
|
|
end;
|
|
{$endif powerpc}
|
|
{$if defined(sparc) or defined(arm) or defined(m68k)}
|
|
{ sparc and arm pass floats in normal registers }
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
{$endif sparc}
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE,
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
cg.a_paramfpu_reg(current_asmdata.CurrAsmList,left.location.size,left.location.register,tempcgpara);
|
|
else
|
|
internalerror(2002042433);
|
|
end;
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE:
|
|
case tempcgpara.location^.loc of
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
cg.a_parammm_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara,mms_movescalar);
|
|
{$ifdef cpu64bitalu}
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
{ force integer size }
|
|
left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
|
|
cg.a_param_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara);
|
|
end;
|
|
{$endif cpu64bitalu}
|
|
{$ifdef powerpc}
|
|
{ x86_64 pushes s64comp in normal register }
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
{ force integer size }
|
|
left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
|
|
if (left.location.size in [OS_32,OS_S32]) then
|
|
cg.a_param_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara)
|
|
else
|
|
cg64.a_param64_ref(current_asmdata.CurrAsmList,left.location.reference,tempcgpara);
|
|
end;
|
|
{$endif powerpc}
|
|
{$if defined(sparc) or defined(arm) or defined(m68k)}
|
|
{ sparc and arm pass floats in normal registers }
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
{$endif}
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE,
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
cg.a_paramfpu_ref(current_asmdata.CurrAsmList,left.location.size,left.location.reference,tempcgpara);
|
|
else
|
|
internalerror(2002042431);
|
|
end;
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
begin
|
|
{$ifndef cpu64bitalu}
|
|
{ use cg64 only for int64, not for 8 byte records }
|
|
if is_64bit(left.resultdef) then
|
|
cg64.a_param64_loc(current_asmdata.CurrAsmList,left.location,tempcgpara)
|
|
else
|
|
{$endif not cpu64bitalu}
|
|
begin
|
|
{$ifndef cpu64bitalu}
|
|
{ Only a_param_ref supports multiple locations, when the
|
|
value is still a const or in a register then write it
|
|
to a reference first. This situation can be triggered
|
|
by typecasting an int64 constant to a record of 8 bytes }
|
|
if left.location.size in [OS_64,OS_S64] then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
{$endif not cpu64bitalu}
|
|
cg.a_param_loc(current_asmdata.CurrAsmList,left.location,tempcgpara);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(2002042432);
|
|
end;
|
|
{$endif i386}
|
|
end
|
|
else
|
|
begin
|
|
case left.location.loc of
|
|
LOC_CONSTANT,
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER,
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE :
|
|
begin
|
|
{$ifndef cpu64bitalu}
|
|
{ use cg64 only for int64, not for 8 byte records }
|
|
if is_64bit(left.resultdef) then
|
|
cg64.a_param64_loc(current_asmdata.CurrAsmList,left.location,tempcgpara)
|
|
else
|
|
{$endif not cpu64bitalu}
|
|
begin
|
|
{$ifndef cpu64bitalu}
|
|
{ Only a_param_ref supports multiple locations, when the
|
|
value is still a const or in a register then write it
|
|
to a reference first. This situation can be triggered
|
|
by typecasting an int64 constant to a record of 8 bytes }
|
|
if left.location.size in [OS_64,OS_S64] then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
{$endif not cpu64bitalu}
|
|
cg.a_param_loc(current_asmdata.CurrAsmList,left.location,tempcgpara);
|
|
end;
|
|
end;
|
|
{$ifdef SUPPORT_MMX}
|
|
LOC_MMXREGISTER,
|
|
LOC_CMMXREGISTER:
|
|
cg.a_parammm_reg(current_asmdata.CurrAsmList,OS_M64,left.location.register,tempcgpara,nil);
|
|
{$endif SUPPORT_MMX}
|
|
else
|
|
internalerror(200204241);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.secondcallparan;
|
|
var
|
|
href : treference;
|
|
otlabel,
|
|
oflabel : tasmlabel;
|
|
begin
|
|
if not(assigned(parasym)) then
|
|
internalerror(200304242);
|
|
|
|
{ Skip nothingn nodes which are used after disabling
|
|
a parameter }
|
|
if (left.nodetype<>nothingn) then
|
|
begin
|
|
otlabel:=current_procinfo.CurrTrueLabel;
|
|
oflabel:=current_procinfo.CurrFalseLabel;
|
|
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
|
|
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
|
|
secondpass(left);
|
|
|
|
maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true);
|
|
|
|
{ release memory for refcnt out parameters }
|
|
if (parasym.varspez=vs_out) and
|
|
(left.resultdef.needs_inittable) then
|
|
begin
|
|
location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false);
|
|
cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
|
|
end;
|
|
|
|
paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara);
|
|
|
|
{ handle varargs first, because parasym is not valid }
|
|
if (cpf_varargs_para in callparaflags) then
|
|
begin
|
|
if paramanager.push_addr_param(vs_value,left.resultdef,
|
|
aktcallnode.procdefinition.proccalloption) then
|
|
push_addr_para
|
|
else
|
|
push_value_para;
|
|
end
|
|
{ hidden parameters }
|
|
else if (vo_is_hidden_para in parasym.varoptions) then
|
|
begin
|
|
{ don't push a node that already generated a pointer type
|
|
by address for implicit hidden parameters }
|
|
if (vo_is_funcret in parasym.varoptions) or
|
|
{ pass "this" in C++ classes explicitly as pointer
|
|
because push_addr_param might not be true for them }
|
|
(is_cppclass(parasym.vardef) and (vo_is_self in parasym.varoptions)) or
|
|
(not(left.resultdef.typ in [pointerdef,classrefdef]) and
|
|
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
|
|
aktcallnode.procdefinition.proccalloption)) then
|
|
push_addr_para
|
|
else
|
|
push_value_para;
|
|
end
|
|
{ formal def }
|
|
else if (parasym.vardef.typ=formaldef) then
|
|
begin
|
|
{ allow passing of a constant to a const formaldef }
|
|
if (parasym.varspez=vs_const) and
|
|
(left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
push_addr_para;
|
|
end
|
|
{ Normal parameter }
|
|
else
|
|
begin
|
|
{ don't push a node that already generated a pointer type
|
|
by address for implicit hidden parameters }
|
|
if (not(
|
|
(vo_is_hidden_para in parasym.varoptions) and
|
|
(left.resultdef.typ in [pointerdef,classrefdef])
|
|
) and
|
|
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
|
|
aktcallnode.procdefinition.proccalloption)) and
|
|
{ dyn. arrays passed to an array of const must be passed by value, see tests/webtbs/tw4219.pp }
|
|
not(
|
|
is_array_of_const(parasym.vardef) and
|
|
is_dynamic_array(left.resultdef)
|
|
) then
|
|
begin
|
|
{ Passing a var parameter to a var parameter, we can
|
|
just push the address transparently }
|
|
if (left.nodetype=loadn) and
|
|
(tloadnode(left).is_addr_param_load) then
|
|
begin
|
|
if (left.location.reference.index<>NR_NO) or
|
|
(left.location.reference.offset<>0) then
|
|
internalerror(200410107);
|
|
cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,left.location.reference.base,tempcgpara)
|
|
end
|
|
else
|
|
begin
|
|
{ Force to be in memory }
|
|
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
push_addr_para;
|
|
end;
|
|
end
|
|
else
|
|
push_value_para;
|
|
end;
|
|
current_procinfo.CurrTrueLabel:=otlabel;
|
|
current_procinfo.CurrFalseLabel:=oflabel;
|
|
|
|
{ update return location in callnode when this is the function
|
|
result }
|
|
if assigned(parasym) and
|
|
(vo_is_funcret in parasym.varoptions) then
|
|
location_copy(aktcallnode.location,left.location);
|
|
end;
|
|
|
|
{ next parameter }
|
|
if assigned(right) then
|
|
tcallparanode(right).secondcallparan;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCGCALLNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgcallnode.extra_interrupt_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.extra_call_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.extra_post_call_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.pop_parasize(pop_size:longint);
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.handle_return_value;
|
|
var
|
|
tmpcgsize,
|
|
cgsize : tcgsize;
|
|
retloc : tlocation;
|
|
{$ifdef cpu64bitaddr}
|
|
ref : treference;
|
|
{$endif cpu64bitaddr}
|
|
{$ifndef x86}
|
|
hregister : tregister;
|
|
{$endif not x86}
|
|
begin
|
|
{ Check that the return location is set when the result is passed in
|
|
a parameter }
|
|
if (procdefinition.proctypeoption<>potype_constructor) and
|
|
paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
|
|
begin
|
|
if location.loc<>LOC_REFERENCE then
|
|
internalerror(200304241);
|
|
exit;
|
|
end;
|
|
|
|
{ Load normal (ordinal,float,pointer) result value from accumulator }
|
|
cgsize:=procdefinition.funcretloc[callerside].size;
|
|
case procdefinition.funcretloc[callerside].loc of
|
|
LOC_FPUREGISTER:
|
|
begin
|
|
location_reset(location,LOC_FPUREGISTER,cgsize);
|
|
location.register:=procdefinition.funcretloc[callerside].register;
|
|
{$ifdef x86}
|
|
tcgx86(cg).inc_fpu_stack;
|
|
{$else x86}
|
|
if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then
|
|
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
|
|
hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
|
|
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
|
|
location.register:=hregister;
|
|
{$endif x86}
|
|
end;
|
|
|
|
LOC_REGISTER:
|
|
begin
|
|
if cgsize<>OS_NO then
|
|
begin
|
|
location_reset(location,LOC_REGISTER,cgsize);
|
|
{$ifdef cpu64bitaddr}
|
|
{ x86-64 system v abi:
|
|
structs with up to 16 bytes are returned in registers }
|
|
if cgsize in [OS_128,OS_S128] then
|
|
begin
|
|
tg.GetTemp(current_asmdata.CurrAsmList,16,8,tt_normal,ref);
|
|
location_reset(location,LOC_REFERENCE,OS_NO);
|
|
location.reference:=ref;
|
|
cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,procdefinition.funcretloc[callerside].register,ref);
|
|
inc(ref.offset,8);
|
|
cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,procdefinition.funcretloc[callerside].registerhi,ref);
|
|
end
|
|
else
|
|
{$else cpu64bitaddr}
|
|
if cgsize in [OS_64,OS_S64] then
|
|
begin
|
|
retloc:=procdefinition.funcretloc[callerside];
|
|
if retloc.loc<>LOC_REGISTER then
|
|
internalerror(200409141);
|
|
{ the function result registers are already allocated }
|
|
if getsupreg(retloc.register64.reglo)<first_int_imreg then
|
|
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo);
|
|
location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
|
|
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reglo,location.register64.reglo);
|
|
if getsupreg(retloc.register64.reghi)<first_int_imreg then
|
|
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
|
|
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
|
|
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reghi,location.register64.reghi);
|
|
end
|
|
else
|
|
{$endif not cpu64bitaddr}
|
|
begin
|
|
{ change register size after the unget because the
|
|
getregister was done for the full register
|
|
def_cgsize(resultdef) is used here because
|
|
it could be a constructor call }
|
|
|
|
if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
|
|
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
|
|
|
|
{ but use def_size only if it returns something valid because in
|
|
case of odd sized structured results in registers def_cgsize(resultdef)
|
|
could return OS_NO }
|
|
if def_cgsize(resultdef)<>OS_NO then
|
|
tmpcgsize:=def_cgsize(resultdef)
|
|
else
|
|
tmpcgsize:=cgsize;
|
|
|
|
location.register:=cg.getintregister(current_asmdata.CurrAsmList,tmpcgsize);
|
|
cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,tmpcgsize,procdefinition.funcretloc[callerside].register,location.register);
|
|
end;
|
|
{$ifdef arm}
|
|
if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
|
|
begin
|
|
location_force_mem(current_asmdata.CurrAsmList,location);
|
|
end;
|
|
{$endif arm}
|
|
end
|
|
else
|
|
begin
|
|
if resultdef.size>0 then
|
|
internalerror(200305131);
|
|
end;
|
|
end;
|
|
|
|
LOC_MMREGISTER:
|
|
begin
|
|
location_reset(location,LOC_MMREGISTER,cgsize);
|
|
if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
|
|
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
|
|
location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
|
|
cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
|
|
end;
|
|
|
|
else
|
|
internalerror(200405023);
|
|
end;
|
|
|
|
{ copy value to the final location if this was already provided to the
|
|
callnode. This must be done after the call node, because the location can
|
|
also be used as parameter and may not be finalized yet }
|
|
if assigned(funcretnode) then
|
|
begin
|
|
funcretnode.pass_generate_code;
|
|
{ Decrease refcount for refcounted types, this can be skipped when
|
|
we have used a temp, because then it is already done from tempcreatenode.
|
|
Also no finalize is needed, because there is no risk of exceptions from the
|
|
function since this is code is only executed after the function call has returned }
|
|
if funcretnode.resultdef.needs_inittable and
|
|
(funcretnode.nodetype<>temprefn) then
|
|
cg.g_decrrefcount(current_asmdata.CurrAsmList,funcretnode.resultdef,funcretnode.location.reference);
|
|
|
|
case location.loc of
|
|
LOC_REGISTER :
|
|
{$ifndef cpu64bitalu}
|
|
if cgsize in [OS_64,OS_S64] then
|
|
cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location)
|
|
else
|
|
{$endif}
|
|
cg.a_load_reg_loc(current_asmdata.CurrAsmList,cgsize,location.register,funcretnode.location);
|
|
LOC_REFERENCE:
|
|
begin
|
|
case funcretnode.location.loc of
|
|
LOC_REGISTER:
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,cgsize,cgsize,location.reference,funcretnode.location.register);
|
|
LOC_REFERENCE:
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,location.reference,funcretnode.location.reference,resultdef.size);
|
|
else
|
|
internalerror(200802121);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(200709085);
|
|
end;
|
|
location := funcretnode.location;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.release_unused_return_value;
|
|
begin
|
|
{ When the result is not used we need to finalize the result and
|
|
can release the temp. This need to be after the callcleanupblock
|
|
tree is generated, because that converts the temp from persistent to normal }
|
|
if not(cnf_return_value_used in callnodeflags) then
|
|
begin
|
|
case location.loc of
|
|
LOC_REFERENCE :
|
|
begin
|
|
if resultdef.needs_inittable then
|
|
cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
|
|
tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
|
|
end;
|
|
{$ifdef x86}
|
|
LOC_FPUREGISTER :
|
|
begin
|
|
{ release FPU stack }
|
|
emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG);
|
|
tcgx86(cg).dec_fpu_stack;
|
|
end;
|
|
{$endif x86}
|
|
end;
|
|
if procdefinition.funcretloc[callerside].size<>OS_NO then
|
|
location_free(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside]);
|
|
location_reset(location,LOC_VOID,OS_NO);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.release_para_temps;
|
|
var
|
|
hp,
|
|
hp2 : tnode;
|
|
ppn : tcallparanode;
|
|
begin
|
|
{ Release temps from parameters }
|
|
ppn:=tcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if assigned(ppn.left) then
|
|
begin
|
|
{ don't release the funcret temp }
|
|
if not(assigned(ppn.parasym)) or
|
|
not(vo_is_funcret in ppn.parasym.varoptions) then
|
|
location_freetemp(current_asmdata.CurrAsmList,ppn.left.location);
|
|
{ process also all nodes of an array of const }
|
|
hp:=ppn.left;
|
|
while (hp.nodetype=typeconvn) do
|
|
hp:=ttypeconvnode(hp).left;
|
|
if (hp.nodetype=arrayconstructorn) and
|
|
assigned(tarrayconstructornode(hp).left) then
|
|
begin
|
|
while assigned(hp) do
|
|
begin
|
|
hp2:=tarrayconstructornode(hp).left;
|
|
{ ignore typeconvs and addrn inserted by arrayconstructn for
|
|
passing a shortstring }
|
|
if (hp2.nodetype=typeconvn) and
|
|
(tunarynode(hp2).left.nodetype=addrn) then
|
|
hp2:=tunarynode(tunarynode(hp2).left).left;
|
|
location_freetemp(current_asmdata.CurrAsmList,hp2.location);
|
|
hp:=tarrayconstructornode(hp).right;
|
|
end;
|
|
end;
|
|
end;
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.pushparas;
|
|
var
|
|
ppn : tcgcallparanode;
|
|
callerparaloc,
|
|
tmpparaloc : pcgparalocation;
|
|
sizeleft: aint;
|
|
htempref,
|
|
href : treference;
|
|
begin
|
|
{ copy all resources to the allocated registers }
|
|
ppn:=tcgcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if (ppn.left.nodetype<>nothingn) then
|
|
begin
|
|
{ better check for the real location of the parameter here, when stack passed parameters
|
|
are saved temporary in registers, checking for the tmpparaloc.loc is wrong
|
|
}
|
|
paramanager.freeparaloc(current_asmdata.CurrAsmList,ppn.tempcgpara);
|
|
tmpparaloc:=ppn.tempcgpara.location;
|
|
sizeleft:=ppn.tempcgpara.intsize;
|
|
callerparaloc:=ppn.parasym.paraloc[callerside].location;
|
|
while assigned(callerparaloc) do
|
|
begin
|
|
{ Every paraloc must have a matching tmpparaloc }
|
|
if not assigned(tmpparaloc) then
|
|
internalerror(200408224);
|
|
if callerparaloc^.size<>tmpparaloc^.size then
|
|
internalerror(200408225);
|
|
case callerparaloc^.loc of
|
|
LOC_REGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_REGISTER then
|
|
internalerror(200408221);
|
|
if getsupreg(callerparaloc^.register)<first_int_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_load_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
|
|
tmpparaloc^.register,callerparaloc^.register);
|
|
end;
|
|
LOC_FPUREGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_FPUREGISTER then
|
|
internalerror(200408222);
|
|
if getsupreg(callerparaloc^.register)<first_fpu_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,ppn.tempcgpara.size,tmpparaloc^.register,callerparaloc^.register);
|
|
end;
|
|
LOC_MMREGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_MMREGISTER then
|
|
internalerror(200408223);
|
|
if getsupreg(callerparaloc^.register)<first_mm_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
|
|
tmpparaloc^.register,callerparaloc^.register,mms_movescalar);
|
|
end;
|
|
LOC_REFERENCE:
|
|
begin
|
|
if use_fixed_stack then
|
|
begin
|
|
{ Can't have a data copied to the stack, every location
|
|
must contain a valid size field }
|
|
|
|
if (ppn.tempcgpara.size=OS_NO) and
|
|
((tmpparaloc^.loc<>LOC_REFERENCE) or
|
|
assigned(tmpparaloc^.next)) then
|
|
internalerror(200501281);
|
|
reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset);
|
|
{ copy parameters in case they were moved to a temp. location because we've a fixed stack }
|
|
case tmpparaloc^.loc of
|
|
LOC_REFERENCE:
|
|
begin
|
|
reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset);
|
|
{ use concatcopy, because it can also be a float which fails when
|
|
load_ref_ref is used }
|
|
if (ppn.tempcgpara.size <> OS_NO) then
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,tcgsize2size[tmpparaloc^.size])
|
|
else
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,sizeleft)
|
|
end;
|
|
LOC_REGISTER:
|
|
cg.a_load_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
|
|
LOC_FPUREGISTER:
|
|
cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
|
|
LOC_MMREGISTER:
|
|
cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar);
|
|
else
|
|
internalerror(200402081);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
dec(sizeleft,tcgsize2size[tmpparaloc^.size]);
|
|
callerparaloc:=callerparaloc^.next;
|
|
tmpparaloc:=tmpparaloc^.next;
|
|
end;
|
|
end;
|
|
ppn:=tcgcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.freeparas;
|
|
var
|
|
ppn : tcgcallparanode;
|
|
begin
|
|
{ free the resources allocated for the parameters }
|
|
ppn:=tcgcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if (ppn.left.nodetype<>nothingn) then
|
|
begin
|
|
if (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
|
|
paramanager.freeparaloc(current_asmdata.CurrAsmList,ppn.parasym.paraloc[callerside]);
|
|
end;
|
|
ppn:=tcgcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure tcgcallnode.pass_generate_code;
|
|
var
|
|
name_to_call: shortstring;
|
|
regs_to_save_int,
|
|
regs_to_save_fpu,
|
|
regs_to_save_mm : Tcpuregisterset;
|
|
href : treference;
|
|
pop_size : longint;
|
|
vmtoffset : aint;
|
|
pvreg,
|
|
vmtreg : tregister;
|
|
oldaktcallnode : tcallnode;
|
|
{$ifdef vtentry}
|
|
sym : tasmsymbol;
|
|
{$endif vtentry}
|
|
{$ifdef x86_64}
|
|
cgpara : tcgpara;
|
|
{$endif x86_64}
|
|
begin
|
|
if not assigned(procdefinition) or
|
|
not procdefinition.has_paraloc_info then
|
|
internalerror(200305264);
|
|
|
|
if assigned(callinitblock) then
|
|
secondpass(callinitblock);
|
|
|
|
regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
|
|
regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
|
|
regs_to_save_mm:=paramanager.get_volatile_registers_mm(procdefinition.proccalloption);
|
|
|
|
{ Include Function result registers }
|
|
if (not is_void(resultdef)) then
|
|
begin
|
|
case procdefinition.funcretloc[callerside].loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER:
|
|
include(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
include(regs_to_save_fpu,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
include(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
LOC_REFERENCE,
|
|
LOC_VOID:
|
|
;
|
|
else
|
|
internalerror(2004110213);
|
|
end;
|
|
end;
|
|
|
|
{ Process parameters, register parameters will be loaded
|
|
in imaginary registers. The actual load to the correct
|
|
register is done just before the call }
|
|
oldaktcallnode:=aktcallnode;
|
|
aktcallnode:=self;
|
|
if assigned(left) then
|
|
tcallparanode(left).secondcallparan;
|
|
aktcallnode:=oldaktcallnode;
|
|
|
|
{ procedure variable or normal function call ? }
|
|
if (right=nil) then
|
|
begin
|
|
name_to_call:='';
|
|
{ When methodpointer is typen we don't need (and can't) load
|
|
a pointer. We can directly call the correct procdef (PFV) }
|
|
if (po_virtualmethod in procdefinition.procoptions) and
|
|
assigned(methodpointer) and
|
|
(methodpointer.nodetype<>typen) and
|
|
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
|
|
begin
|
|
{ virtual methods require an index }
|
|
if tprocdef(procdefinition).extnumber=$ffff then
|
|
internalerror(200304021);
|
|
|
|
secondpass(methodpointer);
|
|
|
|
{ Load VMT from self }
|
|
if methodpointer.resultdef.typ=objectdef then
|
|
gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(methodpointer.resultdef),methodpointer.location,vmtreg)
|
|
else
|
|
begin
|
|
{ Load VMT value in register }
|
|
location_force_reg(current_asmdata.CurrAsmList,methodpointer.location,OS_ADDR,false);
|
|
vmtreg:=methodpointer.location.register;
|
|
end;
|
|
|
|
{ test validity of VMT }
|
|
if not(is_interface(tprocdef(procdefinition)._class)) and
|
|
not(is_cppclass(tprocdef(procdefinition)._class)) then
|
|
cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tprocdef(procdefinition)._class);
|
|
|
|
{ Call through VMT, generate a VTREF symbol to notify the linker }
|
|
vmtoffset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
|
|
{$ifdef vtentry}
|
|
if not is_interface(tprocdef(procdefinition)._class) then
|
|
begin
|
|
inc(current_asmdata.NextVTEntryNr);
|
|
current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition)._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
|
|
end;
|
|
{$endif vtentry}
|
|
|
|
{$ifndef x86}
|
|
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
|
{$endif not x86}
|
|
reference_reset_base(href,vmtreg,vmtoffset);
|
|
{$ifndef x86}
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,pvreg);
|
|
{$endif not x86}
|
|
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
{ call method }
|
|
extra_call_code;
|
|
{$ifdef x86}
|
|
cg.a_call_ref(current_asmdata.CurrAsmList,href);
|
|
{$else x86}
|
|
cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
|
|
{$endif x86}
|
|
extra_post_call_code;
|
|
end
|
|
else
|
|
begin
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
if procdefinition.proccalloption=pocall_syscall then
|
|
do_syscall
|
|
else
|
|
begin
|
|
{ Calling interrupt from the same code requires some
|
|
extra code }
|
|
if (po_interrupt in procdefinition.procoptions) then
|
|
extra_interrupt_code;
|
|
extra_call_code;
|
|
if (name_to_call='') then
|
|
cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions)
|
|
else
|
|
cg.a_call_name(current_asmdata.CurrAsmList,name_to_call,po_weakexternal in procdefinition.procoptions);
|
|
extra_post_call_code;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
{ now procedure variable case }
|
|
begin
|
|
secondpass(right);
|
|
|
|
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
|
{ Only load OS_ADDR from the reference }
|
|
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,right.location.reference,pvreg)
|
|
else
|
|
cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,right.location,pvreg);
|
|
location_freetemp(current_asmdata.CurrAsmList,right.location);
|
|
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
{ Calling interrupt from the same code requires some
|
|
extra code }
|
|
if (po_interrupt in procdefinition.procoptions) then
|
|
extra_interrupt_code;
|
|
extra_call_code;
|
|
cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
|
|
extra_post_call_code;
|
|
end;
|
|
|
|
{ Need to remove the parameters from the stack? }
|
|
if (procdefinition.proccalloption in clearstack_pocalls) then
|
|
begin
|
|
pop_size:=pushedparasize;
|
|
{ for Cdecl functions we don't need to pop the funcret when it
|
|
was pushed by para }
|
|
if paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then
|
|
dec(pop_size,sizeof(pint));
|
|
{ Remove parameters/alignment from the stack }
|
|
pop_parasize(pop_size);
|
|
end;
|
|
|
|
{ Release registers, but not the registers that contain the
|
|
function result }
|
|
if (not is_void(resultdef)) then
|
|
begin
|
|
case procdefinition.funcretloc[callerside].loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER:
|
|
begin
|
|
{$ifndef cpu64bitalu}
|
|
if procdefinition.funcretloc[callerside].size in [OS_64,OS_S64] then
|
|
begin
|
|
exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register64.reghi));
|
|
exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register64.reglo));
|
|
end
|
|
else
|
|
{$endif not cpu64bitalu}
|
|
exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
end;
|
|
LOC_FPUREGISTER,
|
|
LOC_CFPUREGISTER:
|
|
exclude(regs_to_save_fpu,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
LOC_MMREGISTER,
|
|
LOC_CMMREGISTER:
|
|
exclude(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
|
|
LOC_REFERENCE,
|
|
LOC_VOID:
|
|
;
|
|
else
|
|
internalerror(2004110214);
|
|
end;
|
|
end;
|
|
|
|
{$if defined(x86) or defined(arm)}
|
|
if (procdefinition.proccalloption=pocall_safecall) and
|
|
(target_info.system in system_all_windows) then
|
|
begin
|
|
{$ifdef x86_64}
|
|
cgpara.init;
|
|
paramanager.getintparaloc(pocall_default,1,cgpara);
|
|
cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,NR_RAX,cgpara);
|
|
cgpara.done;
|
|
{$endif x86_64}
|
|
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
|
|
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK',false);
|
|
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
|
|
end;
|
|
{$endif}
|
|
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
|
|
{ handle function results }
|
|
if (not is_void(resultdef)) then
|
|
handle_return_value
|
|
else
|
|
location_reset(location,LOC_VOID,OS_NO);
|
|
|
|
{ convert persistent temps for parameters and function result to normal temps }
|
|
if assigned(callcleanupblock) then
|
|
secondpass(callcleanupblock);
|
|
|
|
{ release temps and finalize unused return values, must be
|
|
after the callcleanupblock because that converts temps
|
|
from persistent to normal }
|
|
release_unused_return_value;
|
|
|
|
{ release temps of paras }
|
|
release_para_temps;
|
|
|
|
{ perhaps i/o check ? }
|
|
if (cs_check_io in current_settings.localswitches) and
|
|
(po_iocheck in procdefinition.procoptions) and
|
|
not(po_iocheck in current_procinfo.procdef.procoptions) and
|
|
{ no IO check for methods and procedure variables }
|
|
(right=nil) and
|
|
not(po_virtualmethod in procdefinition.procoptions) then
|
|
begin
|
|
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
|
|
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false);
|
|
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
ccallparanode:=tcgcallparanode;
|
|
ccallnode:=tcgcallnode;
|
|
end.
|