gcc/testsuite/ada/acats/support/fxf2a00.a

   1 -- FXF2A00.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- FOUNDATION DESCRIPTION:
  27 --      This foundation declares supporting objects, types and a generic
  28 --      function for testing decimal fixed point operations.
  29 --
  30 --      The generic function contains a loop which steps through two arrays:
  31 --      one of binary operations and one of operands. For each iteration, the
  32 --      current operation is performed on the current operand and a variable
  33 --      "Result" e.g.:
  34 --
  35 --                   Result := Operation(2)(Operand(3), Result);
  36 --
  37 --      The result of each operation is cumulated in Result and returned to
  38 --      the caller when the loop completes.
  39 --
  40 -- CHANGE HISTORY:
  41 --      12 Mar 96   SAIC    Prerelease version for ACVC 2.1.
  42 --
  43 --!
  44
  45 package FXF2A00 is
  46
  47    Loop_Count : constant := 30000;             -- # test iterations.
  48    Optr_Count : constant :=     6;             -- # operations in op sequence.
  49    Opnd_Count : constant :=     5;             -- # different operands.
  50
  51    type Loop_Range is range 1 .. Loop_Count;   -- range 1 .. 30000.
  52    type Optr_Range is mod Optr_Count;          -- range 0 .. 5.
  53    type Opnd_Range is mod Opnd_Count;          -- range 0 .. 4.
  54
  55
  56    generic
  57
  58       type Decimal_Fixed is delta <> digits <>;
  59
  60       type Operator_Ptr is access
  61         function (L, R : Decimal_Fixed) return Decimal_Fixed;
  62
  63       type Operator_Table is array (Optr_Range) of Operator_Ptr;
  64       type Operand_Table  is array (Opnd_Range) of Decimal_Fixed;
  65
  66    function Operations_Loop (Initial : Decimal_Fixed;
  67                              Operator: Operator_Table;
  68                              Operand : Operand_Table) return Decimal_Fixed;
  69
  70 end FXF2A00;
  71
  72
  73      --==================================================================--
  74
  75
  76 package body FXF2A00 is
  77
  78    function Operations_Loop (Initial : Decimal_Fixed;
  79                              Operator: Operator_Table;
  80                              Operand : Operand_Table) return Decimal_Fixed is
  81
  82       Result     : Decimal_Fixed := Initial;  -- Cumulator.
  83       Optr_Index : Optr_Range := 0;           -- Index into operations table.
  84       Opnd_Index : Opnd_Range := 0;           -- Index into operand table.
  85
  86    begin
  87       for Count in Loop_Range loop
  88          Result     := Operator(Optr_Index) (Result, Operand(Opnd_Index));
  89          Optr_Index := Optr_Index + 1;        -- Modular addition.
  90          Opnd_Index := Opnd_Index + 1;        -- Modular addition.
  91       end loop;
  92
  93       return Result;
  94    end Operations_Loop;
  95
  96 end FXF2A00;