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