1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- S Y S T E M . S T R E A M _ A T T R I B U T E S --
9 -- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
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. --
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. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.IO_Exceptions
;
35 with Ada
.Streams
; use Ada
.Streams
;
36 with Unchecked_Conversion
;
38 package body System
.Stream_Attributes
is
40 Err
: exception renames Ada
.IO_Exceptions
.End_Error
;
41 -- Exception raised if insufficient data read (note that the RM implies
42 -- that Data_Error might be the appropriate choice, but AI195-00132
43 -- decides with a binding interpretation that End_Error is preferred).
45 SU
: constant := System
.Storage_Unit
;
47 subtype SEA
is Ada
.Streams
.Stream_Element_Array
;
48 subtype SEO
is Ada
.Streams
.Stream_Element_Offset
;
50 generic function UC
renames Unchecked_Conversion
;
52 -- Subtypes used to define Stream_Element_Array values that map
53 -- into the elementary types, using unchecked conversion.
55 Thin_Pointer_Size
: constant := System
.Address
'Size;
56 Fat_Pointer_Size
: constant := System
.Address
'Size * 2;
58 subtype S_AD
is SEA
(1 .. (Fat_Pointer_Size
+ SU
- 1) / SU
);
59 subtype S_AS
is SEA
(1 .. (Thin_Pointer_Size
+ SU
- 1) / SU
);
60 subtype S_B
is SEA
(1 .. (Boolean'Size + SU
- 1) / SU
);
61 subtype S_C
is SEA
(1 .. (Character'Size + SU
- 1) / SU
);
62 subtype S_F
is SEA
(1 .. (Float'Size + SU
- 1) / SU
);
63 subtype S_I
is SEA
(1 .. (Integer'Size + SU
- 1) / SU
);
64 subtype S_LF
is SEA
(1 .. (Long_Float'Size + SU
- 1) / SU
);
65 subtype S_LI
is SEA
(1 .. (Long_Integer'Size + SU
- 1) / SU
);
66 subtype S_LLF
is SEA
(1 .. (Long_Long_Float'Size + SU
- 1) / SU
);
67 subtype S_LLI
is SEA
(1 .. (Long_Long_Integer'Size + SU
- 1) / SU
);
68 subtype S_LLU
is SEA
(1 .. (UST
.Long_Long_Unsigned
'Size + SU
- 1) / SU
);
69 subtype S_LU
is SEA
(1 .. (UST
.Long_Unsigned
'Size + SU
- 1) / SU
);
70 subtype S_SF
is SEA
(1 .. (Short_Float'Size + SU
- 1) / SU
);
71 subtype S_SI
is SEA
(1 .. (Short_Integer'Size + SU
- 1) / SU
);
72 subtype S_SSI
is SEA
(1 .. (Short_Short_Integer'Size + SU
- 1) / SU
);
73 subtype S_SSU
is SEA
(1 .. (UST
.Short_Short_Unsigned
'Size + SU
- 1) / SU
);
74 subtype S_SU
is SEA
(1 .. (UST
.Short_Unsigned
'Size + SU
- 1) / SU
);
75 subtype S_U
is SEA
(1 .. (UST
.Unsigned
'Size + SU
- 1) / SU
);
76 subtype S_WC
is SEA
(1 .. (Wide_Character'Size + SU
- 1) / SU
);
78 -- Unchecked conversions from the elementary type to the stream type
80 function From_AD
is new UC
(Fat_Pointer
, S_AD
);
81 function From_AS
is new UC
(Thin_Pointer
, S_AS
);
82 function From_C
is new UC
(Character, S_C
);
83 function From_F
is new UC
(Float, S_F
);
84 function From_I
is new UC
(Integer, S_I
);
85 function From_LF
is new UC
(Long_Float, S_LF
);
86 function From_LI
is new UC
(Long_Integer, S_LI
);
87 function From_LLF
is new UC
(Long_Long_Float, S_LLF
);
88 function From_LLI
is new UC
(Long_Long_Integer, S_LLI
);
89 function From_LLU
is new UC
(UST
.Long_Long_Unsigned
, S_LLU
);
90 function From_LU
is new UC
(UST
.Long_Unsigned
, S_LU
);
91 function From_SF
is new UC
(Short_Float, S_SF
);
92 function From_SI
is new UC
(Short_Integer, S_SI
);
93 function From_SSI
is new UC
(Short_Short_Integer, S_SSI
);
94 function From_SSU
is new UC
(UST
.Short_Short_Unsigned
, S_SSU
);
95 function From_SU
is new UC
(UST
.Short_Unsigned
, S_SU
);
96 function From_U
is new UC
(UST
.Unsigned
, S_U
);
97 function From_WC
is new UC
(Wide_Character, S_WC
);
99 -- Unchecked conversions from the stream type to elementary type
101 function To_AD
is new UC
(S_AD
, Fat_Pointer
);
102 function To_AS
is new UC
(S_AS
, Thin_Pointer
);
103 function To_C
is new UC
(S_C
, Character);
104 function To_F
is new UC
(S_F
, Float);
105 function To_I
is new UC
(S_I
, Integer);
106 function To_LF
is new UC
(S_LF
, Long_Float);
107 function To_LI
is new UC
(S_LI
, Long_Integer);
108 function To_LLF
is new UC
(S_LLF
, Long_Long_Float);
109 function To_LLI
is new UC
(S_LLI
, Long_Long_Integer);
110 function To_LLU
is new UC
(S_LLU
, UST
.Long_Long_Unsigned
);
111 function To_LU
is new UC
(S_LU
, UST
.Long_Unsigned
);
112 function To_SF
is new UC
(S_SF
, Short_Float);
113 function To_SI
is new UC
(S_SI
, Short_Integer);
114 function To_SSI
is new UC
(S_SSI
, Short_Short_Integer);
115 function To_SSU
is new UC
(S_SSU
, UST
.Short_Short_Unsigned
);
116 function To_SU
is new UC
(S_SU
, UST
.Short_Unsigned
);
117 function To_U
is new UC
(S_U
, UST
.Unsigned
);
118 function To_WC
is new UC
(S_WC
, Wide_Character);
124 function I_AD
(Stream
: access RST
) return Fat_Pointer
is
129 Ada
.Streams
.Read
(Stream
.all, T
, L
);
142 function I_AS
(Stream
: access RST
) return Thin_Pointer
is
147 Ada
.Streams
.Read
(Stream
.all, T
, L
);
160 function I_B
(Stream
: access RST
) return Boolean is
165 Ada
.Streams
.Read
(Stream
.all, T
, L
);
170 return Boolean'Val (T
(1));
178 function I_C
(Stream
: access RST
) return Character is
183 Ada
.Streams
.Read
(Stream
.all, T
, L
);
196 function I_F
(Stream
: access RST
) return Float is
201 Ada
.Streams
.Read
(Stream
.all, T
, L
);
214 function I_I
(Stream
: access RST
) return Integer is
219 Ada
.Streams
.Read
(Stream
.all, T
, L
);
232 function I_LF
(Stream
: access RST
) return Long_Float is
237 Ada
.Streams
.Read
(Stream
.all, T
, L
);
250 function I_LI
(Stream
: access RST
) return Long_Integer is
255 Ada
.Streams
.Read
(Stream
.all, T
, L
);
268 function I_LLF
(Stream
: access RST
) return Long_Long_Float is
273 Ada
.Streams
.Read
(Stream
.all, T
, L
);
286 function I_LLI
(Stream
: access RST
) return Long_Long_Integer is
291 Ada
.Streams
.Read
(Stream
.all, T
, L
);
304 function I_LLU
(Stream
: access RST
) return UST
.Long_Long_Unsigned
is
309 Ada
.Streams
.Read
(Stream
.all, T
, L
);
322 function I_LU
(Stream
: access RST
) return UST
.Long_Unsigned
is
327 Ada
.Streams
.Read
(Stream
.all, T
, L
);
340 function I_SF
(Stream
: access RST
) return Short_Float is
345 Ada
.Streams
.Read
(Stream
.all, T
, L
);
358 function I_SI
(Stream
: access RST
) return Short_Integer is
363 Ada
.Streams
.Read
(Stream
.all, T
, L
);
376 function I_SSI
(Stream
: access RST
) return Short_Short_Integer is
381 Ada
.Streams
.Read
(Stream
.all, T
, L
);
394 function I_SSU
(Stream
: access RST
) return UST
.Short_Short_Unsigned
is
399 Ada
.Streams
.Read
(Stream
.all, T
, L
);
412 function I_SU
(Stream
: access RST
) return UST
.Short_Unsigned
is
417 Ada
.Streams
.Read
(Stream
.all, T
, L
);
430 function I_U
(Stream
: access RST
) return UST
.Unsigned
is
435 Ada
.Streams
.Read
(Stream
.all, T
, L
);
448 function I_WC
(Stream
: access RST
) return Wide_Character is
453 Ada
.Streams
.Read
(Stream
.all, T
, L
);
466 procedure W_AD
(Stream
: access RST
; Item
: in Fat_Pointer
) is
467 T
: constant S_AD
:= From_AD
(Item
);
470 Ada
.Streams
.Write
(Stream
.all, T
);
477 procedure W_AS
(Stream
: access RST
; Item
: in Thin_Pointer
) is
478 T
: constant S_AS
:= From_AS
(Item
);
481 Ada
.Streams
.Write
(Stream
.all, T
);
488 procedure W_B
(Stream
: access RST
; Item
: in Boolean) is
492 T
(1) := Boolean'Pos (Item
);
493 Ada
.Streams
.Write
(Stream
.all, T
);
500 procedure W_C
(Stream
: access RST
; Item
: in Character) is
501 T
: constant S_C
:= From_C
(Item
);
504 Ada
.Streams
.Write
(Stream
.all, T
);
511 procedure W_F
(Stream
: access RST
; Item
: in Float) is
512 T
: constant S_F
:= From_F
(Item
);
515 Ada
.Streams
.Write
(Stream
.all, T
);
522 procedure W_I
(Stream
: access RST
; Item
: in Integer) is
523 T
: constant S_I
:= From_I
(Item
);
526 Ada
.Streams
.Write
(Stream
.all, T
);
533 procedure W_LF
(Stream
: access RST
; Item
: in Long_Float) is
534 T
: constant S_LF
:= From_LF
(Item
);
537 Ada
.Streams
.Write
(Stream
.all, T
);
544 procedure W_LI
(Stream
: access RST
; Item
: in Long_Integer) is
545 T
: constant S_LI
:= From_LI
(Item
);
548 Ada
.Streams
.Write
(Stream
.all, T
);
555 procedure W_LLF
(Stream
: access RST
; Item
: in Long_Long_Float) is
556 T
: constant S_LLF
:= From_LLF
(Item
);
559 Ada
.Streams
.Write
(Stream
.all, T
);
566 procedure W_LLI
(Stream
: access RST
; Item
: in Long_Long_Integer) is
567 T
: constant S_LLI
:= From_LLI
(Item
);
570 Ada
.Streams
.Write
(Stream
.all, T
);
577 procedure W_LLU
(Stream
: access RST
; Item
: in UST
.Long_Long_Unsigned
) is
578 T
: constant S_LLU
:= From_LLU
(Item
);
581 Ada
.Streams
.Write
(Stream
.all, T
);
588 procedure W_LU
(Stream
: access RST
; Item
: in UST
.Long_Unsigned
) is
589 T
: constant S_LU
:= From_LU
(Item
);
592 Ada
.Streams
.Write
(Stream
.all, T
);
599 procedure W_SF
(Stream
: access RST
; Item
: in Short_Float) is
600 T
: constant S_SF
:= From_SF
(Item
);
603 Ada
.Streams
.Write
(Stream
.all, T
);
610 procedure W_SI
(Stream
: access RST
; Item
: in Short_Integer) is
611 T
: constant S_SI
:= From_SI
(Item
);
614 Ada
.Streams
.Write
(Stream
.all, T
);
621 procedure W_SSI
(Stream
: access RST
; Item
: in Short_Short_Integer) is
622 T
: constant S_SSI
:= From_SSI
(Item
);
625 Ada
.Streams
.Write
(Stream
.all, T
);
632 procedure W_SSU
(Stream
: access RST
; Item
: in UST
.Short_Short_Unsigned
) is
633 T
: constant S_SSU
:= From_SSU
(Item
);
636 Ada
.Streams
.Write
(Stream
.all, T
);
643 procedure W_SU
(Stream
: access RST
; Item
: in UST
.Short_Unsigned
) is
644 T
: constant S_SU
:= From_SU
(Item
);
647 Ada
.Streams
.Write
(Stream
.all, T
);
654 procedure W_U
(Stream
: access RST
; Item
: in UST
.Unsigned
) is
655 T
: constant S_U
:= From_U
(Item
);
658 Ada
.Streams
.Write
(Stream
.all, T
);
665 procedure W_WC
(Stream
: access RST
; Item
: in Wide_Character) is
666 T
: constant S_WC
:= From_WC
(Item
);
669 Ada
.Streams
.Write
(Stream
.all, T
);
672 end System
.Stream_Attributes
;