gcc/ada/a-timoio.adb

   1 ------------------------------------------------------------------------------
   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;