OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-ztcoau.adb] - Blame information for rev 747

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

Line No. Rev Author Line
1 706 jeremybenn 
------------------------------------------------------------------------------
2 
--                                                                          --
3 
--                         GNAT RUN-TIME COMPONENTS                         --
4 
--                                                                          --
5 
--    A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X     --
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 
with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
33 
with Ada.Wide_Wide_Text_IO.Float_Aux;
34 
 
35 
with System.Img_Real; use System.Img_Real;
36 
 
37 
package body Ada.Wide_Wide_Text_IO.Complex_Aux is
38 
 
39 
   package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
40 
 
41 
   ---------
42 
   -- Get --
43 
   ---------
44 
 
45 
   procedure Get
46 
     (File  : File_Type;
47 
      ItemR : out Long_Long_Float;
48 
      ItemI : out Long_Long_Float;
49 
      Width : Field)
50 
   is
51 
      Buf   : String (1 .. Field'Last);
52 
      Stop  : Integer := 0;
53 
      Ptr   : aliased Integer;
54 
      Paren : Boolean := False;
55 
 
56 
   begin
57 
      --  General note for following code, exceptions from the calls
58 
      --  to Get for components of the complex value are propagated.
59 
 
60 
      if Width /= 0 then
61 
         Load_Width (File, Width, Buf, Stop);
62 
         Gets (Buf (1 .. Stop), ItemR, ItemI, Ptr);
63 
 
64 
         for J in Ptr + 1 .. Stop loop
65 
            if not Is_Blank (Buf (J)) then
66 
               raise Data_Error;
67 
            end if;
68 
         end loop;
69 
 
70 
      --  Case of width = 0
71 
 
72 
      else
73 
         Load_Skip (File);
74 
         Ptr := 0;
75 
         Load (File, Buf, Ptr, '(', Paren);
76 
         Aux.Get (File, ItemR, 0);
77 
         Load_Skip (File);
78 
         Load (File, Buf, Ptr, ',');
79 
         Aux.Get (File, ItemI, 0);
80 
 
81 
         if Paren then
82 
            Load_Skip (File);
83 
            Load (File, Buf, Ptr, ')', Paren);
84 
 
85 
            if not Paren then
86 
               raise Data_Error;
87 
            end if;
88 
         end if;
89 
      end if;
90 
   end Get;
91 
 
92 
   ----------
93 
   -- Gets --
94 
   ----------
95 
 
96 
   procedure Gets
97 
     (From  : String;
98 
      ItemR : out Long_Long_Float;
99 
      ItemI : out Long_Long_Float;
100 
      Last  : out Positive)
101 
   is
102 
      Paren : Boolean;
103 
      Pos   : Integer;
104 
 
105 
   begin
106 
      String_Skip (From, Pos);
107 
 
108 
      if From (Pos) = '(' then
109 
         Pos := Pos + 1;
110 
         Paren := True;
111 
      else
112 
         Paren := False;
113 
      end if;
114 
 
115 
      Aux.Gets (From (Pos .. From'Last), ItemR, Pos);
116 
 
117 
      String_Skip (From (Pos + 1 .. From'Last), Pos);
118 
 
119 
      if From (Pos) = ',' then
120 
         Pos := Pos + 1;
121 
      end if;
122 
 
123 
      Aux.Gets (From (Pos .. From'Last), ItemI, Pos);
124 
 
125 
      if Paren then
126 
         String_Skip (From (Pos + 1 .. From'Last), Pos);
127 
 
128 
         if From (Pos) /= ')' then
129 
            raise Data_Error;
130 
         end if;
131 
      end if;
132 
 
133 
      Last := Pos;
134 
   end Gets;
135 
 
136 
   ---------
137 
   -- Put --
138 
   ---------
139 
 
140 
   procedure Put
141 
     (File  : File_Type;
142 
      ItemR : Long_Long_Float;
143 
      ItemI : Long_Long_Float;
144 
      Fore  : Field;
145 
      Aft   : Field;
146 
      Exp   : Field)
147 
   is
148 
   begin
149 
      Put (File, '(');
150 
      Aux.Put (File, ItemR, Fore, Aft, Exp);
151 
      Put (File, ',');
152 
      Aux.Put (File, ItemI, Fore, Aft, Exp);
153 
      Put (File, ')');
154 
   end Put;
155 
 
156 
   ----------
157 
   -- Puts --
158 
   ----------
159 
 
160 
   procedure Puts
161 
     (To    : out String;
162 
      ItemR : Long_Long_Float;
163 
      ItemI : Long_Long_Float;
164 
      Aft   :  Field;
165 
      Exp   :  Field)
166 
   is
167 
      I_String : String (1 .. 3 * Field'Last);
168 
      R_String : String (1 .. 3 * Field'Last);
169 
 
170 
      Iptr : Natural;
171 
      Rptr : Natural;
172 
 
173 
   begin
174 
      --  Both parts are initially converted with a Fore of 0
175 
 
176 
      Rptr := 0;
177 
      Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
178 
      Iptr := 0;
179 
      Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
180 
 
181 
      --  Check room for both parts plus parens plus comma (RM G.1.3(34))
182 
 
183 
      if Rptr + Iptr + 3 > To'Length then
184 
         raise Layout_Error;
185 
      end if;
186 
 
187 
      --  If there is room, layout result according to (RM G.1.3(31-33))
188 
 
189 
      To (To'First) := '(';
190 
      To (To'First + 1 .. To'First + Rptr) := R_String (1 .. Rptr);
191 
      To (To'First + Rptr + 1) := ',';
192 
 
193 
      To (To'Last) := ')';
194 
 
195 
      To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
196 
 
197 
      for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
198 
         To (J) := ' ';
199 
      end loop;
200 
   end Puts;
201 
 
202 
end Ada.Wide_Wide_Text_IO.Complex_Aux;

powered by: WebSVN 2.1.0

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