1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . I M A G E _ I -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2020, 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-- 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 32package body System.Image_I is 33 34 subtype Non_Positive is Int range Int'First .. 0; 35 36 procedure Set_Digits 37 (T : Non_Positive; 38 S : in out String; 39 P : in out Natural); 40 -- Set digits of absolute value of T, which is zero or negative. We work 41 -- with the negative of the value so that the largest negative number is 42 -- not a special case. 43 44 ------------------- 45 -- Image_Integer -- 46 ------------------- 47 48 procedure Image_Integer 49 (V : Int; 50 S : in out String; 51 P : out Natural) 52 is 53 pragma Assert (S'First = 1); 54 55 begin 56 if V >= 0 then 57 S (1) := ' '; 58 P := 1; 59 pragma Assert (P < S'Last); 60 61 else 62 P := 0; 63 pragma Assert (P < S'Last - 1); 64 end if; 65 66 Set_Image_Integer (V, S, P); 67 end Image_Integer; 68 69 ---------------- 70 -- Set_Digits -- 71 ---------------- 72 73 procedure Set_Digits 74 (T : Non_Positive; 75 S : in out String; 76 P : in out Natural) 77 is 78 Nb_Digits : Natural := 0; 79 Value : Non_Positive := T; 80 begin 81 pragma Assert (P >= S'First - 1 and P < S'Last); 82 -- No check is done since, as documented in the Set_Image_Integer 83 -- specification, the caller guarantees that S is long enough to 84 -- hold the result. 85 86 -- First we compute the number of characters needed for representing 87 -- the number. 88 loop 89 Value := Value / 10; 90 Nb_Digits := Nb_Digits + 1; 91 exit when Value = 0; 92 end loop; 93 94 Value := T; 95 96 -- We now populate digits from the end of the string to the beginning 97 for J in reverse 1 .. Nb_Digits loop 98 S (P + J) := Character'Val (48 - (Value rem 10)); 99 Value := Value / 10; 100 end loop; 101 102 P := P + Nb_Digits; 103 end Set_Digits; 104 105 ----------------------- 106 -- Set_Image_Integer -- 107 ----------------------- 108 109 procedure Set_Image_Integer 110 (V : Int; 111 S : in out String; 112 P : in out Natural) 113 is 114 begin 115 if V >= 0 then 116 Set_Digits (-V, S, P); 117 118 else 119 pragma Assert (P >= S'First - 1 and P < S'Last); 120 -- No check is done since, as documented in the specification, 121 -- the caller guarantees that S is long enough to hold the result. 122 P := P + 1; 123 S (P) := '-'; 124 Set_Digits (V, S, P); 125 end if; 126 end Set_Image_Integer; 127 128end System.Image_I; 129