gcc/ada/a-tiinio.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME COMPONENTS                          --
   4 --                                                                          --
   5 --               A D A . T E X T _ I O . I N T E G E R _ I O                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1992-1999 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- As a special exception,  if other files  instantiate  generics from this --
  24 -- unit, or you link  this unit with other files  to produce an executable, --
  25 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  26 -- covered  by the  GNU  General  Public  License.  This exception does not --
  27 -- however invalidate  any other reasons why  the executable file  might be --
  28 -- covered by the  GNU Public License.                                      --
  29 --                                                                          --
  30 -- GNAT was originally developed  by the GNAT team at  New York University. --
  31 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 with Ada.Text_IO.Integer_Aux;
  36
  37 package body Ada.Text_IO.Integer_IO is
  38
  39    package Aux renames Ada.Text_IO.Integer_Aux;
  40
  41    Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
  42    --  Throughout this generic body, we distinguish between the case
  43    --  where type Integer is acceptable, and where a Long_Long_Integer
  44    --  is needed. This constant Boolean is used to test for these cases
  45    --  and since it is a constant, only the code for the relevant case
  46    --  will be included in the instance.
  47
  48    ---------
  49    -- Get --
  50    ---------
  51
  52    procedure Get
  53      (File  : in File_Type;
  54       Item  : out Num;
  55       Width : in Field := 0)
  56    is
  57       --  We depend on a range check to get Data_Error
  58
  59       pragma Unsuppress (Range_Check);
  60       pragma Unsuppress (Overflow_Check);
  61
  62    begin
  63       if Need_LLI then
  64          Aux.Get_LLI (File, Long_Long_Integer (Item), Width);
  65       else
  66          Aux.Get_Int (File, Integer (Item), Width);
  67       end if;
  68
  69    exception
  70       when Constraint_Error => raise Data_Error;
  71    end Get;
  72
  73    procedure Get
  74      (Item  : out Num;
  75       Width : in Field := 0)
  76    is
  77       --  We depend on a range check to get Data_Error
  78
  79       pragma Unsuppress (Range_Check);
  80       pragma Unsuppress (Overflow_Check);
  81
  82    begin
  83       if Need_LLI then
  84          Aux.Get_LLI (Current_In, Long_Long_Integer (Item), Width);
  85       else
  86          Aux.Get_Int (Current_In, Integer (Item), Width);
  87       end if;
  88
  89    exception
  90       when Constraint_Error => raise Data_Error;
  91    end Get;
  92
  93    procedure Get
  94      (From : in String;
  95       Item : out Num;
  96       Last : out Positive)
  97    is
  98       --  We depend on a range check to get Data_Error
  99
 100       pragma Unsuppress (Range_Check);
 101       pragma Unsuppress (Overflow_Check);
 102
 103    begin
 104       if Need_LLI then
 105          Aux.Gets_LLI (From, Long_Long_Integer (Item), Last);
 106       else
 107          Aux.Gets_Int (From, Integer (Item), Last);
 108       end if;
 109
 110    exception
 111       when Constraint_Error => raise Data_Error;
 112    end Get;
 113
 114    ---------
 115    -- Put --
 116    ---------
 117
 118    procedure Put
 119      (File  : in File_Type;
 120       Item  : in Num;
 121       Width : in Field := Default_Width;
 122       Base  : in Number_Base := Default_Base)
 123    is
 124    begin
 125       if Need_LLI then
 126          Aux.Put_LLI (File, Long_Long_Integer (Item), Width, Base);
 127       else
 128          Aux.Put_Int (File, Integer (Item), Width, Base);
 129       end if;
 130    end Put;
 131
 132    procedure Put
 133      (Item  : in Num;
 134       Width : in Field := Default_Width;
 135       Base  : in Number_Base := Default_Base)
 136    is
 137    begin
 138       if Need_LLI then
 139          Aux.Put_LLI (Current_Out, Long_Long_Integer (Item), Width, Base);
 140       else
 141          Aux.Put_Int (Current_Out, Integer (Item), Width, Base);
 142       end if;
 143    end Put;
 144
 145    procedure Put
 146      (To   : out String;
 147       Item : in Num;
 148       Base : in Number_Base := Default_Base)
 149    is
 150    begin
 151       if Need_LLI then
 152          Aux.Puts_LLI (To, Long_Long_Integer (Item), Base);
 153       else
 154          Aux.Puts_Int (To, Integer (Item), Base);
 155       end if;
 156    end Put;
 157
 158 end Ada.Text_IO.Integer_IO;