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

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-timoio.adb] - Blame information for rev 293

Go to most recent revision | 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 . M O D U L A R _ 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.Modular_Aux;
33 
 
34 
with System.Unsigned_Types; use System.Unsigned_Types;
35 
 
36 
package body Ada.Text_IO.Modular_IO is
37 
 
38 
   package Aux renames Ada.Text_IO.Modular_Aux;
39 
 
40 
   ---------
41 
   -- Get --
42 
   ---------
43 
 
44 
   procedure Get
45 
     (File  : File_Type;
46 
      Item  : out Num;
47 
      Width : Field := 0)
48 
   is
49 
      pragma Unsuppress (Range_Check);
50 
 
51 
   begin
52 
      if Num'Size > Unsigned'Size then
53 
         Aux.Get_LLU (File, Long_Long_Unsigned (Item), Width);
54 
      else
55 
         Aux.Get_Uns (File, Unsigned (Item), Width);
56 
      end if;
57 
 
58 
   exception
59 
      when Constraint_Error => raise Data_Error;
60 
   end Get;
61 
 
62 
   procedure Get
63 
     (Item  : out Num;
64 
      Width : Field := 0)
65 
   is
66 
      pragma Unsuppress (Range_Check);
67 
 
68 
   begin
69 
      if Num'Size > Unsigned'Size then
70 
         Aux.Get_LLU (Current_In, Long_Long_Unsigned (Item), Width);
71 
      else
72 
         Aux.Get_Uns (Current_In, Unsigned (Item), Width);
73 
      end if;
74 
 
75 
   exception
76 
      when Constraint_Error => raise Data_Error;
77 
   end Get;
78 
 
79 
   procedure Get
80 
     (From : String;
81 
      Item : out Num;
82 
      Last : out Positive)
83 
   is
84 
      pragma Unsuppress (Range_Check);
85 
 
86 
   begin
87 
      if Num'Size > Unsigned'Size then
88 
         Aux.Gets_LLU (From, Long_Long_Unsigned (Item), Last);
89 
      else
90 
         Aux.Gets_Uns (From, Unsigned (Item), Last);
91 
      end if;
92 
 
93 
   exception
94 
      when Constraint_Error => raise Data_Error;
95 
   end Get;
96 
 
97 
   ---------
98 
   -- Put --
99 
   ---------
100 
 
101 
   procedure Put
102 
     (File  : File_Type;
103 
      Item  : Num;
104 
      Width : Field := Default_Width;
105 
      Base  : Number_Base := Default_Base)
106 
   is
107 
   begin
108 
      if Num'Size > Unsigned'Size then
109 
         Aux.Put_LLU (File, Long_Long_Unsigned (Item), Width, Base);
110 
      else
111 
         Aux.Put_Uns (File, Unsigned (Item), Width, Base);
112 
      end if;
113 
   end Put;
114 
 
115 
   procedure Put
116 
     (Item  : Num;
117 
      Width : Field := Default_Width;
118 
      Base  : Number_Base := Default_Base)
119 
   is
120 
   begin
121 
      if Num'Size > Unsigned'Size then
122 
         Aux.Put_LLU (Current_Out, Long_Long_Unsigned (Item), Width, Base);
123 
      else
124 
         Aux.Put_Uns (Current_Out, Unsigned (Item), Width, Base);
125 
      end if;
126 
   end Put;
127 
 
128 
   procedure Put
129 
     (To   : out String;
130 
      Item : Num;
131 
      Base : Number_Base := Default_Base)
132 
   is
133 
   begin
134 
      if Num'Size > Unsigned'Size then
135 
         Aux.Puts_LLU (To, Long_Long_Unsigned (Item), Base);
136 
      else
137 
         Aux.Puts_Uns (To, Unsigned (Item), Base);
138 
      end if;
139 
   end Put;
140 
 
141 
end Ada.Text_IO.Modular_IO;

powered by: WebSVN 2.1.0

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