1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . T E X T _ I O . C O M P L E X _ A U X --
10 -- Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 with Ada
.Text_IO
.Generic_Aux
; use Ada
.Text_IO
.Generic_Aux
;
36 with Ada
.Text_IO
.Float_Aux
;
38 with System
.Img_Real
; use System
.Img_Real
;
40 package body Ada
.Text_IO
.Complex_Aux
is
42 package Aux
renames Ada
.Text_IO
.Float_Aux
;
50 ItemR
: out Long_Long_Float;
51 ItemI
: out Long_Long_Float;
54 Buf
: String (1 .. Field
'Last);
56 Ptr
: aliased Integer;
57 Paren
: Boolean := False;
60 -- General note for following code, exceptions from the calls to
61 -- Get for components of the complex value are propagated.
64 Load_Width
(File
, Width
, Buf
, Stop
);
65 Gets
(Buf
(1 .. Stop
), ItemR
, ItemI
, Ptr
);
67 for J
in Ptr
+ 1 .. Stop
loop
68 if not Is_Blank
(Buf
(J
)) then
78 Load
(File
, Buf
, Ptr
, '(', Paren
);
79 Aux
.Get
(File
, ItemR
, 0);
81 Load
(File
, Buf
, Ptr
, ',');
82 Aux
.Get
(File
, ItemI
, 0);
86 Load
(File
, Buf
, Ptr
, ')', Paren
);
101 ItemR
: out Long_Long_Float;
102 ItemI
: out Long_Long_Float;
109 String_Skip
(From
, Pos
);
111 if From
(Pos
) = '(' then
118 Aux
.Gets
(From
(Pos
.. From
'Last), ItemR
, Pos
);
120 String_Skip
(From
(Pos
+ 1 .. From
'Last), Pos
);
122 if From
(Pos
) = ',' then
126 Aux
.Gets
(From
(Pos
.. From
'Last), ItemI
, Pos
);
129 String_Skip
(From
(Pos
+ 1 .. From
'Last), Pos
);
131 if From
(Pos
) /= ')' then
145 ItemR
: Long_Long_Float;
146 ItemI
: Long_Long_Float;
153 Aux
.Put
(File
, ItemR
, Fore
, Aft
, Exp
);
155 Aux
.Put
(File
, ItemI
, Fore
, Aft
, Exp
);
165 ItemR
: Long_Long_Float;
166 ItemI
: Long_Long_Float;
170 I_String
: String (1 .. 3 * Field
'Last);
171 R_String
: String (1 .. 3 * Field
'Last);
177 -- Both parts are initially converted with a Fore of 0
180 Set_Image_Real
(ItemR
, R_String
, Rptr
, 0, Aft
, Exp
);
182 Set_Image_Real
(ItemI
, I_String
, Iptr
, 0, Aft
, Exp
);
184 -- Check room for both parts plus parens plus comma (RM G.1.3(34))
186 if Rptr
+ Iptr
+ 3 > To
'Length then
190 -- If there is room, layout result according to (RM G.1.3(31-33))
192 To
(To
'First) := '(';
193 To
(To
'First + 1 .. To
'First + Rptr
) := R_String
(1 .. Rptr
);
194 To
(To
'First + Rptr
+ 1) := ',';
197 To
(To
'Last - Iptr
.. To
'Last - 1) := I_String
(1 .. Iptr
);
199 for J
in To
'First + Rptr
+ 2 .. To
'Last - Iptr
- 1 loop
205 end Ada
.Text_IO
.Complex_Aux
;