paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 17:19:26 +02:00
Code Issues Packages Projects Releases Wiki Activity
1422985ca0
fpc/compiler/ncgutil.pas
peter 1422985ca0 * Change several $ifdef i386 to x86 
* Change several OS_32 to OS_INT/OS_ADDR
2004-01-31 17:45:16 +00:00

2769 lines
107 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Helper routines for all code generators
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 ncgutil;
{$i fpcdefs.inc}
interface
uses
node,cpuinfo,
globtype,
cpubase,cgbase,
aasmbase,aasmtai,aasmcpu,
symconst,symbase,symdef,symsym,symtype,symtable
{$ifndef cpu64bit}
,cg64f32
{$endif cpu64bit}
;
type
tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
procedure firstcomplex(p : tbinarynode);
procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
// procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
procedure gen_proc_symbol(list:Taasmoutput);
procedure gen_proc_symbol_end(list:Taasmoutput);
procedure gen_stackalloc_code(list:Taasmoutput);
procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
procedure gen_save_used_regs(list:TAAsmoutput);
procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
procedure gen_entry_code(list:TAAsmoutput);
procedure gen_exit_code(list:TAAsmoutput);
procedure gen_load_para_value(list:TAAsmoutput);
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
(*
procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
*)
{#
Allocate the buffers for exception management and setjmp environment.
Return a pointer to these buffers, send them to the utility routine
so they are registered, and then call setjmp.
Then compare the result of setjmp with 0, and if not equal
to zero, then jump to exceptlabel.
Also store the result of setjmp to a temporary space by calling g_save_exception_reason
It is to note that this routine may be called *after* the stackframe of a
routine has been called, therefore on machines where the stack cannot
be modified, all temps should be allocated on the heap instead of the
stack.
}
procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
procedure insertconstdata(sym : ttypedconstsym);
procedure insertbssdata(sym : tvarsym);
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
implementation
uses
{$ifdef Delphi}
Sysutils,
{$else}
strings,
{$endif}
cutils,cclasses,
globals,systems,verbose,
defutil,
procinfo,paramgr,fmodule,
regvars,
{$ifdef GDB}
gdb,
{$endif GDB}
ncon,
tgobj,cgobj;
const
{ Please leave this here, this module should NOT use
exprasmlist, the lists are always passed as arguments.
Declaring it as string here results in an error when compiling (PFV) }
exprasmlist = 'error';
{*****************************************************************************
Misc Helpers
*****************************************************************************}
{ DO NOT RELY on the fact that the tnode is not yet swaped
because of inlining code PM }
procedure firstcomplex(p : tbinarynode);
var
hp : tnode;
begin
{ always calculate boolean AND and OR from left to right }
if (p.nodetype in [orn,andn]) and
is_boolean(p.left.resulttype.def) then
begin
if nf_swaped in p.flags then
internalerror(234234);
end
else
if (
(p.location.loc=LOC_FPUREGISTER) and
(p.right.registersfpu > p.left.registersfpu)
) or
(
(
(
((p.left.registersfpu = 0) and (p.right.registersfpu = 0)) or
(p.location.loc<>LOC_FPUREGISTER)
) and
(p.left.registers32<p.right.registers32)
)
) then
begin
hp:=p.left;
p.left:=p.right;
p.right:=hp;
if nf_swaped in p.flags then
exclude(p.flags,nf_swaped)
else
include(p.flags,nf_swaped);
end;
end;
procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
{
produces jumps to true respectively false labels using boolean expressions
depending on whether the loading of regvars is currently being
synchronized manually (such as in an if-node) or automatically (most of
the other cases where this procedure is called), loadregvars can be
"lr_load_regvars" or "lr_dont_load_regvars"
}
var
opsize : tcgsize;
storepos : tfileposinfo;
begin
if nf_error in p.flags then
exit;
storepos:=aktfilepos;
aktfilepos:=p.fileinfo;
if is_boolean(p.resulttype.def) then
begin
{$ifdef OLDREGVARS}
if loadregvars = lr_load_regvars then
load_all_regvars(list);
{$endif OLDREGVARS}
if is_constboolnode(p) then
begin
if tordconstnode(p).value<>0 then
cg.a_jmp_always(list,truelabel)
else
cg.a_jmp_always(list,falselabel)
end
else
begin
opsize:=def_cgsize(p.resulttype.def);
case p.location.loc of
LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
begin
{$ifdef OLDREGVARS}
if (p.location.loc = LOC_CREGISTER) then
load_regvar_reg(list,p.location.register);
{$endif OLDREGVARS}
cg.a_cmp_const_loc_label(list,opsize,OC_NE,
0,p.location,truelabel);
{ !!! should happen right after cmp (JM) }
location_release(list,p.location);
cg.a_jmp_always(list,falselabel);
end;
LOC_JUMP:
;
{$ifdef cpuflags}
LOC_FLAGS :
begin
cg.a_jmp_flags(list,p.location.resflags,
truelabel);
cg.a_jmp_always(list,falselabel);
end;
{$endif cpuflags}
else
begin
printnode(output,p);
internalerror(200308241);
end;
end;
end;
end
else
internalerror(200112305);
aktfilepos:=storepos;
end;
(*
This code needs fixing. It is not safe to use rgint; on the m68000 it
would be rgaddr.
procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
begin
case t.loc of
LOC_REGISTER:
begin
{ can't be a regvar, since it would be LOC_CREGISTER then }
exclude(regs,getsupreg(t.register));
if t.registerhigh<>NR_NO then
exclude(regs,getsupreg(t.registerhigh));
end;
LOC_CREFERENCE,LOC_REFERENCE:
begin
if not(cs_regvars in aktglobalswitches) or
(getsupreg(t.reference.base) in cg.rgint.usableregs) then
exclude(regs,getsupreg(t.reference.base));
if not(cs_regvars in aktglobalswitches) or
(getsupreg(t.reference.index) in cg.rgint.usableregs) then
exclude(regs,getsupreg(t.reference.index));
end;
end;
end;
*)
{*****************************************************************************
EXCEPTION MANAGEMENT
*****************************************************************************}
procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
var
paraloc1,paraloc2,paraloc3 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paraloc3:=paramanager.getintparaloc(pocall_default,3);
paramanager.allocparaloc(list,paraloc3);
cg.a_paramaddr_ref(list,envbuf,paraloc3);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,jmpbuf,paraloc2);
{ push type of exceptionframe }
paramanager.allocparaloc(list,paraloc1);
cg.a_param_const(list,OS_S32,1,paraloc1);
paramanager.freeparaloc(list,paraloc3);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_SETJMP');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.g_exception_reason_save(list, href);
cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,NR_FUNCTION_RESULT_REG,exceptlabel);
end;
procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
begin
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_POPADDRSTACK');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
if not onlyfree then
begin
cg.g_exception_reason_load(list, href);
cg.a_cmp_const_reg_label(list,OS_S32,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
end;
end;
{*****************************************************************************
TLocation
*****************************************************************************}
{$ifndef cpu64bit}
{ 32-bit version }
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
var
hregister,
hregisterhi : tregister;
hreg64 : tregister64;
hl : tasmlabel;
oldloc : tlocation;
begin
oldloc:=l;
if dst_size=OS_NO then
internalerror(200309144);
{ handle transformations to 64bit separate }
if dst_size in [OS_64,OS_S64] then
begin
if not (l.size in [OS_64,OS_S64]) then
begin
{ load a smaller size to OS_64 }
if l.loc=LOC_REGISTER then
begin
hregister:=cg.makeregsize(l.registerlow,OS_32);
cg.a_load_reg_reg(list,l.size,OS_32,l.registerlow,hregister);
end
else
begin
location_release(list,l);
hregister:=cg.getintregister(list,OS_INT);
end;
{ load value in low register }
case l.loc of
LOC_FLAGS :
cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
LOC_JUMP :
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,OS_INT,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,OS_INT,0,hregister);
cg.a_label(list,hl);
end;
else
cg.a_load_loc_reg(list,OS_INT,l,hregister);
end;
{ reset hi part, take care of the signed bit of the current value }
hregisterhi:=cg.getintregister(list,OS_INT);
if (dst_size=OS_S64) and
(l.size in [OS_S8,OS_S16,OS_S32]) then
begin
if l.loc=LOC_CONSTANT then
begin
if (longint(l.value)<0) then
cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
else
cg.a_load_const_reg(list,OS_32,0,hregisterhi);
end
else
begin
cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister,
hregisterhi);
end;
end
else
cg.a_load_const_reg(list,OS_32,0,hregisterhi);
location_reset(l,LOC_REGISTER,dst_size);
l.registerlow:=hregister;
l.registerhigh:=hregisterhi;
end
else
begin
{ 64bit to 64bit }
if (l.loc=LOC_REGISTER) or
((l.loc=LOC_CREGISTER) and maybeconst) then
begin
hregister:=l.registerlow;
hregisterhi:=l.registerhigh;
end
else
begin
hregister:=cg.getintregister(list,OS_INT);
hregisterhi:=cg.getintregister(list,OS_INT);
location_release(list,l);
end;
hreg64.reglo:=hregister;
hreg64.reghi:=hregisterhi;
{ load value in new register }
cg64.a_load64_loc_reg(list,l,hreg64);
location_reset(l,LOC_REGISTER,dst_size);
l.registerlow:=hregister;
l.registerhigh:=hregisterhi;
end;
end
else
begin
{Do not bother to recycle the existing register. The register
allocator eliminates unnecessary moves, so it's not needed
and trying to recycle registers can cause problems because
the registers changes size and may need aditional constraints.}
location_release(list,l);
hregister:=cg.getintregister(list,dst_size);
{ load value in new register }
case l.loc of
LOC_FLAGS :
cg.g_flags2reg(list,dst_size,l.resflags,hregister);
LOC_JUMP :
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,dst_size,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,dst_size,0,hregister);
cg.a_label(list,hl);
end;
else
begin
{ load_loc_reg can only handle size >= l.size, when the
new size is smaller then we need to adjust the size
of the orignal and maybe recalculate l.register for i386 }
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
begin
if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
l.register:=cg.makeregsize(l.register,dst_size);
{ for big endian systems, the reference's offset must }
{ be increased in this case, since they have the }
{ MSB first in memory and e.g. byte(word_var) should }
{ return the second byte in this case (JM) }
if (target_info.endian = ENDIAN_BIG) and
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
{$ifdef x86}
l.size:=dst_size;
{$endif x86}
end;
cg.a_load_loc_reg(list,dst_size,l,hregister);
{$ifndef x86}
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
l.size:=dst_size;
{$endif not x86}
end;
end;
if (l.loc <> LOC_CREGISTER) or
not maybeconst then
location_reset(l,LOC_REGISTER,dst_size)
else
location_reset(l,LOC_CREGISTER,dst_size);
l.register:=hregister;
end;
{ Release temp when it was a reference }
if oldloc.loc=LOC_REFERENCE then
location_freetemp(list,oldloc);
end;
{$else cpu64bit}
{ 64-bit version }
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
var
hregister : tregister;
hl : tasmlabel;
oldloc : tlocation;
begin
oldloc:=l;
if dst_size=OS_NO then
internalerror(200309144);
{ handle transformations to 64bit separate }
if dst_size in [OS_64,OS_S64] then
begin
{ load a smaller size to OS_64 }
if l.loc=LOC_REGISTER then
hregister:=cg.makeregsize(l.register,OS_INT)
else
begin
location_release(list,l);
hregister:=cg.getintregister(list,OS_INT);
end;
{ load value in low register }
case l.loc of
{$ifdef cpuflags}
LOC_FLAGS :
cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
{$endif cpuflags}
LOC_JUMP :
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,OS_INT,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,OS_INT,0,hregister);
cg.a_label(list,hl);
end;
else
cg.a_load_loc_reg(list,OS_INT,l,hregister);
end;
location_reset(l,LOC_REGISTER,dst_size);
l.register:=hregister;
end
else
begin
{ transformations to 32bit or smaller }
if l.loc=LOC_REGISTER then
begin
hregister:=l.register;
end
else
begin
{ get new register }
if (l.loc=LOC_CREGISTER) and
maybeconst and
(TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
hregister:=l.register
else
begin
location_release(list,l);
hregister:=cg.getintregister(list,OS_INT);
end;
end;
hregister:=cg.makeregsize(hregister,dst_size);
{ load value in new register }
case l.loc of
{$ifdef cpuflags}
LOC_FLAGS :
cg.g_flags2reg(list,dst_size,l.resflags,hregister);
{$endif cpuflags}
LOC_JUMP :
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,dst_size,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,dst_size,0,hregister);
cg.a_label(list,hl);
end;
else
begin
{ load_loc_reg can only handle size >= l.size, when the
new size is smaller then we need to adjust the size
of the orignal and maybe recalculate l.register for i386 }
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
begin
if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
l.register:=cg.makeregsize(l.register,dst_size);
{ for big endian systems, the reference's offset must }
{ be increased in this case, since they have the }
{ MSB first in memory and e.g. byte(word_var) should }
{ return the second byte in this case (JM) }
if (target_info.endian = ENDIAN_BIG) and
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
{$ifdef x86}
l.size:=dst_size;
{$endif x86}
end;
cg.a_load_loc_reg(list,dst_size,l,hregister);
{$ifndef x86}
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
l.size:=dst_size;
{$endif not x86}
end;
end;
location_reset(l,LOC_REGISTER,dst_size);
l.register:=hregister;
end;
{ Release temp when it was a reference }
if oldloc.loc=LOC_REFERENCE then
location_freetemp(list,oldloc);
end;
{$endif cpu64bit}
procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
var
reg : tregister;
href : treference;
begin
if (l.loc<>LOC_FPUREGISTER) and
((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
begin
{ if it's in an mm register, store to memory first }
if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
begin
tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
location_release(list,l);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=href;
end;
reg:=cg.getfpuregister(list,l.size);
cg.a_loadfpu_loc_reg(list,l,reg);
location_freetemp(list,l);
location_release(list,l);
location_reset(l,LOC_FPUREGISTER,l.size);
l.register:=reg;
end;
end;
procedure location_force_mmregscalar(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
var
reg : tregister;
href : treference;
begin
if (l.loc<>LOC_MMREGISTER) and
((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then
begin
{ if it's in an fpu register, store to memory first }
if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
begin
tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
cg.a_loadfpu_reg_ref(list,l.size,l.register,href);
location_release(list,l);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=href;
end;
reg:=cg.getmmregister(list,l.size);
cg.a_loadmm_loc_reg(list,l.size,l,reg,mms_movescalar);
location_freetemp(list,l);
location_release(list,l);
location_reset(l,LOC_MMREGISTER,l.size);
l.register:=reg;
end;
end;
procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
var
r : treference;
begin
case l.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
begin
tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
cg.a_loadfpu_reg_ref(list,l.size,l.register,r);
location_release(list,l);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r;
end;
LOC_MMREGISTER,
LOC_CMMREGISTER:
begin
tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
location_release(list,l);
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r;
end;
LOC_CONSTANT,
LOC_REGISTER,
LOC_CREGISTER :
begin
tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
if l.size in [OS_64,OS_S64] then
begin
cg64.a_load64_loc_ref(list,l,r);
location_release(list,l);
end
else
begin
location_release(list,l);
cg.a_load_loc_ref(list,l.size,l,r);
end;
location_reset(l,LOC_REFERENCE,l.size);
l.reference:=r;
end;
LOC_CREFERENCE,
LOC_REFERENCE : ;
else
internalerror(200203219);
end;
end;
{*****************************************************************************
Maybe_Save
*****************************************************************************}
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
begin
{$ifdef i386}
if (needed>=maxfpuregs) and
(l.loc = LOC_FPUREGISTER) then
begin
location_force_mem(list,l);
maybe_pushfpu:=true;
end
else
maybe_pushfpu:=false;
{$endif i386}
end;
{****************************************************************************
Init/Finalize Code
****************************************************************************}
procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
var
href1,href2 : treference;
list:TAAsmoutput;
hsym : tvarsym;
l : longint;
loadref : boolean;
localcopyloc : tparalocation;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
(tvarsym(p).varspez=vs_value) and
(paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
begin
loadref:=true;
case tvarsym(p).localloc.loc of
LOC_REGISTER :
begin
reference_reset_base(href1,tvarsym(p).localloc.register,0);
loadref:=false;
end;
LOC_REFERENCE :
reference_reset_base(href1,tvarsym(p).localloc.reference.index,
tvarsym(p).localloc.reference.offset);
else
internalerror(200309181);
end;
if is_open_array(tvarsym(p).vartype.def) or
is_array_of_const(tvarsym(p).vartype.def) then
begin
{ cdecl functions don't have a high pointer so it is not possible to generate
a local copy }
if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
begin
hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
if not assigned(hsym) then
internalerror(200306061);
case hsym.localloc.loc of
LOC_REFERENCE :
begin
{ this code is only executed before the code for the body and the entry/exit code is generated
so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
}
include(current_procinfo.flags,pi_do_call);
reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
end
else
internalerror(200309182);
end;
end;
end
else
begin
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309183);
{ Allocate space for the local copy }
l:=tvarsym(p).getvaluesize;
localcopyloc.loc:=LOC_REFERENCE;
localcopyloc.size:=int_cgsize(l);
tg.GetLocal(list,l,tvarsym(p).vartype.def,localcopyloc.reference);
{ Copy data }
reference_reset_base(href2,localcopyloc.reference.index,localcopyloc.reference.offset);
if is_shortstring(tvarsym(p).vartype.def) then
begin
{ this code is only executed before the code for the body and the entry/exit code is generated
so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
}
include(current_procinfo.flags,pi_do_call);
cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
end
else
cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
{ update localloc of varsym }
tg.Ungetlocal(list,tvarsym(p).localloc.reference);
tvarsym(p).localloc:=localcopyloc;
end;
end;
end;
{ generates the code for initialisation of local data }
procedure initialize_data(p : tnamedindexitem;arg:pointer);
var
href : treference;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
(tvarsym(p).refs>0) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).owner.symtabletype=localsymtable then
begin
case tvarsym(p).localloc.loc of
LOC_REFERENCE :
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
else
internalerror(2003091810);
end;
end
else
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
end;
end;
{ generates the code for finalisation of local data }
procedure finalize_data(p : tnamedindexitem;arg:pointer);
var
href : treference;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
case tsym(p).typ of
varsym :
begin
if (tvarsym(p).refs>0) and
not(vo_is_funcret in tvarsym(p).varoptions) and
assigned(tvarsym(p).vartype.def) and
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if tvarsym(p).owner.symtabletype=localsymtable then
begin
case tvarsym(p).localloc.loc of
LOC_REFERENCE :
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
else
internalerror(2003091811);
end;
end
else
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
end;
end;
typedconstsym :
begin
if ttypedconstsym(p).is_writable and
ttypedconstsym(p).typedconsttype.def.needs_inittable then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata(ttypedconstsym(p).mangledname),0);
cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
end;
end;
end;
end;
{ generates the code for incrementing the reference count of parameters and
initialize out parameters }
procedure init_paras(p : tnamedindexitem;arg:pointer);
var
href : treference;
tmpreg : tregister;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
not is_class(tvarsym(p).vartype.def) and
tvarsym(p).vartype.def.needs_inittable then
begin
case tvarsym(p).varspez of
vs_value :
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309187);
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
end;
vs_out :
begin
case tvarsym(p).localloc.loc of
LOC_REFERENCE :
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
else
internalerror(2003091810);
end;
tmpreg:=cg.getaddressregister(list);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
reference_reset_base(href,tmpreg,0);
cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
cg.ungetregister(list,tmpreg);
end;
end;
end;
end;
{ generates the code for decrementing the reference count of parameters }
procedure final_paras(p : tnamedindexitem;arg:pointer);
var
href : treference;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
not is_class(tvarsym(p).vartype.def) and
tvarsym(p).vartype.def.needs_inittable then
begin
if (tvarsym(p).varspez=vs_value) then
begin
if tvarsym(p).localloc.loc<>LOC_REFERENCE then
internalerror(200309188);
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
end;
end
else if (tsym(p).typ=varsym) and
(tvarsym(p).varspez=vs_value) and
(is_open_array(tvarsym(p).vartype.def) or
is_array_of_const(tvarsym(p).vartype.def)) then
begin
{ cdecl functions don't have a high pointer so it is not possible to generate
a local copy }
if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
begin
reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
cg.g_releasevaluepara_openarray(list,href);
end;
end;
end;
{ Initialize temp ansi/widestrings,interfaces }
procedure inittempvariables(list:taasmoutput);
var
hp : ptemprecord;
href : treference;
begin
hp:=tg.templist;
while assigned(hp) do
begin
if assigned(hp^.def) and
hp^.def.needs_inittable then
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_initialize(list,hp^.def,href,false);
end;
hp:=hp^.next;
end;
end;
procedure finalizetempvariables(list:taasmoutput);
var
hp : ptemprecord;
href : treference;
paraloc1 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
hp:=tg.templist;
while assigned(hp) do
begin
if assigned(hp^.def) and
hp^.def.needs_inittable then
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.g_finalize(list,hp^.def,href,false);
end;
hp:=hp^.next;
end;
end;
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
var
ressym : tvarsym;
resloc : tlocation;
href : treference;
hreg : tregister;
begin
{ Is the loading needed? }
if is_void(current_procinfo.procdef.rettype.def) or
(
(po_assembler in current_procinfo.procdef.procoptions) and
(not(assigned(current_procinfo.procdef.funcretsym)) or
(tvarsym(current_procinfo.procdef.funcretsym).refs=0))
) then
exit;
{ Constructors need to return self }
if (current_procinfo.procdef.proctypeoption=potype_constructor) then
begin
cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
{ return the self pointer }
ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
if not assigned(ressym) then
internalerror(200305058);
case ressym.localloc.loc of
LOC_REFERENCE :
reference_reset_base(href,ressym.localloc.reference.index,ressym.localloc.reference.offset);
else
internalerror(2003091810);
end;
cg.ungetregister(list,NR_FUNCTION_RETURN_REG);
// for the optimizer
cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_FUNCTION_RETURN_REG);
uses_acc:=true;
exit;
end;
ressym := tvarsym(current_procinfo.procdef.funcretsym);
if (ressym.refs>0) then
begin
case ressym.localloc.loc of
LOC_FPUREGISTER,
LOC_REGISTER :
begin
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
location_reset(resloc,LOC_CREGISTER,OS_ADDR)
else
if ressym.vartype.def.deftype = floatdef then
location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
else
location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
resloc.register:=ressym.localloc.register;
end;
LOC_REFERENCE :
begin
location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procinfo.procdef.rettype.def));
reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
end;
else
internalerror(200309184);
end;
{ Here, we return the function result. In most architectures, the value is
passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
function returns in a register and the caller receives it in an other one }
case current_procinfo.procdef.rettype.def.deftype of
orddef,
enumdef :
begin
uses_acc:=true;
{$ifndef cpu64bit}
if resloc.size in [OS_64,OS_S64] then
begin
uses_acchi:=true;
cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
// for the optimizer
cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
NR_FUNCTION_RETURN64_HIGH_REG));
end
else
{$endif cpu64bit}
begin
cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
hreg:=cg.makeregsize(NR_FUNCTION_RETURN_REG,resloc.size);
cg.ungetregister(list,hreg);
// for the optimizer
cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
end;
end;
floatdef :
begin
uses_fpu := true;
{$ifdef cpufpemu}
if cs_fp_emulation in aktmoduleswitches then
cg.a_loadfpu_loc_reg(list,resloc,NR_FUNCTION_RETURN_REG)
else
{$endif cpufpemu}
cg.a_loadfpu_loc_reg(list,resloc,NR_FPU_RESULT_REG);
end;
else
begin
if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
begin
uses_acc:=true;
{$ifndef cpu64bit}
{ Win32 can return records in EAX:EDX }
if resloc.size in [OS_64,OS_S64] then
begin
uses_acchi:=true;
cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
// for the optimizer
cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
NR_FUNCTION_RETURN64_HIGH_REG));
end
else
{$endif cpu64bit}
begin
cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
hreg:=cg.makeregsize(NR_FUNCTION_RETURN_REG,resloc.size);
cg.ungetregister(list,hreg);
// for the optimizer
cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
end;
end
end;
end;
end;
end;
procedure gen_load_para_value(list:TAAsmoutput);
var
hp : tparaitem;
href : treference;
gotregvarparas : boolean;
begin
{ Store register parameters in reference or in register variable }
if assigned(current_procinfo.procdef.parast) and
not (po_assembler in current_procinfo.procdef.procoptions) then
begin
{ move register parameters which aren't regable into memory }
{ we do this before init_paras because that one calls routines which may overwrite these }
{ registers and it also expects the values to be in memory }
hp:=tparaitem(current_procinfo.procdef.para.first);
gotregvarparas := false;
while assigned(hp) do
begin
case tvarsym(hp.parasym).localloc.loc of
LOC_REGISTER :
begin
gotregvarparas := true;
{ cg.a_load_param_reg will first allocate and then deallocate paraloc }
{ register (if the parameter resides in a register) and then allocate }
{ the regvar (which is currently not allocated) }
cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,nil);
end;
LOC_FPUREGISTER:
begin
gotregvarparas := true;
{ cg.a_load_param_reg will first allocate and then deallocate paraloc }
{ register (if the parameter resides in a register) and then allocate }
{ the regvar (which is currently not allocated) }
cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,nil);
end;
LOC_REFERENCE :
begin
if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
begin
if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
begin
{$ifndef cpu64bit}
if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
begin
cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
end
else
{$endif cpu64bit}
cg.getexplicitregister(list,hp.paraloc[calleeside].register);
end;
{ Release parameter register }
{$ifndef cpu64bit}
if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
begin
cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
end
else
{$endif cpu64bit}
cg.ungetregister(list,hp.paraloc[calleeside].register);
reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,nil);
end;
end;
else
internalerror(200309185);
end;
hp:=tparaitem(hp.next);
end;
if gotregvarparas then
begin
{ deallocate all register variables again }
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
cg.ungetregister(list,tvarsym(hp.parasym).localloc.register);
hp:=tparaitem(hp.next);
end;
end;
end;
{ generate copies of call by value parameters, must be done before
the initialization and body is parsed because the refcounts are
incremented using the local copies }
if not(po_assembler in current_procinfo.procdef.procoptions) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
end;
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
begin
{ initialize local data like ansistrings }
case current_procinfo.procdef.proctypeoption of
potype_unitinit:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ initialisizes temp. ansi/wide string data }
inittempvariables(list);
{ initialize ansi/widesstring para's }
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
{$ifdef OLDREGVARS}
load_regvars(list,nil);
{$endif OLDREGVARS}
end;
procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
begin
{$ifdef OLDREGVARS}
cleanup_regvars(list);
{$endif OLDREGVARS}
{ finalize temporary data }
finalizetempvariables(list);
{ finalize local data like ansistrings}
case current_procinfo.procdef.proctypeoption of
potype_unitfinalize:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ units/progs have separate code for initialization and finalization }
potype_unitinit: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ finalize paras data }
if assigned(current_procinfo.procdef.parast) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
end;
procedure gen_entry_code(list:TAAsmoutput);
var
href : treference;
paraloc1,
paraloc2 : tparalocation;
begin
{ the actual profile code can clobber some registers,
therefore if the context must be saved, do it before
the actual call to the profile code
}
if (cs_profile in aktmoduleswitches) and
not(po_assembler in current_procinfo.procdef.procoptions) then
begin
{ non-win32 can call mcout even in main }
if not (target_info.system in [system_i386_win32,system_i386_wdosx]) then
cg.g_profilecode(list)
else
{ wdosx, and win32 should not call mcount before monstartup has been called }
if not (current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.g_profilecode(list);
end;
{ call startup helpers from main program }
if (current_procinfo.procdef.proctypeoption=potype_proginit) then
begin
{ initialize profiling for win32 }
if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
(cs_profile in aktmoduleswitches) then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,href,paraloc2);
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
cg.a_call_name(list,'_monstartup');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl));
end;
{ initialize units }
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
end;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list.concat(Tai_force_line.Create);
{$endif GDB}
{$ifdef OLDREGVARS}
load_regvars(list,nil);
{$endif OLDREGVARS}
end;
procedure gen_exit_code(list:TAAsmoutput);
begin
{ call __EXIT for main program }
if (not DLLsource) and
(current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.a_call_name(list,'FPC_DO_EXIT');
end;
{****************************************************************************
Entry/Exit
****************************************************************************}
procedure gen_proc_symbol(list:Taasmoutput);
var
hs : string;
begin
{ add symbol entry point as well as debug information }
{ will be inserted in front of the rest of this list. }
{ Insert alignment and assembler names }
{ Align, gprof uses 16 byte granularity }
if (cs_profile in aktmoduleswitches) then
list.concat(Tai_align.create(16))
else
list.concat(Tai_align.create(aktalignment.procalign));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if (po_public in current_procinfo.procdef.procoptions) then
Tprocsym(current_procinfo.procdef.procsym).is_global:=true;
current_procinfo.procdef.concatstabto(list);
Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
end;
{$endif GDB}
repeat
hs:=current_procinfo.procdef.aliasnames.getfirst;
if hs='' then
break;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and
target_info.use_function_relative_addresses then
list.concat(Tai_stab_function_name.create(strpnew(hs)));
{$endif GDB}
if (cs_profile in aktmoduleswitches) or
(po_public in current_procinfo.procdef.procoptions) then
list.concat(Tai_symbol.createname_global(hs,0))
else
list.concat(Tai_symbol.createname(hs,0));
until false;
end;
procedure gen_proc_symbol_end(list:Taasmoutput);
{$ifdef GDB}
var
stabsendlabel : tasmlabel;
mangled_length : longint;
p : pchar;
{$endif GDB}
begin
list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
objectlibrary.getlabel(stabsendlabel);
cg.a_label(list,stabsendlabel);
{ define calling EBP as pseudo local var PM }
{ this enables test if the function is a local one !! }
{if assigned(current_procinfo.parent) and
(current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
list.concat(Tai_stabs.Create(strpnew(
'"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
if (not is_void(current_procinfo.procdef.rettype.def)) and
(tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
begin
if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
begin
{$warning Need to add gdb support for ret in param register calling}
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
begin
list.concat(Tai_stabs.Create(strpnew(
'"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
if (m_result in aktmodeswitches) then
list.concat(Tai_stabs.Create(strpnew(
'"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
end
else
begin
list.concat(Tai_stabs.Create(strpnew(
'"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
if (m_result in aktmodeswitches) then
list.concat(Tai_stabs.Create(strpnew(
'"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
end;
end;
end;
mangled_length:=length(current_procinfo.procdef.mangledname);
getmem(p,2*mangled_length+50);
strpcopy(p,'192,0,0,');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(p),'-');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
end;
list.concat(Tai_stabn.Create(strnew(p)));
{List.concat(Tai_stabn.Create(strpnew('192,0,0,'
+current_procinfo.procdef.mangledname))));
p[0]:='2';p[1]:='2';p[2]:='4';
strpcopy(strend(p),'_end');}
strpcopy(p,'224,0,0,'+stabsendlabel.name);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(p),'-');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
end;
list.concatlist(withdebuglist);
list.concat(Tai_stabn.Create(strnew(p)));
{ strpnew('224,0,0,'
+current_procinfo.procdef.mangledname+'_end'))));}
freemem(p,2*mangled_length+50);
end;
{$endif GDB}
end;
procedure gen_stackalloc_code(list:Taasmoutput);
var
hitemp,
lotemp,
stackframe : longint;
check : boolean;
paraloc1 : tparalocation;
href : treference;
begin
check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
if check then
begin
{ Allocate tempspace to store register parameter than
is destroyed when calling stackchecking code }
paraloc1:=paramanager.getintparaloc(pocall_default,1);
if paraloc1.loc=LOC_REGISTER then
tg.GetTemp(list,POINTER_SIZE,tt_normal,href);
end;
{ Calculate size of stackframe }
stackframe:=current_procinfo.calc_stackframe_size;
{ All temps are know, write offsets used for information }
if (cs_asm_source in aktglobalswitches) then
begin
if tg.direction>0 then
begin
lotemp:=current_procinfo.tempstart;
hitemp:=tg.lasttemp;
end
else
begin
lotemp:=tg.lasttemp;
hitemp:=current_procinfo.tempstart;
end;
list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+
tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
end;
{$ifndef powerpc}
{ at least for the ppc this applies always, so this code isn't usable (FK) }
{ omit stack frame ? }
if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
begin
CGmessage(cg_d_stackframe_omited);
if stackframe<>0 then
cg.g_stackpointer_alloc(list,stackframe);
end
else
{$endif powerpc}
begin
if (po_interrupt in current_procinfo.procdef.procoptions) then
cg.g_interrupt_stackframe_entry(list);
cg.g_stackframe_entry(list,stackframe);
{ Add stack checking code? }
if check then
begin
{ The tempspace to store original register is already
allocated above before the stackframe size is calculated. }
if paraloc1.loc=LOC_REGISTER then
cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
paramanager.allocparaloc(list,paraloc1);
cg.a_param_const(list,OS_INT,stackframe,paraloc1);
paramanager.freeparaloc(list,paraloc1);
{ No register saving needed, saveregisters is used }
{$ifndef x86}
cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
{$endif x86}
cg.a_call_name(list,'FPC_STACKCHECK');
{$ifndef x86}
cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
{$endif x86}
if paraloc1.loc=LOC_REGISTER then
begin
cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
tg.UnGetTemp(list,href);
end;
end;
end;
end;
procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
var
stacksize,
retsize : longint;
begin
{$ifndef powerpc}
{ remove stackframe }
if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
begin
stacksize:=current_procinfo.calc_stackframe_size;
if (stacksize<>0) then
cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
end
else
cg.g_restore_frame_pointer(list);
{$endif}
{$ifdef x86}
{ at last, the return is generated }
if (po_interrupt in current_procinfo.procdef.procoptions) then
cg.g_interrupt_stackframe_exit(list,usesacc,usesacchi)
else
{$endif x86}
begin
if current_procinfo.procdef.proccalloption in clearstack_pocalls then
begin
retsize:=0;
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
inc(retsize,POINTER_SIZE);
end
else
retsize:=current_procinfo.para_stack_size;
cg.g_return_from_proc(list,retsize);
end;
{$ifndef cpu64bit}
if usesacchi then
begin
cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_LOW_REG);
cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
end
else
{$endif cpu64bit}
if usesacc then
cg.a_reg_dealloc(list,NR_FUNCTION_RETURN_REG);
end;
procedure gen_save_used_regs(list:TAAsmoutput);
begin
{ Pure assembler routines need to save the registers themselves }
if (po_assembler in current_procinfo.procdef.procoptions) then
exit;
{ for the save all registers we can simply use a pusha,popa which
push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
if (po_saveregisters in current_procinfo.procdef.procoptions) then
cg.g_save_all_registers(list)
else
if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
cg.g_save_standard_registers(list);
end;
procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
begin
{ Pure assembler routines need to save the registers themselves }
if (po_assembler in current_procinfo.procdef.procoptions) then
exit;
{ for the save all registers we can simply use a pusha,popa which
push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
if (po_saveregisters in current_procinfo.procdef.procoptions) then
cg.g_restore_all_registers(list,usesacc,usesacchi)
else
if current_procinfo.procdef.proccalloption in savestdregs_pocalls then
cg.g_restore_standard_registers(list);
end;
{****************************************************************************
Inlining
****************************************************************************}
(*
procedure load_inlined_return_value(list:TAAsmoutput);
var
ressym: tvarsym;
resloc: tlocation;
r,r2 : tregister;
begin
if not is_void(current_procinfo.procdef.rettype.def) then
begin
ressym := tvarsym(current_procinfo.procdef.funcretsym);
if ressym.reg.enum <> R_NO then
begin
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
location_reset(resloc,LOC_CREGISTER,OS_ADDR)
else
if ressym.vartype.def.deftype = floatdef then
location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
else
location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
resloc.register := ressym.reg;
end
else
begin
location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
end;
{ Here, we return the function result. In most architectures, the value is
passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
function returns in a register and the caller receives it in an other one }
case current_procinfo.procdef.rettype.def.deftype of
orddef,
enumdef :
begin
{$ifndef cpu64bit}
if resloc.size in [OS_64,OS_S64] then
begin
r:=cg.getregisterint(list,OS_INT);
r2:=cg.getregisterint(list,OS_INT);
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
end
else
{$endif cpu64bit}
begin
r:=cg.getregisterint(list,resloc.size);
cg.a_load_loc_reg(list,resloc.size,resloc,r);
end;
end;
floatdef :
begin
{$ifdef cpufpemu}
if cs_fp_emulation in aktmoduleswitches then
r.enum := FUNCTION_RETURN_REG
else
{$endif cpufpemu}
r.enum:=FPU_RESULT_REG;
cg.a_loadfpu_loc_reg(list,resloc,r);
end;
else
begin
if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
begin
{$ifndef cpu64bit}
{ Win32 can return records in EAX:EDX }
if resloc.size in [OS_64,OS_S64] then
begin
r:=cg.getregisterint(list,OS_INT);
r2:=cg.getregisterint(list,OS_INT);
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
end
else
{$endif cpu64bit}
begin
r:=cg.getregisterint(list,resloc.size);
cg.a_load_loc_reg(list,resloc.size,resloc,r);
end;
end
end;
end;
end;
end;
procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
begin
{ initialize return value }
initretvalue(list);
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
{ initialisizes temp. ansi/wide string data }
inittempvariables(list);
{ initialize ansi/widesstring para's }
if assigned(current_procinfo.procdef.parast) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
{ generate copies of call by value parameters }
if not(po_assembler in current_procinfo.procdef.procoptions) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
load_regvars(list,nil);
end;
procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
var
usesacc,
usesacchi,
usesfpu : boolean;
begin
if aktexitlabel.is_used then
cg.a_label(list,aktexitlabel);
cleanup_regvars(list);
{ finalize temporary data }
finalizetempvariables(list);
current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
{ finalize paras data }
if assigned(current_procinfo.procdef.parast) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
{ handle return value, this is not done for assembler routines when
they didn't reference the result variable }
if not(po_assembler in current_procinfo.procdef.procoptions) or
(assigned(current_procinfo.procdef.funcretsym) and
(tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
begin
if (current_procinfo.procdef.proctypeoption=potype_constructor) then
internalerror(200305263);
// load_inlined_return_value(list);
load_return_value(list,usesacc,usesacchi,usesfpu)
end;
cleanup_regvars(list);
end;
*)
{****************************************************************************
Const Data
****************************************************************************}
procedure insertconstdata(sym : ttypedconstsym);
{ this does not affect the local stack space, since all
typed constansts and initialized variables are always
put in the .data / .rodata section
}
var
storefilepos : tfileposinfo;
curconstsegment : taasmoutput;
l : longint;
begin
storefilepos:=aktfilepos;
aktfilepos:=sym.fileinfo;
if sym.is_writable then
curconstsegment:=datasegment
else
curconstsegment:=consts;
l:=sym.getsize;
{ insert cut for smartlinking or alignment }
if (cs_create_smart in aktmoduleswitches) then
curconstSegment.concat(Tai_cut.Create);
curconstSegment.concat(Tai_align.create(const_align(l)));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
sym.concatstabto(curconstsegment);
{$endif GDB}
if (sym.owner.symtabletype=globalsymtable) or
(cs_create_smart in aktmoduleswitches) or
(assigned(current_procinfo) and
(current_procinfo.procdef.proccalloption=pocall_inline)) or
DLLSource then
curconstSegment.concat(Tai_symbol.Createdataname_global(sym.mangledname,l))
else
curconstSegment.concat(Tai_symbol.Createdataname(sym.mangledname,l));
aktfilepos:=storefilepos;
end;
procedure insertbssdata(sym : tvarsym);
var
l,varalign : longint;
storefilepos : tfileposinfo;
begin
storefilepos:=aktfilepos;
aktfilepos:=sym.fileinfo;
l:=sym.getvaluesize;
if (vo_is_thread_var in sym.varoptions) then
inc(l,pointer_size);
varalign:=var_align(l);
{
sym.address:=align(datasize,varalign);
datasize:=tvarsym(sym).address+l;
}
{ insert cut for smartlinking or alignment }
if (cs_create_smart in aktmoduleswitches) then
bssSegment.concat(Tai_cut.Create);
bssSegment.concat(Tai_align.create(varalign));
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
sym.concatstabto(bsssegment);
{$endif GDB}
if (sym.owner.symtabletype=globalsymtable) or
(cs_create_smart in aktmoduleswitches) or
DLLSource or
(assigned(current_procinfo) and
(current_procinfo.procdef.proccalloption=pocall_inline)) or
(vo_is_exported in sym.varoptions) or
(vo_is_C_var in sym.varoptions) then
bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
else
bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
aktfilepos:=storefilepos;
end;
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
{ Only allocate space for referenced locals }
if (sym.typ=varsym) and
(tvarsym(sym).refs>0) then
begin
with tvarsym(sym) do
begin
{$warning TODO Add support for register variables}
localloc.loc:=LOC_REFERENCE;
tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
if cs_asm_source in aktglobalswitches then
list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if (sym.typ=varsym) and
(tvarsym(sym).refs>0) then
begin
with tvarsym(sym) do
begin
{ Note: We need to keep the data available in memory
for the sub procedures that can access local data
in the parent procedures }
case localloc.loc of
LOC_REFERENCE :
tg.Ungetlocal(list,localloc.reference);
LOC_REGISTER :
begin
{$ifndef cpu64bit}
if localloc.size in [OS_64,OS_S64] then
begin
cg.ungetregister(list,localloc.registerlow);
cg.ungetregister(list,localloc.registerhigh);
end
else
{$endif cpu64bit}
cg.ungetregister(list,localloc.register);
end;
end;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
if not(po_assembler in current_procinfo.procdef.procoptions) then
begin
case paraitem.paraloc[calleeside].loc of
LOC_FPUREGISTER,
LOC_REGISTER:
begin
(*
if paraitem.paraloc[calleeside].register=NR_NO then
begin
paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
{$ifndef cpu64bit}
if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
begin
paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
end;
*)
(*
{$warning TODO Allocate register paras}
localloc.loc:=LOC_REGISTER;
localloc.size:=paraitem.paraloc[calleeside].size;
{$ifndef cpu64bit}
if localloc.size in [OS_64,OS_S64] then
begin
localloc.registerlow:=cg.getregisterint(list,OS_32);
localloc.registerhigh:=cg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
localloc.register:=cg.getregisterint(list,localloc.size);
*)
localloc.loc:=LOC_REFERENCE;
localloc.size:=paraitem.paraloc[calleeside].size;
tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
end
else
localloc:=paraitem.paraloc[calleeside];
end;
end
else
localloc:=paraitem.paraloc[calleeside];
if cs_asm_source in aktglobalswitches then
begin
case localloc.loc of
LOC_REFERENCE :
begin
list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
{$ifdef powerpc}
localloc.size:=paraitem.paraloc[calleeside].size;
tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
{$endif powerpc}
end;
end;
end;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
{$warning TODO Allocate register paras}
localloc.loc:=LOC_REFERENCE;
localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
if cs_asm_source in aktglobalswitches then
begin
case localloc.loc of
LOC_REFERENCE :
list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
end;
end;
paraitem.paraloc[callerside]:=localloc;
paraitem.paraloc[calleeside]:=localloc;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
{ Note: We need to keep the data available in memory
for the sub procedures that can access local data
in the parent procedures }
case localloc.loc of
LOC_REFERENCE :
tg.UngetLocal(list,localloc.reference);
LOC_REGISTER :
begin
if localloc.register<>paraitem.paraloc[calleeside].register then
begin
{$ifndef cpu64bit}
if localloc.size in [OS_64,OS_S64] then
begin
cg.ungetregister(list,localloc.registerlow);
cg.ungetregister(list,localloc.registerhigh);
end
else
{$endif cpu64bit}
cg.ungetregister(list,localloc.register);
end;
end;
end;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
end.
{
$Log$
Revision 1.185 2004-01-31 17:45:17 peter
* Change several $ifdef i386 to x86
* Change several OS_32 to OS_INT/OS_ADDR
Revision 1.184 2004/01/21 21:01:34 peter
* fixed stackchecking for register calling
Revision 1.183 2004/01/17 15:55:10 jonas
* fixed allocation of parameters passed by reference for powerpc in
callee
Revision 1.182 2004/01/13 18:08:58 florian
* x86-64 compilation fixed
Revision 1.181 2004/01/12 22:11:38 peter
* use localalign info for alignment for locals and temps
* sparc fpu flags branching added
* moved powerpc copy_valye_openarray to generic
Revision 1.180 2003/12/28 21:57:43 jonas
* fixed procedures declared as "interrupt" for non-x86
Revision 1.179 2003/12/26 13:19:16 florian
* rtl and compiler compile with -Cfsse2
Revision 1.178 2003/12/26 00:32:21 florian
+ fpu<->mm register conversion
Revision 1.177 2003/12/24 00:10:02 florian
- delete parameter in cg64 methods removed
Revision 1.176 2003/12/23 14:38:07 florian
+ second_floataddsse implemented
Revision 1.175 2003/12/22 19:00:17 florian
* fixed some x86-64 issues
Revision 1.174 2003/12/07 16:28:30 jonas
* fixed typo found by Charlie
Revision 1.173 2003/12/06 01:15:22 florian
* reverted Peter's alloctemp patch; hopefully properly
Revision 1.172 2003/12/03 23:13:20 peter
* delayed paraloc allocation, a_param_*() gets extra parameter
if it needs to allocate temp or real paralocation
* optimized/simplified int-real loading
Revision 1.171 2003/11/30 19:35:29 florian
* fixed several arm related problems
Revision 1.170 2003/11/29 20:13:25 florian
* fixed several pi_do_call problems
Revision 1.169 2003/11/23 17:05:15 peter
* register calling is left-right
* parameter ordering
* left-right calling inserts result parameter last
Revision 1.168 2003/11/22 00:31:25 jonas
+ extra allocations of function result regs for the optimiser
Revision 1.167 2003/11/11 21:10:12 peter
* remove temporary stdcall hack
Revision 1.166 2003/11/10 22:02:52 peter
* cross unit inlining fixed
Revision 1.165 2003/11/07 15:58:32 florian
* Florian's culmutative nr. 1; contains:
- invalid calling conventions for a certain cpu are rejected
- arm softfloat calling conventions
- -Sp for cpu dependend code generation
- several arm fixes
- remaining code for value open array paras on heap
Revision 1.164 2003/11/04 19:03:50 peter
* fixes for temp type patch
Revision 1.163 2003/11/04 15:35:13 peter
* fix for referencecounted temps
Revision 1.162 2003/10/25 11:34:02 florian
* fixed compilation of ppc system unit
Revision 1.161 2003/10/19 01:34:30 florian
* some ppc stuff fixed
* memory leak fixed
Revision 1.160 2003/10/17 15:08:34 peter
* commented out more obsolete constants
Revision 1.159 2003/10/17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.158 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units
* moved location_* and reference_* to cgobj
* first things for mmx register allocation
Revision 1.157 2003/10/09 21:31:37 daniel
* Register allocator splitted, ans abstract now
Revision 1.156 2003/10/07 18:18:16 peter
* fix register calling for assembler procedures
* fix result loading for assembler procedures
Revision 1.155 2003/10/07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.154 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose
* fixed ppc and sparc compiles
Revision 1.153 2003/09/30 21:02:37 peter
* updates for inlining
Revision 1.152 2003/09/29 20:58:56 peter
* optimized releasing of registers
Revision 1.151 2003/09/28 21:47:18 peter
* register paras and local copies updates
Revision 1.150 2003/09/28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.149 2003/09/28 13:39:38 peter
* optimized releasing of registers
Revision 1.148 2003/09/25 21:28:00 peter
* parameter fixes
Revision 1.147 2003/09/23 21:03:59 peter
* check for refs>0 in init/final local data
Revision 1.146 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure
Revision 1.145 2003/09/16 16:17:01 peter
* varspez in calls to push_addr_param
Revision 1.144 2003/09/14 21:33:37 peter
* location_force_reg gives IE when size=OS_NO
Revision 1.143 2003/09/14 19:18:10 peter
* remove obsolete code already in comments
Revision 1.142 2003/09/11 11:54:59 florian
* improved arm code generation
* move some protected and private field around
* the temp. register for register parameters/arguments are now released
before the move to the parameter register is done. This improves
the code in a lot of cases.
Revision 1.141 2003/09/10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.140 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes
Revision 1.139 2003/09/03 15:55:01 peter
* NEWRA branch merged
Revision 1.138 2003/09/03 11:18:37 florian
* fixed arm concatcopy
+ arm support in the common compiler sources added
* moved some generic cg code around
+ tfputype added
* ...
Revision 1.137.2.4 2003/08/31 15:46:26 peter
* more updates for tregister
Revision 1.137.2.3 2003/08/29 17:28:59 peter
* next batch of updates
Revision 1.137.2.2 2003/08/28 18:35:08 peter
* tregister changed to cardinal
Revision 1.137.2.1 2003/08/27 19:55:54 peter
* first tregister patch
Revision 1.137 2003/08/20 20:29:06 daniel
* Some more R_NO changes
* Preventive code to loadref added
Revision 1.136 2003/08/20 17:48:49 peter
* fixed stackalloc to not allocate localst.datasize twice
* order of stackalloc code fixed for implicit init/final
Revision 1.135 2003/08/17 16:59:20 jonas
* fixed regvars so they work with newra (at least for ppc)
* fixed some volatile register bugs
+ -dnotranslation option for -dnewra, which causes the registers not to
be translated from virtual to normal registers. Requires support in
the assembler writer as well, which is only implemented in aggas/
agppcgas currently
Revision 1.134 2003/08/11 21:18:20 peter
* start of sparc support for newra
Revision 1.133 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code
Revision 1.132 2003/08/03 14:09:50 daniel
* Fixed a register allocator bug
* Figured out why -dnewra generates superfluous "mov reg1,reg2"
statements: changes in location_force. These moves are now no longer
constrained so they are optimized away.
Revision 1.131 2003/07/23 11:04:15 jonas
* split en_exit_code into a part that may allocate a register and a part
that doesn't, so the former can be done before the register colouring
has been performed
Revision 1.130 2003/07/06 17:58:22 peter
* framepointer fixes for sparc
* parent framepointer code more generic
Revision 1.129 2003/07/06 15:31:20 daniel
* Fixed register allocator. *Lots* of fixes.
Revision 1.128 2003/07/02 22:18:04 peter
* paraloc splitted in callerparaloc,calleeparaloc
* sparc calling convention updates
Revision 1.127 2003/06/17 18:13:51 jonas
* fixed -dnewra compilation problems
Revision 1.126 2003/06/17 16:32:44 peter
* alloc register for function result
Revision 1.125 2003/06/13 21:19:30 peter
* current_procdef removed, use current_procinfo.procdef instead
Revision 1.124 2003/06/09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.123 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's
Revision 1.122 2003/06/06 14:43:02 peter
* g_copyopenarrayvalue gets length reference
* don't copy open arrays for cdecl
Revision 1.121 2003/06/03 21:11:09 peter
* cg.a_load_* get a from and to size specifier
* makeregsize only accepts newregister
* i386 uses generic tcgnotnode,tcgunaryminus
Revision 1.120 2003/06/03 15:49:49 jonas
* fixed ref/loc problems
Revision 1.119 2003/06/03 15:06:37 daniel
* fixed conflict marks
Revision 1.118 2003/06/03 13:01:59 daniel
* Register allocator finished
Revision 1.117 2003/06/02 21:42:05 jonas
* function results can now also be regvars
- removed tprocinfo.return_offset, never use it again since it's invalid
if the result is a regvar
Revision 1.116 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.115 2003/05/31 20:28:17 jonas
* changed copyvalueparas so it also supports register parameters
(except for copy_value_openarray, but that one is seriously broken
anyway, since it expects that the high parameter will always be in
memory right after the pointer to the array, while it could just as
will be in a register)
Revision 1.114 2003/05/31 15:05:28 peter
* FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
Revision 1.113 2003/05/31 00:48:15 jonas
* fixed my previous commit
Revision 1.112 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)
Revision 1.111 2003/05/30 23:49:18 jonas
* a_load_loc_reg now has an extra size parameter for the destination
register (properly fixes what I worked around in revision 1.106 of
ncgutil.pas)
Revision 1.110 2003/05/30 18:52:10 jonas
* fixed bug with intregvars
* locapara.loc can also be LOC_CFPUREGISTER -> also fixed
rcgppc.a_param_ref, which previously got bogus size values
Revision 1.109 2003/05/27 21:19:08 jonas
* fixed ppc cycle
Revision 1.108 2003/05/27 14:28:14 jonas
* patch from Peter for nested procedures
Revision 1.107 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added
Revision 1.106 2003/05/24 11:59:42 jonas
* fixed integer typeconversion problems
Revision 1.105 2003/05/23 14:27:35 peter
* remove some unit dependencies
* current_procinfo changes to store more info
Revision 1.104 2003/05/15 18:58:53 peter
* removed selfpointer_offset, vmtpointer_offset
* tvarsym.adjusted_address
* address in localsymtable is now in the real direction
* removed some obsolete globals
Revision 1.103 2003/05/14 19:37:25 jonas
* patch from Peter for int64 function results
Revision 1.102 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.101 2003/05/13 15:16:13 peter
* removed ret_in_acc, it's the reverse of ret_in_param
* fixed ret_in_param for win32 cdecl array
Revision 1.100 2003/05/12 08:08:27 jonas
* fixed several initialization and finalization related bugs (missing
tg.direction's, wrong paralocation for decreasing refcount of
everything but ansistrings)
Revision 1.99 2003/05/11 21:37:03 peter
* moved implicit exception frame from ncgutil to psub
* constructor/destructor helpers moved from cobj/ncgutil to psub
Revision 1.98 2003/05/11 14:45:12 peter
* tloadnode does not support objectsymtable,withsymtable anymore
* withnode cleanup
* direct with rewritten to use temprefnode
Revision 1.97 2003/05/10 13:20:23 jonas
* moved storing of register parameters to memory even earlier in the
entry code to fix problems with constructors
Revision 1.96 2003/05/09 17:47:02 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn
Revision 1.95 2003/04/29 07:28:52 michael
+ Patch from peter to fix wrong pushing of ansistring function results in open array
Revision 1.94 2003/04/28 21:17:38 peter
* do not finalize function results
Revision 1.93 2003/04/27 16:30:34 jonas
* store register para's to memory before copying the valuepara's, because
that one requires them to be there already (and it calls subroutines ->
could overwrite those registers)
Revision 1.92 2003/04/27 11:21:33 peter
* aktprocdef renamed to current_procinfo.procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be
cleaned up properly
* gen_main_procsym changed to create_main_proc and release_main_proc
to also generate a tprocinfo structure
* fixed unit implicit initfinal
Revision 1.91 2003/04/27 07:29:50 peter
* current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing
a new procdef declaration
* aktprocsym removed
* lexlevel removed, use symtable.symtablelevel instead
* implicit init/final code uses the normal genentry/genexit
* funcret state checking updated for new funcret handling
Revision 1.90 2003/04/26 17:21:08 florian
* fixed passing of fpu values by fpu register
Revision 1.89 2003/04/25 20:59:33 peter
* removed funcretn,funcretsym, function result is now in varsym
and aliases for result and function name are added using absolutesym
* vs_hidden parameter for funcret passed in parameter
* vs_hidden fixes
* writenode changed to printnode and released from extdebug
* -vp option added to generate a tree.log with the nodetree
* nicer printnode for statements, callnode
Revision 1.88 2003/04/23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.87 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.86 2003/04/22 13:47:08 peter
* fixed C style array of const
* fixed C array passing
* fixed left to right with high parameters
Revision 1.85 2003/04/22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.84 2003/04/16 09:26:55 jonas
* assembler procedures now again get a stackframe if they have local
variables. No space is reserved for a function result however.
Also, the register parameters aren't automatically saved on the stack
anymore in assembler procedures.
Revision 1.83 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.82 2003/03/30 20:59:07 peter
* fix classmethod from classmethod call
* move BeforeDestruction/AfterConstruction calls to
genentrycode/genexitcode instead of generating them on the fly
after a call to a constructor
Revision 1.81 2003/03/28 19:16:56 peter
* generic constructor working for i386
* remove fixed self register
* esi added as address register for i386
Revision 1.80 2003/03/17 15:52:20 peter
* fix range error
Revision 1.79 2003/03/11 21:46:24 jonas
* lots of new regallocator fixes, both in generic and ppc-specific code
(ppc compiler still can't compile the linux system unit though)
Revision 1.78 2003/02/26 21:15:43 daniel
* Fixed the optimizer
Revision 1.77 2003/02/19 22:00:14 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed
Revision 1.76 2003/02/15 22:17:38 carl
* bugfix of FPU emulation code
Revision 1.75 2003/01/09 22:00:53 florian
* fixed some PowerPC issues
Revision 1.74 2003/01/09 20:41:10 florian
* fixed broken PowerPC compiler
Revision 1.73 2003/01/08 18:43:56 daniel
* Tregister changed into a record
Revision 1.72 2002/12/29 23:51:43 florian
* web bug 2214 fixed: ie 10 in const array constructors
Revision 1.71 2002/12/24 15:56:50 peter
* stackpointer_alloc added for adjusting ESP. Win32 needs
this for the pageprotection
Revision 1.70 2002/12/05 14:39:21 florian
* added missing then, Carl did you really a make fullcycle :) ?
Revision 1.69 2002/12/03 22:13:39 carl
* bugfix of problems with profile code which clobbers some registers
Revision 1.68 2002/12/01 22:06:59 carl
* warning of portabilitiy problems with parasize / localsize
Revision 1.67 2002/11/30 18:44:57 carl
+ profiling support for Win32
Revision 1.66 2002/11/30 14:39:15 carl
* try to fix profiling for win32
Revision 1.65 2002/11/28 23:28:14 florian
* push_value_para didn't release floatdef locations, fixes tw2045
Revision 1.64 2002/11/27 02:33:19 peter
* copy_value_on_stack method added for cdecl record passing
Revision 1.63 2002/11/25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.62 2002/11/18 17:31:55 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.61 2002/11/17 17:49:08 mazen
+ return_result_reg and FUNCTION_RESULT_REG are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
Revision 1.60 2002/11/17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.59 2002/11/15 01:58:51 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing
- errors for cdecl and high()
- win32 import stabs
- win32 records<=8 are returned in eax:edx (turned off by default)
- heaptrc update
- more info for temp management in .s file with EXTDEBUG
Revision 1.58 2002/11/10 19:07:45 mazen
* SPARC calling mechanism almost OK (as in GCC./mppcsparc )
Revision 1.57 2002/11/03 20:22:40 mazen
* parameter handling updated
Revision 1.56 2002/10/16 19:01:43 peter
+ $IMPLICITEXCEPTIONS switch to turn on/off generation of the
implicit exception frames for procedures with initialized variables
and for constructors. The default is on for compatibility
Revision 1.55 2002/10/14 19:42:33 peter
* only use init tables for threadvars
Revision 1.54 2002/10/06 19:41:30 peter
* Add finalization of typed consts
* Finalization of globals in the main program
Revision 1.53 2002/10/05 15:18:42 carl
* fix heap leaks
Revision 1.52 2002/09/30 07:00:46 florian
* fixes to common code to get the alpha compiler compiled applied
Revision 1.51 2002/09/22 14:02:35 carl
* stack checking cannot be called before system unit is initialized
* MC68020 define
Revision 1.50 2002/09/17 18:54:03 jonas
* a_load_reg_reg() now has two size parameters: source and dest. This
allows some optimizations on architectures that don't encode the
register size in the register name.
Revision 1.49 2002/09/10 21:48:30 florian
* improved handling of procedures with register calling conventions
Revision 1.48 2002/09/07 15:25:03 peter
* old logs removed and tabs fixed
Revision 1.47 2002/09/02 18:44:48 peter
* fixed (not) pushing of empty parameters
* fixed implicit initialization/finalization generation
* fixed/optimized local copy of value arguments init/final
Revision 1.46 2002/09/01 19:27:34 peter
* use index register when available for generating a reference with
only a signle register. Using the base register could possibly
destroy the framepointer
Revision 1.45 2002/09/01 18:50:20 peter
* fixed maybe_save that did not support a reference with only
a index register. It now also updates the location with the new
base register only
Revision 1.44 2002/09/01 14:42:41 peter
* removevaluepara added to fix the stackpointer so restoring of
saved registers works
Revision 1.43 2002/08/25 19:25:18 peter
* sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be
called separatly. This allows to deref the address calculation
* procedures now calculate the parast addresses after the procedure
directives are parsed. This fixes the cdecl parast problem
* push_addr_param has an extra argument that specifies if cdecl is used
or not
Revision 1.42 2002/08/24 18:38:26 peter
* really use tt_noreuse for exception frame buffers
Revision 1.41 2002/08/23 16:14:49 peter
* tempgen cleanup
* tt_noreuse temp type added that will be used in genentrycode
Revision 1.40 2002/08/18 10:42:37 florian
* remaining assembler writer bugs fixed, the errors in the
system unit are inline assembler problems
Revision 1.39 2002/08/17 09:23:36 florian
* first part of procinfo rewrite
Revision 1.38 2002/08/16 14:24:57 carl
* issameref() to test if two references are the same (then emit no opcodes)
+ ret_in_reg to replace ret_in_acc
(fix some register allocation bugs at the same time)
+ save_std_register now has an extra parameter which is the
usedinproc registers
Revision 1.37 2002/08/15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.36 2002/08/14 19:25:09 carl
* fix Florian's last commit for m68k compilation
Revision 1.35 2002/08/13 21:40:56 florian
* more fixes for ppc calling conventions
Revision 1.34 2002/08/12 15:08:39 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class
* many many updates for m68k (will soon start to compile)
- removed some ifdef or correct them for correct cpu
Revision 1.33 2002/08/11 14:32:27 peter
* renamed current_library to objectlibrary
Revision 1.32 2002/08/11 13:24:12 peter
* saving of asmsymbols in ppu supported
* asmsymbollist global is removed and moved into a new class
tasmlibrarydata that will hold the info of a .a file which
corresponds with a single module. Added librarydata to tmodule
to keep the library info stored for the module. In the future the
objectfiles will also be stored to the tasmlibrarydata class
* all getlabel/newasmsymbol and friends are moved to the new class
Revision 1.31 2002/08/09 19:16:57 carl
* stack allocation is now done separately (at the end) of genentrycode
so temps. can be allocated before.
* fix generic exception handling
Revision 1.30 2002/08/06 20:55:21 florian
* first part of ppc calling conventions fix
Revision 1.29 2002/08/04 19:09:22 carl
+ added generic exception support (still does not work!)
+ more documentation
Revision 1.28 2002/07/29 21:23:42 florian
* more fixes for the ppc
+ wrappers for the tcnvnode.first_* stuff introduced
}
Reference in New Issue View Git Blame Copy Permalink