]>
Commit | Line | Data |
---|---|---|
818ab71a | 1 | /* Copyright (C) 2002-2016 Free Software Foundation, Inc. |
6de9cd9a | 2 | Contributed by Andy Vaught |
10256cbe | 3 | F2003 I/O support contributed by Jerry DeLisle |
6de9cd9a | 4 | |
eea58adb | 5 | This file is part of the GNU Fortran runtime library (libgfortran). |
6de9cd9a DN |
6 | |
7 | Libgfortran is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
748086b7 | 9 | the Free Software Foundation; either version 3, or (at your option) |
6de9cd9a DN |
10 | any later version. |
11 | ||
12 | Libgfortran is distributed in the hope that it will be useful, | |
13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | GNU General Public License for more details. | |
16 | ||
748086b7 JJ |
17 | Under Section 7 of GPL version 3, you are granted additional |
18 | permissions described in the GCC Runtime Library Exception, version | |
19 | 3.1, as published by the Free Software Foundation. | |
20 | ||
21 | You should have received a copy of the GNU General Public License and | |
22 | a copy of the GCC Runtime Library Exception along with this program; | |
23 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
24 | <http://www.gnu.org/licenses/>. */ | |
57dea9f6 | 25 | |
6de9cd9a DN |
26 | #ifndef GFOR_IO_H |
27 | #define GFOR_IO_H | |
28 | ||
29 | /* IO library include. */ | |
30 | ||
6de9cd9a | 31 | #include "libgfortran.h" |
73e5b024 | 32 | |
5e805e44 | 33 | #include <gthr.h> |
7d7b8bfe | 34 | |
9cbecd06 JB |
35 | |
36 | /* POSIX 2008 specifies that the extended locale stuff is found in | |
37 | locale.h, but some systems have them in xlocale.h. */ | |
38 | ||
39 | #include <locale.h> | |
40 | ||
41 | #ifdef HAVE_XLOCALE_H | |
42 | #include <xlocale.h> | |
43 | #endif | |
44 | ||
45 | ||
92cbdb68 | 46 | /* Forward declarations. */ |
5e805e44 | 47 | struct st_parameter_dt; |
92cbdb68 JB |
48 | typedef struct stream stream; |
49 | struct fbuf; | |
50 | struct format_data; | |
51 | typedef struct fnode fnode; | |
52 | struct gfc_unit; | |
6de9cd9a | 53 | |
9cbecd06 JB |
54 | #ifdef HAVE_NEWLOCALE |
55 | /* We have POSIX 2008 extended locale stuff. */ | |
56 | extern locale_t c_locale; | |
57 | internal_proto(c_locale); | |
58 | #else | |
59 | extern char* old_locale; | |
60 | internal_proto(old_locale); | |
61 | extern int old_locale_ctr; | |
62 | internal_proto(old_locale_ctr); | |
63 | extern __gthread_mutex_t old_locale_lock; | |
64 | internal_proto(old_locale_lock); | |
65 | #endif | |
66 | ||
82b8244c | 67 | |
d10fb73e JD |
68 | /* Macros for testing what kinds of I/O we are doing. */ |
69 | ||
70 | #define is_array_io(dtp) ((dtp)->internal_unit_desc) | |
71 | ||
72 | #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal) | |
73 | ||
74 | #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) | |
75 | ||
c7421e06 JD |
76 | #define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit) |
77 | ||
965eec16 | 78 | /* The array_loop_spec contains the variables for the loops over index ranges |
44720bef | 79 | that are encountered. */ |
29dc5138 | 80 | |
965eec16 | 81 | typedef struct array_loop_spec |
29dc5138 | 82 | { |
29dc5138 | 83 | /* Index counter for this dimension. */ |
44720bef | 84 | index_type idx; |
6de9cd9a | 85 | |
29dc5138 | 86 | /* Start for the index counter. */ |
44720bef | 87 | index_type start; |
29dc5138 PT |
88 | |
89 | /* End for the index counter. */ | |
44720bef | 90 | index_type end; |
29dc5138 PT |
91 | |
92 | /* Step for the index counter. */ | |
44720bef | 93 | index_type step; |
29dc5138 | 94 | } |
965eec16 JD |
95 | array_loop_spec; |
96 | ||
e73d3ca6 PT |
97 | /* User defined input/output iomsg length. */ |
98 | ||
99 | #define IOMSG_LEN 256 | |
100 | ||
101 | /* Subroutine formatted_dtio (struct, unit, iotype, v_list, iostat, | |
102 | iomsg, (_iotype), (_iomsg)) */ | |
103 | typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *, gfc_array_i4 *, | |
104 | GFC_INTEGER_4 *, char *, | |
105 | gfc_charlen_type, gfc_charlen_type); | |
106 | ||
107 | /* Subroutine unformatted_dtio (struct, unit, iostat, iomsg, (_iomsg)) */ | |
108 | typedef void (*unformatted_dtio)(void *, GFC_INTEGER_4 *, GFC_INTEGER_4 *, | |
109 | char *, gfc_charlen_type); | |
110 | ||
111 | /* The dtio calls for namelist require a CLASS object to be built. */ | |
112 | typedef struct gfc_class | |
113 | { | |
114 | void *data; | |
115 | void *vptr; | |
116 | index_type len; | |
117 | } | |
118 | gfc_class; | |
119 | ||
120 | ||
eea58adb | 121 | /* A structure to build a hash table for format data. */ |
7812c78c | 122 | |
92cbdb68 | 123 | #define FORMAT_HASH_SIZE 16 |
7812c78c JD |
124 | |
125 | typedef struct format_hash_entry | |
126 | { | |
127 | char *key; | |
128 | gfc_charlen_type key_len; | |
129 | struct format_data *hashed_fmt; | |
130 | } | |
131 | format_hash_entry; | |
132 | ||
965eec16 | 133 | /* Representation of a namelist object in libgfortran |
29dc5138 | 134 | |
965eec16 JD |
135 | Namelist Records |
136 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ | |
137 | or | |
138 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END | |
139 | ||
8b6dba81 | 140 | The object can be a fully qualified, compound name for an intrinsic |
965eec16 JD |
141 | type, derived types or derived type components. So, a substring |
142 | a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist | |
143 | read. Hence full information about the structure of the object has | |
144 | to be available to list_read.c and write. | |
145 | ||
146 | These requirements are met by the following data structures. | |
147 | ||
148 | namelist_info type contains all the scalar information about the | |
149 | object and arrays of descriptor_dimension and array_loop_spec types for | |
29dc5138 | 150 | arrays. */ |
6de9cd9a DN |
151 | |
152 | typedef struct namelist_type | |
153 | { | |
a11930ba JD |
154 | /* Object type. */ |
155 | bt type; | |
29dc5138 PT |
156 | |
157 | /* Object name. */ | |
6de9cd9a | 158 | char * var_name; |
29dc5138 PT |
159 | |
160 | /* Address for the start of the object's data. */ | |
6de9cd9a | 161 | void * mem_pos; |
29dc5138 | 162 | |
e73d3ca6 PT |
163 | /* Address of specific DTIO subroutine. */ |
164 | void * dtio_sub; | |
165 | ||
166 | /* Address of vtable if dtio_sub non-null. */ | |
167 | void * vtable; | |
168 | ||
29dc5138 PT |
169 | /* Flag to show that a read is to be attempted for this node. */ |
170 | int touched; | |
171 | ||
172 | /* Length of intrinsic type in bytes. */ | |
6de9cd9a | 173 | int len; |
29dc5138 PT |
174 | |
175 | /* Rank of the object. */ | |
176 | int var_rank; | |
177 | ||
178 | /* Overall size of the object in bytes. */ | |
179 | index_type size; | |
180 | ||
181 | /* Length of character string. */ | |
182 | index_type string_length; | |
183 | ||
184 | descriptor_dimension * dim; | |
965eec16 | 185 | array_loop_spec * ls; |
6de9cd9a DN |
186 | struct namelist_type * next; |
187 | } | |
188 | namelist_info; | |
189 | ||
190 | /* Options for the OPEN statement. */ | |
191 | ||
192 | typedef enum | |
91b30ee5 | 193 | { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, |
6de9cd9a DN |
194 | ACCESS_UNSPECIFIED |
195 | } | |
196 | unit_access; | |
197 | ||
198 | typedef enum | |
199 | { ACTION_READ, ACTION_WRITE, ACTION_READWRITE, | |
200 | ACTION_UNSPECIFIED | |
201 | } | |
202 | unit_action; | |
203 | ||
204 | typedef enum | |
205 | { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED } | |
206 | unit_blank; | |
207 | ||
208 | typedef enum | |
209 | { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE, | |
210 | DELIM_UNSPECIFIED | |
211 | } | |
212 | unit_delim; | |
213 | ||
214 | typedef enum | |
215 | { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED } | |
216 | unit_form; | |
217 | ||
218 | typedef enum | |
219 | { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND, | |
220 | POSITION_UNSPECIFIED | |
221 | } | |
222 | unit_position; | |
223 | ||
224 | typedef enum | |
225 | { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH, | |
226 | STATUS_REPLACE, STATUS_UNSPECIFIED | |
227 | } | |
228 | unit_status; | |
229 | ||
230 | typedef enum | |
231 | { PAD_YES, PAD_NO, PAD_UNSPECIFIED } | |
232 | unit_pad; | |
233 | ||
10256cbe JD |
234 | typedef enum |
235 | { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } | |
236 | unit_decimal; | |
237 | ||
238 | typedef enum | |
239 | { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } | |
240 | unit_encoding; | |
241 | ||
242 | typedef enum | |
82a4f54c TB |
243 | { ROUND_UP = GFC_FPE_UPWARD, |
244 | ROUND_DOWN = GFC_FPE_DOWNWARD, | |
245 | ROUND_ZERO = GFC_FPE_TOWARDZERO, | |
246 | ROUND_NEAREST = GFC_FPE_TONEAREST, | |
247 | ROUND_COMPATIBLE = 10, /* round away from zero. */ | |
248 | ROUND_PROCDEFINED, /* Here as ROUND_NEAREST. */ | |
249 | ROUND_UNSPECIFIED /* Should never occur. */ | |
250 | } | |
10256cbe JD |
251 | unit_round; |
252 | ||
253 | /* NOTE: unit_sign must correspond with the sign_status enumerator in | |
254 | st_parameter_dt to not break the ABI. */ | |
255 | typedef enum | |
256 | { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } | |
257 | unit_sign; | |
258 | ||
6de9cd9a DN |
259 | typedef enum |
260 | { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } | |
261 | unit_advance; | |
262 | ||
55948b69 | 263 | typedef enum |
1060d940 | 264 | {READING, WRITING, LIST_READING, LIST_WRITING} |
55948b69 | 265 | unit_mode; |
6de9cd9a | 266 | |
10256cbe | 267 | typedef enum |
931149a6 | 268 | { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } |
10256cbe JD |
269 | unit_async; |
270 | ||
d7445152 JD |
271 | typedef enum |
272 | { SIGN_S, SIGN_SS, SIGN_SP } | |
273 | unit_sign_s; | |
274 | ||
5e805e44 JJ |
275 | #define CHARACTER1(name) \ |
276 | char * name; \ | |
277 | gfc_charlen_type name ## _len | |
278 | #define CHARACTER2(name) \ | |
279 | gfc_charlen_type name ## _len; \ | |
280 | char * name | |
281 | ||
6de9cd9a DN |
282 | typedef struct |
283 | { | |
5e805e44 JJ |
284 | st_parameter_common common; |
285 | GFC_INTEGER_4 recl_in; | |
286 | CHARACTER2 (file); | |
287 | CHARACTER1 (status); | |
288 | CHARACTER2 (access); | |
289 | CHARACTER1 (form); | |
290 | CHARACTER2 (blank); | |
291 | CHARACTER1 (position); | |
292 | CHARACTER2 (action); | |
293 | CHARACTER1 (delim); | |
294 | CHARACTER2 (pad); | |
181c9f4a | 295 | CHARACTER1 (convert); |
10256cbe JD |
296 | CHARACTER2 (decimal); |
297 | CHARACTER1 (encoding); | |
298 | CHARACTER2 (round); | |
299 | CHARACTER1 (sign); | |
300 | CHARACTER2 (asynchronous); | |
dcfddbd4 | 301 | GFC_INTEGER_4 *newunit; |
5e805e44 JJ |
302 | } |
303 | st_parameter_open; | |
6de9cd9a | 304 | |
5e805e44 | 305 | #define IOPARM_CLOSE_HAS_STATUS (1 << 7) |
6de9cd9a | 306 | |
5e805e44 JJ |
307 | typedef struct |
308 | { | |
309 | st_parameter_common common; | |
310 | CHARACTER1 (status); | |
311 | } | |
312 | st_parameter_close; | |
6de9cd9a | 313 | |
5e805e44 JJ |
314 | typedef struct |
315 | { | |
316 | st_parameter_common common; | |
317 | } | |
318 | st_parameter_filepos; | |
319 | ||
320 | #define IOPARM_INQUIRE_HAS_EXIST (1 << 7) | |
321 | #define IOPARM_INQUIRE_HAS_OPENED (1 << 8) | |
322 | #define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) | |
323 | #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) | |
324 | #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) | |
325 | #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) | |
91b30ee5 JD |
326 | #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) |
327 | #define IOPARM_INQUIRE_HAS_FILE (1 << 14) | |
328 | #define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) | |
329 | #define IOPARM_INQUIRE_HAS_FORM (1 << 16) | |
330 | #define IOPARM_INQUIRE_HAS_BLANK (1 << 17) | |
331 | #define IOPARM_INQUIRE_HAS_POSITION (1 << 18) | |
332 | #define IOPARM_INQUIRE_HAS_ACTION (1 << 19) | |
333 | #define IOPARM_INQUIRE_HAS_DELIM (1 << 20) | |
334 | #define IOPARM_INQUIRE_HAS_PAD (1 << 21) | |
335 | #define IOPARM_INQUIRE_HAS_NAME (1 << 22) | |
336 | #define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) | |
337 | #define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) | |
338 | #define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) | |
339 | #define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) | |
340 | #define IOPARM_INQUIRE_HAS_READ (1 << 27) | |
341 | #define IOPARM_INQUIRE_HAS_WRITE (1 << 28) | |
342 | #define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) | |
343 | #define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) | |
76b88c5f | 344 | #define IOPARM_INQUIRE_HAS_FLAGS2 (1u << 31) |
10256cbe JD |
345 | |
346 | #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) | |
347 | #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) | |
348 | #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) | |
e1456843 JJ |
349 | #define IOPARM_INQUIRE_HAS_ROUND (1 << 3) |
350 | #define IOPARM_INQUIRE_HAS_SIGN (1 << 4) | |
351 | #define IOPARM_INQUIRE_HAS_PENDING (1 << 5) | |
10256cbe JD |
352 | #define IOPARM_INQUIRE_HAS_SIZE (1 << 6) |
353 | #define IOPARM_INQUIRE_HAS_ID (1 << 7) | |
797332ed | 354 | #define IOPARM_INQUIRE_HAS_IQSTREAM (1 << 8) |
b8d5e926 | 355 | |
5e805e44 JJ |
356 | typedef struct |
357 | { | |
358 | st_parameter_common common; | |
359 | GFC_INTEGER_4 *exist, *opened, *number, *named; | |
360 | GFC_INTEGER_4 *nextrec, *recl_out; | |
91b30ee5 | 361 | GFC_IO_INT *strm_pos_out; |
5e805e44 JJ |
362 | CHARACTER1 (file); |
363 | CHARACTER2 (access); | |
364 | CHARACTER1 (form); | |
365 | CHARACTER2 (blank); | |
366 | CHARACTER1 (position); | |
367 | CHARACTER2 (action); | |
368 | CHARACTER1 (delim); | |
369 | CHARACTER2 (pad); | |
370 | CHARACTER1 (name); | |
371 | CHARACTER2 (sequential); | |
372 | CHARACTER1 (direct); | |
373 | CHARACTER2 (formatted); | |
374 | CHARACTER1 (unformatted); | |
375 | CHARACTER2 (read); | |
376 | CHARACTER1 (write); | |
377 | CHARACTER2 (readwrite); | |
181c9f4a | 378 | CHARACTER1 (convert); |
10256cbe JD |
379 | GFC_INTEGER_4 flags2; |
380 | CHARACTER1 (asynchronous); | |
931149a6 | 381 | CHARACTER2 (decimal); |
10256cbe | 382 | CHARACTER1 (encoding); |
e1456843 JJ |
383 | CHARACTER2 (round); |
384 | CHARACTER1 (sign); | |
385 | GFC_INTEGER_4 *pending; | |
260f179b | 386 | GFC_IO_INT *size; |
931149a6 | 387 | GFC_INTEGER_4 *id; |
797332ed | 388 | CHARACTER1 (iqstream); |
5e805e44 JJ |
389 | } |
390 | st_parameter_inquire; | |
391 | ||
5e805e44 JJ |
392 | |
393 | #define IOPARM_DT_LIST_FORMAT (1 << 7) | |
394 | #define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) | |
395 | #define IOPARM_DT_HAS_REC (1 << 9) | |
396 | #define IOPARM_DT_HAS_SIZE (1 << 10) | |
397 | #define IOPARM_DT_HAS_IOLENGTH (1 << 11) | |
398 | #define IOPARM_DT_HAS_FORMAT (1 << 12) | |
399 | #define IOPARM_DT_HAS_ADVANCE (1 << 13) | |
400 | #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) | |
401 | #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) | |
10256cbe JD |
402 | #define IOPARM_DT_HAS_ID (1 << 16) |
403 | #define IOPARM_DT_HAS_POS (1 << 17) | |
404 | #define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) | |
405 | #define IOPARM_DT_HAS_BLANK (1 << 19) | |
406 | #define IOPARM_DT_HAS_DECIMAL (1 << 20) | |
407 | #define IOPARM_DT_HAS_DELIM (1 << 21) | |
408 | #define IOPARM_DT_HAS_PAD (1 << 22) | |
409 | #define IOPARM_DT_HAS_ROUND (1 << 23) | |
410 | #define IOPARM_DT_HAS_SIGN (1 << 24) | |
d7445152 | 411 | #define IOPARM_DT_HAS_F2003 (1 << 25) |
5e805e44 | 412 | /* Internal use bit. */ |
76b88c5f | 413 | #define IOPARM_DT_IONML_SET (1u << 31) |
5e805e44 | 414 | |
d7445152 | 415 | |
d7445152 JD |
416 | typedef struct st_parameter_dt |
417 | { | |
418 | st_parameter_common common; | |
419 | GFC_IO_INT rec; | |
420 | GFC_IO_INT *size, *iolength; | |
421 | gfc_array_char *internal_unit_desc; | |
422 | CHARACTER1 (format); | |
423 | CHARACTER2 (advance); | |
424 | CHARACTER1 (internal_unit); | |
425 | CHARACTER2 (namelist_name); | |
5e805e44 JJ |
426 | /* Private part of the structure. The compiler just needs |
427 | to reserve enough space. */ | |
428 | union | |
429 | { | |
e1456843 JJ |
430 | struct |
431 | { | |
432 | void (*transfer) (struct st_parameter_dt *, bt, void *, int, | |
433 | size_t, size_t); | |
434 | struct gfc_unit *current_unit; | |
435 | /* Item number in a formatted data transfer. Also used in namelist | |
436 | read_logical as an index into line_buffer. */ | |
437 | int item_count; | |
438 | unit_mode mode; | |
439 | unit_blank blank_status; | |
440 | unit_sign sign_status; | |
441 | int scale_factor; | |
442 | int max_pos; /* Maximum righthand column written to. */ | |
443 | /* Number of skips + spaces to be done for T and X-editing. */ | |
444 | int skips; | |
445 | /* Number of spaces to be done for T and X-editing. */ | |
446 | int pending_spaces; | |
447 | /* Whether an EOR condition was encountered. Value is: | |
448 | 0 if no EOR was encountered | |
449 | 1 if an EOR was encountered due to a 1-byte marker (LF) | |
450 | 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ | |
451 | int sf_seen_eor; | |
452 | unit_advance advance_status; | |
453 | unsigned reversion_flag : 1; /* Format reversion has occurred. */ | |
454 | unsigned first_item : 1; | |
455 | unsigned seen_dollar : 1; | |
456 | unsigned eor_condition : 1; | |
457 | unsigned no_leading_blank : 1; | |
458 | unsigned char_flag : 1; | |
459 | unsigned input_complete : 1; | |
460 | unsigned at_eol : 1; | |
461 | unsigned comma_flag : 1; | |
462 | /* A namelist specific flag used in the list directed library | |
eea58adb | 463 | to flag that calls are being made from namelist read (e.g. to |
e1456843 JJ |
464 | ignore comments or to treat '/' as a terminator) */ |
465 | unsigned namelist_mode : 1; | |
466 | /* A namelist specific flag used in the list directed library | |
467 | to flag read errors and return, so that an attempt can be | |
468 | made to read a new object name. */ | |
469 | unsigned nml_read_error : 1; | |
470 | /* A sequential formatted read specific flag used to signal that a | |
471 | character string is being read so don't use commas to shorten a | |
472 | formatted field width. */ | |
473 | unsigned sf_read_comma : 1; | |
474 | /* A namelist specific flag used to enable reading input from | |
475 | line_buffer for logical reads. */ | |
476 | unsigned line_buffer_enabled : 1; | |
477 | /* An internal unit specific flag used to identify that the associated | |
478 | unit is internal. */ | |
479 | unsigned unit_is_internal : 1; | |
480 | /* An internal unit specific flag to signify an EOF condition for list | |
481 | directed read. */ | |
482 | unsigned at_eof : 1; | |
50220190 JD |
483 | /* Used for g0 floating point output. */ |
484 | unsigned g0_no_blanks : 1; | |
2418d0e0 JD |
485 | /* Used to signal use of free_format_data. */ |
486 | unsigned format_not_saved : 1; | |
2558e2e8 JD |
487 | /* A flag used to identify when a non-standard expanded namelist read |
488 | has occurred. */ | |
489 | unsigned expanded_read : 1; | |
490 | /* 13 unused bits. */ | |
e1456843 | 491 | |
c86af7f3 JB |
492 | /* Used for ungetc() style functionality. Possible values |
493 | are an unsigned char, EOF, or EOF - 1 used to mark the | |
494 | field as not valid. */ | |
e73d3ca6 | 495 | int last_char; /* No longer used, moved to gfc_unit. */ |
e1456843 JJ |
496 | char nml_delim; |
497 | ||
498 | int repeat_count; | |
499 | int saved_length; | |
500 | int saved_used; | |
501 | bt saved_type; | |
502 | char *saved_string; | |
503 | char *scratch; | |
504 | char *line_buffer; | |
505 | struct format_data *fmt; | |
e1456843 | 506 | namelist_info *ionml; |
9cbecd06 JB |
507 | #ifdef HAVE_NEWLOCALE |
508 | locale_t old_locale; | |
509 | #endif | |
2558e2e8 JD |
510 | /* Current position within the look-ahead line buffer. */ |
511 | int line_buffer_pos; | |
60c063fa JB |
512 | /* Storage area for values except for strings. Must be |
513 | large enough to hold a complex value (two reals) of the | |
6b680210 JB |
514 | largest kind. */ |
515 | char value[32]; | |
e1456843 | 516 | GFC_IO_INT size_used; |
e73d3ca6 PT |
517 | formatted_dtio fdtio_ptr; |
518 | unformatted_dtio ufdtio_ptr; | |
e1456843 | 519 | } p; |
ebf85e50 JJ |
520 | /* This pad size must be equal to the pad_size declared in |
521 | trans-io.c (gfc_build_io_library_fndecls). The above structure | |
522 | must be smaller or equal to this array. */ | |
e1456843 | 523 | char pad[16 * sizeof (char *) + 32 * sizeof (int)]; |
5e805e44 | 524 | } u; |
e1456843 JJ |
525 | GFC_INTEGER_4 *id; |
526 | GFC_IO_INT pos; | |
527 | CHARACTER1 (asynchronous); | |
528 | CHARACTER2 (blank); | |
529 | CHARACTER1 (decimal); | |
530 | CHARACTER2 (delim); | |
531 | CHARACTER1 (pad); | |
532 | CHARACTER2 (round); | |
533 | CHARACTER1 (sign); | |
6de9cd9a | 534 | } |
5e805e44 | 535 | st_parameter_dt; |
6de9cd9a | 536 | |
ebf85e50 JJ |
537 | /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */ |
538 | extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) | |
539 | >= sizeof (((st_parameter_dt *) 0)->u.p) | |
540 | ? 1 : -1]; | |
541 | ||
10256cbe JD |
542 | #define IOPARM_WAIT_HAS_ID (1 << 7) |
543 | ||
544 | typedef struct | |
545 | { | |
546 | st_parameter_common common; | |
547 | CHARACTER1 (id); | |
548 | } | |
549 | st_parameter_wait; | |
550 | ||
551 | ||
5e805e44 JJ |
552 | #undef CHARACTER1 |
553 | #undef CHARACTER2 | |
6de9cd9a DN |
554 | |
555 | typedef struct | |
556 | { | |
557 | unit_access access; | |
558 | unit_action action; | |
559 | unit_blank blank; | |
560 | unit_delim delim; | |
561 | unit_form form; | |
562 | int is_notpadded; | |
563 | unit_position position; | |
564 | unit_status status; | |
565 | unit_pad pad; | |
d7445152 JD |
566 | unit_convert convert; |
567 | int has_recl; | |
10256cbe JD |
568 | unit_decimal decimal; |
569 | unit_encoding encoding; | |
570 | unit_round round; | |
571 | unit_sign sign; | |
10256cbe | 572 | unit_async async; |
6de9cd9a DN |
573 | } |
574 | unit_flags; | |
575 | ||
576 | ||
909087e0 | 577 | typedef struct gfc_unit |
6de9cd9a DN |
578 | { |
579 | int unit_number; | |
6de9cd9a | 580 | stream *s; |
965eec16 JD |
581 | |
582 | /* Treap links. */ | |
583 | struct gfc_unit *left, *right; | |
6de9cd9a DN |
584 | int priority; |
585 | ||
108bc190 TK |
586 | int read_bad, current_record, saved_pos, previous_nonadvancing_write; |
587 | ||
6de9cd9a DN |
588 | enum |
589 | { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } | |
590 | endfile; | |
591 | ||
5e805e44 | 592 | unit_mode mode; |
6de9cd9a | 593 | unit_flags flags; |
105b7136 JD |
594 | unit_pad pad_status; |
595 | unit_decimal decimal_status; | |
596 | unit_delim delim_status; | |
379924dd | 597 | unit_round round_status; |
5e805e44 | 598 | |
07b3bbf2 TK |
599 | /* recl -- Record length of the file. |
600 | last_record -- Last record number read or written | |
601 | maxrec -- Maximum record number in a direct access file | |
602 | bytes_left -- Bytes left in current record. | |
603 | strm_pos -- Current position in file for STREAM I/O. | |
604 | recl_subrecord -- Maximum length for subrecord. | |
605 | bytes_left_subrecord -- Bytes left in current subrecord. */ | |
606 | gfc_offset recl, last_record, maxrec, bytes_left, strm_pos, | |
607 | recl_subrecord, bytes_left_subrecord; | |
608 | ||
609 | /* Set to 1 if we have read a subrecord. */ | |
610 | ||
611 | int continued; | |
6de9cd9a | 612 | |
5e805e44 JJ |
613 | __gthread_mutex_t lock; |
614 | /* Number of threads waiting to acquire this unit's lock. | |
615 | When non-zero, close_unit doesn't only removes the unit | |
616 | from the UNIT_ROOT tree, but doesn't free it and the | |
617 | last of the waiting threads will do that. | |
618 | This must be either atomically increased/decreased, or | |
619 | always guarded by UNIT_LOCK. */ | |
620 | int waiting; | |
621 | /* Flag set by close_unit if the unit as been closed. | |
622 | Must be manipulated under unit's lock. */ | |
623 | int closed; | |
624 | ||
965eec16 JD |
625 | /* For traversing arrays */ |
626 | array_loop_spec *ls; | |
627 | int rank; | |
5e805e44 | 628 | |
0e05c303 JB |
629 | /* Name of the file at the time OPEN was executed, as a |
630 | null-terminated C string. */ | |
631 | char *filename; | |
7812c78c JD |
632 | |
633 | /* The format hash table. */ | |
634 | struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE]; | |
15877a88 JB |
635 | |
636 | /* Formatting buffer. */ | |
637 | struct fbuf *fbuf; | |
d428be77 JD |
638 | |
639 | /* Function pointer, points to list_read worker functions. */ | |
640 | int (*next_char_fn_ptr) (st_parameter_dt *); | |
641 | void (*push_char_fn_ptr) (st_parameter_dt *, int); | |
e73d3ca6 PT |
642 | |
643 | /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */ | |
644 | int child_dtio; | |
645 | int last_char; | |
6de9cd9a | 646 | } |
909087e0 | 647 | gfc_unit; |
6de9cd9a | 648 | |
10c682a0 | 649 | |
6de9cd9a DN |
650 | /* unit.c */ |
651 | ||
5e805e44 JJ |
652 | /* Maximum file offset, computed at library initialization time. */ |
653 | extern gfc_offset max_offset; | |
654 | internal_proto(max_offset); | |
655 | ||
656 | /* Unit tree root. */ | |
657 | extern gfc_unit *unit_root; | |
658 | internal_proto(unit_root); | |
659 | ||
660 | extern __gthread_mutex_t unit_lock; | |
661 | internal_proto(unit_lock); | |
6de9cd9a | 662 | |
7d7b8bfe RH |
663 | extern int close_unit (gfc_unit *); |
664 | internal_proto(close_unit); | |
6de9cd9a | 665 | |
54ffdb12 JD |
666 | extern gfc_unit *get_internal_unit (st_parameter_dt *); |
667 | internal_proto(get_internal_unit); | |
668 | ||
669 | extern void free_internal_unit (st_parameter_dt *); | |
670 | internal_proto(free_internal_unit); | |
91b30ee5 | 671 | |
7d7b8bfe RH |
672 | extern gfc_unit *find_unit (int); |
673 | internal_proto(find_unit); | |
6de9cd9a | 674 | |
5e805e44 | 675 | extern gfc_unit *find_or_create_unit (int); |
59c0928b | 676 | internal_proto(find_or_create_unit); |
5e805e44 JJ |
677 | |
678 | extern gfc_unit *get_unit (st_parameter_dt *, int); | |
7d7b8bfe | 679 | internal_proto(get_unit); |
6de9cd9a | 680 | |
5e805e44 JJ |
681 | extern void unlock_unit (gfc_unit *); |
682 | internal_proto(unlock_unit); | |
683 | ||
108bc190 TK |
684 | extern void finish_last_advance_record (gfc_unit *u); |
685 | internal_proto (finish_last_advance_record); | |
686 | ||
7812c78c JD |
687 | extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *); |
688 | internal_proto (unit_truncate); | |
689 | ||
dcfddbd4 JD |
690 | extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *); |
691 | internal_proto(get_unique_unit_number); | |
692 | ||
6de9cd9a DN |
693 | /* open.c */ |
694 | ||
5e805e44 | 695 | extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); |
7d7b8bfe | 696 | internal_proto(new_unit); |
6de9cd9a | 697 | |
7812c78c | 698 | |
6de9cd9a DN |
699 | /* transfer.c */ |
700 | ||
701 | #define SCRATCH_SIZE 300 | |
702 | ||
7d7b8bfe RH |
703 | extern const char *type_name (bt); |
704 | internal_proto(type_name); | |
6de9cd9a | 705 | |
7812c78c | 706 | extern void * read_block_form (st_parameter_dt *, int *); |
15877a88 | 707 | internal_proto(read_block_form); |
6de9cd9a | 708 | |
74db2a47 JD |
709 | extern void * read_block_form4 (st_parameter_dt *, int *); |
710 | internal_proto(read_block_form4); | |
711 | ||
5e805e44 | 712 | extern void *write_block (st_parameter_dt *, int); |
7d7b8bfe | 713 | internal_proto(write_block); |
6de9cd9a | 714 | |
9370b3c0 TK |
715 | extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *, |
716 | int*); | |
965eec16 JD |
717 | internal_proto(next_array_record); |
718 | ||
9370b3c0 TK |
719 | extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *, |
720 | gfc_offset *); | |
965eec16 JD |
721 | internal_proto(init_loop_spec); |
722 | ||
5e805e44 | 723 | extern void next_record (st_parameter_dt *, int); |
7d7b8bfe | 724 | internal_proto(next_record); |
6de9cd9a | 725 | |
10256cbe JD |
726 | extern void st_wait (st_parameter_wait *); |
727 | export_proto(st_wait); | |
728 | ||
7812c78c JD |
729 | extern void hit_eof (st_parameter_dt *); |
730 | internal_proto(hit_eof); | |
731 | ||
6de9cd9a DN |
732 | /* read.c */ |
733 | ||
32aa3bff | 734 | extern void set_integer (void *, GFC_INTEGER_LARGEST, int); |
7d7b8bfe | 735 | internal_proto(set_integer); |
6de9cd9a | 736 | |
80b91c0b JB |
737 | extern GFC_UINTEGER_LARGEST si_max (int); |
738 | internal_proto(si_max); | |
6de9cd9a | 739 | |
5e805e44 | 740 | extern int convert_real (st_parameter_dt *, void *, const char *, int); |
7d7b8bfe | 741 | internal_proto(convert_real); |
6de9cd9a | 742 | |
458653cc JDA |
743 | extern int convert_infnan (st_parameter_dt *, void *, const char *, int); |
744 | internal_proto(convert_infnan); | |
745 | ||
5e805e44 | 746 | extern void read_a (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 747 | internal_proto(read_a); |
6de9cd9a | 748 | |
cea93abb JD |
749 | extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int); |
750 | internal_proto(read_a); | |
751 | ||
5e805e44 | 752 | extern void read_f (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 753 | internal_proto(read_f); |
6de9cd9a | 754 | |
5e805e44 | 755 | extern void read_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 756 | internal_proto(read_l); |
6de9cd9a | 757 | |
5e805e44 | 758 | extern void read_x (st_parameter_dt *, int); |
7d7b8bfe | 759 | internal_proto(read_x); |
6de9cd9a | 760 | |
5e805e44 | 761 | extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); |
7d7b8bfe | 762 | internal_proto(read_radix); |
6de9cd9a | 763 | |
5e805e44 | 764 | extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 765 | internal_proto(read_decimal); |
6de9cd9a | 766 | |
e73d3ca6 PT |
767 | extern void read_user_defined (st_parameter_dt *, void *); |
768 | internal_proto(read_user_defined); | |
769 | ||
770 | extern void read_user_defined (st_parameter_dt *, void *); | |
771 | internal_proto(read_user_defined); | |
772 | ||
6de9cd9a DN |
773 | /* list_read.c */ |
774 | ||
5e805e44 JJ |
775 | extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, |
776 | size_t); | |
7d7b8bfe | 777 | internal_proto(list_formatted_read); |
6de9cd9a | 778 | |
5e805e44 | 779 | extern void finish_list_read (st_parameter_dt *); |
7d7b8bfe | 780 | internal_proto(finish_list_read); |
6de9cd9a | 781 | |
5e805e44 | 782 | extern void namelist_read (st_parameter_dt *); |
7d7b8bfe | 783 | internal_proto(namelist_read); |
6de9cd9a | 784 | |
5e805e44 | 785 | extern void namelist_write (st_parameter_dt *); |
7d7b8bfe | 786 | internal_proto(namelist_write); |
6de9cd9a DN |
787 | |
788 | /* write.c */ | |
789 | ||
5e805e44 | 790 | extern void write_a (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 791 | internal_proto(write_a); |
6de9cd9a | 792 | |
cea93abb JD |
793 | extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int); |
794 | internal_proto(write_a_char4); | |
795 | ||
5e805e44 | 796 | extern void write_b (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 797 | internal_proto(write_b); |
6de9cd9a | 798 | |
5e805e44 | 799 | extern void write_d (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 800 | internal_proto(write_d); |
6de9cd9a | 801 | |
5e805e44 | 802 | extern void write_e (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 803 | internal_proto(write_e); |
6de9cd9a | 804 | |
5e805e44 | 805 | extern void write_en (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 806 | internal_proto(write_en); |
6de9cd9a | 807 | |
5e805e44 | 808 | extern void write_es (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 809 | internal_proto(write_es); |
6de9cd9a | 810 | |
5e805e44 | 811 | extern void write_f (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 812 | internal_proto(write_f); |
6de9cd9a | 813 | |
5e805e44 | 814 | extern void write_i (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 815 | internal_proto(write_i); |
6de9cd9a | 816 | |
5e805e44 | 817 | extern void write_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 818 | internal_proto(write_l); |
6de9cd9a | 819 | |
5e805e44 | 820 | extern void write_o (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 821 | internal_proto(write_o); |
6de9cd9a | 822 | |
9355110f JD |
823 | extern void write_real (st_parameter_dt *, const char *, int); |
824 | internal_proto(write_real); | |
825 | ||
900e887f JD |
826 | extern void write_real_g0 (st_parameter_dt *, const char *, int, int); |
827 | internal_proto(write_real_g0); | |
828 | ||
5e805e44 | 829 | extern void write_x (st_parameter_dt *, int, int); |
7d7b8bfe | 830 | internal_proto(write_x); |
6de9cd9a | 831 | |
5e805e44 | 832 | extern void write_z (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 833 | internal_proto(write_z); |
6de9cd9a | 834 | |
e73d3ca6 PT |
835 | extern void write_user_defined (st_parameter_dt *, void *); |
836 | internal_proto(write_user_defined); | |
837 | ||
838 | extern void write_user_defined (st_parameter_dt *, void *); | |
839 | internal_proto(write_user_defined); | |
840 | ||
5e805e44 JJ |
841 | extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, |
842 | size_t); | |
7d7b8bfe | 843 | internal_proto(list_formatted_write); |
6de9cd9a | 844 | |
e5ef4b3b JB |
845 | /* size_from_kind.c */ |
846 | extern size_t size_from_real_kind (int); | |
847 | internal_proto(size_from_real_kind); | |
848 | ||
849 | extern size_t size_from_complex_kind (int); | |
850 | internal_proto(size_from_complex_kind); | |
851 | ||
7812c78c | 852 | |
5e805e44 JJ |
853 | /* lock.c */ |
854 | extern void free_ionml (st_parameter_dt *); | |
855 | internal_proto(free_ionml); | |
856 | ||
857 | static inline void | |
858 | inc_waiting_locked (gfc_unit *u) | |
859 | { | |
860 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
861 | (void) __sync_fetch_and_add (&u->waiting, 1); | |
862 | #else | |
863 | u->waiting++; | |
864 | #endif | |
865 | } | |
866 | ||
867 | static inline int | |
868 | predec_waiting_locked (gfc_unit *u) | |
869 | { | |
870 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
871 | return __sync_add_and_fetch (&u->waiting, -1); | |
872 | #else | |
873 | return --u->waiting; | |
874 | #endif | |
875 | } | |
876 | ||
877 | static inline void | |
878 | dec_waiting_unlocked (gfc_unit *u) | |
879 | { | |
880 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
881 | (void) __sync_fetch_and_add (&u->waiting, -1); | |
882 | #else | |
883 | __gthread_mutex_lock (&unit_lock); | |
884 | u->waiting--; | |
885 | __gthread_mutex_unlock (&unit_lock); | |
886 | #endif | |
887 | } | |
888 | ||
992b0aa1 JB |
889 | |
890 | static inline void | |
891 | memset4 (gfc_char4_t *p, gfc_char4_t c, int k) | |
892 | { | |
893 | int j; | |
894 | for (j = 0; j < k; j++) | |
895 | *p++ = c; | |
896 | } | |
897 | ||
6de9cd9a | 898 | #endif |
eaa90d25 | 899 |