File : s-imgwiu.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . I M G _ W I U --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, 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 -- --
19 -- --
20 -- --
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.Unsigned_Types; use System.Unsigned_Types;
33
34 package body System.Img_WIU is
35
36 -----------------------------
37 -- Set_Image_Width_Integer --
38 -----------------------------
39
40 procedure Set_Image_Width_Integer
41 (V : Integer;
42 W : Integer;
43 S : out String;
44 P : in out Natural)
45 is
46 Start : Natural;
47
48 begin
49 -- Positive case can just use the unsigned circuit directly
50
51 if V >= 0 then
52 Set_Image_Width_Unsigned (Unsigned (V), W, S, P);
53
54 -- Negative case has to set a minus sign. Note also that we have to be
55 -- careful not to generate overflow with the largest negative number.
56
57 else
58 P := P + 1;
59 S (P) := ' ';
60 Start := P;
61
62 declare
63 pragma Suppress (Overflow_Check);
64 pragma Suppress (Range_Check);
65 begin
66 Set_Image_Width_Unsigned (Unsigned (-V), W - 1, S, P);
67 end;
68
69 -- Set minus sign in last leading blank location. Because of the
70 -- code above, there must be at least one such location.
71
72 while S (Start + 1) = ' ' loop
73 Start := Start + 1;
74 end loop;
75
76 S (Start) := '-';
77 end if;
78
79 end Set_Image_Width_Integer;
80
81 ------------------------------
82 -- Set_Image_Width_Unsigned --
83 ------------------------------
84
85 procedure Set_Image_Width_Unsigned
86 (V : Unsigned;
87 W : Integer;
88 S : out String;
89 P : in out Natural)
90 is
91 Start : constant Natural := P;
92 F, T : Natural;
93
94 procedure Set_Digits (T : Unsigned);
95 -- Set digits of absolute value of T
96
97 ----------------
98 -- Set_Digits --
99 ----------------
100
101 procedure Set_Digits (T : Unsigned) is
102 begin
103 if T >= 10 then
104 Set_Digits (T / 10);
105 P := P + 1;
106 S (P) := Character'Val (T mod 10 + Character'Pos ('0'));
107 else
108 P := P + 1;
109 S (P) := Character'Val (T + Character'Pos ('0'));
110 end if;
111 end Set_Digits;
112
113 -- Start of processing for Set_Image_Width_Unsigned
114
115 begin
116 Set_Digits (V);
117
118 -- Add leading spaces if required by width parameter
119
120 if P - Start < W then
121 F := P;
122 P := P + (W - (P - Start));
123 T := P;
124
125 while F > Start loop
126 S (T) := S (F);
127 T := T - 1;
128 F := F - 1;
129 end loop;
130
131 for J in Start + 1 .. T loop
132 S (J) := ' ';
133 end loop;
134 end if;
135
136 end Set_Image_Width_Unsigned;
137
138 end System.Img_WIU;