1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- I N T E R F A C E S . C _ S T R E A M S --
9 -- Copyright (C) 1996-2009, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the Alpha/VMS version
34 with Ada.Unchecked_Conversion;
35 package body Interfaces.C_Streams is
37 use type System.CRTL.size_t;
39 -- As the functions fread, fwrite and setvbuf are too big to be inlined,
40 -- they are just wrappers to the following implementation functions.
46 stream : FILEs) return size_t;
53 stream : FILEs) return size_t;
59 stream : FILEs) return size_t;
65 size : size_t) return int;
75 stream : FILEs) return size_t
77 Get_Count : size_t := 0;
79 type Buffer_Type is array (size_t range 1 .. count,
80 size_t range 1 .. size) of Character;
81 type Buffer_Access is access Buffer_Type;
82 function To_BA is new Ada.Unchecked_Conversion (voids, Buffer_Access);
84 BA : constant Buffer_Access := To_BA (buffer);
88 -- This Fread goes with the Fwrite below. The C library fread sometimes
89 -- can't read fputc generated files.
91 for C in 1 .. count loop
92 for S in 1 .. size loop
99 BA.all (C, S) := Character'Val (Ch);
102 Get_Count := Get_Count + 1;
113 stream : FILEs) return size_t
115 Get_Count : size_t := 0;
117 type Buffer_Type is array (size_t range 1 .. count,
118 size_t range 1 .. size) of Character;
119 type Buffer_Access is access Buffer_Type;
120 function To_BA is new Ada.Unchecked_Conversion (voids, Buffer_Access);
122 BA : constant Buffer_Access := To_BA (buffer);
126 -- This Fread goes with the Fwrite below. The C library fread sometimes
127 -- can't read fputc generated files.
129 for C in 1 + index .. count + index loop
130 for S in 1 .. size loop
131 Ch := fgetc (stream);
137 BA.all (C, S) := Character'Val (Ch);
140 Get_Count := Get_Count + 1;
150 stream : FILEs) return size_t
153 return fread_impl (buffer, size, count, stream);
161 stream : FILEs) return size_t
164 return fread_impl (buffer, index, size, count, stream);
175 stream : FILEs) return size_t
177 Put_Count : size_t := 0;
179 type Buffer_Type is array (size_t range 1 .. count,
180 size_t range 1 .. size) of Character;
181 type Buffer_Access is access Buffer_Type;
182 function To_BA is new Ada.Unchecked_Conversion (voids, Buffer_Access);
184 BA : constant Buffer_Access := To_BA (buffer);
187 -- Fwrite on VMS has the undesirable effect of always generating at
188 -- least one record of output per call, regardless of buffering. To
189 -- get around this, we do multiple fputc calls instead.
191 for C in 1 .. count loop
192 for S in 1 .. size loop
193 if fputc (Character'Pos (BA.all (C, S)), stream) = EOF then
198 Put_Count := Put_Count + 1;
208 stream : FILEs) return size_t
211 return fwrite_impl (buffer, size, count, stream);
218 function setvbuf_impl
222 size : size_t) return int
224 use type System.Address;
227 -- In order for the above fwrite hack to work, we must always buffer
228 -- stdout and stderr. Is_regular_file on VMS cannot detect when
229 -- these are redirected to a file, so checking for that condition
233 and then (stream = stdout or else stream = stderr)
235 return System.CRTL.setvbuf
236 (stream, buffer, IOLBF, System.CRTL.size_t (size));
238 return System.CRTL.setvbuf
239 (stream, buffer, mode, System.CRTL.size_t (size));
247 size : size_t) return int
250 return setvbuf_impl (stream, buffer, mode, size);
253 end Interfaces.C_Streams;