OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [a-tienio.adb] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn 
------------------------------------------------------------------------------
2 
--                                                                          --
3 
--                         GNAT RUN-TIME COMPONENTS                         --
4 
--                                                                          --
5 
--           A D A . T E X T _ I O . E N U M E R A T I O N _ I O            --
6 
--                                                                          --
7 
--                                 B o d y                                  --
8 
--                                                                          --
9 
--          Copyright (C) 1992-2009, 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.Text_IO.Enumeration_Aux;
33 
 
34 
package body Ada.Text_IO.Enumeration_IO is
35 
 
36 
   package Aux renames Ada.Text_IO.Enumeration_Aux;
37 
 
38 
   ---------
39 
   -- Get --
40 
   ---------
41 
 
42 
   procedure Get (File : File_Type; Item : out Enum) is
43 
      Buf    : String (1 .. Enum'Width + 1);
44 
      Buflen : Natural;
45 
 
46 
   begin
47 
      Aux.Get_Enum_Lit (File, Buf, Buflen);
48 
 
49 
      declare
50 
         Buf_Str : String renames Buf (1 .. Buflen);
51 
         pragma Unsuppress (Range_Check);
52 
      begin
53 
         Item := Enum'Value (Buf_Str);
54 
      end;
55 
 
56 
   exception
57 
      when Constraint_Error => raise Data_Error;
58 
   end Get;
59 
 
60 
   procedure Get (Item : out Enum) is
61 
      pragma Unsuppress (Range_Check);
62 
   begin
63 
      Get (Current_In, Item);
64 
   end Get;
65 
 
66 
   procedure Get
67 
     (From : String;
68 
      Item : out Enum;
69 
      Last : out Positive)
70 
   is
71 
      Start : Natural;
72 
 
73 
   begin
74 
      Aux.Scan_Enum_Lit (From, Start, Last);
75 
 
76 
      declare
77 
         From_Str : String renames From (Start .. Last);
78 
         pragma Unsuppress (Range_Check);
79 
      begin
80 
         Item := Enum'Value (From_Str);
81 
      end;
82 
 
83 
   exception
84 
      when Constraint_Error => raise Data_Error;
85 
   end Get;
86 
 
87 
   ---------
88 
   -- Put --
89 
   ---------
90 
 
91 
   procedure Put
92 
     (File  : File_Type;
93 
      Item  : Enum;
94 
      Width : Field := Default_Width;
95 
      Set   : Type_Set := Default_Setting)
96 
   is
97 
      Image : constant String := Enum'Image (Item);
98 
   begin
99 
      Aux.Put (File, Image, Width, Set);
100 
   end Put;
101 
 
102 
   procedure Put
103 
     (Item  : Enum;
104 
      Width : Field := Default_Width;
105 
      Set   : Type_Set := Default_Setting)
106 
   is
107 
   begin
108 
      Put (Current_Out, Item, Width, Set);
109 
   end Put;
110 
 
111 
   procedure Put
112 
     (To   : out String;
113 
      Item : Enum;
114 
      Set  : Type_Set := Default_Setting)
115 
   is
116 
      Image : constant String := Enum'Image (Item);
117 
   begin
118 
      Aux.Puts (To, Image, Set);
119 
   end Put;
120 
 
121 
end Ada.Text_IO.Enumeration_IO;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.