mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 17:29:11 +02:00
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is defined * if currency = orddef, prefer currency -> int64/qword conversion over currency -> float conversions * optimized currency/currency if currency = orddef * TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent precision loss if currency=int64 and bestreal = double
This commit is contained in:
parent
c094978054
commit
2af569745c
@ -387,10 +387,20 @@ implementation
|
|||||||
orddef :
|
orddef :
|
||||||
begin { ordinal to real }
|
begin { ordinal to real }
|
||||||
if is_integer(def_from) or
|
if is_integer(def_from) or
|
||||||
is_currency(def_from) then
|
(is_currency(def_from) and
|
||||||
|
(s64currencytype.def.deftype = floatdef)) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_int_2_real;
|
doconv:=tc_int_2_real;
|
||||||
eq:=te_convert_l1;
|
eq:=te_convert_l1;
|
||||||
|
end
|
||||||
|
else if is_currency(def_from)
|
||||||
|
{ and (s64currencytype.def.deftype = orddef)) } then
|
||||||
|
begin
|
||||||
|
{ prefer conversion to orddef in this case, unless }
|
||||||
|
{ the orddef < currency (then it will get convert l3, }
|
||||||
|
{ and conversion to float is favoured) }
|
||||||
|
doconv:=tc_int_2_real;
|
||||||
|
eq:=te_convert_l2;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
floatdef :
|
floatdef :
|
||||||
@ -1249,7 +1259,17 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.39 2003-12-16 09:41:44 daniel
|
Revision 1.40 2004-01-02 17:19:04 jonas
|
||||||
|
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
|
||||||
|
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is
|
||||||
|
defined
|
||||||
|
* if currency = orddef, prefer currency -> int64/qword conversion over
|
||||||
|
currency -> float conversions
|
||||||
|
* optimized currency/currency if currency = orddef
|
||||||
|
* TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent
|
||||||
|
precision loss if currency=int64 and bestreal = double
|
||||||
|
|
||||||
|
Revision 1.39 2003/12/16 09:41:44 daniel
|
||||||
* Automatic conversion from integer constants to pointer constants is no
|
* Automatic conversion from integer constants to pointer constants is no
|
||||||
longer done except in Delphi mode
|
longer done except in Delphi mode
|
||||||
|
|
||||||
|
@ -195,9 +195,10 @@ implementation
|
|||||||
{ when there is a currency type then use currency, but
|
{ when there is a currency type then use currency, but
|
||||||
only when currency is defined as float }
|
only when currency is defined as float }
|
||||||
else
|
else
|
||||||
if (s64currencytype.def.deftype=floatdef) and
|
if (is_currency(right.resulttype.def) or
|
||||||
(is_currency(right.resulttype.def) or
|
is_currency(left.resulttype.def)) and
|
||||||
is_currency(left.resulttype.def)) then
|
((s64currencytype.def.deftype = floatdef) or
|
||||||
|
(nodetype <> slashn)) then
|
||||||
begin
|
begin
|
||||||
resultrealtype:=s64currencytype;
|
resultrealtype:=s64currencytype;
|
||||||
inserttypeconv(right,resultrealtype);
|
inserttypeconv(right,resultrealtype);
|
||||||
@ -596,7 +597,24 @@ implementation
|
|||||||
{ but an int/int gives real/real! }
|
{ but an int/int gives real/real! }
|
||||||
if nodetype=slashn then
|
if nodetype=slashn then
|
||||||
begin
|
begin
|
||||||
if (left.resulttype.def.deftype <> floatdef) and
|
if is_currency(left.resulttype.def) and
|
||||||
|
is_currency(right.resulttype.def) then
|
||||||
|
{ In case of currency, converting to float means dividing by 10000 }
|
||||||
|
{ However, since this is already a division, both divisions by }
|
||||||
|
{ 10000 are eliminated when we divide the results -> we can skip }
|
||||||
|
{ them. }
|
||||||
|
if s64currencytype.def.deftype = floatdef then
|
||||||
|
begin
|
||||||
|
{ there's no s64comptype or so, how do we avoid the type conversion?
|
||||||
|
left.resulttype := s64comptype;
|
||||||
|
right.resulttype := s64comptype; }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
left.resulttype := cs64bittype;
|
||||||
|
right.resulttype := cs64bittype;
|
||||||
|
end
|
||||||
|
else if (left.resulttype.def.deftype <> floatdef) and
|
||||||
(right.resulttype.def.deftype <> floatdef) then
|
(right.resulttype.def.deftype <> floatdef) then
|
||||||
CGMessage(type_h_use_div_for_int);
|
CGMessage(type_h_use_div_for_int);
|
||||||
inserttypeconv(right,resultrealtype);
|
inserttypeconv(right,resultrealtype);
|
||||||
@ -1886,7 +1904,17 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.104 2003-12-31 20:47:02 jonas
|
Revision 1.105 2004-01-02 17:19:04 jonas
|
||||||
|
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
|
||||||
|
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is
|
||||||
|
defined
|
||||||
|
* if currency = orddef, prefer currency -> int64/qword conversion over
|
||||||
|
currency -> float conversions
|
||||||
|
* optimized currency/currency if currency = orddef
|
||||||
|
* TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent
|
||||||
|
precision loss if currency=int64 and bestreal = double
|
||||||
|
|
||||||
|
Revision 1.104 2003/12/31 20:47:02 jonas
|
||||||
* properly fixed assigned() mess (by handling it separately in ncginl)
|
* properly fixed assigned() mess (by handling it separately in ncginl)
|
||||||
-> all assigned()-related tests in the test suite work again
|
-> all assigned()-related tests in the test suite work again
|
||||||
|
|
||||||
|
@ -1710,6 +1710,7 @@ begin
|
|||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
def_symbol('CPU68K');
|
def_symbol('CPU68K');
|
||||||
def_symbol('CPU32');
|
def_symbol('CPU32');
|
||||||
|
def_symbol('FPC_CURRENCY_IS_INT64');
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef ALPHA}
|
{$ifdef ALPHA}
|
||||||
def_symbol('CPUALPHA');
|
def_symbol('CPUALPHA');
|
||||||
@ -1722,6 +1723,7 @@ begin
|
|||||||
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
||||||
def_symbol('FPC_HAS_TYPE_SINGLE');
|
def_symbol('FPC_HAS_TYPE_SINGLE');
|
||||||
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
|
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
|
||||||
|
def_symbol('FPC_CURRENCY_IS_INT64');
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef iA64}
|
{$ifdef iA64}
|
||||||
def_symbol('CPUIA64');
|
def_symbol('CPUIA64');
|
||||||
@ -1742,6 +1744,7 @@ begin
|
|||||||
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
||||||
def_symbol('FPC_HAS_TYPE_SINGLE');
|
def_symbol('FPC_HAS_TYPE_SINGLE');
|
||||||
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
|
def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
|
||||||
|
def_symbol('FPC_CURRENCY_IS_INT64');
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef vis}
|
{$ifdef vis}
|
||||||
def_symbol('CPUVIS');
|
def_symbol('CPUVIS');
|
||||||
@ -1752,6 +1755,7 @@ begin
|
|||||||
def_symbol('CPU32');
|
def_symbol('CPU32');
|
||||||
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
def_symbol('FPC_HAS_TYPE_DOUBLE');
|
||||||
def_symbol('FPC_HAS_TYPE_SINGLE');
|
def_symbol('FPC_HAS_TYPE_SINGLE');
|
||||||
|
def_symbol('FPC_CURRENCY_IS_INT64');
|
||||||
{$endif arm}
|
{$endif arm}
|
||||||
|
|
||||||
{ get default messagefile }
|
{ get default messagefile }
|
||||||
@ -1989,7 +1993,17 @@ finalization
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.118 2003-12-17 22:50:42 hajny
|
Revision 1.119 2004-01-02 17:19:04 jonas
|
||||||
|
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
|
||||||
|
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is
|
||||||
|
defined
|
||||||
|
* if currency = orddef, prefer currency -> int64/qword conversion over
|
||||||
|
currency -> float conversions
|
||||||
|
* optimized currency/currency if currency = orddef
|
||||||
|
* TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent
|
||||||
|
precision loss if currency=int64 and bestreal = double
|
||||||
|
|
||||||
|
Revision 1.118 2003/12/17 22:50:42 hajny
|
||||||
* fixed incorrect error message
|
* fixed incorrect error message
|
||||||
|
|
||||||
Revision 1.117 2003/12/11 18:15:06 florian
|
Revision 1.117 2003/12/11 18:15:06 florian
|
||||||
|
@ -609,10 +609,13 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
|||||||
fr: Real;
|
fr: Real;
|
||||||
tr: Real;
|
tr: Real;
|
||||||
Begin
|
Begin
|
||||||
fr := Frac(d);
|
fr := abs(Frac(d));
|
||||||
tr := Trunc(d);
|
tr := Trunc(d);
|
||||||
if fr > 0.5 then
|
if fr > 0.5 then
|
||||||
|
if d >= 0 then
|
||||||
result:=Trunc(d)+1
|
result:=Trunc(d)+1
|
||||||
|
else
|
||||||
|
result:=Trunc(d)-1
|
||||||
else
|
else
|
||||||
if fr < 0.5 then
|
if fr < 0.5 then
|
||||||
result:=Trunc(d)
|
result:=Trunc(d)
|
||||||
@ -627,6 +630,55 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
|||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef FPC_CURRENCY_IS_INT64}
|
||||||
|
|
||||||
|
function trunc(c : currency) : int64;
|
||||||
|
type
|
||||||
|
tmyrec = record
|
||||||
|
i: int64;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
result := int64(tmyrec(c)) div 10000
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function trunc(c : comp) : int64;
|
||||||
|
begin
|
||||||
|
result := c
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function round(c : currency) : int64;
|
||||||
|
type
|
||||||
|
tmyrec = record
|
||||||
|
i: int64;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
rem, absrem: longint;
|
||||||
|
begin
|
||||||
|
{ (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
|
||||||
|
result := int64(tmyrec(c)) div 10000;
|
||||||
|
rem := int64(tmyrec(c)) - result * 10000;
|
||||||
|
absrem := abs(rem);
|
||||||
|
if (absrem > 5000) or
|
||||||
|
((absrem = 5000) and
|
||||||
|
(rem > 0)) then
|
||||||
|
if (rem > 0) then
|
||||||
|
inc(result)
|
||||||
|
else
|
||||||
|
dec(result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function round(c : comp) : int64;
|
||||||
|
begin
|
||||||
|
result := c
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif FPC_CURRENCY_IS_INT64}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_LN}
|
{$ifndef FPC_SYSTEM_HAS_LN}
|
||||||
function Ln(d:Real):Real;[internconst:in_const_ln];
|
function Ln(d:Real):Real;[internconst:in_const_ln];
|
||||||
{*****************************************************************}
|
{*****************************************************************}
|
||||||
@ -1112,7 +1164,17 @@ function fpc_int64_to_double(i : int64): double; compilerproc;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.16 2003-12-08 19:44:11 jonas
|
Revision 1.17 2004-01-02 17:19:04 jonas
|
||||||
|
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
|
||||||
|
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is
|
||||||
|
defined
|
||||||
|
* if currency = orddef, prefer currency -> int64/qword conversion over
|
||||||
|
currency -> float conversions
|
||||||
|
* optimized currency/currency if currency = orddef
|
||||||
|
* TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent
|
||||||
|
precision loss if currency=int64 and bestreal = double
|
||||||
|
|
||||||
|
Revision 1.16 2003/12/08 19:44:11 jonas
|
||||||
* use HandleError instead of RunError so exception catching works
|
* use HandleError instead of RunError so exception catching works
|
||||||
|
|
||||||
Revision 1.15 2003/09/03 14:09:37 florian
|
Revision 1.15 2003/09/03 14:09:37 florian
|
||||||
|
@ -41,6 +41,14 @@
|
|||||||
function power(bas,expo : extended) : extended;
|
function power(bas,expo : extended) : extended;
|
||||||
function power(bas,expo : int64) : int64;
|
function power(bas,expo : int64) : int64;
|
||||||
|
|
||||||
|
{$ifdef FPC_CURRENCY_IS_INT64}
|
||||||
|
function trunc(c : currency) : int64;
|
||||||
|
function trunc(c : comp) : int64;
|
||||||
|
function round(c : currency) : int64;
|
||||||
|
function round(c : comp) : int64;
|
||||||
|
{$endif FPC_CURRENCY_IS_INT64}
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
real48 = array[0..5] of byte;
|
real48 = array[0..5] of byte;
|
||||||
|
|
||||||
@ -54,7 +62,17 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.13 2003-01-21 19:36:36 mazen
|
Revision 1.14 2004-01-02 17:19:04 jonas
|
||||||
|
* if currency = int64, FPC_CURRENCY_IS_INT64 is defined
|
||||||
|
+ round and trunc for currency and comp if FPC_CURRENCY_IS_INT64 is
|
||||||
|
defined
|
||||||
|
* if currency = orddef, prefer currency -> int64/qword conversion over
|
||||||
|
currency -> float conversions
|
||||||
|
* optimized currency/currency if currency = orddef
|
||||||
|
* TODO: write FPC_DIV_CURRENCY and FPC_MUL_CURRENCY routines to prevent
|
||||||
|
precision loss if currency=int64 and bestreal = double
|
||||||
|
|
||||||
|
Revision 1.13 2003/01/21 19:36:36 mazen
|
||||||
- fpc_int64_to_double removed as not supported by most cpu targets
|
- fpc_int64_to_double removed as not supported by most cpu targets
|
||||||
|
|
||||||
Revision 1.12 2003/01/20 22:21:36 mazen
|
Revision 1.12 2003/01/20 22:21:36 mazen
|
||||||
|
Loading…
Reference in New Issue
Block a user