Browse Source

* 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

Jonas Maebe 21 years ago
parent
commit
2af569745c
5 changed files with 154 additions and 12 deletions
  1. 22 2
      compiler/defcmp.pas
  2. 33 5
      compiler/nadd.pas
  3. 15 1
      compiler/options.pas
  4. 65 3
      rtl/inc/genmath.inc
  5. 19 1
      rtl/inc/mathh.inc

+ 22 - 2
compiler/defcmp.pas

@@ -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
 
 

+ 33 - 5
compiler/nadd.pas

@@ -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
-                (is_currency(right.resulttype.def) or
-                 is_currency(left.resulttype.def)) then
+             if (is_currency(right.resulttype.def) or
+                 is_currency(left.resulttype.def)) and
+                ((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
 
 

+ 15 - 1
compiler/options.pas

@@ -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

+ 65 - 3
rtl/inc/genmath.inc

@@ -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
-          result:=Trunc(d)+1
+         if d >= 0 then
+           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

+ 19 - 1
rtl/inc/mathh.inc

@@ -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