mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:29:28 +02:00
+ generic int_to_real type conversion
+ generic unaryminus node
This commit is contained in:
carl
parent
e5895885fe
commit
e212fa90d5
198
compiler/ncgmat.pas
Normal file
198
compiler/ncgmat.pas
Normal file
@ -0,0 +1,198 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2002 by Florian Klaempfl
|
||||
|
||||
Generate generic mathematical 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 ncgmat;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
node,nmat,cpubase,cgbase,cginfo;
|
||||
|
||||
type
|
||||
tcgunaryminusnode = class(tunaryminusnode)
|
||||
procedure pass_2;override;
|
||||
{ This routine is called to change the sign of the
|
||||
floating point value in the floating point
|
||||
register r.
|
||||
|
||||
This routine should be overriden, since
|
||||
the generic version is not optimal at all. The
|
||||
generic version assumes that floating
|
||||
point values are stored in the register
|
||||
in IEEE-754 format.
|
||||
}
|
||||
procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
globtype,systems,
|
||||
cutils,verbose,globals,
|
||||
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
|
||||
pass_1,pass_2,
|
||||
ncon,
|
||||
cpuinfo,
|
||||
tgobj,ncgutil,cgobj,rgobj,rgcpu,cg64f32;
|
||||
|
||||
{*****************************************************************************
|
||||
TCGUNARYMINUSNODE
|
||||
*****************************************************************************}
|
||||
procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tcgsize);
|
||||
var
|
||||
href : treference;
|
||||
hreg : tregister;
|
||||
begin
|
||||
{ get a temporary memory reference to store the floating
|
||||
point value
|
||||
}
|
||||
tg.gettempofsizereference(exprasmlist,tcgsize2size[_size],href);
|
||||
{ store the floating point value in the temporary memory area }
|
||||
cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href);
|
||||
{ only single and double ieee are supported }
|
||||
if _size = OS_F64 then
|
||||
begin
|
||||
{ on little-endian machine the most significant
|
||||
32-bit value is stored at the highest address
|
||||
}
|
||||
if target_info.endian = endian_little then
|
||||
inc(href.offset,4);
|
||||
end
|
||||
else
|
||||
if _size <> OS_F32 then
|
||||
internalerror(20020814);
|
||||
hreg := rg.getregisterint(exprasmlist);
|
||||
{ load value }
|
||||
cg.a_load_ref_reg(exprasmlist,OS_32,href,hreg);
|
||||
{ bitwise complement copied value }
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_32,hreg,hreg);
|
||||
{ sign-bit is bit 31/63 of single/double }
|
||||
cg.a_op_const_reg(exprasmlist,OP_AND,$80000000,hreg);
|
||||
{ or with value in reference memory }
|
||||
cg.a_op_reg_ref(exprasmlist,OP_OR,OS_32,hreg,href);
|
||||
rg.ungetregister(exprasmlist,hreg);
|
||||
{ store the floating point value in the temporary memory area }
|
||||
if _size = OS_F64 then
|
||||
begin
|
||||
{ on little-endian machine the most significant
|
||||
32-bit value is stored at the highest address
|
||||
}
|
||||
if target_info.endian = endian_little then
|
||||
dec(href.offset,4);
|
||||
end;
|
||||
cg.a_loadfpu_ref_reg(exprasmlist,_size,href,r);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgunaryminusnode.pass_2;
|
||||
|
||||
|
||||
begin
|
||||
if is_64bitint(left.resulttype.def) then
|
||||
begin
|
||||
secondpass(left);
|
||||
|
||||
{ load left operator in a register }
|
||||
location_copy(location,left.location);
|
||||
location_force_reg(exprasmlist,location,OS_64,false);
|
||||
cg64.a_op64_loc_reg(exprasmlist,OP_NEG,
|
||||
location,joinreg64(location.registerlow,location.registerhigh));
|
||||
end
|
||||
else
|
||||
begin
|
||||
secondpass(left);
|
||||
location_reset(location,LOC_REGISTER,OS_INT);
|
||||
case left.location.loc of
|
||||
LOC_REGISTER:
|
||||
begin
|
||||
location.register:=left.location.register;
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
|
||||
location.register);
|
||||
end;
|
||||
LOC_CREGISTER:
|
||||
begin
|
||||
location.register:=rg.getregisterint(exprasmlist);
|
||||
cg.a_load_reg_reg(exprasmlist,OS_INT,left.location.register,
|
||||
location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
|
||||
location.register);
|
||||
end;
|
||||
LOC_REFERENCE,
|
||||
LOC_CREFERENCE:
|
||||
begin
|
||||
reference_release(exprasmlist,left.location.reference);
|
||||
if (left.resulttype.def.deftype=floatdef) then
|
||||
begin
|
||||
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
|
||||
location.register:=rg.getregisterfpu(exprasmlist);
|
||||
cg.a_loadfpu_ref_reg(exprasmlist,
|
||||
def_cgsize(left.resulttype.def),
|
||||
left.location.reference,location.register);
|
||||
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
|
||||
end
|
||||
else
|
||||
begin
|
||||
location.register:=rg.getregisterint(exprasmlist);
|
||||
{ why is the size is OS_INT, since in pass_1 we convert
|
||||
everything to a signed natural value anyways
|
||||
}
|
||||
cg.a_load_ref_reg(exprasmlist,OS_INT,
|
||||
left.location.reference,location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NEG,OS_INT,location.register,
|
||||
location.register);
|
||||
end;
|
||||
end;
|
||||
LOC_FPUREGISTER:
|
||||
begin
|
||||
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
|
||||
location.register:=left.location.register;
|
||||
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
|
||||
end;
|
||||
LOC_CFPUREGISTER:
|
||||
begin
|
||||
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
|
||||
location.register:=rg.getregisterfpu(exprasmlist);
|
||||
cg.a_loadfpu_reg_reg(exprasmlist,left.location.register,location.register);
|
||||
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
|
||||
end;
|
||||
else
|
||||
internalerror(200203225);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
begin
|
||||
cunaryminusnode:=tcgunaryminusnode;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-08-14 19:26:55 carl
|
||||
+ generic int_to_real type conversion
|
||||
+ generic unaryminus node
|
||||
|
||||
}
|
||||
@ -263,10 +263,10 @@ implementation
|
||||
|
||||
procedure do_set(pos : longint);
|
||||
|
||||
{$ifdef oldset}
|
||||
{$ifdef oldset}
|
||||
var
|
||||
mask,l : longint;
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
if (pos and not $ff)<>0 then
|
||||
@ -275,7 +275,7 @@ implementation
|
||||
constsethi:=pos;
|
||||
if pos<constsetlo then
|
||||
constsetlo:=pos;
|
||||
{$ifdef oldset}
|
||||
{$ifdef oldset}
|
||||
{ to do this correctly we use the 32bit array }
|
||||
l:=pos shr 5;
|
||||
mask:=1 shl (pos mod 32);
|
||||
@ -283,9 +283,9 @@ implementation
|
||||
if (pconst32bitset(constset)^[l] and mask)<>0 then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
pconst32bitset(constset)^[l]:=pconst32bitset(constset)^[l] or mask;
|
||||
{$else}
|
||||
include(constset^,pos);
|
||||
{$endif}
|
||||
{$else}
|
||||
include(constset^,pos);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
var
|
||||
@ -295,11 +295,11 @@ implementation
|
||||
begin
|
||||
if p.nodetype<>arrayconstructorn then
|
||||
internalerror(200205105);
|
||||
new(constset);
|
||||
new(constset);
|
||||
{$ifdef oldset}
|
||||
FillChar(constset^,sizeof(constset^),0);
|
||||
{$else}
|
||||
constset^:=[];
|
||||
constset^:=[];
|
||||
{$endif}
|
||||
htype.reset;
|
||||
constsetlo:=0;
|
||||
@ -964,7 +964,7 @@ implementation
|
||||
begin
|
||||
if is_procsym_call(left) then
|
||||
begin
|
||||
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
|
||||
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
|
||||
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
|
||||
currprocdef,tcallnode(left).symtableproc);
|
||||
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
|
||||
@ -1354,28 +1354,47 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.first_int_to_real : tnode;
|
||||
|
||||
function ttypeconvnode.first_int_to_real: tnode;
|
||||
var
|
||||
fname: string[19];
|
||||
typname : string[12];
|
||||
begin
|
||||
first_int_to_real:=nil;
|
||||
{$ifdef m68k}
|
||||
if (cs_fp_emulation in aktmoduleswitches) or
|
||||
(tfloatdef(resulttype.def).typ=s32real) then
|
||||
begin
|
||||
if registers32<1 then
|
||||
registers32:=1;
|
||||
end
|
||||
else
|
||||
if registersfpu<1 then
|
||||
registersfpu:=1;
|
||||
{$else not m68k}
|
||||
if registersfpu<1 then
|
||||
registersfpu:=1;
|
||||
{$endif not m68k}
|
||||
location.loc:=LOC_FPUREGISTER;
|
||||
{ Get the type name }
|
||||
{ Normally the typename should be one of the following:
|
||||
single, double - carl
|
||||
}
|
||||
typname := lower(pbestrealtype^.def.gettypename);
|
||||
{ converting a 64bit integer to a float requires a helper }
|
||||
if is_64bitint(left.resulttype.def) then
|
||||
begin
|
||||
if is_signed(left.resulttype.def) then
|
||||
fname := 'fpc_int64_to_'+typname
|
||||
else
|
||||
fname := 'fpc_qword_to_'+typname;
|
||||
result := ccallnode.createintern(fname,ccallparanode.create(
|
||||
left,nil));
|
||||
left:=nil;
|
||||
firstpass(result);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
{ other integers are supposed to be 32 bit }
|
||||
begin
|
||||
if is_signed(left.resulttype.def) then
|
||||
fname := 'fpc_longint_to_'+typname
|
||||
else
|
||||
fname := 'fpc_cardinal_to_'+typname;
|
||||
result := ccallnode.createintern(fname,ccallparanode.create(
|
||||
left,nil));
|
||||
left:=nil;
|
||||
firstpass(result);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function ttypeconvnode.first_real_to_real : tnode;
|
||||
begin
|
||||
first_real_to_real:=nil;
|
||||
@ -1920,7 +1939,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.68 2002-08-11 16:08:55 florian
|
||||
Revision 1.69 2002-08-14 19:26:55 carl
|
||||
+ generic int_to_real type conversion
|
||||
+ generic unaryminus node
|
||||
|
||||
Revision 1.68 2002/08/11 16:08:55 florian
|
||||
+ support of explicit type case boolean->char
|
||||
|
||||
Revision 1.67 2002/08/11 15:28:00 florian
|
||||
|
||||
@ -59,8 +59,8 @@ interface
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
{$ifdef state_tracking}
|
||||
function track_state_pass(exec_known:boolean):boolean;override;
|
||||
{$endif}
|
||||
function track_state_pass(exec_known:boolean):boolean;override;
|
||||
{$endif}
|
||||
end;
|
||||
tnotnodeclass = class of tnotnode;
|
||||
|
||||
@ -486,7 +486,7 @@ implementation
|
||||
if (left.location.loc<>LOC_REGISTER) and
|
||||
(registersfpu<1) then
|
||||
registersfpu:=1;
|
||||
location.loc:=LOC_REGISTER;
|
||||
location.loc:=LOC_FPUREGISTER;
|
||||
end
|
||||
{$ifdef SUPPORT_MMX}
|
||||
else if (cs_mmx in aktlocalswitches) and
|
||||
@ -519,7 +519,7 @@ implementation
|
||||
****************************************************************************}
|
||||
|
||||
const boolean_reverse:array[ltn..unequaln] of Tnodetype=
|
||||
(gten,gtn,lten,ltn,unequaln,equaln);
|
||||
(gten,gtn,lten,ltn,unequaln,equaln);
|
||||
|
||||
constructor tnotnode.create(expr : tnode);
|
||||
|
||||
@ -541,25 +541,25 @@ implementation
|
||||
|
||||
resulttype:=left.resulttype;
|
||||
|
||||
{Try optmimizing ourself away.}
|
||||
if left.nodetype=notn then
|
||||
begin
|
||||
{Double not. Remove both.}
|
||||
t:=Tnotnode(left).left;
|
||||
Tnotnode(left).left:=nil;
|
||||
left:=t;
|
||||
result:=t;
|
||||
exit;
|
||||
end;
|
||||
if left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten] then
|
||||
begin
|
||||
{Not of boolean expression. Turn around the operator and remove
|
||||
the not.}
|
||||
result:=left;
|
||||
left.nodetype:=boolean_reverse[left.nodetype];
|
||||
left:=nil;
|
||||
exit;
|
||||
end;
|
||||
{Try optmimizing ourself away.}
|
||||
if left.nodetype=notn then
|
||||
begin
|
||||
{Double not. Remove both.}
|
||||
t:=Tnotnode(left).left;
|
||||
Tnotnode(left).left:=nil;
|
||||
left:=t;
|
||||
result:=t;
|
||||
exit;
|
||||
end;
|
||||
if left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten] then
|
||||
begin
|
||||
{Not of boolean expression. Turn around the operator and remove
|
||||
the not.}
|
||||
result:=left;
|
||||
left.nodetype:=boolean_reverse[left.nodetype];
|
||||
left:=nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ constant folding }
|
||||
if (left.nodetype=ordconstn) then
|
||||
@ -701,12 +701,12 @@ implementation
|
||||
function Tnotnode.track_state_pass(exec_known:boolean):boolean;
|
||||
|
||||
begin
|
||||
track_state_pass:=true;
|
||||
if left.track_state_pass(exec_known) then
|
||||
begin
|
||||
left.resulttype.def:=nil;
|
||||
do_resulttypepass(left);
|
||||
end;
|
||||
track_state_pass:=true;
|
||||
if left.track_state_pass(exec_known) then
|
||||
begin
|
||||
left.resulttype.def:=nil;
|
||||
do_resulttypepass(left);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
@ -718,7 +718,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 2002-07-20 11:57:54 florian
|
||||
Revision 1.37 2002-08-14 19:26:55 carl
|
||||
+ generic int_to_real type conversion
|
||||
+ generic unaryminus node
|
||||
|
||||
Revision 1.36 2002/07/20 11:57:54 florian
|
||||
* types.pas renamed to defbase.pas because D6 contains a types
|
||||
unit so this would conflicts if D6 programms are compiled
|
||||
+ Willamette/SSE2 instructions to assembler added
|
||||
|
||||
Loading…
Reference in New Issue
Block a user