1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . I M G _ E N U M -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2000-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 32pragma Compiler_Unit_Warning; 33 34with Ada.Unchecked_Conversion; 35 36package body System.Img_Enum is 37 38 ------------------------- 39 -- Image_Enumeration_8 -- 40 ------------------------- 41 42 function Image_Enumeration_8 43 (Pos : Natural; 44 Names : String; 45 Indexes : System.Address) 46 return String 47 is 48 type Natural_8 is range 0 .. 2 ** 7 - 1; 49 type Index_Table is array (Natural) of Natural_8; 50 type Index_Table_Ptr is access Index_Table; 51 52 function To_Index_Table_Ptr is 53 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); 54 55 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); 56 57 Start : constant Natural := Natural (IndexesT (Pos)); 58 Next : constant Natural := Natural (IndexesT (Pos + 1)); 59 60 subtype Result_Type is String (1 .. Next - Start); 61 -- We need this result type to force the result to have the 62 -- required lower bound of 1, rather than the slice bounds. 63 64 begin 65 return Result_Type (Names (Start .. Next - 1)); 66 end Image_Enumeration_8; 67 68 -------------------------- 69 -- Image_Enumeration_16 -- 70 -------------------------- 71 72 function Image_Enumeration_16 73 (Pos : Natural; 74 Names : String; 75 Indexes : System.Address) 76 return String 77 is 78 type Natural_16 is range 0 .. 2 ** 15 - 1; 79 type Index_Table is array (Natural) of Natural_16; 80 type Index_Table_Ptr is access Index_Table; 81 82 function To_Index_Table_Ptr is 83 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); 84 85 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); 86 87 Start : constant Natural := Natural (IndexesT (Pos)); 88 Next : constant Natural := Natural (IndexesT (Pos + 1)); 89 90 subtype Result_Type is String (1 .. Next - Start); 91 -- We need this result type to force the result to have the 92 -- required lower bound of 1, rather than the slice bounds. 93 94 begin 95 return Result_Type (Names (Start .. Next - 1)); 96 end Image_Enumeration_16; 97 98 -------------------------- 99 -- Image_Enumeration_32 -- 100 -------------------------- 101 102 function Image_Enumeration_32 103 (Pos : Natural; 104 Names : String; 105 Indexes : System.Address) 106 return String 107 is 108 type Natural_32 is range 0 .. 2 ** 31 - 1; 109 type Index_Table is array (Natural) of Natural_32; 110 type Index_Table_Ptr is access Index_Table; 111 112 function To_Index_Table_Ptr is 113 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); 114 115 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); 116 117 Start : constant Natural := Natural (IndexesT (Pos)); 118 Next : constant Natural := Natural (IndexesT (Pos + 1)); 119 120 subtype Result_Type is String (1 .. Next - Start); 121 -- We need this result type to force the result to have the 122 -- required lower bound of 1, rather than the slice bounds. 123 124 begin 125 return Result_Type (Names (Start .. Next - 1)); 126 end Image_Enumeration_32; 127 128end System.Img_Enum; 129