procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ada: Rewrite Set_Image_*_Unsigned routines to remove recursion.

Browse source 
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.
This commit is contained in:
Vasiliy Fofanov 2023-07-26 08:33:18 +00:00 • committed by Marc Poulhiès
parent 3b21dae599
commit 65a31e22a8
2 changed files with 55 additions and 100 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
gcc/ada/libgnat/s-imageb.adb
View file

@ -88,69 +88,54 @@ 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
----------------
-- Set_Digits --
----------------
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;
-- Start of processing for Set_Image_Based_Unsigned
Nb_Digits : Natural := 1;
T : Uns := V;
begin
if B >= 10 then
-- 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;
P := Start;
-- 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
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;
-- 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;
P := P + Nb_Digits;
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;
for J in Start + 1 .. T loop
S (J) := ' ';
end loop;
end if;
end Set_Image_Based_Unsigned;
end System.Image_B;

78
gcc/ada/libgnat/s-imagew.adb
View file

@ -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
-- 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;
if P - Start < W then
F := P;
P := P + (W - (P - Start));
T := P;
P := Start;
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;
-- 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;
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;
-- 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;