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-2012, 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 32with Ada.Unchecked_Conversion; 33 34with System.Val_Util; use System.Val_Util; 35 36package 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 155end System.Val_Enum; 156