OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [s-imgint.adb] - Blame information for rev 410

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn 
------------------------------------------------------------------------------
2 
--                                                                          --
3 
--                         GNAT RUN-TIME COMPONENTS                         --
4 
--                                                                          --
5 
--                       S Y S T E M . I M G _ I N T                        --
6 
--                                                                          --
7 
--                                 B o d y                                  --
8 
--                                                                          --
9 
--          Copyright (C) 1992-2009, 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 
 
32 
package body System.Img_Int is
33 
 
34 
   -------------------
35 
   -- Image_Integer --
36 
   -------------------
37 
 
38 
   procedure Image_Integer
39 
     (V : Integer;
40 
      S : in out String;
41 
      P : out Natural)
42 
   is
43 
      pragma Assert (S'First = 1);
44 
 
45 
      procedure Set_Digits (T : Integer);
46 
      --  Set digits of absolute value of T, which is zero or negative. We work
47 
      --  with the negative of the value so that the largest negative number is
48 
      --  not a special case.
49 
 
50 
      ----------------
51 
      -- Set_Digits --
52 
      ----------------
53 
 
54 
      procedure Set_Digits (T : Integer) is
55 
      begin
56 
         if T <= -10 then
57 
            Set_Digits (T / 10);
58 
            P := P + 1;
59 
            S (P) := Character'Val (48 - (T rem 10));
60 
         else
61 
            P := P + 1;
62 
            S (P) := Character'Val (48 - T);
63 
         end if;
64 
      end Set_Digits;
65 
 
66 
   --  Start of processing for Image_Integer
67 
 
68 
   begin
69 
      P := 1;
70 
 
71 
      if V >= 0 then
72 
         S (P) := ' ';
73 
         Set_Digits (-V);
74 
      else
75 
         S (P) := '-';
76 
         Set_Digits (V);
77 
      end if;
78 
   end Image_Integer;
79 
 
80 
   -----------------------
81 
   -- Set_Image_Integer --
82 
   -----------------------
83 
 
84 
   procedure Set_Image_Integer
85 
     (V : Integer;
86 
      S : in out String;
87 
      P : in out Natural)
88 
   is
89 
      procedure Set_Digits (T : Integer);
90 
      --  Set digits of absolute value of T, which is zero or negative. We work
91 
      --  with the negative of the value so that the largest negative number is
92 
      --  not a special case.
93 
 
94 
      ----------------
95 
      -- Set_Digits --
96 
      ----------------
97 
 
98 
      procedure Set_Digits (T : Integer) is
99 
      begin
100 
         if T <= -10 then
101 
            Set_Digits (T / 10);
102 
            P := P + 1;
103 
            S (P) := Character'Val (48 - (T rem 10));
104 
         else
105 
            P := P + 1;
106 
            S (P) := Character'Val (48 - T);
107 
         end if;
108 
      end Set_Digits;
109 
 
110 
   --  Start of processing for Set_Image_Integer
111 
 
112 
   begin
113 
      if V >= 0 then
114 
         Set_Digits (-V);
115 
      else
116 
         P := P + 1;
117 
         S (P) := '-';
118 
         Set_Digits (V);
119 
      end if;
120 
   end Set_Image_Integer;
121 
 
122 
end System.Img_Int;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.