home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / uintp.ads < prev    next >
Text File  |  1996-09-28  |  16KB  |  369 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                                U I N T P                                 --
  6. --                                                                          --
  7. --                                 S p e c                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.33 $                             --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Support for universal integer arithmetic
  27.  
  28. --  WARNING: There is a C version of this package. Any changes to this
  29. --  source file must be properly reflected in the C header file sinfo.h
  30.  
  31. with System; use System;
  32. --  with Ttypes; use Ttypes;
  33. with Types;  use Types;
  34. with Table;
  35. with Unchecked_Conversion;
  36.  
  37. package Uintp is
  38.  
  39.    -------------------------------------------------
  40.    -- Basic Types and Constants for Uintp Package --
  41.    -------------------------------------------------
  42.  
  43.    type Uint is private;
  44.    --  The basic universal integer type
  45.  
  46.    No_Uint : constant Uint;
  47.    --  A constant value indicating a missing or unset Uint value
  48.  
  49.    Uint_0  : constant Uint;
  50.    Uint_1  : constant Uint;
  51.    Uint_2  : constant Uint;
  52.    Uint_3  : constant Uint;
  53.    Uint_4  : constant Uint;
  54.    Uint_5  : constant Uint;
  55.    Uint_6  : constant Uint;
  56.    Uint_7  : constant Uint;
  57.    Uint_8  : constant Uint;
  58.    Uint_9  : constant Uint;
  59.    Uint_10 : constant Uint;
  60.    Uint_16 : constant Uint;
  61.    Uint_32 : constant Uint;
  62.    Uint_63 : constant Uint;
  63.    Uint_64 : constant Uint;
  64.  
  65.    Uint_Minus_1 : constant Uint;
  66.    Uint_Minus_2 : constant Uint;
  67.    Uint_Minus_3 : constant Uint;
  68.    Uint_Minus_4 : constant Uint;
  69.    Uint_Minus_5 : constant Uint;
  70.    Uint_Minus_6 : constant Uint;
  71.    Uint_Minus_7 : constant Uint;
  72.    Uint_Minus_8 : constant Uint;
  73.    Uint_Minus_9 : constant Uint;
  74.  
  75.    -----------------
  76.    -- Subprograms --
  77.    -----------------
  78.  
  79.    procedure Initialize;
  80.    --  Initialize Uint tables. Note that Initialize must not be called if
  81.    --  Tree_Read is used.
  82.  
  83.    procedure Tree_Read;
  84.    --  Initializes internal tables from current tree file using Tree_Read.
  85.    --  Note that Initialize should not be called if Tree_Read is used.
  86.    --  Tree_Read includes all necessary initialization.
  87.  
  88.    procedure Tree_Write;
  89.    --  Writes out internal tables to current tree file using Tree_Write
  90.  
  91.    function UI_Abs (Right : Uint) return Uint;
  92.    --  Returns abs function of universal integer.
  93.  
  94.    function UI_Add (Left : Uint; Right : Uint) return Uint;
  95.    function UI_Add (Left : Int;  Right : Uint) return Uint;
  96.    function UI_Add (Left : Uint; Right : Int)  return Uint;
  97.    --  Returns sum of two integer values.
  98.  
  99.    function UI_Decimal_Digits_Hi (U : Uint) return Nat;
  100.    --  Returns an estimate of the number of decimal digits required to
  101.    --  represent the absolute value of U. This estimate is correct or high,
  102.    --  i.e. it never returns a value that is too low. The accuracy of the
  103.    --  estimate affects only the effectiveness of comparison optimizations
  104.    --  in Urealp.
  105.  
  106.    function UI_Decimal_Digits_Lo (U : Uint) return Nat;
  107.    --  Returns an estimate of the number of decimal digits required to
  108.    --  represent the absolute value of U. This estimate is correct or low,
  109.    --  i.e. it never returns a value that is too high. The accuracy of the
  110.    --  estimate affects only the effectiveness of comparison optimizations
  111.    --  in Urealp.
  112.  
  113.    function UI_Div (Left : Uint; Right : Uint) return Uint;
  114.    function UI_Div (Left : Int;  Right : Uint) return Uint;
  115.    function UI_Div (Left : Uint; Right : Int)  return Uint;
  116.    --  Returns quotient of two integer values. Fatal error if Right = 0
  117.  
  118.    function UI_Eq (Left : Uint; Right : Uint) return Boolean;
  119.    function UI_Eq (Left : Int;  Right : Uint) return Boolean;
  120.    function UI_Eq (Left : Uint; Right : Int)  return Boolean;
  121.    --  Compares integer values for equality.
  122.  
  123.    function UI_Expon (Left : Uint; Right : Uint) return Uint;
  124.    function UI_Expon (Left : Int;  Right : Uint) return Uint;
  125.    function UI_Expon (Left : Uint; Right : Int)  return Uint;
  126.    function UI_Expon (Left : Int;  Right : Int)  return Uint;
  127.    --  Returns result of exponentiating two integer values
  128.    --  Fatal error if Right is negative.
  129.  
  130.    function UI_From_Int (Input : Int) return Uint;
  131.    --  Converts Int value to universal integer form.
  132.  
  133.    function UI_Ge (Left : Uint; Right : Uint) return Boolean;
  134.    function UI_Ge (Left : Int;  Right : Uint) return Boolean;
  135.    function UI_Ge (Left : Uint; Right : Int)  return Boolean;
  136.    --  Compares integer values for greater than or equal.
  137.  
  138.    function UI_Gt (Left : Uint; Right : Uint) return Boolean;
  139.    function UI_Gt (Left : Int;  Right : Uint) return Boolean;
  140.    function UI_Gt (Left : Uint; Right : Int)  return Boolean;
  141.    --  Compares integer values for greater than.
  142.  
  143.    UI_Image_Buffer : String (1 .. 32);
  144.    UI_Image_Length : Natural;
  145.  
  146.    procedure UI_Image (Input : Uint);
  147.    --  Places a representation of Uint, consisting of a possible minus sign,
  148.    --  followed by a string of decimal digits, in UI_Image_Buffer, setting
  149.    --  UI_Image_Length to the number of stored characters. Values longer than
  150.    --  32 characters are output approximately in exponential form.
  151.  
  152.    function UI_Is_In_Int_Range (Input : Uint) return Boolean;
  153.    --  Determines if universal integer is in Int range.
  154.  
  155.    function UI_Le (Left : Uint; Right : Uint) return Boolean;
  156.    function UI_Le (Left : Int;  Right : Uint) return Boolean;
  157.    function UI_Le (Left : Uint; Right : Int)  return Boolean;
  158.    --  Compares integer values for less than or equal.
  159.  
  160.    function UI_Lt (Left : Uint; Right : Uint) return Boolean;
  161.    function UI_Lt (Left : Int;  Right : Uint) return Boolean;
  162.    function UI_Lt (Left : Uint; Right : Int)  return Boolean;
  163.    --  Compares integer values for less than.
  164.  
  165.    function UI_Max (Left : Uint; Right : Uint) return Uint;
  166.    function UI_Max (Left : Int;  Right : Uint) return Uint;
  167.    function UI_Max (Left : Uint; Right : Int)  return Uint;
  168.    --  Returns maximum of two integer values
  169.  
  170.    function UI_Min (Left : Uint; Right : Uint) return Uint;
  171.    function UI_Min (Left : Int;  Right : Uint) return Uint;
  172.    function UI_Min (Left : Uint; Right : Int)  return Uint;
  173.    --  Returns minimum of two integer values
  174.  
  175.    function UI_Mod (Left : Uint; Right : Uint) return Uint;
  176.    function UI_Mod (Left : Int;  Right : Uint) return Uint;
  177.    function UI_Mod (Left : Uint; Right : Int)  return Uint;
  178.    --  Returns mod function of two integer values.
  179.  
  180.    function UI_Mul (Left : Uint; Right : Uint) return Uint;
  181.    function UI_Mul (Left : Int;  Right : Uint) return Uint;
  182.    function UI_Mul (Left : Uint; Right : Int)  return Uint;
  183.    --  Returns product of two integer values
  184.  
  185.    function UI_Ne (Left : Uint; Right : Uint) return Boolean;
  186.    function UI_Ne (Left : Int;  Right : Uint) return Boolean;
  187.    function UI_Ne (Left : Uint; Right : Int)  return Boolean;
  188.    --  Compares integer values for inequality.
  189.  
  190.    function UI_Negate (Right : Uint) return Uint;
  191.    --  Returns negative of universal integer.
  192.  
  193.    function UI_Rem (Left : Uint; Right : Uint) return Uint;
  194.    function UI_Rem (Left : Int;  Right : Uint) return Uint;
  195.    function UI_Rem (Left : Uint; Right : Int)  return Uint;
  196.    --  Returns rem of two integer values.
  197.  
  198.    function UI_Sub (Left : Uint; Right : Uint) return Uint;
  199.    function UI_Sub (Left : Int;  Right : Uint) return Uint;
  200.    function UI_Sub (Left : Uint; Right : Int)  return Uint;
  201.    --  Returns difference of two integer values
  202.  
  203.    function UI_To_Int (Input : Uint) return Int;
  204.    --  Converts universal integer value to Int. Fatal error
  205.    --  if value is not in appropriate range.
  206.  
  207.    procedure UI_Write (Input : Uint);
  208.    --  Writes value of Uint as string of decimal digits, preceded by a
  209.    --  possible minus sign, to the output file.
  210.  
  211.    ------------------------
  212.    -- Operator Renamings --
  213.    ------------------------
  214.  
  215.    function "+" (Left : Uint; Right : Uint) return Uint renames UI_Add;
  216.    function "+" (Left : Int;  Right : Uint) return Uint renames UI_Add;
  217.    function "+" (Left : Uint; Right : Int)  return Uint renames UI_Add;
  218.  
  219.    function "/" (Left : Uint; Right : Uint) return Uint renames UI_Div;
  220.    function "/" (Left : Int;  Right : Uint) return Uint renames UI_Div;
  221.    function "/" (Left : Uint; Right : Int)  return Uint renames UI_Div;
  222.  
  223.    function "*" (Left : Uint; Right : Uint) return Uint renames UI_Mul;
  224.    function "*" (Left : Int;  Right : Uint) return Uint renames UI_Mul;
  225.    function "*" (Left : Uint; Right : Int)  return Uint renames UI_Mul;
  226.  
  227.    function "-" (Left : Uint; Right : Uint) return Uint renames UI_Sub;
  228.    function "-" (Left : Int;  Right : Uint) return Uint renames UI_Sub;
  229.    function "-" (Left : Uint; Right : Int)  return Uint renames UI_Sub;
  230.  
  231.    function "**"  (Left : Uint; Right : Uint) return Uint renames UI_Expon;
  232.    function "**"  (Left : Uint; Right : Int)  return Uint renames UI_Expon;
  233.    function "**"  (Left : Int;  Right : Uint) return Uint renames UI_Expon;
  234.    function "**"  (Left : Int;  Right : Int)  return Uint renames UI_Expon;
  235.  
  236.    function "abs" (Real : Uint) return Uint renames UI_Abs;
  237.  
  238.    function "mod" (Left : Uint; Right : Uint) return Uint renames UI_Mod;
  239.    function "mod" (Left : Int;  Right : Uint) return Uint renames UI_Mod;
  240.    function "mod" (Left : Uint; Right : Int)  return Uint renames UI_Mod;
  241.  
  242.    function "rem" (Left : Uint; Right : Uint) return Uint renames UI_Rem;
  243.    function "rem" (Left : Int;  Right : Uint) return Uint renames UI_Rem;
  244.    function "rem" (Left : Uint; Right : Int)  return Uint renames UI_Rem;
  245.  
  246.    function "-"   (Real : Uint) return Uint renames UI_Negate;
  247.  
  248.    function "="   (Left : Uint; Right : Uint) return Boolean renames UI_Eq;
  249.    function "="   (Left : Int;  Right : Uint) return Boolean renames UI_Eq;
  250.    function "="   (Left : Uint; Right : Int)  return Boolean renames UI_Eq;
  251.  
  252.    function ">="  (Left : Uint; Right : Uint) return Boolean renames UI_Ge;
  253.    function ">="  (Left : Int;  Right : Uint) return Boolean renames UI_Ge;
  254.    function ">="  (Left : Uint; Right : Int)  return Boolean renames UI_Ge;
  255.  
  256.    function ">"   (Left : Uint; Right : Uint) return Boolean renames UI_Gt;
  257.    function ">"   (Left : Int;  Right : Uint) return Boolean renames UI_Gt;
  258.    function ">"   (Left : Uint; Right : Int)  return Boolean renames UI_Gt;
  259.  
  260.    function "<="  (Left : Uint; Right : Uint) return Boolean renames UI_Le;
  261.    function "<="  (Left : Int;  Right : Uint) return Boolean renames UI_Le;
  262.    function "<="  (Left : Uint; Right : Int)  return Boolean renames UI_Le;
  263.  
  264.    function "<"   (Left : Uint; Right : Uint) return Boolean renames UI_Lt;
  265.    function "<"   (Left : Int;  Right : Uint) return Boolean renames UI_Lt;
  266.    function "<"   (Left : Uint; Right : Int)  return Boolean renames UI_Lt;
  267.  
  268.    -----------------------------
  269.    -- Mark/Release Processing --
  270.    -----------------------------
  271.  
  272.    --  The space used by Uint data is not automatically reclaimed. However,
  273.    --  a mark-release regime is implemented which allows storage to be
  274.    --  released back to a previously noted mark. This is used for example
  275.    --  when doing comparisons, where only intermediate results get stored
  276.    --  that do not need to be saved for future use.
  277.  
  278.    type Save_Mark is private;
  279.  
  280.    function Mark return Save_Mark;
  281.    --  Note mark point for future release
  282.  
  283.    procedure Release (M : Save_Mark);
  284.    --  Release storage allocated since mark was noted
  285.  
  286.    -----------------------------------
  287.    -- Representation of Uint Values --
  288.    -----------------------------------
  289.  
  290. private
  291.  
  292.    type Uint is new Int range Uint_Low_Bound .. Uint_High_Bound;
  293.  
  294.    --  Uint values are represented as multiple precision integers stored in
  295.    --  a multi-digit format using Base as the base. This value is chosen so
  296.    --  that the product Base*Base is within the range of allowed Int values.
  297.  
  298.    Base : constant Int := 2 ** 15;
  299.    --  Base is defined to allow the primitive operations (a0, b0, c0)
  300.    --  defined in the section "The Classical Algorithms" (sec. 4.3.1)
  301.    --  of Knuth's "The Art of Computer Programming", Vol. 2. It is these
  302.    --  algorithms that are used in this package.
  303.  
  304.    --  Values in the range -(Base-1)..+(Base-1), i.e. one-digit values,
  305.    --  are encoded directly as Uint values by adding a bias value.
  306.  
  307.    --  The following  values define the bias used to store Uint values which
  308.    --  are in the range -(Base-1)..+(Base-1), as well as the biased values
  309.    --  for the first and last values in this range. We use a new derived type
  310.    --  for these constants to avoid accidental use of Uint arithmetic on
  311.    --  these values, which is never correct.
  312.  
  313.    type Ctrl is new Int;
  314.  
  315.    Uint_Direct_Bias  : constant Ctrl :=
  316.                          Ctrl (Int (Uint_Low_Bound) + Base);
  317.  
  318.    Uint_Direct_First : constant Ctrl :=
  319.                          Ctrl (Int (Uint_Direct_Bias) - (Base - Int (1)));
  320.  
  321.    Uint_Direct_Last  : constant Ctrl :=
  322.                          Ctrl (Int (Uint_Direct_Bias) + (Base - Int (1)));
  323.  
  324.    No_Uint : constant Uint := Uint (Uint_Low_Bound);
  325.  
  326.    Uint_0  : constant Uint := Uint (Uint_Direct_Bias);
  327.    Uint_1  : constant Uint := Uint (Uint_Direct_Bias + 1);
  328.    Uint_2  : constant Uint := Uint (Uint_Direct_Bias + 2);
  329.    Uint_3  : constant Uint := Uint (Uint_Direct_Bias + 3);
  330.    Uint_4  : constant Uint := Uint (Uint_Direct_Bias + 4);
  331.    Uint_5  : constant Uint := Uint (Uint_Direct_Bias + 5);
  332.    Uint_6  : constant Uint := Uint (Uint_Direct_Bias + 6);
  333.    Uint_7  : constant Uint := Uint (Uint_Direct_Bias + 7);
  334.    Uint_8  : constant Uint := Uint (Uint_Direct_Bias + 8);
  335.    Uint_9  : constant Uint := Uint (Uint_Direct_Bias + 9);
  336.    Uint_10 : constant Uint := Uint (Uint_Direct_Bias + 10);
  337.    Uint_16 : constant Uint := Uint (Uint_Direct_Bias + 16);
  338.    Uint_32 : constant Uint := Uint (Uint_Direct_Bias + 32);
  339.    Uint_63 : constant Uint := Uint (Uint_Direct_Bias + 63);
  340.    Uint_64 : constant Uint := Uint (Uint_Direct_Bias + 64);
  341.  
  342.    Uint_Minus_1 : constant Uint := Uint (Uint_Direct_Bias - 1);
  343.    Uint_Minus_2 : constant Uint := Uint (Uint_Direct_Bias - 2);
  344.    Uint_Minus_3 : constant Uint := Uint (Uint_Direct_Bias - 3);
  345.    Uint_Minus_4 : constant Uint := Uint (Uint_Direct_Bias - 4);
  346.    Uint_Minus_5 : constant Uint := Uint (Uint_Direct_Bias - 5);
  347.    Uint_Minus_6 : constant Uint := Uint (Uint_Direct_Bias - 6);
  348.    Uint_Minus_7 : constant Uint := Uint (Uint_Direct_Bias - 7);
  349.    Uint_Minus_8 : constant Uint := Uint (Uint_Direct_Bias - 8);
  350.    Uint_Minus_9 : constant Uint := Uint (Uint_Direct_Bias - 9);
  351.  
  352.    type Save_Mark is record
  353.       Save_Uint   : Uint;
  354.       Save_Udigit : Int;
  355.    end record;
  356.  
  357.    pragma Inline (UI_Abs);
  358.    pragma Inline (UI_Sub);
  359.    pragma Inline (UI_Eq);
  360.    pragma Inline (UI_Ge);
  361.    pragma Inline (UI_Gt);
  362.    pragma Inline (UI_Is_In_Int_Range);
  363.    pragma Inline (UI_Le);
  364.    pragma Inline (UI_Mod);
  365.    pragma Inline (UI_Ne);
  366.    pragma Inline (UI_Negate);
  367.    pragma Inline (UI_Rem);
  368. end Uintp;
  369.