gcc/ada/s-boustr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                S Y S T E M . B O U N D E D _ S T R I N G S               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                       Copyright (C) 2016, AdaCore                        --
  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 System.Storage_Elements;
  33
  34 package body System.Bounded_Strings is
  35
  36    ------------
  37    -- Append --
  38    ------------
  39
  40    procedure Append (X : in out Bounded_String; C : Character) is
  41    begin
  42       --  If we have too many characters to fit, simply drop them
  43
  44       if X.Length < X.Max_Length then
  45          X.Length           := X.Length + 1;
  46          X.Chars (X.Length) := C;
  47       end if;
  48    end Append;
  49
  50    procedure Append (X : in out Bounded_String; S : String) is
  51    begin
  52       for C of S loop
  53          Append (X, C);
  54       end loop;
  55    end Append;
  56
  57    --------------------
  58    -- Append_Address --
  59    --------------------
  60
  61    procedure Append_Address (X : in out Bounded_String; A : Address)
  62    is
  63       S : String (1 .. 18);
  64       P : Natural;
  65       use System.Storage_Elements;
  66       N : Integer_Address;
  67
  68       H : constant array (Integer range 0 .. 15) of Character :=
  69         "0123456789abcdef";
  70    begin
  71       P := S'Last;
  72       N := To_Integer (A);
  73       loop
  74          S (P) := H (Integer (N mod 16));
  75          P := P - 1;
  76          N := N / 16;
  77          exit when N = 0;
  78       end loop;
  79
  80       S (P - 1) := '0';
  81       S (P) := 'x';
  82
  83       Append (X, S (P - 1 .. S'Last));
  84    end Append_Address;
  85
  86    -------------
  87    -- Is_Full --
  88    -------------
  89
  90    function Is_Full (X : Bounded_String) return Boolean is
  91    begin
  92       return X.Length >= X.Max_Length;
  93    end Is_Full;
  94
  95    ---------------
  96    -- To_String --
  97    ---------------
  98
  99    function To_String (X : Bounded_String) return String is
 100    begin
 101       return X.Chars (1 .. X.Length);
 102    end To_String;
 103
 104 end System.Bounded_Strings;