mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 10:11:27 +01:00
59abf2555b
unit so this would conflicts if D6 programms are compiled + Willamette/SSE2 instructions to assembler added
723 lines
26 KiB
ObjectPascal
723 lines
26 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
Member of the Free Pascal development team
|
|
|
|
This unit implements the code generation for 64 bit int
|
|
arithmethics on 32 bit processors
|
|
|
|
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.
|
|
|
|
****************************************************************************
|
|
}
|
|
{# This unit implements the code generation for 64 bit int arithmethics on
|
|
32 bit processors.
|
|
}
|
|
unit cg64f32;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
aasmbase,aasmtai,aasmcpu,
|
|
cpuinfo, cpubase,
|
|
cginfo, cgobj,
|
|
node,symtype;
|
|
|
|
type
|
|
{# Defines all the methods required on 32-bit processors
|
|
to handle 64-bit integers.
|
|
}
|
|
tcg64f32 = class(tcg64)
|
|
procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
|
|
procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
|
|
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
|
|
procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
|
|
procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
|
|
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
|
|
procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
|
|
procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
|
|
procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
|
|
|
|
procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
|
|
procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
|
|
procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
|
|
procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
|
|
procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
|
|
procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
|
|
|
|
procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
|
|
procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
|
|
procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
|
|
procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
|
|
procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
|
|
|
|
procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
|
|
procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
|
|
procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
|
|
procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
|
|
|
|
procedure g_rangecheck64(list: taasmoutput; const p: tnode;
|
|
const todef: tdef); override;
|
|
end;
|
|
|
|
{# Creates a tregister64 record from 2 32 Bit registers. }
|
|
function joinreg64(reglo,reghi : tregister) : tregister64;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,globals,systems,
|
|
cgbase,
|
|
verbose,
|
|
symbase,symconst,symdef,defbase;
|
|
|
|
|
|
function joinreg64(reglo,reghi : tregister) : tregister64;
|
|
begin
|
|
result.reglo:=reglo;
|
|
result.reghi:=reghi;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
|
|
var
|
|
tmpreg: tregister;
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
begin
|
|
tmpreg:=reg.reglo;
|
|
reg.reglo:=reg.reghi;
|
|
reg.reghi:=tmpreg;
|
|
end;
|
|
cg.a_load_reg_ref(list,OS_32,reg.reglo,ref);
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_reg_ref(list,OS_32,reg.reghi,tmpref);
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
|
|
var
|
|
tmpvalue : DWord;
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
swap_qword(value);
|
|
cg.a_load_const_ref(list,OS_32,lo(value),ref);
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
|
|
var
|
|
tmpreg: tregister;
|
|
tmpref: treference;
|
|
got_scratch: boolean;
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
begin
|
|
tmpreg := reg.reglo;
|
|
reg.reglo := reg.reghi;
|
|
reg.reghi := tmpreg;
|
|
end;
|
|
got_scratch:=false;
|
|
tmpref := ref;
|
|
if (tmpref.base=reg.reglo) then
|
|
begin
|
|
tmpreg := cg.get_scratch_reg_int(list);
|
|
got_scratch:=true;
|
|
cg.a_load_reg_reg(list,OS_ADDR,tmpref.base,tmpreg);
|
|
tmpref.base:=tmpreg;
|
|
end
|
|
else
|
|
{ this works only for the i386, thus the i386 needs to override }
|
|
{ this method and this method must be replaced by a more generic }
|
|
{ implementation FK }
|
|
if (tmpref.index=reg.reglo) then
|
|
begin
|
|
tmpreg:=cg.get_scratch_reg_int(list);
|
|
got_scratch:=true;
|
|
cg.a_load_reg_reg(list,OS_ADDR,tmpref.index,tmpreg);
|
|
tmpref.index:=tmpreg;
|
|
end;
|
|
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
|
|
if got_scratch then
|
|
cg.free_scratch_reg(list,tmpreg);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
|
|
|
|
begin
|
|
cg.a_load_reg_reg(list,OS_32,regsrc.reglo,regdst.reglo);
|
|
cg.a_load_reg_reg(list,OS_32,regsrc.reghi,regdst.reghi);
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
|
|
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
swap_qword(value);
|
|
cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
|
|
cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
|
|
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_load64_ref_reg(list,l.reference,reg);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_load64_reg_reg(list,l.register64,reg);
|
|
LOC_CONSTANT :
|
|
a_load64_const_reg(list,l.valueqword,reg);
|
|
else
|
|
internalerror(200112292);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
|
|
begin
|
|
case l.loc of
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_load64_reg_ref(list,l.reg64,ref);
|
|
LOC_CONSTANT :
|
|
a_load64_const_ref(list,l.valueqword,ref);
|
|
else
|
|
internalerror(200203288);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
|
|
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_load64_const_ref(list,value,l.reference);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_load64_const_reg(list,value,l.reg64);
|
|
else
|
|
internalerror(200112293);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
|
|
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_load64_reg_ref(list,reg,l.reference);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_load64_reg_reg(list,reg,l.register64);
|
|
else
|
|
internalerror(200112293);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
|
|
var
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
cg.a_load_reg_ref(list,OS_32,reg,ref)
|
|
else
|
|
begin
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_reg_ref(list,OS_32,reg,tmpref)
|
|
end;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
|
|
var
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_little then
|
|
cg.a_load_reg_ref(list,OS_32,reg,ref)
|
|
else
|
|
begin
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_reg_ref(list,OS_32,reg,tmpref)
|
|
end;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
|
|
var
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_big then
|
|
cg.a_load_ref_reg(list,OS_32,ref,reg)
|
|
else
|
|
begin
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_ref_reg(list,OS_32,tmpref,reg)
|
|
end;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
|
|
var
|
|
tmpref: treference;
|
|
begin
|
|
if target_info.endian = endian_little then
|
|
cg.a_load_ref_reg(list,OS_32,ref,reg)
|
|
else
|
|
begin
|
|
tmpref := ref;
|
|
inc(tmpref.offset,4);
|
|
cg.a_load_ref_reg(list,OS_32,tmpref,reg)
|
|
end;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE :
|
|
a_load64low_ref_reg(list,l.reference,reg);
|
|
LOC_REGISTER :
|
|
cg.a_load_reg_reg(list,OS_32,l.registerlow,reg);
|
|
LOC_CONSTANT :
|
|
cg.a_load_const_reg(list,OS_32,l.valuelow,reg);
|
|
else
|
|
internalerror(200203244);
|
|
end;
|
|
end;
|
|
|
|
procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE,
|
|
LOC_CREFERENCE :
|
|
a_load64high_ref_reg(list,l.reference,reg);
|
|
LOC_REGISTER :
|
|
cg.a_load_reg_reg(list,OS_32,l.registerhigh,reg);
|
|
LOC_CONSTANT :
|
|
cg.a_load_const_reg(list,OS_32,l.valuehigh,reg);
|
|
else
|
|
internalerror(200203244);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_op64_const_ref(list,op,value,l.reference);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_op64_const_reg(list,op,value,l.register64);
|
|
else
|
|
internalerror(200203292);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_op64_reg_ref(list,op,reg,l.reference);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_op64_reg_reg(list,op,reg,l.register64);
|
|
else
|
|
internalerror(2002032422);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
|
|
begin
|
|
case l.loc of
|
|
LOC_REFERENCE, LOC_CREFERENCE:
|
|
a_op64_ref_reg(list,op,l.reference,reg);
|
|
LOC_REGISTER,LOC_CREGISTER:
|
|
a_op64_reg_reg(list,op,l.register64,reg);
|
|
LOC_CONSTANT :
|
|
a_op64_const_reg(list,op,l.valueqword,reg);
|
|
else
|
|
internalerror(200203242);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
|
|
var
|
|
tempreg: tregister64;
|
|
begin
|
|
tempreg.reghi := cg.get_scratch_reg_int(list);
|
|
tempreg.reglo := cg.get_scratch_reg_int(list);
|
|
a_load64_ref_reg(list,ref,tempreg);
|
|
a_op64_reg_reg(list,op,tempreg,reg);
|
|
cg.free_scratch_reg(list,tempreg.reglo);
|
|
cg.free_scratch_reg(list,tempreg.reghi);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
|
|
var
|
|
tempreg: tregister64;
|
|
begin
|
|
tempreg.reghi := cg.get_scratch_reg_int(list);
|
|
tempreg.reglo := cg.get_scratch_reg_int(list);
|
|
a_load64_ref_reg(list,ref,tempreg);
|
|
a_op64_const_reg(list,op,value,tempreg);
|
|
a_load64_reg_ref(list,tempreg,ref);
|
|
cg.free_scratch_reg(list,tempreg.reglo);
|
|
cg.free_scratch_reg(list,tempreg.reghi);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
|
|
begin
|
|
{$warning FIX ME}
|
|
cg.a_param_reg(list,OS_32,reg.reghi,locpara);
|
|
{ the nr+1 needs definitivly a fix FK }
|
|
{ maybe the parameter numbering needs }
|
|
{ to take care of this on 32 Bit }
|
|
{ systems FK }
|
|
cg.a_param_reg(list,OS_32,reg.reglo,locpara);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
|
|
begin
|
|
{$warning FIX ME}
|
|
if target_info.endian = endian_big then
|
|
swap_qword(value);
|
|
cg.a_param_const(list,OS_32,hi(value),locpara);
|
|
{ the nr+1 needs definitivly a fix FK }
|
|
{ maybe the parameter numbering needs }
|
|
{ to take care of this on 32 Bit }
|
|
{ systems FK }
|
|
cg.a_param_const(list,OS_32,lo(value),locpara);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
|
|
var
|
|
tmpref: treference;
|
|
begin
|
|
{$warning FIX ME}
|
|
tmpref := r;
|
|
inc(tmpref.offset,4);
|
|
cg.a_param_ref(list,OS_32,tmpref,locpara);
|
|
{ the nr+1 needs definitivly a fix FK }
|
|
{ maybe the parameter numbering needs }
|
|
{ to take care of this on 32 Bit }
|
|
{ systems FK }
|
|
cg.a_param_ref(list,OS_32,r,locpara);
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
|
|
begin
|
|
{$warning FIX ME}
|
|
case l.loc of
|
|
LOC_REGISTER,
|
|
LOC_CREGISTER :
|
|
a_param64_reg(list,l.register64,locpara);
|
|
LOC_CONSTANT :
|
|
a_param64_const(list,l.valueqword,locpara);
|
|
LOC_CREFERENCE,
|
|
LOC_REFERENCE :
|
|
a_param64_ref(list,l.reference,locpara);
|
|
else
|
|
internalerror(200203287);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcg64f32.g_rangecheck64(list : taasmoutput;const p : tnode;const todef : tdef);
|
|
|
|
var
|
|
neglabel,
|
|
poslabel,
|
|
endlabel: tasmlabel;
|
|
hreg : tregister;
|
|
hdef : torddef;
|
|
fromdef : tdef;
|
|
opsize : tcgsize;
|
|
oldregisterdef: boolean;
|
|
from_signed,to_signed: boolean;
|
|
got_scratch: boolean;
|
|
|
|
begin
|
|
fromdef:=p.resulttype.def;
|
|
from_signed := is_signed(fromdef);
|
|
to_signed := is_signed(todef);
|
|
|
|
if not is_64bitint(todef) then
|
|
begin
|
|
oldregisterdef := registerdef;
|
|
registerdef := false;
|
|
|
|
{ get the high dword in a register }
|
|
if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
begin
|
|
hreg := p.location.registerhigh;
|
|
got_scratch := false
|
|
end
|
|
else
|
|
begin
|
|
hreg := cg.get_scratch_reg_int(list);
|
|
got_scratch := true;
|
|
a_load64high_ref_reg(list,p.location.reference,hreg);
|
|
end;
|
|
getlabel(poslabel);
|
|
|
|
{ check high dword, must be 0 (for positive numbers) }
|
|
cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
|
|
|
|
{ It can also be $ffffffff, but only for negative numbers }
|
|
if from_signed and to_signed then
|
|
begin
|
|
getlabel(neglabel);
|
|
cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
|
|
end;
|
|
{ !!! freeing of register should happen directly after compare! (JM) }
|
|
if got_scratch then
|
|
cg.free_scratch_reg(list,hreg);
|
|
{ For all other values we have a range check error }
|
|
cg.a_call_name(list,'FPC_RANGEERROR');
|
|
|
|
{ if the high dword = 0, the low dword can be considered a }
|
|
{ simple cardinal }
|
|
cg.a_label(list,poslabel);
|
|
hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
|
|
{ the real p.resulttype.def is already saved in fromdef }
|
|
p.resulttype.def := hdef;
|
|
{ no use in calling just "g_rangecheck" since that one will }
|
|
{ simply call the inherited method too (JM) }
|
|
cg.g_rangecheck(list,p,todef);
|
|
hdef.free;
|
|
{ restore original resulttype.def }
|
|
p.resulttype.def := todef;
|
|
|
|
if from_signed and to_signed then
|
|
begin
|
|
getlabel(endlabel);
|
|
cg.a_jmp_always(list,endlabel);
|
|
{ if the high dword = $ffffffff, then the low dword (when }
|
|
{ considered as a longint) must be < 0 }
|
|
cg.a_label(list,neglabel);
|
|
if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
begin
|
|
hreg := p.location.registerlow;
|
|
got_scratch := false
|
|
end
|
|
else
|
|
begin
|
|
hreg := cg.get_scratch_reg_int(list);
|
|
got_scratch := true;
|
|
a_load64low_ref_reg(list,p.location.reference,hreg);
|
|
end;
|
|
{ get a new neglabel (JM) }
|
|
getlabel(neglabel);
|
|
cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
|
|
{ !!! freeing of register should happen directly after compare! (JM) }
|
|
if got_scratch then
|
|
cg.free_scratch_reg(list,hreg);
|
|
|
|
cg.a_call_name(list,'FPC_RANGEERROR');
|
|
|
|
{ if we get here, the 64bit value lies between }
|
|
{ longint($80000000) and -1 (JM) }
|
|
cg.a_label(list,neglabel);
|
|
hdef:=torddef.create(s32bit,longint($80000000),-1);
|
|
p.resulttype.def := hdef;
|
|
cg.g_rangecheck(list,p,todef);
|
|
hdef.free;
|
|
cg.a_label(list,endlabel);
|
|
end;
|
|
registerdef := oldregisterdef;
|
|
p.resulttype.def := fromdef;
|
|
{ restore p's resulttype.def }
|
|
end
|
|
else
|
|
{ todef = 64bit int }
|
|
{ no 64bit subranges supported, so only a small check is necessary }
|
|
|
|
{ if both are signed or both are unsigned, no problem! }
|
|
if (from_signed xor to_signed) and
|
|
{ also not if the fromdef is unsigned and < 64bit, since that will }
|
|
{ always fit in a 64bit int (todef is 64bit) }
|
|
(from_signed or
|
|
(torddef(fromdef).typ = u64bit)) then
|
|
begin
|
|
{ in all cases, there is only a problem if the higest bit is set }
|
|
if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
begin
|
|
if is_64bitint(fromdef) then
|
|
begin
|
|
hreg := p.location.registerhigh;
|
|
opsize := OS_32;
|
|
end
|
|
else
|
|
begin
|
|
hreg := p.location.register;
|
|
opsize := def_cgsize(p.resulttype.def);
|
|
end;
|
|
got_scratch := false;
|
|
end
|
|
else
|
|
begin
|
|
hreg := cg.get_scratch_reg_int(list);
|
|
got_scratch := true;
|
|
|
|
opsize := def_cgsize(p.resulttype.def);
|
|
if opsize in [OS_64,OS_S64] then
|
|
a_load64high_ref_reg(list,p.location.reference,hreg)
|
|
else
|
|
cg.a_load_ref_reg(list,opsize,p.location.reference,hreg);
|
|
end;
|
|
getlabel(poslabel);
|
|
cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
|
|
|
|
{ !!! freeing of register should happen directly after compare! (JM) }
|
|
if got_scratch then
|
|
cg.free_scratch_reg(list,hreg);
|
|
cg.a_call_name(list,'FPC_RANGEERROR');
|
|
cg.a_label(list,poslabel);
|
|
end;
|
|
end;
|
|
|
|
(*
|
|
procedure int64f32_assignment_int64_reg(p : passignmentnode);
|
|
|
|
begin
|
|
end;
|
|
|
|
|
|
begin
|
|
p2_assignment:=@int64f32_assignement_int64;
|
|
*)
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.21 2002-07-20 11:57:52 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
|
|
|
|
Revision 1.20 2002/07/12 10:14:26 jonas
|
|
* some big-endian fixes
|
|
|
|
Revision 1.19 2002/07/11 07:23:17 jonas
|
|
+ generic implementations of a_op64_ref_reg() and a_op64_const_ref()
|
|
(only works for processors with >2 scratch registers)
|
|
|
|
Revision 1.18 2002/07/10 11:12:44 jonas
|
|
* fixed a_op64_const_loc()
|
|
|
|
Revision 1.17 2002/07/07 09:52:32 florian
|
|
* powerpc target fixed, very simple units can be compiled
|
|
* some basic stuff for better callparanode handling, far from being finished
|
|
|
|
Revision 1.16 2002/07/01 18:46:21 peter
|
|
* internal linker
|
|
* reorganized aasm layer
|
|
|
|
Revision 1.15 2002/07/01 16:23:52 peter
|
|
* cg64 patch
|
|
* basics for currency
|
|
* asnode updates for class and interface (not finished)
|
|
|
|
Revision 1.14 2002/05/20 13:30:40 carl
|
|
* bugfix of hdisponen (base must be set, not index)
|
|
* more portability fixes
|
|
|
|
Revision 1.13 2002/05/18 13:34:05 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.12 2002/05/16 19:46:35 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.10 2002/05/12 16:53:04 peter
|
|
* moved entry and exitcode to ncgutil and cgobj
|
|
* foreach gets extra argument for passing local data to the
|
|
iterator function
|
|
* -CR checks also class typecasts at runtime by changing them
|
|
into as
|
|
* fixed compiler to cycle with the -CR option
|
|
* fixed stabs with elf writer, finally the global variables can
|
|
be watched
|
|
* removed a lot of routines from cga unit and replaced them by
|
|
calls to cgobj
|
|
* u32bit-s32bit updates for and,or,xor nodes. When one element is
|
|
u32bit then the other is typecasted also to u32bit without giving
|
|
a rangecheck warning/error.
|
|
* fixed pascal calling method with reversing also the high tree in
|
|
the parast, detected by tcalcst3 test
|
|
|
|
Revision 1.9 2002/04/25 20:16:38 peter
|
|
* moved more routines from cga/n386util
|
|
|
|
Revision 1.8 2002/04/21 15:28:51 carl
|
|
* a_jmp_cond -> a_jmp_always
|
|
|
|
Revision 1.7 2002/04/07 13:21:18 carl
|
|
+ more documentation
|
|
|
|
Revision 1.6 2002/04/03 10:41:35 jonas
|
|
+ a_load64_const_loc method
|
|
|
|
Revision 1.5 2002/04/02 17:11:27 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.4 2002/03/04 19:10:11 peter
|
|
* removed compiler warnings
|
|
|
|
Revision 1.3 2002/01/24 12:33:52 jonas
|
|
* adapted ranges of native types to int64 (e.g. high cardinal is no
|
|
longer longint($ffffffff), but just $fffffff in psystem)
|
|
* small additional fix in 64bit rangecheck code generation for 32 bit
|
|
processors
|
|
* adaption of ranges required the matching talgorithm used for selecting
|
|
which overloaded procedure to call to be adapted. It should now always
|
|
select the closest match for ordinal parameters.
|
|
+ inttostr(qword) in sysstr.inc/sysstrh.inc
|
|
+ abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
|
|
fixes were required to be able to add them)
|
|
* is_in_limit() moved from ncal to types unit, should always be used
|
|
instead of direct comparisons of low/high values of orddefs because
|
|
qword is a special case
|
|
|
|
}
|