gcc/ada/libgnat/s-valenu.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                      S Y S T E M . V A L _ E N U M                       --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Unchecked_Conversion;
  33
  34 with System.Val_Util; use System.Val_Util;
  35
  36 package body System.Val_Enum is
  37
  38    -------------------------
  39    -- Value_Enumeration_8 --
  40    -------------------------
  41
  42    function Value_Enumeration_8
  43      (Names   : String;
  44       Indexes : System.Address;
  45       Num     : Natural;
  46       Str     : String)
  47       return    Natural
  48    is
  49       F : Natural;
  50       L : Natural;
  51       S : String (Str'Range) := Str;
  52
  53       type Natural_8 is range 0 .. 2 ** 7 - 1;
  54       type Index_Table is array (Natural) of Natural_8;
  55       type Index_Table_Ptr is access Index_Table;
  56
  57       function To_Index_Table_Ptr is
  58         new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
  59
  60       IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
  61
  62    begin
  63       Normalize_String (S, F, L);
  64
  65       for J in 0 .. Num loop
  66          if Names
  67            (Natural (IndexesT (J)) ..
  68             Natural (IndexesT (J + 1)) - 1) = S (F .. L)
  69          then
  70             return J;
  71          end if;
  72       end loop;
  73
  74       Bad_Value (Str);
  75    end Value_Enumeration_8;
  76
  77    --------------------------
  78    -- Value_Enumeration_16 --
  79    --------------------------
  80
  81    function Value_Enumeration_16
  82      (Names   : String;
  83       Indexes : System.Address;
  84       Num     : Natural;
  85       Str     : String)
  86       return    Natural
  87    is
  88       F : Natural;
  89       L : Natural;
  90       S : String (Str'Range) := Str;
  91
  92       type Natural_16 is range 0 .. 2 ** 15 - 1;
  93       type Index_Table is array (Natural) of Natural_16;
  94       type Index_Table_Ptr is access Index_Table;
  95
  96       function To_Index_Table_Ptr is
  97         new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
  98
  99       IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
 100
 101    begin
 102       Normalize_String (S, F, L);
 103
 104       for J in 0 .. Num loop
 105          if Names
 106            (Natural (IndexesT (J)) ..
 107             Natural (IndexesT (J + 1)) - 1) = S (F .. L)
 108          then
 109             return J;
 110          end if;
 111       end loop;
 112
 113       Bad_Value (Str);
 114    end Value_Enumeration_16;
 115
 116    --------------------------
 117    -- Value_Enumeration_32 --
 118    --------------------------
 119
 120    function Value_Enumeration_32
 121      (Names   : String;
 122       Indexes : System.Address;
 123       Num     : Natural;
 124       Str     : String)
 125       return    Natural
 126    is
 127       F : Natural;
 128       L : Natural;
 129       S : String (Str'Range) := Str;
 130
 131       type Natural_32 is range 0 .. 2 ** 31 - 1;
 132       type Index_Table is array (Natural) of Natural_32;
 133       type Index_Table_Ptr is access Index_Table;
 134
 135       function To_Index_Table_Ptr is
 136         new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
 137
 138       IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
 139
 140    begin
 141       Normalize_String (S, F, L);
 142
 143       for J in 0 .. Num loop
 144          if Names
 145            (Natural (IndexesT (J)) ..
 146             Natural (IndexesT (J + 1)) - 1) = S (F .. L)
 147          then
 148             return J;
 149          end if;
 150       end loop;
 151
 152       Bad_Value (Str);
 153    end Value_Enumeration_32;
 154
 155 end System.Val_Enum;