]>
Commit | Line | Data |
---|---|---|
10256cbe | 1 | /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
9a7b6ea7 | 2 | Free Software Foundation, Inc. |
6de9cd9a | 3 | Contributed by Andy Vaught |
10256cbe | 4 | F2003 I/O support contributed by Jerry DeLisle |
6de9cd9a DN |
5 | |
6 | This file is part of the GNU Fortran 95 runtime library (libgfortran). | |
7 | ||
8 | Libgfortran is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 2, or (at your option) | |
11 | any later version. | |
12 | ||
13 | Libgfortran is distributed in the hope that it will be useful, | |
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | GNU General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with Libgfortran; see the file COPYING. If not, write to | |
fe2ae685 KC |
20 | the Free Software Foundation, 51 Franklin Street, Fifth Floor, |
21 | Boston, MA 02110-1301, USA. */ | |
6de9cd9a | 22 | |
57dea9f6 TM |
23 | /* As a special exception, if you link this library with other files, |
24 | some of which are compiled with GCC, to produce an executable, | |
25 | this library does not by itself cause the resulting executable | |
26 | to be covered by the GNU General Public License. | |
27 | This exception does not however invalidate any other reasons why | |
28 | the executable file might be covered by the GNU General Public License. */ | |
29 | ||
6de9cd9a DN |
30 | #ifndef GFOR_IO_H |
31 | #define GFOR_IO_H | |
32 | ||
33 | /* IO library include. */ | |
34 | ||
6de9cd9a | 35 | #include "libgfortran.h" |
73e5b024 | 36 | |
a0124624 | 37 | #include <setjmp.h> |
5e805e44 | 38 | #include <gthr.h> |
7d7b8bfe | 39 | |
6de9cd9a DN |
40 | /* Basic types used in data transfers. */ |
41 | ||
42 | typedef enum | |
43 | { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL, | |
44 | BT_COMPLEX | |
45 | } | |
46 | bt; | |
47 | ||
5e805e44 JJ |
48 | struct st_parameter_dt; |
49 | ||
6de9cd9a DN |
50 | typedef struct stream |
51 | { | |
15877a88 | 52 | char *(*alloc_w_at) (struct stream *, int *); |
7d7b8bfe RH |
53 | try (*sfree) (struct stream *); |
54 | try (*close) (struct stream *); | |
55 | try (*seek) (struct stream *, gfc_offset); | |
200809cb | 56 | try (*trunc) (struct stream *); |
0dc43461 JB |
57 | int (*read) (struct stream *, void *, size_t *); |
58 | int (*write) (struct stream *, const void *, size_t *); | |
82b8244c | 59 | try (*set) (struct stream *, int, size_t); |
6de9cd9a DN |
60 | } |
61 | stream; | |
62 | ||
10256cbe JD |
63 | typedef enum |
64 | { SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC } | |
65 | io_mode; | |
6de9cd9a DN |
66 | |
67 | /* Macros for doing file I/O given a stream. */ | |
68 | ||
69 | #define sfree(s) ((s)->sfree)(s) | |
70 | #define sclose(s) ((s)->close)(s) | |
71 | ||
15877a88 | 72 | #define salloc_w(s, len) ((s)->alloc_w_at)(s, len) |
6de9cd9a DN |
73 | |
74 | #define sseek(s, pos) ((s)->seek)(s, pos) | |
200809cb | 75 | #define struncate(s) ((s)->trunc)(s) |
0dc43461 JB |
76 | #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes) |
77 | #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes) | |
6de9cd9a | 78 | |
82b8244c JB |
79 | #define sset(s, c, n) ((s)->set)(s, c, n) |
80 | ||
d10fb73e JD |
81 | /* Macros for testing what kinds of I/O we are doing. */ |
82 | ||
83 | #define is_array_io(dtp) ((dtp)->internal_unit_desc) | |
84 | ||
85 | #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal) | |
86 | ||
87 | #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) | |
88 | ||
965eec16 | 89 | /* The array_loop_spec contains the variables for the loops over index ranges |
29dc5138 PT |
90 | that are encountered. Since the variables can be negative, ssize_t |
91 | is used. */ | |
92 | ||
965eec16 | 93 | typedef struct array_loop_spec |
29dc5138 | 94 | { |
29dc5138 PT |
95 | /* Index counter for this dimension. */ |
96 | ssize_t idx; | |
6de9cd9a | 97 | |
29dc5138 PT |
98 | /* Start for the index counter. */ |
99 | ssize_t start; | |
100 | ||
101 | /* End for the index counter. */ | |
102 | ssize_t end; | |
103 | ||
104 | /* Step for the index counter. */ | |
105 | ssize_t step; | |
106 | } | |
965eec16 JD |
107 | array_loop_spec; |
108 | ||
109 | /* Representation of a namelist object in libgfortran | |
29dc5138 | 110 | |
965eec16 JD |
111 | Namelist Records |
112 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ | |
113 | or | |
114 | &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END | |
115 | ||
8b6dba81 | 116 | The object can be a fully qualified, compound name for an intrinsic |
965eec16 JD |
117 | type, derived types or derived type components. So, a substring |
118 | a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist | |
119 | read. Hence full information about the structure of the object has | |
120 | to be available to list_read.c and write. | |
121 | ||
122 | These requirements are met by the following data structures. | |
123 | ||
124 | namelist_info type contains all the scalar information about the | |
125 | object and arrays of descriptor_dimension and array_loop_spec types for | |
29dc5138 | 126 | arrays. */ |
6de9cd9a DN |
127 | |
128 | typedef struct namelist_type | |
129 | { | |
29dc5138 PT |
130 | |
131 | /* Object type, stored as GFC_DTYPE_xxxx. */ | |
132 | bt type; | |
133 | ||
134 | /* Object name. */ | |
6de9cd9a | 135 | char * var_name; |
29dc5138 PT |
136 | |
137 | /* Address for the start of the object's data. */ | |
6de9cd9a | 138 | void * mem_pos; |
29dc5138 PT |
139 | |
140 | /* Flag to show that a read is to be attempted for this node. */ | |
141 | int touched; | |
142 | ||
143 | /* Length of intrinsic type in bytes. */ | |
6de9cd9a | 144 | int len; |
29dc5138 PT |
145 | |
146 | /* Rank of the object. */ | |
147 | int var_rank; | |
148 | ||
149 | /* Overall size of the object in bytes. */ | |
150 | index_type size; | |
151 | ||
152 | /* Length of character string. */ | |
153 | index_type string_length; | |
154 | ||
155 | descriptor_dimension * dim; | |
965eec16 | 156 | array_loop_spec * ls; |
6de9cd9a DN |
157 | struct namelist_type * next; |
158 | } | |
159 | namelist_info; | |
160 | ||
161 | /* Options for the OPEN statement. */ | |
162 | ||
163 | typedef enum | |
91b30ee5 | 164 | { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, |
6de9cd9a DN |
165 | ACCESS_UNSPECIFIED |
166 | } | |
167 | unit_access; | |
168 | ||
169 | typedef enum | |
170 | { ACTION_READ, ACTION_WRITE, ACTION_READWRITE, | |
171 | ACTION_UNSPECIFIED | |
172 | } | |
173 | unit_action; | |
174 | ||
175 | typedef enum | |
176 | { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED } | |
177 | unit_blank; | |
178 | ||
179 | typedef enum | |
180 | { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE, | |
181 | DELIM_UNSPECIFIED | |
182 | } | |
183 | unit_delim; | |
184 | ||
185 | typedef enum | |
186 | { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED } | |
187 | unit_form; | |
188 | ||
189 | typedef enum | |
190 | { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND, | |
191 | POSITION_UNSPECIFIED | |
192 | } | |
193 | unit_position; | |
194 | ||
195 | typedef enum | |
196 | { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH, | |
197 | STATUS_REPLACE, STATUS_UNSPECIFIED | |
198 | } | |
199 | unit_status; | |
200 | ||
201 | typedef enum | |
202 | { PAD_YES, PAD_NO, PAD_UNSPECIFIED } | |
203 | unit_pad; | |
204 | ||
10256cbe JD |
205 | typedef enum |
206 | { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } | |
207 | unit_decimal; | |
208 | ||
209 | typedef enum | |
210 | { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } | |
211 | unit_encoding; | |
212 | ||
213 | typedef enum | |
214 | { ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE, | |
215 | ROUND_PROCDEFINED, ROUND_UNSPECIFIED } | |
216 | unit_round; | |
217 | ||
218 | /* NOTE: unit_sign must correspond with the sign_status enumerator in | |
219 | st_parameter_dt to not break the ABI. */ | |
220 | typedef enum | |
221 | { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } | |
222 | unit_sign; | |
223 | ||
6de9cd9a DN |
224 | typedef enum |
225 | { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } | |
226 | unit_advance; | |
227 | ||
55948b69 BD |
228 | typedef enum |
229 | {READING, WRITING} | |
230 | unit_mode; | |
6de9cd9a | 231 | |
10256cbe | 232 | typedef enum |
931149a6 | 233 | { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } |
10256cbe JD |
234 | unit_async; |
235 | ||
d7445152 JD |
236 | typedef enum |
237 | { SIGN_S, SIGN_SS, SIGN_SP } | |
238 | unit_sign_s; | |
239 | ||
5e805e44 JJ |
240 | #define CHARACTER1(name) \ |
241 | char * name; \ | |
242 | gfc_charlen_type name ## _len | |
243 | #define CHARACTER2(name) \ | |
244 | gfc_charlen_type name ## _len; \ | |
245 | char * name | |
246 | ||
6de9cd9a DN |
247 | typedef struct |
248 | { | |
5e805e44 JJ |
249 | st_parameter_common common; |
250 | GFC_INTEGER_4 recl_in; | |
251 | CHARACTER2 (file); | |
252 | CHARACTER1 (status); | |
253 | CHARACTER2 (access); | |
254 | CHARACTER1 (form); | |
255 | CHARACTER2 (blank); | |
256 | CHARACTER1 (position); | |
257 | CHARACTER2 (action); | |
258 | CHARACTER1 (delim); | |
259 | CHARACTER2 (pad); | |
181c9f4a | 260 | CHARACTER1 (convert); |
10256cbe JD |
261 | CHARACTER2 (decimal); |
262 | CHARACTER1 (encoding); | |
263 | CHARACTER2 (round); | |
264 | CHARACTER1 (sign); | |
265 | CHARACTER2 (asynchronous); | |
5e805e44 JJ |
266 | } |
267 | st_parameter_open; | |
6de9cd9a | 268 | |
5e805e44 | 269 | #define IOPARM_CLOSE_HAS_STATUS (1 << 7) |
6de9cd9a | 270 | |
5e805e44 JJ |
271 | typedef struct |
272 | { | |
273 | st_parameter_common common; | |
274 | CHARACTER1 (status); | |
275 | } | |
276 | st_parameter_close; | |
6de9cd9a | 277 | |
5e805e44 JJ |
278 | typedef struct |
279 | { | |
280 | st_parameter_common common; | |
281 | } | |
282 | st_parameter_filepos; | |
283 | ||
284 | #define IOPARM_INQUIRE_HAS_EXIST (1 << 7) | |
285 | #define IOPARM_INQUIRE_HAS_OPENED (1 << 8) | |
286 | #define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) | |
287 | #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) | |
288 | #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) | |
289 | #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) | |
91b30ee5 JD |
290 | #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) |
291 | #define IOPARM_INQUIRE_HAS_FILE (1 << 14) | |
292 | #define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) | |
293 | #define IOPARM_INQUIRE_HAS_FORM (1 << 16) | |
294 | #define IOPARM_INQUIRE_HAS_BLANK (1 << 17) | |
295 | #define IOPARM_INQUIRE_HAS_POSITION (1 << 18) | |
296 | #define IOPARM_INQUIRE_HAS_ACTION (1 << 19) | |
297 | #define IOPARM_INQUIRE_HAS_DELIM (1 << 20) | |
298 | #define IOPARM_INQUIRE_HAS_PAD (1 << 21) | |
299 | #define IOPARM_INQUIRE_HAS_NAME (1 << 22) | |
300 | #define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) | |
301 | #define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) | |
302 | #define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) | |
303 | #define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) | |
304 | #define IOPARM_INQUIRE_HAS_READ (1 << 27) | |
305 | #define IOPARM_INQUIRE_HAS_WRITE (1 << 28) | |
306 | #define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) | |
307 | #define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) | |
10256cbe JD |
308 | #define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31) |
309 | ||
310 | #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) | |
311 | #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) | |
312 | #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) | |
313 | #define IOPARM_INQUIRE_HAS_PENDING (1 << 3) | |
314 | #define IOPARM_INQUIRE_HAS_ROUND (1 << 4) | |
315 | #define IOPARM_INQUIRE_HAS_SIGN (1 << 5) | |
316 | #define IOPARM_INQUIRE_HAS_SIZE (1 << 6) | |
317 | #define IOPARM_INQUIRE_HAS_ID (1 << 7) | |
b8d5e926 | 318 | |
5e805e44 JJ |
319 | typedef struct |
320 | { | |
321 | st_parameter_common common; | |
322 | GFC_INTEGER_4 *exist, *opened, *number, *named; | |
323 | GFC_INTEGER_4 *nextrec, *recl_out; | |
91b30ee5 | 324 | GFC_IO_INT *strm_pos_out; |
5e805e44 JJ |
325 | CHARACTER1 (file); |
326 | CHARACTER2 (access); | |
327 | CHARACTER1 (form); | |
328 | CHARACTER2 (blank); | |
329 | CHARACTER1 (position); | |
330 | CHARACTER2 (action); | |
331 | CHARACTER1 (delim); | |
332 | CHARACTER2 (pad); | |
333 | CHARACTER1 (name); | |
334 | CHARACTER2 (sequential); | |
335 | CHARACTER1 (direct); | |
336 | CHARACTER2 (formatted); | |
337 | CHARACTER1 (unformatted); | |
338 | CHARACTER2 (read); | |
339 | CHARACTER1 (write); | |
340 | CHARACTER2 (readwrite); | |
181c9f4a | 341 | CHARACTER1 (convert); |
10256cbe JD |
342 | GFC_INTEGER_4 flags2; |
343 | CHARACTER1 (asynchronous); | |
931149a6 | 344 | CHARACTER2 (decimal); |
10256cbe | 345 | CHARACTER1 (encoding); |
931149a6 | 346 | CHARACTER2 (pending); |
10256cbe | 347 | CHARACTER1 (round); |
931149a6 | 348 | CHARACTER2 (sign); |
10256cbe | 349 | GFC_INTEGER_4 *size; |
931149a6 | 350 | GFC_INTEGER_4 *id; |
5e805e44 JJ |
351 | } |
352 | st_parameter_inquire; | |
353 | ||
354 | struct gfc_unit; | |
355 | struct format_data; | |
356 | ||
357 | #define IOPARM_DT_LIST_FORMAT (1 << 7) | |
358 | #define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) | |
359 | #define IOPARM_DT_HAS_REC (1 << 9) | |
360 | #define IOPARM_DT_HAS_SIZE (1 << 10) | |
361 | #define IOPARM_DT_HAS_IOLENGTH (1 << 11) | |
362 | #define IOPARM_DT_HAS_FORMAT (1 << 12) | |
363 | #define IOPARM_DT_HAS_ADVANCE (1 << 13) | |
364 | #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) | |
365 | #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) | |
10256cbe JD |
366 | #define IOPARM_DT_HAS_ID (1 << 16) |
367 | #define IOPARM_DT_HAS_POS (1 << 17) | |
368 | #define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) | |
369 | #define IOPARM_DT_HAS_BLANK (1 << 19) | |
370 | #define IOPARM_DT_HAS_DECIMAL (1 << 20) | |
371 | #define IOPARM_DT_HAS_DELIM (1 << 21) | |
372 | #define IOPARM_DT_HAS_PAD (1 << 22) | |
373 | #define IOPARM_DT_HAS_ROUND (1 << 23) | |
374 | #define IOPARM_DT_HAS_SIGN (1 << 24) | |
d7445152 | 375 | #define IOPARM_DT_HAS_F2003 (1 << 25) |
5e805e44 JJ |
376 | /* Internal use bit. */ |
377 | #define IOPARM_DT_IONML_SET (1 << 31) | |
378 | ||
d7445152 JD |
379 | |
380 | typedef struct st_parameter_43 | |
381 | { | |
382 | void (*transfer) (struct st_parameter_dt *, bt, void *, int, | |
383 | size_t, size_t); | |
384 | struct gfc_unit *current_unit; | |
385 | /* Item number in a formatted data transfer. Also used in namelist | |
386 | read_logical as an index into line_buffer. */ | |
387 | int item_count; | |
388 | unit_mode mode; | |
389 | unit_blank blank_status; | |
390 | unit_sign sign_status; | |
391 | int scale_factor; | |
392 | int max_pos; /* Maximum righthand column written to. */ | |
393 | /* Number of skips + spaces to be done for T and X-editing. */ | |
394 | int skips; | |
395 | /* Number of spaces to be done for T and X-editing. */ | |
396 | int pending_spaces; | |
397 | /* Whether an EOR condition was encountered. Value is: | |
398 | 0 if no EOR was encountered | |
399 | 1 if an EOR was encountered due to a 1-byte marker (LF) | |
400 | 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ | |
401 | int sf_seen_eor; | |
402 | unit_advance advance_status; | |
403 | unsigned reversion_flag : 1; /* Format reversion has occurred. */ | |
404 | unsigned first_item : 1; | |
405 | unsigned seen_dollar : 1; | |
406 | unsigned eor_condition : 1; | |
407 | unsigned no_leading_blank : 1; | |
408 | unsigned char_flag : 1; | |
409 | unsigned input_complete : 1; | |
410 | unsigned at_eol : 1; | |
411 | unsigned comma_flag : 1; | |
412 | /* A namelist specific flag used in the list directed library | |
413 | to flag that calls are being made from namelist read (eg. to | |
414 | ignore comments or to treat '/' as a terminator) */ | |
415 | unsigned namelist_mode : 1; | |
416 | /* A namelist specific flag used in the list directed library | |
417 | to flag read errors and return, so that an attempt can be | |
418 | made to read a new object name. */ | |
419 | unsigned nml_read_error : 1; | |
420 | /* A sequential formatted read specific flag used to signal that a | |
421 | character string is being read so don't use commas to shorten a | |
422 | formatted field width. */ | |
423 | unsigned sf_read_comma : 1; | |
424 | /* A namelist specific flag used to enable reading input from | |
425 | line_buffer for logical reads. */ | |
426 | unsigned line_buffer_enabled : 1; | |
427 | /* An internal unit specific flag used to identify that the associated | |
428 | unit is internal. */ | |
429 | unsigned unit_is_internal : 1; | |
430 | /* An internal unit specific flag to signify an EOF condition for list | |
431 | directed read. */ | |
432 | unsigned at_eof : 1; | |
433 | /* 16 unused bits. */ | |
434 | ||
435 | char last_char; | |
436 | char nml_delim; | |
437 | ||
438 | int repeat_count; | |
439 | int saved_length; | |
440 | int saved_used; | |
441 | bt saved_type; | |
442 | char *saved_string; | |
443 | char *scratch; | |
444 | char *line_buffer; | |
445 | struct format_data *fmt; | |
446 | jmp_buf *eof_jump; | |
447 | namelist_info *ionml; | |
448 | /* A flag used to identify when a non-standard expanded namelist read | |
449 | has occurred. */ | |
450 | int expanded_read; | |
451 | /* Storage area for values except for strings. Must be large | |
452 | enough to hold a complex value (two reals) of the largest | |
453 | kind. */ | |
454 | char value[32]; | |
455 | gfc_offset size_used; | |
456 | } st_parameter_43; | |
457 | ||
458 | ||
459 | typedef struct st_parameter_44 | |
5e805e44 | 460 | { |
80ad1971 | 461 | GFC_INTEGER_4 *id; |
10256cbe JD |
462 | GFC_IO_INT pos; |
463 | CHARACTER1 (asynchronous); | |
464 | CHARACTER2 (blank); | |
465 | CHARACTER1 (decimal); | |
466 | CHARACTER2 (delim); | |
467 | CHARACTER1 (pad); | |
468 | CHARACTER2 (round); | |
469 | CHARACTER1 (sign); | |
d7445152 JD |
470 | void (*transfer) (struct st_parameter_dt *, bt, void *, int, |
471 | size_t, size_t); | |
472 | struct gfc_unit *current_unit; | |
473 | /* Item number in a formatted data transfer. Also used in namelist | |
474 | read_logical as an index into line_buffer. */ | |
475 | int item_count; | |
476 | unit_mode mode; | |
477 | unit_blank blank_status; | |
478 | unit_sign sign_status; | |
479 | int scale_factor; | |
480 | int max_pos; /* Maximum righthand column written to. */ | |
481 | /* Number of skips + spaces to be done for T and X-editing. */ | |
482 | int skips; | |
483 | /* Number of spaces to be done for T and X-editing. */ | |
484 | int pending_spaces; | |
485 | /* Whether an EOR condition was encountered. Value is: | |
486 | 0 if no EOR was encountered | |
487 | 1 if an EOR was encountered due to a 1-byte marker (LF) | |
488 | 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ | |
489 | int sf_seen_eor; | |
490 | unit_advance advance_status; | |
491 | unsigned reversion_flag : 1; /* Format reversion has occurred. */ | |
492 | unsigned first_item : 1; | |
493 | unsigned seen_dollar : 1; | |
494 | unsigned eor_condition : 1; | |
495 | unsigned no_leading_blank : 1; | |
496 | unsigned char_flag : 1; | |
497 | unsigned input_complete : 1; | |
498 | unsigned at_eol : 1; | |
499 | unsigned comma_flag : 1; | |
500 | /* A namelist specific flag used in the list directed library | |
501 | to flag that calls are being made from namelist read (eg. to | |
502 | ignore comments or to treat '/' as a terminator) */ | |
503 | unsigned namelist_mode : 1; | |
504 | /* A namelist specific flag used in the list directed library | |
505 | to flag read errors and return, so that an attempt can be | |
506 | made to read a new object name. */ | |
507 | unsigned nml_read_error : 1; | |
508 | /* A sequential formatted read specific flag used to signal that a | |
509 | character string is being read so don't use commas to shorten a | |
510 | formatted field width. */ | |
511 | unsigned sf_read_comma : 1; | |
512 | /* A namelist specific flag used to enable reading input from | |
513 | line_buffer for logical reads. */ | |
514 | unsigned line_buffer_enabled : 1; | |
515 | /* An internal unit specific flag used to identify that the associated | |
516 | unit is internal. */ | |
517 | unsigned unit_is_internal : 1; | |
518 | /* An internal unit specific flag to signify an EOF condition for list | |
519 | directed read. */ | |
520 | unsigned at_eof : 1; | |
521 | /* 16 unused bits. */ | |
522 | ||
523 | char last_char; | |
524 | char nml_delim; | |
525 | ||
526 | int repeat_count; | |
527 | int saved_length; | |
528 | int saved_used; | |
529 | bt saved_type; | |
530 | char *saved_string; | |
531 | char *scratch; | |
532 | char *line_buffer; | |
533 | struct format_data *fmt; | |
534 | jmp_buf *eof_jump; | |
535 | namelist_info *ionml; | |
536 | /* A flag used to identify when a non-standard expanded namelist read | |
537 | has occurred. */ | |
538 | int expanded_read; | |
539 | /* Storage area for values except for strings. Must be large | |
540 | enough to hold a complex value (two reals) of the largest | |
541 | kind. */ | |
542 | char value[32]; | |
543 | gfc_offset size_used; | |
d7445152 JD |
544 | } st_parameter_44; |
545 | ||
546 | typedef struct st_parameter_dt | |
547 | { | |
548 | st_parameter_common common; | |
549 | GFC_IO_INT rec; | |
550 | GFC_IO_INT *size, *iolength; | |
551 | gfc_array_char *internal_unit_desc; | |
552 | CHARACTER1 (format); | |
553 | CHARACTER2 (advance); | |
554 | CHARACTER1 (internal_unit); | |
555 | CHARACTER2 (namelist_name); | |
5e805e44 JJ |
556 | /* Private part of the structure. The compiler just needs |
557 | to reserve enough space. */ | |
558 | union | |
559 | { | |
d7445152 JD |
560 | st_parameter_43 q; |
561 | st_parameter_44 p; | |
ebf85e50 JJ |
562 | /* This pad size must be equal to the pad_size declared in |
563 | trans-io.c (gfc_build_io_library_fndecls). The above structure | |
564 | must be smaller or equal to this array. */ | |
d7445152 | 565 | char pad[32 * sizeof (char *) + 32 * sizeof (int)]; |
5e805e44 | 566 | } u; |
6de9cd9a | 567 | } |
5e805e44 | 568 | st_parameter_dt; |
6de9cd9a | 569 | |
ebf85e50 JJ |
570 | /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */ |
571 | extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) | |
572 | >= sizeof (((st_parameter_dt *) 0)->u.p) | |
573 | ? 1 : -1]; | |
574 | ||
10256cbe JD |
575 | #define IOPARM_WAIT_HAS_ID (1 << 7) |
576 | ||
577 | typedef struct | |
578 | { | |
579 | st_parameter_common common; | |
580 | CHARACTER1 (id); | |
581 | } | |
582 | st_parameter_wait; | |
583 | ||
584 | ||
5e805e44 JJ |
585 | #undef CHARACTER1 |
586 | #undef CHARACTER2 | |
6de9cd9a DN |
587 | |
588 | typedef struct | |
589 | { | |
590 | unit_access access; | |
591 | unit_action action; | |
592 | unit_blank blank; | |
593 | unit_delim delim; | |
594 | unit_form form; | |
595 | int is_notpadded; | |
596 | unit_position position; | |
597 | unit_status status; | |
598 | unit_pad pad; | |
d7445152 JD |
599 | unit_convert convert; |
600 | int has_recl; | |
10256cbe JD |
601 | unit_decimal decimal; |
602 | unit_encoding encoding; | |
603 | unit_round round; | |
604 | unit_sign sign; | |
10256cbe | 605 | unit_async async; |
6de9cd9a DN |
606 | } |
607 | unit_flags; | |
608 | ||
609 | ||
15877a88 JB |
610 | /* Formatting buffer. This is a temporary scratch buffer. Currently used only |
611 | by formatted writes. After every | |
612 | formatted write statement, this buffer is flushed. This buffer is needed since | |
613 | not all devices are seekable, and T or TL edit descriptors require | |
614 | moving backwards in the record. However, advance='no' complicates the | |
615 | situation, so the buffer must only be partially flushed from the end of the | |
616 | last flush until the current position in the record. */ | |
617 | ||
618 | typedef struct fbuf | |
619 | { | |
620 | char *buf; /* Start of buffer. */ | |
621 | size_t len; /* Length of buffer. */ | |
622 | size_t act; /* Active bytes in buffer. */ | |
623 | size_t flushed; /* Flushed bytes from beginning of buffer. */ | |
8947fd62 | 624 | size_t pos; /* Current position in buffer. */ |
15877a88 JB |
625 | } |
626 | fbuf; | |
627 | ||
628 | ||
909087e0 | 629 | typedef struct gfc_unit |
6de9cd9a DN |
630 | { |
631 | int unit_number; | |
6de9cd9a | 632 | stream *s; |
965eec16 JD |
633 | |
634 | /* Treap links. */ | |
635 | struct gfc_unit *left, *right; | |
6de9cd9a DN |
636 | int priority; |
637 | ||
108bc190 TK |
638 | int read_bad, current_record, saved_pos, previous_nonadvancing_write; |
639 | ||
6de9cd9a DN |
640 | enum |
641 | { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } | |
642 | endfile; | |
643 | ||
5e805e44 | 644 | unit_mode mode; |
6de9cd9a | 645 | unit_flags flags; |
105b7136 JD |
646 | unit_pad pad_status; |
647 | unit_decimal decimal_status; | |
648 | unit_delim delim_status; | |
5e805e44 | 649 | |
07b3bbf2 TK |
650 | /* recl -- Record length of the file. |
651 | last_record -- Last record number read or written | |
652 | maxrec -- Maximum record number in a direct access file | |
653 | bytes_left -- Bytes left in current record. | |
654 | strm_pos -- Current position in file for STREAM I/O. | |
655 | recl_subrecord -- Maximum length for subrecord. | |
656 | bytes_left_subrecord -- Bytes left in current subrecord. */ | |
657 | gfc_offset recl, last_record, maxrec, bytes_left, strm_pos, | |
658 | recl_subrecord, bytes_left_subrecord; | |
659 | ||
660 | /* Set to 1 if we have read a subrecord. */ | |
661 | ||
662 | int continued; | |
6de9cd9a | 663 | |
5e805e44 JJ |
664 | __gthread_mutex_t lock; |
665 | /* Number of threads waiting to acquire this unit's lock. | |
666 | When non-zero, close_unit doesn't only removes the unit | |
667 | from the UNIT_ROOT tree, but doesn't free it and the | |
668 | last of the waiting threads will do that. | |
669 | This must be either atomically increased/decreased, or | |
670 | always guarded by UNIT_LOCK. */ | |
671 | int waiting; | |
672 | /* Flag set by close_unit if the unit as been closed. | |
673 | Must be manipulated under unit's lock. */ | |
674 | int closed; | |
675 | ||
965eec16 JD |
676 | /* For traversing arrays */ |
677 | array_loop_spec *ls; | |
678 | int rank; | |
5e805e44 | 679 | |
6de9cd9a | 680 | int file_len; |
5e805e44 | 681 | char *file; |
15877a88 JB |
682 | |
683 | /* Formatting buffer. */ | |
684 | struct fbuf *fbuf; | |
6de9cd9a | 685 | } |
909087e0 | 686 | gfc_unit; |
6de9cd9a | 687 | |
6de9cd9a DN |
688 | /* Format tokens. Only about half of these can be stored in the |
689 | format nodes. */ | |
690 | ||
691 | typedef enum | |
692 | { | |
693 | FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, | |
694 | FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, | |
695 | FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, | |
696 | FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, | |
10256cbe JD |
697 | FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, |
698 | FMT_DP | |
6de9cd9a DN |
699 | } |
700 | format_token; | |
701 | ||
702 | ||
703 | /* Format nodes. A format string is converted into a tree of these | |
704 | structures, which is traversed as part of a data transfer statement. */ | |
705 | ||
706 | typedef struct fnode | |
707 | { | |
708 | format_token format; | |
709 | int repeat; | |
710 | struct fnode *next; | |
711 | char *source; | |
712 | ||
713 | union | |
714 | { | |
715 | struct | |
716 | { | |
717 | int w, d, e; | |
718 | } | |
719 | real; | |
720 | ||
721 | struct | |
722 | { | |
723 | int length; | |
724 | char *p; | |
725 | } | |
726 | string; | |
727 | ||
728 | struct | |
729 | { | |
730 | int w, m; | |
731 | } | |
732 | integer; | |
733 | ||
734 | int w; | |
735 | int k; | |
736 | int r; | |
737 | int n; | |
738 | ||
739 | struct fnode *child; | |
740 | } | |
741 | u; | |
742 | ||
743 | /* Members for traversing the tree during data transfer. */ | |
744 | ||
745 | int count; | |
746 | struct fnode *current; | |
747 | ||
748 | } | |
749 | fnode; | |
750 | ||
751 | ||
752 | /* unix.c */ | |
753 | ||
7d7b8bfe RH |
754 | extern int move_pos_offset (stream *, int); |
755 | internal_proto(move_pos_offset); | |
6de9cd9a | 756 | |
7d7b8bfe RH |
757 | extern int compare_files (stream *, stream *); |
758 | internal_proto(compare_files); | |
6de9cd9a | 759 | |
5e805e44 | 760 | extern stream *open_external (st_parameter_open *, unit_flags *); |
7d7b8bfe | 761 | internal_proto(open_external); |
6de9cd9a | 762 | |
9370b3c0 | 763 | extern stream *open_internal (char *, int, gfc_offset); |
7d7b8bfe | 764 | internal_proto(open_internal); |
6de9cd9a | 765 | |
7d7b8bfe RH |
766 | extern stream *input_stream (void); |
767 | internal_proto(input_stream); | |
6de9cd9a | 768 | |
7d7b8bfe RH |
769 | extern stream *output_stream (void); |
770 | internal_proto(output_stream); | |
6de9cd9a | 771 | |
fbac3363 DE |
772 | extern stream *error_stream (void); |
773 | internal_proto(error_stream); | |
774 | ||
ad238e4f | 775 | extern int compare_file_filename (gfc_unit *, const char *, int); |
7d7b8bfe | 776 | internal_proto(compare_file_filename); |
6de9cd9a | 777 | |
5e805e44 | 778 | extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); |
7d7b8bfe | 779 | internal_proto(find_file); |
6de9cd9a | 780 | |
7d7b8bfe RH |
781 | extern int stream_at_bof (stream *); |
782 | internal_proto(stream_at_bof); | |
6de9cd9a | 783 | |
7d7b8bfe RH |
784 | extern int stream_at_eof (stream *); |
785 | internal_proto(stream_at_eof); | |
6de9cd9a | 786 | |
7d7b8bfe RH |
787 | extern int delete_file (gfc_unit *); |
788 | internal_proto(delete_file); | |
6de9cd9a | 789 | |
5e805e44 | 790 | extern int file_exists (const char *file, gfc_charlen_type file_len); |
7d7b8bfe | 791 | internal_proto(file_exists); |
6de9cd9a | 792 | |
7d7b8bfe RH |
793 | extern const char *inquire_sequential (const char *, int); |
794 | internal_proto(inquire_sequential); | |
6de9cd9a | 795 | |
7d7b8bfe RH |
796 | extern const char *inquire_direct (const char *, int); |
797 | internal_proto(inquire_direct); | |
6de9cd9a | 798 | |
7d7b8bfe RH |
799 | extern const char *inquire_formatted (const char *, int); |
800 | internal_proto(inquire_formatted); | |
6de9cd9a | 801 | |
7d7b8bfe RH |
802 | extern const char *inquire_unformatted (const char *, int); |
803 | internal_proto(inquire_unformatted); | |
6de9cd9a | 804 | |
7d7b8bfe RH |
805 | extern const char *inquire_read (const char *, int); |
806 | internal_proto(inquire_read); | |
6de9cd9a | 807 | |
7d7b8bfe RH |
808 | extern const char *inquire_write (const char *, int); |
809 | internal_proto(inquire_write); | |
6de9cd9a | 810 | |
7d7b8bfe RH |
811 | extern const char *inquire_readwrite (const char *, int); |
812 | internal_proto(inquire_readwrite); | |
6de9cd9a | 813 | |
7d7b8bfe RH |
814 | extern gfc_offset file_length (stream *); |
815 | internal_proto(file_length); | |
6de9cd9a | 816 | |
7d7b8bfe RH |
817 | extern gfc_offset file_position (stream *); |
818 | internal_proto(file_position); | |
6de9cd9a | 819 | |
7d7b8bfe RH |
820 | extern int is_seekable (stream *); |
821 | internal_proto(is_seekable); | |
6de9cd9a | 822 | |
7ab8aa36 JD |
823 | extern int is_special (stream *); |
824 | internal_proto(is_special); | |
825 | ||
b65b81f9 FXC |
826 | extern int is_preconnected (stream *); |
827 | internal_proto(is_preconnected); | |
828 | ||
159840cb FXC |
829 | extern void flush_if_preconnected (stream *); |
830 | internal_proto(flush_if_preconnected); | |
831 | ||
7d7b8bfe RH |
832 | extern void empty_internal_buffer(stream *); |
833 | internal_proto(empty_internal_buffer); | |
6de9cd9a | 834 | |
7d7b8bfe RH |
835 | extern try flush (stream *); |
836 | internal_proto(flush); | |
6de9cd9a | 837 | |
ae8b8789 FXC |
838 | extern int stream_isatty (stream *); |
839 | internal_proto(stream_isatty); | |
840 | ||
841 | extern char * stream_ttyname (stream *); | |
842 | internal_proto(stream_ttyname); | |
843 | ||
5d723e54 FXC |
844 | extern gfc_offset stream_offset (stream *s); |
845 | internal_proto(stream_offset); | |
846 | ||
10c682a0 FXC |
847 | extern int unpack_filename (char *, const char *, int); |
848 | internal_proto(unpack_filename); | |
849 | ||
6de9cd9a DN |
850 | /* unit.c */ |
851 | ||
5e805e44 JJ |
852 | /* Maximum file offset, computed at library initialization time. */ |
853 | extern gfc_offset max_offset; | |
854 | internal_proto(max_offset); | |
855 | ||
856 | /* Unit tree root. */ | |
857 | extern gfc_unit *unit_root; | |
858 | internal_proto(unit_root); | |
859 | ||
860 | extern __gthread_mutex_t unit_lock; | |
861 | internal_proto(unit_lock); | |
6de9cd9a | 862 | |
7d7b8bfe RH |
863 | extern int close_unit (gfc_unit *); |
864 | internal_proto(close_unit); | |
6de9cd9a | 865 | |
54ffdb12 JD |
866 | extern gfc_unit *get_internal_unit (st_parameter_dt *); |
867 | internal_proto(get_internal_unit); | |
868 | ||
869 | extern void free_internal_unit (st_parameter_dt *); | |
870 | internal_proto(free_internal_unit); | |
91b30ee5 | 871 | |
7d7b8bfe RH |
872 | extern gfc_unit *find_unit (int); |
873 | internal_proto(find_unit); | |
6de9cd9a | 874 | |
5e805e44 | 875 | extern gfc_unit *find_or_create_unit (int); |
59c0928b | 876 | internal_proto(find_or_create_unit); |
5e805e44 JJ |
877 | |
878 | extern gfc_unit *get_unit (st_parameter_dt *, int); | |
7d7b8bfe | 879 | internal_proto(get_unit); |
6de9cd9a | 880 | |
5e805e44 JJ |
881 | extern void unlock_unit (gfc_unit *); |
882 | internal_proto(unlock_unit); | |
883 | ||
16d962d9 JD |
884 | extern void update_position (gfc_unit *); |
885 | internal_proto(update_position); | |
886 | ||
108bc190 TK |
887 | extern void finish_last_advance_record (gfc_unit *u); |
888 | internal_proto (finish_last_advance_record); | |
889 | ||
6de9cd9a DN |
890 | /* open.c */ |
891 | ||
5e805e44 | 892 | extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); |
7d7b8bfe | 893 | internal_proto(new_unit); |
6de9cd9a DN |
894 | |
895 | /* format.c */ | |
896 | ||
5e805e44 | 897 | extern void parse_format (st_parameter_dt *); |
7d7b8bfe | 898 | internal_proto(parse_format); |
6de9cd9a | 899 | |
5e805e44 | 900 | extern const fnode *next_format (st_parameter_dt *); |
7d7b8bfe | 901 | internal_proto(next_format); |
6de9cd9a | 902 | |
5e805e44 | 903 | extern void unget_format (st_parameter_dt *, const fnode *); |
7d7b8bfe | 904 | internal_proto(unget_format); |
6de9cd9a | 905 | |
5e805e44 | 906 | extern void format_error (st_parameter_dt *, const fnode *, const char *); |
7d7b8bfe | 907 | internal_proto(format_error); |
6de9cd9a | 908 | |
5e805e44 JJ |
909 | extern void free_format_data (st_parameter_dt *); |
910 | internal_proto(free_format_data); | |
6de9cd9a DN |
911 | |
912 | /* transfer.c */ | |
913 | ||
914 | #define SCRATCH_SIZE 300 | |
915 | ||
7d7b8bfe RH |
916 | extern const char *type_name (bt); |
917 | internal_proto(type_name); | |
6de9cd9a | 918 | |
15877a88 JB |
919 | extern try read_block_form (st_parameter_dt *, void *, size_t *); |
920 | internal_proto(read_block_form); | |
6de9cd9a | 921 | |
0853054e JD |
922 | extern char *read_sf (st_parameter_dt *, int *, int); |
923 | internal_proto(read_sf); | |
924 | ||
5e805e44 | 925 | extern void *write_block (st_parameter_dt *, int); |
7d7b8bfe | 926 | internal_proto(write_block); |
6de9cd9a | 927 | |
9370b3c0 TK |
928 | extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *, |
929 | int*); | |
965eec16 JD |
930 | internal_proto(next_array_record); |
931 | ||
9370b3c0 TK |
932 | extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *, |
933 | gfc_offset *); | |
965eec16 JD |
934 | internal_proto(init_loop_spec); |
935 | ||
5e805e44 | 936 | extern void next_record (st_parameter_dt *, int); |
7d7b8bfe | 937 | internal_proto(next_record); |
6de9cd9a | 938 | |
181c9f4a TK |
939 | extern void reverse_memcpy (void *, const void *, size_t); |
940 | internal_proto (reverse_memcpy); | |
941 | ||
10256cbe JD |
942 | extern void st_wait (st_parameter_wait *); |
943 | export_proto(st_wait); | |
944 | ||
6de9cd9a DN |
945 | /* read.c */ |
946 | ||
32aa3bff | 947 | extern void set_integer (void *, GFC_INTEGER_LARGEST, int); |
7d7b8bfe | 948 | internal_proto(set_integer); |
6de9cd9a | 949 | |
32aa3bff | 950 | extern GFC_UINTEGER_LARGEST max_value (int, int); |
7d7b8bfe | 951 | internal_proto(max_value); |
6de9cd9a | 952 | |
5e805e44 | 953 | extern int convert_real (st_parameter_dt *, void *, const char *, int); |
7d7b8bfe | 954 | internal_proto(convert_real); |
6de9cd9a | 955 | |
5e805e44 | 956 | extern void read_a (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 957 | internal_proto(read_a); |
6de9cd9a | 958 | |
cea93abb JD |
959 | extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int); |
960 | internal_proto(read_a); | |
961 | ||
5e805e44 | 962 | extern void read_f (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 963 | internal_proto(read_f); |
6de9cd9a | 964 | |
5e805e44 | 965 | extern void read_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 966 | internal_proto(read_l); |
6de9cd9a | 967 | |
5e805e44 | 968 | extern void read_x (st_parameter_dt *, int); |
7d7b8bfe | 969 | internal_proto(read_x); |
6de9cd9a | 970 | |
5e805e44 | 971 | extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); |
7d7b8bfe | 972 | internal_proto(read_radix); |
6de9cd9a | 973 | |
5e805e44 | 974 | extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 975 | internal_proto(read_decimal); |
6de9cd9a DN |
976 | |
977 | /* list_read.c */ | |
978 | ||
5e805e44 JJ |
979 | extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, |
980 | size_t); | |
7d7b8bfe | 981 | internal_proto(list_formatted_read); |
6de9cd9a | 982 | |
5e805e44 | 983 | extern void finish_list_read (st_parameter_dt *); |
7d7b8bfe | 984 | internal_proto(finish_list_read); |
6de9cd9a | 985 | |
5e805e44 | 986 | extern void namelist_read (st_parameter_dt *); |
7d7b8bfe | 987 | internal_proto(namelist_read); |
6de9cd9a | 988 | |
5e805e44 | 989 | extern void namelist_write (st_parameter_dt *); |
7d7b8bfe | 990 | internal_proto(namelist_write); |
6de9cd9a DN |
991 | |
992 | /* write.c */ | |
993 | ||
5e805e44 | 994 | extern void write_a (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 995 | internal_proto(write_a); |
6de9cd9a | 996 | |
cea93abb JD |
997 | extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int); |
998 | internal_proto(write_a_char4); | |
999 | ||
5e805e44 | 1000 | extern void write_b (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1001 | internal_proto(write_b); |
6de9cd9a | 1002 | |
5e805e44 | 1003 | extern void write_d (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1004 | internal_proto(write_d); |
6de9cd9a | 1005 | |
5e805e44 | 1006 | extern void write_e (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1007 | internal_proto(write_e); |
6de9cd9a | 1008 | |
5e805e44 | 1009 | extern void write_en (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1010 | internal_proto(write_en); |
6de9cd9a | 1011 | |
5e805e44 | 1012 | extern void write_es (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1013 | internal_proto(write_es); |
6de9cd9a | 1014 | |
5e805e44 | 1015 | extern void write_f (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1016 | internal_proto(write_f); |
6de9cd9a | 1017 | |
5e805e44 | 1018 | extern void write_i (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1019 | internal_proto(write_i); |
6de9cd9a | 1020 | |
5e805e44 | 1021 | extern void write_l (st_parameter_dt *, const fnode *, char *, int); |
7d7b8bfe | 1022 | internal_proto(write_l); |
6de9cd9a | 1023 | |
5e805e44 | 1024 | extern void write_o (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1025 | internal_proto(write_o); |
6de9cd9a | 1026 | |
9355110f JD |
1027 | extern void write_real (st_parameter_dt *, const char *, int); |
1028 | internal_proto(write_real); | |
1029 | ||
900e887f JD |
1030 | extern void write_real_g0 (st_parameter_dt *, const char *, int, int); |
1031 | internal_proto(write_real_g0); | |
1032 | ||
5e805e44 | 1033 | extern void write_x (st_parameter_dt *, int, int); |
7d7b8bfe | 1034 | internal_proto(write_x); |
6de9cd9a | 1035 | |
5e805e44 | 1036 | extern void write_z (st_parameter_dt *, const fnode *, const char *, int); |
7d7b8bfe | 1037 | internal_proto(write_z); |
6de9cd9a | 1038 | |
5e805e44 JJ |
1039 | extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, |
1040 | size_t); | |
7d7b8bfe | 1041 | internal_proto(list_formatted_write); |
6de9cd9a | 1042 | |
e5ef4b3b JB |
1043 | /* size_from_kind.c */ |
1044 | extern size_t size_from_real_kind (int); | |
1045 | internal_proto(size_from_real_kind); | |
1046 | ||
1047 | extern size_t size_from_complex_kind (int); | |
1048 | internal_proto(size_from_complex_kind); | |
1049 | ||
15877a88 JB |
1050 | /* fbuf.c */ |
1051 | extern void fbuf_init (gfc_unit *, size_t); | |
1052 | internal_proto(fbuf_init); | |
1053 | ||
1054 | extern void fbuf_destroy (gfc_unit *); | |
1055 | internal_proto(fbuf_destroy); | |
1056 | ||
1057 | extern void fbuf_reset (gfc_unit *); | |
1058 | internal_proto(fbuf_reset); | |
1059 | ||
1060 | extern char * fbuf_alloc (gfc_unit *, size_t); | |
1061 | internal_proto(fbuf_alloc); | |
1062 | ||
1063 | extern int fbuf_flush (gfc_unit *, int); | |
1064 | internal_proto(fbuf_flush); | |
1065 | ||
1066 | extern int fbuf_seek (gfc_unit *, gfc_offset); | |
1067 | internal_proto(fbuf_seek); | |
1068 | ||
5e805e44 JJ |
1069 | /* lock.c */ |
1070 | extern void free_ionml (st_parameter_dt *); | |
1071 | internal_proto(free_ionml); | |
1072 | ||
1073 | static inline void | |
1074 | inc_waiting_locked (gfc_unit *u) | |
1075 | { | |
1076 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
1077 | (void) __sync_fetch_and_add (&u->waiting, 1); | |
1078 | #else | |
1079 | u->waiting++; | |
1080 | #endif | |
1081 | } | |
1082 | ||
1083 | static inline int | |
1084 | predec_waiting_locked (gfc_unit *u) | |
1085 | { | |
1086 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
1087 | return __sync_add_and_fetch (&u->waiting, -1); | |
1088 | #else | |
1089 | return --u->waiting; | |
1090 | #endif | |
1091 | } | |
1092 | ||
1093 | static inline void | |
1094 | dec_waiting_unlocked (gfc_unit *u) | |
1095 | { | |
1096 | #ifdef HAVE_SYNC_FETCH_AND_ADD | |
1097 | (void) __sync_fetch_and_add (&u->waiting, -1); | |
1098 | #else | |
1099 | __gthread_mutex_lock (&unit_lock); | |
1100 | u->waiting--; | |
1101 | __gthread_mutex_unlock (&unit_lock); | |
1102 | #endif | |
1103 | } | |
1104 | ||
6de9cd9a | 1105 | #endif |
eaa90d25 | 1106 |