mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-26 21:09:26 +02:00
+ tppcvecnode, almost straight copy of the i386 code, can most likely
be made generic if all treference type allow a base, index and offset
This commit is contained in:
Jonas Maebe
parent
04cb71275a
commit
a1a3283c61
443
compiler/powerpc/nppcmem.pas
Normal file
443
compiler/powerpc/nppcmem.pas
Normal file
@ -0,0 +1,443 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2002 by Florian Klaempfl and Jonas Maebe
|
||||
|
||||
Generate PowerPC 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 nppcmem;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
node,nmem,ncgmem;
|
||||
|
||||
type
|
||||
tppcvecnode = class(tcgvecnode)
|
||||
procedure pass_2;override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef delphi}
|
||||
sysutils,
|
||||
{$endif}
|
||||
globtype,systems,
|
||||
cutils,verbose,globals,
|
||||
symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
|
||||
aasmbase,aasmtai,aasmcpu,
|
||||
cginfo,cgbase,pass_2,
|
||||
pass_1,nld,ncon,nadd,
|
||||
cpubase,
|
||||
cgobj,tgobj,rgobj,ncgutil;
|
||||
|
||||
{*****************************************************************************
|
||||
TPPCVECNODE
|
||||
*****************************************************************************}
|
||||
|
||||
procedure tppcvecnode.pass_2;
|
||||
|
||||
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;
|
||||
pushedregs : tmaybesave;
|
||||
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);
|
||||
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
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);
|
||||
cg.a_load_ref_reg(exprasmlist,OS_ADDR,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);
|
||||
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
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.getaddressregister(exprasmlist);
|
||||
cg.a_load_ref_reg(exprasmlist,OS_ADDR,
|
||||
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);
|
||||
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_ANSISTR_CHECKZERO');
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
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
|
||||
{ this should be caught in the resulttypepass! (JM) }
|
||||
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
|
||||
{ this should be caught in the resulttypepass! (JM) }
|
||||
CGMessage(cg_e_can_access_element_zero);
|
||||
|
||||
if (cs_check_range in aktlocalswitches) 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);
|
||||
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
|
||||
href:=location.reference;
|
||||
dec(href.offset,7);
|
||||
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
end;
|
||||
|
||||
st_shortstring:
|
||||
begin
|
||||
{!!!!!!!!!!!!!!!!!}
|
||||
end;
|
||||
|
||||
st_longstring:
|
||||
begin
|
||||
{!!!!!!!!!!!!!!!!!}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
inc(left.location.reference.offset,
|
||||
get_mul_size*tordconstnode(right).value);
|
||||
|
||||
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 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
|
||||
{ should be internalerror! (JM) }
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
isjump:=(right.location.loc=LOC_JUMP);
|
||||
if isjump then
|
||||
begin
|
||||
otl:=truelabel;
|
||||
getlabel(truelabel);
|
||||
ofl:=falselabel;
|
||||
getlabel(falselabel);
|
||||
end;
|
||||
maybe_save(exprasmlist,right.registers32,location,pushedregs);
|
||||
secondpass(right);
|
||||
maybe_restore(exprasmlist,location,pushedregs);
|
||||
{ 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(exprasmlist,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);
|
||||
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(1));
|
||||
href:=location.reference;
|
||||
dec(href.offset,7);
|
||||
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
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;
|
||||
cg.a_op_const_reg(exprasmlist,OP_IMUL,get_mul_size,
|
||||
right.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if location.reference.base=R_NO then
|
||||
{ this wouldn't make sense for the ppc since there are }
|
||||
{ no scalefactors (JM) }
|
||||
internalerror(2002072901)
|
||||
else
|
||||
begin
|
||||
cg.a_loadaddr_ref_reg(exprasmlist,location.reference,
|
||||
location.reference.base);
|
||||
rg.ungetregisterint(exprasmlist,location.reference.index);
|
||||
{ the symbol offset is loaded, }
|
||||
{ so release the symbol name and set symbol }
|
||||
{ to nil }
|
||||
location.reference.symbol:=nil;
|
||||
location.reference.offset:=0;
|
||||
cg.a_op_const_reg(exprasmlist,OP_IMUL,
|
||||
get_mul_size,right.location.register);
|
||||
location.reference.index:=right.location.register;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
location.size:=newsize;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
cvecnode:=tppcvecnode;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-07-29 09:21:30 jonas
|
||||
+ tppcvecnode, almost straight copy of the i386 code, can most likely
|
||||
be made generic if all treference type allow a base, index and offset
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user