|
145
|
1 /* Copyright (C) 2002-2020 Free Software Foundation, Inc.
|
|
111
|
2 Contributed by Andy Vaught
|
|
|
3 F2003 I/O support contributed by Jerry DeLisle
|
|
|
4
|
|
|
5 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
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
|
|
|
9 the Free Software Foundation; either version 3, or (at your option)
|
|
|
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
|
|
|
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/>. */
|
|
|
25
|
|
|
26 #ifndef GFOR_IO_H
|
|
|
27 #define GFOR_IO_H
|
|
|
28
|
|
|
29 /* IO library include. */
|
|
|
30
|
|
|
31 #include "libgfortran.h"
|
|
|
32
|
|
|
33 #include <gthr.h>
|
|
|
34
|
|
145
|
35 #define gcc_unreachable() __builtin_unreachable ()
|
|
111
|
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
|
|
|
47 /* Forward declarations. */
|
|
|
48 struct st_parameter_dt;
|
|
|
49 typedef struct stream stream;
|
|
|
50 struct fbuf;
|
|
|
51 struct format_data;
|
|
|
52 typedef struct fnode fnode;
|
|
|
53 struct gfc_unit;
|
|
|
54
|
|
|
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
|
|
|
68
|
|
|
69 /* Macros for testing what kinds of I/O we are doing. */
|
|
|
70
|
|
|
71 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
|
|
|
72
|
|
131
|
73 #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
|
|
111
|
74
|
|
|
75 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
|
|
|
76
|
|
|
77 #define is_char4_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind == 4)
|
|
|
78
|
|
|
79 /* The array_loop_spec contains the variables for the loops over index ranges
|
|
|
80 that are encountered. */
|
|
|
81
|
|
|
82 typedef struct array_loop_spec
|
|
|
83 {
|
|
|
84 /* Index counter for this dimension. */
|
|
|
85 index_type idx;
|
|
|
86
|
|
|
87 /* Start for the index counter. */
|
|
|
88 index_type start;
|
|
|
89
|
|
|
90 /* End for the index counter. */
|
|
|
91 index_type end;
|
|
|
92
|
|
|
93 /* Step for the index counter. */
|
|
|
94 index_type step;
|
|
|
95 }
|
|
|
96 array_loop_spec;
|
|
|
97
|
|
|
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)) */
|
|
131
|
104 typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *,
|
|
|
105 gfc_full_array_i4 *,
|
|
111
|
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
|
|
|
123 /* A structure to build a hash table for format data. */
|
|
|
124
|
|
|
125 #define FORMAT_HASH_SIZE 16
|
|
|
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
|
|
145
|
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
|
|
111
|
149 /* Representation of a namelist object in libgfortran
|
|
|
150
|
|
|
151 Namelist Records
|
|
|
152 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
|
|
|
153 or
|
|
|
154 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
|
|
|
155
|
|
|
156 The object can be a fully qualified, compound name for an intrinsic
|
|
|
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
|
|
|
166 arrays. */
|
|
|
167
|
|
|
168 typedef struct namelist_type
|
|
|
169 {
|
|
|
170 /* Object type. */
|
|
|
171 bt type;
|
|
|
172
|
|
|
173 /* Object name. */
|
|
|
174 char * var_name;
|
|
|
175
|
|
|
176 /* Address for the start of the object's data. */
|
|
|
177 void * mem_pos;
|
|
|
178
|
|
|
179 /* Address of specific DTIO subroutine. */
|
|
|
180 void * dtio_sub;
|
|
|
181
|
|
|
182 /* Address of vtable if dtio_sub non-null. */
|
|
|
183 void * vtable;
|
|
|
184
|
|
|
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. */
|
|
|
189 int len;
|
|
|
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;
|
|
|
201 array_loop_spec * ls;
|
|
|
202 struct namelist_type * next;
|
|
|
203 }
|
|
|
204 namelist_info;
|
|
|
205
|
|
|
206 /* Options for the OPEN statement. */
|
|
|
207
|
|
|
208 typedef enum
|
|
|
209 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
|
|
|
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
|
|
|
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
|
|
|
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 }
|
|
|
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
|
|
|
275 typedef enum
|
|
|
276 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
|
|
|
277 unit_advance;
|
|
|
278
|
|
|
279 typedef enum
|
|
|
280 {READING, WRITING, LIST_READING, LIST_WRITING}
|
|
|
281 unit_mode;
|
|
|
282
|
|
|
283 typedef enum
|
|
|
284 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
|
|
|
285 unit_async;
|
|
|
286
|
|
|
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
|
|
|
311 typedef enum
|
|
|
312 { SIGN_S, SIGN_SS, SIGN_SP }
|
|
|
313 unit_sign_s;
|
|
|
314
|
|
|
315 /* Make sure to keep st_parameter_* in sync with gcc/fortran/ioparm.def. */
|
|
|
316
|
|
|
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
|
|
|
324 typedef struct
|
|
|
325 {
|
|
|
326 st_parameter_common common;
|
|
131
|
327 GFC_IO_INT recl_in;
|
|
111
|
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);
|
|
|
337 CHARACTER1 (convert);
|
|
|
338 CHARACTER2 (decimal);
|
|
|
339 CHARACTER1 (encoding);
|
|
|
340 CHARACTER2 (round);
|
|
|
341 CHARACTER1 (sign);
|
|
|
342 CHARACTER2 (asynchronous);
|
|
|
343 GFC_INTEGER_4 *newunit;
|
|
|
344 GFC_INTEGER_4 readonly;
|
|
|
345 CHARACTER2 (cc);
|
|
|
346 CHARACTER1 (share);
|
|
|
347 }
|
|
|
348 st_parameter_open;
|
|
|
349
|
|
|
350 #define IOPARM_CLOSE_HAS_STATUS (1 << 7)
|
|
|
351
|
|
|
352 typedef struct
|
|
|
353 {
|
|
|
354 st_parameter_common common;
|
|
|
355 CHARACTER1 (status);
|
|
|
356 }
|
|
|
357 st_parameter_close;
|
|
|
358
|
|
|
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)
|
|
|
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)
|
|
|
389 #define IOPARM_INQUIRE_HAS_FLAGS2 (1u << 31)
|
|
|
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)
|
|
|
394 #define IOPARM_INQUIRE_HAS_ROUND (1 << 3)
|
|
|
395 #define IOPARM_INQUIRE_HAS_SIGN (1 << 4)
|
|
|
396 #define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
|
|
|
397 #define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
|
|
|
398 #define IOPARM_INQUIRE_HAS_ID (1 << 7)
|
|
|
399 #define IOPARM_INQUIRE_HAS_IQSTREAM (1 << 8)
|
|
|
400 #define IOPARM_INQUIRE_HAS_SHARE (1 << 9)
|
|
|
401 #define IOPARM_INQUIRE_HAS_CC (1 << 10)
|
|
|
402
|
|
|
403 typedef struct
|
|
|
404 {
|
|
|
405 st_parameter_common common;
|
|
|
406 GFC_INTEGER_4 *exist, *opened, *number, *named;
|
|
131
|
407 GFC_IO_INT *nextrec, *recl_out, *strm_pos_out;
|
|
111
|
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);
|
|
|
424 CHARACTER1 (convert);
|
|
|
425 GFC_INTEGER_4 flags2;
|
|
|
426 CHARACTER1 (asynchronous);
|
|
|
427 CHARACTER2 (decimal);
|
|
|
428 CHARACTER1 (encoding);
|
|
|
429 CHARACTER2 (round);
|
|
|
430 CHARACTER1 (sign);
|
|
|
431 GFC_INTEGER_4 *pending;
|
|
|
432 GFC_IO_INT *size;
|
|
|
433 GFC_INTEGER_4 *id;
|
|
|
434 CHARACTER1 (iqstream);
|
|
|
435 CHARACTER2 (share);
|
|
|
436 CHARACTER1 (cc);
|
|
|
437 }
|
|
|
438 st_parameter_inquire;
|
|
|
439
|
|
|
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)
|
|
|
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)
|
|
|
459 #define IOPARM_DT_HAS_F2003 (1 << 25)
|
|
|
460 #define IOPARM_DT_HAS_UDTIO (1 << 26)
|
|
131
|
461 #define IOPARM_DT_DEC_EXT (1 << 27)
|
|
111
|
462 /* Internal use bit. */
|
|
|
463 #define IOPARM_DT_IONML_SET (1u << 31)
|
|
|
464
|
|
|
465
|
|
|
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);
|
|
|
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);
|
|
|
485 /* Private part of the structure. The compiler just needs
|
|
|
486 to reserve enough space. */
|
|
|
487 union
|
|
|
488 {
|
|
|
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;
|
|
|
501 /* Maximum righthand column written to. */
|
|
|
502 int max_pos;
|
|
|
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
|
|
|
523 to flag that calls are being made from namelist read (e.g. to
|
|
|
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;
|
|
|
543 /* Used for g0 floating point output. */
|
|
|
544 unsigned g0_no_blanks : 1;
|
|
|
545 /* Used to signal use of free_format_data. */
|
|
|
546 unsigned format_not_saved : 1;
|
|
|
547 /* A flag used to identify when a non-standard expanded namelist read
|
|
|
548 has occurred. */
|
|
|
549 unsigned expanded_read : 1;
|
|
131
|
550 /* Flag to indicate if the statement has async="YES". */
|
|
|
551 unsigned async : 1;
|
|
|
552 /* 12 unused bits. */
|
|
111
|
553
|
|
|
554 int child_saved_iostat;
|
|
|
555 int nml_delim;
|
|
|
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;
|
|
|
564 namelist_info *ionml;
|
|
|
565 #ifdef HAVE_NEWLOCALE
|
|
|
566 locale_t old_locale;
|
|
|
567 #endif
|
|
|
568 /* Current position within the look-ahead line buffer. */
|
|
|
569 int line_buffer_pos;
|
|
|
570 /* Storage area for values except for strings. Must be
|
|
|
571 large enough to hold a complex value (two reals) of the
|
|
|
572 largest kind. */
|
|
|
573 char value[32];
|
|
|
574 GFC_IO_INT not_used; /* Needed for alignment. */
|
|
|
575 formatted_dtio fdtio_ptr;
|
|
|
576 unformatted_dtio ufdtio_ptr;
|
|
|
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;
|
|
|
592 } p;
|
|
|
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. */
|
|
|
596 char pad[16 * sizeof (char *) + 32 * sizeof (int)];
|
|
|
597 } u;
|
|
|
598 }
|
|
|
599 st_parameter_dt;
|
|
|
600
|
|
|
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
|
|
|
606 #define IOPARM_WAIT_HAS_ID (1 << 7)
|
|
|
607
|
|
|
608 typedef struct
|
|
|
609 {
|
|
|
610 st_parameter_common common;
|
|
131
|
611 GFC_INTEGER_4 *id;
|
|
111
|
612 }
|
|
|
613 st_parameter_wait;
|
|
|
614
|
|
|
615
|
|
|
616 #undef CHARACTER1
|
|
|
617 #undef CHARACTER2
|
|
|
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;
|
|
|
630 unit_convert convert;
|
|
|
631 int has_recl;
|
|
|
632 unit_decimal decimal;
|
|
|
633 unit_encoding encoding;
|
|
|
634 unit_round round;
|
|
|
635 unit_sign sign;
|
|
|
636 unit_async async;
|
|
|
637 unit_share share;
|
|
|
638 unit_cc cc;
|
|
|
639 int readonly;
|
|
|
640 }
|
|
|
641 unit_flags;
|
|
|
642
|
|
|
643
|
|
|
644 typedef struct gfc_unit
|
|
|
645 {
|
|
|
646 int unit_number;
|
|
|
647 stream *s;
|
|
|
648
|
|
|
649 /* Treap links. */
|
|
|
650 struct gfc_unit *left, *right;
|
|
|
651 int priority;
|
|
|
652
|
|
|
653 int read_bad, current_record, saved_pos, previous_nonadvancing_write;
|
|
|
654
|
|
|
655 enum
|
|
|
656 { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
|
|
|
657 endfile;
|
|
|
658
|
|
|
659 unit_mode mode;
|
|
|
660 unit_flags flags;
|
|
|
661 unit_pad pad_status;
|
|
|
662 unit_decimal decimal_status;
|
|
|
663 unit_delim delim_status;
|
|
|
664 unit_round round_status;
|
|
|
665
|
|
|
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;
|
|
|
679
|
|
131
|
680 /* Contains the pointer to the async unit. */
|
|
|
681 struct async_unit *au;
|
|
|
682
|
|
111
|
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
|
|
|
695 /* For traversing arrays */
|
|
|
696 array_loop_spec *ls;
|
|
|
697 int rank;
|
|
|
698
|
|
|
699 /* Name of the file at the time OPEN was executed, as a
|
|
|
700 null-terminated C string. */
|
|
|
701 char *filename;
|
|
|
702
|
|
|
703 /* The format hash table. */
|
|
|
704 struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
|
|
|
705
|
|
|
706 /* Formatting buffer. */
|
|
|
707 struct fbuf *fbuf;
|
|
|
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);
|
|
|
712
|
|
|
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
|
|
|
719 /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */
|
|
|
720 int child_dtio;
|
|
|
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. */
|
|
|
725 int last_char;
|
|
|
726 bool has_size;
|
|
|
727 GFC_IO_INT size_used;
|
|
|
728 }
|
|
|
729 gfc_unit;
|
|
|
730
|
|
|
731 typedef struct gfc_saved_unit
|
|
|
732 {
|
|
|
733 GFC_INTEGER_4 unit_number;
|
|
|
734 gfc_unit *unit;
|
|
|
735 }
|
|
|
736 gfc_saved_unit;
|
|
|
737
|
|
|
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
|
|
|
753 /* unit.c */
|
|
|
754
|
|
|
755 /* Maximum file offset, computed at library initialization time. */
|
|
|
756 extern gfc_offset max_offset;
|
|
|
757 internal_proto(max_offset);
|
|
|
758
|
|
131
|
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
|
|
111
|
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);
|
|
|
770
|
|
|
771 extern int close_unit (gfc_unit *);
|
|
|
772 internal_proto(close_unit);
|
|
|
773
|
|
|
774 extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int);
|
|
|
775 internal_proto(set_internal_unit);
|
|
|
776
|
|
|
777 extern void stash_internal_unit (st_parameter_dt *);
|
|
|
778 internal_proto(stash_internal_unit);
|
|
|
779
|
|
|
780 extern gfc_unit *find_unit (int);
|
|
|
781 internal_proto(find_unit);
|
|
|
782
|
|
|
783 extern gfc_unit *find_or_create_unit (int);
|
|
|
784 internal_proto(find_or_create_unit);
|
|
|
785
|
|
|
786 extern gfc_unit *get_unit (st_parameter_dt *, int);
|
|
|
787 internal_proto(get_unit);
|
|
|
788
|
|
131
|
789 extern void unlock_unit(gfc_unit *);
|
|
111
|
790 internal_proto(unlock_unit);
|
|
|
791
|
|
|
792 extern void finish_last_advance_record (gfc_unit *u);
|
|
131
|
793 internal_proto(finish_last_advance_record);
|
|
111
|
794
|
|
131
|
795 extern int unit_truncate(gfc_unit *, gfc_offset, st_parameter_common *);
|
|
|
796 internal_proto(unit_truncate);
|
|
111
|
797
|
|
|
798 extern int newunit_alloc (void);
|
|
|
799 internal_proto(newunit_alloc);
|
|
|
800
|
|
131
|
801 extern void newunit_free (int);
|
|
|
802 internal_proto(newunit_free);
|
|
|
803
|
|
111
|
804
|
|
|
805 /* open.c */
|
|
|
806
|
|
|
807 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
|
|
|
808 internal_proto(new_unit);
|
|
|
809
|
|
|
810
|
|
|
811 /* transfer.c */
|
|
|
812
|
|
|
813 #define SCRATCH_SIZE 300
|
|
|
814
|
|
|
815 extern const char *type_name (bt);
|
|
|
816 internal_proto(type_name);
|
|
|
817
|
|
131
|
818 extern void * read_block_form (st_parameter_dt *, size_t *);
|
|
111
|
819 internal_proto(read_block_form);
|
|
|
820
|
|
131
|
821 extern void * read_block_form4 (st_parameter_dt *, size_t *);
|
|
111
|
822 internal_proto(read_block_form4);
|
|
|
823
|
|
131
|
824 extern void *write_block (st_parameter_dt *, size_t);
|
|
111
|
825 internal_proto(write_block);
|
|
|
826
|
|
|
827 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
|
|
|
828 int*);
|
|
|
829 internal_proto(next_array_record);
|
|
|
830
|
|
|
831 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
|
|
|
832 gfc_offset *);
|
|
|
833 internal_proto(init_loop_spec);
|
|
|
834
|
|
|
835 extern void next_record (st_parameter_dt *, int);
|
|
|
836 internal_proto(next_record);
|
|
|
837
|
|
|
838 extern void st_wait (st_parameter_wait *);
|
|
131
|
839 export_proto (st_wait);
|
|
|
840
|
|
|
841 extern void st_wait_async (st_parameter_wait *);
|
|
|
842 export_proto (st_wait_async);
|
|
111
|
843
|
|
|
844 extern void hit_eof (st_parameter_dt *);
|
|
|
845 internal_proto(hit_eof);
|
|
|
846
|
|
131
|
847 extern void transfer_array_inner (st_parameter_dt *, gfc_array_char *, int,
|
|
|
848 gfc_charlen_type);
|
|
|
849 internal_proto (transfer_array_inner);
|
|
|
850
|
|
111
|
851 /* read.c */
|
|
|
852
|
|
|
853 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
|
|
|
854 internal_proto(set_integer);
|
|
|
855
|
|
|
856 extern GFC_UINTEGER_LARGEST si_max (int);
|
|
|
857 internal_proto(si_max);
|
|
|
858
|
|
|
859 extern int convert_real (st_parameter_dt *, void *, const char *, int);
|
|
|
860 internal_proto(convert_real);
|
|
|
861
|
|
|
862 extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
|
|
|
863 internal_proto(convert_infnan);
|
|
|
864
|
|
131
|
865 extern void read_a (st_parameter_dt *, const fnode *, char *, size_t);
|
|
111
|
866 internal_proto(read_a);
|
|
|
867
|
|
131
|
868 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, size_t);
|
|
111
|
869 internal_proto(read_a);
|
|
|
870
|
|
|
871 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
|
|
|
872 internal_proto(read_f);
|
|
|
873
|
|
|
874 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
|
|
|
875 internal_proto(read_l);
|
|
|
876
|
|
131
|
877 extern void read_x (st_parameter_dt *, size_t);
|
|
111
|
878 internal_proto(read_x);
|
|
|
879
|
|
|
880 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
|
|
|
881 internal_proto(read_radix);
|
|
|
882
|
|
|
883 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
|
|
|
884 internal_proto(read_decimal);
|
|
|
885
|
|
|
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
|
|
|
892 /* list_read.c */
|
|
|
893
|
|
|
894 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
|
|
|
895 size_t);
|
|
|
896 internal_proto(list_formatted_read);
|
|
|
897
|
|
|
898 extern void finish_list_read (st_parameter_dt *);
|
|
|
899 internal_proto(finish_list_read);
|
|
|
900
|
|
|
901 extern void namelist_read (st_parameter_dt *);
|
|
|
902 internal_proto(namelist_read);
|
|
|
903
|
|
|
904 extern void namelist_write (st_parameter_dt *);
|
|
|
905 internal_proto(namelist_write);
|
|
|
906
|
|
|
907 /* write.c */
|
|
|
908
|
|
131
|
909 extern void write_a (st_parameter_dt *, const fnode *, const char *, size_t);
|
|
111
|
910 internal_proto(write_a);
|
|
|
911
|
|
131
|
912 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, size_t);
|
|
111
|
913 internal_proto(write_a_char4);
|
|
|
914
|
|
|
915 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
916 internal_proto(write_b);
|
|
|
917
|
|
|
918 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
919 internal_proto(write_d);
|
|
|
920
|
|
|
921 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
922 internal_proto(write_e);
|
|
|
923
|
|
|
924 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
925 internal_proto(write_en);
|
|
|
926
|
|
|
927 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
928 internal_proto(write_es);
|
|
|
929
|
|
|
930 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
931 internal_proto(write_f);
|
|
|
932
|
|
|
933 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
934 internal_proto(write_i);
|
|
|
935
|
|
|
936 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
|
|
|
937 internal_proto(write_l);
|
|
|
938
|
|
|
939 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
940 internal_proto(write_o);
|
|
|
941
|
|
|
942 extern void write_real (st_parameter_dt *, const char *, int);
|
|
|
943 internal_proto(write_real);
|
|
|
944
|
|
145
|
945 extern void write_real_w0 (st_parameter_dt *, const char *, int, const fnode*);
|
|
|
946 internal_proto(write_real_w0);
|
|
111
|
947
|
|
|
948 extern void write_x (st_parameter_dt *, int, int);
|
|
|
949 internal_proto(write_x);
|
|
|
950
|
|
|
951 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
|
|
|
952 internal_proto(write_z);
|
|
|
953
|
|
|
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
|
|
|
960 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
|
|
|
961 size_t);
|
|
|
962 internal_proto(list_formatted_write);
|
|
|
963
|
|
|
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
|
|
|
971
|
|
|
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 {
|
|
145
|
979 #ifdef HAVE_ATOMIC_FETCH_ADD
|
|
|
980 (void) __atomic_fetch_add (&u->waiting, 1, __ATOMIC_RELAXED);
|
|
111
|
981 #else
|
|
|
982 u->waiting++;
|
|
|
983 #endif
|
|
|
984 }
|
|
|
985
|
|
|
986 static inline int
|
|
|
987 predec_waiting_locked (gfc_unit *u)
|
|
|
988 {
|
|
145
|
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);
|
|
111
|
1003 #else
|
|
|
1004 return --u->waiting;
|
|
|
1005 #endif
|
|
|
1006 }
|
|
|
1007
|
|
|
1008 static inline void
|
|
|
1009 dec_waiting_unlocked (gfc_unit *u)
|
|
|
1010 {
|
|
145
|
1011 #ifdef HAVE_ATOMIC_FETCH_ADD
|
|
|
1012 (void) __atomic_fetch_add (&u->waiting, -1, __ATOMIC_RELAXED);
|
|
111
|
1013 #else
|
|
|
1014 __gthread_mutex_lock (&unit_lock);
|
|
|
1015 u->waiting--;
|
|
|
1016 __gthread_mutex_unlock (&unit_lock);
|
|
|
1017 #endif
|
|
|
1018 }
|
|
|
1019
|
|
|
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
|
|
145
|
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
|
|
111
|
1079 #endif
|
|
|
1080
|
|
131
|
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);
|
