@@ -88,68 +88,53 @@ package body System.Image_B is
S : out String;
P : in out Natural)
is
- Start : constant Natural := P;
- F, T : Natural;
+ Start : constant Natural := P + 1;
BU : constant Uns := Uns (B);
Hex : constant array
(Uns range 0 .. 15) of Character := "0123456789ABCDEF";
- procedure Set_Digits (T : Uns);
- -- Set digits of absolute value of T
+ Nb_Digits : Natural := 1;
+ T : Uns := V;
- ----------------
- -- Set_Digits --
- ----------------
+ begin
- procedure Set_Digits (T : Uns) is
- begin
- if T >= BU then
- Set_Digits (T / BU);
- P := P + 1;
- S (P) := Hex (T mod BU);
- else
- P := P + 1;
- S (P) := Hex (T);
- end if;
- end Set_Digits;
+ -- First we compute the number of characters needed for representing
+ -- the number.
+ loop
+ T := T / BU;
+ exit when T = 0;
+ Nb_Digits := Nb_Digits + 1;
+ end loop;
- -- Start of processing for Set_Image_Based_Unsigned
+ P := Start;
- begin
+ -- Pad S with spaces up to W reduced by Nb_Digits plus extra 3-4
+ -- characters needed for displaying the base.
+ while P < Start + W - Nb_Digits - 3 - B / 10 loop
+ S (P) := ' ';
+ P := P + 1;
+ end loop;
if B >= 10 then
- P := P + 1;
S (P) := '1';
+ P := P + 1;
end if;
+ S (P) := Hex (BU mod 10);
P := P + 1;
- S (P) := Character'Val (Character'Pos ('0') + B mod 10);
- P := P + 1;
S (P) := '#';
-
- Set_Digits (V);
-
P := P + 1;
- S (P) := '#';
-
- -- Add leading spaces if required by width parameter
-
- if P - Start < W then
- F := P;
- P := Start + W;
- T := P;
- while F > Start loop
- S (T) := S (F);
- T := T - 1;
- F := F - 1;
- end loop;
+ -- We now populate digits from the end of the value to the beginning
+ T := V;
+ for J in reverse P .. P + Nb_Digits - 1 loop
+ S (J) := Hex (T mod BU);
+ T := T / BU;
+ end loop;
- for J in Start + 1 .. T loop
- S (J) := ' ';
- end loop;
- end if;
+ P := P + Nb_Digits;
+ S (P) := '#';
end Set_Image_Based_Unsigned;
@@ -86,66 +86,36 @@ package body System.Image_W is
S : out String;
P : in out Natural)
is
- Start : constant Natural := P;
- F, T : Natural;
-
- procedure Set_Digits (T : Uns);
- -- Set digits of absolute value of T
-
- ----------------
- -- Set_Digits --
- ----------------
-
- procedure Set_Digits (T : Uns) is
- begin
- if T >= 10 then
- Set_Digits (T / 10);
- pragma Assert (P >= (S'First - 1) and P < S'Last and
- P < Natural'Last);
- -- No check is done since, as documented in the specification,
- -- the caller guarantees that S is long enough to hold the result.
- P := P + 1;
- S (P) := Character'Val (T mod 10 + Character'Pos ('0'));
-
- else
- pragma Assert (P >= (S'First - 1) and P < S'Last and
- P < Natural'Last);
- -- No check is done since, as documented in the specification,
- -- the caller guarantees that S is long enough to hold the result.
- P := P + 1;
- S (P) := Character'Val (T + Character'Pos ('0'));
- end if;
- end Set_Digits;
-
- -- Start of processing for Set_Image_Width_Unsigned
+ Start : constant Natural := P + 1;
+ Nb_Digits : Natural := 1;
+ T : Uns := V;
begin
- Set_Digits (V);
-
- -- Add leading spaces if required by width parameter
-
- if P - Start < W then
- F := P;
- P := P + (W - (P - Start));
- T := P;
-
- while F > Start loop
- pragma Assert (T >= S'First and T <= S'Last and
- F >= S'First and F <= S'Last);
- -- No check is done since, as documented in the specification,
- -- the caller guarantees that S is long enough to hold the result.
- S (T) := S (F);
- T := T - 1;
- F := F - 1;
- end loop;
- for J in Start + 1 .. T loop
- pragma Assert (J >= S'First and J <= S'Last);
- -- No check is done since, as documented in the specification,
- -- the caller guarantees that S is long enough to hold the result.
- S (J) := ' ';
- end loop;
- end if;
+ -- First we compute the number of characters needed for representing
+ -- the number.
+ loop
+ T := T / 10;
+ exit when T = 0;
+ Nb_Digits := Nb_Digits + 1;
+ end loop;
+
+ P := Start;
+
+ -- Pad S with spaces up to W reduced by Nb_Digits
+ while P < Start + W - Nb_Digits loop
+ S (P) := ' ';
+ P := P + 1;
+ end loop;
+
+ -- We now populate digits from the end of the value to the beginning
+ T := V;
+ for J in reverse P .. P + Nb_Digits - 1 loop
+ S (J) := Character'Val (T mod 10 + Character'Pos ('0'));
+ T := T / 10;
+ end loop;
+
+ P := P + Nb_Digits - 1;
end Set_Image_Width_Unsigned;
From: Vasiliy Fofanov <fofanov@adacore.com> This rewriting removes algorithm inefficiencies due to unnecessary recursion and copying. The new version has much smaller and statically known stack requirements and is additionally up to 2x faster. gcc/ada/ * libgnat/s-imageb.adb (Set_Image_Based_Unsigned): Rewritten. * libgnat/s-imagew.adb (Set_Image_Width_Unsigned): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-imageb.adb | 71 ++++++++++++------------------ gcc/ada/libgnat/s-imagew.adb | 84 ++++++++++++------------------------ 2 files changed, 55 insertions(+), 100 deletions(-)