fpc/compiler/i386/n386mem.pas
peter 8d0751ff97 * removed some more routines from cga
* moved location_force_reg/mem to ncgutil
  * moved arrayconstructnode secondpass to ncgld
2002-04-19 15:39:34 +00:00

800 lines
31 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate i386 assembler for in memory related 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 n386mem;
{$i defines.inc}
interface
uses
node,nmem,ncgmem;
type
ti386newnode = class(tnewnode)
procedure pass_2;override;
end;
ti386addrnode = class(tcgaddrnode)
procedure pass_2;override;
end;
ti386simplenewdisposenode = class(tsimplenewdisposenode)
procedure pass_2;override;
end;
ti386derefnode = class(tcgderefnode)
procedure pass_2;override;
end;
ti386vecnode = class(tvecnode)
procedure pass_2;override;
end;
implementation
uses
{$ifdef delphi}
sysutils,
{$endif}
globtype,systems,
cutils,verbose,globals,
symconst,symtype,symdef,symsym,symtable,aasm,types,
cginfo,cgbase,pass_2,
pass_1,nld,ncon,nadd,
cpubase,
cgobj,cga,tgobj,rgobj,ncgutil,n386util;
{*****************************************************************************
TI386NEWNODE
*****************************************************************************}
procedure ti386newnode.pass_2;
var
pushed : tpushedsaved;
regstopush: tregisterset;
href : treference;
begin
if assigned(left) then
begin
secondpass(left);
location_copy(location,left.location);
end
else
begin
location_reset(location,LOC_REFERENCE,OS_ADDR);
regstopush := all_registers;
remove_non_regvars_from_loc(location,regstopush);
rg.saveusedregisters(exprasmlist,pushed,regstopush);
tg.gettempofsizereference(exprasmlist,pointer_size,location.reference);
{ determines the size of the mem block }
push_int(tpointerdef(resulttype.def).pointertype.def.size);
emit_push_lea_loc(location,false);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_GETMEM');
if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
{ push pointer we just allocated, we need to initialize the
data located at that pointer not the pointer self (PFV) }
cg.a_param_loc(exprasmlist,location,1);
emitcall('FPC_INITIALIZE');
end;
rg.restoreusedregisters(exprasmlist,pushed);
{ may be load ESI }
maybe_loadself;
end;
end;
{*****************************************************************************
TI386ADDRNODE
*****************************************************************************}
procedure ti386addrnode.pass_2;
begin
inherited pass_2;
{ for use of other segments }
if left.location.reference.segment<>R_NO then
location.segment:=left.location.reference.segment;
end;
{*****************************************************************************
TI386SIMPLENEWDISPOSENODE
*****************************************************************************}
procedure ti386simplenewdisposenode.pass_2;
var
regstopush: tregisterset;
pushed : tpushedsaved;
href : treference;
lefttemp: treference;
left_needs_initfinal: boolean;
procedure saveleft;
begin
tg.gettempofsizereference(exprasmlist,pointer_size,lefttemp);
cg.a_load_loc_ref(exprasmlist,left.location,lefttemp);
location_release(exprasmlist,left.location);
end;
begin
secondpass(left);
if codegenerror then
exit;
left_needs_initfinal:=tpointerdef(left.resulttype.def).pointertype.def.needs_inittable;
regstopush := all_registers;
remove_non_regvars_from_loc(left.location,regstopush);
rg.saveusedregisters(exprasmlist,pushed,regstopush);
rg.saveregvars(exprasmlist,all_registers);
{ call the mem handling procedures }
case nodetype of
simpledisposen:
begin
if left_needs_initfinal then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
{ push pointer adress }
cg.a_param_loc(exprasmlist,left.location,1);
{ save left and free its registers }
saveleft;
emitcall('FPC_FINALIZE');
{ push left again as parameter for freemem }
emit_push_mem(lefttemp);
tg.ungetiftemp(exprasmlist,lefttemp);
end
else
begin
cg.a_param_loc(exprasmlist,left.location,1);
location_release(exprasmlist,left.location);
end;
emitcall('FPC_FREEMEM');
end;
simplenewn:
begin
{ determines the size of the mem block }
push_int(tpointerdef(left.resulttype.def).pointertype.def.size);
emit_push_lea_loc(left.location,true);
{ save left and free its registers }
if left_needs_initfinal then
saveleft;
emitcall('FPC_GETMEM');
if left_needs_initfinal then
begin
reference_reset_symbol(href,tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti),0);
emitpushreferenceaddr(href);
emit_push_mem(lefttemp);
tg.ungetiftemp(exprasmlist,lefttemp);
emitcall('FPC_INITIALIZE');
end;
end;
end;
rg.restoreusedregisters(exprasmlist,pushed);
{ may be load ESI }
maybe_loadself;
end;
{*****************************************************************************
TI386DEREFNODE
*****************************************************************************}
procedure ti386derefnode.pass_2;
begin
inherited pass_2;
if tpointerdef(left.resulttype.def).is_far then
location.reference.segment:=R_FS;
if not tpointerdef(left.resulttype.def).is_far and
(cs_gdb_heaptrc in aktglobalswitches) and
(cs_checkpointer in aktglobalswitches) then
begin
emit_reg(
A_PUSH,S_L,location.reference.base);
emitcall('FPC_CHECKPOINTER');
end;
end;
{*****************************************************************************
TI386VECNODE
*****************************************************************************}
procedure ti386vecnode.pass_2;
var
is_pushed : boolean;
function get_mul_size:longint;
begin
if nf_memindex in flags then
get_mul_size:=1
else
begin
if (left.resulttype.def.deftype=arraydef) then
get_mul_size:=tarraydef(left.resulttype.def).elesize
else
get_mul_size:=resulttype.def.size;
end
end;
procedure calc_emit_mul;
var
l1,l2 : longint;
begin
l1:=get_mul_size;
case l1 of
1,2,4,8 : location.reference.scalefactor:=l1;
else
begin
if ispowerof2(l1,l2) then
emit_const_reg(A_SHL,S_L,l2,right.location.register)
else
emit_const_reg(A_IMUL,S_L,l1,right.location.register);
end;
end;
end;
var
extraoffset : longint;
{ rl stores the resulttype.def of the left node, this is necessary }
{ to detect if it is an ansistring }
{ because in constant nodes which constant index }
{ the left tree is removed }
t : tnode;
href : treference;
srsym : tsym;
pushed : tpushedsaved;
hightree : tnode;
isjump : boolean;
otl,ofl : tasmlabel;
newsize : tcgsize;
begin
newsize:=def_cgsize(resulttype.def);
location_reset(location,LOC_REFERENCE,newsize);
secondpass(left);
{ we load the array reference to location }
{ an ansistring needs to be dereferenced }
if is_ansistring(left.resulttype.def) or
is_widestring(left.resulttype.def) then
begin
if nf_callunique in flags then
begin
if left.location.loc<>LOC_REFERENCE then
begin
CGMessage(cg_e_illegal_expression);
exit;
end;
rg.saveusedregisters(exprasmlist,pushed,all_registers);
emitpushreferenceaddr(left.location.reference);
rg.saveregvars(exprasmlist,all_registers);
if is_ansistring(left.resulttype.def) then
emitcall('FPC_ANSISTR_UNIQUE')
else
emitcall('FPC_WIDESTR_UNIQUE');
maybe_loadself;
rg.restoreusedregisters(exprasmlist,pushed);
end;
case left.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
location.reference.base:=left.location.register;
LOC_CREFERENCE,
LOC_REFERENCE :
begin
location_release(exprasmlist,left.location);
location.reference.base:=rg.getregisterint(exprasmlist);
emit_ref_reg(A_MOV,S_L,
left.location.reference,location.reference.base);
end;
else
internalerror(2002032218);
end;
{ check for a zero length string,
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
emit_reg(A_PUSH,S_L,location.reference.base);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_ANSISTR_CHECKZERO');
maybe_loadself;
rg.restoreusedregisters(exprasmlist,pushed);
end;
{ in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
if is_ansistring(left.resulttype.def) then
dec(location.reference.offset)
else
dec(location.reference.offset,2);
{ we've also to keep left up-to-date, because it is used }
{ if a constant array index occurs, subject to change (FK) }
location_copy(left.location,location);
end
else if is_dynamic_array(left.resulttype.def) then
{ ... also a dynamic string }
begin
case left.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
location.reference.base:=left.location.register;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
location_release(exprasmlist,left.location);
location.reference.base:=rg.getregisterint(exprasmlist);
emit_ref_reg(A_MOV,S_L,
left.location.reference,location.reference.base);
end;
else
internalerror(2002032219);
end;
{$warning FIXME}
{ check for a zero length string,
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
emit_reg(A_PUSH,S_L,location.reference.base);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_ANSISTR_CHECKZERO');
maybe_loadself;
rg.restoreusedregisters(exprasmlist,pushed);
end;
{ we've also to keep left up-to-date, because it is used }
{ if a constant array index occurs, subject to change (FK) }
location_copy(left.location,location);
end
else
location_copy(location,left.location);
{ offset can only differ from 0 if arraydef }
if (left.resulttype.def.deftype=arraydef) and
not(is_dynamic_array(left.resulttype.def)) then
dec(location.reference.offset,
get_mul_size*tarraydef(left.resulttype.def).lowrange);
if right.nodetype=ordconstn then
begin
{ offset can only differ from 0 if arraydef }
if (left.resulttype.def.deftype=arraydef) then
begin
if not(is_open_array(left.resulttype.def)) and
not(is_array_of_const(left.resulttype.def)) and
not(is_dynamic_array(left.resulttype.def)) then
begin
if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
(tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
begin
if (cs_check_range in aktlocalswitches) then
CGMessage(parser_e_range_check_error)
else
CGMessage(parser_w_range_check_error);
end;
dec(left.location.reference.offset,
get_mul_size*tarraydef(left.resulttype.def).lowrange);
end
else
begin
{ range checking for open and dynamic arrays !!!! }
{$warning FIXME}
{!!!!!!!!!!!!!!!!!}
end;
end
else if (left.resulttype.def.deftype=stringdef) then
begin
if (tordconstnode(right).value=0) and not(is_shortstring(left.resulttype.def)) then
CGMessage(cg_e_can_access_element_zero);
if (cs_check_range in aktlocalswitches) then
case tstringdef(left.resulttype.def).string_typ of
{ it's the same for ansi- and wide strings }
st_widestring,
st_ansistring:
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
push_int(tordconstnode(right).value);
href:=location.reference;
dec(href.offset,7);
emit_ref(A_PUSH,S_L,href);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_ANSISTR_RANGECHECK');
rg.restoreusedregisters(exprasmlist,pushed);
maybe_loadself;
end;
st_shortstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
st_longstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
end;
end;
inc(left.location.reference.offset,
get_mul_size*tordconstnode(right).value);
if nf_memseg in flags then
left.location.reference.segment:=R_FS;
{
left.resulttype:=resulttype.def;
disposetree(right);
_p:=left;
putnode(p);
p:=_p;
}
location_copy(location,left.location);
end
else
{ not nodetype=ordconstn }
begin
if (cs_regalloc in aktglobalswitches) and
{ if we do range checking, we don't }
{ need that fancy code (it would be }
{ buggy) }
not(cs_check_range in aktlocalswitches) and
(left.resulttype.def.deftype=arraydef) then
begin
extraoffset:=0;
if (right.nodetype=addn) then
begin
if taddnode(right).right.nodetype=ordconstn then
begin
extraoffset:=tordconstnode(taddnode(right).right).value;
t:=taddnode(right).left;
{ First pass processed this with the assumption }
{ that there was an add node which may require an }
{ extra register. Fake it or die with IE10 (JM) }
t.registers32 := taddnode(right).registers32;
taddnode(right).left:=nil;
right.free;
right:=t;
end
else if tordconstnode(taddnode(right).left).nodetype=ordconstn then
begin
extraoffset:=tordconstnode(taddnode(right).left).value;
t:=taddnode(right).right;
t.registers32 := right.registers32;
taddnode(right).right:=nil;
right.free;
right:=t;
end;
end
else if (right.nodetype=subn) then
begin
if taddnode(right).right.nodetype=ordconstn then
begin
{ this was "extraoffset:=right.right.value;" Looks a bit like
copy-paste bug :) (JM) }
extraoffset:=-tordconstnode(taddnode(right).right).value;
t:=taddnode(right).left;
t.registers32 := right.registers32;
taddnode(right).left:=nil;
right.free;
right:=t;
end
{ You also have to negate right.right in this case! I can't add an
unaryminusn without causing a crash, so I've disabled it (JM)
else if right.left.nodetype=ordconstn then
begin
extraoffset:=right.left.value;
t:=right.right;
t^.registers32 := right.registers32;
putnode(right);
putnode(right.left);
right:=t;
end;}
end;
inc(location.reference.offset,
get_mul_size*extraoffset);
end;
{ calculate from left to right }
if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
CGMessage(cg_e_illegal_expression);
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
getlabel(truelabel);
ofl:=falselabel;
getlabel(falselabel);
end;
is_pushed:=maybe_push(right.registers32,self,false);
secondpass(right);
if is_pushed then
restore(self,false);
{ here we change the location of right
and the update was forgotten so it
led to wrong code in emitrangecheck later PM
so make range check before }
if cs_check_range in aktlocalswitches then
begin
if left.resulttype.def.deftype=arraydef then
begin
if is_open_array(left.resulttype.def) or
is_array_of_const(left.resulttype.def) then
begin
tarraydef(left.resulttype.def).genrangecheck;
srsym:=searchsymonlyin(tloadnode(left).symtable,
'high'+tvarsym(tloadnode(left).symtableentry).name);
hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
firstpass(hightree);
secondpass(hightree);
location_release(exprasmlist,hightree.location);
reference_reset_symbol(href,newasmsymbol(tarraydef(left.resulttype.def).getrangecheckstring),4);
cg.a_load_loc_ref(exprasmlist,hightree.location,href);
hightree.free;
hightree:=nil;
end;
cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
end;
end;
location_force_reg(right.location,OS_32,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{ produce possible range check code: }
if cs_check_range in aktlocalswitches then
begin
if left.resulttype.def.deftype=arraydef then
begin
{ done defore (PM) }
end
else if (left.resulttype.def.deftype=stringdef) then
begin
case tstringdef(left.resulttype.def).string_typ of
{ it's the same for ansi- and wide strings }
st_widestring,
st_ansistring:
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
emit_reg(A_PUSH,S_L,right.location.register);
href:=location.reference;
dec(href.offset,7);
emit_ref(A_PUSH,S_L,href);
rg.saveregvars(exprasmlist,all_registers);
emitcall('FPC_ANSISTR_RANGECHECK');
rg.restoreusedregisters(exprasmlist,pushed);
maybe_loadself;
end;
st_shortstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
st_longstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
end;
end;
end;
if location.reference.index=R_NO then
begin
location.reference.index:=right.location.register;
calc_emit_mul;
end
else
begin
if location.reference.base=R_NO then
begin
case location.reference.scalefactor of
2 : emit_const_reg(A_SHL,S_L,1,location.reference.index);
4 : emit_const_reg(A_SHL,S_L,2,location.reference.index);
8 : emit_const_reg(A_SHL,S_L,3,location.reference.index);
end;
calc_emit_mul;
location.reference.base:=location.reference.index;
location.reference.index:=right.location.register;
end
else
begin
emit_ref_reg(A_LEA,S_L,location.reference,location.reference.index);
rg.ungetregisterint(exprasmlist,location.reference.base);
{ the symbol offset is loaded, }
{ so release the symbol name and set symbol }
{ to nil }
location.reference.symbol:=nil;
location.reference.offset:=0;
calc_emit_mul;
location.reference.base:=location.reference.index;
location.reference.index:=right.location.register;
end;
end;
if nf_memseg in flags then
location.reference.segment:=R_FS;
end;
location.size:=newsize;
end;
begin
cnewnode:=ti386newnode;
csimplenewdisposenode:=ti386simplenewdisposenode;
caddrnode:=ti386addrnode;
cderefnode:=ti386derefnode;
cvecnode:=ti386vecnode;
end.
{
$Log$
Revision 1.26 2002-04-19 15:39:35 peter
* removed some more routines from cga
* moved location_force_reg/mem to ncgutil
* moved arrayconstructnode secondpass to ncgld
Revision 1.25 2002/04/15 19:12:09 carl
+ target_info.size_of_pointer -> pointer_size
+ some cleanup of unused types/variables
* move several constants from cpubase to their specific units
(where they are used)
+ att_Reg2str -> gas_reg2str
+ int_reg2str -> std_reg2str
Revision 1.24 2002/04/04 19:06:12 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines
Revision 1.23 2002/04/02 17:11:36 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines
* location_force_reg added for loading a location to a register
of a specified size
* secondassignment parses now first the right and then the left node
(this is compatible with Kylix). This saves a lot of push/pop especially
with string operations
* adapted some routines to use the new cg methods
Revision 1.22 2002/04/01 09:44:04 jonas
* better fix for new/dispose bug with init/final data
Revision 1.21 2002/03/31 20:26:39 jonas
+ a_loadfpu_* and a_loadmm_* methods in tcg
* register allocation is now handled by a class and is mostly processor
independent (+rgobj.pas and i386/rgcpu.pas)
* temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
* some small improvements and fixes to the optimizer
* some register allocation fixes
* some fpuvaroffset fixes in the unary minus node
* push/popusedregisters is now called rg.save/restoreusedregisters and
(for i386) uses temps instead of push/pop's when using -Op3 (that code is
also better optimizable)
* fixed and optimized register saving/restoring for new/dispose nodes
* LOC_FPU locations now also require their "register" field to be set to
R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- list field removed of the tnode class because it's not used currently
and can cause hard-to-find bugs
Revision 1.20 2002/03/04 19:10:14 peter
* removed compiler warnings
Revision 1.19 2001/12/30 17:24:47 jonas
* range checking is now processor independent (part in cgobj,
part in cg64f32) and should work correctly again (it needed
some changes after the changes of the low and high of
tordef's to int64)
* maketojumpbool() is now processor independent (in ncgutil)
* getregister32 is now called getregisterint
Revision 1.18 2001/12/03 21:48:43 peter
* freemem change to value parameter
* torddef low/high range changed to int64
Revision 1.17 2001/09/30 16:17:17 jonas
* made most constant and mem handling processor independent
Revision 1.16 2001/08/30 20:13:57 peter
* rtti/init table updates
* rttisym for reusable global rtti/init info
* support published for interfaces
Revision 1.15 2001/08/26 13:37:00 florian
* some cg reorganisation
* some PPC updates
Revision 1.14 2001/07/08 21:00:18 peter
* various widestring updates, it works now mostly without charset
mapping supported
Revision 1.13 2001/04/18 22:02:03 peter
* registration of targets and assemblers
Revision 1.12 2001/04/13 01:22:19 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.11 2001/04/02 21:20:38 peter
* resulttype rewrite
Revision 1.10 2001/03/11 22:58:52 peter
* getsym redesign, removed the globals srsym,srsymtable
Revision 1.9 2001/02/02 22:38:00 peter
* fixed crash with new(precord), merged
Revision 1.8 2000/12/25 00:07:33 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.7 2000/12/05 11:44:33 jonas
+ new integer regvar handling, should be much more efficient
Revision 1.6 2000/11/29 00:30:48 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.5 2000/11/04 14:25:24 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.4 2000/10/31 22:02:57 peter
* symtable splitted, no real code changes
Revision 1.3 2000/10/31 14:18:53 jonas
* merged double deleting of left location when using a temp in
secondwith (merged from fixes branch). This also fixes web bug1194
Revision 1.2 2000/10/21 18:16:13 florian
* a lot of changes:
- basic dyn. array support
- basic C++ support
- some work for interfaces done
....
Revision 1.1 2000/10/15 09:33:32 peter
* moved n386*.pas to i386/ cpu_target dir
Revision 1.2 2000/10/14 21:52:54 peter
* fixed memory leaks
Revision 1.1 2000/10/14 10:14:49 peter
* moehrendorf oct 2000 rewrite
}