1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . T E X T _ I O . M O D U L A R _ A U X --
10 -- Copyright (C) 1992-2001 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
;
37 with System
.Img_BIU
; use System
.Img_BIU
;
38 with System
.Img_Uns
; use System
.Img_Uns
;
39 with System
.Img_LLB
; use System
.Img_LLB
;
40 with System
.Img_LLU
; use System
.Img_LLU
;
41 with System
.Img_LLW
; use System
.Img_LLW
;
42 with System
.Img_WIU
; use System
.Img_WIU
;
43 with System
.Val_Uns
; use System
.Val_Uns
;
44 with System
.Val_LLU
; use System
.Val_LLU
;
46 package body Ada
.Text_IO
.Modular_Aux
is
48 use System
.Unsigned_Types
;
50 -----------------------
51 -- Local Subprograms --
52 -----------------------
54 procedure Load_Modular
57 Ptr
: in out Natural);
58 -- This is an auxiliary routine that is used to load an possibly signed
59 -- modular literal value from the input file into Buf, starting at Ptr + 1.
60 -- Ptr is left set to the last character stored.
68 Item
: out Long_Long_Unsigned
;
71 Buf
: String (1 .. Field
'Last);
73 Ptr
: aliased Integer := 1;
77 Load_Width
(File
, Width
, Buf
, Stop
);
78 String_Skip
(Buf
, Ptr
);
80 Load_Modular
(File
, Buf
, Stop
);
83 Item
:= Scan_Long_Long_Unsigned
(Buf
, Ptr
'Access, Stop
);
84 Check_End_Of_Field
(Buf
, Stop
, Ptr
, Width
);
96 Buf
: String (1 .. Field
'Last);
98 Ptr
: aliased Integer := 1;
102 Load_Width
(File
, Width
, Buf
, Stop
);
103 String_Skip
(Buf
, Ptr
);
105 Load_Modular
(File
, Buf
, Stop
);
108 Item
:= Scan_Unsigned
(Buf
, Ptr
'Access, Stop
);
109 Check_End_Of_Field
(Buf
, Stop
, Ptr
, Width
);
118 Item
: out Long_Long_Unsigned
;
121 Pos
: aliased Integer;
124 String_Skip
(From
, Pos
);
125 Item
:= Scan_Long_Long_Unsigned
(From
, Pos
'Access, From
'Last);
129 when Constraint_Error
=>
143 Pos
: aliased Integer;
146 String_Skip
(From
, Pos
);
147 Item
:= Scan_Unsigned
(From
, Pos
'Access, From
'Last);
151 when Constraint_Error
=>
160 procedure Load_Modular
163 Ptr
: in out Natural)
171 -- Note: it is a bit strange to allow a minus sign here, but it seems
172 -- consistent with the general behavior expected by the ACVC tests
173 -- which is to scan past junk and then signal data error, see ACVC
174 -- test CE3704F, case (6), which is for signed integer exponents,
175 -- which seems a similar case.
177 Load
(File
, Buf
, Ptr
, '+', '-');
178 Load_Digits
(File
, Buf
, Ptr
, Loaded
);
181 Load
(File
, Buf
, Ptr
, '#', ':', Loaded
);
185 Load_Extended_Digits
(File
, Buf
, Ptr
);
186 Load
(File
, Buf
, Ptr
, Buf
(Hash_Loc
));
189 Load
(File
, Buf
, Ptr
, 'E', 'e', Loaded
);
193 -- Note: it is strange to allow a minus sign, since the syntax
194 -- does not, but that is what ACVC test CE3704F, case (6) wants
195 -- for the signed case, and there seems no good reason to treat
196 -- exponents differently for the signed and unsigned cases.
198 Load
(File
, Buf
, Ptr
, '+', '-');
199 Load_Digits
(File
, Buf
, Ptr
);
210 Item
: Long_Long_Unsigned
;
214 Buf
: String (1 .. Field
'Last);
218 if Base
= 10 and then Width
= 0 then
219 Set_Image_Long_Long_Unsigned
(Item
, Buf
, Ptr
);
221 Set_Image_Width_Long_Long_Unsigned
(Item
, Width
, Buf
, Ptr
);
223 Set_Image_Based_Long_Long_Unsigned
(Item
, Base
, Width
, Buf
, Ptr
);
226 Put_Item
(File
, Buf
(1 .. Ptr
));
239 Buf
: String (1 .. Field
'Last);
243 if Base
= 10 and then Width
= 0 then
244 Set_Image_Unsigned
(Item
, Buf
, Ptr
);
246 Set_Image_Width_Unsigned
(Item
, Width
, Buf
, Ptr
);
248 Set_Image_Based_Unsigned
(Item
, Base
, Width
, Buf
, Ptr
);
251 Put_Item
(File
, Buf
(1 .. Ptr
));
260 Item
: Long_Long_Unsigned
;
263 Buf
: String (1 .. Field
'Last);
268 Set_Image_Width_Long_Long_Unsigned
(Item
, To
'Length, Buf
, Ptr
);
270 Set_Image_Based_Long_Long_Unsigned
(Item
, Base
, To
'Length, Buf
, Ptr
);
273 if Ptr
> To
'Length then
276 To
(To
'First .. To
'First + Ptr
- 1) := Buf
(1 .. Ptr
);
289 Buf
: String (1 .. Field
'Last);
294 Set_Image_Width_Unsigned
(Item
, To
'Length, Buf
, Ptr
);
296 Set_Image_Based_Unsigned
(Item
, Base
, To
'Length, Buf
, Ptr
);
299 if Ptr
> To
'Length then
302 To
(To
'First .. To
'First + Ptr
- 1) := Buf
(1 .. Ptr
);
306 end Ada
.Text_IO
.Modular_Aux
;