Mark ChangeLog
[official-gcc.git] / gcc / ada / a-wtcoau.adb
blobaecad0046bb3920fc0551b3ba524900cbf802b40
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . 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-2005 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
34 with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
35 with Ada.Wide_Text_IO.Float_Aux;
37 with System.Img_Real; use System.Img_Real;
39 package body Ada.Wide_Text_IO.Complex_Aux is
41 package Aux renames Ada.Wide_Text_IO.Float_Aux;
43 ---------
44 -- Get --
45 ---------
47 procedure Get
48 (File : File_Type;
49 ItemR : out Long_Long_Float;
50 ItemI : out Long_Long_Float;
51 Width : Field)
53 Buf : String (1 .. Field'Last);
54 Stop : Integer := 0;
55 Ptr : aliased Integer;
56 Paren : Boolean := False;
58 begin
59 -- General note for following code, exceptions from the calls
60 -- to Get for components of the complex value are propagated.
62 if Width /= 0 then
63 Load_Width (File, Width, Buf, Stop);
64 Gets (Buf (1 .. Stop), ItemR, ItemI, Ptr);
66 for J in Ptr + 1 .. Stop loop
67 if not Is_Blank (Buf (J)) then
68 raise Data_Error;
69 end if;
70 end loop;
72 -- Case of width = 0
74 else
75 Load_Skip (File);
76 Ptr := 0;
77 Load (File, Buf, Ptr, '(', Paren);
78 Aux.Get (File, ItemR, 0);
79 Load_Skip (File);
80 Load (File, Buf, Ptr, ',');
81 Aux.Get (File, ItemI, 0);
83 if Paren then
84 Load_Skip (File);
85 Load (File, Buf, Ptr, ')', Paren);
87 if not Paren then
88 raise Data_Error;
89 end if;
90 end if;
91 end if;
92 end Get;
94 ----------
95 -- Gets --
96 ----------
98 procedure Gets
99 (From : String;
100 ItemR : out Long_Long_Float;
101 ItemI : out Long_Long_Float;
102 Last : out Positive)
104 Paren : Boolean;
105 Pos : Integer;
107 begin
108 String_Skip (From, Pos);
110 if From (Pos) = '(' then
111 Pos := Pos + 1;
112 Paren := True;
113 else
114 Paren := False;
115 end if;
117 Aux.Gets (From (Pos .. From'Last), ItemR, Pos);
119 String_Skip (From (Pos + 1 .. From'Last), Pos);
121 if From (Pos) = ',' then
122 Pos := Pos + 1;
123 end if;
125 Aux.Gets (From (Pos .. From'Last), ItemI, Pos);
127 if Paren then
128 String_Skip (From (Pos + 1 .. From'Last), Pos);
130 if From (Pos) /= ')' then
131 raise Data_Error;
132 end if;
133 end if;
135 Last := Pos;
136 end Gets;
138 ---------
139 -- Put --
140 ---------
142 procedure Put
143 (File : File_Type;
144 ItemR : Long_Long_Float;
145 ItemI : Long_Long_Float;
146 Fore : Field;
147 Aft : Field;
148 Exp : Field)
150 begin
151 Put (File, '(');
152 Aux.Put (File, ItemR, Fore, Aft, Exp);
153 Put (File, ',');
154 Aux.Put (File, ItemI, Fore, Aft, Exp);
155 Put (File, ')');
156 end Put;
158 ----------
159 -- Puts --
160 ----------
162 procedure Puts
163 (To : out String;
164 ItemR : Long_Long_Float;
165 ItemI : Long_Long_Float;
166 Aft : Field;
167 Exp : Field)
169 I_String : String (1 .. 3 * Field'Last);
170 R_String : String (1 .. 3 * Field'Last);
172 Iptr : Natural;
173 Rptr : Natural;
175 begin
176 -- Both parts are initially converted with a Fore of 0
178 Rptr := 0;
179 Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
180 Iptr := 0;
181 Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
183 -- Check room for both parts plus parens plus comma (RM G.1.3(34))
185 if Rptr + Iptr + 3 > To'Length then
186 raise Layout_Error;
187 end if;
189 -- If there is room, layout result according to (RM G.1.3(31-33))
191 To (To'First) := '(';
192 To (To'First + 1 .. To'First + Rptr) := R_String (1 .. Rptr);
193 To (To'First + Rptr + 1) := ',';
195 To (To'Last) := ')';
198 To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
200 for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
201 To (J) := ' ';
202 end loop;
203 end Puts;
205 end Ada.Wide_Text_IO.Complex_Aux;