1 |
14 |
jlechner |
/* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
2 |
|
|
Contributed by Andy Vaught
|
3 |
|
|
|
4 |
|
|
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
5 |
|
|
|
6 |
|
|
Libgfortran is free software; you can redistribute it and/or modify
|
7 |
|
|
it under the terms of the GNU General Public License as published by
|
8 |
|
|
the Free Software Foundation; either version 2, or (at your option)
|
9 |
|
|
any later version.
|
10 |
|
|
|
11 |
|
|
Libgfortran is distributed in the hope that it will be useful,
|
12 |
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
13 |
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
14 |
|
|
GNU General Public License for more details.
|
15 |
|
|
|
16 |
|
|
You should have received a copy of the GNU General Public License
|
17 |
|
|
along with Libgfortran; see the file COPYING. If not, write to
|
18 |
|
|
the Free Software Foundation, 51 Franklin Street, Fifth Floor,
|
19 |
|
|
Boston, MA 02110-1301, USA. */
|
20 |
|
|
|
21 |
|
|
/* As a special exception, if you link this library with other files,
|
22 |
|
|
some of which are compiled with GCC, to produce an executable,
|
23 |
|
|
this library does not by itself cause the resulting executable
|
24 |
|
|
to be covered by the GNU General Public License.
|
25 |
|
|
This exception does not however invalidate any other reasons why
|
26 |
|
|
the executable file might be covered by the GNU General Public License. */
|
27 |
|
|
|
28 |
|
|
#ifndef GFOR_IO_H
|
29 |
|
|
#define GFOR_IO_H
|
30 |
|
|
|
31 |
|
|
/* IO library include. */
|
32 |
|
|
|
33 |
|
|
#include <setjmp.h>
|
34 |
|
|
#include "libgfortran.h"
|
35 |
|
|
|
36 |
|
|
#include <gthr.h>
|
37 |
|
|
|
38 |
|
|
#define DEFAULT_TEMPDIR "/tmp"
|
39 |
|
|
|
40 |
|
|
/* Basic types used in data transfers. */
|
41 |
|
|
|
42 |
|
|
typedef enum
|
43 |
|
|
{ BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
|
44 |
|
|
BT_COMPLEX
|
45 |
|
|
}
|
46 |
|
|
bt;
|
47 |
|
|
|
48 |
|
|
|
49 |
|
|
typedef enum
|
50 |
|
|
{ SUCCESS = 1, FAILURE }
|
51 |
|
|
try;
|
52 |
|
|
|
53 |
|
|
struct st_parameter_dt;
|
54 |
|
|
|
55 |
|
|
typedef struct stream
|
56 |
|
|
{
|
57 |
|
|
char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
|
58 |
|
|
char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
|
59 |
|
|
try (*sfree) (struct stream *);
|
60 |
|
|
try (*close) (struct stream *);
|
61 |
|
|
try (*seek) (struct stream *, gfc_offset);
|
62 |
|
|
try (*truncate) (struct stream *);
|
63 |
|
|
int (*read) (struct stream *, void *, size_t *);
|
64 |
|
|
int (*write) (struct stream *, const void *, size_t *);
|
65 |
|
|
try (*set) (struct stream *, int, size_t);
|
66 |
|
|
}
|
67 |
|
|
stream;
|
68 |
|
|
|
69 |
|
|
|
70 |
|
|
/* Macros for doing file I/O given a stream. */
|
71 |
|
|
|
72 |
|
|
#define sfree(s) ((s)->sfree)(s)
|
73 |
|
|
#define sclose(s) ((s)->close)(s)
|
74 |
|
|
|
75 |
|
|
#define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
|
76 |
|
|
#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
|
77 |
|
|
|
78 |
|
|
#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
|
79 |
|
|
#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
|
80 |
|
|
|
81 |
|
|
#define sseek(s, pos) ((s)->seek)(s, pos)
|
82 |
|
|
#define struncate(s) ((s)->truncate)(s)
|
83 |
|
|
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
|
84 |
|
|
#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
|
85 |
|
|
|
86 |
|
|
#define sset(s, c, n) ((s)->set)(s, c, n)
|
87 |
|
|
|
88 |
|
|
/* The array_loop_spec contains the variables for the loops over index ranges
|
89 |
|
|
that are encountered. Since the variables can be negative, ssize_t
|
90 |
|
|
is used. */
|
91 |
|
|
|
92 |
|
|
typedef struct array_loop_spec
|
93 |
|
|
{
|
94 |
|
|
/* Index counter for this dimension. */
|
95 |
|
|
ssize_t idx;
|
96 |
|
|
|
97 |
|
|
/* Start for the index counter. */
|
98 |
|
|
ssize_t start;
|
99 |
|
|
|
100 |
|
|
/* End for the index counter. */
|
101 |
|
|
ssize_t end;
|
102 |
|
|
|
103 |
|
|
/* Step for the index counter. */
|
104 |
|
|
ssize_t step;
|
105 |
|
|
}
|
106 |
|
|
array_loop_spec;
|
107 |
|
|
|
108 |
|
|
/* Representation of a namelist object in libgfortran
|
109 |
|
|
|
110 |
|
|
Namelist Records
|
111 |
|
|
&GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
|
112 |
|
|
or
|
113 |
|
|
&GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
|
114 |
|
|
|
115 |
|
|
The object can be a fully qualified, compound name for an instrinsic
|
116 |
|
|
type, derived types or derived type components. So, a substring
|
117 |
|
|
a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
|
118 |
|
|
read. Hence full information about the structure of the object has
|
119 |
|
|
to be available to list_read.c and write.
|
120 |
|
|
|
121 |
|
|
These requirements are met by the following data structures.
|
122 |
|
|
|
123 |
|
|
namelist_info type contains all the scalar information about the
|
124 |
|
|
object and arrays of descriptor_dimension and array_loop_spec types for
|
125 |
|
|
arrays. */
|
126 |
|
|
|
127 |
|
|
typedef struct namelist_type
|
128 |
|
|
{
|
129 |
|
|
|
130 |
|
|
/* Object type, stored as GFC_DTYPE_xxxx. */
|
131 |
|
|
bt type;
|
132 |
|
|
|
133 |
|
|
/* Object name. */
|
134 |
|
|
char * var_name;
|
135 |
|
|
|
136 |
|
|
/* Address for the start of the object's data. */
|
137 |
|
|
void * mem_pos;
|
138 |
|
|
|
139 |
|
|
/* Flag to show that a read is to be attempted for this node. */
|
140 |
|
|
int touched;
|
141 |
|
|
|
142 |
|
|
/* Length of intrinsic type in bytes. */
|
143 |
|
|
int len;
|
144 |
|
|
|
145 |
|
|
/* Rank of the object. */
|
146 |
|
|
int var_rank;
|
147 |
|
|
|
148 |
|
|
/* Overall size of the object in bytes. */
|
149 |
|
|
index_type size;
|
150 |
|
|
|
151 |
|
|
/* Length of character string. */
|
152 |
|
|
index_type string_length;
|
153 |
|
|
|
154 |
|
|
descriptor_dimension * dim;
|
155 |
|
|
array_loop_spec * ls;
|
156 |
|
|
struct namelist_type * next;
|
157 |
|
|
}
|
158 |
|
|
namelist_info;
|
159 |
|
|
|
160 |
|
|
/* Options for the OPEN statement. */
|
161 |
|
|
|
162 |
|
|
typedef enum
|
163 |
|
|
{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND,
|
164 |
|
|
ACCESS_UNSPECIFIED
|
165 |
|
|
}
|
166 |
|
|
unit_access;
|
167 |
|
|
|
168 |
|
|
typedef enum
|
169 |
|
|
{ ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
|
170 |
|
|
ACTION_UNSPECIFIED
|
171 |
|
|
}
|
172 |
|
|
unit_action;
|
173 |
|
|
|
174 |
|
|
typedef enum
|
175 |
|
|
{ BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
|
176 |
|
|
unit_blank;
|
177 |
|
|
|
178 |
|
|
typedef enum
|
179 |
|
|
{ DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
|
180 |
|
|
DELIM_UNSPECIFIED
|
181 |
|
|
}
|
182 |
|
|
unit_delim;
|
183 |
|
|
|
184 |
|
|
typedef enum
|
185 |
|
|
{ FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
|
186 |
|
|
unit_form;
|
187 |
|
|
|
188 |
|
|
typedef enum
|
189 |
|
|
{ POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
|
190 |
|
|
POSITION_UNSPECIFIED
|
191 |
|
|
}
|
192 |
|
|
unit_position;
|
193 |
|
|
|
194 |
|
|
typedef enum
|
195 |
|
|
{ STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
|
196 |
|
|
STATUS_REPLACE, STATUS_UNSPECIFIED
|
197 |
|
|
}
|
198 |
|
|
unit_status;
|
199 |
|
|
|
200 |
|
|
typedef enum
|
201 |
|
|
{ PAD_YES, PAD_NO, PAD_UNSPECIFIED }
|
202 |
|
|
unit_pad;
|
203 |
|
|
|
204 |
|
|
typedef enum
|
205 |
|
|
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
|
206 |
|
|
unit_advance;
|
207 |
|
|
|
208 |
|
|
typedef enum
|
209 |
|
|
{READING, WRITING}
|
210 |
|
|
unit_mode;
|
211 |
|
|
|
212 |
|
|
typedef enum
|
213 |
|
|
{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
|
214 |
|
|
unit_convert;
|
215 |
|
|
|
216 |
|
|
#define CHARACTER1(name) \
|
217 |
|
|
char * name; \
|
218 |
|
|
gfc_charlen_type name ## _len
|
219 |
|
|
#define CHARACTER2(name) \
|
220 |
|
|
gfc_charlen_type name ## _len; \
|
221 |
|
|
char * name
|
222 |
|
|
|
223 |
|
|
#define IOPARM_LIBRETURN_MASK (3 << 0)
|
224 |
|
|
#define IOPARM_LIBRETURN_OK (0 << 0)
|
225 |
|
|
#define IOPARM_LIBRETURN_ERROR (1 << 0)
|
226 |
|
|
#define IOPARM_LIBRETURN_END (2 << 0)
|
227 |
|
|
#define IOPARM_LIBRETURN_EOR (3 << 0)
|
228 |
|
|
#define IOPARM_ERR (1 << 2)
|
229 |
|
|
#define IOPARM_END (1 << 3)
|
230 |
|
|
#define IOPARM_EOR (1 << 4)
|
231 |
|
|
#define IOPARM_HAS_IOSTAT (1 << 5)
|
232 |
|
|
#define IOPARM_HAS_IOMSG (1 << 6)
|
233 |
|
|
|
234 |
|
|
#define IOPARM_COMMON_MASK ((1 << 7) - 1)
|
235 |
|
|
|
236 |
|
|
typedef struct st_parameter_common
|
237 |
|
|
{
|
238 |
|
|
GFC_INTEGER_4 flags;
|
239 |
|
|
GFC_INTEGER_4 unit;
|
240 |
|
|
const char *filename;
|
241 |
|
|
GFC_INTEGER_4 line;
|
242 |
|
|
CHARACTER2 (iomsg);
|
243 |
|
|
GFC_INTEGER_4 *iostat;
|
244 |
|
|
}
|
245 |
|
|
st_parameter_common;
|
246 |
|
|
|
247 |
|
|
#define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
|
248 |
|
|
#define IOPARM_OPEN_HAS_FILE (1 << 8)
|
249 |
|
|
#define IOPARM_OPEN_HAS_STATUS (1 << 9)
|
250 |
|
|
#define IOPARM_OPEN_HAS_ACCESS (1 << 10)
|
251 |
|
|
#define IOPARM_OPEN_HAS_FORM (1 << 11)
|
252 |
|
|
#define IOPARM_OPEN_HAS_BLANK (1 << 12)
|
253 |
|
|
#define IOPARM_OPEN_HAS_POSITION (1 << 13)
|
254 |
|
|
#define IOPARM_OPEN_HAS_ACTION (1 << 14)
|
255 |
|
|
#define IOPARM_OPEN_HAS_DELIM (1 << 15)
|
256 |
|
|
#define IOPARM_OPEN_HAS_PAD (1 << 16)
|
257 |
|
|
#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
|
258 |
|
|
|
259 |
|
|
typedef struct
|
260 |
|
|
{
|
261 |
|
|
st_parameter_common common;
|
262 |
|
|
GFC_INTEGER_4 recl_in;
|
263 |
|
|
CHARACTER2 (file);
|
264 |
|
|
CHARACTER1 (status);
|
265 |
|
|
CHARACTER2 (access);
|
266 |
|
|
CHARACTER1 (form);
|
267 |
|
|
CHARACTER2 (blank);
|
268 |
|
|
CHARACTER1 (position);
|
269 |
|
|
CHARACTER2 (action);
|
270 |
|
|
CHARACTER1 (delim);
|
271 |
|
|
CHARACTER2 (pad);
|
272 |
|
|
CHARACTER1 (convert);
|
273 |
|
|
}
|
274 |
|
|
st_parameter_open;
|
275 |
|
|
|
276 |
|
|
#define IOPARM_CLOSE_HAS_STATUS (1 << 7)
|
277 |
|
|
|
278 |
|
|
typedef struct
|
279 |
|
|
{
|
280 |
|
|
st_parameter_common common;
|
281 |
|
|
CHARACTER1 (status);
|
282 |
|
|
}
|
283 |
|
|
st_parameter_close;
|
284 |
|
|
|
285 |
|
|
typedef struct
|
286 |
|
|
{
|
287 |
|
|
st_parameter_common common;
|
288 |
|
|
}
|
289 |
|
|
st_parameter_filepos;
|
290 |
|
|
|
291 |
|
|
#define IOPARM_INQUIRE_HAS_EXIST (1 << 7)
|
292 |
|
|
#define IOPARM_INQUIRE_HAS_OPENED (1 << 8)
|
293 |
|
|
#define IOPARM_INQUIRE_HAS_NUMBER (1 << 9)
|
294 |
|
|
#define IOPARM_INQUIRE_HAS_NAMED (1 << 10)
|
295 |
|
|
#define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11)
|
296 |
|
|
#define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12)
|
297 |
|
|
#define IOPARM_INQUIRE_HAS_FILE (1 << 13)
|
298 |
|
|
#define IOPARM_INQUIRE_HAS_ACCESS (1 << 14)
|
299 |
|
|
#define IOPARM_INQUIRE_HAS_FORM (1 << 15)
|
300 |
|
|
#define IOPARM_INQUIRE_HAS_BLANK (1 << 16)
|
301 |
|
|
#define IOPARM_INQUIRE_HAS_POSITION (1 << 17)
|
302 |
|
|
#define IOPARM_INQUIRE_HAS_ACTION (1 << 18)
|
303 |
|
|
#define IOPARM_INQUIRE_HAS_DELIM (1 << 19)
|
304 |
|
|
#define IOPARM_INQUIRE_HAS_PAD (1 << 20)
|
305 |
|
|
#define IOPARM_INQUIRE_HAS_NAME (1 << 21)
|
306 |
|
|
#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 22)
|
307 |
|
|
#define IOPARM_INQUIRE_HAS_DIRECT (1 << 23)
|
308 |
|
|
#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 24)
|
309 |
|
|
#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25)
|
310 |
|
|
#define IOPARM_INQUIRE_HAS_READ (1 << 26)
|
311 |
|
|
#define IOPARM_INQUIRE_HAS_WRITE (1 << 27)
|
312 |
|
|
#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28)
|
313 |
|
|
#define IOPARM_INQUIRE_HAS_CONVERT (1 << 29)
|
314 |
|
|
|
315 |
|
|
typedef struct
|
316 |
|
|
{
|
317 |
|
|
st_parameter_common common;
|
318 |
|
|
GFC_INTEGER_4 *exist, *opened, *number, *named;
|
319 |
|
|
GFC_INTEGER_4 *nextrec, *recl_out;
|
320 |
|
|
CHARACTER1 (file);
|
321 |
|
|
CHARACTER2 (access);
|
322 |
|
|
CHARACTER1 (form);
|
323 |
|
|
CHARACTER2 (blank);
|
324 |
|
|
CHARACTER1 (position);
|
325 |
|
|
CHARACTER2 (action);
|
326 |
|
|
CHARACTER1 (delim);
|
327 |
|
|
CHARACTER2 (pad);
|
328 |
|
|
CHARACTER1 (name);
|
329 |
|
|
CHARACTER2 (sequential);
|
330 |
|
|
CHARACTER1 (direct);
|
331 |
|
|
CHARACTER2 (formatted);
|
332 |
|
|
CHARACTER1 (unformatted);
|
333 |
|
|
CHARACTER2 (read);
|
334 |
|
|
CHARACTER1 (write);
|
335 |
|
|
CHARACTER2 (readwrite);
|
336 |
|
|
CHARACTER1 (convert);
|
337 |
|
|
}
|
338 |
|
|
st_parameter_inquire;
|
339 |
|
|
|
340 |
|
|
struct gfc_unit;
|
341 |
|
|
struct format_data;
|
342 |
|
|
|
343 |
|
|
#define IOPARM_DT_LIST_FORMAT (1 << 7)
|
344 |
|
|
#define IOPARM_DT_NAMELIST_READ_MODE (1 << 8)
|
345 |
|
|
#define IOPARM_DT_HAS_REC (1 << 9)
|
346 |
|
|
#define IOPARM_DT_HAS_SIZE (1 << 10)
|
347 |
|
|
#define IOPARM_DT_HAS_IOLENGTH (1 << 11)
|
348 |
|
|
#define IOPARM_DT_HAS_FORMAT (1 << 12)
|
349 |
|
|
#define IOPARM_DT_HAS_ADVANCE (1 << 13)
|
350 |
|
|
#define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14)
|
351 |
|
|
#define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15)
|
352 |
|
|
/* Internal use bit. */
|
353 |
|
|
#define IOPARM_DT_IONML_SET (1 << 31)
|
354 |
|
|
|
355 |
|
|
typedef struct st_parameter_dt
|
356 |
|
|
{
|
357 |
|
|
st_parameter_common common;
|
358 |
|
|
GFC_INTEGER_4 rec;
|
359 |
|
|
GFC_INTEGER_4 *size, *iolength;
|
360 |
|
|
gfc_array_char *internal_unit_desc;
|
361 |
|
|
CHARACTER1 (format);
|
362 |
|
|
CHARACTER2 (advance);
|
363 |
|
|
CHARACTER1 (internal_unit);
|
364 |
|
|
CHARACTER2 (namelist_name);
|
365 |
|
|
/* Private part of the structure. The compiler just needs
|
366 |
|
|
to reserve enough space. */
|
367 |
|
|
union
|
368 |
|
|
{
|
369 |
|
|
struct
|
370 |
|
|
{
|
371 |
|
|
void (*transfer) (struct st_parameter_dt *, bt, void *, int,
|
372 |
|
|
size_t, size_t);
|
373 |
|
|
struct gfc_unit *current_unit;
|
374 |
|
|
/* Item number in a formatted data transfer. Also used in namelist
|
375 |
|
|
read_logical as an index into line_buffer. */
|
376 |
|
|
int item_count;
|
377 |
|
|
unit_mode mode;
|
378 |
|
|
unit_blank blank_status;
|
379 |
|
|
enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
|
380 |
|
|
int scale_factor;
|
381 |
|
|
int max_pos; /* Maximum righthand column written to. */
|
382 |
|
|
/* Number of skips + spaces to be done for T and X-editing. */
|
383 |
|
|
int skips;
|
384 |
|
|
/* Number of spaces to be done for T and X-editing. */
|
385 |
|
|
int pending_spaces;
|
386 |
|
|
/* Whether an EOR condition was encountered. Value is:
|
387 |
|
|
|
388 |
|
|
1 if an EOR was encountered due to a 1-byte marker (LF)
|
389 |
|
|
2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
|
390 |
|
|
int sf_seen_eor;
|
391 |
|
|
unit_advance advance_status;
|
392 |
|
|
|
393 |
|
|
unsigned reversion_flag : 1; /* Format reversion has occurred. */
|
394 |
|
|
unsigned first_item : 1;
|
395 |
|
|
unsigned seen_dollar : 1;
|
396 |
|
|
unsigned eor_condition : 1;
|
397 |
|
|
unsigned no_leading_blank : 1;
|
398 |
|
|
unsigned char_flag : 1;
|
399 |
|
|
unsigned input_complete : 1;
|
400 |
|
|
unsigned at_eol : 1;
|
401 |
|
|
unsigned comma_flag : 1;
|
402 |
|
|
/* A namelist specific flag used in the list directed library
|
403 |
|
|
to flag that calls are being made from namelist read (eg. to
|
404 |
|
|
ignore comments or to treat '/' as a terminator) */
|
405 |
|
|
unsigned namelist_mode : 1;
|
406 |
|
|
/* A namelist specific flag used in the list directed library
|
407 |
|
|
to flag read errors and return, so that an attempt can be
|
408 |
|
|
made to read a new object name. */
|
409 |
|
|
unsigned nml_read_error : 1;
|
410 |
|
|
/* A sequential formatted read specific flag used to signal that a
|
411 |
|
|
character string is being read so don't use commas to shorten a
|
412 |
|
|
formatted field width. */
|
413 |
|
|
unsigned sf_read_comma : 1;
|
414 |
|
|
/* A namelist specific flag used to enable reading input from
|
415 |
|
|
line_buffer for logical reads. */
|
416 |
|
|
unsigned line_buffer_enabled : 1;
|
417 |
|
|
/* An internal unit specific flag used to identify that the associated
|
418 |
|
|
unit is internal. */
|
419 |
|
|
unsigned unit_is_internal : 1;
|
420 |
|
|
/* 17 unused bits. */
|
421 |
|
|
|
422 |
|
|
char last_char;
|
423 |
|
|
char nml_delim;
|
424 |
|
|
|
425 |
|
|
int repeat_count;
|
426 |
|
|
int saved_length;
|
427 |
|
|
int saved_used;
|
428 |
|
|
bt saved_type;
|
429 |
|
|
char *saved_string;
|
430 |
|
|
char *scratch;
|
431 |
|
|
char *line_buffer;
|
432 |
|
|
struct format_data *fmt;
|
433 |
|
|
jmp_buf *eof_jump;
|
434 |
|
|
namelist_info *ionml;
|
435 |
|
|
|
436 |
|
|
/* Storage area for values except for strings. Must be large
|
437 |
|
|
enough to hold a complex value (two reals) of the largest
|
438 |
|
|
kind. */
|
439 |
|
|
char value[32];
|
440 |
|
|
gfc_offset size_used;
|
441 |
|
|
} p;
|
442 |
|
|
/* This pad size must be equal to the pad_size declared in
|
443 |
|
|
trans-io.c (gfc_build_io_library_fndecls). The above structure
|
444 |
|
|
must be smaller or equal to this array. */
|
445 |
|
|
char pad[16 * sizeof (char *) + 32 * sizeof (int)];
|
446 |
|
|
} u;
|
447 |
|
|
}
|
448 |
|
|
st_parameter_dt;
|
449 |
|
|
|
450 |
|
|
/* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */
|
451 |
|
|
extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
|
452 |
|
|
>= sizeof (((st_parameter_dt *) 0)->u.p)
|
453 |
|
|
? 1 : -1];
|
454 |
|
|
|
455 |
|
|
#undef CHARACTER1
|
456 |
|
|
#undef CHARACTER2
|
457 |
|
|
|
458 |
|
|
typedef struct
|
459 |
|
|
{
|
460 |
|
|
unit_access access;
|
461 |
|
|
unit_action action;
|
462 |
|
|
unit_blank blank;
|
463 |
|
|
unit_delim delim;
|
464 |
|
|
unit_form form;
|
465 |
|
|
int is_notpadded;
|
466 |
|
|
unit_position position;
|
467 |
|
|
unit_status status;
|
468 |
|
|
unit_pad pad;
|
469 |
|
|
unit_convert convert;
|
470 |
|
|
}
|
471 |
|
|
unit_flags;
|
472 |
|
|
|
473 |
|
|
|
474 |
|
|
/* The default value of record length for preconnected units is defined
|
475 |
|
|
here. This value can be overriden by an environment variable.
|
476 |
|
|
Default value is 1 Gb. */
|
477 |
|
|
|
478 |
|
|
#define DEFAULT_RECL 1073741824
|
479 |
|
|
|
480 |
|
|
|
481 |
|
|
typedef struct gfc_unit
|
482 |
|
|
{
|
483 |
|
|
int unit_number;
|
484 |
|
|
stream *s;
|
485 |
|
|
|
486 |
|
|
/* Treap links. */
|
487 |
|
|
struct gfc_unit *left, *right;
|
488 |
|
|
int priority;
|
489 |
|
|
|
490 |
|
|
int read_bad, current_record;
|
491 |
|
|
enum
|
492 |
|
|
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
|
493 |
|
|
endfile;
|
494 |
|
|
|
495 |
|
|
unit_mode mode;
|
496 |
|
|
unit_flags flags;
|
497 |
|
|
|
498 |
|
|
/* recl -- Record length of the file.
|
499 |
|
|
last_record -- Last record number read or written
|
500 |
|
|
maxrec -- Maximum record number in a direct access file
|
501 |
|
|
bytes_left -- Bytes left in current record. */
|
502 |
|
|
gfc_offset recl, last_record, maxrec, bytes_left;
|
503 |
|
|
|
504 |
|
|
__gthread_mutex_t lock;
|
505 |
|
|
/* Number of threads waiting to acquire this unit's lock.
|
506 |
|
|
When non-zero, close_unit doesn't only removes the unit
|
507 |
|
|
from the UNIT_ROOT tree, but doesn't free it and the
|
508 |
|
|
last of the waiting threads will do that.
|
509 |
|
|
This must be either atomically increased/decreased, or
|
510 |
|
|
always guarded by UNIT_LOCK. */
|
511 |
|
|
int waiting;
|
512 |
|
|
/* Flag set by close_unit if the unit as been closed.
|
513 |
|
|
Must be manipulated under unit's lock. */
|
514 |
|
|
int closed;
|
515 |
|
|
|
516 |
|
|
/* For traversing arrays */
|
517 |
|
|
array_loop_spec *ls;
|
518 |
|
|
int rank;
|
519 |
|
|
|
520 |
|
|
int file_len;
|
521 |
|
|
char *file;
|
522 |
|
|
}
|
523 |
|
|
gfc_unit;
|
524 |
|
|
|
525 |
|
|
/* Format tokens. Only about half of these can be stored in the
|
526 |
|
|
format nodes. */
|
527 |
|
|
|
528 |
|
|
typedef enum
|
529 |
|
|
{
|
530 |
|
|
FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
|
531 |
|
|
FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
|
532 |
|
|
FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
|
533 |
|
|
FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
|
534 |
|
|
FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
|
535 |
|
|
}
|
536 |
|
|
format_token;
|
537 |
|
|
|
538 |
|
|
|
539 |
|
|
/* Format nodes. A format string is converted into a tree of these
|
540 |
|
|
structures, which is traversed as part of a data transfer statement. */
|
541 |
|
|
|
542 |
|
|
typedef struct fnode
|
543 |
|
|
{
|
544 |
|
|
format_token format;
|
545 |
|
|
int repeat;
|
546 |
|
|
struct fnode *next;
|
547 |
|
|
char *source;
|
548 |
|
|
|
549 |
|
|
union
|
550 |
|
|
{
|
551 |
|
|
struct
|
552 |
|
|
{
|
553 |
|
|
int w, d, e;
|
554 |
|
|
}
|
555 |
|
|
real;
|
556 |
|
|
|
557 |
|
|
struct
|
558 |
|
|
{
|
559 |
|
|
int length;
|
560 |
|
|
char *p;
|
561 |
|
|
}
|
562 |
|
|
string;
|
563 |
|
|
|
564 |
|
|
struct
|
565 |
|
|
{
|
566 |
|
|
int w, m;
|
567 |
|
|
}
|
568 |
|
|
integer;
|
569 |
|
|
|
570 |
|
|
int w;
|
571 |
|
|
int k;
|
572 |
|
|
int r;
|
573 |
|
|
int n;
|
574 |
|
|
|
575 |
|
|
struct fnode *child;
|
576 |
|
|
}
|
577 |
|
|
u;
|
578 |
|
|
|
579 |
|
|
/* Members for traversing the tree during data transfer. */
|
580 |
|
|
|
581 |
|
|
int count;
|
582 |
|
|
struct fnode *current;
|
583 |
|
|
|
584 |
|
|
}
|
585 |
|
|
fnode;
|
586 |
|
|
|
587 |
|
|
|
588 |
|
|
/* unix.c */
|
589 |
|
|
|
590 |
|
|
extern int move_pos_offset (stream *, int);
|
591 |
|
|
internal_proto(move_pos_offset);
|
592 |
|
|
|
593 |
|
|
extern int compare_files (stream *, stream *);
|
594 |
|
|
internal_proto(compare_files);
|
595 |
|
|
|
596 |
|
|
extern stream *open_external (st_parameter_open *, unit_flags *);
|
597 |
|
|
internal_proto(open_external);
|
598 |
|
|
|
599 |
|
|
extern stream *open_internal (char *, int);
|
600 |
|
|
internal_proto(open_internal);
|
601 |
|
|
|
602 |
|
|
extern stream *input_stream (void);
|
603 |
|
|
internal_proto(input_stream);
|
604 |
|
|
|
605 |
|
|
extern stream *output_stream (void);
|
606 |
|
|
internal_proto(output_stream);
|
607 |
|
|
|
608 |
|
|
extern stream *error_stream (void);
|
609 |
|
|
internal_proto(error_stream);
|
610 |
|
|
|
611 |
|
|
extern int compare_file_filename (gfc_unit *, const char *, int);
|
612 |
|
|
internal_proto(compare_file_filename);
|
613 |
|
|
|
614 |
|
|
extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
|
615 |
|
|
internal_proto(find_file);
|
616 |
|
|
|
617 |
|
|
extern void flush_all_units (void);
|
618 |
|
|
internal_proto(flush_all_units);
|
619 |
|
|
|
620 |
|
|
extern int stream_at_bof (stream *);
|
621 |
|
|
internal_proto(stream_at_bof);
|
622 |
|
|
|
623 |
|
|
extern int stream_at_eof (stream *);
|
624 |
|
|
internal_proto(stream_at_eof);
|
625 |
|
|
|
626 |
|
|
extern int delete_file (gfc_unit *);
|
627 |
|
|
internal_proto(delete_file);
|
628 |
|
|
|
629 |
|
|
extern int file_exists (const char *file, gfc_charlen_type file_len);
|
630 |
|
|
internal_proto(file_exists);
|
631 |
|
|
|
632 |
|
|
extern const char *inquire_sequential (const char *, int);
|
633 |
|
|
internal_proto(inquire_sequential);
|
634 |
|
|
|
635 |
|
|
extern const char *inquire_direct (const char *, int);
|
636 |
|
|
internal_proto(inquire_direct);
|
637 |
|
|
|
638 |
|
|
extern const char *inquire_formatted (const char *, int);
|
639 |
|
|
internal_proto(inquire_formatted);
|
640 |
|
|
|
641 |
|
|
extern const char *inquire_unformatted (const char *, int);
|
642 |
|
|
internal_proto(inquire_unformatted);
|
643 |
|
|
|
644 |
|
|
extern const char *inquire_read (const char *, int);
|
645 |
|
|
internal_proto(inquire_read);
|
646 |
|
|
|
647 |
|
|
extern const char *inquire_write (const char *, int);
|
648 |
|
|
internal_proto(inquire_write);
|
649 |
|
|
|
650 |
|
|
extern const char *inquire_readwrite (const char *, int);
|
651 |
|
|
internal_proto(inquire_readwrite);
|
652 |
|
|
|
653 |
|
|
extern gfc_offset file_length (stream *);
|
654 |
|
|
internal_proto(file_length);
|
655 |
|
|
|
656 |
|
|
extern gfc_offset file_position (stream *);
|
657 |
|
|
internal_proto(file_position);
|
658 |
|
|
|
659 |
|
|
extern int is_seekable (stream *);
|
660 |
|
|
internal_proto(is_seekable);
|
661 |
|
|
|
662 |
|
|
extern int is_preconnected (stream *);
|
663 |
|
|
internal_proto(is_preconnected);
|
664 |
|
|
|
665 |
|
|
extern void flush_if_preconnected (stream *);
|
666 |
|
|
internal_proto(flush_if_preconnected);
|
667 |
|
|
|
668 |
|
|
extern void empty_internal_buffer(stream *);
|
669 |
|
|
internal_proto(empty_internal_buffer);
|
670 |
|
|
|
671 |
|
|
extern try flush (stream *);
|
672 |
|
|
internal_proto(flush);
|
673 |
|
|
|
674 |
|
|
extern int stream_isatty (stream *);
|
675 |
|
|
internal_proto(stream_isatty);
|
676 |
|
|
|
677 |
|
|
extern char * stream_ttyname (stream *);
|
678 |
|
|
internal_proto(stream_ttyname);
|
679 |
|
|
|
680 |
|
|
extern gfc_offset stream_offset (stream *s);
|
681 |
|
|
internal_proto(stream_offset);
|
682 |
|
|
|
683 |
|
|
extern int unit_to_fd (int);
|
684 |
|
|
internal_proto(unit_to_fd);
|
685 |
|
|
|
686 |
|
|
extern int unpack_filename (char *, const char *, int);
|
687 |
|
|
internal_proto(unpack_filename);
|
688 |
|
|
|
689 |
|
|
/* unit.c */
|
690 |
|
|
|
691 |
|
|
/* Maximum file offset, computed at library initialization time. */
|
692 |
|
|
extern gfc_offset max_offset;
|
693 |
|
|
internal_proto(max_offset);
|
694 |
|
|
|
695 |
|
|
/* Unit tree root. */
|
696 |
|
|
extern gfc_unit *unit_root;
|
697 |
|
|
internal_proto(unit_root);
|
698 |
|
|
|
699 |
|
|
extern __gthread_mutex_t unit_lock;
|
700 |
|
|
internal_proto(unit_lock);
|
701 |
|
|
|
702 |
|
|
extern int close_unit (gfc_unit *);
|
703 |
|
|
internal_proto(close_unit);
|
704 |
|
|
|
705 |
|
|
extern gfc_unit *get_internal_unit (st_parameter_dt *);
|
706 |
|
|
internal_proto(get_internal_unit);
|
707 |
|
|
|
708 |
|
|
extern void free_internal_unit (st_parameter_dt *);
|
709 |
|
|
internal_proto(free_internal_unit);
|
710 |
|
|
|
711 |
|
|
extern int is_internal_unit (st_parameter_dt *);
|
712 |
|
|
internal_proto(is_internal_unit);
|
713 |
|
|
|
714 |
|
|
extern int is_array_io (st_parameter_dt *);
|
715 |
|
|
internal_proto(is_array_io);
|
716 |
|
|
|
717 |
|
|
extern gfc_unit *find_unit (int);
|
718 |
|
|
internal_proto(find_unit);
|
719 |
|
|
|
720 |
|
|
extern gfc_unit *find_or_create_unit (int);
|
721 |
|
|
internal_proto(find_unit);
|
722 |
|
|
|
723 |
|
|
extern gfc_unit *get_unit (st_parameter_dt *, int);
|
724 |
|
|
internal_proto(get_unit);
|
725 |
|
|
|
726 |
|
|
extern void unlock_unit (gfc_unit *);
|
727 |
|
|
internal_proto(unlock_unit);
|
728 |
|
|
|
729 |
|
|
/* open.c */
|
730 |
|
|
|
731 |
|
|
extern void test_endfile (gfc_unit *);
|
732 |
|
|
internal_proto(test_endfile);
|
733 |
|
|
|
734 |
|
|
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
|
735 |
|
|
internal_proto(new_unit);
|
736 |
|
|
|
737 |
|
|
/* format.c */
|
738 |
|
|
|
739 |
|
|
extern void parse_format (st_parameter_dt *);
|
740 |
|
|
internal_proto(parse_format);
|
741 |
|
|
|
742 |
|
|
extern const fnode *next_format (st_parameter_dt *);
|
743 |
|
|
internal_proto(next_format);
|
744 |
|
|
|
745 |
|
|
extern void unget_format (st_parameter_dt *, const fnode *);
|
746 |
|
|
internal_proto(unget_format);
|
747 |
|
|
|
748 |
|
|
extern void format_error (st_parameter_dt *, const fnode *, const char *);
|
749 |
|
|
internal_proto(format_error);
|
750 |
|
|
|
751 |
|
|
extern void free_format_data (st_parameter_dt *);
|
752 |
|
|
internal_proto(free_format_data);
|
753 |
|
|
|
754 |
|
|
/* transfer.c */
|
755 |
|
|
|
756 |
|
|
#define SCRATCH_SIZE 300
|
757 |
|
|
|
758 |
|
|
extern const char *type_name (bt);
|
759 |
|
|
internal_proto(type_name);
|
760 |
|
|
|
761 |
|
|
extern void *read_block (st_parameter_dt *, int *);
|
762 |
|
|
internal_proto(read_block);
|
763 |
|
|
|
764 |
|
|
extern char *read_sf (st_parameter_dt *, int *, int);
|
765 |
|
|
internal_proto(read_sf);
|
766 |
|
|
|
767 |
|
|
extern void *write_block (st_parameter_dt *, int);
|
768 |
|
|
internal_proto(write_block);
|
769 |
|
|
|
770 |
|
|
extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *);
|
771 |
|
|
internal_proto(next_array_record);
|
772 |
|
|
|
773 |
|
|
extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *);
|
774 |
|
|
internal_proto(init_loop_spec);
|
775 |
|
|
|
776 |
|
|
extern void next_record (st_parameter_dt *, int);
|
777 |
|
|
internal_proto(next_record);
|
778 |
|
|
|
779 |
|
|
extern void reverse_memcpy (void *, const void *, size_t);
|
780 |
|
|
internal_proto (reverse_memcpy);
|
781 |
|
|
|
782 |
|
|
/* read.c */
|
783 |
|
|
|
784 |
|
|
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
|
785 |
|
|
internal_proto(set_integer);
|
786 |
|
|
|
787 |
|
|
extern GFC_UINTEGER_LARGEST max_value (int, int);
|
788 |
|
|
internal_proto(max_value);
|
789 |
|
|
|
790 |
|
|
extern int convert_real (st_parameter_dt *, void *, const char *, int);
|
791 |
|
|
internal_proto(convert_real);
|
792 |
|
|
|
793 |
|
|
extern void read_a (st_parameter_dt *, const fnode *, char *, int);
|
794 |
|
|
internal_proto(read_a);
|
795 |
|
|
|
796 |
|
|
extern void read_f (st_parameter_dt *, const fnode *, char *, int);
|
797 |
|
|
internal_proto(read_f);
|
798 |
|
|
|
799 |
|
|
extern void read_l (st_parameter_dt *, const fnode *, char *, int);
|
800 |
|
|
internal_proto(read_l);
|
801 |
|
|
|
802 |
|
|
extern void read_x (st_parameter_dt *, int);
|
803 |
|
|
internal_proto(read_x);
|
804 |
|
|
|
805 |
|
|
extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
|
806 |
|
|
internal_proto(read_radix);
|
807 |
|
|
|
808 |
|
|
extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
|
809 |
|
|
internal_proto(read_decimal);
|
810 |
|
|
|
811 |
|
|
/* list_read.c */
|
812 |
|
|
|
813 |
|
|
extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
|
814 |
|
|
size_t);
|
815 |
|
|
internal_proto(list_formatted_read);
|
816 |
|
|
|
817 |
|
|
extern void finish_list_read (st_parameter_dt *);
|
818 |
|
|
internal_proto(finish_list_read);
|
819 |
|
|
|
820 |
|
|
extern void namelist_read (st_parameter_dt *);
|
821 |
|
|
internal_proto(namelist_read);
|
822 |
|
|
|
823 |
|
|
extern void namelist_write (st_parameter_dt *);
|
824 |
|
|
internal_proto(namelist_write);
|
825 |
|
|
|
826 |
|
|
/* write.c */
|
827 |
|
|
|
828 |
|
|
extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
|
829 |
|
|
internal_proto(write_a);
|
830 |
|
|
|
831 |
|
|
extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
|
832 |
|
|
internal_proto(write_b);
|
833 |
|
|
|
834 |
|
|
extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
|
835 |
|
|
internal_proto(write_d);
|
836 |
|
|
|
837 |
|
|
extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
|
838 |
|
|
internal_proto(write_e);
|
839 |
|
|
|
840 |
|
|
extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
|
841 |
|
|
internal_proto(write_en);
|
842 |
|
|
|
843 |
|
|
extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
|
844 |
|
|
internal_proto(write_es);
|
845 |
|
|
|
846 |
|
|
extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
|
847 |
|
|
internal_proto(write_f);
|
848 |
|
|
|
849 |
|
|
extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
|
850 |
|
|
internal_proto(write_i);
|
851 |
|
|
|
852 |
|
|
extern void write_l (st_parameter_dt *, const fnode *, char *, int);
|
853 |
|
|
internal_proto(write_l);
|
854 |
|
|
|
855 |
|
|
extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
|
856 |
|
|
internal_proto(write_o);
|
857 |
|
|
|
858 |
|
|
extern void write_x (st_parameter_dt *, int, int);
|
859 |
|
|
internal_proto(write_x);
|
860 |
|
|
|
861 |
|
|
extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
|
862 |
|
|
internal_proto(write_z);
|
863 |
|
|
|
864 |
|
|
extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
|
865 |
|
|
size_t);
|
866 |
|
|
internal_proto(list_formatted_write);
|
867 |
|
|
|
868 |
|
|
/* error.c */
|
869 |
|
|
extern try notify_std (int, const char *);
|
870 |
|
|
internal_proto(notify_std);
|
871 |
|
|
|
872 |
|
|
extern notification notification_std(int);
|
873 |
|
|
internal_proto(notification_std);
|
874 |
|
|
|
875 |
|
|
/* size_from_kind.c */
|
876 |
|
|
extern size_t size_from_real_kind (int);
|
877 |
|
|
internal_proto(size_from_real_kind);
|
878 |
|
|
|
879 |
|
|
extern size_t size_from_complex_kind (int);
|
880 |
|
|
internal_proto(size_from_complex_kind);
|
881 |
|
|
|
882 |
|
|
/* lock.c */
|
883 |
|
|
extern void free_ionml (st_parameter_dt *);
|
884 |
|
|
internal_proto(free_ionml);
|
885 |
|
|
|
886 |
|
|
static inline void
|
887 |
|
|
inc_waiting_locked (gfc_unit *u)
|
888 |
|
|
{
|
889 |
|
|
#ifdef HAVE_SYNC_FETCH_AND_ADD
|
890 |
|
|
(void) __sync_fetch_and_add (&u->waiting, 1);
|
891 |
|
|
#else
|
892 |
|
|
u->waiting++;
|
893 |
|
|
#endif
|
894 |
|
|
}
|
895 |
|
|
|
896 |
|
|
static inline int
|
897 |
|
|
predec_waiting_locked (gfc_unit *u)
|
898 |
|
|
{
|
899 |
|
|
#ifdef HAVE_SYNC_FETCH_AND_ADD
|
900 |
|
|
return __sync_add_and_fetch (&u->waiting, -1);
|
901 |
|
|
#else
|
902 |
|
|
return --u->waiting;
|
903 |
|
|
#endif
|
904 |
|
|
}
|
905 |
|
|
|
906 |
|
|
static inline void
|
907 |
|
|
dec_waiting_unlocked (gfc_unit *u)
|
908 |
|
|
{
|
909 |
|
|
#ifdef HAVE_SYNC_FETCH_AND_ADD
|
910 |
|
|
(void) __sync_fetch_and_add (&u->waiting, -1);
|
911 |
|
|
#else
|
912 |
|
|
__gthread_mutex_lock (&unit_lock);
|
913 |
|
|
u->waiting--;
|
914 |
|
|
__gthread_mutex_unlock (&unit_lock);
|
915 |
|
|
#endif
|
916 |
|
|
}
|
917 |
|
|
|
918 |
|
|
#endif
|
919 |
|
|
|
920 |
|
|
/* ../runtime/environ.c This is here because we return unit_convert. */
|
921 |
|
|
|
922 |
|
|
unit_convert get_unformatted_convert (int);
|
923 |
|
|
internal_proto(get_unformatted_convert);
|