]>
Commit | Line | Data |
---|---|---|
8d9254fc | 1 | /* Copyright (C) 2002-2020 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 | |
60674b3f | 35 | #define gcc_unreachable() __builtin_unreachable () |
9cbecd06 JB |
36 | |
37 | /* POSIX 2008 specifies that the extended locale stuff is found in | |
38 | locale.h, but some systems have them in xlocale.h. */ | |
39 | ||
40 | #include <locale.h> | |
41 | ||
42 | #ifdef HAVE_XLOCALE_H | |
43 | #include <xlocale.h> | |
44 | #endif | |
45 | ||
46 | ||
92cbdb68 | 47 | /* Forward declarations. */ |
5e805e44 | 48 | struct st_parameter_dt; |
92cbdb68 JB |
49 | typedef struct stream stream; |
50 | struct fbuf; | |
51 | struct format_data; | |
52 | typedef struct fnode fnode; | |
53 | struct gfc_unit; | |
6de9cd9a | 54 | |
9cbecd06 JB |
55 | #ifdef HAVE_NEWLOCALE |
56 | /* We have POSIX 2008 extended locale stuff. */ | |
57 | extern locale_t c_locale; | |
58 | internal_proto(c_locale); | |
59 | #else | |
60 | extern char* old_locale; | |
61 | internal_proto(old_locale); | |
62 | extern int old_locale_ctr; | |
63 | internal_proto(old_locale_ctr); | |
64 | extern __gthread_mutex_t old_locale_lock; | |
65 | internal_proto(old_locale_lock); | |
66 | #endif | |
67 | ||
82b8244c | 68 | |
d10fb73e JD |
69 | /* Macros for testing what kinds of I/O we are doing. */ |
70 | ||
71 | #define is_array_io(dtp) ((dtp)->internal_unit_desc) | |
72 | ||
7b39e3c2 | 73 | #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal) |
d10fb73e JD |
74 | |
75 | #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) | |
76 | ||
4a8d4422 | 77 | #define is_char4_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind == 4) |
c7421e06 | 78 | |
965eec16 | 79 | /* The array_loop_spec contains the variables for the loops over index ranges |
44720bef | 80 | that are encountered. */ |
29dc5138 | 81 | |
965eec16 | 82 | typedef struct array_loop_spec |
29dc5138 | 83 | { |
29dc5138 | 84 | /* Index counter for this dimension. */ |
44720bef | 85 | index_type idx; |
6de9cd9a | 86 | |
29dc5138 | 87 | /* Start for the index counter. */ |
44720bef | 88 | index_type start; |
29dc5138 PT |
89 | |
90 | /* End for the index counter. */ | |
44720bef | 91 | index_type end; |
29dc5138 PT |
92 | |
93 | /* Step for the index counter. */ | |
44720bef | 94 | index_type step; |
29dc5138 | 95 | } |
965eec16 JD |
96 | array_loop_spec; |
97 | ||
e73d3ca6 PT |
98 | /* User defined input/output iomsg length. */ |
99 | ||
100 | #define IOMSG_LEN 256 | |
101 | ||
102 | /* Subroutine formatted_dtio (struct, unit, iotype, v_list, iostat, | |
103 | iomsg, (_iotype), (_iomsg)) */ | |
636b78f0 JD |
104 | typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *, |
105 | gfc_full_array_i4 *, | |
e73d3ca6 PT |
106 | GFC_INTEGER_4 *, char *, |
107 | gfc_charlen_type, gfc_charlen_type); | |
108 | ||
109 | /* Subroutine unformatted_dtio (struct, unit, iostat, iomsg, (_iomsg)) */ | |
110 | typedef void (*unformatted_dtio)(void *, GFC_INTEGER_4 *, GFC_INTEGER_4 *, | |
111 | char *, gfc_charlen_type); | |
112 | ||
113 | /* The dtio calls for namelist require a CLASS object to be built. */ | |
114 | typedef struct gfc_class | |
115 | { | |
116 | void *data; | |
117 | void *vptr; | |
118 | index_type len; | |
119 | } | |
120 | gfc_class; | |
121 | ||
122 | ||
eea58adb | 123 | /* A structure to build a hash table for format data. */ |
7812c78c | 124 | |
92cbdb68 | 125 | #define FORMAT_HASH_SIZE 16 |
7812c78c JD |
126 | |
127 | typedef struct format_hash_entry | |
128 | { | |
129 | char *key; | |
130 | gfc_charlen_type key_len; | |
131 | struct format_data *hashed_fmt; | |
132 | } | |
133 | format_hash_entry; | |
134 | ||
67732fbc JD |
135 | /* Format tokens. Only about half of these can be stored in the |
136 | format nodes. */ | |
137 | ||
138 | typedef enum | |
139 | { | |
140 | FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, | |
141 | FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, | |
142 | FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, | |
143 | FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, | |
144 | FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, | |
145 | FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT | |
146 | } | |
147 | format_token; | |
148 | ||
965eec16 | 149 | /* Representation of a namelist object in libgfortran |
29dc5138 | 150 | |
965eec16 JD |
151 | Namelist Records |
152 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ | |
153 | or | |
154 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END | |
155 | ||
8b6dba81 | 156 | The object can be a fully qualified, compound name for an intrinsic |
965eec16 JD |
157 | type, derived types or derived type components. So, a substring |
158 | a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist | |
159 | read. Hence full information about the structure of the object has | |
160 | to be available to list_read.c and write. | |
161 | ||
162 | These requirements are met by the following data structures. | |
163 | ||
164 | namelist_info type contains all the scalar information about the | |
165 | object and arrays of descriptor_dimension and array_loop_spec types for | |
29dc5138 | 166 | arrays. */ |
6de9cd9a DN |
167 | |
168 | typedef struct namelist_type | |
169 | { | |
a11930ba JD |
170 | /* Object type. */ |
171 | bt type; | |
29dc5138 PT |
172 | |
173 | /* Object name. */ | |
6de9cd9a | 174 | char * var_name; |
29dc5138 PT |
175 | |
176 | /* Address for the start of the object's data. */ | |
6de9cd9a | 177 | void * mem_pos; |
29dc5138 | 178 | |
e73d3ca6 PT |
179 | /* Address of specific DTIO subroutine. */ |
180 | void * dtio_sub; | |
181 | ||
182 | /* Address of vtable if dtio_sub non-null. */ | |
183 | void * vtable; | |
184 | ||
29dc5138 PT |
185 | /* Flag to show that a read is to be attempted for this node. */ |
186 | int touched; | |
187 | ||
188 | /* Length of intrinsic type in bytes. */ | |
6de9cd9a | 189 | int len; |
29dc5138 PT |
190 | |
191 | /* Rank of the object. */ | |
192 | int var_rank; | |
193 | ||
194 | /* Overall size of the object in bytes. */ | |
195 | index_type size; | |
196 | ||
197 | /* Length of character string. */ | |
198 | index_type string_length; | |
199 | ||
200 | descriptor_dimension * dim; | |
965eec16 | 201 | array_loop_spec * ls; |
6de9cd9a DN |
202 | struct namelist_type * next; |
203 | } | |
204 | namelist_info; | |
205 | ||
206 | /* Options for the OPEN statement. */ | |
207 | ||
208 | typedef enum | |
91b30ee5 | 209 | { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, |
6de9cd9a DN |
210 | ACCESS_UNSPECIFIED |
211 | } | |
212 | unit_access; | |
213 | ||
214 | typedef enum | |
215 | { ACTION_READ, ACTION_WRITE, ACTION_READWRITE, | |
216 | ACTION_UNSPECIFIED | |
217 | } | |
218 | unit_action; | |
219 | ||
220 | typedef enum | |
221 | { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED } | |
222 | unit_blank; | |
223 | ||
224 | typedef enum | |
225 | { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE, | |
226 | DELIM_UNSPECIFIED | |
227 | } | |
228 | unit_delim; | |
229 | ||
230 | typedef enum | |
231 | { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED } | |
232 | unit_form; | |
233 | ||
234 | typedef enum | |
235 | { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND, | |
236 | POSITION_UNSPECIFIED | |
237 | } | |
238 | unit_position; | |
239 | ||
240 | typedef enum | |
241 | { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH, | |
242 | STATUS_REPLACE, STATUS_UNSPECIFIED | |
243 | } | |
244 | unit_status; | |
245 | ||
246 | typedef enum | |
247 | { PAD_YES, PAD_NO, PAD_UNSPECIFIED } | |
248 | unit_pad; | |
249 | ||
10256cbe JD |
250 | typedef enum |
251 | { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } | |
252 | unit_decimal; | |
253 | ||
254 | typedef enum | |
255 | { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } | |
256 | unit_encoding; | |
257 | ||
258 | typedef enum | |
82a4f54c TB |
259 | { ROUND_UP = GFC_FPE_UPWARD, |
260 | ROUND_DOWN = GFC_FPE_DOWNWARD, | |
261 | ROUND_ZERO = GFC_FPE_TOWARDZERO, | |
262 | ROUND_NEAREST = GFC_FPE_TONEAREST, | |
263 | ROUND_COMPATIBLE = 10, /* round away from zero. */ | |
264 | ROUND_PROCDEFINED, /* Here as ROUND_NEAREST. */ | |
265 | ROUND_UNSPECIFIED /* Should never occur. */ | |
266 | } | |
10256cbe JD |
267 | unit_round; |
268 | ||
269 | /* NOTE: unit_sign must correspond with the sign_status enumerator in | |
270 | st_parameter_dt to not break the ABI. */ | |
271 | typedef enum | |
272 | { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } | |
273 | unit_sign; | |
274 | ||
6de9cd9a DN |
275 | typedef enum |
276 | { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } | |
277 | unit_advance; | |
278 | ||
55948b69 | 279 | typedef enum |
1060d940 | 280 | {READING, WRITING, LIST_READING, LIST_WRITING} |
55948b69 | 281 | unit_mode; |
6de9cd9a | 282 | |
10256cbe | 283 | typedef enum |
931149a6 | 284 | { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } |
10256cbe JD |
285 | unit_async; |
286 | ||
0ef33d44 FR |
287 | typedef enum |
288 | { SHARE_DENYRW, SHARE_DENYNONE, | |
289 | SHARE_UNSPECIFIED | |
290 | } | |
291 | unit_share; | |
292 | ||
293 | typedef enum | |
294 | { CC_LIST, CC_FORTRAN, CC_NONE, | |
295 | CC_UNSPECIFIED | |
296 | } | |
297 | unit_cc; | |
298 | ||
299 | /* End-of-record types for CC_FORTRAN. */ | |
300 | typedef enum | |
301 | { CCF_DEFAULT=0x0, | |
302 | CCF_OVERPRINT=0x1, | |
303 | CCF_ONE_LF=0x2, | |
304 | CCF_TWO_LF=0x4, | |
305 | CCF_PAGE_FEED=0x8, | |
306 | CCF_PROMPT=0x10, | |
307 | CCF_OVERPRINT_NOA=0x20, | |
308 | } /* 6 bits */ | |
309 | cc_fortran; | |
310 | ||
d7445152 JD |
311 | typedef enum |
312 | { SIGN_S, SIGN_SS, SIGN_SP } | |
313 | unit_sign_s; | |
314 | ||
0ef33d44 FR |
315 | /* Make sure to keep st_parameter_* in sync with gcc/fortran/ioparm.def. */ |
316 | ||
5e805e44 JJ |
317 | #define CHARACTER1(name) \ |
318 | char * name; \ | |
319 | gfc_charlen_type name ## _len | |
320 | #define CHARACTER2(name) \ | |
321 | gfc_charlen_type name ## _len; \ | |
322 | char * name | |
323 | ||
6de9cd9a DN |
324 | typedef struct |
325 | { | |
5e805e44 | 326 | st_parameter_common common; |
831cf09d | 327 | GFC_IO_INT recl_in; |
5e805e44 JJ |
328 | CHARACTER2 (file); |
329 | CHARACTER1 (status); | |
330 | CHARACTER2 (access); | |
331 | CHARACTER1 (form); | |
332 | CHARACTER2 (blank); | |
333 | CHARACTER1 (position); | |
334 | CHARACTER2 (action); | |
335 | CHARACTER1 (delim); | |
336 | CHARACTER2 (pad); | |
181c9f4a | 337 | CHARACTER1 (convert); |
10256cbe JD |
338 | CHARACTER2 (decimal); |
339 | CHARACTER1 (encoding); | |
340 | CHARACTER2 (round); | |
341 | CHARACTER1 (sign); | |
342 | CHARACTER2 (asynchronous); | |
dcfddbd4 | 343 | GFC_INTEGER_4 *newunit; |
0ef33d44 FR |
344 | GFC_INTEGER_4 readonly; |
345 | CHARACTER2 (cc); | |
346 | CHARACTER1 (share); | |
5e805e44 JJ |
347 | } |
348 | st_parameter_open; | |
6de9cd9a | 349 | |
5e805e44 | 350 | #define IOPARM_CLOSE_HAS_STATUS (1 << 7) |
6de9cd9a | 351 | |
5e805e44 JJ |
352 | typedef struct |
353 | { | |
354 | st_parameter_common common; | |
355 | CHARACTER1 (status); | |
356 | } | |
357 | st_parameter_close; | |
6de9cd9a | 358 | |
5e805e44 JJ |
359 | typedef struct |
360 | { | |
361 | st_parameter_common common; | |
362 | } | |
363 | st_parameter_filepos; | |
364 | ||
365 | #define IOPARM_INQUIRE_HAS_EXIST (1 << 7) | |
366 | #define IOPARM_INQUIRE_HAS_OPENED (1 << 8) | |
367 | #define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) | |
368 | #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) | |
369 | #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) | |
370 | #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) | |
91b30ee5 JD |
371 | #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) |
372 | #define IOPARM_INQUIRE_HAS_FILE (1 << 14) | |
373 | #define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) | |
374 | #define IOPARM_INQUIRE_HAS_FORM (1 << 16) | |
375 | #define IOPARM_INQUIRE_HAS_BLANK (1 << 17) | |
376 | #define IOPARM_INQUIRE_HAS_POSITION (1 << 18) | |
377 | #define IOPARM_INQUIRE_HAS_ACTION (1 << 19) | |
378 | #define IOPARM_INQUIRE_HAS_DELIM (1 << 20) | |
379 | #define IOPARM_INQUIRE_HAS_PAD (1 << 21) | |
380 | #define IOPARM_INQUIRE_HAS_NAME (1 << 22) | |
381 | #define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) | |
382 | #define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) | |
383 | #define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) | |
384 | #define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) | |
385 | #define IOPARM_INQUIRE_HAS_READ (1 << 27) | |
386 | #define IOPARM_INQUIRE_HAS_WRITE (1 << 28) | |
387 | #define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) | |
388 | #define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) | |
76b88c5f | 389 | #define IOPARM_INQUIRE_HAS_FLAGS2 (1u << 31) |
10256cbe JD |
390 | |
391 | #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) | |
392 | #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) | |
393 | #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) | |
e1456843 JJ |
394 | #define IOPARM_INQUIRE_HAS_ROUND (1 << 3) |
395 | #define IOPARM_INQUIRE_HAS_SIGN (1 << 4) | |
396 | #define IOPARM_INQUIRE_HAS_PENDING (1 << 5) | |
10256cbe JD |
397 | #define IOPARM_INQUIRE_HAS_SIZE (1 << 6) |
398 | #define IOPARM_INQUIRE_HAS_ID (1 << 7) | |
797332ed | 399 | #define IOPARM_INQUIRE_HAS_IQSTREAM (1 << 8) |
0ef33d44 FR |
400 | #define IOPARM_INQUIRE_HAS_SHARE (1 << 9) |
401 | #define IOPARM_INQUIRE_HAS_CC (1 << 10) | |
b8d5e926 | 402 | |
5e805e44 JJ |
403 | typedef struct |
404 | { | |
405 | st_parameter_common common; | |
406 | GFC_INTEGER_4 *exist, *opened, *number, *named; | |
a7037861 | 407 | GFC_IO_INT *nextrec, *recl_out, *strm_pos_out; |
5e805e44 JJ |
408 | CHARACTER1 (file); |
409 | CHARACTER2 (access); | |
410 | CHARACTER1 (form); | |
411 | CHARACTER2 (blank); | |
412 | CHARACTER1 (position); | |
413 | CHARACTER2 (action); | |
414 | CHARACTER1 (delim); | |
415 | CHARACTER2 (pad); | |
416 | CHARACTER1 (name); | |
417 | CHARACTER2 (sequential); | |
418 | CHARACTER1 (direct); | |
419 | CHARACTER2 (formatted); | |
420 | CHARACTER1 (unformatted); | |
421 | CHARACTER2 (read); | |
422 | CHARACTER1 (write); | |
423 | CHARACTER2 (readwrite); | |
181c9f4a | 424 | CHARACTER1 (convert); |
10256cbe JD |
425 | GFC_INTEGER_4 flags2; |
426 | CHARACTER1 (asynchronous); | |
931149a6 | 427 | CHARACTER2 (decimal); |
10256cbe | 428 | CHARACTER1 (encoding); |
e1456843 JJ |
429 | CHARACTER2 (round); |
430 | CHARACTER1 (sign); | |
431 | GFC_INTEGER_4 *pending; | |
260f179b | 432 | GFC_IO_INT *size; |
931149a6 | 433 | GFC_INTEGER_4 *id; |
797332ed | 434 | CHARACTER1 (iqstream); |
0ef33d44 FR |
435 | CHARACTER2 (share); |
436 | CHARACTER1 (cc); | |
5e805e44 JJ |
437 | } |
438 | st_parameter_inquire; | |
439 | ||
5e805e44 JJ |
440 | |
441 | #define IOPARM_DT_LIST_FORMAT (1 << 7) | |
442 | #define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) | |
443 | #define IOPARM_DT_HAS_REC (1 << 9) | |
444 | #define IOPARM_DT_HAS_SIZE (1 << 10) | |
445 | #define IOPARM_DT_HAS_IOLENGTH (1 << 11) | |
446 | #define IOPARM_DT_HAS_FORMAT (1 << 12) | |
447 | #define IOPARM_DT_HAS_ADVANCE (1 << 13) | |
448 | #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) | |
449 | #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) | |
10256cbe JD |
450 | #define IOPARM_DT_HAS_ID (1 << 16) |
451 | #define IOPARM_DT_HAS_POS (1 << 17) | |
452 | #define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) | |
453 | #define IOPARM_DT_HAS_BLANK (1 << 19) | |
454 | #define IOPARM_DT_HAS_DECIMAL (1 << 20) | |
455 | #define IOPARM_DT_HAS_DELIM (1 << 21) | |
456 | #define IOPARM_DT_HAS_PAD (1 << 22) | |
457 | #define IOPARM_DT_HAS_ROUND (1 << 23) | |
458 | #define IOPARM_DT_HAS_SIGN (1 << 24) | |
d7445152 | 459 | #define IOPARM_DT_HAS_F2003 (1 << 25) |
4a8d4422 | 460 | #define IOPARM_DT_HAS_UDTIO (1 << 26) |
7ee4f6f3 | 461 | #define IOPARM_DT_DEC_EXT (1 << 27) |
5e805e44 | 462 | /* Internal use bit. */ |
76b88c5f | 463 | #define IOPARM_DT_IONML_SET (1u << 31) |
5e805e44 | 464 | |
d7445152 | 465 | |
d7445152 JD |
466 | typedef struct st_parameter_dt |
467 | { | |
468 | st_parameter_common common; | |
469 | GFC_IO_INT rec; | |
470 | GFC_IO_INT *size, *iolength; | |
471 | gfc_array_char *internal_unit_desc; | |
472 | CHARACTER1 (format); | |
473 | CHARACTER2 (advance); | |
474 | CHARACTER1 (internal_unit); | |
475 | CHARACTER2 (namelist_name); | |
13926b24 JD |
476 | GFC_INTEGER_4 *id; |
477 | GFC_IO_INT pos; | |
478 | CHARACTER1 (asynchronous); | |
479 | CHARACTER2 (blank); | |
480 | CHARACTER1 (decimal); | |
481 | CHARACTER2 (delim); | |
482 | CHARACTER1 (pad); | |
483 | CHARACTER2 (round); | |
484 | CHARACTER1 (sign); | |
5e805e44 JJ |
485 | /* Private part of the structure. The compiler just needs |
486 | to reserve enough space. */ | |
487 | union | |
488 | { | |
e1456843 JJ |
489 | struct |
490 | { | |
491 | void (*transfer) (struct st_parameter_dt *, bt, void *, int, | |
492 | size_t, size_t); | |
493 | struct gfc_unit *current_unit; | |
494 | /* Item number in a formatted data transfer. Also used in namelist | |
495 | read_logical as an index into line_buffer. */ | |
496 | int item_count; | |
497 | unit_mode mode; | |
498 | unit_blank blank_status; | |
499 | unit_sign sign_status; | |
500 | int scale_factor; | |
13926b24 JD |
501 | /* Maximum righthand column written to. */ |
502 | int max_pos; | |
e1456843 JJ |
503 | /* Number of skips + spaces to be done for T and X-editing. */ |
504 | int skips; | |
505 | /* Number of spaces to be done for T and X-editing. */ | |
506 | int pending_spaces; | |
507 | /* Whether an EOR condition was encountered. Value is: | |
508 | 0 if no EOR was encountered | |
509 | 1 if an EOR was encountered due to a 1-byte marker (LF) | |
510 | 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ | |
511 | int sf_seen_eor; | |
512 | unit_advance advance_status; | |
513 | unsigned reversion_flag : 1; /* Format reversion has occurred. */ | |
514 | unsigned first_item : 1; | |
515 | unsigned seen_dollar : 1; | |
516 | unsigned eor_condition : 1; | |
517 | unsigned no_leading_blank : 1; | |
518 | unsigned char_flag : 1; | |
519 | unsigned input_complete : 1; | |
520 | unsigned at_eol : 1; | |
521 | unsigned comma_flag : 1; | |
522 | /* A namelist specific flag used in the list directed library | |
eea58adb | 523 | to flag that calls are being made from namelist read (e.g. to |
e1456843 JJ |
524 | ignore comments or to treat '/' as a terminator) */ |
525 | unsigned namelist_mode : 1; | |
526 | /* A namelist specific flag used in the list directed library | |
527 | to flag read errors and return, so that an attempt can be | |
528 | made to read a new object name. */ | |
529 | unsigned nml_read_error : 1; | |
530 | /* A sequential formatted read specific flag used to signal that a | |
531 | character string is being read so don't use commas to shorten a | |
532 | formatted field width. */ | |
533 | unsigned sf_read_comma : 1; | |
534 | /* A namelist specific flag used to enable reading input from | |
535 | line_buffer for logical reads. */ | |
536 | unsigned line_buffer_enabled : 1; | |
537 | /* An internal unit specific flag used to identify that the associated | |
538 | unit is internal. */ | |
539 | unsigned unit_is_internal : 1; | |
540 | /* An internal unit specific flag to signify an EOF condition for list | |
541 | directed read. */ | |
542 | unsigned at_eof : 1; | |
50220190 JD |
543 | /* Used for g0 floating point output. */ |
544 | unsigned g0_no_blanks : 1; | |
2418d0e0 JD |
545 | /* Used to signal use of free_format_data. */ |
546 | unsigned format_not_saved : 1; | |
2558e2e8 JD |
547 | /* A flag used to identify when a non-standard expanded namelist read |
548 | has occurred. */ | |
549 | unsigned expanded_read : 1; | |
2b4c9065 NK |
550 | /* Flag to indicate if the statement has async="YES". */ |
551 | unsigned async : 1; | |
552 | /* 12 unused bits. */ | |
e1456843 | 553 | |
1f10d710 | 554 | int child_saved_iostat; |
13926b24 | 555 | int nml_delim; |
e1456843 JJ |
556 | int repeat_count; |
557 | int saved_length; | |
558 | int saved_used; | |
559 | bt saved_type; | |
560 | char *saved_string; | |
561 | char *scratch; | |
562 | char *line_buffer; | |
563 | struct format_data *fmt; | |
e1456843 | 564 | namelist_info *ionml; |
9cbecd06 JB |
565 | #ifdef HAVE_NEWLOCALE |
566 | locale_t old_locale; | |
567 | #endif | |
2558e2e8 JD |
568 | /* Current position within the look-ahead line buffer. */ |
569 | int line_buffer_pos; | |
60c063fa JB |
570 | /* Storage area for values except for strings. Must be |
571 | large enough to hold a complex value (two reals) of the | |
6b680210 JB |
572 | largest kind. */ |
573 | char value[32]; | |
8b729f5c | 574 | GFC_IO_INT not_used; /* Needed for alignment. */ |
e73d3ca6 PT |
575 | formatted_dtio fdtio_ptr; |
576 | unformatted_dtio ufdtio_ptr; | |
0ef33d44 FR |
577 | /* With CC_FORTRAN, the first character of a record determines the |
578 | style of record end (and start) to use. We must mark down the type | |
579 | when we write first in write_a so we remember the end type later in | |
580 | next_record_w. */ | |
581 | struct | |
582 | { | |
583 | unsigned type : 6; /* See enum cc_fortran. */ | |
584 | unsigned len : 2; /* Always 0, 1, or 2. */ | |
585 | /* The union is updated after start-of-record is written. */ | |
586 | union | |
587 | { | |
588 | char start; /* Output character for start of record. */ | |
589 | char end; /* Output character for end of record. */ | |
590 | } u; | |
591 | } cc; | |
e1456843 | 592 | } p; |
ebf85e50 JJ |
593 | /* This pad size must be equal to the pad_size declared in |
594 | trans-io.c (gfc_build_io_library_fndecls). The above structure | |
595 | must be smaller or equal to this array. */ | |
e1456843 | 596 | char pad[16 * sizeof (char *) + 32 * sizeof (int)]; |
5e805e44 | 597 | } u; |
6de9cd9a | 598 | } |
5e805e44 | 599 | st_parameter_dt; |
6de9cd9a | 600 | |
ebf85e50 JJ |
601 | /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */ |
602 | extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) | |
603 | >= sizeof (((st_parameter_dt *) 0)->u.p) | |
604 | ? 1 : -1]; | |
605 | ||
10256cbe JD |
606 | #define IOPARM_WAIT_HAS_ID (1 << 7) |
607 | ||
608 | typedef struct | |
609 | { | |
610 | st_parameter_common common; | |
2b4c9065 | 611 | GFC_INTEGER_4 *id; |
10256cbe JD |
612 | } |
613 | st_parameter_wait; | |
614 | ||
615 | ||
5e805e44 JJ |
616 | #undef CHARACTER1 |
617 | #undef CHARACTER2 | |
6de9cd9a DN |
618 | |
619 | typedef struct | |
620 | { | |
621 | unit_access access; | |
622 | unit_action action; | |
623 | unit_blank blank; | |
624 | unit_delim delim; | |
625 | unit_form form; | |
626 | int is_notpadded; | |
627 | unit_position position; | |
628 | unit_status status; | |
629 | unit_pad pad; | |
d7445152 JD |
630 | unit_convert convert; |
631 | int has_recl; | |
10256cbe JD |
632 | unit_decimal decimal; |
633 | unit_encoding encoding; | |
634 | unit_round round; | |
635 | unit_sign sign; | |
10256cbe | 636 | unit_async async; |
0ef33d44 FR |
637 | unit_share share; |
638 | unit_cc cc; | |
639 | int readonly; | |
6de9cd9a DN |
640 | } |
641 | unit_flags; | |
642 | ||
643 | ||
909087e0 | 644 | typedef struct gfc_unit |
6de9cd9a DN |
645 | { |
646 | int unit_number; | |
6de9cd9a | 647 | stream *s; |
965eec16 JD |
648 | |
649 | /* Treap links. */ | |
650 | struct gfc_unit *left, *right; | |
6de9cd9a DN |
651 | int priority; |
652 | ||
108bc190 TK |
653 | int read_bad, current_record, saved_pos, previous_nonadvancing_write; |
654 | ||
6de9cd9a DN |
655 | enum |
656 | { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } | |
657 | endfile; | |
658 | ||
5e805e44 | 659 | unit_mode mode; |
6de9cd9a | 660 | unit_flags flags; |
105b7136 JD |
661 | unit_pad pad_status; |
662 | unit_decimal decimal_status; | |
663 | unit_delim delim_status; | |
379924dd | 664 | unit_round round_status; |
5e805e44 | 665 | |
07b3bbf2 TK |
666 | /* recl -- Record length of the file. |
667 | last_record -- Last record number read or written | |
668 | maxrec -- Maximum record number in a direct access file | |
669 | bytes_left -- Bytes left in current record. | |
670 | strm_pos -- Current position in file for STREAM I/O. | |
671 | recl_subrecord -- Maximum length for subrecord. | |
672 | bytes_left_subrecord -- Bytes left in current subrecord. */ | |
673 | gfc_offset recl, last_record, maxrec, bytes_left, strm_pos, | |
674 | recl_subrecord, bytes_left_subrecord; | |
675 | ||
676 | /* Set to 1 if we have read a subrecord. */ | |
677 | ||
678 | int continued; | |
6de9cd9a | 679 | |
2b4c9065 NK |
680 | /* Contains the pointer to the async unit. */ |
681 | struct async_unit *au; | |
682 | ||
5e805e44 JJ |
683 | __gthread_mutex_t lock; |
684 | /* Number of threads waiting to acquire this unit's lock. | |
685 | When non-zero, close_unit doesn't only removes the unit | |
686 | from the UNIT_ROOT tree, but doesn't free it and the | |
687 | last of the waiting threads will do that. | |
688 | This must be either atomically increased/decreased, or | |
689 | always guarded by UNIT_LOCK. */ | |
690 | int waiting; | |
691 | /* Flag set by close_unit if the unit as been closed. | |
692 | Must be manipulated under unit's lock. */ | |
693 | int closed; | |
694 | ||
965eec16 JD |
695 | /* For traversing arrays */ |
696 | array_loop_spec *ls; | |
697 | int rank; | |
5e805e44 | 698 | |
0e05c303 JB |
699 | /* Name of the file at the time OPEN was executed, as a |
700 | null-terminated C string. */ | |
701 | char *filename; | |
7812c78c JD |
702 | |
703 | /* The format hash table. */ | |
704 | struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE]; | |
15877a88 JB |
705 | |
706 | /* Formatting buffer. */ | |
707 | struct fbuf *fbuf; | |
d428be77 JD |
708 | |
709 | /* Function pointer, points to list_read worker functions. */ | |
710 | int (*next_char_fn_ptr) (st_parameter_dt *); | |
711 | void (*push_char_fn_ptr) (st_parameter_dt *, int); | |
e73d3ca6 | 712 | |
4a8d4422 JD |
713 | /* Internal unit char string data. */ |
714 | char * internal_unit; | |
715 | gfc_charlen_type internal_unit_len; | |
716 | gfc_array_char *string_unit_desc; | |
717 | int internal_unit_kind; | |
718 | ||
e73d3ca6 PT |
719 | /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */ |
720 | int child_dtio; | |
1f10d710 JD |
721 | |
722 | /* Used for ungetc() style functionality. Possible values | |
723 | are an unsigned char, EOF, or EOF - 1 used to mark the | |
724 | field as not valid. */ | |
e73d3ca6 | 725 | int last_char; |
c680ada5 JD |
726 | bool has_size; |
727 | GFC_IO_INT size_used; | |
6de9cd9a | 728 | } |
909087e0 | 729 | gfc_unit; |
6de9cd9a | 730 | |
4a8d4422 JD |
731 | typedef struct gfc_saved_unit |
732 | { | |
733 | GFC_INTEGER_4 unit_number; | |
734 | gfc_unit *unit; | |
735 | } | |
736 | gfc_saved_unit; | |
10c682a0 | 737 | |
b9233944 JB |
738 | /* TEMP_FAILURE_RETRY macro from glibc. */ |
739 | ||
740 | #ifndef TEMP_FAILURE_RETRY | |
741 | /* Evaluate EXPRESSION, and repeat as long as it returns -1 with `errno' | |
742 | set to EINTR. */ | |
743 | ||
744 | # define TEMP_FAILURE_RETRY(expression) \ | |
745 | (__extension__ \ | |
746 | ({ long int __result; \ | |
747 | do __result = (long int) (expression); \ | |
748 | while (__result == -1L && errno == EINTR); \ | |
749 | __result; })) | |
750 | #endif | |
751 | ||
752 | ||
6de9cd9a DN |
753 | /* unit.c */ |
754 | ||
5e805e44 JJ |
755 | /* Maximum file offset, computed at library initialization time. */ |
756 | extern gfc_offset max_offset; | |
757 | internal_proto(max_offset); | |
758 | ||
67c24a8b JB |
759 | /* Default RECL for sequential access if not given in OPEN statement, |
760 | computed at library initialization time. */ | |
761 | extern gfc_offset default_recl; | |
762 | internal_proto(default_recl); | |
763 | ||
5e805e44 JJ |
764 | /* Unit tree root. */ |
765 | extern gfc_unit *unit_root; | |
766 | internal_proto(unit_root); | |
767 | ||
768 | extern __gthread_mutex_t unit_lock; | |
769 | internal_proto(unit_lock); | |
6de9cd9a | 770 | |
7d7b8bfe RH |
771 | extern int close_unit (gfc_unit *); |
772 | internal_proto(close_unit); | |
6de9cd9a | 773 | |
4a8d4422 JD |
774 | extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int); |
775 | internal_proto(set_internal_unit); | |
54ffdb12 | 776 | |
4a8d4422 JD |
777 | extern void stash_internal_unit (st_parameter_dt *); |
778 | internal_proto(stash_internal_unit); | |
91b30ee5 | 779 | |
7d7b8bfe RH |
780 | extern gfc_unit *find_unit (int); |
781 | internal_proto(find_unit); | |
6de9cd9a | 782 | |
5e805e44 | 783 | extern gfc_unit *find_or_create_unit (int); |
59c0928b | 784 | internal_proto(find_or_create_unit); |
5e805e44 JJ |
785 | |
786 | extern gfc_unit *get_unit (st_parameter_dt *, int); | |
7d7b8bfe | 787 | internal_proto(get_unit); |
6de9cd9a | 788 | |
8c098567 | 789 | extern void unlock_unit(gfc_unit *); |
5e805e44 JJ |
790 | internal_proto(unlock_unit); |
791 | ||
108bc190 | 792 | extern void finish_last_advance_record (gfc_unit *u); |
8c098567 | 793 | internal_proto(finish_last_advance_record); |
108bc190 | 794 | |
8c098567 JD |
795 | extern int unit_truncate(gfc_unit *, gfc_offset, st_parameter_common *); |
796 | internal_proto(unit_truncate); | |
7812c78c | 797 | |
c04d4ede JB |
798 | extern int newunit_alloc (void); |
799 | internal_proto(newunit_alloc); | |
800 | ||
8c098567 JD |
801 | extern void newunit_free (int); |
802 | internal_proto(newunit_free); | |
803 | ||
dcfddbd4 | 804 | |
6de9cd9a DN |
805 | /* open.c */ |
806 | ||
5e805e44 | 807 | extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); |
7d7b8bfe | 808 | internal_proto(new_unit); |
6de9cd9a | 809 | |
7812c78c | 810 | |
6de9cd9a DN |
811 | /* transfer.c */ |
812 | ||
813 | #define SCRATCH_SIZE 300 | |
814 | ||
7d7b8bfe RH |
815 | extern const char *type_name (bt); |
816 | internal_proto(type_name); | |
6de9cd9a | 817 | |
ea99ec5b | 818 | extern void * read_block_form (st_parameter_dt *, size_t *); |
15877a88 | 819 | internal_proto(read_block_form); |
6de9cd9a | 820 | |
ea99ec5b | 821 | extern void * read_block_form4 (st_parameter_dt *, size_t *); |
74db2a47 JD |
822 | internal_proto(read_block_form4); |
823 | ||
ea99ec5b | 824 | extern void *write_block (st_parameter_dt *, size_t); |
7d7b8bfe | 825 | internal_proto(write_block); |
6de9cd9a | 826 | |
9370b3c0 TK |
827 | extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *, |
828 | int*); | |
965eec16 JD |
829 | internal_proto(next_array_record); |
830 | ||
9370b3c0 TK |
831 | extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *, |
832 | gfc_offset *); | |
965eec16 JD |
833 | internal_proto(init_loop_spec); |
834 | ||
5e805e44 | 835 | extern void next_record (st_parameter_dt *, int); |
7d7b8bfe | 836 | internal_proto(next_record); |
6de9cd9a | 837 | |
10256cbe | 838 | extern void st_wait (st_parameter_wait *); |
2b4c9065 NK |
839 | export_proto (st_wait); |
840 | ||
841 | extern void st_wait_async (st_parameter_wait *); | |
842 | export_proto (st_wait_async); | |
10256cbe | 843 | |
7812c78c JD |
844 | extern void hit_eof (st_parameter_dt *); |
845 | internal_proto(hit_eof); | |
846 | ||
2b4c9065 NK |
847 | extern void transfer_array_inner (st_parameter_dt *, gfc_array_char *, int, |
848 | gfc_charlen_type); | |
849 | internal_proto (transfer_array_inner); | |
850 | ||
6de9cd9a DN |
851 | /* read.c */ |
852 | ||
32aa3bff | 853 | extern void set_integer (void *, GFC_INTEGER_LARGEST, int); |
7d7b8bfe | 854 | internal_proto(set_integer); |
6de9cd9a | 855 | |
80b91c0b JB |
856 | extern GFC_UINTEGER_LARGEST si_max (int); |
857 | internal_proto(si_max); | |
6de9cd9a | 858 | |
5e805e44 | 859 | extern int convert_real (st_parameter_dt *, void *, const char *, int); |
7d7b8bfe | 860 | internal_proto(convert_real); |
6de9cd9a | 861 | |
458653cc JDA |
862 | extern int convert_infnan (st_parameter_dt *, void *, const char *, int); |
863 | internal_proto(convert_infnan); | |
864 | ||
ea99ec5b | 865 | extern void read_a (st_parameter_dt *, const fnode *, char *, size_t); |
7d7b8bfe | 866 | internal_proto(read_a); |
6de9cd9a | 867 | |
ea99ec5b | 868 | extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, size_t); |
cea93abb JD |
869 | internal_proto(read_a); |
870 | ||
5e805e44 | 871 | extern void read_f (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 872 | internal_proto(read_f); |
6de9cd9a | 873 | |
5e805e44 | 874 | extern void read_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 875 | internal_proto(read_l); |
6de9cd9a | 876 | |
ea99ec5b | 877 | extern void read_x (st_parameter_dt *, size_t); |
7d7b8bfe | 878 | internal_proto(read_x); |
6de9cd9a | 879 | |
5e805e44 | 880 | extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); |
7d7b8bfe | 881 | internal_proto(read_radix); |
6de9cd9a | 882 | |
5e805e44 | 883 | extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 884 | internal_proto(read_decimal); |
6de9cd9a | 885 | |
e73d3ca6 PT |
886 | extern void read_user_defined (st_parameter_dt *, void *); |
887 | internal_proto(read_user_defined); | |
888 | ||
889 | extern void read_user_defined (st_parameter_dt *, void *); | |
890 | internal_proto(read_user_defined); | |
891 | ||
6de9cd9a DN |
892 | /* list_read.c */ |
893 | ||
5e805e44 JJ |
894 | extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, |
895 | size_t); | |
7d7b8bfe | 896 | internal_proto(list_formatted_read); |
6de9cd9a | 897 | |
5e805e44 | 898 | extern void finish_list_read (st_parameter_dt *); |
7d7b8bfe | 899 | internal_proto(finish_list_read); |
6de9cd9a | 900 | |
5e805e44 | 901 | extern void namelist_read (st_parameter_dt *); |
7d7b8bfe | 902 | internal_proto(namelist_read); |
6de9cd9a | 903 | |
5e805e44 | 904 | extern void namelist_write (st_parameter_dt *); |
7d7b8bfe | 905 | internal_proto(namelist_write); |
6de9cd9a DN |
906 | |
907 | /* write.c */ | |
908 | ||
ea99ec5b | 909 | extern void write_a (st_parameter_dt *, const fnode *, const char *, size_t); |
7d7b8bfe | 910 | internal_proto(write_a); |
6de9cd9a | 911 | |
ea99ec5b | 912 | extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, size_t); |
cea93abb JD |
913 | internal_proto(write_a_char4); |
914 | ||
5e805e44 | 915 | extern void write_b (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 916 | internal_proto(write_b); |
6de9cd9a | 917 | |
5e805e44 | 918 | extern void write_d (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 919 | internal_proto(write_d); |
6de9cd9a | 920 | |
5e805e44 | 921 | extern void write_e (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 922 | internal_proto(write_e); |
6de9cd9a | 923 | |
5e805e44 | 924 | extern void write_en (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 925 | internal_proto(write_en); |
6de9cd9a | 926 | |
5e805e44 | 927 | extern void write_es (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 928 | internal_proto(write_es); |
6de9cd9a | 929 | |
5e805e44 | 930 | extern void write_f (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 931 | internal_proto(write_f); |
6de9cd9a | 932 | |
5e805e44 | 933 | extern void write_i (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 934 | internal_proto(write_i); |
6de9cd9a | 935 | |
5e805e44 | 936 | extern void write_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 937 | internal_proto(write_l); |
6de9cd9a | 938 | |
5e805e44 | 939 | extern void write_o (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 940 | internal_proto(write_o); |
6de9cd9a | 941 | |
9355110f JD |
942 | extern void write_real (st_parameter_dt *, const char *, int); |
943 | internal_proto(write_real); | |
944 | ||
67732fbc JD |
945 | extern void write_real_w0 (st_parameter_dt *, const char *, int, format_token, int); |
946 | internal_proto(write_real_w0); | |
900e887f | 947 | |
5e805e44 | 948 | extern void write_x (st_parameter_dt *, int, int); |
7d7b8bfe | 949 | internal_proto(write_x); |
6de9cd9a | 950 | |
5e805e44 | 951 | extern void write_z (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 952 | internal_proto(write_z); |
6de9cd9a | 953 | |
e73d3ca6 PT |
954 | extern void write_user_defined (st_parameter_dt *, void *); |
955 | internal_proto(write_user_defined); | |
956 | ||
957 | extern void write_user_defined (st_parameter_dt *, void *); | |
958 | internal_proto(write_user_defined); | |
959 | ||
5e805e44 JJ |
960 | extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, |
961 | size_t); | |
7d7b8bfe | 962 | internal_proto(list_formatted_write); |
6de9cd9a | 963 | |
e5ef4b3b JB |
964 | /* size_from_kind.c */ |
965 | extern size_t size_from_real_kind (int); | |
966 | internal_proto(size_from_real_kind); | |
967 | ||
968 | extern size_t size_from_complex_kind (int); | |
969 | internal_proto(size_from_complex_kind); | |
970 | ||
7812c78c | 971 | |
5e805e44 JJ |
972 | /* lock.c */ |
973 | extern void free_ionml (st_parameter_dt *); | |
974 | internal_proto(free_ionml); | |
975 | ||
976 | static inline void | |
977 | inc_waiting_locked (gfc_unit *u) | |
978 | { | |
0536d5b3 JB |
979 | #ifdef HAVE_ATOMIC_FETCH_ADD |
980 | (void) __atomic_fetch_add (&u->waiting, 1, __ATOMIC_RELAXED); | |
5e805e44 JJ |
981 | #else |
982 | u->waiting++; | |
983 | #endif | |
984 | } | |
985 | ||
986 | static inline int | |
987 | predec_waiting_locked (gfc_unit *u) | |
988 | { | |
0536d5b3 JB |
989 | #ifdef HAVE_ATOMIC_FETCH_ADD |
990 | /* Note that the pattern | |
991 | ||
992 | if (predec_waiting_locked (u) == 0) | |
993 | // destroy u | |
994 | ||
995 | could be further optimized by making this be an __ATOMIC_RELEASE, | |
996 | and then inserting a | |
997 | ||
998 | __atomic_thread_fence (__ATOMIC_ACQUIRE); | |
999 | ||
1000 | inside the branch before destroying. But for now, lets keep it | |
1001 | simple. */ | |
1002 | return __atomic_add_fetch (&u->waiting, -1, __ATOMIC_ACQ_REL); | |
5e805e44 JJ |
1003 | #else |
1004 | return --u->waiting; | |
1005 | #endif | |
1006 | } | |
1007 | ||
1008 | static inline void | |
1009 | dec_waiting_unlocked (gfc_unit *u) | |
1010 | { | |
0536d5b3 JB |
1011 | #ifdef HAVE_ATOMIC_FETCH_ADD |
1012 | (void) __atomic_fetch_add (&u->waiting, -1, __ATOMIC_RELAXED); | |
5e805e44 JJ |
1013 | #else |
1014 | __gthread_mutex_lock (&unit_lock); | |
1015 | u->waiting--; | |
1016 | __gthread_mutex_unlock (&unit_lock); | |
1017 | #endif | |
1018 | } | |
1019 | ||
992b0aa1 JB |
1020 | |
1021 | static inline void | |
1022 | memset4 (gfc_char4_t *p, gfc_char4_t c, int k) | |
1023 | { | |
1024 | int j; | |
1025 | for (j = 0; j < k; j++) | |
1026 | *p++ = c; | |
1027 | } | |
1028 | ||
88a8126a JB |
1029 | /* Used in width fields to indicate that the default should be used */ |
1030 | #define DEFAULT_WIDTH -1 | |
1031 | ||
1032 | /* Defaults for certain format field descriptors. These are decided based on | |
1033 | * the type of the value being formatted. | |
1034 | * | |
1035 | * The behaviour here is modelled on the Oracle Fortran compiler. At the time | |
1036 | * of writing, the details were available at this URL: | |
1037 | * | |
1038 | * https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d | |
1039 | */ | |
1040 | ||
1041 | static inline int | |
1042 | default_width_for_integer (int kind) | |
1043 | { | |
1044 | switch (kind) | |
1045 | { | |
1046 | case 1: | |
1047 | case 2: return 7; | |
1048 | case 4: return 12; | |
1049 | case 8: return 23; | |
1050 | case 16: return 44; | |
1051 | default: return 0; | |
1052 | } | |
1053 | } | |
1054 | ||
1055 | static inline int | |
1056 | default_width_for_float (int kind) | |
1057 | { | |
1058 | switch (kind) | |
1059 | { | |
1060 | case 4: return 15; | |
1061 | case 8: return 25; | |
1062 | case 16: return 42; | |
1063 | default: return 0; | |
1064 | } | |
1065 | } | |
1066 | ||
1067 | static inline int | |
1068 | default_precision_for_float (int kind) | |
1069 | { | |
1070 | switch (kind) | |
1071 | { | |
1072 | case 4: return 7; | |
1073 | case 8: return 16; | |
1074 | case 16: return 33; | |
1075 | default: return 0; | |
1076 | } | |
1077 | } | |
1078 | ||
6de9cd9a | 1079 | #endif |
eaa90d25 | 1080 | |
2b4c9065 NK |
1081 | extern void |
1082 | st_write_done_worker (st_parameter_dt *); | |
1083 | internal_proto (st_write_done_worker); | |
1084 | ||
1085 | extern void | |
1086 | st_read_done_worker (st_parameter_dt *); | |
1087 | internal_proto (st_read_done_worker); | |
1088 | ||
1089 | extern void | |
1090 | data_transfer_init_worker (st_parameter_dt *, int); | |
1091 | internal_proto (data_transfer_init_worker); |