Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/math/m36.src

Text File | 1988-05-03 | 238.5 KB | 6,522 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--maebasic.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-------------------------------------------------------------------------------
--                                                                           --
--             Emulation of Machine Arithmetic - a WIS Ada Tool              --
--                                                                           --
--                         Ada Technology Group                              --
--                         SYSCON Corporation                                --
--                         3990 Sherman Street                               --
--                         San Diego, CA. 92110                              --
--                                                                           --
--                        John Long & John Reddan                            --
--                                                                           --
-------------------------------------------------------------------------------

package MAE_BASIC_OPERATIONS is
-------------------------------------------------------------------
-- The emulation packages are currently configured
-- to support Honeywell 36-bit arithmetic.
--
-- The purpose of this package is to provide general machine
-- arithmetic types and functions to support integer and floating
-- point variables.  The underlying arithmetic operations will
-- be performed component-wise.  It is assumed that the system
-- provides for integer operations.

-------------------------------------------------------------------
-- Here are the declarations of the basic constants and variables.
-- Some of these constants reflect the emulation target and the
-- implementation host (and compiler) dependencies.
-- It is possible that changing these constants and variables could
-- improve software performance.  They are the basic elements for
-- building the MAE_INTEGER_TYPE and MAE_FLOAT_TYPE types.
--
   -- number of bits in a component
      NO_COMP_BITS : constant INTEGER := 7;
   -- maximum value of a component
      MAX_COMP_VALUE : constant INTEGER := (2**NO_COMP_BITS)-1;
   -- component base value
      BASE_COMP_VALUE : constant INTEGER := MAX_COMP_VALUE+1;
   -- the values associated with a bit position,
   --  initialized in the body of this package
      BIT_VALUE : array (1 .. NO_COMP_BITS) of INTEGER;
   -- a component, note that the range of a true component is
   -- 0 .. MAX_COMP_VALUE, although intermediate values, obtained
   -- during computations, lie outside the range.
      subtype COMP is INTEGER;
   -- an array of components
      type COMPONENT_ARRAY_TYPE is array (NATURAL range <>) of COMP;
   -- the use of representation specifications could direct the
   --  compiler how to store the array and possibly increase efficiency.
   --  note that the least significant COMP is the first in the
   --  array, and consequently the most significant COMP is the last.
   --
   --  most signif                                     least signif
   --    'last                            . .            'first
   -- --------------  --------------                  --------------
   -- | 1 2 3 .. n |  | 1 2 3 .. n |      . .         | 1 2 3 .. n |
   -- --------------  --------------                  --------------

   -- Identification of the caller
      type CLASSIFICATION is (INTEGER_CLASS, SHORT_FLOAT_CLASS,
                               LONG_FLOAT_CLASS);

   -- Declaration for short comp arrays
      SHORT_NUM_COMPS : constant INTEGER := 6;
      SHORT_NUM_BITS : constant INTEGER := SHORT_NUM_COMPS * NO_COMP_BITS;
      subtype SHORT_COMPONENT_ARRAY is
                 COMPONENT_ARRAY_TYPE (1 .. SHORT_NUM_COMPS);
      SHORT_ZERO_ARRAY : constant SHORT_COMPONENT_ARRAY :=
                    (1 .. SHORT_NUM_COMPS => 0);

      type SHORT_COMP_ARRAY is
         record
            COMPONENT_ARRAY : SHORT_COMPONENT_ARRAY;
            CLASS_OF_ARRAY : CLASSIFICATION;
            BITS_SHIFTED : INTEGER;
         end record;

      INTEGER_COMP_ARRAY : SHORT_COMP_ARRAY :=
                                  (SHORT_ZERO_ARRAY, INTEGER_CLASS, 0);
      SHORT_FLOAT_COMP_ARRAY : SHORT_COMP_ARRAY :=
                                  (SHORT_ZERO_ARRAY, SHORT_FLOAT_CLASS, 0);

   -- The emulated target dependent constants for 36-bit storage
      TARGET_INTEGER_NUM_BITS : constant INTEGER := 35;
      TARGET_SHORT_NUM_BITS : constant INTEGER := 28;

   -- Declaration for long comp arrays
      LONG_NUM_COMPS : constant INTEGER := (2 * SHORT_NUM_COMPS);
      LONG_NUM_BITS : constant INTEGER := LONG_NUM_COMPS * NO_COMP_BITS;
      subtype LONG_COMPONENT_ARRAY is
                 COMPONENT_ARRAY_TYPE (1 .. LONG_NUM_COMPS);
      LONG_ZERO_ARRAY : LONG_COMPONENT_ARRAY :=
                    (1 .. LONG_NUM_COMPS => 0);

      type LONG_COMP_ARRAY is
         record
            COMPONENT_ARRAY : LONG_COMPONENT_ARRAY;
            CLASS_OF_ARRAY : CLASSIFICATION;
            BITS_SHIFTED : INTEGER;
         end record;

      LONG_FLOAT_COMP_ARRAY : LONG_COMP_ARRAY :=
                   (LONG_ZERO_ARRAY, LONG_FLOAT_CLASS, 0);

   -- The emulated target dependent constants for 72-bit storage
      TARGET_LONG_NUM_BITS : constant INTEGER := 64;

   -- Extended array length for LONG multiplication
      subtype EXTRA_COMPONENT_ARRAY is
                 COMPONENT_ARRAY_TYPE  (1 .. LONG_NUM_COMPS*2);
      EXTRA_ZERO_ARRAY : EXTRA_COMPONENT_ARRAY :=
                    (1 .. LONG_NUM_COMPS*2 => 0);

   -- Extended array for spaces filling string arrays
      EMPTY_STRING : STRING (1 .. 40) :=
          "                                        ";

   -- the sign of a number
      subtype SIGN_TYPE is BOOLEAN;
      NEG_SIGN : constant BOOLEAN := FALSE;
      POS_SIGN : constant BOOLEAN := TRUE;
   -- the exponent of a floating type
      subtype EXPONENT_TYPE is INTEGER;
      MIN_EXPONENT_VALUE : constant INTEGER := -128;
      MAX_EXPONENT_VALUE : constant INTEGER := 127;

   -- The follow declarations specify the value of the most
   -- significant component for the digits ONE .. TEN and their
   -- corresponding exponents.  The component values can be thought
   -- of as a binary representation (picture) of the most signif.
   -- comp.  Applying the binary exponent as left shifts, it is
   -- easy to see how the digit is obtained.  This allows
   -- for the length of the array to change without affecting
   -- the code in the higher level packages.
      POINT_FIVE : constant INTEGER := 2**(NO_COMP_BITS-1);
      POINT_FIVE_SIX_TWO_FIVE : constant INTEGER :=
         2**(NO_COMP_BITS-1) + 2**(NO_COMP_BITS-4);
      POINT_SIX_TWO_FIVE : constant INTEGER :=
         2**(NO_COMP_BITS-1) + 2**(NO_COMP_BITS-3);
      POINT_SEVEN_FIVE : constant INTEGER :=
         2**(NO_COMP_BITS-1) + 2**(NO_COMP_BITS-2);
      POINT_EIGHT_SEVEN_FIVE : constant INTEGER :=
         2**(NO_COMP_BITS-1) + 2**(NO_COMP_BITS-2) + 2**(NO_COMP_BITS-3);
      DIGIT_PICTURE : constant array (1 .. 10) of INTEGER :=
         (POINT_FIVE,
          POINT_FIVE,
          POINT_SEVEN_FIVE,
          POINT_FIVE,
          POINT_SIX_TWO_FIVE,
          POINT_SEVEN_FIVE,
          POINT_EIGHT_SEVEN_FIVE,
          POINT_FIVE,
          POINT_FIVE_SIX_TWO_FIVE,
          POINT_SIX_TWO_FIVE);
      DIGIT_BINARY_EXPONENT : constant array (1 .. 10) of INTEGER :=
         (1, 2, 2, 3, 3, 3, 3, 4, 4, 4);


   -- String IO constants
   -- the only base available is base 10
      subtype NUMBER_BASE is INTEGER range 2 .. 16;
      DEFAULT_BASE : constant NUMBER_BASE := 10;
      subtype FIELD is INTEGER range 0 .. INTEGER'last;

   -- a TeleSoft 1.5 restriction that is detected in the package
   -- above this package does not allow
   --   SHORT_DEFAULT_AFT : constant FIELD := SHORT_FLOAT_DIGITS-1;
   --   LONG_DEFAULT_AFT : constant FIELD := LONG_FLOAT_DIGITS-1;
      SHORT_DEFAULT_AFT : constant FIELD := 7;
      LONG_DEFAULT_AFT : constant FIELD := 17;

      SHORT_DEFAULT_EXP : constant FIELD := 3;
      LONG_DEFAULT_EXP : constant FIELD := 3;


   -- predefined attributes
      LOG_2 : constant FLOAT := 0.30103;
      SHORT_FLOAT_DIGITS : constant INTEGER :=
          INTEGER((FLOAT(TARGET_SHORT_NUM_BITS-1)*LOG_2)-0.5);
      LONG_FLOAT_DIGITS : constant INTEGER :=
          INTEGER((FLOAT(TARGET_LONG_NUM_BITS-1)*LOG_2)-0.5);
      -- the next declaration is not exported from MAE, it
      -- is only used in the integer PUT and IMAGE routines
      INTEGER_DIGITS : constant INTEGER :=
          INTEGER((FLOAT(TARGET_INTEGER_NUM_BITS)*LOG_2)+0.5);

      SHORT_FLOAT_EMAX : INTEGER renames MAX_EXPONENT_VALUE;
      LONG_FLOAT_EMAX : INTEGER renames MAX_EXPONENT_VALUE;

      SHORT_FLOAT_MACHINE_EMAX : INTEGER renames MAX_EXPONENT_VALUE;
      LONG_FLOAT_MACHINE_EMAX : INTEGER renames MAX_EXPONENT_VALUE;

      SHORT_FLOAT_MACHINE_EMIN : INTEGER renames MIN_EXPONENT_VALUE;
      LONG_FLOAT_MACHINE_EMIN : INTEGER renames MIN_EXPONENT_VALUE;

      SHORT_FLOAT_MACHINE_MANTISSA : INTEGER
           renames TARGET_SHORT_NUM_BITS;
      LONG_FLOAT_MACHINE_MANTISSA : INTEGER
           renames TARGET_LONG_NUM_BITS;

      SHORT_FLOAT_MACHINE_OVERFLOWS : constant BOOLEAN := TRUE;
      LONG_FLOAT_MACHINE_OVERFLOWS : constant BOOLEAN := TRUE;

      SHORT_FLOAT_MACHINE_RADIX : constant INTEGER := 2;
      LONG_FLOAT_MACHINE_RADIX : constant INTEGER := 2;

      SHORT_FLOAT_MACHINE_ROUNDS : constant BOOLEAN := TRUE;
      LONG_FLOAT_MACHINE_ROUNDS : constant BOOLEAN := TRUE;

      SHORT_FLOAT_SAFE_EMAX : INTEGER renames MAX_EXPONENT_VALUE;
      LONG_FLOAT_SAFE_EMAX : INTEGER renames MAX_EXPONENT_VALUE;


-------------------------------------------------------------------
-- The exception to be raised for all arithmetic and boolean
-- functions defined in this package.
--
   MAE_NUMERIC_ERROR : EXCEPTION renames STANDARD.NUMERIC_ERROR;

-------------------------------------------------------------------
-- Function to determine the number of components for
-- the representation.
--
   function BITS_TO_COMPS (NO_OF_BITS : INTEGER) return INTEGER;

-------------------------------------------------------------------
-- Operations on the sign
--
   -- Since the SIGN_TYPE is a BOOLEAN, most of the operations
   -- are assumed system functions

   function CHANGE_SIGN (SIGN : SIGN_TYPE) return SIGN_TYPE;

-------------------------------------------------------------------
-- Operations on the exponent
--
   -- Since the EXPONENT_TYPE is an INTEGER, the operations
   -- are assumed system functions

-------------------------------------------------------------------
-- Operations on the component
--
   -- If the variable NO_COMP_BITS is chosen properly, an assumption
   -- on which the entire package design is based, COMP and any
   -- result of binary operation (except exponentiation which is
   -- never used with COMP) of two COMPs is an INTEGER.
   -- Therefore, the operations are assumed system functions

-------------------------------------------------------------------
-- Operations on short component arrays
--
   -- Predefined system functions : function "=" and function "/=".
   -- Comparisons are handled under variable-sized arrays.
   -- The array parameters must have the same length and the same
   -- CLASSIFICATION (both INTEGER_CLASS or both SHORT_FLOAT_CLASS).
   -- The returning result component array will contain the same
   -- number of elements.
   -- For SHORT_FLOAT_CLASS parameters, the BITS_SHIFTED variable within
   -- the array is set for higher level exponent operation.
   -- The SHORT_FLOAT_CLASS array will be normalized by these routines.
   -- Note that the least significant COMP is the first in the
   -- array, and consequently the most significant COMP is the last.

   function "+"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY;
   function "-"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY;
   function "*"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY;
   function "/"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY;
   function "rem"  (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY;


-------------------------------------------------------------------
-- Operations on long component arrays
--
   -- Predefined system functions : function "=" and function "/=".
   -- Comparisions are handled under variable-sized arrays.
   -- The array parameters must have the same length.
   -- The returning result component array will contain the same
   -- number of elements.
   -- For LONG_FLOAT_CLASS parameters, the BITS_SHIFTED variable within
   -- the array is set for higher level exponent operation.
   -- The LONG_FLOAT_CLASS array will be normalized by these routines.

   function "+"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY;
   function "-"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY;
   function "*"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY;
   function "/"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY;


-------------------------------------------------------------------
-- Operations on variable-sized component arrays
--
   -- The array parameters are only comprised of components,
   -- no CLASSIFICATION or BITS_SHIFTED info is included.
   -- The array will not be normalized by these routines, that
   -- is the responsibility of a higher level routine.

   -- The comparison functions.
   -- Predefined system functions : function "=" and function "/=".

   function "<"    (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN;
   function "<="   (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN;
   function ">"    (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN;
   function ">="   (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN;

   -- This routine performs a divide by two on the array,
   -- with rounding to even.
   procedure DIVIDE_ARRAY_BY_TWO (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE);

   -- This routine sets the range of all individual COMPs within
   -- (0 .. MAX_COMP_VALUE) by looping through the array from the least
   -- significant COMP to the most significant COMP, performing
   -- carries and borrows as necessary.  Since the most significant
   -- COMP has nowhere to carry or borrow, it is left unbounded.
   -- This allows the higher level routine to determine if shifting
   -- must occur, an error exists, or whatever.
   procedure RANGE_CHECK (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE);

   -- This routine shifts to the right and truncates a
   -- component array.  The BITS variable is the number of bits
   -- to shift the array and must be positive.
   procedure ARRAY_TRUNCATION_SHIFT_RIGHT
      (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE; BITS : in NATURAL);

   -- This routine sets the most significant bit in the array to one
   -- (normalized), by shifting the array to the left.
   -- The BITS variable is the number of bits the array was shifted.
   procedure ARRAY_NORMALIZE
      (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE; BITS : out INTEGER);

-------------------------------------------------------------------
end MAE_BASIC_OPERATIONS;

-------------------------------------------------------------------
-------------------------------------------------------------------

package body MAE_BASIC_OPERATIONS is
-------------------------------------------------------------------
-- The purpose of this package is to provide general
-- arithmetic operations for computation of integer and floating
-- point variables.


-------------------------------------------------------------------
-- Local exceptions
--
   MAE_INTEGER_OVERFLOW : EXCEPTION;
   MAE_DIVIDE_BY_ZERO : EXCEPTION;
   MAE_INVALID_OPERATION : EXCEPTION;
   MAE_IMPOSSIBLE : EXCEPTION;

-------------------------------------------------------------------
-- Function to determine the number of components needed for
-- the representation.
--
   function BITS_TO_COMPS (NO_OF_BITS : NATURAL) return NATURAL is
      -- This routine returns number of components needed in the
      -- array to hold at least all the bits.
   begin
     return (((NO_OF_BITS - 1) / NO_COMP_BITS) + 1);
   end BITS_TO_COMPS;

-------------------------------------------------------------------
-- Operations on the sign
--
   function CHANGE_SIGN (SIGN : SIGN_TYPE) return SIGN_TYPE is
      -- The purpose of this function is to change
      -- the sign.
   begin
      -- Change the sign by using a case on possible values
      case SIGN is
         when POS_SIGN => return NEG_SIGN;
         when NEG_SIGN => return POS_SIGN;
      end case;
   end CHANGE_SIGN;

-------------------------------------------------------------------
-- Operations on component arrays
--
-- For all the operations on two component arrays, the component
-- arrays must have the same number of elements(components) and
-- the returning result component array will contain the same
-- number of elements.
--
   function "<"    (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN is
      -- Compare arrays from the most significant component to the
      -- least significant component until the compare is resolved.
      -- Since this routine is internal to the MAE package, it is
      -- assumed the caller will pass identically sized arrays.
      -- Therefore, there are no error checks.
   begin
      for I in reverse LEFT'first .. LEFT'last loop
          if LEFT(I) < RIGHT(I) then
            return TRUE;
          elsif LEFT(I) > RIGHT(I) then
            return FALSE;
          end if;
      end loop;
      -- The arrays were equal.
      return FALSE;
   end "<";

-----------------------------

   function "<="   (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN is
      -- Compare arrays from the most significant component to the
      -- least significant component until the compare is resolved.
      -- Since this routine is internal to the MAE package, it is
      -- assumed the caller will pass identically sized arrays.
      -- Therefore, there are no error checks.
   begin

      for I in reverse LEFT'first .. LEFT'last loop
          if LEFT(I) < RIGHT(I) then
            return TRUE;
          elsif LEFT(I) > RIGHT(I) then
            return FALSE;
          end if;
      end loop;
      -- The arrays were equal.
      return TRUE;
   end "<=";

-----------------------------

   function ">"    (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN is
      -- Compare arrays from the most significant component to the
      -- least significant component until the compare is resolved.
      -- Since this routine is internal to the MAE package, it is
      -- assumed the caller will pass identically sized arrays.
      -- Therefore, there are no error checks.
   begin

      for I in reverse LEFT'first .. LEFT'last loop
          if LEFT(I) > RIGHT(I) then
            return TRUE;
          elsif LEFT(I) < RIGHT(I) then
            return FALSE;
          end if;
      end loop;
      -- The arrays were equal.
      return FALSE;
   end ">";

-----------------------------

   function ">="   (LEFT, RIGHT : COMPONENT_ARRAY_TYPE) return BOOLEAN is
      -- Compare arrays from the most significant component to the
      -- least significant component until the compare is resolved.
      -- Since this routine is internal to the MAE package, it is
      -- assumed the caller will pass identically sized arrays.
      -- Therefore, there are no error checks.
   begin
      for I in reverse LEFT'first .. LEFT'last loop
          if LEFT(I) > RIGHT(I) then
            return TRUE;
          elsif LEFT(I) < RIGHT(I) then
            return FALSE;
          end if;
      end loop;
      -- The arrays were equal.
      return TRUE;
   end ">=";

-------------------------------------------------------------------
-- This section contains a set of tools to be used by the higher
-- level routines
--

   procedure DIVIDE_ARRAY_BY_TWO(INTERMEDIATE : in out COMPONENT_ARRAY_TYPE) is
      -- The purpose of this procedure is to divide the component
      -- array by two (it is equilvalent to a right shift)
      -- with rounding to even.
      CARRY_DOWN : INTEGER := 0;
      INDEX, TEMP : INTEGER;
      CARRY_VALUE : constant INTEGER := BIT_VALUE(BIT_VALUE'first);
   begin
      -- Loop over the array from the most signif to the least
      -- signif, dividing the individual COMP by two and carrying
      -- down the remainder.
      for I in reverse INTERMEDIATE'first .. INTERMEDIATE'last loop
         TEMP := INTERMEDIATE(I);
         INTERMEDIATE(I) := (TEMP / 2) + (CARRY_DOWN * CARRY_VALUE);
         CARRY_DOWN := TEMP rem 2;
      end loop;

      -- Check for rounding to even.
      -- Since we have shifted only one bit, if the least signif
      -- bit in the array is one, then add the shifted bit back
      -- into the least signif COMP and do a inline RANGE_CHECK.
      if (INTERMEDIATE(INTERMEDIATE'first) rem 2) = 1 then
         INTERMEDIATE(INTERMEDIATE'first) :=
            INTERMEDIATE(INTERMEDIATE'first) + CARRY_DOWN;

         -- Since the maximum value for the carry down was one,
         -- all carries must equal one and remainders must equal zero.
         INDEX := INTERMEDIATE'first;
         while INTERMEDIATE(INDEX) > MAX_COMP_VALUE loop
            -- The comp is oversized, the carry value will be one.
            INTERMEDIATE(INDEX) := 0;
            INDEX := INDEX + 1;
            INTERMEDIATE(INDEX) := INTERMEDIATE(INDEX) + 1;
         end loop;
      end if;

   end DIVIDE_ARRAY_BY_TWO;

-----------------------------

   procedure RANGE_CHECK(INTERMEDIATE : in out COMPONENT_ARRAY_TYPE) is
      -- This routine sets the range of all individual COMPs within
      -- (0 .. MAX_COMP_VALUE) by looping through the array from the least
      -- significant COMP to the most significant COMP, performing
      -- carries and borrows as necessary.  Since the most significant
      -- COMP has nowhere to carry or borrow, it is left unbounded.
      -- This allows the higher level routine to determine if shifting
      -- must occur, an error exists, or whatever.
      CARRY : INTEGER;
   begin
      -- Loop over array from the least to the most signif.
      -- If the COMP is oversized, modulo it to within size
      -- and add the carry to the next higher COMP.
      -- If the COMP is undersized, modulo it to within size
      -- and add the borrow to the next higher COMP.
      for I in INTERMEDIATE'first .. INTERMEDIATE'last-1 loop
         if INTERMEDIATE(I) > MAX_COMP_VALUE then
            -- The comp is oversized, the carry value will be positive.
            CARRY := INTERMEDIATE(I) / BASE_COMP_VALUE;
            INTERMEDIATE(I) := INTERMEDIATE(I) MOD BASE_COMP_VALUE;
            INTERMEDIATE(I+1) := INTERMEDIATE(I+1) + CARRY;
         elsif INTERMEDIATE(I) < 0 then
            -- The comp is negative, the carry value will be negative.
            CARRY := ((INTERMEDIATE(I)+1) / BASE_COMP_VALUE) - 1;
            INTERMEDIATE(I) := INTERMEDIATE(I) MOD BASE_COMP_VALUE;
            INTERMEDIATE(I+1) := INTERMEDIATE(I+1) + CARRY;
         end if;
      end loop;
   end RANGE_CHECK;

-----------------------------

   procedure ARRAY_TRUNCATION_SHIFT_RIGHT
          (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE; BITS : in NATURAL) is
      -- The purpose of this function is a right shift, truncating
      -- any bits shift beyond the array bounds.  First shift across
      -- whole components, then shift bits.
      CARRY_DOWN : INTEGER := 0;
      TEMP : INTEGER;
      WHOLE_COMPS, WHOLE_COMPS_OPPOSITE : INTEGER;
      INNER_BITS, INNER_BITS_OPPOSITE : INTEGER;
      DIVIDER_VALUE, CARRY_VALUE : INTEGER;
   begin
      -- First determine if BITS is greater than the size of
      -- a COMP, if it is then shift whole COMPS.
      WHOLE_COMPS := BITS / NO_COMP_BITS;
      WHOLE_COMPS_OPPOSITE := INTERMEDIATE'last - WHOLE_COMPS;
      if WHOLE_COMPS > 0 then

         -- Shift in the order of least to most signif component
         -- so as not to overwrite any of the number.
         for I in INTERMEDIATE'first .. WHOLE_COMPS_OPPOSITE loop
            INTERMEDIATE(I) := INTERMEDIATE(I+WHOLE_COMPS);
         end loop;

         -- Zero fill the components that are above where the
         -- most signif component was moved.
         for I in WHOLE_COMPS_OPPOSITE+1 .. INTERMEDIATE'last loop
            INTERMEDIATE(I) := 0;
         end loop;
      end if;

      -- Now perform bit shifts within, and across, components.
      INNER_BITS := BITS rem NO_COMP_BITS;
      if INNER_BITS > 0 then
         CARRY_DOWN := 0;

         -- Since shifts across components can occur, a constant
         -- carry down multiplier value, dependent on the bits
         -- shifted, must be determined.
         CARRY_VALUE := BIT_VALUE(INNER_BITS);
         INNER_BITS_OPPOSITE := NO_COMP_BITS - INNER_BITS;
         -- Since shifts across components can occur, a constant
         -- modulo divider value, dependent on the bits
         -- shifted, must be determined.
         DIVIDER_VALUE := BIT_VALUE(INNER_BITS_OPPOSITE);

         -- Shift in the order of most to least signif so as
         -- to add in the carry down.
         for I in reverse INTERMEDIATE'first .. WHOLE_COMPS_OPPOSITE loop
            TEMP := INTERMEDIATE(I);
            INTERMEDIATE(I) := (TEMP / DIVIDER_VALUE)
                                   + (CARRY_DOWN * CARRY_VALUE);
            CARRY_DOWN := TEMP rem DIVIDER_VALUE;
         end loop;
      end if;

   end ARRAY_TRUNCATION_SHIFT_RIGHT;

-----------------------------

   function FIND_MOST_SIGNIF_BIT (MOST_SIGNIF_COMP : COMP) return INTEGER is
      -- The purpose of this function is to return the bit position
      -- of the most signif bit that is on in a COMP, where the
      -- most signif position is one and the least signif is NO_COMP_BITS.
      -- Since this routine is internal to the MAE package, it is
      -- assumed the caller will pass a non-zero COMP.
      -- Therefore, there are no error checks.
      BIT : INTEGER;
   begin
      for I in 1 .. NO_COMP_BITS loop
         BIT := I;
         exit when MOST_SIGNIF_COMP >= BIT_VALUE(BIT);
      end loop;
      return BIT;
   end FIND_MOST_SIGNIF_BIT;

-----------------------------

   procedure ARRAY_NORMALIZE (INTERMEDIATE : in out COMPONENT_ARRAY_TYPE;
                              BITS : out INTEGER) is
      -- The purpose of this function is to normalize a COMPONENT_ARRAY.
      -- First find the most signif comp in the array.  Then shift across
      -- whole comps to place the most signif comp.  Now multiply the
      -- array by a constant that sets the most signif bit.
      -- Returning the number of bits shifted and a normalized
      -- COMPONENT_ARRAY.
      -- Note that the routine does not adjust for oversized
      -- COMPs.  The array should be RANGE_CHECKed and the most
      -- signif component inpected, before passing to this routine.
      MULTIPLIER : INTEGER;
      MSC, MSC_OPPOSITE : INTEGER;
   begin
      BITS := 0;
      -- Check if already normal.
      if INTERMEDIATE(INTERMEDIATE'last) >= BIT_VALUE(BIT_VALUE'first) then
         return;
      end if;

      -- Check for zero, if not zero, then the most signif comp is located.
      MSC := INTERMEDIATE'last;
      while INTERMEDIATE(MSC) = 0 loop
         MSC := MSC - 1;
         if MSC = 0 then
            -- The array is zero.
            return;
         end if;
      end loop;
      MSC_OPPOSITE := INTERMEDIATE'last - MSC;

      -- Shift across array comps if necessary, zeroing the trailing.
      if MSC < INTERMEDIATE'last then
         -- Shift in the order of most to least signif so as not
         -- to overwrite any of the number.
         for J in reverse INTERMEDIATE'first .. MSC loop
            INTERMEDIATE(J+MSC_OPPOSITE) := INTERMEDIATE(J);
         end loop;
         for J in INTERMEDIATE'first .. MSC_OPPOSITE loop
            INTERMEDIATE(J) := 0;
         end loop;
      end if;

      -- Set the most signif bit by finding the highest valued bit
      -- that is on, then multipling the array by a constant that
      -- moves the highest bit into the most signif bit
      -- position in the array.
      BITS := FIND_MOST_SIGNIF_BIT(INTERMEDIATE(INTERMEDIATE'last)) - 1;
      MULTIPLIER := BIT_VALUE(NO_COMP_BITS-BITS);
      if MULTIPLIER > 1 then
         for J in INTERMEDIATE'range loop
            INTERMEDIATE(J) := INTERMEDIATE(J) * MULTIPLIER;
         end loop;
         RANGE_CHECK(INTERMEDIATE);
      end if;

      -- Set the returned value of the number of bits shifted,
      -- which includes whole components and bits shifted.
      BITS := BITS + (MSC_OPPOSITE * NO_COMP_BITS);

    end ARRAY_NORMALIZE;

-------------------------------------------------------------------

   function "+"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY is
      -- The purpose of this function is to add SHORT_COMP_ARRAYs
      -- returning a SHORT_COMP_ARRAY value.
      -- For SHORT_FLOAT_CLASS the array will be normalized and the BITS_SHIFTED
      -- variable will be set to a value corresponding to the number
      -- of bits the result array needed to be shifted to the left to
      -- be normalized.  It is possible for BITS_SHIFTED to equal -1.
      -- For INTEGER_CLASS the array will be checked for overflow.
      RESULT : SHORT_COMP_ARRAY := LEFT;
      C_RESULT : SHORT_COMPONENT_ARRAY := SHORT_ZERO_ARRAY;
      C_LEFT : SHORT_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : SHORT_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
   begin

      -- Check for matching array types
      if LEFT.CLASS_OF_ARRAY /= RIGHT.CLASS_OF_ARRAY then
         raise MAE_INVALID_OPERATION;
      end if;

      -- Loop over the array, adding adjacent components
      for I in C_LEFT'range loop
         C_RESULT(I) := C_LEFT(I) + C_RIGHT(I);
      end loop;
      RANGE_CHECK(C_RESULT);

      case RESULT.CLASS_OF_ARRAY is
         when SHORT_FLOAT_CLASS =>
            -- If the most signif comp is greater than the maximum
            -- value divide the array by two.  This will make the
            -- array normalized since the add operation would only
            -- generate maximum value of (2 * BASE_COMP_VALUE) - 1.
            if C_RESULT(C_RESULT'last) > MAX_COMP_VALUE then
               DIVIDE_ARRAY_BY_TWO(C_RESULT);
               SHIFT_BITS := -1;
            else
               -- Otherwise normalize by calling the routine
               ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            end if;
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when INTEGER_CLASS =>
            -- If the most signif comp is greater than the maximum
            -- value it is an overflow.
            if C_RESULT(C_RESULT'last) > MAX_COMP_VALUE then
               raise MAE_INTEGER_OVERFLOW;
            end if;
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := 0;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "+";

-----------------------------

   function "-"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY is
      -- The purpose of this function is to subtract SHORT_COMP_ARRAYs
      -- returning a SHORT_COMP_ARRAY value.
      -- ASSUME : LEFT >= RIGHT
      RESULT : SHORT_COMP_ARRAY := LEFT;
      C_RESULT : SHORT_COMPONENT_ARRAY := SHORT_ZERO_ARRAY;
      C_LEFT : SHORT_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : SHORT_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
   begin

      if LEFT.CLASS_OF_ARRAY /= RIGHT.CLASS_OF_ARRAY then
         raise MAE_INVALID_OPERATION;
      end if;

      -- validate the assumption left >= right
      if C_LEFT < C_RIGHT then
         raise MAE_INVALID_OPERATION;
      end if;

      -- Loop over the array, subtracting adjacent components
      for I in C_LEFT'range loop
         C_RESULT(I) := C_LEFT(I) - C_RIGHT(I);
      end loop;
      RANGE_CHECK(C_RESULT);

      case RESULT.CLASS_OF_ARRAY is
         when SHORT_FLOAT_CLASS =>
            -- Normalize by calling the routine
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when INTEGER_CLASS =>
            -- Just return the result, since the LEFT >= RIGHT
            -- the result must be zero or positive.
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := 0;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

  exception
     when others =>
        raise MAE_NUMERIC_ERROR;
   end "-";

-----------------------------

   function "*"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY is
      -- The purpose of this function is to multiply SHORT_COMP_ARRAYs
      -- returning a SHORT_COMP_ARRAY value.  This requires much
      -- range checking of the individual COMPs.
      RESULT : SHORT_COMP_ARRAY := LEFT;
      RESULT_LAST : constant INTEGER := SHORT_NUM_COMPS;
      C_RESULT : LONG_COMPONENT_ARRAY := LONG_ZERO_ARRAY;
      C_LEFT : SHORT_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : SHORT_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
      INDEX : INTEGER;
   begin
      -- Do the multiply by looping over the arrays

      -- loop over LEFT array
      for I in C_LEFT'range loop
         -- Zero check
         if C_LEFT(I) /= 0 then
            -- loop over RIGHT array
            for J in C_RIGHT'range loop
               -- Zero check
               if C_RIGHT(J) /= 0 then
                  -- Multiply the two COMPs
                  INDEX := I + J - 1;
                  C_RESULT(INDEX) := C_RESULT(INDEX) + (C_LEFT(I)*C_RIGHT(J));
               end if;
            end loop;
            -- RANGE_CHECK the intermediate result
            RANGE_CHECK(C_RESULT);
         end if;
      end loop;

      RESULT.BITS_SHIFTED := 0;
      case RESULT.CLASS_OF_ARRAY is
         -- Called by an MAE_INTEGER_TYPE
         when INTEGER_CLASS =>
            -- Overflow condition if outside the range of the
            -- input SHORT_COMP_ARRAY.
            for I in RESULT_LAST+1 .. LONG_NUM_COMPS loop
               if C_RESULT(I) /= 0 then
                  raise MAE_INTEGER_OVERFLOW;
               end if;
            end loop;
            RESULT.COMPONENT_ARRAY := C_RESULT(1 .. RESULT_LAST);

         when SHORT_FLOAT_CLASS =>
            -- Normalize the result.
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY :=
               C_RESULT((C_RESULT'last-RESULT_LAST)+1 .. C_RESULT'last);
            -- Check for rounding to even.
            -- Look beyond the array for the rounding bits.
            -- Because the rounding technique is
               -- If round value is (0 <= x < .5), round down (no action)
               -- If least signif bit is on (1,odd)
                  -- then round up if round value is (.5 <= x < 1)
               -- If least signif bit is off (0,even),
                  -- then round up if round value is (.5 < x < 1),
                  -- else round down if round value is (x = .5)

            -- Assume that a round up will occur if round value
            -- is (.5 <= x < 1), then correct if the one case of a
            -- round down occurs.
            if C_RESULT(C_RESULT'last-RESULT_LAST) >=
                                   BIT_VALUE(BIT_VALUE'first) then
               -- the round value is (.5 <= x < 1), assume round up
               RESULT.COMPONENT_ARRAY(1) := RESULT.COMPONENT_ARRAY(1) + 1;
               -- check for the one round down case
               if C_RESULT(C_RESULT'last-RESULT_LAST) =
                                   BIT_VALUE(BIT_VALUE'first) then
                  -- Since we already added 1 to the least signif bit,
                  -- check if the least signif bit is now 1
                  -- (therefore it was zero).
                  if (RESULT.COMPONENT_ARRAY(1) rem 2) = 1 then
                     INDEX := (C_RESULT'last-RESULT_LAST)-1;
                     -- Loop over the remaining components, if they are
                     -- all zero then the round value equaled .5
                     while C_RESULT(INDEX) = 0 loop
                        INDEX := INDEX - 1;
                        if INDEX = 0 then
                           -- assumption incorrect, subtract 1 to correct
                           -- the assumption.
                           RESULT.COMPONENT_ARRAY(1) :=
                                        RESULT.COMPONENT_ARRAY(1) - 1;
                           exit;
                        end if;
                     end loop;
                  end if;
               end if;
               -- Do an inline RANGE_CHECK.
               -- next line should be INDEX := RESULT.COMPONENT_ARRAY'first;
               INDEX := 1;
               while RESULT.COMPONENT_ARRAY(INDEX) > MAX_COMP_VALUE loop
                  -- The comp is oversized, the carry value will be positive.
                  RESULT.COMPONENT_ARRAY(INDEX) := 0;
                  INDEX := INDEX + 1;
                  RESULT.COMPONENT_ARRAY(INDEX) :=
                                  RESULT.COMPONENT_ARRAY(INDEX) + 1;
                  -- If the 'impossible' carry to the most signif bit occurs
                  -- then another normalization must occur
                  if INDEX = RESULT_LAST then
                     if RESULT.COMPONENT_ARRAY(INDEX) > MAX_COMP_VALUE then
                        DIVIDE_ARRAY_BY_TWO(RESULT.COMPONENT_ARRAY);
                        SHIFT_BITS := SHIFT_BITS - 1;
                     end if;
                  end if;
               end loop;
            end if;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
     when others =>
        raise MAE_NUMERIC_ERROR;
   end "*";

-----------------------------

   function "/"    (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY is
      -- The purpose of this function is to divide SHORT_COMP_ARRAYs
      -- returning a SHORT_COMP_ARRAY value.  This requires much
      -- range checking of the individual COMPs.
      RESULT : SHORT_COMP_ARRAY := LEFT;
      C_RESULT : SHORT_COMPONENT_ARRAY := SHORT_ZERO_ARRAY;
      C_LEFT : SHORT_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : SHORT_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
      RESULT_SHIFT_BITS, LEFT_SHIFT_BITS, RIGHT_SHIFT_BITS : INTEGER := 0;
      LEFT_MSC : constant INTEGER := C_LEFT'last;
      R_COUNT : INTEGER;
      INDEX, INDEX_BIT : INTEGER;
   begin
      -- If the divisor is zero, then there is an error
      if C_RIGHT = SHORT_ZERO_ARRAY then
         RESULT.COMPONENT_ARRAY := C_RESULT;
         raise MAE_DIVIDE_BY_ZERO;
      end if;

      -- Initialize variables by normalizing.  This is also done for
      -- INTEGER_CLASS array to allow the same division operation code
      -- for INTEGER_CLASS and SHORT_FLOAT_CLASS.  It works because a
      -- right shift with truncation is done on the array before returning.
      ARRAY_NORMALIZE(C_LEFT, LEFT_SHIFT_BITS);
      ARRAY_NORMALIZE(C_RIGHT, RIGHT_SHIFT_BITS);

      -- Save shifting values to correct result before exiting
      RESULT_SHIFT_BITS := (RIGHT_SHIFT_BITS - LEFT_SHIFT_BITS) + 1;

      -- Make C_RIGHT(RIGHT_MSC) less than the C_LEFT by dividing
      -- C_RIGHT by 2.
      -- To make available the entire C_RESULT array for accuracy
      -- and instead of updating the RIGHT_SHIFT_BITS variable
      -- by one, we will view the shift as a shift of the
      -- LEFT_SHIFT_BITS by 1, since this equivalent and
      -- LEFT_SHIFT_BITS is the changing variable in the loop.
      LEFT_SHIFT_BITS := 1;
      DIVIDE_ARRAY_BY_TWO(C_RIGHT);

      -- This is the main loop for the division algorithm
      -- The loop has three exit points.
      loop
         if RESULT.CLASS_OF_ARRAY = INTEGER_CLASS then
            -- Check if the integer portion of the result
            -- has been determined.
            if LEFT_SHIFT_BITS > RESULT_SHIFT_BITS then
               -- EXIT POINT ONE
                  -- Integer divide has been completed
               exit;
            end if;
         end if;

         R_COUNT := 0;
         -- Loop over array subtracting the divisor from the
         -- remaining dividend.  Since (divisor*4 > dividend),
         -- the R_COUNT variable can be a maximum of 3
         -- (after adding dividend if subtracted too much).
         while C_LEFT(C_LEFT'last) >= C_RIGHT(C_RIGHT'last) loop
            for J in C_LEFT'range loop
              -- subtract RIGHT COMP from LEFT COMP
              C_LEFT(J) := C_LEFT(J) - C_RIGHT(J);
            end loop;
            R_COUNT := R_COUNT + 1;
            RANGE_CHECK(C_LEFT);
         end loop;
         -- May have subtracted too much
         if C_LEFT(C_LEFT'last) < 0 then
            for J in C_LEFT'range loop
              -- add back the last subtraction
              C_LEFT(J) := C_LEFT(J) + C_RIGHT(J);
            end loop;
            R_COUNT := R_COUNT - 1;
            RANGE_CHECK(C_LEFT);
         end if;

         -- Locate the bit position to add the count to
         -- the result array.  Determine which component, INDEX,
         -- and the bit, INDEX_BIT, within that component.
         INDEX := C_RESULT'last - (LEFT_SHIFT_BITS / NO_COMP_BITS);
         INDEX_BIT := (LEFT_SHIFT_BITS rem NO_COMP_BITS) + 1;

         -- If the bit position is still with the array bounds,
         -- then add the value, continue,
         -- else add the value, RANGE_CHECK, exit.
         if INDEX > 0 then
            C_RESULT(INDEX) := C_RESULT(INDEX)+(R_COUNT*BIT_VALUE(INDEX_BIT));
         else
            if (INDEX = 0) then
               if ((INDEX_BIT = 1) and (R_COUNT = 3)) then
                  C_RESULT(C_RESULT'first) := C_RESULT(C_RESULT'first) + 2;
               elsif ((INDEX_BIT = 1) and (R_COUNT = 2)) or
                     ((INDEX_BIT = 2) and (R_COUNT = 3)) then
                  C_RESULT(C_RESULT'first) := C_RESULT(C_RESULT'first) + 1;
               end if;
            end if;
            -- RANGE_CHECK the result.
            RANGE_CHECK(C_RESULT);

            -- EXIT POINT TWO
               -- The dividend has been shifted beyond significance.
            exit;
         end if;

         -- RANGE_CHECK the result.
         RANGE_CHECK(C_RESULT);
         -- NORMALIZE the remaining dividend.
         if C_LEFT = SHORT_ZERO_ARRAY then
            -- EXIT POINT THREE
               -- The dividend has been reduced to zero.
            exit;
         else
            ARRAY_NORMALIZE(C_LEFT, SHIFT_BITS);
            LEFT_SHIFT_BITS := LEFT_SHIFT_BITS + SHIFT_BITS;
         end if;
      end loop;

      case RESULT.CLASS_OF_ARRAY is
         when SHORT_FLOAT_CLASS =>
            -- shift the result back
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS - RESULT_SHIFT_BITS;

         when INTEGER_CLASS =>
            -- if the result is less than one return zero
            if RESULT_SHIFT_BITS < 1 then
               RESULT.COMPONENT_ARRAY := SHORT_ZERO_ARRAY;
            -- else return the integer portion
            elsif RESULT_SHIFT_BITS <= SHORT_NUM_BITS then
               ARRAY_TRUNCATION_SHIFT_RIGHT(C_RESULT,
                              (SHORT_NUM_BITS - RESULT_SHIFT_BITS));
            else
               raise MAE_IMPOSSIBLE;
            end if;
            RESULT.COMPONENT_ARRAY := C_RESULT;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;
   end "/";

-----------------------------

   function "rem"  (LEFT,RIGHT : SHORT_COMP_ARRAY) return SHORT_COMP_ARRAY is
      -- The purpose of this function is to find the remainder
      -- of the LEFT from the RIGHT SHORT_COMP_ARRAY
      -- returning a SHORT_COMP_ARRAY value.
      RESULT : SHORT_COMP_ARRAY;
   begin
      if LEFT.CLASS_OF_ARRAY /= RIGHT.CLASS_OF_ARRAY then
         raise MAE_INVALID_OPERATION;
      end if;

      case LEFT.CLASS_OF_ARRAY is

         when INTEGER_CLASS =>
            -- Apply the definition of the remainder
            RESULT := LEFT - ((LEFT / RIGHT) * RIGHT);

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "rem";

-------------------------------------------------------------------

   function "+"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY is
      -- The purpose of this function is to add LONG_COMP_ARRAYs
      -- returning a LONG_COMP_ARRAY value.
      -- For LONG_FLOAT_CLASS the array will be normalized and the BITS_SHIFTED
      -- variable will be set to a value corresponding to the number
      -- of bits the result array needed to be shifted to the left to
      -- be normalized.  It is possible for BITS_SHIFTED to equal -1.
      RESULT : LONG_COMP_ARRAY := LEFT;
      C_RESULT : LONG_COMPONENT_ARRAY := LONG_ZERO_ARRAY;
      C_LEFT : LONG_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : LONG_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
   begin

      if LEFT.CLASS_OF_ARRAY /= RIGHT.CLASS_OF_ARRAY then
         raise MAE_INVALID_OPERATION;
      end if;

      -- Loop over the array, adding adjacent components.
      for I in C_LEFT'range loop
         C_RESULT(I) := C_LEFT(I) + C_RIGHT(I);
      end loop;
      RANGE_CHECK(C_RESULT);

      case RESULT.CLASS_OF_ARRAY is
         when LONG_FLOAT_CLASS =>
            -- If the most signif comp is greater than the  maximum
            -- value divide the array by two.  This will make the
            -- array normalized since the add operation would only
            -- generate a maximum value of (2 * BASE_COMP_VALUE) - 1.
            if C_RESULT(C_RESULT'last) > MAX_COMP_VALUE then
               DIVIDE_ARRAY_BY_TWO(C_RESULT);
               SHIFT_BITS := -1;
            else
               -- Otherwise normalize by calling the routine.
               ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            end if;
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "+";

-----------------------------

   function "-"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY is
      -- The purpose of this function is to subtract LONG_COMP_ARRAYs
      -- returning a LONG_COMP_ARRAY value.
      -- ASSUME : LEFT >= RIGHT
      RESULT : LONG_COMP_ARRAY := LEFT;
      C_RESULT : LONG_COMPONENT_ARRAY := LONG_ZERO_ARRAY;
      C_LEFT : LONG_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : LONG_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;

   begin

      if LEFT.CLASS_OF_ARRAY /= RIGHT.CLASS_OF_ARRAY then
         raise MAE_INVALID_OPERATION;
      end if;

      -- validate the assumption left >= right
      if C_LEFT < C_RIGHT then
         raise MAE_INVALID_OPERATION;
      end if;

      -- Loop over the array, subtracting adjacent components.
      for I in C_LEFT'range loop
         C_RESULT(I) := C_LEFT(I) - C_RIGHT(I);
      end loop;
      RANGE_CHECK(C_RESULT);

      case RESULT.CLASS_OF_ARRAY is
         when LONG_FLOAT_CLASS =>
            -- Normalized by calling the routine
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;
   end "-";

-----------------------------

   function "*"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY is
      -- The purpose of this function is to multiply LONG_COMP_ARRAYs
      -- returning a LONG_COMP_ARRAY value.  This requires much
      -- range checking of the individual COMPs.
      RESULT : LONG_COMP_ARRAY := LEFT;
      RESULT_LAST : constant INTEGER := LONG_NUM_COMPS;
      C_RESULT : EXTRA_COMPONENT_ARRAY := EXTRA_ZERO_ARRAY;
      C_LEFT : LONG_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : LONG_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
      INDEX : INTEGER;
   begin
      -- Do the multiply by looping over the arrays

      -- loop over LEFT array
      for I in C_LEFT'range loop
         -- Zero check
         if C_LEFT(I) /= 0 then
            -- loop over RIGHT array
            for J in C_RIGHT'range loop
               -- Zero check
               if C_RIGHT(J) /= 0 then
                  -- Multiply the two COMPs
                  INDEX := I + J - 1;
                  C_RESULT(INDEX) := C_RESULT(INDEX) + (C_LEFT(I)*C_RIGHT(J));
               end if;
            end loop;
            -- RANGE_CHECK the intermediate result
            RANGE_CHECK(C_RESULT);
         end if;
      end loop;

      RESULT.BITS_SHIFTED := 0;
      case RESULT.CLASS_OF_ARRAY is
         when LONG_FLOAT_CLASS =>
            -- Normalize the result.
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY :=
               C_RESULT((C_RESULT'last-RESULT_LAST)+1 .. C_RESULT'last);
            -- Check for rounding to even.
            -- Look beyond the array for the rounding bits.
            -- Because the rounding technique is
               -- If round value is (0 <= x < .5), round down (no action)
               -- If least signif bit is on (1,odd)
                  -- then round up if round value is (.5 <= x < 1)
               -- If least signif bit is off (0,even),
                  -- then round up if round value is (.5 < x < 1),
                  -- else round down if round value is (x = .5)

            -- Assume that a round up will occur if round value
            -- is (.5 <= x < 1), then correct if the one case of a
            -- round down occurs
            if C_RESULT(C_RESULT'last-RESULT_LAST) >=
                                   BIT_VALUE(BIT_VALUE'first) then
               -- The round value is (.5 <= x < 1), assume round up
               RESULT.COMPONENT_ARRAY(1) := RESULT.COMPONENT_ARRAY(1) + 1;
               -- check for the one round down case
               if C_RESULT(C_RESULT'last-RESULT_LAST) =
                                   BIT_VALUE(BIT_VALUE'first) then
                  -- since we already added 1 to the least signif bit,
                  -- check if the least signif bit is now 1
                  -- (therefore it was zero).
                  if (RESULT.COMPONENT_ARRAY(1) rem 2) = 1 then
                     INDEX := (C_RESULT'last-RESULT_LAST)-1;
                     -- Loop over the remaining components, if they are
                     -- all zero then the round value equaled .5
                     while C_RESULT(INDEX) = 0 loop
                        INDEX := INDEX - 1;
                        if INDEX = 0 then
                           -- assumption incorrect, subtract 1 to correct
                           -- the assumption.
                           RESULT.COMPONENT_ARRAY(1) :=
                                        RESULT.COMPONENT_ARRAY(1) - 1;
                           exit;
                        end if;
                     end loop;
                  end if;
               end if;
               -- Do an inline RANGE_CHECK.
               -- next line should be INDEX := RESULT.COMPONENT_ARRAY'first;
               INDEX := 1;
               while RESULT.COMPONENT_ARRAY(INDEX) > MAX_COMP_VALUE loop
                  -- The comp is oversized, the carry value will be positive.
                  RESULT.COMPONENT_ARRAY(INDEX) := 0;
                  INDEX := INDEX + 1;
                  RESULT.COMPONENT_ARRAY(INDEX) :=
                                     RESULT.COMPONENT_ARRAY(INDEX) + 1;
                  -- If the 'impossible' carry to the most signif bit occurs
                  -- then another normalization must occur
                  if INDEX = RESULT_LAST then
                     if RESULT.COMPONENT_ARRAY(INDEX) > MAX_COMP_VALUE then
                        DIVIDE_ARRAY_BY_TWO(RESULT.COMPONENT_ARRAY);
                        SHIFT_BITS := SHIFT_BITS - 1;
                     end if;
                  end if;
               end loop;
            end if;
            RESULT.BITS_SHIFTED := SHIFT_BITS;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;
   end "*";

-----------------------------

   function "/"    (LEFT,RIGHT : LONG_COMP_ARRAY) return LONG_COMP_ARRAY is
      -- The purpose of this function is to divide LONG_COMP_ARRAYs
      -- returning a LONG_COMP_ARRAY value.  This requires much
      -- range checking of the individual COMPs.
      RESULT : LONG_COMP_ARRAY := LEFT;
      C_RESULT : LONG_COMPONENT_ARRAY := LONG_ZERO_ARRAY;
      C_LEFT : LONG_COMPONENT_ARRAY := LEFT.COMPONENT_ARRAY;
      C_RIGHT : LONG_COMPONENT_ARRAY := RIGHT.COMPONENT_ARRAY;
      SHIFT_BITS : INTEGER := 0;
      RESULT_SHIFT_BITS, LEFT_SHIFT_BITS, RIGHT_SHIFT_BITS : INTEGER := 0;
      LEFT_MSC : constant INTEGER := C_LEFT'last;
      R_COUNT : INTEGER;
      INDEX, INDEX_BIT : INTEGER;
   begin
      -- If the divisor is zero, then there is an error.
      if C_RIGHT = LONG_ZERO_ARRAY then
         RESULT.COMPONENT_ARRAY := C_RESULT;
         raise MAE_DIVIDE_BY_ZERO;
      end if;

      -- Initialize variables by normalizing.
      ARRAY_NORMALIZE(C_LEFT, LEFT_SHIFT_BITS);
      ARRAY_NORMALIZE(C_RIGHT, RIGHT_SHIFT_BITS);

      -- Save shifting values to correct result before exiting.
      RESULT_SHIFT_BITS := (RIGHT_SHIFT_BITS - LEFT_SHIFT_BITS) + 1;

      -- Make C_RIGHT(RIGHT_MSC) less than the C_LEFT by dividing
      -- C_RIGHT by 2.
      -- To make available the entire C_RESULT array for accuracy
      -- and instead of updating the RIGHT_SHIFT_BITS variable
      -- by one, we will view the shift as a shift of the
      -- LEFT_SHIFT_BITS by 1, since this equivalent and
      -- LEFT_SHIFT_BITS is the changing variable in the loop.
      LEFT_SHIFT_BITS := 1;
      DIVIDE_ARRAY_BY_TWO(C_RIGHT);

      -- This is the main loop for the division algorithm
      -- The loop has two exit points.
      loop
         R_COUNT := 0;
         -- Loop over array subtracing the divisor from the
         -- remaining dividend.  Since (divisor*4 > dividend),
         -- the R_COUNT variable can be a maximum of 3
         -- (after adding dividend if subtracted too much).
         while C_LEFT(C_LEFT'last) >= C_RIGHT(C_RIGHT'last) loop
            for J in C_LEFT'range loop
              -- subtract RIGHT COMP from LEFT COMP
              C_LEFT(J) := C_LEFT(J) - C_RIGHT(J);
            end loop;
            R_COUNT := R_COUNT + 1;
            RANGE_CHECK(C_LEFT);
         end loop;
         -- May have subtracted too much
         if C_LEFT(C_LEFT'last) < 0 then
            for J in C_LEFT'range loop
              -- add back the last subtraction
              C_LEFT(J) := C_LEFT(J) + C_RIGHT(J);
            end loop;
            R_COUNT := R_COUNT - 1;
            RANGE_CHECK(C_LEFT);
         end if;

         -- Locate bit position to add the count to
         -- the result array.  Determine which component, INDEX,
         -- and the bit, INDEX_BIT, within that component.
         INDEX := C_RESULT'last - (LEFT_SHIFT_BITS / NO_COMP_BITS);
         INDEX_BIT := (LEFT_SHIFT_BITS rem NO_COMP_BITS) + 1;

         -- If the bit position os still within the array bounds,
         -- then add the value, continue,
         -- else add the value, RANGE_CHECK, exit.
         if INDEX > 0 then
            C_RESULT(INDEX) := C_RESULT(INDEX)+(R_COUNT*BIT_VALUE(INDEX_BIT));
         else
            if (INDEX = 0) then
               if ((INDEX_BIT = 1) and (R_COUNT = 3)) then
                  C_RESULT(C_RESULT'first) := C_RESULT(C_RESULT'first) + 2;
               elsif ((INDEX_BIT = 1) and (R_COUNT = 2)) or
                     ((INDEX_BIT = 2) and (R_COUNT = 3)) then
                  C_RESULT(C_RESULT'first) := C_RESULT(C_RESULT'first) + 1;
               end if;
            end if;
            -- RANGE_CHECK the result.
            RANGE_CHECK(C_RESULT);

            -- EXIT POINT TWO
               -- The dividend has been shifted beyond significance.
            exit;
         end if;

         -- RANGE_CHECK the result.
         RANGE_CHECK(C_RESULT);
         -- NORMALIZE the remaining dividend.
         if C_LEFT = LONG_ZERO_ARRAY then
            -- EXIT POINT THREE
               -- The dividend has been reduced to zero.
            exit;
         else
            ARRAY_NORMALIZE(C_LEFT, SHIFT_BITS);
            LEFT_SHIFT_BITS := LEFT_SHIFT_BITS + SHIFT_BITS;
         end if;
      end loop;

      case RESULT.CLASS_OF_ARRAY is
         when LONG_FLOAT_CLASS =>
            -- shift the result back
            ARRAY_NORMALIZE(C_RESULT, SHIFT_BITS);
            RESULT.COMPONENT_ARRAY := C_RESULT;
            RESULT.BITS_SHIFTED := SHIFT_BITS - RESULT_SHIFT_BITS;

         when others =>
            raise MAE_INVALID_OPERATION;

      end case;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;
   end "/";


-------------------------------------------------------------------
-- The body of the package
--
begin
   -- the initializing of the bit position value array
   for I in BIT_VALUE'first .. BIT_VALUE'last loop
      BIT_VALUE(I) := 2**(BIT_VALUE'last - I);
   end loop;
end MAE_BASIC_OPERATIONS;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--maeint.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-------------------------------------------------------------------------------
--                                                                           --
--             Emulation of Machine Arithmetic - a WIS Ada Tool              --
--                                                                           --
--                         Ada Technology Group                              --
--                         SYSCON Corporation                                --
--                         3990 Sherman Street                               --
--                         San Diego, CA. 92110                              --
--                                                                           --
--                        John Long & John Reddan                            --
--                                                                           --
-------------------------------------------------------------------------------

with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package MAE_INTEGER is
-------------------------------------------------------------------

-- The purpose of this package is to emulate target machine
-- integer arithmetic on host machines with 16-bit or larger
-- words.
--
-- The range of the supported type is as follows:
--
--    TARGET_INTEGER
--       range of -2**MAE_BASIC_OPERATIONS.TARGET_INTEGER_NUM_BITS
--                        to
--                 2**MAE_BASIC_OPERATIONS.TARGET_INTEGER_NUM_BITS-1
--
-- Any errors which occur during use of the arithmetic and
-- boolean functions defined below will result in the
-- raising of the exception "MAE_NUMERIC_ERROR".

--
-- Visible operations with MAE_INTEGER_TYPE
--
   type MAE_INTEGER_TYPE is private;

   -- The defined operators for this type are as follows:

   -- predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN;
   function "<="   (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN;
   function ">"    (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN;
   function ">="   (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN;

   function "+"    (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "-"    (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "abs"  (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;

   function "+"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "-"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "*"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "/"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "rem"  (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;
   function "mod"  (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE;

   function "**"   (LEFT : MAE_INTEGER_TYPE; RIGHT : INTEGER)
                       return MAE_INTEGER_TYPE;

   function MAE_INTEGER_TYPE_VALUE(STRING_PIC : STRING)
                                      return MAE_INTEGER_TYPE;

   function MAE_INTEGER_TYPE_IMAGE(STORE_PIC : MAE_INTEGER_TYPE)
                                      return STRING;

   procedure GET (FROM : in STRING;
                  ITEM : out MAE_INTEGER_TYPE;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in MAE_INTEGER_TYPE;
                  BASE : in NUMBER_BASE := DEFAULT_BASE);

   function TARGET_INTEGER_FIRST return MAE_INTEGER_TYPE;

   function TARGET_INTEGER_LAST return MAE_INTEGER_TYPE;

-------------------------------------------------------------------
private

-- The declaration of the next variable is to allow
-- the record declaration under the Telesoft version 1.5 compiler.
-- A better declaration would allow the COMP_ARRAY range to be
-- (1 .. BITS_TO_COMPS(NO_OF_BITS).

   type MAE_INTEGER_TYPE is
      record
         SIGN : SIGN_TYPE := POS_SIGN;
         COMPS : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
      end record;

-------------------------------------------------------------------
end MAE_INTEGER;

-------------------------------------------------------------------
-------------------------------------------------------------------
with TEXT_IO;
with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package body MAE_INTEGER is
-------------------------------------------------------------------
-- The purpose of this package is to emulate 36 bit machine
-- arithmetic on a 32 bit host machine for 36 bit integer
-- numbers.  The range of the supported type is as follows:
--
--    Integer
--       range of -2**35 to 2**35-1
--
--
-------------------------------------------------------------------
-- Local exception names for better tracing
--
   MAE_FORMAT_ERROR : EXCEPTION;
   DATA_ERROR : EXCEPTION;
   LAYOUT_ERROR : EXCEPTION;

-------------------------------------------------------------------
-- Constants for local functions and procedures
--
-- Once again the declaration of variables is affect by the
-- Telesoft 1.5 compiler.  The better declaration would use
-- the 'range, 'first, and 'last attributes for initialization.
-- The intialization of the digits ONE .. TEN are in the
-- body(bottom) of this package.

   ZERO : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   ONE : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   TWO : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   THREE : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   FOUR : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   FIVE : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   SIX : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   SEVEN : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   EIGHT : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   NINE : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   TEN : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;
   THOUSAND : SHORT_COMP_ARRAY := INTEGER_COMP_ARRAY;

   MAE_INTEGER_ONE : MAE_INTEGER_TYPE;
   MAE_INTEGER_TWO : MAE_INTEGER_TYPE;

   MAE_INTEGER_FIRST : MAE_INTEGER_TYPE;
   MAE_INTEGER_LAST : MAE_INTEGER_TYPE;

   TWO_THREE : constant INTEGER := 2**3;
   TWO_THREE_LESS_ONE : constant INTEGER := (2**3)-1;
   TWO_TWO : constant INTEGER := 2**2;
   TWO_TWO_LESS_ONE : constant INTEGER := (2**2)-1;

-------------------------------------------------------------------
-- Visible operations with MAE_INTEGER_TYPE
--
   function TARGET_INTEGER_FIRST return MAE_INTEGER_TYPE is
   begin
      return MAE_INTEGER_FIRST;
   end TARGET_INTEGER_FIRST;

------------------------------

   function TARGET_INTEGER_LAST return MAE_INTEGER_TYPE is
   begin
      return MAE_INTEGER_LAST;
   end TARGET_INTEGER_LAST;

------------------------------

   -- predefined system functions : function "=" and function "/="

------------------------------

   function "<"    (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the component arrays.
   begin
      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               return (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               return (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<";

------------------------------

   function "<="   (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the component arrays.
   begin
      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               return (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               return (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<=";

------------------------------

   function ">"    (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the component arrays.
   begin
      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               return (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               return (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">";

------------------------------

   function ">="   (LEFT, RIGHT : MAE_INTEGER_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the component arrays.
   begin
      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               return (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               return (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">=";

------------------------------

   function "+"    (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
   begin
      -- No action needed
      return RIGHT;
   end "+";

------------------------------

   function "-"    (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      RESULT : MAE_INTEGER_TYPE := RIGHT;
   begin
      -- change the sign
      RESULT.SIGN := CHANGE_SIGN(RIGHT.SIGN);

      return RESULT;
   end "-";

------------------------------

   function "abs"  (RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      RESULT : MAE_INTEGER_TYPE := RIGHT;
   begin
      RESULT.SIGN := POS_SIGN;
      return RESULT;
   end "abs";


--------------------------------------------------------------------

   procedure CHECK_IF_OK_FOR_TARGET (RESULT : in out MAE_INTEGER_TYPE) is
      -- This routine checks if the computed result from an operation
      -- has actually overflowed the emulated target.  The size is
      -- specified by the variable TARGET_INTEGER_NUM_BITS in the
      -- basic operations package.  This routine is called when
      -- just before the result is exported.
      MSC, MSB : INTEGER;
   begin
      -- determine most significant comp and most significant bit
      MSC := (TARGET_INTEGER_NUM_BITS / NO_COMP_BITS) + 1;
      MSB := (NO_COMP_BITS - (TARGET_INTEGER_NUM_BITS rem NO_COMP_BITS));

      -- if non-zero above MSC then it overflowed
      for I in MSC+1 .. SHORT_NUM_COMPS loop
         if RESULT.COMPS.COMPONENT_ARRAY(I) /= 0 then
            raise MAE_NUMERIC_ERROR;
         end if;
      end loop;

      -- if non-zero at MSB or above within MSC then it overflowed,
      -- unless the number is exactly the negative maximum
      if RESULT.COMPS.COMPONENT_ARRAY(MSC) >= (BIT_VALUE(MSB)) then
         if (RESULT.SIGN = NEG_SIGN) and
              (RESULT.COMPS.COMPONENT_ARRAY(MSC) = (BIT_VALUE(MSB))) then
            for I in 1 .. MSC-1 loop
               if RESULT.COMPS.COMPONENT_ARRAY(I) /= 0 then
                  raise MAE_NUMERIC_ERROR;
               end if;
            end loop;
         else
            raise MAE_NUMERIC_ERROR;
         end if;
      end if;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end CHECK_IF_OK_FOR_TARGET;

--------------------------------------------------------------------

   function "+"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to add two
      -- MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- zero check
      if LEFT.COMPS = ZERO then
         RESULT := RIGHT;
         CHECK_IF_OK_FOR_TARGET(RESULT);
         return RESULT;
      elsif RIGHT.COMPS = ZERO then
         RESULT := LEFT;
         CHECK_IF_OK_FOR_TARGET(RESULT);
         return RESULT;
      end if;

      case (LEFT.SIGN xor RIGHT.SIGN) is
         -- The signs are different (subtraction)
         when TRUE =>
            if LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY then
               RESULT.COMPS := LEFT.COMPS - RIGHT.COMPS;
               RESULT.SIGN := LEFT.SIGN;
            else
               RESULT.COMPS := RIGHT.COMPS - LEFT.COMPS;
               RESULT.SIGN := RIGHT.SIGN;
            end if;

         -- The signs are the same
         when FALSE =>
            RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
            RESULT.SIGN := LEFT.SIGN;

      end case;
      -- if result is zero, set sign positive
      if RESULT.COMPS = ZERO then
         RESULT.SIGN := POS_SIGN;
      end if;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "+";

---------------------------

   function "-"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to subtract two
      -- MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- zero check
      if RIGHT.COMPS = ZERO then
         RESULT := LEFT;
         CHECK_IF_OK_FOR_TARGET(RESULT);
         return RESULT;
      elsif LEFT.COMPS = ZERO then
         RESULT := -RIGHT;
         CHECK_IF_OK_FOR_TARGET(RESULT);
         return RESULT;
      end if;

      case (LEFT.SIGN xor RIGHT.SIGN) is
         -- The signs are different
         when TRUE =>
            RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
            RESULT.SIGN := LEFT.SIGN;

         -- The sign are the same
         when FALSE =>
            if LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY then
               RESULT.COMPS := LEFT.COMPS - RIGHT.COMPS;
               RESULT.SIGN := LEFT.SIGN;
            else
               RESULT.COMPS := RIGHT.COMPS - LEFT.COMPS;
               RESULT.SIGN := not LEFT.SIGN;
            end if;

      end case;
      -- if result is zero, set sign positive
      if RESULT.COMPS = ZERO then
         RESULT.SIGN := POS_SIGN;
      end if;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "-";

------------------------------

   function "*"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to multiply two
      -- MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- First set the sign, then the integer portion.
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (LEFT.COMPS = ZERO) or (RIGHT.COMPS = ZERO) then
         RESULT.COMPS := ZERO;
      -- one check
      elsif LEFT.COMPS = ONE then
         RESULT.COMPS := RIGHT.COMPS;
      elsif RIGHT.COMPS = ONE then
         RESULT.COMPS := LEFT.COMPS;
      else
         RESULT.COMPS := LEFT.COMPS * RIGHT.COMPS;
      end if;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "*";

---------------------------

   function "/"    (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to divide two
      -- MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- First set the sign, then the integer portion.
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (RIGHT.COMPS = ZERO) then
         raise MAE_NUMERIC_ERROR;
      elsif (LEFT.COMPS = ZERO) then
         RESULT.COMPS := ZERO;
      -- one check
      elsif RIGHT.COMPS = ONE then
         RESULT.COMPS := LEFT.COMPS;
      else
         RESULT.COMPS := LEFT.COMPS / RIGHT.COMPS;
      end if;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "/";

---------------------------

   function "rem"  (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to calculate the remainder
      -- of MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- First set the sign, then the integer portion.
      RESULT.SIGN := LEFT.SIGN;
      RESULT.COMPS := LEFT.COMPS rem RIGHT.COMPS;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "rem";

---------------------------

   function "mod"  (LEFT,RIGHT : MAE_INTEGER_TYPE) return MAE_INTEGER_TYPE is
      -- The purpose of this function is to modulo
      -- MAE_INTEGER_TYPEs.
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- The sign of the result is the sign of the dividend
      RESULT.SIGN := RIGHT.SIGN;
      case (LEFT.SIGN xor RIGHT.SIGN) is
         -- if the signs are different, the modulo is
         -- is the complement of the remainder about the dividend.
         when TRUE =>
            RESULT.COMPS := LEFT.COMPS rem RIGHT.COMPS;
            if RESULT.COMPS /= ZERO then
               RESULT.COMPS := RIGHT.COMPS - RESULT.COMPS;
            end if;

         -- if the signs are the same, the modulo is
         -- is the remainder.
         when FALSE =>
            RESULT.COMPS := LEFT.COMPS rem RIGHT.COMPS;
      end case;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "mod";

---------------------------

   function "**"   (LEFT : MAE_INTEGER_TYPE; RIGHT : INTEGER)
                       return MAE_INTEGER_TYPE is
      -- The purpose of this function is to raise a MAE_INTEGER_TYPE
      -- to a given power.  A simple loop with a multiplication could
      -- be done the given count, less one, times.  This method is
      -- inefficient, therefore a different algorithm is used.
      -- The use of additional memory to hold intermediate
      -- calculations will improve performance by reducing
      -- the number of multiplications.
      COUNT : constant INTEGER := RIGHT;
      REM_COUNT : INTEGER := RIGHT;
      RESULT : MAE_INTEGER_TYPE;
      POWER_2, POWER_4, POWER_8 : SHORT_COMP_ARRAY := ZERO;
   begin
      -- if the power is less than 0, it is an exception
      if COUNT < 0 then
         raise CONSTRAINT_ERROR;
      -- if the power is 0, return 1
      elsif COUNT = 0 then
         RESULT.COMPS := ONE;
         return RESULT;
      -- if the power is 1 or number is 0 or 1, return the input number
      elsif (COUNT = 1) or (LEFT.COMPS = ONE) or (LEFT.COMPS = ZERO) then
         return LEFT;
      elsif COUNT > TWO_THREE_LESS_ONE then
         -- compute to POWER_8
         POWER_2 := LEFT.COMPS * LEFT.COMPS;
         POWER_4 := POWER_2 * POWER_2;
         POWER_8 := POWER_4 * POWER_4;
         RESULT.COMPS := POWER_8;
         REM_COUNT := REM_COUNT - 8;
      elsif COUNT > TWO_TWO_LESS_ONE then
         -- compute to POWER_4
         POWER_2 := LEFT.COMPS * LEFT.COMPS;
         POWER_4 := POWER_2 * POWER_2;
         RESULT.COMPS := POWER_4;
         REM_COUNT := REM_COUNT - 4;
      else
         -- compute to POWER_2
         POWER_2 := LEFT.COMPS * LEFT.COMPS;
         RESULT.COMPS := POWER_2;
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- the pre-computed values are now used the build
      -- to the answer

      -- loop until the power is reduced to under the
      -- maximum pre-computed value
      loop
         if REM_COUNT < TWO_THREE then
           exit;
         end if;
         RESULT.COMPS := RESULT.COMPS * POWER_8;
         REM_COUNT := REM_COUNT - 8;
      end loop;

      -- the remaining power may be between 4 .. 7
      if REM_COUNT > TWO_TWO_LESS_ONE then
         RESULT.COMPS := RESULT.COMPS * POWER_4;
         REM_COUNT := REM_COUNT - 4;
      end if;

      -- the remaining power may be between 2 .. 3
      if REM_COUNT > 1 then
         RESULT.COMPS := RESULT.COMPS * POWER_2;
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- the remaining power may be 1, therefore the sign
      -- is negative if the input number is negative
      if REM_COUNT = 1 then
         RESULT.COMPS := RESULT.COMPS * LEFT.COMPS;
         RESULT.SIGN := LEFT.SIGN;
      end if;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "**";

----------------------------

   function MAE_INTEGER_TYPE_VALUE(STRING_PIC : STRING)
                                      return MAE_INTEGER_TYPE is
   -- The purpose of this function is to convert a string
   -- of characters into the MAE_INTEGER_TYPE structure.
   -- The string is valid if an only if it contains solely
   -- digits and is within the specified range for
   -- MAE_INTEGER_TYPEs.
      INDEX : INTEGER;
      RESULT : MAE_INTEGER_TYPE;
   begin
      -- Strip leading spaces if necessary
      INDEX := STRING_PIC'first;
      for I in STRING_PIC'first .. STRING_PIC'last loop
         if STRING_PIC(I) /= ' ' then
            exit;
         end if;
         INDEX := INDEX + 1;
         -- if the string is empty
         if INDEX > STRING_PIC'last then
            raise MAE_FORMAT_ERROR;
         end if;
      end loop;

      -- Set the sign
      RESULT.SIGN := POS_SIGN;
      if STRING_PIC(INDEX) = '-' then
         RESULT.SIGN := NEG_SIGN;
         INDEX := INDEX + 1;
      elsif STRING_PIC(INDEX) = '+' then
         INDEX := INDEX + 1;
      end if;

      -- if the string is empty
      if INDEX > STRING_PIC'last then
         raise MAE_FORMAT_ERROR;
      end if;

      -- Store the integer portion
      for I in INDEX .. STRING_PIC'last loop
         case STRING_PIC(I) is
            when '0' => RESULT.COMPS := RESULT.COMPS*TEN;
            when '1' => RESULT.COMPS := RESULT.COMPS*TEN + ONE;
            when '2' => RESULT.COMPS := RESULT.COMPS*TEN + TWO;
            when '3' => RESULT.COMPS := RESULT.COMPS*TEN + THREE;
            when '4' => RESULT.COMPS := RESULT.COMPS*TEN + FOUR;
            when '5' => RESULT.COMPS := RESULT.COMPS*TEN + FIVE;
            when '6' => RESULT.COMPS := RESULT.COMPS*TEN + SIX;
            when '7' => RESULT.COMPS := RESULT.COMPS*TEN + SEVEN;
            when '8' => RESULT.COMPS := RESULT.COMPS*TEN + EIGHT;
            when '9' => RESULT.COMPS := RESULT.COMPS*TEN + NINE;
            when ' ' =>
               -- if there is a space after the sign - exception
               -- else check if it is the end of the number
               if I /= INDEX then
                  -- Check trailing spaces if necessary
                  for J in I+1 .. STRING_PIC'last loop
                     if STRING_PIC(J) /= ' ' then
                        raise MAE_FORMAT_ERROR;
                     end if;
                  end loop;
                  exit;
               else
                  raise MAE_FORMAT_ERROR;
               end if;
            when others => raise MAE_FORMAT_ERROR;
         end case;
      end loop;

      CHECK_IF_OK_FOR_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end MAE_INTEGER_TYPE_VALUE;

------------------------------

   function MAE_INTEGER_TYPE_IMAGE(STORE_PIC : MAE_INTEGER_TYPE)
                                      return STRING is
   -- The purpose of this function is to convert a
   -- MAE_INTEGER_TYPE into string of characters.
      INDEX : INTEGER;
      INTERMEDIATE : MAE_INTEGER_TYPE := STORE_PIC;
      TEMP : SHORT_COMP_ARRAY;
      TEMP_INTEGER : INTEGER;
      STRING_PIC : STRING (1 .. INTEGER_DIGITS+4) :=
              EMPTY_STRING(1 .. INTEGER_DIGITS+4);
      TEMP_THREE_CHAR : STRING (1 .. 3);
   begin
      INDEX := STRING_PIC'last;
      -- Store the integer portion
      -- if it is zero
      if INTERMEDIATE.COMPS = ZERO then
         STRING_PIC(INDEX) := '0';
         INDEX := INDEX - 1;
      else
         -- loop over the MAE_NUMBER taking the least significant
         -- decimal digits and storing them in the array(backwards)
         while INTERMEDIATE.COMPS /= ZERO loop
            TEMP := INTERMEDIATE.COMPS rem THOUSAND;
            INTERMEDIATE.COMPS := INTERMEDIATE.COMPS / THOUSAND;
            -- assumes 1000 fits into two components
            TEMP_INTEGER := TEMP.COMPONENT_ARRAY(2)*BASE_COMP_VALUE +
                                  TEMP.COMPONENT_ARRAY(1);
            TEXT_IO.INTEGER_IO.PUT(TEMP_THREE_CHAR, TEMP_INTEGER);
            for I in 1 .. 2 loop
                exit when TEMP_THREE_CHAR(I) /= ' ';
                TEMP_THREE_CHAR(I) := '0';
            end loop;
            STRING_PIC(INDEX-2 .. INDEX) := TEMP_THREE_CHAR;
            INDEX := INDEX - 3;
         end loop;
         INDEX := INDEX + 1;

         while STRING_PIC(INDEX) = '0' loop
            STRING_PIC(INDEX) := ' ';
            INDEX := INDEX + 1;
         end loop;

         -- Store the sign
         INDEX := INDEX - 1;
         if STORE_PIC.SIGN = NEG_SIGN then
            STRING_PIC(INDEX) := '-';
         end if;
      end if;

      return STRING_PIC(INDEX .. STRING_PIC'last);

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end MAE_INTEGER_TYPE_IMAGE;

------------------------------

   procedure GET (FROM : in STRING;
                  ITEM : out MAE_INTEGER_TYPE;
                  LAST : out POSITIVE) is

   begin
      ITEM := MAE_INTEGER_TYPE_VALUE(FROM);
      LAST := FROM'last;

   exception
      when others =>
         raise DATA_ERROR;

   end GET;

------------------------------

   procedure PUT (TO : out STRING;
                  ITEM : in MAE_INTEGER_TYPE;
                  BASE : in NUMBER_BASE := DEFAULT_BASE) is
   -- The purpose of this function is to convert a
   -- MAE_INTEGER_TYPE into string of characters.
      INDEX : INTEGER;
      INTERMEDIATE : MAE_INTEGER_TYPE := ITEM;
      TEMP : SHORT_COMP_ARRAY;
      TEMP_INTEGER : INTEGER;
      STRING_PIC : STRING (1 .. INTEGER_DIGITS+4);
      TEMP_THREE_CHAR : STRING (1 .. 3);
      LAST_DIGIT : INTEGER;
   begin
      if BASE /= DEFAULT_BASE then
         raise LAYOUT_ERROR;
      end if;

      TO := EMPTY_STRING(TO'first .. TO'last);
      -- Store the integer portion
      -- if it is zero
      if INTERMEDIATE.COMPS = ZERO then
         TO(TO'last) := '0';
      else
         INDEX := STRING_PIC'last;
         -- loop over the MAE_NUMBER taking the least significant
         -- decimal digits and storing them in the array(backwards)
         while INTERMEDIATE.COMPS /= ZERO loop
            TEMP := INTERMEDIATE.COMPS rem THOUSAND;
            INTERMEDIATE.COMPS := INTERMEDIATE.COMPS / THOUSAND;
            TEMP_INTEGER := TEMP.COMPONENT_ARRAY(2)*BASE_COMP_VALUE +
                                  TEMP.COMPONENT_ARRAY(1);
            -- assumes 1000 fits into two components
            TEXT_IO.INTEGER_IO.PUT(TEMP_THREE_CHAR, TEMP_INTEGER);
            for I in 1 .. 2 loop
                exit when TEMP_THREE_CHAR(I) /= ' ';
                TEMP_THREE_CHAR(I) := '0';
            end loop;
            STRING_PIC(INDEX-2 .. INDEX) := TEMP_THREE_CHAR;
            INDEX := INDEX - 3;
         end loop;
         INDEX := INDEX + 1;

         while STRING_PIC(INDEX) = '0' loop
            STRING_PIC(INDEX) := ' ';
            INDEX := INDEX + 1;
         end loop;

         -- Store the sign
         if ITEM.SIGN = NEG_SIGN then
            INDEX := INDEX - 1;
            STRING_PIC(INDEX) := '-';
         end if;

         TO((TO'last-(STRING_PIC'last-INDEX)) .. TO'last) :=
                   STRING_PIC(INDEX .. STRING_PIC'last);
      end if;

   exception
      when others =>
         raise LAYOUT_ERROR;

   end PUT;

------------------------------

begin

   -- Initialize the digits ONE .. TEN with the appropriate
   -- integer value.  This allows for the length of the array
   -- to change in the basic operations and not caused a coding
   -- change in this package.
   -- Notice that these values assume the declaration of the type
   -- is initially a zero value.  This assumption is justified since
   -- the declaration of the type is in this package specification.
   -- ZERO taken care of by the initial value.
   ONE.COMPONENT_ARRAY(1) := 1;
   TWO.COMPONENT_ARRAY(1) := 2;
   THREE.COMPONENT_ARRAY(1) := 3;
   FOUR.COMPONENT_ARRAY(1) := 4;
   FIVE.COMPONENT_ARRAY(1) := 5;
   SIX.COMPONENT_ARRAY(1) := 6;
   SEVEN.COMPONENT_ARRAY(1) := 7;
   EIGHT.COMPONENT_ARRAY(1) := 8;
   NINE.COMPONENT_ARRAY(1) := 9;
   TEN.COMPONENT_ARRAY(1) := 10;
   THOUSAND.COMPONENT_ARRAY(2) := 1000 / BASE_COMP_VALUE;
   THOUSAND.COMPONENT_ARRAY(1) := 1000 rem BASE_COMP_VALUE;

   MAE_INTEGER_ONE.COMPS := ONE;
   MAE_INTEGER_TWO.COMPS := TWO;

   MAE_INTEGER_LAST := ((((MAE_INTEGER_TWO**(TARGET_INTEGER_NUM_BITS-1))
                     - MAE_INTEGER_ONE) * MAE_INTEGER_TWO) + MAE_INTEGER_ONE);
   MAE_INTEGER_FIRST := (-(MAE_INTEGER_LAST)) - MAE_INTEGER_ONE;

end MAE_INTEGER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--maeshort.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-------------------------------------------------------------------------------
--                                                                           --
--             Emulation of Machine Arithmetic - a WIS Ada Tool              --
--                                                                           --
--                         Ada Technology Group                              --
--                         SYSCON Corporation                                --
--                         3990 Sherman Street                               --
--                         San Diego, CA. 92110                              --
--                                                                           --
--                        John Long & John Reddan                            --
--                                                                           --
-------------------------------------------------------------------------------

with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package MAE_SHORT_FLOAT is
-------------------------------------------------------------------
-- The purpose of this package is to emulate target machine
-- floating point arithmetic on host machines with 16-bit or
-- larger word size.
--
-- The range of the supported type is as follows:
--
--     TARGET_SHORT_FLOAT (Real)
--        approximate range of 10**-38 to 10**38 and 0
--        mantissa => MAE_BASIC_OPERATIONS.TARGET_SHORT_NUM_BITS
--                    bit binary fraction
--        exponent => -128 to 127
--
-- Any errors which occur during use of the arithmetic and
-- boolean functions defined below will result in the
-- raising of the exception "MAE_NUMERIC_ERROR".

--
-- Visible operations with MAE_SHORT_FLOAT_TYPE
--
   type MAE_SHORT_FLOAT_TYPE is private;

   -- The defined operators for this type are as follows:

   -- predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN;
   function "<="   (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN;
   function ">"    (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN;
   function ">="   (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN;

   function "+"    (RIGHT : MAE_SHORT_FLOAT_TYPE) return MAE_SHORT_FLOAT_TYPE;
   function "-"    (RIGHT : MAE_SHORT_FLOAT_TYPE) return MAE_SHORT_FLOAT_TYPE;
   function "abs"  (RIGHT : MAE_SHORT_FLOAT_TYPE) return MAE_SHORT_FLOAT_TYPE;

   function "+"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE;
   function "-"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE;
   function "*"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE;
   function "/"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE;

   function "**"   (LEFT : MAE_SHORT_FLOAT_TYPE; RIGHT : INTEGER)
                       return MAE_SHORT_FLOAT_TYPE;


   procedure GET (FROM : in STRING;
                  ITEM : out MAE_SHORT_FLOAT_TYPE;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in MAE_SHORT_FLOAT_TYPE;
                  AFT : in FIELD := SHORT_DEFAULT_AFT;
                  EXP : in FIELD := SHORT_DEFAULT_EXP);

   function TARGET_SHORT_FLOAT_EPSILON return MAE_SHORT_FLOAT_TYPE;

   function TARGET_SHORT_FLOAT_LARGE return MAE_SHORT_FLOAT_TYPE;

   function TARGET_SHORT_FLOAT_SMALL return MAE_SHORT_FLOAT_TYPE;

   function TARGET_SHORT_FLOAT_LAST return MAE_SHORT_FLOAT_TYPE;

   function TARGET_SHORT_FLOAT_FIRST return MAE_SHORT_FLOAT_TYPE;

-------------------------------------------------------------------
private

-- The declaration of the next variable is to allow
-- the record declaration under the Telesoft version 1.5 compiler.
-- A better declaration would allow the COMP_ARRAY range to be
-- (1 .. BITS_TO_COMPS(NO_OF_BITS).

   type MAE_SHORT_FLOAT_TYPE is
      record
         SIGN : SIGN_TYPE := POS_SIGN;
         COMPS : SHORT_COMP_ARRAY := SHORT_FLOAT_COMP_ARRAY;
         EXPONENT : EXPONENT_TYPE := 0;
      end record;

-------------------------------------------------------------------
end MAE_SHORT_FLOAT;

-------------------------------------------------------------------
-------------------------------------------------------------------
with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package body MAE_SHORT_FLOAT is
-------------------------------------------------------------------
-- Local variables for better tracing
--
   MAE_FORMAT_ERROR : EXCEPTION;
   MAE_SHORT_FLOAT_OVERFLOW : EXCEPTION;
   DATA_ERROR : EXCEPTION;
   LAYOUT_ERROR : EXCEPTION;

-------------------------------------------------------------------
-- Constants for local functions and procedures
--
-- Once again the declaration of variables is affect by the
-- Telesoft 1.5 compiler.  The better declaration would use
-- the 'range, 'first, and 'last attributes for initialization.
-- The initialization of the variables ONE .. TEN are done in
-- the body(bottom) of this package.

   ZERO : MAE_SHORT_FLOAT_TYPE;
   ONE : MAE_SHORT_FLOAT_TYPE;
   TWO : MAE_SHORT_FLOAT_TYPE;
   THREE : MAE_SHORT_FLOAT_TYPE;
   FOUR : MAE_SHORT_FLOAT_TYPE;
   FIVE : MAE_SHORT_FLOAT_TYPE;
   SIX : MAE_SHORT_FLOAT_TYPE;
   SEVEN : MAE_SHORT_FLOAT_TYPE;
   EIGHT : MAE_SHORT_FLOAT_TYPE;
   NINE : MAE_SHORT_FLOAT_TYPE;
   TEN : MAE_SHORT_FLOAT_TYPE;

   HUNDRED : MAE_SHORT_FLOAT_TYPE;
   THOUSAND : MAE_SHORT_FLOAT_TYPE;
   TEN_THOUSAND : MAE_SHORT_FLOAT_TYPE;

   ONE_TENTH : MAE_SHORT_FLOAT_TYPE;
   ONE_HUNDREDTH : MAE_SHORT_FLOAT_TYPE;
   ONE_THOUSANDTH : MAE_SHORT_FLOAT_TYPE;
   ONE_TEN_THOUSANDTH : MAE_SHORT_FLOAT_TYPE;

   MAE_SHORT_FLOAT_EPSILON : MAE_SHORT_FLOAT_TYPE;
   MAE_SHORT_FLOAT_LARGE : MAE_SHORT_FLOAT_TYPE;
   MAE_SHORT_FLOAT_SMALL : MAE_SHORT_FLOAT_TYPE;
   MAE_SHORT_FLOAT_LAST : MAE_SHORT_FLOAT_TYPE;
   MAE_SHORT_FLOAT_FIRST : MAE_SHORT_FLOAT_TYPE;

   TWO_THREE : constant INTEGER := 2**3;
   TWO_THREE_LESS_ONE : constant INTEGER := (2**3)-1;
   TWO_TWO : constant INTEGER := 2**2;
   TWO_TWO_LESS_ONE : constant INTEGER := (2**2)-1;

-------------------------------------------------------------------
-- Visible operations with MAE_SHORT_FLOAT_TYPE
--
   function TARGET_SHORT_FLOAT_EPSILON return MAE_SHORT_FLOAT_TYPE is
   begin
      return MAE_SHORT_FLOAT_EPSILON;
   end TARGET_SHORT_FLOAT_EPSILON;

------------------------------

   function TARGET_SHORT_FLOAT_LARGE return MAE_SHORT_FLOAT_TYPE is
   begin
      return MAE_SHORT_FLOAT_LARGE;
   end TARGET_SHORT_FLOAT_LARGE;

------------------------------

   function TARGET_SHORT_FLOAT_SMALL return MAE_SHORT_FLOAT_TYPE is
   begin
      return MAE_SHORT_FLOAT_SMALL;
   end TARGET_SHORT_FLOAT_SMALL;

------------------------------

   function TARGET_SHORT_FLOAT_LAST return MAE_SHORT_FLOAT_TYPE is
   begin
      return MAE_SHORT_FLOAT_LAST;
   end TARGET_SHORT_FLOAT_LAST;

------------------------------

   function TARGET_SHORT_FLOAT_FIRST return MAE_SHORT_FLOAT_TYPE is
   begin
      return MAE_SHORT_FLOAT_FIRST;
   end TARGET_SHORT_FLOAT_FIRST;

------------------------------


   -- predefined system functions : function "=" and function "/="

   function "<"    (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
            return FALSE;
         else
            return RIGHT.SIGN;
         end if;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<";

------------------------------

   function "<="   (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return RIGHT.SIGN;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<=";

------------------------------

   function ">"    (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not RIGHT.SIGN;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">";

------------------------------

   function ">="   (LEFT, RIGHT : MAE_SHORT_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
            return TRUE;
         else
            return not RIGHT.SIGN;
         end if;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">=";

------------------------------

   function "+"    (RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
   begin
      -- No action needed
      return RIGHT;
   end "+";

------------------------------

   function "-"    (RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      RESULT : MAE_SHORT_FLOAT_TYPE := RIGHT;
   begin
      RESULT.SIGN := CHANGE_SIGN(RIGHT.SIGN);
      return RESULT;
   end "-";

------------------------------

   function "abs"  (RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      RESULT : MAE_SHORT_FLOAT_TYPE := RIGHT;
   begin
      RESULT.SIGN := POS_SIGN;
      return RESULT;
   end "abs";

-------------------------------------------------------------------

   procedure ROUND_TO_TARGET (RESULT : in out MAE_SHORT_FLOAT_TYPE) is
      -- The purpose of this function is perform an underflow
      -- check (if true set result to zero), and overflow check
      -- (raise constraint error), then to round the float type
      -- so as to match the emulated target.
      -- The input array must be normalized.
-- --------------------------------------------------------------
--
--               Rounding Technique Summary
--
-- --------------------------------------------------------------
--
--      LSB    : the least significant bit
--      GUARD  : the guard bit, first bit beyond LSB
--      STICKY : the logical "or" of all bits beyond GUARD
--
--
--              BEFORE ROUNDING             AFTER ROUNDING
--
--      LSB   |  GUARD  | STICKY  ||   LSB   | HOW ROUNDED ?
--   --------------------------------------------------------
--       0    |    0    |    0    ||    0    | exact
--       0    |    0    |    1    ||    0    | down (0<x<.5)
--       0    |    1    |    0    ||    0    | down (.5)
--       0    |    1    |    1    ||    1    | up (.5<x<1)
--       1    |    0    |    0    ||    1    | exact
--       1    |    0    |    1    ||    1    | down (0<x<.5)
--       1    |    1    |    0    ||    0*   | up (.5)
--       1    |    1    |    1    ||    0*   | up (.5<x<1)
--
--       * note that a carry to the bit above the LSB occurs
--
--    The references to 0, .5, and 1, are with respect to the
--    least significant bit in the binary representation.
--    For example, the representative value of the guard bit
--    is one-half the representative value of the least
--    significant bit, and the maximum value that can be
--    represented by the sticky bit is (.499999 ...) times
--    the representative value of the least significant bit.
--
-- --------------------------------------------------------------
      C_RESULT : SHORT_COMPONENT_ARRAY := RESULT.COMPS.COMPONENT_ARRAY;
      LSC, LSB, LSB_FLAG : INTEGER;
      GUARD, GUARD_FLAG, GUARD_COMP : INTEGER;
      STICKY, STICKY_FLAG : INTEGER;
      CARRY, INDEX : INTEGER;
   begin
      -- Check for overflow.
      if (RESULT.EXPONENT < MIN_EXPONENT_VALUE) then
         RESULT := ZERO;
      elsif (RESULT.EXPONENT > MAX_EXPONENT_VALUE) then
         raise MAE_SHORT_FLOAT_OVERFLOW;
      else
         -- Determine the position of the least signif bit (lsb)
         -- (which is inside of the least signif comp, lsc)
         -- in the array. The next bit is the guard bit.  The next
         -- is the sticky bit which is the logical or of all the
         -- bits after guard.
         LSC := ((SHORT_NUM_BITS - TARGET_SHORT_NUM_BITS) / NO_COMP_BITS) + 1;
         LSB := ((TARGET_SHORT_NUM_BITS-1) rem NO_COMP_BITS) + 1;

         if SHORT_FLOAT_MACHINE_ROUNDS then
            -- Get the value (0 or 1) of the lsb
            LSB_FLAG := ((C_RESULT(LSC) / BIT_VALUE(LSB)) rem 2);

            -- The guard bit is one bit after lsb.
            if LSB /= NO_COMP_BITS then
               GUARD := LSB + 1;
               GUARD_COMP := LSC;
            else
               GUARD := 1;
               GUARD_COMP := LSC - 1;
            end if;
            -- Get the guard bit value.
            GUARD_FLAG := ((C_RESULT(GUARD_COMP) / BIT_VALUE(GUARD)) rem 2);

            -- If guard bit equaled 0, then no rounding necessary.
            if GUARD_FLAG /= 0 then
               -- Otherwise determine the sticky bit
               if GUARD /= NO_COMP_BITS then
                  STICKY := GUARD + 1;
               else
                  STICKY := 1;
               end if;

               -- Initial sticky bit value is 0.
               STICKY_FLAG := 0;
               -- First check the remaining bits in the comp where
               -- the sticky bit is located.
               if (C_RESULT(GUARD_COMP) rem BIT_VALUE(GUARD)) /= 0 then
                  STICKY_FLAG := 1;
               else
                  -- Now check the remaining bits in the array
                  for I in GUARD_COMP+1 .. SHORT_NUM_COMPS loop
                     if C_RESULT(I) /= 0 then
                        STICKY_FLAG := 1;
                        exit;
                     end if;
                  end loop;
               end if;

               -- Check for round for (.5 <= x < 1), recall the guard bit=1.
               if (STICKY_FLAG = 1) or (LSB_FLAG = 1) then
                  C_RESULT(LSC) := C_RESULT(LSC) + BIT_VALUE(LSB);
                  -- Do an inline RANGE_CHECK
                  INDEX := LSC;
                  while C_RESULT(INDEX) > MAX_COMP_VALUE loop
                     CARRY := C_RESULT(INDEX) / BASE_COMP_VALUE;
                     C_RESULT(INDEX) := C_RESULT(INDEX) mod BASE_COMP_VALUE;
                     INDEX := INDEX + 1;
                     C_RESULT(INDEX) := C_RESULT(INDEX) + CARRY;
                     -- If it carries all the way up to the most
                     -- signif bit, divide the array by two and
                     -- bump the exponent.
                     if INDEX = SHORT_NUM_COMPS then
                        if C_RESULT(INDEX) > MAX_COMP_VALUE then
                           DIVIDE_ARRAY_BY_TWO(C_RESULT);
                           RESULT.EXPONENT := RESULT.EXPONENT + 1;
                        end if;
                     end if;
                  end loop;
               end if;
            end if;
         end if;

         -- Zero out the lower portion of the array
         C_RESULT(LSC) := (C_RESULT(LSC) / BIT_VALUE(LSB)) * BIT_VALUE(LSB);
         for I in 1 .. LSC-1 loop
            C_RESULT(I) := 0;
         end loop;

         RESULT.COMPS.COMPONENT_ARRAY := C_RESULT;
      end if;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ROUND_TO_TARGET;

------------------------------

   procedure NORMALIZE_SHORT_FLOAT (RESULT : in out MAE_SHORT_FLOAT_TYPE) is
      -- The purpose of this function is to normalize the
      -- the float type so as to maintain accuracy during
      -- computations.
      SHIFT_BITS : INTEGER := 0;
   begin
      ARRAY_NORMALIZE(RESULT.COMPS.COMPONENT_ARRAY, SHIFT_BITS);
      RESULT.EXPONENT := RESULT.EXPONENT - SHIFT_BITS;
   end NORMALIZE_SHORT_FLOAT;

------------------------------

   function ALIGN (ADD_VALUE : MAE_SHORT_FLOAT_TYPE; MATCH_EXP : INTEGER)
                                        return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to shift the intermediate,
      -- to be used in an add/subtract operation, so that the
      -- exponent equals the MATCH_EXP.
      INTERMEDIATE : MAE_SHORT_FLOAT_TYPE := ADD_VALUE;
      SHIFT_BITS : INTEGER;
   begin
      -- determine the number of bits to be shifted
      SHIFT_BITS := MATCH_EXP - INTERMEDIATE.EXPONENT;
      -- check if the number is shifted beyond significance
      if SHIFT_BITS >= SHORT_NUM_BITS then
         return ZERO;
      elsif SHIFT_BITS < 1 then
         raise MAE_NUMERIC_ERROR;
      else

         -- rounding may be needed here

         ARRAY_TRUNCATION_SHIFT_RIGHT(INTERMEDIATE.COMPS.COMPONENT_ARRAY,
                                          SHIFT_BITS);
         INTERMEDIATE.EXPONENT := MATCH_EXP;
         return INTERMEDIATE;
      end if;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ALIGN;

-------------------------------------------------------------------

   function "+"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to add two
      -- MAE_SHORT_FLOAT_TYPEs.
      RESULT, TEMP : MAE_SHORT_FLOAT_TYPE;
   begin
      -- zero check
      if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT := LEFT;
         NORMALIZE_SHORT_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      elsif LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT := RIGHT;
         NORMALIZE_SHORT_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      case (LEFT.SIGN xor RIGHT.SIGN) is
         -- The signs are different (subtraction)
         when TRUE =>
            if LEFT.EXPONENT > RIGHT.EXPONENT then
               TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
               RESULT.COMPS := LEFT.COMPS - TEMP.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := LEFT.SIGN;
            elsif LEFT.EXPONENT < RIGHT.EXPONENT then
               TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
               RESULT.COMPS := RIGHT.COMPS - TEMP.COMPS;
               RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            else
               if LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY then
                  RESULT.COMPS := LEFT.COMPS - RIGHT.COMPS;
                  RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
                  RESULT.SIGN := LEFT.SIGN;
               else
                  RESULT.COMPS := RIGHT.COMPS - LEFT.COMPS;
                  RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
                  RESULT.SIGN := RIGHT.SIGN;
               end if;
            end if;
         -- The signs are the same
         when FALSE =>
            if LEFT.EXPONENT > RIGHT.EXPONENT then
               TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
               RESULT.COMPS := LEFT.COMPS + TEMP.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := LEFT.SIGN;
            elsif LEFT.EXPONENT < RIGHT.EXPONENT then
               TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
               RESULT.COMPS := RIGHT.COMPS + TEMP.COMPS;
               RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            else
               RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            end if;

      end case;

      RESULT.COMPS.BITS_SHIFTED := 0;
      if RESULT.COMPS = ZERO.COMPS then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      end if;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "+";

------------------------------

   function "-"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to subtract two
      -- MAE_SHORT_FLOAT_TYPEs.
      RESULT : MAE_SHORT_FLOAT_TYPE;
   begin
      -- subtract is the same as add negative
      RESULT := LEFT + (-RIGHT);

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "-";

------------------------------

   function "*"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to multiply two
      -- MAE_SHORT_FLOAT_TYPEs.
      RESULT : MAE_SHORT_FLOAT_TYPE;
   begin
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) or
           (RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         return ZERO;
      -- one check
      elsif (LEFT = ONE) or (LEFT = -ONE) then
         RESULT.COMPS := RIGHT.COMPS;
         RESULT.EXPONENT := RIGHT.EXPONENT;
         NORMALIZE_SHORT_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      elsif (RIGHT = ONE) or (RIGHT = -ONE) then
         RESULT.COMPS := LEFT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT;
         NORMALIZE_SHORT_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      RESULT.COMPS := LEFT.COMPS * RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT + RIGHT.EXPONENT)
                             - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "*";

------------------------------

   function "/"    (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to divide two
      -- MAE_SHORT_FLOAT_TYPEs.
      RESULT : MAE_SHORT_FLOAT_TYPE;
   begin
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         raise MAE_NUMERIC_ERROR;
      elsif (LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         return ZERO;
      -- one check
      elsif (RIGHT = ONE) or (RIGHT = -ONE) then
         RESULT.COMPS := LEFT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT;
         NORMALIZE_SHORT_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      RESULT.COMPS := LEFT.COMPS / RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT - RIGHT.EXPONENT)
                            - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "/";

------------------------------

   function MULT (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to multiply two
      -- MAE_SHORT_FLOAT_TYPEs without rounding to the target
      -- precision.  This allows the exponentiation and
      -- string conversion routines to maintain accuracy.
      RESULT : MAE_SHORT_FLOAT_TYPE;
   begin
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      RESULT.COMPS := LEFT.COMPS * RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT + RIGHT.EXPONENT)
                             - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end MULT;

------------------------------

   function ADD (LEFT,RIGHT : MAE_SHORT_FLOAT_TYPE)
                       return MAE_SHORT_FLOAT_TYPE is
      -- The purpose of this function is to add two
      -- MAE_SHORT_FLOAT_TYPEs without rounding to the target
      -- precision.  This allows the exponentiation and
      -- string conversion routines to maintain accuracy.
      -- Since it has a specialized operation, both operator
      -- signs are assumed positive.
      RESULT, TEMP : MAE_SHORT_FLOAT_TYPE;
   begin
      -- The signs are the same
      if LEFT.EXPONENT > RIGHT.EXPONENT then
         TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
         RESULT.COMPS := LEFT.COMPS + TEMP.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      elsif LEFT.EXPONENT < RIGHT.EXPONENT then
         TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
         RESULT.COMPS := RIGHT.COMPS + TEMP.COMPS;
         RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      else
         RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      end if;

      RESULT.SIGN := POS_SIGN;
      RESULT.COMPS.BITS_SHIFTED := 0;
      if RESULT.COMPS = ZERO.COMPS then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      end if;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ADD;

------------------------------

   function "**"   (LEFT : MAE_SHORT_FLOAT_TYPE; RIGHT : INTEGER)
                       return MAE_SHORT_FLOAT_TYPE is
   -- The purpose of this function is to raise a MAE_SHORT_FLOAT_TYPE
   -- to a given power.  A simple loop with a multiplication could
   -- be done the given number, less one, times.  This method is
   -- inefficient, therefore a different algorithm is used.
   -- The use of additional memory to hold intermediate
   -- calculations will improve performance by reducing
   -- the number of multiplications.
      COUNT : INTEGER := RIGHT;
      REM_COUNT : INTEGER := RIGHT;
      RESULT : MAE_SHORT_FLOAT_TYPE;
      POWER_2, POWER_4, POWER_8 : MAE_SHORT_FLOAT_TYPE := ZERO;
      NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
   begin
      -- If the power is less than 0, set a flag that will determine
      -- if the result is to be inverted.
      if (COUNT < 0) then
         if LEFT = ZERO then
            raise MAE_NUMERIC_ERROR;
         end if;
         if COUNT = -1 then
            RESULT := ONE / LEFT;
            return RESULT;
         end if;
         NEG_SIGN_EXP_FLAG := TRUE;
         COUNT := abs(COUNT);
         REM_COUNT := COUNT;
      end if;
      -- if the power is 0, return 1
      if COUNT = 0 then return ONE;
      -- if the power is 1 or the number is 0 or 1, return the input number
      elsif (COUNT = 1) or (LEFT = ONE) or (LEFT = ZERO) then return LEFT;
      elsif COUNT > TWO_THREE_LESS_ONE then
         -- compute to POWER_8
         POWER_2 := MULT(LEFT, LEFT);
         POWER_4 := MULT(POWER_2, POWER_2);
         POWER_8 := MULT(POWER_4, POWER_4);
         RESULT := POWER_8;
         REM_COUNT := REM_COUNT - 8;
      elsif COUNT > TWO_TWO_LESS_ONE then
         -- compute to POWER_4
         POWER_2 := MULT(LEFT, LEFT);
         POWER_4 := MULT(POWER_2, POWER_2);
         RESULT := POWER_4;
         REM_COUNT := REM_COUNT - 4;
      else
         -- compute to POWER_2
         POWER_2 := MULT(LEFT, LEFT);
         RESULT := POWER_2;
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- the pre-computed values are now used to build
      -- to the answer

      -- loop until the power is reduced to under the
      -- maximum pre-computed value
      loop
         if REM_COUNT < TWO_THREE then
           exit;
         end if;
         RESULT := MULT(RESULT, POWER_8);
         REM_COUNT := REM_COUNT - 8;
      end loop;

      -- the remaining power may be between 4 .. 7
      if REM_COUNT > TWO_TWO_LESS_ONE then
         RESULT := MULT(RESULT, POWER_4);
         REM_COUNT := REM_COUNT - 4;
      end if;

      -- the remaining power may be between 2 .. 3
      if REM_COUNT > 1 then
         RESULT := MULT(RESULT, POWER_2);
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- The remaining power may be 1, therefore the sign
      -- is negative if the input number is negative
      if REM_COUNT = 1 then
         RESULT := MULT(RESULT, LEFT);
      end if;

      -- If exponent was negative, the result is inverted
      if NEG_SIGN_EXP_FLAG then
         RESULT := ONE / RESULT;
      end if;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "**";

------------------------------

   procedure GET(FROM : in STRING;
                 ITEM : out MAE_SHORT_FLOAT_TYPE;
                 LAST : out POSITIVE) is
   -- The purpose of this function is to convert a string
   -- of characters into the MAE_SHORT_FLOAT_TYPE structure.
   -- The string is valid if an only if it conforms to the
   -- format specified by the LRM
   --
   -- FORE . AFT
   -- FORE . AFT E EXP
   -- where
   --    FORE : decimal digits, optional leading spaces,
   --            and a minus sign for negative values
   --    "."  : the decimal point
   --    AFT  : decimal digits
   --    EXP  : sign (plus or minus) and exponent
   --
   -- and is within the specified range for
   -- MAE_SHORT_FLOAT_TYPEs.
      INDEX : INTEGER;
      RESULT, TEMP, MULTIPLIER : MAE_SHORT_FLOAT_TYPE;
      NEG_SIGN_FLAG : BOOLEAN := FALSE;
      FRACTION_FLAG, EXPONENT_FLAG, NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
      EMPTY_FLAG : BOOLEAN := TRUE;
      S_PTR, POWER_OF_TEN, BASE_TEN_EXP : INTEGER := 0;

   begin
      -- Strip leading spaces if necessary
      INDEX := FROM'first;
      for I in FROM'first .. FROM'last loop
         if FROM(I) /= ' ' then
            exit;
         else
            INDEX := INDEX + 1;
         end if;
         -- if the string is empty
         if INDEX > FROM'last then
            raise MAE_FORMAT_ERROR;
         end if;
      end loop;

      -- Set the sign flag(assigned to the result sign before exiting).
      if FROM(INDEX) = '-' then
         NEG_SIGN_FLAG := TRUE;
         INDEX := INDEX + 1;
      elsif FROM(INDEX) = '+' then
         INDEX := INDEX + 1;
      end if;

      -- if the string is empty
      if INDEX > FROM'last then
         raise MAE_FORMAT_ERROR;
      end if;

      -- Store the integer portion

      for I in INDEX .. FROM'last loop
         S_PTR := I;

         case FROM(I) is
            when '0' .. '9' =>
               -- Multiply old result by ten and add in the digit
               -- (recall that MULT is multiply, ADD is add)

               RESULT := MULT(RESULT, TEN);
               case FROM(I) is

                  when '0' => null;
                  when '1' => RESULT := ADD(RESULT, ONE);
                  when '2' => RESULT := ADD(RESULT, TWO);
                  when '3' => RESULT := ADD(RESULT, THREE);
                  when '4' => RESULT := ADD(RESULT, FOUR);
                  when '5' => RESULT := ADD(RESULT, FIVE);
                  when '6' => RESULT := ADD(RESULT, SIX);
                  when '7' => RESULT := ADD(RESULT, SEVEN);
                  when '8' => RESULT := ADD(RESULT, EIGHT);
                  when '9' => RESULT := ADD(RESULT, NINE);
                  when others => raise MAE_FORMAT_ERROR;
               end case;
               -- Once a digit is encountered set empty false
               EMPTY_FLAG := FALSE;
               -- If the digit followed the decimal point increase
               -- the exponent counter
               if FRACTION_FLAG then
                  POWER_OF_TEN := POWER_OF_TEN + 1;
               end if;

            when ' ' =>
               -- If there is a space, before a digit, after the sign
               -- exception, else check if it is the end of the number
               if EMPTY_FLAG then
                  -- spaces after the sign
                  raise MAE_FORMAT_ERROR;
               else
                  for J in I+1 .. FROM'last loop
                     if FROM(J) /= ' ' then
                        raise MAE_FORMAT_ERROR;
                     end if;
                  end loop;
                  exit;
               end if;

            when '.' =>
               if FRACTION_FLAG or EMPTY_FLAG then
                  -- two decimal points, or leading point
                  raise MAE_FORMAT_ERROR;
               else
                  FRACTION_FLAG := TRUE;
               end if;

            when 'e' | 'E' =>
               if EMPTY_FLAG then
                  -- no decimal number
                  raise MAE_FORMAT_ERROR;
               else
                  -- Set the exponent flag on
                  EXPONENT_FLAG := TRUE;
                  exit;
               end if;

            when others => raise MAE_FORMAT_ERROR;
         end case;
      end loop;

      -- Set the sign
      if NEG_SIGN_FLAG then
         RESULT.SIGN := NEG_SIGN;
      else
         RESULT.SIGN := POS_SIGN;
      end if;


      -- If the string contained the 'E' determine the exponent
      if EXPONENT_FLAG then
         EMPTY_FLAG := TRUE;

         -- Check the sign
         S_PTR := S_PTR + 1;
         if FROM(S_PTR) = '-' then
            NEG_SIGN_EXP_FLAG := TRUE;
            INDEX := INDEX + 1;
         elsif FROM(S_PTR) = '+' then
            INDEX := INDEX + 1;
         else
            raise MAE_NUMERIC_ERROR;
         end if;


         for I in S_PTR+1 .. FROM'last loop

            case FROM(I) is
               when '0' .. '9' =>
                  case FROM(I) is

                     when '0' => BASE_TEN_EXP := BASE_TEN_EXP*10;
                     when '1' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 1;
                     when '2' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 2;
                     when '3' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 3;
                     when '4' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 4;
                     when '5' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 5;
                     when '6' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 6;
                     when '7' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 7;
                     when '8' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 8;
                     when '9' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 9;
                     when others => raise MAE_FORMAT_ERROR;
                  end case;
                  EMPTY_FLAG := FALSE;

               when ' ' =>
                  if EMPTY_FLAG then
                     -- no exponent number
                    raise MAE_FORMAT_ERROR;
                  else
                     for J in I+1 .. FROM'last loop
                        if FROM(J) /= ' ' then
                           raise MAE_FORMAT_ERROR;
                        end if;
                     end loop;
                     exit;
                  end if;

               when others => raise MAE_FORMAT_ERROR;

            end case;
         end loop;
      end if;

      if EMPTY_FLAG or (POWER_OF_TEN = 0) then
         -- either (no number) or (no exponent) or (no fraction)
         raise MAE_FORMAT_ERROR;
      end if;

      if RESULT.COMPS = ZERO.COMPS then
         ITEM := ZERO;
      else
         -- If the base ten exponent was negative.
         if NEG_SIGN_EXP_FLAG then
            BASE_TEN_EXP := -BASE_TEN_EXP;
         end if;

         -- Now we must adjust the base ten exponent by the number of
         -- digits that follow the decimal point in the string.
         BASE_TEN_EXP := BASE_TEN_EXP - POWER_OF_TEN;

         -- If the input base ten exponent needs to be translated
         -- into a base two exponent, use the "and" routine to
         -- multiply but round after the final multiply.
         if BASE_TEN_EXP /= 0 then
           if BASE_TEN_EXP > 0 then
               while BASE_TEN_EXP >= 4 loop
                  RESULT := MULT(RESULT, TEN_THOUSAND);
                  BASE_TEN_EXP := BASE_TEN_EXP - 4;
               end loop;
               if BASE_TEN_EXP = 3 then
                  RESULT := MULT(RESULT, THOUSAND);
               end if;
               if BASE_TEN_EXP = 2 then
                  RESULT := MULT(RESULT, HUNDRED);
               end if;
               if BASE_TEN_EXP = 1 then
                  RESULT := MULT(RESULT, TEN);
               end if;
            else
               while BASE_TEN_EXP <= -4 loop
                  RESULT := MULT(RESULT, ONE_TEN_THOUSANDTH);
                  BASE_TEN_EXP := BASE_TEN_EXP + 4;
               end loop;
               if BASE_TEN_EXP = -3 then
                  RESULT := MULT(RESULT, ONE_THOUSANDTH);
               end if;
               if BASE_TEN_EXP = -2 then
                  RESULT := MULT(RESULT, ONE_HUNDREDTH);
               end if;
               if BASE_TEN_EXP = -1 then
                  RESULT := MULT(RESULT, ONE_TENTH);
               end if;
            end if;
         end if;

         ROUND_TO_TARGET(RESULT);

         ITEM := RESULT;
      end if;

      LAST := FROM'last;


   exception
      when others =>
         raise DATA_ERROR;

   end GET;

------------------------------

   procedure MULT_BY_TEN (RESULT : in out COMPONENT_ARRAY_TYPE) is
      -- This routine is used by the binary to ASCII conversion
      -- (PUT) to extract the next digit by multiplying the
      -- array by ten, thus the digit is the most signif
      -- comp of the array "integer divided" by ten.
   begin
      for I in RESULT'first .. RESULT'last loop
         RESULT(I) := RESULT(I) * 10;
      end loop;
      RANGE_CHECK(RESULT);

   end MULT_BY_TEN;

------------------------------
   procedure PUT(TO : out STRING;
                 ITEM : in MAE_SHORT_FLOAT_TYPE;
                 AFT : in FIELD := SHORT_DEFAULT_AFT;
                 EXP : in FIELD := SHORT_DEFAULT_EXP) is
      -- The purpose of this function is to convert a
      -- MAE_SHORT_FLOAT_TYPE into string of characters.
      COMP_PTR, INDEX : INTEGER;
      RESULT : MAE_SHORT_FLOAT_TYPE := ITEM;
      WORK_ARRAY : SHORT_COMPONENT_ARRAY;
      TEMP_CHAR : STRING (1 .. 1);
      TEMP_VALUE : INTEGER;
      STRING_PIC : STRING (1 .. SHORT_FLOAT_DIGITS+1) :=
                      EMPTY_STRING(1 .. SHORT_FLOAT_DIGITS+1);
      DECIMAL_VALUE, OFFSET, OFFSET_BITS, POWER_OF_TEN : INTEGER := 0;

      LSB : INTEGER := (NO_COMP_BITS + 1 + (2*(SHORT_FLOAT_DIGITS)));
      LSC, BIT_IN_LSC : INTEGER;

      NEG_SIGN_FLAG, NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
      DISPLAY_DIGITS : INTEGER := 0;
      FIRST_DIGIT : BOOLEAN := TRUE;

      TO_INDEX : INTEGER := 0;
      EXPONENT_STRING : STRING (1 .. 4) := "   0";
      EXPONENT_INDEX : INTEGER := 0;
      EXPONENT_LENGTH : INTEGER := 1;

      ALMOST_ZERO : MAE_SHORT_FLOAT_TYPE := ZERO;

      ACTUAL_FORE : INTEGER := 1;
      ACTUAL_AFT : INTEGER := AFT;
      ACTUAL_EXP : INTEGER := EXP;

      FORE_FIELD_ZERO_FLAG : BOOLEAN := FALSE;
      FORE_WIDTH_DIGITS_BEYOND_PRECISION : INTEGER := 0;
      AFT_WIDTH_DIGITS_BEYOND_PRECISION : INTEGER := 0;
      AFT_LEADING_ZERO_DIGITS : INTEGER := 0;
      SIGNIFICANT_AFT : INTEGER := 0;

   begin
      TO(TO'first .. TO'last) := EMPTY_STRING(1 .. TO'length);

      -- The variable INDEX is the pointer into the string.
      INDEX := STRING_PIC'first;

      -- Check for zero.
      if RESULT.COMPS /= ZERO.COMPS then

         -- Store the sign
         if RESULT.SIGN = NEG_SIGN then
            NEG_SIGN_FLAG := TRUE;
            RESULT.SIGN := POS_SIGN;
         end if;

         -- Determine the base ten exponent by forcing the result
         -- into the range .1 <= x < 1., and tracking the count.
         POWER_OF_TEN := -1;
         if RESULT < ONE then
            while RESULT < ONE_TEN_THOUSANDTH loop
               RESULT := MULT(RESULT, TEN_THOUSAND);
               POWER_OF_TEN := POWER_OF_TEN - 4;
            end loop;
            if RESULT < ONE_THOUSANDTH then
               RESULT := MULT(RESULT, THOUSAND);
               POWER_OF_TEN := POWER_OF_TEN - 3;
            end if;
            if RESULT < ONE_HUNDREDTH then
               RESULT := MULT(RESULT, HUNDRED);
               POWER_OF_TEN := POWER_OF_TEN - 2;
            end if;
            if RESULT < ONE_TENTH then
               RESULT := MULT(RESULT, TEN);
               POWER_OF_TEN := POWER_OF_TEN - 1;
            end if;
         else
            while RESULT >= THOUSAND loop
               RESULT := MULT(RESULT, ONE_TEN_THOUSANDTH);
               POWER_OF_TEN := POWER_OF_TEN + 4;
            end loop;
            if RESULT >= HUNDRED then
               RESULT := MULT(RESULT, ONE_THOUSANDTH);
               POWER_OF_TEN := POWER_OF_TEN + 3;
            end if;
            if RESULT >= TEN then
               RESULT := MULT(RESULT, ONE_HUNDREDTH);
               POWER_OF_TEN := POWER_OF_TEN + 2;
            end if;
            if RESULT >= ONE then
               RESULT := MULT(RESULT, ONE_TENTH);
               POWER_OF_TEN := POWER_OF_TEN + 1;
            end if;
         end if;

         -- Store the integer portion
         -- The OFFSET corrects the decimal value with respect to the
         -- RESULT.EXPONENT which must equal (0 | -1 | -2 | -3)
         OFFSET_BITS := -RESULT.EXPONENT;
         OFFSET := BASE_COMP_VALUE * (2**(OFFSET_BITS));

         -- Loop over the MAE_NUMBER taking the most significant
         -- decimal digit and storing it in the array(forewards)
         WORK_ARRAY := RESULT.COMPS.COMPONENT_ARRAY;
         -- The variable ALMOST_ZERO is zero thru all significant bits
         while (WORK_ARRAY > ALMOST_ZERO.COMPS.COMPONENT_ARRAY) loop
            -- Determine where the scaled least signif bit is located
            LSC := ((SHORT_NUM_BITS - LSB) / NO_COMP_BITS) + 1;
            BIT_IN_LSC := ((LSB-1) rem NO_COMP_BITS) + 1;
            -- The least signif bit is scaled down by two bits
            -- instead of the true inverse log(2) which is approx 3.322
            -- since the original LSB is less than TARGET_SHORT_NUM_BITS.
            LSB := LSB - 2;
            ALMOST_ZERO.COMPS.COMPONENT_ARRAY(LSC) := BIT_VALUE(BIT_IN_LSC);
            ALMOST_ZERO.COMPS.COMPONENT_ARRAY(LSC-1) := 0;

            MULT_BY_TEN(WORK_ARRAY);

            -- If the rest of the number(significant) is all nines, round up.
            if (WORK_ARRAY(WORK_ARRAY'last) rem BASE_COMP_VALUE) =
                                 MAX_COMP_VALUE then
               COMP_PTR := WORK_ARRAY'last - 1;
               while WORK_ARRAY(COMP_PTR) = MAX_COMP_VALUE loop
                  COMP_PTR := COMP_PTR - 1;
                  if COMP_PTR <= LSC then
                     if (WORK_ARRAY(LSC) / BIT_VALUE(BIT_IN_LSC)) =
                            (MAX_COMP_VALUE / BIT_VALUE(BIT_IN_LSC)) then
                        -- Instead of adding a rounding value just set to
                        -- BASE_COMP_VALUE since either case will produce
                        -- a remaining number less than ALMOST_ZERO
                        WORK_ARRAY(LSC) := BASE_COMP_VALUE;
                        RANGE_CHECK(WORK_ARRAY);
                     end if;
                     exit;
                  end if;
               end loop;
            end if;

            -- Extract the decimal value from the array.
            DECIMAL_VALUE := WORK_ARRAY(WORK_ARRAY'last) / OFFSET;
            WORK_ARRAY(WORK_ARRAY'last) := WORK_ARRAY(WORK_ARRAY'last) -
                                              (DECIMAL_VALUE * OFFSET);

            -- The next check is valid the first time thru the loop
            -- and remedies the .99999999999 ...    case.
            if FIRST_DIGIT then
               FIRST_DIGIT := FALSE;
               if DECIMAL_VALUE = 10 then
                  STRING_PIC(INDEX) := '1';
                  INDEX := INDEX + 1;
                  POWER_OF_TEN := POWER_OF_TEN + 1;
                  exit;
               end if;
            end if;

            -- Get the ASCII value of the decimal value
            -- and store it in the string
            TEMP_CHAR := INTEGER'image(DECIMAL_VALUE);
            STRING_PIC(INDEX) := TEMP_CHAR(1);
            INDEX := INDEX + 1;

            -- If the (display number+1) decimal digits are in the string.
            if (INDEX=STRING_PIC'last+1) or (LSB<=NO_COMP_BITS) then
               exit;
            end if;
         end loop;
      end if;

      for I in INDEX .. STRING_PIC'last loop
         STRING_PIC(I) := '0';
      end loop;

      if AFT = 0 then
         ACTUAL_AFT := 1;
      end if;
      if EXP = 1 then
         ACTUAL_EXP := 2;
      end if;

      -- determine the number of digits to produce
      if ACTUAL_EXP /= 0 then
         -- ACTUAL_FORE must equal one
         if (ACTUAL_FORE + ACTUAL_AFT) <= SHORT_FLOAT_DIGITS then
            DISPLAY_DIGITS := ACTUAL_FORE + ACTUAL_AFT;
         else
            DISPLAY_DIGITS := SHORT_FLOAT_DIGITS;
            AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                    ACTUAL_AFT - (SHORT_FLOAT_DIGITS - ACTUAL_FORE);
            ACTUAL_AFT := (SHORT_FLOAT_DIGITS - ACTUAL_FORE);
         end if;
      else
         if POWER_OF_TEN >= 0 then
            ACTUAL_FORE := POWER_OF_TEN + 1;
            if (ACTUAL_FORE + ACTUAL_AFT) <= SHORT_FLOAT_DIGITS then
               DISPLAY_DIGITS := ACTUAL_FORE + ACTUAL_AFT;
            else
               DISPLAY_DIGITS := SHORT_FLOAT_DIGITS;
               AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                    ACTUAL_AFT - (SHORT_FLOAT_DIGITS - ACTUAL_FORE);
               if AFT_WIDTH_DIGITS_BEYOND_PRECISION >= ACTUAL_AFT then
                  AFT_WIDTH_DIGITS_BEYOND_PRECISION := ACTUAL_AFT;
                  ACTUAL_AFT := 0;
                  FORE_WIDTH_DIGITS_BEYOND_PRECISION :=
                       ACTUAL_FORE - SHORT_FLOAT_DIGITS;
                  ACTUAL_FORE := SHORT_FLOAT_DIGITS;
               else
                  ACTUAL_AFT := (SHORT_FLOAT_DIGITS - ACTUAL_FORE);
               end if;
            end if;
         else
            -- ACTUAL_FORE must equal one, with a value of zero
            FORE_FIELD_ZERO_FLAG := TRUE;
            AFT_LEADING_ZERO_DIGITS := abs(POWER_OF_TEN+1);
            SIGNIFICANT_AFT := ACTUAL_AFT - AFT_LEADING_ZERO_DIGITS;
            if SIGNIFICANT_AFT <= SHORT_FLOAT_DIGITS then
               DISPLAY_DIGITS := SIGNIFICANT_AFT;
               if SIGNIFICANT_AFT <= 0 then
                  AFT_LEADING_ZERO_DIGITS := ACTUAL_AFT;
                  ACTUAL_AFT := 0;
               elsif SIGNIFICANT_AFT > 0 then
                  ACTUAL_AFT := SIGNIFICANT_AFT;
               end if;
            else
               DISPLAY_DIGITS := SHORT_FLOAT_DIGITS;
               AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                  SIGNIFICANT_AFT - SHORT_FLOAT_DIGITS;
               ACTUAL_AFT := SHORT_FLOAT_DIGITS;
            end if;
         end if;
      end if;

      if DISPLAY_DIGITS > 0 then
         -- Round the digit in the last-1 position using the last digit.
         INDEX := DISPLAY_DIGITS + 1;
         if STRING_PIC(INDEX) >= '5' then
            STRING_PIC(INDEX) := '0';
            INDEX := INDEX - 1;
            STRING_PIC(INDEX) := CHARACTER'succ(STRING_PIC(INDEX));
            while STRING_PIC(INDEX) > '9' loop
               if INDEX = STRING_PIC'first then
                  -- rounding to outside array can only occur if
                  -- with FORE=1, value=0
                  STRING_PIC(INDEX) := '1';
                  POWER_OF_TEN := POWER_OF_TEN + 1;
                  if POWER_OF_TEN = 0 then
                     FORE_FIELD_ZERO_FLAG := FALSE;
                  elsif AFT_LEADING_ZERO_DIGITS > 0 then
                     AFT_LEADING_ZERO_DIGITS := AFT_LEADING_ZERO_DIGITS - 1;
                     AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                               AFT_WIDTH_DIGITS_BEYOND_PRECISION + 1;
                  end if;
                  exit;
               end if;

               STRING_PIC(INDEX) := '0';
               INDEX := INDEX - 1;
               STRING_PIC(INDEX) := CHARACTER'succ(STRING_PIC(INDEX));
            end loop;
            INDEX := INDEX + 1;
         else
            STRING_PIC(INDEX) := '0';
         end if;
      elsif DISPLAY_DIGITS = 0 then
         if STRING_PIC(STRING_PIC'first) >= '5' then
            STRING_PIC(STRING_PIC'first) := '1';
            POWER_OF_TEN := POWER_OF_TEN + 1;
            if POWER_OF_TEN = 0 then
               FORE_FIELD_ZERO_FLAG := FALSE;
            else
               AFT_LEADING_ZERO_DIGITS := AFT_LEADING_ZERO_DIGITS - 1;
               ACTUAL_AFT := 1;
            end if;
         end if;
      end if;

      if (ACTUAL_EXP = 0) then
         -- fill the string in reverse
         TO_INDEX := TO'last;
         if FORE_FIELD_ZERO_FLAG then
            -- fore field is zero
            -- store the aft field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in 1 .. AFT_LEADING_ZERO_DIGITS loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := '0';
            TO_INDEX := TO_INDEX - 1;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         else
            -- non-zero fore field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(ACTUAL_FORE+I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            for I in 1 .. FORE_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_FORE loop
               TO(TO_INDEX) := STRING_PIC(I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         end if;
      else
         if STRING_PIC(STRING_PIC'first) = '0' then
            -- zero string, the length includes leading zero,
            -- '.', AFT, 'E', EXP
            TO_INDEX := TO'last - (2 + ACTUAL_AFT + ACTUAL_EXP);
            TO(TO_INDEX) := '0';
            TO_INDEX := TO_INDEX + 1;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX + 1;
            -- fill out the aft field
            for I in 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX + 1;
            end loop;
            TO(TO_INDEX) := 'E';
            TO_INDEX := TO_INDEX + 1;
            TO(TO_INDEX) := '+';
            TO_INDEX := TO_INDEX + 1;
            -- fill out the exponent field
            for I in 1 .. ACTUAL_EXP-1 loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX + 1;
            end loop;
         else
            -- If there is an exponent, store it in the string.
            if POWER_OF_TEN /= 0 then
               if POWER_OF_TEN < 0 then
                  NEG_SIGN_EXP_FLAG := TRUE;
                  POWER_OF_TEN := abs(POWER_OF_TEN);
               end if;

               -- determine the base ten exponent
               -- fill the string in reverse
               EXPONENT_INDEX := EXPONENT_STRING'last;
               while POWER_OF_TEN /= 0 loop
                  TEMP_VALUE := POWER_OF_TEN rem 10;
                  POWER_OF_TEN := POWER_OF_TEN / 10;
                  TEMP_CHAR := INTEGER'image(TEMP_VALUE);
                  EXPONENT_STRING(EXPONENT_INDEX) := TEMP_CHAR(1);
                  EXPONENT_INDEX := EXPONENT_INDEX - 1;
               end loop;
               EXPONENT_LENGTH := EXPONENT_STRING'last - EXPONENT_INDEX;
            end if;

            -- fill the string in reverse
            TO_INDEX := TO'last;
            -- store the exponent field
            for I in 1 .. EXPONENT_LENGTH loop
               TO(TO_INDEX) := EXPONENT_STRING((EXPONENT_STRING'last+1)-I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            -- fill out the exponent field
            for I in EXPONENT_LENGTH+1 .. ACTUAL_EXP-1 loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            if NEG_SIGN_EXP_FLAG then
               TO(TO_INDEX) := '-';
            else
               TO(TO_INDEX) := '+';
            end if;
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := 'E';
            TO_INDEX := TO_INDEX - 1;
            -- store the aft field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(I+1);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := STRING_PIC(STRING_PIC'first);
            TO_INDEX := TO_INDEX - 1;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         end if;
      end if;

   exception
      when others =>
         raise LAYOUT_ERROR;

   end PUT;

-------------------------------
-- The body of the package
--
begin
   -- Initialize the digits ONE .. TEN with the DIGIT_PICTURE
   -- and DIGIT_BINARY_EXPONENT arrays, and initialize ONE_TENTH
   -- with an array specified in MAE_BASIC_OPERATIONS.  This allows
   -- for the length of the array to change in the basic operations
   -- and not caused a coding change in this package.
   -- Notice that these values assume the declaration of the type
   -- is initially a zero value.  This assumption is justified since
   -- the declaration of the type is in this package specification.
   -- ZERO taken care of by the initial value.
   ONE.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(1);
   ONE.EXPONENT := DIGIT_BINARY_EXPONENT(1);
   TWO.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(2);
   TWO.EXPONENT := DIGIT_BINARY_EXPONENT(2);
   THREE.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(3);
   THREE.EXPONENT := DIGIT_BINARY_EXPONENT(3);
   FOUR.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(4);
   FOUR.EXPONENT := DIGIT_BINARY_EXPONENT(4);
   FIVE.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(5);
   FIVE.EXPONENT := DIGIT_BINARY_EXPONENT(5);
   SIX.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(6);
   SIX.EXPONENT := DIGIT_BINARY_EXPONENT(6);
   SEVEN.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(7);
   SEVEN.EXPONENT := DIGIT_BINARY_EXPONENT(7);
   EIGHT.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(8);
   EIGHT.EXPONENT := DIGIT_BINARY_EXPONENT(8);
   NINE.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(9);
   NINE.EXPONENT := DIGIT_BINARY_EXPONENT(9);
   TEN.COMPS.COMPONENT_ARRAY(SHORT_NUM_COMPS) := DIGIT_PICTURE(10);
   TEN.EXPONENT := DIGIT_BINARY_EXPONENT(10);


   HUNDRED.COMPS := TEN.COMPS * TEN.COMPS;
   HUNDRED.EXPONENT := (TEN.EXPONENT + TEN.EXPONENT)
                            - HUNDRED.COMPS.BITS_SHIFTED;
   HUNDRED.COMPS.BITS_SHIFTED := 0;

   THOUSAND.COMPS := HUNDRED.COMPS * TEN.COMPS;
   THOUSAND.EXPONENT := (HUNDRED.EXPONENT + TEN.EXPONENT)
                            - THOUSAND.COMPS.BITS_SHIFTED;
   THOUSAND.COMPS.BITS_SHIFTED := 0;

   TEN_THOUSAND.COMPS := THOUSAND.COMPS * TEN.COMPS;
   TEN_THOUSAND.EXPONENT := (THOUSAND.EXPONENT + TEN.EXPONENT)
                            - TEN_THOUSAND.COMPS.BITS_SHIFTED;
   TEN_THOUSAND.COMPS.BITS_SHIFTED := 0;


   ONE_TENTH.COMPS := ONE.COMPS / TEN.COMPS;
   ONE_TENTH.EXPONENT := (ONE.EXPONENT - TEN.EXPONENT)
                            - ONE_TENTH.COMPS.BITS_SHIFTED;
   ONE_TENTH.COMPS.BITS_SHIFTED := 0;

   ONE_HUNDREDTH.COMPS := ONE_TENTH.COMPS / TEN.COMPS;
   ONE_HUNDREDTH.EXPONENT := (ONE_TENTH.EXPONENT - TEN.EXPONENT)
                            - ONE_HUNDREDTH.COMPS.BITS_SHIFTED;
   ONE_HUNDREDTH.COMPS.BITS_SHIFTED := 0;

   ONE_THOUSANDTH.COMPS := ONE_HUNDREDTH.COMPS / TEN.COMPS;
   ONE_THOUSANDTH.EXPONENT := (ONE_HUNDREDTH.EXPONENT - TEN.EXPONENT)
                            - ONE_THOUSANDTH.COMPS.BITS_SHIFTED;
   ONE_THOUSANDTH.COMPS.BITS_SHIFTED := 0;

   ONE_TEN_THOUSANDTH.COMPS := ONE_THOUSANDTH.COMPS / TEN.COMPS;
   ONE_TEN_THOUSANDTH.EXPONENT := (ONE_THOUSANDTH.EXPONENT - TEN.EXPONENT)
                            - ONE_TEN_THOUSANDTH.COMPS.BITS_SHIFTED;
   ONE_TEN_THOUSANDTH.COMPS.BITS_SHIFTED := 0;


   MAE_SHORT_FLOAT_EPSILON := (TWO**(-(TARGET_SHORT_NUM_BITS-1)));
   MAE_SHORT_FLOAT_LARGE := ((TWO**(MAX_EXPONENT_VALUE-1)) -
               (TWO**(MAX_EXPONENT_VALUE-(TARGET_SHORT_NUM_BITS))))
               *TWO;
   MAE_SHORT_FLOAT_SMALL := (TWO**(MIN_EXPONENT_VALUE-1));
   MAE_SHORT_FLOAT_LAST := MAE_SHORT_FLOAT_LARGE;
   MAE_SHORT_FLOAT_FIRST := -MAE_SHORT_FLOAT_LARGE;

end MAE_SHORT_FLOAT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--maelong.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-------------------------------------------------------------------------------
--                                                                           --
--             Emulation of Machine Arithmetic - a WIS Ada Tool              --
--                                                                           --
--                         Ada Technology Group                              --
--                         SYSCON Corporation                                --
--                         3990 Sherman Street                               --
--                         San Diego, CA. 92110                              --
--                                                                           --
--                        John Long & John Reddan                            --
--                                                                           --
-------------------------------------------------------------------------------

with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package MAE_LONG_FLOAT is
-------------------------------------------------------------------
-- The purpose of this package is to emulate target machine
-- double precision floating point arithmetic on host machines
-- with 16-bit or larger words.
--
-- The range of the supported type is as follows:
--
--     TARGET_LONG_FLOAT (Double Precision Real)
--        approximate range of 10**-38 to 10**38 and 0
--        mantissa => MAE_BASIC_OPERATIONS.TARGET_LONG_NUM_BITS
--                    bit binary fraction
--        exponent => -128 to 127
--
--
-- Any errors which occur during use of the arithmetic and
-- boolean functions defined below will result in the
-- raising of the exception "MAE_NUMERIC_ERROR".

-----------------------------------------------------------------
-- Visible operations with MAE_LONG_FLOAT_TYPE
--
   type MAE_LONG_FLOAT_TYPE is private;

   -- The defined operators for this type are as follows:

   -- predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN;
   function "<="   (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN;
   function ">"    (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN;
   function ">="   (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN;

   function "+"    (RIGHT : MAE_LONG_FLOAT_TYPE) return MAE_LONG_FLOAT_TYPE;
   function "-"    (RIGHT : MAE_LONG_FLOAT_TYPE) return MAE_LONG_FLOAT_TYPE;
   function "abs"  (RIGHT : MAE_LONG_FLOAT_TYPE) return MAE_LONG_FLOAT_TYPE;

   function "+"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE;
   function "-"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE;
   function "*"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE;
   function "/"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE;

   function "**"   (LEFT : MAE_LONG_FLOAT_TYPE; RIGHT : INTEGER)
                       return MAE_LONG_FLOAT_TYPE;


   procedure GET (FROM : in STRING;
                  ITEM : out MAE_LONG_FLOAT_TYPE;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in MAE_LONG_FLOAT_TYPE;
                  AFT : in FIELD := LONG_DEFAULT_AFT;
                  EXP : in FIELD := LONG_DEFAULT_EXP);

   function TARGET_LONG_FLOAT_EPSILON return MAE_LONG_FLOAT_TYPE;

   function TARGET_LONG_FLOAT_LARGE return MAE_LONG_FLOAT_TYPE;

   function TARGET_LONG_FLOAT_SMALL return MAE_LONG_FLOAT_TYPE;

   function TARGET_LONG_FLOAT_LAST return MAE_LONG_FLOAT_TYPE;

   function TARGET_LONG_FLOAT_FIRST return MAE_LONG_FLOAT_TYPE;


-------------------------------------------------------------------
private

-- The declaration of the next variable is to allow
-- the record declaration under the Telesoft version 1.5 compiler.
-- A better declaration would allow the COMP_ARRAY range to be
-- (1 .. BITS_TO_COMPS(NO_OF_BITS).

   type MAE_LONG_FLOAT_TYPE is
      record
         SIGN : SIGN_TYPE := POS_SIGN;
         COMPS : LONG_COMP_ARRAY := LONG_FLOAT_COMP_ARRAY;
         EXPONENT : EXPONENT_TYPE := 0;
      end record;

-------------------------------------------------------------------
end MAE_LONG_FLOAT;

-------------------------------------------------------------------
-------------------------------------------------------------------

with MAE_BASIC_OPERATIONS; use MAE_BASIC_OPERATIONS;

package body MAE_LONG_FLOAT is
-------------------------------------------------------------------
-- Local variables for better tracing
--
   MAE_FORMAT_ERROR : EXCEPTION;
   MAE_LONG_FLOAT_OVERFLOW : EXCEPTION;
   DATA_ERROR : EXCEPTION;
   LAYOUT_ERROR : EXCEPTION;

-------------------------------------------------------------------
-- Constants for local functions and procedures
--
-- Once again the declaration of variables is affect by the
-- Telesoft 1.5 compiler.  The better declaration would use
-- the 'range, 'first, and 'last attributes for initialization.
-- The intialization of the digits ONE .. TEN and ONE_TENTH
-- are in the body(bottom) of this package.

   ZERO : MAE_LONG_FLOAT_TYPE;
   ONE : MAE_LONG_FLOAT_TYPE;
   TWO : MAE_LONG_FLOAT_TYPE;
   THREE : MAE_LONG_FLOAT_TYPE;
   FOUR : MAE_LONG_FLOAT_TYPE;
   FIVE : MAE_LONG_FLOAT_TYPE;
   SIX : MAE_LONG_FLOAT_TYPE;
   SEVEN : MAE_LONG_FLOAT_TYPE;
   EIGHT : MAE_LONG_FLOAT_TYPE;
   NINE : MAE_LONG_FLOAT_TYPE;
   TEN : MAE_LONG_FLOAT_TYPE;

   HUNDRED : MAE_LONG_FLOAT_TYPE;
   THOUSAND : MAE_LONG_FLOAT_TYPE;
   TEN_THOUSAND : MAE_LONG_FLOAT_TYPE;

   ONE_TENTH : MAE_LONG_FLOAT_TYPE;
   ONE_HUNDREDTH : MAE_LONG_FLOAT_TYPE;
   ONE_THOUSANDTH : MAE_LONG_FLOAT_TYPE;
   ONE_TEN_THOUSANDTH : MAE_LONG_FLOAT_TYPE;

   MAE_LONG_FLOAT_EPSILON : MAE_LONG_FLOAT_TYPE;
   MAE_LONG_FLOAT_LARGE : MAE_LONG_FLOAT_TYPE;
   MAE_LONG_FLOAT_SMALL : MAE_LONG_FLOAT_TYPE;
   MAE_LONG_FLOAT_LAST : MAE_LONG_FLOAT_TYPE;
   MAE_LONG_FLOAT_FIRST : MAE_LONG_FLOAT_TYPE;

   TWO_THREE : constant INTEGER := 2**3;
   TWO_THREE_LESS_ONE : constant INTEGER := (2**3)-1;
   TWO_TWO : constant INTEGER := 2**2;
   TWO_TWO_LESS_ONE : constant INTEGER := (2**2)-1;

-------------------------------------------------------------------
-- Visible operations with MAE_LONG_FLOAT_TYPE
--
--
   function TARGET_LONG_FLOAT_EPSILON return MAE_LONG_FLOAT_TYPE is
   begin
      return MAE_LONG_FLOAT_EPSILON;
   end TARGET_LONG_FLOAT_EPSILON;

------------------------------

   function TARGET_LONG_FLOAT_LARGE return MAE_LONG_FLOAT_TYPE is
   begin
      return MAE_LONG_FLOAT_LARGE;
   end TARGET_LONG_FLOAT_LARGE;

------------------------------

   function TARGET_LONG_FLOAT_SMALL return MAE_LONG_FLOAT_TYPE is
   begin
      return MAE_LONG_FLOAT_SMALL;
   end TARGET_LONG_FLOAT_SMALL;

------------------------------

   function TARGET_LONG_FLOAT_LAST return MAE_LONG_FLOAT_TYPE is
   begin
      return MAE_LONG_FLOAT_LAST;
   end TARGET_LONG_FLOAT_LAST;

------------------------------

   function TARGET_LONG_FLOAT_FIRST return MAE_LONG_FLOAT_TYPE is
   begin
      return MAE_LONG_FLOAT_FIRST;
   end TARGET_LONG_FLOAT_FIRST;

------------------------------

   -- predefined system functions : function "=" and function "/="

------------------------------

   function "<"    (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
            return FALSE;
         else
            return RIGHT.SIGN;
         end if;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<";

------------------------------

   function "<="   (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return RIGHT.SIGN;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return FALSE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return TRUE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "<=";

------------------------------

   function ">"    (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return not RIGHT.SIGN;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY < RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">";

------------------------------

   function ">="   (LEFT, RIGHT : MAE_LONG_FLOAT_TYPE) return BOOLEAN is
      -- Resolve the comparision by, first checking the signs, then
      -- checking the exponent, and finally the component arrays.
   begin
      if LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
            return TRUE;
         else
            return not RIGHT.SIGN;
         end if;
      elsif RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         return LEFT.SIGN;
      end if;

      case LEFT.SIGN is
         when POS_SIGN =>
            if RIGHT.SIGN = POS_SIGN then
               -- both are positive
               if LEFT.EXPONENT > RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT < RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY >= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is positive, right is negative
               return TRUE;
            end if;
         when NEG_SIGN =>
            if RIGHT.SIGN = NEG_SIGN then
               -- both are negative
               if LEFT.EXPONENT < RIGHT.EXPONENT then
                  return TRUE;
               elsif LEFT.EXPONENT > RIGHT.EXPONENT then
                  return FALSE;
               else
                  return
                   (LEFT.COMPS.COMPONENT_ARRAY <= RIGHT.COMPS.COMPONENT_ARRAY);
               end if;
            else
               -- left is negative, right is positive
               return FALSE;
            end if;
      end case;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ">=";

---------------------------

   function "+"    (RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
   begin
      -- No action needed
      return RIGHT;
   end "+";

---------------------------

   function "-"    (RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      RESULT : MAE_LONG_FLOAT_TYPE := RIGHT;
   begin
      RESULT.SIGN := CHANGE_SIGN(RIGHT.SIGN);
      return RESULT;
   end "-";

---------------------------

   function "abs"  (RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      RESULT : MAE_LONG_FLOAT_TYPE := RIGHT;
   begin
      RESULT.SIGN := POS_SIGN;
      return RESULT;
   end "abs";

-------------------------------------------------------------------

   procedure ROUND_TO_TARGET (RESULT : in out MAE_LONG_FLOAT_TYPE) is
      -- The purpose of this function is perform an underflow
      -- check (if true set result to zero), and overflow check
      -- (raise constraint error), then to round the float type
      -- so as to match the emulated target.
      -- The input array must be normalized.
-- --------------------------------------------------------------
--
--               Rounding Technique Summary
--
-- --------------------------------------------------------------
--
--      LSB    : the least significant bit
--      GUARD  : the guard bit, first bit beyond LSB
--      STICKY : the logical "or" of all bits beyond GUARD
--
--
--              BEFORE ROUNDING             AFTER ROUNDING
--
--      LSB   |  GUARD  | STICKY  ||   LSB   | HOW ROUNDED ?
--   --------------------------------------------------------
--       0    |    0    |    0    ||    0    | exact
--       0    |    0    |    1    ||    0    | down (0<x<.5)
--       0    |    1    |    0    ||    0    | down (.5)
--       0    |    1    |    1    ||    1    | up (.5<x<1)
--       1    |    0    |    0    ||    1    | exact
--       1    |    0    |    1    ||    1    | down (0<x<.5)
--       1    |    1    |    0    ||    0*   | up (.5)
--       1    |    1    |    1    ||    0*   | up (.5<x<1)
--
--       * note that a carry to the bit above the LSB occurs
--
--    The references to 0, .5, and 1, are with respect to the
--    least significant bit in the binary representation.
--    For example, the representative value of the guard bit
--    is one-half the representative value of the least
--    significant bit, and the maximum value that can be
--    represented by the sticky bit is (.499999 ...) times
--    the representative value of the least significant bit.
--
-- --------------------------------------------------------------
      C_RESULT : LONG_COMPONENT_ARRAY := RESULT.COMPS.COMPONENT_ARRAY;
      LSC, LSB, LSB_FLAG : INTEGER;
      GUARD, GUARD_FLAG, GUARD_COMP : INTEGER;
      STICKY, STICKY_FLAG : INTEGER;
      CARRY, INDEX : INTEGER;
   begin
      if (RESULT.EXPONENT < MIN_EXPONENT_VALUE) then
         RESULT := ZERO;
      elsif (RESULT.EXPONENT > MAX_EXPONENT_VALUE) then
         raise MAE_LONG_FLOAT_OVERFLOW;
      else
         -- Determine the position of the least signif bit (lsb)
         -- (which is inside of the least signif comp, lsc)
         -- in the array. The next bit is the guard bit.  The next
         -- is the sticky bit which is the logical or of all the
         -- bits after guard.
         LSC := ((LONG_NUM_BITS - TARGET_LONG_NUM_BITS) / NO_COMP_BITS) + 1;
         LSB := ((TARGET_LONG_NUM_BITS-1) rem NO_COMP_BITS) + 1;
         LSB_FLAG := ((C_RESULT(LSC) / BIT_VALUE(LSB)) rem 2);

         if LONG_FLOAT_MACHINE_ROUNDS then
            -- The guard bit is one bit after lsb.
            if LSB /= NO_COMP_BITS then
               GUARD := LSB + 1;
               GUARD_COMP := LSC;
            else
               GUARD := 1;
               GUARD_COMP := LSC - 1;
            end if;
            -- Get the guard bit value.
            GUARD_FLAG := ((C_RESULT(GUARD_COMP) / BIT_VALUE(GUARD)) rem 2);
            -- if guard=0 then no rounding necessary
            if (GUARD_FLAG /= 0) then

               -- Otherwise determine the sticky bit
               -- Initial sticky bit value is 0.
               if GUARD /= NO_COMP_BITS then
                  STICKY := GUARD + 1;
               else
                  STICKY := 1;
               end if;
               STICKY_FLAG := 0;
               -- First check the remaining bits in the comp where
               -- the sticky bit is located.
               if (C_RESULT(GUARD_COMP) rem BIT_VALUE(GUARD)) /= 0 then
                  STICKY_FLAG := 1;
               else
                  -- Now check the remaining bits in the array
                  for I in GUARD_COMP+1 .. LONG_NUM_COMPS loop
                     if C_RESULT(I) /= 0 then
                        STICKY_FLAG := 1;
                        exit;
                     end if;
                  end loop;
               end if;
               -- Check for round for (.5 <= x < 1), recall the guard bit=1.
               if (STICKY_FLAG = 1) or (LSB_FLAG = 1) then
                  C_RESULT(LSC) := C_RESULT(LSC) + BIT_VALUE(LSB);
                  -- Do an inline RANGE_CHECK
                  INDEX := LSC;
                  while C_RESULT(INDEX) > MAX_COMP_VALUE loop
                     CARRY := C_RESULT(INDEX) / BASE_COMP_VALUE;
                     C_RESULT(INDEX) := C_RESULT(INDEX) mod BASE_COMP_VALUE;
                     INDEX := INDEX + 1;
                     C_RESULT(INDEX) := C_RESULT(INDEX) + CARRY;
                     -- If it carries all the way up to the most
                     -- signif bit, divide the array by two and
                     -- bump the exponent.
                     if INDEX = LONG_NUM_COMPS then
                        if C_RESULT(INDEX) > MAX_COMP_VALUE then
                           DIVIDE_ARRAY_BY_TWO(C_RESULT);
                           RESULT.EXPONENT := RESULT.EXPONENT + 1;
                        end if;
                     end if;
                  end loop;
               end if;
            end if;
         end if;

         -- Zero out the lower portion of the array
         C_RESULT(LSC) := (C_RESULT(LSC) / BIT_VALUE(LSB)) * BIT_VALUE(LSB);
         for I in 1 .. LSC-1 loop
            C_RESULT(I) := 0;
         end loop;

         RESULT.COMPS.COMPONENT_ARRAY := C_RESULT;
      end if;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ROUND_TO_TARGET;

------------------------------

   procedure NORMALIZE_LONG_FLOAT (RESULT : in out MAE_LONG_FLOAT_TYPE) is
      -- The purpose of this function is to normalize the
      -- the float type so as to maintain accuracy during
      -- computations.
      SHIFT_BITS : INTEGER := 0;
   begin
      ARRAY_NORMALIZE(RESULT.COMPS.COMPONENT_ARRAY, SHIFT_BITS);
      RESULT.EXPONENT := RESULT.EXPONENT - SHIFT_BITS;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end NORMALIZE_LONG_FLOAT;

------------------------------

   function ALIGN (ADD_VALUE : MAE_LONG_FLOAT_TYPE; MATCH_EXP : INTEGER)
                                        return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to shift the intermediate,
      -- to be used in an add/subtract operation, so that the
      -- exponent equals the MATCH_EXP.
      INTERMEDIATE : MAE_LONG_FLOAT_TYPE := ADD_VALUE;
      SHIFT_BITS : INTEGER;
   begin
      -- determine the number of bits to be shifted
      SHIFT_BITS := MATCH_EXP - INTERMEDIATE.EXPONENT;
      -- check if the number is shifted beyond significance
      if SHIFT_BITS >= LONG_NUM_BITS then
         return ZERO;
      elsif SHIFT_BITS < 1 then
         raise MAE_NUMERIC_ERROR;
      else

         -- rounding may be needed here

         ARRAY_TRUNCATION_SHIFT_RIGHT(INTERMEDIATE.COMPS.COMPONENT_ARRAY,
                                          SHIFT_BITS);
         INTERMEDIATE.EXPONENT := MATCH_EXP;
         return INTERMEDIATE;
      end if;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ALIGN;

-------------------------------------------------------------------

   function "+"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to add two
      -- MAE_LONG_FLOAT_TYPEs.
      RESULT, TEMP : MAE_LONG_FLOAT_TYPE;
   begin
      -- zero check
      if RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT := LEFT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      elsif LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT := RIGHT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      case (LEFT.SIGN xor RIGHT.SIGN) is
         -- The signs are different (subtraction)
         when TRUE =>
            if LEFT.EXPONENT > RIGHT.EXPONENT then
               TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
               RESULT.COMPS := LEFT.COMPS - TEMP.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := LEFT.SIGN;
            elsif LEFT.EXPONENT < RIGHT.EXPONENT then
               TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
               RESULT.COMPS := RIGHT.COMPS - TEMP.COMPS;
               RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            else
               if LEFT.COMPS.COMPONENT_ARRAY > RIGHT.COMPS.COMPONENT_ARRAY then
                  RESULT.COMPS := LEFT.COMPS - RIGHT.COMPS;
                  RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
                  RESULT.SIGN := LEFT.SIGN;
               else
                  RESULT.COMPS := RIGHT.COMPS - LEFT.COMPS;
                  RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
                  RESULT.SIGN := RIGHT.SIGN;
               end if;
            end if;
         -- The signs are the same
         when FALSE =>
            if LEFT.EXPONENT > RIGHT.EXPONENT then
               TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
               RESULT.COMPS := LEFT.COMPS + TEMP.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := LEFT.SIGN;
            elsif LEFT.EXPONENT < RIGHT.EXPONENT then
               TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
               RESULT.COMPS := RIGHT.COMPS + TEMP.COMPS;
               RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            else
               RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
               RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
               RESULT.SIGN := RIGHT.SIGN;
            end if;

      end case;

      RESULT.COMPS.BITS_SHIFTED := 0;
      if RESULT.COMPS = ZERO.COMPS then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      end if;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "+";

------------------------------

   function "-"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to subtract two
      -- MAE_LONG_FLOAT_TYPEs.
      RESULT : MAE_LONG_FLOAT_TYPE;
   begin
      -- subtract is same as add negative
         -- takin' the easy way
      RESULT := LEFT + (-RIGHT);

      return RESULT;


   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "-";

------------------------------

   function "*"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to multiply two
      -- MAE_LONG_FLOAT_TYPEs.
      RESULT : MAE_LONG_FLOAT_TYPE;
   begin
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) or
           (RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         RESULT.COMPS := ZERO.COMPS;
         RESULT.EXPONENT := ZERO.EXPONENT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      -- one check
      elsif (LEFT = ONE) or (LEFT = -ONE) then
         RESULT.COMPS := RIGHT.COMPS;
         RESULT.EXPONENT := RIGHT.EXPONENT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      elsif (RIGHT = ONE) or (RIGHT = -ONE) then
         RESULT.COMPS := LEFT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      RESULT.COMPS := LEFT.COMPS * RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT + RIGHT.EXPONENT)
                             - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "*";

------------------------------

   function "/"    (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to divide two
      -- MAE_LONG_FLOAT_TYPEs.
      RESULT : MAE_LONG_FLOAT_TYPE;
   begin
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);
      -- zero check
      if (RIGHT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         raise MAE_NUMERIC_ERROR;
      elsif (LEFT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY) then
         RESULT.COMPS := ZERO.COMPS;
         RESULT.EXPONENT := ZERO.EXPONENT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      -- one check
      elsif (RIGHT = ONE) or (RIGHT = -ONE) then
         RESULT.COMPS := LEFT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT;
         NORMALIZE_LONG_FLOAT(RESULT);
         ROUND_TO_TARGET(RESULT);
         return RESULT;
      end if;

      RESULT.COMPS := LEFT.COMPS / RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT - RIGHT.EXPONENT)
                            - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "/";

------------------------------

   function MULT (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to multiply two
      -- MAE_LONG_FLOAT_TYPEs without rounding the result
      -- to the target precision.  This allows the exponentiation
      -- and string operation to maintain precision.
      RESULT : MAE_LONG_FLOAT_TYPE;
   begin
      RESULT.COMPS := LEFT.COMPS * RIGHT.COMPS;
      if RESULT.COMPS.COMPONENT_ARRAY = ZERO.COMPS.COMPONENT_ARRAY then
         RESULT.EXPONENT := 0;
      else
         RESULT.EXPONENT := (LEFT.EXPONENT + RIGHT.EXPONENT)
                             - RESULT.COMPS.BITS_SHIFTED;
      end if;
      RESULT.COMPS.BITS_SHIFTED := 0;
      RESULT.SIGN := not (LEFT.SIGN xor RIGHT.SIGN);

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end MULT;

------------------------------

   function ADD (LEFT,RIGHT : MAE_LONG_FLOAT_TYPE)
                       return MAE_LONG_FLOAT_TYPE is
      -- The purpose of this function is to add two
      -- MAE_LONG_FLOAT_TYPEs without rounding to the target
      -- precision.  This allows the exponentiation and
      -- string conversion routines to maintain accuracy.
      -- Since it has a specialized operation, both operator
      -- signs are assumed positive.
      RESULT, TEMP : MAE_LONG_FLOAT_TYPE;
   begin
      -- The signs are the same
      if LEFT.EXPONENT > RIGHT.EXPONENT then
         TEMP := ALIGN(RIGHT, LEFT.EXPONENT);
         RESULT.COMPS := LEFT.COMPS + TEMP.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      elsif LEFT.EXPONENT < RIGHT.EXPONENT then
         TEMP := ALIGN(LEFT, RIGHT.EXPONENT);
         RESULT.COMPS := RIGHT.COMPS + TEMP.COMPS;
         RESULT.EXPONENT := RIGHT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      else
         RESULT.COMPS := LEFT.COMPS + RIGHT.COMPS;
         RESULT.EXPONENT := LEFT.EXPONENT - RESULT.COMPS.BITS_SHIFTED;
      end if;

      RESULT.SIGN := POS_SIGN;
      RESULT.COMPS.BITS_SHIFTED := 0;
      if RESULT.COMPS = ZERO.COMPS then
         RESULT.EXPONENT := 0;
         RESULT.SIGN := POS_SIGN;
      end if;

      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end ADD;

------------------------------

   function "**"   (LEFT : MAE_LONG_FLOAT_TYPE; RIGHT : INTEGER)
                       return MAE_LONG_FLOAT_TYPE is
   -- The purpose of this function is to raise a MAE_LONG_FLOAT_TYPE
   -- to a given power.  A simple loop with a multiplication could
   -- be done the given number, less one, times.  This method is
   -- inefficient, therefore a different algorithm is used.
   -- The use of additional memory to hold intermediate
   -- calculations will improve performance by reducing
   -- the number of multiplications.
      COUNT : INTEGER := RIGHT;
      REM_COUNT : INTEGER := RIGHT;
      RESULT : MAE_LONG_FLOAT_TYPE;
      POWER_2, POWER_4, POWER_8 : MAE_LONG_FLOAT_TYPE := ZERO;
      NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
   begin
      -- if the power is less than 0, invert number, then continue
      if (COUNT < 0) then
         if LEFT = ZERO then
            raise MAE_NUMERIC_ERROR;
         end if;
         if COUNT = -1 then
            RESULT := ONE / LEFT;
            ROUND_TO_TARGET(RESULT);
            return RESULT;
         end if;
         NEG_SIGN_EXP_FLAG := TRUE;
         COUNT := abs(COUNT);
         REM_COUNT := COUNT;
      end if;
      -- if the power is 0, return 1
      if COUNT = 0 then return ONE;
      -- if the power is 1 or the number is 0 or 1, return the input number
      elsif (COUNT = 1) or (LEFT = ONE) or (LEFT = ZERO) then return LEFT;
      elsif COUNT > TWO_THREE_LESS_ONE then
         -- compute to POWER_8
         POWER_2 := MULT(LEFT, LEFT);
         POWER_4 := MULT(POWER_2, POWER_2);
         POWER_8 := MULT(POWER_4, POWER_4);
         RESULT := POWER_8;
         REM_COUNT := REM_COUNT - 8;
      elsif COUNT > TWO_TWO_LESS_ONE then
         -- compute to POWER_4
         POWER_2 := MULT(LEFT, LEFT);
         POWER_4 := MULT(POWER_2, POWER_2);
         RESULT := POWER_4;
         REM_COUNT := REM_COUNT - 4;
      else
         -- compute to POWER_2
         POWER_2 := MULT(LEFT, LEFT);
         RESULT := POWER_2;
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- the pre-computed values are now used to build
      -- to the answer

      -- loop until the power is reduced to under the
      -- maximum pre-computed value
      loop
         if REM_COUNT < TWO_THREE then
           exit;
         end if;
         RESULT := MULT(RESULT, POWER_8);
         REM_COUNT := REM_COUNT - 8;
      end loop;

      -- the remaining power may be between 4 .. 7
      if REM_COUNT > TWO_TWO_LESS_ONE then
         RESULT := MULT(RESULT, POWER_4);
         REM_COUNT := REM_COUNT - 4;
      end if;

      -- the remaining power may be between 2 .. 3
      if REM_COUNT > 1 then
         RESULT := MULT(RESULT, POWER_2);
         REM_COUNT := REM_COUNT - 2;
      end if;

      -- the remaining power may be 1, therefore the sign
      -- is negative if the input number is negative
      if REM_COUNT = 1 then
         RESULT := MULT(RESULT, LEFT);
      end if;

      -- If exponent was negative, the result is inverted
      if NEG_SIGN_EXP_FLAG then
         RESULT := ONE / RESULT;
      end if;

      ROUND_TO_TARGET(RESULT);
      return RESULT;

   exception
      when others =>
         raise MAE_NUMERIC_ERROR;

   end "**";

---------------------------

   procedure GET(FROM : in STRING;
                 ITEM : out MAE_LONG_FLOAT_TYPE;
                 LAST : out POSITIVE) is
   -- The purpose of this function is to convert a string
   -- of characters into the MAE_LONG_FLOAT_TYPE structure.
   -- The string is valid if an only if it conforms to the
   -- format specified by the LRM
   --
   -- FORE . AFT
   -- FORE . AFT E EXP
   -- where
   --    FORE : decimal digits, optional leading spaces,
   --            and a minus sign for negative values
   --    "."  : the decimal point
   --    AFT  : decimal digits
   --    EXP  : sign (plus or minus) and exponent
   --
   -- and is within the specified range for
   -- MAE_LONG_FLOAT_TYPEs.
      INDEX : INTEGER;
      RESULT, TEMP, MULTIPLIER : MAE_LONG_FLOAT_TYPE;
      NEG_SIGN_FLAG : BOOLEAN := FALSE;
      FRACTION_FLAG, EXPONENT_FLAG, NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
      EMPTY_FLAG : BOOLEAN := TRUE;
      S_PTR, POWER_OF_TEN, BASE_TEN_EXP : INTEGER := 0;

   begin
      -- Strip leading spaces if necessary
      INDEX := FROM'first;
      for I in FROM'first .. FROM'last loop
         if FROM(I) /= ' ' then
            exit;
         else
            INDEX := INDEX + 1;
         end if;
         -- if the string is empty
         if INDEX > FROM'last then
            raise MAE_FORMAT_ERROR;
         end if;
      end loop;

      -- Set the sign flag(assigned to the result sign before exiting).
      if FROM(INDEX) = '-' then
         NEG_SIGN_FLAG := TRUE;
         INDEX := INDEX + 1;
      elsif FROM(INDEX) = '+' then
         INDEX := INDEX + 1;
      end if;

      -- if the string is empty
      if INDEX > FROM'last then
         raise MAE_FORMAT_ERROR;
      end if;

      -- Store the integer portion

      for I in INDEX .. FROM'last loop
         S_PTR := I;

         case FROM(I) is
            when '0' .. '9' =>
               -- Multiply old result by ten and add in the digit
               -- (recall that MULT is multiply, ADD is add)

               RESULT := MULT(RESULT, TEN);
               case FROM(I) is

                  when '0' => null;
                  when '1' => RESULT := ADD(RESULT, ONE);
                  when '2' => RESULT := ADD(RESULT, TWO);
                  when '3' => RESULT := ADD(RESULT, THREE);
                  when '4' => RESULT := ADD(RESULT, FOUR);
                  when '5' => RESULT := ADD(RESULT, FIVE);
                  when '6' => RESULT := ADD(RESULT, SIX);
                  when '7' => RESULT := ADD(RESULT, SEVEN);
                  when '8' => RESULT := ADD(RESULT, EIGHT);
                  when '9' => RESULT := ADD(RESULT, NINE);
                  when others => raise MAE_FORMAT_ERROR;
               end case;
               -- Once a digit is encountered set empty false
               EMPTY_FLAG := FALSE;
               -- If the digit followed the decimal point increase
               -- the exponent counter
               if FRACTION_FLAG then
                  POWER_OF_TEN := POWER_OF_TEN + 1;
               end if;

            when ' ' =>
               -- If there is a space, before a digit, after the sign
               -- exception, else check if it is the end of the number
               if EMPTY_FLAG then
                  -- spaces after the sign
                  raise MAE_FORMAT_ERROR;
               else
                  for J in I+1 .. FROM'last loop
                     if FROM(J) /= ' ' then
                        raise MAE_FORMAT_ERROR;
                     end if;
                  end loop;
                  exit;
               end if;

            when '.' =>
               if FRACTION_FLAG or EMPTY_FLAG then
                  -- two decimal points, or leading point
                  raise MAE_FORMAT_ERROR;
               else
                  FRACTION_FLAG := TRUE;
               end if;

            when 'e' | 'E' =>
               if EMPTY_FLAG then
                  -- no decimal number
                  raise MAE_FORMAT_ERROR;
               else
                  -- Set the exponent flag on
                  EXPONENT_FLAG := TRUE;
                  exit;
               end if;

            when others => raise MAE_FORMAT_ERROR;
         end case;
      end loop;

      -- Set the sign
      if NEG_SIGN_FLAG then
         RESULT.SIGN := NEG_SIGN;
      else
         RESULT.SIGN := POS_SIGN;
      end if;


      -- If the string contained the 'E' determine the exponent
      if EXPONENT_FLAG then
         EMPTY_FLAG := TRUE;

         -- Check the sign
         S_PTR := S_PTR + 1;
         if FROM(S_PTR) = '-' then
            NEG_SIGN_EXP_FLAG := TRUE;
            INDEX := INDEX + 1;
         elsif FROM(S_PTR) = '+' then
            INDEX := INDEX + 1;
         else
            raise MAE_NUMERIC_ERROR;
         end if;


         for I in S_PTR+1 .. FROM'last loop

            case FROM(I) is
               when '0' .. '9' =>
                  case FROM(I) is

                     when '0' => BASE_TEN_EXP := BASE_TEN_EXP*10;
                     when '1' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 1;
                     when '2' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 2;
                     when '3' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 3;
                     when '4' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 4;
                     when '5' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 5;
                     when '6' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 6;
                     when '7' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 7;
                     when '8' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 8;
                     when '9' => BASE_TEN_EXP := BASE_TEN_EXP*10 + 9;
                     when others => raise MAE_FORMAT_ERROR;
                  end case;
                  EMPTY_FLAG := FALSE;

               when ' ' =>
                  if EMPTY_FLAG then
                     -- no exponent number
                    raise MAE_FORMAT_ERROR;
                  else
                     for J in I+1 .. FROM'last loop
                        if FROM(J) /= ' ' then
                           raise MAE_FORMAT_ERROR;
                        end if;
                     end loop;
                     exit;
                  end if;

               when others => raise MAE_FORMAT_ERROR;

            end case;
         end loop;
      end if;

      if EMPTY_FLAG or (POWER_OF_TEN = 0) then
         -- either (no number) or (no exponent) or (no fraction)
         raise MAE_FORMAT_ERROR;
      end if;

      if RESULT.COMPS = ZERO.COMPS then
         ITEM := ZERO;
      else
         -- If the base ten exponent was negative.
         if NEG_SIGN_EXP_FLAG then
            BASE_TEN_EXP := -BASE_TEN_EXP;
         end if;

         -- Now we must adjust the base ten exponent by the number of
         -- digits that follow the decimal point in the string.
         BASE_TEN_EXP := BASE_TEN_EXP - POWER_OF_TEN;

         -- If the input base ten exponent needs to be translated
         -- into a base two exponent, use the "and" routine to
         -- multiply but round after the final multiply.
         if BASE_TEN_EXP /= 0 then
           if BASE_TEN_EXP > 0 then
               while BASE_TEN_EXP >= 4 loop
                  RESULT := MULT(RESULT, TEN_THOUSAND);
                  BASE_TEN_EXP := BASE_TEN_EXP - 4;
               end loop;
               if BASE_TEN_EXP = 3 then
                  RESULT := MULT(RESULT, THOUSAND);
               end if;
               if BASE_TEN_EXP = 2 then
                  RESULT := MULT(RESULT, HUNDRED);
               end if;
               if BASE_TEN_EXP = 1 then
                  RESULT := MULT(RESULT, TEN);
               end if;
            else
               while BASE_TEN_EXP <= -4 loop
                  RESULT := MULT(RESULT, ONE_TEN_THOUSANDTH);
                  BASE_TEN_EXP := BASE_TEN_EXP + 4;
               end loop;
               if BASE_TEN_EXP = -3 then
                  RESULT := MULT(RESULT, ONE_THOUSANDTH);
               end if;
               if BASE_TEN_EXP = -2 then
                  RESULT := MULT(RESULT, ONE_HUNDREDTH);
               end if;
               if BASE_TEN_EXP = -1 then
                  RESULT := MULT(RESULT, ONE_TENTH);
               end if;
            end if;
         end if;

         ROUND_TO_TARGET(RESULT);

         ITEM := RESULT;
      end if;

      LAST := FROM'last;


   exception
      when others =>
         raise DATA_ERROR;

   end GET;

------------------------------

   procedure MULT_BY_TEN (RESULT : in out COMPONENT_ARRAY_TYPE) is
      -- This routine is used by the binary to ASCII conversion
      -- (PUT) to extract the next digit by multiplying the
      -- array by ten, thus the digit is the most signif
      -- comp of the array "integer divided" by ten.
   begin
      for I in RESULT'first .. RESULT'last loop
         RESULT(I) := RESULT(I) * 10;
      end loop;
      RANGE_CHECK(RESULT);

   end MULT_BY_TEN;

------------------------------

   procedure PUT(TO : out STRING;
                 ITEM : in MAE_LONG_FLOAT_TYPE;
                 AFT : in FIELD := LONG_DEFAULT_AFT;
                 EXP : in FIELD := LONG_DEFAULT_EXP) is
      -- The purpose of this function is to convert a
      -- MAE_LONG_FLOAT_TYPE into string of characters.
      COMP_PTR, INDEX : INTEGER;
      RESULT : MAE_LONG_FLOAT_TYPE := ITEM;
      WORK_ARRAY : LONG_COMPONENT_ARRAY;
      TEMP_CHAR : STRING (1 .. 1);
      TEMP_VALUE : INTEGER;
      STRING_PIC : STRING (1 .. LONG_FLOAT_DIGITS+1) :=
                      EMPTY_STRING(1 .. LONG_FLOAT_DIGITS+1);
      DECIMAL_VALUE, OFFSET, OFFSET_BITS, POWER_OF_TEN : INTEGER := 0;

      LSB : INTEGER := (NO_COMP_BITS + 1 + (2*(LONG_FLOAT_DIGITS)));
      LSC, BIT_IN_LSC : INTEGER;

      NEG_SIGN_FLAG, NEG_SIGN_EXP_FLAG : BOOLEAN := FALSE;
      DISPLAY_DIGITS : INTEGER := 0;
      FIRST_DIGIT : BOOLEAN := TRUE;

      TO_INDEX : INTEGER := 0;
      EXPONENT_STRING : STRING (1 .. 4) := "   0";
      EXPONENT_INDEX : INTEGER := 0;
      EXPONENT_LENGTH : INTEGER := 1;

      ALMOST_ZERO : MAE_LONG_FLOAT_TYPE := ZERO;

      ACTUAL_FORE : INTEGER := 1;
      ACTUAL_AFT : INTEGER := AFT;
      ACTUAL_EXP : INTEGER := EXP;

      FORE_FIELD_ZERO_FLAG : BOOLEAN := FALSE;
      FORE_WIDTH_DIGITS_BEYOND_PRECISION : INTEGER := 0;
      AFT_WIDTH_DIGITS_BEYOND_PRECISION : INTEGER := 0;
      AFT_LEADING_ZERO_DIGITS : INTEGER := 0;
      SIGNIFICANT_AFT : INTEGER := 0;

   begin
      TO(TO'first .. TO'last) := EMPTY_STRING(1 .. TO'length);

      -- The variable INDEX is the pointer into the string.
      INDEX := STRING_PIC'first;

      -- Check for zero.
      if RESULT.COMPS /= ZERO.COMPS then

         -- Store the sign
         if RESULT.SIGN = NEG_SIGN then
            NEG_SIGN_FLAG := TRUE;
            RESULT.SIGN := POS_SIGN;
         end if;

         -- Determine the base ten exponent by forcing the result
         -- into the range .1 <= x < 1., and tracking the count.
         POWER_OF_TEN := -1;
         if RESULT < ONE then
            while RESULT < ONE_TEN_THOUSANDTH loop
               RESULT := MULT(RESULT, TEN_THOUSAND);
               POWER_OF_TEN := POWER_OF_TEN - 4;
            end loop;
            if RESULT < ONE_THOUSANDTH then
               RESULT := MULT(RESULT, THOUSAND);
               POWER_OF_TEN := POWER_OF_TEN - 3;
            end if;
            if RESULT < ONE_HUNDREDTH then
               RESULT := MULT(RESULT, HUNDRED);
               POWER_OF_TEN := POWER_OF_TEN - 2;
            end if;
            if RESULT < ONE_TENTH then
               RESULT := MULT(RESULT, TEN);
               POWER_OF_TEN := POWER_OF_TEN - 1;
            end if;
         else
            while RESULT >= THOUSAND loop
               RESULT := MULT(RESULT, ONE_TEN_THOUSANDTH);
               POWER_OF_TEN := POWER_OF_TEN + 4;
            end loop;
            if RESULT >= HUNDRED then
               RESULT := MULT(RESULT, ONE_THOUSANDTH);
               POWER_OF_TEN := POWER_OF_TEN + 3;
            end if;
            if RESULT >= TEN then
               RESULT := MULT(RESULT, ONE_HUNDREDTH);
               POWER_OF_TEN := POWER_OF_TEN + 2;
            end if;
            if RESULT >= ONE then
               RESULT := MULT(RESULT, ONE_TENTH);
               POWER_OF_TEN := POWER_OF_TEN + 1;
            end if;
         end if;

         -- Store the integer portion
         -- The OFFSET corrects the decimal value with respect to the
         -- RESULT.EXPONENT which must equal (0 | -1 | -2 | -3)
         OFFSET_BITS := -RESULT.EXPONENT;
         OFFSET := BASE_COMP_VALUE * (2**(OFFSET_BITS));

         -- Loop over the MAE_NUMBER taking the most significant
         -- decimal digit and storing it in the array(forewards)
         WORK_ARRAY := RESULT.COMPS.COMPONENT_ARRAY;
         -- The variable ALMOST_ZERO is zero thru all significant bits
         while (WORK_ARRAY > ALMOST_ZERO.COMPS.COMPONENT_ARRAY) loop
            -- Determine where the scaled least signif bit is located
            LSC := ((LONG_NUM_BITS - LSB) / NO_COMP_BITS) + 1;
            BIT_IN_LSC := ((LSB-1) rem NO_COMP_BITS) + 1;
            -- The least signif bit is scaled down by two bits
            -- instead of the true inverse log(2) which is approx 3.322
            -- since the original LSB is less than TARGET_LONG_NUM_BITS.
            LSB := LSB - 2;
            ALMOST_ZERO.COMPS.COMPONENT_ARRAY(LSC) := BIT_VALUE(BIT_IN_LSC);
            ALMOST_ZERO.COMPS.COMPONENT_ARRAY(LSC-1) := 0;

            MULT_BY_TEN(WORK_ARRAY);

            -- If the rest of the number(significant) is all nines, round up.
            if (WORK_ARRAY(WORK_ARRAY'last) rem BASE_COMP_VALUE) =
                                 MAX_COMP_VALUE then
               COMP_PTR := WORK_ARRAY'last - 1;
               while WORK_ARRAY(COMP_PTR) = MAX_COMP_VALUE loop
                  COMP_PTR := COMP_PTR - 1;
                  if COMP_PTR <= LSC then
                     if (WORK_ARRAY(LSC) / BIT_VALUE(BIT_IN_LSC)) =
                            (MAX_COMP_VALUE / BIT_VALUE(BIT_IN_LSC)) then
                        -- Instead of adding a rounding value just set to
                        -- BASE_COMP_VALUE since either case will produce
                        -- a remaining number less than ALMOST_ZERO
                        WORK_ARRAY(LSC) := BASE_COMP_VALUE;
                        RANGE_CHECK(WORK_ARRAY);
                     end if;
                     exit;
                  end if;
               end loop;
            end if;

            -- Extract the decimal value from the array.
            DECIMAL_VALUE := WORK_ARRAY(WORK_ARRAY'last) / OFFSET;
            WORK_ARRAY(WORK_ARRAY'last) := WORK_ARRAY(WORK_ARRAY'last) -
                                              (DECIMAL_VALUE * OFFSET);

            -- The next check is valid the first time thru the loop
            -- and remedies the .99999999999 ...    case.
            if FIRST_DIGIT then
               FIRST_DIGIT := FALSE;
               if DECIMAL_VALUE = 10 then
                  STRING_PIC(INDEX) := '1';
                  INDEX := INDEX + 1;
                  POWER_OF_TEN := POWER_OF_TEN + 1;
                  exit;
               end if;
            end if;

            -- Get the ASCII value of the decimal value
            -- and store it in the string
            TEMP_CHAR := INTEGER'image(DECIMAL_VALUE);
            STRING_PIC(INDEX) := TEMP_CHAR(1);
            INDEX := INDEX + 1;

            -- If the (display number+1) decimal digits are in the string.
            if (INDEX=STRING_PIC'last+1) or (LSB<=NO_COMP_BITS) then
               exit;
            end if;
         end loop;
      end if;

      for I in INDEX .. STRING_PIC'last loop
         STRING_PIC(I) := '0';
      end loop;

      if AFT = 0 then
         ACTUAL_AFT := 1;
      end if;
      if EXP = 1 then
         ACTUAL_EXP := 2;
      end if;

      -- determine the number of digits to produce
      if ACTUAL_EXP /= 0 then
         -- ACTUAL_FORE must equal one
         if (ACTUAL_FORE + ACTUAL_AFT) <= LONG_FLOAT_DIGITS then
            DISPLAY_DIGITS := ACTUAL_FORE + ACTUAL_AFT;
         else
            DISPLAY_DIGITS := LONG_FLOAT_DIGITS;
            AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                    ACTUAL_AFT - (LONG_FLOAT_DIGITS - ACTUAL_FORE);
            ACTUAL_AFT := (LONG_FLOAT_DIGITS - ACTUAL_FORE);
         end if;
      else
         if POWER_OF_TEN >= 0 then
            ACTUAL_FORE := POWER_OF_TEN + 1;
            if (ACTUAL_FORE + ACTUAL_AFT) <= LONG_FLOAT_DIGITS then
               DISPLAY_DIGITS := ACTUAL_FORE + ACTUAL_AFT;
            else
               DISPLAY_DIGITS := LONG_FLOAT_DIGITS;
               AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                    ACTUAL_AFT - (LONG_FLOAT_DIGITS - ACTUAL_FORE);
               if AFT_WIDTH_DIGITS_BEYOND_PRECISION >= ACTUAL_AFT then
                  AFT_WIDTH_DIGITS_BEYOND_PRECISION := ACTUAL_AFT;
                  ACTUAL_AFT := 0;
                  FORE_WIDTH_DIGITS_BEYOND_PRECISION :=
                       ACTUAL_FORE - LONG_FLOAT_DIGITS;
                  ACTUAL_FORE := LONG_FLOAT_DIGITS;
               else
                  ACTUAL_AFT := (LONG_FLOAT_DIGITS - ACTUAL_FORE);
               end if;
            end if;
         else
            -- ACTUAL_FORE must equal one, with a value of zero
            FORE_FIELD_ZERO_FLAG := TRUE;
            AFT_LEADING_ZERO_DIGITS := abs(POWER_OF_TEN+1);
            SIGNIFICANT_AFT := ACTUAL_AFT - AFT_LEADING_ZERO_DIGITS;
            if SIGNIFICANT_AFT <= LONG_FLOAT_DIGITS then
               DISPLAY_DIGITS := SIGNIFICANT_AFT;
               if SIGNIFICANT_AFT <= 0 then
                  AFT_LEADING_ZERO_DIGITS := ACTUAL_AFT;
                  ACTUAL_AFT := 0;
               elsif SIGNIFICANT_AFT > 0 then
                  ACTUAL_AFT := SIGNIFICANT_AFT;
               end if;
            else
               DISPLAY_DIGITS := LONG_FLOAT_DIGITS;
               AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                  SIGNIFICANT_AFT - LONG_FLOAT_DIGITS;
               ACTUAL_AFT := LONG_FLOAT_DIGITS;
            end if;
         end if;
      end if;

      if DISPLAY_DIGITS > 0 then
         -- Round the digit in the last-1 position using the last digit.
         INDEX := DISPLAY_DIGITS + 1;
         if STRING_PIC(INDEX) >= '5' then
            STRING_PIC(INDEX) := '0';
            INDEX := INDEX - 1;
            STRING_PIC(INDEX) := CHARACTER'succ(STRING_PIC(INDEX));
            while STRING_PIC(INDEX) > '9' loop
               if INDEX = STRING_PIC'first then
                  -- rounding to outside array can only occur if
                  -- with FORE=1, value=0
                  STRING_PIC(INDEX) := '1';
                  POWER_OF_TEN := POWER_OF_TEN + 1;
                  if POWER_OF_TEN = 0 then
                     FORE_FIELD_ZERO_FLAG := FALSE;
                  elsif AFT_LEADING_ZERO_DIGITS > 0 then
                     AFT_LEADING_ZERO_DIGITS := AFT_LEADING_ZERO_DIGITS - 1;
                     AFT_WIDTH_DIGITS_BEYOND_PRECISION :=
                               AFT_WIDTH_DIGITS_BEYOND_PRECISION + 1;
                  end if;
                  exit;
               end if;

               STRING_PIC(INDEX) := '0';
               INDEX := INDEX - 1;
               STRING_PIC(INDEX) := CHARACTER'succ(STRING_PIC(INDEX));
            end loop;
            INDEX := INDEX + 1;
         else
            STRING_PIC(INDEX) := '0';
         end if;
      elsif DISPLAY_DIGITS = 0 then
         if STRING_PIC(STRING_PIC'first) >= '5' then
            STRING_PIC(STRING_PIC'first) := '1';
            POWER_OF_TEN := POWER_OF_TEN + 1;
            if POWER_OF_TEN = 0 then
               FORE_FIELD_ZERO_FLAG := FALSE;
            else
               AFT_LEADING_ZERO_DIGITS := AFT_LEADING_ZERO_DIGITS - 1;
               ACTUAL_AFT := 1;
            end if;
         end if;
      end if;

      if (ACTUAL_EXP = 0) then
         -- fill the string in reverse
         TO_INDEX := TO'last;
         if FORE_FIELD_ZERO_FLAG then
            -- fore field is zero
            -- store the aft field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in 1 .. AFT_LEADING_ZERO_DIGITS loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := '0';
            TO_INDEX := TO_INDEX - 1;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         else
            -- non-zero fore field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(ACTUAL_FORE+I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            for I in 1 .. FORE_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_FORE loop
               TO(TO_INDEX) := STRING_PIC(I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         end if;
      else
         if STRING_PIC(STRING_PIC'first) = '0' then
            -- zero string, the length includes leading zero,
            -- '.', AFT, 'E', EXP
            TO_INDEX := TO'last - (2 + ACTUAL_AFT + ACTUAL_EXP);
            TO(TO_INDEX) := '0';
            TO_INDEX := TO_INDEX + 1;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX + 1;
            -- fill out the aft field
            for I in 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX + 1;
            end loop;
            TO(TO_INDEX) := 'E';
            TO_INDEX := TO_INDEX + 1;
            TO(TO_INDEX) := '+';
            TO_INDEX := TO_INDEX + 1;
            -- fill out the exponent field
            for I in 1 .. ACTUAL_EXP-1 loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX + 1;
            end loop;
         else
            -- If there is an exponent, store it in the string.
            if POWER_OF_TEN /= 0 then
               if POWER_OF_TEN < 0 then
                  NEG_SIGN_EXP_FLAG := TRUE;
                  POWER_OF_TEN := abs(POWER_OF_TEN);
               end if;

               -- determine the base ten exponent
               -- fill the string in reverse
               EXPONENT_INDEX := EXPONENT_STRING'last;
               while POWER_OF_TEN /= 0 loop
                  TEMP_VALUE := POWER_OF_TEN rem 10;
                  POWER_OF_TEN := POWER_OF_TEN / 10;
                  TEMP_CHAR := INTEGER'image(TEMP_VALUE);
                  EXPONENT_STRING(EXPONENT_INDEX) := TEMP_CHAR(1);
                  EXPONENT_INDEX := EXPONENT_INDEX - 1;
               end loop;
               EXPONENT_LENGTH := EXPONENT_STRING'last - EXPONENT_INDEX;
            end if;

            -- fill the string in reverse
            TO_INDEX := TO'last;
            -- store the exponent field
            for I in 1 .. EXPONENT_LENGTH loop
               TO(TO_INDEX) := EXPONENT_STRING((EXPONENT_STRING'last+1)-I);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            -- fill out the exponent field
            for I in EXPONENT_LENGTH+1 .. ACTUAL_EXP-1 loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            if NEG_SIGN_EXP_FLAG then
               TO(TO_INDEX) := '-';
            else
               TO(TO_INDEX) := '+';
            end if;
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := 'E';
            TO_INDEX := TO_INDEX - 1;
            -- store the aft field
            for I in 1 .. AFT_WIDTH_DIGITS_BEYOND_PRECISION loop
               TO(TO_INDEX) := '0';
               TO_INDEX := TO_INDEX - 1;
            end loop;
            for I in reverse 1 .. ACTUAL_AFT loop
               TO(TO_INDEX) := STRING_PIC(I+1);
               TO_INDEX := TO_INDEX - 1;
            end loop;
            TO(TO_INDEX) := '.';
            TO_INDEX := TO_INDEX - 1;
            TO(TO_INDEX) := STRING_PIC(STRING_PIC'first);
            TO_INDEX := TO_INDEX - 1;
            if NEG_SIGN_FLAG then
               TO(TO_INDEX) := '-';
               TO_INDEX := TO_INDEX - 1;
            end if;
         end if;
      end if;

   exception
      when others =>
         raise LAYOUT_ERROR;

   end PUT;

---------------------------
-- The body of the package.
--
begin

   -- Initialize the digits ONE .. TEN with the DIGIT_PICTURE
   -- and DIGIT_BINARY_EXPONENT arrays, and initialize ONE_TENTH
   -- with an array specified in MAE_BASIC_OPERATIONS.  This allows
   -- for the length of the array to change in the basic operations
   -- and not caused a coding change in this package.
   -- Notice that these values assume the declaration of the type
   -- is initially a zero value.  This assumption is justified since
   -- the declaration of the type is in this package specification.
   -- ZERO taken care of by the initial value.
   ONE.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(1);
   ONE.EXPONENT := DIGIT_BINARY_EXPONENT(1);
   TWO.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(2);
   TWO.EXPONENT := DIGIT_BINARY_EXPONENT(2);
   THREE.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(3);
   THREE.EXPONENT := DIGIT_BINARY_EXPONENT(3);
   FOUR.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(4);
   FOUR.EXPONENT := DIGIT_BINARY_EXPONENT(4);
   FIVE.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(5);
   FIVE.EXPONENT := DIGIT_BINARY_EXPONENT(5);
   SIX.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(6);
   SIX.EXPONENT := DIGIT_BINARY_EXPONENT(6);
   SEVEN.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(7);
   SEVEN.EXPONENT := DIGIT_BINARY_EXPONENT(7);
   EIGHT.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(8);
   EIGHT.EXPONENT := DIGIT_BINARY_EXPONENT(8);
   NINE.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(9);
   NINE.EXPONENT := DIGIT_BINARY_EXPONENT(9);
   TEN.COMPS.COMPONENT_ARRAY(LONG_NUM_COMPS) := DIGIT_PICTURE(10);
   TEN.EXPONENT := DIGIT_BINARY_EXPONENT(10);

   HUNDRED.COMPS := TEN.COMPS * TEN.COMPS;
   HUNDRED.EXPONENT := (TEN.EXPONENT + TEN.EXPONENT)
                            - HUNDRED.COMPS.BITS_SHIFTED;
   HUNDRED.COMPS.BITS_SHIFTED := 0;

   THOUSAND.COMPS := HUNDRED.COMPS * TEN.COMPS;
   THOUSAND.EXPONENT := (HUNDRED.EXPONENT + TEN.EXPONENT)
                            - THOUSAND.COMPS.BITS_SHIFTED;
   THOUSAND.COMPS.BITS_SHIFTED := 0;

   TEN_THOUSAND.COMPS := THOUSAND.COMPS * TEN.COMPS;
   TEN_THOUSAND.EXPONENT := (THOUSAND.EXPONENT + TEN.EXPONENT)
                            - TEN_THOUSAND.COMPS.BITS_SHIFTED;
   TEN_THOUSAND.COMPS.BITS_SHIFTED := 0;


   ONE_TENTH.COMPS := ONE.COMPS / TEN.COMPS;
   ONE_TENTH.EXPONENT := (ONE.EXPONENT - TEN.EXPONENT)
                            - ONE_TENTH.COMPS.BITS_SHIFTED;
   ONE_TENTH.COMPS.BITS_SHIFTED := 0;

   ONE_HUNDREDTH.COMPS := ONE_TENTH.COMPS / TEN.COMPS;
   ONE_HUNDREDTH.EXPONENT := (ONE_TENTH.EXPONENT - TEN.EXPONENT)
                            - ONE_HUNDREDTH.COMPS.BITS_SHIFTED;
   ONE_HUNDREDTH.COMPS.BITS_SHIFTED := 0;

   ONE_THOUSANDTH.COMPS := ONE_HUNDREDTH.COMPS / TEN.COMPS;
   ONE_THOUSANDTH.EXPONENT := (ONE_HUNDREDTH.EXPONENT - TEN.EXPONENT)
                            - ONE_THOUSANDTH.COMPS.BITS_SHIFTED;
   ONE_THOUSANDTH.COMPS.BITS_SHIFTED := 0;

   ONE_TEN_THOUSANDTH.COMPS := ONE_THOUSANDTH.COMPS / TEN.COMPS;
   ONE_TEN_THOUSANDTH.EXPONENT := (ONE_THOUSANDTH.EXPONENT - TEN.EXPONENT)
                            - ONE_TEN_THOUSANDTH.COMPS.BITS_SHIFTED;
   ONE_TEN_THOUSANDTH.COMPS.BITS_SHIFTED := 0;


   MAE_LONG_FLOAT_EPSILON := (TWO**(-(TARGET_LONG_NUM_BITS-1)));
   MAE_LONG_FLOAT_LARGE := ((TWO**(MAX_EXPONENT_VALUE-1)) -
               (TWO**(MAX_EXPONENT_VALUE-(TARGET_LONG_NUM_BITS))))
               *TWO;
   MAE_LONG_FLOAT_SMALL := (TWO**(MIN_EXPONENT_VALUE-1));
   MAE_LONG_FLOAT_LAST := MAE_LONG_FLOAT_LARGE;
   MAE_LONG_FLOAT_FIRST := -MAE_LONG_FLOAT_LARGE;


end MAE_LONG_FLOAT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--mae.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-------------------------------------------------------------------------------
--                                                                           --
--             Emulation of Machine Arithmetic - a WIS Ada Tool              --
--                                                                           --
--                         Ada Technology Group                              --
--                         SYSCON Corporation                                --
--                         3990 Sherman Street                               --
--                         San Diego, CA. 92110                              --
--                                                                           --
--                        John Long & John Reddan                            --
--                                                                           --
-------------------------------------------------------------------------------

with MAE_BASIC_OPERATIONS;
with MAE_INTEGER;
with MAE_SHORT_FLOAT;
with MAE_LONG_FLOAT;

package MACHINE_ARITHMETIC_EMULATION is
--------------------------------------------------------------------
--  The purpose of this package is to emulate target machine
--  arithmetic on host machines with 16-bit or larger words.
--  This package will export support for target integer, real,
--  and double precision real numbers.
--
--  The emulation packages are currently configured to
--  support Honeywell 36-bit arithmetic.
--
--  The ranges for the current configuration are as follows:
--
--     TARGET_INTEGER
--        range of -2**35 to 2**35-1
--     TARGET_SHORT_FLOAT
--        approximate range of 10**-38 to 10**38 and 0
--        mantissa => 27 bit binary fraction
--        exponent => -128 to 127
--     TARGET_LONG_FLOAT
--        approximate range of 10**-38 to 10**38 and 0
--        mantissa => 63 bit binary fraction
--        exponent => -128 to 127
--
--  Any errors which occur during use of the arithmetic and
--  boolean functions defined below will result in the
--  raising of the exception "MAE_NUMERIC_ERROR".  The
--  exception declared in this package is a rename of
--  the predefined exception NUMERIC_ERROR.  This can be
--  changed for programs needing to handle arithmetic
--  exceptions generated by the emulation packages separately.
--


--------------------------------------------------------------------
-- Parameters within MAE_BASIC_OPERATIONS that need to be available
-- to the user of the Emulation of Machine Arithmetic package:
--
   subtype NUMBER_BASE is MAE_BASIC_OPERATIONS.NUMBER_BASE;
   DEFAULT_BASE : NUMBER_BASE renames MAE_BASIC_OPERATIONS.DEFAULT_BASE;

   subtype FIELD is MAE_BASIC_OPERATIONS.FIELD;
   TARGET_SHORT_DEFAULT_AFT : FIELD
                 renames MAE_BASIC_OPERATIONS.SHORT_DEFAULT_AFT;
   TARGET_LONG_DEFAULT_AFT : FIELD
                 renames MAE_BASIC_OPERATIONS.LONG_DEFAULT_AFT;
   TARGET_SHORT_DEFAULT_EXP : FIELD
                 renames MAE_BASIC_OPERATIONS.SHORT_DEFAULT_EXP;
   TARGET_LONG_DEFAULT_EXP : FIELD
                 renames MAE_BASIC_OPERATIONS.LONG_DEFAULT_EXP;

   --
   -- predefined attributes for the emulated types
   --
      TARGET_SHORT_FLOAT_DIGITS : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_DIGITS;
      TARGET_LONG_FLOAT_DIGITS : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_DIGITS;

      TARGET_SHORT_FLOAT_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_EMAX;
      TARGET_LONG_FLOAT_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_EMAX;

      TARGET_SHORT_FLOAT_MACHINE_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_EMAX;
      TARGET_LONG_FLOAT_MACHINE_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_EMAX;

      TARGET_SHORT_FLOAT_MACHINE_EMIN : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_EMIN;
      TARGET_LONG_FLOAT_MACHINE_EMIN : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_EMIN;

      TARGET_SHORT_FLOAT_MACHINE_MANTISSA : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_MANTISSA;
      TARGET_LONG_FLOAT_MACHINE_MANTISSA : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_MANTISSA;

      TARGET_SHORT_FLOAT_MACHINE_OVERFLOWS : BOOLEAN
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_OVERFLOWS;
      TARGET_LONG_FLOAT_MACHINE_OVERFLOWS : BOOLEAN
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_OVERFLOWS;

      TARGET_SHORT_FLOAT_MACHINE_RADIX : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_RADIX;
      TARGET_LONG_FLOAT_MACHINE_RADIX : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_RADIX;

      TARGET_SHORT_FLOAT_MACHINE_ROUNDS : BOOLEAN
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_MACHINE_ROUNDS;
      TARGET_LONG_FLOAT_MACHINE_ROUNDS : BOOLEAN
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_MACHINE_ROUNDS;

      TARGET_SHORT_FLOAT_SAFE_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.SHORT_FLOAT_SAFE_EMAX;
      TARGET_LONG_FLOAT_SAFE_EMAX : INTEGER
                 renames MAE_BASIC_OPERATIONS.LONG_FLOAT_SAFE_EMAX;

--------------------------------------------------------------------
-- Visible operations with TARGET_INTEGER
--
-- The follow declaration should be private

   subtype TARGET_INTEGER is MAE_INTEGER.MAE_INTEGER_TYPE;

   -- The defined operators for this type are as follows:

   function TARGET_INTEGER_FIRST return TARGET_INTEGER;
   function TARGET_INTEGER_LAST return TARGET_INTEGER;

   -- Predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN;
   function "<="   (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN;
   function ">"    (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN;
   function ">="   (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN;

   function "+"    (RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "-"    (RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "abs"  (RIGHT : TARGET_INTEGER) return TARGET_INTEGER;

   function "+"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "-"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "*"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "/"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "rem"  (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;
   function "mod"  (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER;

   function "**"   (LEFT : TARGET_INTEGER; RIGHT : INTEGER)
                       return TARGET_INTEGER;

   function TARGET_INTEGER_VALUE (STRING_PIC : STRING)
                       return TARGET_INTEGER;
   function TARGET_INTEGER_IMAGE (STORE_PIC : TARGET_INTEGER)
                       return STRING;

   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_INTEGER;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_INTEGER;
                  BASE : in NUMBER_BASE := DEFAULT_BASE);

--------------------------------------------------------------------
-- Visible operations with TARGET_SHORT_FLOAT
--
-- The following declaration should be private

   subtype TARGET_SHORT_FLOAT is MAE_SHORT_FLOAT.MAE_SHORT_FLOAT_TYPE;

   -- The defined operators for this type are as follows:


   function TARGET_SHORT_FLOAT_EPSILON return TARGET_SHORT_FLOAT;
   function TARGET_SHORT_FLOAT_LARGE return TARGET_SHORT_FLOAT;
   function TARGET_SHORT_FLOAT_SMALL return TARGET_SHORT_FLOAT;
   function TARGET_SHORT_FLOAT_LAST return TARGET_SHORT_FLOAT;
   function TARGET_SHORT_FLOAT_FIRST return TARGET_SHORT_FLOAT;

   -- Predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN;
   function "<="   (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN;
   function ">"    (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN;
   function ">="   (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN;

   function "+"    (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;
   function "-"    (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;
   function "abs"  (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;

   function "+"    (LEFT,RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;
   function "-"    (LEFT,RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;
   function "*"    (LEFT,RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;
   function "/"    (LEFT,RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT;

   function "**"   (LEFT : TARGET_SHORT_FLOAT; RIGHT : INTEGER)
                       return TARGET_SHORT_FLOAT;

   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_SHORT_FLOAT;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_SHORT_FLOAT;
                  AFT : in FIELD := TARGET_SHORT_DEFAULT_AFT;
                  EXP : in FIELD := TARGET_SHORT_DEFAULT_EXP);

--------------------------------------------------------------------
-- Visible operations with TARGET_LONG_FLOAT
--
-- The following declaration should be private

   subtype TARGET_LONG_FLOAT is MAE_LONG_FLOAT.MAE_LONG_FLOAT_TYPE;

   -- The defined operators for this type are as follows:

   function TARGET_LONG_FLOAT_EPSILON return TARGET_LONG_FLOAT;
   function TARGET_LONG_FLOAT_LARGE return TARGET_LONG_FLOAT;
   function TARGET_LONG_FLOAT_SMALL return TARGET_LONG_FLOAT;
   function TARGET_LONG_FLOAT_LAST return TARGET_LONG_FLOAT;
   function TARGET_LONG_FLOAT_FIRST return TARGET_LONG_FLOAT;

   -- Predefined system function "=" and function "/="
   function "<"    (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN;
   function "<="   (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN;
   function ">"    (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN;
   function ">="   (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN;

   function "+"    (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;
   function "-"    (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;
   function "abs"  (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;

   function "+"    (LEFT,RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;
   function "-"    (LEFT,RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;
   function "*"    (LEFT,RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;
   function "/"    (LEFT,RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT;

   function "**"   (LEFT : TARGET_LONG_FLOAT; RIGHT : INTEGER)
                       return TARGET_LONG_FLOAT;

   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_LONG_FLOAT;
                  LAST : out POSITIVE);

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_LONG_FLOAT;
                  AFT : in FIELD := TARGET_LONG_DEFAULT_AFT;
                  EXP : in FIELD := TARGET_LONG_DEFAULT_EXP);

--------------------------------------------------------------------
-- private

   -- Note : Derived types are not supported under
   -- Telesoft version 1.5

   -- The types are private to prevent direct manipulation of
   -- the components of the numbers.  The exported types
   -- are declarations of the appropriate types from the
   -- respective package.

      -- type TARGET_INTEGER is new MAE_INTEGER_TYPE;

      -- type TARGET_SHORT_FLOAT is new MAE_SHORT_FLOAT_TYPE;

      -- type TARGET_LONG_FLOAT is new MAE_SHORT_LONG_TYPE;


--------------------------------------------------------------------

end MACHINE_ARITHMETIC_EMULATION;

--------------------------------------------------------------------
--------------------------------------------------------------------

with MAE_BASIC_OPERATIONS;
with MAE_INTEGER;
with MAE_SHORT_FLOAT;
with MAE_LONG_FLOAT;

package body MACHINE_ARITHMETIC_EMULATION is
--------------------------------------------------------------------

-- Visible operations with TARGET_INTEGER
--

   function TARGET_INTEGER_FIRST return TARGET_INTEGER is
   begin
      return MAE_INTEGER.TARGET_INTEGER_FIRST;
   end;

   function TARGET_INTEGER_LAST return TARGET_INTEGER is
   begin
      return MAE_INTEGER.TARGET_INTEGER_LAST;
   end;

   -- Predefined system function "=" and function "/="

   function "<"    (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN is
   begin
      return MAE_INTEGER."<"(LEFT, RIGHT);
   end;

   function "<="   (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN is
   begin
      return MAE_INTEGER."<="(LEFT, RIGHT);
   end;

   function ">"    (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN is
   begin
      return MAE_INTEGER.">"(LEFT, RIGHT);
   end;

   function ">="   (LEFT, RIGHT : TARGET_INTEGER) return BOOLEAN is
   begin
      return MAE_INTEGER.">="(LEFT, RIGHT);
   end;


   function "+"    (RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."+"(RIGHT);
   end;

   function "-"    (RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."-"(RIGHT);
   end;

   function "abs"  (RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."abs"(RIGHT);
   end;


   function "+"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."+"(LEFT, RIGHT);
   end;

   function "-"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."-"(LEFT, RIGHT);
   end;

   function "*"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."*"(LEFT, RIGHT);
   end;

   function "/"    (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."/"(LEFT, RIGHT);
   end;

   function "rem"  (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."rem"(LEFT, RIGHT);
   end;

   function "mod"  (LEFT,RIGHT : TARGET_INTEGER) return TARGET_INTEGER is
   begin
      return MAE_INTEGER."mod"(LEFT, RIGHT);
   end;


   function "**"   (LEFT : TARGET_INTEGER; RIGHT : INTEGER)
                       return TARGET_INTEGER is
   begin
      return MAE_INTEGER."**"(LEFT, RIGHT);
   end;


   function TARGET_INTEGER_VALUE (STRING_PIC : STRING)
                                     return TARGET_INTEGER is
   begin
      return MAE_INTEGER.MAE_INTEGER_TYPE_VALUE(STRING_PIC);
   end;

   function TARGET_INTEGER_IMAGE (STORE_PIC : TARGET_INTEGER)
                                     return STRING is
   begin
      return MAE_INTEGER.MAE_INTEGER_TYPE_IMAGE(STORE_PIC);
   end;

   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_INTEGER;
                  LAST : out POSITIVE) is
   begin
      MAE_INTEGER.GET(FROM, ITEM, LAST);
   end;

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_INTEGER;
                  BASE : in NUMBER_BASE := DEFAULT_BASE) is
   begin
      MAE_INTEGER.PUT(TO, ITEM, BASE);
   end;

--------------------------------------------------------------------
-- Visible operations with TARGET_SHORT_FLOAT
--

   function TARGET_SHORT_FLOAT_EPSILON return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT.TARGET_SHORT_FLOAT_EPSILON;
   end;

   function TARGET_SHORT_FLOAT_LARGE return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT.TARGET_SHORT_FLOAT_LARGE;
   end;

   function TARGET_SHORT_FLOAT_SMALL return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT.TARGET_SHORT_FLOAT_SMALL;
   end;

   function TARGET_SHORT_FLOAT_LAST return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT.TARGET_SHORT_FLOAT_LAST;
   end;

   function TARGET_SHORT_FLOAT_FIRST return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT.TARGET_SHORT_FLOAT_FIRST;
   end;

   -- Predefined system function "=" and function "/="

   function "<"    (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN is
   begin
      return MAE_SHORT_FLOAT."<"(LEFT, RIGHT);
   end;

   function "<="   (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN is
   begin
      return MAE_SHORT_FLOAT."<="(LEFT, RIGHT);
   end;

   function ">"    (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN is
   begin
      return MAE_SHORT_FLOAT.">"(LEFT, RIGHT);
   end;

   function ">="   (LEFT, RIGHT : TARGET_SHORT_FLOAT) return BOOLEAN is
   begin
      return MAE_SHORT_FLOAT.">="(LEFT, RIGHT);
   end;


   function "+"    (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."+"(RIGHT);
   end;

   function "-"    (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."-"(RIGHT);
   end;

   function "abs"  (RIGHT : TARGET_SHORT_FLOAT) return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."abs"(RIGHT);
   end;


   function "+"    (LEFT,RIGHT : TARGET_SHORT_FLOAT)
                       return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."+"(LEFT, RIGHT);
   end;

   function "-"    (LEFT,RIGHT : TARGET_SHORT_FLOAT)
                       return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."-"(LEFT, RIGHT);
   end;

   function "*"    (LEFT,RIGHT : TARGET_SHORT_FLOAT)
                       return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."*"(LEFT, RIGHT);
   end;

   function "/"    (LEFT,RIGHT : TARGET_SHORT_FLOAT)
                       return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."/"(LEFT, RIGHT);
   end;


   function "**"   (LEFT : TARGET_SHORT_FLOAT; RIGHT : INTEGER)
                       return TARGET_SHORT_FLOAT is
   begin
      return MAE_SHORT_FLOAT."**"(LEFT, RIGHT);
   end;


   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_SHORT_FLOAT;
                  LAST : out POSITIVE) is
   begin
      MAE_SHORT_FLOAT.GET(FROM, ITEM, LAST);
   end;

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_SHORT_FLOAT;
                  AFT : in FIELD := TARGET_SHORT_DEFAULT_AFT;
                  EXP : in FIELD := TARGET_SHORT_DEFAULT_EXP) is
   begin
      MAE_SHORT_FLOAT.PUT(TO, ITEM, AFT, EXP);
   end;

--------------------------------------------------------------------
-- Visible operations with TARGET_LONG_FLOAT
--

   function TARGET_LONG_FLOAT_EPSILON return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT.TARGET_LONG_FLOAT_EPSILON;
   end;

   function TARGET_LONG_FLOAT_LARGE return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT.TARGET_LONG_FLOAT_LARGE;
   end;

   function TARGET_LONG_FLOAT_SMALL return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT.TARGET_LONG_FLOAT_SMALL;
   end;

   function TARGET_LONG_FLOAT_LAST return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT.TARGET_LONG_FLOAT_LAST;
   end;

   function TARGET_LONG_FLOAT_FIRST return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT.TARGET_LONG_FLOAT_FIRST;
   end;

   -- Predefined system function "=" and function "/="

   function "<"    (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN is
   begin
      return MAE_LONG_FLOAT."<"(LEFT, RIGHT);
   end;

   function "<="   (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN is
   begin
      return MAE_LONG_FLOAT."<="(LEFT, RIGHT);
   end;

   function ">"    (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN is
   begin
      return MAE_LONG_FLOAT.">"(LEFT, RIGHT);
   end;

   function ">="   (LEFT, RIGHT : TARGET_LONG_FLOAT) return BOOLEAN is
   begin
      return MAE_LONG_FLOAT.">="(LEFT, RIGHT);
   end;


   function "+"    (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."+"(RIGHT);
   end;

   function "-"    (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."-"(RIGHT);
   end;

   function "abs"  (RIGHT : TARGET_LONG_FLOAT) return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."abs"(RIGHT);
   end;


   function "+"    (LEFT,RIGHT : TARGET_LONG_FLOAT) return
                       TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."+"(LEFT, RIGHT);
   end;

   function "-"    (LEFT,RIGHT : TARGET_LONG_FLOAT)
                       return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."-"(LEFT, RIGHT);
   end;

   function "*"    (LEFT,RIGHT : TARGET_LONG_FLOAT)
                       return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."*"(LEFT, RIGHT);
   end;

   function "/"    (LEFT,RIGHT : TARGET_LONG_FLOAT)
                       return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."/"(LEFT, RIGHT);
   end;


   function "**"   (LEFT : TARGET_LONG_FLOAT; RIGHT : INTEGER)
                       return TARGET_LONG_FLOAT is
   begin
      return MAE_LONG_FLOAT."**"(LEFT, RIGHT);
   end;


   procedure GET (FROM : in STRING;
                  ITEM : out TARGET_LONG_FLOAT;
                  LAST : out POSITIVE) is
   begin
      MAE_LONG_FLOAT.GET(FROM, ITEM, LAST);
   end;

   procedure PUT (TO : out STRING;
                  ITEM : in TARGET_LONG_FLOAT;
                  AFT : in FIELD := TARGET_LONG_DEFAULT_AFT;
                  EXP : in FIELD := TARGET_LONG_DEFAULT_EXP) is
   begin
      MAE_LONG_FLOAT.PUT(TO, ITEM, AFT, EXP);
   end;

--------------------------------------------------------------------
-- The body of the package
--
begin
   null;
end MACHINE_ARITHMETIC_EMULATION;