1 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4 F2003 I/O support contributed by Jerry DeLisle
6 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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 3, or (at your option)
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.
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.
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/>. */
30 /* IO library include. */
32 #include "libgfortran.h"
37 /* Basic types used in data transfers. */
40 { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
45 struct st_parameter_dt;
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 *);
53 /* Avoid keyword truncate due to AIX namespace collision. */
54 int (*trunc) (struct stream *, off_t);
55 int (*flush) (struct stream *);
56 int (*close) (struct stream *);
60 /* Inline functions for doing file I/O given a stream. */
62 sread (stream * s, void * buf, ssize_t nbyte)
64 return s->read (s, buf, nbyte);
68 swrite (stream * s, const void * buf, ssize_t nbyte)
70 return s->write (s, buf, nbyte);
74 sseek (stream * s, off_t offset, int whence)
76 return s->seek (s, offset, whence);
86 struncate (stream * s, off_t length)
88 return s->trunc (s, length);
104 /* Macros for testing what kinds of I/O we are doing. */
106 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
108 #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
110 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
112 /* The array_loop_spec contains the variables for the loops over index ranges
113 that are encountered. Since the variables can be negative, ssize_t
116 typedef struct array_loop_spec
118 /* Index counter for this dimension. */
121 /* Start for the index counter. */
124 /* End for the index counter. */
127 /* Step for the index counter. */
132 /* A stucture to build a hash table for format data. */
134 #define FORMAT_HASH_SIZE 16
136 typedef struct format_hash_entry
139 gfc_charlen_type key_len;
140 struct format_data *hashed_fmt;
144 /* Representation of a namelist object in libgfortran
147 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
149 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
151 The object can be a fully qualified, compound name for an intrinsic
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.
157 These requirements are met by the following data structures.
159 namelist_info type contains all the scalar information about the
160 object and arrays of descriptor_dimension and array_loop_spec types for
163 typedef struct namelist_type
165 /* Object type, stored as GFC_DTYPE_xxxx. */
171 /* Address for the start of the object's data. */
174 /* Flag to show that a read is to be attempted for this node. */
177 /* Length of intrinsic type in bytes. */
180 /* Rank of the object. */
183 /* Overall size of the object in bytes. */
186 /* Length of character string. */
187 index_type string_length;
189 descriptor_dimension * dim;
190 array_loop_spec * ls;
191 struct namelist_type * next;
195 /* Options for the OPEN statement. */
198 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
204 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
210 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
214 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
220 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
224 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
230 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
231 STATUS_REPLACE, STATUS_UNSPECIFIED
236 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
240 { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
244 { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
248 { ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
249 ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
252 /* NOTE: unit_sign must correspond with the sign_status enumerator in
253 st_parameter_dt to not break the ABI. */
255 { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED }
259 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
267 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
271 { SIGN_S, SIGN_SS, SIGN_SP }
274 #define CHARACTER1(name) \
276 gfc_charlen_type name ## _len
277 #define CHARACTER2(name) \
278 gfc_charlen_type name ## _len; \
283 st_parameter_common common;
284 GFC_INTEGER_4 recl_in;
290 CHARACTER1 (position);
294 CHARACTER1 (convert);
295 CHARACTER2 (decimal);
296 CHARACTER1 (encoding);
299 CHARACTER2 (asynchronous);
300 GFC_INTEGER_4 *newunit;
304 #define IOPARM_CLOSE_HAS_STATUS (1 << 7)
308 st_parameter_common common;
315 st_parameter_common common;
317 st_parameter_filepos;
319 #define IOPARM_INQUIRE_HAS_EXIST (1 << 7)
320 #define IOPARM_INQUIRE_HAS_OPENED (1 << 8)
321 #define IOPARM_INQUIRE_HAS_NUMBER (1 << 9)
322 #define IOPARM_INQUIRE_HAS_NAMED (1 << 10)
323 #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11)
324 #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12)
325 #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
326 #define IOPARM_INQUIRE_HAS_FILE (1 << 14)
327 #define IOPARM_INQUIRE_HAS_ACCESS (1 << 15)
328 #define IOPARM_INQUIRE_HAS_FORM (1 << 16)
329 #define IOPARM_INQUIRE_HAS_BLANK (1 << 17)
330 #define IOPARM_INQUIRE_HAS_POSITION (1 << 18)
331 #define IOPARM_INQUIRE_HAS_ACTION (1 << 19)
332 #define IOPARM_INQUIRE_HAS_DELIM (1 << 20)
333 #define IOPARM_INQUIRE_HAS_PAD (1 << 21)
334 #define IOPARM_INQUIRE_HAS_NAME (1 << 22)
335 #define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23)
336 #define IOPARM_INQUIRE_HAS_DIRECT (1 << 24)
337 #define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25)
338 #define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26)
339 #define IOPARM_INQUIRE_HAS_READ (1 << 27)
340 #define IOPARM_INQUIRE_HAS_WRITE (1 << 28)
341 #define IOPARM_INQUIRE_HAS_READWRITE (1 << 29)
342 #define IOPARM_INQUIRE_HAS_CONVERT (1 << 30)
343 #define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31)
345 #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
346 #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
347 #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
348 #define IOPARM_INQUIRE_HAS_ROUND (1 << 3)
349 #define IOPARM_INQUIRE_HAS_SIGN (1 << 4)
350 #define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
351 #define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
352 #define IOPARM_INQUIRE_HAS_ID (1 << 7)
356 st_parameter_common common;
357 GFC_INTEGER_4 *exist, *opened, *number, *named;
358 GFC_INTEGER_4 *nextrec, *recl_out;
359 GFC_IO_INT *strm_pos_out;
364 CHARACTER1 (position);
369 CHARACTER2 (sequential);
371 CHARACTER2 (formatted);
372 CHARACTER1 (unformatted);
375 CHARACTER2 (readwrite);
376 CHARACTER1 (convert);
377 GFC_INTEGER_4 flags2;
378 CHARACTER1 (asynchronous);
379 CHARACTER2 (decimal);
380 CHARACTER1 (encoding);
383 GFC_INTEGER_4 *pending;
387 st_parameter_inquire;
392 #define IOPARM_DT_LIST_FORMAT (1 << 7)
393 #define IOPARM_DT_NAMELIST_READ_MODE (1 << 8)
394 #define IOPARM_DT_HAS_REC (1 << 9)
395 #define IOPARM_DT_HAS_SIZE (1 << 10)
396 #define IOPARM_DT_HAS_IOLENGTH (1 << 11)
397 #define IOPARM_DT_HAS_FORMAT (1 << 12)
398 #define IOPARM_DT_HAS_ADVANCE (1 << 13)
399 #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14)
400 #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15)
401 #define IOPARM_DT_HAS_ID (1 << 16)
402 #define IOPARM_DT_HAS_POS (1 << 17)
403 #define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18)
404 #define IOPARM_DT_HAS_BLANK (1 << 19)
405 #define IOPARM_DT_HAS_DECIMAL (1 << 20)
406 #define IOPARM_DT_HAS_DELIM (1 << 21)
407 #define IOPARM_DT_HAS_PAD (1 << 22)
408 #define IOPARM_DT_HAS_ROUND (1 << 23)
409 #define IOPARM_DT_HAS_SIGN (1 << 24)
410 #define IOPARM_DT_HAS_F2003 (1 << 25)
411 /* Internal use bit. */
412 #define IOPARM_DT_IONML_SET (1 << 31)
415 typedef struct st_parameter_dt
417 st_parameter_common common;
419 GFC_IO_INT *size, *iolength;
420 gfc_array_char *internal_unit_desc;
422 CHARACTER2 (advance);
423 CHARACTER1 (internal_unit);
424 CHARACTER2 (namelist_name);
425 /* Private part of the structure. The compiler just needs
426 to reserve enough space. */
431 void (*transfer) (struct st_parameter_dt *, bt, void *, int,
433 struct gfc_unit *current_unit;
434 /* Item number in a formatted data transfer. Also used in namelist
435 read_logical as an index into line_buffer. */
438 unit_blank blank_status;
439 unit_sign sign_status;
441 int max_pos; /* Maximum righthand column written to. */
442 /* Number of skips + spaces to be done for T and X-editing. */
444 /* Number of spaces to be done for T and X-editing. */
446 /* Whether an EOR condition was encountered. Value is:
447 0 if no EOR was encountered
448 1 if an EOR was encountered due to a 1-byte marker (LF)
449 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
451 unit_advance advance_status;
452 unsigned reversion_flag : 1; /* Format reversion has occurred. */
453 unsigned first_item : 1;
454 unsigned seen_dollar : 1;
455 unsigned eor_condition : 1;
456 unsigned no_leading_blank : 1;
457 unsigned char_flag : 1;
458 unsigned input_complete : 1;
460 unsigned comma_flag : 1;
461 /* A namelist specific flag used in the list directed library
462 to flag that calls are being made from namelist read (eg. to
463 ignore comments or to treat '/' as a terminator) */
464 unsigned namelist_mode : 1;
465 /* A namelist specific flag used in the list directed library
466 to flag read errors and return, so that an attempt can be
467 made to read a new object name. */
468 unsigned nml_read_error : 1;
469 /* A sequential formatted read specific flag used to signal that a
470 character string is being read so don't use commas to shorten a
471 formatted field width. */
472 unsigned sf_read_comma : 1;
473 /* A namelist specific flag used to enable reading input from
474 line_buffer for logical reads. */
475 unsigned line_buffer_enabled : 1;
476 /* An internal unit specific flag used to identify that the associated
478 unsigned unit_is_internal : 1;
479 /* An internal unit specific flag to signify an EOF condition for list
482 /* Used for g0 floating point output. */
483 unsigned g0_no_blanks : 1;
484 /* Used to signal use of free_format_data. */
485 unsigned format_not_saved : 1;
486 /* 14 unused bits. */
498 struct format_data *fmt;
500 namelist_info *ionml;
501 /* A flag used to identify when a non-standard expanded namelist read
504 /* Storage area for values except for strings. Must be
505 large enough to hold a complex value (two reals) of the
508 GFC_IO_INT size_used;
510 /* This pad size must be equal to the pad_size declared in
511 trans-io.c (gfc_build_io_library_fndecls). The above structure
512 must be smaller or equal to this array. */
513 char pad[16 * sizeof (char *) + 32 * sizeof (int)];
517 CHARACTER1 (asynchronous);
519 CHARACTER1 (decimal);
527 /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */
528 extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
529 >= sizeof (((st_parameter_dt *) 0)->u.p)
532 #define IOPARM_WAIT_HAS_ID (1 << 7)
536 st_parameter_common common;
553 unit_position position;
556 unit_convert convert;
558 unit_decimal decimal;
559 unit_encoding encoding;
567 /* Formatting buffer. This is a temporary scratch buffer. Currently used only
568 by formatted writes. After every
569 formatted write statement, this buffer is flushed. This buffer is needed since
570 not all devices are seekable, and T or TL edit descriptors require
571 moving backwards in the record. However, advance='no' complicates the
572 situation, so the buffer must only be partially flushed from the end of the
573 last flush until the current position in the record. */
577 char *buf; /* Start of buffer. */
578 int len; /* Length of buffer. */
579 int act; /* Active bytes in buffer. */
580 int pos; /* Current position in buffer. */
585 typedef struct gfc_unit
591 struct gfc_unit *left, *right;
594 int read_bad, current_record, saved_pos, previous_nonadvancing_write;
597 { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
603 unit_decimal decimal_status;
604 unit_delim delim_status;
606 /* recl -- Record length of the file.
607 last_record -- Last record number read or written
608 maxrec -- Maximum record number in a direct access file
609 bytes_left -- Bytes left in current record.
610 strm_pos -- Current position in file for STREAM I/O.
611 recl_subrecord -- Maximum length for subrecord.
612 bytes_left_subrecord -- Bytes left in current subrecord. */
613 gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
614 recl_subrecord, bytes_left_subrecord;
616 /* Set to 1 if we have read a subrecord. */
620 __gthread_mutex_t lock;
621 /* Number of threads waiting to acquire this unit's lock.
622 When non-zero, close_unit doesn't only removes the unit
623 from the UNIT_ROOT tree, but doesn't free it and the
624 last of the waiting threads will do that.
625 This must be either atomically increased/decreased, or
626 always guarded by UNIT_LOCK. */
628 /* Flag set by close_unit if the unit as been closed.
629 Must be manipulated under unit's lock. */
632 /* For traversing arrays */
639 /* The format hash table. */
640 struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
642 /* Formatting buffer. */
647 /* Format tokens. Only about half of these can be stored in the
652 FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
653 FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
654 FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
655 FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
656 FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
662 /* Format nodes. A format string is converted into a tree of these
663 structures, which is traversed as part of a data transfer statement. */
702 /* Members for traversing the tree during data transfer. */
705 struct fnode *current;
713 extern int compare_files (stream *, stream *);
714 internal_proto(compare_files);
716 extern stream *open_external (st_parameter_open *, unit_flags *);
717 internal_proto(open_external);
719 extern stream *open_internal (char *, int, gfc_offset);
720 internal_proto(open_internal);
722 extern char * mem_alloc_w (stream *, int *);
723 internal_proto(mem_alloc_w);
725 extern char * mem_alloc_r (stream *, int *);
726 internal_proto(mem_alloc_w);
728 extern stream *input_stream (void);
729 internal_proto(input_stream);
731 extern stream *output_stream (void);
732 internal_proto(output_stream);
734 extern stream *error_stream (void);
735 internal_proto(error_stream);
737 extern int compare_file_filename (gfc_unit *, const char *, int);
738 internal_proto(compare_file_filename);
740 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
741 internal_proto(find_file);
743 extern int delete_file (gfc_unit *);
744 internal_proto(delete_file);
746 extern int file_exists (const char *file, gfc_charlen_type file_len);
747 internal_proto(file_exists);
749 extern const char *inquire_sequential (const char *, int);
750 internal_proto(inquire_sequential);
752 extern const char *inquire_direct (const char *, int);
753 internal_proto(inquire_direct);
755 extern const char *inquire_formatted (const char *, int);
756 internal_proto(inquire_formatted);
758 extern const char *inquire_unformatted (const char *, int);
759 internal_proto(inquire_unformatted);
761 extern const char *inquire_read (const char *, int);
762 internal_proto(inquire_read);
764 extern const char *inquire_write (const char *, int);
765 internal_proto(inquire_write);
767 extern const char *inquire_readwrite (const char *, int);
768 internal_proto(inquire_readwrite);
770 extern gfc_offset file_length (stream *);
771 internal_proto(file_length);
773 extern int is_seekable (stream *);
774 internal_proto(is_seekable);
776 extern int is_special (stream *);
777 internal_proto(is_special);
779 extern void flush_if_preconnected (stream *);
780 internal_proto(flush_if_preconnected);
782 extern void empty_internal_buffer(stream *);
783 internal_proto(empty_internal_buffer);
785 extern int stream_isatty (stream *);
786 internal_proto(stream_isatty);
788 extern char * stream_ttyname (stream *);
789 internal_proto(stream_ttyname);
791 extern int unpack_filename (char *, const char *, int);
792 internal_proto(unpack_filename);
796 /* Maximum file offset, computed at library initialization time. */
797 extern gfc_offset max_offset;
798 internal_proto(max_offset);
800 /* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
801 extern GFC_INTEGER_4 next_available_newunit;
802 internal_proto(next_available_newunit);
804 /* Unit tree root. */
805 extern gfc_unit *unit_root;
806 internal_proto(unit_root);
808 extern __gthread_mutex_t unit_lock;
809 internal_proto(unit_lock);
811 extern int close_unit (gfc_unit *);
812 internal_proto(close_unit);
814 extern gfc_unit *get_internal_unit (st_parameter_dt *);
815 internal_proto(get_internal_unit);
817 extern void free_internal_unit (st_parameter_dt *);
818 internal_proto(free_internal_unit);
820 extern gfc_unit *find_unit (int);
821 internal_proto(find_unit);
823 extern gfc_unit *find_or_create_unit (int);
824 internal_proto(find_or_create_unit);
826 extern gfc_unit *get_unit (st_parameter_dt *, int);
827 internal_proto(get_unit);
829 extern void unlock_unit (gfc_unit *);
830 internal_proto(unlock_unit);
832 extern void update_position (gfc_unit *);
833 internal_proto(update_position);
835 extern void finish_last_advance_record (gfc_unit *u);
836 internal_proto (finish_last_advance_record);
838 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
839 internal_proto (unit_truncate);
841 extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
842 internal_proto(get_unique_unit_number);
846 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
847 internal_proto(new_unit);
851 extern void parse_format (st_parameter_dt *);
852 internal_proto(parse_format);
854 extern const fnode *next_format (st_parameter_dt *);
855 internal_proto(next_format);
857 extern void unget_format (st_parameter_dt *, const fnode *);
858 internal_proto(unget_format);
860 extern void format_error (st_parameter_dt *, const fnode *, const char *);
861 internal_proto(format_error);
863 extern void free_format_data (struct format_data *);
864 internal_proto(free_format_data);
866 extern void free_format_hash_table (gfc_unit *);
867 internal_proto(free_format_hash_table);
869 extern void init_format_hash (st_parameter_dt *);
870 internal_proto(init_format_hash);
872 extern void free_format_hash (st_parameter_dt *);
873 internal_proto(free_format_hash);
877 #define SCRATCH_SIZE 300
879 extern const char *type_name (bt);
880 internal_proto(type_name);
882 extern void * read_block_form (st_parameter_dt *, int *);
883 internal_proto(read_block_form);
885 extern char *read_sf (st_parameter_dt *, int *, int);
886 internal_proto(read_sf);
888 extern void *write_block (st_parameter_dt *, int);
889 internal_proto(write_block);
891 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
893 internal_proto(next_array_record);
895 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
897 internal_proto(init_loop_spec);
899 extern void next_record (st_parameter_dt *, int);
900 internal_proto(next_record);
902 extern void reverse_memcpy (void *, const void *, size_t);
903 internal_proto (reverse_memcpy);
905 extern void st_wait (st_parameter_wait *);
906 export_proto(st_wait);
908 extern void hit_eof (st_parameter_dt *);
909 internal_proto(hit_eof);
913 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
914 internal_proto(set_integer);
916 extern GFC_UINTEGER_LARGEST max_value (int, int);
917 internal_proto(max_value);
919 extern int convert_real (st_parameter_dt *, void *, const char *, int);
920 internal_proto(convert_real);
922 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
923 internal_proto(read_a);
925 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
926 internal_proto(read_a);
928 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
929 internal_proto(read_f);
931 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
932 internal_proto(read_l);
934 extern void read_x (st_parameter_dt *, int);
935 internal_proto(read_x);
937 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
938 internal_proto(read_radix);
940 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
941 internal_proto(read_decimal);
945 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
947 internal_proto(list_formatted_read);
949 extern void finish_list_read (st_parameter_dt *);
950 internal_proto(finish_list_read);
952 extern void namelist_read (st_parameter_dt *);
953 internal_proto(namelist_read);
955 extern void namelist_write (st_parameter_dt *);
956 internal_proto(namelist_write);
960 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
961 internal_proto(write_a);
963 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
964 internal_proto(write_a_char4);
966 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
967 internal_proto(write_b);
969 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
970 internal_proto(write_d);
972 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
973 internal_proto(write_e);
975 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
976 internal_proto(write_en);
978 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
979 internal_proto(write_es);
981 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
982 internal_proto(write_f);
984 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
985 internal_proto(write_i);
987 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
988 internal_proto(write_l);
990 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
991 internal_proto(write_o);
993 extern void write_real (st_parameter_dt *, const char *, int);
994 internal_proto(write_real);
996 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
997 internal_proto(write_real_g0);
999 extern void write_x (st_parameter_dt *, int, int);
1000 internal_proto(write_x);
1002 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
1003 internal_proto(write_z);
1005 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
1007 internal_proto(list_formatted_write);
1009 /* size_from_kind.c */
1010 extern size_t size_from_real_kind (int);
1011 internal_proto(size_from_real_kind);
1013 extern size_t size_from_complex_kind (int);
1014 internal_proto(size_from_complex_kind);
1017 extern void fbuf_init (gfc_unit *, int);
1018 internal_proto(fbuf_init);
1020 extern void fbuf_destroy (gfc_unit *);
1021 internal_proto(fbuf_destroy);
1023 extern int fbuf_reset (gfc_unit *);
1024 internal_proto(fbuf_reset);
1026 extern char * fbuf_alloc (gfc_unit *, int);
1027 internal_proto(fbuf_alloc);
1029 extern int fbuf_flush (gfc_unit *, unit_mode);
1030 internal_proto(fbuf_flush);
1032 extern int fbuf_seek (gfc_unit *, int, int);
1033 internal_proto(fbuf_seek);
1035 extern char * fbuf_read (gfc_unit *, int *);
1036 internal_proto(fbuf_read);
1038 /* Never call this function, only use fbuf_getc(). */
1039 extern int fbuf_getc_refill (gfc_unit *);
1040 internal_proto(fbuf_getc_refill);
1043 fbuf_getc (gfc_unit * u)
1045 if (u->fbuf->pos < u->fbuf->act)
1046 return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
1047 return fbuf_getc_refill (u);
1051 extern void free_ionml (st_parameter_dt *);
1052 internal_proto(free_ionml);
1055 inc_waiting_locked (gfc_unit *u)
1057 #ifdef HAVE_SYNC_FETCH_AND_ADD
1058 (void) __sync_fetch_and_add (&u->waiting, 1);
1065 predec_waiting_locked (gfc_unit *u)
1067 #ifdef HAVE_SYNC_FETCH_AND_ADD
1068 return __sync_add_and_fetch (&u->waiting, -1);
1070 return --u->waiting;
1075 dec_waiting_unlocked (gfc_unit *u)
1077 #ifdef HAVE_SYNC_FETCH_AND_ADD
1078 (void) __sync_fetch_and_add (&u->waiting, -1);
1080 __gthread_mutex_lock (&unit_lock);
1082 __gthread_mutex_unlock (&unit_lock);